diff --git a/racket/src/cs/bootstrap/make-boot.rkt b/racket/src/cs/bootstrap/make-boot.rkt index 5ac52e6028..6e6c00c88c 100644 --- a/racket/src/cs/bootstrap/make-boot.rkt +++ b/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) diff --git a/racket/src/cs/bootstrap/r6rs-lang.rkt b/racket/src/cs/bootstrap/r6rs-lang.rkt index 78b2bfab3b..19e3edfd4d 100644 --- a/racket/src/cs/bootstrap/r6rs-lang.rkt +++ b/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)] ...) diff --git a/racket/src/cs/bootstrap/scheme-lang.rkt b/racket/src/cs/bootstrap/scheme-lang.rkt index a6f582b97f..80ca4dadc9 100644 --- a/racket/src/cs/bootstrap/scheme-lang.rkt +++ b/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:dynamic-wind dynamic-wind]) + [s:parameterize parameterize]) 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))