[cells-cvs] CVS cells/utils-kt

[ktilton]

Update of /project/cells/cvsroot/cells/utils-kt
In directory clnet:/tmp/cvs-serv31873/utils-kt

Modified Files:
	detritus.lisp 
Log Message:


--- /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/09/05 18:40:48	1.10
+++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp	2006/10/11 22:16:22	1.11
@@ -46,11 +46,23 @@
 (defun xor (c1 c2)
   (if c1 (not c2) c2))
 
-(export! push-end)
+(export! push-end collect collect-if)
 
 (defmacro push-end (item place )
   `(setf ,place (nconc ,place (list ,item))))
 
+(defun collect (x list &key (key 'identity) (test 'eql))
+  (loop for i in list
+        when (funcall test x (funcall key i))
+        collect i))
+
+(defun collect-if (test list)
+  (loop for i in list
+        when (funcall test i)
+        collect i))
+
+
+
 ;;; --- FIFO Queue -----------------------------
 
 (defun make-fifo-queue (&rest init-data)