1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
|
(in-package "ACL2")
(include-book "bcv-model")
(include-book "bcv-simple-model")
(include-book "generic")
;----------------------------------------------------------------------
;; This is not as straightforward as we would like to think:
;;; Because
;;;;; It is not obvious (to us and computer)
;;;;;
;;;;; if one has an instruction that instruction is a member of merged code
;;;;; then, there is we did a bcv-check-step-pre on it at some point
;;;;; during execution.
;;;;;
;;;;; It is not obvious that the stack map recorded into
;;;;; collect-witness-merged-code-safe will not be "masked" by a later stack
;;;;; map declared for the same pc!
;;;;;
;; (defthm merge-code-safe-implies-bcv-check-step-pre-lemma
;; (implies (and (merged-code-safe merged-code sig-frame)
;; (member inst merged-code)
;; (wff-code1 (extract-code merged-code)
;; (g 'pc (car merged-code)))
;; (inst? inst)
;; (equal pc (g 'pc inst))
;; (bound? pc (collect-witness-merged-code-safe
;; merged-code sig-frame)))
;; (bcv-check-step-pre inst
;; (cdr (assoc-equal pc
;; (collect-witness-merged-code-safe
;; merged-code sig-frame)))))
;; :hints (("Goal" :in-theory (e/d (merged-code-safe
;; collect-witness-merged-code-safe)
;; (bcv-check-step-pre inst?
;; sig-frame-compatible
;; stack-map?
;; bcv-execute-step))
;; :do-not '(generalize fertilize)
;; :induct (merged-code-safe merged-code sig-frame))))
(local
(encapsulate ()
(local
(defthm wff-code1-implies-not-member-lemma
(implies (and (wff-code1 code pc)
(< (g 'pc inst) pc))
(not (member inst code)))))
(defthm wff-code1-implies-not-member-lemma-specific
(implies (and (wff-code1 (extract-code merged-code) (+ 1 (g 'pc inst)))
(inst? inst))
(not (member inst (extract-code merged-code))))
:hints (("Goal" :use ((:instance wff-code1-implies-not-member-lemma
(code (extract-code merged-code))
(pc (+ 1 (g 'pc inst)))))
:in-theory (disable wff-code1-implies-not-member-lemma))))))
(local
(defthm inst-not-member-code-not-member-mergedcode-instance
(implies (and (not (member inst (extract-code merged-code)))
(equal (car (last merged-code)) 'END_OF_CODE)
(inst? inst))
(not (member inst merged-code)))))
(local
(defthm merged-code-safe-implies-end-with-end-of-code
(implies (merged-code-safe mergedcode init-frame)
(equal (car (last mergedcode))
'END_OF_CODE))
:hints (("Goal" :in-theory (enable merged-code-safe)))))
(local
(defthm |Subgoal *1/9.7|
(IMPLIES
(AND (MERGED-CODE-SAFE MERGED-CODE sig-frame)
(inst? inst)
(WFF-CODE1 (EXTRACT-CODE MERGED-CODE)
(+ 1 (G 'PC INST))))
(not (MEMBER INST MERGED-CODE)))
:hints (("Goal" :do-not-induct t))))
(defthm merged-code-safe-implies-extract-code-pc-is-same
(implies (and (merged-code-safe merged-code sig-frame)
(stack-map? (car merged-code)))
(equal (g 'pc (car (extract-code merged-code)))
(g 'pc (car merged-code)))))
(defthm merged-code-safe-implies-extract-code-pc-is-same-strong
(implies (merged-code-safe merged-code sig-frame)
(equal (g 'pc (car (extract-code merged-code)))
(g 'pc (car merged-code)))))
;; (local
;; (defthm wff-code1-implies-car-pc
;; (implies (and (wff-code1 code pc)
;; (consp code))
;; (equal (g 'pc (car code)) pc))))
(local
(defthm wff-code1-uniqueness
(IMPLIES
(AND (WFF-CODE1 (EXTRACT-CODE MERGED-CODE4) any)
(MERGED-CODE-SAFE MERGED-CODE4 MERGED-CODE3))
(wff-code1 (extract-code merged-code4)
(g 'pc (car merged-code4))))
:rule-classes :forward-chaining))
;----------------------------------------------------------------------
;
; EXport
(defthm merge-code-safe-implies-bcv-check-step-pre-lemma
(implies (and (merged-code-safe merged-code sig-frame)
(member inst merged-code)
(wff-code1 (extract-code merged-code)
(g 'pc (car merged-code)))
(inst? inst)
(equal pc (g 'pc inst)))
(bcv-check-step-pre inst
(cdr (assoc-equal pc
(collect-witness-merged-code-safe
merged-code sig-frame)))))
:hints (("Goal" :in-theory (e/d (merged-code-safe
collect-witness-merged-code-safe)
(bcv-check-step-pre inst?
sig-frame-compatible
stack-map?
bcv-execute-step))
:do-not '(generalize fertilize)
:induct (merged-code-safe merged-code sig-frame))))
;----------------------------------------------------------------------
(defthm member-extract-code-member-merged-code
(implies (member inst (extract-code merged-code))
(member inst merged-code))
:rule-classes :forward-chaining)
(defthm member-extract-code-implies-inst
(implies (member inst (extract-code merged-code))
(inst? inst))
:rule-classes :forward-chaining)
;----------------------------------------------------------------------
(defthm merge-code-safe-implies-bcv-check-step-pre
(implies (and (merged-code-safe merged-code sig-frame)
(equal (g 'pc sig-frame) 0)
(wff-code (extract-code merged-code))
(member inst (extract-code merged-code))
(equal pc (g 'pc inst)))
(bcv-check-step-pre inst
(cdr (assoc-equal pc
(collect-witness-merged-code-safe
merged-code sig-frame)))))
:hints (("Goal" :in-theory (disable inst? bcv-check-step-pre)
:do-not-induct t)))
;----------------------------------------------------------------------
(defthm wff-code1-uniqueness
(IMPLIES
(AND (WFF-CODE1 (EXTRACT-CODE MERGED-CODE4) any)
(MERGED-CODE-SAFE MERGED-CODE4 MERGED-CODE3))
(wff-code1 (extract-code merged-code4)
(g 'pc (car merged-code4))))
:rule-classes :forward-chaining)
|