From 0f8f6c2efe0b9da0fa4d9e21964381e3f8e19c53 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 12 Feb 2016 23:13:58 -0500
Subject: [PATCH] Allow for-each to accept multiple list args

---
 scheme/base.sld | 58 +++++++++++++++++++++----------------------------
 1 file changed, 25 insertions(+), 33 deletions(-)

diff --git a/scheme/base.sld b/scheme/base.sld
index 9e4d5f68..87f4cdd5 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -606,14 +606,6 @@
       (make k x)))
     (define (list-copy lst)
       (foldr (lambda (x y) (cons x y)) '() lst))
-;    (define (map func lst)
-;      (foldr (lambda (x y) (cons (func x) y)) '() lst))
-    (define (for-each f lst)
-      (cond
-       ((null? lst) #t)
-       (else
-         (f (car lst))
-         (for-each f (cdr lst)))))
     ;; Implementation of receive from SRFI 8
     (define-syntax receive
       (er-macro-transformer
@@ -651,32 +643,32 @@
           (values '() '()))))))
 ; END support functions
 
-(define (map f lis1 . lists)
-;  (check-arg procedure? f map-in-order)
-  (if (pair? lists)
-      (let recur ((lists (cons lis1 lists)))
-        (receive (cars cdrs) (%cars+cdrs lists)
-          (if (pair? cars)
-              (let ((x (apply f cars)))		; Do head first,
-                (cons x (recur cdrs)))		; then tail.
-              '())))
-      ;; Fast path.
-     (foldr (lambda (x y) (cons (f x) y)) '() lis1)))
+    (define (map f lis1 . lists)
+    ;  (check-arg procedure? f map-in-order)
+      (if (pair? lists)
+          (let recur ((lists (cons lis1 lists)))
+            (receive (cars cdrs) (%cars+cdrs lists)
+              (if (pair? cars)
+                  (let ((x (apply f cars)))		; Do head first,
+                    (cons x (recur cdrs)))		; then tail.
+                  '())))
+          ;; Fast path.
+         (foldr (lambda (x y) (cons (f x) y)) '() lis1)))
 
-;;(define (for-each f lis1 . lists)
-;;  (if (not (null? lis1))
-;;    (if (pair? lists)
-;;      (let recur ((lists (cons lis1 lists)))
-;;        (receive (cars cdrs) (%cars+cdrs lists)
-;;          (if (pair? cars)
-;;              (begin
-;;                (apply f cars)
-;;                (recur cdrs)))))
-;;      ;; Fast path.
-;;      (if (eq? 1 (length lis1))
-;;        (f (car lis1))
-;;        (begin (f (car lis1))
-;;               (for-each f (cdr lis1)))))))
+    (define (for-each f lis1 . lists)
+      (if (not (null? lis1))
+        (if (pair? lists)
+          (let recur ((lists (cons lis1 lists)))
+            (receive (cars cdrs) (%cars+cdrs lists)
+              (if (pair? cars)
+                  (begin
+                    (apply f cars)
+                    (recur cdrs)))))
+          ;; Fast path.
+          (if (eq? 1 (length lis1))
+            (f (car lis1))
+            (begin (f (car lis1))
+                   (for-each f (cdr lis1)))))))
     (define (list-tail lst k) 
       (if (zero? k)
         lst