From b09ae0912528c665bc47385d2fa37566316d55d9 Mon Sep 17 00:00:00 2001
From: Peter McGoron <code@mcgoron.com>
Date: Sun, 13 Oct 2024 10:38:02 -0400
Subject: [PATCH] fix signs, make radix push more precise

---
 read.scm | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

diff --git a/read.scm b/read.scm
index fb60fdf..a2b7166 100644
--- a/read.scm
+++ b/read.scm
@@ -576,8 +576,9 @@
 (define read:number-builder
   (lambda (radix-table)
     (let ((main '())
+          (sign #\+)
           (decimal '())
-          (exp-char #f)
+          (exp-char #\e)
           (exp-digits '())
           (imaginary? #f)
           (current-part 'main)
@@ -593,11 +594,19 @@
                   (set! exp-digits (cons char exp-digits)))))))
         (lambda (op . args)
           (cond
+            ((eq? op 'push!) (apply append-part args))
+            ((eq? op 'sign!) (set! sign (car args)))
             ((eq? op 'finalize)
              (if (not exactness)
                  (set! exactness 'exact))
-             (list 'number-builder
-                   main exactness decimal exp-char exp-digits imaginary?))
+             (if (null? main)
+                 (set! main '(0)))
+             (if (null? decimal)
+                 (set! decimal '(0)))
+             (if (null? exp-digits)
+                 (set! exp-digits '(0)))
+             (list 'basic-number
+                   main sign exactness decimal exp-char exp-digits imaginary?))
             ((eq? op 'exactness!) (set! exactness (car args)))
             ((eq? op 'radix-table!) (set! radix-table (car args)))
             ((eq? op 'set-imaginary!)
@@ -619,7 +628,7 @@
              (set! exp-char (car args)))
             ;; 
             ((eq? op 'radix-table) radix-table)
-            (else (append-part op))))))))
+            (else (error 'number-builder 'invalid op args))))))))
 
 (define readtable:return-number
   (lambda (_ char acc port)
@@ -655,7 +664,7 @@
      readtable:number-main-table
      (list readtable:update radix-list
            (lambda (table char number-builder port)
-             (number-builder char)
+             (number-builder 'push! char)
              (readtable:next table number-builder port))))))
 
 (define readtable:for-bin
@@ -1051,3 +1060,4 @@
 (read-all "#d1234.5678")
 (read-all "#e10.5")
 (read-all "#d10.24f12")
+(read-all "#d-i")