read-once: support globals properly.

When a global variable v is wrapped with (read-once v),
multiple accesses to the place still generate
multiple accesses of the global through getv or getlx
instructions. The reason is that the alet and slet
macros optimize away a temporary bound to the value of
a variable regardless of whether the variable is lexical.
Let's fix that.

* stdlib/place.tl (slet, alet): Replace the bindable test
with lexical-var-p, in the given environment. A binding
to a variable is only alias-like if the variable is
lexical, otherwise we need a real temporary.

* tests/012/struct.tl (get-current-menv): New macro.
(menv): New global variable. Fix a number of tests which
use expand, whose expansion has changed because the
expressions refer to free variables. We introduce an
environment parameter which binds all the variables, so
that the optimized expansion is produced, as before.

* txr.1: Updated documentation. slet gets examples.

1 files changed, 13 insertions, 9 deletions

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)")