summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--match.c46
-rw-r--r--txr.139
3 files changed, 95 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog
index 8ae63b4b..086be220 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
2011-10-21 Kaz Kylheku <kaz@kylheku.com>
+ Implementing @(set) directive for assigning to variables
+ destructively.
+
+ * match.c (dest_set, v_set): New static functions.
+ (dir_tables_init): Add v_set to vertical directives hash table.
+
+ * txr.1: Documented.
+
+2011-10-21 Kaz Kylheku <kaz@kylheku.com>
+
* match.c (v_output): When appending output to a variable,
flatten the previous contents so we can append to a single
string, or to deeply nested list, etc.
diff --git a/match.c b/match.c
index a2bc8eb3..1d415ac5 100644
--- a/match.c
+++ b/match.c
@@ -233,6 +233,37 @@ static val bindable(val obj)
return (obj && symbolp(obj) && obj != t && !keywordp(obj)) ? t : nil;
}
+static val dest_set(val linenum, val bindings, val pattern, val value)
+{
+ if (symbolp(pattern)) {
+ val existing = assoc(bindings, pattern);
+ if (!bindable(pattern))
+ sem_error(linenum, lit("~s cannot be used as a variable"), pattern, nao);
+ if (!existing)
+ sem_error(linenum, lit("cannot set unbound variable ~s"), pattern, nao);
+ *cdr_l(existing) = value;
+ } else if (consp(pattern)) {
+ if (first(pattern) == var_s) {
+ uw_throwf(query_error_s,
+ lit("metavariable @~a syntax cannot be used here"),
+ second(pattern), nao);
+ }
+
+ if (first(pattern) == expr_s) {
+ uw_throwf(query_error_s,
+ lit("the @~s syntax cannot be used here"),
+ rest(pattern), nao);
+ }
+ dest_set(linenum, bindings, car(pattern), car(value));
+ if (cdr(pattern))
+ dest_set(linenum, bindings, cdr(pattern), cdr(value));
+ } else {
+ sem_error(linenum, lit("cannot set ~s: not a variable"), pattern, nao);
+ }
+
+ return nil;
+}
+
static val dest_bind(val linenum, val bindings, val pattern, val value)
{
if (symbolp(pattern)) {
@@ -2095,6 +2126,20 @@ static val v_bind(match_files_ctx c, match_files_ctx *cout)
return next_spec_k;
}
+static val v_set(match_files_ctx c, match_files_ctx *cout)
+{
+ spec_bind (specline, spec_linenum, first_spec, c.spec);
+ val args = rest(first_spec);
+ val pattern = first(args);
+ val form = second(args);
+ val val = eval_form(spec_linenum, form, c.bindings);
+
+ dest_set(spec_linenum, c.bindings, pattern, cdr(val));
+
+ *cout = c;
+ return next_spec_k;
+}
+
static val v_cat(match_files_ctx c, match_files_ctx *cout)
{
spec_bind (specline, spec_linenum, first_spec, c.spec);
@@ -2692,6 +2737,7 @@ static void dir_tables_init(void)
sethash(v_directive_table, local_s, cptr((mem_t *) v_forget_local));
sethash(v_directive_table, merge_s, cptr((mem_t *) v_merge));
sethash(v_directive_table, bind_s, cptr((mem_t *) v_bind));
+ sethash(v_directive_table, set_s, cptr((mem_t *) v_set));
sethash(v_directive_table, cat_s, cptr((mem_t *) v_cat));
sethash(v_directive_table, output_s, cptr((mem_t *) v_output));
sethash(v_directive_table, define_s, cptr((mem_t *) v_define));
diff --git a/txr.1 b/txr.1
index 8e6ef97d..9b47039c 100644
--- a/txr.1
+++ b/txr.1
@@ -1053,6 +1053,11 @@ Binds one or more variables against another variable using a structural
pattern. A limited form of unification takes place which can cause a match to
fail.
+.IP @(set)
+Destructively assigns one or more existing variables using a structural
+pattern, using syntax similar to bind. Assignment to unbound
+variables triggers an error.
+
.IP @(output)
A directive which encloses an output clause in the query. An output section
does not match text, but produces text. The directives above are not
@@ -2091,6 +2096,40 @@ 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 The Set Directive
+
+The @(set) directive resembles bind, but is not a pattern match. It overwrites
+the previous values of variables with new values from the right hand side.
+Each variable that is assigned must have an existing binding.
+
+Examples follow.
+
+Store the value of A back into A, achieving nothing:
+
+ @(set A A)
+
+Exchange the values of A and B:
+
+ @(set (A B) (B A))
+
+Store a string into A:
+
+ @(set A "text")
+
+Store a list into A:
+
+ @(set A ("line1" "line2"))
+
+Destructuring assignment. D assumed to contain the list
+
+ @(bind D ("A" ("B1" "B2") "C1" "C2"))
+ @(bind (A B C) (() () ()))
+ @(set (A B . C) D)
+
+A ends up with "A", B ends up with ("B1" "B2") and C gets ("C1" and "C2").
+
+
.SH BLOCKS
.SS Introduction