diff --git a/collects/syntax/private/stxparse/parse.ss b/collects/syntax/private/stxparse/parse.ss
index f82b09d9de..75d7672023 100644
--- a/collects/syntax/private/stxparse/parse.ss
+++ b/collects/syntax/private/stxparse/parse.ss
@@ -308,6 +308,17 @@
                (let ([sub-id alt-sub-id] ...)
                  (success pre ... id ...))))))]))
 
+;; (disjunct (clause:attr ...) id (expr ...) (id ...)) : expr
+(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 pre ... id ...))))))]))
+
 (begin-for-syntax
  ;; convert-list-pattern : ListPattern id -> SinglePattern
  ;; Converts '() datum pattern at end of list to bind (cons stx index)
@@ -382,6 +393,22 @@
                           #'pattern
                           #'#s(internal-rest-pattern rest index index0))])
             #'(parse:S x fc pattern k)))]
+       [#s(hpat:optional (a ...) pattern defaults)
+        (with-syntax ([(#s(attr id _ _) ...) #'(a ...)]
+                      [index0 (frontier->index-expr (wash #'fc))])
+          #`(let ([success
+                   (lambda (rest index fail id ...)
+                     (with-enclosing-fail fail
+                       (let-attributes ([a id] ...) k)))])
+              (try (parse:H x fc pattern rest index
+                            (success rest index enclosing-fail (attribute id) ...))
+                   (let ([rest x]
+                         [index index0])
+                     (convert-sides x defaults
+                       (clause-success ()
+                         (disjunct/sides defaults success
+                                         (rest index enclosing-fail)
+                                         (id ...))))))))]
        [_
         (with-syntax ([attrs (pattern-attrs (wash #'head))]
                       [index0 (frontier->index-expr (wash #'fc))])
diff --git a/collects/syntax/private/stxparse/rep-patterns.ss b/collects/syntax/private/stxparse/rep-patterns.ss
index dfb67fba05..c6440068c1 100644
--- a/collects/syntax/private/stxparse/rep-patterns.ss
+++ b/collects/syntax/private/stxparse/rep-patterns.ss
@@ -30,8 +30,8 @@ A SinglePattern is one of
   (make-pat:compound SPBase Kind (listof SinglePattern))
   (make-pat:cut SPBase SinglePattern)
   (make-pat:describe SPBase stx boolean SinglePattern)
-  (make-pat:bind SPBase (listof clause:attr))
   (make-pat:fail SPBase stx stx)
+  (make-pat:bind SPBase (listof clause:attr))
 
 A ListPattern is a subtype of SinglePattern; one of
   (make-pat:datum SPBase '())
@@ -53,9 +53,8 @@ A ListPattern is a subtype of SinglePattern; one of
 (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:bind (attrs clauses) #:prefab)
 (define-struct pat:fail (attrs when message) #:prefab)
-
+(define-struct pat:bind (attrs clauses) #:prefab)
 
 #|
 A HeadPattern is one of
@@ -63,12 +62,14 @@ A HeadPattern is one of
   (make-hpat:seq HPBase ListPattern)
   (make-hpat:or HPBase (listof HeadPattern))
   (make-hpat:describe HPBase stx/#f boolean HeadPattern)
+  (make-hpat:optional HPBase HeadPattern (listof clause:attr))
 |#
 
 (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:describe (attrs description transparent? pattern) #:prefab)
+(define-struct hpat:optional (attrs inner defaults) #:prefab)
 
 #|
 An EllipsisHeadPattern is
@@ -114,7 +115,8 @@ A Kind is one of
   (or (hpat:ssc? x)
       (hpat:seq? x)
       (hpat:or? x)
-      (hpat:describe? x)))
+      (hpat:describe? x)
+      (hpat:optional? x)))
 
 (define (ellipsis-head-pattern? x)
   (ehpat? x))
@@ -143,5 +145,5 @@ A Kind is one of
     (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:ssc hpat:seq hpat:or hpat:describe hpat:optional
                   ehpat)))
diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss
index 77a3e58a8e..f8e2e99957 100644
--- a/collects/syntax/private/stxparse/rep.ss
+++ b/collects/syntax/private/stxparse/rep.ss
@@ -306,7 +306,7 @@
 
 ;; parse-head-pattern : stx DeclEnv -> HeadPattern
 (define (parse-head-pattern stx decls)
-  (syntax-case stx (~or ~seq ~describe)
+  (syntax-case stx (~or ~seq ~describe ~optional)
     [id
      (and (identifier? #'id) (not (reserved? #'id)))
      (parse-pat:id stx decls #t)]
@@ -316,6 +316,8 @@
      (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)]))
 
@@ -567,7 +569,18 @@
     [else
      (wrong-syntax stx "expected proper list pattern")]))
 
+(define (parse-hpat:optional stx decls)
+  (define-values (head all-iattrs _name _tmm defaults)
+    (parse-optional-pattern stx decls h-optional-directive-table))
+  (make hpat:optional all-iattrs head defaults))
+
 (define (parse-ehpat/optional stx decls)
+  (define-values (head all-iattrs name too-many-msg defaults)
+    (parse-optional-pattern stx decls eh-optional-directive-table))
+  (make ehpat all-iattrs head
+        (make rep:optional name too-many-msg defaults)))
+
+(define (parse-optional-pattern stx decls optional-directive-table)
   (syntax-case stx (~optional)
     [(~optional p . options)
      (let ([head (parse-head-pattern #'p decls)])
@@ -587,8 +600,7 @@
          (define all-iattrs
            (union-iattrs (list pattern-iattrs defaults-iattrs)))
          (check-iattrs-subset defaults-iattrs pattern-iattrs stx)
-         (make ehpat all-iattrs head
-               (make rep:optional name too-many-msg defaults))))]))
+         (values head all-iattrs name too-many-msg defaults)))]))
 
 (define (parse-ehpat/once stx decls)
   (syntax-case stx (~once)
@@ -876,8 +888,12 @@
 (define describe-option-table
   (list (list '#:transparent)))
 
-;; optional-directive-table
-(define optional-directive-table
+;; eh-optional-directive-table
+(define eh-optional-directive-table
   (list (list '#:too-many check-expression)
         (list '#:name check-expression)
         (list '#:defaults check-bind-clause-list)))
+
+;; h-optional-directive-table
+(define h-optional-directive-table
+  (list (list '#:defaults check-bind-clause-list)))
diff --git a/collects/syntax/scribblings/parse.scrbl b/collects/syntax/scribblings/parse.scrbl
index c86777e379..bd2910e358 100644
--- a/collects/syntax/scribblings/parse.scrbl
+++ b/collects/syntax/scribblings/parse.scrbl
@@ -12,16 +12,31 @@
 @(define ellipses @scheme[...])
 
 @(begin
+   (define (fixup exn)
+     (let ([src (ormap values (exn:fail:syntax-exprs exn))])
+       (if src
+           (make-exn:fail:syntax
+            (format "~a at: ~a" (exn-message exn) (syntax->datum src))
+            (exn-continuation-marks exn)
+            (exn:fail:syntax-exprs exn))
+           exn)))
    (define the-eval
      (parameterize ((sandbox-output 'string)
-                    (sandbox-error-output 'string))
+                    (sandbox-error-output 'string)
+                    (sandbox-make-code-inspector current-code-inspector)
+                    (sandbox-eval-handlers
+                     (list #f
+                           (lambda (thunk)
+                             (with-handlers ([exn:fail:syntax?
+                                              (lambda (e) (raise (fixup e)))])
+                               (thunk))))))
        (make-evaluator 'scheme/base
                        #:requires '(syntax/parse (for-syntax scheme/base)))))
+   (the-eval '(error-print-source-location #f))
    (define-syntax-rule (myexamples e ...)
-     (parameterize ((error-print-source-location #f))
-       (examples #:eval the-eval e ...))))
+     (examples #:eval the-eval e ...)))
 
-@title[#:tag "stxparse"]{Parsing and classifying syntax}
+@title[#:tag "stxparse" #:style '(toc)]{Parsing and classifying syntax}
 
 The @schememodname[syntax/parse] library provides a framework for
 describing and parsing syntax. Using @schememodname[syntax/parse],
@@ -32,6 +47,8 @@ which offers many improvements over @scheme[syntax-case].
 
 @defmodule[syntax/parse]
 
+@local-table-of-contents[]
+
 @;{----------}
 
 @section{Parsing syntax}
@@ -59,25 +76,33 @@ subterms of the syntax object and that clause's side conditions and
 If the syntax object fails to match any of the patterns (or all
 matches fail the corresponding clauses' side conditions), a syntax
 error is raised. If the @scheme[#:context] argument is given,
-@scheme[context-expr] is used in reporting the error.
+@scheme[context-expr] is used in reporting the error; otherwise
+@scheme[stx-expr] is used.
+
+@(myexamples
+  (syntax-parse #'(a b 3)
+    [(x:id ...) 'ok])
+  (syntax-parse #'(a b 3)
+    #:context #'(lambda (a b 3) (+ a b))
+    [(x:id ...) 'ok]))
 
 The @scheme[#:literals] option specifies identifiers that should match
-as literals, rather than simply being pattern variables. A literal in
-the literals list has two components: the identifier used within the
-pattern to signify the positions to be matched (@scheme[pattern-id]),
-and the identifier expected to occur in those positions
-(@scheme[literal-id]). If the single-identifier form is used, the same
-identifier is used for both purposes.
+as @tech{literals}, rather than simply being @tech{pattern
+variables}. A literal in the literals list has two components: the
+identifier used within the pattern to signify the positions to be
+matched (@scheme[pattern-id]), and the identifier expected to occur in
+those positions (@scheme[literal-id]). If the single-identifier form
+is used, the same identifier is used for both purposes.
 
 @bold{Note:} Unlike @scheme[syntax-case], @scheme[syntax-parse]
 requires all literals to have a binding. To match identifiers by their
 symbolic names, consider using the @scheme[atom-in-list] syntax class
 instead.
 
-Many literals can be declared at once via one or more @tech{literal sets},
-imported with the @scheme[#:literal-sets] option. The literal-set
-definition determines the literal identifiers to recognize and the
-names used in the patterns to recognize those literals.
+Many literals can be declared at once via one or more @tech{literal
+sets}, imported with the @scheme[#:literal-sets] option. The
+literal-set definition determines the literal identifiers to recognize
+and the names used in the patterns to recognize those literals.
 
 The @scheme[#:conventions] option imports @tech{convention}s that give
 default syntax classes to pattern variables that do not explicitly
@@ -167,9 +192,9 @@ like the following form.
 @specsubform[pvar-id:syntax-class-id]{
 
 Matches only subterms specified by the @svar[syntax-class-id]. The
-syntax class's attributes are computed for the subterm and bound to
-the pattern variables formed by prefixing @svar[pvar-id.] to the
-name of the attribute. @svar[pvar-id] is bound to the matched
+syntax class's @tech{attributes} are computed for the subterm and
+bound to the pattern variables formed by prefixing @svar[pvar-id.] to
+the name of the attribute. @svar[pvar-id] is bound to the matched
 subterm.
 
 If @svar[pvar-id] is @scheme[_], no attributes are bound.
@@ -179,19 +204,27 @@ If @svar[pvar-id] is empty (that is, if the pattern is of the form
 bound, but their names are not prefixed first.
 
 @myexamples[
-(syntax-parse #'x
+(syntax-parse #'a
   [var:id (syntax-e #'var)])
 (syntax-parse #'12
   [var:id (syntax-e #'var)])
-(syntax-parse #'(x y z)
-  [var:id (syntax-e #'var)])]
+(define-syntax-class two
+  #:attributes (x y)
+  (pattern (x y)))
+(syntax-parse #'(a b)
+  [t:two (syntax->datum #'(t t.x t.y))])
+(syntax-parse #'(a b)
+  [t
+   #:declare t two
+   (syntax->datum #'(t t.x t.y))])]
+
 }
 
 @specsubform[literal-id]{
 
 An identifier that appears in the literals list is not a pattern
-variable; instead, it is a literal that matches any identifier
-@scheme[free-identifier=?] to it.
+variable; instead, it is a @deftech{literal} that matches any
+identifier @scheme[free-identifier=?] to it.
 
 Specifically, if @scheme[literal-id] is the ``pattern'' name of an
 entry in the literals list, then it represents a pattern that matches