* place.tl (define-modify-macro): New macro.

* lisplib.c (set_place_dlt_entries): Add define-modify-macro.

3 files changed, 16 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 046187a6..7d666f83 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2015-05-13  Kaz Kylheku  <kaz@kylheku.com>
 
+	* place.tl (define-modify-macro): New macro.
+
+	* lisplib.c (set_place_dlt_entries): Add define-modify-macro.
+
+2015-05-13  Kaz Kylheku  <kaz@kylheku.com>
+
 	* place.tl (push): Ensure left-to-right eval order.
 
 2015-05-12  Kaz Kylheku  <kaz@kylheku.com>
diff --git a/lisplib.c b/lisplib.c
index 73b739ee..a6f4d931 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -56,6 +56,7 @@ static void set_place_dlt_entries(val dlt, val fun)
     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("define-modify-macro"),
     nil
   };
 
diff --git a/place.tl b/place.tl
index f4d48cff..d421d4fa 100644
--- a/place.tl
+++ b/place.tl
@@ -475,4 +475,12 @@
        (each ((table (list *place-update-expander*
                            *place-clobber-expander*
                            *place-delete-expander*)))
-         (set [table to] [table from])))))
+         (set [table to] [table from]))))
+
+   (defmacro define-modify-macro (name lambda-list function)
+     (let ((cleaned-lambda-list (mapcar [iffi consp car]
+                                        (remql : lambda-list))))
+       (with-gensyms (place-sym args-sym)
+         ^(defmacro ,name (:env env ,place-sym ,*lambda-list)
+            (with-update-expander (getter setter) ,place-sym env
+              ^(,setter (,',function (,getter) ,,*cleaned-lambda-list))))))))