diff options
author | Kevin Ryde <user42@zip.com.au> | 2004-12-14 00:21:25 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2004-12-14 00:21:25 +0000 |
commit | fdc6aebfaf444a84e8b6291c2a5589f4ba477c7a (patch) | |
tree | 846ea6aa92b2ef35ffccb24f857e36e310d7c666 | |
parent | 680b5237147519bff4459a8dd6c0a1224b7e5a1c (diff) | |
download | guile-fdc6aebfaf444a84e8b6291c2a5589f4ba477c7a.tar.gz |
(string-any, string-every): Use a scheme
wrapper around the C code so for the final call to the predicate
procedure is a tail call, per SRFI-13 spec.
-rw-r--r-- | ice-9/boot-9.scm | 28 | ||||
-rw-r--r-- | libguile/srfi-13.c | 4 |
2 files changed, 30 insertions, 2 deletions
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index defab8bfb..7756b4ccd 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -51,6 +51,34 @@ (define format simple-format) +;; this is scheme wrapping the C code so the final pred call is a tail call, +;; per SRFI-13 spec +(define (string-any char_pred s . rest) + (let ((start (if (null? rest) + 0 (car rest))) + (end (if (or (null? rest) (null? (cdr rest))) + (string-length s) (cadr rest)))) + (if (and (procedure? char_pred) + (> end start) + (<= end (string-length s))) ;; let c-code handle range error + (or (string-any-c-code char_pred s start (1- end)) + (char_pred (string-ref s (1- end)))) + (string-any-c-code char_pred s start end)))) + +;; this is scheme wrapping the C code so the final pred call is a tail call, +;; per SRFI-13 spec +(define (string-every char_pred s . rest) + (let ((start (if (null? rest) + 0 (car rest))) + (end (if (or (null? rest) (null? (cdr rest))) + (string-length s) (cadr rest)))) + (if (and (procedure? char_pred) + (> end start) + (<= end (string-length s))) ;; let c-code handle range error + (and (string-every-c-code char_pred s start (1- end)) + (char_pred (string-ref s (1- end)))) + (string-every-c-code char_pred s start end)))) + ;;; {EVAL-CASE} diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index 169bbc94b..c00279092 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -75,7 +75,7 @@ race_error () } #endif -SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0, +SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0, (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" @@ -134,7 +134,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0, #undef FUNC_NAME -SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0, +SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0, (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" |