suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: add explicit pattern checks

Browse Source
This commit is contained in:
Ryan Culpepper 2018-08-12 19:26:09 +02:00
parent fa78f5ebd3
commit e845d0861d
2 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
racket/collects/syntax/parse/private/parse.rkt
View File

@ -712,7 +712,8 @@ Conventions:
(if (predicate x*) (if (predicate x*)
(let-attributes (name-attr ...) k) (let-attributes (name-attr ...) k)
(let ([es* (es-add-thing pr 'description #t role es)]) (let ([es* (es-add-thing pr 'description #t role es)])
(fail (failure* pr es*))))))])])) (fail (failure* pr es*))))))]
[_ (wrong-syntax stx "internal error: bad S pattern: ~e" #'pattern0)])]))
;; (first-desc:S S-pattern) : expr[FirstDesc] ;; (first-desc:S S-pattern) : expr[FirstDesc]
(define-syntax (first-desc:S stx) (define-syntax (first-desc:S stx)
@ -817,7 +818,8 @@ Conventions:
(parse:A x cx pattern pr* es k))] (parse:A x cx pattern pr* es k))]
[#s(action:post pattern) [#s(action:post pattern)
#'(let ([pr* (ps-add-post pr)]) #'(let ([pr* (ps-add-post pr)])
(parse:A x cx pattern pr* es k))])])) (parse:A x cx pattern pr* es k))]
[_ (wrong-syntax stx "internal error: bad A pattern: ~e" #'pattern0)])]))
(begin-for-syntax (begin-for-syntax
;; convert-list-pattern : ListPattern id -> SinglePattern ;; convert-list-pattern : ListPattern id -> SinglePattern
@ -974,7 +976,8 @@ Conventions:
(with ([fail-handler fail-to-succeed] (with ([fail-handler fail-to-succeed]
[cut-prompt fail-to-succeed]) ;; to be safe [cut-prompt fail-to-succeed]) ;; to be safe
(parse:H x cx rest-x rest-cx rest-pr subpattern pr es (parse:H x cx rest-x rest-cx rest-pr subpattern pr es
(fh0 undo-stack (failure* pr0 es0)))))])])) (fh0 undo-stack (failure* pr0 es0)))))]
[_ (wrong-syntax stx "internal error: bad H pattern: ~e" #'head)])]))
;; (parse:dots x cx EH-pattern S-pattern pr es k) : expr[Ans] ;; (parse:dots x cx EH-pattern S-pattern pr es k) : expr[Ans]
;; In k: attrs(EH-pattern, S-pattern) are bound. ;; In k: attrs(EH-pattern, S-pattern) are bound.

2
racket/collects/syntax/parse/private/rep.rkt
View File

@ -1218,6 +1218,8 @@
(parameterize ((stxclass-lookup-config 'yes)) (parameterize ((stxclass-lookup-config 'yes))
(fixup-pattern p head?))) (fixup-pattern p head?)))
;; (eprintf "~v\n===>\n~v\n\n" p p*) ;; (eprintf "~v\n===>\n~v\n\n" p p*)
(unless (if head? (wf-H? p*) (wf-S? p*))
(error 'fixup-variant "result is not well-formed"))
;; Called just for error-reporting ;; Called just for error-reporting
(reorder-iattrs expected-attrs (pattern-attrs p*)) (reorder-iattrs expected-attrs (pattern-attrs p*))
(variant stx sattrs p* defs))])) (variant stx sattrs p* defs))]))