Have a generic interface for equal+hash.

Currently provided by racket/struct, for lack of a better place.

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,9 +193,8 @@
                                      any/c
                                      exact-nonnegative-integer?
                                      #f #f #f))
-  #:property prop:equal+hash
+  #:methods gen:equal+hash
-             (let ([equals
+  [(define (equal-proc x y recursive-equal?)
-                    (lambda (x y recursive-equal?)
      (let ([vx (gvector-vec x)]
            [vy (gvector-vec y)]
            [nx (gvector-n x)]
@@ -202,15 +202,15 @@
        (and (= nx ny)
             (for/and ([index (in-range nx)])
               (recursive-equal? (vector-ref vx index)
-                                                 (vector-ref vy index))))))]
+                                (vector-ref vy index))))))
-                   [hash-code
+   (define (hash-code x hc)
-                    (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))))))])
+         (+ h (hc (vector-ref v i))))))
-               (list equals hash-code hash-code))
+   (define hash-proc  hash-code)
+   (define hash2-proc hash-code)]
   #:property prop:sequence in-gvector)
 
 (provide/contract

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)

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
+  #:methods gen:equal+hash
-  (list (lambda (a b recur)
+  [(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))))
-        (lambda (a recur) (recur (custom-hash-table a)))
+   (define (hash-proc a recur)
-        (lambda (a recur) (recur (custom-hash-table a)))))
+     (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
+               #:methods gen:equal+hash
-                                           (lambda (a b recur) 
+               [(define (equal-proc a b recur)
                   (=? (hash-box-key a) (hash-box-key b)))
-                                           (lambda (v recur) 
+                (define (hash-proc v recur)
                   (hash (hash-box-key v)))
-                                           (lambda (v recur)
+                (define (hash2-proc v recur)
-                                             (hash2 (hash-box-key v)))))
+                  (hash2 (hash-box-key v)))])
              (make-custom-hash table (wrap-make-box box))))])
     (let ([make-custom-hash 
            (lambda (=? hash [hash2 (lambda (v) 10001)])

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

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]
+the structure type transparent, you can use the @racket[#:methods]
-keyword, @racket[prop:equal+hash], and then a list of three functions:
+keyword, @racket[gen:equal+hash], and implement three methods:
 
 @def+int[
 #:eval posn-eval
 (struct lead (width height)
-  #:property
+  #:methods
-  prop:equal+hash
+  gen:equal+hash
-  (list (lambda (a b equal?-recur) 
+  [(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))))
-        (lambda (a hash-recur)
+   (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)))))
-        (lambda (a hash2-recur)
+   (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))))))
+             (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

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
+        structure type to which the generic interface is associated
-        subtype of the structure type).
+        (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
+               #:methods gen:equal+hash
-               (list farm=? farm-hash-1 farm-hash-2))
+	       [(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))

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]

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?]{

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[]
 

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)
+                  dict-count))
-         (only-in racket/list remove-duplicates))
 
 (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
+  #:methods gen:equal+hash
-  (list (lambda (a b recur)
+  [(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))))
-        (lambda (a recur) (recur (custom-hash-table a)))
+   (define (hash-proc a recur)
-        (lambda (a recur) (recur (custom-hash-table a)))))
+     (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
+            #:methods gen:equal+hash
-            (list
+            [(define (equal-proc a b recur)
-             (lambda (a b recur) (=? (hash-box-key a) (hash-box-key b)))
+               (=? (hash-box-key a) (hash-box-key b)))
-             (lambda (v recur)   (hash (hash-box-key v)))
+             (define (hash-proc v recur)
-             (lambda (v recur)   (hash2 (hash-box-key v)))))
+               (hash (hash-box-key v)))
+             (define (hash2-proc v recur)
+               (hash2 (hash-box-key v)))])
     (custom-hash (make-hash) box)))
 
 

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
+        #:methods gen:equal+hash
-        (vector 'ta
+        [(define (equal-proc x y rec)
-                (lambda (x y rec)
            (and (rec (kons-kar x) (kons-kar y))
                 (rec (kons-kdr x) (kons-kdr y))))
-                (lambda (x y) 12)
+         (define (hash-proc x rec)  12)
-                (lambda (x y) 13)))
+         (define (hash2-proc x rec) 13)])
 
 (module+ test
   (require rackunit)

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