mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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

48
srfi/srfi-13.c
View file

@ -53,7 +53,7 @@
#include "srfi-14.h" #include "srfi-14.h"
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}, proceeding from left (index @var{start}) to\n" "the string @var{s}, proceeding from left (index @var{start}) to\n"
"right (index @var{end}). If @code{string-any} returns true,\n" "right (index @var{end}). If @code{string-any} returns true,\n"
@ -65,26 +65,42 @@ 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);
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr, SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
if (SCM_CHARP (char_pred))
{
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; cstr += cstart;
while (cstart < cend) while (cstart < cend)
{ {
res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); res = scm_call_1 (char_pred, SCM_MAKE_CHAR (*cstr));
if (!SCM_FALSEP (res)) if (!SCM_FALSEP (res))
return res; return res;
cstr++; cstr++;
cstart++; cstart++;
} }
}
return SCM_BOOL_F; return SCM_BOOL_F;
} }
#undef FUNC_NAME #undef FUNC_NAME
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}, proceeding from left (index @var{start})\n" "in the string @var{s}, proceeding from left (index @var{start})\n"
"to right (index @var{end}). If @code{string-every} returns\n" "to right (index @var{end}). If @code{string-every} returns\n"
@ -96,15 +112,34 @@ 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);
SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr, SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
if (SCM_CHARP (char_pred))
{
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; res = SCM_BOOL_T;
cstr += cstart; cstr += cstart;
while (cstart < cend) while (cstart < cend)
{ {
res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); res = scm_call_1 (char_pred, SCM_MAKE_CHAR (*cstr));
if (SCM_FALSEP (res)) if (SCM_FALSEP (res))
return res; return res;
cstr++; cstr++;
@ -112,6 +147,7 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0,
} }
return res; return res;
} }
}
#undef FUNC_NAME #undef FUNC_NAME