suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

redex: fix arity-1 cache key computation

Browse Source
This commit is contained in:
Robby Findler 2012-01-01 13:13:48 -06:00
parent a7a70cbca9
commit a6a01fd7b8
1 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/redex/private/matcher.rkt
View File

@ -1017,27 +1017,30 @@ See match-a-pattern.rkt for more details
(syntax-case stx ()
[(_ arity)
(with-syntax ([(args ...) (generate-temporaries (build-list (syntax-e #'arity) (λ (x) 'x)))])
#'(λ (f statsbox)
(let ([ht (make-hash)]
[entries 0])
(lambda (args ...)
(cond
[(not (caching-enabled?)) (f args ...)]
[else
(let* ([key (list args ...)])
;(record-cache-test! statsbox)
(unless (< entries cache-size)
(set! entries 0)
(set! ht (make-hash)))
(let ([ans (hash-ref ht key uniq)])
(cond
[(eq? ans uniq)
;(record-cache-miss! statsbox)
(set! entries (+ entries 1))
(let ([res (f args ...)])
(hash-set! ht key res)
res)]
[else ans])))])))))]))
(with-syntax ([key-exp (if (= 1 (syntax-e #'arity))
(car (syntax->list #'(args ...)))
#'(list args ...))])
#'(λ (f statsbox)
(let ([ht (make-hash)]
[entries 0])
(lambda (args ...)
(cond
[(not (caching-enabled?)) (f args ...)]
[else
(let* ([key key-exp])
;(record-cache-test! statsbox)
(unless (< entries cache-size)
(set! entries 0)
(set! ht (make-hash)))
(let ([ans (hash-ref ht key uniq)])
(cond
[(eq? ans uniq)
;(record-cache-miss! statsbox)
(set! entries (+ entries 1))
(let ([res (f args ...)])
(hash-set! ht key res)
res)]
[else ans])))]))))))]))
(define memoize/key1 (mk-memoize-key 1))
(define memoize/key2 (mk-memoize-key 2))