From 8dcabf600386e1a4e7dbfd1d41f312f0c3e2179c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 28 Jan 2014 22:28:08 +0100 Subject: [PATCH] Minor for-each speedup * module/ice-9/boot-9.scm (for-each): Minor speedup by unrolling tortoise/hare loop. --- module/ice-9/boot-9.scm | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index cac058ccb..91728a64f 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -840,23 +840,22 @@ information is unavailable." (define for-each (case-lambda ((f l) - (let for-each1 ((hare l) (tortoise l) (move? #f)) + (let for-each1 ((hare l) (tortoise l)) (if (pair? hare) - (if move? - (if (eq? tortoise hare) - (scm-error 'wrong-type-arg "for-each" "Circular list: ~S" - (list l) #f) + (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) #f))) - (begin - (f (car hare)) - (for-each1 (cdr hare) tortoise #t))) - + (for-each1 (cdr hare) (cdr tortoise)))))) (if (not (null? hare)) (scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (list l) #f))))) - + ((f l1 l2) (let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f)) (cond