From 62e15979b5d773dda79c4f44c07e919b5d0f6e18 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 23 May 2012 11:46:30 +0200
Subject: [PATCH 1/3] deprecate scm_sym2var

* libguile/deprecated.h:
* libguile/deprecated.c (scm_sym2var): Deprecate this function.

* libguile/modules.h:
* libguile/modules.c (scm_module_ensure_local_variable): New public
  function, replacing scm_sym2var with a true definep, without going
  through eval closures (which are deprecated).
  (scm_current_module): Rework to do something sensible before modules
  are booted.
  (scm_module_lookup, scm_lookup): Refactor to use scm_module_variable.
  (scm_module_define, scm_define): Refactor to use
  scm_module_ensure_local_variable.

* libguile/vm-i-system.c (define!): Use scm_define.

* libguile/vm.c (resolve_variable): Use scm_module_lookup.

* libguile/macros.c (scm_make_syntax_transformer): Use
  scm_module_variable.

* libguile/gdbint.c (gdb_binding): Use scm_define.

* doc/ref/api-modules.texi (Accessing Modules from C): Add docs for
  scm_module_ensure_local_variable.
---
 doc/ref/api-modules.texi |  11 ++++
 libguile/deprecated.c    |  60 +++++++++++++++++++-
 libguile/deprecated.h    |   7 +++
 libguile/gdbint.c        |   5 +-
 libguile/macros.c        |   6 +-
 libguile/modules.c       | 115 ++++++++++++++-------------------------
 libguile/modules.h       |  10 ++--
 libguile/vm-i-system.c   |   4 +-
 libguile/vm.c            |  11 +---
 9 files changed, 132 insertions(+), 97 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 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
     {

From 3f48638c8c82d7839b75204e475af691fcd67c33 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 23 May 2012 12:00:23 +0200
Subject: [PATCH 2/3] deprecate lookup closures

* libguile/deprecated.h (SCM_TOP_LEVEL_LOOKUP_CLOSURE):
* libguile/deprecated.c (scm_lookup_closure_module):
  (scm_module_lookup_closure):
  (scm_current_module_lookup_closure): Deprecate this part of the eval
  closure interface.  It was unused internally, after the scm_sym2var
  refactor.

* libguile/eval.h:
* libguile/modules.c:
* libguile/modules.h: Remove deprecated code.

* libguile/goops.c (scm_ensure_accessor): Use scm_module_variable
  instead of calling the lookup closure.  However I'm not sure that this
  code is used at all.
---
 libguile/deprecated.c | 49 ++++++++++++++++++++++++++++++++++++++++++
 libguile/deprecated.h | 10 +++++++++
 libguile/eval.h       |  6 +-----
 libguile/goops.c      | 12 +++++++++--
 libguile/modules.c    | 50 -------------------------------------------
 libguile/modules.h    |  3 ---
 6 files changed, 70 insertions(+), 60 deletions(-)

diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index c19d58b85..a41f45461 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2694,6 +2694,55 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
 }
 #undef FUNC_NAME
 
+SCM
+scm_lookup_closure_module (SCM proc)
+{
+  scm_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  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
+    /* 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 ();
+}
+
+SCM
+scm_module_lookup_closure (SCM module)
+{
+  scm_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  if (scm_is_false (module))
+    return SCM_BOOL_F;
+  else
+    return SCM_MODULE_EVAL_CLOSURE (module);
+}
+
+SCM
+scm_current_module_lookup_closure ()
+{
+  scm_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  if (scm_module_system_booted_p)
+    return scm_module_lookup_closure (scm_current_module ());
+  else
+    return SCM_BOOL_F;
+}
+
 
 
 
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index be6cd81db..e777d2f80 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -815,6 +815,16 @@ SCM_DEPRECATED scm_t_bits scm_i_deprecated_asrtgo (scm_t_bits condition);
    scm_ensure_module_variable / scm_define / scm_module_define.  */
 SCM_DEPRECATED SCM scm_sym2var (SCM sym, SCM thunk, SCM definep);
 
+
+
+/* Eval closure deprecation, 23-05-2012.  */
+#define SCM_TOP_LEVEL_LOOKUP_CLOSURE (scm_current_module_lookup_closure())
+
+SCM_DEPRECATED SCM scm_lookup_closure_module (SCM proc);
+SCM_DEPRECATED SCM scm_module_lookup_closure (SCM module);
+SCM_DEPRECATED SCM scm_current_module_lookup_closure (void);
+
+
 
 
 void scm_i_init_deprecated (void);
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/goops.c b/libguile/goops.c
index 2f9cf30b9..f4b2b34ef 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
@@ -2765,13 +2765,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/modules.c b/libguile/modules.c
index 9ccbad38b..a7c0c0ce9 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -236,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
  *
@@ -611,24 +579,6 @@ SCM_DEFINE (scm_eval_closure_module,
 }
 #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,
diff --git a/libguile/modules.h b/libguile/modules.h
index a67ec0897..dee77ff92 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -119,16 +119,13 @@ SCM_API void scm_c_export (const char *name, ...);
 
 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);

From 2de74cb56e3af44ce624638facfa061603d39c0d Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 23 May 2012 12:11:08 +0200
Subject: [PATCH 3/3] finish deprecating eval closures

* libguile/deprecated.h:
* libguile/deprecated.c (scm_eval_closure_lookup)
  (scm_standard_eval_closure, scm_standard_interface_eval_closure)
  (scm_eval_closure_module): Deprecate these, as they are unused.

* libguile/modules.h:
* libguile/modules.c: Remove deprecated code.

* module/oop/goops/util.scm (top-level-env, top-level-env?): Deprecate.

* module/ice-9/deprecated.scm (set-system-module!): Deprecate.
  (module-eval-closure): Deprecate, by overriding the core definition to
  return a fresh eval closure.

* module/ice-9/boot-9.scm (make-module): Don't set an eval closure on
  the module.
  (the-root-module, the-scm-module): Don't call set-system-module!.
---
 libguile/deprecated.c       | 79 +++++++++++++++++++++++++++++++++++++
 libguile/deprecated.h       |  8 ++++
 libguile/modules.c          | 63 -----------------------------
 libguile/modules.h          |  8 ----
 module/ice-9/boot-9.scm     | 78 ++++--------------------------------
 module/ice-9/deprecated.scm | 14 ++++++-
 module/oop/goops/util.scm   | 21 +++++-----
 7 files changed, 120 insertions(+), 151 deletions(-)

diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index a41f45461..61fa8e271 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2743,6 +2743,82 @@ scm_current_module_lookup_closure ()
     return SCM_BOOL_F;
 }
 
+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 = SCM_PACK (SCM_SMOB_DATA (eclo));
+
+  scm_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  if (scm_is_true (definep))
+    {
+      if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
+	return SCM_BOOL_F;
+      return scm_module_ensure_local_variable (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_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module));
+}
+#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_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  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_c_issue_deprecation_warning
+    ("Eval closures are deprecated.  See \"Accessing Modules From C\" in\n"
+     "the manual, for replacements.");
+
+  SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P,
+                         "eval-closure");
+  return SCM_SMOB_OBJECT (eval_closure);
+}
+#undef FUNC_NAME
+
 
 
 
@@ -2751,6 +2827,9 @@ scm_i_init_deprecated ()
 {
   properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
   scm_struct_table = scm_make_hash_table (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);
+
 #include "libguile/deprecated.x"
 }
 
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index e777d2f80..2970262b2 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -824,6 +824,14 @@ SCM_DEPRECATED SCM scm_lookup_closure_module (SCM proc);
 SCM_DEPRECATED SCM scm_module_lookup_closure (SCM module);
 SCM_DEPRECATED SCM scm_current_module_lookup_closure (void);
 
+SCM_DEPRECATED scm_t_bits scm_tc16_eval_closure;
+
+#define SCM_EVAL_CLOSURE_P(x)	SCM_TYP16_PREDICATE (scm_tc16_eval_closure, x)
+
+SCM_DEPRECATED SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
+SCM_DEPRECATED SCM scm_standard_eval_closure (SCM module);
+SCM_DEPRECATED SCM scm_standard_interface_eval_closure (SCM module);
+SCM_DEPRECATED SCM scm_eval_closure_module (SCM eval_closure);
 
 
 
diff --git a/libguile/modules.c b/libguile/modules.c
index a7c0c0ce9..7b42a3d43 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -519,66 +519,6 @@ scm_module_ensure_local_variable (SCM module, SCM sym)
 }
 #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 = SCM_PACK (SCM_SMOB_DATA (eclo));
-  if (scm_is_true (definep))
-    {
-      if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
-	return SCM_BOOL_F;
-      return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var),
-			 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_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_SYMBOL (sym_macroexpand, "macroexpand");
 
 SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
@@ -936,9 +876,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 dee77ff92..28df6c6ea 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -64,10 +64,6 @@ 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);
@@ -121,10 +117,6 @@ 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_transformer (SCM module);
 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_INTERNAL void scm_modules_prehistory (void);
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a13e92591..f4ed1df38 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1524,55 +1524,7 @@ VALUE."
 ;;; 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
@@ -1780,7 +1732,6 @@ VALUE."
   ;; 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.
@@ -1824,20 +1775,13 @@ VALUE."
       (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 %default-import-size)
-                                    '()
-                                    (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 %default-import-size)
+                      '()
+                      (make-weak-key-hash-table 31) #f
+                      (make-hash-table 7) #f #f #f))
 
 
 
@@ -2431,9 +2375,6 @@ VALUE."
 ;;; 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.
@@ -2445,7 +2386,6 @@ VALUE."
   (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
@@ -2454,10 +2394,8 @@ VALUE."
 (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 b631b5f42..9d80cfe65 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -69,7 +69,8 @@
             turn-on-debugging
             read-hash-procedures
             process-define-module
-            fluid-let-syntax))
+            fluid-let-syntax
+            set-system-module!))
 
 
 ;;;; Deprecated definitions.
@@ -884,3 +885,14 @@ it.")
   (issue-deprecation-warning
    "`close-io-port' is deprecated.  Use `close-port' instead.")
   (close-port port))
+
+(define (set-system-module! m s)
+  (issue-deprecation-warning
+   "`set-system-module!' is deprecated.  There is no need to use it.")
+  (set-procedure-property! (module-eval-closure m) 'system-module s))
+
+(set! module-eval-closure
+      (lambda (m)
+        (issue-deprecation-warning
+         "`module-eval-closure' is deprecated.  Use module-variable or module-define! instead.")
+        (standard-eval-closure m)))
diff --git a/module/oop/goops/util.scm b/module/oop/goops/util.scm
index 69bb898bf..af72bc3f5 100644
--- a/module/oop/goops/util.scm
+++ b/module/oop/goops/util.scm
@@ -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,15 +37,18 @@
     ((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)
-	'())))
+(begin-deprecated
+ (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 (top-level-env? env)
+   (or (null? env)
+       (procedure? (car env))))
+
+ (export top-level-env? top-level-env))
 
 (define (map* fn . l) 		; A map which accepts dotted lists (arg lists  
   (cond 			; must be "isomorph"