Adding pushnew.

* place.tl (pushnew): New macro.

* lisplib.c (set_place_dlt_entries): Add pushnew.

3 files changed, 19 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 8238480c..9791f74f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2015-05-22  Kaz Kylheku  <kaz@kylheku.com>
 
+	* place.tl (pushnew): New macro.
+
+	* lisplib.c (set_place_dlt_entries): Add pushnew.
+
+2015-05-22  Kaz Kylheku  <kaz@kylheku.com>
+
 	symbol-function, symbol-value and fun become places.
 
 	* eval.c (op_setqf): New function.
diff --git a/lisplib.c b/lisplib.c
index d632f96c..0b8524e3 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -55,7 +55,7 @@ static void set_place_dlt_entries(val dlt, val fun)
     lit("with-delete-expander"),
     lit("set"), lit("pset"), lit("zap"), lit("flip"), lit("inc"), lit("dec"),
     lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"),
-    lit("del"),
+    lit("pushnew"), lit("del"),
     lit("define-modify-macro"),
     nil
   };
diff --git a/place.tl b/place.tl
index 086f2708..83c2d813 100644
--- a/place.tl
+++ b/place.tl
@@ -225,6 +225,18 @@
         ^(let ((,tmp (,getter)))
            (prog1 (car ,tmp) (,setter (cdr ,tmp)))))))
 
+  (defmacro pushnew (new-item place :env env :
+                              (testfun :)
+                              (keyfun :))
+    (with-update-expander (getter setter) place env
+      (with-gensyms (new-item-sym old-list-sym)
+        ^(let ((,new-item-sym ,new-item))
+           ,(with-update-expander (getter setter) place env
+              ^(let ((,old-list-sym (,getter)))
+                 (if (member ,new-item-sym ,old-list-sym ,testfun ,keyfun)
+                   ,old-list-sym
+                   (,setter (cons ,new-item-sym ,old-list-sym)))))))))
+
   (defmacro shift (:env env . places)
     (tree-case places
       (() (sys:eval-err "shift: need at least two arguments"))