number reader: add to toplevel

This commit is contained in:
Peter McGoron 2024-10-13 13:31:46 -04:00
parent 0dab772a77
commit 6f2a1c8301
1 changed files with 58 additions and 7 deletions

View File

@ -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")