Creates, e.g., the expression
(vl-casezx-matchexpr type test match-expr ctx warnings) → (mv warnings expr?)
Function:
(defun vl-casezx-matchexpr (type test match-expr ctx warnings) (declare (xargs :guard (and (vl-casetype-p type) (vl-expr-p test) (vl-expr-p match-expr) (vl-modelement-p ctx) (vl-warninglist-p warnings)))) (declare (xargs :guard (and (member type '(:vl-casez :vl-casex)) (vl-expr-welltyped-p test) (posp (vl-expr->finalwidth test)) (eq (vl-expr->finaltype test) :vl-unsigned)))) (let ((__function__ 'vl-casezx-matchexpr)) (declare (ignorable __function__)) (b* ((type (vl-casetype-fix type)) (ctx (vl-modelement-fix ctx)) (match-expr (vl-expr-fix match-expr)) ((unless (and (vl-expr-welltyped-p match-expr) (posp (vl-expr->finalwidth match-expr)))) (mv (warn :type :vl-casezx-fail :msg "~a0: can't handle ~s1 statement; match expression ~a2 ~ is too complex or incorrectly sized." :args (list ctx (if (eq type :vl-casex) "casex" "casez") match-expr)) nil)) ((mv ok match-bits) (vl-intliteral-msb-bits match-expr)) ((unless ok) (mv (warn :type :vl-casezx-fail :msg "~a0: can't handle ~s1 statement; match expression ~a2 ~ is too complex. (We only support integer literals ~ here.)" :args (list ctx (if (eq type :vl-casex) "casex" "casez") match-expr)) nil)) (finalwidth (max (vl-expr->finalwidth match-expr) (vl-expr->finalwidth test))) (finaltype (if (and (eq (vl-expr->finaltype match-expr) :vl-signed) (eq (vl-expr->finaltype test) :vl-signed)) :vl-signed :vl-unsigned)) (ext-match-bits (append (repeat (- finalwidth (vl-expr->finalwidth match-expr)) (if (eq finaltype :vl-signed) (car match-bits) :vl-0val)) match-bits)) (cm-value (if (eq type :vl-casez) (vl-msb-bits-to-z-care-mask ext-match-bits 0) (vl-msb-bits-to-zx-care-mask ext-match-bits 0))) (cm-guts (make-vl-constint :value cm-value :origwidth finalwidth :origtype finaltype)) (cm-expr (make-vl-atom :guts cm-guts :finalwidth finalwidth :finaltype finaltype)) (zap-bits (if (eq type :vl-casez) (vl-msb-bits-zap-dontcares-z ext-match-bits) (vl-msb-bits-zap-dontcares-zx ext-match-bits))) (zap-expr (vl-msb-bits-to-intliteral zap-bits finaltype)) (test-width (vl-expr->finalwidth test)) (test-ext (if (< test-width finalwidth) (make-vl-nonatom :op :vl-concat :args (list (make-vl-atom :guts (make-vl-constint :origwidth (- finalwidth test-width) :origtype :vl-unsigned :value 0) :finalwidth (- finalwidth test-width) :finaltype :vl-unsigned) test) :finalwidth finalwidth :finaltype finaltype) test)) (if-test (make-vl-nonatom :op :vl-binary-ceq :args (list (make-vl-nonatom :op :vl-binary-bitand :args (list test-ext cm-expr) :finalwidth finalwidth :finaltype finaltype) zap-expr) :finalwidth 1 :finaltype :vl-unsigned))) (mv (ok) if-test))))
Theorem:
(defthm vl-warninglist-p-of-vl-casezx-matchexpr.warnings (b* (((mv ?warnings ?expr?) (vl-casezx-matchexpr type test match-expr ctx warnings))) (vl-warninglist-p warnings)) :rule-classes :rewrite)
Theorem:
(defthm return-type-of-vl-casezx-matchexpr.expr? (b* (((mv ?warnings ?expr?) (vl-casezx-matchexpr type test match-expr ctx warnings))) (iff (vl-expr-p expr?) expr?)) :rule-classes :rewrite)
Theorem:
(defthm vl-expr->finalwidth-of-vl-casezx-matchexpr (b* (((mv ?warnings ?expr?) (vl-casezx-matchexpr type test match-expr ctx warnings))) (implies expr? (equal (vl-expr->finalwidth expr?) 1))) :rule-classes :rewrite)
Theorem:
(defthm vl-expr->finaltype-of-vl-casezx-matchexpr (b* (((mv ?warnings ?expr?) (vl-casezx-matchexpr type test match-expr ctx warnings))) (implies expr? (equal (vl-expr->finaltype expr?) :vl-unsigned))) :rule-classes :rewrite)
Theorem:
(defthm vl-expr-welltyped-p-of-vl-casezx-matchexpr (implies (and (vl-expr-welltyped-p test) (posp (vl-expr->finalwidth test)) (equal (vl-expr->finaltype test) :vl-unsigned)) (b* (((mv & result) (vl-casezx-matchexpr type test match-expr ctx warnings))) (implies result (vl-expr-welltyped-p result)))))
Theorem:
(defthm vl-casezx-matchexpr-of-vl-casetype-fix-type (equal (vl-casezx-matchexpr (vl-casetype-fix type) test match-expr ctx warnings) (vl-casezx-matchexpr type test match-expr ctx warnings)))
Theorem:
(defthm vl-casezx-matchexpr-vl-casetype-equiv-congruence-on-type (implies (vl-casetype-equiv type type-equiv) (equal (vl-casezx-matchexpr type test match-expr ctx warnings) (vl-casezx-matchexpr type-equiv test match-expr ctx warnings))) :rule-classes :congruence)
Theorem:
(defthm vl-casezx-matchexpr-of-vl-expr-fix-test (equal (vl-casezx-matchexpr type (vl-expr-fix test) match-expr ctx warnings) (vl-casezx-matchexpr type test match-expr ctx warnings)))
Theorem:
(defthm vl-casezx-matchexpr-vl-expr-equiv-congruence-on-test (implies (vl-expr-equiv test test-equiv) (equal (vl-casezx-matchexpr type test match-expr ctx warnings) (vl-casezx-matchexpr type test-equiv match-expr ctx warnings))) :rule-classes :congruence)
Theorem:
(defthm vl-casezx-matchexpr-of-vl-expr-fix-match-expr (equal (vl-casezx-matchexpr type test (vl-expr-fix match-expr) ctx warnings) (vl-casezx-matchexpr type test match-expr ctx warnings)))
Theorem:
(defthm vl-casezx-matchexpr-vl-expr-equiv-congruence-on-match-expr (implies (vl-expr-equiv match-expr match-expr-equiv) (equal (vl-casezx-matchexpr type test match-expr ctx warnings) (vl-casezx-matchexpr type test match-expr-equiv ctx warnings))) :rule-classes :congruence)
Theorem:
(defthm vl-casezx-matchexpr-of-vl-modelement-fix-ctx (equal (vl-casezx-matchexpr type test match-expr (vl-modelement-fix ctx) warnings) (vl-casezx-matchexpr type test match-expr ctx warnings)))
Theorem:
(defthm vl-casezx-matchexpr-vl-modelement-equiv-congruence-on-ctx (implies (vl-modelement-equiv ctx ctx-equiv) (equal (vl-casezx-matchexpr type test match-expr ctx warnings) (vl-casezx-matchexpr type test match-expr ctx-equiv warnings))) :rule-classes :congruence)
Theorem:
(defthm vl-casezx-matchexpr-of-vl-warninglist-fix-warnings (equal (vl-casezx-matchexpr type test match-expr ctx (vl-warninglist-fix warnings)) (vl-casezx-matchexpr type test match-expr ctx warnings)))
Theorem:
(defthm vl-casezx-matchexpr-vl-warninglist-equiv-congruence-on-warnings (implies (vl-warninglist-equiv warnings warnings-equiv) (equal (vl-casezx-matchexpr type test match-expr ctx warnings) (vl-casezx-matchexpr type test match-expr ctx warnings-equiv))) :rule-classes :congruence)