summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2023-05-14 09:32:23 -0700
committerKaz Kylheku <kaz@kylheku.com>2023-05-14 09:32:23 -0700
commit30b4cd7fd4aa40616e089b834e34f1928c700ab1 (patch)
tree6aee301a40e21b6950ea1ca5f8bd6dff40f0229d
parent5162fde5237ce801f74e8db2bc680f72f00fb0ce (diff)
downloadtxr-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.c13
-rw-r--r--stdlib/place.tl8
-rw-r--r--tests/019/symbol-value.tl24
3 files changed, 41 insertions, 4 deletions
diff --git a/eval.c b/eval.c
index 0e247fda..3c8d83f5 100644
--- a/eval.c
+++ b/eval.c
@@ -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)