diff --git a/pkgs/racket-test/tests/stxparse/test.rkt b/pkgs/racket-test/tests/stxparse/test.rkt
index 8ffdfcbdb2..591d085977 100644
--- a/pkgs/racket-test/tests/stxparse/test.rkt
+++ b/pkgs/racket-test/tests/stxparse/test.rkt
@@ -4,7 +4,7 @@
          syntax/parse/debug
          syntax/parse/define
          "setup.rkt"
-         (for-syntax syntax/parse))
+         (for-syntax syntax/parse racket/syntax))
 
 ;; Main syntax class and pattern tests
 
@@ -620,6 +620,21 @@
                                      (+ x y z))))
     ))
 
+(test-case "eh pattern-expander"
+  (define-syntax ~oncekw
+    (pattern-expander
+     (λ (stx)
+       (syntax-case stx ()
+         [(_ kw pat ...)
+          (keyword? (syntax-e #'kw))
+          (with-syntax ([name (format-id #'kw "~a-kw" (keyword->string (syntax-e #'kw)))])
+            #'(~once (~seq (~and kw name) pat ...)
+                     #:name (format "the ~a keyword" 'kw)))]))))
+  (check-equal? (syntax-parse #'(m #:a #:b 1 #:a)
+                  [(_ (~or #:a (~oncekw #:b b)) ...)
+                   (syntax->datum #'(b-kw b))])
+                '(#:b 1)))
+
 (test-case "this-syntax"
   (let ()
     (define-syntax-class identity
diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt
index 607e74a864..4120c97a73 100644
--- a/racket/collects/syntax/parse/private/rep.rkt
+++ b/racket/collects/syntax/parse/private/rep.rkt
@@ -459,26 +459,14 @@
      (and (identifier? #'id)
           (not-shadowed? #'id)
           (pattern-expander? (syntax-local-value #'id (λ () #f))))
-     (let* ([proc (pattern-expander-proc (syntax-local-value #'id))]
-            [introducer (make-syntax-introducer)]
-            [mstx (introducer (syntax-local-introduce stx))]
-            [mresult (parameterize ([current-syntax-parse-pattern-introducer introducer])
-                       (proc mstx))]
-            [result (syntax-local-introduce (introducer mresult))])
-       (disappeared! #'id)
-       (recur result))]
+     (begin (disappeared! #'id)
+            (recur (expand-pattern (syntax-local-value #'id) stx)))]
     [(id . rst)
      (and (identifier? #'id)
           (not-shadowed? #'id)
           (pattern-expander? (syntax-local-value #'id (λ () #f))))
-     (let* ([proc (pattern-expander-proc (syntax-local-value #'id))]
-            [introducer (make-syntax-introducer)]
-            [mstx (introducer (syntax-local-introduce stx))]
-            [mresult (parameterize ([current-syntax-parse-pattern-introducer introducer])
-                       (proc mstx))]
-            [result (syntax-local-introduce (introducer mresult))])
-       (disappeared! #'id)
-       (recur result))]
+     (begin (disappeared! #'id)
+            (recur (expand-pattern (syntax-local-value #'id) stx)))]
     [wildcard
      (and (wildcard? #'wildcard)
           (not-shadowed? #'wildcard))
@@ -608,6 +596,16 @@
        (let ([lp (parse-single-pattern (datum->syntax #f contents #'s) decls)])
          (pat:pstruct key lp)))])))
 
+;; expand-pattern : pattern-expander Syntax -> Syntax
+(define (expand-pattern pe stx)
+  (let* ([proc (pattern-expander-proc pe)]
+         [introducer (make-syntax-introducer)]
+         [mstx (introducer (syntax-local-introduce stx))]
+         [mresult (parameterize ([current-syntax-parse-pattern-introducer introducer])
+                    (proc mstx))]
+         [result (syntax-local-introduce (introducer mresult))])
+    result))
+
 ;; parse-ellipsis-head-pattern : stx DeclEnv -> (listof EllipsisHeadPattern)
 (define (parse-ellipsis-head-pattern stx decls)
   (for/list ([ehpat+hstx (in-list (parse*-ellipsis-head-pattern stx decls #t))])
@@ -617,8 +615,22 @@
 ;;                             -> (listof (list EllipsisHeadPattern stx/eh-alternative))
 (define (parse*-ellipsis-head-pattern stx decls allow-or?
                                       #:context [ctx (current-syntax-context)])
+  (define (recur stx) (parse*-ellipsis-head-pattern stx decls allow-or? #:context ctx))
+  (define not-shadowed? (make-not-shadowed? decls))
   (syntax-case* stx (~eh-var ~or ~between ~optional ~once)
                 (make-not-shadowed-id=? decls)
+    [id
+     (and (identifier? #'id)
+          (not-shadowed? #'id)
+          (pattern-expander? (syntax-local-value #'id (lambda () #f))))
+     (begin (disappeared! #'id)
+            (recur (expand-pattern (syntax-local-value #'id) stx)))]
+    [(id . rst)
+     (and (identifier? #'id)
+          (not-shadowed? #'id)
+          (pattern-expander? (syntax-local-value #'id (lambda () #f))))
+     (begin (disappeared! #'id)
+            (recur (expand-pattern (syntax-local-value #'id) stx)))]
     [(~eh-var name eh-alt-set-id)
      (disappeared! stx)
      (let ()