mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

(scm_string_any, scm_string_every): Add support for char

Browse source 
and charset as predicates, per SRFI-13 spec.
This commit is contained in:
Kevin Ryde 2004-08-14 00:36:40 +00:00
parent 23043c797a
commit 313f062011
1 changed files with 56 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

76
srfi/srfi-13.c
View file

@ -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 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
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_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}, proceeding from left (index @var{start})\n"
"to right (index @var{end}). If @code{string-every} returns\n"
@ -96,21 +112,41 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
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