string-any, string-every predicate

string-any, string-every predicate

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 2151 bytes --]

        * srfi-13.c (scm_string_any, scm_string_every): Add support for char
        and charset as predicates, per SRFI-13 spec.

I slipped this into 1.6 too, since it's a deviation from the spec.
New words:


 -- Scheme Procedure: string-any char_pred s [start end]
     Return true if `char_pred' is satisfied for any character in the
     string S.  CHAR_PRED can be

        * A character, to to test for any in S equal to that.

        * A character set (*note SRFI-14::), to test for any character
          in S in that character set.

        * A predicate function, called as `(CHAR_PRED c)' for each
          character in S, from left to right, to test for any on which
          CHAR_PRED returns true.

          When CHAR_PRED does return true (ie. non-`#f'), that value is
          the value returned by `string-any'.

     If there are no characters in S (ie. START equals END) then the
     return is `#f'.

     SRFI-13 specifies that when CHAR_PRED is a predicate function, the
     call on the last character of S (assuming that point is reached)
     is a tail call, but currently in Guile this is not the case.

 -- Scheme Procedure: string-every char_pred s [start end]
     Return true if CHAR_PRED is satisifed for every character in the
     string S.  CHAR_PRED can be

        * A character, to to test for every character in S equal to
          that.

        * A character set (*note SRFI-14::), to test for every
          character in S being in that character set.

        * A predicate function, called as `(CHAR_PRED c)' for each
          character in S, from left to right, to test that it returns
          true for every character in S.

          When CHAR_PRED does return true (ie. non-`#f') for every
          character, the return from the last call is the value
          returned by `string-any'.

     If there are no characters in S (ie. START equals END) then the
     return is `#t'.

     SRFI-13 specifies that when CHAR_PRED is a predicate function, the
     call on the last character of S (assuming that point is reached)
     is a tail call, but currently in Guile this is not the case.



[-- Attachment #2: srfi-13.c.any.diff --]
[-- Type: text/plain, Size: 3207 bytes --]

--- srfi-13.c.~1.11.2.8.~	2004-08-02 10:25:34.000000000 +1000
+++ srfi-13.c	2004-08-14 10:28:17.000000000 +1000
@@ -53,7 +53,7 @@
 #include "srfi-14.h"
 
 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}, proceeding from left (index @var{start}) to\n"
 	    "right (index @var{end}).  If @code{string-any} returns true,\n"
@@ -65,18 +65,34 @@
   int cstart, cend;
   SCM res;
 
-  SCM_VALIDATE_PROC (1, pred);
   SCM_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_FALSEP (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_FALSEP (res))
+            return res;
+          cstr++;
+          cstart++;
+        }
     }
   return SCM_BOOL_F;
 }
@@ -84,7 +100,7 @@
 
 
 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}, proceeding from left (index @var{start})\n"
 	    "to right (index @var{end}).  If @code{string-every} returns\n"
@@ -96,21 +112,41 @@
   int cstart, cend;
   SCM res;
 
-  SCM_VALIDATE_PROC (1, pred);
   SCM_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_FALSEP (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_FALSEP (res))
+            return res;
+          cstr++;
+          cstart++;
+        }
+      return res;
     }
-  return res;
 }
 #undef FUNC_NAME
 

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel