From cf00520d0a130f90f9722571492c09a1ab848af0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 6 May 2025 06:26:56 -0700
Subject: New function: buf-zero-p.

* buf.c (buf_zero_p): New function.
(buf_init): Register buf-zero-p intrinsic.

* buf.h (buf_zero_p): Declared.

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

* txr.1: Documented.
---
 buf.c            | 20 ++++++++++++++++++++
 buf.h            |  1 +
 tests/012/buf.tl | 22 ++++++++++++++++++++++
 txr.1            | 16 ++++++++++++++++
 4 files changed, 59 insertions(+)

diff --git a/buf.c b/buf.c
index 0fad7481..dd5abda9 100644
--- a/buf.c
+++ b/buf.c
@@ -1728,6 +1728,25 @@ val buf_bit(val buf, val bit)
   }
 }
 
+val buf_zero_p(val buf)
+{
+  val self = lit("buf-zero-p");
+  struct buf *b = buf_handle(buf, self);
+  ucnum l = c_unum(b->len, self), i;
+  ucnum *ucdata = coerce(ucnum *, b->data);
+
+  for (i = 0; i < l / sizeof (ucnum); i++) {
+    if (ucdata[i])
+      return nil;
+  }
+
+  for (i = l / sizeof (ucnum) * sizeof (ucnum); i < l; i++)
+    if (b->data[i])
+      return nil;
+
+  return t;
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1830,6 +1849,7 @@ void buf_init(void)
   reg_fun(intern(lit("buf-trunc"), user_package), func_n2(buf_trunc));
   reg_fun(intern(lit("buf-bitset"), user_package), func_n1(buf_bitset));
   reg_fun(intern(lit("buf-bit"), user_package), func_n2(buf_bit));
+  reg_fun(intern(lit("buf-zero-p"), user_package), func_n1(buf_zero_p));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index dad9cf60..c134b43b 100644
--- a/buf.h
+++ b/buf.h
@@ -133,5 +133,6 @@ val buf_not(val buf);
 val buf_trunc(val buf, val bits);
 val buf_bitset(val buf);
 val buf_bit(val buf, val bit);
+val buf_zero_p(val buf);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 3437d6bb..77018647 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -322,3 +322,25 @@
   (buf-bit #b'ffff' -1) nil
   (mapcar (op buf-bit #b'fad5') 0..16)
   (t nil t nil t nil t t nil t nil t t t t t))
+
+(mtest
+  (buf-zero-p #b'') t
+  (buf-zero-p #b'00') t
+  (buf-zero-p #b'01') nil
+  (buf-zero-p #b'80') nil
+  (buf-zero-p #b'000000') t
+  (buf-zero-p #b'000001') nil
+  (buf-zero-p #b'00000000') t
+  (buf-zero-p #b'00000001') nil
+  (buf-zero-p #b'0000000000') t
+  (buf-zero-p #b'0000000001') nil
+  (buf-zero-p #b'000000000000') t
+  (buf-zero-p #b'000000000001') nil
+  (buf-zero-p #b'00000000000000') t
+  (buf-zero-p #b'00000000000001') nil
+  (buf-zero-p #b'0000000000000000') t
+  (buf-zero-p #b'0000000000000001') nil
+  (buf-zero-p #b'000000000000000000') t
+  (buf-zero-p #b'00000000000000000001') nil
+  (buf-zero-p #b'00000000000000000000') t
+  (buf-zero-p #b'000000000000000001') nil)
diff --git a/txr.1 b/txr.1
index 42f2372d..57173cdf 100644
--- a/txr.1
+++ b/txr.1
@@ -30450,6 +30450,22 @@ due to being negative, or excessively positive,
 the value returned is
 .codn nil .
 
+.coNP Function @ buf-zero-p
+.synb
+.mets (buf-zero-p << buf )
+.syne
+.desc
+The
+.code buf-zero-p
+function returns
+.code t
+if
+.meta buf
+does not contain any bytes that are nonzero, otherwise
+.codn nil .
+
+An empty buffer satisfies this condition.
+
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb
 .mets (buf-compress < buf <> [ level ])
-- 
cgit v1.2.3