From 6031c0697bafa00032ad48f06178a98e3fa612fb Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sun, 29 Jun 2014 17:23:51 -0700 Subject: [PATCH] Make TR contract generation not wrap everything in recursive contract. Eta expand struct predicates, as this was the reason for recursive contracts in the first place. Closes PR 14611. original commit: 72d11286042959e8e7103bf23a1ab7a2970bd8b8 --- .../typed-racket/private/type-contract.rkt | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index f0ff5618..1f92c6e5 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -91,12 +91,7 @@ #:kind kind (type->contract-fail typ prop))]) (ignore ; should be ignored by the optimizer - (quasisyntax/loc - stx - (define-values (n) - (recursive-contract - cnt - #,(contract-kind->keyword kind)))))))] + (quasisyntax/loc stx (define-values (n) cnt)))))] [_ (int-err "should never happen - not a define-values: ~a" (syntax->datum stx))])) @@ -455,7 +450,7 @@ nm (recursive-sc-use nm*))))) (recursive-sc (list nm*) (list (struct/sc nm (ormap values mut?) fields)) (recursive-sc-use nm*))] - [else (flat/sc #`(flat-named-contract '#,(syntax-e pred?) #,pred?))])] + [else (flat/sc #`(flat-named-contract '#,(syntax-e pred?) (lambda (x) (#,pred? x))))])] [(Syntax: (Base: 'Symbol _ _ _)) identifier?/sc] [(Syntax: t) (syntax/sc (t->sc t))]