summaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-01-21 10:15:07 -0800
committerKaz Kylheku <kaz@kylheku.com>2015-01-21 10:15:07 -0800
commit47833d3b34633299a1afd778e658bc77f146a03c (patch)
tree4b6b76094ae546b24e3f0acbb495b3d7c9f46b7c /eval.c
parentaa355befc89d94f3f43d3ae4124f7d048fb4e588 (diff)
downloadtxr-47833d3b34633299a1afd778e658bc77f146a03c.tar.gz
txr-47833d3b34633299a1afd778e658bc77f146a03c.tar.bz2
txr-47833d3b34633299a1afd778e658bc77f146a03c.zip
Basic implementation of constantp. Does not
recognize forms like (+ 2 2) as constant. * eval.c (constantp_noex, constantp): New functions. (eval_init): Registered constantp as intrinsic. * tl.vim, txr.vim: Updated. * txr.1: Documented constantp.
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c37
1 files changed, 37 insertions, 0 deletions
diff --git a/eval.c b/eval.c
index 1089c6b8..bba8be6e 100644
--- a/eval.c
+++ b/eval.c
@@ -2983,6 +2983,42 @@ static val macroexpand(val form, val menv)
}
}
+static val constantp_noex(val form)
+{
+ if (consp(form)) {
+ return eq(car(form), quote_s);
+ } else {
+ if (bindable(form))
+ return nil;
+ return t;
+ }
+}
+
+static val constantp(val form, val env_in)
+{
+ val env = default_bool_arg(env_in);
+
+ if (consp(form)) {
+ if (car(form) == quote_s) {
+ return t;
+ } else if (macro_form_p(form, env)) {
+ return constantp_noex(macroexpand(form, env));
+ } else {
+ return nil;
+ }
+ } else if (symbolp(form)) {
+ if (!bindable(form)) {
+ return t;
+ } else if (macro_form_p(form, env)) {
+ return constantp_noex(macroexpand(form, env));
+ } else {
+ return nil;
+ }
+ } else {
+ return t;
+ }
+}
+
val mapcarv(val fun, val list_of_lists)
{
if (!cdr(list_of_lists)) {
@@ -3846,6 +3882,7 @@ void eval_init(void)
func_n2o(macroexpand_1, 1));
reg_fun(intern(lit("macroexpand"), user_package),
func_n2o(macroexpand, 1));
+ reg_fun(intern(lit("constantp"), user_package), func_n2o(constantp, 1));
reg_fun(intern(lit("make-env"), user_package), func_n3o(make_env_intrinsic, 0));
reg_fun(intern(lit("env-fbind"), user_package), func_n3(env_fbind));
reg_fun(intern(lit("env-vbind"), user_package), func_n3(env_vbind));