diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss index 6e9a2beff3..c3f00cca55 100644 --- a/collects/redex/private/matcher.ss +++ b/collects/redex/private/matcher.ss @@ -1592,6 +1592,7 @@ before the pattern compiler is invoked. compiled-pattern?)) (set-cache-size! (-> (and/c integer? positive?) void?)) + (cache-size (and/c integer? positive?)) (make-bindings ((listof bind?) . -> . bindings?)) (bindings-table (bindings? . -> . (listof bind?))) diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index c082c6546d..4fdca8fbfd 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/collects/redex/private/reduction-semantics.ss @@ -1425,7 +1425,15 @@ (values (wrap (letrec ([cache (make-hash)] + [cache-entries 0] [not-in-cache (gensym)] + [cache-result (λ (arg res case) + (when (caching-enabled?) + (when (>= cache-entries cache-size) + (set! cache (make-hash)) + (set! cache-entries 0)) + (hash-set! cache arg (cons res case)) + (set! cache-entries (add1 cache-entries))))] [log-coverage (λ (id) (when id (for-each @@ -1452,7 +1460,7 @@ [(null? cases) (if relation? (begin - (hash-set! cache exp (cons #f #f)) + (cache-result exp #f #f) #f) (redex-error name "no clauses matched for ~s" `(,name . ,exp)))] [else @@ -1470,7 +1478,7 @@ (redex-error name "codomain test failed for ~s, call was ~s" ans `(,name ,@exp))) (cond [ans - (hash-set! cache exp (cons #t id)) + (cache-result exp #t id) (log-coverage id) #t] [else @@ -1499,7 +1507,7 @@ "codomain test failed for ~s, call was ~s" ans `(,name ,@exp))) - (hash-set! cache exp (cons ans id)) + (cache-result exp ans id) (log-coverage id) ans)]))])))]))] [else diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index f53615be1c..7d99f20667 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -369,28 +369,19 @@ clause is followed by an ellipsis. Nested ellipses produce nested lists. } -@defproc[(set-cache-size! [size positive-integer?]) void?]{ - -Changes the cache size; the default size is @scheme[350]. - -The cache is per-pattern (ie, each pattern has a cache of size at most -350 (by default)) and is a simple table that maps expressions to how -they matched the pattern (ie, the bindings for the pattern -variables). When the cache gets full, it is thrown away and a new -cache is started. +@defparam[caching-enabled? on? boolean?]{ + When this parameter is @scheme[#t] (the default), Redex caches the results of + pattern matching and metafunction evaluation. There is a separate cache for + each pattern and metafunction; when one fills (see @scheme[set-cache-size!]), + Redex evicts all of the entries in that cache. + + Caching should be disabled when matching a pattern that depends on values + other than the in-scope pattern variables or evaluating a metafunction + that reads or writes mutable external state. } -@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]. +@defproc[(set-cache-size! [size positive-integer?]) void?]{ +Changes the size of the per-pattern and per-metafunction caches. The default size is @scheme[350]. } @section{Terms} @@ -921,7 +912,7 @@ 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, unless -@scheme[caching-enable?] is set to @scheme[#f]. Accordingly, if a +@scheme[caching-enabled?] 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.