Check if a sum update expression is statically well-formed.
(check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) → result
This is similar to check-product-update-expression, but the target expression must be (a subtype of) a sum type, and the product type is the one associated to the alternative. We also generate a proof obligation saying that the sum type value is of the specified alternative.
Function:
(defun check-sum-update-expression (tname target target-result alternative inits inits-result expr ctxt) (declare (xargs :guard (and (identifierp tname) (expressionp target) (type-resultp target-result) (identifierp alternative) (initializer-listp inits) (type-resultp inits-result) (expressionp expr) (contextp ctxt)))) (declare (xargs :guard (type-result-case inits-result :err t :ok (= (len inits-result.types) (len inits))))) (let ((__function__ 'check-sum-update-expression)) (declare (ignorable __function__)) (type-result-case target-result :err (type-result-err target-result.info) :ok (type-result-case inits-result :err (type-result-err inits-result.info) :ok (b* ((type (ensure-single-type target-result.types)) ((when (not type)) (type-result-err (list :multi-valued-field-target (expression-fix target) target-result.types))) (type (max-supertype type (context->tops ctxt))) ((when (not type)) (type-result-err (list :no-max-supertype type))) (tsum (get-type-sum type (context->tops ctxt))) ((when (not tsum)) (type-result-err (list :sum-update-type-mismatch type))) (oblig? (non-trivial-proof-obligation (context->obligation-vars ctxt) (context->obligation-hyps ctxt) (make-expression-sum-test :type tname :target target :alternative alternative) expr)) (product (get-alternative-product alternative (type-sum->alternatives tsum))) ((when (not product)) (type-result-err (list :sum-update-no-alternative tsum (identifier-fix alternative)))) (fields (type-product->fields product)) ((mv okp obligs unmatched-fields) (match-field-list inits inits-result.types fields ctxt)) ((when (not okp)) (type-result-err (list :field-type-mismatch type (initializer-list-fix inits) unmatched-fields))) (inv (type-product->invariant product)) (inv-oblig? (if inv (b* ((subst-new (initializers-to-variable-substitution inits)) (names (field-list->name-list unmatched-fields)) (subst-old (omap::from-lists names (expression-sum-field-list tname target alternative names))) (subst (omap::update* subst-new subst-old))) (non-trivial-proof-obligation (context->obligation-vars ctxt) (context->obligation-hyps ctxt) (subst-expression subst inv) expr)) nil))) (make-type-result-ok :types (list type) :obligations (append inits-result.obligations oblig? obligs inv-oblig?)))))))
Theorem:
(defthm type-resultp-of-check-sum-update-expression (b* ((result (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt))) (type-resultp result)) :rule-classes :rewrite)
Theorem:
(defthm check-sum-update-expression-of-identifier-fix-tname (equal (check-sum-update-expression (identifier-fix tname) target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-identifier-equiv-congruence-on-tname (implies (identifier-equiv tname tname-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname-equiv target target-result alternative inits inits-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-expression-fix-target (equal (check-sum-update-expression tname (expression-fix target) target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-expression-equiv-congruence-on-target (implies (expression-equiv target target-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target-equiv target-result alternative inits inits-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-type-result-fix-target-result (equal (check-sum-update-expression tname target (type-result-fix target-result) alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-type-result-equiv-congruence-on-target-result (implies (type-result-equiv target-result target-result-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result-equiv alternative inits inits-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-identifier-fix-alternative (equal (check-sum-update-expression tname target target-result (identifier-fix alternative) inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-identifier-equiv-congruence-on-alternative (implies (identifier-equiv alternative alternative-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative-equiv inits inits-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-initializer-list-fix-inits (equal (check-sum-update-expression tname target target-result alternative (initializer-list-fix inits) inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-initializer-list-equiv-congruence-on-inits (implies (initializer-list-equiv inits inits-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits-equiv inits-result expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-type-result-fix-inits-result (equal (check-sum-update-expression tname target target-result alternative inits (type-result-fix inits-result) expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-type-result-equiv-congruence-on-inits-result (implies (type-result-equiv inits-result inits-result-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result-equiv expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-expression-fix-expr (equal (check-sum-update-expression tname target target-result alternative inits inits-result (expression-fix expr) ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-expression-equiv-congruence-on-expr (implies (expression-equiv expr expr-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr-equiv ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-update-expression-of-context-fix-ctxt (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr (context-fix ctxt)) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt)))
Theorem:
(defthm check-sum-update-expression-context-equiv-congruence-on-ctxt (implies (context-equiv ctxt ctxt-equiv) (equal (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt) (check-sum-update-expression tname target target-result alternative inits inits-result expr ctxt-equiv))) :rule-classes :congruence)