From 491808e717ea05fa63dceed0462d3cb771d51a11 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Sun, 20 Sep 2009 20:47:54 +0000
Subject: [PATCH] syntax/parse:   separated ~!, ~bind, ~fail as "action
 patterns", documented   docs use eg "single-term pattern" instead of
 "S-pattern" in text

svn: r16089
---
 collects/syntax/private/stxparse/parse.ss     |  37 +-
 .../syntax/private/stxparse/rep-patterns.ss   | 166 +++--
 collects/syntax/private/stxparse/rep.ss       | 207 +++---
 .../syntax/scribblings/parse-patterns.scrbl   | 599 ++++++++++--------
 collects/syntax/scribblings/parse.scrbl       |  24 +-
 5 files changed, 598 insertions(+), 435 deletions(-)

diff --git a/collects/syntax/private/stxparse/parse.ss b/collects/syntax/private/stxparse/parse.ss
index ac8c93a26f..a4462947f3 100644
--- a/collects/syntax/private/stxparse/parse.ss
+++ b/collects/syntax/private/stxparse/parse.ss
@@ -227,6 +227,8 @@
               (fail x
                     #:expect (expectation pattern0)
                     #:fce fc))]
+       [#s(pat:ghost attrs ghost subpattern)
+        #'(parse:G x fc ghost (parse:S x fc subpattern k))]
        [#s(pat:head attrs head tail)
         #`(parse:H x fc head rest index
                    (parse:S rest #,(frontier:add-index (wash #'fc) #'index) tail k))]
@@ -269,9 +271,6 @@
                       (fail x
                             #:expect (expectation pattern0)
                             #:fce fc))))))]
-       [#s(pat:cut attrs pattern)
-        #`(with-enclosing-fail enclosing-cut-fail
-            (parse:S x fc pattern k))]
        [#s(pat:describe attrs description transparent? pattern)
         #`(let ([previous-fail enclosing-fail]
                 [previous-cut-fail enclosing-cut-fail])
@@ -283,15 +282,7 @@
               (parse:S x #,(empty-frontier #'x) pattern
                        (with-enclosing-cut-fail previous-cut-fail
                          (with-enclosing-fail previous-fail
-                           k)))))]
-       [#s(pat:bind _ clauses)
-        #'(convert-sides x clauses (clause-success () k))]
-       [#s(pat:fail _ condition message)
-        #`(if condition
-              (fail x
-                    #:expect (expectation pattern0)
-                    #:fce fc)
-              k)])]))
+                           k)))))])]))
 
 ;; (parse:S* (id ...) (FCE ...) (SinglePattern ...) expr) : expr
 (define-syntax parse:S*
@@ -323,6 +314,23 @@
                (let ([sub-id alt-sub-id] ...)
                  (success pre ... id ...))))))]))
 
+
+;; (parse:G id FCE SinglePattern expr) : expr
+(define-syntax (parse:G stx)
+  (syntax-case stx ()
+    [(parse:G x fc pattern0 k)
+     (syntax-case #'pattern0 ()
+       [#s(ghost:cut _)
+        #`(with-enclosing-fail enclosing-cut-fail k)]
+       [#s(ghost:bind _ clauses)
+        #`(convert-sides x clauses (clause-success () k))]
+       [#s(ghost:fail _ condition message)
+        #`(if condition
+              (fail x
+                    #:expect (expectation pattern0)
+                    #:fce fc)
+              k)])]))
+
 (begin-for-syntax
  ;; convert-list-pattern : ListPattern id -> SinglePattern
  ;; Converts '() datum pattern at end of list to bind (cons stx index)
@@ -560,11 +568,10 @@
     ;; #'(make-expect:pair)]
     [(_ #s(pat:compound attrs kind0 (part-pattern ...)))
      #''ineffable]
-    [(_ #s(pat:fail _ condition message))
-     #'(expectation-of-message message)]
     [(_ #s(pat:not _ pattern))
      #''ineffable]
-    ))
+    [(_ #s(ghost:fail _ condition message))
+     #'(expectation-of-message message)]))
 
 ;; ----
 
diff --git a/collects/syntax/private/stxparse/rep-patterns.ss b/collects/syntax/private/stxparse/rep-patterns.ss
index 3920040025..796e8de40c 100644
--- a/collects/syntax/private/stxparse/rep-patterns.ss
+++ b/collects/syntax/private/stxparse/rep-patterns.ss
@@ -7,77 +7,85 @@
 (provide (all-defined-out))
 
 #|
-A PBase/HPBase/EHPBase is (listof IAttr)
+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.
-
-An IdPrefix is an identifier/#f
-If #f, it means bind no attributes
-If identifier, it already includes the colon part, unless epsilon
 |#
 
-
 #|
 A SinglePattern is one of
-  (make-pat:any SPBase)
-  (make-pat:var SPBase id id (listof stx) (listof IAttr))
-  (make-pat:datum SPBase datum)
-  (make-pat:literal SPBase identifier)
-  (make-pat:head SPBase HeadPattern SinglePattern)
-  (make-pat:dots SPBase (listof EllipsisHeadPattern) SinglePattern)
-  (make-pat:and SPBase (listof SinglePattern))
-  (make-pat:or SPBase (listof SinglePattern))
-  (make-pat:not SPBase SinglePattern)
-  (make-pat:compound SPBase Kind (listof SinglePattern))
-  (make-pat:cut SPBase SinglePattern)
-  (make-pat:describe SPBase stx boolean SinglePattern)
-  (make-pat:fail SPBase stx stx)
-  (make-pat:bind SPBase (listof clause:attr))
+  (make-pat:any Base)
+  (make-pat:var Base id id (listof stx) (listof IAttr))
+  (make-pat:literal Base identifier)
+  (make-pat:datum Base datum)
+  (make-pat:ghost Base GhostPattern SinglePattern)
+  (make-pat:head Base HeadPattern SinglePattern)
+  (make-pat:dots Base (listof EllipsisHeadPattern) SinglePattern)
+  (make-pat:and Base (listof SinglePattern))
+  (make-pat:or Base (listof SinglePattern))
+  (make-pat:not Base SinglePattern)
+  (make-pat:compound Base Kind (listof SinglePattern))
+  (make-pat:describe Base stx boolean SinglePattern)
 
 A ListPattern is a subtype of SinglePattern; one of
-  (make-pat:datum SPBase '())
-  (make-pat:head SPBase HeadPattern ListPattern)
-  (make-pat:compound SPBase '#:pair (list SinglePattern ListPattern))
-  (make-pat:dots SPBase EllipsisHeadPattern SinglePattern)
-  (make-pat:cut SPBase ListPattern)
+  (make-pat:datum Base '())
+  (make-pat:ghost Base GhostPattern ListPattern)
+  (make-pat:head Base HeadPattern ListPattern)
+  (make-pat:compound Base '#:pair (list SinglePattern ListPattern))
+  (make-pat:dots Base EllipsisHeadPattern SinglePattern)
 |#
 
 (define-struct pat:any (attrs) #:prefab)
 (define-struct pat:var (attrs name parser args nested-attrs) #:prefab)
-(define-struct pat:datum (attrs datum) #:prefab)
 (define-struct pat:literal (attrs id) #:prefab)
+(define-struct pat:datum (attrs datum) #:prefab)
+(define-struct pat:ghost (attrs ghost 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:compound (attrs kind patterns) #:prefab)
-(define-struct pat:cut (attrs pattern) #:prefab)
 (define-struct pat:describe (attrs description transparent? pattern) #:prefab)
-(define-struct pat:fail (attrs when message) #:prefab)
-(define-struct pat:bind (attrs clauses) #:prefab)
+
+#|
+A GhostPattern is one of
+  (make-ghost:cut Base)
+  (make-ghost:fail Base stx stx)
+  (make-ghost:bind Base (listof clause:attr))
+* (make-ghost:and Base (listof GhostPattern))
+
+ghost:and is desugared below in create-* procedures
+|#
+
+(define-struct ghost:cut (attrs) #:prefab)
+(define-struct ghost:fail (attrs when message) #:prefab)
+(define-struct ghost:bind (attrs clauses) #:prefab)
+(define-struct ghost:and (attrs patterns) #:prefab)
 
 #|
 A HeadPattern is one of 
-  (make-hpat:var SPBase id id (listof stx) (listof IAttr))
-  (make-hpat:seq HPBase ListPattern)
-  (make-hpat:and HPBase HeadPattern SinglePattern)
-  (make-hpat:or HPBase (listof HeadPattern))
-  (make-hpat:describe HPBase stx/#f boolean HeadPattern)
-  (make-hpat:optional HPBase HeadPattern (listof clause:attr))
+  (make-hpat:var Base id id (listof stx) (listof IAttr))
+  (make-hpat:seq Base ListPattern)
+  (make-hpat:ghost Base GhostPattern HeadPattern)
+  (make-hpat:and Base HeadPattern SinglePattern)
+  (make-hpat:or Base (listof HeadPattern))
+  (make-hpat:optional Base HeadPattern (listof clause:attr))
+  (make-hpat:describe Base stx/#f boolean HeadPattern)
 |#
 
 (define-struct hpat:var (attrs name parser args nested-attrs) #:prefab)
 (define-struct hpat:seq (attrs inner) #:prefab)
-(define-struct hpat:or (attrs patterns) #:prefab)
+(define-struct hpat:ghost (attrs ghost inner) #:prefab)
 (define-struct hpat:and (attrs head single) #:prefab)
-(define-struct hpat:describe (attrs description transparent? pattern) #:prefab)
+(define-struct hpat:or (attrs patterns) #:prefab)
 (define-struct hpat:optional (attrs inner defaults) #:prefab)
+(define-struct hpat:describe (attrs description transparent? pattern) #:prefab)
 
 #|
 An EllipsisHeadPattern is
-  (make-ehpat EHPBase HeadPattern RepConstraint)
+  (make-ehpat Base HeadPattern RepConstraint)
 
 A RepConstraint is one of
   (make-rep:once stx stx stx)
@@ -85,6 +93,7 @@ A RepConstraint is one of
   (make-rep:bounds nat/#f nat/#f stx stx stx)
   #f
 |#
+
 (define-struct ehpat (attrs head repc) #:prefab)
 (define-struct rep:once (name under-message over-message) #:prefab)
 (define-struct rep:optional (name over-message defaults) #:prefab)
@@ -102,26 +111,31 @@ A Kind is one of
 (define (pattern? x)
   (or (pat:any? x)
       (pat:var? x)
-      (pat:datum? x)
       (pat:literal? x)
+      (pat:datum? x)
+      (pat:ghost? x)
       (pat:head? x)
       (pat:dots? x)
       (pat:and? x)
       (pat:or? x)
       (pat:not? x)
       (pat:compound? x)
-      (pat:cut? x)
-      (pat:describe? x)
-      (pat:bind? x)
-      (pat:fail? x)))
+      (pat:describe? x)))
+
+(define (ghost-pattern? x)
+  (or (ghost:cut? x)
+      (ghost:bind? x)
+      (ghost:fail? x)
+      (ghost:and? x)))
 
 (define (head-pattern? x)
   (or (hpat:var? x)
       (hpat:seq? x)
+      (hpat:ghost? x)
       (hpat:and? x)
       (hpat:or? x)
-      (hpat:describe? x)
-      (hpat:optional? x)))
+      (hpat:optional? x)
+      (hpat:describe? x)))
 
 (define (ellipsis-head-pattern? x)
   (ehpat? x))
@@ -147,10 +161,10 @@ A Kind is one of
            #'(lambda (x)
                (cond [(pred x) (accessor x)] ...
                      [else (raise-type-error 'pattern-attrs "pattern" x)])))]))
-    (mk-get-attrs pat:any pat:var pat:datum pat:literal pat:head pat:dots
-                  pat:and pat:or pat:not pat:compound
-                  pat:cut pat:describe pat:bind pat:fail
-                  hpat:var hpat:seq hpat:and hpat:or hpat:describe
+    (mk-get-attrs pat:any pat:var pat:datum pat:literal pat:ghost pat:head
+                  pat:dots pat:and pat:or pat:not pat:compound pat:describe
+                  ghost:cut ghost:bind ghost:fail ghost:and
+                  hpat:var hpat:seq hpat:ghost hpat:and hpat:or hpat:describe
                   hpat:optional
                   ehpat)))
 
@@ -174,12 +188,21 @@ A Kind is one of
 (define (create-pat:literal literal)
   (make pat:literal null literal))
 
+(define (create-pat:ghost g sp)
+  (cond [(ghost:and? g)
+         (for/fold ([sp sp]) ([g (reverse (ghost:and-patterns g))])
+           (create-pat:ghost g sp))]
+        [else
+         (let ([attrs (append-iattrs (map pattern-attrs (list g sp)))])
+           (make pat:ghost 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:compound kind ps)
   (make pat:compound (append-iattrs (map pattern-attrs ps)) kind ps))
 
-(define (create-pat:cut inner)
-  (make pat:cut (pattern-attrs inner) inner))
-
 (define (create-pat:describe description transparent? p)
   (make pat:describe (pattern-attrs p) description transparent? p))
 
@@ -198,12 +221,17 @@ A Kind is one of
   (let ([attrs (append-iattrs (map pattern-attrs (cons tailp headps)))])
     (make pat:dots attrs headps tailp)))
 
-(define (create-pat:fail condition message)
-  (make pat:fail null condition message))
+;; ----
 
-(define (create-pat:head headp tailp)
-  (let ([attrs (append-iattrs (map pattern-attrs (list headp tailp)))])
-    (make pat:head attrs headp tailp)))
+(define (create-ghost:cut)
+  (make ghost:cut null))
+
+(define (create-ghost:fail condition message)
+  (make ghost:fail null condition message))
+
+(define (create-ghost:and patterns)
+  (let ([attrs (append-iattrs (map pattern-attrs patterns))])
+    (make ghost:and attrs patterns)))
 
 ;; ----
 
@@ -215,6 +243,14 @@ A Kind is one of
 (define (create-hpat:seq lp)
   (make hpat:seq (pattern-attrs lp) lp))
 
+(define (create-hpat:ghost g hp)
+  (cond [(ghost:and? g)
+         (for/fold ([hp hp]) ([g (reverse (ghost:and-patterns g))])
+           (create-hpat:ghost g hp))]
+        [else
+         (let ([attrs (append-iattrs (map pattern-attrs (list g hp)))])
+           (make hpat:ghost attrs g hp))]))
+
 (define (create-hpat:describe description transparent? p)
   (make hpat:describe (pattern-attrs p) description transparent? p))
 
@@ -227,8 +263,14 @@ A Kind is one of
 
 ;; ----
 
-(define (head-pattern->list-pattern hp)
-  ;; simplification: just extract list pattern from hpat:seq
-  (if (hpat:seq? hp)
-      (hpat:seq-inner hp)
-      (create-pat:head hp (create-pat:datum '()))))
+(define (ghost/head-pattern->list-pattern p)
+  (cond [(ghost-pattern? p)
+         (create-pat:ghost p (create-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 '()))]))
+
+(define (ghost-pattern->single-pattern gp)
+  (create-pat:ghost gp (create-pat:any)))
diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss
index b7d821ff0a..64d4076d4f 100644
--- a/collects/syntax/private/stxparse/rep.ss
+++ b/collects/syntax/private/stxparse/rep.ss
@@ -259,50 +259,84 @@
 
 ;; parse-single-pattern : stx DeclEnv -> SinglePattern
 (define (parse-single-pattern stx decls)
+  ;; FIXME: allow ghosts, convert to single-term pattern???
+  (let ([p (parse-*-pattern stx decls #f #f)])
+    p))
+
+;; parse-head-pattern : stx DeclEnv -> HeadPattern
+(define (parse-head-pattern stx decls)
+  (parse-*-pattern stx decls #t #f))
+
+;; parse-*-pattern : stx DeclEnv boolean boolean -> Pattern
+(define (parse-*-pattern stx decls allow-head? allow-ghost?)
+  (define (check-head! x)
+    (unless allow-head?
+      (wrong-syntax stx "head pattern not allowed here"))
+    x)
+  (define (check-ghost! x)
+    ;; Coerce to S-pattern IF only S-patterns allowed
+    (cond [allow-ghost? x]
+          [(not allow-head?) (ghost-pattern->single-pattern x)]
+          [else
+           (wrong-syntax stx "action pattern not allowed here")]))
   (syntax-case stx (~var ~literal ~and ~or ~not ~rest ~struct
-                    ~! ~describe ~bind ~fail)
+                    ~! ~describe ~bind ~fail ~seq ~optional)
     [wildcard
      (wildcard? #'wildcard)
      (create-pat:any)]
+    [~!
+     (check-ghost!
+      (create-ghost:cut))]
     [reserved
      (reserved? #'reserved)
-     (wrong-syntax stx "not allowed here")]
+     (wrong-syntax stx "pattern keyword not allowed here")]
     [id
      (identifier? #'id)
-     (parse-pat:id stx decls #f)]
+     (parse-pat:id stx decls allow-head?)]
     [datum
      (atomic-datum? #'datum)
      (create-pat:datum (syntax->datum #'datum))]
     [(~var . rest)
-     (parse-pat:var stx decls #f)]
+     (parse-pat:var stx decls allow-head?)]
     [(~literal . rest)
      (parse-pat:literal stx decls)]
     [(~and . rest)
-     (parse-pat:and stx decls #f)]
+     (parse-pat:and stx decls allow-head? allow-ghost?)]
     [(~or . rest)
-     (parse-pat:or stx decls #f)]
+     (parse-pat:or stx decls allow-head?)]
     [(~not . rest)
      (parse-pat:not stx decls)]
+    [(~rest . rest)
+     (parse-pat:rest stx decls)]
+    [(~describe . rest)
+     (parse-pat:describe stx decls allow-head?)]
+    [(~seq . rest)
+     (check-head!
+      (parse-hpat:seq stx #'rest decls))]
+    [(~optional . rest)
+     (check-head!
+      (parse-hpat:optional stx decls))]
+    [(~bind . rest)
+     (check-ghost!
+      (parse-pat:bind stx decls))]
+    [(~fail . rest)
+     (check-ghost!
+      (parse-pat:fail stx decls))]
     [(head dots . tail)
      (dots? #'dots)
      (parse-pat:dots stx #'head #'tail decls)]
-    [(~struct key . contents)
-     (let ([lp (parse-single-pattern (syntax/loc stx contents) decls)]
-           [key (syntax->datum #'key)])
-       (create-pat:compound `(#:pstruct ,key) (list lp)))]
-    [(~! . rest)
-     (let ([inner (parse-single-pattern (syntax/loc stx rest) decls)])
-       (create-pat:cut inner))]
-    [(~describe . rest)
-     (parse-pat:describe stx decls #f)]
-    [(~bind . rest)
-     (parse-pat:bind stx decls)]
-    [(~fail . rest)
-     (parse-pat:fail stx decls)]
-    [(~rest . rest)
-     (parse-pat:rest stx decls)]
     [(head . tail)
-     (parse-pat:pair stx #'head #'tail decls)]
+     (let ([headp (parse-*-pattern #'head decls #t #t)]
+           [tailp (parse-single-pattern #'tail decls)])
+       ;; Only make pat:head if head is complicated;
+       ;; otherwise simple compound/pair
+       ;; FIXME: Could also inline ~seq patterns from head...?
+       (cond [(ghost-pattern? headp)
+              (create-pat:ghost headp tailp)]
+             [(head-pattern? headp)
+              (create-pat:head headp tailp)]
+             [else
+              (create-pat:compound '#:pair (list headp tailp))]))]
     [#(a ...)
      (let ([lp (parse-single-pattern (syntax/loc stx (a ...)) decls)])
        (create-pat:compound '#:vector (list lp)))]
@@ -318,27 +352,6 @@
        (let ([lp (parse-single-pattern (datum->syntax #f contents #'s) decls)])
          (create-pat:compound `(#:pstruct ,key) (list lp))))]))
 
-;; parse-head-pattern : stx DeclEnv -> HeadPattern
-(define (parse-head-pattern stx decls)
-  (syntax-case stx (~var ~and ~or ~seq ~describe ~optional)
-    [id
-     (and (identifier? #'id) (not (reserved? #'id)))
-     (parse-pat:id stx decls #t)]
-    [(~var . rest)
-     (parse-pat:var stx decls #t)]
-    [(~and . rest)
-     (parse-pat:and stx decls #t)]
-    [(~or . rest)
-     (parse-pat:or stx decls #t)]
-    [(~seq . rest)
-     (parse-hpat:seq stx #'rest decls)]
-    [(~describe . rest)
-     (parse-pat:describe stx decls #t)]
-    [(~optional . rest)
-     (parse-hpat:optional stx decls)]
-    [_
-     (parse-single-pattern stx decls)]))
-
 ;; parse-ellipsis-head-pattern : stx DeclEnv number -> EllipsisHeadPattern
 (define (parse-ellipsis-head-pattern stx decls)
   (syntax-case stx (~bounds ~optional ~once)
@@ -374,10 +387,9 @@
     [(list 'splicing-parser parser description attrs)
      (parse-pat:id/h id parser null attrs)]
     [#f
-     #|
-     (unless (safe-name? id)
-       (wrong-syntax id "expected identifier not starting with ~ character"))
-     |#
+     (when #f ;; FIXME: enable?
+       (unless (safe-name? id)
+         (wrong-syntax id "expected identifier not starting with ~ character")))
      (let-values ([(name sc) (split-id/get-stxclass id decls)])
        (if sc
            (parse-pat:var* id allow-head? name sc null)
@@ -486,11 +498,60 @@
        (define transparent? (and (assq '#:transparent chunks) #t))
        (syntax-case rest ()
          [(description pattern)
-          (let ([p (parse-some-pattern #'pattern decls allow-head?)])
+          (let ([p (parse-*-pattern #'pattern decls allow-head? #f)])
             (if (head-pattern? p)
                 (create-hpat:describe #'description transparent? p)
                 (create-pat:describe #'description transparent? p)))]))]))
 
+(define (split-prefix xs pred)
+  (let loop ([xs xs] [rprefix null])
+    (cond [(and (pair? xs) (pred (car xs)))
+           (loop (cdr xs) (cons (car xs) rprefix))]
+          [else
+           (values (reverse rprefix) xs)])))
+
+(define (parse-pat:and stx decls allow-head? allow-ghost?)
+  ;; allow-ghost? = allowed to *return* pure ghost pattern;
+  ;; all ~and patterns are allowed to *contain* ghost patterns
+  (define patterns0 (parse-cdr-patterns stx decls allow-head? #t))
+  (define-values (ghosts patterns) (split-prefix patterns0 ghost-pattern?))
+  (cond [(null? patterns)
+         (cond [allow-ghost?
+                (create-ghost:and ghosts)]
+               [allow-head?
+                (wrong-syntax stx "expected at least one head pattern")]
+               [else
+                (wrong-syntax stx "expected at least one single-term pattern")])]
+        [else
+         (let ([p (parse-pat:and* stx patterns)])
+           (if (head-pattern? p)
+               (for/fold ([p p]) ([ghost (reverse ghosts)])
+                 (create-hpat:ghost ghost p))
+               (for/fold ([p p]) ([ghost (reverse ghosts)])
+                 (create-pat:ghost ghost p))))]))
+
+(define (parse-pat:and* stx patterns)
+  ;; patterns is non-empty (empty case handled above)
+  (cond [(null? (cdr patterns))
+         (car patterns)]
+        [(ormap head-pattern? patterns)
+         ;; Check to make sure *all* are head patterns
+         (for ([pattern patterns]
+               [pattern-stx (stx->list (stx-cdr stx))])
+           (unless (or (ghost-pattern? pattern) (head-pattern? pattern))
+             (wrong-syntax
+              pattern-stx
+              "single-term pattern not allowed after head pattern")))
+         (let ([p0 (car patterns)]
+               [lps (map ghost/head-pattern->list-pattern (cdr patterns))])
+           (create-hpat:and p0 (create-pat:and lps)))]
+        [else
+         (create-pat:and
+          (for/list ([p patterns])
+            (if (ghost-pattern? p)
+                (ghost-pattern->single-pattern p)
+                p)))]))
+
 (define (parse-pat:or stx decls allow-head?)
   (define patterns (parse-cdr-patterns stx decls allow-head? #f))
   (cond [(null? (cdr patterns))
@@ -501,24 +562,6 @@
                [else
                 (create-pat:or patterns)])]))
 
-(define (parse-pat:and stx decls allow-head?)
-  (define patterns (parse-cdr-patterns stx decls allow-head? #t))
-  (cond [(null? (cdr patterns))
-         (car patterns)]
-        [(ormap head-pattern? patterns)
-         ;; Check to make sure *all* are head patterns
-         (for ([pattern patterns]
-               [pattern-stx (stx->list (stx-cdr stx))])
-           (unless (head-pattern? pattern)
-             (wrong-syntax
-              pattern-stx
-              "single-term pattern not allowed after head pattern")))
-         (let ([p0 (car patterns)]
-               [lps (map head-pattern->list-pattern (cdr patterns))])
-           (create-hpat:and p0 (create-pat:and lps)))]
-        [else
-         (create-pat:and patterns)]))
-
 (define (parse-pat:not stx decls)
   (syntax-case stx (~not)
     [(~not pattern)
@@ -532,31 +575,16 @@
   (check-list-pattern pattern stx)
   (create-hpat:seq pattern))
 
-(define (parse-cdr-patterns stx decls allow-head? allow-cut?)
+(define (parse-cdr-patterns stx decls allow-head? allow-ghost?)
   (unless (stx-list? stx)
     (wrong-syntax stx "expected sequence of patterns"))
   (let ([result
          (for/list ([sub (cdr (stx->list stx))])
-           (if allow-cut?
-               (or (parse-cut-in-and sub)
-                   (parse-some-pattern sub decls allow-head?))
-               (parse-some-pattern sub decls allow-head?)))])
+           (parse-*-pattern sub decls allow-head? allow-ghost?))])
     (when (null? result)
       (wrong-syntax stx "expected at least one pattern"))
     result))
 
-(define (parse-cut-in-and stx)
-  (syntax-case stx (~!)
-    [~! (create-pat:cut (create-pat:any))]
-    [_ #f]))
-
-(define (parse-some-pattern stx decl allow-head?)
-  (define p (parse-head-pattern stx decl))
-  (when (head-pattern? p)
-    (unless allow-head?
-      (wrong-syntax stx "head pattern not allowed here")))
-  p)
-
 (define (parse-pat:dots stx head tail decls)
   (define headps
     (syntax-case head (~or)
@@ -577,7 +605,7 @@
   (syntax-case stx ()
     [(_ clause ...)
      (let ([clauses (check-bind-clause-list #'(clause ...) stx)])
-       (make pat:bind
+       (make ghost:bind
          (append-iattrs (side-clauses-attrss clauses))
          clauses))]))
 
@@ -598,7 +626,7 @@
                         #`(not #,(caddr chunk)))))])
          (syntax-case rest ()
            [(message)
-            (create-pat:fail condition #'message)]
+            (create-ghost:fail condition #'message)]
            [()
             (wrong-syntax stx "missing message expression")]
            [_
@@ -609,15 +637,6 @@
     [(_ pattern)
      (parse-single-pattern #'pattern decls)]))
 
-(define (parse-pat:pair stx head tail decls)
-  (define headp (parse-head-pattern head decls))
-  (define tailp (parse-single-pattern tail decls))
-  ;; Only make pat:head if head is complicated; otherwise simple compound/pair
-  ;; FIXME: Could also inline ~seq patterns from head...?
-  (if (head-pattern? headp)
-      (create-pat:head headp tailp)
-      (create-pat:compound '#:pair (list headp tailp))))
-
 (define (check-list-pattern pattern stx)
   (match pattern
     [(struct pat:datum (_base '()))
diff --git a/collects/syntax/scribblings/parse-patterns.scrbl b/collects/syntax/scribblings/parse-patterns.scrbl
index 103d707716..23d8965d72 100644
--- a/collects/syntax/scribblings/parse-patterns.scrbl
+++ b/collects/syntax/scribblings/parse-patterns.scrbl
@@ -12,6 +12,18 @@
 @(define ellipses @scheme[...])
 @(define-syntax-rule (defhere id) (defidentifier #'id #:form? #t))
 
+@(define Spattern "single-term pattern")
+@(define Lpattern "list pattern")
+@(define Hpattern "head pattern")
+@(define EHpattern "ellipsis-head pattern")
+@(define Apattern "action pattern")
+
+@(define Spatterns "single-term patterns")
+@(define Lpatterns "list patterns")
+@(define Hpatterns "head patterns")
+@(define EHpatterns "ellipsis-head patterns")
+@(define Apatterns "action patterns")
+
 @(begin
    (define-syntax ref
      (syntax-rules ()
@@ -56,15 +68,20 @@
 
 The grammar of @deftech{syntax patterns} used by
 @schememodname[syntax/parse] facilities is given in the following
-table. There are three main kinds of syntax pattern: @tech{S-patterns}
-(for ``single-term patterns''), @tech{H-patterns} (for ``head
-patterns''), and @tech{EH-patterns} (for ``ellipsis head
-patterns''). A fourth kind, @tech{L-patterns} (for ``list patterns''),
-is a restricted subset of @tech{S-patterns}. 
+table. There are four main kinds of syntax pattern:
+@itemize[
+@item{@tech{@Spatterns}, abbreviated @svar[S-pattern]}
+@item{@tech{@Hpatterns}, abbreviated @svar[H-pattern]}
+@item{@tech{@EHpatterns}, abbreviated @svar[EH-pattern]}
+@item{@tech{@Apatterns}, abbreviated @svar[A-pattern]}
+]
+A fifth kind, @tech{@Lpatterns} (abbreviated
+@svar[L-pattern]), is a just a syntactically restricted subset of
+@tech{@Spatterns}.
 
 When a special form in this manual refers to @svar[syntax-pattern]
 (eg, the description of the @scheme[syntax-parse] special form), it
-means specifically @tech{S-pattern}.
+means specifically @tech{@Spattern}.
 
 @schemegrammar*[#:literals (_ ~var ~literal ~or ~and ~not ~seq 
                             ~rep ~once ~optional
@@ -78,81 +95,118 @@ means specifically @tech{S-pattern}.
                  (~literal literal-id)
                  atomic-datum
                  (H-pattern . S-pattern)
+                 (A-pattern . S-pattern)
                  ((@#,ref[~or eh] EH-pattern ...+) #,ellipses . S-pattern)
                  (EH-pattern #,ellipses . S-pattern)
-                 (@#,ref[~and s] S-pattern ...+)
+                 (@#,ref[~and s] proper-S/A-pattern ...+)
                  (@#,ref[~or s] S-pattern ...+)
                  (~not S-pattern)
                  #((unsyntax @svar[pattern-part]) ...)
                  #s(prefab-struct-key (unsyntax @svar[pattern-part]) ...)
                  (~rest S-pattern)
                  (@#,ref[~describe s] expr S-pattern)
-                 (~! . S-pattern)
-                 (~bind [attr-id expr] ...)
-                 (~fail maybe-fail-condition message-expr)]
+                 A-pattern]
                 [L-pattern
                  ()
+                 (A-pattern . L-pattern)
                  (H-pattern . L-pattern)
                  ((@#,ref[~or eh] EH-pattern ...+) #,ellipses . L-pattern)
                  (EH-pattern #,ellipses . L-pattern)
-                 (~rest L-pattern)
-                 (~! . L-pattern)]
+                 (~rest L-pattern)]
                 [H-pattern
                  pvar-id:splicing-syntax-class-id
                  (@#,ref[~var h] id splicing-syntax-class)
                  (~seq . L-pattern)
-                 (@#,ref[~and h] strict-H-pattern ...+)
+                 (@#,ref[~and h] proper-H/A-pattern ...+)
                  (@#,ref[~or h] H-pattern ...+)
                  (@#,ref[~optional h] H-pattern maybe-optional-option)
                  (@#,ref[~describe h] expr H-pattern)
-                 S-pattern]
+                 proper-S-pattern]
                 [EH-pattern
                  (~once H-pattern once-option ...)
                  (@#,ref[~optional eh] H-pattern optional-option ...)
-                 H-pattern]]
+                 H-pattern]
+                [A-pattern
+                 ~!
+                 (~bind [attr-id expr] ...)
+                 (~fail maybe-fail-condition message-expr)
+                 (@#,ref[~and a] A-pattern ...+)]
+                [proper-S-pattern
+                 #, @elem{a @svar{S-pattern} that is not a @svar{A-pattern}}]
+                [proper-H-pattern
+                 #, @elem{a @svar{H-pattern} that is not a @svar{S-pattern}}]]
 
 The following pattern keywords can be used in multiple pattern
 variants:
 
 @defidform[~var]{ 
 
-Pattern keyword; see @ref[~var s-], @ref[~var s+], or @ref[~var h].
+One of @ref[~var s-], @ref[~var s+], or @ref[~var h].
 }
 
 @defidform[~and]{
 
-Pattern keyword; see @ref[~and s] or @ref[~and h].
+One of @ref[~and s], @ref[~and h], or @ref[~and a]:
+@itemize[
+@item{@ref[~and a] if all of the conjuncts are @tech{@Apatterns}}
+@item{@ref[~and h] if any of the conjuncts is a @tech{proper
+@Hpattern}}
+@item{@ref[~and s] otherwise}
+]
 }
 
 @defidform[~or]{
 
-Pattern keyword; see @ref[~or s], @ref[~or h]), or @ref[~or eh].
+One of @ref[~or s], @ref[~or h]), or @ref[~or eh]:
+@itemize[
+@item{@ref[~or eh] if the pattern occurs directly before ellipses
+  (@ellipses)}
+@item{@ref[~or h] if any of the disjuncts is a @tech{proper @Hpattern}}
+@item{@ref[~or s] otherwise}
+]
 }
 
 @defidform[~describe]{
 
-Pattern keyword; see @ref[~describe s] or @ref[~describe h].
+One of @ref[~describe s] or @ref[~describe h]:
+@itemize[
+@item{@ref[~describe h] if the subpattern is a @tech{proper @Hpattern}}
+@item{@ref[~describe s] otherwise}
+]
 }
 
 @defidform[~optional]{
 
-Pattern keyword; see @ref[~optional h] or @ref[~optional eh].
+One of @ref[~optional h] or @ref[~optional eh]:
+@itemize[
+@item{@ref[~optional eh] if it is an immediate disjunct of a @ref[~or
+eh] pattern}
+@item{@ref[~optional h] otherwise}
+]
 }
 
 
 @;{--------}
 
-@section{S-pattern variants}
+@section{Single-term patterns}
 
-An @deftech{S-pattern} (for ``single-term pattern'') is a pattern that
-describes a single term. The pattern may, of course, consist of other
-parts. For example, @scheme[(17 ...)] is an @tech{S-pattern}
-that matches any term that is a proper list of repeated
-@schemeresult[17] numerals. The @deftech{L-pattern}s (for ``list
-pattern'') are @tech{S-pattern} having a restricted structure that
-constrains it to match only terms that are proper lists.
+A @deftech{@Spattern} (abbreviated @svar[S-pattern]) is a pattern that
+describes a single term. These are like the traditional patterns used
+in @scheme[syntax-rules] and @scheme[syntax-case], but with additional
+variants that make them more expressive.
 
-Here are the variants of @tech{S-pattern}:
+``Single-term'' does not mean ``atomic''; a @Spattern can have
+complex structure, and it can match terms that have many parts. For
+example, @scheme[(17 ...)] is a @Spattern that matches any
+term that is a proper list of repeated @schemeresult[17] numerals. 
+
+A @deftech{proper @Spattern} is one that is not an @tech{@Apattern}.
+
+The @deftech{@Lpatterns} (for ``list pattern'') are @Spatterns
+having a restricted structure that guarantees that they match only
+terms that are proper lists.
+
+Here are the variants of @elem{@Spattern}:
 
 @specsubform[id]{
 
@@ -285,32 +339,46 @@ literals.
 @specsubform[(H-pattern . S-pattern)]{
 
 Matches any term that can be decomposed into a list prefix matching
-the @tech{H-pattern} and a suffix matching the S-pattern.
+@scheme[H-pattern] and a suffix matching @scheme[S-pattern].
 
 Note that the pattern may match terms that are not even improper
 lists; if the head pattern can match a zero-length head, then the
 whole pattern matches whatever the tail pattern accepts.
 
-The first pattern can be an @tech{S-pattern}, in which case the whole
+The first pattern can be a @tech{@Spattern}, in which case the whole
 pattern matches any pair whose first element matches the first pattern
 and whose rest matches the second.
 
-See @tech{H-patterns} for more information.
+See @tech{@Hpatterns} for more information.
+}
+
+@specsubform[(A-pattern . S-pattern)]{
+
+Performs the actions specified by @scheme[A-pattern], then matches
+any term that matches @scheme[S-pattern].
+
+Pragmatically, one can throw an @tech{@Apattern} into any list
+pattern. Thus, @scheme[(x y z)] is a pattern matching a list of three
+terms, and @scheme[(x y ~! z)] is a pattern matching a list of three
+terms, with a @tech{cut} performed after the second one. In other
+words, @Apatterns ``don't take up space.''
+
+See @tech{@Apatterns} for more information.
 }
 
 @specsubform[((@#,def[~or eh] EH-pattern ...+) #,ellipses . S-pattern)]{
 
 Matches any term that can be decomposed into a list head matching some
-number of repetitions of the @tech{EH-pattern} alternatives (subject
-to its repetition constraints) followed by a list tail matching the
-S-pattern.
+number of repetitions of @scheme[EH-pattern] alternatives (subject to
+its repetition constraints) followed by a list tail matching
+@scheme[S-pattern].
 
 In other words, the whole pattern matches either the second pattern
 (which need not be a list) or a term whose head matches one of the
 alternatives of the first pattern and whose tail recursively matches
 the whole sequence pattern.
 
-See @tech{EH-patterns} for more information.
+See @tech{@EHpatterns} for more information.
 }
 
 @specsubform[(EH-pattern #,ellipses . S-pattern)]{
@@ -319,10 +387,13 @@ The @scheme[~or]-free variant of ellipses (@ellipses) pattern is
 equivalent to the @scheme[~or] variant with just one alternative.
 }
 
-@specsubform[(@#,def[~and s] S-pattern ...)]{
+@specsubform[(@#,def[~and s] S/A-pattern ...)]{
 
 Matches any term that matches all of the subpatterns.
 
+The subpatterns can contain a mixture of @tech{@Spatterns} and
+@tech{@Apatterns}, but must contain at least one @tech{@Spattern}.
+
 Attributes bound in subpatterns are available to subsequent
 subpatterns. The whole pattern binds all of the subpatterns'
 attributes.
@@ -348,7 +419,6 @@ purpose, but @scheme[~and] can be lighter weight.
         #f "bad import" #'import-clause bad))
      'ok)])
 ]
-
 }
 
 @specsubform[(@#,def[~or s] S-pattern ...)]{
@@ -372,8 +442,9 @@ to have a value if the whole pattern matches.
 
 @specsubform[(@#,defhere[~not] S-pattern)]{
 
-Matches any term that does not match the subpattern. The subpattern's
-attributes are @emph{not} bound outside of the @scheme[~not]-pattern.
+Matches any term that does not match the subpattern. None of the
+subpattern's attributes are bound outside of the
+@scheme[~not]-pattern.
 
 @myexamples[
 (syntax-parse #'(x y z => u v)
@@ -386,7 +457,7 @@ attributes are @emph{not} bound outside of the @scheme[~not]-pattern.
 @specsubform[#(#, @svar[pattern-part] ...)]{
 
 Matches a term that is a vector whose elements, when considered as a
-list, match the @tech{S-pattern} corresponding to
+list, match the @tech{@Spattern} corresponding to
 @scheme[(pattern-part ...)].
 
 @myexamples[
@@ -397,14 +468,13 @@ list, match the @tech{S-pattern} corresponding to
 (syntax-parse #'#(1 2 3)
   [#(x ~rest y) (syntax->datum #'y)])
 ]
-
 }
 
 @specsubform[#s(prefab-struct-key #, @svar[pattern-part] ...)]{
 
 Matches a term that is a prefab struct whose key is exactly the given
 key and whose sequence of fields, when considered as a list, match the
-@tech{S-pattern} corresponding to @scheme[(pattern-part ...)].
+@tech{@Spattern} corresponding to @scheme[(pattern-part ...)].
 
 @myexamples[
 (syntax-parse #'#s(point 1 2 3)
@@ -418,10 +488,10 @@ key and whose sequence of fields, when considered as a list, match the
 
 @specsubform[(#, @defhere[~rest] S-pattern)]{
 
-Matches just like the inner @scheme[S-pattern]. The @scheme[~rest]
-pattern form is useful in positions where improper lists (``dots'')
-are not allowed by the reader, such as vector and structure patterns
-(see above).
+Matches just like @scheme[S-pattern]. The @scheme[~rest] pattern form
+is useful in positions where improper (``dotted'') lists are not
+allowed by the reader, such as vector and structure patterns (see
+above).
 
 @myexamples[
 (syntax-parse #'(1 2 3)
@@ -442,19 +512,234 @@ A describe-pattern also affects backtracking in two ways:
 
 @itemize{
 
-@item{A cut-pattern (@scheme[~!]) within a describe-pattern only
+@item{A cut (@scheme[~!]) within a describe-pattern only
 eliminates choice-points created within the describe-pattern.}
 
-@item{If a describe-pattern succeeds, then all choice points created
-within the describe-pattern are discarded, and a failure @emph{after}
-the describe-pattern backtracks to a choice point @emph{before} the
-describe-pattern, never one @emph{within} it.}}}
+@item{If a describe-pattern succeeds, then all choice points
+created within the describe-pattern are discarded, and a failure
+@emph{after} the describe-pattern backtracks to a choice point
+@emph{before} the describe-pattern, never one @emph{within} it.}
+}
+}
 
-@specsubform[(@#,defhere[~!] . S-pattern)]{
+@specsubform[A-pattern]{
 
-The @scheme[~!] operator, pronounced ``cut'', eliminates backtracking
-choice points and commits parsing to the current branch of the pattern
-it is exploring.
+An @tech{@Apattern} is considered a @Spattern when there is no
+ambiguity; it matches any term.
+}
+
+
+@section{Head patterns}
+
+A @deftech{@Hpattern} (abbreviated @svar[H-pattern]) is a pattern that
+describes some number of terms that occur at the head of some list
+(possibly an improper list). A @Hpattern's usefulness comes from being
+able to match heads of different lengths, such as optional forms like
+keyword arguments.
+
+A @deftech{proper @Hpattern} is a @Hpattern that is not a @elem{@Spattern}.
+
+Here are the variants of @elem{@Hpattern}:
+
+@specsubform[pvar-id:splicing-syntax-class-id]{
+
+Equivalent to @scheme[(~var pvar-id splicing-syntax-class-id)].
+
+}
+
+@specsubform/subs[(@#,def[~var h] pvar-id splicing-syntax-class)
+                  ([splicing-syntax-class splicing-syntax-class-id
+                                          (splicing-syntax-class-id arg-expr ...)])]{
+
+Pattern variable annotated with a @tech{splicing syntax
+class}. Similar to a normal @tech{annotated pattern variable}, except
+matches a head pattern.
+}
+
+@specsubform[(@#,defhere[~seq] . L-pattern)]{
+
+Matches a head whose elements, if put in a list, would match
+@scheme[L-pattern].
+
+@myexamples[
+(syntax-parse #'(1 2 3 4)
+  [((~seq 1 2 3) 4) 'ok])
+]
+
+See also the section on @tech{@EHpatterns} for more interesting
+examples of @scheme[~seq].
+}
+
+@specsubform[(@#,def[~and h] H-pattern ...)]{
+
+Like the @Spattern version of @scheme[~and], but matches a term head
+instead.
+
+@myexamples[
+(syntax-parse #'(#:a 1 #:b 2 3 4 5)
+  [((~and (~seq (~seq k:keyword e:expr) ...)
+          (~seq keyword-stuff ...))
+    positional-stuff ...)
+   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
+]
+
+The @Hpattern variant of @scheme[~and] requires that all of the
+subpatterns be @tech{proper @Hpatterns} (not @tech{@Spatterns}). This
+is to prevent typos like the following, a variant of the previous
+example with the second @scheme[~seq] omitted:
+
+@myexamples[
+(syntax-parse #'(#:a 1 #:b 2 3 4 5)
+  [((~and (~seq (~seq k:keyword e:expr) ...)
+          (keyword-stuff ...))
+    positional-stuff ...)
+   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
+(code:comment "If the example above were allowed, it would be equivalent to this:")
+(syntax-parse #'(#:a 1 #:b 2 3 4 5)
+  [((~and (~seq (~seq k:keyword e:expr) ...)
+          (~seq (keyword-stuff ...)))
+    positional-stuff ...)
+   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
+]
+}
+
+@specsubform[(@#,def[~or h] H-pattern ...)]{
+
+Like the @Spattern version of @scheme[~or], but matches a term head
+instead.
+
+@myexamples[
+(syntax-parse #'(m #:foo 2 a b c)
+  [(_ (~or (~seq #:foo x) (~seq)) y:id ...)
+   (attribute x)])
+(syntax-parse #'(m a b c)
+  [(_ (~or (~seq #:foo x) (~seq)) y:id ...)
+   (attribute x)])
+]
+}
+
+@specsubform/subs[(@#,def[~optional h] H-pattern maybe-optional-option)
+                  ([maybe-optional-option
+                    (code:line)
+                    (code:line #:defaults ([attr-id expr] ...))])]{
+
+Matches either the given head subpattern or an empty head. If the
+@scheme[#:defaults] option is given, the subsequent attribute bindings
+are used if the subpattern does not match. The default attributes must
+be a subset of the subpattern's attributes.
+
+@myexamples[
+(syntax-parse #'(m #:foo 2 a b c)
+  [(_ (~optional (~seq #:foo x) #:defaults ([x #'#f])) y:id ...)
+   (attribute x)])
+(syntax-parse #'(m a b c)
+  [(_ (~optional (~seq #:foo x) #:defaults ([x #'#f])) y:id ...)
+   (attribute x)])
+(syntax-parse #'(m a b c)
+  [(_ (~optional (~seq #:foo x)) y:id ...)
+   (attribute x)])
+]
+
+}
+
+@specsubform[(@#,def[~describe h] expr H-pattern)]{
+
+Like the @Spattern version of @scheme[~describe], but matches a head
+pattern instead.
+}
+
+@specsubform[S-pattern]{
+
+Matches a head of one element, which must be a term matching
+@scheme[S-pattern].
+}
+
+
+@;{--------}
+
+@section{Ellipsis-head patterns}
+
+An @deftech{@EHpattern} (abbreviated @svar[EH-pattern]) is pattern
+that describes some number of terms, like a @tech{@Hpattern}, but may
+also place contraints on the number of times it occurs in a
+repetition. They are useful for matching keyword arguments where the
+keywords may come in any order.
+
+@myexamples[
+(define parser1
+  (syntax-parser
+   [((~or (~once (~seq #:a x) #:name "#:a keyword")
+          (~optional (~seq #:b y) #:name "#:b keyword")
+          (~seq #:c z)) ...)
+    'ok]))
+(parser1 #'(#:a 1))
+(parser1 #'(#:b 2 #:c 3 #:c 25 #:a 'hi))
+(parser1 #'(#:a 1 #:a 2))
+]
+
+The pattern requires exactly one occurrence of the @scheme[#:a]
+keyword and argument, at most one occurrence of the @scheme[#:b]
+keyword and argument, and any number of @scheme[#:c] keywords and
+arguments. The ``pieces'' can occur in any order.
+
+Here are the variants of @elem{@EHpattern}:
+
+@specsubform/subs[(@#,defhere[~once] H-pattern once-option ...)
+                  ([once-option (code:line #:name name-expr)
+                                (code:line #:too-few too-few-message-expr)
+                                (code:line #:too-many too-many-message-expr)])]{
+
+Matches if the inner @scheme[H-pattern] matches. This pattern must be
+selected exactly once in the match of the entire repetition sequence.
+
+If the pattern is not chosen in the repetition sequence, then an error
+is raised with a message, either @scheme[too-few-message-expr] or
+@schemevalfont{"missing required occurrence of @scheme[name-expr]"}.
+
+If the pattern is chosen more than once in the repetition sequence,
+then an error is raised with a message, either
+@scheme[too-many-message-expr] or @schemevalfont{"too many occurrences
+of @scheme[name-expr]"}.
+}
+
+@specsubform/subs[(@#,def[~optional eh] H-pattern optional-option ...)
+                  ([optional-option (code:line #:name name-expr)
+                                    (code:line #:too-many too-many-message-expr)
+                                    (code:line #:defaults ([attr-id expr] ...))])]{
+
+Matches if the inner @scheme[H-pattern] matches. This pattern may be used at
+most once in the match of the entire repetition.
+
+If the pattern is chosen more than once in the repetition sequence,
+then an error is raised with a message, either
+@scheme[too-many-message-expr] or @schemevalfont{"too many occurrences
+of @scheme[name-expr]"}.
+
+If the @scheme[#:defaults] option is given, the following attribute
+bindings are used if the subpattern does not match at all in the
+sequence. The default attributes must be a subset of the subpattern's
+attributes.
+}
+
+
+@;{--------}
+
+@section{Action patterns}
+
+An @deftech{@Apattern} (abbreviated @svar[A-pattern]) does not
+describe any syntax; rather, it has an effect such as the binding of
+attributes or the modification of the matching process.
+
+The grammar describing where an @Apattern may occur may look
+complicated, but the essence is this: ``@Apatterns don't take up
+space.'' They can be freely added to a list pattern or inserted into
+an @scheme[~and] pattern.
+
+@specsubform[@#,defhere[~!]]{
+
+The @deftech{cut} operator, written @scheme[~!], eliminates
+backtracking choice points and commits parsing to the current branch
+of the pattern it is exploring.
 
 Common opportunities for cut-patterns come from recognizing special
 forms based on keywords. Consider the following expression:
@@ -496,9 +781,8 @@ are discarded.
 
 @specsubform[(@#,defhere[~bind] [attr-id expr] ...)]{
 
-This pattern matches any term. Its effect is to evaluate the
-@scheme[expr]s and bind them to the given @scheme[attr-id]s as
-attributes.
+Evaluates the @scheme[expr]s and binds them to the given
+@scheme[attr-id]s as attributes.
 }
 
 @specsubform/subs[(@#,defhere[~fail] maybe-fail-condition message-expr)
@@ -506,206 +790,17 @@ attributes.
                                          (code:line #:when condition-expr)
                                          (code:line #:unless condition-expr)])]{
 
-This pattern succeeds or fails independent of the term being matched
-against. If the condition is absent, or if the @scheme[#:when]
+If the condition is absent, or if the @scheme[#:when]
 condition evaluates to a true value, or if the @scheme[#:unless]
 condition evaluates to @scheme[#f], then the pattern fails with the
-given message. Otherwise the pattern succeeds.
+given message.
 
 Fail patterns can be used together with cut patterns to recognize
 specific ill-formed terms and address them with specially-created
 failure messages.
 }
 
+@specsubform[(@#,def[~and a] A-pattern ...+)]{
 
-@section{H-pattern variants}
-
-An @deftech{H-pattern} (for ``head pattern'') is a pattern that
-describes some number of terms that occur at the head of some list
-(possibly an improper list). An H-pattern's usefulness comes from
-being able to match heads of different lengths.  H-patterns are useful
-for specifying optional forms such as keyword arguments.
-
-Here are the variants of @tech{H-pattern}:
-
-@specsubform[pvar-id:splicing-syntax-class-id]{
-
-Equivalent to @scheme[(~var pvar-id
-splicing-syntax-class-id)].
-
-}
-
-@specsubform/subs[(@#,def[~var h] pvar-id splicing-syntax-class)
-                  ([splicing-syntax-class splicing-syntax-class-id
-                                          (splicing-syntax-class-id arg-expr ...)])]{
-
-Pattern variable annotated with a @tech{splicing syntax
-class}. Similar to a normal @tech{annotated pattern variable}, except
-matches a head pattern.
-}
-
-@specsubform[(@#,defhere[~seq] . L-pattern)]{
-
-Matches a head whose elements, if put in a list, would match the given
-@tech{L-pattern}.
-
-@myexamples[
-(syntax-parse #'(1 2 3 4)
-  [((~seq 1 2 3) 4) 'ok])
-]
-
-See also the section on @tech{EH-patterns} for more interesting
-examples of @scheme[~seq].
-
-}
-
-@specsubform[(@#,def[~and h] H-pattern ...)]{
-
-Like the S-pattern version of @scheme[~and], but matches a term head
-instead.
-
-@myexamples[
-(syntax-parse #'(#:a 1 #:b 2 3 4 5)
-  [((~and (~seq (~seq k:keyword e:expr) ...)
-          (~seq keyword-stuff ...))
-    positional-stuff ...)
-   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
-]
-
-The H-pattern variant of @scheme[~and] requires that all of the
-subpatterns be strictly @tech{H-patterns} and not
-@tech{S-patterns}. This is to prevent typos like the following, a
-variant of the previous example with the second @scheme[~seq] omitted:
-
-@myexamples[
-(syntax-parse #'(#:a 1 #:b 2 3 4 5)
-  [((~and (~seq (~seq k:keyword e:expr) ...)
-          (keyword-stuff ...))
-    positional-stuff ...)
-   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
-(code:comment "If the example above were allowed, it would be equivalent to this:")
-(syntax-parse #'(#:a 1 #:b 2 3 4 5)
-  [((~and (~seq (~seq k:keyword e:expr) ...)
-          (~seq (keyword-stuff ...)))
-    positional-stuff ...)
-   (syntax->datum #'((k ...) (e ...) (keyword-stuff ...)))])
-]
-}
-
-@specsubform[(@#,def[~or h] H-pattern ...)]{
-
-Like the S-pattern version of @scheme[~or], but matches a term head
-instead.
-
-@myexamples[
-(syntax-parse #'(m #:foo 2 a b c)
-  [(_ (~or (~seq #:foo x) (~seq)) y:id ...)
-   (attribute x)])
-(syntax-parse #'(m a b c)
-  [(_ (~or (~seq #:foo x) (~seq)) y:id ...)
-   (attribute x)])
-]
-}
-
-@specsubform/subs[(@#,def[~optional h] H-pattern maybe-optional-option)
-                  ([maybe-optional-option
-                    (code:line)
-                    (code:line #:defaults ([attr-id expr] ...))])]{
-
-Matches either the given head subpattern or an empty head. If the
-@scheme[#:defaults] option is given, the subsequent attribute bindings
-are used if the subpattern does not match. The default attributes must
-be a subset of the subpattern's attributes.
-
-@myexamples[
-(syntax-parse #'(m #:foo 2 a b c)
-  [(_ (~optional (~seq #:foo x) #:defaults ([x #'#f])) y:id ...)
-   (attribute x)])
-(syntax-parse #'(m a b c)
-  [(_ (~optional (~seq #:foo x) #:defaults ([x #'#f])) y:id ...)
-   (attribute x)])
-(syntax-parse #'(m a b c)
-  [(_ (~optional (~seq #:foo x)) y:id ...)
-   (attribute x)])
-]
-
-}
-
-@specsubform[(@#,def[~describe h] expr H-pattern)]{
-
-Like the S-pattern version of @scheme[~describe], but matches a head
-pattern instead.
-}
-
-@specsubform[S-pattern]{
-
-Matches a head of one element, which must be a term matching the given
-@tech{S-pattern}.
-}
-
-
-@;{--------}
-
-@section{EH-pattern forms}
-
-An @deftech{EH-pattern} (for ``ellipsis-head pattern'') is pattern
-that describes some number of terms, like an @tech{H-pattern}, but may
-also place contraints on the number of times it occurs in a
-repetition. EH-patterns (and ellipses) are useful for matching keyword
-arguments where the keywords may come in any order.
-
-@myexamples[
-(define parser1
-  (syntax-parser
-   [((~or (~once (~seq #:a x) #:name "#:a keyword")
-          (~optional (~seq #:b y) #:name "#:b keyword")
-          (~seq #:c z)) ...)
-    'ok]))
-(parser1 #'(#:a 1))
-(parser1 #'(#:b 2 #:c 3 #:c 25 #:a 'hi))
-(parser1 #'(#:a 1 #:a 2))
-]
-
-The pattern requires exactly one occurrence of the @scheme[#:a]
-keyword and argument, at most one occurrence of the @scheme[#:b]
-keyword and argument, and any number of @scheme[#:c] keywords and
-arguments. The ``pieces'' can occur in any order.
-
-Here are the variants of @tech{EH-pattern}:
-
-@specsubform/subs[(@#,defhere[~once] H-pattern once-option ...)
-                  ([once-option (code:line #:name name-expr)
-                                (code:line #:too-few too-few-message-expr)
-                                (code:line #:too-many too-many-message-expr)])]{
-
-Matches if the inner H-pattern matches. This pattern must be selected
-exactly once in the match of the entire repetition sequence.
-
-If the pattern is not chosen in the repetition sequence, then an error
-is raised with a message, either @scheme[too-few-message-expr] or
-@schemevalfont{"missing required occurrence of @scheme[name-expr]"}.
-
-If the pattern is chosen more than once in the repetition sequence,
-then an error is raised with a message, either
-@scheme[too-many-message-expr] or @schemevalfont{"too many occurrences
-of @scheme[name-expr]"}.
-}
-
-@specsubform/subs[(@#,def[~optional eh] H-pattern optional-option ...)
-                  ([optional-option (code:line #:name name-expr)
-                                    (code:line #:too-many too-many-message-expr)
-                                    (code:line #:defaults ([attr-id expr] ...))])]{
-
-Matches if the inner H-pattern matches. This pattern may be used at
-most once in the match of the entire repetition.
-
-If the pattern is chosen more than once in the repetition sequence,
-then an error is raised with a message, either
-@scheme[too-many-message-expr] or @schemevalfont{"too many occurrences
-of @scheme[name-expr]"}.
-
-If the @scheme[#:defaults] option is given, the following attribute
-bindings are used if the subpattern does not match at all in the
-sequence. The default attributes must be a subset of the subpattern's
-attributes.
+Performs the actions of each @scheme[A-pattern].
 }
diff --git a/collects/syntax/scribblings/parse.scrbl b/collects/syntax/scribblings/parse.scrbl
index a0f58b63ee..8387a3f957 100644
--- a/collects/syntax/scribblings/parse.scrbl
+++ b/collects/syntax/scribblings/parse.scrbl
@@ -191,10 +191,9 @@ The second pattern matches unparenthesized identifiers. The @scheme[e]
 attribute is bound using a @scheme[#:with] clause, which matches the
 pattern @scheme[e] against the syntax from evaluating @scheme[#'#f].
 
-Optional keyword arguments are supported via ``head patterns'' (called
-@tech{H-patterns} in the reference documentation). Unlike normal
-patterns, which match one term, head patterns can match a variable
-number of subterms in a list.
+Optional keyword arguments are supported via @tech{head
+patterns}. Unlike normal patterns, which match one term, head patterns
+can match a variable number of subterms in a list.
 
 Suppose @schemekeywordfont{mylet} accepted an optional
 @scheme[#:check] keyword with one argument, a procedure that would be
@@ -394,7 +393,7 @@ structures can share syntax class definitions.
                  (pattern syntax-pattern pattern-directive ...)])]{
 
 Defines @scheme[name-id] as a @deftech{syntax class}, which
-encapsulates one or more @tech{S-patterns}.
+encapsulates one or more @tech{single-term patterns}.
 
 When the @scheme[arg-id]s are present, they are bound as variables in
 the body. The body of the syntax-class definition contains a non-empty
@@ -449,7 +448,8 @@ These options have the same meaning as in @scheme[syntax-parse].
 }
 
 Each variant of a syntax class is specified as a separate
-@scheme[pattern]-form whose syntax pattern is an @tech{S-pattern}.
+@scheme[pattern]-form whose syntax pattern is a @tech{single-term
+pattern}.
 }
 
 @defform*[#:literals (pattern)
@@ -459,13 +459,13 @@ Each variant of a syntax class is specified as a separate
              stxclass-variant ...+)]]{
 
 Defines @scheme[name-id] as a @deftech{splicing syntax class},
-analogous to a @tech{syntax class} but encapsulating @tech{H-patterns}
-rather than @tech{S-patterns}.
+analogous to a @tech{syntax class} but encapsulating @tech{head
+patterns} rather than @tech{single-term patterns}.
 
 The options are the same as for @scheme[define-syntax-class].
 
 Each variant of a splicing syntax class is specified as a separate
-@scheme[pattern]-form whose syntax pattern is an @tech{H-pattern}.
+@scheme[pattern]-form whose syntax pattern is a @tech{head pattern}.
 }
 
 @defform[#:literals (pattern)
@@ -476,9 +476,9 @@ class. The variant accepts syntax matching the given syntax pattern
 with the accompanying @tech{pattern directives}.
 
 When used within @scheme[define-syntax-class], @scheme[syntax-pattern]
-should be an @tech{S-pattern}; within
-@scheme[define-splicing-syntax-class], it should be an
-@tech{H-pattern}.
+should be a @tech{single-term pattern}; within
+@scheme[define-splicing-syntax-class], it should be a @tech{head
+pattern}.
 
 The attributes of the variant are the attributes of the pattern
 together with all attributes bound by @scheme[#:with] clauses,