branch: externals/compat
commit 26ee17853e8a63b7d29fb602e9d3ec4c0782e6cc
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@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
