Move environment initialization after local expansion in Typed Racket.

This means that syntax errors caught by `local-expand' are reported sooner, but shouldn't change other timing results.

original commit: f9b0f0ce7320b09eb2203580a7d04d909dc2f430

collects/typed-racket/core.rkt

@@ -15,7 +15,7 @@
 
 (provide mb-core ti-core wt-core)
 
-(define (mb-core stx)
+(define (mb-core stx init)
   (syntax-parse stx
     [(mb (~optional (~or (~and #:optimize    (~bind [opt? #'#t])) ; kept for backward compatibility
                          (~and #:no-optimize (~bind [opt? #'#f]))))
@@ -24,7 +24,7 @@
        (parameterize ([optimize? (or (and (not (attribute opt?)) (optimize?))
                                      (and (attribute opt?) (syntax-e (attribute opt?))))])
          (tc-setup
-          stx pmb-form 'module-begin new-mod tc-module after-code
+          stx pmb-form 'module-begin new-mod init tc-module after-code
           (with-syntax*
            (;; pmb = #%plain-module-begin
             [(pmb . body2) new-mod]
@@ -46,7 +46,7 @@
 
 (define did-I-suggest-:print-type-already? #f)
 (define :print-type-message " ... [Use (:print-type <expr>) to see more.]")
-(define (ti-core stx)
+(define (ti-core stx init)
   (syntax-parse stx
     [(_ . ((~datum module) . rest))
      #'(module . rest)]
@@ -55,14 +55,14 @@
     ;; Prints the _entire_ type. May be quite large.
     [(_ . ((~literal :print-type) e:expr))
      #`(display #,(format "~a\n"
-                          (tc-setup #'stx #'e 'top-level expanded tc-toplevel-form type
+                          (tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form type
                                     (match type
                                       [(tc-result1: t f o) t]
                                       [(tc-results: t) (cons 'Values t)]))))]
     ;; given a function and a desired return type, fill in the blanks
     [(_ . ((~literal :query-result-type) op:expr desired-type:expr))
      (let ([expected (parse-type #'desired-type)])
-       (tc-setup #'stx #'op 'top-level expanded tc-toplevel-form type
+       (tc-setup #'stx #'op 'top-level expanded init tc-toplevel-form type
                  (match type
                    [(tc-result1: (and t (Function: _)) f o)
                     (let ([cleaned (cleanup-type t expected)])
@@ -75,7 +75,7 @@
                    [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]
     [(_ . form)
      (tc-setup
-      stx #'form 'top-level body2 tc-toplevel-form type
+      stx #'form 'top-level body2 init tc-toplevel-form type
       (with-syntax*
        ([optimized-body (car (maybe-optimize #`(#,body2)))])
        (syntax-parse body2

collects/typed-racket/private/with-types.rkt

@@ -7,7 +7,7 @@
           (prefix-in c: (combine-in racket/contract/region racket/contract/base)))
          "../base-env/extra-procs.rkt" (except-in "../base-env/prims.rkt" with-handlers)
          "../tc-setup.rkt"
-         syntax/parse racket/block racket/match
+         syntax/parse racket/match
          unstable/sequence  "../base-env/base-types-extra.rkt"
          (except-in (path-up "env/type-name-env.rkt"
                              "env/type-alias-env.rkt"
@@ -28,13 +28,14 @@
 
 (provide wt-core)
 
-(define (with-type-helper stx body fvids fvtys exids extys resty expr? ctx)
+(define (with-type-helper stx init body fvids fvtys exids extys resty expr? ctx)
   (define old-context (unbox typed-context?))
   (unless (not old-context)
     (tc-error/stx stx "with-type cannot be used in a typed module."))
   (define ((no-contract t [stx stx]))
     (tc-error/stx stx "Type ~a could not be converted to a contract." t))
   (set-box! typed-context? #t)
+  (init)
   (define fv-types (for/list ([t (in-list (syntax->list fvtys))])
                      (parse-type t)))
   (define fv-cnts (for/list ([t (in-list fv-types)]
@@ -121,7 +122,7 @@
                              ([ex-id ex-cnt] ...)
                              (define-values (ex-id ...) body)))))))
 
-(define (wt-core stx)
+(define (wt-core stx init)
   (define-syntax-class typed-id
     #:description "[id type]"
     [pattern (id ty)])
@@ -143,7 +144,7 @@
     [pattern (~seq #:result ty:expr)])
   (syntax-parse stx
     [(_ :typed-ids fv:free-vars . body)
-     (with-type-helper stx #'body #'(fv.id ...) #'(fv.ty ...) #'(id ...) #'(ty ...) #f #f (syntax-local-context))]
+     (with-type-helper stx init #'body #'(fv.id ...) #'(fv.ty ...) #'(id ...) #'(ty ...) #f #f (syntax-local-context))]
     [(_ :result-ty fv:free-vars . body)
-     (with-type-helper stx #'body #'(fv.id ...) #'(fv.ty ...) #'() #'() #'ty #t (syntax-local-context))]))
+     (with-type-helper stx init #'body #'(fv.id ...) #'(fv.ty ...) #'() #'() #'ty #t (syntax-local-context))]))
 

collects/typed-racket/tc-setup.rkt

@@ -13,7 +13,6 @@
          (rep type-rep)
          (except-in (utils utils) infer)
          (only-in (r:infer infer-dummy) infer-param)
-         racket/match
          (for-syntax racket/base)
          (for-template racket/base))
 
@@ -34,13 +33,13 @@
           (do-time "Optimized")))
       body))
 
-(define-syntax-rule (tc-setup orig-stx stx expand-ctxt fully-expanded-stx checker result . body)
+(define-syntax-rule (tc-setup orig-stx stx expand-ctxt fully-expanded-stx init checker result . body)
   (let ()
     (set-box! typed-context? #t)
     ;(start-timing (syntax-property stx 'enclosing-module-name))
     (with-handlers
-        ([(lambda (e) (and #f (exn:fail? e) (not (exn:fail:syntax? e))))
-          (lambda (e) (tc-error "Internal Typed Racket Error : ~a" e))])
+        ([(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e))))
+          (λ (e) (tc-error "Internal Typed Racket Error : ~a" e))])
       (parameterize (;; enable fancy printing?
                      [custom-printer #t]
                      ;; a cheat to avoid units
@@ -60,17 +59,18 @@
                                                (cons (syntax-e id) ty)))))]
                      ;; reinitialize disappeared uses
                      [disappeared-use-todo      null]
-                     [disappeared-bindings-todo null])
+                     [disappeared-bindings-todo null])        
+        (define fully-expanded-stx (disarm* (local-expand stx expand-ctxt null)))
+        (when (show-input?)
+          (pretty-print (syntax->datum fully-expanded-stx)))
+        (do-time "Local Expand Done")
+        (init)
         (do-time "Initialized Envs")
-        (let ([fully-expanded-stx (disarm* (local-expand stx expand-ctxt null))])
-          (when (show-input?)
-            (pretty-print (syntax->datum fully-expanded-stx)))
-          (do-time "Local Expand Done")
-          (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)]
-                         [orig-module-stx (or (orig-module-stx) orig-stx)]
-                         [expanded-module-stx fully-expanded-stx]
-                         [debugging? #f])
-            (do-time "Starting `checker'")
-            (let ([result (checker fully-expanded-stx)])
-              (do-time "Typechecking Done")
-              (let () . body))))))))
+        (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)]
+                       [orig-module-stx (or (orig-module-stx) orig-stx)]
+                       [expanded-module-stx fully-expanded-stx]
+                       [debugging? #f])
+          (do-time "Starting `checker'")
+          (define result (checker fully-expanded-stx))
+          (do-time "Typechecking Done")
+          (let () . body))))))

collects/typed-racket/typed-racket.rkt

@@ -34,11 +34,10 @@
 (define-syntax-rule (drivers [name sym] ...)
   (begin
     (define-syntax (name stx)
-      (do-time (format "Calling ~a driver" 'name))
-      (do-standard-inits)
+      (do-time (format "Calling ~a driver" 'name))      
       (define f (dynamic-require 'typed-racket/core 'sym))
       (do-time (format "Loaded core ~a" 'sym))
-      (begin0 (f stx)
+      (begin0 (f stx do-standard-inits)
               (do-time "Finished, returning to Racket")))
     ...))