diff --git a/racket/collects/syntax/parse/private/opt.rkt b/racket/collects/syntax/parse/private/opt.rkt
index ec032026ea..255160050f 100644
--- a/racket/collects/syntax/parse/private/opt.rkt
+++ b/racket/collects/syntax/parse/private/opt.rkt
@@ -118,7 +118,7 @@
 ;; pattern->partitioner : pattern -> (values (pattern -> boolean) ((listof pk1) -> PK))
 (define (pattern->partitioner pat1)
   (match pat1
-    [(pat:pair attrs proper? head tail)
+    [(pat:pair proper? head tail)
      (values (lambda (p) (and (pat:pair? p) (eq? (pat:pair-proper? p) proper?)))
              (lambda (rows)
                (when DEBUG-OPT-SUCCEED
@@ -158,7 +158,7 @@
 ;; unfold-and : pattern (listof pattern) -> (values pattern (listof pattern))
 (define (unfold-and p onto)
   (match p
-    [(pat:and _as subpatterns)
+    [(pat:and subpatterns)
      ;; pat:and is worth unfolding if first subpattern is not pat:action
      ;; if first subpattern is also pat:and, keep unfolding
      (let* ([first-sub (car subpatterns)]
@@ -175,54 +175,54 @@
   ;;  - if p can succeed multiple times, then factoring changes success order
   ;;  - if p can cut, then factoring changes which choice points are discarded (too few)
   (match p
-    [(pat:any _as) #t]
-    [(pat:svar _as _n) #t]
-    [(pat:var/p _as _n _p _argu _na _ac commit? _r)
+    [(pat:any) #t]
+    [(pat:svar _n) #t]
+    [(pat:var/p _n _p _argu _na _ac commit? _r)
      ;; commit? implies delimit-cut
      commit?]
     [(? pat:integrated?) #t]
-    [(pat:literal _as _lit _ip _lp) #t]
-    [(pat:datum _as _datum) #t]
-    [(pat:action _as _act _pat) #f]
-    [(pat:head _as head tail)
+    [(pat:literal _lit _ip _lp) #t]
+    [(pat:datum _datum) #t]
+    [(pat:action _act _pat) #f]
+    [(pat:head head tail)
      (and (pattern-factorable? head)
           (pattern-factorable? tail))]
-    [(pat:dots _as heads tail)
+    [(pat:dots heads tail)
      ;; Conservative approximation for common case: one head pattern
      ;; In general, check if heads don't overlap, don't overlap with tail.
      (and (= (length heads) 1)
           (let ([head (car heads)])
             (and (pattern-factorable? head)))
-          (equal? tail (create-pat:datum '())))]
-    [(pat:and _as patterns)
+          (equal? tail (pat:datum '())))]
+    [(pat:and patterns)
      (andmap pattern-factorable? patterns)]
-    [(pat:or _as patterns) #f]
-    [(pat:not _as pattern) #f] ;; FIXME: ?
-    [(pat:pair _as _p? head tail)
+    [(pat:or patterns) #f]
+    [(pat:not pattern) #f] ;; FIXME: ?
+    [(pat:pair _p? head tail)
      (and (pattern-factorable? head)
           (pattern-factorable? tail))]
-    [(pat:vector _as pattern)
+    [(pat:vector pattern)
      (pattern-factorable? pattern)]
-    [(pat:box _as pattern)
+    [(pat:box pattern)
      (pattern-factorable? pattern)]
-    [(pat:pstruct _as key pattern)
+    [(pat:pstruct key pattern)
      (pattern-factorable? pattern)]
-    [(pat:describe _as pattern _desc _trans _role)
+    [(pat:describe pattern _desc _trans _role)
      (pattern-factorable? pattern)]
-    [(pat:delimit _as pattern)
+    [(pat:delimit pattern)
      (pattern-factorable? pattern)]
-    [(pat:commit _as pattern) #t]
+    [(pat:commit pattern) #t]
     [(? pat:reflect?) #f]
-    [(pat:post _as pattern)
+    [(pat:post pattern)
      (pattern-factorable? pattern)]
     ;; ----
-    [(hpat:var/p _as _name _parser _argu _na _ac commit? _role)
+    [(hpat:var/p _name _parser _argu _na _ac commit? _role)
      commit?]
-    [(hpat:seq _as inner)
+    [(hpat:seq inner)
      (pattern-factorable? inner)]
-    [(hpat:commit _as inner) #t]
+    [(hpat:commit inner) #t]
     ;; ----
-    [(ehpat _as head repc)
+    [(ehpat head repc)
      (and (equal? repc #f)
           (pattern-factorable? head))]
     ;; ----
@@ -238,17 +238,17 @@
   (define result
     (cond [(and (pat:any? a) (pat:any? b)) #t]
           [(and (pat:svar? a) (pat:svar? b))
-           (equal-iattrs? (pat:svar-attrs a) (pat:svar-attrs b))]
+           (bound-identifier=? (pat:svar-name a) (pat:svar-name b))]
           [(and (pat:var/p? a) (pat:var/p? b))
            (and (free-id/f-equal? (pat:var/p-parser a) (pat:var/p-parser b))
-                (equal-iattrs? (pat:var/p-attrs a) (pat:var/p-attrs b))
+                (bound-id/f-equal? (pat:var/p-name a) (pat:var/p-name b))
+                (equal-iattrs? (pat:var/p-nested-attrs a) (pat:var/p-nested-attrs b))
                 (equal-argu? (pat:var/p-argu a) (pat:var/p-argu b))
                 (expr-equal? (pat:var/p-role a) (pat:var/p-role b)))]
           [(and (pat:integrated? a) (pat:integrated? b))
-           (and (free-identifier=? (pat:integrated-predicate a)
+           (and (bound-id/f-equal? (pat:integrated-name a) (pat:integrated-name b))
+                (free-identifier=? (pat:integrated-predicate a)
                                    (pat:integrated-predicate b))
-                (equal-iattrs? (pat:integrated-attrs a)
-                               (pat:integrated-attrs b))
                 (expr-equal? (pat:integrated-role a) (pat:integrated-role b)))]
           [(and (pat:literal? a) (pat:literal? b))
            ;; literals are hard to compare, so compare gensyms attached to
@@ -295,7 +295,8 @@
           ;; ---
           [(and (hpat:var/p? a) (hpat:var/p? b))
            (and (free-id/f-equal? (hpat:var/p-parser a) (hpat:var/p-parser b))
-                (equal-iattrs? (hpat:var/p-attrs a) (hpat:var/p-attrs b))
+                (bound-id/f-equal? (hpat:var/p-name a) (hpat:var/p-name b))
+                (equal-iattrs? (hpat:var/p-nested-attrs a) (hpat:var/p-nested-attrs b))
                 (equal-argu? (hpat:var/p-argu a) (hpat:var/p-argu b))
                 (expr-equal? (hpat:var/p-role a) (hpat:var/p-role b)))]
           [(and (hpat:seq? a) (hpat:seq? b))
@@ -369,10 +370,17 @@
            (identifier? b)
            (free-identifier=? a b))))
 
+(define (bound-id/f-equal? a b)
+  (or (and (eq? a #f)
+           (eq? b #f))
+      (and (identifier? a)
+           (identifier? b)
+           (bound-identifier=? a b))))
+
 (define (make-and-pattern subs)
-  (cond [(null? subs) (create-pat:any)] ;; shouldn't happen
+  (cond [(null? subs) (pat:any)] ;; shouldn't happen
         [(null? (cdr subs)) (car subs)]
-        [else (create-pat:and subs)]))
+        [else (pat:and subs)]))
 
 (define (*append a b) (if (null? b) a (append a b)))
 
diff --git a/racket/collects/syntax/parse/private/parse.rkt b/racket/collects/syntax/parse/private/parse.rkt
index 1a322037ca..c8d509201d 100644
--- a/racket/collects/syntax/parse/private/parse.rkt
+++ b/racket/collects/syntax/parse/private/parse.rkt
@@ -497,12 +497,12 @@ Conventions:
                 [rest-cx cx]
                 [rest-pr pr])
             k)]
-       [#s(pat:any _attrs)
+       [#s(pat:any)
         #'k]
-       [#s(pat:svar _attrs name)
+       [#s(pat:svar name)
         #'(let-attributes ([#s(attr name 0 #t) (datum->syntax cx x cx)])
             k)]
-       [#s(pat:var/p _attrs name parser argu (nested-a ...) attr-count commit? role)
+       [#s(pat:var/p name parser argu (nested-a ...) attr-count commit? role)
         (with-syntax ([(av ...) (generate-n-temporaries (syntax-e #'attr-count))]
                       [(name-attr ...)
                        (if (identifier? #'name)
@@ -530,7 +530,7 @@ Conventions:
                       (let-attributes (name-attr ...)
                         (let-attributes* ((nested-a ...) (av ...))
                           k))))))]
-       [#s(pat:reflect _attrs obj argu attr-decls name (nested-a ...))
+       [#s(pat:reflect obj argu attr-decls name (nested-a ...))
         (with-syntax ([(name-attr ...)
                        (if (identifier? #'name)
                            #'([#s(attr name 0 #t) (datum->syntax cx x cx)])
@@ -544,7 +544,7 @@ Conventions:
                                 (with ([fail-handler fh])
                                   k))))
                           argu))))]
-       [#s(pat:datum attrs datum)
+       [#s(pat:datum datum)
         (with-syntax ([unwrap-x
                        (if (atomic-datum-stx? #'datum)
                            #'(if (syntax? x) (syntax-e x) x)
@@ -553,22 +553,22 @@ Conventions:
               (if (equal? d (quote datum))
                   k
                   (fail (failure pr (es-add-atom 'datum es))))))]
-       [#s(pat:literal attrs literal input-phase lit-phase)
+       [#s(pat:literal literal input-phase lit-phase)
         #`(if (and (identifier? x)
                    (free-identifier=? x (quote-syntax literal) input-phase lit-phase))
               k
               (fail (failure pr (es-add-literal (quote-syntax literal) es))))]
-       [#s(pat:action attrs action subpattern)
+       [#s(pat:action action subpattern)
         #'(parse:A x cx action pr es (parse:S x cx subpattern pr es k))]
-       [#s(pat:head attrs head tail)
+       [#s(pat:head head tail)
         #`(parse:H x cx rest-x rest-cx rest-pr head pr es
                    (parse:S rest-x rest-cx tail rest-pr es k))]
-       [#s(pat:dots attrs head tail)
+       [#s(pat:dots head tail)
         #`(parse:dots x cx head tail pr es k)]
-       [#s(pat:and attrs subpatterns)
+       [#s(pat:and subpatterns)
         (for/fold ([k #'k]) ([subpattern (in-list (reverse (syntax->list #'subpatterns)))])
           #`(parse:S x cx #,subpattern pr es #,k))]
-       [#s(pat:or (a ...) (subpattern ...))
+       [#s(pat:or (a ...) (subpattern ...) (subattrs ...))
         (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
           #`(let ([success
                    (lambda (fh id ...)
@@ -576,9 +576,9 @@ Conventions:
                        (with ([fail-handler fh])
                          k)))])
               (try (parse:S x cx subpattern pr es
-                            (disjunct subpattern success () (id ...)))
+                            (disjunct subattrs success () (id ...)))
                    ...)))]
-       [#s(pat:not () subpattern)
+       [#s(pat:not subpattern)
         #`(let* ([fh0 fail-handler]
                  [pr0 pr]
                  [es0 es]
@@ -591,11 +591,9 @@ Conventions:
                    [cut-prompt fail-to-succeed]) ;; to be safe
               (parse:S x cx subpattern pr es
                        (fh0 (failure pr0 es0)))))]
-       [#s(pat:pair _attrs proper? head tail)
-        #`(let-values ([(datum cx)
-                        (if (syntax? x)
-                            (values (syntax-e x) x)
-                            (values x cx))])
+       [#s(pat:pair proper? head tail)
+        #`(let ([datum (if (syntax? x) (syntax-e x) x)]
+                [cx (if (syntax? x) x cx)])  ;; FIXME: shadowing cx?!
             (if (pair? datum)
                 (let ([hx (car datum)]
                       [hcx (car datum)]
@@ -606,7 +604,7 @@ Conventions:
                            (parse:S tx cx tail tpr es k)))
                 (let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair (first-desc:S head) es) es)])
                   (fail (failure pr es*)))))]
-       [#s(pat:vector _attrs subpattern)
+       [#s(pat:vector subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
             (if (vector? datum)
                 (let ([datum (vector->list datum)]
@@ -614,7 +612,7 @@ Conventions:
                       [pr* (ps-add-unvector pr)])
                   (parse:S datum vcx subpattern pr* es k))
                 (fail (failure pr es))))]
-       [#s(pat:box _attrs subpattern)
+       [#s(pat:box subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
             (if (box? datum)
                 (let ([datum (unbox datum)]
@@ -622,7 +620,7 @@ Conventions:
                       [pr* (ps-add-unbox pr)])
                   (parse:S datum bcx subpattern pr* es k))
                 (fail (failure pr es))))]
-       [#s(pat:pstruct _attrs key subpattern)
+       [#s(pat:pstruct key subpattern)
         #`(let ([datum (if (syntax? x) (syntax-e x) x)])
             (if (let ([xkey (prefab-struct-key datum)])
                   (and xkey (equal? xkey 'key)))
@@ -631,15 +629,15 @@ Conventions:
                       [pr* (ps-add-unpstruct pr)])
                   (parse:S datum scx subpattern pr* es k))
                 (fail (failure pr es))))]
-       [#s(pat:describe attrs pattern description transparent? role)
+       [#s(pat:describe pattern description transparent? role)
         #`(let ([es* (es-add-thing pr description transparent? role es)]
                 [pr* (if 'transparent? pr (ps-add-opaque pr))])
             (parse:S x cx pattern pr* es* k))]
-       [#s(pat:delimit attrs pattern)
+       [#s(pat:delimit pattern)
         #`(let ([cp0 cut-prompt])
             (with ([cut-prompt fail-handler])
               (parse:S x cx pattern pr es (with ([cut-prompt cp0]) k))))]
-       [#s(pat:commit attrs pattern)
+       [#s(pat:commit pattern)
         #`(let ([fh0 fail-handler]
                 [cp0 cut-prompt])
             (with ([cut-prompt fh0])
@@ -647,10 +645,10 @@ Conventions:
                        (with ([cut-prompt cp0]
                               [fail-handler fh0])
                          k))))]
-       [#s(pat:post attrs pattern)
+       [#s(pat:post pattern)
         #`(let ([pr* (ps-add-post pr)])
             (parse:S x cx pattern pr* es k))]
-       [#s(pat:integrated _attrs name predicate description role)
+       [#s(pat:integrated name predicate description role)
         (with-syntax ([(name-attr ...)
                        (if (identifier? #'name)
                            #'([#s(attr name 0 #t) x*])
@@ -666,49 +664,37 @@ Conventions:
   (syntax-case stx ()
     [(fds p)
      (syntax-case #'p ()
-       [#s(pat:any _as)
+       [#s(pat:any)
         #''(any)]
-       [#s(pat:svar _as name)
+       [#s(pat:svar name)
         #''(any)]
        [#s(pat:var/p _ ...)
         #'#f] ;; FIXME: need access to (constant) description as field
-       [#s(pat:datum _as d)
+       [#s(pat:datum d)
         #''(datum d)]
-       [#s(pat:literal _as id _ip _lp)
+       [#s(pat:literal id _ip _lp)
         #''(literal id)]
-       [#s(pat:describe _as _p description _t? _role)
+       [#s(pat:describe _p description _t? _role)
         #'description] ;; FIXME??? only constants?
-       [#s(pat:delimit _a pattern)
+       [#s(pat:delimit pattern)
         #'(first-desc:S pattern)]
-       [#s(pat:commit _a pattern)
+       [#s(pat:commit pattern)
         #'(first-desc:S pattern)]
-       [#s(pat:post _a pattern)
+       [#s(pat:post pattern)
         #'(first-desc:S pattern)]
-       [#s(pat:integrated _as _name _pred description _role)
+       [#s(pat:integrated _name _pred description _role)
         #''description]
        [_ #'#f])]))
 
-;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
+;; (disjunct (iattr ...) success (pre:expr ...) (id:id ...)) : expr[Ans]
 (define-syntax (disjunct stx)
   (syntax-case stx ()
-    [(disjunct pattern success (pre ...) (id ...))
-     (with-syntax ([(#s(attr sub-id _ _) ...) (pattern-attrs (wash #'pattern))])
-       (with-syntax ([(alt-sub-id ...) (generate-temporaries #'(sub-id ...))])
-         #`(let ([alt-sub-id (attribute sub-id)] ...)
-             (let ([id #f] ...)
-               (let ([sub-id alt-sub-id] ...)
-                 (success fail-handler pre ... id ...))))))]))
-
-;; (disjunct/sides clauses success (pre:expr ...) (id:id ...)) : expr[Ans]
-(define-syntax (disjunct/sides stx)
-  (syntax-case stx ()
-    [(disjunct/sides clauses success (pre ...) (id ...))
-     (with-syntax ([(#s(clause:attr #s(attr sub-id _ _) _) ...) #'clauses])
-       (with-syntax ([(alt-sub-id ...) (generate-temporaries #'(sub-id ...))])
-         #`(let ([alt-sub-id (attribute sub-id)] ...)
-             (let ([id #f] ...)
-               (let ([sub-id alt-sub-id] ...)
-                 (success fail-handler pre ... id ...))))))]))
+    [(disjunct (#s(attr sub-id _ _) ...) success (pre ...) (id ...))
+     (with-syntax ([(alt-sub-id ...) (generate-temporaries #'(sub-id ...))])
+       #`(let ([alt-sub-id (attribute sub-id)] ...)
+           (let ([id #f] ...)
+             (let ([sub-id alt-sub-id] ...)
+               (success fail-handler pre ... id ...)))))]))
 
 ;; (parse:A x cx A-pattern pr es k) : expr[Ans]
 ;; In k: attrs(A-pattern) are bound.
@@ -716,27 +702,28 @@ Conventions:
   (syntax-case stx ()
     [(parse:A x cx pattern0 pr es k)
      (syntax-case #'pattern0 ()
-       [#s(action:cut _)
+       [#s(action:and (action ...))
+        (for/fold ([k #'k]) ([action (in-list (reverse (syntax->list #'(action ...))))])
+          #`(parse:A x cx #,action pr es #,k))]
+       [#s(action:cut)
         #'(with ([fail-handler cut-prompt]) k)]
-       [#s(action:bind _ (side ...))
+       [#s(action:bind (side ...))
         #'(bind/sides (side ...) k)]
-       [#s(action:fail _ condition message)
+       [#s(action:fail condition message)
         #`(let ([c (wrap-user-code condition)])
             (if c
-                (let ([pr* (if (syntax? c)
-                               (ps-add-stx pr c)
-                               pr)]
+                (let ([pr* (if (syntax? c) (ps-add-stx pr c) pr)]
                       [es* (es-add-message message es)])
                   (fail (failure pr* es*)))
                 k))]
-       [#s(action:parse _ pattern expr)
+       [#s(action:parse pattern expr)
         #`(let* ([y (datum->syntax/with-clause (wrap-user-code expr))]
                  [cy y]
                  [pr* (ps-add-stx pr y)])
             (parse:S y cy pattern pr* es k))]
-       [#s(action:do _ (stmt ...))
+       [#s(action:do (stmt ...))
         #'(let () (no-shadow stmt) ... (#%expression k))]
-       [#s(action:post _ pattern group index)
+       [#s(action:post pattern group index)
         #'(let ([pr* (ps-add-post pr 'group 'index)])
             (parse:A x cx pattern pr* es k))])]))
 
@@ -757,20 +744,20 @@ Conventions:
  ;; to rest-var.
  (define (convert-list-pattern pattern end-pattern)
    (syntax-case pattern ()
-     [#s(pat:datum () ())
+     [#s(pat:datum ())
       end-pattern]
-     [#s(pat:action attrs action tail)
+     [#s(pat:action action tail)
       (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
-        #'#s(pat:action attrs action tail))]
-     [#s(pat:head attrs head tail)
+        #'#s(pat:action action tail))]
+     [#s(pat:head head tail)
       (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
-        #'#s(pat:head attrs head tail))]
-     [#s(pat:dots attrs head tail)
+        #'#s(pat:head head tail))]
+     [#s(pat:dots head tail)
       (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
-        #'#s(pat:dots attrs head tail))]
-     [#s(pat:pair attrs proper? head-part tail-part)
+        #'#s(pat:dots head tail))]
+     [#s(pat:pair proper? head-part tail-part)
       (with-syntax ([tail-part (convert-list-pattern #'tail-part end-pattern)])
-        #'#s(pat:pair attrs proper? head-part tail-part))])))
+        #'#s(pat:pair proper? head-part tail-part))])))
 
 ;; (parse:H x cx rest-x rest-cx rest-pr H-pattern pr es k)
 ;; In k: rest, rest-pr, attrs(H-pattern) are bound.
@@ -778,13 +765,13 @@ Conventions:
   (syntax-case stx ()
     [(parse:H x cx rest-x rest-cx rest-pr head pr es k)
      (syntax-case #'head ()
-       [#s(hpat:describe _ pattern description transparent? role)
+       [#s(hpat:describe pattern description transparent? role)
         #`(let ([es* (es-add-thing pr description transparent? role es)]
                 [pr* (if 'transparent? pr (ps-add-opaque pr))])
             (parse:H x cx rest-x rest-cx rest-pr pattern pr* es*
                      (let ([rest-pr (if 'transparent? rest-pr (ps-pop-opaque rest-pr))])
                        k)))]
-       [#s(hpat:var/p _attrs name parser argu (nested-a ...) attr-count commit? role)
+       [#s(hpat:var/p name parser argu (nested-a ...) attr-count commit? role)
         (with-syntax ([(av ...) (generate-n-temporaries (syntax-e #'attr-count))]
                       [(name-attr ...)
                        (if (identifier? #'name)
@@ -814,7 +801,7 @@ Conventions:
                       (let-attributes (name-attr ...)
                         (let-attributes* ((nested-a ...) (av ...))
                           k))))))]
-       [#s(hpat:reflect _attrs obj argu attr-decls name (nested-a ...))
+       [#s(hpat:reflect obj argu attr-decls name (nested-a ...))
         (with-syntax ([(name-attr ...)
                        (if (identifier? #'name)
                            #'([#s(attr name 0 #t)
@@ -829,12 +816,12 @@ Conventions:
                                  (with ([fail-handler fh])
                                    k))))
                           argu))))]
-       [#s(hpat:and (a ...) head single)
+       [#s(hpat:and head single)
         #`(let ([cx0 cx])
             (parse:H x cx rest-x rest-cx rest-pr head pr es
                      (let ([lst (stx-list-take x (ps-difference pr rest-pr))])
                        (parse:S lst cx0 single pr es k))))]
-       [#s(hpat:or (a ...) (subpattern ...))
+       [#s(hpat:or (a ...) (subpattern ...) (subattrs ...))
         (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
           #`(let ([success
                    (lambda (fh rest-x rest-cx rest-pr id ...)
@@ -842,39 +829,22 @@ Conventions:
                        (with ([fail-handler fh])
                          k)))])
               (try (parse:H x cx rest-x rest-cx rest-pr subpattern pr es
-                            (disjunct subpattern success
-                                      (rest-x rest-cx rest-pr) (id ...)))
+                            (disjunct subattrs success (rest-x rest-cx rest-pr) (id ...)))
                    ...)))]
-       [#s(hpat:seq attrs pattern)
+       [#s(hpat:seq pattern)
         (with-syntax ([pattern
                        (convert-list-pattern
                         #'pattern
                         #'#s(internal-rest-pattern rest-x rest-cx rest-pr))])
           #'(parse:S x cx pattern pr es k))]
-       [#s(hpat:action attrs action subpattern)
+       [#s(hpat:action action subpattern)
         #'(parse:A x cx action pr es (parse:H x cx rest-x rest-cx rest-pr subpattern pr es k))]
-       [#s(hpat:optional (a ...) pattern defaults)
-        (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
-          #`(let ([success
-                   (lambda (fh rest-x rest-cx rest-pr id ...)
-                     (let-attributes ([a id] ...)
-                       (with ([fail-handler fh])
-                         k)))])
-              (try (parse:H x cx rest-x rest-cx rest-pr pattern pr es 
-                            (success fail-handler rest-x rest-cx rest-pr (attribute id) ...))
-                   (let ([rest-x x]
-                         [rest-cx cx]
-                         [rest-pr pr])
-                     (bind/sides defaults
-                       (disjunct/sides defaults success
-                                       (rest-x rest-cx rest-pr)
-                                       (id ...)))))))]
-       [#s(hpat:delimit _attrs pattern)
+       [#s(hpat:delimit pattern)
         #'(let ([cp0 cut-prompt])
             (with ([cut-prompt fail-handler])
               (parse:H x cx rest-x rest-cx rest-pr pattern pr es
                        (with ([cut-prompt cp0]) k))))]
-       [#s(hpat:commit attrs pattern)
+       [#s(hpat:commit pattern)
         #`(let ([fh0 fail-handler]
                 [cp0 cut-prompt])
             (with ([cut-prompt fh0])
@@ -882,15 +852,15 @@ Conventions:
                        (with ([cut-prompt cp0]
                               [fail-handler fh0])
                          k))))]
-       [#s(hpat:post _ pattern)
+       [#s(hpat:post pattern)
         #'(let ([pr (ps-add-post pr)])
             (parse:H x cx rest-x rest-cx rest-pr pattern pr es k))]
-       [#s(hpat:peek _ pattern)
+       [#s(hpat:peek pattern)
         #`(let ([saved-x x] [saved-cx cx] [saved-pr pr])
             (parse:H x cx dummy-x dummy-cx dummy-pr pattern pr es
                      (let ([rest-x saved-x] [rest-cx saved-cx] [rest-pr saved-pr])
                        k)))]
-       [#s(hpat:peek-not () subpattern)
+       [#s(hpat:peek-not subpattern)
         #`(let* ([fh0 fail-handler]
                  [pr0 pr]
                  [es0 es]
@@ -908,11 +878,10 @@ Conventions:
               (parse:H x cx rest-x rest-cx rest-pr subpattern pr es
                        (fh0 (failure pr0 es0)))))]
        [_
-        (with-syntax ([attrs (pattern-attrs (wash #'head))])
-          #'(parse:S x cx
-                     ;; FIXME: consider proper-list-pattern? (yes is consistent with ~seq)
-                     #s(pat:pair attrs #t head #s(internal-rest-pattern rest-x rest-cx rest-pr))
-                     pr es k))])]))
+        #'(parse:S x cx
+                   ;; FIXME: consider proper-list-pattern? (yes is consistent with ~seq)
+                   #s(pat:pair #t head #s(internal-rest-pattern rest-x rest-cx rest-pr))
+                   pr es k)])]))
 
 ;; (parse:dots x cx EH-pattern S-pattern pr es k) : expr[Ans]
 ;; In k: attrs(EH-pattern, S-pattern) are bound.
@@ -920,17 +889,15 @@ Conventions:
   (syntax-case stx ()
     ;; == Specialized cases
     ;; -- (x ... . ())
-    [(parse:dots x cx (#s(ehpat (attr0) #s(pat:svar _attrs name) #f))
-                 #s(pat:datum () ()) pr es k)
+    [(parse:dots x cx (#s(ehpat (attr0) #s(pat:svar name) #f))
+                 #s(pat:datum ()) pr es k)
      #'(let-values ([(status result) (predicate-ellipsis-parser x cx pr es void #f #f)])
          (case status
            ((ok) (let-attributes ([attr0 result]) k))
            (else (fail result))))]
     ;; -- (x:sc ... . ()) where sc is an integrable stxclass like id or expr
-    [(parse:dots x cx (#s(ehpat (attr0)
-                                #s(pat:integrated _attrs _name pred? desc role)
-                                #f))
-                 #s(pat:datum () ()) pr es k)
+    [(parse:dots x cx (#s(ehpat (attr0) #s(pat:integrated _name pred? desc role) #f))
+                 #s(pat:datum ()) pr es k)
      #'(let-values ([(status result) (predicate-ellipsis-parser x cx pr es pred? desc role)])
          (case status
            ((ok) (let-attributes ([attr0 result]) k))
@@ -974,8 +941,8 @@ Conventions:
              (define (dots-loop dx dcx loop-pr fh rel-rep ... alt-id ...)
                (with ([fail-handler fh])
                  (try-or-pair/null-check tail-pattern-is-null? dx dcx loop-pr es
-                   (try (parse:EH dx dcx loop-pr head-repc dx* dcx* loop-pr* alt-map head-rep
-                                  head es loop-k)
+                   (try (parse:EH dx dcx loop-pr head-attrs head-repc dx* dcx* loop-pr* 
+                                  alt-map head-rep head es loop-k)
                         ...)
                    (cond [(< rel-rep (rep:min-number rel-repc))
                           (let ([es (expectation-of-reps/too-few es rel-rep rel-repc)])
@@ -1002,10 +969,10 @@ Conventions:
 ;; In k: x*, cx*, pr*, alts`attrs(H-pattern) are bound and rep is shadowed.
 (define-syntax (parse:EH stx)
   (syntax-case stx ()
-    [(parse:EH x cx pr repc x* cx* pr* alts rep head es k)
+    [(parse:EH x cx pr attrs repc x* cx* pr* alts rep head es k)
      (let ()
        (define/with-syntax k*
-         (let* ([main-attrs (wash-iattrs (pattern-attrs (wash #'head)))]
+         (let* ([main-attrs (wash-iattrs #'attrs)]
                 [ids (map attr-name main-attrs)]
                 [alt-ids
                  (let ([table (make-bound-id-table)])
@@ -1014,8 +981,7 @@ Conventions:
                        (bound-id-table-set! table (car entry) (cdr entry))))
                    (for/list ([id (in-list ids)]) (bound-id-table-ref table id)))])
            (with-syntax ([(id ...) ids]
-                         [(alt-id ...) alt-ids]
-                         [(alt-a ...) (map rename-attr main-attrs alt-ids)])
+                         [(alt-id ...) alt-ids])
              #`(let ([alt-id (rep:combine repc (attribute id) alt-id)] ...)
                  k))))
        (syntax-case #'repc ()
diff --git a/racket/collects/syntax/parse/private/rep-attrs.rkt b/racket/collects/syntax/parse/private/rep-attrs.rkt
index 7996314eaa..11fbe0a72d 100644
--- a/racket/collects/syntax/parse/private/rep-attrs.rkt
+++ b/racket/collects/syntax/parse/private/rep-attrs.rkt
@@ -48,9 +48,6 @@ of signatures easier for reified syntax-classes.
  [reorder-iattrs
   (-> (listof sattr?) (listof iattr?)
       (listof iattr?))]
- [rename-attr
-  (-> iattr? identifier?
-      iattr?)]
 
  ;; SAttr operations
  [iattr->sattr
@@ -136,9 +133,6 @@ of signatures easier for reified syntax-classes.
         #:key (lambda (a) (symbol->string (attr-name a)))
         #:cache-keys? #t))
 
-(define (rename-attr a name)
-  (make attr name (attr-depth a) (attr-syntax? a)))
-
 ;; intersect-sattrss : (listof (listof SAttr)) -> (listof SAttr)
 ;; FIXME: rely on sorted inputs, simplify algorithm and avoid second sort?
 (define (intersect-sattrss attrss)
diff --git a/racket/collects/syntax/parse/private/rep-patterns.rkt b/racket/collects/syntax/parse/private/rep-patterns.rkt
index e2f0828fd0..b554172976 100644
--- a/racket/collects/syntax/parse/private/rep-patterns.rkt
+++ b/racket/collects/syntax/parse/private/rep-patterns.rkt
@@ -2,7 +2,7 @@
 (require syntax/parse/private/residual-ct ;; keep abs. path
          "rep-attrs.rkt"
          "kws.rkt"
-         "make.rkt"
+         "minimatch.rkt"
          (for-syntax racket/base
                      syntax/stx
                      racket/syntax))
@@ -12,118 +12,107 @@
 Uses Arguments from kws.rkt
 |#
 
-#|
-A Base is (listof IAttr)
-  If P = (make-pattern Attrs ...) and A is in Attrs,
-  the depth of A is with respect to P,
-  not with respect to the entire enclosing pattern.
-|#
-
 #|
 A SinglePattern is one of
-  (pat:any Base)
-  (pat:svar Base id)  -- "simple" var, no stxclass
-  (pat:var/p Base id id Arguments (Listof IAttr) nat/#f bool stx) -- var with parser
-  (pat:literal Base identifier ct-phase ct-phase)
-  (pat:datum Base datum)
-  (pat:action Base ActionPattern SinglePattern)
-  (pat:head Base HeadPattern SinglePattern)
-  (pat:dots Base (listof EllipsisHeadPattern) SinglePattern)
-  (pat:and Base (listof SinglePattern))
-  (pat:or Base (listof SinglePattern))
-  (pat:not Base SinglePattern)
-  (pat:pair Base boolean SinglePattern SinglePattern)
-  (pat:vector Base SinglePattern)
-  (pat:box Base SinglePattern)
-  (pat:pstruct Base key SinglePattern)
-  (pat:describe Base SinglePattern stx boolean stx)
-  (pat:delimit Base SinglePattern)
-  (pat:commit Base SinglePattern)
-  (pat:reflect Base stx Arguments (listof SAttr) id (listof IAttr))
-  (pat:post Base SinglePattern)
-  (pat:integrated Base id/#f id string stx)
+  (pat:any)
+  (pat:svar id)  -- "simple" var, no stxclass
+  (pat:var/p id id Arguments (Listof IAttr) nat/#f bool stx) -- var with parser
+  (pat:literal identifier ct-phase ct-phase)
+  (pat:datum datum)
+  (pat:action ActionPattern SinglePattern)
+  (pat:head HeadPattern SinglePattern)
+  (pat:dots (listof EllipsisHeadPattern) SinglePattern)
+  (pat:and (listof SinglePattern))
+  (pat:or (listof IAttr) (listof SinglePattern) (listof (listof IAttr)))
+  (pat:not SinglePattern)
+  (pat:pair boolean SinglePattern SinglePattern)
+  (pat:vector SinglePattern)
+  (pat:box SinglePattern)
+  (pat:pstruct key SinglePattern)
+  (pat:describe SinglePattern stx boolean stx)
+  (pat:delimit SinglePattern)
+  (pat:commit SinglePattern)
+  (pat:reflect stx Arguments (listof SAttr) id (listof IAttr))
+  (pat:post SinglePattern)
+  (pat:integrated id/#f id string stx)
 
 A ListPattern is a subtype of SinglePattern; one of
-  (pat:datum Base '())
-  (pat:action Base ActionPattern ListPattern)
-  (pat:head Base HeadPattern ListPattern)
-  (pat:pair Base #t SinglePattern ListPattern)
-  (pat:dots Base EllipsisHeadPattern SinglePattern)
+  (pat:datum '())
+  (pat:action ActionPattern ListPattern)
+  (pat:head HeadPattern ListPattern)
+  (pat:pair #t SinglePattern ListPattern)
+  (pat:dots EllipsisHeadPattern SinglePattern)
 |#
 
-(define-struct pat:any (attrs) #:prefab)
-(define-struct pat:svar (attrs name) #:prefab)
-(define-struct pat:var/p (attrs name parser argu nested-attrs attr-count commit? role) #:prefab)
-(define-struct pat:literal (attrs id input-phase lit-phase) #:prefab)
-(define-struct pat:datum (attrs datum) #:prefab)
-(define-struct pat:action (attrs action inner) #:prefab)
-(define-struct pat:head (attrs head tail) #:prefab)
-(define-struct pat:dots (attrs heads tail) #:prefab)
-(define-struct pat:and (attrs patterns) #:prefab)
-(define-struct pat:or (attrs patterns) #:prefab)
-(define-struct pat:not (attrs pattern) #:prefab)
-(define-struct pat:pair (attrs proper? head tail) #:prefab)
-(define-struct pat:vector (attrs pattern) #:prefab)
-(define-struct pat:box (attrs pattern) #:prefab)
-(define-struct pat:pstruct (attrs key pattern) #:prefab)
-(define-struct pat:describe (attrs pattern description transparent? role) #:prefab)
-(define-struct pat:delimit (attrs pattern) #:prefab)
-(define-struct pat:commit (attrs pattern) #:prefab)
-(define-struct pat:reflect (attrs obj argu attr-decls name nested-attrs) #:prefab)
-(define-struct pat:post (attrs pattern) #:prefab)
-(define-struct pat:integrated (attrs name predicate description role) #:prefab)
+(define-struct pat:any () #:prefab)
+(define-struct pat:svar (name) #:prefab)
+(define-struct pat:var/p (name parser argu nested-attrs attr-count commit? role) #:prefab)
+(define-struct pat:literal (id input-phase lit-phase) #:prefab)
+(define-struct pat:datum (datum) #:prefab)
+(define-struct pat:action (action inner) #:prefab)
+(define-struct pat:head (head tail) #:prefab)
+(define-struct pat:dots (heads tail) #:prefab)
+(define-struct pat:and (patterns) #:prefab)
+(define-struct pat:or (attrs patterns attrss) #:prefab)
+(define-struct pat:not (pattern) #:prefab)
+(define-struct pat:pair (proper? head tail) #:prefab)
+(define-struct pat:vector (pattern) #:prefab)
+(define-struct pat:box (pattern) #:prefab)
+(define-struct pat:pstruct (key pattern) #:prefab)
+(define-struct pat:describe (pattern description transparent? role) #:prefab)
+(define-struct pat:delimit (pattern) #:prefab)
+(define-struct pat:commit (pattern) #:prefab)
+(define-struct pat:reflect (obj argu attr-decls name nested-attrs) #:prefab)
+(define-struct pat:post (pattern) #:prefab)
+(define-struct pat:integrated (name predicate description role) #:prefab)
 
 #|
 A ActionPattern is one of
-  (action:cut Base)
-  (action:fail Base stx stx)
-  (action:bind Base (listof clause:attr))
-* (action:and Base (listof ActionPattern))
-  (action:parse Base SinglePattern stx)
-  (action:do Base (listof stx))
-  (action:post Base ActionPattern Quotable Nat)
-
-action:and is desugared below in create-* procedures
+  (action:cut)
+  (action:fail stx stx)
+  (action:bind (listof clause:attr))
+  (action:and (listof ActionPattern))
+  (action:parse SinglePattern stx)
+  (action:do (listof stx))
+  (action:post ActionPattern Quotable Nat)
 |#
 
-(define-struct action:cut (attrs) #:prefab)
-(define-struct action:fail (attrs when message) #:prefab)
-(define-struct action:bind (attrs clauses) #:prefab)
-(define-struct action:and (attrs patterns) #:prefab)
-(define-struct action:parse (attrs pattern expr) #:prefab)
-(define-struct action:do (attrs stmts) #:prefab)
-(define-struct action:post (attrs pattern group index) #:prefab)
+(define-struct action:cut () #:prefab)
+(define-struct action:fail (when message) #:prefab)
+(define-struct action:bind (clauses) #:prefab)
+(define-struct action:and (patterns) #:prefab)
+(define-struct action:parse (pattern expr) #:prefab)
+(define-struct action:do (stmts) #:prefab)
+(define-struct action:post (pattern group index) #:prefab)
 
 #|
 A HeadPattern is one of 
-  (hpat:var/p Base id id Arguments (listof IAttr) nat/#f bool stx)
-  (hpat:seq Base ListPattern)
-  (hpat:action Base ActionPattern HeadPattern)
-  (hpat:and Base HeadPattern SinglePattern)
-  (hpat:or Base (listof HeadPattern))
-  (hpat:optional Base HeadPattern (listof clause:attr))
-  (hpat:describe Base HeadPattern stx/#f boolean stx)
-  (hpat:delimit Base HeadPattern)
-  (hpat:commit Base HeadPattern)
-  (hpat:reflect Base stx Arguments (listof SAttr) id (listof IAttr))
-  (hpat:post Base HeadPattern)
-  (hpat:peek Base HeadPattern)
-  (hpat:peek-not Base HeadPattern)
+  (hpat:var/p id id Arguments (listof IAttr) nat/#f bool stx)
+  (hpat:seq ListPattern)
+  (hpat:action ActionPattern HeadPattern)
+  (hpat:and HeadPattern SinglePattern)
+  (hpat:or (listof IAttr) (listof HeadPattern) (listof (listof IAttr)))
+  (hpat:describe HeadPattern stx/#f boolean stx)
+  (hpat:delimit HeadPattern)
+  (hpat:commit HeadPattern)
+  (hpat:reflect stx Arguments (listof SAttr) id (listof IAttr))
+  (hpat:post HeadPattern)
+  (hpat:peek HeadPattern)
+  (hpat:peek-not HeadPattern)
 |#
 
-(define-struct hpat:var/p (attrs name parser argu nested-attrs attr-count commit? role) #:prefab)
-(define-struct hpat:seq (attrs inner) #:prefab)
-(define-struct hpat:action (attrs action inner) #:prefab)
-(define-struct hpat:and (attrs head single) #:prefab)
-(define-struct hpat:or (attrs patterns) #:prefab)
-(define-struct hpat:optional (attrs inner defaults) #:prefab)
-(define-struct hpat:describe (attrs pattern description transparent? role) #:prefab)
-(define-struct hpat:delimit (attrs pattern) #:prefab)
-(define-struct hpat:commit (attrs pattern) #:prefab)
-(define-struct hpat:reflect (attrs obj argu attr-decls name nested-attrs) #:prefab)
-(define-struct hpat:post (attrs pattern) #:prefab)
-(define-struct hpat:peek (attrs pattern) #:prefab)
-(define-struct hpat:peek-not (attrs pattern) #:prefab)
+(define-struct hpat:var/p (name parser argu nested-attrs attr-count commit? role) #:prefab)
+(define-struct hpat:seq (inner) #:prefab)
+(define-struct hpat:action (action inner) #:prefab)
+(define-struct hpat:and (head single) #:prefab)
+(define-struct hpat:or (attrs patterns attrss) #:prefab)
+(define-struct hpat:describe (pattern description transparent? role) #:prefab)
+(define-struct hpat:delimit (pattern) #:prefab)
+(define-struct hpat:commit (pattern) #:prefab)
+(define-struct hpat:reflect (obj argu attr-decls name nested-attrs) #:prefab)
+(define-struct hpat:post (pattern) #:prefab)
+(define-struct hpat:peek (pattern) #:prefab)
+(define-struct hpat:peek-not (pattern) #:prefab)
 
 #|
 An EllipsisHeadPattern is
@@ -192,7 +181,6 @@ A SideClause is one of
       (hpat:action? x)
       (hpat:and? x)
       (hpat:or? x)
-      (hpat:optional? x)
       (hpat:describe? x)
       (hpat:delimit? x)
       (hpat:commit? x)
@@ -210,186 +198,121 @@ A SideClause is one of
   (or (single-pattern? x)
       (head-pattern? x)))
 
-(define pattern-attrs
-  (let ()
-    (define-syntax (mk-get-attrs stx)
-      (syntax-case stx ()
-        [(_ struct ...)
-         (with-syntax
-             ([([pred accessor] ...)
-               (for/list ([s (in-list (stx->list #'(struct ...)))])
-                 (list (format-id s "~a?" (syntax-e s))
-                       (format-id s "~a-attrs" (syntax-e s))))])
-           #'(lambda (x)
-               (cond [(pred x) (accessor x)] ...
-                     [else (raise-type-error 'pattern-attrs "pattern" x)])))]))
-    (mk-get-attrs pat:any pat:svar pat:var/p pat:datum pat:literal pat:action pat:head
-                  pat:dots pat:and pat:or pat:not pat:describe
-                  pat:pair pat:vector pat:box pat:pstruct
-                  pat:delimit pat:commit pat:reflect pat:post pat:integrated
-                  action:cut action:bind action:fail action:and action:parse
-                  action:do action:post
-                  hpat:var/p hpat:seq hpat:action hpat:and hpat:or hpat:describe
-                  hpat:optional hpat:delimit hpat:commit hpat:reflect hpat:post
-                  hpat:peek hpat:peek-not
-                  ehpat)))
+;; check-pattern : *Pattern -> *Pattern
+;; Does attr computation to catch errors, but returns same pattern.
+(define (check-pattern p)
+  (void (pattern-attrs p))
+  p)
+
+;; pattern-attrs-table : Hasheq[*Pattern => (Listof IAttr)]
+(define pattern-attrs-table (make-weak-hasheq))
+
+;; pattern-attrs : *Pattern -> (Listof IAttr)
+(define (pattern-attrs p)
+  (hash-ref! pattern-attrs-table p (lambda () (pattern-attrs* p))))
+
+(define (pattern-attrs* p)
+  (match p
+    ;; -- S patterns
+    [(pat:any)
+     null]
+    [(pat:svar name)
+     (list (attr name 0 #t))]
+    [(pat:var/p name _ _ nested-attrs _ _ _)
+     (if name (cons (attr name 0 #t) nested-attrs) nested-attrs)]
+    [(pat:reflect _ _ _ name nested-attrs)
+     (if name (cons (attr name 0 #t) nested-attrs) nested-attrs)]
+    [(pat:datum _)
+     null]
+    [(pat:literal _ _ _)
+     null]
+    [(pat:action a sp)
+     (append-iattrs (map pattern-attrs (list a sp)))]
+    [(pat:head headp tailp)
+     (append-iattrs (map pattern-attrs (list headp tailp)))]
+    [(pat:pair _proper? headp tailp)
+     (append-iattrs (map pattern-attrs (list headp tailp)))]
+    [(pat:vector sp)
+     (pattern-attrs sp)]
+    [(pat:box sp)
+     (pattern-attrs sp)]
+    [(pat:pstruct key sp)
+     (pattern-attrs sp)]
+    [(pat:describe sp _ _ _)
+     (pattern-attrs sp)]
+    [(pat:and ps)
+     (append-iattrs (map pattern-attrs ps))]
+    [(pat:or _ ps _)
+     (union-iattrs (map pattern-attrs ps))]
+    [(pat:not _)
+     null]
+    [(pat:dots headps tailp)
+     (append-iattrs (map pattern-attrs (append headps (list tailp))))]
+    [(pat:delimit sp)
+     (pattern-attrs sp)]
+    [(pat:commit sp)
+     (pattern-attrs sp)]
+    [(pat:post sp)
+     (pattern-attrs sp)]
+    [(pat:integrated name _ _ _)
+     (if name (list (attr name 0 #t)) null)]
+
+    ;; -- A patterns
+    [(action:cut)
+     null]
+    [(action:fail _ _)
+     null]
+    [(action:bind clauses)
+     (map clause:attr-attr clauses)]
+    [(action:and ps)
+     (append-iattrs (map pattern-attrs ps))]
+    [(action:parse sp _)
+     (pattern-attrs sp)]
+    [(action:do _)
+     null]
+    [(action:post sp _ _)
+     (pattern-attrs sp)]
+
+    ;; -- H patterns
+    [(hpat:var/p name _ _ nested-attrs _ _ _)
+     (if name (cons (attr name 0 #t) nested-attrs) nested-attrs)]
+    [(hpat:reflect _ _ _ name nested-attrs)
+     (if name (cons (attr name 0 #t) nested-attrs) nested-attrs)]
+    [(hpat:seq lp)
+     (pattern-attrs lp)]
+    [(hpat:action a hp)
+     (append-iattrs (map pattern-attrs (list a hp)))]
+    [(hpat:describe hp _ _ _)
+     (pattern-attrs hp)]
+    [(hpat:and hp sp)
+     (append-iattrs (map pattern-attrs (list hp sp)))]
+    [(hpat:or _ ps _)
+     (union-iattrs (map pattern-attrs ps))]
+    [(hpat:delimit hp)
+     (pattern-attrs hp)]
+    [(hpat:commit hp)
+     (pattern-attrs hp)]
+    [(hpat:post hp)
+     (pattern-attrs hp)]
+    [(hpat:peek hp)
+     (pattern-attrs hp)]
+    [(hpat:peek-not hp)
+     null]
+
+    ;; EH patterns
+    [(ehpat iattrs _ _)
+     iattrs]
+    ))
 
 ;; ----
 
-;; Helpers to handle attribute calculations
-;; Too complicated for a few pattern forms; those are handled in rep.rkt
+(define (create-pat:or ps)
+  (define attrss (map pattern-attrs ps))
+  (pat:or (union-iattrs attrss) ps attrss))
 
-(define (create-pat:any)
-  (make pat:any null))
-
-(define (create-pat:svar name)
-  (let ([attrs (list (make attr name 0 #t))])
-    (make pat:svar attrs name)))
-
-(define (create-pat:var/p name parser argu nested-attrs attr-count commit? role)
-  (let ([attrs (if name (cons (make attr name 0 #t) nested-attrs) nested-attrs)])
-    (make pat:var/p attrs name parser argu nested-attrs attr-count commit? role)))
-
-(define (create-pat:reflect obj argu attr-decls name nested-attrs)
-  (let ([attrs
-         (if name (cons (make attr name 0 #t) nested-attrs) nested-attrs)])
-    (make pat:reflect attrs obj argu attr-decls name nested-attrs)))
-
-(define (create-pat:datum datum)
-  (make pat:datum null datum))
-
-(define (create-pat:literal literal input-phase lit-phase)
-  (make pat:literal null literal input-phase lit-phase))
-
-(define (create-pat:action g sp)
-  (cond [(action:and? g)
-         (for/fold ([sp sp]) ([g (in-list (reverse (action:and-patterns g)))])
-           (create-pat:action g sp))]
-        [else
-         (let ([attrs (append-iattrs (map pattern-attrs (list g sp)))])
-           (make pat:action attrs g sp))]))
-
-(define (create-pat:head headp tailp)
-  (let ([attrs (append-iattrs (map pattern-attrs (list headp tailp)))])
-    (make pat:head attrs headp tailp)))
-
-(define (create-pat:pair headp tailp)
-  (let ([attrs (append-iattrs (map pattern-attrs (list headp tailp)))]
-        [proper? (proper-list-pattern? tailp #t)])
-    (make pat:pair attrs proper? headp tailp)))
-
-(define (create-pat:vector pattern)
-  (make pat:vector (pattern-attrs pattern) pattern))
-
-(define (create-pat:box pattern)
-  (make pat:box (pattern-attrs pattern) pattern))
-
-(define (create-pat:pstruct key pattern)
-  (make pat:pstruct (pattern-attrs pattern) key pattern))
-
-(define (create-pat:describe p description transparent? role)
-  (make pat:describe (pattern-attrs p) p description transparent? role))
-
-(define (create-pat:and patterns)
-  (let ([attrs (append-iattrs (map pattern-attrs patterns))])
-    (make pat:and attrs patterns)))
-
-(define (create-pat:or patterns)
-  (let ([attrs (union-iattrs (map pattern-attrs patterns))])
-    (make pat:or attrs patterns)))
-
-(define (create-pat:not pattern)
-  (make pat:not null pattern))
-
-(define (create-pat:dots headps tailp)
-  (let ([attrs (append-iattrs (map pattern-attrs (cons tailp headps)))])
-    (make pat:dots attrs headps tailp)))
-
-(define (create-pat:delimit pattern)
-  (make pat:delimit (pattern-attrs pattern) pattern))
-
-(define (create-pat:commit pattern)
-  (make pat:commit (pattern-attrs pattern) pattern))
-
-(define (create-pat:post pattern)
-  (make pat:post (pattern-attrs pattern) pattern))
-
-(define (create-pat:integrated name predicate description role)
-  (let ([attrs (if name (list (make attr name 0 #t)) null)])
-    (make pat:integrated attrs name predicate description role)))
-
-;; ----
-
-(define (create-action:cut)
-  (make action:cut null))
-
-(define (create-action:fail condition message)
-  (make action:fail null condition message))
-
-(define (create-action:bind clauses)
-  (make action:bind (map clause:attr-attr clauses) clauses))
-
-(define (create-action:and patterns)
-  (let ([attrs (append-iattrs (map pattern-attrs patterns))])
-    (make action:and attrs patterns)))
-
-(define (create-action:parse pattern expr)
-  (make action:parse (pattern-attrs pattern) pattern expr))
-
-(define (create-action:do stmts)
-  (make action:do null stmts))
-
-(define (create-action:post pattern group index)
-  (make action:post (pattern-attrs pattern) pattern group index))
-
-;; ----
-
-(define (create-hpat:var/p name parser argu nested-attrs attr-count commit? role)
-  (let ([attrs (if name (cons (make attr name 0 #t) nested-attrs) nested-attrs)])
-    (make hpat:var/p attrs name parser argu nested-attrs attr-count commit? role)))
-
-(define (create-hpat:reflect obj argu attr-decls name nested-attrs)
-  (let ([attrs
-         (if name (cons (make attr name 0 #t) nested-attrs) nested-attrs)])
-    (make hpat:reflect attrs obj argu attr-decls name nested-attrs)))
-
-(define (create-hpat:seq lp)
-  (make hpat:seq (pattern-attrs lp) lp))
-
-(define (create-hpat:action g hp)
-  (cond [(action:and? g)
-         (for/fold ([hp hp]) ([g (in-list (reverse (action:and-patterns g)))])
-           (create-hpat:action g hp))]
-        [else
-         (let ([attrs (append-iattrs (map pattern-attrs (list g hp)))])
-           (make hpat:action attrs g hp))]))
-
-(define (create-hpat:describe p description transparent? role)
-  (make hpat:describe (pattern-attrs p) p description transparent? role))
-
-(define (create-hpat:and hp sp)
-  (make hpat:and (append-iattrs (map pattern-attrs (list hp sp))) hp sp))
-
-(define (create-hpat:or patterns)
-  (let ([attrs (union-iattrs (map pattern-attrs patterns))])
-    (make hpat:or attrs patterns)))
-
-(define (create-hpat:delimit pattern)
-  (make hpat:delimit (pattern-attrs pattern) pattern))
-
-(define (create-hpat:commit pattern)
-  (make hpat:commit (pattern-attrs pattern) pattern))
-
-(define (create-hpat:post pattern)
-  (make hpat:post (pattern-attrs pattern) pattern))
-
-(define (create-hpat:peek pattern)
-  (make hpat:peek (pattern-attrs pattern) pattern))
-
-(define (create-hpat:peek-not pattern)
-  (make hpat:peek-not null pattern))
-
-;; ----
+(define (create-hpat:or ps)
+  (define attrss (map pattern-attrs ps))
+  (hpat:or (union-iattrs attrss) ps attrss))
 
 (define (create-ehpat head repc)
   (let* ([iattrs0 (pattern-attrs head)]
@@ -410,22 +333,22 @@ A SideClause is one of
 
 (define (action/head-pattern->list-pattern p)
   (cond [(action-pattern? p)
-         (create-pat:action p (create-pat:any))]
+         (pat:action p (pat:any))]
         [(hpat:seq? p)
          ;; simplification: just extract list pattern from hpat:seq
          (hpat:seq-inner p)]
         [else
-         (create-pat:head p (create-pat:datum '()))]))
+         (pat:head p (pat:datum '()))]))
 
-(define (action-pattern->single-pattern gp)
-  (create-pat:action gp (create-pat:any)))
+(define (action-pattern->single-pattern a)
+  (pat:action a (pat:any)))
 
 (define (proper-list-pattern? p trust-pair?)
   (or (and (pat:datum? p) (eq? (pat:datum-datum p) '()))
       (and (pat:pair? p)
            (if trust-pair?
                (pat:pair-proper? p)
-               (proper-list-pattern? (pat:pair-tail p))))
+               (proper-list-pattern? (pat:pair-tail p) trust-pair?)))
       (and (pat:head? p) (proper-list-pattern? (pat:head-tail p) trust-pair?))
       (and (pat:dots? p) (proper-list-pattern? (pat:dots-tail p) trust-pair?))
       (and (pat:action? p) (proper-list-pattern? (pat:action-inner p) trust-pair?))))
diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt
index 3a9428fa20..7bf23e6569 100644
--- a/racket/collects/syntax/parse/private/rep.rkt
+++ b/racket/collects/syntax/parse/private/rep.rkt
@@ -402,34 +402,29 @@
 
 ;; combine-pattern+sides : Pattern (listof SideClause) -> Pattern
 (define (combine-pattern+sides pattern sides splicing?)
-  (define sides-group (gensym*))
-  (define actions-pattern
-    (create-action:and
-     (for/list ([side (in-list sides)] [index (in-naturals)])
-       (match side
-         [(clause:fail condition message)
-          (create-action:post
-           (create-action:fail condition message)
-           sides-group index)]
-         [(clause:with wpat expr defs)
-          (let ([ap (create-action:post
-                     (create-action:parse wpat expr)
-                     sides-group index)])
-            (if (pair? defs)
-                (create-action:and (list (create-action:do defs) ap))
-                ap))]
-         [(clause:attr attr expr)
-          (create-action:bind (list side))]
-         [(clause:do stmts)
-          (create-action:do stmts)]))))
-  (define dummy-pattern
-    (and (pair? sides)
-         (create-pat:action actions-pattern (create-pat:any))))
-  (if dummy-pattern
-      (if splicing?
-          (create-hpat:and pattern dummy-pattern)
-          (create-pat:and (list pattern dummy-pattern)))
-      pattern))
+  (check-pattern
+   (cond [(pair? sides)
+          (define group (gensym*))
+          (define actions-pattern
+            (action:and
+             (for/list ([side (in-list sides)] [index (in-naturals)])
+               (side-clause->pattern side group index))))
+          (cond [splicing? (hpat:and pattern (pat:action actions-pattern (pat:any)))]
+                [else (pat:and (list pattern (pat:action actions-pattern (pat:any))))])]
+         [else pattern])))
+
+;; side-clause->pattern : SideClause UninternedSymbol Nat -> ActionPattern
+(define (side-clause->pattern side group index)
+  (match side
+    [(clause:fail condition message)
+     (action:post (action:fail condition message) group index)]
+    [(clause:with wpat expr defs)
+     (let ([ap (action:post (action:parse wpat expr) group index)])
+       (if (pair? defs) (action:and (list (action:do defs) ap)) ap))]
+    [(clause:attr attr expr)
+     (action:bind (list side))]
+    [(clause:do stmts)
+     (action:do stmts)]))
 
 ;; gensym* : -> UninternedSymbol
 ;; Like gensym, but with deterministic name from compilation-local counter.
@@ -474,6 +469,7 @@
           [else
            (wrong-syntax stx "action pattern not allowed here")]))
   (define not-shadowed? (make-not-shadowed? decls))
+  (check-pattern
   (syntax-case* stx (~var ~literal ~datum ~and ~or ~not ~rest ~describe
                      ~seq ~optional ~! ~bind ~fail ~parse ~do
                      ~post ~peek ~peek-not ~delimit-cut ~commit ~reflect
@@ -507,7 +503,7 @@
      (and (wildcard? #'wildcard)
           (not-shadowed? #'wildcard))
      (begin (disappeared! stx)
-            (create-pat:any))]
+            (pat:any))]
     [~!
      (disappeared! stx)
      (begin
@@ -515,7 +511,7 @@
          (wrong-syntax stx
                        "cut (~~!) not allowed within ~~not pattern"))
        (check-action!
-        (create-action:cut)))]
+        (action:cut)))]
     [reserved
      (and (reserved? #'reserved)
           (not-shadowed? #'reserved))
@@ -525,7 +521,7 @@
      (parse-pat:id stx decls allow-head?)]
     [datum
      (atomic-datum-stx? #'datum)
-     (create-pat:datum (syntax->datum #'datum))]
+     (pat:datum (syntax->datum #'datum))]
     [(~var . rest)
      (disappeared! stx)
      (parse-pat:var stx decls allow-head?)]
@@ -533,7 +529,7 @@
      (disappeared! stx)
      (syntax-case stx (~datum)
        [(~datum d)
-        (create-pat:datum (syntax->datum #'d))]
+        (pat:datum (syntax->datum #'d))]
        [_ (wrong-syntax stx "bad ~~datum form")])]
     [(~literal . rest)
      (disappeared! stx)
@@ -613,25 +609,25 @@
      (let ([headp (parse-*-pattern #'head decls #t #t)]
            [tailp (parse-single-pattern #'tail decls)])
        (cond [(action-pattern? headp)
-              (create-pat:action headp tailp)]
+              (pat:action headp tailp)]
              [(head-pattern? headp)
-              (create-pat:head headp tailp)]
+              (pat:head headp tailp)]
              [else
-              (create-pat:pair headp tailp)]))]
+              (pat:pair (proper-list-pattern? tailp #t) headp tailp)]))]
     [#(a ...)
      (let ([lp (parse-single-pattern (syntax/loc stx (a ...)) decls)])
-       (create-pat:vector lp))]
+       (pat:vector lp))]
     [b
      (box? (syntax-e #'b))
      (let ([bp (parse-single-pattern (unbox (syntax-e #'b)) decls)])
-       (create-pat:box bp))]
+       (pat:box bp))]
     [s
      (and (struct? (syntax-e #'s)) (prefab-struct-key (syntax-e #'s)))
      (let* ([s (syntax-e #'s)]
             [key (prefab-struct-key s)]
             [contents (struct->list s)])
        (let ([lp (parse-single-pattern (datum->syntax #f contents #'s) decls)])
-         (create-pat:pstruct key lp)))]))
+         (pat:pstruct key lp)))])))
 
 ;; parse-ellipsis-head-pattern : stx DeclEnv -> (listof EllipsisHeadPattern)
 (define (parse-ellipsis-head-pattern stx decls)
@@ -653,7 +649,7 @@
          (let* ([iattrs (id-pattern-attrs (eh-alternative-attrs alt) prefix)]
                 [attr-count (length iattrs)])
            (list (create-ehpat
-                  (create-hpat:var/p #f (eh-alternative-parser alt) no-arguments iattrs attr-count #f #f)
+                  (hpat:var/p #f (eh-alternative-parser alt) no-arguments iattrs attr-count #f #f)
                   (eh-alternative-repc alt))
                  (replace-eh-alternative-attrs
                   alt (iattrs->sattrs iattrs))))))]
@@ -694,7 +690,7 @@
 
 (define (parse-pat:id id decls allow-head?)
   (cond [(declenv-lookup decls id)
-         => (lambda (entry) (parse-pat:id/entry id decls allow-head? entry))]
+         => (lambda (entry) (parse-pat:id/entry id allow-head? entry))]
         [(not (safe-name? id))
          (wrong-syntax id "expected identifier not starting with ~~ character")]
         [else
@@ -702,22 +698,21 @@
            (cond [(stxclass? suffix)
                   (parse-pat:var/sc id allow-head? name suffix no-arguments "." #f #f)]
                  [(or (den:lit? suffix) (den:datum-lit? suffix))
-                  (create-pat:and
-                   (list
-                    (create-pat:svar name)
-                    (parse-pat:id/entry id decls allow-head? suffix)))]
+                  (pat:and
+                   (list (pat:svar name)
+                         (parse-pat:id/entry id allow-head? suffix)))]
                  [(declenv-apply-conventions decls id)
                   => (lambda (entry) (parse-pat:id/entry id allow-head? entry))]
-                 [else (create-pat:svar name)]))]))
+                 [else (pat:svar name)]))]))
 
 ;; parse-pat:id/entry : Identifier .... DeclEntry -> SinglePattern
 ;; Handle when meaning of identifier pattern is given by declenv entry.
 (define (parse-pat:id/entry id allow-head? entry)
   (match entry
     [(den:lit internal literal input-phase lit-phase)
-     (create-pat:literal literal input-phase lit-phase)]
+     (pat:literal literal input-phase lit-phase)]
     [(den:datum-lit internal sym)
-     (create-pat:datum sym)]
+     (pat:datum sym)]
     [(den:magic-class name class argu role)
      (let* ([pos-count (length (arguments-pargs argu))]
             [kws (arguments-kws argu)]
@@ -769,14 +764,14 @@
   (cond [(and (epsilon? name0) (not scname))
          (wrong-syntax name0 "illegal pattern variable name")]
         [(and (wildcard? name0) (not scname))
-         (create-pat:any)]
+         (pat:any)]
         [scname
          (let ([sc (get-stxclass/check-arity scname sc+args-stx
                                              (length (arguments-pargs argu))
                                              (arguments-kws argu))])
            (parse-pat:var/sc stx allow-head? name0 sc argu pfx role #f))]
         [else ;; Just proper name
-         (create-pat:svar name0)]))
+         (pat:svar name0)]))
 
 (define (parse-pat:var/sc stx allow-head? name sc argu pfx role parser*)
   ;; if parser* not #f, overrides sc parser
@@ -807,18 +802,18 @@
 (define (parse-pat:id/s name parser argu attrs commit? pfx role)
   (define prefix (name->prefix name pfx))
   (define bind (name->bind name))
-  (create-pat:var/p bind parser argu (id-pattern-attrs attrs prefix) (length attrs) commit? role))
+  (pat:var/p bind parser argu (id-pattern-attrs attrs prefix) (length attrs) commit? role))
 
 (define (parse-pat:id/s/integrate name integrate role)
   (define bind (name->bind name))
   (let ([predicate (integrate-predicate integrate)]
         [description (integrate-description integrate)])
-    (create-pat:integrated bind predicate description role)))
+    (pat:integrated bind predicate description role)))
 
 (define (parse-pat:id/h name parser argu attrs commit? pfx role)
   (define prefix (name->prefix name pfx))
   (define bind (name->bind name))
-  (create-hpat:var/p bind parser argu (id-pattern-attrs attrs prefix) (length attrs) commit? role))
+  (hpat:var/p bind parser argu (id-pattern-attrs attrs prefix) (length attrs) commit? role))
 
 (define (name->prefix id pfx)
   (cond [(wildcard? id) #f]
@@ -866,7 +861,7 @@
            [_ (raise-syntax-error #f "bad syntax" stx)]))
        (define prefix (name->prefix #'name "."))
        (define bind (name->bind #'name))
-       (define ctor (if splicing? create-hpat:reflect create-pat:reflect))
+       (define ctor (if splicing? hpat:reflect pat:reflect))
        (ctor #'obj (parse-argu (syntax->list #'(arg ...))) attr-decls bind
              (id-pattern-attrs attr-decls prefix)))]))
 
@@ -883,7 +878,7 @@
             [phase (options-select-value chunks '#:phase
                                          #:default #'(syntax-local-phase-level))])
        ;; FIXME: Duplicates phase expr!
-       (create-pat:literal #'lit phase phase))]
+       (pat:literal #'lit phase phase))]
     [_
      (wrong-syntax stx "bad ~~literal pattern")]))
 
@@ -900,8 +895,8 @@
          [(description pattern)
           (let ([p (parse-*-pattern #'pattern decls allow-head? #f)])
             (if (head-pattern? p)
-                (create-hpat:describe p #'description transparent? role)
-                (create-pat:describe p #'description transparent? role)))]))]))
+                (hpat:describe p #'description transparent? role)
+                (pat:describe p #'description transparent? role)))]))]))
 
 (define (parse-pat:delimit stx decls allow-head?)
   (syntax-case stx ()
@@ -909,8 +904,8 @@
      (let ([p (parameterize ((cut-allowed? #t))
                 (parse-*-pattern #'pattern decls allow-head? #f))])
        (if (head-pattern? p)
-           (create-hpat:delimit p)
-           (create-pat:delimit p)))]))
+           (hpat:delimit p)
+           (pat:delimit p)))]))
 
 (define (parse-pat:commit stx decls allow-head?)
   (syntax-case stx ()
@@ -918,8 +913,8 @@
      (let ([p (parameterize ((cut-allowed? #t))
                 (parse-*-pattern #'pattern decls allow-head? #f))])
        (if (head-pattern? p)
-           (create-hpat:commit p)
-           (create-pat:commit p)))]))
+           (hpat:commit p)
+           (pat:commit p)))]))
 
 (define (split-prefix xs pred)
   (let loop ([xs xs] [rprefix null])
@@ -935,7 +930,7 @@
   (define-values (actions patterns) (split-prefix patterns0 action-pattern?))
   (cond [(null? patterns)
          (cond [allow-action?
-                (create-action:and actions)]
+                (action:and actions)]
                [allow-head?
                 (wrong-syntax stx "expected at least one head pattern")]
                [else
@@ -944,9 +939,9 @@
          (let ([p (parse-pat:and* stx patterns)])
            (if (head-pattern? p)
                (for/fold ([p p]) ([action (in-list (reverse actions))])
-                 (create-hpat:action action p))
+                 (hpat:action action p))
                (for/fold ([p p]) ([action (in-list (reverse actions))])
-                 (create-pat:action action p))))]))
+                 (pat:action action p))))]))
 
 (define (parse-pat:and* stx patterns)
   ;; patterns is non-empty (empty case handled above)
@@ -962,9 +957,9 @@
               "single-term pattern not allowed after head pattern")))
          (let ([p0 (car patterns)]
                [lps (map action/head-pattern->list-pattern (cdr patterns))])
-           (create-hpat:and p0 (create-pat:and lps)))]
+           (hpat:and p0 (pat:and lps)))]
         [else
-         (create-pat:and
+         (pat:and
           (for/list ([p (in-list patterns)])
             (if (action-pattern? p)
                 (action-pattern->single-pattern p)
@@ -985,7 +980,7 @@
     [(_ pattern)
      (let ([p (parameterize ((cut-allowed? #f))
                 (parse-single-pattern #'pattern decls))])
-       (create-pat:not p))]
+       (pat:not p))]
     [_
      (wrong-syntax stx "expected a single subpattern")]))
 
@@ -993,7 +988,7 @@
   (define pattern (parse-single-pattern list-stx decls))
   (unless (proper-list-pattern? pattern #t)
     (wrong-syntax stx "expected proper list pattern"))
-  (create-hpat:seq pattern))
+  (hpat:seq pattern))
 
 (define (parse-cdr-patterns stx decls allow-head? allow-action?)
   (unless (stx-list? stx)
@@ -1010,21 +1005,19 @@
   (define tailp (parse-single-pattern tail decls))
   (unless (pair? headps)
     (wrong-syntax head "expected at least one pattern"))
-  (create-pat:dots headps tailp))
+  (pat:dots headps tailp))
 
 (define (parse-pat:plus-dots stx head tail decls)
   (define headp (parse-head-pattern head decls))
   (define tailp (parse-single-pattern tail decls))
   (define head/rep (create-ehpat headp (make-rep:bounds 1 +inf.0 #f #f #f)))
-  (create-pat:dots (list head/rep) tailp))
+  (pat:dots (list head/rep) tailp))
 
 (define (parse-pat:bind stx decls)
   (syntax-case stx ()
     [(_ clause ...)
      (let ([clauses (check-bind-clause-list #'(clause ...) stx)])
-       (make action:bind
-         (append-iattrs (side-clauses-attrss clauses))
-         clauses))]))
+       (action:bind clauses))]))
 
 (define (parse-pat:fail stx decls)
   (syntax-case stx ()
@@ -1043,9 +1036,9 @@
                         #`(not #,(caddr chunk)))))])
          (syntax-case rest ()
            [(message)
-            (create-action:fail condition #'message)]
+            (action:fail condition #'message)]
            [()
-            (create-action:fail condition #''#f)]
+            (action:fail condition #''#f)]
            [_
             (wrong-syntax stx "bad ~~fail pattern")])))]))
 
@@ -1054,39 +1047,38 @@
     [(_ pattern)
      (let ([p (parse-*-pattern #'pattern decls allow-head? allow-action?)])
        (cond [(action-pattern? p)
-              (cond [allow-action? (create-action:post p #f 0)]
-                    [(not allow-head?) (create-pat:post (action-pattern->single-pattern p))]
+              (cond [allow-action? (action:post p #f 0)]
+                    [(not allow-head?) (pat:post (action-pattern->single-pattern p))]
                     [else (wrong-syntax stx "action pattern not allowed here")])]
              [(head-pattern? p)
-              (cond [allow-head? (create-hpat:post p)]
+              (cond [allow-head? (hpat:post p)]
                     [else (wrong-syntax stx "head pattern now allowed here")])]
-             [else
-              (create-pat:post p)]))]))
+             [else (pat:post p)]))]))
 
 (define (parse-pat:peek stx decls)
   (syntax-case stx ()
     [(_ pattern)
      (let ([p (parse-head-pattern #'pattern decls)])
-       (create-hpat:peek p))]))
+       (hpat:peek p))]))
 
 (define (parse-pat:peek-not stx decls)
   (syntax-case stx ()
     [(_ pattern)
      (let ([p (parse-head-pattern #'pattern decls)])
-       (create-hpat:peek-not p))]))
+       (hpat:peek-not p))]))
 
 (define (parse-pat:parse stx decls)
   (syntax-case stx ()
     [(_ pattern expr)
      (let ([p (parse-single-pattern #'pattern decls)])
-       (create-action:parse p #'expr))]
+       (action:parse p #'expr))]
     [_
      (wrong-syntax stx "bad ~~parse pattern")]))
 
 (define (parse-pat:do stx decls)
   (syntax-case stx ()
     [(_ stmt ...)
-     (create-action:do (syntax->list #'(stmt ...)))]
+     (action:do (syntax->list #'(stmt ...)))]
     [_
      (wrong-syntax stx "bad ~~do pattern")]))
 
@@ -1098,10 +1090,13 @@
 (define (parse-hpat:optional stx decls)
   (define-values (head-stx head iattrs _name _tmm defaults)
     (parse*-optional-pattern stx decls h-optional-directive-table))
-  (make hpat:optional iattrs head defaults))
+  (create-hpat:or
+   (list head
+         (hpat:action (action:bind defaults)
+                      (hpat:seq (pat:datum '()))))))
 
 ;; parse*-optional-pattern : stx DeclEnv table
-;;                        -> (values 
+;;                        -> (values Syntax HeadPattern IAttrs Stx Stx Defaults)
 (define (parse*-optional-pattern stx decls optional-directive-table)
   (syntax-case stx ()
     [(_ p . options)