69 lines
2.2 KiB
Racket
69 lines
2.2 KiB
Racket
#lang racket
|
|
|
|
(require racket/struct)
|
|
|
|
(provide free-id-tree=?
|
|
free-id-tree-hash-code
|
|
free-id-tree-secondary-hash-code
|
|
|
|
free-id-tree-table?
|
|
immutable-free-id-tree-table?
|
|
mutable-free-id-tree-table?
|
|
weak-free-id-tree-table?
|
|
make-immutable-free-id-tree-table
|
|
make-mutable-free-id-tree-table
|
|
make-weak-free-id-tree-table)
|
|
|
|
(define (free-id-tree=? a b)
|
|
(define rec=? free-id-tree=?)
|
|
(cond
|
|
[(identifier? a) (and (identifier? b)
|
|
(free-identifier=? a b))]
|
|
[(syntax? a) (and (syntax? b)
|
|
(rec=? (syntax-e a)
|
|
(syntax-e b)))]
|
|
[(pair? a) (and (pair? b)
|
|
(rec=? (car a) (car b))
|
|
(rec=? (cdr a) (cdr b)))]
|
|
[(vector? a) (and (vector? b)
|
|
(rec=? (vector->list a)
|
|
(vector->list b)))]
|
|
[(box? a) (and (box? b)
|
|
(rec=? (unbox a)
|
|
(unbox b)))]
|
|
[(prefab-struct-key a)
|
|
=> (λ (a-key)
|
|
(let ([b-key (prefab-struct-key b)])
|
|
(and (equal? a-key b-key)
|
|
(rec=? (struct->list a)
|
|
(struct->list b)))))]
|
|
[(null? a) (null? b)]
|
|
[else (error (format "Unexpected value for free-id-tree=? : ~a"
|
|
a))]))
|
|
|
|
(define ((free-id-tree-hash hc) a)
|
|
(define rec-hash (free-id-tree-hash hc))
|
|
(cond
|
|
[(identifier? a) (hc (syntax-e #'a))]
|
|
[(syntax? a) (rec-hash (syntax-e a))]
|
|
[(pair? a) (hc (cons (rec-hash (car a))
|
|
(rec-hash (cdr a))))]
|
|
[(vector? a) (hc (list->vector (rec-hash (vector->list a))))]
|
|
[(box? a) (hc (box (rec-hash (unbox a))))]
|
|
[(prefab-struct-key a)
|
|
=> (λ (a-key)
|
|
(hc (apply make-prefab-struct a-key
|
|
(rec-hash (struct->list a)))))]
|
|
[else (hc a)]))
|
|
|
|
(define free-id-tree-hash-code
|
|
(free-id-tree-hash equal-hash-code))
|
|
(define free-id-tree-secondary-hash-code
|
|
(free-id-tree-hash equal-secondary-hash-code))
|
|
|
|
(define-custom-hash-types free-id-tree-table
|
|
#:key? syntax?
|
|
free-id-tree=?
|
|
free-id-tree-hash-code
|
|
free-id-tree-secondary-hash-code)
|