Simplify text reader by reusing Racket's float parser

This commit is contained in:
Tony Garnock-Jones 2023-11-01 17:13:36 +01:00
parent 8a8facc080
commit 071566b1e1
1 changed files with 8 additions and 36 deletions

View File

@ -317,49 +317,21 @@
(define (read-raw-symbol-or-number acc)
(if (delimiter-follows?)
(let ((input (reverse acc)))
(let ((input (list->string (reverse acc))))
(or (analyze-number input)
(string->symbol (list->string input))))
(string->symbol input)))
(read-raw-symbol-or-number (cons (read-char in-port) acc))))
(define (analyze-number input)
(match input
[(cons (and sign (or #\+ #\-)) input) (read-digit+ (list sign) read-fracexp input)]
[_ (read-digit+ (list) read-fracexp input)]))
(define (read-digit* acc-rev k input)
(match input
[(cons (? char? (? char-numeric? d)) input) (read-digit* (cons d acc-rev) k input)]
[_ (k acc-rev input)]))
(define (read-digit+ acc-rev k input)
(match input
[(cons (? char? (? char-numeric? d)) input) (read-digit* (cons d acc-rev) k input)]
[(pregexp #px"^([-+]?\\d+)(((\\.\\d+([eE][-+]?\\d+)?)|([eE][-+]?\\d+))([fF]?))?$"
(list _ whole _ frac _ _ _ f))
(define n (string->number (if frac (string-append whole frac) whole)))
(cond [(not n) #f]
[(and f (positive? (string-length f))) (float n)]
[else n])]
[_ #f]))
(define (read-fracexp acc-rev input)
(match input
[(cons #\. input) (read-digit+ (cons #\. acc-rev) read-exp input)]
[_ (read-exp acc-rev input)]))
(define (read-exp acc-rev input)
(match input
[(cons (and e (or #\e #\E)) input) (read-sign-and-exp (cons e acc-rev) input)]
[_ (finish-number acc-rev input)]))
(define (read-sign-and-exp acc-rev input)
(match input
[(cons (and sign (or #\+ #\-)) input) (read-digit+ (cons sign acc-rev) finish-number input)]
[_ (read-digit+ acc-rev finish-number input)]))
(define (finish-number acc-rev input)
(define s (list->string (reverse acc-rev)))
(define n (string->number s 10))
(cond [(not n) #f]
[(and (flonum? n) (member input '((#\f) (#\F)))) (float n)]
[(equal? input '()) n]
[else #f]))
;;---------------------------------------------------------------------------
;; Main entry point to parser