Merge remote-tracking branch 'local-2.0/stable-2.0'
[bpt/guile.git] / libguile / modules.c
index d59428c..a5150f8 100644 (file)
@@ -1,18 +1,19 @@
-/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008 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 as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -41,12 +42,32 @@ int scm_module_system_booted_p = 0;
 
 scm_t_bits scm_module_tag;
 
+/* The current module, a fluid. */
 static SCM the_module;
 
+/* Most of the module system is implemented in Scheme. These bindings from
+   boot-9 are needed to provide the Scheme interface. */
 static SCM the_root_module_var;
+static SCM module_make_local_var_x_var;
+static SCM define_module_star_var;
+static SCM process_use_modules_var;
+static SCM resolve_module_var;
+static SCM module_public_interface_var;
+static SCM module_export_x_var;
+static SCM default_duplicate_binding_procedures_var;
 
-static SCM
-the_root_module ()
+/* The #:ensure keyword.  */
+static SCM k_ensure;
+
+
+static SCM unbound_variable (const char *func, SCM sym)
+{
+  scm_error (scm_from_latin1_symbol ("unbound-variable"), func,
+             "Unbound variable: ~S", scm_list_1 (sym), SCM_BOOL_F);
+}
+
+SCM
+scm_the_root_module (void)
 {
   if (scm_module_system_booted_p)
     return SCM_VARIABLE_REF (the_root_module_var);
@@ -61,7 +82,7 @@ SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
 {
   SCM curr = scm_fluid_ref (the_module);
 
-  return scm_is_true (curr) ? curr : the_root_module ();
+  return scm_is_true (curr) ? curr : scm_the_root_module ();
 }
 #undef FUNC_NAME
 
@@ -132,7 +153,7 @@ convert_module_name (const char *name)
        ptr++;
       if (ptr > name)
        {
-         SCM sym = scm_from_locale_symboln (name, ptr-name);
+         SCM sym = scm_from_utf8_symboln (name, ptr-name);
          *tail = scm_cons (sym, SCM_EOL);
          tail = SCM_CDRLOC (*tail);
        }
@@ -142,10 +163,6 @@ convert_module_name (const char *name)
   return list;
 }
 
-static SCM process_define_module_var;
-static SCM process_use_modules_var;
-static SCM resolve_module_var;
-
 SCM
 scm_c_resolve_module (const char *name)
 {
@@ -162,8 +179,8 @@ SCM
 scm_c_define_module (const char *name,
                     void (*init)(void *), void *data)
 {
-  SCM module = scm_call_1 (SCM_VARIABLE_REF (process_define_module_var),
-                          scm_list_1 (convert_module_name (name)));
+  SCM module = scm_call_1 (SCM_VARIABLE_REF (define_module_star_var),
+                          convert_module_name (name));
   if (init)
     scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
   return module;
@@ -176,8 +193,6 @@ scm_c_use_module (const char *name)
              scm_list_1 (scm_list_1 (convert_module_name (name))));
 }
 
-static SCM module_export_x_var;
-
 SCM
 scm_module_export (SCM module, SCM namelist)
 {
@@ -203,7 +218,7 @@ scm_c_export (const char *name, ...)
   if (name)
     {
       va_list ap;
-      SCM names = scm_cons (scm_from_locale_symbol (name), SCM_EOL);
+      SCM names = scm_cons (scm_from_utf8_symbol (name), SCM_EOL);
       SCM *tail = SCM_CDRLOC (names);
       va_start (ap, name);
       while (1)
@@ -211,7 +226,7 @@ scm_c_export (const char *name, ...)
          const char *n = va_arg (ap, const char *);
          if (n == NULL)
            break;
-         *tail = scm_cons (scm_from_locale_symbol (n), SCM_EOL);
+         *tail = scm_cons (scm_from_utf8_symbol (n), SCM_EOL);
          tail = SCM_CDRLOC (*tail);
        }
       va_end (ap);
@@ -222,55 +237,36 @@ scm_c_export (const char *name, ...)
 
 /* Environments */
 
-SCM
-scm_top_level_env (SCM thunk)
-{
-  if (SCM_IMP (thunk))
-    return SCM_EOL;
-  else
-    return scm_cons (thunk, SCM_EOL);
-}
-
-SCM
-scm_env_top_level (SCM env)
-{
-  while (scm_is_pair (env))
-    {
-      SCM car_env = SCM_CAR (env);
-      if (!scm_is_pair (car_env) && scm_is_true (scm_procedure_p (car_env)))
-       return car_env;
-      env = SCM_CDR (env);
-    }
-  return SCM_BOOL_F;
-}
-
 SCM_SYMBOL (sym_module, "module");
 
 SCM
 scm_lookup_closure_module (SCM proc)
 {
   if (scm_is_false (proc))
-    return the_root_module ();
+    return scm_the_root_module ();
   else if (SCM_EVAL_CLOSURE_P (proc))
     return SCM_PACK (SCM_SMOB_DATA (proc));
   else
     {
-      SCM mod = scm_procedure_property (proc, sym_module);
+      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 = the_root_module ();
+       mod = scm_the_root_module ();
       return mod;
     }
 }
 
-SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0,
-           (SCM env),
-           "Return the module of @var{ENV}, a lexical environment.")
-#define FUNC_NAME s_scm_env_module
-{
-  return scm_lookup_closure_module (scm_env_top_level (env));
-}
-#undef FUNC_NAME
-
 /*
  * C level implementation of the standard eval closure
  *
@@ -279,12 +275,6 @@ SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0,
  * release.
  */
 
-/* The `module-make-local-var!' variable.  */
-static SCM module_make_local_var_x_var = SCM_UNSPECIFIED;
-
-/* The `default-duplicate-binding-procedures' variable.  */
-static SCM default_duplicate_binding_procedures_var = SCM_UNSPECIFIED;
-
 /* Return the list of default duplicate binding handlers (procedures).  */
 static inline SCM
 default_duplicate_binding_handlers (void)
@@ -304,41 +294,52 @@ resolve_duplicate_binding (SCM module, SCM sym,
                           SCM iface1, SCM var1,
                           SCM iface2, SCM var2)
 {
+  SCM args[8];
+  SCM handlers;
   SCM result = SCM_BOOL_F;
 
-  if (!scm_is_eq (var1, var2))
+  if (scm_is_eq (var1, var2))
+    return var1;
+  
+  args[0] = module;
+  args[1] = sym;
+  args[2] = iface1;
+  args[3] = SCM_VARIABLE_REF (var1);
+  if (SCM_UNBNDP (args[3]))
+    args[3] = SCM_BOOL_F;
+  args[4] = iface2;
+  args[5] = SCM_VARIABLE_REF (var2);
+  if (SCM_UNBNDP (args[5]))
+    args[5] = SCM_BOOL_F;
+  args[6] = scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_BOOL_F);
+  args[7] = SCM_BOOL_F;
+      
+  handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
+  if (scm_is_false (handlers))
+    handlers = default_duplicate_binding_handlers ();
+
+  for (; scm_is_pair (handlers); handlers = SCM_CDR (handlers))
     {
-      SCM val1, val2;
-      SCM handlers, h, handler_args;
-
-      val1 = SCM_VARIABLE_REF (var1);
-      val2 = SCM_VARIABLE_REF (var2);
-
-      val1 = (val1 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val1;
-      val2 = (val2 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val2;
-
-      handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
-      if (scm_is_false (handlers))
-       handlers = default_duplicate_binding_handlers ();
-
-      handler_args = scm_list_n (module, sym,
-                                iface1, val1, iface2, val2,
-                                var1, val1,
-                                SCM_UNDEFINED);
-
-      for (h = handlers;
-          scm_is_pair (h) && scm_is_false (result);
-          h = SCM_CDR (h))
-       {
-         result = scm_apply (SCM_CAR (h), handler_args, SCM_EOL);
-       }
+      if (scm_is_true (args[6])) 
+        {
+          args[7] = SCM_VARIABLE_REF (args[6]);
+          if (SCM_UNBNDP (args[7]))
+            args[7] = SCM_BOOL_F;
+        }
+      
+      result = scm_call_n (SCM_CAR (handlers), args, 8);
+
+      if (scm_is_true (result))
+        return result;
     }
-  else
-    result = var1;
 
-  return result;
+  return SCM_BOOL_F;
 }
 
+/* No lock is needed for access to this variable, as there are no
+   threads before modules are booted.  */
+SCM scm_pre_modules_obarray;
+
 /* Lookup SYM as an imported variable of MODULE.  */
 static inline SCM
 module_imported_variable (SCM module, SCM sym)
@@ -374,9 +375,15 @@ module_imported_variable (SCM module, SCM sym)
              {
                /* SYM is a duplicate binding (imported more than once) so we
                   need to resolve it.  */
-               found_var = resolve_duplicate_binding (module, sym,
-                                                      found_iface, found_var,
-                                                      iface, var);
+                found_var = resolve_duplicate_binding (module, sym,
+                                                       found_iface, found_var,
+                                                       iface, var);
+
+                /* Note that it could be that FOUND_VAR doesn't belong
+                   either to FOUND_IFACE or to IFACE, if it was created
+                   by merge-generics.  The right thing to do there would
+                   be to treat the import obarray as the iface, but the
+                   import obarray isn't actually a module.  Oh well.  */
                if (scm_is_eq (found_var, var))
                  found_iface = iface;
              }
@@ -410,32 +417,47 @@ SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
 
   register SCM b;
 
-  /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
-     evaluated.  */
   if (scm_module_system_booted_p)
     SCM_VALIDATE_MODULE (1, module);
 
   SCM_VALIDATE_SYMBOL (2, sym);
 
+  if (scm_is_false (module))
+    return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
 
   /* 1. Check module obarray */
   b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (b))
     return b;
 
-  /* 2. Search imported bindings.  In order to be consistent with
-     `module-variable', the binder gets called only when no imported binding
-     matches SYM.  */
-  b = module_imported_variable (module, sym);
-  if (SCM_BOUND_THING_P (b))
-    return SCM_BOOL_F;
+  /* At this point we should just be able to return #f, but there is the
+     possibility that a custom binder establishes a mapping for this
+     variable.
+
+     However a custom binder should be called only if there is no
+     imported binding with the name SYM. So here instead of the order:
+
+       2. Search imported bindings.  In order to be consistent with
+          `module-variable', the binder gets called only when no
+          imported binding matches SYM.
+  
+       3. Query the custom binder.
+
+     we first check if there is a binder at all, and if not, just return
+     #f directly.
+  */
 
   {
-    /* 3. Query the custom binder.  */
     SCM binder = SCM_MODULE_BINDER (module);
 
     if (scm_is_true (binder))
       {
+        /* 2. */
+        b = module_imported_variable (module, sym);
+        if (SCM_BOUND_THING_P (b))
+          return SCM_BOOL_F;
+
+        /* 3. */
        b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
        if (SCM_BOUND_THING_P (b))
          return b;
@@ -465,6 +487,9 @@ SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
 
   SCM_VALIDATE_SYMBOL (2, sym);
 
+  if (scm_is_false (module))
+    return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
+
   /* 1. Check module obarray */
   var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (var))
@@ -496,9 +521,9 @@ SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
 
 scm_t_bits scm_tc16_eval_closure;
 
-#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<16)
+#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<0)
 #define SCM_EVAL_CLOSURE_INTERFACE_P(e) \
-  (SCM_CELL_WORD_0 (e) & SCM_F_EVAL_CLOSURE_INTERFACE)
+  (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. */
@@ -534,11 +559,26 @@ SCM_DEFINE (scm_standard_interface_eval_closure,
            "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,
+  SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | (SCM_F_EVAL_CLOSURE_INTERFACE<<16),
                      SCM_UNPACK (module));
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_eval_closure_module,
+           "eval-closure-module", 1, 0, 0,
+           (SCM eval_closure),
+           "Return the module associated with this eval closure.")
+/* the idea is that eval closures are really not the way to do things, they're
+   superfluous given our module system. this function lets mmacros migrate away
+   from eval closures. */
+#define FUNC_NAME s_scm_eval_closure_module
+{
+  SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P,
+                         "eval-closure");
+  return SCM_SMOB_OBJECT (eval_closure);
+}
+#undef FUNC_NAME
+
 SCM
 scm_module_lookup_closure (SCM module)
 {
@@ -557,22 +597,34 @@ scm_current_module_lookup_closure ()
     return SCM_BOOL_F;
 }
 
-SCM
-scm_module_transformer (SCM module)
+SCM_SYMBOL (sym_macroexpand, "macroexpand");
+
+SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
+           (SCM module),
+           "Returns the syntax expander for the given module.")
+#define FUNC_NAME s_scm_module_transformer
 {
-  if (scm_is_false (module))
-    return SCM_BOOL_F;
+  if (SCM_UNLIKELY (scm_is_false (module)))
+    {
+      SCM v = scm_hashq_ref (scm_pre_modules_obarray,
+                             sym_macroexpand,
+                             SCM_BOOL_F);
+      if (scm_is_false (v))
+        SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL);
+      return SCM_VARIABLE_REF (v);
+    }
   else
-    return SCM_MODULE_TRANSFORMER (module);
+    {
+      SCM_VALIDATE_MODULE (SCM_ARG1, module);
+      return SCM_MODULE_TRANSFORMER (module);
+    }
 }
+#undef FUNC_NAME
 
 SCM
 scm_current_module_transformer ()
 {
-  if (scm_module_system_booted_p)
-    return scm_module_transformer (scm_current_module ());
-  else
-    return SCM_BOOL_F;
+  return scm_module_transformer (scm_current_module ());
 }
 
 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
@@ -618,6 +670,12 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+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
@@ -631,15 +689,13 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
  * the scm_pre_modules_obarray (a `eq' hash table).
  */
 
-SCM scm_pre_modules_obarray;
-
 SCM 
 scm_sym2var (SCM sym, SCM proc, SCM definep)
 #define FUNC_NAME "scm_sym2var"
 {
   SCM var;
 
-  if (SCM_NIMP (proc))
+  if (SCM_HEAP_OBJECT_P (proc))
     {
       if (SCM_EVAL_CLOSURE_P (proc))
        {
@@ -678,7 +734,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
 SCM
 scm_c_module_lookup (SCM module, const char *name)
 {
-  return scm_module_lookup (module, scm_from_locale_symbol (name));
+  return scm_module_lookup (module, scm_from_utf8_symbol (name));
 }
 
 SCM
@@ -690,7 +746,7 @@ scm_module_lookup (SCM module, SCM sym)
 
   var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
   if (scm_is_false (var))
-    SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym));
+    unbound_variable (FUNC_NAME, sym);
   return var;
 }
 #undef FUNC_NAME
@@ -698,7 +754,7 @@ scm_module_lookup (SCM module, SCM sym)
 SCM
 scm_c_lookup (const char *name)
 {
-  return scm_lookup (scm_from_locale_symbol (name));
+  return scm_lookup (scm_from_utf8_symbol (name));
 }
 
 SCM
@@ -707,14 +763,132 @@ scm_lookup (SCM sym)
   SCM var = 
     scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
   if (scm_is_false (var))
-    scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym));
+    unbound_variable (NULL, sym);
   return var;
 }
 
+SCM
+scm_public_variable (SCM module_name, SCM name)
+{
+  SCM mod, iface;
+  
+  mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
+                    k_ensure, SCM_BOOL_F);
+
+  if (scm_is_false (mod))
+    scm_misc_error ("public-lookup", "Module named ~s does not exist",
+                    scm_list_1 (module_name));
+  
+  iface = scm_module_public_interface (mod);
+
+  if (scm_is_false (iface))
+    scm_misc_error ("public-lookup", "Module ~s has no public interface",
+                    scm_list_1 (mod));
+  
+  return scm_module_variable (iface, name);
+}
+
+SCM
+scm_private_variable (SCM module_name, SCM name)
+{
+  SCM mod;
+  
+  mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
+                    k_ensure, SCM_BOOL_F);
+
+  if (scm_is_false (mod))
+    scm_misc_error ("private-lookup", "Module named ~s does not exist",
+                    scm_list_1 (module_name));
+  
+  return scm_module_variable (mod, name);
+}
+
+SCM
+scm_c_public_variable (const char *module_name, const char *name)
+{
+  return scm_public_variable (convert_module_name (module_name),
+                              scm_from_utf8_symbol (name));
+}
+
+SCM
+scm_c_private_variable (const char *module_name, const char *name)
+{
+  return scm_private_variable (convert_module_name (module_name),
+                               scm_from_utf8_symbol (name));
+}
+
+SCM
+scm_public_lookup (SCM module_name, SCM name)
+{
+  SCM var;
+  
+  var = scm_public_variable (module_name, name);
+
+  if (scm_is_false (var))
+    scm_misc_error ("public-lookup", "No variable bound to ~s in module ~s",
+                    scm_list_2 (name, module_name));
+  
+  return var;
+}
+
+SCM
+scm_private_lookup (SCM module_name, SCM name)
+{
+  SCM var;
+  
+  var = scm_private_variable (module_name, name);
+
+  if (scm_is_false (var))
+    scm_misc_error ("private-lookup", "No variable bound to ~s in module ~s",
+                    scm_list_2 (name, module_name));
+  
+  return var;
+}
+
+SCM
+scm_c_public_lookup (const char *module_name, const char *name)
+{
+  return scm_public_lookup (convert_module_name (module_name),
+                            scm_from_utf8_symbol (name));
+}
+
+SCM
+scm_c_private_lookup (const char *module_name, const char *name)
+{
+  return scm_private_lookup (convert_module_name (module_name),
+                             scm_from_utf8_symbol (name));
+}
+
+SCM
+scm_public_ref (SCM module_name, SCM name)
+{
+  return scm_variable_ref (scm_public_lookup (module_name, name));
+}
+
+SCM
+scm_private_ref (SCM module_name, SCM name)
+{
+  return scm_variable_ref (scm_private_lookup (module_name, name));
+}
+
+SCM
+scm_c_public_ref (const char *module_name, const char *name)
+{
+  return scm_public_ref (convert_module_name (module_name),
+                         scm_from_utf8_symbol (name));
+}
+
+SCM
+scm_c_private_ref (const char *module_name, const char *name)
+{
+  return scm_private_ref (convert_module_name (module_name),
+                          scm_from_utf8_symbol (name));
+}
+
 SCM
 scm_c_module_define (SCM module, const char *name, SCM value)
 {
-  return scm_module_define (module, scm_from_locale_symbol (name), value);
+  return scm_module_define (module, scm_from_utf8_symbol (name), value);
 }
 
 SCM
@@ -733,17 +907,23 @@ scm_module_define (SCM module, SCM sym, SCM value)
 SCM
 scm_c_define (const char *name, SCM value)
 {
-  return scm_define (scm_from_locale_symbol (name), value);
+  return scm_define (scm_from_utf8_symbol (name), value);
 }
 
-SCM
-scm_define (SCM sym, SCM value)
+SCM_DEFINE (scm_define, "define!", 2, 0, 0,
+           (SCM sym, SCM value),
+           "Define @var{sym} to be @var{value} in the current module."
+            "Returns the variable itself. Note that this is a procedure, "
+            "not a macro.")
+#define FUNC_NAME s_scm_define
 {
-  SCM var =
-    scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T);
+  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;
 }
+#undef FUNC_NAME
 
 SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
            (SCM module, SCM variable),
@@ -764,6 +944,8 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
       obarray = SCM_MODULE_OBARRAY (module);
     }
 
+  SCM_VALIDATE_VARIABLE (SCM_ARG2, variable);
+
   if (!SCM_HASHTABLE_P (obarray))
       return SCM_BOOL_F;
 
@@ -778,32 +960,25 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
        {
          handle = SCM_CAR (ls);
 
-         if (SCM_CAR (handle) == SCM_PACK (NULL))
-           {
-             /* FIXME: We hit a weak pair whose car has become unreachable.
-                We should remove the pair in question or something.  */
-           }
-         else
-           {
-             if (SCM_CDR (handle) == variable)
-               return SCM_CAR (handle);
-           }
+          if (scm_is_eq (SCM_CDR (handle), variable))
+            return SCM_CAR (handle);
 
          ls = SCM_CDR (ls);
        }
     }
 
-  /* Try the `uses' list.  */
-  {
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
-      {
-       SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
-       if (scm_is_true (sym))
-         return sym;
-       uses = SCM_CDR (uses);
-      }
-  }
+  if (!scm_is_false (module))
+    {
+      /* Try the `uses' list.  */
+      SCM uses = SCM_MODULE_USES (module);
+      while (scm_is_pair (uses))
+       {
+         SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
+         if (scm_is_true (sym))
+           return sym;
+         uses = SCM_CDR (uses);
+       }
+    }
 
   return SCM_BOOL_F;
 }
@@ -822,23 +997,10 @@ SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0,
 
 SCM_SYMBOL (scm_sym_system_module, "system-module");
 
-SCM
-scm_system_module_env_p (SCM env)
-{
-  SCM proc = scm_env_top_level (env);
-  if (scm_is_false (proc))
-    return SCM_BOOL_T;
-  return ((scm_is_true (scm_procedure_property (proc,
-                                               scm_sym_system_module)))
-         ? SCM_BOOL_T
-         : SCM_BOOL_F);
-}
-
 void
 scm_modules_prehistory ()
 {
-  scm_pre_modules_obarray 
-    = scm_permanent_object (scm_c_make_hash_table (1533));
+  scm_pre_modules_obarray = scm_c_make_hash_table (1790);
 }
 
 void
@@ -850,24 +1012,24 @@ scm_init_modules ()
   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_permanent_object (scm_make_fluid ());
+  the_module = scm_make_fluid ();
 }
 
 static void
 scm_post_boot_init_modules ()
 {
-#define PERM(x) scm_permanent_object(x)
-
   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
   scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
 
-  resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
-  process_define_module_var = PERM (scm_c_lookup ("process-define-module"));
-  process_use_modules_var = PERM (scm_c_lookup ("process-use-modules"));
-  module_export_x_var = PERM (scm_c_lookup ("module-export!"));
-  the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
-  default_duplicate_binding_procedures_var =
-    PERM (scm_c_lookup ("default-duplicate-binding-procedures"));
+  resolve_module_var = scm_c_lookup ("resolve-module");
+  define_module_star_var = scm_c_lookup ("define-module*");
+  process_use_modules_var = scm_c_lookup ("process-use-modules");
+  module_export_x_var = scm_c_lookup ("module-export!");
+  the_root_module_var = scm_c_lookup ("the-root-module");
+  default_duplicate_binding_procedures_var = 
+    scm_c_lookup ("default-duplicate-binding-procedures");
+  module_public_interface_var = scm_c_lookup ("module-public-interface");
+  k_ensure = scm_from_locale_keyword ("ensure");
 
   scm_module_system_booted_p = 1;
 }