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

object/c-equivalent? refactoring

Browse Source 
- add comment saying `check-one-object/equivalent` only compares common
  members
- put the similar parts of `check-one-object` and
  `check-one-object/equivalent` in a helper function
- in `object/c-equivalent?`, check that names match before comparing the
  common contracts (because the names should be fast to check-if-incorrect)
This commit is contained in:
Ben Greenman 2018-05-11 20:10:08 -04:00 committed by Robby Findler
parent cc44afdf77
commit 568f086162
1 changed files with 14 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
racket/collects/racket/private/class-c-old.rkt
View File

@ -1596,12 +1596,12 @@
(cond
[(base-object/c? that)
(and
(check-one-object/equivalent base-object/c-methods base-object/c-method-contracts this that)
(check-one-object/equivalent base-object/c-fields base-object/c-field-contracts this that)
(equal? (base-object/c-methods that)
(base-object/c-methods this))
(equal? (base-object/c-fields that)
(base-object/c-fields this)))]
(base-object/c-fields this))
(check-one-object/equivalent base-object/c-methods base-object/c-method-contracts this that)
(check-one-object/equivalent base-object/c-fields base-object/c-field-contracts this that))]
[else #f]))
(define (object/c-common-methods-stronger? this that)
@ -1622,13 +1622,23 @@
;; See `check-one-stronger`. The difference is that this one only checks the
;; names that are in both this and that.
(define (check-one-object names-sel ctcs-sel this that)
(check-one-object/common-names names-sel ctcs-sel this that contract-stronger?))
;; Similar to `check-one-object`, but compare common fields/methods with
;; `contract-equivalent?`
(define (check-one-object/equivalent names-sel ctcs-sel this that)
(check-one-object/common-names names-sel ctcs-sel this that contract-equivalent?))
;; Extract names (using `names-sel`) and contracts (`ctcs-sel`) from objects `this` and `that`.
;; For all contracts with the same name, compare the contracts using `compare-ctcs`.
(define (check-one-object/common-names names-sel ctcs-sel this that compare-ctcs)
(for/and ([this-name (in-list (names-sel this))]
[this-ctc (in-list (ctcs-sel this))])
(or (not (member this-name (names-sel that)))
(for/or ([that-name (in-list (names-sel that))]
[that-ctc (in-list (ctcs-sel that))])
(and (equal? this-name that-name)
(contract-stronger?
(compare-ctcs
(if (just-check-existence? this-ctc)
any/c
this-ctc)
@ -1636,23 +1646,6 @@
any/c
that-ctc)))))))
(define (check-one-object/equivalent names-sel ctcs-sel this that)
(and (equal? (names-sel this)
(names-sel this))
(for/and ([this-name (in-list (names-sel this))]
[this-ctc (in-list (ctcs-sel this))])
(or (not (member this-name (names-sel that)))
(for/or ([that-name (in-list (names-sel that))]
[that-ctc (in-list (ctcs-sel that))])
(and (equal? this-name that-name)
(contract-equivalent?
(if (just-check-existence? this-ctc)
any/c
this-ctc)
(if (just-check-existence? that-ctc)
any/c
that-ctc))))))))
(define-struct base-object/c (methods method-contracts fields field-contracts)
#:property prop:custom-write custom-write-property-proc
#:property prop:contract