diff options
-rw-r--r-- | doc/ref/api-modules.texi | 11 | ||||
-rw-r--r-- | libguile/deprecated.c | 3 | ||||
-rw-r--r-- | libguile/deprecated.h | 2 | ||||
-rw-r--r-- | libguile/eval.h | 6 | ||||
-rw-r--r-- | libguile/gdbint.c | 5 | ||||
-rw-r--r-- | libguile/goops.c | 12 | ||||
-rw-r--r-- | libguile/macros.c | 6 | ||||
-rw-r--r-- | libguile/modules.c | 202 | ||||
-rw-r--r-- | libguile/modules.h | 21 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 4 | ||||
-rw-r--r-- | libguile/vm.c | 11 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 78 | ||||
-rw-r--r-- | module/ice-9/deprecated.scm | 2 | ||||
-rw-r--r-- | module/oop/goops/util.scm | 14 |
14 files changed, 78 insertions, 299 deletions
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi index c91c2d409..17ab46277 100644 --- a/doc/ref/api-modules.texi +++ b/doc/ref/api-modules.texi @@ -1008,6 +1008,17 @@ Like @code{scm_c_define} and @code{scm_define}, but the specified module is used instead of the current one. @end deftypefn +In some rare cases, you may need to access the variable that +@code{scm_module_define} would have accessed, without changing the +binding of the existing variable, if one is present. In that case, use +@code{scm_module_ensure_local_variable}: + +@deftypefn {C Function} SCM scm_module_ensure_local_variable (SCM @var{module}, SCM @var{sym}) +Like @code{scm_module_define}, but if the @var{sym} is already locally +bound in that module, the variable's existing binding is not reset. +Returns a variable. +@end deftypefn + @deftypefn {C Function} SCM scm_module_reverse_lookup (SCM @var{module}, SCM @var{variable}) Find the symbol that is bound to @var{variable} in @var{module}. When no such binding is found, return @code{#f}. @end deftypefn diff --git a/libguile/deprecated.c b/libguile/deprecated.c index e6ef91757..cf4402435 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2,7 +2,7 @@ deprecate something, move it here when that is feasible. */ -/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2003, 2004, 2006, 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 @@ -78,6 +78,7 @@ scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr, + void scm_i_init_deprecated () { diff --git a/libguile/deprecated.h b/libguile/deprecated.h index d11667191..8588c190c 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -5,7 +5,7 @@ #ifndef SCM_DEPRECATED_H #define SCM_DEPRECATED_H -/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2003,2004, 2005, 2006, 2007, 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 diff --git a/libguile/eval.h b/libguile/eval.h index 014f0dec5..9e5f65467 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -3,7 +3,7 @@ #ifndef SCM_EVAL_H #define SCM_EVAL_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -57,10 +57,6 @@ typedef SCM (*scm_t_trampoline_2) (SCM proc, SCM arg1, SCM arg2); #define SCM_EXTEND_ENV scm_acons -/*fixme* This should probably be removed throught the code. */ - -#define SCM_TOP_LEVEL_LOOKUP_CLOSURE (scm_current_module_lookup_closure()) - SCM_API SCM scm_call_0 (SCM proc); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index b502c7c46..2df3c5c46 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -1,5 +1,5 @@ /* GDB interface for Guile - * Copyright (C) 1996,1997,1999,2000,2001,2002,2004,2009,2011 + * Copyright (C) 1996,1997,1999,2000,2001,2002,2004,2009,2011,2012 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -234,8 +234,7 @@ gdb_binding (SCM name, SCM value) } SCM_BEGIN_FOREIGN_BLOCK; { - SCM var = scm_sym2var (name, SCM_TOP_LEVEL_LOOKUP_CLOSURE, SCM_BOOL_T); - SCM_VARIABLE_SET (var, value); + scm_define (name, value); } SCM_END_FOREIGN_BLOCK; return 0; diff --git a/libguile/goops.c b/libguile/goops.c index 5e846eeae..355e5efa4 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011 +/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -2750,13 +2750,21 @@ SCM_KEYWORD (k_getter, "getter"); SCM scm_ensure_accessor (SCM name) { - SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F); + SCM var, gf; + + var = scm_module_variable (scm_current_module (), name); + if (SCM_VARIABLEP (var) && !SCM_UNBNDP (SCM_VARIABLE_REF (var))) + gf = SCM_VARIABLE_REF (var); + else + gf = SCM_BOOL_F; + if (!SCM_IS_A_P (gf, scm_class_accessor)) { gf = scm_make (scm_list_3 (scm_class_generic, k_name, name)); gf = scm_make (scm_list_5 (scm_class_accessor, k_name, name, k_setter, gf)); } + return gf; } diff --git a/libguile/macros.c b/libguile/macros.c index 2a9b9a45b..47b252d85 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 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 @@ -92,8 +92,8 @@ SCM_DEFINE (scm_make_syntax_transformer, "make-syntax-transformer", 3, 0, 0, SCM existing_var; SCM_VALIDATE_SYMBOL (1, name); - existing_var = scm_sym2var (name, scm_current_module_lookup_closure (), - SCM_BOOL_F); + + existing_var = scm_module_variable (scm_current_module (), name); if (scm_is_true (existing_var) && scm_is_true (scm_variable_bound_p (existing_var)) && SCM_MACROP (SCM_VARIABLE_REF (existing_var))) diff --git a/libguile/modules.c b/libguile/modules.c index a5150f8c7..d87ec7a64 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -80,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 : scm_the_root_module (); + if (scm_module_system_booted_p) + return scm_fluid_ref (the_module); + else + return SCM_BOOL_F; } #undef FUNC_NAME @@ -235,38 +236,6 @@ scm_c_export (const char *name, ...) } -/* Environments */ - -SCM_SYMBOL (sym_module, "module"); - -SCM -scm_lookup_closure_module (SCM proc) -{ - if (scm_is_false (proc)) - return scm_the_root_module (); - else if (SCM_EVAL_CLOSURE_P (proc)) - return SCM_PACK (SCM_SMOB_DATA (proc)); - else - { - SCM mod; - - /* FIXME: The `module' property is no longer set on eval closures, as it - introduced a circular reference that precludes garbage collection of - modules with the current weak hash table semantics (see - http://lists.gnu.org/archive/html/guile-devel/2009-01/msg00102.html and - http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/2465 - for details). Since it doesn't appear to be used (only in this - function, which has 1 caller), we no longer extend - `set-module-eval-closure!' to set the `module' property. */ - abort (); - - mod = scm_procedure_property (proc, sym_module); - if (scm_is_false (mod)) - mod = scm_the_root_module (); - return mod; - } -} - /* * C level implementation of the standard eval closure * @@ -519,84 +488,37 @@ 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<<0) -#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \ - (SCM_SMOB_FLAGS (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<<16), - SCM_UNPACK (module)); -} -#undef FUNC_NAME + if (scm_is_false (var)) + { + var = scm_make_variable (SCM_UNDEFINED); + SCM_SETCDR (handle, var); + } -SCM_DEFINE (scm_eval_closure_module, - "eval-closure-module", 1, 0, 0, - (SCM eval_closure), - "Return the module associated with this eval closure.") -/* the idea is that eval closures are really not the way to do things, they're - superfluous given our module system. this function lets mmacros migrate away - from eval closures. */ -#define FUNC_NAME s_scm_eval_closure_module -{ - SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P, - "eval-closure"); - return SCM_SMOB_OBJECT (eval_closure); + return var; + } } #undef FUNC_NAME -SCM -scm_module_lookup_closure (SCM module) -{ - if (scm_is_false (module)) - 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_SYMBOL (sym_macroexpand, "macroexpand"); SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0, @@ -676,61 +598,6 @@ scm_module_public_interface (SCM module) return scm_call_1 (SCM_VARIABLE_REF (module_public_interface_var), module); } -/* 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_sym2var (SCM sym, SCM proc, SCM definep) -#define FUNC_NAME "scm_sym2var" -{ - SCM var; - - if (SCM_HEAP_OBJECT_P (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; - - 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_true (var) && !SCM_VARIABLEP (var)) - SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym)); - - return var; -} -#undef FUNC_NAME - SCM scm_c_module_lookup (SCM module, const char *name) { @@ -742,9 +609,7 @@ scm_module_lookup (SCM module, SCM sym) #define FUNC_NAME "module-lookup" { SCM var; - SCM_VALIDATE_MODULE (1, module); - - var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); + var = scm_module_variable (module, sym); if (scm_is_false (var)) unbound_variable (FUNC_NAME, sym); return var; @@ -760,11 +625,7 @@ scm_c_lookup (const char *name) SCM scm_lookup (SCM sym) { - SCM var = - scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); - if (scm_is_false (var)) - unbound_variable (NULL, sym); - return var; + return scm_module_lookup (scm_current_module (), sym); } SCM @@ -896,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 @@ -917,11 +778,9 @@ SCM_DEFINE (scm_define, "define!", 2, 0, 0, "not a macro.") #define FUNC_NAME s_scm_define { - SCM var; SCM_VALIDATE_SYMBOL (SCM_ARG1, sym); - var = scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T); - SCM_VARIABLE_SET (var, value); - return var; + + return scm_module_define (scm_current_module (), sym, value); } #undef FUNC_NAME @@ -1009,9 +868,6 @@ 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_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0); - the_module = scm_make_fluid (); } diff --git a/libguile/modules.h b/libguile/modules.h index 07dc2c3c4..28df6c6ea 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008, 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 @@ -64,16 +64,10 @@ SCM_API scm_t_bits scm_module_tag; #define SCM_MODULE_IMPORT_OBARRAY(module) \ SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray]) -SCM_API scm_t_bits scm_tc16_eval_closure; - -#define SCM_EVAL_CLOSURE_P(x) SCM_TYP16_PREDICATE (scm_tc16_eval_closure, x) - SCM_API SCM scm_current_module (void); SCM_API SCM scm_the_root_module (void); -SCM_API SCM scm_module_variable (SCM module, SCM sym); -SCM_API SCM scm_module_local_variable (SCM module, SCM sym); SCM_API SCM scm_interaction_environment (void); SCM_API SCM scm_set_current_module (SCM module); @@ -81,6 +75,10 @@ SCM_API SCM scm_c_call_with_current_module (SCM module, SCM (*func)(void *), void *data); SCM_API void scm_dynwind_current_module (SCM module); +SCM_API SCM scm_module_variable (SCM module, SCM sym); +SCM_API SCM scm_module_local_variable (SCM module, SCM sym); +SCM_API SCM scm_module_ensure_local_variable (SCM module, SCM sym); + SCM_API SCM scm_c_lookup (const char *name); SCM_API SCM scm_c_define (const char *name, SCM val); SCM_API SCM scm_lookup (SCM symbol); @@ -115,20 +113,11 @@ SCM_API SCM scm_c_define_module (const char *name, SCM_API void scm_c_use_module (const char *name); SCM_API void scm_c_export (const char *name, ...); -SCM_API SCM scm_sym2var (SCM sym, SCM thunk, SCM definep); - SCM_API SCM scm_module_public_interface (SCM module); SCM_API SCM scm_module_import_interface (SCM module, SCM sym); -SCM_API SCM scm_module_lookup_closure (SCM module); SCM_API SCM scm_module_transformer (SCM module); -SCM_API SCM scm_current_module_lookup_closure (void); SCM_API SCM scm_current_module_transformer (void); -SCM_API SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); -SCM_API SCM scm_standard_eval_closure (SCM module); -SCM_API SCM scm_standard_interface_eval_closure (SCM module); -SCM_API SCM scm_eval_closure_module (SCM eval_closure); /* deprecated already */ SCM_API SCM scm_get_pre_modules_obarray (void); -SCM_API SCM scm_lookup_closure_module (SCM proc); SCM_INTERNAL void scm_modules_prehistory (void); SCM_INTERNAL void scm_init_modules (void); diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index a542e8ea1..a05326868 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1412,9 +1412,7 @@ VM_DEFINE_INSTRUCTION (84, define, "define", 0, 0, 2) SCM sym, val; POP2 (sym, val); SYNC_REGISTER (); - VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (), - SCM_BOOL_T), - val); + scm_define (sym, val); NEXT; } diff --git a/libguile/vm.c b/libguile/vm.c index 5f8bda1f8..0d9aa4029 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -611,17 +611,10 @@ resolve_variable (SCM what, SCM program_module) { if (SCM_LIKELY (scm_is_symbol (what))) { - if (SCM_LIKELY (scm_is_true (program_module))) - /* might longjmp */ + if (scm_is_true (program_module)) return scm_module_lookup (program_module, what); else - { - SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F); - if (scm_is_false (v)) - scm_misc_error (NULL, "unbound variable: ~S", scm_list_1 (what)); - else - return v; - } + return scm_module_lookup (scm_the_root_module (), what); } else { diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 9add63bbf..14dfb605e 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1839,55 +1839,7 @@ written into the port is returned." ;;; Every module object is of the type 'module-type', which is a record ;;; consisting of the following members: ;;; -;;; - eval-closure: the function that defines for its module the strategy that -;;; shall be followed when looking up symbols in the module. -;;; -;;; An eval-closure is a function taking two arguments: the symbol to be -;;; looked up and a boolean value telling whether a binding for the symbol -;;; should be created if it does not exist yet. If the symbol lookup -;;; succeeded (either because an existing binding was found or because a new -;;; binding was created), a variable object representing the binding is -;;; returned. Otherwise, the value #f is returned. Note that the eval -;;; closure does not take the module to be searched as an argument: During -;;; construction of the eval-closure, the eval-closure has to store the -;;; module it belongs to in its environment. This means, that any -;;; eval-closure can belong to only one module. -;;; -;;; The eval-closure of a module can be defined arbitrarily. However, three -;;; special cases of eval-closures are to be distinguished: During startup -;;; the module system is not yet activated. In this phase, no modules are -;;; defined and all bindings are automatically stored by the system in the -;;; pre-modules-obarray. Since no eval-closures exist at this time, the -;;; functions which require an eval-closure as their argument need to be -;;; passed the value #f. -;;; -;;; The other two special cases of eval-closures are the -;;; standard-eval-closure and the standard-interface-eval-closure. Both -;;; behave equally for the case that no new binding is to be created. The -;;; difference between the two comes in, when the boolean argument to the -;;; eval-closure indicates that a new binding shall be created if it is not -;;; found. -;;; -;;; Given that no new binding shall be created, both standard eval-closures -;;; define the following standard strategy of searching bindings in the -;;; module: First, the module's obarray is searched for the symbol. Second, -;;; if no binding for the symbol was found in the module's obarray, the -;;; module's binder procedure is exececuted. If this procedure did not -;;; return a binding for the symbol, the modules referenced in the module's -;;; uses list are recursively searched for a binding of the symbol. If the -;;; binding can not be found in these modules also, the symbol lookup has -;;; failed. -;;; -;;; If a new binding shall be created, the standard-interface-eval-closure -;;; immediately returns indicating failure. That is, it does not even try -;;; to look up the symbol. In contrast, the standard-eval-closure would -;;; first search the obarray, and if no binding was found there, would -;;; create a new binding in the obarray, therefore not calling the binder -;;; procedure or searching the modules in the uses list. -;;; -;;; The explanation of the following members obarray, binder and uses -;;; assumes that the symbol lookup follows the strategy that is defined in -;;; the standard-eval-closure and the standard-interface-eval-closure. +;;; - eval-closure: A deprecated field, to be removed in Guile 2.2. ;;; ;;; - obarray: a hash table that maps symbols to variable objects. In this ;;; hash table, the definitions are found that are local to the module (that @@ -2095,7 +2047,6 @@ written into the port is returned." ;; NOTE: If you change the set of fields or their order, you also need to ;; change the constants in libguile/modules.h. ;; - ;; NOTE: The getter `module-eval-closure' is used in libguile/modules.c. ;; NOTE: The getter `module-transfomer' is defined libguile/modules.c. ;; NOTE: The getter `module-name' is defined later, due to boot reasons. ;; NOTE: The getter `module-public-interface' is used in libguile/modules.c. @@ -2135,20 +2086,13 @@ written into the port is returned." (error "Lazy-binder expected to be a procedure or #f." binder)) - (let ((module (module-constructor (make-hash-table size) - uses binder #f macroexpand - #f #f #f - (make-hash-table) - '() - (make-weak-key-hash-table 31) #f - (make-hash-table 7) #f #f #f))) - - ;; We can't pass this as an argument to module-constructor, - ;; because we need it to close over a pointer to the module - ;; itself. - (set-module-eval-closure! module (standard-eval-closure module)) - - module)) + (module-constructor (make-hash-table size) + uses binder #f macroexpand + #f #f #f + (make-hash-table) + '() + (make-weak-key-hash-table 31) #f + (make-hash-table 7) #f #f #f)) @@ -2715,9 +2659,6 @@ written into the port is returned." ;;; better thought of as a root. ;;; -(define (set-system-module! m s) - (set-procedure-property! (module-eval-closure m) 'system-module s)) - ;; The root module uses the pre-modules-obarray as its obarray. This ;; special obarray accumulates all bindings that have been established ;; before the module system is fully booted. @@ -2729,7 +2670,6 @@ written into the port is returned." (let ((m (make-module 0))) (set-module-obarray! m (%get-pre-modules-obarray)) (set-module-name! m '(guile)) - (set-system-module! m #t) m)) ;; The root interface is a module that uses the same obarray as the @@ -2738,10 +2678,8 @@ written into the port is returned." (define the-scm-module (let ((m (make-module 0))) (set-module-obarray! m (%get-pre-modules-obarray)) - (set-module-eval-closure! m (standard-interface-eval-closure m)) (set-module-name! m '(guile)) (set-module-kind! m 'interface) - (set-system-module! m #t) ;; In Guile 1.8 and earlier M was its own public interface. (set-module-public-interface! m m) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 6b39e7a7c..85d07e8bf 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2005, 2006, 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 diff --git a/module/oop/goops/util.scm b/module/oop/goops/util.scm index 69bb898bf..3c86f1525 100644 --- a/module/oop/goops/util.scm +++ b/module/oop/goops/util.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008, 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 @@ -17,7 +17,7 @@ (define-module (oop goops util) - :export (mapappend find-duplicate top-level-env top-level-env? + :export (mapappend find-duplicate map* for-each* length* improper->proper) :use-module (srfi srfi-1) :re-export (any every) @@ -37,16 +37,6 @@ ((memv (car l) (cdr l)) (car l)) (else (find-duplicate (cdr l))))) -(define (top-level-env) - (let ((mod (current-module))) - (if mod - (module-eval-closure mod) - '()))) - -(define (top-level-env? env) - (or (null? env) - (procedure? (car env)))) - (define (map* fn . l) ; A map which accepts dotted lists (arg lists (cond ; must be "isomorph" ((null? (car l)) '()) |