diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2012-01-26 12:26:16 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2012-01-26 12:26:16 -0800 |
commit | b58791b726228b97297cc4512476f6016b9346a2 (patch) | |
tree | 2ed1b157bb29f6f90c97565adac4b2d54c2e1912 | |
parent | b7aae46f879bfc8a43781a08aaef9f506f7211bf (diff) | |
download | txr-b58791b726228b97297cc4512476f6016b9346a2.tar.gz txr-b58791b726228b97297cc4512476f6016b9346a2.tar.bz2 txr-b58791b726228b97297cc4512476f6016b9346a2.zip |
* eval.c (dwim_loc, dwim_op): Eliminated redundant re-evaluation
of range arguments. They are already evaluated since the cons
expression is evaluates as part of the dwim arglist.
Replaced some open code with function calls to the new listref
and listref_l functions.
(tostring, tostringp): made extern and moved to lib.c.
* lib.c (listref, listref_l): New functions.
(tostring, tostringp): moved here from eval.c.
* lib.h (listref, listref_l, tostring, tostringp): Declared.
* match.c (format_field): Handle index and range references.
* txr.1: Documented new output variable syntax.
-rw-r--r-- | ChangeLog | 18 | ||||
-rw-r--r-- | eval.c | 44 | ||||
-rw-r--r-- | lib.c | 37 | ||||
-rw-r--r-- | lib.h | 6 | ||||
-rw-r--r-- | match.c | 59 | ||||
-rw-r--r-- | txr.1 | 38 |
6 files changed, 146 insertions, 56 deletions
@@ -1,3 +1,21 @@ +2012-01-26 Kaz Kylheku <kaz@kylheku.com> + + * eval.c (dwim_loc, dwim_op): Eliminated redundant re-evaluation + of range arguments. They are already evaluated since the cons + expression is evaluates as part of the dwim arglist. + Replaced some open code with function calls to the new listref + and listref_l functions. + (tostring, tostringp): made extern and moved to lib.c. + + * lib.c (listref, listref_l): New functions. + (tostring, tostringp): moved here from eval.c. + + * lib.h (listref, listref_l, tostring, tostringp): Declared. + + * match.c (format_field): Handle index and range references. + + * txr.1: Documented new output variable syntax. + 2012-01-25 Kaz Kylheku <kaz@kylheku.com> * eval.c (dwim_loc): Handles full responsibility for assigning @@ -663,14 +663,11 @@ static val *dwim_loc(val form, val env, val op, val newval) val index = first(args); if (consp(index)) { - val from = eval(car(index), env, form); - val to = eval(cdr(index), env, form); - if (op != set_s) eval_error(form, lit("[~s ~s]: slice takes only simple assignments"), obj, index, nao); - replace_vec(obj, from, to, newval); + replace_vec(obj, car(index), cdr(index), newval); return 0; } else { return vecref_l(obj, first(args)); @@ -685,15 +682,8 @@ static val *dwim_loc(val form, val env, val op, val newval) val index = first(args); val cell = obj; if (bignump(index) || fixnump(index)) { - for (; gt(index, zero); index = minus(index, one)) - cell = cdr(cell); - if (lt(index, zero) || !cell) - eval_error(form, lit("[~s ~s]: cannot assign nonexistent location"), - cell, first(args), nao); - return car_l(cell); + return listref_l(obj, index); } else if (consp(index)) { - val from = eval(car(index), env, form); - val to = eval(cdr(index), env, form); val newlist; val tempform; @@ -701,7 +691,7 @@ static val *dwim_loc(val form, val env, val op, val newval) eval_error(form, lit("[~s ~s]: slice takes only simple assignments"), cell, index, nao); - newlist = replace_list(obj, from, to, newval); + newlist = replace_list(obj, car(index), cdr(index), newval); tempform = list(op, second(form), cons(quote_s, cons(newlist, nil)), nao); eval(tempform, env, form); @@ -947,9 +937,7 @@ static val op_dwim(val form, val env) val index = first(args); if (consp(index)) { - val from = eval(car(index), env, form); - val to = eval(cdr(index), env, form); - return sub_vec(obj, from, to); + return sub_vec(obj, car(index), cdr(index)); } else { return vecref(obj, first(args)); } @@ -966,15 +954,9 @@ static val op_dwim(val form, val env) obj, index, nao); if (consp(index)) { - val from = eval(car(index), env, form); - val to = eval(cdr(index), env, form); - return sub_list(obj, from, to); + return sub_list(obj, car(index), cdr(index)); } else { - if (lt(index, zero)) - return nil; - for (; gt(index, zero); index = minus(index, one)) - obj = cdr(obj); - return car(obj); + return listref(obj, first(args)); } } case COBJ: @@ -1500,20 +1482,6 @@ static val lazy_mappendv(val fun, val list_of_lists) return lazy_appendv(lazy_mapcarv(fun, list_of_lists)); } -static val tostring(val obj) -{ - val ss = make_string_output_stream(); - obj_print(obj, ss); - return get_string_from_stream(ss); -} - -static val tostringp(val obj) -{ - val ss = make_string_output_stream(); - obj_pprint(obj, ss); - return get_string_from_stream(ss); -} - static val symbol_function(val sym) { return lookup_fun(nil, sym); @@ -307,6 +307,29 @@ val sixth(val cons) return car(cdr(cdr(cdr(cdr(cdr(cons)))))); } +val listref(val list, val ind) +{ + if (lt(ind, zero)) + return nil; + for (; gt(ind, zero); ind = minus(ind, one)) + list = cdr(list); + return car(list); +} + +val *listref_l(val list, val ind) +{ + val olist = list; + val oind = ind; + + for (; gt(ind, zero) && list; ind = minus(ind, one)) + list = cdr(list); + if (consp(list)) + return car_l(list); + + uw_throwf(error_s, lit("~s has no assignable location at ~s"), + olist, oind, nao); +} + val *tail(val cons) { while (cdr(cons)) @@ -3793,6 +3816,20 @@ val obj_pprint(val obj, val out) return obj; } +val tostring(val obj) +{ + val ss = make_string_output_stream(); + obj_print(obj, ss); + return get_string_from_stream(ss); +} + +val tostringp(val obj) +{ + val ss = make_string_output_stream(); + obj_pprint(obj, ss); + return get_string_from_stream(ss); +} + void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t), val *stack_bottom) { @@ -324,6 +324,8 @@ val third(val cons); val fourth(val cons); val fifth(val cons); val sixth(val cons); +val listref(val list, val ind); +val *listref_l(val list, val ind); val *tail(val cons); val *ltail(val *cons); val pop(val *plist); @@ -554,9 +556,11 @@ val find(val list, val key, val testfun, val keyfun); val set_diff(val list1, val list2, val testfun, val keyfun); val length(val seq); val env(void); - val obj_print(val obj, val stream); val obj_pprint(val obj, val stream); +val tostring(val obj); +val tostringp(val obj); + void init(const wchar_t *progname, mem_t *(*oom_realloc)(mem_t *, size_t), val *stack_bottom); void dump(val obj, val stream); @@ -1206,33 +1206,60 @@ static val match_line(match_line_ctx c) debug_leave; } -val format_field(val string_or_list, val modifier, val filter, val eval_fun) +val format_field(val obj, val modifier, val filter, val eval_fun) { - val n = zero; + val n = zero, sep = lit(" "); val plist = nil; - - if (!stringp(string_or_list)) - return string_or_list; + val str; for (; modifier; pop(&modifier)) { val item = first(modifier); - if (regexp(item)) + if (regexp(item)) { uw_throw(query_error_s, lit("format_field: regex modifier in output")); - if (keywordp(item)) { + } else if (keywordp(item)) { plist = modifier; break; - } + } else if (consp(item)) { + if (car(item) == dwim_s) { + val arg_expr = second(item); - { + if (consp(arg_expr) && car(arg_expr) == cons_s) { + val from = funcall1(eval_fun, second(arg_expr)); + val to = funcall1(eval_fun, third(arg_expr)); + + obj = if3((vectorp(obj)), + sub_vec(obj, from, to), + sub_list(obj, from, to)); + } else { + val arg = funcall1(eval_fun, arg_expr); + if (bignump(arg) || fixnump(arg)) { + if (vectorp(obj)) + obj = vecref(obj, arg); + else + obj = listref(obj, arg); + } else { + uw_throwf(query_error_s, lit("format_field: bad index: ~s"), + arg, nao); + } + } + } + } else { val v = funcall1(eval_fun, item); if (fixnump(v)) n = v; + else if (stringp(v)) + sep = v; else uw_throwf(query_error_s, lit("format_field: bad modifier object: ~s"), item, nao); } } + if (listp(obj)) + str = cat_str(mapcar(func_n1(tostringp), obj), sep); + else + str = if3(stringp(obj), obj, tostringp(obj)); + { val filter_sym = getplist(plist, filter_k); @@ -1246,27 +1273,27 @@ val format_field(val string_or_list, val modifier, val filter, val eval_fun) } if (filter) - string_or_list = filter_string(filter, cat_str(list(string_or_list, nao), + str = filter_string(filter, cat_str(list(str, nao), nil)); } { val right = lt(n, zero); val width = if3(lt(n, zero), neg(n), n); - val diff = minus(width, length_str(string_or_list)); + val diff = minus(width, length_str(str)); if (le(diff, zero)) - return string_or_list; + return str; - if (ge(length_str(string_or_list), width)) - return string_or_list; + if (ge(length_str(str), width)) + return str; { val padding = mkstring(diff, chr(' ')); return if3(right, - cat_str(list(padding, string_or_list, nao), nil), - cat_str(list(string_or_list, padding, nao), nil)); + cat_str(list(padding, str, nao), nil), + cat_str(list(str, padding, nao), nil)); } } } @@ -1046,7 +1046,10 @@ into the literal template. If a is bound to "apple" and b to "banana", the quasiliteral `one@a and two @{b}s` represents the string "one apple and two bananas". A backquote escaped by a backslash represents itself, and two consecutive @ characters code for a literal @. -There is no \e@ escape. +There is no \e@ escape. Quasiliterals support the full output variable +syntax. Expressions within variables substitutions follow the evaluation rules +of TXR Lisp when the quasiliteral occurs in TXR Lisp, and the rules of +the TXR pattern language when the quasiliteral occurs in the pattern language. .SS Numbers @@ -3318,6 +3321,39 @@ for the output clause. The syntax for this is @(NAME :filter <filterspec>}. The filter specification syntax is the same as in the output clause. See Output Filtering below. +Additional syntax is supported in output variables that is does not appear +in pattern matching variables. + +A square bracket index notation may be used to extract elements from a variable +which is a list, or to extract ranges. Elements are indexed from zero. This +notation is only available in brace-enclosed syntax, and looks like this: + +.IP +@{NAME[expr]) + +Extract the element at the position given by expr. + +.IP +@{NAME[expr1..expr2]) + +Extract a list of elements from the position given by expr1, up to +one position less than the position given by expr2. +The elements from the range are catenated together to form a single string, +with a separator character in between. The default character is a space. +An alternate character may be given as a string argument. + +.TP +Example: + + @(bind a ("a" "b" "c" "d")) + @(output) + @{a[1..3] "," 10} + @(end) + +The above produces the text "b,c" in a field 10 spaces wide. The [1..3] +argument extracts a range of a; the "," argument specifies an alternate +separator string, and 10 specifies the field width. + .SS The Repeat Directive The repeat directive is generates repeated text from a ``boilerplate'', |