From 6f2a1c8301f22a69df4f7ece839837d33ab585bb Mon Sep 17 00:00:00 2001
From: Peter McGoron <code@mcgoron.com>
Date: Sun, 13 Oct 2024 13:31:46 -0400
Subject: [PATCH] number reader: add to toplevel

---
 read.scm | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 58 insertions(+), 7 deletions(-)

diff --git a/read.scm b/read.scm
index 29ab362..6e20573 100644
--- a/read.scm
+++ b/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")
+