From f888430a6012947a9aea3624592dff1fc1f18726 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
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.
---
 ChangeLog                 | 10 ++++++++++
 lisplib.c                 |  2 +-
 share/txr/stdlib/place.tl | 19 +++++++++++++++----
 txr.1                     | 23 ++++++++++++++++++++---
 4 files changed, 46 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0bfa7ee3..8702a519 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2015-07-11  Kaz Kylheku  <kaz@kylheku.com>
+
+	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.
+
 2015-07-11  Kaz Kylheku  <kaz@kylheku.com>
 
 	* share/txr/stdlib/place.tl (defplace dwim): Eliminate
diff --git a/lisplib.c b/lisplib.c
index 9db0853d..be437634 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -68,7 +68,7 @@ static val place_set_entries(val dlt, val fun)
     lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"),
     lit("pushnew"), lit("del"),
     lit("defplace"), lit("define-modify-macro"),
-    lit("placelet"),
+    lit("placelet"), lit("placelet*"),
     nil
   };
 
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)))))
diff --git a/txr.1 b/txr.1
index cbc37a1c..c2dc168d 100644
--- a/txr.1
+++ b/txr.1
@@ -28679,9 +28679,10 @@ applies inside a
 form. Of course, lexical operator macros do not shadow
 symbol macros under any circumstances.
 
-.coNP Operator @ placelet
+.coNP Macros @ placelet and @ placelet*
 .synb
 .mets (placelet >> ({( sym << place )}*) << body-form *)
+.mets (placelet* >> ({( sym << place )}*) << body-form *)
 .syne
 .desc
 The
@@ -28710,10 +28711,26 @@ scope of the
 This means that whenever
 .meta sym
 is evaluated, it stands for the value of the storage
-location, and whenever a value is apprently stored into
+location, and whenever a value is apparently stored into
 .metn sym ,
 it is actually the storage location which receives it.
 
+The
+.code placelet*
+variant implements an alternative scoping rule, which allows a later
+.meta place
+form to refer to a
+.meta sym
+bound to an earlier
+.meta place
+form. In other words, a given
+.meta sym
+binding is visible not only to the
+.metn body-form -s
+but also to
+.meta place
+forms which occur later.
+
 Note: certain kinds of places, notably
 .cblk
 .meti (force << promise )
@@ -28735,7 +28752,7 @@ performs the syntactic substitution of symbol
 .code x
 by form
 .codn y ,
-whereever
+wherever
 .code x
 appears inside
 .code z
-- 
cgit v1.2.3