55 lines
1.3 KiB
Racket
55 lines
1.3 KiB
Racket
#lang racket/base
|
|
;; Poor-man's hash consing.
|
|
|
|
(provide canonicalize)
|
|
|
|
(define canonical-values (make-weak-hash))
|
|
|
|
(define sentinel (cons #f #f))
|
|
|
|
(define (canonicalize val)
|
|
(cond
|
|
[(or (struct-type? val)
|
|
(symbol? val)
|
|
(fixnum? val))
|
|
;; These values already have unique representations.
|
|
val]
|
|
[else
|
|
(define b (hash-ref canonical-values
|
|
val
|
|
(lambda ()
|
|
(define new-b (make-weak-box val))
|
|
(hash-set! canonical-values val new-b)
|
|
#f)))
|
|
(if (not b)
|
|
(canonicalize val)
|
|
(let ((v (weak-box-value b sentinel)))
|
|
(if (eq? v sentinel) (canonicalize val) v)))]))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define v1 (canonicalize (cons 1 2)))
|
|
|
|
(let ((v2 (canonicalize (cons 1 2))))
|
|
(check-eq? v1 v2))
|
|
|
|
(collect-garbage)
|
|
(check-equal? (hash-count canonical-values) 1)
|
|
|
|
(let ((v2 (canonicalize (cons 1 2))))
|
|
(check-eq? v1 v2))
|
|
|
|
(set! v1 (canonicalize (cons 1 2)))
|
|
|
|
(collect-garbage)
|
|
(check-equal? (hash-count canonical-values) 1)
|
|
|
|
(let ((v2 (canonicalize (cons 1 2))))
|
|
(check-eq? v1 v2))
|
|
|
|
(set! v1 #f)
|
|
|
|
(collect-garbage)
|
|
(check-equal? (hash-count canonical-values) 0))
|