From 7ac825c0d2ce608c8836d78910a92889b52be9f8 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 26 Oct 2016 21:51:43 -0700 Subject: 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. --- share/txr/stdlib/place.tl | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'share') 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)) -- cgit v1.2.3