summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/ice-9/boot-9.scm22
-rw-r--r--module/srfi/srfi-1.scm22
2 files changed, 11 insertions, 33 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f9a7c1fd9..aceb3eb88 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -912,22 +912,12 @@ for key @var{k}, then invoke @var{thunk}."
(define for-each
(case-lambda
((f l)
- (let for-each1 ((hare l) (tortoise l))
- (if (pair? hare)
- (begin
- (f (car hare))
- (let ((hare (cdr hare)))
- (if (pair? hare)
- (begin
- (when (eq? tortoise hare)
- (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
- (list l) #f))
- (f (car hare))
- (for-each1 (cdr hare) (cdr tortoise)))
- (for-each1 hare tortoise))))
- (if (not (null? hare))
- (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
- (list l) #f)))))
+ (unless (list? l)
+ (scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (list l) #f))
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
((f l1 l2)
(let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f))
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 74b01bc93..fd0b55e9e 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -606,24 +606,12 @@ has just one element then that's the return value."
(case-lambda
((f l)
(check-arg procedure? f for-each)
- (let for-each1 ((hare l) (tortoise l))
- (if (pair? hare)
- (begin
- (f (car hare))
- (let ((hare (cdr hare)))
- (if (pair? hare)
- (begin
- (when (eq? tortoise hare)
- (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
- (list l) #f))
- (f (car hare))
- (for-each1 (cdr hare) (cdr tortoise)))
- (for-each1 hare tortoise))))
- (if (not (null? hare))
- (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
- (list l) #f)))))
+ (check-arg list? l for-each)
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
-
((f l1 . rest)
(check-arg procedure? f for-each)
(let ((len (fold (lambda (ls len)