diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2023-05-14 09:32:23 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2023-05-14 09:32:23 -0700 |
commit | 30b4cd7fd4aa40616e089b834e34f1928c700ab1 (patch) | |
tree | 6aee301a40e21b6950ea1ca5f8bd6dff40f0229d | |
parent | 5162fde5237ce801f74e8db2bc680f72f00fb0ce (diff) | |
download | txr-30b4cd7fd4aa40616e089b834e34f1928c700ab1.tar.gz txr-30b4cd7fd4aa40616e089b834e34f1928c700ab1.tar.bz2 txr-30b4cd7fd4aa40616e089b834e34f1928c700ab1.zip |
bug: symbol-value place always global.
We have a problem. If v is a dynamic variable, then
the form
(let (v)
(set (symbol-value 'v) 3))
is not behaving correctly; it's updating the top-level
value of v not the rebound one.
* eval.c (set_symbol_value): New static function.
(eval_init): Register sys:set-symbol-value intrinsic.
The top-vb variable, though no longer referenced by
the symbol-value place, because existing compiled
code depends on it.
* stdlib/place.tl (symbol-value): Rewrite the place
logic to use symbol-value to access the variable,
and set-symbol-value to update it, instead of referencing
sys:top-vb.
(sys:get-vb): This function has to stay, because it
provides run-time support for code compiled with the
buggy version of the place.
* tests/019/symbol-value.tl: New file.
-rw-r--r-- | eval.c | 13 | ||||
-rw-r--r-- | stdlib/place.tl | 8 | ||||
-rw-r--r-- | tests/019/symbol-value.tl | 24 |
3 files changed, 41 insertions, 4 deletions
@@ -5832,6 +5832,18 @@ static val symbol_value(val sym) lookup_symac(nil, sym))); } +static val set_symbol_value(val sym, val value) +{ + val vbind = lookup_var(nil, sym); + + if (vbind) + rplacd(vbind, value); + else + sethash(top_vb, sym, cons(sym, value)); + + return value; +} + static val symbol_function(val sym) { uses_or2; @@ -7579,6 +7591,7 @@ void eval_init(void) reg_varl(intern(lit("top-fb"), system_package), top_fb); reg_varl(intern(lit("top-mb"), system_package), top_mb); reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value)); + reg_fun(intern(lit("set-symbol-value"), system_package), func_n2(set_symbol_value)); reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function)); reg_fun(intern(lit("symbol-macro"), user_package), func_n1(symbol_macro)); reg_fun(intern(lit("boundp"), user_package), func_n1(boundp)); diff --git a/stdlib/place.tl b/stdlib/place.tl index 13b9bb18..fdd4e544 100644 --- a/stdlib/place.tl +++ b/stdlib/place.tl @@ -862,10 +862,10 @@ (defplace (symbol-value sym-expr) body (getter setter - (with-gensyms (binding-sym) - ^(let ((,binding-sym (sys:get-vb ,sym-expr))) - (macrolet ((,getter () ^(cdr ,',binding-sym)) - (,setter (val) ^(sys:rplacd ,',binding-sym ,val))) + (with-gensyms (sym) + ^(let ((,sym ,sym-expr)) + (macrolet ((,getter () ^(symbol-value ,',sym)) + (,setter (val) ^(sys:set-symbol-value ,',sym ,val))) ,body)))) nil (deleter diff --git a/tests/019/symbol-value.tl b/tests/019/symbol-value.tl new file mode 100644 index 00000000..ca724f5a --- /dev/null +++ b/tests/019/symbol-value.tl @@ -0,0 +1,24 @@ +(load "../common") + +(defparm v 42) + +(mtest + v 42 + (symbol-value 'v) 42 + (set (symbol-value 'v) 73) 73 + (symbol-value 'v) 73 + v 73) + +(mtest + (let ((v 2)) v) 2 + (let ((v 2)) (symbol-value 'v)) 2 + (progn (let ((v 2)) (set (symbol-value 'v) 1)) v) 73 + (let ((v 2)) (set (symbol-value 'v) 1) v) 1 + v 73) + +(test + (progn + (let ((v 2)) + (set (symbol-value 'x) 73)) + x) + 73) |