From 320f9d85e4e9d8c5c9cf60d540b1d13fa88530cf Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Thu, 9 May 2013 22:30:28 +0200 Subject: [PATCH] Add support for mapc --- src/list.lisp | 7 +++++++ src/toplevel.lisp | 2 +- tests/list.lisp | 6 ++++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/list.lisp b/src/list.lisp index 7a4ca6d..d515e52 100644 --- 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 --- 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 --- 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)))) -- 1.7.10.4