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@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 ,@keying ,@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)