Separate parsing for numbers

This commit is contained in:
Justin Ethier 2016-02-20 02:08:00 -05:00
parent 3a3610f93d
commit 05b264d02c

View file

@ -313,18 +313,15 @@
(parse fp '() (cons #f toks) all? #f parens ptbl) (parse fp '() (cons #f toks) all? #f parens ptbl)
#f)) #f))
;; Numbers ;; Numbers
;; TODO: technically broken for #e because allows whitespace between "#e" and the number itself
;; TODO: #b (binary), #o (octal), #d (decimal), and #x (hexadecimal) also #i for inexact ;; TODO: #b (binary), #o (octal), #d (decimal), and #x (hexadecimal) also #i for inexact
;; TODO: cleanup code to support above. hex may be tricky and require
;; a specialized parsing pass. actually, bin and oct do too because
;; otherwise they would be parsed as decimal numbers
((eq? #\e next-c) ((eq? #\e next-c)
;(write `(DEBUG ,next-c ,toks)) ;(write `(DEBUG ,next-c ,toks))
(let ((sub (parse fp '() '() #f #f parens ptbl))) (let ((num (parse-number 10 fp '() ptbl)))
;(write `(DEBUG2 ,sub ,(string? sub))) ;(write `(DEBUG2 ,num ,(string? num)))
(cond (cond
((number? sub) ((and (not (null? num))
(let ((result (exact sub))) (token-numeric? num))
(let ((result (exact (parse-atom num))))
(if all? (if all?
(parse fp '() (cons result toks) all? #f parens ptbl) (parse fp '() (cons result toks) all? #f parens ptbl)
result))) result)))
@ -450,17 +447,40 @@
(equal? c #\+) (equal? c #\+)
(equal? c #\-))) (equal? c #\-)))
;; token-numeric? -> [chars] -> boolean
(define (token-numeric? a)
(or (char-numeric? (car a))
(and (> (length a) 1)
(char-numeric? (cadr a)))))
;; parse-atom -> [chars] -> literal ;; parse-atom -> [chars] -> literal
(define (parse-atom a) (define (parse-atom a)
(cond (cond
((or (char-numeric? (car a)) ((token-numeric? a)
(and (> (length a) 1)
(char-numeric? (cadr a))
(sign? (car a))))
(string->number (list->string a))) (string->number (list->string a)))
(else (else
(string->symbol (list->string a))))) (string->symbol (list->string a)))))
;;;;;
;; Read next character from port, using buffered char if available
(define (get-next-char fp ptbl)
(if (in-port:get-buf ptbl)
(in-port:read-buf! ptbl) ;; Already buffered
(read-char fp)))
(define (parse-number base fp tok ptbl)
(let ((c (get-next-char fp ptbl))
(next (lambda (c) (parse-number base fp (cons c tok) ptbl))))
(cond
((sign? c) (next c))
((eq? #\. c) (next c))
((char-numeric? c) (next c))
(else
;; We are done parsing a number
(in-port:set-buf! ptbl c) ;; rebuffer unprocessed char
(reverse tok))))) ;; Return token
;;;;;
;; Main lexer/parser ;; Main lexer/parser
(define cyc-read ;; TODO: should be (read), but that is breaking on csi 4.8.0.5 (define cyc-read ;; TODO: should be (read), but that is breaking on csi 4.8.0.5
(lambda args (lambda args