the reader now understands some complex numbers.
This commit is contained in:
Abdulaziz Ghuloum
parent
a492d318e1
commit
be37f629c5
|
|
@ -20,6 +20,7 @@
|
|||
annotation-expression annotation-source
|
||||
annotation-stripped)
|
||||
(import
|
||||
(only (ikarus.string-to-number) define-string->number-parser)
|
||||
(ikarus system $chars)
|
||||
(ikarus system $fx)
|
||||
(ikarus system $pairs)
|
||||
|
|
@ -256,7 +257,7 @@
|
|||
(string-append ".." (string c)))]))]
|
||||
[else
|
||||
(cons 'datum
|
||||
(tokenize-decimal-no-digits p '(#\.) #f))]))))
|
||||
(dot p '(#\.) 10 #f #f))]))))
|
||||
(define tokenize-char*
|
||||
(lambda (i str p d)
|
||||
(cond
|
||||
|
|
@ -566,17 +567,17 @@
|
|||
[else (die/p p 'tokenize
|
||||
(format "invalid sequence #v~a" c))]))]
|
||||
[(memq c '(#\e #\E))
|
||||
(cons 'datum (tokenize-exactness-mark p (list c #\#) 'e))]
|
||||
(cons 'datum (parse-string p (list c #\#) 10 #f 'e))]
|
||||
[(memq c '(#\i #\I))
|
||||
(cons 'datum (tokenize-exactness-mark p (list c #\#) 'i))]
|
||||
(cons 'datum (parse-string p (list c #\#) 10 #f 'i))]
|
||||
[(memq c '(#\b #\B))
|
||||
(cons 'datum (tokenize-radix-mark p (list c #\#) 2))]
|
||||
(cons 'datum (parse-string p (list c #\#) 2 2 #f))]
|
||||
[(memq c '(#\x #\X))
|
||||
(cons 'datum (tokenize-radix-mark p (list c #\#) 16))]
|
||||
(cons 'datum (parse-string p (list c #\#) 16 16 #f))]
|
||||
[(memq c '(#\o #\O))
|
||||
(cons 'datum (tokenize-radix-mark p (list c #\#) 8))]
|
||||
(cons 'datum (parse-string p (list c #\#) 8 8 #f))]
|
||||
[(memq c '(#\d #\D))
|
||||
(cons 'datum (tokenize-radix-mark p (list c #\#) 10))]
|
||||
(cons 'datum (parse-string p (list c #\#) 10 10 #f))]
|
||||
[($char= #\@ c)
|
||||
(when (eq? (port-mode p) 'r6rs-mode)
|
||||
(die/p-1 p 'tokenize "fasl syntax is invalid in #!r6rs mode"
|
||||
|
|
@ -586,233 +587,30 @@
|
|||
[else
|
||||
(die/p-1 p 'tokenize
|
||||
(format "invalid syntax #~a" c))])))
|
||||
(define (tokenize-exactness-mark p ls exact?)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(tokenize-integer p (cons c ls) exact? 10 d))]
|
||||
[(char=? c #\.)
|
||||
(tokenize-decimal-no-digits p (cons c ls) exact?)]
|
||||
[(char=? c #\-)
|
||||
(- (tokenize-integer-no-digits p (cons c ls) exact? 10))]
|
||||
[(char=? c #\+)
|
||||
(tokenize-integer-no-digits p (cons c ls) exact? 10)]
|
||||
[(char=? c #\#)
|
||||
(let ([c1 (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c1)
|
||||
(num-error p "eof object" (cons c ls))]
|
||||
[(memv c1 '(#\b #\B))
|
||||
(tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 2)]
|
||||
[(memv c1 '(#\x #\X))
|
||||
(tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 16)]
|
||||
[(memv c1 '(#\o #\O))
|
||||
(tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 8)]
|
||||
[(memv c1 '(#\d #\D))
|
||||
(tokenize-radix/exactness-marks p (cons* c1 c ls) exact? 10)]
|
||||
[else (num-error p "invalid sequence" (cons* c1 c ls))]))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-radix-mark p ls radix)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(tokenize-integer p (cons c ls) #f radix d))]
|
||||
[(char=? c #\.)
|
||||
(unless (= radix 10)
|
||||
(num-error p "invalid decimal" (cons c ls)))
|
||||
(tokenize-decimal-no-digits p (cons c ls) #f)]
|
||||
[(char=? c #\-)
|
||||
(- (tokenize-integer-no-digits p (cons c ls) #f radix))]
|
||||
[(char=? c #\+)
|
||||
(tokenize-integer-no-digits p (cons c ls) #f radix)]
|
||||
[(char=? c #\#)
|
||||
(let ([c1 (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c1)
|
||||
(num-error p "eof object" (cons c ls))]
|
||||
[(memv c1 '(#\e #\E))
|
||||
(tokenize-radix/exactness-marks p (cons c1 (cons c ls))
|
||||
'e radix)]
|
||||
[(memv c1 '(#\i #\I))
|
||||
(tokenize-radix/exactness-marks p (cons c1 (cons c ls))
|
||||
'i radix)]
|
||||
[else (num-error p "invalid sequence" (cons* c1 c ls))]))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-radix/exactness-marks p ls exact? radix)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(tokenize-integer p (cons c ls) exact? radix d))]
|
||||
[(char=? c #\.)
|
||||
(unless (= radix 10)
|
||||
(num-error p "invalid decimal" (cons c ls)))
|
||||
(tokenize-decimal-no-digits p (cons c ls) exact?)]
|
||||
[(char=? c #\-)
|
||||
(- (tokenize-integer-no-digits p (cons c ls) exact? radix))]
|
||||
[(char=? c #\+)
|
||||
(tokenize-integer-no-digits p (cons c ls) exact? radix)]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-integer p ls exact? radix ac)
|
||||
(define (tokenize-denom-start p ls exact? radix num)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(tokenize-denom p (cons c ls) exact? radix num d))]
|
||||
[(char=? c #\-)
|
||||
(tokenize-denom-no-digits p (cons c ls) exact? radix (- num))]
|
||||
[(char=? c #\+)
|
||||
(tokenize-denom-no-digits p (cons c ls) exact? radix num)]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-denom-no-digits p ls exact? radix num)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(tokenize-denom p (cons c ls) exact? radix num d))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-denom p ls exact? radix num ac)
|
||||
|
||||
(define (num-error p str ls)
|
||||
(die/p-1 p 'read "invalid numeric sequence"
|
||||
(list->string (reverse ls))))
|
||||
|
||||
(define-syntax port-config
|
||||
(syntax-rules (GEN-TEST GEN-ARGS FAIL)
|
||||
[(_ GEN-ARGS k . rest) (k (p ac) . rest)]
|
||||
[(_ FAIL (p ac))
|
||||
(num-error p "invalid numeric sequence" ac)]
|
||||
[(_ GEN-TEST var next (p ac) eof-case char-case)
|
||||
(let ([c (peek-char p)])
|
||||
(cond
|
||||
[(eof-object? c)
|
||||
(read-char p)
|
||||
(if (= ac 0)
|
||||
(num-error p "zero denominator" ls)
|
||||
(convert/exact exact? (/ num ac)))]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(read-char p)
|
||||
(tokenize-denom p (cons c ls) exact? radix num
|
||||
(+ (* radix ac) d)))]
|
||||
[(delimiter? c)
|
||||
(if (= ac 0)
|
||||
(num-error p "zero denominator" ls)
|
||||
(convert/exact exact? (/ num ac)))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(let ([c (peek-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (convert/exact exact? ac)]
|
||||
[(radix-digit c radix) =>
|
||||
(lambda (d)
|
||||
(read-char p)
|
||||
(tokenize-integer p (cons c ls) exact? radix
|
||||
(+ (* ac radix) d)))]
|
||||
[(char=? c #\.)
|
||||
(unless (= radix 10)
|
||||
(num-error p "invalid decimal" (cons c ls)))
|
||||
(read-char p)
|
||||
(tokenize-decimal p (cons c ls) exact? ac 0)]
|
||||
[(char=? c #\/)
|
||||
(read-char p)
|
||||
(tokenize-denom-start p (cons #\/ ls) exact? radix ac)]
|
||||
[(memv c '(#\e #\E)) ; exponent
|
||||
(read-char p)
|
||||
(unless (= radix 10)
|
||||
(num-error p "invalid decimal" (cons c ls)))
|
||||
(let ([ex (tokenize-exponent-start p (cons c ls))])
|
||||
(convert/exact (or exact? 'i)
|
||||
(* ac (expt radix ex))))]
|
||||
[(delimiter? c)
|
||||
(convert/exact exact? ac)]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-exponent-start p ls)
|
||||
(define (tokenize-exponent-no-digits p ls)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(tokenize-exponent p (cons c ls) d))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-exponent p ls ac)
|
||||
(let ([c (peek-char p)])
|
||||
(cond
|
||||
[(eof-object? c) ac]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(read-char p)
|
||||
(tokenize-exponent p (cons c ls)
|
||||
(+ (* ac 10) d)))]
|
||||
[(delimiter? c) ac]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(tokenize-exponent p (cons c ls) d))]
|
||||
[(char=? c #\-)
|
||||
(- (tokenize-exponent-no-digits p (cons c ls)))]
|
||||
[(char=? c #\+)
|
||||
(tokenize-exponent-no-digits p (cons c ls))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-decimal p ls exact? ac exp)
|
||||
(let ([c (peek-char p)])
|
||||
(cond
|
||||
[(eof-object? c)
|
||||
(let ([ac (* ac (expt 10 exp))])
|
||||
(convert/exact (or exact? 'i) ac))]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(read-char p)
|
||||
(tokenize-decimal p (cons c ls) exact?
|
||||
(+ (* ac 10) d) (- exp 1)))]
|
||||
[(memv c '(#\e #\E))
|
||||
(read-char p)
|
||||
(let ([ex (tokenize-exponent-start p (cons c ls))])
|
||||
(let ([ac (* ac (expt 10 (+ exp ex)))])
|
||||
(convert/exact (or exact? 'i) ac)))]
|
||||
[(delimiter? c)
|
||||
(let ([ac (* ac (expt 10 exp))])
|
||||
(convert/exact (or exact? 'i) ac))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-decimal-no-digits p ls exact?)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "eof object" ls)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(tokenize-decimal p (cons c ls) exact? d -1))]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (convert/exact exact? n)
|
||||
(if (eq? exact? 'i)
|
||||
(exact->inexact n)
|
||||
n))
|
||||
(define (radix-digit c radix)
|
||||
(case radix
|
||||
[(10)
|
||||
(cond
|
||||
[(char<=? #\0 c #\9)
|
||||
(fx- (char->integer c) (char->integer #\0))]
|
||||
[else #f])]
|
||||
[(16)
|
||||
(cond
|
||||
[(char<=? #\0 c #\9)
|
||||
(fx- (char->integer c) (char->integer #\0))]
|
||||
[(char<=? #\a c #\f)
|
||||
(fx- (char->integer c) (fx- (char->integer #\a) 10))]
|
||||
[(char<=? #\A c #\F)
|
||||
(fx- (char->integer c) (fx- (char->integer #\A) 10))]
|
||||
[else #f])]
|
||||
[(8)
|
||||
(cond
|
||||
[(char<=? #\0 c #\7)
|
||||
(fx- (char->integer c) (char->integer #\0))]
|
||||
[else #f])]
|
||||
[(2)
|
||||
(case c
|
||||
[(#\0) 0]
|
||||
[(#\1) 1]
|
||||
[else #f])]
|
||||
[else (die 'radix-digit "invalid radix" radix)]))
|
||||
(if (or (eof-object? c) (delimiter? c))
|
||||
eof-case
|
||||
(let ([var c])
|
||||
(define-syntax next
|
||||
(syntax-rules ()
|
||||
[(_ who args (... ...))
|
||||
(who p (cons (get-char p) ac) args (... ...))]))
|
||||
char-case)))]))
|
||||
|
||||
(define-string->number-parser port-config
|
||||
(parse-string digit+ sign dot))
|
||||
|
||||
(define (read-char* p ls str who ci? delimited?)
|
||||
(let f ([i 0] [ls ls])
|
||||
(cond
|
||||
|
|
@ -836,37 +634,6 @@
|
|||
(die/p-1 p 'tokenize
|
||||
(format "invalid ~a: ~s" who
|
||||
(list->string (reverse (cons c ls)))))]))])))
|
||||
(define (tokenize-integer/nan/inf-no-digits p ls)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "invalid eof" ls)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
(tokenize-integer p (cons c ls) #f 10 d))]
|
||||
[(char=? c #\.)
|
||||
(tokenize-decimal-no-digits p (cons c ls) #f)]
|
||||
[(memv c '(#\i #\I))
|
||||
(read-char* p (cons #\i ls) "nf.0" "number sequence" #t #t)
|
||||
+inf.0]
|
||||
[(memv c '(#\n #\N))
|
||||
(read-char* p (cons #\i ls) "an.0" "number sequence" #t #t)
|
||||
+nan.0]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (tokenize-integer-no-digits p ls exact? radix?)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
[(eof-object? c) (num-error p "invalid eof" ls)]
|
||||
[(radix-digit c (or radix? 10)) =>
|
||||
(lambda (d)
|
||||
(tokenize-integer p (cons c ls) exact? (or radix? 10) d))]
|
||||
[(char=? c #\.)
|
||||
(when (and radix? (not (= radix? 10)))
|
||||
(num-error p "invalid decimal" (cons c ls)))
|
||||
(tokenize-decimal-no-digits p (cons c ls) exact?)]
|
||||
[else (num-error p "invalid sequence" (cons c ls))])))
|
||||
(define (num-error p str ls)
|
||||
(die/p-1 p 'read "invalid numeric sequence"
|
||||
(list->string (reverse ls))))
|
||||
(define (tokenize-hashnum p n)
|
||||
(let ([c (read-char p)])
|
||||
(cond
|
||||
|
|
@ -948,10 +715,10 @@
|
|||
'(macro . unquote-splicing)]
|
||||
[else '(macro . unquote)]))]
|
||||
[($char= #\# c) (tokenize-hash p)]
|
||||
[(radix-digit c 10) =>
|
||||
(lambda (d)
|
||||
[(char<=? #\0 c #\9)
|
||||
(let ([d (fx- (char->integer c) (char->integer #\0))])
|
||||
(cons 'datum
|
||||
(tokenize-integer p (list c) #f 10 d)))]
|
||||
(digit+ p (list c) 10 #f +1 d)))]
|
||||
[(initial? c)
|
||||
(let ([ls (reverse (tokenize-identifier (cons c '()) p))])
|
||||
(cons 'datum (string->symbol (list->string ls))))]
|
||||
|
|
@ -965,7 +732,7 @@
|
|||
[(delimiter? c) '(datum . +)]
|
||||
[else
|
||||
(cons 'datum
|
||||
(tokenize-integer/nan/inf-no-digits p '(#\+)))]))]
|
||||
(sign p '(#\+) 10 #f +1))]))]
|
||||
[(memq c '(#\-))
|
||||
(let ([c (peek-char p)])
|
||||
(cond
|
||||
|
|
@ -978,7 +745,7 @@
|
|||
(cons 'datum (string->symbol str))))]
|
||||
[else
|
||||
(cons 'datum
|
||||
(- (tokenize-integer/nan/inf-no-digits p '(#\-))))]))]
|
||||
(sign p '(#\-) 10 #f -1))]))]
|
||||
[($char= #\. c)
|
||||
(tokenize-dot p)]
|
||||
[($char= #\| c)
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
|
||||
(library (ikarus.string-to-number)
|
||||
(export string->number)
|
||||
(export string->number define-string->number-parser)
|
||||
(import (except (ikarus) string->number))
|
||||
|
||||
(module (string->number)
|
||||
(define who 'string->number)
|
||||
(define (do-sn/ex sn ex ac)
|
||||
(* sn (if (eq? ex 'i) (inexact ac) ac)))
|
||||
|
|
@ -51,39 +50,54 @@
|
|||
(define-syntax fail
|
||||
(syntax-rules ()
|
||||
[(_) (C FAIL (Ca ...))]))
|
||||
(C GEN-TEST c next (Ca ...)
|
||||
(gen-empty C (Ca ...) clause* ...)
|
||||
(gen-char C (Ca ...) c clause* ...)))]))
|
||||
(define-syntax define-parser^
|
||||
(lambda (x)
|
||||
(define (lookup ls1 ls2)
|
||||
(lambda (var)
|
||||
(let f ([ls1 ls1] [ls2 ls2])
|
||||
(cond
|
||||
[(C GEN-EOF? (Ca ...))
|
||||
(gen-empty C (Ca ...) clause* ...)]
|
||||
[else
|
||||
(let ([c (C GEN-REF (Ca ...))])
|
||||
(define-syntax next
|
||||
(syntax-rules ()
|
||||
[(_ who args (... ...))
|
||||
(C GEN-NEXT (Ca ...) who args (... ...))]))
|
||||
(gen-char C (Ca ...) c clause* ...))]))]))
|
||||
(define-syntax define-parser
|
||||
(syntax-rules ()
|
||||
[(null? ls1)
|
||||
(error 'define-parser "cannot find" var)]
|
||||
[(bound-identifier=? var (car ls1))
|
||||
(car ls2)]
|
||||
[else (f (cdr ls1) (cdr ls2))]))))
|
||||
(syntax-case x ()
|
||||
[(_ (entries ...) config next fail
|
||||
orig*
|
||||
[name* (arg** ...) clause** ...] ...)
|
||||
(begin
|
||||
(module M (entries ...)
|
||||
(with-syntax ([(mapped-entries ...)
|
||||
(map
|
||||
(lookup
|
||||
(car (syntax->datum #'orig*))
|
||||
#'(name* ...))
|
||||
#'(entries ...))])
|
||||
#'(begin
|
||||
(config GEN-ARGS
|
||||
gen-clause config next fail name*
|
||||
(arg** ...)
|
||||
(clause** ...))
|
||||
...)
|
||||
(import M))])))
|
||||
...
|
||||
(define entries mapped-entries)
|
||||
...))])))
|
||||
(define-syntax define-parser
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
[(_ definer next fail [name* (arg** ...) clause** ...] ...)
|
||||
(with-syntax ([orig*
|
||||
(datum->syntax #'foo (list #'(name* ...)))])
|
||||
#'(define-syntax definer
|
||||
(syntax-rules ()
|
||||
[(_ config (entries (... ...)))
|
||||
(define-parser^ (entries (... ...)) config next fail
|
||||
orig*
|
||||
[name* (arg** ...) clause** ...] ...)])))]))))
|
||||
|
||||
(define-syntax string-config
|
||||
(syntax-rules (GEN-EOF? GEN-REF GEN-ARGS GEN-NEXT FAIL)
|
||||
[(_ GEN-EOF? (s n i)) (fx=? i n)]
|
||||
[(_ GEN-REF (s n i)) (string-ref s i)]
|
||||
[(_ GEN-ARGS k . rest) (k (s n i) . rest)]
|
||||
[(_ GEN-NEXT (s n i) who . rest)
|
||||
(who s n (fx+ i 1) . rest)]
|
||||
[(_ FAIL (s n i)) #f]))
|
||||
|
||||
(define-parser (do-parse) string-config next fail
|
||||
|
||||
(define-parser define-string->number-parser next fail
|
||||
|
||||
(ratio+ (r ex sn num ac)
|
||||
[(eof)
|
||||
|
|
@ -239,24 +253,35 @@
|
|||
[(#\.)
|
||||
(if (fx=? r 10)
|
||||
(next dot r ex sn)
|
||||
(fail))])
|
||||
(fail))]
|
||||
[(#\n)
|
||||
(next sign-n)])
|
||||
(sign-n () [(#\a) (next sign-na)])
|
||||
(sign-na () [(#\n) (next sign-nan)])
|
||||
(sign-nan () [(#\.) (next sign-nan.)])
|
||||
(sign-nan. () [(#\0) (next sign-nan.0)])
|
||||
(sign-nan.0 ()
|
||||
[(eof) +nan.0]
|
||||
[(#\i) (next sign-nan.0i)])
|
||||
(sign-nan.0i ()
|
||||
[(eof) (make-rectangular 0.0 +nan.0)])
|
||||
|
||||
(do-parse-h (dr r ex)
|
||||
(parse-string-h (dr r ex)
|
||||
[(#\x #\X)
|
||||
(if r (fail) (next do-parse 16 16 ex))]
|
||||
(if r (fail) (next parse-string 16 16 ex))]
|
||||
[(#\o #\O)
|
||||
(if r (fail) (next do-parse 8 8 ex))]
|
||||
(if r (fail) (next parse-string 8 8 ex))]
|
||||
[(#\b #\B)
|
||||
(if r (fail) (next do-parse 2 2 ex))]
|
||||
(if r (fail) (next parse-string 2 2 ex))]
|
||||
[(#\d #\D)
|
||||
(if r (fail) (next do-parse 10 10 ex))]
|
||||
(if r (fail) (next parse-string 10 10 ex))]
|
||||
[(#\e #\E)
|
||||
(if ex (fail) (next do-parse dr r 'e))]
|
||||
(if ex (fail) (next parse-string dr r 'e))]
|
||||
[(#\i #\I)
|
||||
(if ex (fail) (next do-parse dr r 'i))])
|
||||
(if ex (fail) (next parse-string dr r 'i))])
|
||||
|
||||
(do-parse (dr r ex)
|
||||
[(#\#) (next do-parse-h dr r ex)]
|
||||
(parse-string (dr r ex)
|
||||
[(#\#) (next parse-string-h dr r ex)]
|
||||
[(#\+) (next sign dr ex +1)]
|
||||
[(#\-) (next sign dr ex -1)]
|
||||
[(#\.)
|
||||
|
|
@ -267,17 +292,33 @@
|
|||
(next digit+ dr ex +1 d)])
|
||||
)
|
||||
|
||||
(define-syntax string-config
|
||||
(syntax-rules (GEN-TEST GEN-ARGS FAIL)
|
||||
[(_ GEN-ARGS k . rest) (k (s n i) . rest)]
|
||||
[(_ FAIL (s n i)) #f]
|
||||
[(_ GEN-TEST var next (s n i) sk fk)
|
||||
(if (fx=? i n)
|
||||
sk
|
||||
(let ([var (string-ref s i)])
|
||||
(define-syntax next
|
||||
(syntax-rules ()
|
||||
[(_ who args (... ...))
|
||||
(who s n (fx+ i 1) args (... ...))]))
|
||||
fk))]))
|
||||
|
||||
(define-string->number-parser string-config (parse-string))
|
||||
|
||||
(define string->number
|
||||
(case-lambda
|
||||
[(s)
|
||||
(unless (string? s) (die who "not a string" s))
|
||||
(do-parse s (string-length s) 0 10 #f #f)]
|
||||
(parse-string s (string-length s) 0 10 #f #f)]
|
||||
[(s r)
|
||||
(unless (string? s) (die who "not a string" s))
|
||||
(unless (memv r '(10 16 2 8)) (die who "invalid radix" r))
|
||||
(do-parse s (string-length s) 0 r #f #f)]))
|
||||
(parse-string s (string-length s) 0 r #f #f)]))
|
||||
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1494
|
||||
1495
|
||||
|
|
|
|||
|
|
@ -82,9 +82,7 @@
|
|||
"ikarus.intel-assembler.ss"
|
||||
"ikarus.trace.ss"
|
||||
"ikarus.fasl.write.ss"
|
||||
;;; HERE
|
||||
"ikarus.fasl.ss"
|
||||
|
||||
"ikarus.compiler.ss"
|
||||
"psyntax.compat.ss"
|
||||
"psyntax.library-manager.ss"
|
||||
|
|
@ -92,7 +90,6 @@
|
|||
"psyntax.config.ss"
|
||||
"psyntax.builders.ss"
|
||||
"psyntax.expander.ss"
|
||||
|
||||
"ikarus.load.ss"
|
||||
"ikarus.pretty-print.ss"
|
||||
"ikarus.cafe.ss"
|
||||
|
|
|
|||
Loading…
Reference in New Issue