diff --git a/collects/redex/HISTORY b/collects/redex/HISTORY
index 7881397b20..1a51f5bcc3 100644
--- a/collects/redex/HISTORY
+++ b/collects/redex/HISTORY
@@ -1,3 +1,8 @@
+  - Added tracing to metafunctions (see current-traced-metafunctions)
+
+  - added caching-enabled? parameter (changed how set-cache-size! 
+    works)
+
 v4.2
 
   - added white-bracket-sizing to control how the brackets
diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index 00d009ee78..c077fcf151 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -5,6 +5,7 @@
          "term.ss"
          "loc-wrapper.ss"
 	 "error.ss"
+         mzlib/trace
          (lib "list.ss")
          (lib "etc.ss"))
 
@@ -1164,14 +1165,23 @@
                                                 `(,name ,@exp)
                                                 (length mtchs))]
                                   [else
-                                   (let ([ans (rhs metafunc (mtch-bindings (car mtchs)))])
+                                   (let ([ans (rhs traced-metafunc (mtch-bindings (car mtchs)))])
                                      (unless (match-pattern codom-compiled-pattern ans)
                                        (redex-error name "codomain test failed for ~s, call was ~s" ans `(,name ,@exp)))
                                      (hash-set! cache exp ans)
                                      ans)])))]))]
                       [else 
-                       cache-ref])))])
-        metafunc)
+                       cache-ref])))]
+               [ot (current-trace-print-args)]
+               [traced-metafunc (lambda (exp)
+                                  (if (or (eq? (current-traced-metafunctions) 'all)
+                                          (memq name (current-traced-metafunctions)))
+                                      (parameterize ([current-trace-print-args
+                                                      (λ (name args kws kw-args level)
+                                                        (ot name (car args) kws kw-args level))])
+                                        (trace-apply name metafunc '() '() exp))
+                                      (metafunc exp)))])
+        traced-metafunc)
       compiled-patterns
       rhss)
      (if dom-compiled-pattern
@@ -1179,6 +1189,8 @@
          (λ (exp) (and (ormap (λ (pat) (match-pattern pat exp)) compiled-patterns) 
                        #t))))))
 
+(define current-traced-metafunctions (make-parameter '()))
+
 (define-syntax (metafunction-form stx)
   (syntax-case stx ()
     [(_ id)
@@ -1788,6 +1800,7 @@
          (rename-out [metafunction-form metafunction])
          metafunction? metafunction-proc
          in-domain?
+         current-traced-metafunctions
          metafunc-proc-lang
          metafunc-proc-pict-info
          metafunc-proc-name
diff --git a/collects/redex/private/tl-test.ss b/collects/redex/private/tl-test.ss
index 7c0c109f48..af8919fc49 100644
--- a/collects/redex/private/tl-test.ss
+++ b/collects/redex/private/tl-test.ss
@@ -507,6 +507,29 @@
             'no-exn)
           'no-exn))
     
+  ;; test that tracing works properly
+  ;; note that caching comes into play here (which is why we don't see the recursive calls)
+  (let ()
+    (define-metafunction empty-language
+      [(f 0) 0]
+      [(f number) (f ,(- (term number) 1))])
+    
+    (let ([sp (open-output-string)])
+      (parameterize ([current-output-port sp])
+        (term (f 1)))
+      (test (get-output-string sp) ""))
+    
+    (let ([sp (open-output-string)])
+      (parameterize ([current-output-port sp]
+                     [current-traced-metafunctions 'all])
+        (term (f 1)))
+      (test (get-output-string sp) "|(f 1)\n|0\n"))
+    
+    (let ([sp (open-output-string)])
+      (parameterize ([current-output-port sp]
+                     [current-traced-metafunctions '(f)])
+        (term (f 1)))
+      (test (get-output-string sp) "|(f 1)\n|0\n")))
   
 
 ;                                                                                                                                
diff --git a/collects/redex/private/traces.ss b/collects/redex/private/traces.ss
index e245c5f7d1..5efb8c074e 100644
--- a/collects/redex/private/traces.ss
+++ b/collects/redex/private/traces.ss
@@ -149,10 +149,12 @@
   ;; only changed on the reduction thread
   ;; frontier : (listof (is-a?/c graph-editor-snip%))
   (define frontier 
-    (map (lambda (expr) (build-snip snip-cache #f expr pred pp 
-                                    (dark-pen-color) (light-pen-color)
-                                    (dark-text-color) (light-text-color) #f))
-         exprs))
+    (filter
+     (λ (x) x)
+     (map (lambda (expr) (build-snip snip-cache #f expr pred pp 
+                                     (dark-pen-color) (light-pen-color)
+                                     (dark-text-color) (light-text-color) #f))
+          exprs)))
   
   ;; set-font-size : number -> void
   ;; =eventspace main thread=
@@ -516,16 +518,15 @@
 (define (build-snip cache parent-snip expr pred pp light-arrow-color dark-arrow-color dark-label-color light-label-color name)
   (let-values ([(snip new?)
                 (let/ec k
-                  (k
-                   (hash-ref
-                    cache
-                    expr
-                    (lambda ()
-                      (let ([new-snip (make-snip parent-snip expr pred pp)])
-                        (hash-set! cache expr new-snip)
-                        (k new-snip #t))))
-                   #f))])
-    
+                  (values (hash-ref
+                           cache
+                           expr
+                           (lambda ()
+                             (let ([new-snip (make-snip parent-snip expr pred pp)])
+                               (hash-set! cache expr new-snip)
+                               (k new-snip #t))))
+                          #f))])
+
     (when parent-snip
       (send snip record-edge-label parent-snip name)
       (add-links/text-colors parent-snip snip
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index 3f6b0f75e0..0335ffc8cd 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -944,6 +944,16 @@ legtimate inputs according to @scheme[metafunction-name]'s contract,
 and @scheme[#f] otherwise.
 }
 
+@defparam[current-traced-metafunctions traced-metafunctions (or/c 'all (listof symbol?))]{
+
+Controls which metafunctions are currently being traced. If it is
+@scheme['all], all of them are. Otherwise, the elements of the list
+name the metafunctions to trace. 
+
+Defaults to @scheme['()].
+
+}
+
 @section{Testing}
 
 All of the exports in this section are provided both by
diff --git a/collects/redex/reduction-semantics.ss b/collects/redex/reduction-semantics.ss
index 7a477f2cb8..dfbd96b498 100644
--- a/collects/redex/reduction-semantics.ss
+++ b/collects/redex/reduction-semantics.ss
@@ -30,7 +30,6 @@
          define-metafunction/extension
          metafunction
          in-domain?
-         
          caching-enabled?)
 
 (provide (rename-out [test-match redex-match])
@@ -45,6 +44,7 @@
          test-results)
 
 (provide/contract
+ [current-traced-metafunctions (parameter/c (or/c 'all (listof symbol?)))]
  [reduction-relation->rule-names (-> reduction-relation? (listof symbol?))]
  [language-nts (-> compiled-lang? (listof symbol?))]
  [set-cache-size! (-> number? void?)]