guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-289-g747747e


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-289-g747747e
Date: Wed, 23 May 2012 10:39:20 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=747747ee06ac64c224b91e8f64f810a1159c1675

The branch, master has been updated
       via  747747ee06ac64c224b91e8f64f810a1159c1675 (commit)
       via  2de74cb56e3af44ce624638facfa061603d39c0d (commit)
       via  3f48638c8c82d7839b75204e475af691fcd67c33 (commit)
       via  62e15979b5d773dda79c4f44c07e919b5d0f6e18 (commit)
      from  4df52c924dad7c7450dea61186b0820b5da844d1 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 747747ee06ac64c224b91e8f64f810a1159c1675
Merge: 4df52c9 2de74cb
Author: Andy Wingo <address@hidden>
Date:   Wed May 23 12:38:56 2012 +0200

    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

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-modules.texi    |   11 +++
 libguile/deprecated.c       |    3 +-
 libguile/deprecated.h       |    2 +-
 libguile/eval.h             |    6 +-
 libguile/gdbint.c           |    5 +-
 libguile/goops.c            |   12 ++-
 libguile/macros.c           |    6 +-
 libguile/modules.c          |  202 ++++++------------------------------------
 libguile/modules.h          |   21 +----
 libguile/vm-i-system.c      |    4 +-
 libguile/vm.c               |   11 +--
 module/ice-9/boot-9.scm     |   78 ++---------------
 module/ice-9/deprecated.scm |    2 +-
 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 c91c2d4..17ab462 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
address@hidden would have accessed, without changing the
+binding of the existing variable, if one is present.  In that case, use
address@hidden:
+
address@hidden {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.
address@hidden 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 e6ef917..cf44024 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 d116671..8588c19 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 014f0de..9e5f654 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 b502c7c..2df3c5c 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 5e846ee..355e5ef 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 2a9b9a4..47b252d 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 a5150f8..d87ec7a 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 07dc2c3..28df6c6 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 a542e8e..a053268 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 5f8bda1..0d9aa40 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 9add63b..14dfb60 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 6b39e7a..85d07e8 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 69bb898..3c86f15 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)) '())


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]