Fixing function for pnumber structures.
Function:
(defun pnumber-fix$inline (x) (declare (xargs :guard (pnumberp x))) (mbe :logic (case (pnumber-kind x) (:digit (b* ((digit (acl2::char-fix (std::da-nth 0 (cdr x))))) (let ((digit (if (dec-digit-char-p digit) digit #\0))) (cons :digit (list digit))))) (:dot-digit (b* ((digit (acl2::char-fix (std::da-nth 0 (cdr x))))) (let ((digit (if (dec-digit-char-p digit) digit #\0))) (cons :dot-digit (list digit))))) (:number-digit (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (digit (acl2::char-fix (std::da-nth 1 (cdr x))))) (let ((digit (if (dec-digit-char-p digit) digit #\0))) (cons :number-digit (list number digit))))) (:number-nondigit (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (nondigit (acl2::char-fix (std::da-nth 1 (cdr x))))) (let ((nondigit (if (str::letter/uscore-char-p nondigit) nondigit #\_))) (cons :number-nondigit (list number nondigit))))) (:number-locase-e-sign (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (sign (sign-fix (std::da-nth 1 (cdr x))))) (cons :number-locase-e-sign (list number sign)))) (:number-upcase-e-sign (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (sign (sign-fix (std::da-nth 1 (cdr x))))) (cons :number-upcase-e-sign (list number sign)))) (:number-locase-p-sign (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (sign (sign-fix (std::da-nth 1 (cdr x))))) (cons :number-locase-p-sign (list number sign)))) (:number-upcase-p-sign (b* ((number (pnumber-fix (std::da-nth 0 (cdr x)))) (sign (sign-fix (std::da-nth 1 (cdr x))))) (cons :number-upcase-p-sign (list number sign)))) (:number-dot (b* ((number (pnumber-fix (std::da-nth 0 (cdr x))))) (cons :number-dot (list number))))) :exec x))
Theorem:
(defthm pnumberp-of-pnumber-fix (b* ((new-x (pnumber-fix$inline x))) (pnumberp new-x)) :rule-classes :rewrite)
Theorem:
(defthm pnumber-fix-when-pnumberp (implies (pnumberp x) (equal (pnumber-fix x) x)))
Function:
(defun pnumber-equiv$inline (acl2::x acl2::y) (declare (xargs :guard (and (pnumberp acl2::x) (pnumberp acl2::y)))) (equal (pnumber-fix acl2::x) (pnumber-fix acl2::y)))
Theorem:
(defthm pnumber-equiv-is-an-equivalence (and (booleanp (pnumber-equiv x y)) (pnumber-equiv x x) (implies (pnumber-equiv x y) (pnumber-equiv y x)) (implies (and (pnumber-equiv x y) (pnumber-equiv y z)) (pnumber-equiv x z))) :rule-classes (:equivalence))
Theorem:
(defthm pnumber-equiv-implies-equal-pnumber-fix-1 (implies (pnumber-equiv acl2::x x-equiv) (equal (pnumber-fix acl2::x) (pnumber-fix x-equiv))) :rule-classes (:congruence))
Theorem:
(defthm pnumber-fix-under-pnumber-equiv (pnumber-equiv (pnumber-fix acl2::x) acl2::x) :rule-classes (:rewrite :rewrite-quoted-constant))
Theorem:
(defthm equal-of-pnumber-fix-1-forward-to-pnumber-equiv (implies (equal (pnumber-fix acl2::x) acl2::y) (pnumber-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm equal-of-pnumber-fix-2-forward-to-pnumber-equiv (implies (equal acl2::x (pnumber-fix acl2::y)) (pnumber-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm pnumber-equiv-of-pnumber-fix-1-forward (implies (pnumber-equiv (pnumber-fix acl2::x) acl2::y) (pnumber-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm pnumber-equiv-of-pnumber-fix-2-forward (implies (pnumber-equiv acl2::x (pnumber-fix acl2::y)) (pnumber-equiv acl2::x acl2::y)) :rule-classes :forward-chaining)
Theorem:
(defthm pnumber-kind$inline-of-pnumber-fix-x (equal (pnumber-kind$inline (pnumber-fix x)) (pnumber-kind$inline x)))
Theorem:
(defthm pnumber-kind$inline-pnumber-equiv-congruence-on-x (implies (pnumber-equiv x x-equiv) (equal (pnumber-kind$inline x) (pnumber-kind$inline x-equiv))) :rule-classes :congruence)
Theorem:
(defthm consp-of-pnumber-fix (consp (pnumber-fix x)) :rule-classes :type-prescription)
Theorem:
(defthm pnumber-fix$inline-of-pnumber-fix-x (equal (pnumber-fix$inline (pnumber-fix x)) (pnumber-fix$inline x)))
Theorem:
(defthm pnumber-fix$inline-pnumber-equiv-congruence-on-x (implies (pnumber-equiv x x-equiv) (equal (pnumber-fix$inline x) (pnumber-fix$inline x-equiv))) :rule-classes :congruence)