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

added object=-hash-code

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-doc/scribblings/reference/class.scrbl
View File

@ -2509,6 +2509,11 @@ returns @racket[#t] if both arguments are @racket[#f].
@history[#:added "6.1.1.8"]} @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?]{ @defproc[(object->vector [object object?] [opaque-v any/c #f]) vector?]{

4
pkgs/racket-test/tests/racket/contract/object-contract.rkt
View File

@ -1425,7 +1425,9 @@
(test #f (contract-eval 'object=?) o1 (contract-eval '(new object%))) (test #f (contract-eval 'object=?) o1 (contract-eval '(new object%)))
(test #t (contract-eval 'object=?) o1 o2) (test #t (contract-eval 'object=?) o1 o2)
(test #t (contract-eval 'object=?) o2 o1) (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 (ctest #t
method-in-interface? method-in-interface?

29
racket/collects/racket/private/class-internal.rkt
View File

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