Make syntax-local-introduce work in match expanders

pkgs/racket-doc/scribblings/reference/match.scrbl

@@ -695,8 +695,9 @@ properties.
 }
 
 @defproc[(syntax-local-match-introduce [stx syntax?]) syntax?]{
-Like @racket[syntax-local-introduce], but for match expanders.
-}
+For backward compatibility only; equivalent to @racket[syntax-local-introduce].
+
+@history[#:changed "6.90.0.29" @elem{Made equivalent to @racket[syntax-local-introduce].}]}
 
 
 @defparam[match-equality-test comp-proc (any/c any/c . -> . any)]{

pkgs/racket-test/tests/match/examples.rkt

@@ -841,5 +841,18 @@
               (set! foo 2)
               (check-equal? x 2))
 
+   (test-case
+    "match-expander with arity 2"
+    (define-syntax forty-two-pat
+      (let ()
+        (define-struct datum-pat (datum)
+          #:property prop:match-expander
+          (lambda (pat stx)
+            (datum->syntax #'here (datum-pat-datum pat) stx)))
+        (make-datum-pat 42)))
+    (check-equal? (match 42
+                    [(forty-two-pat) #t])
+                  #t))
+
 
 ))

racket/collects/racket/match/parse-helper.rkt

@@ -2,10 +2,9 @@
 
 (require (for-template racket/base)
          syntax/boundmap
+         syntax/apply-transformer
          racket/struct-info
-         ;macro-debugger/emit
-         "patterns.rkt"
-         "syntax-local-match-introduce.rkt")
+         "patterns.rkt")
 
 (provide ddk? parse-literal all-vars pattern-var? match:syntax-err
          match-expander-transform trans-match trans-match* parse-struct
@@ -170,20 +169,16 @@
                                   error-msg)
   (let* ([expander* (syntax-local-value expander)]
          [transformer (accessor expander*)]
-         ;; this transformer might have been defined w/ `syntax-id-rules'
-         [transformer (if (set!-transformer? transformer)
-                          (set!-transformer-procedure transformer)
-                          transformer)])
+         [transformer-proc (if (set!-transformer? transformer)
+                               (set!-transformer-procedure transformer)
+                               transformer)])
     (unless transformer (raise-syntax-error #f error-msg expander*))
-    (define introducer (make-syntax-introducer))
-    (parameterize ([current-match-introducer introducer])
-      (let* ([mstx (introducer (syntax-local-introduce stx))]
-             [mresult (if (procedure-arity-includes? transformer 2)
-                          (transformer expander* mstx)
-                          (transformer mstx))]
-             [result (syntax-local-introduce (introducer mresult))])
-        ;(emit-local-step stx result #:id expander)
-        (parse result)))))
+    (parse (local-apply-transformer
+            (λ (stx) (if (procedure-arity-includes? transformer-proc 2)
+                         (transformer-proc expander* stx)
+                         (transformer-proc stx)))
+            stx
+            'expression))))
 
 ;; raise an error, blaming stx
 (define (match:syntax-err stx msg)

racket/collects/racket/match/syntax-local-match-introduce.rkt

@@ -1,15 +1,8 @@
 #lang racket/base
 
-(provide syntax-local-match-introduce
-         current-match-introducer)
-
-(define current-match-introducer
-  (make-parameter
-   (lambda (x)
-     (error 'syntax-local-match-introduce "not expanding match expander form"))))
+(provide syntax-local-match-introduce)
 
 (define (syntax-local-match-introduce x)
   (unless (syntax? x)
     (raise-argument-error 'syntax-local-match-introduce "syntax?" x))
-  ((current-match-introducer) x))
-
+  (syntax-local-introduce x))