diff --git a/collects/syntax/private/stxparse/parse.ss b/collects/syntax/private/stxparse/parse.ss
index 61c6203154..3c3ee34125 100644
--- a/collects/syntax/private/stxparse/parse.ss
+++ b/collects/syntax/private/stxparse/parse.ss
@@ -247,6 +247,13 @@
               (try (parse:S x fc subpattern
                             (disjunct subpattern success (enclosing-fail) (id ...)))
                    ...)))]
+       [#s(pat:not () subpattern)
+        #`(let ([fail-to-succeed (lambda (_failure) k)]
+                [outer-fail enclosing-fail])
+            (with-enclosing-fail* fail-to-succeed
+              (parse:S x fc subpattern
+                       (with-enclosing-fail outer-fail
+                         (fail x #:expect (expectation pattern0) #:fce fc)))))]
        [#s(pat:compound attrs kind0 (part-pattern ...))
         (let ([kind (get-kind (wash #'kind0))])
           (with-syntax ([(part ...) (generate-temporaries (kind-selectors kind))])
@@ -376,6 +383,10 @@
                                           #'null])))
                     k))
                 (fail x #:expect result #:fce fc)))]
+       [#s(hpat:and (a ...) head single)
+        #`(parse:H x fc head rest index
+                   (let ([lst (stx-list-take x index)])
+                     (parse:S lst fc single k)))]
        [#s(hpat:or (a ...) (subpattern ...))
         (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
           #`(let ([success
@@ -560,6 +571,8 @@
      #''ineffable]
     [(_ #s(pat:fail _ condition message))
      #'(expectation-of-message message)]
+    [(_ #s(pat:not _ pattern))
+     #''ineffable]
     ))
 
 ;; ----
diff --git a/collects/syntax/private/stxparse/rep-attrs.ss b/collects/syntax/private/stxparse/rep-attrs.ss
index 72885b51bc..43754a42ed 100644
--- a/collects/syntax/private/stxparse/rep-attrs.ss
+++ b/collects/syntax/private/stxparse/rep-attrs.ss
@@ -3,8 +3,7 @@
          scheme/match
          syntax/stx
          syntax/id-table
-         "../util.ss"
-         "rep-patterns.ss")
+         "../util.ss")
 (provide (struct-out attr))
 
 #|
diff --git a/collects/syntax/private/stxparse/rep-patterns.ss b/collects/syntax/private/stxparse/rep-patterns.ss
index c6440068c1..47cdd31bc3 100644
--- a/collects/syntax/private/stxparse/rep-patterns.ss
+++ b/collects/syntax/private/stxparse/rep-patterns.ss
@@ -1,5 +1,7 @@
 #lang scheme/base
-(require (for-syntax scheme/base
+(require "rep-attrs.ss"
+         "../util.ss"
+         (for-syntax scheme/base
                      syntax/stx
                      "../util.ss"))
 (provide (all-defined-out))
@@ -27,6 +29,7 @@ A SinglePattern is one of
   (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)
@@ -50,6 +53,7 @@ A ListPattern is a subtype of SinglePattern; one of
 (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)
@@ -60,6 +64,7 @@ A ListPattern is a subtype of SinglePattern; one of
 A HeadPattern is one of
   (make-hpat:ssc HPBase id id boolean boolean)
   (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))
@@ -68,6 +73,7 @@ A HeadPattern is one of
 (define-struct hpat:ssc (attrs parser description bind-term? bind-attrs?) #:prefab)
 (define-struct hpat:seq (attrs inner) #:prefab)
 (define-struct hpat:or (attrs patterns) #:prefab)
+(define-struct hpat:and (attrs head single) #:prefab)
 (define-struct hpat:describe (attrs description transparent? pattern) #:prefab)
 (define-struct hpat:optional (attrs inner defaults) #:prefab)
 
@@ -105,6 +111,7 @@ A Kind is one of
       (pat:dots? x)
       (pat:and? x)
       (pat:or? x)
+      (pat:not? x)
       (pat:compound? x)
       (pat:cut? x)
       (pat:describe? x)
@@ -114,6 +121,7 @@ A Kind is one of
 (define (head-pattern? x)
   (or (hpat:ssc? x)
       (hpat:seq? x)
+      (hpat:and? x)
       (hpat:or? x)
       (hpat:describe? x)
       (hpat:optional? x)))
@@ -143,7 +151,81 @@ A Kind is one of
                (cond [(pred x) (accessor x)] ...
                      [else (raise-type-error 'pattern-attrs "pattern" x)])))]))
     (mk-get-attrs pat:name pat:any pat:sc pat:datum pat:literal pat:head
-                  pat:dots pat:and pat:or pat:compound pat:cut pat:describe
-                  pat:bind pat:fail
-                  hpat:ssc hpat:seq hpat:or hpat:describe hpat:optional
+                  pat:dots pat:and pat:or pat:not pat:compound pat:cut
+                  pat:describe pat:bind pat:fail
+                  hpat:ssc hpat:seq hpat:and hpat:or hpat:describe
+                  hpat:optional
                   ehpat)))
+
+
+;; ----
+
+;; Helpers to handle attribute calculations
+;; Too complicated for a few pattern forms; those are handled in rep.ss
+
+(define (create-pat:any)
+  (make pat:any null))
+
+(define (create-pat:name pattern ids)
+  (let ([as (for/list ([id ids]) (make attr id 0 #t))])
+    (make pat:name (append as (pattern-attrs pattern)) pattern ids)))
+
+(define (create-pat:datum datum)
+  (make pat:datum null datum))
+
+(define (create-pat:literal literal)
+  (make pat:literal null literal))
+
+(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))
+
+(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: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-hpat:seq lp)
+  (make hpat:seq (pattern-attrs lp) lp))
+
+(define (create-hpat:describe description transparent? p)
+  (make hpat:describe (pattern-attrs p) description transparent? p))
+
+(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 (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 '()))))
diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss
index 734205d098..d6a5a69e95 100644
--- a/collects/syntax/private/stxparse/rep.ss
+++ b/collects/syntax/private/stxparse/rep.ss
@@ -73,8 +73,10 @@
   (list (quote-syntax _)
         (quote-syntax ||)
         (quote-syntax ...)
+        (quote-syntax ~var)
         (quote-syntax ~and)
         (quote-syntax ~or)
+        (quote-syntax ~not)
         (quote-syntax ~seq)
         (quote-syntax ~rep)
         (quote-syntax ~once)
@@ -252,10 +254,10 @@
 
 ;; parse-single-pattern : stx DeclEnv -> SinglePattern
 (define (parse-single-pattern stx decls)
-  (syntax-case stx (~and ~or ~rest ~struct ~! ~describe ~bind ~fail)
+  (syntax-case stx (~var ~and ~or ~not ~rest ~struct ~! ~describe ~bind ~fail)
     [wildcard
      (wildcard? #'wildcard)
-     (make pat:any null)]
+     (create-pat:any)]
     [reserved
      (reserved? #'reserved)
      (wrong-syntax stx "not allowed here")]
@@ -264,21 +266,23 @@
      (parse-pat:id stx decls #f)]
     [datum
      (atomic-datum? #'datum)
-     (make pat:datum null (syntax->datum #'datum))]
+     (create-pat:datum (syntax->datum #'datum))]
     [(~and . rest)
-     (parse-pat:and stx decls)]
+     (parse-pat:and stx decls #f)]
     [(~or . rest)
      (parse-pat:or stx decls #f)]
+    [(~not . rest)
+     (parse-pat:not 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)])
-       (make pat:compound (pattern-attrs lp) `(#:pstruct ,key) (list lp)))]
+       (create-pat:compound `(#:pstruct ,key) (list lp)))]
     [(~! . rest)
      (let ([inner (parse-single-pattern (syntax/loc stx rest) decls)])
-       (make pat:cut (pattern-attrs inner) inner))]
+       (create-pat:cut inner))]
     [(~describe . rest)
      (parse-pat:describe stx decls #f)]
     [(~bind . rest)
@@ -291,25 +295,27 @@
      (parse-pat:pair stx #'head #'tail decls)]
     [#(a ...)
      (let ([lp (parse-single-pattern (syntax/loc stx (a ...)) decls)])
-       (make pat:compound (pattern-attrs lp) '#:vector (list lp)))]
+       (create-pat:compound '#:vector (list lp)))]
     [b
      (box? (syntax-e #'b))
      (let ([bp (parse-single-pattern (unbox (syntax-e #'b)) decls)])
-       (make pat:compound (pattern-attrs bp) '#:box (list bp)))]
+       (create-pat:compound '#:box (list bp)))]
     [s
      (and (struct? (syntax-e #'s)) (prefab-struct-key (syntax-e #'s)))
      (let* ([s (syntax-e #'s)]
             [key (prefab-struct-key s)]
             [contents (cdr (vector->list (struct->vector s)))])
        (let ([lp (parse-single-pattern (datum->syntax #f contents #'s) decls)])
-         (make pat:compound (pattern-attrs lp) `(#:pstruct ,key) (list lp))))]))
+         (create-pat:compound `(#:pstruct ,key) (list lp))))]))
 
 ;; parse-head-pattern : stx DeclEnv -> HeadPattern
 (define (parse-head-pattern stx decls)
-  (syntax-case stx (~or ~seq ~describe ~optional)
+  (syntax-case stx (~var ~and ~or ~seq ~describe ~optional)
     [id
      (and (identifier? #'id) (not (reserved? #'id)))
      (parse-pat:id stx decls #t)]
+    [(~and . rest)
+     (parse-pat:and stx decls #t)]
     [(~or . rest)
      (parse-pat:or stx decls #t)]
     [(~seq . rest)
@@ -342,7 +348,7 @@
   (define entry (declenv-lookup decls id))
   (match entry
     [(list 'literal internal-id literal-id)
-     (make pat:literal null literal-id)]
+     (create-pat:literal literal-id)]
     [(list 'stxclass _ _ _)
      (error 'parse-pat:id
             "(internal error) decls had leftover 'stxclass entry: ~s"
@@ -370,7 +376,7 @@
                               (stxclass-description sc)
                               (stxclass-attrs sc))]
              [else
-              (wrap/name name (make pat:any null))]))]))
+              (wrap/name name (create-pat:any))]))]))
 
 (define (parse-pat:id/s stx name parser description attrs)
   (define prefix (name->prefix name))
@@ -398,8 +404,7 @@
   (cond [(wildcard? id) pattern]
         [(epsilon? id) pattern]
         [else
-         (let ([a (make attr id 0 #t)])
-           (make pat:name (cons a (pattern-attrs pattern)) pattern (list id)))]))
+         (create-pat:name pattern (list id))]))
 
 ;; id-pattern-attrs : (listof SAttr) id/#f IdPrefix -> (listof IAttr)
 (define (id-pattern-attrs sattrs bind prefix)
@@ -436,31 +441,49 @@
          [(description pattern)
           (let ([p (parse-some-pattern #'pattern decls allow-head?)])
             (if (head-pattern? p)
-                (make hpat:describe (pattern-attrs p)
-                      #'description transparent? p)
-                (make pat:describe (pattern-attrs p)
-                      #'description transparent? p)))]))]))
+                (create-hpat:describe #'description transparent? p)
+                (create-pat:describe #'description transparent? p)))]))]))
 
 (define (parse-pat:or stx decls allow-head?)
   (define patterns (parse-cdr-patterns stx decls allow-head? #f))
   (cond [(null? (cdr patterns))
          (car patterns)]
         [else
-         (let ()
-           (define attrs (union-iattrs (map pattern-attrs patterns)))
-           (cond [(ormap head-pattern? patterns)
-                  (make-hpat:or attrs patterns)]
-                 [else
-                  (make-pat:or attrs patterns)]))]))
+         (cond [(ormap head-pattern? patterns)
+                (create-hpat:or patterns)]
+               [else
+                (create-pat:or patterns)])]))
 
-(define (parse-pat:and stx decls)
-  (define patterns (parse-cdr-patterns stx decls #f #t))
-  (make pat:and (append-iattrs (map pattern-attrs patterns)) 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)
+     (let ([p (parse-single-pattern #'pattern decls)])
+       (create-pat:not p))]
+    [_
+     (wrong-syntax stx "expected a single subpattern")]))
 
 (define (parse-hpat:seq stx list-stx decls)
   (define pattern (parse-single-pattern list-stx decls))
   (check-list-pattern pattern stx)
-  (make hpat:seq (pattern-attrs pattern) pattern))
+  (create-hpat:seq pattern))
 
 (define (parse-cdr-patterns stx decls allow-head? allow-cut?)
   (unless (stx-list? stx)
@@ -477,7 +500,7 @@
 
 (define (parse-cut-in-and stx)
   (syntax-case stx (~!)
-    [~! (make pat:cut null (make pat:any null))]
+    [~! (create-pat:cut (create-pat:any))]
     [_ #f]))
 
 (define (parse-some-pattern stx decl allow-head?)
@@ -501,10 +524,7 @@
       [_
        (list (parse-ellipsis-head-pattern head decls))]))
   (define tailp (parse-single-pattern tail decls))
-  (define attrs
-    (append-iattrs (cons (pattern-attrs tailp)
-                         (map pattern-attrs headps))))
-  (make pat:dots attrs headps tailp))
+  (create-pat:dots headps tailp))
 
 (define (parse-pat:bind stx decls)
   (syntax-case stx ()
@@ -531,7 +551,7 @@
                         #`(not #,(caddr chunk)))))])
          (syntax-case rest ()
            [(message)
-            (make pat:fail null condition #'message)]
+            (create-pat:fail condition #'message)]
            [()
             (wrong-syntax stx "missing message expression")]
            [_
@@ -545,14 +565,11 @@
 (define (parse-pat:pair stx head tail decls)
   (define headp (parse-head-pattern head decls))
   (define tailp (parse-single-pattern tail decls))
-  (define attrs
-    (append-iattrs
-     (list (pattern-attrs headp) (pattern-attrs tailp))))
   ;; Only make pat:head if head is complicated; otherwise simple compound/pair
   ;; FIXME: Could also inline ~seq patterns from head...?
   (if (head-pattern? headp)
-      (make pat:head attrs headp tailp)
-      (make pat:compound attrs '#:pair (list headp tailp))))
+      (create-pat:head headp tailp)
+      (create-pat:compound '#:pair (list headp tailp))))
 
 (define (check-list-pattern pattern stx)
   (match pattern
diff --git a/collects/syntax/private/stxparse/runtime.ss b/collects/syntax/private/stxparse/runtime.ss
index 11376367ce..faf05f7544 100644
--- a/collects/syntax/private/stxparse/runtime.ss
+++ b/collects/syntax/private/stxparse/runtime.ss
@@ -11,8 +11,10 @@
                      "../util.ss"))
 
 (provide pattern
+         ~var
          ~and
          ~or
+         ~not
          ~seq
          ~bounds
          ~once
@@ -74,8 +76,10 @@
       (raise-syntax-error #f "keyword used out of context" stx))))
 
 (define-keyword pattern)
+(define-keyword ~var)
 (define-keyword ~and)
 (define-keyword ~or)
+(define-keyword ~not)
 (define-keyword ~seq)
 (define-keyword ~bounds)
 (define-keyword ~once)
diff --git a/collects/syntax/private/stxparse/sc.ss b/collects/syntax/private/stxparse/sc.ss
index 464f598428..391c6623f0 100644
--- a/collects/syntax/private/stxparse/sc.ss
+++ b/collects/syntax/private/stxparse/sc.ss
@@ -26,8 +26,10 @@
          syntax-parser
 
          pattern
+         ~var
          ~and
          ~or
+         ~not
          ~seq
          ~bounds
          ~once