Fixing function for truth4 bit structures.
Function:
(defun truth4-fix (x) (declare (xargs :guard (truth4-p x))) (let ((__function__ 'truth4-fix)) (declare (ignorable __function__)) (mbe :logic (loghead 16 x) :exec x)))
Theorem:
(defthm truth4-p-of-truth4-fix (b* ((fty::fixed (truth4-fix x))) (truth4-p fty::fixed)) :rule-classes :rewrite)
Theorem:
(defthm truth4-fix-when-truth4-p (implies (truth4-p x) (equal (truth4-fix x) x)))
Function:
(defun truth4-equiv$inline (acl2::x acl2::y) (declare (xargs :guard (and (truth4-p acl2::x) (truth4-p acl2::y)))) (equal (truth4-fix acl2::x) (truth4-fix acl2::y)))
Theorem:
(defthm truth4-equiv-is-an-equivalence (and (booleanp (truth4-equiv x y)) (truth4-equiv x x) (implies (truth4-equiv x y) (truth4-equiv y x)) (implies (and (truth4-equiv x y) (truth4-equiv y z)) (truth4-equiv x z))) :rule-classes (:equivalence))
Theorem:
(defthm truth4-equiv-implies-equal-truth4-fix-1 (implies (truth4-equiv acl2::x x-equiv) (equal (truth4-fix acl2::x) (truth4-fix x-equiv))) :rule-classes (:congruence))
Theorem:
(defthm truth4-fix-under-truth4-equiv (truth4-equiv (truth4-fix acl2::x) acl2::x) :rule-classes (:rewrite :rewrite-quoted-constant))
Theorem:
(defthm truth4-fix-of-truth4-fix-x (equal (truth4-fix (truth4-fix x)) (truth4-fix x)))
Theorem:
(defthm truth4-fix-truth4-equiv-congruence-on-x (implies (truth4-equiv x x-equiv) (equal (truth4-fix x) (truth4-fix x-equiv))) :rule-classes :congruence)