diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-05-22 06:13:49 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-05-22 06:13:49 -0700 |
commit | 22e6568de7fe351974057e57d17078fd8f2b442b (patch) | |
tree | 7e41d28a500dd0d556b9ab429b9d5c45de9bc78f /eval.c | |
parent | ecc85df1f89e968089a3ad2498bc0138a09d95a4 (diff) | |
download | txr-22e6568de7fe351974057e57d17078fd8f2b442b.tar.gz txr-22e6568de7fe351974057e57d17078fd8f2b442b.tar.bz2 txr-22e6568de7fe351974057e57d17078fd8f2b442b.zip |
symbol-function, symbol-value and fun become places.
* eval.c (op_setqf): New function.
(eval_init): Register sys:setqf operator. Also expose
global variable hash tables via sys:top-vb and sys:top-fb.
* place.tl (sys:get-fb, sys:get-vb): New functions.
(fun, symbol-function, symbol-value): New places defined.
Diffstat (limited to 'eval.c')
-rw-r--r-- | eval.c | 19 |
1 files changed, 19 insertions, 0 deletions
@@ -1710,6 +1710,22 @@ static val op_lisp1_value(val form, val env) } } +static val op_setqf(val form, val env) +{ + val args = rest(form); + val var = pop(&args); + val newval = pop(&args); + + if (!bindable(var)) { + eval_error(form, lit("sys:setqf: ~s is not a bindable symbol"), var, nao); + } else { + val binding = lookup_fun(env, var); + if (nilp(binding)) + eval_error(form, lit("unbound function ~s"), var, nao); + return sys_rplacd(binding, eval(newval, env, form)); + } +} + static val op_for(val form, val env) { val forsym = first(form); @@ -3940,6 +3956,7 @@ void eval_init(void) reg_op(setq_s, op_setq); reg_op(intern(lit("lisp1-setq"), system_package), op_lisp1_setq); reg_op(intern(lit("lisp1-value"), system_package), op_lisp1_value); + reg_op(intern(lit("setqf"), system_package), op_setqf); reg_op(for_s, op_for); reg_op(for_star_s, op_for); reg_op(dohash_s, op_dohash); @@ -4404,6 +4421,8 @@ void eval_init(void) reg_fun(intern(lit("make-like"), user_package), func_n2(make_like)); reg_fun(intern(lit("nullify"), user_package), func_n1(nullify)); + reg_var(intern(lit("top-vb"), system_package), top_vb); + reg_var(intern(lit("top-fb"), system_package), top_fb); reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value)); reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function)); reg_fun(intern(lit("boundp"), user_package), func_n1(boundp)); |