peter
/
UNSLISP
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix signs, make radix push more precise

This commit is contained in:
Peter McGoron 2024-10-13 10:38:02 -04:00
parent 798f70a2e9
commit b09ae09125
1 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
read.scm
View File

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