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

fix module->namespace problem, add link to bug report page, fix tests

Browse Source 
svn: r8470
This commit is contained in:
Matthew Flatt 2008-01-30 00:21:24 +00:00
parent 99818355f7
commit 4c23a44fd5
10 changed files with 85 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/lazy/lang/reader.ss Normal file
View File

@ -0,0 +1,2 @@
(module reader syntax/module-reader
lazy)

12
collects/scheme/enter.ss
View File

@ -44,8 +44,10 @@
;; Reload anything that's not up to date:
(check-latest mod))
(define (notify re? path)
(fprintf (current-error-port) " [~aloading ~a]\n" (if re? "re-" "") path))
(define ((enter-load/use-compiled orig re?) path name)
(fprintf (current-error-port) " [~aloading ~a]\n" (if re? "re-" "") path)
(if name
;; Module load:
(let ([code (get-module-code path
@ -55,7 +57,9 @@
(compile e)))
(lambda (ext loader?)
(load-extension ext)
#f))]
#f)
#:notify (lambda (chosen)
(notify re? chosen)))]
[path (normal-case-path
(simplify-path
(path->complete-path path
@ -71,7 +75,9 @@
;; Evaluate the module:
(eval code))
;; Not a module:
(orig path name)))
(begin
(notify re? path)
(orig path name))))
(define (get-timestamp path)
(file-or-directory-modify-seconds path #f (lambda () -inf.0)))

4
collects/scribblings/release/release.scrbl
View File

@ -8,11 +8,11 @@
@title{Release Notes}
@itemize{
@itemize[#:style "compact"]{
@item{@rl-link['("drscheme" "HISTORY.txt")]{DrScheme}}
@item{@rl-link['("mzscheme" "HISTORY.txt")]{MzScheme}
@itemize{
@itemize[#:style "compact"]{
@item{@rl-link['("mzscheme" "MzScheme_4.txt")]{Porting from v3xx to v4.x}}
@item{@rl-link['("mzscheme" "MzScheme_300.txt")]{Porting from v2xx to v3xx}}
@item{@rl-link['("mzscheme" "MzScheme_200.txt")]{Porting from v1xx to v2xx}}

17
collects/scribblings/start/manuals.ss
View File

@ -45,6 +45,12 @@
(make-element "tocsubseclink"
(list label))))))
(define (make-spacer)
(make-toc-element
#f
null
(list 'nbsp)))
(define (build-contents all?)
(let* ([dirs (find-relevant-directories '(scribblings))]
[infos (map get-info/full dirs)]
@ -136,13 +142,14 @@
(to-toc "master-index/index.html"
"Master Index")
(make-toc-element
#f
null
(list 'nbsp))
(make-spacer)
(to-toc (build-path (find-doc-dir) "license/index.html")
"License")
(to-toc (build-path (find-doc-dir) "acks/index.html")
"Acknowledgments")
(to-toc (build-path (find-doc-dir) "release/index.html")
"Release Notes")))))
"Release Notes")
(make-spacer)
(to-toc (format "http://bugs.plt-scheme.org/?v=~a" (version))
"Report a Bug")))))

6
collects/syntax/doc.txt
View File

@ -328,7 +328,8 @@ _modcode.ss_: getting module compiled code
======================================================================
> (get-module-code path [compiled-subdir compile-proc ext-proc]
[#:choose choose-proc]) -
[#:choose choose-proc]
[#:notify notify-proc]) -
returns a compiled expression for the declaration of the module
specified by `module-path-v'. The `module-path-v' argument is a
quoted module path, as for MzScheme's `dynamic-require' using the
@ -366,6 +367,9 @@ _modcode.ss_: getting module compiled code
raised (to report that an extension file cannot be used) when
`ext-proc' is #f.
If `notify-proc' is supplied, it is called for the file (source,
".zo" or extension) that is chosen.
> moddep-current-open-input-file
A parameter whose value is used like `open-input-file' to read a

17
collects/syntax/modcode.ss
View File

@ -67,7 +67,8 @@
(define (get-module-code path
[sub-path "compiled"] [compiler compile] [extension-handler #f]
#:choose [choose (lambda (src zo so) #f)])
#:choose [choose (lambda (src zo so) #f)]
#:notify [notify void])
(unless (path-string? path)
(raise-type-error 'get-module-code "path or string (sans nul)" path))
(let*-values ([(path) (resolve path)]
@ -95,6 +96,7 @@
[(or (eq? prefer 'zo)
(and (not prefer)
(date>=? zo path-d)))
(notify zo)
(read-one path zo #f)]
;; Maybe there's an .so? Use it only if we don't prefer source.
[(or (eq? prefer 'so)
@ -102,14 +104,17 @@
(or (not path-d)
(date>=? so path-d))))
(if extension-handler
(extension-handler so #f)
(raise (make-exn:get-module-code
(format "get-module-code: cannot use extension file; ~e" so)
(current-continuation-marks)
so)))]
(begin
(notify so)
(extension-handler so #f))
(raise (make-exn:get-module-code
(format "get-module-code: cannot use extension file; ~e" so)
(current-continuation-marks)
so)))]
;; Use source if it exists
[(or (eq? prefer 'src)
path-d)
(notify path)
(with-dir (lambda () (compiler (read-one path path #t))))]
;; Report a not-there error
[else (raise (make-exn:get-module-code

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

@ -299,7 +299,8 @@
(test #f immutable? (list* 1 null))
(test #f immutable? (list* 1 2 null))
(test #f immutable? 1)
(test #f immutable? #(1 2 3))
(test #t immutable? #(1 2 3))
(test #f immutable? (vector 1 2 3))
(test #f immutable? #())
(test #f immutable? (string-copy "hi"))
@ -1289,7 +1290,7 @@
(err/rt-test (vector-set! #(1 2 3) (expt 2 100) 'x) exn:application:mismatch?)
(err/rt-test (vector-set! '(1 2 3) 2 'x))
(err/rt-test (vector-set! #(1 2 3) "2" 'x))
(define v (quote #(1 2 3)))
(define v (vector 1 2 3))
(vector-fill! v 0)
(test (quote #(0 0 0)) 'vector-fill! v)
(arity-test vector-fill! 2 2)

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

@ -718,7 +718,7 @@ void scheme_save_initial_module_set(Scheme_Env *env)
REGISTER_SO(initial_renames);
}
initial_renames = scheme_make_module_rename(0, mzMOD_RENAME_NORMAL, NULL);
scheme_append_module_rename(env->rename, initial_renames);
scheme_append_module_rename(env->rename, initial_renames, 1);
/* Clone variable bindings: */
if (!initial_toplevel) {
@ -752,7 +752,7 @@ void scheme_install_initial_module_set(Scheme_Env *env)
rn = scheme_make_module_rename(0, mzMOD_RENAME_TOPLEVEL, NULL);
env->rename = rn;
}
scheme_append_module_rename(initial_renames, env->rename);
scheme_append_module_rename(initial_renames, env->rename, 1);
/* Copy toplevel: */
{
@ -1127,28 +1127,28 @@ static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Obj
brn = scheme_make_module_rename(0, mzMOD_RENAME_TOPLEVEL, NULL);
env->rename = brn;
}
scheme_append_module_rename(rn, brn);
scheme_append_module_rename(rn, brn, 0);
brn = env->exp_env->rename;
if (!brn) {
brn = scheme_make_module_rename(1, mzMOD_RENAME_TOPLEVEL, NULL);
env->exp_env->rename = brn;
}
scheme_append_module_rename(et_rn, brn);
scheme_append_module_rename(et_rn, brn, 0);
brn = env->template_env->rename;
if (!brn) {
brn = scheme_make_module_rename(-1, mzMOD_RENAME_TOPLEVEL, NULL);
env->template_env->rename = brn;
}
scheme_append_module_rename(tt_rn, brn);
scheme_append_module_rename(tt_rn, brn, 0);
brn = env->dt_rename;
if (!brn) {
brn = scheme_make_module_rename(MZ_LABEL_PHASE, mzMOD_RENAME_TOPLEVEL, NULL);
env->dt_rename = brn;
}
scheme_append_module_rename(dt_rn, brn);
scheme_append_module_rename(dt_rn, brn, 0);
return scheme_void;
}
@ -2131,7 +2131,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
v = scheme_stx_to_rename(m->rn_stx);
rn = scheme_make_module_rename(0, mzMOD_RENAME_NORMAL, NULL);
scheme_append_module_rename(v, rn);
scheme_append_module_rename(v, rn, 1);
menv->rename = rn;
if (!menv->marked_names) {
Scheme_Hash_Table *mn;
@ -2207,7 +2207,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
v = scheme_stx_to_rename(m->et_rn_stx);
rn = scheme_make_module_rename(1, mzMOD_RENAME_NORMAL, NULL);
scheme_append_module_rename(v, rn);
scheme_append_module_rename(v, rn, 1);
menv->exp_env->rename = rn;
if (!menv->exp_env->marked_names) {
Scheme_Hash_Table *mn;
@ -2278,7 +2278,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
v = scheme_stx_to_rename(m->dt_rn_stx);
rn = scheme_make_module_rename(MZ_LABEL_PHASE, mzMOD_RENAME_NORMAL, NULL);
scheme_append_module_rename(v, rn);
scheme_append_module_rename(v, rn, 1);
menv->dt_rename = rn;
if (!menv->label_env->marked_names) {
Scheme_Hash_Table *mn;
@ -8100,28 +8100,28 @@ top_level_require_execute(Scheme_Object *data)
brn = scheme_make_module_rename(0, mzMOD_RENAME_TOPLEVEL, NULL);
env->rename = brn;
}
scheme_append_module_rename(rn, brn);
scheme_append_module_rename(rn, brn, 0);
brn = env->exp_env->rename;
if (!brn) {
brn = scheme_make_module_rename(1, mzMOD_RENAME_TOPLEVEL, NULL);
env->exp_env->rename = brn;
}
scheme_append_module_rename(et_rn, brn);
scheme_append_module_rename(et_rn, brn, 0);
brn = env->template_env->rename;
if (!brn) {
brn = scheme_make_module_rename(-1, mzMOD_RENAME_TOPLEVEL, NULL);
env->template_env->rename = brn;
}
scheme_append_module_rename(tt_rn, brn);
scheme_append_module_rename(tt_rn, brn, 0);
brn = env->dt_rename;
if (!brn) {
brn = scheme_make_module_rename(MZ_LABEL_PHASE, mzMOD_RENAME_TOPLEVEL, NULL);
env->dt_rename = brn;
}
scheme_append_module_rename(dt_rn, brn);
scheme_append_module_rename(dt_rn, brn, 0);
return scheme_void;
}

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

@ -675,7 +675,7 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
Scheme_Object *scheme_get_kernel_modidx(void);
void scheme_remove_module_rename(Scheme_Object *mrn,
Scheme_Object *localname);
void scheme_append_module_rename(Scheme_Object *src, Scheme_Object *dest);
void scheme_append_module_rename(Scheme_Object *src, Scheme_Object *dest, int with_unmarshal);
void scheme_list_module_rename(Scheme_Object *src, Scheme_Hash_Table *ht);
Scheme_Object *scheme_rename_to_stx(Scheme_Object *rn);

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

@ -1169,7 +1169,7 @@ void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info)
static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest,
Scheme_Object *old_midx, Scheme_Object *new_midx,
int do_pes)
int do_pes, int do_unm)
{
Scheme_Hash_Table *ht, *hts, *drop_ht;
Scheme_Object *v;
@ -1196,6 +1196,24 @@ static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest,
}
}
if (do_unm) {
if (!SCHEME_NULLP(((Module_Renames *)src)->unmarshal_info)) {
Scheme_Object *first = NULL, *last = NULL, *pr, *l;
for (l = ((Module_Renames *)src)->unmarshal_info; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
pr = scheme_make_pair(SCHEME_CAR(l), scheme_null);
if (last)
SCHEME_CDR(last) = pr;
else
first = pr;
last = pr;
}
SCHEME_CDR(last) = ((Module_Renames *)dest)->unmarshal_info;
((Module_Renames *)dest)->unmarshal_info = first;
((Module_Renames *)dest)->needs_unmarshal = 1;
}
}
for (t = 0; t < 2; t++) {
if (!t) {
ht = ((Module_Renames *)dest)->ht;
@ -1272,9 +1290,9 @@ static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest,
}
}
void scheme_append_module_rename(Scheme_Object *src, Scheme_Object *dest)
void scheme_append_module_rename(Scheme_Object *src, Scheme_Object *dest, int do_unm)
{
do_append_module_rename(src, dest, NULL, NULL, 1);
do_append_module_rename(src, dest, NULL, NULL, 1, do_unm);
}
void scheme_remove_module_rename(Scheme_Object *mrn,
@ -1346,7 +1364,7 @@ Scheme_Object *scheme_stx_shift_rename(Scheme_Object *mrn,
nmrn = scheme_make_module_rename(0, mzMOD_RENAME_NORMAL, NULL);
/* use "append" to copy most info: */
do_append_module_rename(mrn, nmrn, old_midx, new_midx, 0);
do_append_module_rename(mrn, nmrn, old_midx, new_midx, 0, 0);
/* Manually copy unmarshal_infos, where we have to shift anyway: */
@ -1371,7 +1389,11 @@ Scheme_Object *scheme_stx_shift_rename(Scheme_Object *mrn,
l = SCHEME_CDR(l);
}
((Module_Renames *)nmrn)->shared_pes = nl;
if (((Module_Renames *)mrn)->needs_unmarshal) {
((Module_Renames *)nmrn)->needs_unmarshal = 1;
}
return nmrn;
}