Add and export PUSHNEW.
authorOlof-Joachim Frahm <olof@macrolet.net>
Fri, 17 May 2013 22:47:05 +0000 (00:47 +0200)
committerOlof-Joachim Frahm <olof@macrolet.net>
Fri, 17 May 2013 22:47:05 +0000 (00:47 +0200)
src/boot.lisp
src/toplevel.lisp

index e33051c..4f22ec9 100644 (file)
               ,@(cdr newval))
          ,setter))))
 
+(defmacro pushnew (x place &rest keys &key key test test-not)
+  (declare (ignore key test test-not))
+  (multiple-value-bind (dummies vals newval setter getter)
+      (get-setf-expansion place)
+    (let ((g (gensym))
+          (v (gensym)))
+      `(let* ((,g ,x)
+              ,@(mapcar #'list dummies vals)
+              ,@(cdr newval)
+              (,v ,getter))
+         (if (member ,g ,v ,@keys)
+             ,v
+             (let ((,(car newval) (cons ,g ,getter)))
+               ,setter))))))
+
 (defmacro dolist ((var list &optional result) &body body)
   (let ((g!list (gensym)))
     (unless (symbolp var) (error "`~S' is not a symbol." var))
index 60e016a..c498c42 100644 (file)
@@ -70,7 +70,7 @@
           multiple-value-prog1 nconc nil ninth not nreconc nth nthcdr null
           numberp or otherwise package-name package-use-list packagep pairlis
           parse-integer plusp pop prin1-to-string print proclaim prog prog1
-          prog2 progn psetq push quote rassoc read-from-string remove remove-if
+          prog2 progn psetq push pushnew quote rassoc read-from-string remove remove-if
           remove-if-not return return-from revappend reverse rplaca rplacd
           second set setf setq seventh sixth some string string-upcase string=
           string< stringp subseq subst symbol-function symbol-name symbol-package