[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv16739

Modified Files:
	more-macros.lisp 
Log Message:
Improve pushnew to accept test-not.


--- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp	2006/04/28 23:21:32	1.32
+++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp	2006/05/02 20:03:47	1.33
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Jun  7 15:05:57 2002
 ;;;;                
-;;;; $Id: more-macros.lisp,v 1.32 2006/04/28 23:21:32 ffjeld Exp $
+;;;; $Id: more-macros.lisp,v 1.33 2006/05/02 20:03:47 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -63,22 +63,27 @@
       `(setq ,place (cons ,item ,place))
     form))
   
-(defmacro pushnew (&environment env item place &key (key ''identity) (test ''eq) test-not)
-  (when test-not
-    (error "Test-not not supported."))
-  (multiple-value-bind (tmp-vars tmp-var-init-forms store-vars setter-form getter-form)
-      (get-setf-expansion place env)
-    (assert (= 1 (length store-vars)) ()
-      "Can't pushnew a place with ~D cells." (length store-vars))
-    (let ((store-var (first store-vars))
-	  (item-var (gensym "push-item-")))
-      `(let ((,item-var ,item)
-	     ,@(mapcar #'list tmp-vars tmp-var-init-forms))
-	 (let ((old-value ,getter-form))
-	   (if (not (member ,item-var old-value :key ,key :test ,test))
-	       (let ((,store-var (cons ,item-var old-value)))
-		 ,setter-form)
-	     old-value))))))
+(defmacro pushnew (&environment env item place &key (key nil keyp) (test nil testp) (test-not nil test-notp))
+  (let ((testing
+	 (cond
+	  (testp (list :test test))
+	  (test-notp (list :test-not test-not))))
+	(keying
+	 (cond
+	  (keyp (list :key key)))))
+    (multiple-value-bind (tmp-vars tmp-var-init-forms store-vars setter-form getter-form)
+	(get-setf-expansion place env)
+      (assert (= 1 (length store-vars)) ()
+	"Can't pushnew a place with ~D cells." (length store-vars))
+      (let ((store-var (first store-vars))
+	    (item-var (gensym "push-item-")))
+	`(let ((,item-var ,item)
+	       ,@(mapcar #'list tmp-vars tmp-var-init-forms))
+	   (let ((old-value ,getter-form))
+	     (if (not (member ,item-var old-value , at keying , at testing))
+		 (let ((,store-var (cons ,item-var old-value)))
+		   ,setter-form)
+	       old-value)))))))
   
 (defmacro remf (&environment env place indicator)
   (multiple-value-bind (tmp-vars tmp-var-init-forms store-vars setter-form getter-form)