Improve error-handling in Racket schema reader
This commit is contained in:
parent
b69c3a0894
commit
947b816a57
|
@ -127,7 +127,10 @@
|
||||||
(if (and (> (string-length str) 0) (string=? (substring str 0 1) "="))
|
(if (and (> (string-length str) 0) (string=? (substring str 0 1) "="))
|
||||||
(ks (SimplePattern-lit (string->symbol (substring str 1))))
|
(ks (SimplePattern-lit (string->symbol (substring str 1))))
|
||||||
(ks (SimplePattern-Ref (parse-ref-dsl sym))))]
|
(ks (SimplePattern-Ref (parse-ref-dsl sym))))]
|
||||||
[(strip-annotations (record (record 'lit '()) (list v))) (ks (SimplePattern-lit v))]
|
[(strip-annotations (record (record 'lit '()) lit-pat))
|
||||||
|
(match lit-pat
|
||||||
|
[(list v) (ks (SimplePattern-lit v))]
|
||||||
|
[_ (error 'parse-simple-dsl "Invalid <<lit> ...> pattern: ~a" (input->string item))])]
|
||||||
[(list stx (peel-annotations '...)) (ks (SimplePattern-seqof (walk-simple stx)))]
|
[(list stx (peel-annotations '...)) (ks (SimplePattern-seqof (walk-simple stx)))]
|
||||||
[(? set? s)
|
[(? set? s)
|
||||||
(when (not (= (set-count s) 1))
|
(when (not (= (set-count s) 1))
|
||||||
|
@ -140,8 +143,11 @@
|
||||||
|
|
||||||
(define (parse-compound-dsl item)
|
(define (parse-compound-dsl item)
|
||||||
(match (peel-annotations item)
|
(match (peel-annotations item)
|
||||||
[(record (strip-annotations (record 'rec '())) (peel-annotations (list label fields)))
|
[(record (strip-annotations (record 'rec '())) fields-pat)
|
||||||
(CompoundPattern-rec (maybe-named label) (maybe-named fields))]
|
(match fields-pat
|
||||||
|
[(peel-annotations (list label fields))
|
||||||
|
(CompoundPattern-rec (maybe-named label) (maybe-named fields))]
|
||||||
|
[_ (error 'parse-simple-dsl "Invalid <<rec> ...> pattern: ~a" (input->string item))])]
|
||||||
[(record (strip-annotations label) (peel-annotations fields))
|
[(record (strip-annotations label) (peel-annotations fields))
|
||||||
(CompoundPattern-rec (NamedPattern-anonymous (Pattern-SimplePattern (SimplePattern-lit label)))
|
(CompoundPattern-rec (NamedPattern-anonymous (Pattern-SimplePattern (SimplePattern-lit label)))
|
||||||
(NamedPattern-anonymous (walk fields)))]
|
(NamedPattern-anonymous (walk fields)))]
|
||||||
|
|
Loading…
Reference in New Issue