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

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/05/19 17:34:25

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

Log message:
        (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.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procs.h.diff?cvsroot=OldCVS&tr1=1.39&tr2=1.40&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procs.c.diff?cvsroot=OldCVS&tr1=1.55&tr2=1.56&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/procs.c
diff -u guile/guile-core/libguile/procs.c:1.55 
guile/guile-core/libguile/procs.c:1.56
--- guile/guile-core/libguile/procs.c:1.55      Tue May 15 07:57:21 2001
+++ guile/guile-core/libguile/procs.c   Sat May 19 17:34:25 2001
@@ -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_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_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_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_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;
 }
 
@@ -401,6 +402,42 @@
 #include "libguile/procs.x"
 #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:
Index: guile/guile-core/libguile/procs.h
diff -u guile/guile-core/libguile/procs.h:1.39 
guile/guile-core/libguile/procs.h:1.40
--- guile/guile-core/libguile/procs.h:1.39      Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/procs.h   Sat May 19 17:34:25 2001
@@ -161,15 +161,12 @@
 
 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);
@@ -192,6 +189,16 @@
 #if (SCM_DEBUG_DEPRECATED == 0)
 
 #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 */