preserve submoduleness in module path index for expanded submodules
The preserved path is exposed by a new `module-path-index-submodule' function, and `module-path-index-join' now accepts an optional submodule path. Also, fixed a problem with `collapse-module-path-index' when a module path indx is built on a resolved module path that is a submodule path. In addition to the main repair, `collapse-module-path[-index]' is correctly documented to allow '(quote <sym>) rel-to paths. Finally, `collapse-module-path-index' changed to use a symbolic resolved module path that appears as the base of a module path index, rather than falling back to the given rel-to path. It's possble that the old beavior was intentional, but it wasn't tested, and it seems more likely to have been a bug. Closes PR 12724
This commit is contained in:
Matthew Flatt
parent
3c615e434b
commit
9ba663aa77
|
|
@ -28,7 +28,7 @@ Returns @racket[#f] if @racket[v] is a @tech{resolved module path},
|
|||
(and/c path? complete-path?)
|
||||
(cons/c (or/c symbol?
|
||||
(and/c path? complete-path?))
|
||||
(cons/c symbol? (listof symbol?))))])
|
||||
(non-empty-listof symbol?)))])
|
||||
resolved-module-path?]{
|
||||
|
||||
Returns a @tech{resolved module path} that encapsulates @racket[path],
|
||||
|
|
@ -47,7 +47,7 @@ A @tech{resolved module path} is interned. That is, if two
|
|||
(and/c path? complete-path?)
|
||||
(cons/c (or/c symbol?
|
||||
(and/c path? complete-path?))
|
||||
(cons/c symbol? (listof symbol?))))]{
|
||||
(non-empty-listof symbol?)))]{
|
||||
|
||||
Returns the path or symbol encapsulated by a @tech{resolved module path}.
|
||||
A list result corresponds to a @tech{submodule} path.}
|
||||
|
|
@ -196,8 +196,9 @@ path index}. If the identifier is instead defined in a module that is
|
|||
imported via a module path (as opposed to a literal module name), then
|
||||
the identifier's source module will be reported using a @tech{module
|
||||
path index} that contains the @racket[require]d module path and the
|
||||
``self'' @tech{module path index}.
|
||||
|
||||
``self'' @tech{module path index}. A ``self'' @tech{module path index}
|
||||
has a submodule path when the module that it refers to is a
|
||||
@tech{submodule}.
|
||||
|
||||
A @tech{module path index} has state. When it is @deftech{resolved} to
|
||||
a @tech{resolved module path}, then the @tech{resolved module path} is
|
||||
|
|
@ -234,8 +235,9 @@ resolved name can depend on the value of
|
|||
(values (or/c module-path? #f)
|
||||
(or/c module-path-index? resolved-module-path? #f))]{
|
||||
|
||||
Returns two values: a module path, and a base @tech{module path index}
|
||||
or @racket[#f] to which the module path is relative.
|
||||
Returns two values: a module path, and a base path---either a
|
||||
@tech{module path index}, @tech{resolved module path}, or
|
||||
@racket[#f]---to which the first path is relative.
|
||||
|
||||
A @racket[#f] second result means that the path is relative to an
|
||||
unspecified directory (i.e., its resolution depends on the value of
|
||||
|
|
@ -244,15 +246,29 @@ unspecified directory (i.e., its resolution depends on the value of
|
|||
|
||||
A @racket[#f] for the first result implies a @racket[#f] for the
|
||||
second result, and means that @racket[mpi] represents ``self'' (see
|
||||
above).}
|
||||
above). Such a @tech{module path index} may have a non-@racket[#f]
|
||||
submodule path as reported by @racket[module-path-index-submodule].}
|
||||
|
||||
|
||||
@defproc[(module-path-index-submodule [mpi module-path-index?])
|
||||
(or/c #f (non-empty-listof symbol?))]{
|
||||
|
||||
Returns a non-empty list of symbols if @racket[mpi] is a ``self'' (see
|
||||
above) @tech{module path index} that refers to a @tech{submodule}. The
|
||||
result is always @racket[#f] if either result of
|
||||
@racket[(module-path-index-split mpi)] is non-@racket[#f].}
|
||||
|
||||
|
||||
@defproc[(module-path-index-join [path (or/c module-path? #f)]
|
||||
[mpi (or/c module-path-index? resolved-module-path? #f)])
|
||||
[base (or/c module-path-index? resolved-module-path? #f)]
|
||||
[submod (or/c #f (non-empty-listof symbol?)) #f])
|
||||
module-path-index?]{
|
||||
|
||||
Combines @racket[path] and @racket[mpi] to create a new @tech{module
|
||||
path index}. The @racket[path] argument can @racket[#f] only if
|
||||
@racket[mpi] is also @racket[#f].}
|
||||
Combines @racket[path], @racket[base], and @racket[submod] to create a
|
||||
new @tech{module path index}. The @racket[path] argument can
|
||||
@racket[#f] only if @racket[base] is also @racket[#f]. The
|
||||
@racket[submod] argument can be a list only when @racket[path] and
|
||||
@racket[base] are both @racket[#f].}
|
||||
|
||||
@defproc[(compiled-module-expression? [v any/c]) boolean?]{
|
||||
|
||||
|
|
@ -262,9 +278,9 @@ declaration, @racket[#f] otherwise. See also
|
|||
|
||||
|
||||
@defproc*[([(module-compiled-name [compiled-module-code compiled-module-expression?])
|
||||
(or/c symbol? (cons/c symbol? (cons/c symbol? (listof symbol?))))]
|
||||
(or/c symbol? (cons/c symbol? (non-empty-listof symbol?)))]
|
||||
[(module-compiled-name [compiled-module-code compiled-module-expression?]
|
||||
[name (or/c symbol? (cons/c symbol? (cons/c symbol? (listof symbol?))))])
|
||||
[name (or/c symbol? (cons/c symbol? (non-empty-listof symbol?)))])
|
||||
compiled-module-expression?])]{
|
||||
|
||||
Takes a module declaration in compiled form and either gets the
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
(cons/c 'file any/c)
|
||||
(cons/c 'planet any/c)
|
||||
(cons/c 'quote any/c))
|
||||
(listof symbol?))))))
|
||||
(cons/c symbol? (listof symbol?)))))))
|
||||
|
||||
(define rel-to-module-path-v/c
|
||||
(or/c simple-rel-to-module-path-v/c
|
||||
|
|
|
|||
|
|
@ -118,8 +118,11 @@
|
|||
(if path
|
||||
(resolve-module-path path (resolve-possible-module-path-index base relto))
|
||||
(let ()
|
||||
(define sm (module-path-index-submodule mpi))
|
||||
(define-values (dir submod) (force-relto relto #f))
|
||||
(combine-submod (path-ss->rkt dir) submod)))))
|
||||
(combine-submod (path-ss->rkt dir) (if (and sm submod)
|
||||
(append submod sm)
|
||||
(or sm submod)))))))
|
||||
|
||||
(define (resolve-possible-module-path-index base relto)
|
||||
(cond [(module-path-index? base)
|
||||
|
|
|
|||
|
|
@ -345,11 +345,21 @@ Use syntax/modcollapse instead.
|
|||
(collapse-module-path-index base relto-mp)]
|
||||
[(resolved-module-path? base)
|
||||
(let ([n (resolved-module-path-name base)])
|
||||
(if (path? n)
|
||||
n
|
||||
(force-relto relto-mp)))]
|
||||
(if (pair? n)
|
||||
(if (path? (car n))
|
||||
(cons 'submod n)
|
||||
(list* 'submod `(quote ,(car n)) (cdr n)))
|
||||
(if (path? n)
|
||||
n
|
||||
`(quote ,n))))]
|
||||
[else (force-relto relto-mp)])))
|
||||
(force-relto relto-mp))))
|
||||
(let ([r (force-relto relto-mp)]
|
||||
[sm (module-path-index-submodule mpi)])
|
||||
(if sm
|
||||
(if (and (pair? r) (eq? (car r) 'submod))
|
||||
(append r sm)
|
||||
(list* 'submod r sm))
|
||||
r)))))
|
||||
|
||||
(provide collapse-module-path
|
||||
collapse-module-path-index)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,8 @@
|
|||
@defmodule[syntax/modcollapse]
|
||||
|
||||
@defproc[(collapse-module-path [module-path-v module-path?]
|
||||
[rel-to-module-path-v any/c])
|
||||
[rel-to-module-path-v (or/c module-path?
|
||||
(-> module-path?))])
|
||||
(or/c path? module-path?)]{
|
||||
|
||||
Returns a ``simplified'' module path by combining
|
||||
|
|
@ -14,13 +15,14 @@ Returns a ``simplified'' module path by combining
|
|||
latter must have one of the following forms: a @racket['(lib ....)] or
|
||||
symbol module path; a @racket['(file ....)] module path; a
|
||||
@racket['(planet ....)] module path; a @techlink[#:doc refman]{path};
|
||||
a @racket['(submod _base _symbol)] module path or @racket['(submod
|
||||
_path _symbol ...)] list; or a thunk to generate one of those.
|
||||
@racket['(@#,racket[quote] @#,racket[_symbol])];
|
||||
a @racket['(submod @#,racket[_base] @#,racket[_symbol] ...)] module path
|
||||
where @racket[_base] would be allowed; or a thunk to generate one of those.
|
||||
|
||||
The result can be a path if @racket[module-path-v] contains a path
|
||||
element that is needed for the result, or if
|
||||
@racket[rel-to-module-path-v] is a non-string path that is needed for
|
||||
the result. Similarly, the result can be @racket[submod] wrapping a
|
||||
the result. Similarly, the result can be @racket['submod] wrapping a
|
||||
path. Otherwise, the result is a module path in the sense of
|
||||
@racket[module-path?].
|
||||
|
||||
|
|
@ -32,7 +34,8 @@ base is normalized in the case of a @racket['lib] or @racket['planet]
|
|||
base.}
|
||||
|
||||
@defproc[(collapse-module-path-index [module-path-index module-path-index?]
|
||||
[rel-to-module-path-v any/c])
|
||||
[rel-to-module-path-v (or/c module-path?
|
||||
(-> module-path?))])
|
||||
(or/c path? module-path?)]{
|
||||
|
||||
Like @racket[collapse-module-path], but the input is a @techlink[#:doc
|
||||
|
|
|
|||
|
|
@ -86,6 +86,19 @@
|
|||
(when (eq? (system-path-convention-type) 'unix)
|
||||
(test (expand-user-path "~/x.rkt") resolve-module-path '(file "~/x.rkt") #f))
|
||||
|
||||
(test `(submod ,(build-path (current-directory) "x.rkt") sub2)
|
||||
resolve-module-path-index
|
||||
(module-path-index-join `(submod ".." sub2)
|
||||
(module-path-index-join #f #f '(sub1)))
|
||||
(build-path (current-directory) "x.rkt"))
|
||||
|
||||
(test `(submod ,(build-path (current-directory) "x.rkt") sub3 sub2)
|
||||
resolve-module-path-index
|
||||
(module-path-index-join `(submod ".." sub2)
|
||||
(module-path-index-join #f #f '(sub1)))
|
||||
`(submod ,(build-path (current-directory) "x.rkt") sub3))
|
||||
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; collapse-module-path[-index]
|
||||
|
||||
|
|
@ -307,6 +320,26 @@
|
|||
(err/rt-test (collapse-module-path "/apple.ss" (current-directory)))
|
||||
(err/rt-test (collapse-module-path-index "apple.ss" (current-directory)))
|
||||
|
||||
(test '(submod 'z sub2)
|
||||
collapse-module-path-index
|
||||
(module-path-index-join `(submod ".." sub2)
|
||||
(make-resolved-module-path
|
||||
'(z sub1)))
|
||||
''a)
|
||||
|
||||
(test `(submod ,(build-path (find-system-path 'temp-dir) "z") sub2)
|
||||
collapse-module-path-index
|
||||
(module-path-index-join `(submod ".." sub2)
|
||||
(make-resolved-module-path
|
||||
(list (build-path (find-system-path 'temp-dir) "z") 'sub1)))
|
||||
''a)
|
||||
|
||||
(test `(submod 'a sub2)
|
||||
collapse-module-path-index
|
||||
(module-path-index-join `(submod ".." sub2)
|
||||
(module-path-index-join #f #f '(sub1)))
|
||||
''a)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -325,6 +325,37 @@
|
|||
(module* inner-main #f
|
||||
(print-cake 20))))))
|
||||
|
||||
(syntax-case (parameterize ([current-namespace (make-base-namespace)])
|
||||
(expand
|
||||
'(module m racket/base
|
||||
(define x 0)
|
||||
(module* sub #f
|
||||
(+ x 1))))) ()
|
||||
[(_ name lang (mb (def (x1) _) (mod sub #f
|
||||
(mb_ (app cwv (lam () (app_ + x2 _))
|
||||
_)))))
|
||||
(begin
|
||||
(test #t free-identifier=? #'x1 #'x2)
|
||||
(let ([mpi (car (identifier-binding #'x2))])
|
||||
(define-values (a b) (module-path-index-split mpi))
|
||||
(test '(submod "..") values a)
|
||||
(test #t module-path-index? b)
|
||||
(define-values (ba bb) (module-path-index-split b))
|
||||
(test #f values ba)
|
||||
(test #f values bb)
|
||||
(test '(sub) module-path-index-submodule b)))])
|
||||
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(eval
|
||||
(expand
|
||||
'(module m racket
|
||||
(module X racket
|
||||
(define x 1)
|
||||
(provide x))
|
||||
(module Y racket
|
||||
(require (submod ".." X))
|
||||
(define y (add1 x)))))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; `begin-for-syntax' doesn't affect `module' with non-#f language:
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
Version 5.3.0.3
|
||||
Added module-path-index-submodule
|
||||
Changed module-path-index-join to support a submodule argument
|
||||
|
||||
Version 5.3.0.1
|
||||
ffi/unsafe: integer-type bounds consistently checked
|
||||
|
||||
|
|
|
|||
|
|
@ -171,6 +171,7 @@ typedef struct Thread_Local_Variables {
|
|||
void *retry_alloc_r1_;
|
||||
double scheme_jit_save_fp_;
|
||||
struct Scheme_Bucket_Table *starts_table_;
|
||||
struct Scheme_Bucket_Table *submodule_empty_modidx_table_;
|
||||
struct Scheme_Modidx *modidx_caching_chain_;
|
||||
struct Scheme_Object *global_shift_cache_;
|
||||
struct mz_proc_thread *proc_thread_self_;
|
||||
|
|
@ -526,6 +527,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
|
|||
#define retry_alloc_r1 XOA (scheme_get_thread_local_variables()->retry_alloc_r1_)
|
||||
#define scheme_jit_save_fp XOA (scheme_get_thread_local_variables()->scheme_jit_save_fp_)
|
||||
#define starts_table XOA (scheme_get_thread_local_variables()->starts_table_)
|
||||
#define submodule_empty_modidx_table XOA (scheme_get_thread_local_variables()->submodule_empty_modidx_table_)
|
||||
#define modidx_caching_chain XOA (scheme_get_thread_local_variables()->modidx_caching_chain_)
|
||||
#define global_shift_cache XOA (scheme_get_thread_local_variables()->global_shift_cache_)
|
||||
#define proc_thread_self XOA (scheme_get_thread_local_variables()->proc_thread_self_)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -71,6 +71,7 @@ static Scheme_Object *module_path_index_p(int argc, Scheme_Object *argv[]);
|
|||
static Scheme_Object *module_path_index_resolve(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *module_path_index_split(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *module_path_index_join(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *module_path_index_submodule(int argc, Scheme_Object *argv[]);
|
||||
|
||||
static Scheme_Object *is_module_path(int argc, Scheme_Object **argv);
|
||||
|
||||
|
|
@ -227,6 +228,7 @@ READ_ONLY static Scheme_Object *empty_self_modname;
|
|||
|
||||
THREAD_LOCAL_DECL(static Scheme_Object *empty_self_shift_cache);
|
||||
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *starts_table);
|
||||
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *submodule_empty_modidx_table);
|
||||
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
|
||||
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *place_local_modpath_table);
|
||||
#endif
|
||||
|
|
@ -321,6 +323,8 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob
|
|||
Scheme_Object **exsnoms,
|
||||
int start, int count, int do_uninterned);
|
||||
|
||||
static Scheme_Object *get_submodule_empty_self_modidx(Scheme_Object *submodule_path);
|
||||
|
||||
#define MODCHAIN_TABLE(p) ((Scheme_Hash_Table *)(SCHEME_VEC_ELS(p)[0]))
|
||||
#define MODCHAIN_AVAIL(p, n) (SCHEME_VEC_ELS(p)[3+n])
|
||||
|
||||
|
|
@ -426,7 +430,8 @@ void scheme_init_module(Scheme_Env *env)
|
|||
GLOBAL_FOLDING_PRIM("module-path-index?", module_path_index_p, 1, 1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY("module-path-index-resolve", module_path_index_resolve, 1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY2("module-path-index-split", module_path_index_split, 1, 1, 2, 2, env);
|
||||
GLOBAL_PRIM_W_ARITY("module-path-index-join", module_path_index_join, 2, 2, env);
|
||||
GLOBAL_PRIM_W_ARITY("module-path-index-submodule", module_path_index_submodule,1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY("module-path-index-join", module_path_index_join, 2, 3, env);
|
||||
GLOBAL_FOLDING_PRIM("resolved-module-path?", resolved_module_path_p, 1, 1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY("make-resolved-module-path", make_resolved_module_path, 1, 1, env);
|
||||
GLOBAL_PRIM_W_ARITY("resolved-module-path-name", resolved_module_path_name, 1, 1, env);
|
||||
|
|
@ -3296,9 +3301,52 @@ static Scheme_Object *module_path_index_join(int argc, Scheme_Object *argv[])
|
|||
argv[1]);
|
||||
}
|
||||
|
||||
if (argc > 2) {
|
||||
Scheme_Object *l = argv[2];
|
||||
if (SCHEME_TRUEP(l)) {
|
||||
if (SCHEME_PAIRP(l)) {
|
||||
while (SCHEME_PAIRP(l)) {
|
||||
if (!SCHEME_SYMBOLP(SCHEME_CAR(l)))
|
||||
break;
|
||||
l = SCHEME_CDR(l);
|
||||
}
|
||||
} else
|
||||
l = scheme_false;
|
||||
if (!SCHEME_NULLP(l))
|
||||
scheme_wrong_type("module-path-index-join", "non-empty list of symbols", 2, argc, argv);
|
||||
if (SCHEME_TRUEP(argv[0]) || SCHEME_TRUEP(argv[1]))
|
||||
scheme_arg_mismatch("module-path-index-join",
|
||||
"first or second non-#f argument results a #f third argument, given: ",
|
||||
argv[2]);
|
||||
return get_submodule_empty_self_modidx(argv[2]);
|
||||
}
|
||||
}
|
||||
|
||||
return scheme_make_modidx(argv[0], argv[1], scheme_false);
|
||||
}
|
||||
|
||||
static Scheme_Object *module_path_index_submodule(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Modidx *modidx;
|
||||
Scheme_Object *a;
|
||||
|
||||
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_module_index_type))
|
||||
scheme_wrong_type("module-path-index-submodule", "module-path-index", 0, argc, argv);
|
||||
|
||||
modidx = (Scheme_Modidx *)argv[0];
|
||||
a = modidx->resolved;
|
||||
if (SCHEME_TRUEP(modidx->path)
|
||||
|| SCHEME_TRUEP(modidx->base)
|
||||
|| SCHEME_FALSEP(a))
|
||||
return scheme_false;
|
||||
|
||||
a = scheme_resolved_module_path_value(a);
|
||||
if (!SCHEME_PAIRP(a))
|
||||
return scheme_false;
|
||||
|
||||
return SCHEME_CDR(a);
|
||||
}
|
||||
|
||||
void scheme_init_module_path_table()
|
||||
{
|
||||
REGISTER_SO(modpath_table);
|
||||
|
|
@ -3557,6 +3605,33 @@ int same_resolved_modidx(Scheme_Object *a, Scheme_Object *b)
|
|||
return scheme_equal(a, b);
|
||||
}
|
||||
|
||||
static Scheme_Object *get_submodule_empty_self_modidx(Scheme_Object *submodule_path)
|
||||
{
|
||||
Scheme_Bucket *b;
|
||||
|
||||
if (SCHEME_NULLP(submodule_path))
|
||||
return empty_self_modidx;
|
||||
|
||||
if (!submodule_empty_modidx_table) {
|
||||
REGISTER_SO(submodule_empty_modidx_table);
|
||||
submodule_empty_modidx_table = scheme_make_weak_equal_table();
|
||||
}
|
||||
|
||||
scheme_start_atomic();
|
||||
b = scheme_bucket_from_table(submodule_empty_modidx_table, (const char *)submodule_path);
|
||||
if (!b->val) {
|
||||
submodule_path = make_resolved_module_path_obj(scheme_make_pair(scheme_resolved_module_path_value(empty_self_modname),
|
||||
submodule_path));
|
||||
submodule_path = scheme_make_modidx(scheme_false,
|
||||
scheme_false,
|
||||
submodule_path);
|
||||
b->val = submodule_path;
|
||||
}
|
||||
scheme_end_atomic_no_swap();
|
||||
|
||||
return b->val;
|
||||
}
|
||||
|
||||
static Scheme_Object *_module_resolve_k(void);
|
||||
|
||||
static Scheme_Object *_module_resolve(Scheme_Object *modidx, Scheme_Object *stx, Scheme_Env *env, int load_it)
|
||||
|
|
@ -6399,6 +6474,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
|
|||
Scheme_Comp_Env *benv;
|
||||
Scheme_Module *m;
|
||||
Scheme_Object *mbval, *orig_ii;
|
||||
Scheme_Object *this_empty_self_modidx;
|
||||
int saw_mb, check_mb = 0, skip_strip = 0;
|
||||
Scheme_Object *restore_confusing_name = NULL;
|
||||
LOG_EXPAND_DECLS;
|
||||
|
|
@ -6653,14 +6729,18 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
|
|||
|
||||
fm = scheme_stx_property(fm, module_name_symbol, scheme_resolved_module_path_value(rmp));
|
||||
|
||||
this_empty_self_modidx = get_submodule_empty_self_modidx(submodule_path);
|
||||
|
||||
if (ii) {
|
||||
/* phase shift to replace self_modidx of previous expansion (if any): */
|
||||
fm = scheme_stx_phase_shift(fm, NULL, empty_self_modidx, self_modidx, NULL, m->insp);
|
||||
fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp);
|
||||
|
||||
fm = scheme_add_rename(fm, rn_set);
|
||||
} else if (skip_strip) {
|
||||
/* phase shift to replace self_modidx of previous expansion: */
|
||||
fm = scheme_stx_phase_shift(fm, NULL, empty_self_modidx, self_modidx, NULL, m->insp);
|
||||
} else {
|
||||
if (skip_strip) {
|
||||
/* phase shift to replace self_modidx of previous expansion: */
|
||||
fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp);
|
||||
}
|
||||
}
|
||||
|
||||
SCHEME_EXPAND_OBSERVE_RENAME_ONE(rec[drec].observer, fm);
|
||||
|
|
@ -6768,17 +6848,17 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
|
|||
SCHEME_CAR(hints));
|
||||
fm = scheme_stx_property(fm,
|
||||
scheme_intern_symbol("module-self-path-index"),
|
||||
empty_self_modidx);
|
||||
this_empty_self_modidx);
|
||||
}
|
||||
|
||||
/* for future expansion, shift away from self_modidx: */
|
||||
if (m->pre_submodules) /* non-NULL => some submodules, even if it's '() */
|
||||
fm = phase_shift_skip_submodules(fm, self_modidx, empty_self_modidx, -1);
|
||||
fm = phase_shift_skip_submodules(fm, self_modidx, this_empty_self_modidx, -1);
|
||||
else
|
||||
fm = scheme_stx_phase_shift(fm, NULL, self_modidx, empty_self_modidx, NULL, NULL);
|
||||
fm = scheme_stx_phase_shift(fm, NULL, self_modidx, this_empty_self_modidx, NULL, NULL);
|
||||
|
||||
/* make self_modidx like the empty modidx */
|
||||
((Scheme_Modidx *)self_modidx)->resolved = empty_self_modname;
|
||||
((Scheme_Modidx *)self_modidx)->resolved = ((Scheme_Modidx *)this_empty_self_modidx)->resolved;
|
||||
}
|
||||
|
||||
if (rec[drec].comp || (rec[drec].depth != -2)) {
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
#define USE_COMPILED_STARTUP 1
|
||||
|
||||
#define EXPECTED_PRIM_COUNT 1045
|
||||
#define EXPECTED_PRIM_COUNT 1046
|
||||
#define EXPECTED_UNSAFE_COUNT 78
|
||||
#define EXPECTED_FLFXNUM_COUNT 68
|
||||
#define EXPECTED_FUTURES_COUNT 13
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.3.0.2"
|
||||
#define MZSCHEME_VERSION "5.3.0.3"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 3
|
||||
#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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user