Make the weak table for the signature-checked pairs truly weak.

... by wrapping ephemerons around the values.
This commit is contained in:
Mike Sperber 2010-10-09 17:51:30 +02:00
parent f706b0d7a7
commit f35477b82b

View File

@ -588,7 +588,8 @@
((hash-ref checked-pair-table ((hash-ref checked-pair-table
p p
(lambda () #f)) (lambda () #f))
=> checked-access) => (lambda (eph)
(checked-access (ephemeron-value eph))))
(else (raw-access p))))) (else (raw-access p)))))
(define checked-raw-car (checked-pair-access checked-pair-car car)) (define checked-raw-car (checked-pair-access checked-pair-car car))
@ -600,12 +601,12 @@
((hash-ref checked-pair-table ((hash-ref checked-pair-table
p p
(lambda () #f)) (lambda () #f))
=> (lambda (cp) => (lambda (eph)
(checked-set! cp new))) (checked-set! (ephemeron-value eph) new)))
(else (else
(let ((cp (make-checked-pair (car p) (cdr p) #f))) (let ((cp (make-checked-pair (car p) (cdr p) #f)))
(checked-set! cp new) (checked-set! cp new)
(hash-set! checked-pair-table p cp)))))) (hash-set! checked-pair-table p (make-ephemeron p cp)))))))
(define checked-raw-set-car! (checked-raw-set! set-checked-pair-car!)) (define checked-raw-set-car! (checked-raw-set! set-checked-pair-car!))
(define checked-raw-set-cdr! (checked-raw-set! set-checked-pair-cdr!)) (define checked-raw-set-cdr! (checked-raw-set! set-checked-pair-cdr!))
@ -615,7 +616,8 @@
((hash-ref checked-pair-table ((hash-ref checked-pair-table
p p
(lambda () #f)) (lambda () #f))
=> checked-pair-log) => (lambda (eph)
(checked-pair-log (ephemeron-value eph))))
(else #f))) (else #f)))
(define (checked-pair-set-log! p new) (define (checked-pair-set-log! p new)
@ -623,11 +625,12 @@
((hash-ref checked-pair-table ((hash-ref checked-pair-table
p p
(lambda () #f)) (lambda () #f))
=> (lambda (cp) => (lambda (eph)
(set-checked-pair-log! cp new))) (set-checked-pair-log! (ephemeron-value eph) new)))
(else (else
(hash-set! checked-pair-table p (hash-set! checked-pair-table p
(make-checked-pair (car p) (cdr p) new))))) (make-ephemeron p
(make-checked-pair (car p) (cdr p) new))))))
(define checked-pair-lazy-wrap-info (define checked-pair-lazy-wrap-info
(make-lazy-wrap-info cons (make-lazy-wrap-info cons
@ -659,4 +662,4 @@
(check-lazy-wraps! checked-pair-descriptor p) (check-lazy-wraps! checked-pair-descriptor p)
(checked-raw-cdr p)) (checked-raw-cdr p))
) )