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

3.99.0.3: improved namespace API

Browse Source 
svn: r7756
This commit is contained in:
Matthew Flatt 2007-11-18 02:06:57 +00:00
parent 42beccc03b
commit 391892a848
34 changed files with 526 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/compiler/compiler-unit.ss
View File

@ -22,9 +22,6 @@
syntax/toplevel
syntax/moddep
scheme/namespace
syntax/namespace-reflect
mzlib/list
scheme/file
mzlib/compile ; gets compile-file
@ -33,8 +30,8 @@
(provide compiler@)
(define-reflection-anchor anchor)
(define orig-namespace (reflection-anchor->namespace anchor))
(define-namespace-anchor anchor)
(define orig-namespace (namespace-anchor->empty-namespace anchor))
;; ;;;;;;;; ----- The main compiler unit ------ ;;;;;;;;;;
(define-unit compiler@
@ -170,10 +167,7 @@
(define (compile-zos prefix)
(let ([n (if prefix
(let ([ns (make-base-namespace)])
(parameterize ([current-namespace ns])
(namespace-require 'scheme/base)
ns))
(make-base-namespace)
(current-namespace))])
(when prefix
(eval prefix n))

5
collects/compiler/main.ss
View File

@ -32,8 +32,7 @@
(lib "link.ss" "dynext")
(lib "pack.ss" "setup")
(lib "getinfo.ss" "setup")
(lib "dirs.ss" "setup")
scheme/namespace)
(lib "dirs.ss" "setup"))
(define dest-dir (make-parameter #f))
(define auto-dest-dir (make-parameter #f))
@ -486,7 +485,7 @@
'auto
(dest-dir)))]
[(make-zo)
(let ([n (make-base-namespace)]
(let ([n (make-base-empty-namespace)]
[mc (dynamic-require '(lib "mzlib/cm.ss")
'managed-compile-zo)]
[cnh (dynamic-require '(lib "mzlib/cm.ss")

5
collects/mzlib/restart.ss
View File

@ -1,7 +1,6 @@
(module restart scheme/base
(require "cmdline.ss"
scheme/namespace)
(require "cmdline.ss")
(provide restart-mzscheme)
@ -95,7 +94,7 @@
(unless (null? rest)
(set! args rest))
;(when args (set! rest args))
(let ([n (make-base-namespace)]
(let ([n (make-base-empty-namespace)]
[argv (if args (list->vector args) (vector))])
(parameterize ([current-command-line-arguments argv])
(thread-wait

9
collects/r5rs/main.ss
View File

@ -1,7 +1,6 @@
(module main scheme/base
(require syntax/namespace-reflect
(for-syntax scheme/base))
(require (for-syntax scheme/base))
(provide (for-syntax syntax-rules ...)
(rename-out
@ -441,7 +440,7 @@
;; --------------------------------------------------
(define-reflection-anchor here)
(define-namespace-anchor here)
(define (scheme-report-environment n)
(unless (= n 5)
@ -454,10 +453,8 @@
(mk-r5rs #t))
(define (mk-r5rs stx-only?)
(let ([n (make-namespace)]
[orig (reflection-anchor->namespace here)])
(let ([n (namespace-anchor->empty-namespace here)])
(parameterize ([current-namespace n])
(namespace-attach-module orig 'r5rs)
(if stx-only?
(namespace-require '(only r5rs
quote quasiquote

2
collects/scheme/base.ss
View File

@ -6,6 +6,7 @@
"private/qqstx.ss"
"private/stx.ss"
"private/kw-file.ss"
"private/namespace.ss"
(for-syntax "private/stxcase-scheme.ss"))
(#%provide (all-from-except "private/pre-base.ss"
@ -21,6 +22,7 @@
identifier?
(all-from "private/stxcase-scheme.ss")
(all-from "private/qqstx.ss")
(all-from "private/namespace.ss")
(for-syntax syntax-rules syntax-id-rules ... _)
(rename -open-input-file open-input-file)
(rename -open-output-file open-output-file)

4
collects/scheme/mzscheme.ss
View File

@ -29,7 +29,7 @@
(all-from "private/qqstx.ss")
(all-from "private/define.ss")
(all-from-except '#%kernel #%module-begin #%datum
if make-namespace
if make-empty-namespace
syntax->datum datum->syntax
free-identifier=?
free-transformer-identifier=?
@ -45,7 +45,7 @@
namespace-transformer-require
(rename cleanse-path expand-path)
(rename if* if)
(rename make-namespace* make-namespace)
make-namespace
#%top-interaction
(rename datum #%datum)
(rename mzscheme-in-stx-module-begin #%module-begin)

10
collects/scheme/namespace.ss
View File

@ -1,10 +0,0 @@
(module namespace scheme/base
(provide make-base-namespace)
(define orig-namespace
(variable-reference-namespace (#%variable-reference orig-namespace)))
(define (make-base-namespace)
(let ([ns (make-namespace)])
(namespace-attach-module orig-namespace 'scheme/base ns)
ns)))

9
collects/scheme/private/modbeg.ss
View File

@ -7,14 +7,7 @@
(#%provide module-begin)
(define-values (print-values)
(lambda vs
(for-each (lambda (v)
(if (void? v)
(void)
(begin
(print v)
(newline))))
vs)))
(lambda vs (for-each (current-print) vs)))
(define-syntaxes (module-begin)
(lambda (stx)

72
collects/scheme/private/namespace.ss Normal file
View File

@ -0,0 +1,72 @@
(module namespace "pre-base.ss"
(require (for-syntax '#%kernel "define.ss"
"stx.ss" "stxcase-scheme.ss" "small-scheme.ss"
"stxloc.ss"))
(provide make-base-empty-namespace
make-base-namespace
define-namespace-anchor
namespace-anchor?
namespace-anchor->empty-namespace
namespace-anchor->namespace)
;; ----------------------------------------
(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)
'scheme/base
ns)
ns))
(define (make-base-namespace)
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-require 'scheme/base))
ns))
;; ----------------------------------------
(define-syntax (define-namespace-anchor stx)
(unless (memq (syntax-local-context) '(top-level module))
(raise-syntax-error #f
"allowed only in a top-level or module context"
stx))
(syntax-case stx ()
[(_ id)
(let ([id-stx #'id])
(unless (identifier? id-stx)
(raise-syntax-error #f
"expected an identifier"
stx
id-stx))
(syntax/loc stx
(define id (make-namespace-anchor (#%variable-reference id)))))]))
(define-struct namespace-anchor (var))
(define (namespace-anchor->empty-namespace ra)
(unless (namespace-anchor? ra)
(raise-type-error 'anchor->empty-namespace
"namespace anchor"
ra))
(variable-reference->empty-namespace (namespace-anchor-var ra)))
(define (namespace-anchor->namespace ra)
(unless (namespace-anchor? ra)
(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))))))

10
collects/scheme/private/old-procs.ss
View File

@ -6,22 +6,22 @@
"stxmz-body.ss"
"define.ss")
(#%provide make-namespace*
(#%provide make-namespace
free-identifier=?*
namespace-transformer-require)
(define reflect-var #f)
(define make-namespace*
(define make-namespace
(case-lambda
[() (make-namespace* 'initial)]
[() (make-namespace 'initial)]
[(flag)
(unless (memq flag '(initial empty))
(raise-syntax-error 'make-namespace
"'initial or 'empty"
flag))
(let ([new (make-namespace)]
[old (variable-reference-namespace (#%variable-reference reflect-var))])
(let ([new (make-empty-namespace)]
[old (variable-reference->empty-namespace (#%variable-reference reflect-var))])
(namespace-attach-module old 'mzscheme new)
(parameterize ([current-namespace new])
(namespace-require 'mzscheme))

2
collects/scribblings/guide/guide.scrbl
View File

@ -91,7 +91,7 @@ printed output.
@; ----------------------------------------------------------------------
@section[#:tag "reflection"]{Reflection and Dynamic Evaluation}
@include-section["namespaces.scrbl"]
@; ----------------------------------------------------------------------

231
collects/scribblings/guide/namespaces.scrbl Normal file
View File

@ -0,0 +1,231 @@
#lang scribble/doc
@require[scribble/manual]
@require[scribble/eval]
@require[scheme/class]
@require["guide-utils.ss"]
@title[#:tag "reflection"]{Reflection and Dynamic Evaluation}
Scheme is a @italic{dynamic} language. It offers numerous facilities
for loading, compiling, and even constructing new code at run
time.
@; ----------------------------------------------------------------------
@section{Namespaces}
Dynamic evaluation requires a @deftech{namespace}, which encapsulates
two pieces of information:
@itemize{
@item{A mapping from identifiers to bindings. For example, a
namespace might map the identifier @schemeidfont{lambda} to the
@scheme[lambda] form. An ``empty'' namespace is one that maps
every identifier to an uninitialized top-level variable.}
@item{A mapping from module names to module declarations and
instances.}
}
The first mapping is used for evaluating expressions in a top-level
context, as in @scheme[(eval '(lambda (x) (+ x 1)))]. The second
mapping is used, for example, by @scheme[dynamic-require] to locate a
module. The call @scheme[(eval '(require scheme/base))] normally uses
both pieces: the identifier mapping determines the binding of
@schemeidfont{require}; if it turns out to mean @scheme[require], then
the module mapping is used to locate the @schememodname[scheme/base]
module.
From the perspective of the core Scheme run-time system, all
evaluation is reflective. Execution starts with an initial namespace
that contains a few primitive modules, and that is further populated
by loading files and modules as specified on the command line or as
supplied in the @tech{REPL}. Top-level @scheme[require] and
@scheme[define] forms adjust the identifier mapping, and module
declarations (typically loaded on demand for a @scheme[require] form)
adjust the module mapping.
Informally, the term @defterm{namespace} is sometimes used
interchangeably with @defterm{environment} or @defterm{scope}. In PLT
Scheme, the term @defterm{namespace} has the more specific, dynamic
meaning given above, and it should not be confused with static lexical
concepts.
@; ----------------------------------------------------------------------
@section{Creating and Installing Namespaces}
A @tech{namespace} is a first-class value. Some functions, such as
@scheme[eval], accept an optional namespace argument. More often, the
namespace used by a dynamic operation is the @deftech{current
namespace} as determined by the @scheme[current-namespace] parameter.
The function @scheme[make-empty-namespace] creates a new, empty
@tech{namespace}. Since the namespace is truly empty, it cannot at
first be used to evaluate any top-level expression---not even
@scheme[(require scheme)]. In particular,
@schemeblock[
(parameterize ([current-namespace (make-empty-namespace)])
(namespace-require 'scheme))
]
fails, because the namespace does not include the primitive modules on
which @scheme[scheme] is built.
To make a namespace useful, some modules much be @deftech{attached}
from an existing namespace. Attaching a module adjust the mapping of
module names to instances by transitively copying entries (the module
and all its imports) from an existing namespace's mapping. Normally,
instead of just attaching the primitive modules---whose names and
organization are subject to change---a higher-level module is
attached, such as @schememodname[scheme] or
@schememodname[scheme/base].
The @scheme[make-base-empty-namespace] function provides a namespace
that is empty, except that @schememodname[scheme/base] is
attached. The resulting namespace is still ``empty'' in the sense that
the identifiers-to-bindings part of the namespace has no mappings;
only the module mapping has been populated. Nevertheless, with an
initial module mapping, further modules can be loaded.
A namespace created with @scheme[make-base-empty-namespace] is
suitable for many basic dynamic tasks. For example, suppose that a
@schememodname[my-dsl] library implements a domain-specific language in
which you want to execute commands from a user-specified file. A
namespace created with @scheme[make-base-empty-namespace] is enough to
get started:
@schemeblock[
(define (run-dsl file)
(parameterize ([current-namespace (make-base-empty-namespace)])
(namespace-require 'my-dsl)
(load file)))
]
Note that the @scheme[parameterize] of @scheme[current-namespace] does
not affect the meaning of identifier like @scheme[namespace-require]
within the @scheme[parameterize] body. Those identifiers obtain their
meaning from the enclosing context (probably a module). Only
expressions that are dynamic with respect to this code, such as the
content of @scheme[load]ed files, are affected by the
@scheme[parameterize].
Another subtle point in the above example is the use of
@scheme[(namespace-require 'my-dsl)] instead of @scheme[(eval
'(require my-dsl))]. The latter would not work, because @scheme[eval]
needs to obtain a meaning for @scheme[require] in the namespace, and
the namespace's identifier mapping is initially empty. The
@scheme[namespace-require] function, in contrast, directly imports the
given module into the current namespace. Starting with
@scheme[(namespace-require 'scheme/base)] would introduce a binding
for @schemeidfont{require} and make a subsequent @scheme[(eval
'(require my-dsl))] work. The above is better, not only because it is
more compact, but also because it avoids introducing bindings that are
not part of the domain-specific languages.
@; ----------------------------------------------------------------------
@section{Sharing Data and Code Across Namespaces}
Modules not attached to a new namespace will be loaded and
instantiated afresh if they are demanded by evaluation. For example,
@schememodname[scheme/base] does not include
@schememodname[scheme/class], and loading @schememodname[scheme/class]
again will create a distinct class datatype:
@interaction[
(require scheme/class)
(class? object%)
(class?
(parameterize ([current-namespace (make-base-empty-namespace)])
(namespace-require 'scheme/class) (code:comment #, @t{loads again})
(eval 'object%)))
]
For cases when dynamically loaded code needs to share more code and
data with its context, use the @scheme[namespace-attach-module]
function. The first argument to @scheme[namespace-attach-module] is a
source namespace from which to draw a module instance; in some cases,
the current namespace is known to include the module that needs to be
shared:
@interaction[
(require scheme/class)
(class?
(let ([ns (make-base-empty-namespace)])
(namespace-attach-module (current-namespace)
'scheme/class
ns)
(parameterize ([current-namespace ns])
(namespace-require 'scheme/class) (code:comment #, @t{uses attached})
(eval 'object%))))
]
Within a module, however, the combination of
@scheme[define-namespace-anchor] and
@scheme[namespace-anchor->empty-namespace] offers a more reliable
method for obtaining a source namespace:
@schememod[
scheme/base
(require scheme/class)
(define-namespace-anchor a)
(define (load-plug-in file)
(let ([ns (make-base-empty-namespace)])
(namespace-attach-module (namespace-anchor->empty-namespace a)
'scheme/class
ns)
(parameterize ([current-namespace ns])
(dynamic-require file 'plug-in%))))
]
The anchor bound by @scheme[namespace-attach-module] connects the the
run time of a module with the namespace in which a module is loaded
(which might differ from the current namespace). In the above
example, since the enclosing module requires
@schememodname[scheme/class], the namespace produced by
@scheme[namespace-anchor->empty-namespace] certainly contains an
instance of @schememodname[scheme/class]. Moreover, that instance is
the same as the one imported into the module, so the class datatype is
shared.
@; {
@; ----------------------------------------------------------------------
@section{The Top Level is Hopeless}
@; ----------------------------------------------------------------------
@section{Guidelines on @scheme[eval], @scheme[load], and @scheme[dynamic-require]}
These dynamic features are powerful tools, but they are also easily
misused. This section provides some general guidelines on using
dynamic features.
@itemize{
@item{If you find a use for @scheme[eval] or @scheme[load], then it's
probably an abuse. In any case, don't expect the environment
for dynamically evaluated code to have anything to do with the
environment of a call to @scheme[eval] or @scheme[load].}
@item{If you find a use for @scheme[dynamic-require], such as for a
plug-in architecture or to delay loading code, then it's likely
a fine use.}
@item{When using functions like @scheme[eval], @scheme[load], or
@scheme[dynamic-require], take care to install an appropriate
@tech{namespace}.}
}
}

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

@ -6,25 +6,80 @@
See @secref["namespace-model"] for basic information on the
namespace model.
A new namespace is created with the @scheme[make-namespace] procedure,
which returns a first-class namespace value. A namespace is used by
setting the @scheme[current-namespace] parameter value, or by
providing the namespace to procedures such as @scheme[eval] and
A new 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
namespace to procedures such as @scheme[eval] and
@scheme[eval-syntax].
[FIXME: define the initial namespace.]
@defproc[(namespace? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a namespace value, @scheme[#f]
otherwise.}
@defproc[(make-namespace) namespace?]{
@defproc[(make-empty-namespace) namespace?]{
Creates a new namespace that is empty. Attach modules from an existing
namespace to the new one with @scheme[namespace-attach-module].}
Creates a new namespace that is empty, and whose module registry
contains no mappings. 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.}
@defproc[(make-base-namespace) namespace?]{
Creates a new namespace with @schememodname[scheme/base] attached and
@scheme[require]d into the top-level environment.}
@defform[(define-namespace-anchor id)]{
Binds @scheme[id] to a namespace anchor that can be used with
@scheme[namespace-anchor->empty-namespace] and
@scheme[namespace-anchor->namespace].
This form can be used only in a @tech{top-level context} or in a
@tech{module-context}.}
@defproc[(namespace-anchor? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a namespace-anchor value,
@scheme[#f] otherwise.}
@defproc[(namespace-anchor->empty-namespace [a namespace-anchor?]) namespace?]{
Returns an empty namespace that shares a module registry with the
source of the anchor.
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 at @tech{phase} 0. 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.}
@defproc[(namespace-anchor->namespace [a namespace-anchor?]) namespace?]{
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 module registry of the module instance at @tech{phase}
0.
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
anchor definition was evaluated.}
@defparam[current-namespace n namespace?]{

2
collects/setup/main.ss
View File

@ -18,7 +18,7 @@
(define-values (make-kernel-namespace)
(lambda ()
(let-values ([(ns) (make-namespace)]
(let-values ([(ns) (make-empty-namespace)]
[(cns) (current-namespace)])
(namespace-attach-module cns ''#%builtin ns)
ns)))

5
collects/setup/scribble-index.ss
View File

@ -8,7 +8,6 @@
scheme/class
setup/getinfo
setup/dirs
syntax/namespace-reflect
mzlib/serialize
scheme/file)
@ -30,7 +29,7 @@
(define-struct doc (source dest))
(define-reflection-anchor here)
(define-namespace-anchor here)
(define (load-xref)
(let* ([renderer (new (html:render-mixin render%)
@ -64,7 +63,7 @@
dirs)))]
[ci (send renderer collect null null)])
(map (lambda (doc)
(parameterize ([current-namespace (reflection-anchor->namespace here)])
(parameterize ([current-namespace (namespace-anchor->empty-namespace here)])
(with-handlers ([exn:fail? (lambda (exn) exn)])
(let ([r (with-input-from-file (build-path (doc-dest doc) "xref-out.ss")
read)])

7
collects/setup/scribble.ss
View File

@ -7,7 +7,6 @@
setup/main-collects
scribble/base-render
scribble/struct
syntax/namespace-reflect
scribble/manual ; really shouldn't be here... see dynamic-require-doc
(prefix-in html: scribble/html-render)
(prefix-in latex: scribble/latex-render))
@ -367,17 +366,17 @@
(set-info-time! info (/ (current-inexact-milliseconds) 1000))
(void)))))))))
(define-reflection-anchor anchor)
(define-namespace-anchor anchor)
(define (dynamic-require-doc path)
;; Use a separate namespace so that we don't end up with all the documentation
;; loaded at once.
;; Use a custodian to compensate for examples executed during the build
;; that may not be entirely clean (e.g., leaves a stuck thread).
(let ([p (make-namespace)]
(let ([p (make-empty-namespace)]
[c (make-custodian)]
[ch (make-channel)]
[ns (reflection-anchor->namespace anchor)])
[ns (namespace-anchor->empty-namespace anchor)])
(parameterize ([current-custodian c])
(namespace-attach-module ns 'scribble/base-render p)
(namespace-attach-module ns 'scribble/html-render p)

28
collects/setup/setup-unit.ss
View File

@ -14,8 +14,6 @@
mzlib/process
planet/planet-archives
planet/private/planet-shared
scheme/namespace
syntax/namespace-reflect
"option-sig.ss"
compiler/sig
@ -28,7 +26,7 @@
"dirs.ss"
"main-collects.ss")
(define-reflection-anchor anchor)
(define-namespace-anchor anchor)
(provide setup@)
@ -582,7 +580,7 @@
;; already loaded, create a fresh namespace before calling
;; this function.
;; To avoid keeping modules in memory across collections,
;; pass `make-namespace' as `get-namespace', otherwise use
;; pass `make-base-namespace' as `get-namespace', otherwise use
;; `current-namespace' for `get-namespace'.
(for-each (lambda (cc)
(parameterize ([current-namespace (get-namespace)])
@ -625,8 +623,8 @@
(dynamic-require `(lib "zo-compile.ss" ,(compile-mode)) 'zo-compile))]
[orig-kinds (use-compiled-file-paths)]
[orig-compile (current-compile)]
[orig-namespace (reflection-anchor->namespace anchor)])
(parameterize ([current-namespace (make-base-namespace)]
[orig-namespace (namespace-anchor->empty-namespace anchor)])
(parameterize ([current-namespace (make-base-empty-namespace)]
[current-compile zo-compile]
[use-compiled-file-paths (list mode-dir)]
[current-compiler-dynamic-require-wrapper
@ -665,7 +663,7 @@
(directory-list c))))))
;; Make .zos
(compile-directory-zos dir info))
make-base-namespace))))
make-base-empty-namespace))))
(when (make-so) (make-it "extensions" compile-directory-extension current-namespace))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -773,11 +771,17 @@
(when (make-docs)
(setup-printf "Building documentation")
(doc:verbose (verbose))
(doc:setup-scribblings (if (and (null? x-specific-collections)
(null? x-specific-planet-dirs))
#f
(map cc-path ccs-to-compile))
#f))
(with-handlers ([exn:fail? (lambda (exn)
(setup-printf
"Docs failure: ~a"
(if (exn? exn)
(exn-message exn)
exn)))])
(doc:setup-scribblings (if (and (null? x-specific-collections)
(null? x-specific-planet-dirs))
#f
(map cc-path ccs-to-compile))
#f)))
(when (doc-pdf-dest)
(setup-printf "Building PDF documentation (via pdflatex)")

30
collects/syntax/namespace-reflect.ss
View File

@ -1,30 +0,0 @@
(module namespace-reflect scheme/base
(require (for-syntax scheme/base))
(provide define-reflection-anchor
reflection-anchor->namespace)
(define-syntax (define-reflection-anchor stx)
(unless (memq (syntax-local-context) '(top-level module))
(raise-syntax-error #f
"allowed only in a top-level or module context"
stx))
(syntax-case stx ()
[(_ id)
(let ([id-stx #'id])
(unless (identifier? id-stx)
(raise-syntax-error #f
"expected an identifier"
stx
id-stx))
#'(define id (make-reflection-anchor (#%variable-reference id))))]))
(define-struct reflection-anchor (var))
(define (reflection-anchor->namespace ra)
(unless (reflection-anchor? ra)
(raise-type-error 'reflection-anchor->namespace
"reflection anchor"
ra))
(variable-reference-namespace (reflection-anchor-var ra))))

1
collects/tests/mzscheme/contract-test.ss
View File

@ -9,7 +9,6 @@
(define contract-namespace
(let ([n (make-base-namespace)])
(parameterize ([current-namespace n])
(namespace-require 'scheme/base)
(namespace-require '(for-syntax scheme/base))
(namespace-require '(for-template scheme/base))
(namespace-require 'scheme/contract)

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

@ -82,8 +82,6 @@
(arity-test namespace-undefine-variable! 1 2)
(define n (make-base-namespace))
(parameterize ([current-namespace n])
(namespace-require 'scheme/base))
(test #t 'same-with-arg-and-param
((lambda (a b)
(and (andmap (lambda (ai) (memq ai b)) a)

1
collects/tests/mzscheme/optimize.ss
View File

@ -10,7 +10,6 @@
;; Check JIT inlining of primitives:
(parameterize ([current-namespace (make-base-namespace)]
[eval-jit-enabled #t])
(namespace-require 'scheme/base)
(let* ([check-error-message (lambda (name proc)
(unless (memq name '(eq? not null? pair?
real? number? boolean?

5
collects/tests/mzscheme/param.ss
View File

@ -295,10 +295,7 @@
#f)
(list current-namespace
(list (let ([n (make-base-namespace)])
(parameterize ([current-namespace n])
(namespace-require 'scheme/base))
n)
(list (make-base-namespace)
(make-namespace))
'(begin 0)
exn:fail:syntax?

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

@ -846,7 +846,7 @@
(let ()
(define n (current-namespace))
(define n2 (make-base-namespace))
(define n2 (make-empty-base-namespace))
(define i (make-inspector))
@ -1070,7 +1070,6 @@
(let ([go-once
(lambda (eval)
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(eval '(module mm scheme/base
(require (for-syntax scheme/base))
(define-syntax (define$ stx)
@ -1092,7 +1091,6 @@
(test '(1 2 7 8) eval '(list a b c d)))
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(eval '(module mm scheme/base
(require (for-syntax scheme/base))
(define-syntax (define$ stx)
@ -1176,7 +1174,6 @@
(test #f 'load-ok load?))
(make-resolved-module-path 'a))
(old name base stx load?))])])
(namespace-require 'scheme/base)
(let ([a-code '(module a scheme/base
(provide x y)
(define x 1)
@ -1193,7 +1190,6 @@
(parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes p))))))]
[x-id (parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(printf "here\n")
(eval a-code)
(eval '(require 'a))
@ -1207,7 +1203,6 @@
(test #t eval '(free-identifier=? (f) #'x))
(test #t eval `(free-identifier=? (f) (quote-syntax ,x-id)))
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(eval '(module a scheme/base
(provide y)
(define y 3)))

1
collects/tests/mzscheme/unit.ss
View File

@ -599,7 +599,6 @@
(test 55 'namespace
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(namespace-variable-bind/invoke-unit
(x)
(unit

1
collects/tests/mzscheme/unitsig.ss
View File

@ -608,7 +608,6 @@
(test 120
'namespace
(parameterize ([current-namespace (make-base-namespace)])
(namespace-require 'scheme/base)
(namespace-variable-bind/invoke-unit/sig
(foo)
(unit/sig (foo)

15
doc/release-notes/mzscheme/MzScheme_4.txt
View File

@ -339,12 +339,9 @@ with some syntactic and name changes.
module-template-identifier=? -> free-template-identifier=?
module-label-identifier=? -> free-label-identifier=?
* The `make-namespace' function always creates an empty
namespace. The `make-base-namespace' function from the
`scheme/namespace' library creates a namespace to which
`scheme/base' is attached, but not required into the top-level
environment.
See also the new `syntax/reflect-namespace' library, which provides
a syntactic form and function for obtaining a namespace for the
enclosing module.
* Instead of `make-namespace': `make-empty-namespace' always creates
an empty namespace; `make-empty-base-namespace' creates a namespace
to which `scheme/base' is attached, but not required into the
top-level environment; `make-base-namespace' function creates a
namespace where `scheme/base' is `require'd into the top-level
environment. See also `define-namespace-anchor'.

2
src/mzscheme/gc2/setup.ss
View File

@ -78,7 +78,7 @@
(let ([mk-cm make-compilation-manager-load/use-compiled-handler]
[old-namespace (current-namespace)])
(current-namespace (make-namespace))
(current-namespace (make-empty-namespace))
(namespace-attach-module old-namespace ''#%builtin)
(use-compiled-file-paths (list "compiled"))
(current-load/use-compiled (mk-cm))

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

@ -1,13 +1,13 @@
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,50,50,0,0,0,1,0,0,6,0,9,
0,14,0,18,0,23,0,28,0,32,0,39,0,52,0,55,0,62,0,69,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,51,50,0,0,0,1,0,0,6,0,9,
0,14,0,18,0,23,0,36,0,41,0,45,0,52,0,55,0,62,0,69,0,
78,0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,
0,177,0,179,0,193,0,203,0,209,0,227,0,26,1,36,1,53,1,86,1,
119,1,178,1,223,1,45,2,90,2,95,2,115,2,245,2,9,3,57,3,123,
3,6,4,148,4,191,4,202,4,25,5,0,0,29,7,0,0,65,98,101,103,
105,110,29,11,11,64,108,101,116,42,63,108,101,116,64,119,104,101,110,64,99,
111,110,100,63,97,110,100,66,108,101,116,114,101,99,72,112,97,114,97,109,101,
116,101,114,105,122,101,62,111,114,66,100,101,102,105,110,101,66,117,110,108,101,
105,110,29,11,11,64,108,101,116,42,63,108,101,116,64,119,104,101,110,72,112,
97,114,97,109,101,116,101,114,105,122,101,64,99,111,110,100,63,97,110,100,66,
108,101,116,114,101,99,62,111,114,66,100,101,102,105,110,101,66,117,110,108,101,
115,115,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,
68,35,37,112,97,114,97,109,122,11,29,94,2,14,68,35,37,107,101,114,110,
101,108,11,62,105,102,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,
@ -17,7 +17,7 @@
95,8,240,48,117,0,0,11,16,0,95,8,193,11,16,0,96,35,11,93,158,
2,16,34,16,2,2,13,159,2,2,35,2,13,97,10,34,11,94,158,2,15,
34,158,2,16,34,16,20,2,10,2,2,2,3,2,2,2,4,2,2,2,5,
2,2,2,6,2,2,2,7,2,2,2,9,2,2,2,8,2,2,2,11,2,
2,2,2,6,2,2,2,7,2,2,2,8,2,2,2,9,2,2,2,11,2,
2,2,12,2,2,13,16,4,34,29,11,11,2,2,11,18,98,64,104,101,114,
101,8,31,8,30,8,29,8,28,8,27,27,248,22,174,3,195,249,22,167,3,
80,158,37,34,251,22,73,2,17,248,22,88,199,12,249,22,63,2,1,248,22,
@ -25,15 +25,15 @@
248,22,88,199,249,22,63,2,1,248,22,90,201,12,27,248,22,65,248,22,174,
3,196,28,248,22,71,193,20,15,159,35,34,35,28,248,22,71,248,22,65,194,
248,22,64,193,249,22,167,3,80,158,37,34,251,22,73,2,17,248,22,64,199,
249,22,63,2,7,248,22,65,201,11,18,100,10,8,31,8,30,8,29,8,28,
8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,55,56,16,4,11,
11,2,19,3,1,7,101,110,118,55,51,55,57,27,248,22,65,248,22,174,3,
249,22,63,2,8,248,22,65,201,11,18,100,10,8,31,8,30,8,29,8,28,
8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,56,50,16,4,11,
11,2,19,3,1,7,101,110,118,55,51,56,51,27,248,22,65,248,22,174,3,
196,28,248,22,71,193,20,15,159,35,34,35,28,248,22,71,248,22,65,194,248,
22,64,193,249,22,167,3,80,158,37,34,250,22,73,2,20,248,22,73,249,22,
73,248,22,73,2,21,248,22,64,201,251,22,73,2,17,2,21,2,21,249,22,
63,2,10,248,22,65,204,18,100,11,8,31,8,30,8,29,8,28,8,27,16,
4,11,11,2,18,3,1,7,101,110,118,55,51,56,49,16,4,11,11,2,19,
3,1,7,101,110,118,55,51,56,50,248,22,174,3,193,27,248,22,174,3,194,
4,11,11,2,18,3,1,7,101,110,118,55,51,56,53,16,4,11,11,2,19,
3,1,7,101,110,118,55,51,56,54,248,22,174,3,193,27,248,22,174,3,194,
249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22,65,248,22,174,
3,196,249,22,167,3,80,158,37,34,28,248,22,51,248,22,168,3,248,22,64,
197,27,249,22,2,32,0,89,162,8,36,35,41,9,222,33,39,248,22,174,3,
@ -57,12 +57,12 @@
65,248,22,174,3,196,28,248,22,71,193,20,15,159,35,34,35,249,22,167,3,
80,158,37,34,27,248,22,174,3,248,22,64,197,28,249,22,137,8,62,61,62,
248,22,168,3,248,22,88,196,250,22,73,2,20,248,22,73,249,22,73,21,93,
2,25,248,22,64,199,250,22,74,2,6,249,22,73,2,25,249,22,73,248,22,
2,25,248,22,64,199,250,22,74,2,7,249,22,73,2,25,249,22,73,248,22,
97,203,2,25,248,22,65,202,251,22,73,2,17,28,249,22,137,8,248,22,168,
3,248,22,64,200,64,101,108,115,101,10,248,22,64,197,250,22,74,2,20,9,
248,22,65,200,249,22,63,2,6,248,22,65,202,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,52,48,52,16,4,
11,11,2,19,3,1,7,101,110,118,55,52,48,53,18,158,94,10,64,118,111,
248,22,65,200,249,22,63,2,7,248,22,65,202,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,52,48,56,16,4,
11,11,2,19,3,1,7,101,110,118,55,52,48,57,18,158,94,10,64,118,111,
105,100,8,47,27,248,22,65,248,22,174,3,196,249,22,167,3,80,158,37,34,
28,248,22,51,248,22,168,3,248,22,64,197,250,22,73,2,26,248,22,73,248,
22,64,199,248,22,88,198,27,248,22,168,3,248,22,64,197,250,22,73,2,26,
@ -77,17 +77,17 @@
20,102,159,34,16,0,16,1,33,32,10,16,5,93,2,12,89,162,8,36,35,
51,9,223,0,33,33,34,20,102,159,34,16,1,20,25,159,35,2,2,2,13,
16,0,11,16,5,93,2,5,89,162,8,36,35,51,9,223,0,33,34,34,20,
102,159,34,16,1,20,25,159,35,2,2,2,13,16,0,11,16,5,93,2,7,
102,159,34,16,1,20,25,159,35,2,2,2,13,16,0,11,16,5,93,2,8,
89,162,8,36,35,51,9,223,0,33,35,34,20,102,159,34,16,1,20,25,159,
35,2,2,2,13,16,1,33,36,11,16,5,93,2,10,89,162,8,36,35,54,
9,223,0,33,37,34,20,102,159,34,16,1,20,25,159,35,2,2,2,13,16,
1,33,38,11,16,5,93,2,4,89,162,8,36,35,56,9,223,0,33,41,34,
20,102,159,34,16,1,20,25,159,35,2,2,2,13,16,0,11,16,5,93,2,
8,89,162,8,36,35,51,9,223,0,33,43,34,20,102,159,34,16,1,20,25,
9,89,162,8,36,35,51,9,223,0,33,43,34,20,102,159,34,16,1,20,25,
159,35,2,2,2,13,16,0,11,16,5,93,2,3,89,162,8,36,35,52,9,
223,0,33,44,34,20,102,159,34,16,1,20,25,159,35,2,2,2,13,16,0,
11,16,5,93,2,9,89,162,8,36,35,53,9,223,0,33,45,34,20,102,159,
34,16,1,20,25,159,35,2,2,2,13,16,0,11,16,5,93,2,6,89,162,
11,16,5,93,2,6,89,162,8,36,35,53,9,223,0,33,45,34,20,102,159,
34,16,1,20,25,159,35,2,2,2,13,16,0,11,16,5,93,2,7,89,162,
8,36,35,56,9,223,0,33,46,34,20,102,159,34,16,1,20,25,159,35,2,
2,2,13,16,1,33,48,11,16,5,93,2,11,89,162,8,36,35,52,9,223,
0,33,49,34,20,102,159,34,16,1,20,25,159,35,2,2,2,13,16,0,11,
@ -95,7 +95,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 1943);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,50,61,0,0,0,1,0,0,3,0,16,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,51,61,0,0,0,1,0,0,3,0,16,
0,21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169,0,
200,0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1,112,
1,157,1,202,1,226,1,9,2,11,2,20,2,71,2,87,3,96,3,126,3,
@ -298,7 +298,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 4179);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,50,7,0,0,0,1,0,0,6,0,19,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,51,7,0,0,0,1,0,0,6,0,19,
0,34,0,48,0,62,0,76,0,0,0,245,0,0,0,65,113,117,111,116,101,
29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,110,
101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,11,
@ -315,7 +315,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 281);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,50,52,0,0,0,1,0,0,3,0,14,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,51,46,57,57,46,48,46,51,52,0,0,0,1,0,0,3,0,14,
0,41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184,0,
200,0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1,74,
1,82,1,163,1,199,1,216,1,245,1,17,2,47,2,57,2,87,2,97,2,

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

@ -76,7 +76,9 @@ static Scheme_Object *namespace_set_variable_value(int, Scheme_Object *[]);
static Scheme_Object *namespace_undefine_variable(int, Scheme_Object *[]);
static Scheme_Object *namespace_mapped_symbols(int, Scheme_Object *[]);
static Scheme_Object *namespace_module_registry(int, Scheme_Object *[]);
static Scheme_Object *variable_module_path(int, Scheme_Object *[]);
static Scheme_Object *variable_namespace(int, Scheme_Object *[]);
static Scheme_Object *variable_top_level_namespace(int, Scheme_Object *[]);
static Scheme_Object *now_transforming(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_exp_time_value(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_exp_time_name(int argc, Scheme_Object *argv[]);
@ -510,9 +512,19 @@ static void make_init_env(void)
1, 1),
env);
scheme_add_global_constant("variable-reference-namespace",
scheme_add_global_constant("variable-reference->resolved-module-path",
scheme_make_prim_w_arity(variable_module_path,
"variable-reference->resolved-module-path",
1, 1),
env);
scheme_add_global_constant("variable-reference->empty-namespace",
scheme_make_prim_w_arity(variable_namespace,
"variable-reference-namespace",
"variable-reference->empty-namespace",
1, 1),
env);
scheme_add_global_constant("variable-reference->top-level-namespace",
scheme_make_prim_w_arity(variable_top_level_namespace,
"variable-reference->top-level-namespace",
1, 1),
env);
@ -3759,7 +3771,46 @@ static Scheme_Object *namespace_module_registry(int argc, Scheme_Object **argv)
return (Scheme_Object *)((Scheme_Env *)argv[0])->module_registry;
}
static Scheme_Object *do_variable_namespace(const char *who, int tl, int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
Scheme_Env *env;
int ph;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_global_ref_type))
env = NULL;
else {
v = SCHEME_PTR_VAL(argv[0]);
env = ((Scheme_Bucket_With_Home *)v)->home;
if (tl && env->module) {
env = NULL;
} else {
ph = env->phase;
while (ph--) {
env = env->template_env;
}
}
}
if (!env)
scheme_wrong_type(who,
(tl ? "top-level variable-reference" : "variable-reference"),
0, argc, argv);
return (Scheme_Object *)make_env(env, 0, 0);
}
static Scheme_Object *variable_namespace(int argc, Scheme_Object *argv[])
{
return do_variable_namespace("variable-reference->empty-namespace", 0, argc, 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);
}
static Scheme_Object *variable_module_path(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
Scheme_Env *env;
@ -3769,14 +3820,15 @@ static Scheme_Object *variable_namespace(int argc, Scheme_Object *argv[])
else {
v = SCHEME_PTR_VAL(argv[0]);
env = ((Scheme_Bucket_With_Home *)v)->home;
if (env->phase)
env = NULL;
}
if (!env)
scheme_wrong_type("variable-reference-namespace", "variable-reference (phase 0)", 0, argc, argv);
scheme_wrong_type("variable-reference->resolved-module-path", "variable-reference", 0, argc, argv);
return (Scheme_Object *)env;
if (env->module)
return env->module->modname;
else
return scheme_false;
}
static Scheme_Object *

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

@ -2039,18 +2039,12 @@ static int add_require_renames(Scheme_Object *rn, Scheme_Object *et_rn, Scheme_O
return add_initial_require_renames(NULL, rn, NULL, et_rn, NULL, dt_rn, NULL, im, idx);
}
static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
{
Scheme_Env *menv, *env;
Scheme_Object *modchain, *name;
Scheme_Env *menv;
Scheme_Object *modchain;
env = scheme_get_env(NULL);
if (!SCHEME_PATHP(argv[0])
&& !scheme_is_module_path(argv[0]))
scheme_wrong_type("module->namespace", "path or module-path", 0, argc, argv);
name = scheme_module_resolve(scheme_make_modidx(argv[0], scheme_false, scheme_false), 1);
name = scheme_module_resolve(scheme_make_modidx(name, scheme_false, scheme_false), 1);
modchain = env->modchain;
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(modchain), name);
@ -2148,7 +2142,7 @@ static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
}
if (menv->lazy_syntax)
finish_expstart_module(menv, 1, 0, scheme_null);
finish_expstart_module_in_namespace(menv, env);
if (!menv->et_ran)
scheme_run_module_exptime(menv, 1);
scheme_prepare_exp_env(menv);
@ -2297,6 +2291,20 @@ static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
return (Scheme_Object *)menv;
}
static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
{
Scheme_Env *env;
env = scheme_get_env(NULL);
if (!SCHEME_PATHP(argv[0])
&& !scheme_is_module_path(argv[0]))
scheme_wrong_type("module->namespace", "path or module-path", 0, argc, argv);
return scheme_module_to_namespace(argv[0], env);
}
static Scheme_Object *module_compiled_p(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;

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

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 887
#define EXPECTED_PRIM_COUNT 889
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

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

@ -2513,6 +2513,8 @@ Scheme_Object *scheme_module_exported_list(Scheme_Object *modpath, Scheme_Env *g
void scheme_run_module(Scheme_Env *menv, int set_ns);
void scheme_run_module_exptime(Scheme_Env *menv, int set_ns);
Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env);
/*========================================================================*/
/* errors and exceptions */
/*========================================================================*/

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

@ -10,12 +10,12 @@
The string and the separate X/Y/Z/W numbers must
be updated consistently. */
#define MZSCHEME_VERSION "3.99.0.2"
#define MZSCHEME_VERSION "3.99.0.3"
#define MZSCHEME_VERSION_X 3
#define MZSCHEME_VERSION_Y 99
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -455,9 +455,9 @@ void scheme_init_thread(Scheme_Env *env)
scheme_add_global_constant("make-namespace",
scheme_add_global_constant("make-empty-namespace",
scheme_make_prim_w_arity(scheme_make_namespace,
"make-namespace",
"make-empty-namespace",
0, 0),
env);