Support #i and #e

This commit is contained in:
Justin Ethier 2016-02-20 03:08:35 -05:00
parent f7eed523be
commit 03ca7d3c4b

View file

@ -313,23 +313,19 @@
(parse fp '() (cons #f toks) all? #f parens ptbl) (parse fp '() (cons #f toks) all? #f parens ptbl)
#f)) #f))
;; Numbers ;; Numbers
;; TODO: #b (binary), #o (octal), #d (decimal), and #x (hexadecimal) also #i for inexact ;; TODO: #b (binary), #o (octal), #d (decimal), and #x (hexadecimal)
((eq? #\e next-c) ((eq? #\e next-c)
;(write `(DEBUG ,next-c ,toks)) (parse-number
(let ((num (parse-number 10 fp '() ptbl))) fp toks all? parens ptbl
;(write `(DEBUG2 ,num ,(string? num))) 10 (lambda (num)
(cond (exact
((and (not (null? num)) (parse-atom num)))))
(token-numeric? num)) ((eq? #\i next-c)
(let ((result (exact (parse-atom num)))) (parse-number
(if all? fp toks all? parens ptbl
(parse fp '() (cons result toks) all? #f parens ptbl) 10 (lambda (num)
result))) (inexact
(else (parse-atom num)))))
(parse-error
"Illegal number syntax"
(in-port:get-lnum ptbl)
(in-port:get-cnum ptbl))))))
;; Vector ;; Vector
((eq? #\( next-c) ((eq? #\( next-c)
(let ((sub (parse fp '() '() #t #f (+ parens 1) ptbl)) (let ((sub (parse fp '() '() #t #f (+ parens 1) ptbl))
@ -469,9 +465,26 @@
(in-port:read-buf! ptbl) ;; Already buffered (in-port:read-buf! ptbl) ;; Already buffered
(read-char fp))) (read-char fp)))
(define (parse-number base fp tok ptbl) (define (parse-number fp toks all? parens ptbl base tok->num)
; (parse-number-rec base fp '() ptbl))
(let ((num (parse-number-rec 10 fp '() ptbl)))
;(write `(DEBUG2 ,num ,(string? num)))
(cond
((and (not (null? num))
(token-numeric? num))
(let ((result (tok->num num)))
(if all?
(parse fp '() (cons result toks) all? #f parens ptbl)
result)))
(else
(parse-error
"Illegal number syntax"
(in-port:get-lnum ptbl)
(in-port:get-cnum ptbl))))))
(define (parse-number-rec base fp tok ptbl)
(let ((c (get-next-char fp ptbl)) (let ((c (get-next-char fp ptbl))
(next (lambda (c) (parse-number base fp (cons c tok) ptbl)))) (next (lambda (c) (parse-number-rec base fp (cons c tok) ptbl))))
(cond (cond
((sign? c) (next c)) ((sign? c) (next c))
((eq? #\. c) (next c)) ((eq? #\. c) (next c))