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

tweak to tree-reduce memoization

Browse Source 
original commit: 5d1deee09b4ccf13e58df4d9487b4e87589e334c
This commit is contained in:
Matthew Flatt 2017-12-21 07:24:57 -07:00
parent 8af0a5de94
commit c9701b1d7c
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
s/tree.ss
View File

@ -276,19 +276,20 @@
[(eq? st full-tree) [(eq? st full-tree)
;; Memoizing at full subtrees uses offset and size ;; Memoizing at full subtrees uses offset and size
;; (combined into one number) to identity the subtree. ;; (combined into one number) to identity the subtree.
(let ([key (+ offset (* total-size size))]) (let ([key (and (fx> size (fixnum-width))
(+ offset (* total-size size)))])
(cond (cond
[(hashtable-ref full-cache key #f) [(and key (hashtable-ref full-cache key #f))
=> (lambda (v) v)] => (lambda (v) v)]
[else [else
(let ([v (do ([size size (fx- size 1)] (let ([v (do ([size size (fx- size 1)]
[offset offset (fx+ offset 1)] [offset offset (fx+ offset 1)]
[init init (apply-leaf-proc init offset extra-leaf-args)]) [init init (apply-leaf-proc init offset extra-leaf-args)])
((fx= size 0) init))]) ((fx= size 0) init))])
(hashtable-set! full-cache key v) (when key (hashtable-set! full-cache key v))
v)]))] v)]))]
[else [else
;; We're relying on a fresh `cons`es to repersent different parts ;; We're relying on a fresh `cons`es to represent different parts
;; of a tree, even if the parts have the same local content. So, ;; of a tree, even if the parts have the same local content. So,
;; `eq?` identifies a subtree. ;; `eq?` identifies a subtree.
(let ([cell (eq-hashtable-cell cache st #f)] (let ([cell (eq-hashtable-cell cache st #f)]