Check if a strict binary expression is well-formed.
(check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) → result
The
Function:
(defun check-strict-binary-expression (op arg1 arg2 arg1-result arg2-result expr ctxt) (declare (xargs :guard (and (binary-opp op) (expressionp arg1) (expressionp arg2) (type-resultp arg1-result) (type-resultp arg2-result) (expressionp expr) (contextp ctxt)))) (declare (xargs :guard (binary-op-strictp op))) (let ((__function__ 'check-strict-binary-expression)) (declare (ignorable __function__)) (type-result-case arg1-result :err (type-result-err arg1-result.info) :ok (b* ((arg1-type (ensure-single-type arg1-result.types))) (if (not arg1-type) (type-result-err (list :type-mismatch-multi (expression-fix arg1) arg1-result.types)) (type-result-case arg2-result :err (type-result-err arg2-result.info) :ok (b* ((arg2-type (ensure-single-type arg2-result.types))) (if (not arg2-type) (type-result-err (list :type-mismatch-multi (expression-fix arg2) arg2-result.types)) (case (binary-op-kind op) (:eq (check-eq-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:ne (check-ne-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:lt (check-lt-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:le (check-le-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:gt (check-gt-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:ge (check-ge-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:iff (check-iff-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:add (check-add-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:sub (check-sub-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:mul (check-mul-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:div (check-div-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (:rem (check-rem-expression arg1 arg2 arg1-type arg2-type arg1-result.obligations arg2-result.obligations expr ctxt)) (t (prog2$ (impossible) (type-result-err :impossible))))))))))))
Theorem:
(defthm type-resultp-of-check-strict-binary-expression (b* ((result (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt))) (type-resultp result)) :rule-classes :rewrite)
Theorem:
(defthm check-strict-binary-expression-of-binary-op-fix-op (equal (check-strict-binary-expression (binary-op-fix op) arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-binary-op-equiv-congruence-on-op (implies (binary-op-equiv op op-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op-equiv arg1 arg2 arg1-result arg2-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-expression-fix-arg1 (equal (check-strict-binary-expression op (expression-fix arg1) arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-expression-equiv-congruence-on-arg1 (implies (expression-equiv arg1 arg1-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1-equiv arg2 arg1-result arg2-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-expression-fix-arg2 (equal (check-strict-binary-expression op arg1 (expression-fix arg2) arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-expression-equiv-congruence-on-arg2 (implies (expression-equiv arg2 arg2-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2-equiv arg1-result arg2-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-type-result-fix-arg1-result (equal (check-strict-binary-expression op arg1 arg2 (type-result-fix arg1-result) arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-type-result-equiv-congruence-on-arg1-result (implies (type-result-equiv arg1-result arg1-result-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result-equiv arg2-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-type-result-fix-arg2-result (equal (check-strict-binary-expression op arg1 arg2 arg1-result (type-result-fix arg2-result) expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-type-result-equiv-congruence-on-arg2-result (implies (type-result-equiv arg2-result arg2-result-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result-equiv expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-expression-fix-expr (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result (expression-fix expr) ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-expression-equiv-congruence-on-expr (implies (expression-equiv expr expr-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr-equiv ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-strict-binary-expression-of-context-fix-ctxt (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr (context-fix ctxt)) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt)))
Theorem:
(defthm check-strict-binary-expression-context-equiv-congruence-on-ctxt (implies (context-equiv ctxt ctxt-equiv) (equal (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt) (check-strict-binary-expression op arg1 arg2 arg1-result arg2-result expr ctxt-equiv))) :rule-classes :congruence)