X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=lists.lisp;h=dfa9d386d25d5c9f100c317372442b3ef15adcff;hp=229bc91d6cc40d73bece0377d419db1d56a83ee4;hb=ea921dd2ce51a46bb3ca92a07df095d5ace99dcf;hpb=ce1cbb4b287d275af616a81e30197b6e57a82d90 diff --git a/lists.lisp b/lists.lisp index 229bc91..dfa9d38 100644 --- a/lists.lisp +++ b/lists.lisp @@ -151,18 +151,24 @@ (defmacro update-alist (akey value alist &key (test '#'eql) (key '#'identity)) "Macro to support below (setf get-alist)" - (let ((elem (gensym))) - `(let ((,elem (assoc ,akey ,alist :test ,test :key ,key))) - (if ,elem - (progn - (setf (cdr ,elem) ,value) - ,alist) - (setf ,alist (acons ,akey ,value ,alist)))))) + (let ((elem (gensym "ELEM-")) + (val (gensym "VAL-"))) + `(let ((,elem (assoc ,akey ,alist :test ,test :key ,key)) + (,val ,value)) + (cond + (,elem + (setf (cdr ,elem) ,val)) + (,alist + (setf (cdr (last ,alist)) (list (cons ,akey ,val)))) + (t + (setf ,alist (list (cons ,akey ,val))))) + ,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 won't work if the alist is NIL." (update-alist key value alist :test test) value) @@ -186,3 +192,12 @@ (setf ,plist (append ,plist (list ,pkey ,value))))))) +(defun unique-slot-values (list slot &key (test 'eql)) + (let ((uniq '())) + (dolist (item list (nreverse uniq)) + (let ((value (slot-value item slot))) + (unless (find value uniq :test test) + (push value uniq)))))) + + +