fix compatible-closure to deal properly with language extension

Thanks to David Van Horn for spotting the problem and providing
a nice simple test case

Please include in 6.1
(cherry picked from commit 3666842cd4)

pkgs/redex-pkgs/redex-lib/redex/private/reduction-semantics.rkt

@@ -193,11 +193,6 @@
          "language argument does not contain a definition of the non-terminal ~a, needed by the reduction-relation"
          red-lang-nt))))
   
-  (let ([cp (compile-pattern
-             lang
-             `(in-hole (name ctxt ,pat)
-                       (name exp any))
-             #f)])
   (build-reduction-relation
    #f
    lang
@@ -205,7 +200,12 @@
     (λ (make-proc)
       (make-rewrite-proc
        (λ (lang)
-           (let ([f (make-proc lang)])
+         (define f (make-proc lang))
+         (define cp (compile-pattern
+                     lang
+                     `(in-hole (name ctxt ,pat)
+                               (name exp any))
+                     #f))
          (λ (main-exp exp extend acc)
            (let loop ([ms (or (match-pattern cp exp) '())]
                       [acc acc])
@@ -218,7 +218,7 @@
                         (f main-exp
                            (lookup-binding bindings 'exp)
                            (λ (x) (extend (plug (lookup-binding bindings 'ctxt) x)))
-                               acc)))])))))
+                           acc)))]))))
        (rewrite-proc-name make-proc)
        (rewrite-proc-lhs make-proc)
        (rewrite-proc-lhs-src make-proc)
@@ -235,7 +235,7 @@
         ;; not have a domain
         `any]
        [else
-          `(in-hole ,pat ,orig-pat)])))))
+        `(in-hole ,pat ,orig-pat)]))))
 
 (define (apply-reduction-relation/tagged p v)
   (let loop ([procs (reduction-relation-procs p)]

pkgs/redex-pkgs/redex-test/redex/tests/tl-test.rkt

@@ -3167,6 +3167,17 @@
   
   (test #t (regexp-match? #rx"^compatible-closure:.*fred" err-msg)))
 
+;; this tests that context-closure (and thus compatible-closure)
+;; play along properly with way extend-reduction-relation handles
+;; language extensions
+(let ()
+  (define-language L0 (K ::= number))
+  (define r (reduction-relation L0 (--> 5 6)))
+  (define r0 (context-closure r L0 (hole K)))
+  (define-language L1 (K ::= string))
+  (define r1 (extend-reduction-relation r0 L1))
+  (test (apply-reduction-relation r1  (term (5 "14"))) (list '(6 "14"))))
+  
   (let* ([R (reduction-relation
              empty-language
              (--> any any id))]