conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

better contextual error messages for invalid numeric sequences.

This commit is contained in:
Abdulaziz Ghuloum 2008-06-03 22:27:33 -07:00
parent be37f629c5
commit 9f7196d11a
3 changed files with 102 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
scheme/ikarus.reader.ss
View File

@ -589,19 +589,34 @@
(format "invalid syntax #~a" c))]))) (format "invalid syntax #~a" c))])))
(define (num-error p str ls) (define (num-error p str ls)
(die/p-1 p 'read "invalid numeric sequence" (die/p-1 p 'read str
(list->string (reverse ls)))) (list->string (reverse ls))))
(define-syntax port-config (define-syntax port-config
(syntax-rules (GEN-TEST GEN-ARGS FAIL) (syntax-rules (GEN-TEST GEN-ARGS FAIL EOF-ERROR GEN-DELIM-TEST)
[(_ GEN-ARGS k . rest) (k (p ac) . rest)] [(_ GEN-ARGS k . rest) (k (p ac) . rest)]
[(_ FAIL (p ac)) [(_ FAIL (p ac))
(num-error p "invalid numeric sequence" ac)] (num-error p "invalid numeric sequence" ac)]
[(_ GEN-TEST var next (p ac) eof-case char-case) [(_ FAIL (p ac) c)
(num-error p "invalid numeric sequence" (cons c ac))]
[(_ EOF-ERROR (p ac))
(num-error p "invalid eof while reading number" ac)]
[(_ GEN-DELIM-TEST c sk fk)
(if (delimiter? c) sk fk)]
[(_ GEN-TEST var next fail (p ac) eof-case char-case)
(let ([c (peek-char p)]) (let ([c (peek-char p)])
(if (or (eof-object? c) (delimiter? c)) (if (eof-object? c)
eof-case (let ()
(define-syntax fail
(syntax-rules ()
[(_) (num-error p "invalid numeric sequence" ac)]))
eof-case)
(let ([var c]) (let ([var c])
(define-syntax fail
(syntax-rules ()
[(_)
(num-error p "invalid numeric sequence"
(cons var ac))]))
(define-syntax next (define-syntax next
(syntax-rules () (syntax-rules ()
[(_ who args (... ...)) [(_ who args (... ...))

107
scheme/ikarus.string-to-number.ss
View File

@ -26,33 +26,43 @@
(module (define-parser) (module (define-parser)
(define-syntax gen-empty (define-syntax gen-empty
(syntax-rules (eof) (syntax-rules (eof)
[(_ C Ca) (C FAIL Ca)] [(_ C Ca) (C EOF-ERROR Ca)]
[(_ C Ca [(eof) then] . rest) then] [(_ C Ca [(eof) then] . rest) then]
[(_ C Ca other . rest) (gen-empty C Ca . rest)])) [(_ C Ca other . rest) (gen-empty C Ca . rest)]))
(define-syntax gen-delimiter
(syntax-rules (eof)
[(_ C Ca c)
(C GEN-DELIM-TEST c
(C FAIL Ca)
(C FAIL Ca c))]
[(_ C Ca c [(eof) then] . rest)
(C GEN-DELIM-TEST c
then
(C FAIL Ca c))]
[(_ C Ca c other . rest) (gen-delimiter C Ca c . rest)]))
(define-syntax gen-char (define-syntax gen-char
(syntax-rules (eof =>) (syntax-rules (eof =>)
[(_ C Ca c) (C FAIL Ca)] [(_ C Ca c dc) dc]
[(_ C Ca c [(eof) then] . rest) [(_ C Ca c dc [(eof) then] . rest)
(gen-char C Ca c . rest)] (gen-char C Ca c dc . rest)]
[(_ C Ca c [(test . args) => result then] . rest) [(_ C Ca c dc [(test . args) => result then] . rest)
(cond (cond
[(test c . args) => [(test c . args) =>
(lambda (result) then)] (lambda (result) then)]
[else (gen-char C Ca c . rest)])] [else (gen-char C Ca c dc . rest)])]
[(_ C Ca c [ls then] . rest) [(_ C Ca c dc [ls then] . rest)
(if (memv c 'ls) (if (memv c 'ls)
then then
(gen-char C Ca c . rest))])) (gen-char C Ca c dc . rest))]))
(define-syntax gen-clause (define-syntax gen-clause
(syntax-rules () (syntax-rules ()
[(_ (Ca ...) C next fail name (arg* ...) (clause* ...)) [(_ (Ca ...) C next fail name (arg* ...) (clause* ...))
(define (name Ca ... arg* ...) (define (name Ca ... arg* ...)
(define-syntax fail (C GEN-TEST c next fail (Ca ...)
(syntax-rules ()
[(_) (C FAIL (Ca ...))]))
(C GEN-TEST c next (Ca ...)
(gen-empty C (Ca ...) clause* ...) (gen-empty C (Ca ...) clause* ...)
(gen-char C (Ca ...) c clause* ...)))])) (gen-char C (Ca ...) c
(gen-delimiter C (Ca ...) c clause* ...)
clause* ...)))]))
(define-syntax define-parser^ (define-syntax define-parser^
(lambda (x) (lambda (x)
(define (lookup ls1 ls2) (define (lookup ls1 ls2)
@ -119,7 +129,8 @@
[(#\i) [(#\i)
(if (= ac 0) (if (= ac 0)
(fail) (fail)
(make-rectangular 0 (do-sn/ex sn ex (/ num ac))))]) (next im:done
(make-rectangular 0 (do-sn/ex sn ex (/ num ac)))))])
(im:ratio+ (r real ex sn num ac) (im:ratio+ (r real ex sn num ac)
[(digit r) => d [(digit r) => d
@ -147,16 +158,34 @@
[(digit r) => d [(digit r) => d
(next exponent+digit r ex sn ac exp1 (+ (* exp2 r) d) exp-sign)]) (next exponent+digit r ex sn ac exp1 (+ (* exp2 r) d) exp-sign)])
(im:exponent+digit (r real ex sn ac exp1 exp2 exp-sign)
[(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 (+ (* exp2 r) d) exp-sign)]
[(#\i)
(let ([imag (do-dec-sn/ex sn ex
(* ac (expt 10 (+ exp1 (* exp2 exp-sign)))))])
(next im:done (make-rectangular real imag)))])
(exponent+sign (r ex sn ac exp1 exp-sign) (exponent+sign (r ex sn ac exp1 exp-sign)
[(digit r) => d [(digit r) => d
(next exponent+digit r ex sn ac exp1 d exp-sign)]) (next exponent+digit r ex sn ac exp1 d exp-sign)])
(im:exponent+sign (r real ex sn ac exp1 exp-sign)
[(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 d exp-sign)])
(exponent (r ex sn ac exp1) (exponent (r ex sn ac exp1)
[(digit r) => d [(digit r) => d
(next exponent+digit r ex sn ac exp1 d +1)] (next exponent+digit r ex sn ac exp1 d +1)]
[(#\+) (next exponent+sign r ex sn ac exp1 +1)] [(#\+) (next exponent+sign r ex sn ac exp1 +1)]
[(#\-) (next exponent+sign r ex sn ac exp1 -1)]) [(#\-) (next exponent+sign r ex sn ac exp1 -1)])
(im:exponent (r real ex sn ac exp1)
[(digit r) => d
(next im:exponent+digit r real ex sn ac exp1 d +1)]
[(#\+) (next im:exponent+sign r real ex sn ac exp1 +1)]
[(#\-) (next im:exponent+sign r real ex sn ac exp1 -1)])
(digit+dot (r ex sn ac exp) (digit+dot (r ex sn ac exp)
[(eof) [(eof)
(do-dec-sn/ex sn ex (* ac (expt 10 exp)))] (do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
@ -176,6 +205,17 @@
(next exponent r ex sn ac exp) (next exponent r ex sn ac exp)
(fail))]) (fail))])
(im:digit+dot (r real ex sn ac exp)
[(eof)
(do-dec-sn/ex sn ex (* ac (expt 10 exp)))]
[(digit r) => d
(next im:digit+dot r real ex sn (+ (* ac r) d) (- exp 1))]
[(#\i)
(let ([imag (do-dec-sn/ex sn ex (* ac (expt 10 exp)))])
(next im:done (make-rectangular real imag)))]
[(#\e)
(next im:exponent r real ex sn ac exp)])
(digit+ (r ex sn ac) (digit+ (r ex sn ac)
[(eof) (do-sn/ex sn ex ac)] [(eof) (do-sn/ex sn ex ac)]
[(digit r) => d [(digit r) => d
@ -238,13 +278,21 @@
(dot (r ex sn) (dot (r ex sn)
[(digit r) => d [(digit r) => d
(next digit+dot r ex sn d -1)]) (next digit+dot r ex sn d -1)])
(im:dot (r real ex sn)
[(digit r) => d
(next im:digit+dot r real ex sn d -1)])
(im:sign (r real ex sn) (im:sign (r real ex sn)
[(digit r) => d [(digit r) => d
(next im:digit+ r real ex sn d)] (next im:digit+ r real ex sn d)]
[(#\i) [(#\i)
(next im:sign-i real ex sn)]) (next im:sign-i real ex sn)]
[(#\.)
(if (fx=? r 10)
(next im:dot r real ex sn)
(fail))])
(sign (r ex sn) (sign (r ex sn)
[(digit r) => d [(digit r) => d
(next digit+ r ex sn d)] (next digit+ r ex sn d)]
@ -293,18 +341,25 @@
) )
(define-syntax string-config (define-syntax string-config
(syntax-rules (GEN-TEST GEN-ARGS FAIL) (syntax-rules (EOF-ERROR GEN-TEST GEN-ARGS FAIL GEN-DELIM-TEST)
[(_ GEN-ARGS k . rest) (k (s n i) . rest)] [(_ GEN-ARGS k . rest) (k (s n i) . rest)]
[(_ FAIL (s n i) c) #f]
[(_ FAIL (s n i)) #f] [(_ FAIL (s n i)) #f]
[(_ GEN-TEST var next (s n i) sk fk) [(_ EOF-ERROR (s n i)) #f]
(if (fx=? i n) [(_ GEN-DELIM-TEST c sk fk) #f]
sk [(_ GEN-TEST var next fail (s n i) sk fk)
(let ([var (string-ref s i)]) (let ()
(define-syntax next (define-syntax fail
(syntax-rules () (syntax-rules ()
[(_ who args (... ...)) [(_) #f]))
(who s n (fx+ i 1) args (... ...))])) (if (fx=? i n)
fk))])) 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-parser string-config (parse-string))

2
scheme/last-revision
View File

@ -1 +1 @@
1495 1496