Add support for mapc

diff --git a/src/list.lisp b/src/list.lisp
index 7a4ca6d..d515e52 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -161,6 +161,13 @@
                (rplaca tail (cdar tail)))
              (collect (apply func elems))))))))
 
+(defun mapc (func &rest lists)
+  (do* ((elems (map1 #'car lists) (map1 #'car lists-rest))
+        (lists-rest (map1 #'cdr lists) (map1 #'cdr lists-rest)))
+       ((dolist (x elems) (when (null x) (return t)))
+        (car lists))
+    (apply func elems)))
+
 (defun last (x)
   (while (consp (cdr x))
     (setq x (cdr x)))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index b5ef24b..9e94336 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -65,7 +65,7 @@
           get-universal-time go identity if in-package incf integerp intern
           intersection keywordp labels lambda last length let let*
           lisp-implementation-type list list* list-all-packages listp loop
-          make-array make-package make-symbol mapcar member minusp mod
+          make-array make-package make-symbol mapc mapcar member minusp mod
           multiple-value-bind multiple-value-call multiple-value-list
           multiple-value-prog1 nconc nil ninth not nreconc nth nthcdr null
           numberp or otherwise package-name package-use-list packagep pairlis

diff --git a/tests/list.lisp b/tests/list.lisp
index 2f1b57c..9bb2996 100644 (file)
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -87,3 +87,9 @@
              (bar (pop foo)))
         (and (= bar 1)
              (= (car foo) 2))))
+
+;; MAPC
+(test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
+(test (let (foo)
+        (mapc (lambda (x y z) (print (list x y z)) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))
+        (equal foo '(8))))