change asubrs to be gsubrs

* libguile/numbers.h:
* libguile/numbers.c (scm_i_gcd, scm_i_lcm, scm_i_logand, scm_i_logior)
  (scm_i_logxor, scm_i_min, scm_i_max, scm_i_sum, scm_i_difference)
  (scm_i_product, scm_i_divide): Change asubrs to be gsubrs.

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 6fc4c2a..6583103 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1026,10 +1026,24 @@ scm_modulo (SCM x, SCM y)
     SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG1, s_modulo);
 }
 
-SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
-/* "Return the greatest common divisor of all arguments.\n"
- * "If called without arguments, 0 is returned."
- */
+SCM_PRIMITIVE_GENERIC (scm_i_gcd, "gcd", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the greatest common divisor of all parameter values.\n"
+                       "If called without arguments, 0 is returned.")
+#define FUNC_NAME s_scm_i_gcd
+{
+  while (!scm_is_null (rest))
+    { x = scm_gcd (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_gcd (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_gcd s_scm_i_gcd
+#define g_gcd g_scm_i_gcd
+
 SCM
 scm_gcd (SCM x, SCM y)
 {
@@ -1126,10 +1140,24 @@ scm_gcd (SCM x, SCM y)
     SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd);
 }
 
-SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm);
-/* "Return the least common multiple of the arguments.\n"
- * "If called without arguments, 1 is returned."
- */
+SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the least common multiple of the arguments.\n"
+                       "If called without arguments, 1 is returned.")
+#define FUNC_NAME s_scm_i_lcm
+{
+  while (!scm_is_null (rest))
+    { x = scm_lcm (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_lcm (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_lcm s_scm_i_lcm
+#define g_lcm g_scm_i_lcm
+
 SCM
 scm_lcm (SCM n1, SCM n2)
 {
@@ -1227,14 +1255,28 @@ scm_lcm (SCM n1, SCM n2)
 
 */
 
-SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
-             (SCM n1, SCM n2),
-            "Return the bitwise AND of the integer arguments.\n\n"
-            "@lisp\n"
-            "(logand) @result{} -1\n"
-            "(logand 7) @result{} 7\n"
-            "(logand #b111 #b011 #b001) @result{} 1\n"
-            "@end lisp")
+SCM_DEFINE (scm_i_logand, "logand", 0, 2, 1,
+            (SCM x, SCM y, SCM rest),
+            "Return the bitwise AND of the integer arguments.\n\n"
+            "@lisp\n"
+            "(logand) @result{} -1\n"
+            "(logand 7) @result{} 7\n"
+            "(logand #b111 #b011 #b001) @result{} 1\n"
+            "@end lisp")
+#define FUNC_NAME s_scm_i_logand
+{
+  while (!scm_is_null (rest))
+    { x = scm_logand (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_logand (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_scm_logand s_scm_i_logand
+
+SCM scm_logand (SCM n1, SCM n2)
 #define FUNC_NAME s_scm_logand
 {
   long int nn1;
@@ -1303,14 +1345,28 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
 #undef FUNC_NAME
 
 
-SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
-             (SCM n1, SCM n2),
-            "Return the bitwise OR of the integer arguments.\n\n"
-            "@lisp\n"
-            "(logior) @result{} 0\n"
-            "(logior 7) @result{} 7\n"
-            "(logior #b000 #b001 #b011) @result{} 3\n"
-           "@end lisp")
+SCM_DEFINE (scm_i_logior, "logior", 0, 2, 1,
+            (SCM x, SCM y, SCM rest),
+            "Return the bitwise OR of the integer arguments.\n\n"
+            "@lisp\n"
+            "(logior) @result{} 0\n"
+            "(logior 7) @result{} 7\n"
+            "(logior #b000 #b001 #b011) @result{} 3\n"
+            "@end lisp")
+#define FUNC_NAME s_scm_i_logior
+{
+  while (!scm_is_null (rest))
+    { x = scm_logior (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_logior (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_scm_logior s_scm_i_logior
+
+SCM scm_logior (SCM n1, SCM n2)
 #define FUNC_NAME s_scm_logior
 {
   long int nn1;
@@ -1377,8 +1433,8 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
 #undef FUNC_NAME
 
 
-SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
-             (SCM n1, SCM n2),
+SCM_DEFINE (scm_i_logxor, "logxor", 0, 2, 1,
+            (SCM x, SCM y, SCM rest),
             "Return the bitwise XOR of the integer arguments.  A bit is\n"
             "set in the result if it is set in an odd number of arguments.\n"
             "@lisp\n"
@@ -1387,6 +1443,20 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
             "(logxor #b000 #b001 #b011) @result{} 2\n"
             "(logxor #b000 #b001 #b011 #b011) @result{} 1\n"
            "@end lisp")
+#define FUNC_NAME s_scm_i_logxor
+{
+  while (!scm_is_null (rest))
+    { x = scm_logxor (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_logxor (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_scm_logxor s_scm_i_logxor
+
+SCM scm_logxor (SCM n1, SCM n2)
 #define FUNC_NAME s_scm_logxor
 {
   long int nn1;
@@ -3727,9 +3797,23 @@ scm_negative_p (SCM x)
    unlike scm_less_p above which takes some trouble to preserve all bits in
    its test, such trouble is not required for min and max.  */
 
-SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max);
-/* "Return the maximum of all parameter values."
- */
+SCM_PRIMITIVE_GENERIC (scm_i_max, "max", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the maximum of all parameter values.")
+#define FUNC_NAME s_scm_i_max
+{
+  while (!scm_is_null (rest))
+    { x = scm_max (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_max (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_max s_scm_i_max
+#define g_max g_scm_i_max
+
 SCM
 scm_max (SCM x, SCM y)
 {
@@ -3859,9 +3943,23 @@ scm_max (SCM x, SCM y)
 }
 
 
-SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
-/* "Return the minium of all parameter values."
- */
+SCM_PRIMITIVE_GENERIC (scm_i_min, "min", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the minimum of all parameter values.")
+#define FUNC_NAME s_scm_i_min
+{
+  while (!scm_is_null (rest))
+    { x = scm_min (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_min (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_min s_scm_i_min
+#define g_min g_scm_i_min
+
 SCM
 scm_min (SCM x, SCM y)
 {
@@ -3984,7 +4082,7 @@ scm_min (SCM x, SCM y)
           goto use_less;
        }
       else
-       SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+       SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
     }
   else
     SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min);
@@ -4198,13 +4296,28 @@ SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference);
-/* If called with one argument @var{z1}, -@var{z1} returned. Otherwise
- * the sum of all but the first argument are subtracted from the first
- * argument.  */
-#define FUNC_NAME s_difference
+SCM_PRIMITIVE_GENERIC (scm_i_difference, "-", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "If called with one argument @var{z1}, -@var{z1} returned. Otherwise\n"
+                       "the sum of all but the first argument are subtracted from the first\n"
+                       "argument.")
+#define FUNC_NAME s_scm_i_difference
+{
+  while (!scm_is_null (rest))
+    { x = scm_difference (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_difference (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_difference s_scm_i_difference
+#define g_difference g_scm_i_difference
+
 SCM
 scm_difference (SCM x, SCM y)
+#define FUNC_NAME s_difference
 {
   if (SCM_UNLIKELY (SCM_UNBNDP (y)))
     {
@@ -4443,10 +4556,24 @@ SCM_DEFINE (scm_oneminus, "1-", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product);
-/* "Return the product of all arguments.  If called without arguments,\n"
- * "1 is returned."
- */
+SCM_PRIMITIVE_GENERIC (scm_i_product, "*", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return the product of all arguments.  If called without arguments,\n"
+                       "1 is returned.")
+#define FUNC_NAME s_scm_i_product
+{
+  while (!scm_is_null (rest))
+    { x = scm_product (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_product (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_product s_scm_i_product
+#define g_product g_scm_i_product
+
 SCM
 scm_product (SCM x, SCM y)
 {
@@ -4663,13 +4790,28 @@ arising out of or in connection with the use or performance of
 this software.
 ****************************************************************/
 
-SCM_GPROC1 (s_divide, "/", scm_tc7_asubr, scm_divide, g_divide);
-/* Divide the first argument by the product of the remaining
-   arguments.  If called with one argument @var{z1}, 1/@var{z1} is
-   returned.  */
-#define FUNC_NAME s_divide
+SCM_PRIMITIVE_GENERIC (scm_i_divide, "/", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Divide the first argument by the product of the remaining\n"
+                       "arguments.  If called with one argument @var{z1}, 1/@var{z1} is\n"
+                       "returned.")
+#define FUNC_NAME s_scm_i_divide
+{
+  while (!scm_is_null (rest))
+    { x = scm_divide (x, y);
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_divide (x, y);
+}
+#undef FUNC_NAME
+                       
+#define s_divide s_scm_i_divide
+#define g_divide g_scm_i_divide
+
 static SCM
-scm_i_divide (SCM x, SCM y, int inexact)
+do_divide (SCM x, SCM y, int inexact)
+#define FUNC_NAME s_divide
 {
   double a;
 
@@ -5062,12 +5204,12 @@ scm_i_divide (SCM x, SCM y, int inexact)
 SCM
 scm_divide (SCM x, SCM y)
 {
-  return scm_i_divide (x, y, 0);
+  return do_divide (x, y, 0);
 }
 
 static SCM scm_divide2real (SCM x, SCM y)
 {
-  return scm_i_divide (x, y, 1);
+  return do_divide (x, y, 1);
 }
 #undef FUNC_NAME
 

diff --git a/libguile/numbers.h b/libguile/numbers.h
index 1a8523f..95d59b8 100644 (file)
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -208,6 +208,12 @@ SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
 SCM_API SCM scm_logcount (SCM n);
 SCM_API SCM scm_integer_length (SCM n);
 
+SCM_INTERNAL SCM scm_i_gcd (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_lcm (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_logior (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_logxor (SCM x, SCM y, SCM rest);
+
 SCM_API size_t scm_iint2str (scm_t_intmax num, int rad, char *p);
 SCM_API size_t scm_iuint2str (scm_t_uintmax num, int rad, char *p);
 SCM_API SCM scm_number_to_string (SCM x, SCM radix);
@@ -238,7 +244,6 @@ 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);
@@ -277,6 +282,13 @@ SCM_API SCM scm_log10 (SCM z);
 SCM_API SCM scm_exp (SCM z);
 SCM_API SCM scm_sqrt (SCM z);
 
+SCM_INTERNAL SCM scm_i_min (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_max (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_difference (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_product (SCM x, SCM y, SCM rest);
+SCM_INTERNAL SCM scm_i_divide (SCM x, SCM y, SCM rest);
+
 /* bignum internal functions */
 SCM_INTERNAL SCM scm_i_mkbig (void);
 SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x);