From da8782fb099f53b3e13902174ed93c68e3559ef1 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 8 Aug 2012 22:00:56 -0700 Subject: [PATCH] Make generated flat contracts actually flat. original commit: 3876dfa8411e06b2225b614246fa0274855e915b --- collects/tests/typed-racket/succeed/def-pred.rkt | 4 ++++ collects/typed-racket/private/type-contract.rkt | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/collects/tests/typed-racket/succeed/def-pred.rkt b/collects/tests/typed-racket/succeed/def-pred.rkt index 4722e868..6d54886d 100644 --- a/collects/tests/typed-racket/succeed/def-pred.rkt +++ b/collects/tests/typed-racket/succeed/def-pred.rkt @@ -3,3 +3,7 @@ (define-predicate int-or-bool? (U Integer Boolean)) (int-or-bool? 7) + +(define-predicate int-list? (Rec List (Pair Integer (U '() List)))) +(int-list? 1) +(int-list? '(1 2 3)) diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index ea22a5ea..b66d0818 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -217,7 +217,7 @@ (match-let ([(Mu-name: n-nm _) ty]) (with-syntax ([(n*) (generate-temporaries (list n-nm))]) (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*))))] [(Value: #f) #'false/c] [(Instance: (Class: _ _ (list (list name fcn) ...))) @@ -258,7 +258,7 @@ (#,pred? val) #,@(for/list ([fty flds] [f-acc acc-ids]) #`((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))))))]) rec) ;Should make this case a chaperone/impersonator contract