Check if a sum field expression is statically well-formed.
(check-sum-field-expression tname target target-result alternative field expr ctxt) → result
The type of the expression must be a defined sum type, or a subtype of a defined sum type: we calculate the maximal supertype of the expression's type, and ensure that it is a defined sum type; since sum types are not subtypes, calculating the maximal supertype cannot ``skip'' a sum type.
We generate a proof obligation saying that the target expression has the specified alternative.
We find the type of the field in the alternative of the sum type: this is the type of the whole expression.
Function:
(defun check-sum-field-expression (tname target target-result alternative field expr ctxt) (declare (xargs :guard (and (identifierp tname) (expressionp target) (type-resultp target-result) (identifierp alternative) (identifierp field) (expressionp expr) (contextp ctxt)))) (let ((__function__ 'check-sum-field-expression)) (declare (ignorable __function__)) (type-result-case target-result :err (type-result-err target-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-field-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-field-no-alternative tsum (identifier-fix alternative)))) (ftype (get-field-type field (type-product->fields product))) ((when (not ftype)) (type-result-err (list :no-field-in-product (identifier-fix field) product)))) (make-type-result-ok :types (list ftype) :obligations (append target-result.obligations oblig?))))))
Theorem:
(defthm type-resultp-of-check-sum-field-expression (b* ((result (check-sum-field-expression tname target target-result alternative field expr ctxt))) (type-resultp result)) :rule-classes :rewrite)
Theorem:
(defthm check-sum-field-expression-of-identifier-fix-tname (equal (check-sum-field-expression (identifier-fix tname) target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-identifier-equiv-congruence-on-tname (implies (identifier-equiv tname tname-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname-equiv target target-result alternative field expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-expression-fix-target (equal (check-sum-field-expression tname (expression-fix target) target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-expression-equiv-congruence-on-target (implies (expression-equiv target target-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target-equiv target-result alternative field expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-type-result-fix-target-result (equal (check-sum-field-expression tname target (type-result-fix target-result) alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-type-result-equiv-congruence-on-target-result (implies (type-result-equiv target-result target-result-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result-equiv alternative field expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-identifier-fix-alternative (equal (check-sum-field-expression tname target target-result (identifier-fix alternative) field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-identifier-equiv-congruence-on-alternative (implies (identifier-equiv alternative alternative-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative-equiv field expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-identifier-fix-field (equal (check-sum-field-expression tname target target-result alternative (identifier-fix field) expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-identifier-equiv-congruence-on-field (implies (identifier-equiv field field-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field-equiv expr ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-expression-fix-expr (equal (check-sum-field-expression tname target target-result alternative field (expression-fix expr) ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-expression-equiv-congruence-on-expr (implies (expression-equiv expr expr-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr-equiv ctxt))) :rule-classes :congruence)
Theorem:
(defthm check-sum-field-expression-of-context-fix-ctxt (equal (check-sum-field-expression tname target target-result alternative field expr (context-fix ctxt)) (check-sum-field-expression tname target target-result alternative field expr ctxt)))
Theorem:
(defthm check-sum-field-expression-context-equiv-congruence-on-ctxt (implies (context-equiv ctxt ctxt-equiv) (equal (check-sum-field-expression tname target target-result alternative field expr ctxt) (check-sum-field-expression tname target target-result alternative field expr ctxt-equiv))) :rule-classes :congruence)