added object=-hash-code

This commit is contained in:
Robby Findler 2018-11-26 15:40:40 +01:00
parent a001b5b231
commit b68866db0f
3 changed files with 26 additions and 12 deletions

View File

@ -2509,6 +2509,11 @@ returns @racket[#t] if both arguments are @racket[#f].
@history[#:added "6.1.1.8"]}
@defproc[(object=-hash-code [o object?]) fixnum?]{
Returns the hash code for @racket[o] that corresponds to
the equality relation @racket[object=?].
@history[#:added "7.1.0.6"]}
@defproc[(object->vector [object object?] [opaque-v any/c #f]) vector?]{

View File

@ -1425,7 +1425,9 @@
(test #f (contract-eval 'object=?) o1 (contract-eval '(new object%)))
(test #t (contract-eval 'object=?) o1 o2)
(test #t (contract-eval 'object=?) o2 o1)
(test #f (contract-eval 'object=?) (contract-eval '(new object%)) o2))
(test #f (contract-eval 'object=?) (contract-eval '(new object%)) o2)
(test ((contract-eval 'object=-hash-code) o1) (contract-eval 'object=-hash-code) o1)
(test ((contract-eval 'object=-hash-code) o1) (contract-eval 'object=-hash-code) o2))
(ctest #t
method-in-interface?

View File

@ -40,7 +40,7 @@
mixin
interface interface* interface?
object% object? externalizable<%> printable<%> writable<%> equal<%>
object=? object-or-false=?
object=? object-or-false=? object=-hash-code
new make-object instantiate
send send/apply send/keyword-apply send* send+ dynamic-send
class-field-accessor class-field-mutator with-method
@ -4430,15 +4430,21 @@ An example
(and o1 o2 (-object=? o1 o2)))]))
(define (-object=? o1 o2)
(let* ([orig-o1 (if (has-original-object? o1) (original-object o1) o1)]
[orig-o2 (if (has-original-object? o2) (original-object o2) o2)]
[orig-orig-o1 (if (wrapped-object? orig-o1)
(wrapped-object-object orig-o1)
orig-o1)]
[orig-orig-o2 (if (wrapped-object? orig-o2)
(wrapped-object-object orig-o2)
orig-o2)])
(eq? orig-orig-o1 orig-orig-o2)))
(eq? (object=-original-object o1)
(object=-original-object o2)))
(define (object=-original-object o)
(define orig-o (if (has-original-object? o) (original-object o) o))
(define orig-orig-o
(if (wrapped-object? orig-o)
(wrapped-object-object orig-o)
orig-o))
orig-orig-o)
(define (object=-hash-code o)
(unless (object? o)
(raise-argument-error 'object=-hash-code "object?" 0 o))
(eq-hash-code (object=-original-object o)))
;;--------------------------------------------------------------------
;; primitive classes
@ -4837,7 +4843,8 @@ An example
class?
mixin
(rename-out [_interface interface]) interface* interface?
object% object? object=? object-or-false=? externalizable<%> printable<%> writable<%> equal<%>
object% object? object=? object-or-false=? object=-hash-code
externalizable<%> printable<%> writable<%> equal<%>
new make-object instantiate
get-field set-field! field-bound? field-names
dynamic-get-field dynamic-set-field!