diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | place.tl | 20 |
3 files changed, 29 insertions, 1 deletions
@@ -1,5 +1,13 @@ 2015-05-09 Kaz Kylheku <kaz@kylheku.com> + Adding pset operator. + + * place.tl (pset): New macro. + + * lisplib.c (set_place_dlt_entries): Add pset. + +2015-05-09 Kaz Kylheku <kaz@kylheku.com> + * place.tl (set): Take multiple place/value pairs. Allow zero arguments. @@ -53,7 +53,7 @@ static void set_place_dlt_entries(val dlt, val fun) lit("call-delete-expander)"), lit("with-update-expander"), lit("with-clobber-expander"), lit("with-delete-expander"), - lit("set"), lit("zap"), lit("flip"), lit("inc"), lit("dec"), + lit("set"), lit("pset"), lit("zap"), lit("flip"), lit("inc"), lit("dec"), lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"), lit("del"), nil @@ -119,6 +119,26 @@ ^(progn ,*assign-forms) (car assign-forms)))) + (defmacro pset (:env env . place-value-pairs) + (let ((len (length place-value-pairs))) + (cond + ((oddp len) (sys:eval-err "pset: arguments must be pairs")) + ((<= len 2) ^(set ,*place-value-pairs)) + (t (let* ((pvtgs (mapcar (tb ((a b)) + (list a b (gensym) (gensym) (gensym))) + (tuples 2 place-value-pairs))) + (ls (reduce-left (tb ((lets stores) (place value temp getter setter)) + (list ^((,temp ,value) ,*lets) + ^((,setter ,temp) ,*stores))) + pvtgs '(nil nil))) + (lets (first ls)) + (stores (second ls)) + (body-form ^(let (,*lets) ,*stores))) + (reduce-left (tb (accum-form (place value temp getter setter)) + (call-update-expander getter setter + place env accum-form)) + pvtgs body-form)))))) + (defmacro zap (place :env env) (with-update-expander (getter setter) place env ^(prog1 (,getter) (,setter nil)))) |