Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Handle #b #o #x at the parser (but not string->number yet)

Browse source
This commit is contained in:
Justin Ethier 2016-02-20 03:34:18 -05:00
parent 03ca7d3c4b
commit b49a30a923
1 changed files with 30 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
scheme/read.sld
View file

@ -313,19 +313,25 @@
(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)
((eq? #\e next-c) ((eq? #\e next-c)
(parse-number (parse-number fp toks all? parens ptbl
fp toks all? parens ptbl
10 (lambda (num) 10 (lambda (num)
(exact (exact
(parse-atom num))))) (parse-atom num)))))
((eq? #\i next-c) ((eq? #\i next-c)
(parse-number (parse-number fp toks all? parens ptbl
fp toks all? parens ptbl
10 (lambda (num) 10 (lambda (num)
(inexact (inexact
(parse-atom num))))) (parse-atom num)))))
((eq? #\b next-c)
(parse-number fp toks all? parens ptbl
2 (lambda (num) (list->string num))))
((eq? #\o next-c)
(parse-number fp toks all? parens ptbl
8 (lambda (num) (list->string num))))
((eq? #\x next-c)
(parse-number fp toks all? parens ptbl
16 (lambda (num) (list->string num))))
;; 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))
@ -467,11 +473,14 @@
(define (parse-number fp toks all? parens ptbl base tok->num) (define (parse-number fp toks all? parens ptbl base tok->num)
; (parse-number-rec base fp '() ptbl)) ; (parse-number-rec base fp '() ptbl))
(let ((num (parse-number-rec 10 fp '() ptbl))) (let ((num (parse-number-rec base fp '() ptbl)))
;(write `(DEBUG2 ,num ,(string? num))) ;(write `(DEBUG2 ,num ,(string? num)))
(cond (cond
((and (not (null? num)) ((and (not (null? num))
(token-numeric? num)) (or (token-numeric? num)
(and (> (length num) 0)
(= base 16)
(hex-digit? (car num)))))
(let ((result (tok->num num))) (let ((result (tok->num num)))
(if all? (if all?
(parse fp '() (cons result toks) all? #f parens ptbl) (parse fp '() (cons result toks) all? #f parens ptbl)
@ -488,11 +497,24 @@
(cond (cond
((sign? c) (next c)) ((sign? c) (next c))
((eq? #\. c) (next c)) ((eq? #\. c) (next c))
((char-numeric? c) (next c)) ((char-numeric? c)
(if (or (and (= base 2) (char>? c #\1))
(and (= base 8) (char>? c #\7)))
(parse-error
"Illegal digit"
(in-port:get-lnum ptbl)
(in-port:get-cnum ptbl)))
(next c))
((and (= base 16) (hex-digit? c))
(next c))
(else (else
;; We are done parsing a number ;; We are done parsing a number
(in-port:set-buf! ptbl c) ;; rebuffer unprocessed char (in-port:set-buf! ptbl c) ;; rebuffer unprocessed char
(reverse tok))))) ;; Return token (reverse tok))))) ;; Return token
(define (hex-digit? c)
(or (and (char>=? c #\a) (char<=? c #\f))
(and (char>=? c #\A) (char<=? c #\F))))
;;;;; ;;;;;
;; Main lexer/parser ;; Main lexer/parser