From ec40b5be8f33b7545d101297fac7bcecb250f9b2 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 15 Aug 2011 17:57:53 -0400
Subject: [PATCH] Refactor base-special-env to run at phase 0.

Unfortunately, it can no longer be required normally, and forces changes to test suites.

original commit: 8ecc2a4da4c995a83ddc630ab274859f47597fc6
---
 .../base-env/base-special-env.rkt             | 32 +++++++++----------
 collects/typed-scheme/typed-scheme.rkt        | 15 ++++-----
 2 files changed, 22 insertions(+), 25 deletions(-)

diff --git a/collects/typed-scheme/base-env/base-special-env.rkt b/collects/typed-scheme/base-env/base-special-env.rkt
index ab849597..99b52934 100644
--- a/collects/typed-scheme/base-env/base-special-env.rkt
+++ b/collects/typed-scheme/base-env/base-special-env.rkt
@@ -5,27 +5,24 @@
  "../utils/utils.rkt"
  racket/promise
  string-constants/string-constant
- racket/private/kw racket/file racket/port
- (for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval)
-             (utils tc-utils)
-             (env init-envs)
-             (except-in (rep filter-rep object-rep type-rep) make-arr)
-             (types convenience union)
-             (only-in (types convenience) [make-arr* make-arr])))
+ racket/private/kw racket/file racket/port syntax/parse
+ (for-template (only-in racket/private/kw kw-expander-proc kw-expander-impl)
+               racket/base racket/promise racket/file racket/port string-constants/string-constant)
+ (utils tc-utils)
+ (env init-envs)
+ (except-in (rep filter-rep object-rep type-rep) make-arr)
+ (types convenience union)
+ (only-in (types convenience) [make-arr* make-arr])
+ (for-template )
+ (for-syntax racket/base syntax/parse (only-in racket/syntax syntax-local-eval)))
 
 (define-syntax (define-initial-env stx)
   (syntax-parse stx
     [(_ initialize-env [id-expr ty] ...)
-     (with-syntax ([(id ...)
-                    (for/list ([expr (syntax->list #'(id-expr ...))])
-                      (syntax-local-eval expr))])
-       #`(begin
-           (define-for-syntax initial-env
-             (make-env
-              [id ty] ...))
-           (define-for-syntax (initialize-env)
-             (initialize-type-env initial-env))
-           (provide (for-syntax initialize-env))))]))
+     #`(begin
+         (define initial-env (make-env [id-expr ty] ...))
+         (define (initialize-env) (initialize-type-env initial-env))
+         (provide initialize-env))]))
 
 (define-initial-env initialize-special
   ;; make-promise
@@ -33,6 +30,7 @@
      #:context #'make-promise
      [(_ mp . _) #'mp])
    (-poly (a) (-> (-> a) (-Promise a)))]
+  
   ;; language
   [(syntax-parse (local-expand #'(this-language) 'expression null)
      #:context #'language
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 875466a9..1552b7f5 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -3,8 +3,7 @@
 (require (for-syntax racket/base
                      ;; these requires are needed since their code
                      ;; appears in the residual program
-                     "typecheck/renamer.rkt" "types/type-table.rkt" profile)
-         "base-env/base-special-env.rkt" )
+                     "typecheck/renamer.rkt" "types/type-table.rkt"))
 
 (provide (rename-out [module-begin #%module-begin]
                      [top-interaction #%top-interaction]
@@ -17,12 +16,12 @@
 (define-for-syntax initialized #f)
 (define-for-syntax (do-standard-inits)
   (unless initialized
-      (initialize-special)
-      ((dynamic-require 'typed-scheme/base-env/base-structs 'initialize-structs))
-      ((dynamic-require 'typed-scheme/base-env/base-env-indexing 'initialize-indexing))
-      ((dynamic-require 'typed-scheme/base-env/base-env 'init))
-      ((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init))
-      (set! initialized #t)))
+    ((dynamic-require 'typed-scheme/base-env/base-structs 'initialize-structs))
+    ((dynamic-require 'typed-scheme/base-env/base-env-indexing 'initialize-indexing))    
+    ((dynamic-require 'typed-scheme/base-env/base-env 'init))    
+    ((dynamic-require 'typed-scheme/base-env/base-env-numeric 'init))    
+    ((dynamic-require 'typed-scheme/base-env/base-special-env 'initialize-special))    
+    (set! initialized #t)))
 
 (define-syntax-rule (drivers [name sym] ...)
   (begin