diff --git a/rosette/base/core/term.rkt b/rosette/base/core/term.rkt index 5019a468..19c62033 100644 --- a/rosette/base/core/term.rkt +++ b/rosette/base/core/term.rkt @@ -19,7 +19,12 @@ ; These IDs are never reused, and they are used to impose an ordering on the children ; of expressions with commutative operators. #|-----------------------------------------------------------------------------------|# -(define current-terms (make-parameter (make-hash))) + +;; Initialize with #f so that the hash table cooperates with garbage collector. +;; See #247 +(define current-terms (make-parameter #f)) +(current-terms (make-hash)) + (define current-index (make-parameter 0)) ; Clears the entire term cache if invoked with #f (default), or @@ -77,17 +82,23 @@ ; restores (terms) to its old value. If terms-expr is not given, it defaults to ; (terms), so (with-terms expr) is equivalent to (with-terms (terms) expr). (define-syntax (with-terms stx) + ;; Parameterize with #f so that the hash table cooperates with garbage collector. + ;; See #247 (syntax-parse stx [(_ expr) - #'(parameterize ([current-terms (hash-copy (current-terms))]) - expr)] + #'(let ([orig-terms (current-terms)]) + (parameterize ([current-terms #f]) + (current-terms (hash-copy orig-terms)) + expr))] [(_ terms-expr expr) - #'(parameterize ([current-terms (hash-copy-clear (current-terms))]) - (let ([ts terms-expr] - [cache (current-terms)]) - (for ([t ts]) - (hash-set! cache (term-val t) t)) - expr))])) + #'(let ([orig-terms (current-terms)]) + (parameterize ([current-terms #f]) + (current-terms (hash-copy-clear orig-terms)) + (let ([ts terms-expr] + [cache (current-terms)]) + (for ([t ts]) + (hash-set! cache (term-val t) t)) + expr)))])) diff --git a/test/base/term.rkt b/test/base/term.rkt index 3217dd7f..48bf741b 100644 --- a/test/base/term.rkt +++ b/test/base/term.rkt @@ -58,5 +58,42 @@ (f @integer?) (check-exn #px"type should remain unchanged" (lambda () (f @boolean?))))) +(define clear-terms!+gc-terms!-tests + (test-suite+ + "Tests for clear-terms! and gc-terms!" + + (with-terms '() + (let () + (define-symbolic x y z @integer?) + (define a (@+ x 1)) + (define b (@+ y 2)) + (define c (@+ z 3)) + (check-equal? (length (terms)) 6) + + ;; this should evict z and c + (clear-terms! (list z)) + + (check-equal? (length (terms)) 4) + + ;; this doesn't affect strongly-held values + (set! b #f) + + (check-equal? (length (terms)) 4) + + (gc-terms!) ; change the representation + (collect-garbage) + + (check-equal? (length (terms)) 3) + + (clear-terms! (list x)) + (collect-garbage) + + (check-equal? (length (terms)) 1) + + ;; this is a dummy check to reference a, b, and c so that + ;; they are not garbage-collected earlier + (check-equal? (length (list a b c)) 3))))) + (module+ test - (time (run-tests value-tests))) + (time (run-tests value-tests)) + (time (run-tests clear-terms!+gc-terms!-tests)))