From: Olof-Joachim Frahm <olof@macrolet.net>
Date: Fri, 17 May 2013 22:47:05 +0000 (+0200)
Subject: Add and export PUSHNEW.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c3b19b129a11f61ad6bbe17c04b6bff92c048f17;p=jscl.git

Add and export PUSHNEW.
---

diff --git a/src/boot.lisp b/src/boot.lisp
index e33051c..4f22ec9 100644
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -143,6 +143,21 @@
               ,@(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))
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 60e016a..c498c42 100644
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -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