diff options
| -rw-r--r-- | list-functions-2.lisp | 33 |
1 files changed, 32 insertions, 1 deletions
diff --git a/list-functions-2.lisp b/list-functions-2.lisp index 0bae5f3..c8d4ccd 100644 --- a/list-functions-2.lisp +++ b/list-functions-2.lisp @@ -1,5 +1,5 @@ (export '(copy-tree assoc assoc-if assoc-if-not rassoc rassoc-if - rassoc-if-not sublis nsublis)) + rassoc-if-not sublis nsublis mapcar mapcan mapcon)) (defun copy-tree (tree) @@ -58,3 +58,34 @@ (defun nsublis (alist tree &key key test test-not) (sublvs alist tree :key key :test test :test-not test-not)) + + +(defun some1 (function list) + (and (not (null list)) + (or (funcall function (first list)) + (some1 function (rest list))))) + +(defun every1 (function list) + (or (null list) + (and (funcall function (first list)) + (every1 function (rest list))))) + +(defun mapcar1 (function list) + (when list + (cons (funcall function (first list)) + (mapcar1 function (rest list))))) + +(defun mapcan1 (function list) + (%append (mapcar1 function list))) + +(defun mapcar (function list &rest more-lists) + (let ((lists (list* list more-lists))) + (when (every1 'identity lists) + (cons (apply function (mapcar1 'car lists)) + (apply 'mapcar (list* function (mapcar1 'cdr lists))))))) + +(defun mapcan (function list &rest more-lists) + (%append (apply 'mapcar (list* function list more-lists)))) + +(defun mapcon (function list &rest more-lists) + (apply (function mapcan) (list* function list more-lists))) |