From 3d72d4e39ed6134c52f8325dd55b75adaa3e6239 Mon Sep 17 00:00:00 2001 From: Ken Harris Date: Mon, 17 Jun 2013 08:51:22 -0700 Subject: [PATCH] MAPLIST. --- src/list.lisp | 18 ++++++++++++++++++ tests/list.lisp | 8 ++++++++ 2 files changed, 26 insertions(+) diff --git a/src/list.lisp b/src/list.lisp index dabd201..ad0e7a6 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -194,6 +194,24 @@ (rplaca tail (cdar tail))) (collect (apply func elems)))))))) +(defun mapn (func list) + (with-collect + (while list + (collect (funcall func list)) + (setq list (cdr list))))) + +(defun maplist (func list &rest lists) + (let ((lists (cons list lists))) + (with-collect + (block loop + (loop + (let ((elems (mapn #'car lists))) + (do ((tail lists (cdr tail))) + ((null tail)) + (when (null (car tail)) (return-from loop)) + (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))) diff --git a/tests/list.lisp b/tests/list.lisp index 4a99d8c..ffc672d 100644 --- a/tests/list.lisp +++ b/tests/list.lisp @@ -204,6 +204,14 @@ ;; MAPCAR (test (equal (mapcar #'+ '(1 2) '(3) '(4 5 6)) '(8))) +;; MAPLIST +(test (equal '((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3)) + (maplist #'append '(1 2 3 4) '(1 2) '(1 2 3)))) +(test (equal '((FOO A B C D) (FOO B C D) (FOO C D) (FOO D)) + (maplist #'(lambda (x) (cons 'foo x)) '(a b c d)))) +(test (equal '(0 0 1 0 1 1 1) + (maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c)))) + ;; MAPC (test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2))) (test (let (foo) -- 1.7.10.4