From 93d286914e5c1945b40362de4ab25b640179cfad Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 19 Dec 2015 10:44:49 -0600 Subject: [PATCH] =?UTF-8?q?port=20new-=E2=88=80/c=20and=20new-=E2=88=83/c?= =?UTF-8?q?=20to=20late-neg?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../racket/contract/private/exists.rkt | 30 ++++++++++--------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/racket/collects/racket/contract/private/exists.rkt b/racket/collects/racket/contract/private/exists.rkt index f5161c4dd0..8fbfda0f6a 100644 --- a/racket/collects/racket/contract/private/exists.rkt +++ b/racket/collects/racket/contract/private/exists.rkt @@ -11,19 +11,21 @@ [_new-∀/c new-∀/c]) ∀∃?) -(define (∀∃-proj ctc) - (let ([in (∀∃/c-in ctc)] - [out (∀∃/c-out ctc)] - [pred? (∀∃/c-pred? ctc)] - [neg? (∀∃/c-neg? ctc)]) - (define name (∀∃/c-name ctc)) - (λ (blame) - (if (equal? neg? (blame-swapped? blame)) - (λ (val) - (if (pred? val) - (out val) - (raise-blame-error blame val "not ~a: ~e" name val))) - in)))) +(define (∀∃-late-neg-proj ctc) + (define in (∀∃/c-in ctc)) + (define (inj v neg-party) (in v)) + (define out (∀∃/c-out ctc)) + (define pred? (∀∃/c-pred? ctc)) + (define neg? (∀∃/c-neg? ctc)) + (define name (∀∃/c-name ctc)) + (λ (blame) + (if (equal? neg? (blame-swapped? blame)) + (λ (val neg-party) + (if (pred? val) + (out val) + (raise-blame-error blame val #:missing-party neg-party + "not ~a: ~e" name val))) + inj))) (define-struct ∀∃/c (in out pred? name neg?) #:omit-define-syntaxes @@ -32,7 +34,7 @@ (build-contract-property #:name (λ (ctc) (∀∃/c-name ctc)) #:first-order (λ (ctc) (λ (x) #t)) ;; ??? - #:projection ∀∃-proj + #:late-neg-projection ∀∃-late-neg-proj #:stronger (λ (this that) (equal? this that)) #:generate (λ (ctc) (cond