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

Simplify boot-9 for-each with two lists

Browse source 
* module/ice-9/boot-9.scm (for-each): Simplify the two-argument case in
  the same way as the one-argument case.
This commit is contained in:
Andy Wingo 2014-03-16 19:48:48 +01:00
parent f87a7327a5
commit ed59b70a54
1 changed files with 7 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -920,34 +920,13 @@ for key @var{k}, then invoke @var{thunk}."
(for-each1 (cdr l))))) (for-each1 (cdr l)))))
((f l1 l2) ((f l1 l2)
(let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f)) (unless (= (length l1) (length l2))
(cond (scm-error 'wrong-type-arg "for-each" "List of wrong length: ~S"
((and (pair? h1) (pair? h2)) (list l2) #f))
(cond (let for-each2 ((l1 l1) (l2 l2))
((not move?) (unless (null? l1)
(f (car h1) (car h2)) (f (car l1) (car l2))
(for-each2 (cdr h1) (cdr h2) t1 t2 #t)) (for-each2 (cdr l1) (cdr l2)))))
((eq? t1 h1)
(scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
(list l1) #f))
((eq? t2 h2)
(scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
(list l2) #f))
(else
(f (car h1) (car h2))
(for-each2 (cdr h1) (cdr h2) (cdr t1) (cdr t2) #f))))
((if (null? h1)
(or (null? h2) (pair? h2))
(and (pair? h1) (null? h2)))
(if #f #f))
((list? h1)
(scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
(list h2) #f))
(else
(scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
(list h1) #f)))))
((f l1 . rest) ((f l1 . rest)
(let ((len (length l1))) (let ((len (length l1)))