mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 13:20:26 +02:00
Code Activity

Minor for-each speedup

Browse source 
* module/ice-9/boot-9.scm (for-each): Minor speedup by unrolling
  tortoise/hare loop.
This commit is contained in:
Andy Wingo 2014-01-28 22:28:08 +01:00
parent 024a60e374
commit 8dcabf6003
1 changed files with 10 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

21
module/ice-9/boot-9.scm
View file

@ -840,23 +840,22 @@ information is unavailable."
(define for-each (define for-each
(case-lambda (case-lambda
((f l) ((f l)
(let for-each1 ((hare l) (tortoise l) (move? #f)) (let for-each1 ((hare l) (tortoise l))
(if (pair? hare) (if (pair? hare)
(if move? (begin
(if (eq? tortoise hare) (f (car hare))
(scm-error 'wrong-type-arg "for-each" "Circular list: ~S" (let ((hare (cdr hare)))
(list l) #f) (if (pair? hare)
(begin (begin
(when (eq? tortoise hare)
(scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
(list l) #f))
(f (car hare)) (f (car hare))
(for-each1 (cdr hare) (cdr tortoise) #f))) (for-each1 (cdr hare) (cdr tortoise))))))
(begin
(f (car hare))
(for-each1 (cdr hare) tortoise #t)))
(if (not (null? hare)) (if (not (null? hare))
(scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
(list l) #f))))) (list l) #f)))))
((f l1 l2) ((f l1 l2)
(let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f)) (let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f))
(cond (cond