From 472942e65dc0816185b309ac0ba4eca2d87428f8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 7 Sep 2021 07:21:53 -0700
Subject: string-finish: new function.

* eval.c (eval_init): Register string-finish intrinsic.

* lib.c (string_finish): New function.

* lib.h (string_finish): Declared.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 eval.c             |  1 +
 lib.c              | 19 +++++++++++++++++++
 lib.h              |  1 +
 stdlib/doc-syms.tl |  1 +
 txr.1              | 20 ++++++++++++++++++++
 5 files changed, 42 insertions(+)

diff --git a/eval.c b/eval.c
index 74ab1703..def3586d 100644
--- a/eval.c
+++ b/eval.c
@@ -7144,6 +7144,7 @@ void eval_init(void)
   reg_fun(intern(lit("upcase-str"), user_package), func_n1(upcase_str));
   reg_fun(intern(lit("downcase-str"), user_package), func_n1(downcase_str));
   reg_fun(intern(lit("string-extend"), user_package), func_n3o(string_extend, 2));
+  reg_fun(intern(lit("string-finish"), user_package), func_n1(string_finish));
   reg_fun(intern(lit("stringp"), user_package), func_n1(stringp));
   reg_fun(intern(lit("lazy-stringp"), user_package), func_n1(lazy_stringp));
   reg_fun(intern(lit("length-str"), user_package), func_n1(length_str));
diff --git a/lib.c b/lib.c
index ee74ff89..cdfb5742 100644
--- a/lib.c
+++ b/lib.c
@@ -4843,6 +4843,25 @@ val string_extend(val str, val tail, val finish_in)
   return str;
 }
 
+val string_finish(val str)
+{
+  val self = lit("string-finish");
+  type_check(self, str, STR);
+
+  {
+    cnum len = c_fixnum(length_str(str), self);
+    cnum alloc = c_fixnum(str->st.alloc, self);
+
+    if (alloc > len + 1) {
+      alloc = len + 1;
+      str->st.str = chk_wrealloc(str->st.str, alloc);
+      set(mkloc(str->st.alloc, str), num_fast(alloc));
+    }
+  }
+
+  return str;
+}
+
 val stringp(val str)
 {
   switch (type(str)) {
diff --git a/lib.h b/lib.h
index 4c6993e6..19cedbf8 100644
--- a/lib.h
+++ b/lib.h
@@ -885,6 +885,7 @@ val copy_str(val str);
 val upcase_str(val str);
 val downcase_str(val str);
 val string_extend(val str, val tail, val finish);
+val string_finish(val str);
 val stringp(val str);
 val lazy_stringp(val str);
 val length_str(val str);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 8284884b..2f95f333 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1819,6 +1819,7 @@
       ("string-decode" "N-033502F8")
       ("string-encode" "N-033502F8")
       ("string-extend" "N-03D5358A")
+      ("string-finish" "N-0295275B")
       ("string-lt" "N-03ABBED1")
       ("stringp" "N-00BB392B")
       ("strsignal" "N-00234BED")
diff --git a/txr.1 b/txr.1
index 971391f3..01322a70 100644
--- a/txr.1
+++ b/txr.1
@@ -24339,6 +24339,26 @@ allocation intended to improves the performance of subsequent
 .code string-extend
 calls.
 
+.coNP Function @ string-finish
+.synb
+.mets (string-finish << string )
+.syne
+.desc
+The
+.code string-finish
+function removes excess allocation from
+.meta string
+that may have been produced by previous calls to
+.codn string-extend .
+
+Note: if the most recent call to string
+.code string-extend
+specified a true value for the
+.meta final
+parameter, then calling
+.code string-finish
+is unnecessary and does nothing.
+
 .coNP Function @ stringp
 .synb
 .mets (stringp << obj )
-- 
cgit v1.2.3