[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-75-g9c246c0

[Andy Wingo]

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=9c246c03838c1cc844d15a7c4817029df1994e96

The branch, master has been updated
       via  9c246c03838c1cc844d15a7c4817029df1994e96 (commit)
       via  9fdf9fd3ea7130fd85eaf0a333a965ac4d2b07c3 (commit)
      from  e809758a7e0f3f63162a0a9064b95bd1c1d10628 (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 9c246c03838c1cc844d15a7c4817029df1994e96
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 5 16:31:12 2010 +0100

    remove unused snarf macros
    
    * libguile/snarf.h (SCM_DEFINE1, SCM_PRIMITIVE_GENERIC_1, SCM_PROC1)
      (SCM_GPROC1): Remove, as these deal in the removed typed subr
      constructors.
    
    * libguile/tags.h (scm_tcs_subrs): Remove this. Use scm_tc7_gsubr
      instead, though hopefully that will go too, soon.

commit 9fdf9fd3ea7130fd85eaf0a333a965ac4d2b07c3
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 5 16:15:14 2010 +0100

    move subr implementation details to gsubr.[ch]
    
    * libguile/procs.h: Move subr macros to gsubr.h.
    * libguile/procs.c (scm_c_make_subr, scm_c_make_subr_with_generic)
      (scm_c_define_subr, scm_c_define_subr_with_generic): Remove these,
      because they deal in subr types, and now there is only one subr type.
      The body of this code is now in gsubr.c.
    
    * libguile/deprecated.h (scm_subr_p): Remove from procs.[ch] and define
      as a deprecated macro. Only used internally, but who knows who's out
      there.
    
    * libguile/goops.c (scm_generic_capability_p)
      (scm_enable_primitive_generic_x, scm_set_primitive_generic_x)
      (scm_primitive_generic_generic): Use the new SCM_PRIMITIVE_GENERIC_P
      macro instead of calling scm_subr_p.
    
    * libguile/gsubr.h (SCM_PRIMITIVE_P, SCM_PRIMITIVE_GENERIC_P): New
      macros, to replace scm_subr_p and hacky checking for generic
      capability.
      (SCM_SUBR_META_INFO, SCM_SUBR_NAME, SCM_SUBRF, SCM_SUBR_PROPS)
      (SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC)
      (SCM_SUBR_ARITY_TO_TYPE): Moved here from procs.h.
    
    * libguile/gsubr.c (create_gsubr): Inline the
      scm_c_make_subr definition here, and work for generics too. Removed a
      scm_remember_upto_here_1 that was added earlier in the year when
      meta_info was not being traced by the GC. Adapt callers.

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

Summary of changes:
 libguile/deprecated.h |    5 ++++
 libguile/goops.c      |   13 ++++------
 libguile/gsubr.c      |   52 +++++++++++++---------------------------
 libguile/gsubr.h      |   26 ++++++++++++++++++++
 libguile/procs.c      |   62 -------------------------------------------------
 libguile/procs.h      |   28 ----------------------
 libguile/snarf.h      |   37 -----------------------------
 libguile/tags.h       |    5 ----
 8 files changed, 53 insertions(+), 175 deletions(-)

diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 671f40f..5b7c9a2 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -598,6 +598,11 @@ SCM_DEPRECATED scm_t_trampoline_2 scm_trampoline_2 (SCM 
proc);
 
 
 
+/* Deprecated 2010-01-05, use SCM_PRIMITIVE_P instead */
+#define scm_subr_p(x) (SCM_PRIMITIVE_P (x))
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/goops.c b/libguile/goops.c
index 983fa59..a703e7a 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -39,6 +39,7 @@
 #include "libguile/dynl.h"
 #include "libguile/dynwind.h"
 #include "libguile/eval.h"
+#include "libguile/gsubr.h"
 #include "libguile/hashtab.h"
 #include "libguile/keywords.h"
 #include "libguile/macros.h"
@@ -1693,9 +1694,7 @@ SCM_DEFINE (scm_generic_capability_p, 
"generic-capability?", 1, 0, 0,
 {
   SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
              proc, SCM_ARG1, FUNC_NAME);
-  return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc)
-         ? SCM_BOOL_T
-         : SCM_BOOL_F);
+  return (SCM_PRIMITIVE_GENERIC_P (proc) ? SCM_BOOL_T : SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1708,8 +1707,7 @@ SCM_DEFINE (scm_enable_primitive_generic_x, 
"enable-primitive-generic!", 0, 0, 1
   while (!scm_is_null (subrs))
     {
       SCM subr = SCM_CAR (subrs);
-      SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr),
-                 subr, SCM_ARGn, FUNC_NAME);
+      SCM_ASSERT (SCM_PRIMITIVE_GENERIC_P (subr), subr, SCM_ARGn, FUNC_NAME);
       *SCM_SUBR_GENERIC (subr)
        = scm_make (scm_list_3 (scm_class_generic,
                                k_name,
@@ -1725,8 +1723,7 @@ SCM_DEFINE (scm_set_primitive_generic_x, 
"set-primitive-generic!", 2, 0, 0,
            "")
 #define FUNC_NAME s_scm_set_primitive_generic_x
 {
-  SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr),
-              subr, SCM_ARG1, FUNC_NAME);
+  SCM_ASSERT (SCM_PRIMITIVE_GENERIC_P (subr), subr, SCM_ARG1, FUNC_NAME);
   SCM_ASSERT (SCM_PUREGENERICP (generic), generic, SCM_ARG2, FUNC_NAME);
   *SCM_SUBR_GENERIC (subr) = generic;
   return SCM_UNSPECIFIED;
@@ -1738,7 +1735,7 @@ SCM_DEFINE (scm_primitive_generic_generic, 
"primitive-generic-generic", 1, 0, 0,
            "")
 #define FUNC_NAME s_scm_primitive_generic_generic
 {
-  if (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr))
+  if (SCM_PRIMITIVE_GENERIC_P (subr))
     {
       if (!*SCM_SUBR_GENERIC (subr))
        scm_enable_primitive_generic_x (scm_list_1 (subr));
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 24ba670..70be51b 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -48,9 +48,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
 static SCM
 create_gsubr (int define, const char *name,
              unsigned int req, unsigned int opt, unsigned int rst,
-             SCM (*fcn) ())
+             SCM (*fcn) (), SCM *generic_loc)
 {
   SCM subr;
+  SCM sname;
+  SCM *meta_info;
   unsigned type;
 
   type = SCM_GSUBR_MAKTYPE (req, opt, rst);
@@ -59,11 +61,18 @@ create_gsubr (int define, const char *name,
       || SCM_GSUBR_REST (type) != rst)
     scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
 
-  subr = scm_c_make_subr (name, scm_tc7_gsubr | (type << 8U),
-                          fcn);
+  meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info");
+  sname = scm_from_locale_symbol (name);
+  meta_info[0] = sname;
+  meta_info[1] = SCM_EOL;  /* properties */
+
+  subr = scm_double_cell ((scm_t_bits) scm_tc7_gsubr | (type << 8U),
+                          (scm_t_bits) fcn,
+                          (scm_t_bits) generic_loc,
+                          (scm_t_bits) meta_info);
 
   if (define)
-    scm_define (SCM_SUBR_NAME (subr), subr);
+    scm_define (sname, subr);
 
   return subr;
 }
@@ -71,40 +80,13 @@ create_gsubr (int define, const char *name,
 SCM
 scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
 {
-  return create_gsubr (0, name, req, opt, rst, fcn);
+  return create_gsubr (0, name, req, opt, rst, fcn, NULL);
 }
 
 SCM
 scm_c_define_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
 {
-  return create_gsubr (1, name, req, opt, rst, fcn);
-}
-
-static SCM
-create_gsubr_with_generic (int define,
-                          const char *name,
-                          int req,
-                          int opt,
-                          int rst,
-                          SCM (*fcn)(),
-                          SCM *gf)
-{
-  SCM subr;
-  unsigned type;
-
-  type = SCM_GSUBR_MAKTYPE (req, opt, rst);
-  if (SCM_GSUBR_REQ (type) != req
-      || SCM_GSUBR_OPT (type) != opt
-      || SCM_GSUBR_REST (type) != rst)
-    scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
-
-  subr = scm_c_make_subr_with_generic (name, scm_tc7_gsubr | (type << 8U),
-                                       fcn, gf);
-
-  if (define)
-    scm_define (SCM_SUBR_NAME (subr), subr);
-
-  return subr;
+  return create_gsubr (1, name, req, opt, rst, fcn, NULL);
 }
 
 SCM
@@ -115,7 +97,7 @@ scm_c_make_gsubr_with_generic (const char *name,
                               SCM (*fcn)(),
                               SCM *gf)
 {
-  return create_gsubr_with_generic (0, name, req, opt, rst, fcn, gf);
+  return create_gsubr (0, name, req, opt, rst, fcn, gf);
 }
 
 SCM
@@ -126,7 +108,7 @@ scm_c_define_gsubr_with_generic (const char *name,
                                 SCM (*fcn)(),
                                 SCM *gf)
 {
-  return create_gsubr_with_generic (1, name, req, opt, rst, fcn, gf);
+  return create_gsubr (1, name, req, opt, rst, fcn, gf);
 }
 
 /* Apply PROC, a gsubr, to the ARGC arguments in ARGV.  ARGC is expected to
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index e75658d..74a08a2 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -25,6 +25,32 @@
 
 #include "libguile/__scm.h"
 
+
+
+
+/* Subrs 
+ */
+
+#define SCM_PRIMITIVE_P(x) (SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_gsubr)
+#define SCM_PRIMITIVE_GENERIC_P(x) (SCM_PRIMITIVE_P (x) && SCM_SUBR_GENERIC 
(x))
+
+#define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
+#define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
+#define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
+#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
+#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
+#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
+#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) 
g))
+
+/* Return the most suitable subr type for a subr with REQ required arguments,
+   OPT optional arguments, and REST (0 or 1) arguments.  This has to be in
+   sync with `create_gsubr ()'.  */
+#define SCM_SUBR_ARITY_TO_TYPE(req, opt, rest)                         \
+  (scm_tc7_gsubr | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))
+
+
+
+
 
 
 /* Return an integer describing the arity of GSUBR, a subr of type
diff --git a/libguile/procs.c b/libguile/procs.c
index 6c03911..e940378 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -41,53 +41,6 @@
  */
 
 
-SCM
-scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
-{
-  register SCM z;
-  SCM sname;
-  SCM *meta_info;
-
-  meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info");
-  sname = scm_from_locale_symbol (name);
-  meta_info[0] = sname;
-  meta_info[1] = SCM_EOL;  /* properties */
-
-  z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn,
-                      0 /* generic */, (scm_t_bits) meta_info);
-
-  scm_remember_upto_here_1 (sname);
-
-  return z;
-}
-
-SCM
-scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
-{
-  SCM subr = scm_c_make_subr (name, type, fcn);
-  scm_define (SCM_SUBR_NAME (subr), subr);
-  return subr;
-}
-
-SCM
-scm_c_make_subr_with_generic (const char *name, 
-                             long type, SCM (*fcn) (), SCM *gf)
-{
-  SCM subr = scm_c_make_subr (name, type, fcn);
-  SCM_SET_SUBR_GENERIC_LOC (subr, gf);
-  return subr;
-}
-
-SCM
-scm_c_define_subr_with_generic (const char *name, 
-                               long type, SCM (*fcn) (), SCM *gf)
-{
-  SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
-  scm_define (SCM_SUBR_NAME (subr), subr);
-  return subr;
-}
-
-
 SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, 
            (SCM obj),
            "Return @code{#t} if @var{obj} is a procedure.")
@@ -123,21 +76,6 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-/* Only used internally. */
-int
-scm_subr_p (SCM obj)
-{
-  if (SCM_NIMP (obj))
-    switch (SCM_TYP7 (obj))
-      {
-      case scm_tc7_gsubr:
-       return 1;
-      default:
-       ;
-      }
-  return 0;
-}
-
 SCM_SYMBOL (sym_documentation, "documentation");
 
 SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, 
diff --git a/libguile/procs.h b/libguile/procs.h
index a832cd0..a4dfaff 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -27,36 +27,8 @@
 
 
 
-
-/* Subrs 
- */
-
-#define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
-#define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
-#define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
-#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
-#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
-#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
-#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) 
g))
-
-/* Return the most suitable subr type for a subr with REQ required arguments,
-   OPT optional arguments, and REST (0 or 1) arguments.  This has to be in
-   sync with `create_gsubr ()'.  */
-#define SCM_SUBR_ARITY_TO_TYPE(req, opt, rest)                         \
-  (scm_tc7_gsubr | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))
-
-
-
-
-SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
-SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
-                                         SCM (*fcn)(), SCM *gf);
-SCM_API SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
-SCM_API SCM scm_c_define_subr_with_generic (const char *name, long type,
-                                           SCM (*fcn)(), SCM *gf);
 SCM_API SCM scm_procedure_p (SCM obj);
 SCM_API SCM scm_thunk_p (SCM obj);
-SCM_API int scm_subr_p (SCM obj);
 SCM_API SCM scm_procedure_documentation (SCM proc);
 SCM_API SCM scm_procedure_with_setter_p (SCM obj);
 SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter);
diff --git a/libguile/snarf.h b/libguile/snarf.h
index e5b059b..a00f5b7 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -152,26 +152,6 @@ scm_c_export (s_ ## FNAME, NULL); \
 )\
 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 
-#define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(scm_c_define_subr (s_ ## FNAME, TYPE, FNAME); ) \
-SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
-
-#define SCM_PRIMITIVE_GENERIC_1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
-static SCM g_ ## FNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(\
-g_ ## FNAME = SCM_PACK (0); \
-scm_c_define_subr_with_generic (s_ ## FNAME, TYPE, FNAME, &g_ ## FNAME); \
-)\
-SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
-
 #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
 SCM_SNARF_HERE(static const char RANAME[]=STR) \
 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
@@ -194,23 +174,6 @@ scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
                                  (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
 )
 
-#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
-SCM_SNARF_INIT(\
-scm_c_define_subr (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
-)
-
-
-#define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
-SCM_SNARF_HERE(\
-static const char RANAME[]=STR; \
-static SCM GF \
-)SCM_SNARF_INIT(\
-GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
-scm_c_define_subr_with_generic (RANAME, TYPE, \
-                                (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
-)
-
 #ifdef SCM_SUPPORT_STATIC_ALLOCATION
 
 # define SCM_SYMBOL(c_name, scheme_name)                               \
diff --git a/libguile/tags.h b/libguile/tags.h
index d2e66e3..a8ecf0f 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -648,11 +648,6 @@ enum scm_tc8_tags
   case scm_tc3_struct + 112:\
   case scm_tc3_struct + 120
 
-/* For subrs
- */
-#define scm_tcs_subrs \
-  case scm_tc7_gsubr
-
 
 
 #if (SCM_ENABLE_DEPRECATED == 1)


hooks/post-receive
-- 
GNU Guile