+(define map
+ (case-lambda
+ ((f l)
+ (check-arg procedure? f map)
+ (check-arg list? l map)
+ (let map1 ((in l) (out '()))
+ (if (pair? in)
+ (map1 (cdr in) (cons (f (car in)) out))
+ (reverse! out))))
+
+ ((f l1 . rest)
+ (check-arg procedure? f map)
+ (let ((len (fold (lambda (ls len)
+ (let ((ls-len (length+ ls)))
+ (if len
+ (if ls-len (min ls-len len) len)
+ ls-len)))
+ (length+ l1)
+ rest)))
+ (if (not len)
+ (scm-error 'wrong-type-arg "map"
+ "Args do not contain a proper (finite) list: ~S"
+ (list (cons l1 rest)) #f))
+ (let mapn ((l1 l1) (rest rest) (len len) (out '()))
+ (if (zero? len)
+ (reverse! out)
+ (mapn (cdr l1) (map cdr rest) (1- len)
+ (cons (apply f (car l1) (map car rest)) out))))))))
+
+(define map-in-order map)
+
+(define for-each
+ (case-lambda
+ ((f l)
+ (check-arg procedure? f for-each)
+ (check-arg list? l for-each)
+ (let for-each1 ((l l))
+ (unless (null? l)
+ (f (car l))
+ (for-each1 (cdr l)))))
+
+ ((f l1 l2)
+ (check-arg procedure? f for-each)
+ (let* ((len1 (length+ l1))
+ (len2 (length+ l2))
+ (len (if (and len1 len2)
+ (min len1 len2)
+ (or len1 len2))))
+ (unless len
+ (scm-error 'wrong-type-arg "for-each"
+ "Args do not contain a proper (finite) list: ~S"
+ (list (list l1 l2)) #f))
+ (let for-each2 ((l1 l1) (l2 l2) (len len))
+ (unless (zero? len)
+ (f (car l1) (car l2))
+ (for-each2 (cdr l1) (cdr l2) (1- len))))))
+
+ ((f l1 . rest)
+ (check-arg procedure? f for-each)
+ (let ((len (fold (lambda (ls len)
+ (let ((ls-len (length+ ls)))
+ (if len
+ (if ls-len (min ls-len len) len)
+ ls-len)))
+ (length+ l1)
+ rest)))
+ (if (not len)
+ (scm-error 'wrong-type-arg "for-each"
+ "Args do not contain a proper (finite) list: ~S"
+ (list (cons l1 rest)) #f))
+ (let for-eachn ((l1 l1) (rest rest) (len len))
+ (if (> len 0)
+ (begin
+ (apply f (car l1) (map car rest))
+ (for-eachn (cdr l1) (map cdr rest) (1- len)))))))))