diff options
| author | Gary Houston <ghouston@arglist.com> | 2001-08-05 10:12:37 +0000 |
|---|---|---|
| committer | Gary Houston <ghouston@arglist.com> | 2001-08-05 10:12:37 +0000 |
| commit | 5753f02f67d31e87bceba2b1f559c20e6e21b015 (patch) | |
| tree | 8da8903eeff56c0eb5188adcd865eb5f874d8034 /srfi | |
| parent | 848458d99068f7542b5f63d52eb2338595a5fb1e (diff) | |
| download | guile-5753f02f67d31e87bceba2b1f559c20e6e21b015.tar.gz | |
* srfi-1.scm (check-arg-type, non-negative-integer?): a couple of new
internal definitions.
(list-tabulate, iota): check for bad arguments that otherwise
give weird output.
(filter): check for proper list, to avoid infinite recursion on
a circular list.
Diffstat (limited to 'srfi')
| -rw-r--r-- | srfi/ChangeLog | 9 | ||||
| -rw-r--r-- | srfi/srfi-1.scm | 13 |
2 files changed, 22 insertions, 0 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog index d4b650181..d2e94bbe5 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,12 @@ +2001-08-05 Gary Houston <ghouston@arglist.com> + + * srfi-1.scm (check-arg-type, non-negative-integer?): a couple of new + internal definitions. + (list-tabulate, iota): check for bad arguments that otherwise + give weird output. + (filter): check for proper list, to avoid infinite recursion on + a circular list. + 2001-08-04 Gary Houston <ghouston@arglist.com> * srfi-1.scm (filter): replaced with a tail-recursive version. diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index cd2ca757d..f58c1ebfe 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -254,7 +254,18 @@ (define (xcons d a) (cons a d)) +;; internal helper, similar to (scsh utilities) check-arg. +(define (check-arg-type pred arg caller) + (if (pred arg) + arg + (scm-error 'wrong-type-arg caller + "Wrong type argument: ~S" (list arg) '()))) + +;; the srfi spec doesn't seem to forbid inexact integers. +(define (non-negative-integer? x) (and (integer? x) (>= x 0))) + (define (list-tabulate n init-proc) + (check-arg-type non-negative-integer? n "list-tabulate") (let lp ((n n) (acc '())) (if (<= n 0) acc @@ -272,6 +283,7 @@ (lp (cdr r) (cdr p))))))) (define (iota count . rest) + (check-arg-type non-negative-integer? count "iota") (let ((start (if (pair? rest) (car rest) 0)) (step (if (and (pair? rest) (pair? (cdr rest))) (cadr rest) 1))) (let lp ((n 0) (acc '())) @@ -720,6 +732,7 @@ ;;; Filtering & partitioning (define (filter pred list) + (check-arg-type list? list "caller") ; reject circular lists. (letrec ((filiter (lambda (pred rest result) (if (null? rest) (reverse! result) |