diff options
| -rw-r--r-- | stdlib/place.tl | 5 | ||||
| -rw-r--r-- | tests/012/struct.tl | 22 | ||||
| -rw-r--r-- | txr.1 | 30 |
3 files changed, 42 insertions, 15 deletions
diff --git a/stdlib/place.tl b/stdlib/place.tl index fcc86735..b3b6395f 100644 --- a/stdlib/place.tl +++ b/stdlib/place.tl @@ -129,13 +129,14 @@ [sys:r-s-let-expander bindings body e 'let constantp]) (defmacro slet (bindings :env e . body) - (sys:r-s-let-expander bindings body e 'let [orf constantp bindable])) + (sys:r-s-let-expander bindings body e 'let [orf constantp + (op lexical-var-p e)])) (defmacro alet (bindings :env e . body) (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings))) (if [some exp-bindings constantp second] [sys:r-s-let-expander exp-bindings body e 'alet constantp] - ^(,(if [all exp-bindings bindable second] + ^(,(if [all exp-bindings (op lexical-var-p e) second] 'symacrolet 'let) ,exp-bindings ,*body)))) diff --git a/tests/012/struct.tl b/tests/012/struct.tl index bdff6311..93979786 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -28,32 +28,36 @@ (slot (slot (slot a 'b) 'c) 'd)) -(test (expand 's.a) +(defmacro get-current-menv (:env e) e) +(defvarl menv (let (s a b c d) (macro-time (get-current-menv)))) + +(test (expand 's.a menv) (slot s 'a)) -(test (expand 's.[a]) +(test (expand 's.[a] menv) [(slot s 'a) s]) -(test (expand 's.[a b c]) +(test (expand 's.[a b c] menv) [(slot s 'a) s b c]) (set *gensym-counter* 0) -(stest (ignwarn (expand 's.(a))) + +(stest (ignwarn (expand 's.(a) menv)) "(call (slot s 'a)\n \ \ s)") (set *gensym-counter* 0) -(stest (ignwarn (expand 's.(a b c))) +(stest (ignwarn (expand 's.(a b c) menv)) "(call (slot s 'a)\n \ \ s b c)") -(test (expand 's.[a].b) +(test (expand 's.[a].b menv) (slot [(slot s 'a) s] 'b)) -(test (expand 's.[a b c].b) +(test (expand 's.[a b c].b menv) (slot [(slot s 'a) s b c] 'b)) (set *gensym-counter* 0) -(stest (ignwarn (expand 's.(a).d)) +(stest (ignwarn (expand 's.(a).d menv)) "(slot (call (slot s 'a)\n \ \ s)\n \ \ 'd)") (set *gensym-counter* 0) -(stest (ignwarn (expand 's.(a b c).d)) +(stest (ignwarn (expand 's.(a b c).d menv)) "(slot (call (slot s 'a)\n \ \ s b c)\n \ \ 'd)") @@ -44223,8 +44223,30 @@ reduces bindings initialized by constant expressions to symbol macros. In addition, unlike .codn rlet , .code slet -also reduces to symbol macros those bindings which -are initialized by symbol expressions (values of variables). +also reduces to symbol macros those bindings whose initializing +expressions are simple references to lexical variables. + +.TP* Examples: + +.verb + ;; reduces to let + (slet ((a (list x y))) + a) + + ;; b is a free variable, so this is also let + (slet ((a b)) + a) + + ;; b is lexical, so a becomes a symbol macro + ;; the (slet ...) form becomes b. + (let (b) + (slet ((a b)) + a)) + + ;; a becomes symbol macro; form transforms to 1. + (slet ((a 1)) + a) +.brev .coNP Macro @ alet .synb @@ -44237,7 +44259,7 @@ The macro .code slet macro. All bindings initialized by constant expressions are turned to symbol macros. Then, if all of the remaining bindings are -all initialized by symbol expressions, they are also turned to +all initialized by lexical variables, they are also turned to symbol macros. Otherwise, none of the remaining bindings are turned to symbol macros. @@ -44249,7 +44271,7 @@ others' evaluations. In this situation .code alet still propagates constants via symbol macros, and can eliminate the remaining temporaries if they can all be made symbol macros for -existing variables: i.e. there doesn't exist any initialization form +existing lexicals: i.e. there doesn't exist any initialization form with interfering side effects. .coNP Macro @ define-accessor |