mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-30 06:50:31 +02:00
(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.
This commit is contained in:
parent
680b523714
commit
fdc6aebfaf
2 changed files with 30 additions and 2 deletions
|
@ -51,6 +51,34 @@
|
||||||
|
|
||||||
(define format simple-format)
|
(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}
|
;;; {EVAL-CASE}
|
||||||
|
|
|
@ -75,7 +75,7 @@ race_error ()
|
||||||
}
|
}
|
||||||
#endif
|
#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),
|
(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"
|
||||||
|
@ -134,7 +134,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0,
|
||||||
#undef FUNC_NAME
|
#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),
|
(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"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue