diff options
| author |  Peter McGoron
| 2024-10-13 10:38:02 -0400 |
|---|---|---|
| committer | Peter McGoron
| 2024-10-13 10:38:02 -0400 |
| commit | b09ae0912528c665bc47385d2fa37566316d55d9 (patch) | |
| tree | 8edb8b0d869d88ca13b014c12e42004b2b75ca85 /read.scm | |
| parent | add basic number reader (no compound numbers yet) (diff) | |
fix signs, make radix push more precise
Diffstat (limited to 'read.scm')
| -rw-r--r-- | read.scm | 20 |
1 files changed, 15 insertions, 5 deletions
@@ -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") |