From b8f0157b13bf3fa1c36d283b6bc454ae80f45d75 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 9 May 2015 10:25:48 -0700 Subject: Adding pset operator. * place.tl (pset): New macro. * lisplib.c (set_place_dlt_entries): Add pset. --- place.tl | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'place.tl') diff --git a/place.tl b/place.tl index 750e0c6c..a948f07b 100644 --- a/place.tl +++ b/place.tl @@ -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)))) -- cgit v1.2.3