diff options
| -rw-r--r-- | ChangeLog | 23 | ||||
| -rw-r--r-- | filter.c | 19 | ||||
| -rw-r--r-- | match.c | 229 | ||||
| -rw-r--r-- | match.h | 1 | ||||
| -rw-r--r-- | txr.1 | 46 | ||||
| -rw-r--r-- | unwind.c | 14 | ||||
| -rw-r--r-- | unwind.h | 3 |
7 files changed, 244 insertions, 91 deletions
@@ -1,5 +1,28 @@ 2011-10-24 Kaz Kylheku <kaz@kylheku.com> + * filter.c (function_filter): New function. + (get_filter): Handle (fun ...) syntax. + + * match.c (v_bind): Establish dynamic environment frame around + dest_bind, and stash the bindings there so filters can have access + to the bindings. + (v_output): Likewise, around do_output calls. + (v_fun): New function. + (match_files): Function handling broken out into v_fun. + (match_funcall): New function. + + * match.h (match_funcall): Declared. + + * unwind.c (uw_push_env): Initialize match_context. + (uw_get_match_context, uw_set_match_context): New functions. + + * unwind.h (struct uw_dynamic_env): New member, match_context. + (uw_get_match_context, uw_set_match_context): Declared. + + * txr.1: Documented function filters. + +2011-10-24 Kaz Kylheku <kaz@kylheku.com> + Turning attention to some plumbing. * unwind.c (uw_env_stack): New static variable. @@ -32,6 +32,7 @@ #include "lib.h" #include "hash.h" #include "unwind.h" +#include "match.h" #include "filter.h" #include "gc.h" @@ -132,15 +133,25 @@ static val compound_filter(val filter_list, val string) return reduce_left(func_n2(string_filter), filter_list, string, nil); } +static val function_filter(val functions, val string) +{ + return reduce_left(swap_12_21(func_n2(match_funcall)), + functions, string, nil); +} + val get_filter(val spec) { if (consp(spec)) { - val filter_list = mapcar(curry_12_2(func_n2(gethash), filters), spec); + if (car(spec) == fun_s) { + return curry_12_2(func_n2(function_filter), rest(spec)); + } else { + val filter_list = mapcar(func_n1(get_filter), spec); - if (memqual(nil, filter_list)) - return nil; + if (memqual(nil, filter_list)) + return nil; - return curry_12_2(func_n2(compound_filter), filter_list); + return curry_12_2(func_n2(compound_filter), filter_list); + } } return gethash(filters, spec); @@ -2208,10 +2208,14 @@ static val v_bind(match_files_ctx c, match_files_ctx *cout) testfun = curry_1234_34(func_n4(filter_equal), lfilt, rfilt); } + uw_env_begin; + uw_set_match_context(cons(c.spec, c.bindings)); c.bindings = dest_bind(spec_linenum, c.bindings, pattern, cdr(value), testfun); + uw_env_end; + if (c.bindings == t) return nil; @@ -2310,7 +2314,10 @@ static val v_output(match_files_ctx c, match_files_ctx *cout) sem_error(spec_linenum, lit(":into requires a variable, not ~s"), into_var, nao); debugf(lit("opening string list stream"), nao); + uw_env_begin; + uw_set_match_context(cons(c.spec, c.bindings)); do_output(c.bindings, specs, filter, stream); + uw_env_end; { val existing = assoc(c.bindings, into_var); @@ -2348,7 +2355,10 @@ static val v_output(match_files_ctx c, match_files_ctx *cout) } } else { val stream = complex_stream(fp, dest); + uw_env_begin; + uw_set_match_context(cons(c.spec, c.bindings)); do_output(c.bindings, specs, filter, stream); + uw_env_end; close_stream(stream, t); } @@ -2574,6 +2584,102 @@ static val v_eof(match_files_ctx c, match_files_ctx *cout) return next_spec_k; } +static val v_fun(match_files_ctx c, match_files_ctx *cout) +{ + spec_bind (specline, spec_linenum, first_spec, c.spec); + val sym = first(first_spec); + val func = uw_get_func(sym); + + if (func) { + val args = rest(first_spec); + val params = car(func); + val ub_p_a_pairs = nil; + val body = cdr(func); + val piter, aiter; + val bindings_cp = copy_alist(c.bindings); + + if (!equal(length(args), length(params))) + sem_error(spec_linenum, lit("function ~a takes ~a argument(s)"), + sym, length(params), nao); + + for (piter = params, aiter = args; piter; + piter = cdr(piter), aiter = cdr(aiter)) + { + val param = car(piter); + val arg = car(aiter); + + if (arg && bindable(arg)) { + val val = assoc(c.bindings, arg); + if (val) { + bindings_cp = acons_new(bindings_cp, + param, + cdr(val)); + } else { + bindings_cp = alist_nremove1(bindings_cp, param); + ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs); + } + } else { + val val = eval_form(spec_linenum, arg, c.bindings); + bindings_cp = acons_new(bindings_cp, param, cdr(val)); + } + } + + { + uw_block_begin(nil, result); + uw_env_begin; + result = match_files(mf_spec_bindings(c, body, bindings_cp)); + uw_env_end; + uw_block_end; + + if (!result) { + debuglf(spec_linenum, lit("function failed"), nao); + return nil; + } + + { + cons_bind (new_bindings, success, result); + + for (piter = ub_p_a_pairs; piter; piter = cdr(piter)) + { + cons_bind (param, arg, car(piter)); + + if (symbolp(arg)) { + val newbind = assoc(new_bindings, param); + if (newbind) { + c.bindings = dest_bind(spec_linenum, c.bindings, + arg, cdr(newbind), equal_f); + if (c.bindings == t) { + debuglf(spec_linenum, + lit("binding mismatch on ~a " + "when returning from ~a"), arg, sym, nao); + return nil; + } + } + } + } + + if (consp(success)) { + debuglf(spec_linenum, + lit("function matched; " + "advancing from line ~a to ~a"), + c.data_lineno, cdr(success), nao); + c.data = car(success); + c.data_lineno = cdr(success); + } else { + debuglf(spec_linenum, lit("function consumed entire file"), + nao); + c.data = nil; + } + } + } + + *cout = c; + return next_spec_k; + } + + return decline_k; +} + static val match_files(match_files_ctx c) { gc_hint(c.data); @@ -2641,95 +2747,18 @@ repeat_spec_same_data: return result; } } else { - val func = uw_get_func(sym); - - if (func) { - val args = rest(first_spec); - val params = car(func); - val ub_p_a_pairs = nil; - val body = cdr(func); - val piter, aiter; - val bindings_cp = copy_alist(c.bindings); - - if (!equal(length(args), length(params))) - sem_error(spec_linenum, lit("function ~a takes ~a argument(s)"), - sym, length(params), nao); - - for (piter = params, aiter = args; piter; - piter = cdr(piter), aiter = cdr(aiter)) - { - val param = car(piter); - val arg = car(aiter); - - if (arg && bindable(arg)) { - val val = assoc(c.bindings, arg); - if (val) { - bindings_cp = acons_new(bindings_cp, - param, - cdr(val)); - } else { - bindings_cp = alist_nremove1(bindings_cp, param); - ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs); - } - } else { - val val = eval_form(spec_linenum, arg, c.bindings); - bindings_cp = acons_new(bindings_cp, param, cdr(val)); - } - } - - { - uw_block_begin(nil, result); - uw_env_begin; - result = match_files(mf_spec_bindings(c, body, bindings_cp)); - uw_env_end; - uw_block_end; - - if (!result) { - debuglf(spec_linenum, lit("function failed"), nao); - return nil; - } - - { - cons_bind (new_bindings, success, result); - - for (piter = ub_p_a_pairs; piter; piter = cdr(piter)) - { - cons_bind (param, arg, car(piter)); - - if (symbolp(arg)) { - val newbind = assoc(new_bindings, param); - if (newbind) { - c.bindings = dest_bind(spec_linenum, c.bindings, - arg, cdr(newbind), equal_f); - if (c.bindings == t) { - debuglf(spec_linenum, - lit("binding mismatch on ~a " - "when returning from ~a"), arg, sym, nao); - return nil; - } - } - } - } - - if (consp(success)) { - debuglf(spec_linenum, - lit("function matched; " - "advancing from line ~a to ~a"), - c.data_lineno, cdr(success), nao); - c.data = car(success); - c.data_lineno = cdr(success); - } else { - debuglf(spec_linenum, lit("function consumed entire file"), - nao); - c.data = nil; - } - } - } + match_files_ctx nc; + val result = v_fun(c, &nc); + if (result == next_spec_k) { + c = nc; if ((c.spec = rest(c.spec)) == nil) break; - goto repeat_spec_same_data; + } else if (result == decline_k) { + /* go on to other processing below */ + } else { + return result; } } } @@ -2760,6 +2789,36 @@ repeat_spec_same_data: return cons(c.bindings, if3(c.data, cons(c.data, c.data_lineno), t)); } +val match_funcall(val name, val arg) +{ + cons_bind (in_spec, in_bindings, uw_get_match_context()); + spec_bind (specline, spec_linenum, first_spec, in_spec); + val arg1_sym = make_sym(lit("arg1")), arg2_sym = make_sym(lit("arg2")); + val bindings = cons(cons(arg1_sym, arg), in_bindings); + val spec = cons(list(spec_linenum, + list(name, arg1_sym, arg2_sym, nao), nao), nil); + match_files_ctx nc; + (void) first_spec; + + val ret = v_fun(mf_all(spec, nil, bindings, nil, num(0)), &nc); + + if (ret == nil) + sem_error(spec_linenum, lit("filter: (~s ~s ~s) failed"), name, + arg, arg2_sym, nao); + + if (ret == decline_k) + sem_error(spec_linenum, lit("filter: function ~s not found"), name, nao); + + { + val out = assoc(nc.bindings, arg2_sym); + if (!out) + sem_error(spec_linenum, + lit("filter: (~s ~s ~s) did not bind ~s"), name, + arg, arg2_sym, arg2_sym, nao); + return cdr(out); + } +} + int extract(val spec, val files, val predefined_bindings) { cons_bind (bindings, success, match_files(mf_all(spec, files, @@ -25,5 +25,6 @@ */ void match_init(void); +val match_funcall(val name, val arg); int extract(val spec, val filenames, val bindings); extern val choose_s; @@ -1073,7 +1073,8 @@ This directive is used for defining named filters, which are useful for filtering variable substitutions in output blocks. Filters are useful when data must be translated between different representations that have different special characters or other syntax, requiring escaping -or similar treatment. +or similar treatment. Note that it is also possible to use a function +as a filter. See Function Filters below. .PP @@ -2153,11 +2154,12 @@ Example, the following produces a match: @(bind "A" "a" :rfilt :upcase) - .IP :filter This keyword is a shorthand to specify both filters to the same value. So for instance :filter :upcase is equivalent to :lfilt :upcase :rfilt :upcase. +For a description of filters, see Output Filtering below. + Of course, compound filters like (:from_html :upcase) are supported with all these keywords. The filters apply across arbitrary patterns and nested data. @@ -3025,6 +3027,46 @@ because '"' will turn to '"' which no longer be recognized by the :from_html filter, because the entity names in HTML codes are case-sensitive. +Instead of a filter name, the syntax (fun NAME) can be used. This +denotes that the function called NAME is to be used as a filter. +This is discussed in the next section Function Filters below. + +.SS Function Filters + +A function can be used as a filter. For this to be possible, the function must +conform to certain rules: + +.IP 1. +The function must take exactly two arguments. + +.IP 2. +When the function is called, the first argument will be bound to a string, +and the second argument will be unbound. The function must produce a string +value by binding it to the second argument. + +For instance, the following is a valid filter function: + + @(define foo_to_bar (in out) + @ (next :string in) + @ (cases) + foo + @ (bind out "bar") + @ (or) + @ (bind out in) + @ (end) + @(end) + +This function binds the out parameter to "bar" if the in parameter +is "foo", otherwise it binds the out parameter to a copy of the in parameter. +This is a simple filter. + +To use the filter, use the syntax (fun foo_to_bar) in place of a filter name. +For instance in the bind directive: + + @(bind "foo" "bar" :lfilt (fun foo_to_bar)) + +The above should succeed since the left side is filtered from "foo" +to "bar", so that there is a match. .SS The Deffilter Directive @@ -125,6 +125,7 @@ void uw_push_env(uw_frame_t *fr) fr->ev.type = UW_ENV; fr->ev.up_env = prev_env; fr->ev.func_bindings = nil; + fr->ev.match_context = nil; fr->ev.up = uw_stack; uw_stack = fr; uw_env_stack = fr; @@ -152,6 +153,19 @@ val uw_set_func(val sym, val value) return value; } +val uw_get_match_context(void) +{ + uw_frame_t *env = uw_find_env(); + return env->ev.match_context; +} + +val uw_set_match_context(val context) +{ + uw_frame_t *env = uw_find_env(); + env->ev.match_context = context; + return context; +} + void uw_pop_frame(uw_frame_t *fr) { assert (fr == uw_stack); @@ -51,6 +51,7 @@ struct uw_dynamic_env { uw_frtype_t type; uw_frame_t *up_env; val func_bindings; + val match_context; }; struct uw_catch { @@ -75,6 +76,8 @@ void uw_push_block(uw_frame_t *, val tag); void uw_push_env(uw_frame_t *); val uw_get_func(val sym); val uw_set_func(val sym, val value); +val uw_get_match_context(void); +val uw_set_match_context(val context); val uw_block_return(val tag, val result); void uw_push_catch(uw_frame_t *, val matches); noreturn val uw_throw(val sym, val exception); |