diff --git a/collects/data/gvector.rkt b/collects/data/gvector.rkt index af41b31731..6a315fc5d6 100644 --- a/collects/data/gvector.rkt +++ b/collects/data/gvector.rkt @@ -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 diff --git a/collects/racket/main.rkt b/collects/racket/main.rkt index 71a6329147..eb9dba86da 100644 --- a/collects/racket/main.rkt +++ b/collects/racket/main.rkt @@ -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) diff --git a/collects/racket/private/dict.rkt b/collects/racket/private/dict.rkt index 7fa787ac78..e189e8ff7a 100644 --- a/collects/racket/private/dict.rkt +++ b/collects/racket/private/dict.rkt @@ -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)]) diff --git a/collects/racket/struct.rkt b/collects/racket/struct.rkt new file mode 100644 index 0000000000..f320467a46 --- /dev/null +++ b/collects/racket/struct.rkt @@ -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)) diff --git a/collects/scribblings/guide/define-struct.scrbl b/collects/scribblings/guide/define-struct.scrbl index 34726f5ffa..085dd1a093 100644 --- a/collects/scribblings/guide/define-struct.scrbl +++ b/collects/scribblings/guide/define-struct.scrbl @@ -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 diff --git a/collects/scribblings/reference/booleans.scrbl b/collects/scribblings/reference/booleans.scrbl index 799648fd4a..037f5a94b9 100644 --- a/collects/scribblings/reference/booleans.scrbl +++ b/collects/scribblings/reference/booleans.scrbl @@ -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)) diff --git a/collects/scribblings/reference/dicts.scrbl b/collects/scribblings/reference/dicts.scrbl index fef68d58b4..31de747b5e 100644 --- a/collects/scribblings/reference/dicts.scrbl +++ b/collects/scribblings/reference/dicts.scrbl @@ -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] diff --git a/collects/scribblings/reference/hashes.scrbl b/collects/scribblings/reference/hashes.scrbl index e48e9aa399..342ffbeafc 100644 --- a/collects/scribblings/reference/hashes.scrbl +++ b/collects/scribblings/reference/hashes.scrbl @@ -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?]{ diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl index f31366a3b0..1c53e8cf73 100644 --- a/collects/scribblings/reference/struct.scrbl +++ b/collects/scribblings/reference/struct.scrbl @@ -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[] diff --git a/collects/tests/generics/custom-hash.rkt b/collects/tests/generics/custom-hash.rkt index 6638cc62ff..f15fd3a748 100644 --- a/collects/tests/generics/custom-hash.rkt +++ b/collects/tests/generics/custom-hash.rkt @@ -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))) diff --git a/collects/tests/generics/equal+hash.rkt b/collects/tests/generics/equal+hash.rkt index 1dc74ca86c..1e7da75f4f 100644 --- a/collects/tests/generics/equal+hash.rkt +++ b/collects/tests/generics/equal+hash.rkt @@ -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) diff --git a/collects/tests/generics/tests.rkt b/collects/tests/generics/tests.rkt index 72b7b60a15..386e02ff7f 100644 --- a/collects/tests/generics/tests.rkt +++ b/collects/tests/generics/tests.rkt @@ -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")