From fd1b20c93d195f236619a415e15c1b1dc8efde7f Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 11 Jun 2010 14:21:15 -0400
Subject: [PATCH] Fix optimizer for refactoring.

---
 .../typed-scheme/succeed/optimize-simple.rkt  |  3 ++
 collects/typed-scheme/tc-setup.rkt            |  6 +--
 collects/typed-scheme/typed-scheme.rkt        | 52 +++++++++----------
 3 files changed, 31 insertions(+), 30 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/optimize-simple.rkt

diff --git a/collects/tests/typed-scheme/succeed/optimize-simple.rkt b/collects/tests/typed-scheme/succeed/optimize-simple.rkt
new file mode 100644
index 0000000000..035a3c7519
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/optimize-simple.rkt
@@ -0,0 +1,3 @@
+#lang typed/racket #:optimize
+
+(+ 3 4)
diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-scheme/tc-setup.rkt
index 79f8abfd9e..f4e041417e 100644
--- a/collects/typed-scheme/tc-setup.rkt
+++ b/collects/typed-scheme/tc-setup.rkt
@@ -4,7 +4,7 @@
          (except-in syntax/parse id)
          unstable/mutated-vars
          scheme/base
-         (private type-contract optimize)
+         (private type-contract)
          (types utils convenience)
          (typecheck typechecker provide-handling tc-toplevel)
          (env type-environments type-name-env type-alias-env)
@@ -13,9 +13,7 @@
          (rep type-rep)
          (except-in (utils utils) infer)
          (only-in (r:infer infer-dummy) infer-param)
-         scheme/nest
-         syntax/kerncase
-         scheme/match
+         racket/match
          (for-syntax racket/base)
          (for-template racket/base))
 
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 95ab29d388..bf710a4f59 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -1,10 +1,10 @@
-#lang scheme/base
+#lang racket/base
 
 (require (rename-in "utils/utils.rkt" [infer r:infer])
          (private with-types)
          (for-syntax 
           (except-in syntax/parse id)
-          unstable/syntax racket/base unstable/match
+          racket/match unstable/syntax racket/base unstable/match
           (private type-contract optimize)
           (types utils convenience)
 	  (typecheck typechecker provide-handling tc-toplevel)
@@ -13,8 +13,7 @@
 	  (utils tc-utils)
 	  (rep type-rep)
 	  (except-in (utils utils) infer)
-          (only-in (r:infer infer-dummy) infer-param)
-          scheme/match
+          (only-in (r:infer infer-dummy) infer-param)          
           "tc-setup.rkt"))
 
 (provide (rename-out [module-begin #%module-begin]
@@ -28,28 +27,29 @@
   (syntax-parse stx
      [(mb (~optional (~and #:optimize (~bind [opt? #'#t]))) forms ...)
       (let ([pmb-form (syntax/loc stx (#%plain-module-begin forms ...))])
-      (tc-setup 
-       stx pmb-form 'module-begin new-mod tc-module after-code
-       (with-syntax*
-        (;; pmb = #%plain-module-begin    
-         [(pmb . body2) new-mod]
-         ;; add in syntax property on useless expression to draw check-syntax arrows
-         [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
-         ;; perform the provide transformation from [Culpepper 07]
-         [transformed-body (remove-provides #'body2)]
-         ;; add the real definitions of contracts on requires
-         [transformed-body (change-contract-fixups #'transformed-body)]
-         ;; potentially optimize the code based on the type information
-         [(optimized-body ...)
-          ;; do we optimize?
-          (if (or (attribute opt?) (optimize?))
-              (begin (printf "optimizing ...\n")
-                     (begin0 (map optimize (syntax->list #'transformed-body))
-                             (do-time "Optimized")))
-              #'transformed-body)])
-        ;; reconstruct the module with the extra code
-        ;; use the regular %#module-begin from `racket/base' for top-level printing
-        #`(#%module-begin optimized-body ... #,after-code check-syntax-help))))]))
+        (parameterize ([optimize? (or (optimize?) (attribute opt?))])
+          (tc-setup 
+           stx pmb-form 'module-begin new-mod tc-module after-code
+           (with-syntax*
+            (;; pmb = #%plain-module-begin    
+             [(pmb . body2) new-mod]
+             ;; add in syntax property on useless expression to draw check-syntax arrows
+             [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
+             ;; perform the provide transformation from [Culpepper 07]
+             [transformed-body (remove-provides #'body2)]
+             ;; add the real definitions of contracts on requires
+             [transformed-body (change-contract-fixups #'transformed-body)]
+             ;; potentially optimize the code based on the type information
+             [(optimized-body ...)
+              ;; do we optimize?
+              (if (optimize?)
+                  (begin (printf "optimizing ...\n")
+                         (begin0 (map optimize (syntax->list #'transformed-body))
+                                 (do-time "Optimized")))
+                  #'transformed-body)])
+            ;; reconstruct the module with the extra code
+            ;; use the regular %#module-begin from `racket/base' for top-level printing
+            #`(#%module-begin optimized-body ... #,after-code check-syntax-help)))))]))
 
 (define-syntax (top-interaction stx)
   (syntax-parse stx