CS bootstrap: avoid pessimizing primitives

Speed up the bootstrap process by more directly referencing primitives
that won't be replaced in the top-lvel namespace for simulating Chez
Scheme.

racket/src/cs/bootstrap/make-boot.rkt

@@ -66,7 +66,34 @@
 (namespace-attach-module (current-namespace) r6rs-lang-mod ns)
 (namespace-attach-module (current-namespace) scheme-lang-mod ns)
 
-(namespace-require/copy r6rs-lang-mod ns) ; get `library`
+(namespace-require r6rs-lang-mod ns) ; get `library`
+
+;; Change some bindings from imported to top-level references so that
+;; expressions are compiled to reference variables that are updated by
+;; loading the Chez Scheme compiler. This approach is better than
+;; using `namespace-require/copy`, because we want most primitives to
+;; be referenced directly to make the compiler run faster.
+(define (reset-toplevels [more '()])
+  (for-each (lambda (sym)
+              (eval `(define ,sym ,sym) ns))
+            (append
+             more
+             '(identifier?
+               datum->syntax
+               syntax->list
+               syntax->datum
+               generate-temporaries
+               free-identifier=?
+               bound-identifier=?
+               make-compile-time-value
+               current-eval
+               eval
+               expand
+               compile
+               error
+               format))))
+
+(reset-toplevels)
 
 (status "Load nanopass")
 (define (load-nanopass)
@@ -88,9 +115,14 @@
   (load/cd (build-path nano-dir "nanopass/implementation-helpers.ikarus.ss"))
   (load-nanopass))
 
-(namespace-require/copy ''nanopass ns)
+(namespace-require ''nanopass ns)
 
-(namespace-require/copy scheme-lang-mod ns)
+(namespace-require scheme-lang-mod ns)
+(reset-toplevels '(run-cp0
+                   errorf
+                   $oops
+                   $undefined-violation
+                   generate-interrupt-trap))
 
 (namespace-require `(for-syntax ,r6rs-lang-mod) ns)
 (namespace-require `(for-syntax ,scheme-lang-mod) ns)

racket/src/cs/bootstrap/r6rs-lang.rkt

@@ -18,7 +18,10 @@
                   do-$make-record-type
                   register-rtd-name!
                   register-rtd-fields!
-                  s:struct-type?)
+                  s:struct-type?
+                  record-predicate
+                  record-accessor
+                  record-mutator)
          (only-in "immediate.rkt"
                   base-rtd)
          (only-in "scheme-struct.rkt"
@@ -45,7 +48,8 @@
                      if
                      sort
                      fixnum?
-                     open-output-file)
+                     open-output-file
+                     dynamic-wind)
          library import export
          (rename-out [patch:define define]
                      [s:syntax syntax]
@@ -61,7 +65,8 @@
                      [s:splicing-let-syntax let-syntax]
                      [s:splicing-letrec-syntax letrec-syntax]
                      [let trace-let]
-                     [define trace-define])
+                     [define trace-define]
+                     [s:dynamic-wind dynamic-wind])
          guard
          identifier-syntax
          (for-syntax datum)
@@ -79,6 +84,9 @@
          record-constructor-descriptor
          record-constructor
          (rename-out [record-constructor r6rs:record-constructor])
+         record-predicate
+         record-accessor
+         record-mutator
          record-constructor-descriptor?
          syntax-violation
          port-position
@@ -372,6 +380,11 @@
     [(_ else) #t]
     [(_ e) e]))
 
+(define s:dynamic-wind
+  (case-lambda
+    [(pre thunk post) (dynamic-wind pre thunk post)]
+    [(critical? pre thunk post) (dynamic-wind pre thunk post)]))
+
 (begin-for-syntax
   (define-syntax-rule (with-implicit (tid id ...) body ...)
     (with-syntax ([id (datum->syntax (syntax tid) 'id)] ...)

racket/src/cs/bootstrap/scheme-lang.rkt

@@ -32,8 +32,7 @@
                      [s:define define-who]
                      [gen-let-values let-values]
                      [s:module module]
-                     [s:parameterize parameterize]
+                     [s:parameterize parameterize])
-                     [s:dynamic-wind dynamic-wind])
          set-who!
          import
          include
@@ -67,9 +66,6 @@
          with-values
          make-record-type
          type-descriptor
-         record-predicate
-         record-accessor
-         record-mutator
          csv7:record-field-accessor
          csv7:record-field-mutator
          csv7:record-field-mutable?
@@ -586,11 +582,6 @@
                                                            (lambda lhs (values . flat-lhs)))])]))])
        #'(let-values ([lhs rhs] ...) body ...))]))
 
-(define s:dynamic-wind
-  (case-lambda
-    [(pre thunk post) (dynamic-wind pre thunk post)]
-    [(critical? pre thunk post) (dynamic-wind pre thunk post)]))
-
 (define-values (prim-flags->bits primvec get-priminfo)
   (get-primdata $sputprop scheme-dir))