Generate a theorem for the transformation of a block item.
(gen-block-item-thm old new vartys-pre
vartys-post const-new thm-index hints)
→
(mv thm-event thm-name updated-thm-index)Function:
(defun gen-block-item-thm (old new vartys-pre vartys-post const-new thm-index hints) (declare (xargs :guard (and (block-itemp old) (block-itemp new) (c::ident-type-mapp vartys-pre) (c::ident-type-mapp vartys-post) (symbolp const-new) (posp thm-index) (true-listp hints)))) (declare (xargs :guard (and (block-item-unambp old) (block-item-annop old) (block-item-unambp new) (block-item-annop new)))) (let ((__function__ 'gen-block-item-thm)) (declare (ignorable __function__)) (b* ((old (block-item-fix old)) (new (block-item-fix new)) ((unless (block-item-formalp old)) (raise "Internal error: ~x0 is not in the formalized subset." old) (mv '(_) nil 1)) ((unless (block-item-formalp new)) (raise "Internal error: ~x0 is not in the formalized subset." new) (mv '(_) nil 1)) (types (block-item-types old)) ((unless (equal (block-item-types new) types)) (raise "Internal error: ~ the types ~x0 of the new block item ~x1 differ from ~ the types ~x2 of the old block item ~x3." (block-item-types new) new types old) (mv '(_) nil 1)) (vars-pre (gen-var-assertions vartys-pre 'compst)) (vars-post (gen-var-assertions vartys-post 'old-compst)) ((mv & old-item) (ldm-block-item old)) ((mv & new-item) (ldm-block-item new)) ((mv & ctypes) (ldm-type-option-set types)) (formula (cons 'b* (cons (cons (cons 'old-item (cons (cons 'quote (cons old-item 'nil)) 'nil)) (cons (cons 'new-item (cons (cons 'quote (cons new-item 'nil)) 'nil)) '(((mv old-sval old-compst) (c::exec-block-item old-item compst old-fenv limit)) ((mv new-sval new-compst) (c::exec-block-item new-item compst new-fenv limit))))) (cons (cons 'implies (cons (cons 'and (cons '(> (c::compustate-frames-number compst) 0) (append vars-pre '((not (c::errorp old-sval)))))) (cons (cons 'and (cons '(not (c::errorp new-sval)) (cons '(equal old-sval new-sval) (cons '(equal old-compst new-compst) (cons (cons 'in (cons '(c::type-option-of-stmt-value old-sval) (cons (cons 'quote (cons ctypes 'nil)) 'nil))) vars-post))))) 'nil))) 'nil)))) ((mv thm-name thm-index) (gen-thm-name const-new thm-index)) (thm-event (cons 'defrule (cons thm-name (cons formula (cons ':rule-classes (cons 'nil (cons ':hints (cons hints 'nil))))))))) (mv thm-event thm-name thm-index))))
Theorem:
(defthm pseudo-event-formp-of-gen-block-item-thm.thm-event (b* (((mv ?thm-event ?thm-name ?updated-thm-index) (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints))) (pseudo-event-formp thm-event)) :rule-classes :rewrite)
Theorem:
(defthm symbolp-of-gen-block-item-thm.thm-name (b* (((mv ?thm-event ?thm-name ?updated-thm-index) (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints))) (symbolp thm-name)) :rule-classes :rewrite)
Theorem:
(defthm posp-of-gen-block-item-thm.updated-thm-index (b* (((mv ?thm-event ?thm-name ?updated-thm-index) (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints))) (posp updated-thm-index)) :rule-classes :rewrite)
Theorem:
(defthm gen-block-item-thm-of-block-item-fix-old (equal (gen-block-item-thm (block-item-fix old) new vartys-pre vartys-post const-new thm-index hints) (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints)))
Theorem:
(defthm gen-block-item-thm-block-item-equiv-congruence-on-old (implies (c$::block-item-equiv old old-equiv) (equal (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints) (gen-block-item-thm old-equiv new vartys-pre vartys-post const-new thm-index hints))) :rule-classes :congruence)
Theorem:
(defthm gen-block-item-thm-of-block-item-fix-new (equal (gen-block-item-thm old (block-item-fix new) vartys-pre vartys-post const-new thm-index hints) (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints)))
Theorem:
(defthm gen-block-item-thm-block-item-equiv-congruence-on-new (implies (c$::block-item-equiv new new-equiv) (equal (gen-block-item-thm old new vartys-pre vartys-post const-new thm-index hints) (gen-block-item-thm old new-equiv vartys-pre vartys-post const-new thm-index hints))) :rule-classes :congruence)