New internal function scat: variable arg cat_str.

Avoids consing up list of strings.

* lib.c (vscat): New static function.
(scat): New function.
(lazy_str): Use scat instead of cat_str.

* lib.h (scat): Declared.

* eval.c (format_field): Use scat instead of cat_str.

* parser.c (open_txr_file, read_eval_stream): Likewise.

4 files changed, 88 insertions, 7 deletions

diff --git a/eval.c b/eval.c
index bc509986..0cd8087d 100644
--- a/eval.c
+++ b/eval.c
@@ -2221,8 +2221,8 @@ val format_field(val obj, val modifier, val filter, val eval_fun)
       val padding = mkstring(diff, chr(' '));
 
       return if3(right,
-                 cat_str(list(padding, str, nao), nil),
-                 cat_str(list(str, padding, nao), nil));
+                 scat(nil, padding, str, nao),
+                 scat(nil, str, padding, nao));
     }
   }
 }
diff --git a/lib.c b/lib.c
index 2c2e55a1..aac7d146 100644
--- a/lib.c
+++ b/lib.c
@@ -3419,6 +3419,86 @@ oflow:
   uw_throwf(error_s, lit("cat-str: string length overflow"), nao);
 }
 
+static val vscat(val sep, va_list vl1, va_list vl2)
+{
+  cnum total = 0;
+  val item, next;
+  wchar_t *str, *ptr;
+  cnum len_sep = (!null_or_missing_p(sep)) ? c_num(length_str(sep)) : 0;
+
+  for (item = va_arg(vl1, val); item != nao; item = next)
+  {
+    next = va_arg(vl1, val);
+
+    if (stringp(item)) {
+      cnum ntotal = total + c_num(length_str(item));
+
+      if (len_sep && next != nao)
+        ntotal += len_sep;
+
+      if (ntotal < total)
+        goto oflow;
+
+      total = ntotal;
+
+      continue;
+    }
+    if (chrp(item)) {
+      cnum ntotal = total + 1;
+
+      if (len_sep && next != nao)
+        ntotal += len_sep;
+
+      if (ntotal < total)
+        goto oflow;
+
+      total = ntotal;
+
+      continue;
+    }
+    uw_throwf(error_s, lit("cat-str: ~s is not a character or string"),
+              item, nao);
+  }
+
+  str = chk_wmalloc(total + 1);
+
+  for (ptr = str, item = va_arg(vl2, val); item != nao; item = next)
+  {
+    next = va_arg(vl2, val);
+
+    if (stringp(item)) {
+      cnum len = c_num(length_str(item));
+      wmemcpy(ptr, c_str(item), len);
+      ptr += len;
+    } else {
+      *ptr++ = c_chr(item);
+    }
+
+    if (len_sep && next != nao) {
+      wmemcpy(ptr, c_str(sep), len_sep);
+      ptr += len_sep;
+    }
+  }
+  *ptr = 0;
+
+  return string_own(str);
+
+oflow:
+  uw_throwf(error_s, lit("vcat: string length overflow"), nao);
+}
+
+val scat(val sep, ...)
+{
+  va_list vl1, vl2;
+  val ret;
+  va_start (vl1, sep);
+  va_start (vl2, sep);
+  ret = vscat(sep, vl1, vl2);
+  va_end (vl1);
+  va_end (vl2);
+  return ret;
+}
+
 val split_str(val str, val sep)
 {
   if (regexp(sep)) {
@@ -6119,12 +6199,12 @@ val lazy_str(val lst, val term, val limit)
     obj->ls.prefix = null_string;
     obj->ls.list = nil;
   } else {
-    set(mkloc(obj->ls.prefix, obj), cat_str(list(first(lst), term, nao), nil));
+    val prefix = scat(nil, first(lst), term, nao);
+    set(mkloc(obj->ls.prefix, obj), prefix);
     set(mkloc(obj->ls.list, obj), rest(lst));
     limit = if2(limit, minus(limit, one));
   }
 
-
   set(mkloc(obj->ls.props->term, obj), term);
   set(mkloc(obj->ls.props->limit, obj), limit);
 
diff --git a/lib.h b/lib.h
index 93ab96bb..1959eb06 100644
--- a/lib.h
+++ b/lib.h
@@ -692,6 +692,7 @@ val match_str_tree(val bigstr, val tree, val pos);
 val replace_str(val str_in, val items, val from, val to);
 val sub_str(val str_in, val from_num, val to_num);
 val cat_str(val list, val sep);
+val scat(val sep, ...);
 val split_str(val str, val sep);
 val split_str_set(val str, val set);
 val tok_str(val str, val tok_regex, val keep_sep);
diff --git a/parser.c b/parser.c
index 95f61012..fe5527b2 100644
--- a/parser.c
+++ b/parser.c
@@ -235,7 +235,7 @@ void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
 #endif
 
     if (suffix == none && in == 0 && !*txr_lisp_p) {
-      spec_file_try = cat_str(list(spec_file, lit("txr"), nao), lit("."));
+      spec_file_try = scat(lit("."), spec_file, lit("txr"), nao);
       in = w_fopen(c_str(spec_file_try), L"r");
 #ifdef ENOENT
       if (in == 0 && errno != ENOENT)
@@ -246,7 +246,7 @@ void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
 
 
     if (suffix == none && in == 0) {
-      spec_file_try = cat_str(list(spec_file, lit("tl"), nao), lit("."));
+      spec_file_try = scat(lit("."), spec_file, lit("tl"), nao);
       in = w_fopen(c_str(spec_file_try), L"r");
       *txr_lisp_p = t;
     }
@@ -369,7 +369,7 @@ val read_eval_stream(val stream, val error_stream, val hash_bang_support)
     val firstline = get_line(stream);
 
     if (firstline && !match_str(firstline, lit("#!"), nil)) {
-      val flwnl = cat_str(list(firstline, lit("\n"), nao), nil);
+      val flwnl = scat(nil, firstline, lit("\n"), nao);
       val string_stream = make_string_byte_input_stream(flwnl);
       stream = make_catenated_stream(list(string_stream, stream, nao));
     }