From 43b371fa552149ad237fec114af4f4feb65fa5bf Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 22 May 2015 07:23:47 -0700 Subject: Adding pushnew. * place.tl (pushnew): New macro. * lisplib.c (set_place_dlt_entries): Add pushnew. --- ChangeLog | 6 ++++++ lisplib.c | 2 +- place.tl | 12 ++++++++++++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 8238480c..9791f74f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2015-05-22 Kaz Kylheku + + * place.tl (pushnew): New macro. + + * lisplib.c (set_place_dlt_entries): Add pushnew. + 2015-05-22 Kaz Kylheku symbol-function, symbol-value and fun become places. 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")) -- cgit v1.2.3