mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +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:37:53 +00:00
parent fa0c0a4b12
commit 788dafed64
1 changed files with 59 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

79
srfi/srfi-13.c
View file

@ -53,7 +53,7 @@
SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0, 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" "Check if the predicate @var{pred} is true for any character in\n"
"the string @var{s}.\n" "the string @var{s}.\n"
"\n" "\n"
@ -71,18 +71,36 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
int cstart, cend; int cstart, cend;
SCM res; SCM res;
SCM_VALIDATE_PROC (1, pred);
MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr, MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
cstr += cstart;
while (cstart < cend) if (SCM_CHARP (char_pred))
{ {
res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); return (memchr (cstr+cstart, (int) SCM_CHAR (char_pred),
if (scm_is_true (res)) cend-cstart) == NULL
return res; ? SCM_BOOL_F : SCM_BOOL_T);
cstr++; }
cstart++; 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; 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_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" "Check if the predicate @var{pred} is true for every character\n"
"in the string @var{s}.\n" "in the string @var{s}.\n"
"\n" "\n"
@ -112,21 +130,42 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
int cstart, cend; int cstart, cend;
SCM res; SCM res;
SCM_VALIDATE_PROC (1, pred);
MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr, MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
res = SCM_BOOL_T; if (SCM_CHARP (char_pred))
cstr += cstart;
while (cstart < cend)
{ {
res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); char cchr = SCM_CHAR (char_pred);
if (scm_is_false (res)) int i;
return res; for (i = cstart; i < cend; i++)
cstr++; if (cstr[i] != cchr)
cstart++; 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 #undef FUNC_NAME