From 0f83274fcd10cc218c22adf35b83f41e8f476efc Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 26 Nov 2016 09:32:22 -0800 Subject: bugfix: quasilit read/print consistency, part 2. In this patch commit I'm addressing the issue introduced in part 1 that expressions in @(output) blocks are still using (sys:expr ...) wrapping, but are passed down to an evaluator which now expects unwrapped expressions now. As part of this change, I'm changing the representation of @expr from (sys:expr . expr) to (sys:expr expr). * eval.c (format_field): Adjust access to sys:expr expression based on new representation. (transform_op): Likewise. * lib.c (obj_print_impl): Likewise. * match.c (dest_bind): Likewise. (do_txeval): Likewise. (do_output_line): Likewise, in some compat code. Here is the fix for the issue: when calling tx_subst_vars, we pass a list of one element containing the expression, not wrapped in sys:expr. Previously, we passed a one-element list containing the sys:expr. * parser.y (o_elem): If a list occurs in the syntax, represent it as (sys:expr list) rather than (sys:expr . list). (list): Do the same for @ n_expr syntax. (expand_meta, make_expr): Harmonize with the representation change. --- eval.c | 6 +++--- lib.c | 2 +- match.c | 10 ++++------ parser.y | 12 ++++++------ 4 files changed, 14 insertions(+), 16 deletions(-) diff --git a/eval.c b/eval.c index 6fe12132..51fcdb4b 100644 --- a/eval.c +++ b/eval.c @@ -2249,7 +2249,7 @@ val format_field(val obj, val modifier, val filter, val eval_fun) } else if ((!opt_compat || opt_compat > 128) && consp(item) && car(item) == expr_s) { - item = cdr(item); + item = cadr(item); goto eval; } else if (consp(item) && car(item) == dwim_s) { val arg_expr = second(item); @@ -3034,8 +3034,8 @@ static val transform_op(val forms, val syms, val rg) val fi = first(forms); val re = rest(forms); - if (fi == expr_s && meta_meta_p(re)) - return cons(syms, rlcp(meta_meta_strip(re), forms)); + if (fi == expr_s && meta_meta_p(car(re))) + return cons(syms, rlcp(meta_meta_strip(car(re)), forms)); /* This handles improper list forms like (a b c . @42) when the recursion hits the @42 part. */ diff --git a/lib.c b/lib.c index c510ba73..f41d1015 100644 --- a/lib.c +++ b/lib.c @@ -9556,7 +9556,7 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) obj_print_impl(second(obj), out, pretty, ctx); } else if (sym == expr_s) { put_char(chr('@'), out); - obj_print_impl(rest(obj), out, pretty, ctx); + obj_print_impl(second(obj), out, pretty, ctx); } else if (sym == rcons_s && consp(cdr(obj)) && consp(cddr(obj)) && !(cdddr(obj))) { diff --git a/match.c b/match.c index 93b84a07..dd376ef2 100644 --- a/match.c +++ b/match.c @@ -353,7 +353,7 @@ static val dest_bind(val spec, val bindings, val pattern, } if (first(pattern) == expr_s) { - ret = tleval(spec, rest(pattern), bindings); + ret = tleval(spec, second(pattern), bindings); lisp_evaled = t; } @@ -1561,10 +1561,8 @@ static val do_txeval(val spec, val form, val bindings, val allow_unbound) for (iter = rest(form); iter != nil; iter = cdr(iter)) tail = list_collect(tail, tx_subst_vars(cdr(car(iter)), bindings, nil)); ret = out; - } else if (sym == var_s) { + } else if (sym == var_s || sym == expr_s) { ret = tleval(spec, second(form), bindings); - } else if (sym == expr_s) { - ret = tleval(spec, rest(form), bindings); } else { ret = mapcar(curry_123_2(func_n3(txeval), spec, bindings), form); } @@ -1878,9 +1876,9 @@ static void do_output_line(val bindings, val specline, val filter, val out) } else if (directive == expr_s) { if (opt_compat && opt_compat < 100) { format(out, lit("~a"), - tleval(elem, rest(elem), bindings), nao); + tleval(elem, second(elem), bindings), nao); } else { - val str = cat_str(tx_subst_vars(cons(elem, nil), + val str = cat_str(tx_subst_vars(cdr(elem), bindings, filter), nil); if (str == nil) sem_error(specline, lit("bad substitution: ~a"), diff --git a/parser.y b/parser.y index b54c7bf8..a6950e8f 100644 --- a/parser.y +++ b/parser.y @@ -732,8 +732,8 @@ o_elem : TEXT { $$ = string_own($1); | SPACE { $$ = string_own($1); rl($$, num(parser->lineno)); } | o_var { $$ = $1; } - | list { $$ = rlcp(cons(expr_s, - expand($1, nil)), $1); } + | list { $$ = rlcp(list(expr_s, + expand($1, nil), nao), $1); } | rep_elem { $$ = $1; } ; @@ -874,7 +874,7 @@ list : '(' n_exprs ')' { $$ = rl($2, num($1)); } | '[' n_exprs ']' { $$ = rl(cons(dwim_s, $2), num($1)); } | '[' ']' { $$ = rl(cons(dwim_s, nil), num($1)); } | '@' n_expr { if (consp($2)) - $$ = rl(cons(expr_s, $2), num($1)); + $$ = rl(cons(expr_s, cons($2, nil)), num($1)); else $$ = rl(cons(var_s, cons($2, nil)), num($1)); } @@ -1520,9 +1520,9 @@ static val expand_meta(val form, val menv) } if ((sym = car(form)) == expr_s) { - val exp_x = expand(rest(form), menv); + val exp_x = expand(second(form), menv); if (!bindable(exp_x)) - return rlcp(cons(sym, exp_x), form); + return rlcp(cons(sym, cons(exp_x, nil)), form); return rlcp(cons(var_s, cons(exp_x, nil)), form); } @@ -1620,7 +1620,7 @@ static wchar_t char_from_name(const wchar_t *name) static val make_expr(parser_t *parser, val sym, val rest, val lineno) { val expr = cons(sym, rest); - val ret = cons(expr_s, expand(expr, nil)); + val ret = cons(expr_s, cons(expand(expr, nil), nil)); if (rest) { rlcp(expr, rest); -- cgit v1.2.3