Optimize in typed regions.
original commit: e057e6a8573d5c3d8bb8f5ce7a5dc1be93dd2a7a
This commit is contained in:
parent
0cf1898580
commit
c96832caba
16
collects/tests/typed-scheme/optimizer/tests/with-type.rkt
Normal file
16
collects/tests/typed-scheme/optimizer/tests/with-type.rkt
Normal file
|
@ -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)
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user