summaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2014-03-01 21:49:46 -0800
committerKaz Kylheku <kaz@kylheku.com>2014-03-01 21:49:46 -0800
commit684c8e9d60812778b785ef0fc3fa78592f228bf8 (patch)
tree3ce51eb4db7a039fcc4e04b2022cfa5b54fde953 /eval.c
parent29bfa94d05a5c7d1a8205753b6c13731ecba564a (diff)
downloadtxr-684c8e9d60812778b785ef0fc3fa78592f228bf8.tar.gz
txr-684c8e9d60812778b785ef0fc3fa78592f228bf8.tar.bz2
txr-684c8e9d60812778b785ef0fc3fa78592f228bf8.zip
New quasiquote idea: let's have two quasiquote macros sharing one
expander. One macro based on sys:qquote, sys:unquote and sys:splice, and the other based on qquote, unquote and splice in the user package. The read syntax puts out the sys: one. * eval.c (expand_qquote): Takes three additional arguments: the qquote, unquote and splice symbols to recognize. The invalid splice diagnostic is adjusted based on which backquote we are expanding. (me_qquote): Look at the symbol in the first position of the form and then expand either the internal quasiquote macro or the public one, passing the right symbols into expand_qquote. (eval_init): Register error-throwing stub functions for the sys_qquote_s, sys_unquote_s and sys_splice_s symbols. Register a macro for sys_qquote_s. * lib.c (sys_qquote_s, sys_unquote_s, sys_splice_s): New symbol variables. (obj_init): Initialize new variables. Change qquote_s, unquote_s and splice_s to user package. (obj_print, obj_pprint): Convert only sys_qquote_s, sys_unquote_s and sys_splice_s to the read syntax. The quote_s, unquote_s and splice_s symbols are not treated specially. * lib.h (sys_qquote_s, sys_unquote_s, sys_splice_s): Declared. * parser.y (n_expr): Use sys_qquote_s, sys_unquote_s and sys_splice_s rather than qquote_s, unquote_s and splice_s. (unquotes_occur): Likewise. * txr.1: Documented.
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c58
1 files changed, 37 insertions, 21 deletions
diff --git a/eval.c b/eval.c
index dc712b89..e718853a 100644
--- a/eval.c
+++ b/eval.c
@@ -2007,7 +2007,8 @@ static val expand_cond_pairs(val form, val menv)
}
}
-static val expand_qquote(val qquoted_form, val menv)
+static val expand_qquote(val qquoted_form, val menv,
+ val qq, val unq, val spl)
{
if (nilp(qquoted_form)) {
return nil;
@@ -2016,44 +2017,50 @@ static val expand_qquote(val qquoted_form, val menv)
} else {
val sym = car(qquoted_form);
- if (sym == splice_s) {
- eval_error(qquoted_form, lit("',*~s syntax is invalid"),
- second(qquoted_form), nao);
- } else if (sym == unquote_s) {
+ if (sym == spl) {
+ val error_msg = if3(spl == sys_splice_s,
+ lit("the splice ,*~s cannot occur as an atom "
+ "or in the dotted position of a list"),
+ lit("(splice ~s) cannot occur as an atom "
+ "or in the dotted position of a list"));
+ eval_error(qquoted_form, error_msg,
+ second(qquoted_form), nao);
+ } else if (sym == unq) {
return expand(second(qquoted_form), menv);
- } else if (sym == qquote_s) {
+ } else if (sym == qq) {
return rlcp(expand_qquote(expand_qquote(second(qquoted_form),
- menv),
- menv),
+ menv, qq, unq, spl),
+ menv, qq, unq, spl),
qquoted_form);
} else if (sym == hash_lit_s) {
- val args = expand_qquote(second(qquoted_form), menv);
- val pairs = expand_qquote(rest(rest(qquoted_form)), menv);
+ val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
+ val pairs = expand_qquote(rest(rest(qquoted_form)), menv, qq, unq, spl);
return rlcp(list(hash_construct_s, args, pairs, nao), qquoted_form);
} else if (sym == vector_lit_s) {
- val args = expand_qquote(second(qquoted_form), menv);
+ val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
return rlcp(list(vector_list_s, args, nao), qquoted_form);
} else {
val f = sym;
val r = cdr(qquoted_form);
val f_ex;
- val r_ex = expand_qquote(r, menv);
+ val r_ex = expand_qquote(r, menv, qq, unq, spl);
if (consp(f)) {
val qsym = car(f);
- if (qsym == splice_s) {
+ if (qsym == spl) {
f_ex = expand(second(f), menv);
- } else if (qsym == unquote_s) {
+ } else if (qsym == unq) {
f_ex = cons(list_s, cons(expand(second(f), menv), nil));
- } else if (qsym == qquote_s) {
+ } else if (qsym == qq) {
f_ex = cons(list_s, cons(expand_qquote(expand_qquote(second(f),
- menv),
- menv), nil));
+ menv, qq,
+ unq, spl),
+ menv, qq, unq, spl), nil));
} else {
- f_ex = cons(list_s, cons(expand_qquote(f, menv), nil));
+ f_ex = cons(list_s, cons(expand_qquote(f, menv, qq, unq, spl), nil));
}
} else {
- f_ex = cons(list_s, cons(expand_qquote(f, menv), nil));
+ f_ex = cons(list_s, cons(expand_qquote(f, menv, qq, unq, spl), nil));
}
if (nilp(r_ex)) {
@@ -2061,7 +2068,7 @@ static val expand_qquote(val qquoted_form, val menv)
} else if (atom(r_ex)) {
return rlcp(cons(append_s, cons(f_ex, cons(r_ex, nil))), qquoted_form);
} else {
- if (consp(r) && car(r) == unquote_s)
+ if (consp(r) && car(r) == unq)
r_ex = cons(r_ex, nil);
else if (car(r_ex) == append_s)
r_ex = cdr(r_ex);
@@ -2076,7 +2083,12 @@ static val expand_qquote(val qquoted_form, val menv)
static val me_qquote(val form, val menv)
{
- return expand_qquote(second(form), menv);
+ if (first(form) == sys_qquote_s)
+ return expand_qquote(second(form), menv,
+ sys_qquote_s, sys_unquote_s, sys_splice_s);
+ return expand_qquote(second(form), menv,
+ qquote_s, unquote_s, splice_s);
+
}
static val expand_vars(val vars, val menv, val form,
@@ -3062,8 +3074,11 @@ void eval_init(void)
reg_op(quote_s, op_quote);
reg_op(qquote_s, op_qquote_error);
+ reg_op(sys_qquote_s, op_qquote_error);
reg_op(unquote_s, op_unquote_error);
+ reg_op(sys_unquote_s, op_unquote_error);
reg_op(splice_s, op_unquote_error);
+ reg_op(sys_splice_s, op_unquote_error);
reg_op(progn_s, op_progn);
reg_op(prog1_s, op_prog1);
reg_op(let_s, op_let);
@@ -3112,6 +3127,7 @@ void eval_init(void)
reg_mac(op_s, me_op);
reg_mac(do_s, me_op);
reg_mac(qquote_s, me_qquote);
+ reg_mac(sys_qquote_s, me_qquote);
reg_fun(cons_s, func_n2(cons));
reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons));