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

syntax/parse: fix struct match patterns with wrong number of subpatterns

Browse Source
This commit is contained in:
Ryan Culpepper 2018-08-10 17:54:20 +02:00
parent 31519f827a
commit 15186ff41c
3 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -75,6 +75,8 @@
[accessors (reverse (list-ref si 3))]) [accessors (reverse (list-ref si 3))])
(unless (andmap identifier? accessors) (unless (andmap identifier? accessors)
(raise-syntax-error #f "struct has incomplete information" #'S)) (raise-syntax-error #f "struct has incomplete information" #'S))
(unless (= (length accessors) (length (syntax->list #'(p ...))))
(raise-syntax-error #f "struct pattern has incorrect number of subpatterns" #'S))
(with-syntax ([predicate predicate] (with-syntax ([predicate predicate]
[(accessor ...) accessors]) [(accessor ...) accessors])
#'(if (predicate x) #'(if (predicate x)

4
racket/collects/syntax/parse/private/opt.rkt
View File

@ -189,7 +189,7 @@
(equal? tail (pat:datum '())))] (equal? tail (pat:datum '())))]
[(pat:and patterns) [(pat:and patterns)
(andmap pattern-factorable? patterns)] (andmap pattern-factorable? patterns)]
[(pat:or patterns) #f] [(pat:or _ patterns _) #f]
[(pat:not pattern) #f] ;; FIXME: ? [(pat:not pattern) #f] ;; FIXME: ?
[(pat:pair head tail) [(pat:pair head tail)
(and (pattern-factorable? head) (and (pattern-factorable? head)
@ -217,7 +217,7 @@
(pattern-factorable? inner)] (pattern-factorable? inner)]
[(hpat:commit inner) #t] [(hpat:commit inner) #t]
;; ---- ;; ----
[(ehpat head repc) [(ehpat _ head repc _)
(and (equal? repc #f) (and (equal? repc #f)
(pattern-factorable? head))] (pattern-factorable? head))]
;; ---- ;; ----

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

@ -352,7 +352,7 @@ A RepConstraint is one of
[(pat:ord sp _ _) (pattern-has-cut? sp)] [(pat:ord sp _ _) (pattern-has-cut? sp)]
[(pat:post sp) (pattern-has-cut? sp)] [(pat:post sp) (pattern-has-cut? sp)]
[(pat:integrated name _ _ _) #f] [(pat:integrated name _ _ _) #f]
[(pat:fixup _ _ _ _ _ _) #t] [(pat:fixup _ _ _ _ _ _ _) #t]
[(pat:and/fixup _ ps) (ormap pattern-has-cut? ps)] [(pat:and/fixup _ ps) (ormap pattern-has-cut? ps)]
;; -- A patterns ;; -- A patterns