diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | filter.c | 12 | ||||
| -rw-r--r-- | filter.h | 1 | ||||
| -rw-r--r-- | lib.c | 43 | ||||
| -rw-r--r-- | lib.h | 5 | ||||
| -rw-r--r-- | match.c | 43 | ||||
| -rw-r--r-- | txr.1 | 66 |
7 files changed, 167 insertions, 29 deletions
@@ -1,3 +1,29 @@ +2011-10-22 Kaz Kylheku <kaz@kylheku.com> + + Task #11474 + + * filter.c (filter_equal): New function. + (upcase_k, downcase_k): New keyword variables. + (filter_init): New keyword variables initialized, + and new upcase and downcase filters registered. + + * filter.h (filter_equal): Declared. + + * lib.c (tree_find): Takes new argument, the equality test function. + (upcase_str, downcase_str): New functions. + (do_curry_123_23): New static function. + (curry_123_23): New function. + + * lib.h (tree_find): Declaration updated. + (upcase_str, downcase_str, curry_123_23): Declared. + + * match.c (dest_bind): Updated to take equality function. + Uses it and passes it down to tree_find. + (v_bind): Filter feature implemented. + (h_var, v_try): Add equal_f to dest_bind argument list. + + * txr.1: Updated to describe new filters and bind arguments. + 2011-10-21 Kaz Kylheku <kaz@kylheku.com> * match.c (v_collect, v_coll): Establish empty list bindings @@ -212,6 +212,13 @@ val filter_string(val filter, val str) uw_throwf(error_s, lit("filter_string: invalid filter ~a"), filter, nao); } +val filter_equal(val filter, val left, val right) +{ + if (stringp(left) && stringp(right)) + return equal(filter_string(filter, left), filter_string(filter, right)); + return equal(left, right); +} + val register_filter(val sym, val table) { return sethash(filters, sym, build_filter_from_list(table)); @@ -540,6 +547,7 @@ static val html_numeric_handler(val ch) val filters; val filter_k, to_html_k, from_html_k; +val upcase_k, downcase_k; void filter_init(void) { @@ -549,6 +557,8 @@ void filter_init(void) filter_k = intern(lit("filter"), keyword_package); to_html_k = intern(lit("to_html"), keyword_package); from_html_k = intern(lit("from_html"), keyword_package); + upcase_k = intern(lit("upcase"), keyword_package); + downcase_k = intern(lit("downcase"), keyword_package); sethash(filters, to_html_k, build_filter(to_html_table, t)); { val trie = build_filter(from_html_table, nil); @@ -556,4 +566,6 @@ void filter_init(void) trie_compress(&trie); sethash(filters, from_html_k, trie); } + sethash(filters, upcase_k, func_n1(upcase_str)); + sethash(filters, downcase_k, func_n1(downcase_str)); } @@ -32,6 +32,7 @@ val trie_value_at(val node); val trie_lookup_feed_char(val node, val ch); val get_filter_trie(val sym); val filter_string(val trie, val str); +val filter_equal(val filter, val left, val right); val register_filter(val sym, val table); void filter_init(void); @@ -372,12 +372,13 @@ val memqual(val obj, val list) return list; } -val tree_find(val obj, val tree) +val tree_find(val obj, val tree, val testfun) { - if (equal(obj, tree)) + if (funcall2(testfun, obj, tree)) return t; else if (consp(tree)) - return some_satisfy(tree, curry_12_2(func_n2(tree_find), obj), nil); + return some_satisfy(tree, curry_123_2(func_n3(tree_find), + obj, testfun), nil); return nil; } @@ -843,6 +844,32 @@ val copy_str(val str) return string(c_str(str)); } +val upcase_str(val str) +{ + val len = length_str(str); + wchar_t *dst = (wchar_t *) chk_malloc((c_num(len) + 1) * sizeof *dst); + const wchar_t *src = c_str(str); + val out = string_own(dst); + + while ((*dst++ = towupper(*src++))) + ; + + return out; +} + +val downcase_str(val str) +{ + val len = length_str(str); + wchar_t *dst = (wchar_t *) chk_malloc((c_num(len) + 1) * sizeof *dst); + const wchar_t *src = c_str(str); + val out = string_own(dst); + + while ((*dst++ = towlower(*src++))) + ; + + return out; +} + val string_extend(val str, val tail) { type_check(str, STR); @@ -1556,6 +1583,16 @@ val curry_123_2(val fun3, val arg1, val arg3) return func_f1(cons(fun3, cons(arg1, arg3)), do_curry_123_2); } +static val do_curry_123_23(val fcons, val arg2, val arg3) +{ + return funcall3(car(fcons), cdr(fcons), arg2, arg3); +} + +val curry_123_23(val fun3, val arg1) +{ + return func_f2(cons(fun3, arg1), do_curry_123_23); +} + static val do_chain(val fun1_list, val arg) { for (; fun1_list; fun1_list = cdr(fun1_list)) @@ -296,7 +296,7 @@ val ldiff(val list1, val list2); val flatten(val list); val memq(val obj, val list); val memqual(val obj, val list); -val tree_find(val obj, val tree); +val tree_find(val obj, val tree, val testfun); val some_satisfy(val list, val pred, val key); val all_satisfy(val list, val pred, val key); val none_satisfy(val list, val pred, val key); @@ -336,6 +336,8 @@ val mkstring(val len, val ch); val mkustring(val len); /* must initialize immediately with init_str! */ val init_str(val str, const wchar_t *); val copy_str(val str); +val upcase_str(val str); +val downcase_str(val str); val string_extend(val str, val tail); val stringp(val str); val lazy_stringp(val str); @@ -388,6 +390,7 @@ val reduce_left(val fun, val list, val init, val key); val curry_12_2(val fun2, val arg); val curry_12_1(val fun2, val arg2); val curry_123_2(val fun3, val arg1, val arg3); +val curry_123_23(val fun3, val arg1); val chain(val first_fun, ...); val andf(val first_fun, ...); val vector(val alloc); @@ -264,22 +264,23 @@ static val dest_set(val linenum, val bindings, val pattern, val value) return nil; } -static val dest_bind(val linenum, val bindings, val pattern, val value) +static val dest_bind(val linenum, val bindings, val pattern, + val value, val testfun) { if (symbolp(pattern)) { if (bindable(pattern)) { val existing = assoc(bindings, pattern); if (existing) { - if (tree_find(value, cdr(existing))) + if (tree_find(value, cdr(existing), testfun)) return bindings; - if (tree_find(cdr(existing), value)) + if (tree_find(cdr(existing), value, testfun)) return bindings; debugf(lit("bind variable mismatch: ~a"), pattern, nao); return t; } return cons(cons(pattern, value), bindings); } else { - return equal(pattern, value) ? bindings : t; + return funcall2(testfun, pattern, value) ? bindings : t; } } else if (consp(pattern)) { val piter = pattern, viter = value; @@ -299,7 +300,7 @@ static val dest_bind(val linenum, val bindings, val pattern, val value) while (consp(piter) && consp(viter)) { - bindings = dest_bind(linenum, bindings, car(piter), car(viter)); + bindings = dest_bind(linenum, bindings, car(piter), car(viter), testfun); if (bindings == t) return t; piter = cdr(piter); @@ -307,14 +308,14 @@ static val dest_bind(val linenum, val bindings, val pattern, val value) } if (bindable(piter)) { - bindings = dest_bind(linenum, bindings, piter, viter); + bindings = dest_bind(linenum, bindings, piter, viter, testfun); if (bindings == t) return t; } else { - return equal(piter, viter) ? bindings : t; + return funcall2(testfun, piter, viter) ? bindings : t; } return bindings; - } else if (tree_find(value, pattern)) { + } else if (tree_find(value, pattern, testfun)) { return bindings; } @@ -429,7 +430,7 @@ static val h_var(match_line_ctx c, match_line_ctx *cout) } if (!tree_find(trim_str(sub_str(c.dataline, c.pos, past)), - cdr(pair))) + cdr(pair), equal_f)) { LOG_MISMATCH("fixed field contents"); return nil; @@ -2137,9 +2138,25 @@ static val v_bind(match_files_ctx c, match_files_ctx *cout) val args = rest(first_spec); val pattern = first(args); val form = second(args); - val val = eval_form(spec_linenum, form, c.bindings); + val keywords = rest(rest(args)); + val value = eval_form(spec_linenum, form, c.bindings); + val testfun = equal_f; + val filter_sym = getplist(keywords, filter_k); + + if (filter_sym) { + val filter = get_filter_trie(filter_sym); + + if (!filter) { + uw_throwf(query_error_s, lit("bind: filter ~s not known"), + filter_sym, nao); + } + + testfun = curry_123_23(func_n3(filter_equal), filter); + } + - c.bindings = dest_bind(spec_linenum, c.bindings, pattern, cdr(val)); + c.bindings = dest_bind(spec_linenum, c.bindings, pattern, + cdr(value), testfun); if (c.bindings == t) return nil; @@ -2327,7 +2344,7 @@ static val v_try(match_files_ctx c, match_files_ctx *cout) if (value) { c.bindings = dest_bind(spec_linenum, c.bindings, - param, cdr(value)); + param, cdr(value), equal_f); if (c.bindings == t) { all_bind = nil; @@ -2629,7 +2646,7 @@ repeat_spec_same_data: val newbind = assoc(new_bindings, param); if (newbind) { c.bindings = dest_bind(spec_linenum, c.bindings, - arg, cdr(newbind)); + arg, cdr(newbind), equal_f); if (c.bindings == t) { debuglf(spec_linenum, lit("binding mismatch on ~a " @@ -2047,14 +2047,19 @@ Example: .SS The Bind Directive +The syntax of the @(bind) directive is: + + @(bind pattern form { keyword value }*) + + The @(bind) directive is a kind of pattern match, which matches one or more -variables on the left hand side to the value of a variable on the right hand -side. The right hand side variable must have a binding, or else the directive -fails. Any variables on the left hand side which are unbound receive a matching -piece of the right hand side value. Any variables on the left which are already -bound must match their corresponding value, or the bind fails. Any variables -which are already bound and which do match their corresponding value remain -unchanged (the match can be inexact). +variables on in the left hand side pattern to the value of a variable on the +right hand side. The right hand side variable must have a binding, or else the +directive fails. Any variables on the left hand side which are unbound receive +a matching piece of the right hand side value. Any variables on the left which +are already bound must match their corresponding value, or the bind fails. Any +variables which are already bound and which do match their corresponding value +remain unchanged (the match can be inexact). The simplest bind is of one variable against itself, for instance bind A against A: @@ -2117,6 +2122,27 @@ They represent themselves. For example @(bind :foo :bar) fails, but @(bind :foo :foo) succeeds since the two sides denote the same keyword symbol object. +.SS Keyword in The Bind Directive + +The Bind directive accepts the :filter keyword parameter. This specifies a +filter for performing a more loose match between the left and right hand side +objects. In the absence of a filter specification, text is compared verbatim, +in a case-insensitive manner. If a filter is specified, it is applied to the +left and right hand side. This has no effect if the left side is an unbound +variable: no filtering takes place in the stablishment of a binding. It is for +comparison purposes only. + +Example: suppose A contains "abc" and B contains "ABC". The following directive will fail: + + @(bind A B) + +However, the following will succeed: + + @(bind A B :filter :upcase) + +Bind will see that A and B have bindings already, and so compare their +contents. Since the :upcase filter is specified, both their contents will be +reduced through it for the purposes of the comparison, rendering them equal. .SS The Set Directive @@ -2920,12 +2946,28 @@ substituted into HTML, these should be replaced by < and >. This is what filtering is for. Filtering is applied to the contents of output variables, not to any template text. .B txr -implements named filters. Currently, the only built-in filters available are -:to_html and :from_html. User-defined filters are possible, however. -See notes on the deffilter directive below. +implements named filters. Built-in filters are named by keywords, +given below. User-defined filters are possible, however. See notes on the +deffilter directive below. + +Built-in filters: + +.IP :to_html +Filter text to HTML, representing special characters using HTML +ampersand sequences. For instance '>' is replaced by '>'. + +.IP :from_html +Filter text with HTML codes into text in which the codes are replaced by the +corresponding characters. For instance '>' is replaced by '>'. + +.IP :upcase +Convert the 26 lower case letters of the English alphabet to upper case. + +.IP :downcase +Convert the 26 upper case letters of the English alphabet to lower case. -To escape HTML characters in all variable substitutions occuring in -an output clause, specify :filter :to_html in the directive: +Example: to escape HTML characters in all variable substitutions occuring in an +output clause, specify :filter :to_html in the directive: @(output :filter :to_html) ... |