[Guile-commits] GNU Guile branch, subr-simplification, updated. release_1-9-2-155-g339cf84

[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=339cf8429be809b924810ff58eecfd86478312d4

The branch, subr-simplification has been updated
       via  339cf8429be809b924810ff58eecfd86478312d4 (commit)
       via  b3ca84f4476531b03cd7689dc77bd80e8b16bd76 (commit)
       via  68bd78cc948be15bb1113b9eaece1a99ce7dc54f (commit)
      from  f96b000b9147a89b5143086b14a48011d379dff8 (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 339cf8429be809b924810ff58eecfd86478312d4
Author: Andy Wingo <address@hidden>
Date:   Sun Sep 6 14:15:28 2009 +0200

    + is not an asubr
    
    * libguile/numbers.h:
    * libguile/numbers.c (scm_i_sum): Rework so that scm_sum is just a
      normal function. Its generic is actually provided by scm_i_sum, a
      gsubr with rest args. In that way, + is no longer an asubr.

commit b3ca84f4476531b03cd7689dc77bd80e8b16bd76
Author: Andy Wingo <address@hidden>
Date:   Sun Sep 6 14:13:48 2009 +0200

    fix compile-time bug compiling (+ "foo" " bar")
    
    * module/language/tree-il/primitives.scm (+, -): Avoid calling exact? on
      non-numeric args.

commit 68bd78cc948be15bb1113b9eaece1a99ce7dc54f
Author: Andy Wingo <address@hidden>
Date:   Sun Sep 6 13:51:31 2009 +0200

    remove scm_tc7_dsubr
    
    * libguile/tags.h: Remove scm_tc7_dsubr. There are no more users of
      this.
    
    * libguile/array-map.c:
    * libguile/eval.c:
    * libguile/eval.i.c:
    * libguile/goops.c:
    * libguile/procprop.c:
    * libguile/procs.h: Remove all dsubr cases.

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

Summary of changes:
 libguile/array-map.c                   |   26 --------------------
 libguile/eval.c                        |   25 -------------------
 libguile/eval.i.c                      |   41 --------------------------------
 libguile/goops.c                       |    1 -
 libguile/numbers.c                     |   22 ++++++++++++++---
 libguile/numbers.h                     |    1 +
 libguile/procprop.c                    |    1 -
 libguile/procs.h                       |    1 -
 libguile/tags.h                        |    3 +-
 module/language/tree-il/primitives.scm |    6 ++--
 10 files changed, 23 insertions(+), 104 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 5f1a2f5..9d837e6 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -699,27 +699,6 @@ ramap (SCM ra0, SCM proc, SCM ras)
 
 
 static int
-ramap_dsubr (SCM ra0, SCM proc, SCM ras)
-{
-  SCM ra1 = SCM_CAR (ras);
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra1)->lbnd + 1;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  ra1 = SCM_I_ARRAY_V (ra1);
-  switch (SCM_TYP7 (ra0))
-    {
-    default:
-      for (; n-- > 0; i0 += inc0, i1 += inc1)
-       GVSET (ra0, i0, scm_call_1 (proc, GVREF (ra1, i1)));
-      break;
-    }
-  return 1;
-}
-
-
-
-static int
 ramap_rp (SCM ra0, SCM proc, SCM ras)
 {
   SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
@@ -818,11 +797,6 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
     gencase:
       scm_ramapc (ramap, proc, ra0, lra, FUNC_NAME);
       return SCM_UNSPECIFIED;
-    case scm_tc7_dsubr:
-      if (! scm_is_pair (lra))
-        SCM_WRONG_NUM_ARGS ();  /* need 1 source */
-      scm_ramapc (ramap_dsubr, proc, ra0, lra, FUNC_NAME);
-      return SCM_UNSPECIFIED;
     case scm_tc7_rpsubr:
       {
        ra_iproc *p;
diff --git a/libguile/eval.c b/libguile/eval.c
index 155abba..6b0a8ca 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3318,28 +3318,6 @@ scm_trampoline_0 (SCM proc)
 }
 
 static SCM
-call_dsubr_1 (SCM proc, SCM arg1)
-{
-  if (SCM_I_INUMP (arg1))
-    {
-      return (scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM 
(arg1))));
-    }
-  else if (SCM_REALP (arg1))
-    {
-      return (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
-    }
-  else if (SCM_BIGP (arg1))
-    {
-      return (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
-    }
-  else if (SCM_FRACTIONP (arg1))
-    {
-      return (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
-    }
-  SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
-}
-
-static SCM
 call_cxr_1 (SCM proc, SCM arg1)
 {
   return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc));
@@ -3365,9 +3343,6 @@ scm_trampoline_1 (SCM proc)
 
   switch (SCM_TYP7 (proc))
     {
-    case scm_tc7_dsubr:
-      trampoline = call_dsubr_1;
-      break;
     case scm_tc7_cxr:
       trampoline = call_cxr_1;
       break;
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 7e923a7..bc08fd8 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -1176,7 +1176,6 @@ dispatch:
          }
         else
           goto badfun;
-      case scm_tc7_dsubr:
       case scm_tc7_cxr:
       wrongnumargs:
        scm_wrong_num_args (proc);
@@ -1205,24 +1204,6 @@ dispatch:
         SCM_ASRTGO (!SCM_IMP (proc), badfun);
        switch (SCM_TYP7 (proc))
          {                             /* have one argument in arg1 */
-         case scm_tc7_dsubr:
-            if (SCM_I_INUMP (arg1))
-              {
-                RETURN (scm_from_double (SCM_DSUBRF (proc) ((double) 
SCM_I_INUM (arg1))));
-              }
-            else if (SCM_REALP (arg1))
-              {
-                RETURN (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE 
(arg1))));
-              }
-            else if (SCM_BIGP (arg1))
-              {
-                RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl 
(arg1))));
-              }
-           else if (SCM_FRACTIONP (arg1))
-             {
-                RETURN (scm_from_double (SCM_DSUBRF (proc) 
(scm_i_fraction2double (arg1))));
-             }
-           SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
          case scm_tc7_cxr:
            RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
          case scm_tc7_rpsubr:
@@ -1367,7 +1348,6 @@ dispatch:
              }
             else
               goto badfun;
-         case scm_tc7_dsubr:
          case scm_tc7_cxr:
            scm_wrong_num_args (proc);
          default:
@@ -1552,7 +1532,6 @@ dispatch:
            goto operatorn;
          else
            goto badfun;
-       case scm_tc7_dsubr:
        case scm_tc7_cxr:
          scm_wrong_num_args (proc);
        default:
@@ -1660,26 +1639,6 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
 tail:
   switch (SCM_TYP7 (proc))
     {
-    case scm_tc7_dsubr:
-      if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
-       scm_wrong_num_args (proc);
-      if (SCM_I_INUMP (arg1))
-        {
-          RETURN (scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM 
(arg1))));
-        }
-      else if (SCM_REALP (arg1))
-        {
-          RETURN (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
-        }
-      else if (SCM_BIGP (arg1))
-       {
-         RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
-       }
-      else if (SCM_FRACTIONP (arg1))
-       {
-         RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
-       }
-      SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
     case scm_tc7_cxr:
       if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
        scm_wrong_num_args (proc);
diff --git a/libguile/goops.c b/libguile/goops.c
index d3ea203..a87c742 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -227,7 +227,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
            return scm_class_fraction;
           }
        case scm_tc7_asubr:
-       case scm_tc7_dsubr:
        case scm_tc7_cxr:
        case scm_tc7_rpsubr:
        case scm_tc7_gsubr:
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 573edf6..ac52631 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -3991,10 +3991,24 @@ scm_min (SCM x, SCM y)
 }
 
 
-SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum);
-/* "Return the sum of all parameter values.  Return 0 if called without\n"
- * "any parameters." 
- */
+SCM_PRIMITIVE_GENERIC (scm_i_sum, "+", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the sum of all parameter values.  Return 0 if 
called without\n"
+                       "any parameters." )
+#define FUNC_NAME s_scm_i_sum
+{
+  while (!scm_is_null (rest))
+    { x = scm_sum (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_sum (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_sum s_scm_i_sum
+#define g_sum g_scm_i_sum
+
 SCM
 scm_sum (SCM x, SCM y)
 {
diff --git a/libguile/numbers.h b/libguile/numbers.h
index 31eba94..1a8523f 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -238,6 +238,7 @@ SCM_API SCM scm_negative_p (SCM x);
 SCM_API SCM scm_max (SCM x, SCM y);
 SCM_API SCM scm_min (SCM x, SCM y);
 SCM_API SCM scm_sum (SCM x, SCM y);
+SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest);
 SCM_API SCM scm_oneplus (SCM x);
 SCM_API SCM scm_difference (SCM x, SCM y);
 SCM_API SCM scm_oneminus (SCM x);
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 0a53bfd..b08193d 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -51,7 +51,6 @@ scm_i_procedure_arity (SCM proc)
  loop:
   switch (SCM_TYP7 (proc))
     {
-    case scm_tc7_dsubr:
     case scm_tc7_cxr:
       a += 1;
       break;
diff --git a/libguile/procs.h b/libguile/procs.h
index ed4ac20..124e228 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -35,7 +35,6 @@
 #define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
 #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
 #define SCM_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
-#define SCM_DSUBRF(x) ((double (*)()) 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))
diff --git a/libguile/tags.h b/libguile/tags.h
index 19e814e..7744938 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -454,7 +454,7 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_unused_7       71
 #define scm_tc7_unused_8       77
 
-#define scm_tc7_dsubr          61
+#define scm_tc7_unused_17      61
 #define scm_tc7_gsubr          63
 #define scm_tc7_rpsubr         69
 #define scm_tc7_program                79
@@ -668,7 +668,6 @@ enum scm_tc8_tags
  */
 #define scm_tcs_subrs \
        scm_tc7_asubr:\
-  case scm_tc7_dsubr:\
   case scm_tc7_cxr:\
   case scm_tc7_rpsubr:\
   case scm_tc7_gsubr
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 955c7bf..98633f0 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -208,11 +208,11 @@
   (x) x
   (x y) (if (and (const? y)
                  (let ((y (const-exp y)))
-                   (and (exact? y) (= y 1))))
+                   (and (number? y) (exact? y) (= y 1))))
             (1+ x)
             (if (and (const? x)
                      (let ((x (const-exp x)))
-                       (and (exact? x) (= x 1))))
+                       (and (number? y) (exact? x) (= x 1))))
                 (1+ y)
                 (+ x y)))
   (x y z . rest) (+ x (+ y z . rest)))
@@ -226,7 +226,7 @@
   (x) (- 0 x)
   (x y) (if (and (const? y)
                  (let ((y (const-exp y)))
-                   (and (exact? y) (= y 1))))
+                   (and (number? y) (exact? y) (= y 1))))
             (1- x)
             (- x y))
   (x y z . rest) (- x (+ y z . rest)))


hooks/post-receive
-- 
GNU Guile