diff --git a/racket/collects/syntax/parse/private/opt.rkt b/racket/collects/syntax/parse/private/opt.rkt
index b569dcc9f3..0e7af8e5a8 100644
--- a/racket/collects/syntax/parse/private/opt.rkt
+++ b/racket/collects/syntax/parse/private/opt.rkt
@@ -175,68 +175,36 @@
              [else (values p onto)]))]
     [_ (values p onto)]))
 
-(define (pattern-factorable? p)
-  ;; Can factor out p if p can succeed at most once, does not cut
-  ;;  - if p can succeed multiple times, then factoring changes success order
-  ;;  - if p can cut, then factoring changes which choice points are discarded (too few)
-  (match p
-    [(pat:any) #t]
-    [(pat:svar _n) #t]
-    [(pat:var/p _ _ _ _ _ (scopts _ commit? _ _))
-     ;; commit? implies delimit-cut
-     commit?]
-    [(? pat:integrated?) #t]
-    [(pat:literal _lit _ip _lp) #t]
-    [(pat:datum _datum) #t]
-    [(pat:action _act _pat) #f]
-    [(pat:head head tail)
-     (and (pattern-factorable? head)
-          (pattern-factorable? tail))]
-    [(pat:dots heads tail)
-     ;; Conservative approximation for common case: one head pattern
-     ;; In general, check if heads don't overlap, don't overlap with tail.
-     (and (= (length heads) 1)
-          (let ([head (car heads)])
-            (and (pattern-factorable? head)))
-          (equal? tail (pat:datum '())))]
-    [(pat:and patterns)
-     (andmap pattern-factorable? patterns)]
-    [(pat:or _ patterns _) #f]
-    [(pat:not pattern) #f] ;; FIXME: ?
-    [(pat:pair head tail)
-     (and (pattern-factorable? head)
-          (pattern-factorable? tail))]
-    [(pat:vector pattern)
-     (pattern-factorable? pattern)]
-    [(pat:box pattern)
-     (pattern-factorable? pattern)]
-    [(pat:pstruct key pattern)
-     (pattern-factorable? pattern)]
-    [(pat:describe pattern _desc _trans _role)
-     (pattern-factorable? pattern)]
-    [(pat:delimit pattern)
-     (pattern-factorable? pattern)]
-    [(pat:commit pattern) #t]
-    [(? pat:reflect?) #f]
-    [(pat:ord pattern _ _)
-     (pattern-factorable? pattern)]
-    [(pat:post pattern)
-     (pattern-factorable? pattern)]
-    [(pat:seq-end) #t]
-    ;; ----
-    [(hpat:single inner)
-     (pattern-factorable? inner)]
-    [(hpat:var/p _ _ _ _ _ (scopts _ commit? _ _))
-     commit?]
-    [(hpat:seq inner)
-     (pattern-factorable? inner)]
-    [(hpat:commit inner) #t]
-    ;; ----
-    [(ehpat _ head repc _)
-     (and (equal? repc #f)
-          (pattern-factorable? head))]
-    ;; ----
-    [else #f]))
+;; pattern-factorable? : *Pattern -> Boolean
+(define (pattern-factorable? p) (not (pattern-unfactorable? p)))
+
+;; pattern-unfactorable? : *Pattern -> Boolean
+(define (pattern-unfactorable? p)
+  ;; Cannot factor out p if
+  ;; - if p can succeed multiple times (factoring changes success order)
+  ;; - if p can cut (factoring changes which choice points are discarded (too few))
+  ;; Note: presence of sub-expressions handled by pattern-equal?.
+  (define (for-pattern p recur)
+    (match p
+      [(pat:var/p _ _ _ _ _ (scopts _ commit? _ _)) (not commit?)]
+      [(pat:action _act _pat) #t]
+      [(pat:dots heads tail)
+       ;; Conservative approximation for common case: one head pattern
+       ;; In general, check if heads don't overlap, don't overlap with tail.
+       (or (> (length heads) 1)
+           (not (equal? tail (pat:datum '())))
+           (recur))]
+      [(pat:or _ patterns _) #t]
+      [(pat:not pattern) #t]
+      [(pat:commit pattern) #f]
+      [(? pat:reflect?) #t]
+      [(hpat:var/p _ _ _ _ _ (scopts _ commit? _ _)) (not commit?)]
+      [(hpat:commit inner) #f]
+      [(ehpat _ head repc _)
+       (or (not (equal? repc #f))
+           (recur))]
+      [_ (recur)]))
+  (pattern-ormap p for-pattern))
 
 (define (subpatterns-equal? as bs)
   (and (= (length as) (length bs))