[Guile-commits] GNU Guile branch, subr-simplification, updated. release_1-9-2-157-ga8c600c

[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=a8c600ce97f8dbc391809a20fcf7610740301042

The branch, subr-simplification has been updated
       via  a8c600ce97f8dbc391809a20fcf7610740301042 (commit)
       via  f749a1f36f78c3f3a61bf45c2a2507d2795205f2 (commit)
      from  339cf8429be809b924810ff58eecfd86478312d4 (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 a8c600ce97f8dbc391809a20fcf7610740301042
Author: Andy Wingo <address@hidden>
Date:   Sun Sep 6 17:28:23 2009 +0200

    +, -, min, lcm, gcd now documented
    
    * test-suite/tests/numbers.test: Change some xfail documented? tests to
      passes.

commit f749a1f36f78c3f3a61bf45c2a2507d2795205f2
Author: Andy Wingo <address@hidden>
Date:   Sun Sep 6 16:47:19 2009 +0200

    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.

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

Summary of changes:
 libguile/numbers.c            |  242 ++++++++++++++++++++++++++++++++---------
 libguile/numbers.h            |   14 ++-
 test-suite/tests/numbers.test |   12 +-
 3 files changed, 211 insertions(+), 57 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index ac52631..2d0f09c 100644
--- 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}, address@hidden 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}, address@hidden 
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
--- 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);
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 774e228..28c0700 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1,5 +1,5 @@
 ;;;; numbers.test --- tests guile's numbers     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009 Free Software 
Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1057,7 +1057,7 @@
 
 (with-test-prefix "gcd"
 
-  (expect-fail "documented?"
+  (pass-if "documented?"
     (documented? gcd))
 
   (with-test-prefix "(n)"
@@ -1242,7 +1242,7 @@
 (with-test-prefix "lcm"
   ;; FIXME: more tests?
   ;; (some of these are already in r4rs.test)
-  (expect-fail (documented? lcm))
+  (pass-if (documented? lcm))
   (pass-if (= (lcm) 1))
   (pass-if (= (lcm 32 -36) 288))
   (let ((big-n 
115792089237316195423570985008687907853269984665640564039457584007913129639936) 
; 2 ^ 256
@@ -2340,7 +2340,7 @@
         (big*4 (* fixnum-max 4))
         (big*5 (* fixnum-max 5)))
 
-    (expect-fail (documented? min))
+    (pass-if (documented? min))
     (pass-if (= 1 (min 7 3 1 5)))
     (pass-if (= 1 (min 1 7 3 5)))
     (pass-if (= 1 (min 7 3 5 1)))
@@ -2436,7 +2436,7 @@
 
 (with-test-prefix "+"
 
-  (expect-fail "documented?"
+  (pass-if "documented?"
     (documented? +))
 
   (with-test-prefix "wrong type argument"
@@ -2525,7 +2525,7 @@
 
 (with-test-prefix "/"
 
-  (expect-fail "documented?"
+  (pass-if "documented?"
     (documented? /))
 
   (with-test-prefix "division by zero"


hooks/post-receive
-- 
GNU Guile