mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

More for-each micro-optimizations

Browse source 
* 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!
This commit is contained in:
Andy Wingo 2014-03-02 12:38:32 +01:00
parent c2379a5b45
commit f87a7327a5
2 changed files with 11 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))

22
module/srfi/srfi-1.scm
View file

@ -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)