Task #11433. Implement continuation of multiple

output blocks across the same stream.

* match.c (close_s, named_k, continue_k, finish_k): New symbol
variables.
(v_output): Implement :named, :finish and :continue.
(v_close): New static function.
(syms_init): New symbols interned.
(dir_tables_init): New entry associating v_close
function with symbol stored in close_s.

* match.h (close_s): Declared.

* txr.1: New features documented.

4 files changed, 148 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 32baa7f5..6fcbe474 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2013-10-11  Kaz Kylheku  <kaz@kylheku.com>
 
+	Task #11433. Implement continuation of multiple
+	output blocks across the same stream.
+
+	* match.c (close_s, named_k, continue_k, finish_k): New symbol
+	variables.
+	(v_output): Implement :named, :finish and :continue.
+	(v_close): New static function.
+	(syms_init): New symbols interned.
+	(dir_tables_init): New entry associating v_close
+	function with symbol stored in close_s.
+
+	* match.h (close_s): Declared.
+
+	* txr.1: New features documented.
+
+2013-10-11  Kaz Kylheku  <kaz@kylheku.com>
+
 	* txr.1: Fix reversed arguments in documentation for time-string-local
 	* and time-string-utc.
 
diff --git a/match.c b/match.c
index c692dbf8..0cd4da50 100644
--- a/match.c
+++ b/match.c
@@ -55,10 +55,11 @@ val decline_k, next_spec_k, repeat_spec_k;
 val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
 val text_s, choose_s, gather_s, do_s, mod_s, modlast_s, fuzz_s, load_s;
-val require_s;
+val close_s, require_s;
 val longest_k, shortest_k, greedy_k;
 val vars_k, resolve_k;
 val append_k, into_k, var_k, list_k, string_k, env_k, counter_k;
+val named_k, continue_k, finish_k;
 
 val filter_s;
 
@@ -3019,6 +3020,7 @@ static val v_output(match_files_ctx *c)
   val append = nil;
   val dest = lit("-");
   val filter = nil;
+  val named_var = nil, continue_expr = nil, finish_expr = nil;
   val alist;
   fpip_t fp;
 
@@ -3037,6 +3039,18 @@ static val v_output(match_files_ctx *c)
 
   nothrow = cdr(assoc(nothrow_k, alist));
   append = cdr(assoc(append_k, alist));
+  named_var = cdr(assoc(named_k, alist));
+  continue_expr = cdr(assoc(continue_k, alist));
+  finish_expr = cdr(assoc(finish_k, alist));
+
+  if (named_var && continue_expr)
+    sem_error(specline, lit(":continue and :named are mutually exclusive"), nao);
+
+  if (named_var && finish_expr)
+    sem_error(specline, lit(":named and :finish are mutually exclusive"), nao);
+
+  if (continue_expr && finish_expr)
+    sem_error(specline, lit(":continue and :finish are mutually exclusive"), nao);
 
   {
     val filter_sym = cdr(assoc(filter_k, alist));
@@ -3058,6 +3072,12 @@ static val v_output(match_files_ctx *c)
       if (!symbolp(into_var)) 
         sem_error(specline, lit(":into requires a variable, not ~s"), into_var, nao);
 
+      if (named_var)
+        sem_error(specline, lit(":into incompatible with :named"), nao);
+
+      if (continue_expr)
+        sem_error(specline, lit(":into incompatible with :continue"), nao);
+
       debuglf(specline, lit("opening string list stream"), nao);
       uw_env_begin;
       uw_set_match_context(cons(c->spec, c->bindings));
@@ -3083,6 +3103,25 @@ static val v_output(match_files_ctx *c)
     }
   }
 
+  if (continue_expr || finish_expr) {
+    uses_or2;
+    val which = or2(continue_expr, finish_expr);
+    val stream = txeval(specline, which, c->bindings);
+
+
+    if (!streamp(stream))
+      sem_error(specline, lit("~s evaluated to ~s which is not a stream"), which, stream, nao);
+
+    uw_env_begin;
+    uw_set_match_context(cons(c->spec, c->bindings));
+    do_output(c->bindings, specs, filter, stream);
+    flush_stream(stream);
+    uw_env_end;
+    if (finish_expr)
+      close_stream(stream, t);
+    return next_spec_k;
+  }
+
   fp = (errno = 0, complex_open(dest, t, append));
 
   debuglf(specline, lit("opening data sink ~a"), dest, nao);
@@ -3105,7 +3144,11 @@ static val v_output(match_files_ctx *c)
     do_output(c->bindings, specs, filter, stream);
     flush_stream(stream);
     uw_env_end;
-    close_stream(stream, t);
+
+    if (named_var)
+      c->bindings = acons(named_var, stream, c->bindings);
+    else
+      close_stream(stream, t);
   }
 
   return next_spec_k;
@@ -3558,6 +3601,23 @@ static val v_load(match_files_ctx *c)
   }
 }
 
+static val v_close(match_files_ctx *c)
+{
+  spec_bind (specline, first_spec, c->spec);
+  val args = rest(first_spec);
+  val stream = txeval(specline, first(args), c->bindings);
+
+  if (rest(specline))
+    sem_error(specline, lit("unexpected material after close"), nao);
+
+  if (!streamp(stream))
+    sem_error(specline, lit("close: ~s is not a stream"), stream, nao);
+
+  close_stream(stream, t);
+  return next_spec_k;
+}
+
+
 static val h_do(match_line_ctx *c)
 {
   val elem = first(c->specline);
@@ -3778,6 +3838,7 @@ static void syms_init(void)
   gather_s = intern(lit("gather"), user_package);
   do_s = intern(lit("do"), user_package);
   load_s = intern(lit("load"), user_package);
+  close_s = intern(lit("close"), user_package);
   require_s = intern(lit("require"), user_package);
   longest_k = intern(lit("longest"), keyword_package);
   shortest_k = intern(lit("shortest"), keyword_package);
@@ -3790,6 +3851,9 @@ static void syms_init(void)
   list_k = intern(lit("list"), keyword_package);
   string_k = intern(lit("string"), keyword_package);
   env_k = intern(lit("env"), keyword_package);
+  named_k = intern(lit("named"), keyword_package);
+  continue_k = intern(lit("continue"), keyword_package);
+  finish_k = intern(lit("finish"), keyword_package);
 
   filter_s = intern(lit("filter"), user_package);
   noval_s = intern(lit("noval"), system_package);
@@ -3843,6 +3907,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, do_s, cptr((mem_t *) v_do));
   sethash(v_directive_table, require_s, cptr((mem_t *) v_require));
   sethash(v_directive_table, load_s, cptr((mem_t *) v_load));
+  sethash(v_directive_table, close_s, cptr((mem_t *) v_close));
 
   sethash(h_directive_table, text_s, cptr((mem_t *) h_text));
   sethash(h_directive_table, var_s, cptr((mem_t *) h_var));
diff --git a/match.h b/match.h
index 83e1e0ad..1c7caf09 100644
--- a/match.h
+++ b/match.h
@@ -25,7 +25,7 @@
  */
 
 extern val text_s, choose_s, gather_s, do_s, require_s;
-extern val load_s, mod_s, modlast_s, counter_k;
+extern val close_s, load_s, mod_s, modlast_s, counter_k;
 val format_field(val string_or_list, val modifier, val filter, val eval_fun);
 val match_filter(val name, val arg, val other_args);
 val match_fun(val name, val args, val input, val files);
diff --git a/txr.1 b/txr.1
index b9f9c0da..49d235c4 100644
--- a/txr.1
+++ b/txr.1
@@ -3537,7 +3537,7 @@ usual printing of the variable bindings or the word false.
 
 The syntax of the @(output) directive is:
 
-  @(output [ DESTINATION ] { bool-keyword | keyword value }* )
+  @(output [ <destination> ] { bool-keyword | keyword value }* )
   .
   . one or more output directives or lines
   .
@@ -3590,6 +3590,35 @@ the new content will be appened to the previous content of
 the variable, after flattening the content to a list,
 as if by the @(flatten) directive.
 
+.IP :named 
+
+The argument of :named is a symbol which denotes a variable.
+The file or pipe stream which is opened for the output is
+stored in this variable, and is not closed at the end of the
+output block. This allows a subsequent output block to continue
+output on the same stream, which is possible using the
+next two keywords, :continue or :finish.
+A new binding is established for the variable, even if it
+already has an existing binding.
+
+.IP :continue
+
+A destination should not be specified if :continue is used.  The argument of
+:continue is an expression, such as a variable name, that must evaluates to a
+stream object. That stream object is used for the output block.
+At the end of the output block, the stream is flushed, but not
+closed.  A usage example is given in the documentation for the Close Directive
+below.
+
+.IP :finish
+
+A destination should not be specified if :finish is used.  The argument of
+:continue is an expression, such as a variable name, that must evaluates to a
+stream object. That stream object is used for the output block.
+At the end of the output block, the stream is closed.
+An example is given in the documentation for the Close Directive
+below.
+
 .SS Output Text
 
 Text in an output clause is not matched against anything, but is output
@@ -3893,6 +3922,39 @@ spaces each one, except the last which has no space.
 If the list has exactly one item, then the @(last) applies to it
 instead of the main clause: it is produced with no trailing space.
 
+.SS The Close Directive
+
+The syntax of the @(close) directive is:
+
+  @(close <expr>)
+
+Where <expr> evaluates to a stream. The close directive can be
+used to explicitly close streams created using @(output ... :named <var>)
+syntax, as an alternative to the @(output :finish <expr>)
+
+Examples:
+
+Write two lines to "foo.txt" over two output blocks using
+a single stream:
+
+  @(output "foo.txt" :named foo)
+  Hello,
+  @(end)
+  @(output :continue foo)
+  world!
+  @(end)
+  @(close foo)
+
+The same as above, using :finish rather than :continue
+so that the stream is closed at the end of the second block:
+
+  @(output "foo.txt" :named foo)
+  Hello,
+  @(end)
+  @(output :finish foo)
+  world!
+  @(end)
+
 .SS Output Filtering
 
 Often it is necessary to transform the output to preserve its meaning