* stream.c (catenated_stream_p, catenated_stream_push): New functions.

* stream.h (catenated_stream_p, catenated_stream_push): Declared.

4 files changed, 76 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 8c0eaacb..466eadab 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2015-06-07  Kaz Kylheku  <kaz@kylheku.com>
+
+	* stream.c (catenated_stream_p, catenated_stream_push): New functions.
+	(stream_init): Registered new functions as intrinsics.
+
+	* stream.h (catenated_stream_p, catenated_stream_push): Declared.
+
+	* txr.1: Documented catenated-stream-p and catenated-stream-push.
+
 2015-05-25  Kaz Kylheku  <kaz@kylheku.com>
 
 	* txr.1: Document new syntactic places framework and place-mutating macros.
diff --git a/stream.c b/stream.c
index 7187749a..9c074ce2 100644
--- a/stream.c
+++ b/stream.c
@@ -2787,6 +2787,28 @@ val make_catenated_stream(val stream_list)
   return cobj(coerce(mem_t *, stream_list), stream_s, &cat_stream_ops.cobj_ops);
 }
 
+val catenated_stream_p(val obj)
+{
+  return if2(streamp(obj),
+             c_true(obj->co.ops == &cat_stream_ops.cobj_ops));
+}
+
+val catenated_stream_push(val new_stream, val cat_stream)
+{
+  type_assert (streamp(new_stream),
+               (lit("~a is not a stream"), new_stream, nao));
+  type_assert (catenated_stream_p(cat_stream),
+               (lit("~a is not a stream"), cat_stream, nao));
+
+  {
+    val streams = coerce(val, cat_stream->co.handle);
+    loc l = mkloc(streams, cat_stream);
+    set(l, cons(new_stream, streams));
+    cat_stream->co.handle = coerce(mem_t *, deref(l));
+    return nil;
+  }
+}
+
 val remove_path(val path)
 {
   if (w_remove(c_str(path)) < 0)
@@ -2923,6 +2945,8 @@ void stream_init(void)
   reg_fun(intern(lit("fileno"), user_package), curry_12_1(func_n2(stream_get_prop), fd_k));
   reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream));
   reg_fun(intern(lit("cat-streams"), user_package), func_n1(make_catenated_stream));
+  reg_fun(intern(lit("catenated-stream-p"), user_package), func_n1(catenated_stream_p));
+  reg_fun(intern(lit("catenated-stream-push"), user_package), func_n2(catenated_stream_push));
   reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory));
   reg_fun(intern(lit("open-file"), user_package), func_n2o(open_file, 1));
   reg_fun(intern(lit("open-fileno"), user_package), func_n2o(open_fileno, 1));
diff --git a/stream.h b/stream.h
index 910cdaec..ed947577 100644
--- a/stream.h
+++ b/stream.h
@@ -122,6 +122,8 @@ val open_tail(val path, val mode_str, val seek_end_p);
 val open_command(val path, val mode_str);
 val open_process(val path, val mode_str, val args);
 val make_catenated_stream(val stream_list);
+val catenated_stream_p(val obj);
+val catenated_stream_push(val new_stream, val cat_stream);
 val remove_path(val path);
 val rename_path(val from, val to);
 val abs_path_p(val path);
diff --git a/txr.1 b/txr.1
index c9dc6127..1e831090 100644
--- a/txr.1
+++ b/txr.1
@@ -24304,6 +24304,47 @@ and
 .code unget-byte
 operations throw an exception.
 
+.coNP Function @ catenated-stream-p
+.synb
+.mets (catenated-stream-p << obj )
+.syne
+.desc
+The
+.code catenated-stream-p
+function returns
+.code t
+if
+.meta obj
+is a catenated stream. Otherwise it returns
+.codn nil .
+
+.coNP Function @ catenated-stream-push
+.synb
+.mets (catenated-stream-push < new-stream << cat-stream )
+.syne
+.desc
+The
+.code catenated-stream-push
+function pushes
+.meta new-stream
+to the front of the stream list inside
+.metn cat-stream .
+
+If an
+.code unget-byte
+or
+.code unget-char
+operation was successfully performed on
+.meta cat-stream
+previously to a call to
+.codn catenated-stream-push ,
+those operations were forwarded to the front stream.
+If those bytes or characters are still pending,
+they are pending inside that stream, and thus
+are logically preceded by the contents
+of
+.metn new-stream .
+
 .coNP Functions @ open-files and @ open-files*
 .synb
 .mets (open-files < path-list <> [ alternative-stream ])