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

Add the contract information to chaperoned boxes, hashes, and vectors.

Browse Source
This commit is contained in:
Stevie Strickland 2010-06-11 17:07:13 -04:00
parent 51629f8c3d
commit a930719a87
4 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/contract/private/box.rkt
View File

@ -80,7 +80,8 @@
(box-immutable (pos-elem-proj (unbox val))) (box-immutable (pos-elem-proj (unbox val)))
(box-wrapper val (box-wrapper val
(λ (b v) (pos-elem-proj v)) (λ (b v) (pos-elem-proj v))
(λ (b v) (neg-elem-proj v)))))))))) (λ (b v) (neg-elem-proj v))
proxy-prop:contracted ctc))))))))
(define-struct (chaperone-box/c box/c) () (define-struct (chaperone-box/c box/c) ()
#:property prop:chaperone-contract #:property prop:chaperone-contract

3
collects/racket/contract/private/hash.rkt
View File

@ -180,7 +180,8 @@
(λ (h k) (λ (h k)
(neg-dom-proj k)) (neg-dom-proj k))
(λ (h k) (λ (h k)
(pos-dom-proj k)))))))))) (pos-dom-proj k))
proxy-prop:contracted ctc))))))))
(define-struct (chaperone-hash/c hash/c) () (define-struct (chaperone-hash/c hash/c) ()
#:omit-define-syntaxes #:omit-define-syntaxes

6
collects/racket/contract/private/vector.rkt
View File

@ -84,7 +84,8 @@
(λ (vec i val) (λ (vec i val)
(elem-pos-proj val)) (elem-pos-proj val))
(λ (vec i val) (λ (vec i val)
(elem-neg-proj val)))))))))) (elem-neg-proj val))
proxy-prop:contracted ctc))))))))
(define-struct (chaperone-vectorof vectorof) () (define-struct (chaperone-vectorof vectorof) ()
#:property prop:chaperone-contract #:property prop:chaperone-contract
@ -237,7 +238,8 @@
(λ (vec i val) (λ (vec i val)
((vector-ref elem-pos-projs i) val)) ((vector-ref elem-pos-projs i) val))
(λ (vec i val) (λ (vec i val)
((vector-ref elem-neg-projs i) val)))))))))) ((vector-ref elem-neg-projs i) val))
proxy-prop:contracted ctc))))))))
(define-struct (chaperone-vector/c vector/c) () (define-struct (chaperone-vector/c vector/c) ()
#:property prop:chaperone-contract #:property prop:chaperone-contract

8
collects/tests/racket/contract-test.rktl
View File

@ -9935,6 +9935,14 @@ so that propagation occurs.
(test ctc value-contract (contract ctc (λ (x) 3) 'pos 'neg))) (test ctc value-contract (contract ctc (λ (x) 3) 'pos 'neg)))
(let ([ctc (case-> (-> number? number? number?) (-> number? number?))]) (let ([ctc (case-> (-> number? number? number?) (-> number? number?))])
(test ctc value-contract (contract ctc (case-lambda [(x) 3] [(x y) (+ x y)]) 'pos 'neg))) (test ctc value-contract (contract ctc (case-lambda [(x) 3] [(x y) (+ x y)]) 'pos 'neg)))
(let ([ctc (box/c number?)])
(test ctc value-contract (contract ctc (box 3) 'pos 'neg)))
(let ([ctc (hash/c number? number?)])
(test ctc value-contract (contract ctc (make-hash) 'pos 'neg)))
(let ([ctc (vectorof number?)])
(test ctc value-contract (contract ctc (vector 1 2 3) 'pos 'neg)))
(let ([ctc (vector/c number? number?)])
(test ctc value-contract (contract ctc (vector 4 5) 'pos 'neg)))
; ;
; ;