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 () (syntax-case stx ()
[(_ arity) [(_ arity)
(with-syntax ([(args ...) (generate-temporaries (build-list (syntax-e #'arity) (λ (x) 'x)))]) (with-syntax ([(args ...) (generate-temporaries (build-list (syntax-e #'arity) (λ (x) 'x)))])
#'(λ (f statsbox) (with-syntax ([key-exp (if (= 1 (syntax-e #'arity))
(let ([ht (make-hash)] (car (syntax->list #'(args ...)))
[entries 0]) #'(list args ...))])
(lambda (args ...) #'(λ (f statsbox)
(cond (let ([ht (make-hash)]
[(not (caching-enabled?)) (f args ...)] [entries 0])
[else (lambda (args ...)
(let* ([key (list args ...)]) (cond
;(record-cache-test! statsbox) [(not (caching-enabled?)) (f args ...)]
(unless (< entries cache-size) [else
(set! entries 0) (let* ([key key-exp])
(set! ht (make-hash))) ;(record-cache-test! statsbox)
(let ([ans (hash-ref ht key uniq)]) (unless (< entries cache-size)
(cond (set! entries 0)
[(eq? ans uniq) (set! ht (make-hash)))
;(record-cache-miss! statsbox) (let ([ans (hash-ref ht key uniq)])
(set! entries (+ entries 1)) (cond
(let ([res (f args ...)]) [(eq? ans uniq)
(hash-set! ht key res) ;(record-cache-miss! statsbox)
res)] (set! entries (+ entries 1))
[else ans])))])))))])) (let ([res (f args ...)])
(hash-set! ht key res)
res)]
[else ans])))]))))))]))
(define memoize/key1 (mk-memoize-key 1)) (define memoize/key1 (mk-memoize-key 1))
(define memoize/key2 (mk-memoize-key 2)) (define memoize/key2 (mk-memoize-key 2))