From 5753f02f67d31e87bceba2b1f559c20e6e21b015 Mon Sep 17 00:00:00 2001
From: Gary Houston <ghouston@arglist.com>
Date: Sun, 5 Aug 2001 10:12:37 +0000
Subject: 	* 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.

---
 srfi/ChangeLog  |  9 +++++++++
 srfi/srfi-1.scm | 13 +++++++++++++
 2 files changed, 22 insertions(+)

(limited to 'srfi')

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)
-- 
cgit v1.2.1