Macro:
(defmacro sbitset-union (&rest args) (cond ((atom args) nil) ((atom (cdr args)) (car args)) (t (xxxjoin 'sbitset-binary-union args))))
Function:
(defun sbitset-union-exec (x y) (declare (xargs :guard (and (sbitsetp x) (sbitsetp y)))) (let ((__function__ 'sbitset-union-exec)) (declare (ignorable __function__)) (b* (((when (atom x)) y) ((when (atom y)) x) (x1 (car x)) (y1 (car y)) ((the unsigned-byte x1.offset) (sbitset-pair-offset x1)) ((the unsigned-byte y1.offset) (sbitset-pair-offset y1)) ((when (< x1.offset y1.offset)) (cons x1 (sbitset-union-exec (cdr x) y))) ((unless (eql x1.offset y1.offset)) (cons y1 (sbitset-union-exec x (cdr y)))) (x1.block (sbitset-pair-block x1)) (y1.block (sbitset-pair-block y1)) (new-block (the-sbitset-block (logior (the-sbitset-block x1.block) (the-sbitset-block y1.block)))) (new-pair (sbitset-pair x1.offset new-block))) (cons new-pair (sbitset-union-exec (cdr x) (cdr y))))))
Function:
(defun sbitset-binary-union$inline (x y) (declare (xargs :guard (and (sbitsetp x) (sbitsetp y)))) (let ((__function__ 'sbitset-binary-union)) (declare (ignorable __function__)) (mbe :logic (sbitset-union-exec (sbitset-fix x) (sbitset-fix y)) :exec (sbitset-union-exec x y))))
Theorem:
(defthm sbitsetp-of-sbitset-union-exec (implies (and (sbitsetp x) (sbitsetp y)) (sbitsetp (sbitset-union-exec x y))))
Theorem:
(defthm sbitset-of-sbitset-union (sbitsetp (sbitset-union x y)))
Theorem:
(defthm sbitset-members-of-sbitset-union (equal (sbitset-members (sbitset-union x y)) (union (sbitset-members x) (sbitset-members y))))