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 984b2004..7895604d 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 @@ -18,7 +18,7 @@ racket/format unstable/list unstable/sequence - (static-contracts types instantiate) + (static-contracts types instantiate optimize) (contract-req) (for-syntax racket/base syntax/parse racket/syntax) (for-template racket/base racket/contract racket/set (utils any-wrap) @@ -145,10 +145,15 @@ [(untyped) 'typed] [(both) 'both])) -(define (type->contract ty fail #:typed-side [typed-side #t] #:kind [kind 'impersonator]) +(define (type->contract ty init-fail #:typed-side [typed-side #t] #:kind [kind 'impersonator]) (let/ec escape - (define (fail/t->sc) (escape (fail))) - (instantiate (type->static-contract ty #:typed-side typed-side fail/t->sc) fail kind))) + (define (fail) (escape (init-fail))) + (instantiate + (optimize + (type->static-contract ty #:typed-side typed-side fail) + (if typed-side 'covariant 'contravariant)) + fail + kind))) (define (type->contract-old ty fail #:typed-side [typed-side #t] #:kind [kind 'impersonator]) (define vars (make-parameter '())) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/back-and-forth.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/back-and-forth.rkt index 9669a35c..8d530ca7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/back-and-forth.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/back-and-forth.rkt @@ -1,5 +1,5 @@ #; -(exn-pred exn:fail:contract? #rx".*contract violation.*\\(-> Number Number\\).*contract.*f.*") +(exn-pred exn:fail:contract? #rx"blaming: violator" #rx"f: contract violation") #lang scheme/load