From f87a7327a54e10ec3ed77a6192a0cd38fed3a9c9 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 2 Mar 2014 12:38:32 +0100
Subject: [PATCH] More for-each micro-optimizations

* module/ice-9/boot-9.scm (for-each):
* module/srfi/srfi-1.scm (for-each): Re-implement one-list case using an
  explicit check for list? instead of the tortoise-hare thing.  Seems to
  be faster!
---
 module/ice-9/boot-9.scm | 22 ++++++----------------
 module/srfi/srfi-1.scm  | 22 +++++-----------------
 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)