added a parameter to disable the various caches in redex

svn: r13024

collects/redex/private/reduction-semantics.ss

@@ -1136,7 +1136,7 @@
                 (λ (exp)
                   (let ([cache-ref (hash-ref cache exp not-in-cache)])
                     (cond
-                      [(eq? cache-ref not-in-cache)
+                      [(or (not (caching-enabled?)) (eq? cache-ref not-in-cache))
                        (when dom-compiled-pattern
                          (unless (match-pattern dom-compiled-pattern exp)
                            (redex-error name

collects/redex/private/tl-test.ss

@@ -195,6 +195,45 @@
           #t))
   
   
+  ;; test caching
+  (let ()
+    (define match? #t)
+    
+    (define-language lang
+      (x (side-condition any match?)))
+    
+    (test (pair? (redex-match lang x 1)) #t)
+    (set! match? #f)
+    (test (pair? (redex-match lang x 1)) #t)
+    (parameterize ([caching-enabled? #f])
+      (test (pair? (redex-match lang x 1)) #f)))
+  
+  
+  (let ()
+    (define sc-eval-count 0)
+    (define-language lang
+      (x (side-condition any (begin (set! sc-eval-count (+ sc-eval-count 1))
+                                    #t))))
+    
+    (redex-match lang x 1)
+    (redex-match lang x 1)
+    (parameterize ([caching-enabled? #f])
+      (redex-match lang x 1))
+    (test sc-eval-count 2))
+  
+  (let ()
+    (define rhs-eval-count 0)
+    (define-metafunction empty-language
+      [(f any) ,(begin (set! rhs-eval-count (+ rhs-eval-count 1))
+                       1)])
+    
+    (term (f 1))
+    (term (f 1))
+    (parameterize ([caching-enabled? #f])
+      (term (f 1)))
+    (test rhs-eval-count 2))
+  
+  
 ;                                                                                             
 ;                                                                                             
 ;                                 ;;;                                ;                        

collects/redex/redex.scrbl

@@ -328,16 +328,28 @@ clause is followed by an ellipsis.  Nested ellipses produce
 nested lists.
 }
 
-@defproc[(set-cache-size! [size (or/c false/c positive-integer?)]) void?]{
+@defproc[(set-cache-size! [size positive-integer?]) void?]{
 
-Changes the cache size; a #f disables the cache
+Changes the cache size; the default size is @scheme[350].
-entirely. The default size is 350.
 
-The cache is per-pattern (ie, each pattern has a cache of
+The cache is per-pattern (ie, each pattern has a cache of size at most
-size at most 350 (by default)) and is a simple table that
+350 (by default)) and is a simple table that maps expressions to how
-maps expressions to how they matched the pattern. When the
+they matched the pattern (ie, the bindings for the pattern
-cache gets full, it is thrown away and a new cache is
+variables). When the cache gets full, it is thrown away and a new
-started.
+cache is started.
+}
+
+@defparam[caching-enabled? on? boolean?]{
+  This is a parameter that controls whether or not a cache
+  is consulted (and updated) while matching and while evaluating
+  metafunctions.
+
+  If it is @scheme[#t], then side-conditions and the right-hand sides
+  of metafunctions are assumed to only depend on the values of the
+  pattern variables in scope (and thus not on any other external
+  state).
+
+  Defaults to @scheme[#t].
 }
 
 @section{Terms}
@@ -859,7 +871,8 @@ no clauses match, if one of the clauses matches multiple ways, or
 if the contract is violated.
 
 Note that metafunctions are assumed to always return the same results
-for the same inputs, and their results are cached. Accordingly, if a
+for the same inputs, and their results are cached, unless
+@scheme[caching-enable?] is set to @scheme[#f]. Accordingly, if a
 metafunction is called with the same inputs twice, then its body is
 only evaluated a single time.
 

collects/redex/reduction-semantics.ss

@@ -29,7 +29,9 @@
          define-metafunction
          define-metafunction/extension
          metafunction
-         in-domain?)
+         in-domain?
+         
+         caching-enabled?)
 
 (provide (rename-out [test-match redex-match])
          term-match