From 2c3c077d4573798220e91ab5c75112c4e5d402c5 Mon Sep 17 00:00:00 2001
From: Casey Klein <clklein@racket-lang.org>
Date: Wed, 20 Oct 2010 17:13:01 -0700
Subject: [PATCH] Revert "adjusted define-metafunction/extension so that it
 recompiles the old cases in the new language"

This reverts commit 99d85159b69da057b83e1f2d17eaf75ad7f08e9d.

Signed-off-by: Casey Klein <clklein@racket-lang.org>
---
 collects/redex/private/reduction-semantics.rkt | 15 +++------------
 collects/redex/tests/tl-test.rkt               | 12 ------------
 2 files changed, 3 insertions(+), 24 deletions(-)

diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt
index 288603e6e3..579698fe5c 100644
--- a/collects/redex/private/reduction-semantics.rkt
+++ b/collects/redex/private/reduction-semantics.rkt
@@ -1521,16 +1521,8 @@
         (syntax->list stuffs)))
      (syntax->list extras))))
 
-(define (build-metafunction lang cases parent-cases/wrong-lang wrap dom-contract-pat codom-contract-pat name relation?)
-  (let ([parent-cases (map (λ (parent-case) 
-                             (make-metafunc-case
-                              (compile-pattern lang (metafunc-case-lhs-pat parent-case) #t)
-                              (metafunc-case-rhs parent-case)
-                              (metafunc-case-lhs-pat parent-case)
-                              (metafunc-case-src-loc parent-case)
-                              (metafunc-case-id parent-case)))
-                           parent-cases/wrong-lang)]
-        [dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))]
+(define (build-metafunction lang cases parent-cases wrap dom-contract-pat codom-contract-pat name relation?)
+  (let ([dom-compiled-pattern (and dom-contract-pat (compile-pattern lang dom-contract-pat #f))]
         [codom-compiled-pattern (compile-pattern lang codom-contract-pat #f)])
     (values
      (wrap
@@ -1554,7 +1546,6 @@
                                                         (metafunc-proc-cases r)))
                                         (cover-case id c))))
                                   (relation-coverage))))]
-               [all-cases (append cases parent-cases)]
                [metafunc
                 (λ (exp)
                   (let ([cache-ref (hash-ref cache exp not-in-cache)])
@@ -1565,7 +1556,7 @@
                            (redex-error name
                                         "~s is not in my domain"
                                         `(,name ,@exp))))
-                       (let loop ([cases all-cases]
+                       (let loop ([cases (append cases parent-cases)]
                                   [num (- (length parent-cases))])
                          (cond
                            [(null? cases) 
diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt
index 52543da215..1d22c55a3d 100644
--- a/collects/redex/tests/tl-test.rkt
+++ b/collects/redex/tests/tl-test.rkt
@@ -531,18 +531,6 @@
     (test (term (g 11 17)) 11)
     (test (term (h 11 17)) 11))
   
-  (let ()
-    (define-language L 
-      (v 1))
-    (define-extended-language M
-      L
-      (v .... 2))
-    (define-metafunction L
-      [(f v) v])
-    (define-metafunction/extension f M
-      [(g 17) 17])
-    (test (term (g 2)) 2))
-  
   (let ()
     (define-metafunction empty-language
       [(f any) 1])