diff options
| -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) |