mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 17:20:29 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
This commit removes code that was newly deprecated in stable-2.0. Conflicts: libguile/deprecated.c libguile/deprecated.h libguile/modules.c module/ice-9/boot-9.scm module/ice-9/deprecated.scm
This commit is contained in:
commit
747747ee06
14 changed files with 81 additions and 302 deletions
|
@ -1008,6 +1008,17 @@ Like @code{scm_c_define} and @code{scm_define}, but the specified
|
||||||
module is used instead of the current one.
|
module is used instead of the current one.
|
||||||
@end deftypefn
|
@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})
|
@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}.
|
Find the symbol that is bound to @var{variable} in @var{module}. When no such binding is found, return @code{#f}.
|
||||||
@end deftypefn
|
@end deftypefn
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
deprecate something, move it here when that is feasible.
|
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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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
|
void
|
||||||
scm_i_init_deprecated ()
|
scm_i_init_deprecated ()
|
||||||
{
|
{
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
#ifndef SCM_DEPRECATED_H
|
#ifndef SCM_DEPRECATED_H
|
||||||
#define 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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_EVAL_H
|
#ifndef SCM_EVAL_H
|
||||||
#define 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.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* 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
|
#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);
|
SCM_API SCM scm_call_0 (SCM proc);
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
/* GDB interface for Guile
|
/* 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.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* 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_BEGIN_FOREIGN_BLOCK;
|
||||||
{
|
{
|
||||||
SCM var = scm_sym2var (name, SCM_TOP_LEVEL_LOOKUP_CLOSURE, SCM_BOOL_T);
|
scm_define (name, value);
|
||||||
SCM_VARIABLE_SET (var, value);
|
|
||||||
}
|
}
|
||||||
SCM_END_FOREIGN_BLOCK;
|
SCM_END_FOREIGN_BLOCK;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
|
@ -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.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
|
@ -2750,13 +2750,21 @@ SCM_KEYWORD (k_getter, "getter");
|
||||||
SCM
|
SCM
|
||||||
scm_ensure_accessor (SCM name)
|
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))
|
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_3 (scm_class_generic, k_name, name));
|
||||||
gf = scm_make (scm_list_5 (scm_class_accessor,
|
gf = scm_make (scm_list_5 (scm_class_accessor,
|
||||||
k_name, name, k_setter, gf));
|
k_name, name, k_setter, gf));
|
||||||
}
|
}
|
||||||
|
|
||||||
return gf;
|
return gf;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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 existing_var;
|
||||||
|
|
||||||
SCM_VALIDATE_SYMBOL (1, name);
|
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)
|
if (scm_is_true (existing_var)
|
||||||
&& scm_is_true (scm_variable_bound_p (existing_var))
|
&& scm_is_true (scm_variable_bound_p (existing_var))
|
||||||
&& SCM_MACROP (SCM_VARIABLE_REF (existing_var)))
|
&& SCM_MACROP (SCM_VARIABLE_REF (existing_var)))
|
||||||
|
|
|
@ -80,9 +80,10 @@ SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
|
||||||
"Return the current module.")
|
"Return the current module.")
|
||||||
#define FUNC_NAME s_scm_current_module
|
#define FUNC_NAME s_scm_current_module
|
||||||
{
|
{
|
||||||
SCM curr = scm_fluid_ref (the_module);
|
if (scm_module_system_booted_p)
|
||||||
|
return scm_fluid_ref (the_module);
|
||||||
return scm_is_true (curr) ? curr : scm_the_root_module ();
|
else
|
||||||
|
return SCM_BOOL_F;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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
|
* 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
|
#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
|
||||||
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_LIKELY (scm_module_system_booted_p))
|
||||||
if (scm_is_true (definep))
|
|
||||||
{
|
{
|
||||||
if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
|
SCM_VALIDATE_MODULE (1, module);
|
||||||
return SCM_BOOL_F;
|
SCM_VALIDATE_SYMBOL (2, sym);
|
||||||
|
|
||||||
return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var),
|
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),
|
SCM handle, var;
|
||||||
"Return an eval closure for the module @var{module}.")
|
|
||||||
#define FUNC_NAME s_scm_standard_eval_closure
|
handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
|
||||||
{
|
sym, SCM_BOOL_F);
|
||||||
SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module));
|
var = SCM_CDR (handle);
|
||||||
|
|
||||||
|
if (scm_is_false (var))
|
||||||
|
{
|
||||||
|
var = scm_make_variable (SCM_UNDEFINED);
|
||||||
|
SCM_SETCDR (handle, var);
|
||||||
|
}
|
||||||
|
|
||||||
|
return var;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
#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_SYMBOL (sym_macroexpand, "macroexpand");
|
||||||
|
|
||||||
SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
|
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);
|
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
|
||||||
scm_c_module_lookup (SCM module, const char *name)
|
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"
|
#define FUNC_NAME "module-lookup"
|
||||||
{
|
{
|
||||||
SCM var;
|
SCM var;
|
||||||
SCM_VALIDATE_MODULE (1, module);
|
var = scm_module_variable (module, sym);
|
||||||
|
|
||||||
var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
|
|
||||||
if (scm_is_false (var))
|
if (scm_is_false (var))
|
||||||
unbound_variable (FUNC_NAME, sym);
|
unbound_variable (FUNC_NAME, sym);
|
||||||
return var;
|
return var;
|
||||||
|
@ -760,11 +625,7 @@ scm_c_lookup (const char *name)
|
||||||
SCM
|
SCM
|
||||||
scm_lookup (SCM sym)
|
scm_lookup (SCM sym)
|
||||||
{
|
{
|
||||||
SCM var =
|
return scm_module_lookup (scm_current_module (), sym);
|
||||||
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
|
|
||||||
if (scm_is_false (var))
|
|
||||||
unbound_variable (NULL, sym);
|
|
||||||
return var;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
@ -896,10 +757,10 @@ scm_module_define (SCM module, SCM sym, SCM value)
|
||||||
#define FUNC_NAME "module-define"
|
#define FUNC_NAME "module-define"
|
||||||
{
|
{
|
||||||
SCM var;
|
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);
|
SCM_VARIABLE_SET (var, value);
|
||||||
|
|
||||||
return var;
|
return var;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
@ -917,11 +778,9 @@ SCM_DEFINE (scm_define, "define!", 2, 0, 0,
|
||||||
"not a macro.")
|
"not a macro.")
|
||||||
#define FUNC_NAME s_scm_define
|
#define FUNC_NAME s_scm_define
|
||||||
{
|
{
|
||||||
SCM var;
|
|
||||||
SCM_VALIDATE_SYMBOL (SCM_ARG1, sym);
|
SCM_VALIDATE_SYMBOL (SCM_ARG1, sym);
|
||||||
var = scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T);
|
|
||||||
SCM_VARIABLE_SET (var, value);
|
return scm_module_define (scm_current_module (), sym, value);
|
||||||
return var;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -1009,9 +868,6 @@ scm_init_modules ()
|
||||||
#include "libguile/modules.x"
|
#include "libguile/modules.x"
|
||||||
module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
|
module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
|
||||||
SCM_UNDEFINED);
|
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 ();
|
the_module = scm_make_fluid ();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_MODULES_H
|
#ifndef SCM_MODULES_H
|
||||||
#define 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
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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) \
|
#define SCM_MODULE_IMPORT_OBARRAY(module) \
|
||||||
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray])
|
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_current_module (void);
|
||||||
SCM_API SCM scm_the_root_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_interaction_environment (void);
|
||||||
SCM_API SCM scm_set_current_module (SCM module);
|
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 (*func)(void *), void *data);
|
||||||
SCM_API void scm_dynwind_current_module (SCM module);
|
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_lookup (const char *name);
|
||||||
SCM_API SCM scm_c_define (const char *name, SCM val);
|
SCM_API SCM scm_c_define (const char *name, SCM val);
|
||||||
SCM_API SCM scm_lookup (SCM symbol);
|
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_use_module (const char *name);
|
||||||
SCM_API void scm_c_export (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_public_interface (SCM module);
|
||||||
SCM_API SCM scm_module_import_interface (SCM module, SCM sym);
|
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_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_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_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_modules_prehistory (void);
|
||||||
SCM_INTERNAL void scm_init_modules (void);
|
SCM_INTERNAL void scm_init_modules (void);
|
||||||
|
|
|
@ -1412,9 +1412,7 @@ VM_DEFINE_INSTRUCTION (84, define, "define", 0, 0, 2)
|
||||||
SCM sym, val;
|
SCM sym, val;
|
||||||
POP2 (sym, val);
|
POP2 (sym, val);
|
||||||
SYNC_REGISTER ();
|
SYNC_REGISTER ();
|
||||||
VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (),
|
scm_define (sym, val);
|
||||||
SCM_BOOL_T),
|
|
||||||
val);
|
|
||||||
NEXT;
|
NEXT;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -611,17 +611,10 @@ resolve_variable (SCM what, SCM program_module)
|
||||||
{
|
{
|
||||||
if (SCM_LIKELY (scm_is_symbol (what)))
|
if (SCM_LIKELY (scm_is_symbol (what)))
|
||||||
{
|
{
|
||||||
if (SCM_LIKELY (scm_is_true (program_module)))
|
if (scm_is_true (program_module))
|
||||||
/* might longjmp */
|
|
||||||
return scm_module_lookup (program_module, what);
|
return scm_module_lookup (program_module, what);
|
||||||
else
|
else
|
||||||
{
|
return scm_module_lookup (scm_the_root_module (), what);
|
||||||
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;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
|
|
@ -1839,55 +1839,7 @@ written into the port is returned."
|
||||||
;;; Every module object is of the type 'module-type', which is a record
|
;;; Every module object is of the type 'module-type', which is a record
|
||||||
;;; consisting of the following members:
|
;;; consisting of the following members:
|
||||||
;;;
|
;;;
|
||||||
;;; - eval-closure: the function that defines for its module the strategy that
|
;;; - eval-closure: A deprecated field, to be removed in Guile 2.2.
|
||||||
;;; 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.
|
|
||||||
;;;
|
;;;
|
||||||
;;; - obarray: a hash table that maps symbols to variable objects. In this
|
;;; - 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
|
;;; 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
|
;; NOTE: If you change the set of fields or their order, you also need to
|
||||||
;; change the constants in libguile/modules.h.
|
;; 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-transfomer' is defined libguile/modules.c.
|
||||||
;; NOTE: The getter `module-name' is defined later, due to boot reasons.
|
;; NOTE: The getter `module-name' is defined later, due to boot reasons.
|
||||||
;; NOTE: The getter `module-public-interface' is used in libguile/modules.c.
|
;; NOTE: The getter `module-public-interface' is used in libguile/modules.c.
|
||||||
|
@ -2135,20 +2086,13 @@ written into the port is returned."
|
||||||
(error
|
(error
|
||||||
"Lazy-binder expected to be a procedure or #f." binder))
|
"Lazy-binder expected to be a procedure or #f." binder))
|
||||||
|
|
||||||
(let ((module (module-constructor (make-hash-table size)
|
(module-constructor (make-hash-table size)
|
||||||
uses binder #f macroexpand
|
uses binder #f macroexpand
|
||||||
#f #f #f
|
#f #f #f
|
||||||
(make-hash-table)
|
(make-hash-table)
|
||||||
'()
|
'()
|
||||||
(make-weak-key-hash-table 31) #f
|
(make-weak-key-hash-table 31) #f
|
||||||
(make-hash-table 7) #f #f #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))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -2715,9 +2659,6 @@ written into the port is returned."
|
||||||
;;; better thought of as a root.
|
;;; 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
|
;; The root module uses the pre-modules-obarray as its obarray. This
|
||||||
;; special obarray accumulates all bindings that have been established
|
;; special obarray accumulates all bindings that have been established
|
||||||
;; before the module system is fully booted.
|
;; before the module system is fully booted.
|
||||||
|
@ -2729,7 +2670,6 @@ written into the port is returned."
|
||||||
(let ((m (make-module 0)))
|
(let ((m (make-module 0)))
|
||||||
(set-module-obarray! m (%get-pre-modules-obarray))
|
(set-module-obarray! m (%get-pre-modules-obarray))
|
||||||
(set-module-name! m '(guile))
|
(set-module-name! m '(guile))
|
||||||
(set-system-module! m #t)
|
|
||||||
m))
|
m))
|
||||||
|
|
||||||
;; The root interface is a module that uses the same obarray as the
|
;; 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
|
(define the-scm-module
|
||||||
(let ((m (make-module 0)))
|
(let ((m (make-module 0)))
|
||||||
(set-module-obarray! m (%get-pre-modules-obarray))
|
(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-name! m '(guile))
|
||||||
(set-module-kind! m 'interface)
|
(set-module-kind! m 'interface)
|
||||||
(set-system-module! m #t)
|
|
||||||
|
|
||||||
;; In Guile 1.8 and earlier M was its own public interface.
|
;; In Guile 1.8 and earlier M was its own public interface.
|
||||||
(set-module-public-interface! m m)
|
(set-module-public-interface! m m)
|
||||||
|
|
|
@ -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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
|
|
@ -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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -17,7 +17,7 @@
|
||||||
|
|
||||||
|
|
||||||
(define-module (oop goops util)
|
(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)
|
map* for-each* length* improper->proper)
|
||||||
:use-module (srfi srfi-1)
|
:use-module (srfi srfi-1)
|
||||||
:re-export (any every)
|
:re-export (any every)
|
||||||
|
@ -37,16 +37,6 @@
|
||||||
((memv (car l) (cdr l)) (car l))
|
((memv (car l) (cdr l)) (car l))
|
||||||
(else (find-duplicate (cdr 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
|
(define (map* fn . l) ; A map which accepts dotted lists (arg lists
|
||||||
(cond ; must be "isomorph"
|
(cond ; must be "isomorph"
|
||||||
((null? (car l)) '())
|
((null? (car l)) '())
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue