From d02b98e9609b8418867d3b46d844d385d128eb0c Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Sat, 19 May 2001 01:22:12 +0000 Subject: [PATCH] * modules.h, modules.c: Moved around a lot of code so that deprecated features appear at the bottom. (root_module_lookup_closure, scm_sym_app, scm_sym_modules, module_prefix, make_modules_in_var, beautify_user_module_x_var, scm_the_root_module, scm_make_module, scm_ensure_user_module, scm_load_scheme_module): Deprecated. (scm_system_module_env_p): Return SCM_BOOL_T directly for environments corresponding to the root module. (convert_module_name, scm_c_resolve_module, scm_c_call_with_current_module, scm_c_define_module, scm_c_use_module, scm_c_export): New. (the_root_module): New static variant of scm_the_root_module. Use it everywhere instead of scm_the_root_module. --- libguile/modules.c | 304 +++++++++++++++++++++++++++++++-------------- libguile/modules.h | 57 +++++---- 2 files changed, 248 insertions(+), 113 deletions(-) diff --git a/libguile/modules.c b/libguile/modules.c index f889fe9aa..fb466d511 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -44,6 +44,8 @@ +#include + #include "libguile/_scm.h" #include "libguile/eval.h" @@ -54,6 +56,7 @@ #include "libguile/struct.h" #include "libguile/variable.h" #include "libguile/fluids.h" +#include "libguile/deprecation.h" #include "libguile/modules.h" @@ -61,18 +64,6 @@ int scm_module_system_booted_p = 0; SCM scm_module_tag; -static SCM the_root_module_var; -static SCM root_module_lookup_closure; - -SCM -scm_the_root_module () -{ - if (scm_module_system_booted_p) - return SCM_VARIABLE_REF (the_root_module_var); - else - return SCM_BOOL_F; -} - static SCM the_module; SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0, @@ -126,91 +117,96 @@ SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0, } #undef FUNC_NAME -SCM_SYMBOL (scm_sym_app, "app"); -SCM_SYMBOL (scm_sym_modules, "modules"); -static SCM module_prefix; - -static SCM -scm_module_full_name (SCM name) -{ - if (SCM_EQ_P (SCM_CAR (name), scm_sym_app)) - return name; - else - return scm_append (SCM_LIST2 (module_prefix, name)); -} - -static SCM make_modules_in_var; -static SCM beautify_user_module_x_var; - SCM -scm_make_module (SCM name) +scm_c_call_with_current_module (SCM module, + SCM (*func)(void *), void *data) { - return scm_apply (SCM_VARIABLE_REF (make_modules_in_var), - SCM_LIST2 (scm_the_root_module (), - scm_module_full_name (name)), - SCM_EOL); + return scm_c_with_fluid (the_module, module, func, data); } -SCM -scm_ensure_user_module (SCM module) +static SCM +convert_module_name (const char *name) { - scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var), - SCM_LIST1 (module), SCM_EOL); - return SCM_UNSPECIFIED; -} + SCM list = SCM_EOL; + SCM *tail = &list; -SCM -scm_module_lookup_closure (SCM module) -{ - if (module == SCM_BOOL_F) - return SCM_BOOL_F; - else - return SCM_MODULE_EVAL_CLOSURE (module); + const char *ptr; + while (*name) + { + while (*name == ' ') + name++; + ptr = name; + while (*ptr && *ptr != ' ') + ptr++; + if (ptr > name) + { + *tail = scm_cons (scm_mem2symbol (name, ptr-name), SCM_EOL); + tail = SCM_CDRLOC (*tail); + } + name = ptr; + } + + return list; } +static SCM process_define_module_var; +static SCM process_use_modules_var; +static SCM resolve_module_var; + SCM -scm_current_module_lookup_closure () +scm_c_resolve_module (const char *name) { - if (scm_module_system_booted_p) - return scm_module_lookup_closure (scm_current_module ()); - else - return SCM_BOOL_F; + return scm_resolve_module (convert_module_name (name)); } SCM -scm_module_transformer (SCM module) +scm_resolve_module (SCM name) { - if (module == SCM_BOOL_F) - return SCM_BOOL_F; - else - return SCM_MODULE_TRANSFORMER (module); + return scm_apply (SCM_VARIABLE_REF (resolve_module_var), + SCM_LIST1 (name), SCM_EOL); } SCM -scm_current_module_transformer () +scm_c_define_module (const char *name, + void (*init)(void *), void *data) { - if (scm_module_system_booted_p) - return scm_module_transformer (scm_current_module ()); - else - return SCM_BOOL_F; + SCM module = scm_apply (SCM_VARIABLE_REF (process_define_module_var), + SCM_LIST1 (SCM_LIST1 (convert_module_name (name))), + SCM_EOL); + if (init) + scm_c_call_with_current_module (module, (SCM (*)(void*))init, data); + return module; } -static SCM resolve_module_var; - -SCM -scm_resolve_module (SCM name) +void +scm_c_use_module (const char *name) { - return scm_apply (SCM_VARIABLE_REF (resolve_module_var), - SCM_LIST1 (name), SCM_EOL); + scm_apply (SCM_VARIABLE_REF (process_use_modules_var), + SCM_LIST1 (SCM_LIST1 (convert_module_name (name))), + SCM_EOL); } -static SCM try_module_autoload_var; +static SCM module_export_x_var; -SCM -scm_load_scheme_module (SCM name) +void +scm_c_export (const char *name, ...) { - return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var), - SCM_LIST1 (name), SCM_EOL); + va_list ap; + SCM names = scm_cons (scm_str2symbol (name), SCM_EOL); + SCM *tail = SCM_CDRLOC (names); + va_start (ap, name); + while (1) + { + const char *n = va_arg (ap, const char *); + if (n == NULL) + break; + *tail = scm_cons (scm_str2symbol (n), SCM_EOL); + tail = SCM_CDRLOC (*tail); + } + scm_apply (SCM_VARIABLE_REF (module_export_x_var), + SCM_LIST2 (scm_current_module (), + names), + SCM_EOL); } /* Environments */ @@ -239,18 +235,29 @@ scm_env_top_level (SCM env) SCM_SYMBOL (sym_module, "module"); +static SCM the_root_module_var; + +static SCM +the_root_module () +{ + if (scm_module_system_booted_p) + return SCM_VARIABLE_REF (the_root_module_var); + else + return SCM_BOOL_F; +} + SCM scm_lookup_closure_module (SCM proc) { if (SCM_FALSEP (proc)) - return scm_the_root_module (); + return the_root_module (); else if (SCM_EVAL_CLOSURE_P (proc)) return SCM_PACK (SCM_SMOB_DATA (proc)); else { SCM mod = scm_procedure_property (proc, sym_module); if (mod == SCM_BOOL_F) - mod = scm_the_root_module (); + mod = the_root_module (); return mod; } } @@ -261,21 +268,6 @@ scm_env_module (SCM env) return scm_lookup_closure_module (scm_env_top_level (env)); } - -SCM_SYMBOL (scm_sym_system_module, "system-module"); - -SCM -scm_system_module_env_p (SCM env) -{ - SCM proc = scm_env_top_level (env); - if (SCM_FALSEP (proc)) - proc = root_module_lookup_closure; - return ((SCM_NFALSEP (scm_procedure_property (proc, - scm_sym_system_module))) - ? SCM_BOOL_T - : SCM_BOOL_F); -} - /* * C level implementation of the standard eval closure * @@ -363,6 +355,42 @@ SCM_DEFINE (scm_standard_interface_eval_closure, } #undef FUNC_NAME +SCM +scm_module_lookup_closure (SCM module) +{ + if (module == SCM_BOOL_F) + return SCM_BOOL_F; + else + return SCM_MODULE_EVAL_CLOSURE (module); +} + +SCM +scm_current_module_lookup_closure () +{ + if (scm_module_system_booted_p) + return scm_module_lookup_closure (scm_current_module ()); + else + return SCM_BOOL_F; +} + +SCM +scm_module_transformer (SCM module) +{ + if (module == SCM_BOOL_F) + return SCM_BOOL_F; + else + 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; +} + /* scm_sym2var * * looks up the variable bound to SYM according to PROC. PROC should be @@ -552,6 +580,32 @@ SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0, } #undef FUNC_NAME +#if SCM_DEBUG_DEPRECATED == 0 + +static SCM root_module_lookup_closure; +SCM_SYMBOL (scm_sym_app, "app"); +SCM_SYMBOL (scm_sym_modules, "modules"); +static SCM module_prefix; +static SCM make_modules_in_var; +static SCM beautify_user_module_x_var; +static SCM try_module_autoload_var; + +#endif + +SCM_SYMBOL (scm_sym_system_module, "system-module"); + +SCM +scm_system_module_env_p (SCM env) +{ + SCM proc = scm_env_top_level (env); + if (SCM_FALSEP (proc)) + return SCM_BOOL_T; + return ((SCM_NFALSEP (scm_procedure_property (proc, + scm_sym_system_module))) + ? SCM_BOOL_T + : SCM_BOOL_F); +} + void scm_modules_prehistory () { @@ -581,17 +635,83 @@ scm_post_boot_init_modules () SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type")); scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_cons_gloc); + + resolve_module_var = PERM (scm_c_lookup ("resolve-module")); + process_define_module_var = PERM (scm_c_lookup ("process-define-module")); + process_use_modules_var = PERM (scm_c_lookup ("process-use-modules")); + module_export_x_var = PERM (scm_c_lookup ("module-export!")); + the_root_module_var = PERM (scm_c_lookup ("the-root-module")); + +#if SCM_DEBUG_DEPRECATED == 0 + module_prefix = PERM (SCM_LIST2 (scm_sym_app, scm_sym_modules)); make_modules_in_var = PERM (scm_c_lookup ("make-modules-in")); - beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!")); - the_root_module_var = PERM (scm_c_lookup ("the-root-module")); root_module_lookup_closure = PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var))); - resolve_module_var = PERM (scm_c_lookup ("resolve-module")); + beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!")); try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload")); + +#endif + scm_module_system_booted_p = 1; } +#if SCM_DEBUG_DEPRECATED == 0 + +SCM +scm_the_root_module () +{ + scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. " + "Use `scm_c_resolve_module (\"guile\") " + "instead."); + + return the_root_module (); +} + +static SCM +scm_module_full_name (SCM name) +{ + if (SCM_EQ_P (SCM_CAR (name), scm_sym_app)) + return name; + else + return scm_append (SCM_LIST2 (module_prefix, name)); +} + +SCM +scm_make_module (SCM name) +{ + scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. " + "Use `scm_c_define_module instead."); + + return scm_apply (SCM_VARIABLE_REF (make_modules_in_var), + SCM_LIST2 (scm_the_root_module (), + scm_module_full_name (name)), + SCM_EOL); +} + +SCM +scm_ensure_user_module (SCM module) +{ + scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. " + "Use `scm_c_define_module instead."); + + scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var), + SCM_LIST1 (module), SCM_EOL); + return SCM_UNSPECIFIED; +} + +SCM +scm_load_scheme_module (SCM name) +{ + scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. " + "Use `scm_c_resolve_module instead."); + + return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var), + SCM_LIST1 (name), SCM_EOL); +} + +#endif + /* Local Variables: c-file-style: "gnu" diff --git a/libguile/modules.h b/libguile/modules.h index 9869e42a0..c1074ee81 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -50,6 +50,9 @@ +extern int scm_module_system_booted_p; +extern SCM scm_module_tag; + #define SCM_MODULEP(OBJ) \ (SCM_NIMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag) @@ -82,31 +85,12 @@ extern scm_bits_t scm_tc16_eval_closure; -extern int scm_module_system_booted_p; -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); -extern SCM scm_top_level_env (SCM thunk); -extern SCM scm_system_module_env_p (SCM env); -extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); -extern SCM scm_standard_eval_closure (SCM module); -extern SCM scm_standard_interface_eval_closure (SCM module); -extern SCM scm_get_pre_modules_obarray (void); -extern SCM scm_lookup_closure_module (SCM proc); -extern SCM scm_env_module (SCM env); +extern SCM scm_c_call_with_current_module (SCM module, + SCM (*func)(void *), void *data); extern SCM scm_c_lookup (const char *name); extern SCM scm_c_define (const char *name, SCM val); @@ -119,11 +103,42 @@ extern SCM scm_module_lookup (SCM module, SCM symbol); extern SCM scm_module_define (SCM module, SCM symbol, SCM val); extern SCM scm_module_reverse_lookup (SCM module, SCM variable); +extern SCM scm_c_resolve_module (const char *name); +extern SCM scm_resolve_module (SCM name); +extern SCM scm_c_define_module (const char *name, + void (*init)(void *), void *data); +extern void scm_c_use_module (const char *name); +extern void scm_c_export (const char *name, ...); + extern SCM scm_sym2var (SCM sym, SCM thunk, SCM definep); +extern SCM scm_module_lookup_closure (SCM module); +extern SCM scm_module_transformer (SCM module); +extern SCM scm_current_module_lookup_closure (void); +extern SCM scm_current_module_transformer (void); +extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); +extern SCM scm_standard_eval_closure (SCM module); +extern SCM scm_standard_interface_eval_closure (SCM module); +extern SCM scm_get_pre_modules_obarray (void); +extern SCM scm_lookup_closure_module (SCM proc); + +extern SCM scm_env_top_level (SCM env); +extern SCM scm_env_module (SCM env); +extern SCM scm_top_level_env (SCM thunk); + extern void scm_modules_prehistory (void); extern void scm_init_modules (void); +#if SCM_DEBUG_DEPRECATED == 0 + +extern SCM scm_the_root_module (void); +extern SCM scm_make_module (SCM name); +extern SCM scm_ensure_user_module (SCM name); +extern SCM scm_load_scheme_module (SCM name); +extern SCM scm_system_module_env_p (SCM env); + +#endif + #endif /* MODULESH */ /* -- 2.20.1