From d2bf3352124f5eb14e917fa253c874b4f5d428c3 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 22 Dec 2015 10:27:36 -0600 Subject: [PATCH] use the correct accessor for subcontracts --- racket/collects/racket/contract/private/arr-i.rkt | 12 ++++++------ racket/collects/racket/contract/private/base.rkt | 4 ++-- .../racket/contract/private/case-arrow.rkt | 6 +++--- racket/collects/racket/contract/private/hash.rkt | 4 ++-- racket/collects/racket/contract/private/misc.rkt | 6 +++--- .../racket/contract/private/parametric.rkt | 2 +- .../collects/racket/contract/private/struct-dc.rkt | 14 +++++++------- .../racket/contract/private/struct-prop.rkt | 2 +- racket/collects/racket/contract/private/vector.rkt | 6 +++--- 9 files changed, 28 insertions(+), 28 deletions(-) diff --git a/racket/collects/racket/contract/private/arr-i.rkt b/racket/collects/racket/contract/private/arr-i.rkt index ba5eddfa20..bd04b22e2e 100644 --- a/racket/collects/racket/contract/private/arr-i.rkt +++ b/racket/collects/racket/contract/private/arr-i.rkt @@ -28,12 +28,12 @@ (provide (rename-out [->i/m ->i])) (define (build-??-args c-or-i-procedure ctc blame) - (define arg-ctc-projs (map (λ (x) (contract-late-neg-projection (->i-arg-contract x))) + (define arg-ctc-projs (map (λ (x) (get/build-late-neg-projection (->i-arg-contract x))) (->i-arg-ctcs ctc))) - (define indy-arg-ctc-projs (map (λ (x) (contract-late-neg-projection (cdr x))) + (define indy-arg-ctc-projs (map (λ (x) (get/build-late-neg-projection (cdr x))) (->i-indy-arg-ctcs ctc))) - (define rng-ctc-projs (map (λ (x) (contract-late-neg-projection (cdr x))) (->i-rng-ctcs ctc))) - (define indy-rng-ctc-projs (map (λ (x) (contract-late-neg-projection (cdr x))) + (define rng-ctc-projs (map (λ (x) (get/build-late-neg-projection (cdr x))) (->i-rng-ctcs ctc))) + (define indy-rng-ctc-projs (map (λ (x) (get/build-late-neg-projection (cdr x))) (->i-indy-rng-ctcs ctc))) (define has-rest (->i-rest ctc)) (define here (->i-here ctc)) @@ -1094,12 +1094,12 @@ evaluted left-to-right.) (raise-argument-error '->i "chaperone-contract?" orig-ctc)) - (((contract-late-neg-projection ctc) blame) obj neg-party)))) + (((get/build-late-neg-projection ctc) blame) obj neg-party)))) (begin-encourage-inline (define (un-dep orig-ctc obj blame neg-party) (let ([ctc (coerce-contract '->i orig-ctc)]) - (((contract-late-neg-projection ctc) blame) obj neg-party)))) + (((get/build-late-neg-projection ctc) blame) obj neg-party)))) (define-for-syntax (mk-used-indy-vars an-istx) (let ([vars (make-free-identifier-mapping)]) diff --git a/racket/collects/racket/contract/private/base.rkt b/racket/collects/racket/contract/private/base.rkt index 3cdac2fe97..ac36fcb5cb 100644 --- a/racket/collects/racket/contract/private/base.rkt +++ b/racket/collects/racket/contract/private/base.rkt @@ -145,7 +145,7 @@ [(recursive-contract-list-contract? ctc) (λ (blame) (define r-ctc (force-recursive-contract ctc)) - (define f (contract-late-neg-projection r-ctc)) + (define f (get/build-late-neg-projection r-ctc)) (define blame-known (blame-add-context blame #f)) (λ (val neg-party) (unless (list? val) @@ -157,7 +157,7 @@ [else (λ (blame) (define r-ctc (force-recursive-contract ctc)) - (define f (contract-late-neg-projection r-ctc)) + (define f (get/build-late-neg-projection r-ctc)) (define blame-known (blame-add-context blame #f)) (λ (val neg-party) ((f blame-known) val neg-party)))])) diff --git a/racket/collects/racket/contract/private/case-arrow.rkt b/racket/collects/racket/contract/private/case-arrow.rkt index f96510c608..83eca5e086 100644 --- a/racket/collects/racket/contract/private/case-arrow.rkt +++ b/racket/collects/racket/contract/private/case-arrow.rkt @@ -184,7 +184,7 @@ (define (case->-proj wrapper) (λ (ctc) (define dom-ctcs+case-nums (get-case->-dom-ctcs+case-nums ctc)) - (define rng-late-neg-ctcs (map contract-late-neg-projection (get-case->-rng-ctcs ctc))) + (define rng-late-neg-ctcs (map get/build-late-neg-projection (get-case->-rng-ctcs ctc))) (define rst-ctcs (base-case->-rst-ctcs ctc)) (define specs (base-case->-specs ctc)) (λ (blame) @@ -294,11 +294,11 @@ [rst (in-list (base-case->-rst-ctcs ctc))] [i (in-naturals)]) (define dom+case-nums - (map (λ (dom) (cons i (contract-late-neg-projection dom))) doms)) + (map (λ (dom) (cons i (get/build-late-neg-projection dom))) doms)) (append acc (if rst (append dom+case-nums - (list (cons i (contract-late-neg-projection rst)))) + (list (cons i (get/build-late-neg-projection rst)))) dom+case-nums)))) (define (get-case->-rng-ctcs ctc) diff --git a/racket/collects/racket/contract/private/hash.rkt b/racket/collects/racket/contract/private/hash.rkt index 1ea2d680a6..3f3369fb9d 100644 --- a/racket/collects/racket/contract/private/hash.rkt +++ b/racket/collects/racket/contract/private/hash.rkt @@ -194,9 +194,9 @@ (define immutable (base-hash/c-immutable ctc)) (define flat? (flat-hash/c? ctc)) (λ (blame) - (define dom-proj ((contract-late-neg-projection (base-hash/c-dom ctc)) + (define dom-proj ((get/build-late-neg-projection (base-hash/c-dom ctc)) (blame-add-key-context blame #f))) - (define rng-proj ((contract-late-neg-projection (base-hash/c-rng ctc)) + (define rng-proj ((get/build-late-neg-projection (base-hash/c-rng ctc)) (blame-add-value-context blame #f))) (λ (val neg-party) (cond diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt index 5afebeb255..1b18727990 100644 --- a/racket/collects/racket/contract/private/misc.rkt +++ b/racket/collects/racket/contract/private/misc.rkt @@ -1994,7 +1994,7 @@ (define (stronger? this other) (contract-stronger? ctc other)) (make-contract #:name name - #:late-neg-projection (contract-late-neg-projection ctc) + #:late-neg-projection (get/build-late-neg-projection ctc) #:first-order (contract-first-order ctc) #:stronger stronger? #:list-contract? (list-contract? ctc)))))) @@ -2037,8 +2037,8 @@ (define (if/c-late-neg-proj ctc) (define predicate (base-if/c-predicate ctc)) - (define thn (contract-late-neg-projection (base-if/c-thn ctc))) - (define els (contract-late-neg-projection (base-if/c-els ctc))) + (define thn (get/build-late-neg-projection (base-if/c-thn ctc))) + (define els (get/build-late-neg-projection (base-if/c-els ctc))) (λ (blame) (define thn-proj (thn blame)) (define els-proj (els blame)) diff --git a/racket/collects/racket/contract/private/parametric.rkt b/racket/collects/racket/contract/private/parametric.rkt index 2fa504c15b..727ae8e344 100644 --- a/racket/collects/racket/contract/private/parametric.rkt +++ b/racket/collects/racket/contract/private/parametric.rkt @@ -69,7 +69,7 @@ (barrier/c negative? var))) (define protector (apply (polymorphic-contract-body c) instances)) - (((contract-late-neg-projection protector) blame) p neg-party)) + (((get/build-late-neg-projection protector) blame) p neg-party)) (lambda (p neg-party) (unless (procedure? p) diff --git a/racket/collects/racket/contract/private/struct-dc.rkt b/racket/collects/racket/contract/private/struct-dc.rkt index 6c13d96a31..624ba27869 100644 --- a/racket/collects/racket/contract/private/struct-dc.rkt +++ b/racket/collects/racket/contract/private/struct-dc.rkt @@ -260,7 +260,7 @@ (cond [(indep? subcontract) (define sub-ctc (indep-ctc subcontract)) - ((contract-late-neg-projection sub-ctc) blame+ctxt)] + ((get/build-late-neg-projection sub-ctc) blame+ctxt)] [else #f]))) (define mut-projs (for/list ([subcontract (in-list (base-struct/dc-subcontracts ctc))] @@ -268,7 +268,7 @@ (cond [(and (indep? subcontract) (mutable? subcontract)) (define sub-ctc (indep-ctc subcontract)) - ((contract-late-neg-projection sub-ctc) blame+ctxt)] + ((get/build-late-neg-projection sub-ctc) blame+ctxt)] [else #f]))) (define orig-indy-projs (for/list ([subcontract (in-list (base-struct/dc-subcontracts ctc))] @@ -276,7 +276,7 @@ (cond [(indep? subcontract) (define sub-ctc (indep-ctc subcontract)) - ((contract-late-neg-projection sub-ctc) blame+ctxt)] + ((get/build-late-neg-projection sub-ctc) blame+ctxt)] [else #f]))) (define orig-mut-indy-projs (for/list ([subcontract (in-list (base-struct/dc-subcontracts ctc))] @@ -284,7 +284,7 @@ (cond [(indep? subcontract) (define sub-ctc (indep-ctc subcontract)) - ((contract-late-neg-projection sub-ctc) blame+ctxt)] + ((get/build-late-neg-projection sub-ctc) blame+ctxt)] [else #f]))) (λ (v neg-party) (cond @@ -339,7 +339,7 @@ 'struct/dc (apply (dep-dep-proc subcontract) dep-args)))) (when dep-ctc (check-flat/chaperone dep-ctc subcontract)) - (define dep-ctc-blame-proj (and dep-ctc (contract-late-neg-projection dep-ctc))) + (define dep-ctc-blame-proj (and dep-ctc (get/build-late-neg-projection dep-ctc))) (define-values (new-chaperone-args new-impersonate-args) (cond [(invariant? subcontract) @@ -589,7 +589,7 @@ (define the-ctc (coerce-contract 'struct/dc (apply (dep-dep-proc this-subcontract) dep-args))) (check-flat/chaperone the-ctc subcontract) - (((contract-late-neg-projection the-ctc) blame) val neg-party)] + (((get/build-late-neg-projection the-ctc) blame) val neg-party)] [else (define indy-blame (car blames)) (define proj (car projs)) @@ -598,7 +598,7 @@ (coerce-contract 'struct/dc (apply (dep-dep-proc subcontract) dep-args)))) - (define dep-ctc-blame-proj (and dep-ctc (contract-late-neg-projection dep-ctc))) + (define dep-ctc-blame-proj (and dep-ctc (get/build-late-neg-projection dep-ctc))) (when (dep? subcontract) (check-flat/chaperone dep-ctc subcontract)) diff --git a/racket/collects/racket/contract/private/struct-prop.rkt b/racket/collects/racket/contract/private/struct-prop.rkt index 24f096d8c2..10edb1961e 100644 --- a/racket/collects/racket/contract/private/struct-prop.rkt +++ b/racket/collects/racket/contract/private/struct-prop.rkt @@ -7,7 +7,7 @@ (define (get-stpc-late-neg-proj stpc) (define get-late-neg-proj - (contract-late-neg-projection + (get/build-late-neg-projection (struct-type-property/c-value-contract stpc))) (λ (input-blame) (define blame (blame-add-context input-blame "the struct property value of" #:swap? #t)) diff --git a/racket/collects/racket/contract/private/vector.rkt b/racket/collects/racket/contract/private/vector.rkt index 9274738fe1..d87920bd7e 100644 --- a/racket/collects/racket/contract/private/vector.rkt +++ b/racket/collects/racket/contract/private/vector.rkt @@ -358,7 +358,7 @@ (define blame+ctxt (blame-add-element-of-context blame)) (define val+np-acceptors (for/list ([c (in-list (base-vector/c-elems ctc))]) - ((contract-late-neg-projection c) blame+ctxt))) + ((get/build-late-neg-projection c) blame+ctxt))) (λ (val neg-party) (with-contract-continuation-mark (cons blame neg-party) @@ -377,12 +377,12 @@ (let ([elem-pos-projs (for/vector #:length (length elem-ctcs) ([c (in-list elem-ctcs)] [i (in-naturals)]) - ((contract-late-neg-projection c) + ((get/build-late-neg-projection c) (blame-add-context blame (format "the ~a element of" (n->th i)))))] [elem-neg-projs (for/vector #:length (length elem-ctcs) ([c (in-list elem-ctcs)] [i (in-naturals)]) - ((contract-late-neg-projection c) + ((get/build-late-neg-projection c) (blame-add-context blame (format "the ~a element of" (n->th i)) #:swap? #t)))]) (λ (val neg-party)