number reader: add to toplevel
This commit is contained in:
parent
0dab772a77
commit
6f2a1c8301
65
read.scm
65
read.scm
|
@ -323,6 +323,7 @@
|
|||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'type) 'ident)
|
||||
((eq? op 'location) location)
|
||||
((eq? op 'value) name)
|
||||
(else (error 'read:ident "invalid operation" op args))))))
|
||||
|
||||
|
@ -333,6 +334,7 @@
|
|||
(char-list 'push (car start-char)))
|
||||
(lambda (op . args)
|
||||
(cond
|
||||
((eq? op 'location) location)
|
||||
((eq? op 'finalize->ident)
|
||||
(read:ident (list->string (char-list 'to-list)) location))
|
||||
(else (apply char-list op args)))))))
|
||||
|
@ -377,12 +379,11 @@
|
|||
(list #\| %bol %eol #\' #\; #f))))
|
||||
|
||||
;;; Read an identifier starting with CHAR.
|
||||
(define readtable:read-ident
|
||||
(define read:read-ident
|
||||
(lambda (table char acc port)
|
||||
(readtable:act readtable:identifier
|
||||
(port 'read)
|
||||
(read:ident-builder (port 'location)
|
||||
char)
|
||||
(read:ident-builder (port 'location) char)
|
||||
port)))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -584,7 +585,7 @@
|
|||
;;; Incremental builder for a number, driven by the lexer.
|
||||
;;; TODO: how will this be turned into a number, in the end?
|
||||
(define read:number-builder
|
||||
(lambda (radix-table)
|
||||
(lambda (radix-table location)
|
||||
(let ((main '())
|
||||
(sign #\+)
|
||||
(decimal '())
|
||||
|
@ -640,6 +641,15 @@
|
|||
((eq? op 'radix-table) radix-table)
|
||||
(else (error 'number-builder 'invalid op args))))))))
|
||||
|
||||
(define read:special-number
|
||||
(lambda (type sign location)
|
||||
(lambda (op)
|
||||
(cond
|
||||
((eq? op 'type) type)
|
||||
((eq? op 'sign) sign)
|
||||
((eq? op 'location) location)
|
||||
(else (error 'special-numbe 'invalid op))))))
|
||||
|
||||
(define readtable:return-number
|
||||
(lambda (_ char acc port)
|
||||
(port 'push char)
|
||||
|
@ -902,7 +912,8 @@
|
|||
(let ((number-port (ident->read (port 'location) ident)))
|
||||
(number-port 'fold-case! #t)
|
||||
(readtable:next readtable:read-prefix-char
|
||||
(read:number-builder readtable:for-dec)
|
||||
(read:number-builder readtable:for-dec
|
||||
(port 'location))
|
||||
number-port))
|
||||
((map:val container) acc port))))))
|
||||
|
||||
|
@ -963,9 +974,41 @@
|
|||
(lambda (toplevel number-char _ port)
|
||||
(readtable:act readtable:read-sign
|
||||
number-char
|
||||
(read:number-builder readtable:for-dec)
|
||||
(read:number-builder readtable:for-dec
|
||||
(port 'location))
|
||||
port)))
|
||||
|
||||
(define readtable:check-for-special-ident
|
||||
(readtable:process
|
||||
(readtable:empty/default
|
||||
(lambda (_ char ident-builder port)
|
||||
(let ((return-ident (readtable:act readtable:identifier
|
||||
char
|
||||
ident-builder
|
||||
port)))
|
||||
(let ((val (return-ident 'value))
|
||||
(loc (return-ident 'location)))
|
||||
(cond
|
||||
((equal? val "+inf.0") (read:special-number 'inf #\+ loc))
|
||||
((equal? val "-inf.0") (read:special-number 'inf #\- loc))
|
||||
((equal? val "+nan.0") (read:special-number 'nan #\+ loc))
|
||||
((equal? val "-nan.0") (read:special-number 'nan #\- loc))
|
||||
(else val))))))
|
||||
(list readtable:update '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
(lambda (_ char ident-builder port)
|
||||
(let ((ident (ident-builder 'finalize->ident)))
|
||||
(let ((number-builder (read:number-builder
|
||||
readtable:for-dec
|
||||
(ident 'location))))
|
||||
(number-builder 'sign! (string-ref (ident 'value) 0))
|
||||
(readtable:act readtable:for-dec char number-builder port)))))))
|
||||
|
||||
(define read:ident-or-number
|
||||
(lambda (_ sign __ port)
|
||||
(readtable:next readtable:check-for-special-ident
|
||||
(read:ident-builder (port 'location) sign)
|
||||
port)))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;
|
||||
;;; Toplevel reader.
|
||||
;;; ;;;;;;;;;;;;;;;;
|
||||
|
@ -974,7 +1017,8 @@
|
|||
(define readtable:top
|
||||
(lambda ()
|
||||
(readtable:process
|
||||
(readtable:empty/default readtable:read-ident)
|
||||
(readtable:empty/default read:read-ident)
|
||||
(list readtable:update '(#\+ #\-) read:ident-or-number)
|
||||
(list readtable:update readtable:ASCII-whitespace readtable:skip)
|
||||
(list readtable:update #f (readtable:return 'eof))
|
||||
(list readtable:update %bol readtable:read-list)
|
||||
|
@ -1082,3 +1126,10 @@
|
|||
(read-all "#d10.24f12")
|
||||
(read-all "#d-i")
|
||||
(read-all "100i")
|
||||
(read-all "+5")
|
||||
(read-all "++1+")
|
||||
(read-all "+inf.0")
|
||||
(read-all "-inf.0")
|
||||
(read-all "+nan.0")
|
||||
(read-all "-100.5e5")
|
||||
|
||||
|
|
Loading…
Reference in New Issue