Fixing function for binop structures.
Function:
(defun binop-fix$inline (x) (declare (xargs :guard (binopp x))) (let ((__function__ 'binop-fix)) (declare (ignorable __function__)) (mbe :logic (case (binop-kind x) (:mul (cons :mul (list))) (:div (cons :div (list))) (:rem (cons :rem (list))) (:add (cons :add (list))) (:sub (cons :sub (list))) (:shl (cons :shl (list))) (:shr (cons :shr (list))) (:lt (cons :lt (list))) (:gt (cons :gt (list))) (:le (cons :le (list))) (:ge (cons :ge (list))) (:eq (cons :eq (list))) (:ne (cons :ne (list))) (:bitand (cons :bitand (list))) (:bitxor (cons :bitxor (list))) (:bitior (cons :bitior (list))) (:logand (cons :logand (list))) (:logor (cons :logor (list))) (:asg (cons :asg (list))) (:asg-mul (cons :asg-mul (list))) (:asg-div (cons :asg-div (list))) (:asg-rem (cons :asg-rem (list))) (:asg-add (cons :asg-add (list))) (:asg-sub (cons :asg-sub (list))) (:asg-shl (cons :asg-shl (list))) (:asg-shr (cons :asg-shr (list))) (:asg-and (cons :asg-and (list))) (:asg-xor (cons :asg-xor (list))) (:asg-ior (cons :asg-ior (list)))) :exec x)))
Theorem:
(defthm binopp-of-binop-fix (b* ((new-x (binop-fix$inline x))) (binopp new-x)) :rule-classes :rewrite)
Theorem:
(defthm binop-fix-when-binopp (implies (binopp x) (equal (binop-fix x) x)))
Function:
(defun binop-equiv$inline (acl2::x acl2::y) (declare (xargs :guard (and (binopp acl2::x) (binopp acl2::y)))) (equal (binop-fix acl2::x) (binop-fix acl2::y)))
Theorem:
(defthm binop-equiv-is-an-equivalence (and (booleanp (binop-equiv x y)) (binop-equiv x x) (implies (binop-equiv x y) (binop-equiv y x)) (implies (and (binop-equiv x y) (binop-equiv y z)) (binop-equiv x z))) :rule-classes (:equivalence))
Theorem:
(defthm binop-equiv-implies-equal-binop-fix-1 (implies (binop-equiv acl2::x x-equiv) (equal (binop-fix acl2::x) (binop-fix x-equiv))) :rule-classes (:congruence))
Theorem:
(defthm binop-fix-under-binop-equiv (binop-equiv (binop-fix acl2::x) acl2::x) :rule-classes (:rewrite :rewrite-quoted-constant))
Theorem:
(defthm equal-of-binop-fix-1-forward-to-binop-equiv (implies (equal (binop-fix acl2::x) acl2::y) (binop-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm equal-of-binop-fix-2-forward-to-binop-equiv (implies (equal acl2::x (binop-fix acl2::y)) (binop-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm binop-equiv-of-binop-fix-1-forward (implies (binop-equiv (binop-fix acl2::x) acl2::y) (binop-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm binop-equiv-of-binop-fix-2-forward (implies (binop-equiv acl2::x (binop-fix acl2::y)) (binop-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm binop-kind$inline-of-binop-fix-x (equal (binop-kind$inline (binop-fix x)) (binop-kind$inline x)))
Theorem:
(defthm binop-kind$inline-binop-equiv-congruence-on-x (implies (binop-equiv x x-equiv) (equal (binop-kind$inline x) (binop-kind$inline x-equiv))) :rule-classes :congruence)
Theorem:
(defthm consp-of-binop-fix (consp (binop-fix x)) :rule-classes :type-prescription)