(scm_string_any, scm_string_every): Add support for char

and charset as predicates, per SRFI-13 spec.

1 files changed, 59 insertions, 20 deletions

diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c
index f7afa2784..2698095d3 100644
--- a/srfi/srfi-13.c
+++ b/srfi/srfi-13.c
@@ -53,7 +53,7 @@
 
 
 SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
-            (SCM pred, SCM s, SCM start, SCM end),
+            (SCM char_pred, SCM s, SCM start, SCM end),
 	    "Check if the predicate @var{pred} is true for any character in\n"
 	    "the string @var{s}.\n"
 	    "\n"
@@ -71,18 +71,36 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
   int cstart, cend;
   SCM res;
 
-  SCM_VALIDATE_PROC (1, pred);
   MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
 				   3, start, cstart,
 				   4, end, cend);
-  cstr += cstart;
-  while (cstart < cend)
+
+  if (SCM_CHARP (char_pred))
     {
-      res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr));
-      if (scm_is_true (res))
-	return res;
-      cstr++;
-      cstart++;
+      return (memchr (cstr+cstart, (int) SCM_CHAR (char_pred),
+                      cend-cstart) == NULL
+              ? SCM_BOOL_F : SCM_BOOL_T);
+    }
+  else if (SCM_CHARSETP (char_pred))
+    {
+      int i;
+      for (i = cstart; i < cend; i++)
+        if (SCM_CHARSET_GET (char_pred, cstr[i]))
+          return SCM_BOOL_T;
+    }
+  else
+    {
+      SCM_VALIDATE_PROC (1, char_pred);
+
+      cstr += cstart;
+      while (cstart < cend)
+        {
+          res = scm_call_1 (char_pred, SCM_MAKE_CHAR (*cstr));
+          if (scm_is_true (res))
+            return res;
+          cstr++;
+          cstart++;
+        }
     }
   return SCM_BOOL_F;
 }
@@ -90,7 +108,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
 
 
 SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
-            (SCM pred, SCM s, SCM start, SCM end),
+            (SCM char_pred, SCM s, SCM start, SCM end),
 	    "Check if the predicate @var{pred} is true for every character\n"
 	    "in the string @var{s}.\n"
 	    "\n"
@@ -112,21 +130,42 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
   int cstart, cend;
   SCM res;
 
-  SCM_VALIDATE_PROC (1, pred);
   MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
 				   3, start, cstart,
 				   4, end, cend);
-  res = SCM_BOOL_T;
-  cstr += cstart;
-  while (cstart < cend)
+  if (SCM_CHARP (char_pred))
     {
-      res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr));
-      if (scm_is_false (res))
-	return res;
-      cstr++;
-      cstart++;
+      char cchr = SCM_CHAR (char_pred);
+      int i;
+      for (i = cstart; i < cend; i++)
+        if (cstr[i] != cchr)
+          return SCM_BOOL_F;
+      return SCM_BOOL_T;
+    }
+  else if (SCM_CHARSETP (char_pred))
+    {
+      int i;
+      for (i = cstart; i < cend; i++)
+        if (! SCM_CHARSET_GET (char_pred, cstr[i]))
+          return SCM_BOOL_F;
+      return SCM_BOOL_T;
+    }
+  else
+    {
+      SCM_VALIDATE_PROC (1, char_pred);
+
+      res = SCM_BOOL_T;
+      cstr += cstart;
+      while (cstart < cend)
+        {
+          res = scm_call_1 (char_pred, SCM_MAKE_CHAR (*cstr));
+          if (scm_is_false (res))
+            return res;
+          cstr++;
+          cstart++;
+        }
+      return res;
     }
-  return res;
 }
 #undef FUNC_NAME