added metafunction result caching

svn: r11883
This commit is contained in:
Robby Findler 2008-09-26 16:13:03 +00:00
parent c0bc68f35b
commit d1b2bf63c7
2 changed files with 44 additions and 31 deletions

View File

@ -1046,8 +1046,13 @@
[codom-compiled-pattern (compile-pattern lang codom-contract-pat #f)])
(values
(wrap
(letrec ([metafunc
(letrec ([cache (make-hash)]
[not-in-cache (gensym)]
[metafunc
(λ (exp)
(let ([cache-ref (hash-ref cache exp not-in-cache)])
(cond
[(eq? cache-ref not-in-cache)
(when dom-compiled-pattern
(unless (match-pattern dom-compiled-pattern exp)
(redex-error name
@ -1078,7 +1083,10 @@
(let ([ans (rhs 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)))
ans)])))])))])
(hash-set! cache exp ans)
ans)])))]))]
[else
cache-ref])))])
metafunc)
compiled-patterns
rhss)

View File

@ -840,6 +840,11 @@ Raises an exception recognized by @scheme[exn:fail:redex?] if
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
metafunction is called with the same inputs twice, then its body is
only evaluated a single time.
As an example, these metafunctions finds the free variables in
an expression in the lc-lang above: