X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=lists.lisp;h=3115dd5dbe1b99476baf576be214fe4353615686;hp=8bc548d829f924dabe8bf4b11b56618987e589ad;hb=526eef1b59e071cbb4ecd35f73a14c1a3f8e32b6;hpb=7c7e6a18fd67e5370fd78690da2642cbe79e4113

diff --git a/lists.lisp b/lists.lisp
index 8bc548d..3115dd5 100644
--- a/lists.lisp
+++ b/lists.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: lists.lisp,v 1.7 2003/06/20 08:35:22 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -22,26 +22,35 @@
   "Make into list if atom"
   (if (listp obj) obj (list obj)))
 
-(defun filter (fn lst)
-  "Filter a list by function, eliminate elements where fn returns nil"
+(defun map-and-remove-nils (fn lst)
+  "mao a list by function, eliminate elements where fn returns nil"
   (let ((acc nil))
     (dolist (x lst (nreverse acc))
       (let ((val (funcall fn x)))
         (when val (push val acc))))))
 
+(defun filter (fn lst)
+  "Filter a list by function, eliminate elements where fn returns nil"
+  (let ((acc nil))
+    (dolist (x lst (nreverse acc))
+      (when (funcall fn x)
+        (push x acc)))))
+
 (defun appendnew (l1 l2)
   "Append two lists, filtering out elem from second list that are already in first list"
   (dolist (elem l2 l1)
     (unless (find elem l1)
       (setq l1 (append l1 (list elem))))))
 
-(defun remove-tree-if (pred tree)
+(defun remove-from-tree-if (pred tree &optional atom-processor)
   "Strip from tree of atoms that satistify predicate"
   (if (atom tree)
       (unless (funcall pred tree)
-	tree)
-    (let ((car-strip (remove-tree-if pred (car tree)))
-	  (cdr-strip (remove-tree-if pred (cdr tree))))
+	(if atom-processor
+	    (funcall atom-processor tree)
+	  tree))
+    (let ((car-strip (remove-from-tree-if pred (car tree) atom-processor))
+	  (cdr-strip (remove-from-tree-if pred (cdr tree) atom-processor)))
       (cond
        ((and car-strip (atom (cadr tree)) (null cdr-strip))
 	(list car-strip))
@@ -148,12 +157,13 @@
 	   (progn
 	     (setf (cdr ,elem) ,value)
 	     ,alist)
-	(setf ,alist (acons ,akey ,value ,alist))))))
+	 (setf ,alist (acons ,akey ,value ,alist))))))
 
 (defun get-alist (key alist &key (test #'eql))
   (cdr (assoc key alist :test test)))
 
 (defun (setf get-alist) (value key alist &key (test #'eql))
+  "This doesn't work to add a field which alist value is only modified locally"
   (update-alist key value alist :test test)
   value)
 
@@ -162,7 +172,7 @@
 
 (defun plist-alist (plist)
   (do ((alist '())
-       (pl plist (cddr plist)))
+       (pl plist (cddr pl)))
       ((null pl) alist)
     (setq alist (acons (car pl) (cadr pl) alist))))
 
@@ -176,11 +186,4 @@
 	     ,plist)
 	 (setf ,plist (append ,plist (list ,pkey ,value)))))))
 
-(defun get-plist (key plist &key (test 'eql) (missing nil))
-  (let-if (pos (member key plist :test test))
-	  (cadr pos)
-	  missing))
 
-(defun (setf get-plist) (value key plist &key (test #'eql))
-  (update-plist key value plist :test test)
-  value)