mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* modules.c (scm_module_type): New.

Browse source 
(scm_post_boot_init_modules): Initialize from Scheme value.
(the_module, scm_current_module, scm_init_modules): the_module is
now a C only fluid.
(scm_current_module): Export to Scheme.
(scm_set_current_module): Do not call out to Scheme, do all the
work in C.  Export procedure to Scheme.  Only accept modules, `#f'
is no longer valid as the current module.  Only set
scm_top_level_lookup_closure_var and scm_system_transformer when
they are not deprecated.
(scm_module_transformer, scm_current_module_transformer): New.

* modules.h (scm_module_index_transformer, SCM_MODULE_TRANSFORMER,
scm_current_module_transformer, scm_module_transformer): New.
This commit is contained in:
Marius Vollmer 2001-04-24 23:40:18 +00:00
parent f2c4aa2a16
commit 55000e5f40
2 changed files with 65 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

78
libguile/modules.c
View file

@ -60,6 +60,7 @@
SCM scm_module_system_booted_p = 0;
SCM scm_module_tag;
SCM scm_module_type;
static SCM the_root_module;
static SCM root_module_lookup_closure;
@ -72,26 +73,51 @@ scm_the_root_module ()
static SCM the_module;
SCM
scm_current_module ()
SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
(),
"Return the current module.")
#define FUNC_NAME s_scm_current_module
{
return scm_fluid_ref (SCM_CDR (the_module));
return scm_fluid_ref (the_module);
}
#undef FUNC_NAME
static SCM set_current_module;
#define SCM_VALIDATE_STRUCT_TYPE(pos, v, type) \
do { \
SCM_ASSERT (SCM_NIMP (v) && SCM_NFALSEP (SCM_STRUCTP (v)) \
&& SCM_STRUCT_VTABLE (v) == (type), \
v, pos, FUNC_NAME); \
} while (0)
/* This is the module selected during loading of code. Currently,
* this is the same as (interaction-environment), but need not be in
* the future.
*/
SCM
scm_set_current_module (SCM module)
SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
(SCM module),
"Set the current module to @var{module} and return"
"the previous current module.")
#define FUNC_NAME s_scm_set_current_module
{
SCM old = scm_current_module ();
scm_apply (SCM_CDR (set_current_module), SCM_LIST1 (module), SCM_EOL);
SCM old;
/* XXX - we can not validate our argument when the module system
hasn't been booted yet since we don't know the type. This
should be fixed when we have a cleaner way of booting
Guile.
*/
if (scm_module_system_booted_p)
SCM_VALIDATE_STRUCT_TYPE (SCM_ARG1, module, scm_module_type);
old = scm_current_module ();
scm_fluid_set_x (the_module, module);
#if SCM_DEBUG_DEPRECATED == 0
scm_fluid_set_x (SCM_CDR (scm_top_level_lookup_closure_var),
scm_current_module_lookup_closure ());
scm_fluid_set_x (SCM_CDR (scm_system_transformer),
scm_current_module_transformer ());
#endif
return old;
}
#undef FUNC_NAME
SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0,
(),
@ -153,6 +179,21 @@ scm_current_module_lookup_closure ()
return SCM_BOOL_F;
}
SCM
scm_module_transformer (SCM module)
{
return SCM_MODULE_TRANSFORMER (module);
}
SCM
scm_current_module_transformer ()
{
if (scm_module_system_booted_p)
return scm_module_transformer (scm_current_module ());
else
return SCM_BOOL_F;
}
static SCM resolve_module;
SCM
@ -286,20 +327,21 @@ scm_init_modules ()
scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
the_module = scm_permanent_object (scm_make_fluid ());
}
void
scm_post_boot_init_modules ()
{
scm_module_tag = (SCM_CELL_WORD_1 (SCM_CDR (scm_intern0 ("module-type")))
+ scm_tc3_cons_gloc);
the_root_module = scm_intern0 ("the-root-module");
the_module = scm_intern0 ("the-module");
set_current_module = scm_intern0 ("set-current-module");
scm_module_type =
scm_permanent_object (SCM_CDR (scm_intern0 ("module-type")));
scm_module_tag = (SCM_CELL_WORD_1 (scm_module_type) + scm_tc3_cons_gloc);
module_prefix = scm_permanent_object (SCM_LIST2 (scm_sym_app,
scm_sym_modules));
make_modules_in = scm_intern0 ("make-modules-in");
beautify_user_module_x = scm_intern0 ("beautify-user-module!");
the_root_module = scm_intern0 ("the-root-module");
root_module_lookup_closure = scm_permanent_object
(scm_module_lookup_closure (SCM_CDR (the_root_module)));
resolve_module = scm_intern0 ("resolve-module");

5
libguile/modules.h
View file

@ -63,6 +63,7 @@
#define scm_module_index_uses 1
#define scm_module_index_binder 2
#define scm_module_index_eval_closure 3
#define scm_module_index_transformer 4
#define SCM_MODULE_OBARRAY(module) \
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@ -72,6 +73,8 @@
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_binder])
#define SCM_MODULE_EVAL_CLOSURE(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
#define SCM_MODULE_TRANSFORMER(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
extern scm_bits_t scm_tc16_eval_closure;
@ -85,11 +88,13 @@ extern SCM scm_module_tag;
extern SCM scm_the_root_module (void);
extern SCM scm_current_module (void);
extern SCM scm_current_module_lookup_closure (void);
extern SCM scm_current_module_transformer (void);
extern SCM scm_interaction_environment (void);
extern SCM scm_set_current_module (SCM module);
extern SCM scm_make_module (SCM name);
extern SCM scm_ensure_user_module (SCM name);
extern SCM scm_module_lookup_closure (SCM module);
extern SCM scm_module_transformer (SCM module);
extern SCM scm_resolve_module (SCM name);
extern SCM scm_load_scheme_module (SCM name);
extern SCM scm_env_top_level (SCM env);