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

46
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,18 +57,20 @@
[(_ . form) [(_ . form)
(tc-setup (tc-setup
stx #'form 'top-level body2 tc-toplevel-form type stx #'form 'top-level body2 tc-toplevel-form type
(syntax-parse body2 (with-syntax*
;; any of these do not produce an expression to be printed ([optimized-body (car (maybe-optimize #`(#,body2)))])
[(head:invis-kw . _) body2] (syntax-parse body2
[_ (let ([ty-str (match type ;; any of these do not produce an expression to be printed
;; don't print results of type void [(head:invis-kw . _) #'optimized-body]
[(tc-result1: (== -Void type-equal?)) #f] [_ (let ([ty-str (match type
[(tc-result1: t f o) ;; don't print results of type void
(format "- : ~a\n" t)] [(tc-result1: (== -Void type-equal?)) #f]
[(tc-results: t) [(tc-result1: t f o)
(format "- : ~a\n" (cons 'Values t))] (format "- : ~a\n" t)]
[x (int-err "bad type result: ~a" x)])]) [(tc-results: t)
(if ty-str (format "- : ~a\n" (cons 'Values t))]
#`(let ([type '#,ty-str]) [x (int-err "bad type result: ~a" x)])])
(begin0 #,body2 (display type))) (if ty-str
body2))]))])) #`(let ([type '#,ty-str])
(begin0 optimized-body (display type)))
#'optimized-body))])))]))