(scm_c_make_subr, scm_c_define_subr,

scm_c_make_subr_with_generic, scm_c_define_subr_with_generic): New
functions.  They replace scm_make_subr, scm_make_subr_opt and
scm_make_subr_with_generic.  The `make' variants only create the
subr object, while the `define' variants also put it into the
current module.  Changed all callers.
(scm_make_subr, scm_make_subr_opt, scm_make_subr_with_generic):
Deprecated.

2 files changed, 74 insertions, 30 deletions

diff --git a/libguile/procs.c b/libguile/procs.c
index 65331edb8..66989d5e8 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -50,6 +50,7 @@
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/smob.h"
+#include "libguile/deprecation.h"
 
 #include "libguile/validate.h"
 #include "libguile/procs.h"
@@ -70,10 +71,8 @@ int scm_subr_table_size = 0;
 int scm_subr_table_room = 800;
 
 SCM 
-scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
+scm_c_make_subr (const char *name, int type, SCM (*fcn) ())
 {
-  SCM symbol;
-  SCM var;
   register SCM z;
   int entry;
 
@@ -89,18 +88,11 @@ scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
       scm_subr_table_room = new_size;
     }
 
-  symbol = scm_str2symbol (name);
-
   SCM_NEWCELL (z);
-  if (set)
-    var = scm_sym2var (symbol, scm_current_module_lookup_closure (),
-		       SCM_BOOL_T);
-  else
-    var = SCM_BOOL_F;
-  
+
   entry = scm_subr_table_size;
   scm_subr_table[entry].handle = z;
-  scm_subr_table[entry].name = symbol;
+  scm_subr_table[entry].name = scm_str2symbol (name);
   scm_subr_table[entry].generic = 0;
   scm_subr_table[entry].properties = SCM_EOL;
   
@@ -108,12 +100,17 @@ scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
   SCM_SET_CELL_TYPE (z, (entry << 8) + type);
   scm_subr_table_size++;
   
-  if (set)
-    SCM_VARIABLE_SET (var, z);
-  
   return z;
 }
 
+SCM
+scm_c_define_subr (const char *name, int type, SCM (*fcn) ())
+{
+  SCM subr = scm_c_make_subr (name, type, fcn);
+  scm_define (SCM_SUBR_ENTRY(subr).name, subr);
+  return subr;
+}
+
 /* This function isn't currently used since subrs are never freed. */
 /* *fixme* Need mutex here. */
 void
@@ -126,17 +123,21 @@ scm_free_subr_entry (SCM subr)
   scm_subr_table_size--;
 }
 
-SCM 
-scm_make_subr (const char *name, int type, SCM (*fcn) ())
+SCM
+scm_c_make_subr_with_generic (const char *name, 
+			      int type, SCM (*fcn) (), SCM *gf)
 {
-  return scm_make_subr_opt (name, type, fcn, 1);
+  SCM subr = scm_c_make_subr (name, type, fcn);
+  SCM_SUBR_ENTRY(subr).generic = gf;
+  return subr;
 }
 
 SCM
-scm_make_subr_with_generic (const char *name, int type, SCM (*fcn) (), SCM *gf)
+scm_c_define_subr_with_generic (const char *name, 
+				int type, SCM (*fcn) (), SCM *gf)
 {
-  SCM subr = scm_make_subr_opt (name, type, fcn, 1);
-  scm_subr_table[scm_subr_table_size - 1].generic = gf;
+  SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
+  scm_define (SCM_SUBR_ENTRY(subr).name, subr);
   return subr;
 }
 
@@ -402,6 +403,42 @@ scm_init_procs ()
 #endif
 }
 
+#if SCM_DEBUG_DEPRECATED == 0
+
+SCM
+scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
+{
+  scm_c_issue_deprecation_warning 
+    ("`scm_make_subr_opt' is deprecated.  Use `scm_c_make_subr' or "
+     "`scm_c_define_subr' instead.");
+
+  if (set)
+    return scm_c_define_subr (name, type, fcn);
+  else
+    return scm_c_make_subr (name, type, fcn);
+}
+
+SCM 
+scm_make_subr (const char *name, int type, SCM (*fcn) ())
+{
+  scm_c_issue_deprecation_warning 
+    ("`scm_make_subr' is deprecated.  Use `scm_c_define_subr' instead.");
+
+  return scm_c_define_subr (name, type, fcn);
+}
+
+SCM
+scm_make_subr_with_generic (const char *name, int type, SCM (*fcn) (), SCM *gf)
+{
+  scm_c_issue_deprecation_warning 
+    ("`scm_make_subr_with_generic' is deprecated.  Use "
+     "`scm_c_define_subr_with_generic' instead.");
+  
+  return scm_c_define_subr_with_generic (name, type, fcn);
+}
+
+#endif /* !SCM_DEBUG_DEPRECATION */
+
 /*
   Local Variables:
   c-file-style: "gnu"
diff --git a/libguile/procs.h b/libguile/procs.h
index ca39c918d..9b8af9138 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -161,15 +161,12 @@ extern int scm_subr_table_room;
 
 extern void scm_mark_subr_table (void);
 extern void scm_free_subr_entry (SCM subr);
-extern SCM scm_make_subr (const char *name, int type, SCM (*fcn) ());
-extern SCM scm_make_subr_with_generic (const char *name,
-				       int type,
-				       SCM (*fcn) (),
-				       SCM *gf);
-extern SCM scm_make_subr_opt (const char *name, 
-                              int type, 
-                              SCM (*fcn) (),
-                              int set);
+extern SCM scm_c_make_subr (const char *name, int type, SCM (*fcn)());
+extern SCM scm_c_make_subr_with_generic (const char *name, int type,
+					 SCM (*fcn)(), SCM *gf);
+extern SCM scm_c_define_subr (const char *name, int type, SCM (*fcn)());
+extern SCM scm_c_define_subr_with_generic (const char *name, int type,
+					   SCM (*fcn)(), SCM *gf);
 extern SCM scm_makcclo (SCM proc, long len);
 extern SCM scm_procedure_p (SCM obj);
 extern SCM scm_closure_p (SCM obj);
@@ -193,6 +190,16 @@ extern SCM scm_make_cclo (SCM proc, SCM len);
 
 #define SCM_SUBR_DOC(x) SCM_BOOL_F
 
+extern SCM scm_make_subr (const char *name, int type, SCM (*fcn) ());
+extern SCM scm_make_subr_with_generic (const char *name,
+				       int type,
+				       SCM (*fcn) (),
+				       SCM *gf);
+extern SCM scm_make_subr_opt (const char *name, 
+                              int type, 
+                              SCM (*fcn) (),
+                              int set);
+
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
 
 #endif  /* SCM_PROCS_H */