New string compression/decompression functions.

* buf.c (str_compress, str_decompress): New functions.
(buf_init): str-compress, str-decompress intrinsics
registered.

* lib.[ch] (string_utf8_from_buf): New function.

* tests/012/buf.tl: New tests.

* txr.1: Documented.

1 files changed, 65 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index ffa2af3b..94cccaa7 100644
--- a/buf.c
+++ b/buf.c
@@ -1385,6 +1385,69 @@ static val buf_decompress(val buf)
   uw_throwf(error_s, lit("~a: decompression failed"), self, nao);
 }
 
+static val str_compress(val str, val level_opt)
+{
+  val self = lit("str-compress");
+  val level = default_arg(level_opt, negone);
+  int lev = c_int(level, self);
+  size_t sz;
+  unsigned char *u8 = utf8_dup_to_buf(c_str(str, self), &sz, 0);
+  uLong bound = compressBound(sz), zsize = bound;
+  mem_t *zdata = chk_malloc(bound);
+
+  if (convert(uLong, sz) != sz) {
+    free(zdata);
+    err_oflow(self);
+  }
+
+  if (compress2(zdata, &zsize, u8, sz, lev) != Z_OK) {
+    free(zdata);
+    uw_throwf(error_s, lit("~a: compression failed"), self, nao);
+  }
+
+  zdata = chk_realloc(zdata, zsize);
+  return make_owned_buf(unum(zsize), zdata);
+}
+
+static val str_decompress(val buf)
+{
+  val self = lit("str-decompress");
+  struct buf *b = buf_handle(buf, self);
+  ucnum zsize = c_unum(b->len, self);
+  uLong zsz10 = 10 * zsize;
+  uLong size = if3(zsz10 > zsize, zsz10, convert(uLong, -1));
+  mem_t *data = chk_malloc(size);
+  val ret = nil;
+
+  for (;;) {
+    switch (uncompress(data, &size, b->data, zsize)) {
+    case Z_OK:
+
+      data = chk_realloc(data, size);
+      ret = string_utf8_from_buf(coerce(char *, data), size);
+      free(data);
+      return ret;
+    case Z_BUF_ERROR:
+      if (size == convert(uLong, -1))
+        break;
+      if (size * 2 > size)
+        size = size * 2;
+      else if (size == convert(uLong, -1))
+        break;
+      else
+        size  = convert(uLong, -1);
+      data = chk_realloc(data, size);
+      continue;
+    default:
+      break;
+    }
+    break;
+  }
+
+  free(data);
+  uw_throwf(error_s, lit("~a: decompression failed"), self, nao);
+}
+
 #endif
 
 val buf_ash(val buf, val bits)
@@ -2084,6 +2147,8 @@ void buf_init(void)
 #if HAVE_ZLIB
   reg_fun(intern(lit("buf-compress"), user_package), func_n2o(buf_compress, 1));
   reg_fun(intern(lit("buf-decompress"), user_package), func_n1(buf_decompress));
+  reg_fun(intern(lit("str-compress"), user_package), func_n2o(str_compress, 1));
+  reg_fun(intern(lit("str-decompress"), user_package), func_n1(str_decompress));
 #endif
 
   reg_fun(intern(lit("buf-ash"), user_package), func_n2(buf_ash));