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

Make generated flat contracts actually flat.

Browse Source
This commit is contained in:
Eric Dobson 2012-08-08 22:00:56 -07:00 committed by Sam Tobin-Hochstadt
parent 6852140dd8
commit 3876dfa841
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-racket/succeed/def-pred.rkt
View File

@ -3,3 +3,7 @@
(define-predicate int-or-bool? (U Integer Boolean)) (define-predicate int-or-bool? (U Integer Boolean))
(int-or-bool? 7) (int-or-bool? 7)
(define-predicate int-list? (Rec List (Pair Integer (U '() List))))
(int-list? 1)
(int-list? '(1 2 3))

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

@ -217,7 +217,7 @@
(match-let ([(Mu-name: n-nm _) ty]) (match-let ([(Mu-name: n-nm _) ty])
(with-syntax ([(n*) (generate-temporaries (list n-nm))]) (with-syntax ([(n*) (generate-temporaries (list n-nm))])
(parameterize ([vars (cons (list n #'n* #'n*) (vars))]) (parameterize ([vars (cons (list n #'n* #'n*) (vars))])
#`(letrec ([n* (recursive-contract #,(t->c b))]) #`(letrec ([n* (recursive-contract #,(t->c b) #,(if flat? #'#:flat #'#:impersonator))])
n*))))] n*))))]
[(Value: #f) #'false/c] [(Value: #f) #'false/c]
[(Instance: (Class: _ _ (list (list name fcn) ...))) [(Instance: (Class: _ _ (list (list name fcn) ...)))
@ -258,7 +258,7 @@
(#,pred? val) (#,pred? val)
#,@(for/list ([fty flds] [f-acc acc-ids]) #,@(for/list ([fty flds] [f-acc acc-ids])
#`((flat-contract-predicate #`((flat-contract-predicate
#,(t->c fty #:seen (cons (cons ty #'(recursive-contract rec)) structs-seen))) #,(t->c fty #:seen (cons (cons ty #'(recursive-contract rec #:flat)) structs-seen)))
(#,f-acc val))))))]) (#,f-acc val))))))])
rec) rec)
;Should make this case a chaperone/impersonator contract ;Should make this case a chaperone/impersonator contract