diff options
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | lisplib.c | 2 | ||||
-rw-r--r-- | place.tl | 12 |
3 files changed, 19 insertions, 1 deletions
@@ -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. @@ -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 }; @@ -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")) |