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

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

@ -1017,6 +1017,9 @@ 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)))])
(with-syntax ([key-exp (if (= 1 (syntax-e #'arity))
(car (syntax->list #'(args ...)))
#'(list args ...))])
#'(λ (f statsbox) #'(λ (f statsbox)
(let ([ht (make-hash)] (let ([ht (make-hash)]
[entries 0]) [entries 0])
@ -1024,7 +1027,7 @@ See match-a-pattern.rkt for more details
(cond (cond
[(not (caching-enabled?)) (f args ...)] [(not (caching-enabled?)) (f args ...)]
[else [else
(let* ([key (list args ...)]) (let* ([key key-exp])
;(record-cache-test! statsbox) ;(record-cache-test! statsbox)
(unless (< entries cache-size) (unless (< entries cache-size)
(set! entries 0) (set! entries 0)
@ -1037,7 +1040,7 @@ See match-a-pattern.rkt for more details
(let ([res (f args ...)]) (let ([res (f args ...)])
(hash-set! ht key res) (hash-set! ht key res)
res)] res)]
[else ans])))])))))])) [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))