Record-delimiting stream adapter.

* regex.c (read_until_match): New function.
(regex_init): Registered read-until-match intrinsic.

* regex.h (read_until_match): Declared.

* stream.c (struct delegate_base): New struct type.
(delegate_base_mark, delegate_put_string, delegate_put_char,
delegate_put_byte, delegate_get_char, delegate_get_byte,
delegate_unget_char, delegate_unget_byte, delegate_close,
delegate_flush, delegate_seek, delegate_truncate,
delegate_get_prop, delegate_set_prop, delegate_get_error,
delegate_get_error_str, delegate_clear_error,
make_delegate_stream): New static functions.
(struct record_adapter_base): New struct type.
(record_adapter_base_mark, record_adapter_mark_op,
record_adapter_get_line): New static functions.
(record_adapter_ops): New static structure.
(record_adapter): New function.
(stream_init): Registered record-adapter intrinsic.

* stream.h (record_adapter): Declared.

* txr.1: Documented read-until-match and record-adapter.

1 files changed, 41 insertions, 0 deletions

diff --git a/regex.c b/regex.c
index 87239806..a1294ca9 100644
--- a/regex.c
+++ b/regex.c
@@ -2502,6 +2502,46 @@ val match_regst_right(val str, val regex, val end)
                       sub_str(str, minus(end, len), end)));
 }
 
+val read_until_match(val regex, val stream)
+{
+  regex_machine_t regm;
+  val out = nil;
+  val ch;
+
+  stream = default_arg(stream, std_input);
+
+  regex_machine_init(&regm, regex);
+
+  if ((ch = get_char(stream))) {
+    if (regex_machine_feed(&regm, c_chr(ch)) == REGM_FAIL) {
+      out = mkstring(one, ch);
+
+      while (ch && (ch = get_char(stream))) {
+        regex_machine_reset(&regm);
+
+        if (regex_machine_feed(&regm, c_chr(ch)) == REGM_FAIL) {
+          string_extend(out, ch);
+          continue;
+        }
+
+        break;
+      }
+    } else {
+      out = mkstring(zero, ch);
+    }
+  }
+
+  while (ch && (ch = get_char(stream))) {
+    if (regex_machine_feed(&regm, c_chr(ch)) == REGM_FAIL) {
+      unget_char(ch, stream);
+      break;
+    }
+  }
+
+  regex_machine_cleanup(&regm);
+  return out;
+}
+
 static char_set_t *create_wide_cs(void)
 {
 #ifdef FULL_UNICODE
@@ -2583,5 +2623,6 @@ void regex_init(void)
   reg_fun(intern(lit("reg-expand-nongreedy"), system_package),
           func_n1(reg_expand_nongreedy));
   reg_fun(intern(lit("reg-optimize"), system_package), func_n1(reg_optimize));
+  reg_fun(intern(lit("read-until-match"), user_package), func_n2o(read_until_match, 1));
   init_special_char_sets();
 }