diff --git a/collects/tests/typed-scheme/optimizer/tests/with-type.rkt b/collects/tests/typed-scheme/optimizer/tests/with-type.rkt new file mode 100644 index 00000000..a15fbeb3 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/with-type.rkt @@ -0,0 +1,16 @@ +#; +( +with-type.rkt line 13 col 19 - + - binary float +34.6 +) + +#lang racket + +(require typed/racket) + +(with-type ([fun (Float -> Float)] + [val Float]) + (define (fun x) (+ x val)) + (define val 17.3)) + +(fun val) diff --git a/collects/typed-scheme/core.rkt b/collects/typed-scheme/core.rkt index 6889d2da..fefdf970 100644 --- a/collects/typed-scheme/core.rkt +++ b/collects/typed-scheme/core.rkt @@ -6,7 +6,6 @@ (private with-types type-contract) (except-in syntax/parse id) racket/match racket/syntax unstable/match - (optimizer optimizer) (types utils convenience) (typecheck typechecker provide-handling tc-toplevel) (env type-name-env type-alias-env) @@ -18,13 +17,6 @@ (provide mb-core ti-core wt-core) -(define (maybe-optimize body) - ;; do we optimize? - (if (optimize?) - (begin0 (map optimize-top (syntax->list body)) - (do-time "Optimized")) - body)) - (define (mb-core stx) (syntax-parse stx [(mb (~optional (~or (~and #:optimize (~bind [opt? #'#t])) ; kept for backward compatibility diff --git a/collects/typed-scheme/private/with-types.rkt b/collects/typed-scheme/private/with-types.rkt index bf2c6035..b79178c0 100644 --- a/collects/typed-scheme/private/with-types.rkt +++ b/collects/typed-scheme/private/with-types.rkt @@ -6,6 +6,7 @@ "../base-env/prims.rkt" (prefix-in c: (combine-in racket/contract/region racket/contract/base))) "../base-env/extra-procs.rkt" "../base-env/prims.rkt" + "../tc-setup.rkt" syntax/parse racket/block racket/match unstable/sequence "../base-env/base-types-extra.rkt" (except-in (path-up "env/type-name-env.rkt" @@ -97,7 +98,7 @@ [(ex-id ...) exids] [(ex-cnt ...) ex-cnts] [(region-cnt ...) region-cnts] - [body expanded-body] + [body (maybe-optimize expanded-body)] [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]) (if expr? (quasisyntax/loc stx diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-scheme/tc-setup.rkt index 176b6636..87ce15f0 100644 --- a/collects/typed-scheme/tc-setup.rkt +++ b/collects/typed-scheme/tc-setup.rkt @@ -5,6 +5,7 @@ unstable/mutated-vars racket/pretty scheme/base + (optimizer optimizer) (private type-contract) (types utils convenience) (typecheck typechecker provide-handling tc-toplevel) @@ -18,12 +19,19 @@ (for-syntax racket/base) (for-template racket/base)) -(provide tc-setup invis-kw) +(provide tc-setup invis-kw maybe-optimize) (define-syntax-class invis-kw #:literals (define-values define-syntaxes #%require #%provide begin) (pattern (~or define-values define-syntaxes #%require #%provide begin))) +(define (maybe-optimize body) + ;; do we optimize? + (if (optimize?) + (begin0 (map optimize-top (syntax->list body)) + (do-time "Optimized")) + body)) + (define-syntax-rule (tc-setup orig-stx stx expand-ctxt fully-expanded-stx checker result . body) (let () (set-box! typed-context? #t)