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

Mutable data at typed boundaries can't have flat contracts.

Browse Source 
Closes PR 12884.
This commit is contained in:
Sam Tobin-Hochstadt 2012-07-14 20:40:30 -04:00
parent 546c12cf2a
commit f40c7f11a6
2 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/tests/typed-racket/fail/predicate-box.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang typed/racket
(define: b : (Boxof Any) (box 4))
(define-predicate boxof-integer? (Boxof Integer))
(define (set-b-box! v) (set-box! b v))
(: a-very-listy-integer (-> Integer))
(define (a-very-listy-integer)
(cond [(boxof-integer? b) (set-b-box! '(1 2 3))
(unbox b)]
[else (error 'a-very-listy-integer "can't happen")]))

17
collects/typed-racket/private/type-contract.rkt
View File

@ -188,13 +188,11 @@
[(Set: t) #`(set/c #,(t->c t))] [(Set: t) #`(set/c #,(t->c t))]
[(Sequence: ts) #`(sequence/c #,@(map t->c ts))] [(Sequence: ts) #`(sequence/c #,@(map t->c ts))]
[(Vector: t) [(Vector: t)
(if flat? (when flat? (exit (fail)))
#`(vectorof #,(t->c t #:flat #t) #:flat? #t) #`(vectorof #,(t->c t))]
#`(vectorof #,(t->c t)))]
[(Box: t) [(Box: t)
(if flat? (when flat? (exit (fail)))
#`(box/c #,(t->c t #:flat #t) #:flat? #t) #`(box/c #,(t->c t))]
#`(box/c #,(t->c t)))]
[(Pair: t1 t2) [(Pair: t1 t2)
#`(cons/c #,(t->c t1) #,(t->c t2))] #`(cons/c #,(t->c t1) #,(t->c t2))]
[(Opaque: p? cert) [(Opaque: p? cert)
@ -238,6 +236,8 @@
=> =>
cdr] cdr]
[proc (exit (fail))] [proc (exit (fail))]
[(and flat? (ormap values mut?))
(exit (fail))]
[poly? [poly?
(with-syntax* ([(rec blame val) (generate-temporaries '(rec blame val))] (with-syntax* ([(rec blame val) (generate-temporaries '(rec blame val))]
[maker maker-id] [maker maker-id]
@ -283,9 +283,8 @@
[(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))] [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
[(Param: in out) #`(parameter/c #,(t->c out))] [(Param: in out) #`(parameter/c #,(t->c out))]
[(Hashtable: k v) [(Hashtable: k v)
(if flat? (when flat? (exit (fail)))
#`(hash/c #,(t->c k #:flat #t) #,(t->c v #:flat #t) #:flat? #t #:immutable 'dont-care) #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care)]
#`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care))]
[else [else
(exit (fail))])))) (exit (fail))]))))