guile/guile-core/libguile modules.h modules.c

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/05/18 18:22:12

Modified files:
        guile-core/libguile: modules.h modules.c 

Log message:
        * modules.h, modules.c: Moved around a lot of code so that
        deprecated features appear at the bottom.
        (root_module_lookup_closure, scm_sym_app, scm_sym_modules,
        module_prefix, make_modules_in_var, beautify_user_module_x_var,
        scm_the_root_module, scm_make_module, scm_ensure_user_module,
        scm_load_scheme_module): Deprecated.
        (scm_system_module_env_p): Return SCM_BOOL_T directly for
        environments corresponding to the root module.
        (convert_module_name, scm_c_resolve_module,
        scm_c_call_with_current_module, scm_c_define_module,
        scm_c_use_module, scm_c_export): New.
        (the_root_module): New static variant of scm_the_root_module.  Use
        it everywhere instead of scm_the_root_module.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.h.diff?cvsroot=OldCVS&tr1=1.14&tr2=1.15&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.c.diff?cvsroot=OldCVS&tr1=1.23&tr2=1.24&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/modules.c
diff -u guile/guile-core/libguile/modules.c:1.23 
guile/guile-core/libguile/modules.c:1.24
--- guile/guile-core/libguile/modules.c:1.23    Tue May 15 07:57:21 2001
+++ guile/guile-core/libguile/modules.c Fri May 18 18:22:12 2001
@@ -44,6 +44,8 @@
 
 
 
+#include <stdarg.h>
+
 #include "libguile/_scm.h"
 
 #include "libguile/eval.h"
@@ -54,6 +56,7 @@
 #include "libguile/struct.h"
 #include "libguile/variable.h"
 #include "libguile/fluids.h"
+#include "libguile/deprecation.h"
 
 #include "libguile/modules.h"
 
@@ -61,18 +64,6 @@
 
 SCM scm_module_tag;
 
-static SCM the_root_module_var;
-static SCM root_module_lookup_closure;
-
-SCM
-scm_the_root_module ()
-{
-  if (scm_module_system_booted_p)
-    return SCM_VARIABLE_REF (the_root_module_var);
-  else
-    return SCM_BOOL_F;
-}
-
 static SCM the_module;
 
 SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
@@ -126,91 +117,96 @@
 }
 #undef FUNC_NAME
 
-SCM_SYMBOL (scm_sym_app, "app");
-SCM_SYMBOL (scm_sym_modules, "modules");
-static SCM module_prefix;
-
-static SCM
-scm_module_full_name (SCM name)
-{
-  if (SCM_EQ_P (SCM_CAR (name), scm_sym_app))
-    return name;
-  else
-    return scm_append (SCM_LIST2 (module_prefix, name));
-}
-
-static SCM make_modules_in_var;
-static SCM beautify_user_module_x_var;
-
 SCM
-scm_make_module (SCM name)
+scm_c_call_with_current_module (SCM module,
+                               SCM (*func)(void *), void *data)
 {
-  return scm_apply (SCM_VARIABLE_REF (make_modules_in_var),
-                   SCM_LIST2 (scm_the_root_module (),
-                              scm_module_full_name (name)),
-                   SCM_EOL);
+  return scm_c_with_fluid (the_module, module, func, data);
 }
 
-SCM
-scm_ensure_user_module (SCM module)
+static SCM
+convert_module_name (const char *name)
 {
-  scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var),
-            SCM_LIST1 (module), SCM_EOL);
-  return SCM_UNSPECIFIED;
-}
+  SCM list = SCM_EOL;
+  SCM *tail = &list;
 
-SCM
-scm_module_lookup_closure (SCM module)
-{
-  if (module == SCM_BOOL_F)
-    return SCM_BOOL_F;
-  else
-    return SCM_MODULE_EVAL_CLOSURE (module);
+  const char *ptr;
+  while (*name)
+    {
+      while (*name == ' ')
+       name++;
+      ptr = name;
+      while (*ptr && *ptr != ' ')
+       ptr++;
+      if (ptr > name)
+       {
+         *tail = scm_cons (scm_mem2symbol (name, ptr-name), SCM_EOL);
+         tail = SCM_CDRLOC (*tail);
+       }
+      name = ptr;
+    }
+
+  return list;
 }
 
+static SCM process_define_module_var;
+static SCM process_use_modules_var;
+static SCM resolve_module_var;
+
 SCM
-scm_current_module_lookup_closure ()
+scm_c_resolve_module (const char *name)
 {
-  if (scm_module_system_booted_p)
-    return scm_module_lookup_closure (scm_current_module ());
-  else
-    return SCM_BOOL_F;
+  return scm_resolve_module (convert_module_name (name));
 }
 
 SCM
-scm_module_transformer (SCM module)
+scm_resolve_module (SCM name)
 {
-  if (module == SCM_BOOL_F)
-    return SCM_BOOL_F;
-  else
-    return SCM_MODULE_TRANSFORMER (module);
+  return scm_apply (SCM_VARIABLE_REF (resolve_module_var),
+                   SCM_LIST1 (name), SCM_EOL);
 }
 
 SCM
-scm_current_module_transformer ()
+scm_c_define_module (const char *name,
+                    void (*init)(void *), void *data)
 {
-  if (scm_module_system_booted_p)
-    return scm_module_transformer (scm_current_module ());
-  else
-    return SCM_BOOL_F;
+  SCM module = scm_apply (SCM_VARIABLE_REF (process_define_module_var),
+                         SCM_LIST1 (SCM_LIST1 (convert_module_name (name))),
+                         SCM_EOL);
+  if (init)
+    scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
+  return module;
 }
 
-static SCM resolve_module_var;
-
-SCM
-scm_resolve_module (SCM name)
+void
+scm_c_use_module (const char *name)
 {
-  return scm_apply (SCM_VARIABLE_REF (resolve_module_var),
-                   SCM_LIST1 (name), SCM_EOL);
+  scm_apply (SCM_VARIABLE_REF (process_use_modules_var),
+            SCM_LIST1 (SCM_LIST1 (convert_module_name (name))),
+            SCM_EOL);
 }
 
-static SCM try_module_autoload_var;
+static SCM module_export_x_var;
 
-SCM
-scm_load_scheme_module (SCM name)
+void
+scm_c_export (const char *name, ...)
 {
-  return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var),
-                   SCM_LIST1 (name), SCM_EOL);
+  va_list ap;
+  SCM names = scm_cons (scm_str2symbol (name), SCM_EOL);
+  SCM *tail = SCM_CDRLOC (names);
+  va_start (ap, name);
+  while (1)
+    {
+      const char *n = va_arg (ap, const char *);
+      if (n == NULL)
+       break;
+      *tail = scm_cons (scm_str2symbol (n), SCM_EOL);
+      tail = SCM_CDRLOC (*tail);
+    }
+  scm_apply (SCM_VARIABLE_REF (module_export_x_var),
+            SCM_LIST2 (scm_current_module (),
+                       names),
+            SCM_EOL);
 }
 
 /* Environments */
@@ -239,18 +235,29 @@
 
 SCM_SYMBOL (sym_module, "module");
 
+static SCM the_root_module_var;
+
+static SCM
+the_root_module ()
+{
+  if (scm_module_system_booted_p)
+    return SCM_VARIABLE_REF (the_root_module_var);
+  else
+    return SCM_BOOL_F;
+}
+
 SCM
 scm_lookup_closure_module (SCM proc)
 {
   if (SCM_FALSEP (proc))
-    return scm_the_root_module ();
+    return 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);
       if (mod == SCM_BOOL_F)
-       mod = scm_the_root_module ();
+       mod = the_root_module ();
       return mod;
     }
 }
@@ -261,21 +268,6 @@
   return scm_lookup_closure_module (scm_env_top_level (env));
 }
 
-
-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_FALSEP (proc))
-    proc = root_module_lookup_closure;
-  return ((SCM_NFALSEP (scm_procedure_property (proc,
-                                               scm_sym_system_module)))
-         ? SCM_BOOL_T
-         : SCM_BOOL_F);
-}
-
 /*
  * C level implementation of the standard eval closure
  *
@@ -363,6 +355,42 @@
 }
 #undef FUNC_NAME
 
+SCM
+scm_module_lookup_closure (SCM module)
+{
+  if (module == SCM_BOOL_F)
+    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
+scm_module_transformer (SCM module)
+{
+  if (module == SCM_BOOL_F)
+    return SCM_BOOL_F;
+  else
+    return SCM_MODULE_TRANSFORMER (module);
+}
+
+SCM
+scm_current_module_transformer ()
+{
+  if (scm_module_system_booted_p)
+    return scm_module_transformer (scm_current_module ());
+  else
+    return SCM_BOOL_F;
+}
+
 /* scm_sym2var
  *
  * looks up the variable bound to SYM according to PROC.  PROC should be
@@ -552,6 +580,32 @@
 }
 #undef FUNC_NAME
 
+#if SCM_DEBUG_DEPRECATED == 0
+
+static SCM root_module_lookup_closure;
+SCM_SYMBOL (scm_sym_app, "app");
+SCM_SYMBOL (scm_sym_modules, "modules");
+static SCM module_prefix;
+static SCM make_modules_in_var;
+static SCM beautify_user_module_x_var;
+static SCM try_module_autoload_var;
+
+#endif
+
+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_FALSEP (proc))
+    return SCM_BOOL_T;
+  return ((SCM_NFALSEP (scm_procedure_property (proc,
+                                               scm_sym_system_module)))
+         ? SCM_BOOL_T
+         : SCM_BOOL_F);
+}
+
 void
 scm_modules_prehistory ()
 {
@@ -581,16 +635,82 @@
 
   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
   scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_cons_gloc);
+
+  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"));
+
+#if SCM_DEBUG_DEPRECATED == 0
+
   module_prefix = PERM (SCM_LIST2 (scm_sym_app, scm_sym_modules));
   make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
-  beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!"));
-  the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
   root_module_lookup_closure =
     PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var)));
-  resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
+  beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!"));
   try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload"));
+
+#endif
+
   scm_module_system_booted_p = 1;
 }
+
+#if SCM_DEBUG_DEPRECATED == 0
+
+SCM
+scm_the_root_module ()
+{
+  scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
+                                  "Use `scm_c_resolve_module (\"guile\") "
+                                  "instead.");
+
+  return the_root_module ();
+}
+
+static SCM
+scm_module_full_name (SCM name)
+{
+  if (SCM_EQ_P (SCM_CAR (name), scm_sym_app))
+    return name;
+  else
+    return scm_append (SCM_LIST2 (module_prefix, name));
+}
+
+SCM
+scm_make_module (SCM name)
+{
+  scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
+                                  "Use `scm_c_define_module instead.");
+
+  return scm_apply (SCM_VARIABLE_REF (make_modules_in_var),
+                   SCM_LIST2 (scm_the_root_module (),
+                              scm_module_full_name (name)),
+                   SCM_EOL);
+}
+
+SCM
+scm_ensure_user_module (SCM module)
+{
+  scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
+                                  "Use `scm_c_define_module instead.");
+
+  scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var),
+            SCM_LIST1 (module), SCM_EOL);
+  return SCM_UNSPECIFIED;
+}
+
+SCM
+scm_load_scheme_module (SCM name)
+{
+  scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
+                                  "Use `scm_c_resolve_module instead.");
+
+  return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var),
+                   SCM_LIST1 (name), SCM_EOL);
+}
+
+#endif
 
 /*
   Local Variables:
Index: guile/guile-core/libguile/modules.h
diff -u guile/guile-core/libguile/modules.h:1.14 
guile/guile-core/libguile/modules.h:1.15
--- guile/guile-core/libguile/modules.h:1.14    Tue May 15 07:57:21 2001
+++ guile/guile-core/libguile/modules.h Fri May 18 18:22:12 2001
@@ -50,6 +50,9 @@
 
 
 
+extern int scm_module_system_booted_p;
+extern SCM scm_module_tag;
+
 #define SCM_MODULEP(OBJ) \
   (SCM_NIMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag)
 
@@ -82,31 +85,12 @@
 
 
 
-extern int scm_module_system_booted_p;
-extern SCM scm_module_tag;
-
-extern SCM scm_the_root_module (void);
 extern SCM scm_current_module (void);
-extern SCM scm_current_module_lookup_closure (void);
-extern SCM scm_current_module_transformer (void);
 extern SCM scm_interaction_environment (void);
 extern SCM scm_set_current_module (SCM module);
-extern SCM scm_make_module (SCM name);
-extern SCM scm_ensure_user_module (SCM name);
-extern SCM scm_module_lookup_closure (SCM module);
-extern SCM scm_module_transformer (SCM module);
-extern SCM scm_resolve_module (SCM name);
-extern SCM scm_load_scheme_module (SCM name);
-extern SCM scm_env_top_level (SCM env);
-extern SCM scm_top_level_env (SCM thunk);
-extern SCM scm_system_module_env_p (SCM env);
-extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
-extern SCM scm_standard_eval_closure (SCM module);
-extern SCM scm_standard_interface_eval_closure (SCM module);
-extern SCM scm_get_pre_modules_obarray (void);
 
-extern SCM scm_lookup_closure_module (SCM proc);
-extern SCM scm_env_module (SCM env);
+extern SCM scm_c_call_with_current_module (SCM module,
+                                          SCM (*func)(void *), void *data);
 
 extern SCM scm_c_lookup (const char *name);
 extern SCM scm_c_define (const char *name, SCM val);
@@ -119,10 +103,41 @@
 extern SCM scm_module_define (SCM module, SCM symbol, SCM val);
 extern SCM scm_module_reverse_lookup (SCM module, SCM variable);
 
+extern SCM scm_c_resolve_module (const char *name);
+extern SCM scm_resolve_module (SCM name);
+extern SCM scm_c_define_module (const char *name,
+                               void (*init)(void *), void *data);
+extern void scm_c_use_module (const char *name);
+extern void scm_c_export (const char *name, ...);
+
 extern SCM scm_sym2var (SCM sym, SCM thunk, SCM definep);
 
+extern SCM scm_module_lookup_closure (SCM module);
+extern SCM scm_module_transformer (SCM module);
+extern SCM scm_current_module_lookup_closure (void);
+extern SCM scm_current_module_transformer (void);
+extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
+extern SCM scm_standard_eval_closure (SCM module);
+extern SCM scm_standard_interface_eval_closure (SCM module);
+extern SCM scm_get_pre_modules_obarray (void);
+extern SCM scm_lookup_closure_module (SCM proc);
+
+extern SCM scm_env_top_level (SCM env);
+extern SCM scm_env_module (SCM env);
+extern SCM scm_top_level_env (SCM thunk);
+
 extern void scm_modules_prehistory (void);
 extern void scm_init_modules (void);
+
+#if SCM_DEBUG_DEPRECATED == 0
+
+extern SCM scm_the_root_module (void);
+extern SCM scm_make_module (SCM name);
+extern SCM scm_ensure_user_module (SCM name);
+extern SCM scm_load_scheme_module (SCM name);
+extern SCM scm_system_module_env_p (SCM env);
+
+#endif
 
 #endif  /* MODULESH */