summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--eval.c30
2 files changed, 37 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index 8702a519..d4e45401 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2015-07-11 Kaz Kylheku <kaz@kylheku.com>
+ Expand away sys:lisp1-value based on lexical info.
+
+ * eval.c (sys_lisp1_value_s): New global symbol variable.
+ (expand_lisp1_value): New static function.
+ (do_expand): Use expand_lisp1_value.
+ (eval_init): Initialize sys_lisp1_value_s.
+
+2015-07-11 Kaz Kylheku <kaz@kylheku.com>
+
Let's have placelet and placelet*.
* share/txr/stdlib/place.tl (placelet*): New macro.
diff --git a/eval.c b/eval.c
index 8993dca3..084e556f 100644
--- a/eval.c
+++ b/eval.c
@@ -90,7 +90,7 @@ val macro_time_s, with_saved_vars_s, macrolet_s;
val defsymacro_s, symacrolet_s, prof_s;
val fbind_s, lbind_s, flet_s, labels_s;
val opip_s, oand_s, chain_s, chand_s;
-val sys_load_s;
+val sys_load_s, sys_lisp1_value_s;
val special_s, whole_k, symacro_k, fun_k;
@@ -1699,6 +1699,29 @@ static val op_lisp1_setq(val form, val env)
}
}
+static val expand_lisp1_value(val form, val menv)
+{
+ if (length(form) != two)
+ eval_error(form, lit("~s: invalid syntax"), first(form), nao);
+
+ {
+ val sym = second(form);
+ val binding_type = lexical_lisp1_binding(menv, sym);
+
+ if (nilp(binding_type))
+ return form;
+
+ if (binding_type == var_k)
+ return sym;
+
+ if (binding_type == fun_k)
+ return rlcp(cons(fun_s, cons(sym, nil)), form);
+
+ eval_error(form, lit("~s: misapplied to symbol macro ~s"),
+ first(form), sym, nao);
+ }
+}
+
static val op_lisp1_value(val form, val env)
{
val args = rest(form);
@@ -3124,6 +3147,8 @@ tail:
if (args == args_ex)
return form;
return rlcp(cons(sym, args_ex), form);
+ } else if (sym == sys_lisp1_value_s) {
+ return expand_lisp1_value(form, menv);
} else {
/* funtion call
also handles: prog1, call, if, and, or,
@@ -3973,6 +3998,7 @@ void eval_init(void)
chain_s = intern(lit("chain"), user_package);
chand_s = intern(lit("chand"), user_package);
sys_load_s = intern(lit("load"), system_package);
+ sys_lisp1_value_s = intern(lit("lisp1-value"), system_package);
reg_op(quote_s, op_quote);
reg_op(qquote_s, op_qquote_error);
@@ -4007,7 +4033,7 @@ void eval_init(void)
reg_op(tree_bind_s, op_tree_bind);
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(sys_lisp1_value_s, 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);