[elpa] externals/compat 26ee17853e 07/27: Add bool-vector functions

[ELPA Syncer]

branch: externals/compat
commit 26ee17853e8a63b7d29fb602e9d3ec4c0782e6cc
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add bool-vector functions
---
 compat-24.el    | 156 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat-tests.el | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 304 insertions(+)

diff --git a/compat-24.el b/compat-24.el
index 968f61525d..d8baecb6cd 100644
--- a/compat-24.el
+++ b/compat-24.el
@@ -85,6 +85,162 @@
         (throw 'fail nil)))
     t))
 
+(compat-defun bool-vector-exclusive-or (a b &optional c)
+  "Return A ^ B, bitwise exclusive or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (bool-vector-p b)
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (unless (or (null c) (bool-vector-p c))
+    (signal 'wrong-type-argument (list 'bool-vector-p c)))
+  (when (/= (length a) (length b))
+    (signal 'wrong-length-argument (list (length a) (length b))))
+  (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+    (when (/= (length a) (length dest))
+      (signal 'wrong-length-argument (list (length a) (length dest))))
+    (dotimes (i (length dest))
+      (let ((val (not (eq (aref a i) (aref b i)))))
+        (unless (eq val (aref dest i))
+          (setq changed t))
+        (aset dest i val)))
+    (if c (and changed c) dest)))
+
+(compat-defun bool-vector-union (a b &optional c)
+  "Return A | B, bitwise or.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (bool-vector-p b)
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (unless (or (null c) (bool-vector-p c))
+    (signal 'wrong-type-argument (list 'bool-vector-p c)))
+  (when (/= (length a) (length b))
+    (signal 'wrong-length-argument (list (length a) (length b))))
+  (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+    (when (/= (length a) (length dest))
+      (signal 'wrong-length-argument (list (length a) (length dest))))
+    (dotimes (i (length dest))
+      (let ((val (or (aref a i) (aref b i))))
+        (unless (eq val (aref dest i))
+          (setq changed t))
+        (aset dest i val)))
+    (if c (and changed c) dest)))
+
+(compat-defun bool-vector-intersection (a b &optional c)
+  "Return A & B, bitwise and.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (bool-vector-p b)
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (unless (or (null c) (bool-vector-p c))
+    (signal 'wrong-type-argument (list 'bool-vector-p c)))
+  (when (/= (length a) (length b))
+    (signal 'wrong-length-argument (list (length a) (length b))))
+  (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+    (when (/= (length a) (length dest))
+      (signal 'wrong-length-argument (list (length a) (length dest))))
+    (dotimes (i (length dest))
+      (let ((val (and (aref a i) (aref b i))))
+        (unless (eq val (aref dest i))
+          (setq changed t))
+        (aset dest i val)))
+    (if c (and changed c) dest)))
+
+(compat-defun bool-vector-set-difference (a b &optional c)
+  "Return A &~ B, set difference.
+If optional third argument C is given, store result into C.
+A, B, and C must be bool vectors of the same length.
+Return the destination vector if it changed or nil otherwise."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (bool-vector-p b)
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (unless (or (null c) (bool-vector-p c))
+    (signal 'wrong-type-argument (list 'bool-vector-p c)))
+  (when (/= (length a) (length b))
+    (signal 'wrong-length-argument (list (length a) (length b))))
+  (let ((dest (or c (make-bool-vector (length a) nil))) changed)
+    (when (/= (length a) (length dest))
+      (signal 'wrong-length-argument (list (length a) (length dest))))
+    (dotimes (i (length dest))
+      (let ((val (and (aref a i) (not (aref b i)))))
+        (unless (eq val (aref dest i))
+          (setq changed t))
+        (aset dest i val)))
+    (if c (and changed c) dest)))
+
+(compat-defun bool-vector-not (a &optional b)
+  "Compute ~A, set complement.
+If optional second argument B is given, store result into B.
+A and B must be bool vectors of the same length.
+Return the destination vector."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (or (null b) (bool-vector-p b))
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (let ((dest (or b (make-bool-vector (length a) nil))))
+    (when (/= (length a) (length dest))
+      (signal 'wrong-length-argument (list (length a) (length dest))))
+    (dotimes (i (length dest))
+      (aset dest i (not (aref a i))))
+    dest))
+
+(compat-defun bool-vector-subsetp (a b)
+  "Return t if every t value in A is also t in B, nil otherwise.
+A and B must be bool vectors of the same length."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (unless (bool-vector-p b)
+    (signal 'wrong-type-argument (list 'bool-vector-p b)))
+  (when (/= (length a) (length b))
+    (signal 'wrong-length-argument (list (length a) (length b))))
+  (catch 'not-subset
+    (dotimes (i (length a))
+      (when (if (aref a i) (not (aref b i)) nil)
+        (throw 'not-subset nil)))
+    t))
+
+(compat-defun bool-vector-count-consecutive (a b i)
+  "Count how many consecutive elements in A equal B starting at I.
+A is a bool vector, B is t or nil, and I is an index into A."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (setq b (and b t))                    ;normalise to nil or t
+  (unless (< i (length a))
+    (signal 'args-out-of-range (list a i)))
+  (let ((len (length a)) (n i))
+    (while (and (< i len) (eq (aref a i) b))
+      (setq i (1+ i)))
+    (- i n)))
+
+(compat-defun bool-vector-count-population (a)
+  "Count how many elements in A are t.
+A is a bool vector.  To count A's nil elements, subtract the
+return value from A's length."
+  :version "24.4"
+  (unless (bool-vector-p a)
+    (signal 'wrong-type-argument (list 'bool-vector-p a)))
+  (let ((n 0))
+    (dotimes (i (length a))
+      (when (aref a i)
+        (setq n (1+ n))))
+    n))
+
 ;;;; Defined in subr.el
 
 (compat-defmacro with-eval-after-load (file &rest body)
diff --git a/compat-tests.el b/compat-tests.el
index a116571ab2..bc3de13c4d 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1423,5 +1423,153 @@ the compatibility function."
     (compat--should "aabb" "cc" "aabbcc")
     (compat--should "aabbcc" "dd" "aabbcc")))
 
+(ert-deftest compat-bool-vector-exclusive-or ()
+  "Check if `compat--bool-vector-exclusive-or' was implemented properly."
+  (let ((a (bool-vector t t nil nil))
+        (b (bool-vector t nil t nil))
+        (c (make-bool-vector 4 nil)))
+    (compat-test bool-vector-exclusive-or
+      (compat--should (bool-vector nil t t nil) a b)
+      (compat--should (bool-vector nil t t nil) b a)
+      (compat--bool-vector-exclusive-or a b c)
+      (should (equal (bool-vector nil t t nil) c))
+      (should (equal (bool-vector nil t t nil) c))
+      (compat--error wrong-length-argument a (bool-vector))
+      (compat--error wrong-length-argument a b (bool-vector))
+      (compat--error wrong-type-argument (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector))
+      (compat--error wrong-type-argument (vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (vector) (vector)))))
+
+(ert-deftest compat-bool-vector-union ()
+  "Check if `compat--bool-vector-union' was implemented properly."
+  (let ((a (bool-vector t t nil nil))
+        (b (bool-vector t nil t nil))
+        (c (make-bool-vector 4 nil)))
+    (compat-test bool-vector-union
+      (compat--should (bool-vector t t t nil) a b)
+      (compat--should (bool-vector t t t nil) b a)
+      (compat--bool-vector-union a b c)
+      (should (equal (bool-vector t t t nil) c))
+      (compat--error wrong-length-argument a (bool-vector))
+      (compat--error wrong-length-argument a b (bool-vector))
+      (compat--error wrong-type-argument (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector))
+      (compat--error wrong-type-argument (vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (vector) (vector)))))
+
+(ert-deftest compat-bool-vector-intersection ()
+  "Check if `compat--bool-vector-intersection' was implemented properly."
+  (let ((a (bool-vector t t nil nil))
+        (b (bool-vector t nil t nil))
+        (c (make-bool-vector 4 nil)))
+    (compat-test bool-vector-intersection
+      (compat--should (bool-vector t nil nil nil) a b)
+      (compat--should (bool-vector t nil nil nil) b a)
+      (compat--bool-vector-intersection a b c)
+      (should (equal (bool-vector t nil nil nil) c))
+      (compat--error wrong-length-argument a (bool-vector))
+      (compat--error wrong-length-argument a b (bool-vector))
+      (compat--error wrong-type-argument (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector))
+      (compat--error wrong-type-argument (vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (vector) (vector)))))
+
+(ert-deftest compat-bool-vector-set-difference ()
+  "Check if `compat--bool-vector-set-difference' was implemented properly."
+  (let ((a (bool-vector t t nil nil))
+        (b (bool-vector t nil t nil))
+        (c (make-bool-vector 4 nil)))
+    (compat-test bool-vector-set-difference
+      (compat--should (bool-vector nil t nil nil) a b)
+      (compat--should (bool-vector nil nil t nil) b a)
+      (compat--bool-vector-set-difference a b c)
+      (should (equal (bool-vector nil t nil nil) c))
+      (compat--bool-vector-set-difference b a c)
+      (should (equal (bool-vector nil nil t nil) c))
+      (compat--error wrong-length-argument a (bool-vector))
+      (compat--error wrong-length-argument a b (bool-vector))
+      (compat--error wrong-type-argument (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector))
+      (compat--error wrong-type-argument (vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (bool-vector) (vector) (vector))
+      (compat--error wrong-type-argument (vector) (bool-vector) (vector))
+      (compat--error wrong-type-argument (vector) (vector) (vector)))))
+
+(ert-deftest compat-bool-vector-not ()
+  "Check if `compat--bool-vector-not' was implemented properly."
+  (compat-test bool-vector-not
+    (compat--should (bool-vector) (bool-vector))
+    (compat--should (bool-vector t) (bool-vector nil))
+    (compat--should (bool-vector nil) (bool-vector t))
+    (compat--should (bool-vector t t) (bool-vector nil nil))
+    (compat--should (bool-vector t nil) (bool-vector nil t))
+    (compat--should (bool-vector nil t) (bool-vector t nil))
+    (compat--should (bool-vector nil nil) (bool-vector t t))
+    (compat--error wrong-type-argument (vector))
+    (compat--error wrong-type-argument (vector) (vector))))
+
+(ert-deftest compat-bool-vector-subsetp ()
+  "Check if `compat--bool-vector-subsetp' was implemented properly."
+  (compat-test bool-vector-subsetp
+    (compat--should t (bool-vector) (bool-vector))
+    (compat--should t (bool-vector t) (bool-vector t))
+    (compat--should t (bool-vector nil) (bool-vector t))
+    (compat--should nil (bool-vector t) (bool-vector nil))
+    (compat--should t (bool-vector nil) (bool-vector nil))
+    (compat--should t (bool-vector t t) (bool-vector t t))
+    (compat--should t (bool-vector nil nil) (bool-vector t t))
+    (compat--should t (bool-vector nil nil) (bool-vector t nil))
+    (compat--should t (bool-vector nil nil) (bool-vector nil t))
+    (compat--should nil (bool-vector t nil) (bool-vector nil nil))
+    (compat--should nil (bool-vector nil t) (bool-vector nil nil))
+    (compat--error wrong-length-argument (bool-vector nil) (bool-vector nil 
nil))
+    (compat--error wrong-type-argument (bool-vector) (vector))
+    (compat--error wrong-type-argument (vector) (bool-vector))
+    (compat--error wrong-type-argument (vector) (vector))))
+
+(ert-deftest compat-bool-vector-count-consecutive ()
+  "Check if `compat--bool-vector-count-consecutive' was implemented properly."
+  (compat-test bool-vector-count-consecutive
+    ;; (compat--should 0 (bool-vector nil) (bool-vector nil) 0)
+    (compat--should 0 (make-bool-vector 10 nil) t 0)
+    (compat--should 10 (make-bool-vector 10 nil) nil 0)
+    (compat--should 0 (make-bool-vector 10 nil) t 1)
+    (compat--should 9 (make-bool-vector 10 nil) nil 1)
+    (compat--should 0 (make-bool-vector 10 nil) t 1)
+    (compat--should 9 (make-bool-vector 10 t) t 1)
+    (compat--should 0 (make-bool-vector 10 nil) t 8)
+    (compat--should 2 (make-bool-vector 10 nil) nil 8)
+    (compat--should 2 (make-bool-vector 10 t) t 8)
+    (compat--should 10 (make-bool-vector 10 t) (make-bool-vector 10 t) 0)
+    (compat--should 4 (bool-vector t t t t nil t t t t t) t 0)
+    (compat--should 0 (bool-vector t t t t nil t t t t t) t 4)
+    (compat--should 5 (bool-vector t t t t nil t t t t t) t 5)
+    (compat--error wrong-type-argument (vector) nil 0)))
+
+(ert-deftest compat-bool-vector-count-population ()
+  "Check if `compat--bool-vector-count-population' was implemented properly."
+  (compat-test bool-vector-count-population
+    (compat--should  0 (bool-vector))
+    (compat--should  0 (make-bool-vector 10 nil))
+    (compat--should 10 (make-bool-vector 10 t))
+    (compat--should  1 (bool-vector nil nil t nil))
+    (compat--should  1 (bool-vector nil nil nil t))
+    (compat--should  1 (bool-vector t nil nil nil))
+    (compat--should  2 (bool-vector t nil nil t))
+    (compat--should  2 (bool-vector t nil t nil))
+    (compat--should  3 (bool-vector t nil t t))
+    (compat--error wrong-type-argument (vector))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here