remove rpsubrs

* libguile/tags.h: Remove rpsubrs (I chose to interpret the terse name
  as "recursive predicate subrs"). Just use gsubrs with rest arguments,
  or do a fold yourself.

* libguile/array-map.c (scm_i_array_equal_p): Do the comparison in
  order, why not.

* libguile/chars.c:
* libguile/eq.c:
* libguile/numbers.c:
* libguile/strorder.c: Add 0,2,1 gsubr wrappers for rpsubrs like eq?, <,
  etc.

* libguile/goops.c (scm_class_of)
* libguile/procprop.c (scm_i_procedure_arity)
* libguile/procs.c (scm_thunk_p)
* libguile/vm.c (apply_foreign): Remove rpsubr cases.

* test-suite/tests/numbers.test ("=", "<"): Turn a couple xfails into
  passes.

libguile/array-map.c

@@ -942,8 +942,10 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
     return SCM_BOOL_T;
   
   while (!scm_is_null (rest))
-    { if (scm_is_false (scm_array_equal_p (ra0, scm_car (rest))))
+    { if (scm_is_false (scm_array_equal_p (ra0, ra1)))
         return SCM_BOOL_F;
+      ra0 = ra1;
+      ra1 = scm_car (rest);
       rest = scm_cdr (rest);
     }
   return scm_array_equal_p (ra0, ra1);

libguile/chars.c

@@ -43,11 +43,28 @@ SCM_DEFINE (scm_char_p, "char?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_eq_p, "char=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the Unicode code point of @var{x} is equal to the\n"
+            "Return @code{#t} if the Unicode code point of @var{x} is equal to the\n"
-             "code point of @var{y}, else @code{#f}.\n")
+            "code point of @var{y}, else @code{#f}.\n")
-#define FUNC_NAME s_scm_char_eq_p
+#define FUNC_NAME s_scm_i_char_eq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_eq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_eq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_eq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_eq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -56,11 +73,28 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr,
 #undef FUNC_NAME
 
 
-SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr, 
+SCM_DEFINE (scm_i_char_less_p, "char<?", 0, 2, 1, 
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} iff the code point of @var{x} is less than the code\n"
+            "Return @code{#t} iff the code point of @var{x} is less than the code\n"
-             "point of @var{y}, else @code{#f}.")
+            "point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_less_p
+#define FUNC_NAME s_scm_i_char_less_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_less_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_less_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_less_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_less_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -68,11 +102,28 @@ SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_leq_p, "char<=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the Unicode code point of @var{x} is less than or\n"
+            "Return @code{#t} if the Unicode code point of @var{x} is less than or\n"
-             "equal to the code point of @var{y}, else @code{#f}.")
+            "equal to the code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_leq_p
+#define FUNC_NAME s_scm_i_char_leq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_leq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_leq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_leq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_leq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -80,11 +131,28 @@ SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_gr_p, "char>?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the Unicode code point of @var{x} is greater than\n"
+            "Return @code{#t} if the Unicode code point of @var{x} is greater than\n"
-             "the code point of @var{y}, else @code{#f}.")
+            "the code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_gr_p
+#define FUNC_NAME s_scm_i_char_gr_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_gr_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_gr_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_gr_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_gr_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -92,11 +160,28 @@ SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_geq_p, "char>=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the Unicode code point of @var{x} is greater than\n"
+            "Return @code{#t} if the Unicode code point of @var{x} is greater than\n"
-             "or equal to the code point of @var{y}, else @code{#f}.")
+            "or equal to the code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_geq_p
+#define FUNC_NAME s_scm_i_char_geq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_geq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_geq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_geq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_geq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -111,11 +196,28 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr,
    implementation would be to use that table and make a char-foldcase
    function.  */
 
-SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_ci_eq_p, "char-ci=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the case-folded Unicode code point of @var{x} is\n"
+            "Return @code{#t} if the case-folded Unicode code point of @var{x} is\n"
-             "the same as the case-folded code point of @var{y}, else @code{#f}.")
+            "the same as the case-folded code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_ci_eq_p
+#define FUNC_NAME s_scm_i_char_ci_eq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_ci_eq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_ci_eq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_ci_eq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_ci_eq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -123,11 +225,28 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_ci_less_p, "char-ci<?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} if the case-folded Unicode code point of @var{x} is\n"
+            "Return @code{#t} if the case-folded Unicode code point of @var{x} is\n"
-             "less than the case-folded code point of @var{y}, else @code{#f}.")
+            "less than the case-folded code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_ci_less_p
+#define FUNC_NAME s_scm_i_char_ci_less_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_ci_less_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_ci_less_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_ci_less_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_ci_less_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -135,12 +254,29 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_ci_leq_p, "char-ci<=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} iff the case-folded Unicodd code point of @var{x} is\n"
+            "Return @code{#t} iff the case-folded Unicodd code point of @var{x} is\n"
-             "less than or equal to the case-folded code point of @var{y}, else\n"
+            "less than or equal to the case-folded code point of @var{y}, else\n"
-             "@code{#f}")
+            "@code{#f}")
-#define FUNC_NAME s_scm_char_ci_leq_p
+#define FUNC_NAME s_scm_i_char_ci_leq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_ci_leq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_ci_leq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_ci_leq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_ci_leq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -148,11 +284,28 @@ SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_ci_gr_p, "char-ci>?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} iff the case-folded code point of @var{x} is greater\n"
+            "Return @code{#t} iff the case-folded code point of @var{x} is greater\n"
-             "than the case-folded code point of @var{y}, else @code{#f}.")
+            "than the case-folded code point of @var{y}, else @code{#f}.")
-#define FUNC_NAME s_scm_char_ci_gr_p
+#define FUNC_NAME s_scm_i_char_ci_gr_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_ci_gr_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_ci_gr_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_ci_gr_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_ci_gr_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);
@@ -160,12 +313,29 @@ SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_char_ci_geq_p, "char-ci>=?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
-             "Return @code{#t} iff the case-folded Unicode code point of @var{x} is\n"
+            "Return @code{#t} iff the case-folded Unicode code point of @var{x} is\n"
-             "greater than or equal to the case-folded code point of @var{y}, else\n"
+            "greater than or equal to the case-folded code point of @var{y}, else\n"
-             "@code{#f}.")
+            "@code{#f}.")
-#define FUNC_NAME s_scm_char_ci_geq_p
+#define FUNC_NAME s_scm_i_char_ci_geq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_char_ci_geq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_char_ci_geq_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_char_ci_geq_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_char_ci_geq_p
 {
   SCM_VALIDATE_CHAR (1, x);
   SCM_VALIDATE_CHAR (2, y);

libguile/eq.c

@@ -47,8 +47,8 @@
 #endif
 
 
-SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_eq_p, "eq?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
 	    "Return @code{#t} if @var{x} and @var{y} are the same object,\n"
 	    "except for numbers and characters.  For example,\n"
 	    "\n"
@@ -87,12 +87,28 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
 	    "(define x (string->symbol \"foo\"))\n"
 	    "(eq? x 'foo) @result{} #t\n"
 	    "@end example")
-#define FUNC_NAME s_scm_eq_p
+#define FUNC_NAME s_scm_i_eq_p
 {
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (scm_is_pair (rest))
+    {
+      if (!scm_is_eq (x, y))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
   return scm_from_bool (scm_is_eq (x, y));
 }
 #undef FUNC_NAME
 
+SCM
+scm_eq_p (SCM x, SCM y)
+{
+  return scm_from_bool (scm_is_eq (x, y));
+}
+
 /* We compare doubles in a special way for 'eqv?' to be able to
    distinguish plus and minus zero and to identify NaNs.
 */
@@ -104,8 +120,8 @@ real_eqv (double x, double y)
 }
 
 #include <stdio.h>
-SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_eqv_p, "eqv?", 0, 2, 1,
-             (SCM x, SCM y),
+            (SCM x, SCM y, SCM rest),
 	    "Return @code{#t} if @var{x} and @var{y} are the same object, or\n"
 	    "for characters and numbers the same value.\n"
 	    "\n"
@@ -122,7 +138,24 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
 	    "(eqv? 3 (+ 1 2)) @result{} #t\n"
 	    "(eqv? 1 1.0)     @result{} #f\n"
 	    "@end example")
-#define FUNC_NAME s_scm_eqv_p
+#define FUNC_NAME s_scm_i_eqv_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (!scm_is_true (scm_eqv_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_eqv_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM scm_eqv_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_eqv_p
 {
   if (scm_is_eq (x, y))
     return SCM_BOOL_T;
@@ -178,44 +211,63 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
 #undef FUNC_NAME
 
 
-SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
+SCM scm_i_equal_p (SCM, SCM, SCM);
-			 (SCM x, SCM y),
+SCM_PRIMITIVE_GENERIC (scm_i_equal_p, "equal?", 0, 2, 1,
-	    "Return @code{#t} if @var{x} and @var{y} are the same type, and\n"
+                       (SCM x, SCM y, SCM rest),
-	    "their contents or value are equal.\n"
+                       "Return @code{#t} if @var{x} and @var{y} are the same type, and\n"
-	    "\n"
+                       "their contents or value are equal.\n"
-	    "For a pair, string, vector or array, @code{equal?} compares the\n"
+                       "\n"
-	    "contents, and does so using using the same @code{equal?}\n"
+                       "For a pair, string, vector or array, @code{equal?} compares the\n"
-	    "recursively, so a deep structure can be traversed.\n"
+                       "contents, and does so using using the same @code{equal?}\n"
-	    "\n"
+                       "recursively, so a deep structure can be traversed.\n"
-	    "@example\n"
+                       "\n"
-	    "(equal? (list 1 2 3) (list 1 2 3))   @result{} #t\n"
+                       "@example\n"
-	    "(equal? (list 1 2 3) (vector 1 2 3)) @result{} #f\n"
+                       "(equal? (list 1 2 3) (list 1 2 3))   @result{} #t\n"
-	    "@end example\n"
+                       "(equal? (list 1 2 3) (vector 1 2 3)) @result{} #f\n"
-	    "\n"
+                       "@end example\n"
-	    "For other objects, @code{equal?} compares as per @code{eqv?},\n"
+                       "\n"
-	    "which means characters and numbers are compared by type and\n"
+                       "For other objects, @code{equal?} compares as per @code{eqv?},\n"
-	    "value (and like @code{eqv?}, exact and inexact numbers are not\n"
+                       "which means characters and numbers are compared by type and\n"
-	    "@code{equal?}, even if their value is the same).\n"
+                       "value (and like @code{eqv?}, exact and inexact numbers are not\n"
-	    "\n"
+                       "@code{equal?}, even if their value is the same).\n"
-	    "@example\n"
+                       "\n"
-	    "(equal? 3 (+ 1 2)) @result{} #t\n"
+                       "@example\n"
-	    "(equal? 1 1.0)     @result{} #f\n"
+                       "(equal? 3 (+ 1 2)) @result{} #t\n"
-	    "@end example\n"
+                       "(equal? 1 1.0)     @result{} #f\n"
-	    "\n"
+                       "@end example\n"
-	    "Hash tables are currently only compared as per @code{eq?}, so\n"
+                       "\n"
-	    "two different tables are not @code{equal?}, even if their\n"
+                       "Hash tables are currently only compared as per @code{eq?}, so\n"
-	    "contents are the same.\n"
+                       "two different tables are not @code{equal?}, even if their\n"
-	    "\n"
+                       "contents are the same.\n"
-	    "@code{equal?} does not support circular data structures, it may\n"
+                       "\n"
-	    "go into an infinite loop if asked to compare two circular lists\n"
+                       "@code{equal?} does not support circular data structures, it may\n"
-	    "or similar.\n"
+                       "go into an infinite loop if asked to compare two circular lists\n"
-	    "\n"
+                       "or similar.\n"
-	    "New application-defined object types (Smobs) have an\n"
+                       "\n"
-	    "@code{equalp} handler which is called by @code{equal?}.  This\n"
+                       "New application-defined object types (Smobs) have an\n"
-	    "lets an application traverse the contents or control what is\n"
+                       "@code{equalp} handler which is called by @code{equal?}.  This\n"
-	    "considered @code{equal?} for two such objects.  If there's no\n"
+                       "lets an application traverse the contents or control what is\n"
-	    "handler, the default is to just compare as per @code{eq?}.")
+                       "considered @code{equal?} for two such objects.  If there's no\n"
-#define FUNC_NAME s_scm_equal_p
+                       "handler, the default is to just compare as per @code{eq?}.")
+#define FUNC_NAME s_scm_i_equal_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (!scm_is_true (scm_equal_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = SCM_CDR (rest);
+    }
+  return scm_equal_p (x, y);
+}
+#undef FUNC_NAME
+
+SCM
+scm_equal_p (SCM x, SCM y)
+#define FUNC_NAME s_scm_i_equal_p
 {
   SCM_CHECK_STACK;
  tailrecurse:
@@ -306,8 +358,8 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
   return SCM_BOOL_F;
   
  generic_equal:
-  if (SCM_UNPACK (g_scm_equal_p))
+  if (SCM_UNPACK (g_scm_i_equal_p))
-    return scm_call_generic_2 (g_scm_equal_p, x, y);
+    return scm_call_generic_2 (g_scm_i_equal_p, x, y);
   else
     return SCM_BOOL_F;
 }

libguile/goops.c

@@ -226,7 +226,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	    return scm_class_fraction;
           }
 	case scm_tc7_cxr:
-	case scm_tc7_rpsubr:
 	case scm_tc7_gsubr:
 	  if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
 	    return scm_class_primitive_generic;

libguile/numbers.c

@@ -3331,8 +3331,25 @@ SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p);
+SCM scm_i_num_eq_p (SCM, SCM, SCM);
-/* "Return @code{#t} if all parameters are numerically equal."  */
+SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1,
+                       (SCM x, SCM y, SCM rest),
+                       "Return @code{#t} if all parameters are numerically equal.")
+#define FUNC_NAME s_scm_i_num_eq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_num_eq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_num_eq_p (x, y);
+}
+#undef FUNC_NAME
 SCM
 scm_num_eq_p (SCM x, SCM y)
 {
@@ -3375,7 +3392,7 @@ scm_num_eq_p (SCM x, SCM y)
       else if (SCM_FRACTIONP (y))
 	return SCM_BOOL_F;
       else
-	SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
     }
   else if (SCM_BIGP (x))
     {
@@ -3410,7 +3427,7 @@ scm_num_eq_p (SCM x, SCM y)
       else if (SCM_FRACTIONP (y))
 	return SCM_BOOL_F;
       else
-	SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
     }
   else if (SCM_REALP (x))
     {
@@ -3448,7 +3465,7 @@ scm_num_eq_p (SCM x, SCM y)
           goto again;
         }
       else
-	SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
     }
   else if (SCM_COMPLEXP (x))
     {
@@ -3486,7 +3503,7 @@ scm_num_eq_p (SCM x, SCM y)
           goto again;
         }
       else
-	SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
     }
   else if (SCM_FRACTIONP (x))
     {
@@ -3520,10 +3537,10 @@ scm_num_eq_p (SCM x, SCM y)
       else if (SCM_FRACTIONP (y))
 	return scm_i_fraction_equalp (x, y);
       else
-	SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
     }
   else
-    SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, s_scm_i_num_eq_p);
 }
 
 
@@ -3533,10 +3550,26 @@ scm_num_eq_p (SCM x, SCM y)
    mpq_cmp.  flonum/frac compares likewise, but with the slight complication
    of the float exponent to take into account.  */
 
-SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p);
+SCM scm_i_num_less_p (SCM, SCM, SCM);
-/* "Return @code{#t} if the list of parameters is monotonically\n"
+SCM_PRIMITIVE_GENERIC (scm_i_num_less_p, "<", 0, 2, 1,
- * "increasing."
+                       (SCM x, SCM y, SCM rest),
- */
+                       "Return @code{#t} if the list of parameters is monotonically\n"
+                       "increasing.")
+#define FUNC_NAME s_scm_i_num_less_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_less_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_less_p (x, y);
+}
+#undef FUNC_NAME
 SCM
 scm_less_p (SCM x, SCM y)
 {
@@ -3566,7 +3599,7 @@ scm_less_p (SCM x, SCM y)
           goto again;
         }
       else
-	SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p);
     }
   else if (SCM_BIGP (x))
     {
@@ -3594,7 +3627,7 @@ scm_less_p (SCM x, SCM y)
       else if (SCM_FRACTIONP (y))
         goto int_frac;
       else
-	SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p);
     }
   else if (SCM_REALP (x))
     {
@@ -3622,7 +3655,7 @@ scm_less_p (SCM x, SCM y)
           goto again;
         }
       else
-	SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p);
     }
   else if (SCM_FRACTIONP (x))
     {
@@ -3655,43 +3688,75 @@ scm_less_p (SCM x, SCM y)
           goto again;
         }
       else
-	SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+	SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p);
     }
   else
-    SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARG1, s_scm_i_num_less_p);
 }
 
 
-SCM_GPROC1 (s_scm_gr_p, ">", scm_tc7_rpsubr, scm_gr_p, g_gr_p);
+SCM scm_i_num_gr_p (SCM, SCM, SCM);
-/* "Return @code{#t} if the list of parameters is monotonically\n"
+SCM_PRIMITIVE_GENERIC (scm_i_num_gr_p, ">", 0, 2, 1,
- * "decreasing."
+                       (SCM x, SCM y, SCM rest),
- */
+                       "Return @code{#t} if the list of parameters is monotonically\n"
-#define FUNC_NAME s_scm_gr_p
+                       "decreasing.")
+#define FUNC_NAME s_scm_i_num_gr_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_gr_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_gr_p (x, y);
+}
+#undef FUNC_NAME
+#define FUNC_NAME s_scm_i_num_gr_p
 SCM
 scm_gr_p (SCM x, SCM y)
 {
   if (!SCM_NUMBERP (x))
-    SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG1, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME);
   else if (!SCM_NUMBERP (y))
-    SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG2, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME);
   else
     return scm_less_p (y, x);
 }
 #undef FUNC_NAME
 
 
-SCM_GPROC1 (s_scm_leq_p, "<=", scm_tc7_rpsubr, scm_leq_p, g_leq_p);
+SCM scm_i_num_leq_p (SCM, SCM, SCM);
-/* "Return @code{#t} if the list of parameters is monotonically\n"
+SCM_PRIMITIVE_GENERIC (scm_i_num_leq_p, "<=", 0, 2, 1,
- * "non-decreasing."
+                       (SCM x, SCM y, SCM rest),
- */
+                       "Return @code{#t} if the list of parameters is monotonically\n"
-#define FUNC_NAME s_scm_leq_p
+                       "non-decreasing.")
+#define FUNC_NAME s_scm_i_num_leq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_leq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_leq_p (x, y);
+}
+#undef FUNC_NAME
+#define FUNC_NAME s_scm_i_num_leq_p
 SCM
 scm_leq_p (SCM x, SCM y)
 {
   if (!SCM_NUMBERP (x))
-    SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG1, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME);
   else if (!SCM_NUMBERP (y))
-    SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG2, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME);
   else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
     return SCM_BOOL_F;
   else
@@ -3700,18 +3765,34 @@ scm_leq_p (SCM x, SCM y)
 #undef FUNC_NAME
 
 
-SCM_GPROC1 (s_scm_geq_p, ">=", scm_tc7_rpsubr, scm_geq_p, g_geq_p);
+SCM scm_i_num_geq_p (SCM, SCM, SCM);
-/* "Return @code{#t} if the list of parameters is monotonically\n"
+SCM_PRIMITIVE_GENERIC (scm_i_num_geq_p, ">=", 0, 2, 1,
- * "non-increasing."
+                       (SCM x, SCM y, SCM rest),
- */
+                       "Return @code{#t} if the list of parameters is monotonically\n"
-#define FUNC_NAME s_scm_geq_p
+                       "non-increasing.")
+#define FUNC_NAME s_scm_i_num_geq_p
+{
+  if (SCM_UNBNDP (x) || SCM_UNBNDP (y))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (scm_geq_p (x, y)))
+        return SCM_BOOL_F;
+      x = y;
+      y = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return scm_geq_p (x, y);
+}
+#undef FUNC_NAME
+#define FUNC_NAME s_scm_i_num_geq_p
 SCM
 scm_geq_p (SCM x, SCM y)
 {
   if (!SCM_NUMBERP (x))
-    SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG1, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME);
   else if (!SCM_NUMBERP (y))
-    SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG2, FUNC_NAME);
+    SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME);
   else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
     return SCM_BOOL_F;
   else

libguile/procprop.c

@@ -56,9 +56,6 @@ scm_i_procedure_arity (SCM proc)
     case scm_tc7_cxr:
       a += 1;
       break;
-    case scm_tc7_rpsubr:
-      r = 1;
-      break;
     case scm_tc7_program:
       if (scm_i_program_arity (proc, &a, &o, &r))
         break;

libguile/procs.c

@@ -135,8 +135,6 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
 	{
 	case scm_tcs_closures:
 	  return scm_from_bool (SCM_CLOSURE_NUM_REQUIRED_ARGS (obj) == 0);
-	case scm_tc7_rpsubr:
-	  return SCM_BOOL_T;
 	case scm_tc7_gsubr:
 	  return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
 	case scm_tc7_program:

libguile/strorder.c

@@ -1,4 +1,4 @@
-/*	Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
+/*	Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008, 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 License
@@ -42,8 +42,8 @@ srfi13_cmp (SCM s1, SCM s2, SCM (*cmp) (SCM, SCM, SCM, SCM, SCM, SCM))
     return SCM_BOOL_F;
 }
 
-SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_equal_p, "string=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Lexicographic equality predicate; return @code{#t} if the two\n"
 	    "strings are the same length and contain the same characters in\n"
 	    "the same positions, otherwise return @code{#f}.\n"
@@ -52,103 +52,273 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
 	    "letters as though they were the same character, but\n"
 	    "@code{string=?} treats upper and lower case as distinct\n"
 	    "characters.")
-#define FUNC_NAME s_scm_string_equal_p
+#define FUNC_NAME s_scm_i_string_equal_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_eq)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_eq);
+}
+#undef FUNC_NAME
+
+SCM scm_string_equal_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_equal_p
 {
   return srfi13_cmp (s1, s2, scm_string_eq);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_ci_equal_p, "string-ci=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Case-insensitive string equality predicate; return @code{#t} if\n"
 	    "the two strings are the same length and their component\n"
 	    "characters match (ignoring case) at each position; otherwise\n"
 	    "return @code{#f}.")
-#define FUNC_NAME s_scm_string_ci_equal_p
+#define FUNC_NAME s_scm_i_string_ci_equal_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_eq)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ci_eq);
+}
+#undef FUNC_NAME
+
+SCM scm_string_ci_equal_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_ci_equal_p
 {
   return srfi13_cmp (s1, s2, scm_string_ci_eq);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_less_p, "string<?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 	    "is lexicographically less than @var{s2}.")
-#define FUNC_NAME s_scm_string_less_p
+#define FUNC_NAME s_scm_i_string_less_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_lt)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_lt);
+}
+#undef FUNC_NAME
+
+SCM scm_string_less_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_less_p
 {
   return srfi13_cmp (s1, s2, scm_string_lt);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_leq_p, "string<=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 	    "is lexicographically less than or equal to @var{s2}.")
-#define FUNC_NAME s_scm_string_leq_p
+#define FUNC_NAME s_scm_i_string_leq_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_le)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_le);
+}
+#undef FUNC_NAME
+
+SCM scm_string_leq_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_leq_p
 {
   return srfi13_cmp (s1, s2, scm_string_le);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_gr_p, "string>?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 	    "is lexicographically greater than @var{s2}.")
-#define FUNC_NAME s_scm_string_gr_p
+#define FUNC_NAME s_scm_i_string_gr_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_gt)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_gt);
+}
+#undef FUNC_NAME
+
+SCM scm_string_gr_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_gr_p
 {
   return srfi13_cmp (s1, s2, scm_string_gt);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_geq_p, "string>=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Lexicographic ordering predicate; return @code{#t} if @var{s1}\n"
 	    "is lexicographically greater than or equal to @var{s2}.")
-#define FUNC_NAME s_scm_string_geq_p
+#define FUNC_NAME s_scm_i_string_geq_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ge)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ge);
+}
+#undef FUNC_NAME
+
+SCM scm_string_geq_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_geq_p
 {
   return srfi13_cmp (s1, s2, scm_string_ge);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_ci_less_p, "string-ci<?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Case insensitive lexicographic ordering predicate; return\n"
 	    "@code{#t} if @var{s1} is lexicographically less than @var{s2}\n"
 	    "regardless of case.")
-#define FUNC_NAME s_scm_string_ci_less_p
+#define FUNC_NAME s_scm_i_string_ci_less_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_lt)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ci_lt);
+}
+#undef FUNC_NAME
+
+SCM scm_string_ci_less_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_ci_less_p
 {
   return srfi13_cmp (s1, s2, scm_string_ci_lt);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_ci_leq_p, "string-ci<=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Case insensitive lexicographic ordering predicate; return\n"
 	    "@code{#t} if @var{s1} is lexicographically less than or equal\n"
 	    "to @var{s2} regardless of case.")
-#define FUNC_NAME s_scm_string_ci_leq_p
+#define FUNC_NAME s_scm_i_string_ci_leq_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_le)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ci_le);
+}
+#undef FUNC_NAME
+
+SCM scm_string_ci_leq_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_ci_leq_p
 {
   return srfi13_cmp (s1, s2, scm_string_ci_le);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_ci_gr_p, "string-ci>?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Case insensitive lexicographic ordering predicate; return\n"
 	    "@code{#t} if @var{s1} is lexicographically greater than\n"
 	    "@var{s2} regardless of case.")
-#define FUNC_NAME s_scm_string_ci_gr_p
+#define FUNC_NAME s_scm_i_string_ci_gr_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_gt)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ci_gt);
+}
+#undef FUNC_NAME
+
+SCM scm_string_ci_gr_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_ci_gr_p
 {
   return srfi13_cmp (s1, s2, scm_string_ci_gt);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
+SCM_DEFINE (scm_i_string_ci_geq_p, "string-ci>=?", 0, 2, 1,
-             (SCM s1, SCM s2),
+            (SCM s1, SCM s2, SCM rest),
 	    "Case insensitive lexicographic ordering predicate; return\n"
 	    "@code{#t} if @var{s1} is lexicographically greater than or\n"
 	    "equal to @var{s2} regardless of case.")
-#define FUNC_NAME s_scm_string_ci_geq_p
+#define FUNC_NAME s_scm_i_string_ci_geq_p
+{
+  if (SCM_UNBNDP (s1) || SCM_UNBNDP (s2))
+    return SCM_BOOL_T;
+  while (!scm_is_null (rest))
+    {
+      if (scm_is_false (srfi13_cmp (s1, s2, scm_string_ci_ge)))
+        return SCM_BOOL_F;
+      s1 = s2;
+      s2 = scm_car (rest);
+      rest = scm_cdr (rest);
+    }
+  return srfi13_cmp (s1, s2, scm_string_ci_ge);
+}
+#undef FUNC_NAME
+
+SCM scm_string_ci_geq_p (SCM s1, SCM s2)
+#define FUNC_NAME s_scm_i_string_ci_geq_p
 {
   return srfi13_cmp (s1, s2, scm_string_ci_ge);
 }

libguile/tags.h

@@ -427,7 +427,7 @@ typedef scm_t_uintptr scm_t_bits;
 
 #define scm_tc7_unused_17	61
 #define scm_tc7_gsubr		63
-#define scm_tc7_rpsubr		69
+#define scm_tc7_unused_19	69
 #define scm_tc7_program		79
 #define scm_tc7_unused_9	85
 #define scm_tc7_unused_10	87
@@ -676,7 +676,6 @@ enum scm_tc8_tags
  */
 #define scm_tcs_subrs \
        scm_tc7_cxr:\
-  case scm_tc7_rpsubr:\
   case scm_tc7_gsubr
 
 

libguile/vm.c

@@ -280,16 +280,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
     case scm_tc7_cxr:
       if (nargs != 1) scm_wrong_num_args (proc);
       return scm_i_chase_pairs (args[0], (scm_t_bits) SCM_SUBRF (proc));
-    case scm_tc7_rpsubr:
-      {
-        int idx = 0;
-        while (nargs-- > 1)
-          { idx++;
-            if (scm_is_false (SCM_SUBRF (proc) (args[idx-1], args[idx])))
-              return SCM_BOOL_F;
-          }
-        return SCM_BOOL_T;
-      }
     case scm_tc7_smob:
       if (!SCM_SMOB_APPLICABLE_P (proc))
         goto badproc;

test-suite/tests/numbers.test

@@ -1589,7 +1589,7 @@
 ;;;
 
 (with-test-prefix "="
-  (expect-fail (documented? =))
+  (pass-if (documented? =))
   (pass-if (= 0 0))
   (pass-if (= 7 7))
   (pass-if (= -7 -7))
@@ -1673,7 +1673,7 @@
 
 (with-test-prefix "<"
 
-  (expect-fail "documented?"
+  (pass-if "documented?"
     (documented? <))
 
   (with-test-prefix "(< 0 n)"