From 0cb60724da377d0b5f85f615ad344c212e8c7409 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 7 Aug 2022 15:52:17 -0700
Subject: Add map and for-each.

---
 lib/scheme/base/60-list.csc | 36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

diff --git a/lib/scheme/base/60-list.csc b/lib/scheme/base/60-list.csc
index cbfc12a..5dfda9f 100644
--- a/lib/scheme/base/60-list.csc
+++ b/lib/scheme/base/60-list.csc
@@ -7,6 +7,7 @@
   cddr
   cdr
   cons
+  for-each
   length
   list
   list-copy
@@ -15,6 +16,7 @@
   list-tail
   list?
   make-list
+  map
   null?
   pair?
   reverse
@@ -141,4 +143,36 @@
   (define (list-copy obj)
     (if (pair? l)
       (cons (car l) (list-copy (cdr l)))
-      l)))
+      l))
+
+
+  (define (map1 proc l)
+    (if (null? l)
+      '()
+      (cons (proc (car l))
+            (map1 proc (cdr l)))))
+
+
+  (define (map proc list1 . lists)
+    (define lists* (cons list1 lists))
+    (if (let loop ((l lists*))
+          (cond
+            ((null? l) #f)
+            ((null? (car l)) #t)
+            (else (loop (cdr l)))))
+      '()
+      (cons (apply proc (map1 car lists*))
+            (map proc (map1 cdr lists*)))))
+
+
+  (define (for-each proc list1 . lists)
+    (define lists* (cons list1 lists))
+    (if (let loop ((l lists*))
+          (cond
+            ((null? l) #f)
+            ((null? (car l)) #t)
+            (else (loop (cdr l)))))
+      #f
+      (begin
+        (apply proc (map car lists*))
+        (for-each proc (map cdr lists*))))))
-- 
cgit v1.3.1