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