Fixing function for binop structures.
Function:
(defun binop-fix$inline (x) (declare (xargs :guard (binopp x))) (mbe :logic (case (binop-kind x) (:mul (cons :mul nil)) (:div (cons :div nil)) (:rem (cons :rem nil)) (:add (cons :add nil)) (:sub (cons :sub nil)) (:shl (cons :shl nil)) (:shr (cons :shr nil)) (:lt (cons :lt nil)) (:gt (cons :gt nil)) (:le (cons :le nil)) (:ge (cons :ge nil)) (:eq (cons :eq nil)) (:ne (cons :ne nil)) (:bitand (cons :bitand nil)) (:bitxor (cons :bitxor nil)) (:bitior (cons :bitior nil)) (:logand (cons :logand nil)) (:logor (cons :logor nil)) (:asg (cons :asg nil)) (:asg-mul (cons :asg-mul nil)) (:asg-div (cons :asg-div nil)) (:asg-rem (cons :asg-rem nil)) (:asg-add (cons :asg-add nil)) (:asg-sub (cons :asg-sub nil)) (:asg-shl (cons :asg-shl nil)) (:asg-shr (cons :asg-shr nil)) (:asg-and (cons :asg-and nil)) (:asg-xor (cons :asg-xor nil)) (:asg-ior (cons :asg-ior nil))) :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)
Theorem:
(defthm binop-fix$inline-of-binop-fix-x (equal (binop-fix$inline (binop-fix x)) (binop-fix$inline x)))
Theorem:
(defthm binop-fix$inline-binop-equiv-congruence-on-x (implies (binop-equiv x x-equiv) (equal (binop-fix$inline x) (binop-fix$inline x-equiv))) :rule-classes :congruence)