suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

eval and phases (4.0.1.2)

Browse Source 
svn: r10452
This commit is contained in:
Matthew Flatt 2008-06-25 18:54:38 +00:00
parent 2528523a1f
commit da82fe2a2d
27 changed files with 1099 additions and 836 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/scheme/match/runtime.ss
View File

@ -26,4 +26,3 @@
;; can we pass this value to regexp-match?
(define (matchable? e)
(or (string? e) (bytes? e)))

23
collects/scheme/private/namespace.ss
View File

@ -15,8 +15,10 @@
(define orig-varref (#%variable-reference orig-varref))
(define (make-base-empty-namespace)
(let ([ns (make-empty-namespace)])
(namespace-attach-module (variable-reference->empty-namespace orig-varref)
(let* ([this-ns (variable-reference->empty-namespace orig-varref)]
[ns (parameterize ([current-namespace this-ns]) ; ensures correct phase
(make-empty-namespace))])
(namespace-attach-module this-ns
'scheme/base
ns)
ns))
@ -43,7 +45,10 @@
stx
id-stx))
(syntax/loc stx
(define id (make-namespace-anchor (#%variable-reference id)))))]))
;; two-step definition allows this to work in for-syntax contexts:
(begin
(define tmp #f)
(define id (make-namespace-anchor (#%variable-reference tmp))))))]))
(define-struct namespace-anchor (var))
@ -59,14 +64,4 @@
(raise-type-error 'anchor->namespace
"namespace anchor"
ra))
(let ([mp (variable-reference->resolved-module-path
(namespace-anchor-var ra))])
(if mp
(let ([ns (namespace-anchor->empty-namespace ra)])
(parameterize ([current-namespace ns])
(module->namespace (let ([name (resolved-module-path-name mp)])
(if (path? name)
name
(list 'quote name))))))
(variable-reference->top-level-namespace
(namespace-anchor-var ra))))))
(variable-reference->namespace (namespace-anchor-var ra))))

3
collects/scheme/private/serialize.ss
View File

@ -62,6 +62,7 @@
(define deserialize-module-guard (make-parameter (lambda (mod-path sym)
(void))))
(define varref (#%variable-reference varref))
(define (mod-to-id info mod-map cache)
(let ([deserialize-id (serialize-info-deserialize-id info)])
@ -72,7 +73,7 @@
(let ([path+name
(cond
[(identifier? deserialize-id)
(let ([b (identifier-binding deserialize-id)])
(let ([b (identifier-binding deserialize-id (variable-reference->phase varref))])
(cons
(and (list? b)
(if (symbol? (caddr b))

2
collects/scribblings/reference/custodians.scrbl
View File

@ -48,7 +48,7 @@ subordinate to @scheme[super] (directly or indirectly). If
@defproc[(custodian-memory-accounting-available?) boolean?]{
Returns @scheme[#t] if MzScheme is compiled with support for
Returns @scheme[#t] if PLT Scheme is compiled with support for
per-custodian memory accounting, @scheme[#f] otherwise.
@margin-note{Memory accounting is normally available in PLT Scheme 3m,

35
collects/scribblings/reference/eval-model.scrbl
View File

@ -516,7 +516,7 @@ definitions.
For example, given the module declaration
@schemeblock[
(module m mzscheme
(module m scheme
(define x 10))
]
@ -525,16 +525,16 @@ and installs @scheme[10] as its value. This @scheme[x] is unrelated to
any top-level definition of @scheme[x].
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@subsection[#:tag "module-phase"]{Module Phases}
@subsection[#:tag "module-phase"]{Phases}
A module can be @tech{instantiate}d in multiple @deftech{phases}. A
phase is an integer that, again, is effectively a prefix on the names
of module-level definitions. A top-level @scheme[require]
@tech{instantiates} a module at @tech{phase} 0, if the module is not
already @tech{instantiate}d at phase 0. A top-level
@scheme[require-for-syntax] @tech{instantiates} a module at
@scheme[(require (for-syntax ....))] @tech{instantiates} a module at
@tech{phase} 1 (if it is not already @tech{instantiate}d at that
level); a @scheme[require-for-syntax] also has a different binding
level); @scheme[for-syntax] also has a different binding
effect on further program parsing, as described in
@secref["intro-binding"].
@ -553,19 +553,28 @@ If a module @tech{instantiate}d at @tech{phase} @math{n}
@scheme[require]s another module, then the @scheme[require]d module is
first @tech{instantiate}d at phase @math{n}, and so on
transitively. (Module @scheme[require]s cannot form cycles.) If a
module @tech{instantiate}d at phase @math{n}
@scheme[require-for-syntax]es another module, the other module is
first @tech{instantiate}d at @tech{phase} @math{n+1}, and so on. If a
module @tech{instantiate}d at phase @math{n} @scheme[require]s
@scheme[for-syntax] another module, the other module is first
@tech{instantiate}d at @tech{phase} @math{n+1}, and so on. If a
module @tech{instantiate}d at phase @math{n} for non-zero @math{n}
@scheme[require-for-template]s another module, the other module is
first @tech{instantiate}d at @tech{phase} @math{n-1}, and so on.
@scheme[require]s @scheme[for-template] another module, the other
module is first @tech{instantiate}d at @tech{phase} @math{n-1}, and so
on.
A final distinction among module @tech{instantiations} is that
multiple @tech{instantiations} may exist at phase 1 and higher. These
multiple @tech{instantiations} may exist at @tech{phase} 1 and higher. These
@tech{instantiations} are created by the parsing of module forms (see
@secref["mod-parse"]), and are, again, conceptually distinguished
by prefixes.
Top-level variables can exist in multiple phases in the same way as
within modules. For example, @scheme[define-for-syntax] creates a
@tech{phase} 1 variable. Furthermore, reflective operations like
@scheme[make-base-namespace] and @scheme[eval] provide access to
top-level variables in higher @tech{phases}, while module
@tech{instantiations} (triggered by with @scheme[require]) relative to such
top-levels are in corresponding higher @tech{phase}s.
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@subsection[#:tag "module-redeclare"]{Module Re-declarations}
@ -682,8 +691,8 @@ thread yields the parameter's value. A parameter procedure sets or
accesses the relevant thread cell for its parameter.
Various operations, such as @scheme[parameterize] or
@scheme[with-parameterization], install a parameterization into the
current continuation's frame.
@scheme[call-with-parameterization], install a parameterization into
the current continuation's frame.
@;------------------------------------------------------------------------
@section[#:tag "exn-model"]{Exceptions}
@ -757,7 +766,7 @@ custodian is shut down. The custodian only weakly retains the box
itself, however (so the box and its content can be collected if there
are no other references to them).
When MzScheme is compiled with support for per-custodian memory
When PLT Scheme is compiled with support for per-custodian memory
accounting (see @scheme[custodian-memory-accounting-available?]), the
@scheme[current-memory-use] procedure can report a custodian-specific
result. This result determines how much memory is occupied by objects

12
collects/scribblings/reference/eval.scrbl
View File

@ -45,11 +45,13 @@ it is sent to the @tech{evaluation handler}:
@itemize{
@item{If @scheme[top-level-form] is a pair whose @scheme[car] is a symbol or
identifier, and if applying @scheme[namespace-syntax-introduce]
to the (@scheme[datum->syntax]-converted) identifier produces
an identifier bound to @scheme[module], then only that
identifier is enriched.}
@item{If @scheme[top-level-form] is a pair whose @scheme[car] is a
symbol or identifier, and if applying
@scheme[namespace-syntax-introduce] to the
(@scheme[datum->syntax]-converted) identifier produces an
identifier bound to @scheme[module] in a @tech{phase level}
that corresponds to @scheme[namespace]'s @tech{base phase},
then only that identifier is enriched.}
@item{For any other @scheme[top-level-form],
@scheme[namespace-syntax-introduce] is applied to the entire

160
collects/scribblings/reference/namespaces.scrbl
View File

@ -4,9 +4,9 @@
@title{Namespaces}
See @secref["namespace-model"] for basic information on the
namespace model.
@tech{namespace} model.
A new namespace is created with procedures like
A new @tech{namespace} is created with procedures like
@scheme[make-empty-namespace], and @scheme[make-base-namespace], which
return a first-class namespace value. A namespace is used by setting
the @scheme[current-namespace] parameter value, or by providing the
@ -21,21 +21,27 @@ otherwise.}
@defproc[(make-empty-namespace) namespace?]{
Creates a new namespace that is empty, and whose @tech{module registry}
contains no mappings. Attach modules from an existing namespace to the
new one with @scheme[namespace-attach-module].}
Creates a new namespace that is empty, and whose @tech{module
registry} contains no mappings. The namespace's @tech{base phase} is
the same as the @tech{base phase} of the @tech{current
namespace}. Attach modules from an existing namespace to the new one
with @scheme[namespace-attach-module].}
@defproc[(make-base-empty-namespace) namespace?]{
Creates a new empty namespace, but with @schememodname[scheme/base]
attached.}
attached. The namespace's @tech{base phase} is the same as the
@tech{phase} in which the @scheme[make-base-empty-namespace]
function was created.}
@defproc[(make-base-namespace) namespace?]{
Creates a new namespace with @schememodname[scheme/base] attached and
@scheme[require]d into the top-level environment.}
@scheme[require]d into the top-level environment. The namespace's
@tech{base phase} is the same as the @tech{phase} in which the
@scheme[make-base-namespace] function was created.}
@defform[(define-namespace-anchor id)]{
@ -56,16 +62,15 @@ Returns @scheme[#t] if @scheme[v] is a namespace-anchor value,
@defproc[(namespace-anchor->empty-namespace [a namespace-anchor?]) namespace?]{
Returns an empty namespace that shares a @tech{module registry} with the
source of the anchor.
Returns an empty namespace that shares a @tech{module registry} with
the source of the anchor, and whose @tech{base phase} the the
@tech{phase} in which the anchor was created.
If the anchor is from a @scheme[define-namespace-anchor] form in a
module context, then the source is the namespace in which the
containing module is instantiated. If the anchor is from a
@scheme[define-namespace-anchor] form in a top-level content, then the
source is the namespace in which the anchor definition was evaluated.
The resulting namespace corresponds to @tech{phase} 0, independent of
the phase of @scheme[a]'s definition.}
source is the namespace in which the anchor definition was evaluated.}
@defproc[(namespace-anchor->namespace [a namespace-anchor?]) namespace?]{
@ -73,10 +78,9 @@ the phase of @scheme[a]'s definition.}
Returns a namespace corresponding to the source of the anchor.
If the anchor is from a @scheme[define-namespace-anchor] form in a
module context, then the result is a namespace obtained via
@scheme[module->namespace] using the resolved name of the enclosing
module and the @tech{module registry} of the module instance at
@tech{phase} 0.
module context, then the result is a namespace for the module's body
in the anchor's phase. The result is the same as a namespace obtained
via @scheme[module->namespace].
If the anchor is from a @scheme[define-namespace-anchor] form in a
top-level content, then the result is the namespace in which the
@ -95,14 +99,22 @@ lexical context of the resulting identifier corresponds to the
top-level environment of the current namespace; the identifier has no
source location or properties.}
@defproc[(namespace-module-identifier [namespace namespace? (current-namespace)]) identifier?]{
Returns an identifier whose binding is @scheme[module] in the
@tech{base phase} of @scheme[namespace].}
@defproc[(namespace-variable-value [sym symbol?]
[use-mapping? any/c #t]
[failure-thunk (or/c (-> any) false/c) #f]
[namespace namespace? (current-namespace)])
any]{
Returns a value for @scheme[sym] in @scheme[namespace]. The returned value
depends on @scheme[use-mapping?]:
Returns a value for @scheme[sym] in @scheme[namespace], using
@scheme[namespace]'s @tech{base phase}. The returned value depends on
@scheme[use-mapping?]:
@itemize{
@ -138,12 +150,13 @@ exception.}
void?]{
Sets the value of @scheme[sym] in the top-level environment of
@scheme[namespace] for @tech{phase level} 0, defining @scheme[sym] if
@scheme[namespace] in the @tech{base phase}, defining @scheme[sym] if
it is not already defined.
If @scheme[map?] is supplied as true, then the namespace's identifier
mapping is also adjusted (see @secref["namespace-model"]) so that
@scheme[sym] maps to the variable.}
If @scheme[map?] is supplied as true, then the namespace's
@tech{identifier} mapping is also adjusted (see
@secref["namespace-model"]) in the @tech{phase level} corresponding to
the @tech{base phase}, so that @scheme[sym] maps to the variable.}
@defproc[(namespace-undefine-variable! [sym symbol?]
@ -151,27 +164,29 @@ mapping is also adjusted (see @secref["namespace-model"]) so that
void?]{
Removes the @scheme[sym] variable, if any, in the top-level
environment of @scheme[namespace] at @tech{phase level} 0. The
namespace's identifier mapping (see @secref["namespace-model"]) is
unaffected.}
environment of @scheme[namespace] in its @tech{base phase}. The
namespace's @tech{identifier} mapping (see @secref["namespace-model"])
is unaffected.}
@defproc[(namespace-mapped-symbols [namespace namespace? (current-namespace)])
(listof symbol?)]{
Returns a list of all symbols that are mapped to variables, syntax,
and imports in @scheme[namespace] for @tech{phase level} 0.}
and imports in @scheme[namespace] for the @tech{phase level}
corresponding to the @tech{namespace}'s @tech{base phase}.}
@defproc[(namespace-require [quoted-raw-require-spec any/c])
void?]{
Performs the import corresponding to @scheme[quoted-raw-require-spec] in
the top-level environment of the current namespace, like a top-level
@scheme[#%require]. The @scheme[quoted-raw-require-spec] argument must be a
datum that corresponds to a quoted @scheme[_raw-require-spec] for
@scheme[#%require], which includes module paths.
Performs the import corresponding to @scheme[quoted-raw-require-spec]
in the top-level environment of the current namespace, like a
top-level @scheme[#%require]. The @scheme[quoted-raw-require-spec]
argument must be a datum that corresponds to a quoted
@scheme[_raw-require-spec] for @scheme[#%require], which includes
module paths.
Module paths in @scheme[quoted-raw-require-spec] are resolved with respect
to @scheme[current-load-relative-directory] or
@ -183,28 +198,29 @@ current namespace corresponds to a module body.}
void?]{
Like @scheme[namespace-require] for syntax exported from the module,
but exported variables at @tech{phase level} 0 are treated differently: the
export's current value is copied to a top-level variable in the
current namespace.}
but exported variables at the namespace's @tech{base phase} are
treated differently: the export's current value is copied to a
top-level variable in the current namespace.}
@defproc[(namespace-require/constant [quoted-raw-require-spec any/c])
void?]{
Like @scheme[namespace-require], but for each exported variable at
@tech{phase level} 0, the export's value is copied to a corresponding
top-level variable that is made immutable. Despite setting the
top-level variable, the corresponding identifier is bound as
imported.}
Like @scheme[namespace-require], but for each exported variable at the
@tech{namespace}'s @tech{base phase}, the export's value is copied to
a corresponding top-level variable that is made immutable. Despite
setting the top-level variable, the corresponding identifier is bound
as imported.}
@defproc[(namespace-require/expansion-time [quoted-raw-require-spec any/c])
void?]{
Like @scheme[namespace-require], but only the transformer part of the
module is executed; that is, the module is merely @tech{visit}ed, and
not @tech{instantiate}d (see @secref["mod-parse"]). If the required
module has not been instantiated before, the module's variables remain
module is executed relative to the @tech{namespace}'s @tech{base
phase}; that is, the module is merely @tech{visit}ed, and not
@tech{instantiate}d (see @secref["mod-parse"]). If the required module
has not been instantiated before, the module's variables remain
undefined.}
@ -214,19 +230,24 @@ undefined.}
any]{
Attaches the instantiated module named by @scheme[modname] in
@scheme[src-namespace] to the @tech{module registry} of
@scheme[dest-namespace]. If @scheme[modname] is not a symbol, the
current module name resolver is called to resolve the path, but no
module is loaded; the resolved form of @scheme[modname] is used as the
module name in @scheme[dest-namespace]. In addition to
@scheme[src-namespace] (at its @tech{base phase}) to the @tech{module
registry} of @scheme[dest-namespace]. If @scheme[modname] is not a
symbol, the current module name resolver is called to resolve the
path, but no module is loaded; the resolved form of @scheme[modname]
is used as the module name in @scheme[dest-namespace]. In addition to
@scheme[modname], every module that it imports (directly or
indirectly) is also recorded in the current namespace's @tech{module
registry}. If @scheme[modname] does not refer to an instantiated
module in @scheme[src-namespace], or if the name of any module to be
attached already has a different declaration or instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. The
inspector of the module invocation in @scheme[dest-namespace] is the
same as inspector of the invocation in @scheme[src-namespace].}
registry}. The inspector of the module invocation in
@scheme[dest-namespace] is the same as inspector of the invocation in
@scheme[src-namespace].
If @scheme[modname] does not refer to an instantiated module in
@scheme[src-namespace], or if the name of any module to be attached
already has a different declaration or instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract].
If @scheme[src-namespace] and @scheme[dest-namespace] do not have the
same @tech{base phase}, then the @exnraise[exn:fail:contract].}
@defproc[(namespace-unprotect-module [inspector inspector?]
@ -252,10 +273,11 @@ is useful only for identification via @scheme[eq?].}
@defproc[(module->namespace [modname module-path?]) namespace?]{
Returns a namespace that corresponds to the body of an instantiated
module in the current namespace's @tech{module registry}. The returned
namespace has the same @tech{module registry} as the current
namespace. Modifying a binding in the namespace changes the binding
seen in modules that require the namespace's module.
module in the current namespace's @tech{module registry} and in the
current namespace's @tech{base phase}. The returned namespace has the
same @tech{module registry} as the current namespace. Modifying a
binding in the namespace changes the binding seen in modules that
require the namespace's module.
Module paths in a top-level @scheme[require] expression are resolved
with respect to the namespace's module. New @scheme[provide]
@ -305,21 +327,20 @@ correspond to the first two elements of a list produced by
namespace?]{
Returns an empty namespace that shares module declarations and
instances with the namespace in which @scheme[varref] is
instantiated. The namespace corresponds to @tech{phase} 0, independent
of the phase of @scheme[varref]'s binding.}
instances with the namespace in which @scheme[varref] is instantiated,
and with the same phase as @scheme[varref].}
@defproc[(variable-reference->top-level-namespace [varref variable-reference?])
@defproc[(variable-reference->namespace [varref variable-reference?])
namespace?]{
If @scheme[varref] refers to a top-level binding, the result is
@scheme[varref]'s namespace if it corresponds to a @tech{phase} 0
binding, otherwise it is the @tech{phase} 0 namespace associated with
@scheme[varref]'s namespace.
If @scheme[varref] refers to a module binding, then the result is a
namespace for the module's body in the referenced binding's
@tech{phase}; the result is the same as a namespace obtained via
@scheme[module->namespace].
If @scheme[varref] refers to a module binding, then the
@exnraise[exn:fail:contract].}
If @scheme[varref] refers to a top-level binding, then the result is
the namespace in which the referenced binding is defined.}
@defproc[(variable-reference->resolved-module-path [varref variable-reference?])
@ -330,3 +351,8 @@ If @scheme[varref] refers to a module binding, the result is a
If @scheme[varref] refers to a top-level binding, then the
@exnraise[exn:fail:contract].}
@defproc[(variable-reference->phase [varref variable-reference?])
exact-nonnegative-integer?]{
Returns the @tech{phase} of the binding referenced by @scheme[varref].}

74
collects/scribblings/reference/syntax-model.scrbl
View File

@ -73,7 +73,7 @@ reference to a specific @tech{top-level variable}.
Every binding has a @deftech{phase level} in which it can be
referenced, where a @tech{phase level} normally corresponds to an
integer (but the special @deftech{label phase level} does not
integer (but the special @tech{label phase level} does not
correspond to an integer). @tech{Phase level} 0 corresponds to the
run time of the enclosing module (or the run time of top-level
expressions). Bindings in @tech{phase level} 0 constitute the
@ -84,7 +84,7 @@ expanded; bindings in @tech{phase level} 1 constitute the
run time of a different module for which the enclosing module is
imported for use at @tech{phase level} 1 (relative to the importing
module); bindings in @tech{phase level} -1 constitute the
@deftech{template environment}. The @tech{label phase level} does not
@deftech{template environment}. The @deftech{label phase level} does not
correspond to any execution time; it is used to track bindings (e.g.,
to identifiers within documentation) without implying an execution
dependency.
@ -313,7 +313,12 @@ things:
is called as a @tech{syntax transformer} (described below), and
parsing starts again with the @tech{syntax-object} result. If
the @tech{transformer binding} is to any other kind of value,
parsing fails with an @scheme[exn:fail:syntax] exception.}
parsing fails with an @scheme[exn:fail:syntax] exception. The
call to the @tech{syntax transformer} is @scheme[parameterize]d
to set @scheme[current-namespace] to a @tech{namespace} that
shares @tech{bindings} and @tech{variables} with the namespace
being used to expand, except that its @tech{base phase} is one
greater.}
@item{A @tech{variable} @tech{binding}, such as introduced by a
module-level @scheme[define] or by @scheme[let]. In this case,
@ -621,7 +626,7 @@ If the last expression form turns out to be a @scheme[define-values]
or @scheme[define-syntaxes] form, expansion fails with a syntax error.
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@subsection[#:tag "mod-parse"]{Module Phases}
@subsection[#:tag "mod-parse"]{Module Phases and Visits}
A @scheme[require] form not only introduces @tech{bindings} at
expansion time, but also @deftech{visits} the referenced module when
@ -632,23 +637,23 @@ in the module, and also evaluates all expressions for
Module @tech{visits} propagate through @scheme[require]s in the same
way as module @tech{instantiation}. Moreover, when a module is
@tech{visit}ed, any module that it @scheme[require-for-syntax]es is
@tech{instantiate}d at @tech{phase} 1, which the adjustment that
@scheme[require-for-template] leading back to @tech{phase} 0 causes
the required module to be merely visited at @tech{phase} 0, not
@tech{instantiate}d.
@tech{visit}ed, any module that it @scheme[require]s
@scheme[for-syntax] is @tech{instantiate}d at @tech{phase} 1, with the
adjustment that @scheme[require] @scheme[for-template]s leading back
to @tech{phase} 0 causes the required module to be merely visited at
@tech{phase} 0, not @tech{instantiate}d.
When the expander encounters @scheme[require-for-syntax], it
When the expander encounters @scheme[(require (for-syntax ....))], it
immediately instantiates the required module at @tech{phase} 1, in
addition to adding bindings scheme @tech{phase level} 1 (i.e., the
@tech{transformer environment}).
When the expander encounters @scheme[require] and
@scheme[require-for-syntax] within a @tech{module context}, the
resulting @tech{visits} and @tech{instantiations} are specific to the
expansion of the enclosing module, and are kept separate from
@tech{visits} and @tech{instantiations} triggered from a
@tech{top-level context} or from the expansion of a different module.
When the expander encounters @scheme[require] and @scheme[(require
(for-syntax ....))] within a @tech{module context}, the resulting
@tech{visits} and @tech{instantiations} are specific to the expansion
of the enclosing module, and are kept separate from @tech{visits} and
@tech{instantiations} triggered from a @tech{top-level context} or
from the expansion of a different module.
@;------------------------------------------------------------------------
@section[#:tag "compilation-model"]{Compilation}
@ -705,10 +710,15 @@ names to module declarations (see @secref["module-eval-model"]).
This registry is shared by all @tech{phase level}s.
For evaluation, each namespace encapsulates a distinct set of
top-level variables, as well as a potentially distinct set of module
instances in each @tech{phase}. That is, even though module
declarations are shared for all @tech{phase levels}, module instances
are distinct for each @tech{phase}.
top-level variables at various @tech{phases}, as well as a potentially
distinct set of module instances in each @tech{phase}. That is, even
though module declarations are shared for all @tech{phase levels},
module instances are distinct for each @tech{phase}. Each namespace
has a @deftech{base phase}, which corresponds to the phase used by
reflective operations such as @scheme[eval] and
@scheme[dynamic-require]. In particular, using @scheme[eval] on a
@scheme[require] form @tech{instantiates} a module in the namespace's
@tech{base phase}.
After a namespace is created, module instances from existing
namespaces can be attached to the new namespace. In terms of the
@ -725,8 +735,8 @@ code that is executing, or with the namespace that was used to link
the compiled form of the currently evaluating code. In particular,
changing the current namespace during evaluation does not change the
variables to which executing expressions refer. The current namespace
only determines the behavior of (essentially reflective) operations to
expand code and to start evaluating expanded/compiled code.
only determines the behavior of reflective operations to expand code
and to start evaluating expanded/compiled code.
@examples[
(code:line
@ -741,16 +751,18 @@ expand code and to start evaluating expanded/compiled code.
(display (eval 'x)))) (code:comment #, @t{displays @scheme['new]}))
]
A namespace is purely a top-level entity, not to be confused with an
environment. In particular, a namespace does not encapsulate the full
environment of an expression inside local-binding forms.
A @tech{namespace} is purely a top-level entity, not to be confused
with an @tech{environment}. In particular, a @tech{namespace} does not
encapsulate the full @tech{environment} of an expression inside
local-binding forms.
If an identifier is bound to syntax or to an import, then defining the
identifier as a variable shadows the syntax or import in future uses
of the environment. Similarly, if an identifier is bound to a
top-level variable, then binding the identifier to syntax or an import
shadows the variable; the variable's value remains unchanged, however,
and may be accessible through previously evaluated expressions.
If an @tech{identifier} is bound to syntax or to an import, then
defining the @tech{identifier} as a @tech{variable} shadows the syntax
or import in future uses of the environment. Similarly, if an
@tech{identifier} is bound to a @tech{top-level variable}, then
binding the identifier to syntax or an import shadows the variable;
the variable's value remains unchanged, however, and may be accessible
through previously evaluated expressions.
@examples[
(define x 5)

20
collects/scribblings/reference/syntax.scrbl
View File

@ -112,7 +112,9 @@ action depends on the shape of the form:
@item{If it is a @scheme[define-syntaxes] or
@scheme[define-values-for-syntax] form, then the right-hand side is
evaluated (in @tech{phase} 1), and the binding is immediately
installed for further partial expansion within the module.}
installed for further partial expansion within the
module. Evaluation of the right-hand side is @scheme[parameterize]d
to set @scheme[current-namespace] as in @scheme[let-syntax].}
@item{If the form is a @scheme[require] form, bindings are introduced
immediately, and the imported modules are @tech{instantiate}d or
@ -1179,6 +1181,12 @@ Creates a @tech{transformer binding} (see
relative to the surrounding context. (See @secref["id-model"] for
information on @tech{phase levels}.)
The evaluation of each @scheme[trans-expr] is @scheme[parameterize]d
to set @scheme[current-namespace] to a @tech{namespace} that shares
@tech{bindings} and @tech{variables} with the namespace being used to
expand the @scheme[let-syntax] form, except that its @tech{base phase}
is one greater.
Each @scheme[id] is bound in the @scheme[body]s, and not in other
@scheme[trans-expr]s.}
@ -1486,8 +1494,10 @@ z
The first form creates a @tech{transformer binding} (see
@secref["transformer-model"]) of @scheme[id] with the value of
@scheme[expr], which is an expression at @tech{phase level} 1 relative
to the surrounding context. (See @secref["id-model"] for
information on @tech{phase levels}.)
to the surrounding context. (See @secref["id-model"] for information
on @tech{phase levels}.) Evaluation of @scheme[expr] side is
@scheme[parameterize]d to set @scheme[current-namespace] as in
@scheme[let-syntax].
The second form is a shorthand the same as for @scheme[define]; it
expands to a definition of the first form where the @scheme[expr] is a
@ -1508,7 +1518,9 @@ as @scheme[id]s, and each value is bound to the corresponding
Like @scheme[define], except that the binding is at @tech{phase level}
1 instead of @tech{phase level} 0 relative to its context. The
expression for the binding is also at @tech{phase level} 1. (See
@secref["id-model"] for information on @tech{phase levels}.)}
@secref["id-model"] for information on @tech{phase levels}.)
Evaluation of @scheme[expr] side is @scheme[parameterize]d to set
@scheme[current-namespace] as in @scheme[let-syntax].}
@defform[(define-values-for-syntax (id ...) expr)]{

3
collects/syntax/modcode.ss
View File

@ -1,4 +1,3 @@
(module modcode scheme/base
(require mzlib/port
mzlib/contract
@ -21,8 +20,6 @@
. opt-> .
any)])
(define moddep-current-open-input-file
(make-parameter open-input-file))

3
collects/syntax/modread.ss
View File

@ -51,7 +51,8 @@
(raise-wrong-module-name filename expected-module
(syntax-e #'nm)))
(datum->syntax-object exp
(cons #'module (cdr (syntax-e exp)))
(cons (namespace-module-identifier)
(cdr (syntax-e exp)))
exp
exp))]
[else

27
collects/tests/mzscheme/namespac.ss
View File

@ -110,4 +110,31 @@
(test (void) namespace-undefine-variable! 'bar)
(test 28 namespace-variable-value 'bar #t (lambda () 28)))
;; ----------------------------------------
(module phaser scheme/base
(define x (variable-reference->phase
(#%variable-reference x)))
(provide x))
(test 0 dynamic-require ''phaser 'x)
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(eval '(begin-for-syntax (display (dynamic-require ''phaser 'x)))))
(test "1" get-output-string s))
(test 0 dynamic-require ''phaser 'x)
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(eval '(begin-for-syntax
(let ([ns (make-base-namespace)])
(namespace-attach-module (current-namespace) ''phaser ns)
(eval '(require 'phaser) ns)
(display (eval 'x ns))))))
(test "1" get-output-string s))
;; ----------------------------------------
(report-errs)

59
collects/tests/mzscheme/stx.ss
View File

@ -938,16 +938,14 @@
;; lifting expressions
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define prev-ctx #f)
(define-syntax (@@foo stx)
(syntax-case stx ()
[(_ n)
(if (zero? (syntax-e #'n))
#'0
#'(list #f 0)
(with-syntax ([m (sub1 (syntax-e #'n))])
(eval `(set! prev-ctx ',(syntax-local-lift-context)))
(syntax-local-lift-expression #'(add1 (@@foo m)))))]))
#`(list '#,(syntax-local-lift-context)
#,(syntax-local-lift-expression #'(add1 (cadr (@@foo m)))))))]))
(define lifted-output #f)
@ -957,11 +955,14 @@
(with-syntax ([id (syntax-local-lift-expression #'(set! lifted-output "lifted!"))])
#'(list lifted-output id))]))
(test 2 '@@foo (@@foo 2))
(test #f values prev-ctx)
(test 2 eval (expand-once #'(@@foo 2)))
(test 2 eval (expand #'(@@foo 2)))
(test 2 eval (expand-to-top-form #'(@@foo 2)))
(test (list #f 2) '@@foo (@@foo 2))
(test (list #f 2) eval-syntax #'(@@foo 2))
(test (list #f 2) eval (expand-once #'(@@foo 2)))
(test (list #f 2) eval (expand-syntax-once #'(@@foo 2)))
(test (list #f 2) eval (expand #'(@@foo 2)))
(test (list #f 2) eval (expand-syntax #'(@@foo 2)))
(test (list #f 2) eval (expand-to-top-form #'(@@foo 2)))
(test (list #f 2) eval (expand-syntax-to-top-form #'(@@foo 2)))
(test (list "lifted!" (void)) '@@goo (@@goo))
(set! lifted-output #f)
(test (list "lifted!" (void)) eval (expand-once #'(@@goo)))
@ -1020,22 +1021,25 @@
(require '@@p)
(test 10 '@@goo (@@goo))
(set! prev-ctx #f)
(module @@m scheme/base
(require (for-syntax scheme/base))
(define-for-syntax prev-ctx #f)
(define-syntax (@@foo stx)
(syntax-case stx ()
[(_ n)
(if (zero? (syntax-e #'n))
#'0
#'(list #f 0)
(with-syntax ([m (sub1 (syntax-e #'n))])
(let ([prev (eval 'prev-ctx)])
(let ([prev prev-ctx])
(if prev
(unless (eq? prev (syntax-local-lift-context))
(error "context mismatch!"))
(eval `(set! prev-ctx ',(syntax-local-lift-context)))))
(syntax-local-lift-expression #'(add1 (@@foo m)))))]))
(error 'context
"mismatch: ~s vs.: ~s"
prev
(syntax-local-lift-context)))
(set! prev-ctx (syntax-local-lift-context))))
#`(list '#,(syntax-local-lift-context)
#,(syntax-local-lift-expression #'(add1 (cadr (@@foo m)))))))]))
(define @@local #f)
(define (set-local v)
(set! @@local v))
@ -1043,10 +1047,9 @@
(provide @@local))
(require '@@m)
(test 2 '@@local @@local)
(test #t symbol? prev-ctx)
(test 2 '@@local (cadr @@local))
(test #t '@@local (symbol? (car @@local)))
(set! prev-ctx #f)
(define-syntaxes (@@local-top @@local-top2 @@local-top3)
(let ([mk
(lambda (stops)
@ -1066,15 +1069,13 @@
(mk null)
(mk #f))))
(test 1 'let-foo (let ([x 5]) (@@foo 1)))
(test 1 eval (expand #'(let ([x 5]) (@@foo 1))))
(test 1 'local-foo (let ([x 5]) (@@local-top (@@foo 1))))
(test 'the-key values prev-ctx)
(test 1 eval (expand #'(let ([x 5]) (@@local-top (@@foo 1)))))
(test 1 eval (expand #'(@@local-top (@@foo 1))))
(test 1 eval (expand #'(@@local-top2 (@@foo 1))))
(test 1 eval (expand #'(@@local-top3 (@@foo 1))))
(test 'the-key values prev-ctx)
(test '(#f 1) 'let-foo (let ([x 5]) (@@foo 1)))
(test '(#f 1) eval (expand #'(let ([x 5]) (@@foo 1))))
(test '(the-key 1) 'local-foo (let ([x 5]) (@@local-top (@@foo 1))))
(test '(the-key 1) eval (expand #'(let ([x 5]) (@@local-top (@@foo 1)))))
(test '(the-key 1) eval (expand #'(@@local-top (@@foo 1))))
(test '(the-key 1) eval (expand #'(@@local-top2 (@@foo 1))))
(test '(the-key 1) eval (expand #'(@@local-top3 (@@foo 1))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check interaction of macro-introduced/lifted names and

20
collects/tests/r6rs/eval.ss
View File

@ -19,6 +19,26 @@
eval:)))
2)
;; Check that `eval' at compile-time produces values (such as conditions)
;; that make sense at compile time (i.e., no phase crossing):
(test (eval
'(let-syntax ([x (lambda (stx)
(datum->syntax
#'here
(condition-message
(call/cc
(lambda (esc)
(with-exception-handler
(lambda (exn) (esc exn))
(lambda ()
(eval '(assertion-violation 'exptime "ok")
(environment
'(rnrs)
'(rnrs eval))))))))))])
x)
(environment '(rnrs) '(for (rnrs eval) expand)))
"ok")
;;
))

1106
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

54
src/mzscheme/src/env.c
View File

@ -74,6 +74,7 @@ static Scheme_Env *make_empty_inited_env(int toplevel_size);
static Scheme_Env *make_empty_not_inited_env(int toplevel_size);
static Scheme_Object *namespace_identifier(int, Scheme_Object *[]);
static Scheme_Object *namespace_module_identifier(int, Scheme_Object *[]);
static Scheme_Object *namespace_variable_value(int, Scheme_Object *[]);
static Scheme_Object *namespace_set_variable_value(int, Scheme_Object *[]);
static Scheme_Object *namespace_undefine_variable(int, Scheme_Object *[]);
@ -497,6 +498,12 @@ static void make_init_env(void)
1, 2),
env);
scheme_add_global_constant("namespace-module-identifier",
scheme_make_prim_w_arity(namespace_module_identifier,
"namespace-module-identifier",
0, 1),
env);
scheme_add_global_constant("namespace-variable-value",
scheme_make_prim_w_arity(namespace_variable_value,
"namespace-variable-value",
@ -537,9 +544,9 @@ static void make_init_env(void)
"variable-reference->empty-namespace",
1, 1),
env);
scheme_add_global_constant("variable-reference->top-level-namespace",
scheme_add_global_constant("variable-reference->namespace",
scheme_make_prim_w_arity(variable_top_level_namespace,
"variable-reference->top-level-namespace",
"variable-reference->namespace",
1, 1),
env);
scheme_add_global_constant("variable-reference->phase",
@ -3708,6 +3715,23 @@ namespace_identifier(int argc, Scheme_Object *argv[])
return obj;
}
static Scheme_Object *
namespace_module_identifier(int argc, Scheme_Object *argv[])
{
Scheme_Env *genv;
if ((argc > 0) && !SCHEME_NAMESPACEP(argv[0]))
scheme_wrong_type("namespace-module-identifier", "namespace", 0, argc, argv);
if (argc)
genv = (Scheme_Env *)argv[0];
else
genv = scheme_get_env(NULL);
return scheme_datum_to_syntax(scheme_intern_symbol("module"), scheme_false,
scheme_sys_wraps_phase(genv->phase), 0, 0);
}
static Scheme_Object *
namespace_variable_value(int argc, Scheme_Object *argv[])
{
@ -3893,34 +3917,24 @@ static Scheme_Object *do_variable_namespace(const char *who, int tl, int argc, S
else {
v = SCHEME_PTR_VAL(argv[0]);
env = ((Scheme_Bucket_With_Home *)v)->home;
if (tl && env->module) {
env = NULL;
}
}
if (!env)
scheme_wrong_type(who,
(tl ? "top-level variable-reference" : "variable-reference"),
"variable-reference",
0, argc, argv);
ph = env->phase;
if (tl == 2) {
return scheme_make_integer(ph);
} else if (tl) {
while (ph--) {
env = env->template_env;
}
/* return env directly */
} else {
env = make_env(env, 0);
/* rewind modchain to phase 0: */
while (ph--) {
v = SCHEME_VEC_ELS(env->modchain)[2];
if (SCHEME_FALSEP(v)) {
scheme_signal_error("internal error: missing modchain for previous phase");
}
env->modchain = v;
}
/* new namespace: */
Scheme_Env *new_env;
new_env = make_env(env, 0);
new_env->phase = env->phase;
env = new_env;
}
return (Scheme_Object *)env;
@ -3933,7 +3947,7 @@ static Scheme_Object *variable_namespace(int argc, Scheme_Object *argv[])
static Scheme_Object *variable_top_level_namespace(int argc, Scheme_Object *argv[])
{
return do_variable_namespace("variable-reference->top-level-namespace", 1, argc, argv);
return do_variable_namespace("variable-reference->namespace", 1, argc, argv);
}
static Scheme_Object *variable_phase(int argc, Scheme_Object *argv[])

27
src/mzscheme/src/eval.c
View File

@ -1817,7 +1817,10 @@ static Scheme_Object *link_toplevel(Scheme_Object *expr, Scheme_Env *env,
Scheme_Object *src_modidx,
Scheme_Object *dest_modidx)
{
if (SAME_TYPE(SCHEME_TYPE(expr), scheme_variable_type)) {
if (SCHEME_SYMBOLP(expr)) {
/* See scheme_make_environment_dummy */
return (Scheme_Object *)scheme_global_bucket(begin_symbol, env);
} else if (SAME_TYPE(SCHEME_TYPE(expr), scheme_variable_type)) {
Scheme_Bucket_With_Home *b = (Scheme_Bucket_With_Home *)expr;
if (!env || !b->home->module)
@ -4655,12 +4658,15 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
{
if (genv->rename_set) {
if (SCHEME_STX_PAIRP(form)) {
Scheme_Object *a, *d;
Scheme_Object *a, *d, *module_stx;
a = SCHEME_STX_CAR(form);
if (SCHEME_STX_SYMBOLP(a)) {
a = scheme_add_rename(a, genv->rename_set);
if (scheme_stx_module_eq(a, scheme_module_stx, 0)) {
module_stx = scheme_datum_to_syntax(scheme_intern_symbol("module"),
scheme_false, scheme_sys_wraps_phase(genv->phase),
0, 0);
if (scheme_stx_module_eq(a, module_stx, genv->phase)) {
/* Don't add renames to the whole module; let the
module's language take over. */
d = SCHEME_STX_CDR(form);
@ -5873,8 +5879,9 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
c = scheme_hash_module_variable(env->genv, env->genv->module->self_modidx,
c, env->genv->module->insp,
-1, env->genv->mod_phase);
} else
} else {
c = (Scheme_Object *)scheme_global_bucket(c, env->genv);
}
return scheme_register_toplevel_in_prefix(c, env, rec, drec);
}
@ -8841,7 +8848,7 @@ static Scheme_Object *expand(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, 1, 0, scheme_true, 0, NULL, 0);
-1, 1, 0, scheme_false, 0, NULL, 0);
}
static Scheme_Object *expand_stx(int argc, Scheme_Object **argv)
@ -8854,7 +8861,7 @@ static Scheme_Object *expand_stx(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, -1, 0, scheme_true, 0, NULL, 0);
-1, -1, 0, scheme_false, 0, NULL, 0);
}
static Scheme_Object *stop_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
@ -9163,7 +9170,7 @@ expand_once(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 0, scheme_true, 0, NULL, 0);
1, 1, 0, scheme_false, 0, NULL, 0);
}
static Scheme_Object *
@ -9177,7 +9184,7 @@ expand_stx_once(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 0, scheme_true, 0, NULL, 0);
1, -1, 0, scheme_false, 0, NULL, 0);
}
static Scheme_Object *
@ -9188,7 +9195,7 @@ expand_to_top_form(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 1, scheme_true, 0, NULL, 0);
1, 1, 1, scheme_false, 0, NULL, 0);
}
static Scheme_Object *
@ -9202,7 +9209,7 @@ expand_stx_to_top_form(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 1, scheme_true, 0, NULL, 0);
1, -1, 1, scheme_false, 0, NULL, 0);
}
static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int cont, int w_prompt)

12
src/mzscheme/src/fun.c
View File

@ -2626,11 +2626,23 @@ scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv,
{
Scheme_Dynamic_State dyn_state;
Scheme_Cont_Frame_Data cframe;
Scheme_Config *config;
scheme_prepare_exp_env(env->genv);
config = scheme_extend_config(scheme_current_config(),
MZCONFIG_ENV,
(Scheme_Object *)env->genv->exp_env);
scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
scheme_set_dynamic_state(&dyn_state, env, mark, boundname, certs,
menv, menv ? menv->link_midx : env->genv->link_midx);
rands_vec[0] = code;
code = scheme_apply_with_dynamic_state(rator, 1, rands_vec, &dyn_state);
scheme_pop_continuation_frame(&cframe);
}
SCHEME_EXPAND_OBSERVE_MACRO_POST_X(rec[drec].observer, code);

143
src/mzscheme/src/module.c
View File

@ -101,7 +101,7 @@ static Scheme_Object *read_module(Scheme_Object *obj);
static Scheme_Module *module_load(Scheme_Object *modname, Scheme_Env *env, const char *who);
static void eval_defmacro(Scheme_Object *names, int count,
static void eval_exptime(Scheme_Object *names, int count,
Scheme_Object *expr,
Scheme_Env *genv, Scheme_Comp_Env *env,
Resolve_Prefix *rp, int let_depth, int shift,
@ -236,7 +236,7 @@ static char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash
int reprovide_kernel,
Scheme_Object *form);
static void start_module(Scheme_Module *m, Scheme_Env *env, int restart, Scheme_Object *syntax_idx,
int eval_exp, int eval_run, Scheme_Object *cycle_list);
int eval_exp, int eval_run, long base_phase, Scheme_Object *cycle_list);
static void finish_expstart_module(Scheme_Env *menv);
static void finish_expstart_module_in_namespace(Scheme_Env *menv, Scheme_Env *env);
static void finish_start_module_in_namespace(Scheme_Env *menv, Scheme_Env *env, int eval_run);
@ -660,7 +660,6 @@ int scheme_is_kernel_modname(Scheme_Object *modname)
Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env)
{
Scheme_Object *rn, *w;
long phase;
if (!env)
@ -670,6 +669,13 @@ Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env)
else
phase = env->genv->phase;
return scheme_sys_wraps_phase(phase);
}
Scheme_Object *scheme_sys_wraps_phase(long phase)
{
Scheme_Object *rn, *w;
if ((phase == 0) && scheme_sys_wraps0)
return scheme_sys_wraps0;
if ((phase == 1) && scheme_sys_wraps1)
@ -767,7 +773,7 @@ void scheme_install_initial_module_set(Scheme_Env *env)
/* Make sure module is running: */
m = (Scheme_Module *)scheme_hash_get(initial_modules_env->module_registry, a[1]);
start_module(m, initial_modules_env, 0, a[1], 0, 1, scheme_null);
start_module(m, initial_modules_env, 0, a[1], 0, 1, 0, scheme_null);
namespace_attach_module(3, a);
}
@ -878,6 +884,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
Scheme_Env *menv, *lookup_env = NULL;
int i, count, protected = 0;
const char *errname;
long base_phase;
modname = argv[0];
name = argv[1];
@ -899,6 +906,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
modidx = scheme_make_modidx(modname, scheme_false, scheme_false);
modname = scheme_module_resolve(modidx, 1);
base_phase = env->phase;
if (phase == 1) {
scheme_prepare_exp_env(env);
@ -950,7 +958,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
if (!phase) {
/* Evaluate id in a fresh namespace */
Scheme_Object *a[3], *ns;
start_module(m, env, 0, modidx, 0, 1, scheme_null);
start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null);
a[0] = scheme_intern_symbol("empty");
ns = scheme_make_namespace(1, a);
a[0] = (Scheme_Object *)env;
@ -1038,9 +1046,9 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
}
if (SCHEME_VOIDP(name))
start_module(m, env, 0, modidx, 1, 0, scheme_null);
start_module(m, env, 0, modidx, 1, 0, base_phase, scheme_null);
else
start_module(m, env, 0, modidx, 0, 1, scheme_null);
start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null);
if (SCHEME_SYMBOLP(name)) {
Scheme_Bucket *b;
@ -1244,6 +1252,13 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
same_namespace = SAME_OBJ(from_env, to_env);
if (from_env->phase != to_env->phase) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"namespace-attach-module: "
"source namespace phase: %ld does not match destination namespace phase: %ld",
(long)from_env->phase, (long)to_env->phase);
}
name = scheme_module_resolve(scheme_make_modidx(argv[1], scheme_false, scheme_false), 0);
todo = scheme_make_pair(name, scheme_null);
@ -1252,7 +1267,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
nophase_todo = scheme_null;
from_modchain = from_env->modchain;
to_modchain = to_env->modchain;
phase = 0;
phase = from_env->phase;
checked = NULL;
next_checked = NULL;
@ -1267,7 +1282,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
nophase_checked = scheme_make_hash_table(SCHEME_hash_ptr);
first_iteration = 1;
max_phase = 0;
max_phase = phase;
just_declare = 0;
checked = scheme_make_hash_table(SCHEME_hash_ptr);
@ -1282,7 +1297,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
if (phase < 0) {
/* As soon as we start traversing negative phases, stop transferring
instances (i.e., transfer declarations only). This transfer-only
mode should stikc even even if we go back into positive phases. */
mode should stick even even if we go back into positive phases. */
just_declare = 1;
}
@ -1345,7 +1360,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
}
if (m2) {
char *phase, buf[32];
char *phase, buf[32], *kind;
if (!menv->phase)
phase = "";
@ -1356,11 +1371,16 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
phase = buf;
}
if (SAME_OBJ(menv->module, m2))
kind = "instance of the same module";
else
kind = "module with the same name";
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"namespace-attach-module: "
"a different module with the same name is already "
"a different %s is already "
"in the destination namespace%s, for name: %D",
phase, name);
kind, phase, name);
return NULL;
}
} else
@ -1666,7 +1686,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
Scheme_Env *te = to_env;
from_modchain = from_env->modchain;
to_modchain = to_env->modchain;
for (i = 0; i < phase; i++) {
for (i = from_env->phase; i < phase; i++) {
from_modchain = SCHEME_VEC_ELS(from_modchain)[1];
scheme_prepare_exp_env(te);
@ -3470,7 +3490,7 @@ static void compute_require_names(Scheme_Env *menv, Scheme_Object *phase,
}
static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp, int eval_run,
Scheme_Object *cycle_list, Scheme_Object *syntax_idx)
long base_phase, Scheme_Object *cycle_list, Scheme_Object *syntax_idx)
{
Scheme_Object *new_cycle_list, *midx, *l;
Scheme_Module *im;
@ -3502,7 +3522,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
start_module(im,
menv->label_env, 0,
midx,
0, 0,
0, 0, base_phase,
new_cycle_list);
}
}
@ -3521,7 +3541,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
start_module(im,
menv->template_env, 0,
midx,
eval_exp, eval_run,
eval_exp, eval_run, base_phase,
new_cycle_list);
}
}
@ -3533,7 +3553,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, env, 0, midx, eval_exp, eval_run, new_cycle_list);
start_module(im, env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
}
scheme_prepare_exp_env(menv);
@ -3547,7 +3567,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, menv->exp_env, 0, midx, eval_exp, eval_run, new_cycle_list);
start_module(im, menv->exp_env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
}
}
@ -3580,7 +3600,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
start_module(im,
menv2, 0,
midx,
eval_exp, eval_run,
eval_exp, eval_run, base_phase,
new_cycle_list);
}
} else {
@ -3602,7 +3622,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, menv2, 0, midx, eval_exp, eval_run, new_cycle_list);
start_module(im, menv2, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
}
}
}
@ -3692,10 +3712,10 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
}
static void expstart_module(Scheme_Env *menv, Scheme_Env *env, int restart,
int eval_exp, int eval_run)
int eval_exp, int eval_run, long base_phase)
{
int delay_run = ((!eval_exp && (menv->phase >= 0))
|| (!eval_run && (menv->phase == -1)));
int delay_run = ((!eval_exp && (menv->phase >= base_phase))
|| (!eval_run && (menv->phase < base_phase)));
if (!restart) {
if (menv && menv->et_running) {
@ -3790,7 +3810,7 @@ void scheme_run_module_exptime(Scheme_Env *menv, int set_ns)
for_stx = SCHEME_TRUEP(SCHEME_VEC_ELS(e)[4]);
e = SCHEME_VEC_ELS(e)[1];
eval_defmacro(names, scheme_list_length(names), e, exp_env, rhs_env,
eval_exptime(names, scheme_list_length(names), e, exp_env, rhs_env,
rp, let_depth, 1, (for_stx ? for_stx_globals : syntax), for_stx,
NULL);
}
@ -3816,7 +3836,7 @@ static void finish_start_module_in_namespace(Scheme_Env *menv, Scheme_Env *from_
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
}
start_module(menv->module, menv, 0, NULL, 1, eval_run, scheme_null);
start_module(menv->module, menv, 0, NULL, 1, eval_run, menv->phase, scheme_null);
if (from_env)
scheme_pop_continuation_frame(&cframe);
@ -3828,7 +3848,7 @@ static void finish_expstart_module_in_namespace(Scheme_Env *menv, Scheme_Env *fr
}
static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
Scheme_Object *syntax_idx, int eval_exp, int eval_run,
Scheme_Object *syntax_idx, int eval_exp, int eval_run, long base_phase,
Scheme_Object *cycle_list)
{
Scheme_Env *menv;
@ -3851,17 +3871,17 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
show("strt", menv, eval_exp, eval_run);
chain_start_module(menv, env, eval_exp, eval_run, cycle_list, syntax_idx);
chain_start_module(menv, env, eval_exp, eval_run, base_phase, cycle_list, syntax_idx);
if (!env->phase) {
if (env->phase == base_phase) {
if (!eval_run) {
expstart_module(menv, env, restart, eval_exp, eval_run);
expstart_module(menv, env, restart, eval_exp, eval_run, base_phase);
show_done("nrn0", menv, eval_exp, eval_run);
return;
}
} else if (env->phase < 0) {
} else if (env->phase < base_phase) {
if (env->phase == -1) {
expstart_module(menv, env, restart, eval_exp, eval_run);
expstart_module(menv, env, restart, eval_exp, eval_run, base_phase);
}
show_done("nrn-", menv, eval_exp, eval_run);
return;
@ -3872,7 +3892,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
}
}
expstart_module(menv, env, restart, eval_exp, eval_run);
expstart_module(menv, env, restart, eval_exp, eval_run, base_phase);
if (m->primitive) {
menv->running = 1;
@ -4208,7 +4228,7 @@ static Scheme_Module_Exports *make_module_exports()
/* define-syntaxes */
/**********************************************************************/
static void *eval_defmacro_k(void)
static void *eval_exptime_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *names;
@ -4238,7 +4258,7 @@ static void *eval_defmacro_k(void)
p->ku.k.p4 = NULL;
p->ku.k.p5 = NULL;
eval_defmacro(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, for_stx, certs);
eval_exptime(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, for_stx, certs);
return NULL;
}
@ -4254,7 +4274,7 @@ static int is_simple_expr(Scheme_Object *v)
return 0;
}
static void eval_defmacro(Scheme_Object *names, int count,
static void eval_exptime(Scheme_Object *names, int count,
Scheme_Object *expr,
Scheme_Env *genv, Scheme_Comp_Env *comp_env,
Resolve_Prefix *rp,
@ -4278,7 +4298,7 @@ static void eval_defmacro(Scheme_Object *names, int count,
p->ku.k.i3 = shift;
p->ku.k.i4 = for_stx;
p->ku.k.p5 = certs;
(void)scheme_enlarge_runstack(depth, eval_defmacro_k);
(void)scheme_enlarge_runstack(depth, eval_exptime_k);
return;
}
@ -4293,11 +4313,21 @@ static void eval_defmacro(Scheme_Object *names, int count,
if (is_simple_expr(expr)) {
vals = _scheme_eval_linked_expr_multi_wp(expr, scheme_current_thread);
} else {
Scheme_Cont_Frame_Data cframe;
Scheme_Config *config;
Scheme_Dynamic_State dyn_state;
config = scheme_extend_config(scheme_current_config(),
MZCONFIG_ENV,
(Scheme_Object *)genv);
scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
scheme_set_dynamic_state(&dyn_state, comp_env, NULL, scheme_false, certs,
genv, (genv->link_midx ? genv->link_midx : genv->module->me->src_modidx));
vals = scheme_eval_linked_expr_multi_with_dynamic_state(expr, &dyn_state);
scheme_pop_continuation_frame(&cframe);
}
scheme_pop_prefix(save_runstack);
@ -4424,7 +4454,7 @@ module_execute(Scheme_Object *data)
/* Replacing an already-running or already-syntaxing module? */
if (old_menv) {
start_module(m, env, 1, NULL, 0, (old_menv->running > 0) ? 1 : 0, scheme_null);
start_module(m, env, 1, NULL, 0, (old_menv->running > 0) ? 1 : 0, env->phase, scheme_null);
}
return scheme_void;
@ -4996,7 +5026,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
{
Scheme_Object *fm, *nm, *ii, *rn, *et_rn, *iidx, *self_modidx, *rmp, *rn_set;
Scheme_Module *iim;
Scheme_Env *menv;
Scheme_Env *menv, *top_env;
Scheme_Comp_Env *benv;
Scheme_Module *m;
Scheme_Object *mbval, *orig_ii;
@ -5043,7 +5073,16 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
m->me = me;
}
menv = scheme_new_module_env(env->genv, m, 1);
top_env = env->genv;
/* Create module env from phase-0 env. This doesn't create bad
sharing, because compile-time module instances for compiling this
module are all fresh instances. */
while (top_env->phase) {
scheme_prepare_template_env(top_env);
top_env = top_env->template_env;
}
menv = scheme_new_module_env(top_env, m, 1);
menv->disallow_unbound = 1;
@ -5070,7 +5109,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
/* load the module for the initial require */
iim = module_load(_module_resolve(iidx, m->ii_src, NULL, 1), menv, NULL);
start_module(iim, menv, 0, iidx, 1, 0, scheme_null);
start_module(iim, menv, 0, iidx, 1, 0, menv->phase, scheme_null);
{
Scheme_Object *ins;
@ -5918,7 +5957,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
if (ri->use_jit)
m = scheme_jit_expr(m);
eval_defmacro(names, count, m, eenv->genv, rhs_env, rp, ri->max_let_depth, 0,
eval_exptime(names, count, m, eenv->genv, rhs_env, rp, ri->max_let_depth, 0,
(for_stx ? env->genv->exp_env->toplevel : env->genv->syntax), for_stx,
rec[drec].certs);
@ -8159,7 +8198,7 @@ void parse_requires(Scheme_Object *form,
int unpack_kern, int copy_vars, int can_save_marshal, int always_run,
int *all_simple)
{
Scheme_Object *ll = form, *mode = scheme_make_integer(0), *just_mode = NULL;
Scheme_Object *ll = form, *mode = scheme_make_integer(0), *just_mode = NULL, *x_mode, *x_just_mode;
Scheme_Module *m;
Scheme_Object *idxstx, *idx, *name, *i, *exns, *prefix, *iname, *ename, *aa, *aav;
Scheme_Object *mark_src, *err_src;
@ -8455,9 +8494,9 @@ void parse_requires(Scheme_Object *form,
m = module_load(name, env, NULL);
if (start)
start_module(m, env, 0, idx, 1, always_run ? 1 : 0, scheme_null);
start_module(m, env, 0, idx, 1, always_run ? 1 : 0, main_env->phase, scheme_null);
else
start_module(m, env, 0, idx, 0, 0, scheme_null);
start_module(m, env, 0, idx, 0, 0, main_env->phase, scheme_null);
/* Add name to require list, if it's not there: */
if (main_env->module) {
@ -8489,7 +8528,19 @@ void parse_requires(Scheme_Object *form,
}
}
add_single_require(m->me, just_mode, mode, idx, rename_env,
x_just_mode = just_mode;
x_mode = mode;
if (main_env->phase) {
/* We get here only via `eval' or `namespace-require'. */
if (x_just_mode && SCHEME_TRUEP(x_just_mode)) {
x_just_mode = scheme_bin_plus(x_just_mode, scheme_make_integer(main_env->phase));
}
if (x_mode && SCHEME_TRUEP(x_mode)) {
x_mode = scheme_bin_plus(x_mode, scheme_make_integer(main_env->phase));
}
}
add_single_require(m->me, x_just_mode, x_mode, idx, rename_env,
rn_set, post_ex_rn_set, NULL,
exns, onlys, prefix, iname, ename,
mark_src,

11
src/mzscheme/src/portfun.c
View File

@ -4442,7 +4442,7 @@ static Scheme_Object *do_load_handler(void *data)
Scheme_Config *config = lhd->config;
Scheme_Object *last_val = scheme_void, *obj, **save_array = NULL;
Scheme_Env *genv;
int save_count = 0, got_one = 0;
int save_count = 0, got_one = 0, as_module;
while ((obj = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, 0, -1, NULL,
NULL, NULL, lhd->delay_load_info))
@ -4452,6 +4452,9 @@ static Scheme_Object *do_load_handler(void *data)
/* ... begin special support for module loading ... */
genv = scheme_get_env(config);
as_module = 0;
if (SCHEME_SYMBOLP(lhd->expected_module)) {
/* Must be of the form `(module <expectedname> ...)',possibly compiled. */
/* Also, file should have no more expressions. */
@ -4539,9 +4542,10 @@ static Scheme_Object *do_load_handler(void *data)
/* Replace `module' in read expression with one bound to #%kernel's `module': */
a = SCHEME_STX_CAR(obj);
d = SCHEME_STX_CDR(obj);
a = scheme_datum_to_syntax(module_symbol, a, scheme_sys_wraps(NULL), 0, 1);
a = scheme_datum_to_syntax(module_symbol, a, scheme_sys_wraps_phase(genv->phase), 0, 1);
d = scheme_make_pair(a, d);
obj = scheme_datum_to_syntax(d, obj, scheme_false, 0, 1);
as_module = 1;
}
} else {
/* Add #%top-interaction, since we're in non-module mode: */
@ -4552,8 +4556,7 @@ static Scheme_Object *do_load_handler(void *data)
/* ... end special support for module loading ... */
genv = scheme_get_env(config);
if (genv->rename_set)
if (!as_module && genv->rename_set)
obj = scheme_add_rename(obj, genv->rename_set);
last_val = _scheme_apply_multi_with_prompt(scheme_get_param(config, MZCONFIG_EVAL_HANDLER),

28
src/mzscheme/src/print.c
View File

@ -2168,6 +2168,34 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
print_utf8_string(pp, ">", 0, 1);
}
}
else if (SCHEME_NAMESPACEP(obj))
{
if (compact || !pp->print_unreadable) {
cannot_print(pp, notdisplay, obj, ht, compact);
} else {
char s[10];
print_utf8_string(pp, "#<namespace:", 0, 12);
if (((Scheme_Env *)obj)->module) {
Scheme_Object *modname;
int is_sym;
modname = ((Scheme_Env *)obj)->module->modname;
is_sym = SCHEME_SYMBOLP(SCHEME_PTR_VAL(modname));
print_utf8_string(pp, (is_sym ? "'" : "\""), 0, 1);
print(SCHEME_PTR_VAL(modname), 0, 0, ht, mt, pp);
PRINTADDRESS(pp, modname);
if (!is_sym)
print_utf8_string(pp, "\"" , 0, 1);
print_utf8_string(pp, ":", 0, 1);
}
sprintf(s, "%ld", ((Scheme_Env *)obj)->phase);
print_utf8_string(pp, s, 0, -1);
print_utf8_string(pp, ">", 0, 1);
}
}
else if (SCHEME_INPORTP(obj))
{
if (compact || !pp->print_unreadable) {

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 915
#define EXPECTED_PRIM_COUNT 916
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

1
src/mzscheme/src/schpriv.h
View File

@ -2577,6 +2577,7 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
int scheme_tl_id_is_sym_used(Scheme_Hash_Table *marked_names, Scheme_Object *sym);
Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env);
Scheme_Object *scheme_sys_wraps_phase(long phase);
Scheme_Env *scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree);
int scheme_is_module_env(Scheme_Comp_Env *env);

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.0.1.1"
#define MZSCHEME_VERSION "4.0.1.2"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

8
src/mzscheme/src/stxobj.c
View File

@ -3345,6 +3345,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
/* Module rename: */
Module_Renames *mrn;
EXPLAIN(printf("Rename/set\n"));
if (SCHEME_RENAMESP(WRAP_POS_FIRST(wraps))) {
mrn = (Module_Renames *)WRAP_POS_FIRST(wraps);
} else {
@ -3359,6 +3361,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
if (mrn && (!is_in_module || (mrn->kind != mzMOD_RENAME_TOPLEVEL))
&& !skip_other_mods) {
EXPLAIN(printf(" use rename %p %d\n", mrn->phase, mrn->kind));
if (mrn->kind != mzMOD_RENAME_TOPLEVEL)
is_in_module = 1;
@ -3392,6 +3396,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
} else
glob_id = SCHEME_STX_VAL(a);
EXPLAIN(printf(" search %s\n", scheme_write_to_string(glob_id, 0)));
rename = scheme_hash_get(mrn->ht, glob_id);
if (!rename && mrn->nomarshal_ht)
rename = scheme_hash_get(mrn->nomarshal_ht, glob_id);
@ -3406,6 +3412,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
get_names_done = 1;
}
EXPLAIN(printf(" search result: %p\n", rename));
if (rename) {
if (mrn->kind == mzMOD_RENAME_MARKED) {
/* One job of a mzMOD_RENAME_MARKED renamer is to replace any

40
src/mzscheme/src/syntax.c
View File

@ -5087,9 +5087,24 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
{
Scheme_Dynamic_State dyn_state;
Scheme_Cont_Frame_Data cframe;
Scheme_Config *config;
Scheme_Object *result;
scheme_prepare_exp_env(dm_env);
config = scheme_extend_config(scheme_current_config(),
MZCONFIG_ENV,
(Scheme_Object *)dm_env->exp_env);
scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
scheme_set_dynamic_state(&dyn_state, rhs_env, NULL, scheme_false, NULL, dm_env, dm_env->link_midx);
return define_execute_with_dynamic_state(form, 4, for_stx ? 2 : 1, rp, dm_env, &dyn_state);
result = define_execute_with_dynamic_state(form, 4, for_stx ? 2 : 1, rp, dm_env, &dyn_state);
scheme_pop_continuation_frame(&cframe);
return result;
}
}
@ -5418,12 +5433,11 @@ Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env)
{
Scheme_Object *dummy;
/* Get prefixed-based accessors for a dummy top-level buckets. It's
used to "link" to the right enviornment. begin_symbol is arbitrary */
dummy = (Scheme_Object *)scheme_global_bucket(begin_symbol, env->genv);
dummy = scheme_register_toplevel_in_prefix(dummy, env, NULL, 0);
return dummy;
/* Get a prefixed-based accessor for a dummy top-level bucket. It's
used to "link" to the right environment at run time. The `begin'
symbol is arbitrary; the top-level/prefix support handles a symbol
as a "toplevel" specially. */
return scheme_register_toplevel_in_prefix(begin_symbol, env, NULL, 0);
}
Scheme_Env *scheme_environment_from_dummy(Scheme_Object *dummy)
@ -5467,10 +5481,22 @@ static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_e
/* short cut */
a = _scheme_eval_linked_expr_multi(a);
} else {
Scheme_Cont_Frame_Data cframe;
Scheme_Config *config;
Scheme_Dynamic_State dyn_state;
scheme_prepare_exp_env(rhs_env->genv);
config = scheme_extend_config(scheme_current_config(),
MZCONFIG_ENV,
(Scheme_Object *)rhs_env->genv->exp_env);
scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
scheme_set_dynamic_state(&dyn_state, rhs_env, NULL, scheme_false, certs, rhs_env->genv, rhs_env->genv->link_midx);
a = scheme_eval_linked_expr_multi_with_dynamic_state(a, &dyn_state);
scheme_pop_continuation_frame(&cframe);
}
scheme_pop_prefix(save_runstack);

13
src/mzscheme/src/thread.c
View File

@ -6674,7 +6674,18 @@ void scheme_add_namespace_option(Scheme_Object *key, void (*f)(Scheme_Env *))
Scheme_Object *scheme_make_namespace(int argc, Scheme_Object *argv[])
{
return (Scheme_Object *)scheme_make_empty_env();
Scheme_Env *genv, *env;
long phase;
genv = scheme_get_env(NULL);
env = scheme_make_empty_env();
for (phase = genv->phase; phase--; ) {
scheme_prepare_exp_env(env);
env = env->exp_env;
}
return env;
}
static Scheme_Object *namespace_p(int argc, Scheme_Object **argv)