From b087ce2765b42ff7d4b33facfe12b613312b37ab Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 22 May 2009 19:19:40 +0000
Subject: [PATCH] fixed a bug in metafunctions

svn: r14932
---
 collects/redex/private/reduction-semantics.ss |  2 +-
 collects/redex/private/tl-test.ss             | 16 ++++++++++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index 90385eb9c0..3035a74eff 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -1117,7 +1117,7 @@
                                         dsc
                                         sc))
                                      dsc
-                                     'codom-side-conditions-rewritten
+                                     `codom-side-conditions-rewritten
                                      'name)))
                                 (term-define-fn name name2))
                             'disappeared-use
diff --git a/collects/redex/private/tl-test.ss b/collects/redex/private/tl-test.ss
index 71d95807a7..4dc69b3a85 100644
--- a/collects/redex/private/tl-test.ss
+++ b/collects/redex/private/tl-test.ss
@@ -571,6 +571,22 @@
     (test (term (foo y))
           (term docare)))
   
+  (let ()
+    (define f-called? #f)
+    (define-metafunction empty-language
+      f : (side-condition any_1 (begin (set! f-called? #t) #t)) -> any
+      [(f any_1) any_1])
+    (test (term (f 1)) 1)
+    (test f-called? #t))
+    
+  (let ()
+    (define g-called? #f)
+    (define-metafunction empty-language
+      g : any -> (side-condition any_1 (begin (set! g-called? #t) #t))
+      [(g any_1) any_1])
+    (test (term (g 1)) 1)
+    (test g-called? #t))
+  
   ;; test that tracing works properly
   ;; note that caching comes into play here (which is why we don't see the recursive calls)
   (let ()