summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2012-01-26 12:26:16 -0800
committerKaz Kylheku <kaz@kylheku.com>2012-01-26 12:26:16 -0800
commitb58791b726228b97297cc4512476f6016b9346a2 (patch)
tree2ed1b157bb29f6f90c97565adac4b2d54c2e1912
parentb7aae46f879bfc8a43781a08aaef9f506f7211bf (diff)
downloadtxr-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--ChangeLog18
-rw-r--r--eval.c44
-rw-r--r--lib.c37
-rw-r--r--lib.h6
-rw-r--r--match.c59
-rw-r--r--txr.138
6 files changed, 146 insertions, 56 deletions
diff --git a/ChangeLog b/ChangeLog
index 88db7899..ee0d422e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
diff --git a/eval.c b/eval.c
index 613359a4..8d83f37d 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
diff --git a/lib.c b/lib.c
index 78e77f57..e71b87cd 100644
--- a/lib.c
+++ b/lib.c
@@ -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)
{
diff --git a/lib.h b/lib.h
index fda6a9fc..f079dd25 100644
--- a/lib.h
+++ b/lib.h
@@ -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);
diff --git a/match.c b/match.c
index 66236781..eb6e347e 100644
--- a/match.c
+++ b/match.c
@@ -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));
}
}
}
diff --git a/txr.1 b/txr.1
index 3853fe7f..ff427fc8 100644
--- a/txr.1
+++ b/txr.1
@@ -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'',