From f888430a6012947a9aea3624592dff1fc1f18726 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 11 Jul 2015 07:28:47 -0700 Subject: Let's have placelet and placelet*. * share/txr/stdlib/place.tl (placelet*): New macro. * lisplib.c (place_set_entries): Add placelet* to list of names. * txr.1: Updated to document placelet* and fix mistakes. --- share/txr/stdlib/place.tl | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 9cae3974..7bb059a8 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -570,14 +570,25 @@ (call-update-expander pl-getter pl-setter place env ^(macrolet ((,tmp-place () ^(,',pl-getter))) ,(sys:expand - ^(symacrolet ((,sym (,tmp-place))) ,*body) + ^(symacrolet ((,sym (,tmp-place))) + ,*body) env)))) (remhash *place-update-expander* tmp-place)))) -(defmacro placelet (sym-place-pairs . body) +(defmacro placelet* (sym-place-pairs . body) (tree-case sym-place-pairs (() ^(progn ,*body)) (((sym place)) ^(sys:placelet-1 ((,sym ,place)) ,*body)) (((sym place) . rest-pairs) ^(sys:placelet-1 ((,sym ,place)) - (placelet (,*rest-pairs) ,*body))) - (obj (throwf 'eval-error "placelet: bad syntax: ~s" obj)))) + (placelet* (,*rest-pairs) ,*body))) + (obj (throwf 'eval-error "placelet*: bad syntax: ~s" obj)))) + +(defmacro placelet (sym-place-pairs . body) + (unless (all sym-place-pairs + [andf consp (opip length (= 2)) (oand first bindable)]) + (throwf 'eval-error "placelet: bad syntax: ~s" sym-place-pairs)) + (tree-bind (: syms places) (transpose sym-place-pairs) + (let ((temps (mapcar (ret (gensym)) syms))) + ^(placelet* (,*(zip temps places)) + (symacrolet (,*(zip syms temps)) + ,*body))))) -- cgit v1.2.3