Improve alet macro.

The alet macro should always convert bindings to constants
into symbol macros; the all-or-nothing logic should be applied
to any remaining bindings.

* share/txr/stdlib/place.tl (sys:r-s-let-expander): Generalize
this function somewhat more by passing in the fallback binding
symbol to use for bindings that can't be turned into symbol
macros, instead of hard-coding them to let.
(rlset, slet): Specify 'let when calling sys:r-s-let-expander.
(alet): If there are any bindings with constantp init
expressions, then recurse: produce an expansion which
separates constantp from non-constantp using
sys:r-s-let-expander. Pass 'alet as fallback binding symbol;
thus the expansion will recurse back to alet, but without
all the constantp bindings, if there are any.
We then deal with those using the existing all-or-nothing
logic (which simplifies slightly since it doesn't have
to check for constantp any more).

* txr.1: Revised description of alet.

1 files changed, 10 insertions, 8 deletions

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index aa534e4a..72519795 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -117,28 +117,30 @@
       (t (sys:eval-err "form ~s is not syntax denoting a deletable place" place)))))
 
 (macro-time
-  (defun sys:r-s-let-expander (bindings body e pred)
+  (defun sys:r-s-let-expander (bindings body e letsym pred)
     (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings)))
       (let ((renames [keep-if pred exp-bindings second])
             (regular [remove-if pred exp-bindings second]))
       (cond ((and renames regular)
               ^(symacrolet ,renames
-                 (let ,regular ,*body)))
+                 (,letsym ,regular ,*body)))
             (renames ^(symacrolet ,renames ,*body))
-            (regular ^(let ,regular ,*body))
+            (regular ^(,letsym ,regular ,*body))
             (t ^(progn ,*body)))))))
 
 (defmacro rlet (bindings :env e . body)
-  [sys:r-s-let-expander bindings body e constantp])
+  [sys:r-s-let-expander bindings body e 'let constantp])
 
 (defmacro slet (bindings :env e . body)
-  (sys:r-s-let-expander bindings body e [orf constantp bindable]))
+  (sys:r-s-let-expander bindings body e 'let [orf constantp bindable]))
 
 (defmacro alet (bindings :env e . body)
   (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings)))
-    ^(,(if [all exp-bindings [orf constantp bindable] second]
-         'symacrolet 'let)
-       ,exp-bindings ,*body)))
+    (if [some exp-bindings constantp second]
+      [sys:r-s-let-expander exp-bindings body e 'alet constantp]
+      ^(,(if [all exp-bindings bindable second]
+           'symacrolet 'let)
+         ,exp-bindings ,*body))))
 
 (defmacro with-gensyms (syms . body)
   ^(let ,(zip syms (repeat '((gensym)))) ,*body))