diff options
author | Kevin Ryde <user42@zip.com.au> | 2004-08-14 00:37:53 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2004-08-14 00:37:53 +0000 |
commit | 788dafed64a4f08d3c3a3825f4e7c95a274d1631 (patch) | |
tree | 167cb862871bf82a572a3ebfb348d9261f39d96f /srfi/srfi-13.c | |
parent | fa0c0a4b12be5a12ed7c79946d758a0a1980d479 (diff) | |
download | guile-788dafed64a4f08d3c3a3825f4e7c95a274d1631.tar.gz |
(scm_string_any, scm_string_every): Add support for char
and charset as predicates, per SRFI-13 spec.
Diffstat (limited to 'srfi/srfi-13.c')
-rw-r--r-- | srfi/srfi-13.c | 79 |
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 |