suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Have a generic interface for equal+hash.

Browse Source 
Currently provided by racket/struct, for lack of a better place.
This commit is contained in:
Vincent St-Amour 2012-05-22 19:10:31 -04:00
parent cc7ae795ea
commit 390cd02b52
12 changed files with 151 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/data/gvector.rkt
View File

@ -4,7 +4,8 @@
unstable/wrapc)
racket/contract/base
racket/dict
racket/vector)
racket/vector
racket/struct)
(define (make-gvector #:capacity [capacity 10])
(gvector (make-vector capacity #f) 0))
@ -192,25 +193,24 @@
any/c
exact-nonnegative-integer?
#f #f #f))
#:property prop:equal+hash
(let ([equals
(lambda (x y recursive-equal?)
(let ([vx (gvector-vec x)]
[vy (gvector-vec y)]
[nx (gvector-n x)]
[ny (gvector-n y)])
(and (= nx ny)
(for/and ([index (in-range nx)])
(recursive-equal? (vector-ref vx index)
(vector-ref vy index))))))]
[hash-code
(lambda (x hc)
(let ([v (gvector-vec x)]
[n (gvector-n x)])
(for/fold ([h 1]) ([i (in-range n)])
;; FIXME: better way of combining hashcodes
(+ h (hc (vector-ref v i))))))])
(list equals hash-code hash-code))
#:methods gen:equal+hash
[(define (equal-proc x y recursive-equal?)
(let ([vx (gvector-vec x)]
[vy (gvector-vec y)]
[nx (gvector-n x)]
[ny (gvector-n y)])
(and (= nx ny)
(for/and ([index (in-range nx)])
(recursive-equal? (vector-ref vx index)
(vector-ref vy index))))))
(define (hash-code x hc)
(let ([v (gvector-vec x)]
[n (gvector-n x)])
(for/fold ([h 1]) ([i (in-range n)])
;; FIXME: better way of combining hashcodes
(+ h (hc (vector-ref v i))))))
(define hash-proc hash-code)
(define hash2-proc hash-code)]
#:property prop:sequence in-gvector)
(provide/contract

2
collects/racket/main.rkt
View File

@ -27,6 +27,7 @@
racket/promise
racket/bool
racket/stream
racket/struct
racket/sequence
racket/local
racket/system
@ -59,6 +60,7 @@
racket/promise
racket/bool
racket/stream
racket/struct
racket/sequence
racket/local
racket/system)

33
collects/racket/private/dict.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/private/generics ; to avoid circular dependencies
racket/struct
(for-syntax racket/base))
(define-generics (dict gen:dict prop:dict dict? #:defined-table dict-def-table
@ -435,14 +436,16 @@
(define dict-iterate-next custom-hash-iterate-next)
(define dict-iterate-key custom-hash-iterate-key)
(define dict-iterate-value custom-hash-iterate-value)]
#:property prop:equal+hash
(list (lambda (a b recur)
(and (recur (custom-hash-make-box a)
(custom-hash-make-box b))
(recur (custom-hash-table a)
(custom-hash-table b))))
(lambda (a recur) (recur (custom-hash-table a)))
(lambda (a recur) (recur (custom-hash-table a)))))
#:methods gen:equal+hash
[(define (equal-proc a b recur)
(and (recur (custom-hash-make-box a)
(custom-hash-make-box b))
(recur (custom-hash-table a)
(custom-hash-table b))))
(define (hash-proc a recur)
(recur (custom-hash-table a)))
(define (hash2-proc a recur)
(recur (custom-hash-table a)))])
(struct immutable-custom-hash custom-hash ()
#:methods gen:dict
@ -471,13 +474,13 @@
(raise-type-error who "procedure (arity 1)" hash2))
(let ()
(struct box hash-box ()
#:property prop:equal+hash (list
(lambda (a b recur)
(=? (hash-box-key a) (hash-box-key b)))
(lambda (v recur)
(hash (hash-box-key v)))
(lambda (v recur)
(hash2 (hash-box-key v)))))
#:methods gen:equal+hash
[(define (equal-proc a b recur)
(=? (hash-box-key a) (hash-box-key b)))
(define (hash-proc v recur)
(hash (hash-box-key v)))
(define (hash2-proc v recur)
(hash2 (hash-box-key v)))])
(make-custom-hash table (wrap-make-box box))))])
(let ([make-custom-hash
(lambda (=? hash [hash2 (lambda (v) 10001)])

33
collects/racket/struct.rkt Normal file
View File

@ -0,0 +1,33 @@
#lang racket/base
;; Provides generic interfaces that correspond to struct properties
;; that live in racket/base
(require racket/private/generics)
(provide gen:equal+hash)
(define-values (prop:gen:equal+hash equal+hash? gen:equal+hash-acc)
(make-struct-type-property
'prop:gen:equal+hash
(lambda (v si)
(unless (and (vector? v)
(= 3 (vector-length v))
(procedure? (vector-ref v 0))
(procedure-arity-includes? (vector-ref v 0) 3)
(procedure? (vector-ref v 1))
(procedure-arity-includes? (vector-ref v 1) 2)
(procedure? (vector-ref v 2))
(procedure-arity-includes? (vector-ref v 2) 2))
(raise-type-error 'guard-for-prop:gen:equal+hash
"vector of three procedures (arities 3, 2, 2)"
v))
v)
(list (cons prop:equal+hash vector->list))))
(define-generics (equal+hash gen:equal+hash prop:gen:equal+hash equal+hash?
#:defined-table dummy
#:prop-defined-already? gen:equal+hash-acc)
(equal-proc equal+hash rhs equal?/recur)
(hash-proc equal+hash equal-hash-code/recur)
(hash2-proc equal+hash equal-secondary-hash-code/recur))

37
collects/scribblings/guide/define-struct.scrbl
View File

@ -1,8 +1,9 @@
#lang scribble/doc
@(require scribble/manual scribble/eval scribble/bnf "guide-utils.rkt"
(for-label racket/serialize))
(for-label racket/serialize racket/struct))
@(define posn-eval (make-base-eval))
@(posn-eval '(require racket/struct))
@title[#:tag "define-struct"]{Programmer-Defined Datatypes}
@ -198,26 +199,26 @@ to mere instance identity for opaque structure types:
]
To support instances comparisons via @racket[equal?] without making
the structure type transparent, you can use the @racket[#:property]
keyword, @racket[prop:equal+hash], and then a list of three functions:
the structure type transparent, you can use the @racket[#:methods]
keyword, @racket[gen:equal+hash], and implement three methods:
@def+int[
#:eval posn-eval
(struct lead (width height)
#:property
prop:equal+hash
(list (lambda (a b equal?-recur)
(code:comment @#,t{compare @racket[a] and @racket[b]})
(and (equal?-recur (lead-width a) (lead-width b))
(equal?-recur (lead-height a) (lead-height b))))
(lambda (a hash-recur)
(code:comment @#,t{compute primary hash code of @racket[a]})
(+ (hash-recur (lead-width a))
(* 3 (hash-recur (lead-height a)))))
(lambda (a hash2-recur)
(code:comment @#,t{compute secondary hash code of @racket[a]})
(+ (hash2-recur (lead-width a))
(hash2-recur (lead-height a))))))
#:methods
gen:equal+hash
[(define (equal-proc a b equal?-recur)
(code:comment @#,t{compare @racket[a] and @racket[b]})
(and (equal?-recur (lead-width a) (lead-width b))
(equal?-recur (lead-height a) (lead-height b))))
(define (hash-proc a hash-recur)
(code:comment @#,t{compute primary hash code of @racket[a]})
(+ (hash-recur (lead-width a))
(* 3 (hash-recur (lead-height a)))))
(define (hash2-proc a hash2-recur)
(code:comment @#,t{compute secondary hash code of @racket[a]})
(+ (hash2-recur (lead-width a))
(hash2-recur (lead-height a))))])
(equal? (lead 1 2) (lead 1 2))
]
@ -235,7 +236,7 @@ secondary hash codes for use with @tech{hash tables}:
(hash-ref h (lead 2 1))
]
The first function provided with @racket[prop:equal+hash] is not
The first function provided with @racket[gen:equal+hash] is not
required to recursively compare the fields of the structure. For
example, a structure type representing a set might implement equality
by checking that the members of the set are the same, independent of

40
collects/scribblings/reference/booleans.scrbl
View File

@ -4,6 +4,9 @@
@(define bool-eval (make-base-eval))
@(bool-eval '(require racket/bool))
@(define struct-eval (make-base-eval))
@(struct-eval '(require racket/struct))
@title[#:tag "booleans"]{Booleans and Equality}
True and false @deftech{booleans} are represented by the values
@ -50,7 +53,7 @@ strings, byte strings, pairs, mutable pairs, vectors, boxes, hash
tables, and inspectable structures. In the last six cases, equality
is recursively defined; if both @racket[v1] and @racket[v2] contain
reference cycles, they are equal when the infinite unfoldings of the
values would be equal. See also @racket[prop:equal+hash] and @racket[prop:impersonator-of].
values would be equal. See also @racket[gen:equal+hash] and @racket[prop:impersonator-of].
@examples[
(equal? 'yes 'yes)
@ -126,17 +129,28 @@ Returns @racket[#t] if @racket[v] is an immutable @tech{string},
@defthing[prop:equal+hash struct-type-property?]{
A @tech{structure type property} (see @secref["structprops"]) that
A deprecated @tech{structure type property} (see @secref["structprops"])
that supplies an equality predicate and hashing functions for a structure
type. @racket[gen:equal+hash] should be used instead. Accepts a list of
three procedures that correspond to the methods of @racket[gen:equal+hash].
}
@section{Extensible Equality and Hashing}
@note-lib[racket/struct]
@defthing[gen:equal+hash any/c]{
A @tech{generic interface} (see @secref["struct-generics"]) that
supplies an equality predicate and hashing functions for a structure
type. The property value must be a list of three procedures:
type. The following methods must be implemented:
@itemize[
@item{@racket[_equal-proc : (any/c any/c (any/c any/c . ->
. boolean?) . -> . any/c)] --- tests whether the first two
arguments are equal, where both values are instances of the
structure type to which the property is associated (or a
subtype of the structure type).
structure type to which the generic interface is associated
(or a subtype of the structure type).
The third argument is an @racket[equal?] predicate to use for
recursive equality checks; use the given predicate instead of
@ -149,7 +163,7 @@ type. The property value must be a list of three procedures:
The @racket[_equal-proc] is called for a pair of structures
only when they are not @racket[eq?], and only when they both
have a @racket[prop:equal+hash] value inherited from the same
have a @racket[gen:equal+hash] value inherited from the same
structure type. With this strategy, the order in which
@racket[equal?] receives two structures does not matter. It
also means that, by default, a structure sub-type inherits the
@ -159,7 +173,7 @@ type. The property value must be a list of three procedures:
. exact-integer?)] --- computes a hash code for the given
structure, like @racket[equal-hash-code]. The first argument is
an instance of the structure type (or one of its subtypes) to
which the property is associated.
which the generic interface is associated.
The second argument is an @racket[equal-hash-code]-like
procedure to use for recursive hash-code computation; use the
@ -179,7 +193,7 @@ are consistent with @racket[_equal-proc]. Specifically,
value for any two structures for which @racket[_equal-proc] produces a
true value.
When a structure type has no @racket[prop:equal+hash] property, then
When a structure type has no @racket[gen:equal+hash] implementation, then
transparent structures (i.e., structures with an @tech{inspector} that
is controlled by the current @tech{inspector}) are @racket[equal?]
when they are instances of the same structure type (not counting
@ -191,10 +205,10 @@ values. For opaque structure types, @racket[equal?] is the same as
@racket[equal-secondary-hash-code] results are based only on
@racket[eq-hash-code]. If a structure has a @racket[prop:impersonator-of]
property, then the @racket[prop:impersonator-of] property takes precedence over
@racket[prop:equal+hash] if the property value's procedure returns a
@racket[gen:equal+hash] if the property value's procedure returns a
non-@racket[#f] value when applied to the structure.
@examples[
@examples[ #:eval struct-eval
(define (farm=? farm1 farm2 recursive-equal?)
(and (= (farm-apples farm1)
(farm-apples farm2))
@ -213,8 +227,10 @@ non-@racket[#f] value when applied to the structure.
(* 1 (farm-oranges farm))))
(define-struct farm (apples oranges sheep)
#:property prop:equal+hash
(list farm=? farm-hash-1 farm-hash-2))
#:methods gen:equal+hash
[(define equal-proc farm=?)
(define hash-proc farm-hash-1)
(define hash2-proc farm-hash-2)])
(define east (make-farm 5 2 20))
(define west (make-farm 18 6 14))
(define north (make-farm 5 20 20))

2
collects/scribblings/reference/dicts.scrbl
View File

@ -655,7 +655,7 @@ iterators, respectively, if @racket[d] implements the
Creates a dictionary that is implemented in terms of a hash table
where keys are compared with @racket[eql?] and hashed with
@racket[hash-proc] and @racket[hash2-proc]. See
@racket[prop:equal+hash] for information on suitable equality and
@racket[gen:equal+hash] for information on suitable equality and
hashing functions.
The @racket[make-custom-hash] and @racket[make-weak-custom-hash]

2
collects/scribblings/reference/hashes.scrbl
View File

@ -443,7 +443,7 @@ the returned number is the same.}
Returns a @tech{fixnum}; for any two calls with @racket[equal?] values,
the returned number is the same. A hash code is computed even when
@racket[v] contains a cycle through pairs, vectors, boxes, and/or
inspectable structure fields. See also @racket[prop:equal+hash].}
inspectable structure fields. See also @racket[gen:equal+hash].}
@defproc[(equal-secondary-hash-code [v any/c]) fixnum?]{

2
collects/scribblings/reference/struct.scrbl
View File

@ -73,7 +73,7 @@ same structure type, no fields are opaque, and the results of applying
@racket[equal?]. (Consequently, @racket[equal?] testing for
structures may depend on the current inspector.) A structure type can
override the default @racket[equal?] definition through the
@racket[prop:equal+hash] property.
@racket[gen:equal+hash] @tech{generic interface}.
@local-table-of-contents[]

35
collects/tests/generics/custom-hash.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/generics
(require racket/generics racket/struct
(only-in racket/dict
gen:dict prop:dict
dict?
@ -9,8 +9,7 @@
dict-set
dict-remove!
dict-remove
dict-count)
(only-in racket/list remove-duplicates))
dict-count))
(struct hash-box (key))
@ -50,14 +49,16 @@
(define (dict-remove dict key)
(error "no functional update"))
(define dict-count custom-hash-count)]
#:property prop:equal+hash
(list (lambda (a b recur)
(and (recur (custom-hash-make-box a)
(custom-hash-make-box b))
(recur (custom-hash-table a)
(custom-hash-table b))))
(lambda (a recur) (recur (custom-hash-table a)))
(lambda (a recur) (recur (custom-hash-table a)))))
#:methods gen:equal+hash
[(define (equal-proc a b recur)
(and (recur (custom-hash-make-box a)
(custom-hash-make-box b))
(recur (custom-hash-table a)
(custom-hash-table b))))
(define (hash-proc a recur)
(recur (custom-hash-table a)))
(define (hash2-proc a recur)
(recur (custom-hash-table a)))])
(define (make-custom-hash =? hash [hash2 (lambda (v) 10001)])
@ -72,11 +73,13 @@
(raise-type-error 'make-custom-hash "procedure (arity 1)" hash2))
(let ()
(struct box hash-box ()
#:property prop:equal+hash
(list
(lambda (a b recur) (=? (hash-box-key a) (hash-box-key b)))
(lambda (v recur) (hash (hash-box-key v)))
(lambda (v recur) (hash2 (hash-box-key v)))))
#:methods gen:equal+hash
[(define (equal-proc a b recur)
(=? (hash-box-key a) (hash-box-key b)))
(define (hash-proc v recur)
(hash (hash-box-key v)))
(define (hash2-proc v recur)
(hash2 (hash-box-key v)))])
(custom-hash (make-hash) box)))

15
collects/tests/generics/equal+hash.rkt
View File

@ -1,14 +1,15 @@
#lang racket
(require racket/struct)
;; vectors as method tables
(struct kons (kar kdr)
#:property prop:equal+hash
(vector 'ta
(lambda (x y rec)
(and (rec (kons-kar x) (kons-kar y))
(rec (kons-kdr x) (kons-kdr y))))
(lambda (x y) 12)
(lambda (x y) 13)))
#:methods gen:equal+hash
[(define (equal-proc x y rec)
(and (rec (kons-kar x) (kons-kar y))
(rec (kons-kdr x) (kons-kdr y))))
(define (hash-proc x rec) 12)
(define (hash2-proc x rec) 13)])
(module+ test
(require rackunit)

1
collects/tests/generics/tests.rkt
View File

@ -6,4 +6,5 @@
(submod "stream.rkt" test)
(submod "iterator.rkt" test)
(submod "struct-form.rkt" test)
(submod "equal+hash.rkt" test)
"from-unstable.rkt")