From 947b816a57b580a76d0d0b5c7846ef818dd79e69 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 28 May 2021 20:06:46 +0200 Subject: [PATCH] Improve error-handling in Racket schema reader --- .../racket/preserves/preserves-schema/reader.rkt | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/implementations/racket/preserves/preserves-schema/reader.rkt b/implementations/racket/preserves/preserves-schema/reader.rkt index 363caa6..4219b5d 100644 --- a/implementations/racket/preserves/preserves-schema/reader.rkt +++ b/implementations/racket/preserves/preserves-schema/reader.rkt @@ -127,7 +127,10 @@ (if (and (> (string-length str) 0) (string=? (substring str 0 1) "=")) (ks (SimplePattern-lit (string->symbol (substring str 1)))) (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 < ...> pattern: ~a" (input->string item))])] [(list stx (peel-annotations '...)) (ks (SimplePattern-seqof (walk-simple stx)))] [(? set? s) (when (not (= (set-count s) 1)) @@ -140,8 +143,11 @@ (define (parse-compound-dsl item) (match (peel-annotations item) - [(record (strip-annotations (record 'rec '())) (peel-annotations (list label fields))) - (CompoundPattern-rec (maybe-named label) (maybe-named fields))] + [(record (strip-annotations (record 'rec '())) fields-pat) + (match fields-pat + [(peel-annotations (list label fields)) + (CompoundPattern-rec (maybe-named label) (maybe-named fields))] + [_ (error 'parse-simple-dsl "Invalid < ...> pattern: ~a" (input->string item))])] [(record (strip-annotations label) (peel-annotations fields)) (CompoundPattern-rec (NamedPattern-anonymous (Pattern-SimplePattern (SimplePattern-lit label))) (NamedPattern-anonymous (walk fields)))]