summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2011-12-19 09:19:18 -0800
committerKaz Kylheku <kaz@kylheku.com>2011-12-19 09:19:18 -0800
commit6ba63a4919af92166391aa6fb5d8a55e8a537c92 (patch)
treee357daf40b395cccdc09ee35f1040680f13f250c
parent61a8fde2872355b4e721f1c5145c77122c92c40e (diff)
downloadtxr-6ba63a4919af92166391aa6fb5d8a55e8a537c92.tar.gz
txr-6ba63a4919af92166391aa6fb5d8a55e8a537c92.tar.bz2
txr-6ba63a4919af92166391aa6fb5d8a55e8a537c92.zip
* eval.c (subst_vars, op_quasi_list, expand_quasi): New static
functions. (expand): New case for quasiliterals. (eval_init): Register quasi literal as special operator. * match.c (format_field): Linkage changed to external. * match.h (format_field): Declared. Declarations rearranged.
-rw-r--r--ChangeLog11
-rw-r--r--eval.c95
-rw-r--r--match.c2
-rw-r--r--match.h6
4 files changed, 110 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 9ea07c80..71949bbe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2011-12-19 Kaz Kylheku <kaz@kylheku.com>
+
+ * eval.c (subst_vars, op_quasi_list, expand_quasi): New static
+ functions.
+ (expand): New case for quasiliterals.
+ (eval_init): Register quasi literal as special operator.
+
+ * match.c (format_field): Linkage changed to external.
+
+ * match.h (format_field): Declared. Declarations rearranged.
+
2011-12-18 Kaz Kylheku <kaz@kylheku.com>
* eval.c (bindings_helper): Fix format arguments.
diff --git a/eval.c b/eval.c
index f093a11a..3052f2db 100644
--- a/eval.c
+++ b/eval.c
@@ -711,6 +711,67 @@ static val op_return_from(val form, val env)
abort();
}
+static val subst_vars(val forms, val env)
+{
+ list_collect_decl(out, iter);
+
+ while (forms) {
+ val form = first(forms);
+
+ if (consp(form)) {
+ val sym = first(form);
+
+ if (sym == var_s) {
+ val sym = second(form);
+ val pat = third(form);
+ val modifiers = fourth(form);
+ val pair = lookup_var(env, sym);
+
+ if (pair) {
+ val str = cdr(pair);
+
+ if (!stringp(str) && !listp(str))
+ str = format(nil, lit("~a"), str, nao);
+
+ if (pat)
+ forms = cons(str, cons(pat, rest(forms)));
+ else if (modifiers)
+ forms = cons(format_field(str, modifiers, nil), rest(forms));
+ else
+ forms = cons(str, rest(forms));
+ continue;
+ }
+ uw_throwf(query_error_s, lit("unbound variable ~a"),
+ sym, nao);
+ } else if (sym == quasi_s) {
+ val nested = subst_vars(rest(form), env);
+ list_collect_append(iter, nested);
+ forms = cdr(forms);
+ continue;
+ } else if (sym == expr_s) {
+ val result = eval(rest(form), env, form);
+ forms = cons(format(nil, lit("~a"), result, nao), rest(forms));
+ continue;
+ } else {
+ val nested = subst_vars(form, env);
+ list_collect_append(iter, nested);
+ forms = cdr(forms);
+ continue;
+ }
+ }
+
+ list_collect(iter, form);
+ forms = cdr(forms);
+ }
+
+ return out;
+}
+
+static val op_quasi_lit(val form, val env)
+{
+ return cat_str(subst_vars(rest(form), env), nil);
+}
+
static val expand_forms(val form)
{
if (atom(form)) {
@@ -858,6 +919,33 @@ static val expand_vars(val vars)
}
}
+static val expand_quasi(val quasi_forms)
+{
+ if (nullp(quasi_forms)) {
+ return nil;
+ } else {
+ val form = first(quasi_forms);
+ val form_ex = form;
+
+ if (atom(form)) {
+ form_ex = form;
+ } else {
+ val sym = car(form);
+ if (sym == expr_s) {
+ val expr_ex = expand(rest(form));
+
+ if (expr_ex != rest(form))
+ form_ex = cons(sym, expr_ex);
+
+ }
+ }
+
+ if (form != form_ex)
+ return cons(form_ex, expand_quasi(rest(quasi_forms)));
+ return quasi_forms;
+ }
+}
+
val expand(val form)
{
if (atom(form)) {
@@ -973,6 +1061,12 @@ val expand(val form)
if (forms == forms_ex)
return form;
return rlcp(cons(sym, forms_ex), form);
+ } else if (sym == quasi_s) {
+ val quasi = rest(form);
+ val quasi_ex = expand_quasi(quasi);
+ if (quasi == quasi_ex)
+ return form;
+ return rlcp(cons(sym, quasi_ex), form);
} else {
/* funtion call */
/* also handles: progn, call, if, and, or, unwind-protect, return */
@@ -1116,6 +1210,7 @@ void eval_init(void)
sethash(op_table, block_s, cptr((mem_t *) op_block));
sethash(op_table, return_s, cptr((mem_t *) op_return));
sethash(op_table, return_from_s, cptr((mem_t *) op_return_from));
+ sethash(op_table, quasi_s, cptr((mem_t *) op_quasi_lit));
reg_fun(cons_s, func_n2(cons));
reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons));
diff --git a/match.c b/match.c
index c8367f22..09d34dec 100644
--- a/match.c
+++ b/match.c
@@ -1203,7 +1203,7 @@ static val match_line(match_line_ctx c)
return cons(c.bindings, c.pos);
}
-static val format_field(val string_or_list, val modifier, val filter)
+val format_field(val string_or_list, val modifier, val filter)
{
val n = zero;
val plist = nil;
diff --git a/match.h b/match.h
index 277d33a8..8d8e9476 100644
--- a/match.h
+++ b/match.h
@@ -24,8 +24,8 @@
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
-extern val do_s;
-void match_init(void);
+extern val text_s, choose_s, gather_s, do_s;
+val format_field(val string_or_list, val modifier, val filter);
val match_funcall(val name, val arg, val other_args);
int extract(val spec, val filenames, val bindings);
-extern val text_s, choose_s, gather_s;
+void match_init(void);