diff --git a/collects/syntax/private/stxparse/codegen-data.ss b/collects/syntax/private/stxparse/codegen-data.ss
index 532fcfa4ca..45f71084a3 100644
--- a/collects/syntax/private/stxparse/codegen-data.ss
+++ b/collects/syntax/private/stxparse/codegen-data.ss
@@ -6,77 +6,6 @@
                        "runtime.ss"))
 (provide (all-defined-out))
 
-;; Frontiers
-
-;; A FrontierContextExpr (FCE) is one of
-;;  - (make-fce Id (listof FrontierIndexExpr))
-;; A FrontierIndexExpr is
-;;  - #'(+ Number expr ...)
-(define-struct fce (stx indexes) #:prefab)
-
-(define (empty-frontier x)
-  (make-fce x (list #'(+ 0))))
-
-(define (done-frontier x)
-  (make-fce x (list #'(+ 0) #'(+ +inf.0))))
-
-(define (frontier:add-car fc x)
-  (make-fce x (cons #'(+ 0) (fce-indexes fc))))
-
-(define (frontier:add-cdr fc)
-  (define (fi:add1 fi)
-    (syntax-case fi (+)
-      [(+ n . rest)
-       #`(+ #,(add1 (syntax-e #'n)) . rest)]))
-  (make-fce (fce-stx fc)
-            (cons (fi:add1 (stx-car (fce-indexes fc)))
-                  (stx-cdr (fce-indexes fc)))))
-
-(define (frontier:add-index fc expr)
-  (define (fi:add-index fi expr)
-    (syntax-case fi (+)
-      [(+ n . rest)
-       #`(+ n #,expr . rest)]))
-  (make-fce (fce-stx fc)
-            (cons (fi:add-index (stx-car (fce-indexes fc)) expr)
-                  (stx-cdr (fce-indexes fc)))))
-
-(define (frontier:add-unvector fc x)
-  (frontier:add-car fc x))
-(define (frontier:add-unbox fc x)
-  (frontier:add-car fc x))
-(define (frontier:add-unpstruct fc x)
-  (frontier:add-car fc x))
-
-(define (frontier:add-subparse fc x)
-  (frontier:add-car
-   (frontier:add-index (frontier:add-car fc x) +inf.0)
-   x))
-
-;; A DynamicFrontierContext (DFC) is a list of numbers.
-;; More operations on DFCs in runtime.ss
-
-(define (frontier->dfc-expr fc)
-  (define (fi->qq-part fi)
-    (syntax-case fi (+)
-      [(+ n)
-       #'n]
-      [expr #`(unquote expr)]))
-  (let ([fis (reverse (stx->list (fce-indexes fc)))])
-    (with-syntax ([(part ...) (map fi->qq-part fis)])
-      #`(quasiquote (part ...)))))
-
-(define (frontier->fstx-expr fc)
-  (fce-stx fc))
-
-(define (frontier->index-expr fc)
-  (syntax-case fc ()
-    [#s(fce stx (index0 index ...))
-     #'index0]))
-
-;; --------
-
-
 (define (get-kind kind)
   (syntax-case kind ()
     [#:pair pairK]
@@ -88,11 +17,10 @@
                       (and xkey (equal? xkey (quote key)))))
                 (list (lambda (s d)
                         #`(datum->syntax #,s (cdr (vector->list (struct->vector #,d))) #,s)))
-                (list (lambda (fc x)
-                        (frontier:add-unpstruct fc x))))]))
+                (list #'dfc-add-unpstruct))]))
 
 ;; A Kind is
-;;   (make-kind id (listof (id id -> stx)) (listof (FCE id -> FCE)))
+;;   (make-kind id (listof (id id -> stx)) (listof expr))
 
 (define-struct kind (predicate selectors frontier-procs) #:transparent)
 
@@ -100,16 +28,16 @@
   (make-kind #'pair?
              (list (lambda (s d) #`(car #,d))
                    (lambda (s d) #`(datum->syntax #,s (cdr #,d) #,s)))
-             (list (lambda (fc x) (frontier:add-car fc x))
-                   (lambda (fc x) (frontier:add-cdr fc)))))
+             (list #'dfc-add-car
+                   #'dfc-add-cdr)))
 
 (define vectorK
   (make-kind #'vector?
              (list (lambda (s d)
                      #`(datum->syntax #,s (vector->list #,d) #,s)))
-             (list (lambda (fc x) (frontier:add-unvector fc x)))))
+             (list #'dfc-add-unvector)))
 
 (define boxK
   (make-kind #'box?
              (list (lambda (s d) #`(unbox #,d)))
-             (list (lambda (fc x) (frontier:add-unbox fc x)))))
+             (list #'dfc-add-unbox)))
diff --git a/collects/syntax/private/stxparse/lib.ss b/collects/syntax/private/stxparse/lib.ss
index 97d7a74078..0bf49c2b4a 100644
--- a/collects/syntax/private/stxparse/lib.ss
+++ b/collects/syntax/private/stxparse/lib.ss
@@ -36,7 +36,7 @@
          kernel-literals)
 
 (define-syntax-rule (define-pred-stxclass name pred)
-  (define-syntax-class name #:attributes ()
+  (define-syntax-class name #:attributes () #:opaque
     (pattern x
              #:fail-unless (pred (syntax-e #'x)) #f)))
 
diff --git a/collects/syntax/private/stxparse/parse.ss b/collects/syntax/private/stxparse/parse.ss
index cc5a54cddf..421e0a0afd 100644
--- a/collects/syntax/private/stxparse/parse.ss
+++ b/collects/syntax/private/stxparse/parse.ss
@@ -36,14 +36,13 @@
 
 ;; ----
 
+;; An FCE is expr[DFC]
+
 ;; (fail expr #:expect expr #:fce FCE) : expr
 (define-syntax (fail stx)
   (syntax-case stx ()
     [(fail x #:expect p #:fce fce)
-     (let ([fc-expr (frontier->dfc-expr (wash #'fce))]
-           [fstx-expr (frontier->fstx-expr (wash #'fce))])
-       #`(enclosing-fail
-          (make-failure x #,fc-expr #,fstx-expr p)))]))
+     #'(enclosing-fail (make-failure x fce p))]))
 
 ;; (parse:rhs RHS (SAttr ...) (id ...) id boolean)
 ;;   : expr[(values ParseFunction DescriptionFunction)]
@@ -73,15 +72,13 @@
 (define-syntax (parse:variant stx)
   (syntax-case stx ()
     [(parse:variant x relsattrs variant #f)
-     (with-syntax ([#s(variant _ _ pattern _ (def ...)) #'variant]
-                   [fc (empty-frontier #'x)])
-       #`(let ()
+     (with-syntax ([#s(variant _ _ pattern _ (def ...)) #'variant])
+       #`(let ([fc (dfc-empty x)])
            def ...
            (parse:S x fc pattern (variant-success x relsattrs variant ()))))]
     [(parse:variant x relsattrs variant #t)
-     (with-syntax ([#s(variant _ _ pattern _ (def ...)) #'variant]
-                   [fc (empty-frontier #'x)])
-       #`(let ()
+     (with-syntax ([#s(variant _ _ pattern _ (def ...)) #'variant])
+       #`(let ([fc (dfc-empty x)])
            def ...
            (parse:H x fc pattern rest index
                     (variant-success x relsattrs variant (rest index)))))]))
@@ -104,17 +101,19 @@
     [(convert-sides x (side0 . sides) (k iattrs . kargs))
      (syntax-case #'side0 ()
        [#s(clause:fail condition message)
-        #`(let ([c (without-fails condition)])
+        #`(let* ([c (without-fails condition)]
+                 [fc (dfc-add-post (dfc-empty x) (if (syntax? c) c x))])
             (if c
                 (fail (if (syntax? c) c x)
                       #:expect (expectation-of-message message)
-                      #:fce #,(frontier:add-subparse (done-frontier #'x) #'(if (syntax? c) c x)))
+                      #:fce fc)
                 (convert-sides x sides (k iattrs . kargs))))]
        [#s(clause:with pattern expr (def ...))
         (with-syntax ([(p-iattr ...) (pattern-attrs (wash #'pattern))])
-          #`(let ([y (datum->syntax #f (without-fails expr))])
+          #`(let* ([y (datum->syntax #f (without-fails expr))]
+                   [fc (dfc-add-post (dfc-empty x) y)])
               def ...
-              (parse:S y #,(done-frontier #'x) pattern
+              (parse:S y fc pattern
                        (convert-sides x sides
                                       (k (p-iattr ... . iattrs) . kargs)))))]
        [#s(clause:attr a expr)
@@ -156,11 +155,10 @@
                                                      #:decls decls0
                                                      #:context #'ctx)])
                (with-syntax ([rest rest]
-                             [fc (empty-frontier #'x)]
                              [pattern
                               (parse-whole-pattern #'p decls2 #:context #'ctx)]
                              [(local-def ...) defs2])
-                 #`(let ()
+                 #`(let ([fc (dfc-empty x)])
                      local-def ...
                      (parse:S x fc pattern
                               (convert-sides x #,sides
@@ -194,9 +192,9 @@
   (syntax-case stx ()
     [(parse:S x fc pattern0 k)
      (syntax-case #'pattern0 ()
-       [#s(internal-rest-pattern rest index index0)
+       [#s(internal-rest-pattern rest rest-fc)
         #`(let ([rest x]
-                [index (- #,(frontier->index-expr (wash #'fc)) index0)])
+                [rest-fc fc])
             k)]
        [#s(pat:name attrs pattern (name ...))
         #`(let-attributes ([#s(attr name 0 #t) x] ...)
@@ -231,8 +229,8 @@
        [#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))]
+        #`(parse:H x fc head rest rest-fc
+                   (parse:S rest rest-fc tail k))]
        [#s(pat:dots attrs head tail)
         #`(parse:dots x fc head tail k)]
        [#s(pat:and attrs subpatterns)
@@ -258,17 +256,16 @@
         (let ([kind (get-kind (wash #'kind0))])
           (with-syntax ([(part ...) (generate-temporaries (kind-selectors kind))])
             (with-syntax ([predicate (kind-predicate kind)]
-                          [(part-fc ...)
-                           (for/list ([fproc (kind-frontier-procs kind)]
-                                      [part-var (syntax->list #'(part ...))])
-                             (fproc (wash #'fc) part-var))]
+                          [(part-fc ...) (generate-temporaries #'(part ...))]
+                          [(part-fc-proc ...) (kind-frontier-procs kind)]
                           [(part-expr ...)
                            (for/list ([selector (kind-selectors kind)])
                              (selector #'x #'datum))])
               #`(let ([datum (syntax-e x)])
                   (if (predicate datum)
                       (let ([part part-expr] ...)
-                        (parse:S* (part ...) (part-fc ...) (part-pattern ...) k))
+                        (let ([part-fc (part-fc-proc fc part)] ...)
+                          (parse:S* (part ...) (part-fc ...) (part-pattern ...) k)))
                       (fail x
                             #:expect (expectation pattern0)
                             #:fce fc))))))]
@@ -280,10 +277,11 @@
                     #:expect (expectation-of-thing description transparent? failure)
                     #:fce fc))
             (with-enclosing-fail* new-fail
-              (parse:S x #,(empty-frontier #'x) pattern
-                       (with-enclosing-cut-fail previous-cut-fail
-                         (with-enclosing-fail previous-fail
-                           k)))))])]))
+              (let ([new-fc (dfc-empty x)])
+                (parse:S x new-fc pattern
+                         (with-enclosing-cut-fail previous-cut-fail
+                           (with-enclosing-fail previous-fail
+                             k))))))])]))
 
 ;; (parse:S* (id ...) (FCE ...) (SinglePattern ...) expr) : expr
 (define-syntax parse:S*
@@ -326,16 +324,17 @@
        [#s(ghost:bind _ clauses)
         #`(convert-sides x clauses (clause-success () k))]
        [#s(ghost:fail _ condition message)
-        #`(let ([c (without-fails condition)])
+        #`(let* ([c (without-fails condition)]
+                 [fc* (dfc-add-post fc (if (syntax? c) c x))])
             (if c
                 (fail (if (syntax? c) c x)
                       #:expect (expectation pattern0)
-                      #:fce #,(frontier:add-subparse (wash #'fc) #'(if (syntax? c) c x)))
+                      #:fce fc*)
                 k))]
        [#s(ghost:parse _ pattern expr)
-        #`(let ([y (datum->syntax #f (without-fails expr))])
-            (parse:S y #,(frontier:add-subparse (wash #'fc) #'y)
-                     pattern k))])]))
+        #`(let* ([y (datum->syntax #f (without-fails expr))]
+                 [fc* (dfc-add-post fc y)])
+            (parse:S y fc* pattern k))])]))
 
 (begin-for-syntax
  ;; convert-list-pattern : ListPattern id -> SinglePattern
@@ -348,6 +347,9 @@
      [#s(pat:name attrs pattern names)
       (with-syntax ([pattern (convert-list-pattern #'pattern end-pattern)])
         #'#s(pat:name attrs pattern names))]
+     [#s(pat:ghost attrs ghost tail)
+      (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
+        #'#s(pat:ghost attrs ghost tail))]
      [#s(pat:head attrs head tail)
       (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
         #'#s(pat:head attrs head tail))]
@@ -361,7 +363,7 @@
 ;; (parse:H id FCE HeadPattern id id expr) : expr
 (define-syntax (parse:H stx)
   (syntax-case stx ()
-    [(parse:H x fc head rest index k)
+    [(parse:H x fc head rest rest-fc k)
      (syntax-case #'head ()
        [#s(hpat:describe _ description transparent? pattern)
         #`(let ([previous-fail enclosing-fail]
@@ -370,70 +372,66 @@
               (fail x
                     #:expect (expectation-of-thing description transparent? failure)
                     #:fce fc))
-            (with-enclosing-fail* new-fail
-              (parse:H x #,(empty-frontier #'x) pattern
-                       rest index
+            (let ([fc* (dfc-empty x)])
+              (with-enclosing-fail* new-fail
+                (parse:H x fc* pattern rest rest-fc
                        (with-enclosing-cut-fail previous-cut-fail
                          (with-enclosing-fail previous-fail
-                           k)))))]
+                           k))))))]
        [#s(hpat:var _attrs name parser (arg ...) (nested-a ...))
         #`(let ([result (parser x)])
             (if (ok? result)
-                (let ([rest (car result)]
-                      [index (cadr result)])
+                (let* ([rest (car result)]
+                       [local-fc (cadr result)]
+                       [rest-fc (dfc-append fc local-fc)])
                   (let-attributes (#,@(if (identifier? #'name)
                                           #'([#s(attr name 0 #t)
-                                              (stx-list-take x index)])
+                                              (stx-list-take x (dfc->index local-fc))])
                                           #'()))
                     (let/unpack ((nested-a ...) (cddr result))
                       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:H x fc head rest rest-fc
+                   (let ([lst (stx-list-take x (dfc-difference fc rest-fc))])
                      (parse:S lst fc single k)))]
        [#s(hpat:or (a ...) (subpattern ...))
         (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
           #`(let ([success
-                   (lambda (rest index fail id ...)
+                   (lambda (rest rest-fc fail id ...)
                      (with-enclosing-fail fail
                        (let-attributes ([a id] ...) k)))])
-              (try (parse:H x fc subpattern rest index
+              (try (parse:H x fc subpattern rest rest-fc
                             (disjunct subpattern success
-                                      (rest index enclosing-fail) (id ...)))
+                                      (rest rest-fc enclosing-fail) (id ...)))
                    ...)))]
        [#s(hpat:seq attrs pattern)
-        (with-syntax ([index0 (frontier->index-expr (wash #'fc))])
-          (with-syntax ([pattern
-                         (convert-list-pattern
-                          #'pattern
-                          #'#s(internal-rest-pattern rest index index0))])
-            #'(parse:S x fc pattern k)))]
+        (with-syntax ([pattern
+                       (convert-list-pattern
+                        #'pattern
+                        #'#s(internal-rest-pattern rest rest-fc))])
+          #'(parse:S x fc pattern k))]
        [#s(hpat:optional (a ...) pattern defaults)
-        (with-syntax ([(#s(attr id _ _) ...) #'(a ...)]
-                      [index0 (frontier->index-expr (wash #'fc))])
+        (with-syntax ([(#s(attr id _ _) ...) #'(a ...)])
           #`(let ([success
-                   (lambda (rest index fail id ...)
+                   (lambda (rest rest-fc 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) ...))
+              (try (parse:H x fc pattern rest rest-fc
+                            (success rest rest-fc enclosing-fail (attribute id) ...))
                    (let ([rest x]
-                         [index index0])
+                         [rest-fc fc])
                      (convert-sides x defaults
                        (clause-success ()
                          (disjunct/sides defaults success
-                                         (rest index enclosing-fail)
+                                         (rest rest-fc enclosing-fail)
                                          (id ...))))))))]
        [_
-        (with-syntax ([attrs (pattern-attrs (wash #'head))]
-                      [index0 (frontier->index-expr (wash #'fc))])
+        (with-syntax ([attrs (pattern-attrs (wash #'head))])
           #'(parse:S x fc
                      #s(pat:compound attrs
                                      #:pair
-                                     (head #s(internal-rest-pattern
-                                              rest index
-                                              index0)))
+                                     (head #s(internal-rest-pattern rest rest-fc)))
                      k))])]))
 
 ;; (parse:dots id FCE EHPattern SinglePattern expr) : expr
@@ -462,34 +460,33 @@
                      [(rel-rep ...) rel-rep-ids]
                      [(rel-repc ...) rel-repcs]
                      [(a ...) attrs]
-                     [(attr-repc ...) attr-repcs]
-                     [loop-fc (frontier:add-index (wash #'fc) #'index)])
+                     [(attr-repc ...) attr-repcs])
          (define-pattern-variable alt-map #'((id . alt-id) ...))
          (define-pattern-variable loop-k
-           #'(dots-loop dx (+ index index2) enclosing-fail rel-rep ... alt-id ...))
+           #'(dots-loop dx loop-fc* enclosing-fail rel-rep ... alt-id ...))
          #`(let ()
-             (define (dots-loop dx index loop-fail rel-rep ... alt-id ...)
+             (define (dots-loop dx loop-fc loop-fail rel-rep ... alt-id ...)
                (with-enclosing-fail loop-fail
-                 (try (parse:EH dx loop-fc head head-repc index2 alt-map head-rep
+                 (try (parse:EH dx loop-fc head head-repc loop-fc* alt-map head-rep
                                 loop-k)
                       ...
                       (cond [(< rel-rep (rep:min-number rel-repc))
                              (fail dx
                                    #:expect (expectation-of-reps/too-few rel-rep rel-repc)
-                                   #:fce loop-fc)]
+                                   #:fce (dfc-add-pre loop-fc #f))]
                             ...
                             [else
                              (let-attributes ([a (rep:finalize a attr-repc alt-id)] ...)
                                (parse:S dx loop-fc tail k))]))))
              (let ([rel-rep 0] ...
                    [alt-id (rep:initial-value attr-repc)] ...)
-               (dots-loop x 0 enclosing-fail rel-rep ... alt-id ...)))))]))
+               (dots-loop x fc enclosing-fail rel-rep ... alt-id ...)))))]))
 
 ;; (parse:EH id FCE EHPattern id id ((id . id) ...)
 ;;           RepConstraint/#f expr) : expr
 (define-syntax (parse:EH stx)
   (syntax-case stx ()
-    [(parse:EH x fc head repc index alts rep k0)
+    [(parse:EH x fc head repc fc* alts rep k0)
      (let ()
        (define-pattern-variable k
          (let* ([main-attrs (wash-iattrs (pattern-attrs (wash #'head)))]
@@ -506,14 +503,13 @@
              #`(let ([alt-id (rep:combine repc (attribute id) alt-id)] ...)
                  k0))))
        (syntax-case #'repc ()
-         [#f #`(parse:H x fc head x index k)]
-         [_  #`(parse:H x fc head x index
+         [#f #`(parse:H x fc head x fc* k)]
+         [_  #`(parse:H x fc head x fc*
                         (if (< rep (rep:max-number repc))
                             (let ([rep (add1 rep)]) k)
                             (fail x
                                   #:expect (expectation-of-reps/too-many rep repc)
-                                  #:fce #,(frontier:add-index (wash #'fc)
-                                                              #'index))))]))]))
+                                  #:fce fc*)))]))]))
 
 ;; (rep:initial-value RepConstraint) : expr
 (define-syntax (rep:initial-value stx)
diff --git a/collects/syntax/private/stxparse/runtime-prose.ss b/collects/syntax/private/stxparse/runtime-prose.ss
index 16338611b7..fb5fe1a945 100644
--- a/collects/syntax/private/stxparse/runtime-prose.ss
+++ b/collects/syntax/private/stxparse/runtime-prose.ss
@@ -11,23 +11,27 @@
          (for-syntax "../util/error.ss")
          "runtime.ss")
 (provide syntax-patterns-fail
-         current-failure-handler)
+         current-failure-handler
+         simplify-failure)
 
 ;; Failure reporting parameter & default
 
 (define (default-failure-handler stx0 f)
   (match (simplify-failure f)
-    [#s(failure x frontier frontier-stx expectation)
-     (report-failure stx0 x (last frontier) frontier-stx expectation)]))
+    [#s(failure x frontier expectation)
+     (report-failure stx0 x (dfc->index frontier) (dfc->stx frontier) expectation)]))
 
 (define current-failure-handler
   (make-parameter default-failure-handler))
 
 (define ((syntax-patterns-fail stx0) f)
-  (let ([value ((current-failure-handler) stx0 f)])
-    (error 'current-failure-handler
-           "current-failure-handler: did not escape, produced ~e" value)))
-
+  (call-with-values (lambda () ((current-failure-handler) stx0 f))
+    (lambda vals
+      (error 'current-failure-handler
+             "current-failure-handler: did not escape, produced ~e"
+             (case (length vals)
+               ((1) (car vals))
+               (else (cons 'values vals)))))))
 
 ;; report-failure : stx stx number stx Expectation -> (escapes)
 (define (report-failure stx0 x index frontier-stx expected)
@@ -39,6 +43,7 @@
            [(one)
             (err "unexpected term" stx0 #'one)]
            [(first . more)
+            ;; TODO: report error with all elements (use improper-stx->list)
             (err "unexpected terms starting here" stx0 #'first)]
            [_
             (err "unexpected term" stx0 x)])]
@@ -48,7 +53,6 @@
            (err (format "~a~a"
                         msg
                         (cond [(zero? index) ""]
-                              [(= index +inf.0) "" #|" after matching main pattern"|#]
                               [else (format " after ~s ~a"
                                             index
                                             (if (= 1 index) "term" "terms"))]))
@@ -57,50 +61,66 @@
         [else
          (err "bad syntax" stx0 stx0)]))
 
-;; FIXME: try different selection/simplification algorithms/heuristics
+;; simplify-failure : Failure -> SimpleFailure
 (define (simplify-failure f)
+  (simplify* f))
+
+;; simplify* : Failure -> SimpleFailure
+(define (simplify* f)
   (match f
     [#s(join-failures f1 f2)
-     (choose-error (simplify-failure f1) (simplify-failure f2))]
-    [#s(failure x frontier frontier-stx expectation)
+     (choose-error (simplify* f1) (simplify* f2))]
+    [#s(failure x frontier expectation)
      (match expectation
        [#s(expect:thing description '#t chained)
-        (let ([new-f (simplify-failure (adjust-failure chained frontier frontier-stx))])
-          (match new-f
-            [#s(failure _ _ _ new-e)
-             (if (ineffable? new-e)
-                 ;; If unfolded failure is ineffable, fall back to the one with description
-                 f
-                 new-f)]
-            [_ new-f]))]
+        (let ([chained* (simplify* chained)])
+          (match chained*
+            [#s(failure _ chained*-frontier chained*-expectation)
+             (cond [(ineffable? chained*-expectation)
+                    ;; If simplified chained failure is ineffable,
+                    ;; keep (& adjust) its frontier
+                    ;; and attach enclosing description
+                    (adjust-failure
+                     (make-failure x chained*-frontier
+                                   (make-expect:thing description #f #f))
+                     frontier)]
+                   [else
+                    ;; Otherwise, "expose" the chained failure and
+                    ;; adjust its frontier
+                    (adjust-failure chained* frontier)])]))]
        [_ f])]))
 
-(define (adjust-failure f base-frontier base-frontier-stx)
+;; FIXME: try different selection/simplification algorithms/heuristics
+(define (simplify-failure0 f)
   (match f
     [#s(join-failures f1 f2)
-     (make-join-failures
-      (adjust-failure f1 base-frontier base-frontier-stx)
-      (adjust-failure f2 base-frontier base-frontier-stx))]
-    [#s(failure x frontier frontier-stx expectation)
-     (let-values ([(frontier frontier-stx)
-                   (combine-frontiers base-frontier base-frontier-stx
-                                      frontier frontier-stx)])
-       (make-failure x frontier frontier-stx expectation))]))
+     (choose-error (simplify-failure0 f1) (simplify-failure0 f2))]
+    [#s(failure x frontier expectation)
+     (match expectation
+       [#s(expect:thing description '#t chained)
+        (let ([chained* (simplify-failure0 chained)])
+          (match chained*
+            [#s(failure _ _ chained*-expectation)
+             (cond [(ineffable? chained*-expectation)
+                    ;; If simplified chained failure is ineffable, ignore it
+                    ;; and stick to the one with the description
+                    f]
+                   [else
+                    ;; Otherwise, "expose" the chained failure
+                    ;; and adjust its frontier
+                    (adjust-failure chained* frontier)])]))]
+       [_ f])]))
 
-(define (combine-frontiers dfc0 stx0 dfc stx)
-  (cond [(null? (cdr dfc0))
-         (values (cons (+ (car dfc0) (car dfc))
-                       (cdr dfc))
-                 (if (null? (cdr dfc))
-                     stx0
-                     stx))]
-        [else
-         (let-values ([(f s) (combine-frontiers (cdr dfc0) stx0 dfc stx)])
-           (values (cons (car dfc0) f) s))]))
+(define (adjust-failure f base-frontier)
+  (match f
+    [#s(failure x frontier expectation)
+     (let ([frontier (dfc-append base-frontier frontier)])
+       (make-failure x frontier expectation))]))
 
-;; choose-error : Failure Failure -> Result
+;; choose-error : Failure Failure -> Failure
 (define (choose-error f1 f2)
-  (case (compare-dfcs (failure-frontier f1) (failure-frontier f2))
+  (case (compare-idfcs (invert-dfc (failure-frontier f1))
+                       (invert-dfc (failure-frontier f2)))
     [(>) f1]
     [(<) f2]
     [(=) (merge-failures f1 f2)]))
@@ -109,7 +129,6 @@
 (define (merge-failures f1 f2)
   (make-failure (failure-stx f1)
                 (failure-frontier f1)
-                (failure-frontier-stx f1)
                 (merge-expectations (failure-expectation f1)
                                     (failure-expectation f2))))
 
@@ -163,3 +182,9 @@
     [(2) (format "~a~a ~a~a" prefix (car items) ult (cadr items))]
     [else (let ([strings (list* (car items) (loop (cdr items)))])
             (apply string-append prefix strings))]))
+
+(define (improper-stx->list stx)
+  (syntax-case stx ()
+    [(a . b) (cons #'a (improper-stx->list #'b))]
+    [() null]
+    [rest (list #'rest)]))
diff --git a/collects/syntax/private/stxparse/runtime.ss b/collects/syntax/private/stxparse/runtime.ss
index 34aa48f88f..29ee0e8578 100644
--- a/collects/syntax/private/stxparse/runtime.ss
+++ b/collects/syntax/private/stxparse/runtime.ss
@@ -2,6 +2,7 @@
 (require scheme/contract/base
          scheme/stxparam
          scheme/list
+         "minimatch.ss"
          (for-syntax scheme/base
                      syntax/stx
                      scheme/private/sc
@@ -32,8 +33,6 @@
 
          this-syntax
 
-         compare-dfcs
-
          expect?
          expectation?
          (struct-out expect:thing)
@@ -121,21 +120,161 @@
 
 ;; == Dynamic Frontier Contexts (DFCs)
 
-;; A DFC is a list of numbers.
+(provide (struct-out dfc:empty)
+         (struct-out dfc:car)
+         (struct-out dfc:cdr)
+         (struct-out dfc:pre)
+         (struct-out dfc:post)
+         dfc-empty
+         dfc-add-car
+         dfc-add-cdr
+         dfc-add-pre
+         dfc-add-post
+         dfc-add-unbox
+         dfc-add-unvector
+         dfc-add-unpstruct
 
-;; compare-dfcs : DFC DFC -> (one-of '< '= '>)
+         dfc->index
+         dfc->stx
+         dfc-difference
+         dfc-append
+
+         invert-dfc
+         compare-idfcs
+         idfc>?
+         idfc=?)
+
+#|
+A Dynamic Frontier Context (DFC) is one of
+  - (make-dfc:empty stx)
+  - (make-dfc:car DFC stx)
+  - (make-dfc:cdr DFC positive-integer)
+  - (make-dfc:pre DFC stx)
+  - (make-dfc:post DFC stx)
+|#
+
+(define-struct dfc:empty (stx) #:prefab)
+(define-struct dfc:car (parent stx) #:prefab)
+(define-struct dfc:cdr (parent n) #:prefab)
+(define-struct dfc:pre (parent stx) #:prefab)
+(define-struct dfc:post (parent stx) #:prefab)
+
+(define (dfc-empty x) (make-dfc:empty x))
+(define (dfc-add-car parent stx)
+  (make-dfc:car parent stx))
+(define (dfc-add-cdr parent _)
+  (match parent
+    [#s(dfc:cdr uberparent n)
+     (make-dfc:cdr uberparent (add1 n))]
+    [_ (make-dfc:cdr parent 1)]))
+(define (dfc-add-pre parent stx)
+  (make-dfc:pre parent stx))
+(define (dfc-add-post parent stx)
+  (make-dfc:post parent stx))
+
+(define (dfc-add-unbox parent stx)
+  (dfc-add-car parent stx))
+(define (dfc-add-unvector parent stx)
+  (dfc-add-car parent stx))
+(define (dfc-add-unpstruct parent stx)
+  (dfc-add-car parent stx))
+
+(define (dfc->index dfc)
+  (match dfc
+    [#s(dfc:cdr parent n) n]
+    [_ 0]))
+
+(define (dfc->stx dfc)
+  (match dfc
+    [#s(dfc:empty stx) stx]
+    [#s(dfc:car parent stx) stx]
+    [#s(dfc:cdr parent n) (dfc->stx parent)]
+    [#s(dfc:pre parent stx) stx]
+    [#s(dfc:post parent stx) stx]))
+
+;; dfc-difference : DFC DFC -> nat
+;; Returns N s.t. B = (dfc-add-cdr^N A)
+(define (dfc-difference a b)
+  (define (whoops)
+    (error 'dfc-difference "~e is not an extension of ~e"
+           (frontier->sexpr b) (frontier->sexpr a)))
+  (match (list a b)
+    [(list #s(dfc:cdr pa na) #s(dfc:cdr pb nb))
+     (unless (equal? pa pb) (whoops))
+     (- nb na)]
+    [(list pa #s(dfc:cdr pb nb))
+     (unless (equal? pa pb) (whoops))
+     nb]
+    [_
+     (unless (equal? a b) (whoops))
+     0]))
+
+;; dfc-append : DFC DFC -> DFC
+;; puts A at the base, B on top
+(define (dfc-append a b)
+  (match b
+    [#s(dfc:empty stx) a]
+    [#s(dfc:car pb stx) (make-dfc:car (dfc-append a pb) stx)]
+    [#s(dfc:cdr #s(dfc:empty _) nb)
+     ;; Special case to merge "consecutive" cdr frames
+     (match a
+       [#s(dfc:cdr pa na) (make-dfc:cdr pa (+ na nb))]
+       [_ (make-dfc:cdr a nb)])]
+    [#s(dfc:cdr pb nb) (make-dfc:cdr (dfc-append a pb) nb)]
+    [#s(dfc:pre pb stx) (make-dfc:pre (dfc-append a pb) stx)]
+    [#s(dfc:post pb stx) (make-dfc:post (dfc-append a pb) stx)]))
+
+
+;; An Inverted DFC (IDFC) is a DFC inverted for easy comparison.
+
+(define (invert-dfc dfc)
+  (define (invert dfc acc)
+    (match dfc
+      [#s(dfc:empty _) acc]
+      [#s(dfc:car parent stx)
+       (invert parent (make-dfc:car acc stx))]
+      [#s(dfc:cdr parent n)
+       (invert parent (make-dfc:cdr acc n))]
+      [#s(dfc:pre parent stx)
+       (invert parent (make-dfc:pre acc stx))]
+      [#s(dfc:post parent stx)
+       (invert parent (make-dfc:post acc stx))]))
+  (invert dfc (dfc-empty 'dummy)))
+
+;; compare-idfcs : IDFC IDFC -> (one-of '< '= '>)
 ;; Note A>B means A is "further along" than B.
-(define (compare-dfcs a b)
-  (cond [(and (null? a) (null? b))
-         '=]
-        [(and (pair? a) (null? b))
-         '>]
-        [(and (null? a) (pair? b))
-         '<]
-        [(and (pair? a) (pair? b))
-         (cond [(> (car a) (car b)) '>]
-               [(< (car a) (car b)) '<]
-               [else (compare-dfcs (cdr a) (cdr b))])]))
+;; Lexicographic generalization of PRE < CAR < CDR < POST
+(define (compare-idfcs a b)
+  (match (list a b)
+    ;; Same constructors
+    [(list #s(dfc:empty _) #s(dfc:empty _)) '=]
+    [(list #s(dfc:car pa _) #s(dfc:car pb _))
+     (compare-idfcs pa pb)]
+    [(list #s(dfc:cdr pa na) #s(dfc:cdr pb nb))
+     (cond [(< na nb) '<]
+           [(> na nb) '>]
+           [(= na nb) (compare-idfcs pa pb)])]
+    [(list #s(dfc:pre pa _) #s(dfc:pre pb _))
+     ;; FIXME: possibly just '= here, treat all sides as equiv
+     (compare-idfcs pa pb)]
+    [(list #s(dfc:post pa _) #s(dfc:post pb _))
+     ;; FIXME: possibly just '= here, treat all sides as equiv
+     (compare-idfcs pa pb)]
+    ;; Different constructors
+    [(list #s(dfc:empty _) _) '<]
+    [(list _ #s(dfc:empty _)) '>]
+    [(list #s(dfc:pre _ _) _) '<]
+    [(list _ #s(dfc:pre _ _)) '>]
+    [(list #s(dfc:car _ _) _) '<]
+    [(list _ #s(dfc:car _ _)) '>]
+    [(list #s(dfc:cdr _ _) _) '<]
+    [(list _ #s(dfc:cdr _ _)) '>]))
+
+(define (idfc>? a b)
+  (eq? (compare-idfcs a b) '>))
+
+(define (idfc=? a b)
+  (eq? (compare-idfcs a b) '=))
 
 ;; == Codegen internal syntax parameters
 
@@ -174,12 +313,12 @@
 ;; == Success and Failure
 
 ;; A Failure is one of
-;;   (make-failure stx DFC stx expectation/c)
+;;   (make-failure stx DFC expectation/c)
 ;;   (make-join-failures Failure Failure)
 
 (define ok? list?)
 
-(define-struct failure (stx frontier frontier-stx expectation) #:prefab)
+(define-struct failure (stx frontier expectation) #:prefab)
 (define-struct join-failures (f1 f2) #:prefab)
 
 ;; (try expr ...)
@@ -387,3 +526,44 @@ An Expectation is one of
       (for ([x v]) (loop (sub1 n) x))))
   (loop n0 v0)
   v0)
+
+
+;; ----
+
+;; debugging
+
+(provide failure->sexpr
+         one-failure->sexpr
+         frontier->sexpr
+         expectation->sexpr)
+
+(define (failure->sexpr f)
+  (define fs
+    (let loop ([f f])
+      (match f
+        [#s(join-failures f1 f2)
+         (append (loop f1) (loop f2))]
+        [_ (list f)])))
+  (case (length fs)
+    ((1) (one-failure->sexpr f))
+    (else `(union ,@(map one-failure->sexpr fs)))))
+
+(define (one-failure->sexpr f)
+  (match f
+    [#s(failure x frontier expectation)
+     `(failure ,(frontier->sexpr frontier)
+               #:term ,(syntax->datum x)
+               #:expected ,(expectation->sexpr expectation))]))
+
+(define (frontier->sexpr dfc)
+  (match (invert-dfc dfc)
+    [#s(dfc:empty _) '()]
+    [#s(dfc:car p _) (cons 0 (frontier->sexpr p))]
+    [#s(dfc:cdr p n) (cons n (frontier->sexpr p))]
+    [#s(dfc:side p _) (cons 'side (frontier->sexpr p))]))
+
+(define (expectation->sexpr expectation)
+  (match expectation
+    [#s(expect:thing thing '#t chained)
+     (make-expect:thing thing #t (failure->sexpr chained))]
+    [_ expectation]))
diff --git a/collects/syntax/private/stxparse/sc.ss b/collects/syntax/private/stxparse/sc.ss
index d4b3be5f39..98f7266228 100644
--- a/collects/syntax/private/stxparse/sc.ss
+++ b/collects/syntax/private/stxparse/sc.ss
@@ -19,6 +19,7 @@
 
          debug-rhs
          debug-pattern
+         debug-parse
 
          syntax-parse
          syntax-parser
@@ -175,6 +176,14 @@
      (let ([p (parse-whole-pattern #'p (new-declenv null) #:context stx)])
        #`(quote #,p))]))
 
+(define-syntax-rule (debug-parse x p)
+  (let/ec escape
+    (parameterize ((current-failure-handler
+                    (lambda (_ f)
+                      (escape (failure->sexpr f)
+                              (failure->sexpr (simplify-failure f))))))
+      (syntax-parse x [p 'success]))))
+
 (define-syntax (syntax-parse stx)
   (syntax-case stx ()
     [(syntax-parse stx-expr . clauses)
diff --git a/collects/tests/stxparse/select.ss b/collects/tests/stxparse/select.ss
new file mode 100644
index 0000000000..5cb56de502
--- /dev/null
+++ b/collects/tests/stxparse/select.ss
@@ -0,0 +1,88 @@
+#lang scheme
+(require schemeunit
+         syntax/parse)
+(require (for-syntax syntax/parse))
+(provide (all-defined-out))
+
+;; Error selection tests
+
+(error-print-source-location #f)
+
+(define-syntax-rule (terx s p stuff ...)
+  (terx* s [p] stuff ...))
+
+(define-syntax terx*
+  (syntax-parser
+    [(terx s [p ...] (~optional (~seq #:term term) #:defaults ([term #'#f])) rx ...)
+     #'(test-case (format "line ~s: ~a match ~s for error"
+                          (syntax-line (quote-syntax s))
+                          's '(p ...))
+         (let ([exn (let/ec escape
+                      (check-exn (lambda (exn)
+                                   (escape exn))
+                                 (lambda ()
+                                   (syntax-parse (quote-syntax s)
+                                     [p 'ok] ...))))])
+           (let ([msg (exn-message exn)]
+                 [stxs (and (exn:fail:syntax? exn)
+                            (exn:fail:syntax-exprs exn))])
+             (when 'term
+               (check-equal? (and (pair? stxs) (syntax->datum (car stxs))) 'term))
+             (erx rx (exn-message exn)) ... #t))
+         'ok)]))
+
+(define-syntax erx
+  (syntax-rules (not)
+    [(erx (not rx) msg)
+     (check (compose not regexp-match?) rx msg)]
+    [(erx rx msg)
+     (check regexp-match? rx msg)]))
+
+;; ----
+
+(terx* (1 2) [x:nat (y:id z:id)]
+       #:term 1
+       #rx"expected identifier")
+
+;; --
+
+(define-syntax-class bindings
+  (pattern ((var:id rhs:expr) ...)))
+
+(terx* ((x 1 2)) [x:id bs:bindings]
+       #:term 2
+       #rx"unexpected term")
+
+;; --
+
+(terx ((a 1) (a 2))
+      ((~or (~once ((~datum a) x) #:name "A clause")
+            (~optional ((~datum b) y) #:name "B clause"))
+       ...)
+      ;; #:term (a 2)
+      #rx"too many occurrences of A clause")
+
+;; --
+
+(define-syntax-class A
+  (pattern ((~datum a) x)))
+(define-syntax-class B
+  (pattern ((~datum b) y)))
+
+(terx ((a 1) (a 2))
+      ((~or (~once a:A #:name "A clause")
+            (~optional b:B #:name "B clause"))
+       ...)
+      #rx"too many occurrences of A clause")
+
+(terx ((a 1 2) _)
+      ((~or (~once a:A #:name "A clause")
+            (~optional b:B #:name "B clause"))
+       ...)
+      #rx"unexpected term")
+
+(terx ((b 1 2) _)
+      ((~or (~once a:A #:name "A clause")
+            (~optional b:B #:name "B clause"))
+       ...)
+      #rx"unexpected term")
diff --git a/collects/tests/stxparse/stxclass.ss b/collects/tests/stxparse/stxclass.ss
index 6bcded5217..d88d7fc9d5 100644
--- a/collects/tests/stxparse/stxclass.ss
+++ b/collects/tests/stxparse/stxclass.ss
@@ -1,7 +1,6 @@
 #lang scheme/base
 
-(require (planet schematics/schemeunit:2:9/test)
-         (planet schematics/schemeunit:2:9/graphical-ui)
+(require schemeunit
          syntax/parse
          (for-syntax scheme/base syntax/parse))
 
@@ -95,15 +94,15 @@
 
 ;; Tests
 
-(define tests
-  (test-suite "Syntax grammars"
-    (test-suite "sc attrs"
+(begin ;; define tests
+  (begin ;; test-suite "Syntax grammars"
+    (begin ;; test-suite "sc attrs"
       (test-sc-attrs one ([a 0]))
       (test-sc-attrs two ([a 0] [b 0]))
       (test-sc-attrs three ([a 0] [b 0] [c 0]))
       (test-sc-attrs two-or-three/tag ([a 0] [a.a 0] [a.b 0]))
       (test-sc-attrs id-num ([x 0] [n 0])))
-    (test-suite "parse-sc"
+    (begin ;; test-suite "parse-sc"
       (test-parse-sc one #'1 ([a 0 1]))
       (test-parse-sc two #'(1 2) ([a 0 1] [b 0 2]))
       (test-parse-sc three #'(1 2 3) ([a 0 1] [b 0 2] [c 0 3]))
@@ -113,7 +112,7 @@
                      ([x 0 this] [n 0 12]))
       (test-parse-sc id-string #'(that "here")
                      ([x 0 that] [label 0 "here"])))
-    (test-suite "with-patterns"
+    (begin ;; test-suite "with-patterns"
       (test-patterns (t:two-to-four/untagged ...) #'((1 2 3) (4 5) (6 7 8))
         (check-equal? (syntax->datum #'(t.a ...)) '(1 4 6)))
       (test-patterns (t:two-to-four/untagged ...) #'((1 2 3) (4 5) (6 7 8))
diff --git a/collects/tests/stxparse/test.ss b/collects/tests/stxparse/test.ss
index f31c7186c3..8539559364 100644
--- a/collects/tests/stxparse/test.ss
+++ b/collects/tests/stxparse/test.ss
@@ -54,7 +54,7 @@
                         (syntax-line (quote-syntax s))
                         's '(p ...))
        (check-exn (lambda (exn)
-                    (erx rx (exn-message exn)) ...)
+                    (erx rx (exn-message exn)) ... #t)
                   (lambda ()
                     (syntax-parse (quote-syntax s)
                       [p 'ok] ...)))
@@ -63,7 +63,7 @@
 (define-syntax erx
   (syntax-rules (not)
     [(erx (not rx) msg)
-     (check-false (regexp-match? rx msg))]
+     (check (compose not regexp-match?) rx msg)]
     [(erx rx msg)
      (check regexp-match? rx msg)]))
 
@@ -220,8 +220,8 @@
 ;; -- A patterns
 
 ;; cut patterns
-(terx* (1 2 3) [(1 ~! 4) (1 2 3)]
-       "4" (not "2"))
+(terx* (1 2 3) [(1 ~! 4) (1 _:nat 3)]
+       "4" (not "exact nonnegative integer"))
 
 ;; cut-in-and
 (terx* 1 [(~and a:nat ~! 2) b:nat]