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

contract: collapsible, prune leaves if eq? and trusted (#2706)

Browse Source 
Change the condition for filtering leaf contracts via `eq?`.

Before, we looked for flat or chaperone contracts.
After, look for flat or trusted contracts. So:

1. untrusted chaperones with side effects that are unsafe to drop are not
   dropped, and
2. impersonator contracts can now be dropped (object/c, recursive-contract)
This commit is contained in:
Ben Greenman 2019-07-11 15:53:16 -04:00 committed by GitHub
parent ef4eb585d7
commit eef651743e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 30 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
pkgs/racket-test/tests/racket/contract/collapsible-arrow.rkt
View File

@ -887,10 +887,33 @@
'(3 2 1)) '(3 2 1))
(test/spec-passed/result (test/spec-passed/result
'calculate-drops-2 'calculate-drops:trusted-chaperone
'(let* ([ctc1 (coerce-contract/f (box/c symbol?))]
[ctcs (list ctc1 ctc1 ctc1 ctc1 ctc1)])
(calculate-drops ctcs))
'(3 2 1))
(test/spec-passed/result
'calculate-drops:trusted-impersonator
'(let* ([ctc1 (coerce-contract/f (object/c))] '(let* ([ctc1 (coerce-contract/f (object/c))]
[ctcs (list ctc1 ctc1 ctc1 ctc1 ctc1)]) [ctcs (list ctc1 ctc1 ctc1 ctc1 ctc1)])
(calculate-drops ctcs)) (calculate-drops ctcs))
'(3 2 1))
(test/spec-passed/result
'calculate-drops:untrusted-chaperone
'(let* ([lnp (λ (v np) v)]
[ctc1 (coerce-contract/f (make-chaperone-contract #:late-neg-projection lnp))]
[ctcs (list ctc1 ctc1 ctc1)])
(calculate-drops ctcs))
'())
(test/spec-passed/result
'calculate-drops:untrusted-impersonator
'(let* ([lnp (λ (v np) v)]
[ctc1 (coerce-contract/f (make-contract #:late-neg-projection lnp))]
[ctcs (list ctc1 ctc1 ctc1)])
(calculate-drops ctcs))
'()) '())
(test/spec-passed/result (test/spec-passed/result
@ -918,7 +941,7 @@
[c4 (coerce-contract/f (object/c))] [c4 (coerce-contract/f (object/c))]
[ctcs (list c1 c2 c3 c4 c4 c2 c3 c1 c3 c2 c4 c1 c4)]) [ctcs (list c1 c2 c3 c4 c4 c2 c3 c1 c3 c2 c4 c1 c4)])
(calculate-drops ctcs)) (calculate-drops ctcs))
'(7 5 6)) '(10 7 4 5 6))
(test/spec-passed/result (test/spec-passed/result
'calculate-drops-6 'calculate-drops-6

6
racket/collects/racket/contract/private/collapsible-common.rkt
View File

@ -183,7 +183,11 @@
([flat (in-list flats)] ([flat (in-list flats)]
[i (in-naturals)]) [i (in-naturals)])
(cond (cond
[(or (flat-contract-struct? flat) (chaperone-contract-struct? flat)) [(or (flat-contract-struct? flat)
(trusted-contract-struct? flat))
;; Drop contracts that (1) do not change their behavior and (2) are
;; between other eq? contracts. (Trusted chaperones and
;; impersonators definitely don't change themselves.)
(cond (cond
[(hash-ref seen flat #f) [(hash-ref seen flat #f)
(define maybe-index (hash-ref maybe-drop flat #f)) (define maybe-index (hash-ref maybe-drop flat #f))