syndicate-2017/racket/syndicate/canonicalize.rkt

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))