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 530d2d425..c19d58b85 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 @@ -2637,6 +2637,64 @@ scm_i_deprecated_asrtgo (scm_t_bits condition) } + + + +/* 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 (definep) + scm_c_issue_deprecation_warning + ("scm_sym2var is deprecated. Use scm_define or scm_module_define\n" + "to define variables. In some rare cases you may need\n" + "scm_module_ensure_local_variable."); + else + scm_c_issue_deprecation_warning + ("scm_sym2var is deprecated. Use scm_module_variable to look up\n" + "variables."); + + 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 + { + if (scm_is_false (definep)) + var = scm_module_variable (scm_the_root_module (), sym); + else + var = scm_module_ensure_local_variable (scm_the_root_module (), sym); + } + + 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 + + void diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 2b85bef6a..be6cd81db 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -810,6 +810,13 @@ SCM_DEPRECATED scm_t_bits scm_i_deprecated_asrtgo (scm_t_bits condition); +/* Deprecated 23-05-2012, as as it's undocumented, poorly named, and + adequately replaced by scm_module_variable / + scm_ensure_module_variable / scm_define / scm_module_define. */ +SCM_DEPRECATED SCM scm_sym2var (SCM sym, SCM thunk, SCM definep); + + + void scm_i_init_deprecated (void); #endif diff --git a/libguile/gdbint.c b/libguile/gdbint.c index 77fdbd17a..7a0ebc985 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/macros.c b/libguile/macros.c index a0b140126..fe33e7e48 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 6c3f2629e..9ccbad38b 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011 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 @@ -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 @@ -519,6 +520,37 @@ SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0, } #undef FUNC_NAME +SCM +scm_module_ensure_local_variable (SCM module, SCM sym) +#define FUNC_NAME "module-ensure-local-variable" +{ + if (SCM_LIKELY (scm_module_system_booted_p)) + { + 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); + } + + { + SCM handle, var; + + 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); + } + + return var; + } +} +#undef FUNC_NAME + scm_t_bits scm_tc16_eval_closure; #define SCM_F_EVAL_CLOSURE_INTERFACE (1<<0) @@ -676,61 +708,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_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; - - 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 +719,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 +735,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 +867,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 +888,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 diff --git a/libguile/modules.h b/libguile/modules.h index 07dc2c3c4..a67ec0897 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 @@ -72,8 +72,6 @@ SCM_API scm_t_bits scm_tc16_eval_closure; 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 +79,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,8 +117,6 @@ 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); diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 5c808a08b..40d26afa0 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1446,9 +1446,7 @@ VM_DEFINE_INSTRUCTION (82, 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 db5e58ca0..5dec106a5 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -610,17 +610,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 {