X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/df22662f5de5585f723943a44e61fb71f7a49190..4af0d97ee65f298be33d5959cd36a5bea8797be9:/libguile/modules.c diff --git a/libguile/modules.c b/libguile/modules.c index beee0e2a5..7b42a3d43 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -1,18 +1,19 @@ -/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ @@ -41,12 +42,32 @@ int scm_module_system_booted_p = 0; scm_t_bits scm_module_tag; +/* The current module, a fluid. */ static SCM the_module; +/* Most of the module system is implemented in Scheme. These bindings from + boot-9 are needed to provide the Scheme interface. */ static SCM the_root_module_var; +static SCM module_make_local_var_x_var; +static SCM define_module_star_var; +static SCM process_use_modules_var; +static SCM resolve_module_var; +static SCM module_public_interface_var; +static SCM module_export_x_var; +static SCM default_duplicate_binding_procedures_var; -static SCM -the_root_module () +/* The #:ensure keyword. */ +static SCM k_ensure; + + +static SCM unbound_variable (const char *func, SCM sym) +{ + scm_error (scm_from_latin1_symbol ("unbound-variable"), func, + "Unbound variable: ~S", scm_list_1 (sym), SCM_BOOL_F); +} + +SCM +scm_the_root_module (void) { if (scm_module_system_booted_p) return SCM_VARIABLE_REF (the_root_module_var); @@ -59,9 +80,10 @@ SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0, "Return the current module.") #define FUNC_NAME s_scm_current_module { - SCM curr = scm_fluid_ref (the_module); - - return scm_is_true (curr) ? curr : the_root_module (); + if (scm_module_system_booted_p) + return scm_fluid_ref (the_module); + else + return SCM_BOOL_F; } #undef FUNC_NAME @@ -142,10 +164,6 @@ convert_module_name (const char *name) return list; } -static SCM process_define_module_var; -static SCM process_use_modules_var; -static SCM resolve_module_var; - SCM scm_c_resolve_module (const char *name) { @@ -162,8 +180,8 @@ SCM scm_c_define_module (const char *name, void (*init)(void *), void *data) { - SCM module = scm_call_1 (SCM_VARIABLE_REF (process_define_module_var), - scm_list_1 (convert_module_name (name))); + SCM module = scm_call_1 (SCM_VARIABLE_REF (define_module_star_var), + convert_module_name (name)); if (init) scm_c_call_with_current_module (module, (SCM (*)(void*))init, data); return module; @@ -176,8 +194,6 @@ scm_c_use_module (const char *name) scm_list_1 (scm_list_1 (convert_module_name (name)))); } -static SCM module_export_x_var; - SCM scm_module_export (SCM module, SCM namelist) { @@ -220,57 +236,6 @@ scm_c_export (const char *name, ...) } -/* Environments */ - -SCM -scm_top_level_env (SCM thunk) -{ - if (SCM_IMP (thunk)) - return SCM_EOL; - else - return scm_cons (thunk, SCM_EOL); -} - -SCM -scm_env_top_level (SCM env) -{ - while (scm_is_pair (env)) - { - SCM car_env = SCM_CAR (env); - if (!scm_is_pair (car_env) && scm_is_true (scm_procedure_p (car_env))) - return car_env; - env = SCM_CDR (env); - } - return SCM_BOOL_F; -} - -SCM_SYMBOL (sym_module, "module"); - -SCM -scm_lookup_closure_module (SCM proc) -{ - if (scm_is_false (proc)) - 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 (scm_is_false (mod)) - mod = the_root_module (); - return mod; - } -} - -SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0, - (SCM env), - "Return the module of @var{ENV}, a lexical environment.") -#define FUNC_NAME s_scm_env_module -{ - return scm_lookup_closure_module (scm_env_top_level (env)); -} -#undef FUNC_NAME - /* * C level implementation of the standard eval closure * @@ -279,12 +244,6 @@ SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0, * release. */ -/* The `module-make-local-var!' variable. */ -static SCM module_make_local_var_x_var = SCM_UNSPECIFIED; - -/* The `default-duplicate-binding-procedures' variable. */ -static SCM default_duplicate_binding_procedures_var = SCM_UNSPECIFIED; - /* Return the list of default duplicate binding handlers (procedures). */ static inline SCM default_duplicate_binding_handlers (void) @@ -304,41 +263,50 @@ resolve_duplicate_binding (SCM module, SCM sym, SCM iface1, SCM var1, SCM iface2, SCM var2) { + SCM args[8]; + SCM handlers; SCM result = SCM_BOOL_F; - if (!scm_is_eq (var1, var2)) + if (scm_is_eq (var1, var2)) + return var1; + + args[0] = module; + args[1] = sym; + args[2] = iface1; + args[3] = SCM_VARIABLE_REF (var1); + if (SCM_UNBNDP (args[3])) + args[3] = SCM_BOOL_F; + args[4] = iface2; + args[5] = SCM_VARIABLE_REF (var2); + if (SCM_UNBNDP (args[5])) + args[5] = SCM_BOOL_F; + args[6] = scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_BOOL_F); + args[7] = SCM_BOOL_F; + + handlers = SCM_MODULE_DUPLICATE_HANDLERS (module); + if (scm_is_false (handlers)) + handlers = default_duplicate_binding_handlers (); + + for (; scm_is_pair (handlers); handlers = SCM_CDR (handlers)) { - SCM val1, val2; - SCM handlers, h, handler_args; - - val1 = SCM_VARIABLE_REF (var1); - val2 = SCM_VARIABLE_REF (var2); - - val1 = (val1 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val1; - val2 = (val2 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val2; - - handlers = SCM_MODULE_DUPLICATE_HANDLERS (module); - if (scm_is_false (handlers)) - handlers = default_duplicate_binding_handlers (); - - handler_args = scm_list_n (module, sym, - iface1, val1, iface2, val2, - var1, val1, - SCM_UNDEFINED); - - for (h = handlers; - scm_is_pair (h) && scm_is_false (result); - h = SCM_CDR (h)) - { - result = scm_apply (SCM_CAR (h), handler_args, SCM_EOL); - } + if (scm_is_true (args[6])) + { + args[7] = SCM_VARIABLE_REF (args[6]); + if (SCM_UNBNDP (args[7])) + args[7] = SCM_BOOL_F; + } + + result = scm_call_n (SCM_CAR (handlers), args, 8); + + if (scm_is_true (result)) + return result; } - else - result = var1; - return result; + return SCM_BOOL_F; } +/* No lock is needed for access to this variable, as there are no + threads before modules are booted. */ SCM scm_pre_modules_obarray; /* Lookup SYM as an imported variable of MODULE. */ @@ -376,9 +344,15 @@ module_imported_variable (SCM module, SCM sym) { /* SYM is a duplicate binding (imported more than once) so we need to resolve it. */ - found_var = resolve_duplicate_binding (module, sym, - found_iface, found_var, - iface, var); + found_var = resolve_duplicate_binding (module, sym, + found_iface, found_var, + iface, var); + + /* Note that it could be that FOUND_VAR doesn't belong + either to FOUND_IFACE or to IFACE, if it was created + by merge-generics. The right thing to do there would + be to treat the import obarray as the iface, but the + import obarray isn't actually a module. Oh well. */ if (scm_is_eq (found_var, var)) found_iface = iface; } @@ -412,32 +386,47 @@ SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0, register SCM b; - /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being - evaluated. */ if (scm_module_system_booted_p) SCM_VALIDATE_MODULE (1, module); SCM_VALIDATE_SYMBOL (2, sym); + if (scm_is_false (module)) + return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED); /* 1. Check module obarray */ b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED); if (SCM_BOUND_THING_P (b)) return b; - /* 2. Search imported bindings. In order to be consistent with - `module-variable', the binder gets called only when no imported binding - matches SYM. */ - b = module_imported_variable (module, sym); - if (SCM_BOUND_THING_P (b)) - return SCM_BOOL_F; + /* At this point we should just be able to return #f, but there is the + possibility that a custom binder establishes a mapping for this + variable. + + However a custom binder should be called only if there is no + imported binding with the name SYM. So here instead of the order: + + 2. Search imported bindings. In order to be consistent with + `module-variable', the binder gets called only when no + imported binding matches SYM. + + 3. Query the custom binder. + + we first check if there is a binder at all, and if not, just return + #f directly. + */ { - /* 3. Query the custom binder. */ SCM binder = SCM_MODULE_BINDER (module); if (scm_is_true (binder)) { + /* 2. */ + b = module_imported_variable (module, sym); + if (SCM_BOUND_THING_P (b)) + return SCM_BOOL_F; + + /* 3. */ b = scm_call_3 (binder, module, sym, SCM_BOOL_F); if (SCM_BOUND_THING_P (b)) return b; @@ -499,85 +488,65 @@ SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0, } #undef FUNC_NAME -scm_t_bits scm_tc16_eval_closure; - -#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<16) -#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \ - (SCM_CELL_WORD_0 (e) & SCM_F_EVAL_CLOSURE_INTERFACE) - -/* NOTE: This function may be called by a smob application - or from another C function directly. */ SCM -scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) +scm_module_ensure_local_variable (SCM module, SCM sym) +#define FUNC_NAME "module-ensure-local-variable" { - SCM module = SCM_PACK (SCM_SMOB_DATA (eclo)); - if (scm_is_true (definep)) + if (SCM_LIKELY (scm_module_system_booted_p)) { - if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) - return SCM_BOOL_F; + SCM_VALIDATE_MODULE (1, module); + SCM_VALIDATE_SYMBOL (2, sym); + return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var), - module, sym); + module, sym); } - else - return scm_module_variable (module, sym); -} -SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0, - (SCM module), - "Return an eval closure for the module @var{module}.") -#define FUNC_NAME s_scm_standard_eval_closure -{ - SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module)); -} -#undef FUNC_NAME + { + SCM handle, var; + handle = scm_hashq_create_handle_x (scm_pre_modules_obarray, + sym, SCM_BOOL_F); + var = SCM_CDR (handle); -SCM_DEFINE (scm_standard_interface_eval_closure, - "standard-interface-eval-closure", 1, 0, 0, - (SCM module), - "Return a interface eval closure for the module @var{module}. " - "Such a closure does not allow new bindings to be added.") -#define FUNC_NAME s_scm_standard_interface_eval_closure -{ - SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | SCM_F_EVAL_CLOSURE_INTERFACE, - SCM_UNPACK (module)); -} -#undef FUNC_NAME + if (scm_is_false (var)) + { + var = scm_make_variable (SCM_UNDEFINED); + SCM_SETCDR (handle, var); + } -SCM -scm_module_lookup_closure (SCM module) -{ - if (scm_is_false (module)) - return SCM_BOOL_F; - else - return SCM_MODULE_EVAL_CLOSURE (module); + return var; + } } +#undef FUNC_NAME -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_SYMBOL (sym_macroexpand, "macroexpand"); -SCM -scm_module_transformer (SCM module) +SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0, + (SCM module), + "Returns the syntax expander for the given module.") +#define FUNC_NAME s_scm_module_transformer { - if (scm_is_false (module)) - return SCM_BOOL_F; + if (SCM_UNLIKELY (scm_is_false (module))) + { + SCM v = scm_hashq_ref (scm_pre_modules_obarray, + sym_macroexpand, + SCM_BOOL_F); + if (scm_is_false (v)) + SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL); + return SCM_VARIABLE_REF (v); + } else - return SCM_MODULE_TRANSFORMER (module); + { + SCM_VALIDATE_MODULE (SCM_ARG1, module); + return SCM_MODULE_TRANSFORMER (module); + } } +#undef FUNC_NAME SCM scm_current_module_transformer () { - if (scm_module_system_booted_p) - return scm_module_transformer (scm_current_module ()); - else - return SCM_BOOL_F; + return scm_module_transformer (scm_current_module ()); } SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, @@ -623,114 +592,158 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0, } #undef FUNC_NAME -SCM_SYMBOL (sym_sys_module_public_interface, "%module-public-interface"); +SCM +scm_module_public_interface (SCM module) +{ + return scm_call_1 (SCM_VARIABLE_REF (module_public_interface_var), module); +} -SCM_DEFINE (scm_module_public_interface, "module-public-interface", 1, 0, 0, - (SCM module), - "Return the public interface of @var{module}.\n\n" - "If @var{module} has no public interface, @code{#f} is returned.") -#define FUNC_NAME s_scm_module_public_interface +SCM +scm_c_module_lookup (SCM module, const char *name) { - SCM var; + return scm_module_lookup (module, scm_from_locale_symbol (name)); +} - SCM_VALIDATE_MODULE (1, module); - var = scm_module_local_variable (module, sym_sys_module_public_interface); - if (scm_is_true (var)) - return SCM_VARIABLE_REF (var); - else - return SCM_BOOL_F; +SCM +scm_module_lookup (SCM module, SCM sym) +#define FUNC_NAME "module-lookup" +{ + SCM var; + var = scm_module_variable (module, sym); + if (scm_is_false (var)) + unbound_variable (FUNC_NAME, sym); + return var; } #undef FUNC_NAME -/* scm_sym2var - * - * looks up the variable bound to SYM according to PROC. PROC should be - * a `eval closure' of some module. - * - * When no binding exists, and DEFINEP is true, create a new binding - * with a initial value of SCM_UNDEFINED. Return `#f' when DEFINEP as - * false and no binding exists. - * - * When PROC is `#f', it is ignored and the binding is searched for in - * the scm_pre_modules_obarray (a `eq' hash table). - */ +SCM +scm_c_lookup (const char *name) +{ + return scm_lookup (scm_from_locale_symbol (name)); +} -SCM -scm_sym2var (SCM sym, SCM proc, SCM definep) -#define FUNC_NAME "scm_sym2var" +SCM +scm_lookup (SCM sym) { - SCM var; + return scm_module_lookup (scm_current_module (), sym); +} - if (SCM_NIMP (proc)) - { - if (SCM_EVAL_CLOSURE_P (proc)) - { - /* Bypass evaluator in the standard case. */ - var = scm_eval_closure_lookup (proc, sym, definep); - } - else - var = scm_call_2 (proc, sym, definep); - } - else - { - SCM handle; +SCM +scm_public_variable (SCM module_name, SCM name) +{ + SCM mod, iface; + + mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name, + k_ensure, SCM_BOOL_F); - if (scm_is_false (definep)) - var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F); - else - { - handle = scm_hashq_create_handle_x (scm_pre_modules_obarray, - sym, SCM_BOOL_F); - var = SCM_CDR (handle); - if (scm_is_false (var)) - { - var = scm_make_variable (SCM_UNDEFINED); - SCM_SETCDR (handle, var); - } - } - } + if (scm_is_false (mod)) + scm_misc_error ("public-lookup", "Module named ~s does not exist", + scm_list_1 (module_name)); + + iface = scm_module_public_interface (mod); - if (scm_is_true (var) && !SCM_VARIABLEP (var)) - SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym)); + if (scm_is_false (iface)) + scm_misc_error ("public-lookup", "Module ~s has no public interface", + scm_list_1 (mod)); + + return scm_module_variable (iface, name); +} - return var; +SCM +scm_private_variable (SCM module_name, SCM name) +{ + SCM mod; + + mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name, + k_ensure, SCM_BOOL_F); + + if (scm_is_false (mod)) + scm_misc_error ("private-lookup", "Module named ~s does not exist", + scm_list_1 (module_name)); + + return scm_module_variable (mod, name); } -#undef FUNC_NAME SCM -scm_c_module_lookup (SCM module, const char *name) +scm_c_public_variable (const char *module_name, const char *name) { - return scm_module_lookup (module, scm_from_locale_symbol (name)); + return scm_public_variable (convert_module_name (module_name), + scm_from_locale_symbol (name)); } SCM -scm_module_lookup (SCM module, SCM sym) -#define FUNC_NAME "module-lookup" +scm_c_private_variable (const char *module_name, const char *name) +{ + return scm_private_variable (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_public_lookup (SCM module_name, SCM name) { SCM var; - SCM_VALIDATE_MODULE (1, module); + + var = scm_public_variable (module_name, name); - var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); if (scm_is_false (var)) - SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym)); + scm_misc_error ("public-lookup", "No variable bound to ~s in module ~s", + scm_list_2 (name, module_name)); + return var; } -#undef FUNC_NAME SCM -scm_c_lookup (const char *name) +scm_private_lookup (SCM module_name, SCM name) { - return scm_lookup (scm_from_locale_symbol (name)); + SCM var; + + var = scm_private_variable (module_name, name); + + if (scm_is_false (var)) + scm_misc_error ("private-lookup", "No variable bound to ~s in module ~s", + scm_list_2 (name, module_name)); + + return var; } SCM -scm_lookup (SCM sym) +scm_c_public_lookup (const char *module_name, const char *name) { - SCM var = - scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); - if (scm_is_false (var)) - scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym)); - return var; + return scm_public_lookup (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_c_private_lookup (const char *module_name, const char *name) +{ + return scm_private_lookup (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_public_ref (SCM module_name, SCM name) +{ + return scm_variable_ref (scm_public_lookup (module_name, name)); +} + +SCM +scm_private_ref (SCM module_name, SCM name) +{ + return scm_variable_ref (scm_private_lookup (module_name, name)); +} + +SCM +scm_c_public_ref (const char *module_name, const char *name) +{ + return scm_public_ref (convert_module_name (module_name), + scm_from_locale_symbol (name)); +} + +SCM +scm_c_private_ref (const char *module_name, const char *name) +{ + return scm_private_ref (convert_module_name (module_name), + scm_from_locale_symbol (name)); } SCM @@ -744,10 +757,10 @@ scm_module_define (SCM module, SCM sym, SCM value) #define FUNC_NAME "module-define" { SCM var; - SCM_VALIDATE_MODULE (1, module); - var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_T); + var = scm_module_ensure_local_variable (module, sym); SCM_VARIABLE_SET (var, value); + return var; } #undef FUNC_NAME @@ -758,14 +771,18 @@ scm_c_define (const char *name, SCM value) return scm_define (scm_from_locale_symbol (name), value); } -SCM -scm_define (SCM sym, SCM value) +SCM_DEFINE (scm_define, "define!", 2, 0, 0, + (SCM sym, SCM value), + "Define @var{sym} to be @var{value} in the current module." + "Returns the variable itself. Note that this is a procedure, " + "not a macro.") +#define FUNC_NAME s_scm_define { - SCM var = - scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T); - SCM_VARIABLE_SET (var, value); - return var; + SCM_VALIDATE_SYMBOL (SCM_ARG1, sym); + + return scm_module_define (scm_current_module (), sym, value); } +#undef FUNC_NAME SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, (SCM module, SCM variable), @@ -786,6 +803,8 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, obarray = SCM_MODULE_OBARRAY (module); } + SCM_VALIDATE_VARIABLE (SCM_ARG2, variable); + if (!SCM_HASHTABLE_P (obarray)) return SCM_BOOL_F; @@ -799,23 +818,34 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, while (!scm_is_null (ls)) { handle = SCM_CAR (ls); - if (SCM_CDR (handle) == variable) - return SCM_CAR (handle); + + if (SCM_UNPACK (SCM_CAR (handle)) == 0) + { + /* FIXME: We hit a weak pair whose car has become unreachable. + We should remove the pair in question or something. */ + } + else + { + if (scm_is_eq (SCM_CDR (handle), variable)) + return SCM_CAR (handle); + } + ls = SCM_CDR (ls); } } - /* Try the `uses' list. */ - { - SCM uses = SCM_MODULE_USES (module); - while (scm_is_pair (uses)) - { - SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable); - if (scm_is_true (sym)) - return sym; - uses = SCM_CDR (uses); - } - } + if (!scm_is_false (module)) + { + /* Try the `uses' list. */ + SCM uses = SCM_MODULE_USES (module); + while (scm_is_pair (uses)) + { + SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable); + if (scm_is_true (sym)) + return sym; + uses = SCM_CDR (uses); + } + } return SCM_BOOL_F; } @@ -834,23 +864,10 @@ SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0, 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_is_false (proc)) - return SCM_BOOL_T; - return ((scm_is_true (scm_procedure_property (proc, - scm_sym_system_module))) - ? SCM_BOOL_T - : SCM_BOOL_F); -} - void scm_modules_prehistory () { - scm_pre_modules_obarray - = scm_permanent_object (scm_c_make_hash_table (1533)); + scm_pre_modules_obarray = scm_c_make_hash_table (1533); } void @@ -859,28 +876,24 @@ scm_init_modules () #include "libguile/modules.x" module_make_local_var_x_var = scm_c_define ("module-make-local-var!", SCM_UNDEFINED); - 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 ()); + the_module = scm_make_fluid (); } static void scm_post_boot_init_modules () { -#define PERM(x) scm_permanent_object(x) - SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type")); scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct); - 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")); - default_duplicate_binding_procedures_var = - PERM (scm_c_lookup ("default-duplicate-binding-procedures")); + resolve_module_var = scm_c_lookup ("resolve-module"); + define_module_star_var = scm_c_lookup ("define-module*"); + process_use_modules_var = scm_c_lookup ("process-use-modules"); + module_export_x_var = scm_c_lookup ("module-export!"); + the_root_module_var = scm_c_lookup ("the-root-module"); + default_duplicate_binding_procedures_var = + scm_c_lookup ("default-duplicate-binding-procedures"); + module_public_interface_var = scm_c_lookup ("module-public-interface"); + k_ensure = scm_from_locale_keyword ("ensure"); scm_module_system_booted_p = 1; }