suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Have TR optimize at the REPL.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-05-24 16:20:28 -04:00
parent 2cddccfe7e
commit 5352593bf1
1 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/typed-scheme/core.rkt
View File

@ -18,6 +18,13 @@
(provide mb-core ti-core wt-core) (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) (define (mb-core stx)
(syntax-parse stx (syntax-parse stx
[(mb (~optional (~or (~and #:optimize (~bind [opt? #'#t])) ; kept for backward compatibility [(mb (~optional (~or (~and #:optimize (~bind [opt? #'#t])) ; kept for backward compatibility
@ -38,12 +45,7 @@
;; add the real definitions of contracts on requires ;; add the real definitions of contracts on requires
[transformed-body (change-contract-fixups #'transformed-body)] [transformed-body (change-contract-fixups #'transformed-body)]
;; potentially optimize the code based on the type information ;; potentially optimize the code based on the type information
[(optimized-body ...) [(optimized-body ...) (maybe-optimize #'transformed-body)])
;; do we optimize?
(if (optimize?)
(begin0 (map optimize-top (syntax->list #'transformed-body))
(do-time "Optimized"))
#'transformed-body)])
;; reconstruct the module with the extra code ;; reconstruct the module with the extra code
;; use the regular %#module-begin from `racket/base' for top-level printing ;; use the regular %#module-begin from `racket/base' for top-level printing
#`(#%module-begin optimized-body ... #,after-code check-syntax-help)))))])) #`(#%module-begin optimized-body ... #,after-code check-syntax-help)))))]))
@ -55,9 +57,11 @@
[(_ . form) [(_ . form)
(tc-setup (tc-setup
stx #'form 'top-level body2 tc-toplevel-form type stx #'form 'top-level body2 tc-toplevel-form type
(with-syntax*
([optimized-body (car (maybe-optimize #`(#,body2)))])
(syntax-parse body2 (syntax-parse body2
;; any of these do not produce an expression to be printed ;; any of these do not produce an expression to be printed
[(head:invis-kw . _) body2] [(head:invis-kw . _) #'optimized-body]
[_ (let ([ty-str (match type [_ (let ([ty-str (match type
;; don't print results of type void ;; don't print results of type void
[(tc-result1: (== -Void type-equal?)) #f] [(tc-result1: (== -Void type-equal?)) #f]
@ -68,5 +72,5 @@
[x (int-err "bad type result: ~a" x)])]) [x (int-err "bad type result: ~a" x)])])
(if ty-str (if ty-str
#`(let ([type '#,ty-str]) #`(let ([type '#,ty-str])
(begin0 #,body2 (display type))) (begin0 optimized-body (display type)))
body2))]))])) #'optimized-body))])))]))