guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-161-g2de74


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-161-g2de74cb
Date: Wed, 23 May 2012 10:30:51 +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=2de74cb56e3af44ce624638facfa061603d39c0d

The branch, stable-2.0 has been updated
       via  2de74cb56e3af44ce624638facfa061603d39c0d (commit)
       via  3f48638c8c82d7839b75204e475af691fcd67c33 (commit)
       via  62e15979b5d773dda79c4f44c07e919b5d0f6e18 (commit)
      from  15bb587f45b718f08756993fec9274212cc7df58 (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 2de74cb56e3af44ce624638facfa061603d39c0d
Author: Andy Wingo <address@hidden>
Date:   Wed May 23 12:11:08 2012 +0200

    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!.

commit 3f48638c8c82d7839b75204e475af691fcd67c33
Author: Andy Wingo <address@hidden>
Date:   Wed May 23 12:00:23 2012 +0200

    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.

commit 62e15979b5d773dda79c4f44c07e919b5d0f6e18
Author: Andy Wingo <address@hidden>
Date:   Wed May 23 11:46:30 2012 +0200

    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.

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

Summary of changes:
 doc/ref/api-modules.texi    |   11 +++
 libguile/deprecated.c       |  188 +++++++++++++++++++++++++++++++++++++++-
 libguile/deprecated.h       |   25 +++++
 libguile/eval.h             |    6 +-
 libguile/gdbint.c           |    5 +-
 libguile/goops.c            |   12 ++-
 libguile/macros.c           |    6 +-
 libguile/modules.c          |  204 +++++++------------------------------------
 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 |   14 +++-
 module/oop/goops/util.scm   |   21 +++--
 14 files changed, 310 insertions(+), 296 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 530d2d4..61fa8e2 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
@@ -2639,11 +2639,197 @@ 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
+
+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;
+}
+
+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
+
+
+
+
 void
 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 2b85bef..2970262 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -810,6 +810,31 @@ 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);
+
+
+
+/* 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);
+
+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);
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
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 77fdbd1..7a0ebc9 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 2f9cf30..f4b2b34 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/macros.c b/libguile/macros.c
index a0b1401..fe33e7e 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 6c3f262..7b42a3d 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
 
@@ -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_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 +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
 
@@ -1017,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 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 5c808a0..40d26af 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 db5e58c..5dec106 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
     {
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a13e925..f4ed1df 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 b631b5f..9d80cfe 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 69bb898..af72bc3 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"


hooks/post-receive
-- 
GNU Guile



reply via email to

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