Changeset 2783 for src/ERTL/ERTLtoERTLptrOK.ma
 Timestamp:
 Mar 6, 2013, 12:09:52 PM (7 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

src/ERTL/ERTLtoERTLptrOK.ma
r2691 r2783 14 14 (**************************************************************************) 15 15 16 include "ERTL ptr/ERTLtoERTLptr.ma".16 include "ERTL/ERTLToERTLptr.ma". 17 17 include "common/StatusSimulation.ma". 18 18 include "joint/Traces.ma". … … 28 28 joint_abstract_status (mk_prog_params ERTLptr_semantics prog stack_sizes). 29 29 30 definition sigma_map ≝ λ prog : ertl_program. 31 joint_closed_internal_function ERTL (prog_var_names … prog) → label → option label. 32 33 34 definition sigma_pc_opt : 35 ∀ prog : ertl_program. 36 sigma_map prog → program_counter → option program_counter ≝ 37 λprog,sigma,pc. 38 let ge ≝ globalenv_noinit … prog in 30 definition sigma_map ≝ block → label → option label. 31 definition lbl_funct ≝ block → label → option (list label). 32 definition regs_funct ≝ block → label → option (list register). 33 (* 34 definition get_internal_function_from_ident : 35 ∀ p: sem_params. ∀ globals : list ident . ∀ge : genv_t (joint_function p globals). 36 ident → option(joint_closed_internal_function p globals) ≝ 37 λp,globals,ge,id. 38 ! bl ← (find_symbol (joint_function p globals) ge id); 39 ! bl' ← (code_block_of_block bl); 40 ! 〈f,fn〉 ← res_to_opt … (fetch_internal_function ? ge bl'); 41 return fn. 42 *) 43 44 lemma match_reg_elim : ∀ A : Type[0]. ∀ P : A → Prop. ∀ r : region. 45 ∀f : (r = XData) → A. ∀g : (r = Code) → A. (∀ prf : r = XData.P (f prf)) → 46 (∀ prf : r = Code.P (g prf)) → 47 P ((match r return λx.(r = x → ?) with 48 [XData ⇒ f  Code ⇒ g])(refl ? r)). 49 #A #P * #f #g #H1 #H2 normalize nodelta [ @H1  @H2] 50 qed. 51 52 (* 53 lemma get_internal_function_from_ident_ok : 54 ∀p : sem_params. ∀globals : list ident. ∀ge : genv_t (joint_function p globals). 55 ∀bl,f,fn. fetch_internal_function ? ge bl = return 〈f,fn〉 → 56 get_internal_function_from_ident p globals ge f= return fn. 57 #p #globals #ge #bl #f #fn #EQf 58 @('bind_inversion EQf) * #f1 * #fn1 whd in match fetch_function; 59 normalize nodelta #H lapply(opt_eq_from_res ???? H) H #H @('bind_inversion H) H 60 #f2 #EQf2 #H @('bind_inversion H) H #fn2 #EQfn2 whd in ⊢ (??%% → ??%% → ?); 61 #EQ1 #EQ2 destruct whd in match get_internal_function_from_ident; normalize nodelta 62 >(symbol_of_block_rev … EQf2) >m_return_bind 63 cut(code_block_of_block bl = return bl) 64 [ whd in match code_block_of_block; normalize nodelta @match_reg_elim 65 [ >(pi2 ?? bl) #ABS destruct] elim bl #bl1 #EQ #prf % ] #EQbl >EQbl 66 >m_return_bind >EQf % 67 qed. 68 *) 69 70 definition get_sigma : 71 ertl_program → lbl_funct → sigma_map ≝ 72 λprog,f_lbls.λbl,searched. 73 let globals ≝ prog_var_names … prog in 74 let ge ≝ globalenv_noinit … prog in 75 ! bl ← code_block_of_block bl ; 76 ! 〈id,fn〉 ← res_to_opt … (fetch_internal_function … ge bl); 77 !〈res,s〉 ← find ?? (joint_if_code … fn) 78 (λlbl.λ_. match f_lbls bl lbl with 79 [None ⇒ false 80 Some lbls ⇒ 81 match split_on_last … lbls with 82 [None ⇒ eq_identifier … searched lbl 83 Some x ⇒ eq_identifier … searched (\snd x) 84 ] 85 ]); 86 return res. 87 88 definition sigma_pc_opt : 89 ertl_program → lbl_funct → 90 program_counter → option program_counter ≝ 91 λprog,f_lbls,pc. 92 let sigma ≝ get_sigma prog f_lbls in 93 let ertl_ptr_point ≝ point_of_pc ERTLptr_semantics pc in 39 94 if eqZb (block_id (pc_block pc)) (1) then (* check for dummy exit pc *) 40 95 return pc 41 96 else 42 ! 〈i, fd〉 ← res_to_opt … (fetch_internal_function … ge (pc_block pc)) ; 43 ! ertl_ptr_point ← sigma fd (point_of_pc ERTL_semantics pc) ; 44 return pc_of_point 45 ERTLptr_semantics (pc_block pc) ertl_ptr_point. 97 ! ertl_point ← sigma (pc_block pc) ertl_ptr_point; 98 return pc_of_point 99 ERTL_semantics (pc_block pc) ertl_point. 46 100 47 101 definition sigma_stored_pc ≝ 48 λprog, sigma,pc. match sigma_pc_opt prog sigmapc with102 λprog,f_lbls,pc. match sigma_pc_opt prog f_lbls pc with 49 103 [None ⇒ null_pc (pc_offset … pc)  Some x ⇒ x]. 50 104 51 105 52 definition sigma_beval : 53 ∀prog : ertl_program. 54 sigma_map prog → 106 definition sigma_beval : ertl_program → lbl_funct → 55 107 beval → beval ≝ 56 λprog, sigma,bv.108 λprog,f_lbls,bv. 57 109 match bv with 58 [ BVpc pc prt ⇒ match sigma_pc_opt prog sigmapc with110 [ BVpc pc prt ⇒ match sigma_pc_opt prog f_lbls pc with 59 111 [None ⇒ BVundef  Some x ⇒ BVpc x prt] 60 112  _ ⇒ bv 61 113 ]. 62 114 63 (* 64 definition sigma_beval : 65 ∀prog,sigma,bv. 66 sigma_beval_opt prog sigma bv ≠ None ? → beval ≝ 67 λprog,sigma,bv.opt_safe …. 68 *) 69 definition sigma_is : 70 ∀prog : ertl_program. 71 sigma_map prog → 72 internal_stack → internal_stack ≝ 73 λprog,sigma,is. 115 definition sigma_is : ertl_program → lbl_funct → 116 internal_stack → internal_stack ≝ 117 λprog,f_lbls,is. 74 118 match is with 75 119 [ empty_is ⇒ empty_is 76  one_is bv ⇒ one_is (sigma_beval prog sigmabv)120  one_is bv ⇒ one_is (sigma_beval prog f_lbls bv) 77 121  both_is bv1 bv2 ⇒ 78 both_is (sigma_beval prog sigma bv1) (sigma_beval prog sigmabv2)122 both_is (sigma_beval prog f_lbls bv1) (sigma_beval prog f_lbls bv2) 79 123 ]. 80 124 81 125 lemma sigma_is_empty : ∀prog,sigma. 82 126 sigma_is prog sigma empty_is = empty_is. 83 #prog #sigma % 84 qed. 85 86 definition sigma_mem : 87 ∀prog : ertl_program . sigma_map prog → bemem → bemem ≝ 88 λprog,sigma,m. 127 #prog #sigma % qed. 128 129 definition sigma_mem : ertl_program → lbl_funct → 130 bemem → bemem ≝ 131 λprog,f_lbls,m. 89 132 mk_mem 90 133 (λb. … … 94 137 mk_block_contents l h 95 138 (λz.If Zleb l z ∧ Zltb z h then with prf'' do 96 sigma_beval prog sigma(contents (blocks m b) z)139 sigma_beval prog f_lbls (contents (blocks m b) z) 97 140 else BVundef) 98 141 else empty_block OZ OZ) … … 100 143 (nextblock_pos m). 101 144 102 (*DOPPIONE ASSIOMA IN LINEARISE_PROOF.MA *) 103 axiom mem_ext_eq : 104 ∀m1,m2 : mem. 105 (∀b.let bc1 ≝ blocks m1 b in 106 let bc2 ≝ blocks m2 b in 107 low bc1 = low bc2 ∧ high bc1 = high bc2 ∧ 108 ∀z.contents bc1 z = contents bc2 z) → 109 nextblock m1 = nextblock m2 → m1 = m2. 110 111 112 113 inductive id_is_in (A : Type[0]) : Pos → positive_map A → Prop ≝ 114  is_in_root : ∀l,r,opt_a. id_is_in A (one) (pm_node … opt_a l r) 115  is_in_left : ∀l,r,opt_a,x. id_is_in A x l → 116 id_is_in A (p0 x) (pm_node … opt_a l r) 117  is_in_right : ∀l,r,opt_a,x. id_is_in A x r → 118 id_is_in A (p1 x) (pm_node … opt_a l r). 119 120 definition id_is_in : ∀A : Type[0]. ∀tag : identifierTag. 121 identifier_map tag A → identifier tag → Prop ≝ 122 λA,tag,m,id.match id with 123 [an_identifier x ⇒ match m with 124 [an_id_map p ⇒ id_is_in A x p] 125 ]. 126 127 lemma lookup_eq : ∀ A : Type[0]. 128 ∀m,m' : positive_map A. 129 (∀id. lookup_opt A id m = lookup_opt A id m' 130 ∧ (id_is_in A id m ↔ id_is_in A id m')) → m=m'. 131 #A #m elim m 132 [ * [#_ %] #opt_a #l #r #H lapply(H one) normalize * #EQ >EQ * #_ #H1 lapply(H1 ?) [%] 133 H1 H <EQ EQ #H inversion H #l1 #r1 #opt_a1 134 [ #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) 135 *: #pos #H1 #_ #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) 136 ] 137  #opt_a #l #r #Hl #Hr * 138 [ #H lapply(H one) normalize * #EQ >EQ * #H1 #_ lapply(H1 ?) [%] 139 H1 H EQ #H inversion H #l1 #r1 #opt_a1 140 [ #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) 141 *: #pos #H1 #_ #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) 142 ] 143  #opt_a1 #l1 #r1 #H lapply(H one) normalize * #EQ >EQ EQ #_ @eq_f2 [@Hl@Hr] 144 #id [ lapply(H (p0 id))  lapply(H (p1 id))] normalize * #H1 * #H2 #H3 % 145 [1,3: assumption] % #H4 [1,3: lapply(H2 ?) *: lapply(H3 ?)] 146 try %2 try %3 try assumption #H5 inversion H5 #l2 #r2 #opt_a2 147 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ @⊥ 148 [1,3: cut(p0 id ≠ one) [1,3: @(pos_elim … id) /3/] 149 *: cut(p1 id ≠ one) [1,3: @(pos_elim … id) /3/] 150 ] * #H @H assumption 151 *: #pos #H6 #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) 152 #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct(EQ) #_ assumption 153 ] 154 ] 155 ] 156 qed. 157 158 include alias "common/Identifiers.ma". 159 include alias "common/PositiveMap.ma". 160 161 162 lemma p0_neq_one : ∀x: Pos. p0 x ≠ one. 163 #x /3/ 164 qed. 165 166 lemma p1_neq_one : ∀x: Pos. p1 x ≠ one. 167 #x /3/ 168 qed. 169 170 lemma lookup_ok_to_update : ∀ A : Type[0]. 171 ∀ tag : identifierTag. 172 ∀m,m' : identifier_map tag A. ∀id,a. 173 (lookup tag A m' id = Some ? a) → lookup tag A m id ≠ None ? → 174 (∀ id'. id ≠ id' → (lookup tag A m id' = lookup tag A m' id') ∧ 175 (id_is_in A tag m id' ↔ id_is_in A tag m' id')) → 176 update tag A m id a = return m'. 177 #A #tag * #m * #m' * #id #a 178 normalize in ⊢ (%→%→?); lapply id id lapply m' m' elim m 179 [ #m' #id #m_spec' normalize in ⊢ (% → ?); * #EQ @⊥ @EQ %] #opt_a #l #r #Hl #Hr 180 #m' * [*: #x] normalize in ⊢ (%→%→?); #m_spec' 181 [ cases opt_a opt_a [* #H @⊥ @H %] #a1 #_ #H normalize @eq_f @eq_f 182 lapply H H lapply m_spec'; m_spec' lapply a a cases m' 183 [#a normalize #EQ destruct] #opt_a1 #l1 #r1 #a 184 normalize in ⊢ (%→?); #EQ >EQ #H @eq_f2 @lookup_eq #id' 185 [ lapply (H (an_identifier tag (p0 id')) ?) 186  lapply (H (an_identifier tag (p1 id')) ?) 187 ] 188 [1,3:% @(pos_elim … id') [1,3:#H destruct*: #n #IP #H destruct]] 189 * normalize #H1 * #H2 #H3 % [1,3: >H1 %] % #H4 190 [1,3: lapply(H2 ?) *: lapply(H3 ?)] try %2 try %3 try assumption 191 #H5 inversion H5 #l2 #r2 #opt_a2 192 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ @⊥ 193 [1,3: cut(p0 id' ≠ one) [1,3: /3/] 194 *: cut(p1 id' ≠ one) [1,3: /3/] 195 ] >EQ * #H @H % 196 *: #pos #H6 #_ #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 destruct(EQ1) 197 #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 destruct(EQ1) #_ assumption 198 ] 199 *: #H lapply m_spec' m_spec' cases m' m' [1,3: normalize #EQ destruct] 200 #opt_a1 #l1 #r1 normalize in ⊢ (% → ?); #H1 #H2 201 [ lapply(Hr ?? H1 H ?)  lapply(Hl ?? H1 H ?)] 202 [1,3: * #y * #y_spec 203 [lapply(H2 (an_identifier tag (p1 y)) ?)  lapply(H2 (an_identifier tag (p0 y)) ?)] 204 [1,3: % #EQ destruct @y_spec %] * normalize #H3 * #H4 #H5 % // % #H6 205 [1,3: lapply(H4 ?) *: lapply (H5 ?)] try %2 try %3 try assumption 206 #H7 inversion H7 #l2 #r2 #opt_a2 207 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ @⊥ 208 [1,3: cut(p1 y ≠ one) [1,3: /3/] 209 *: cut(p0 y ≠ one) [1,3: /3/] 210 ] >EQ * #H @H % 211 *: #pos #H6 #_ #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 212 destruct(EQ1) #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 213 destruct(EQ1) #_ assumption 214 ] 215 2,4: normalize cases(update A x a ?) normalize [2,4: #pos_map] 216 #EQ destruct @eq_f @eq_f lapply(H2 (an_identifier tag one) ?) 217 [1,3: % #EQ destruct] * normalize #EQ >EQ #_ @eq_f2 [2,3: %] 218 @lookup_eq #id' 219 [lapply (H2 (an_identifier tag (p0 id')) ?)  220 lapply (H2 (an_identifier tag (p1 id')) ?) ] 221 [1,3: % #EQ1 destruct] * normalize #H3 * #H4 #H5 % // % #H6 222 [1,3: lapply(H4 ?) *: lapply(H5 ?)] try %2 try %3 try assumption 223 #H7 inversion H7 #l2 #r2 #opt_a2 224 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ @⊥ 225 [1,3: cut(p0 id' ≠ one) [1,3: /3/] 226 *: cut(p1 id' ≠ one) [1,3: /3/] 227 ] >EQ * #H @H % 228 *: #pos #H6 #_ #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 229 destruct(EQ1) #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 230 destruct(EQ1) #_ assumption 231 ] 232 ] 233 ] 234 qed. 235 236 lemma update_ok_to_lookup : ∀ A : Type[0]. 237 ∀ tag : identifierTag. 238 ∀m,m' : identifier_map tag A. ∀id,a. 239 update tag A m id a = return m' → 240 (lookup tag A m' id = Some ? a) ∧ lookup tag A m id ≠ None ? ∧ 241 (∀ id'. id ≠ id' → (lookup tag A m id' = lookup tag A m' id') ∧ 242 (id_is_in A tag m id' ↔ id_is_in A tag m' id')). 243 #A #tag * #m * #m' * #id #a 244 whd in ⊢ (??%% → ?); inversion(update A ???) normalize nodelta [#_ #ABS destruct] 245 #m1 #m1_spec #EQ destruct % [%] 246 [ normalize @(update_lookup_opt_same … m1_spec) 247 3: * #id' * #id_spec' normalize % 248 [@(update_lookup_opt_other … m1_spec ??) % #EQ @id_spec' >EQ %] 249 lapply id_spec' lapply m1_spec id_spec' m1_spec 250 (*cases id [*:#x] id normalize*) lapply m' m' lapply id lapply id' id id' 251 elim m [#id' #id #m' cases id [*: #x] normalize #EQ destruct] 252 #opt_a #l #r #Hl #Hr #id' #id #m' cases id [*:#x] id normalize 253 [ cases opt_a [2:#a] normalize #EQ destruct cases id' [#H @⊥ @H %] 254 #x #_ normalize % #H [1,2: %3 *: %2] 255 inversion H #l1 #r1 #opt_a1 256 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) #EQ1 @⊥ 257 [1,2: cut(p1 x ≠ one) [1,3: @(pos_elim … x) /3/] 258 *: cut(p0 x ≠ one) [1,3: @(pos_elim … x) /3/] 259 ] 260 * #H @H >EQ1 // 261 *: #pos #H1 #_ #EQ lapply(jmeq_to_eq ??? EQ) #EQ1 destruct(EQ1) 262 #EQ lapply(jmeq_to_eq ??? EQ) #EQ1 destruct(EQ1) #_ assumption 263 ] 264 *: inversion(update A x a ?) normalize [1,3: #_ #EQ destruct] #pos_map 265 #pos_map_spec #EQ destruct #id_spec' % #H 266 inversion H #l1 #l2 #opt_a1 267 [1,4,7,10: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ 268 #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 destruct(EQ1) 269 #H1 % 270 *: #pos #H1 #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ 271 #EQ1 lapply(jmeq_to_eq ??? EQ1) EQ1 #EQ1 destruct(EQ1) 272 #H2 try %2 try %3 try assumption 273 [ @(proj1 … (Hr ? ? pos_map pos_map_spec ?)) [#EQ1 destruct @id_spec' %] 274  @(proj2 … (Hr ? ? l2 pos_map_spec ?)) [#EQ1 destruct @id_spec' %] 275  @(proj1 … (Hl ? ? pos_map pos_map_spec ?)) [#EQ1 destruct @id_spec' %] 276  @(proj2 … (Hl ? ? l1 pos_map_spec ?)) [#EQ1 destruct @id_spec' %] 277 ] 278 assumption 279 ] 280 ] 281  % normalize lapply m1_spec lapply id lapply m' id m' elim m 282 [#m' * [*: #x] normalize #EQ destruct] #opt_a #l #r #Hl #Hr #m' * [*: #x] 283 normalize [ cases opt_a [2:#a] normalize #EQ1 #EQ2 destruct] 284 inversion (update A x a ?) [1,3: #_ normalize #EQ destruct] 285 #pos_map #EQpos_map normalize #EQ destruct [@Hr@Hl] assumption 286 ] 287 qed. 288 289 290 (* 291 292 lemma update_lookup_after : ∀ A : Type[0]. 293 ∀ tag : identifierTag. 294 ∀m,m' : identifier_map tag A. ∀id,a. 295 update tag A m id a = return m' → 296 lookup tag A m' id = Some ? a. 297 #A #B #tag * #m1 * #id #a whd in ⊢ (??%% → ?); inversion(update A ???) 298 normalize nodelta [#_ #EQ destruct] #pos_map #pos_map_spec #EQ destruct 299 @(update_lookup_opt_same … pos_map_spec) 300 qed. 301 302 lemma p0_neq_one : ∀x: Pos. p0 x ≠ one. 303 #x /3/ 304 qed. 305 306 lemma p1_neq_one : ∀x: Pos. p1 x ≠ one. 307 #x /3/ 308 qed. 309 310 lemma id_is_in_map : ∀ A,B : Type[0]. ∀tag : identifierTag. 311 ∀m : identifier_map tag A. 312 ∀ F : (∀a:A.(Σid. lookup tag A m id = Some A a) → B). 313 ∀id. id_is_in A tag m id ↔ id_is_in B tag (map_inf1 A B tag m F) id. 314 #A #B #tag * #m elim m 315 [ #F * #id % normalize #H inversion H #l #r #opt_a 316 [1,4: #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct 317 *: #pos #H1 #_ #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct 318 ] 319  * [2:#a] #l #r #Hl #Hr #F ** [1,4: *:#x] normalize % #H try % try %2 try %3 320 [1,2,5,6: cases(Hr ? (an_identifier tag x)) *: cases (Hl ? (an_identifier tag x))] 321 [2,4,6,8,10,12,14,16: #a1 ** #id1 #prf1 @F try(@a1) 322 try(%{(an_identifier tag (p1 id1))} assumption) 323 try(%{(an_identifier tag (p0 id1))} assumption) ] 324 try(#H1 #_ @H1) try(#_ #H1 @H1) H1 Hl Hr inversion H #l1 #r1 #opt_a1 325 [1,4,7,10,13,16,19,22: #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ @⊥ 326 [1,2,3,4: lapply(p1_neq_one x) 327 *: lapply(p0_neq_one x) 328 ] * #H @H >EQ % 329 *: #pos #H1 #_ #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct 330 #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQ destruct #_ assumption 331 ] 332 ] 333 qed. 334 335 lemma map_update_commute : ∀ A, B : Type[0]. 336 ∀tag : identifierTag. 337 ∀m1,m2 : identifier_map tag A. 338 ∀id,a. 339 update tag A m1 id a = return m2 → 340 ∀ F : (∀a:A.(Σid. lookup tag A m1 id = Some A a) → B). 341 ∀ F': (∀a:A.(Σid. lookup tag A m2 id = Some A a) → B). 342 (∀a',id',prf,prf'. F a' «id',prf» = F' a' «id',prf'») → ∃prf. 343 update tag B (map_inf1 A B tag m1 F) id (F' a «id,prf») = 344 return map_inf1 A B tag m2 F'. 345 #A #B #tag #m1 #m2 #id #a #m2_spec #F #F' #eqFF' % 346 [ @hide_prf cases(update_lookup_previous A tag m1 m2 id a) #H1 #_ cases (H1 m2_spec) 347 * #H1 #H2 #H3 assumption 348  cases(update_lookup_previous B tag (map_inf1 A B tag m1 F) 349 (map_inf1 A B tag m2 F') id (F' a «id,?»)) 350 [ #_ #H @H ] cases(update_lookup_previous A tag m1 m2 id a) #H2 #INUTILE 351 cases(H2 m2_spec) * #H3 #H4 #H5 % [%] 352 [ >(lookup_map … H3) % 353  elim H4 H4 #H4 % #H5 @H4 lapply H5 cases m1 in F; m1 #m1 cases id id 354 elim m1 [ #id #F normalize * %] #a1 #l #r #Hl #Hr * [*:#x] #F normalize 355 [ cases a1 in F; [2: #a2] #F normalize [2: * %] #EQ destruct 356 *: #H 357 [@(Hr x ??)  @(Hl x ??)] 358 [1,3:#a ** #id1 #prf1 @F [1,3: @a] 359 [%{(an_identifier tag (p1 id1))}%{(an_identifier tag (p0 id1))}] 360 normalize assumption 361 *: normalize @H 362 ] 363 ] 364  #id' #id_spec' lapply(H5 id' id_spec') * #H6 * #H7 #H8 % 365 [ lapply H6 inversion (lookup tag A m2 id') 366 [2: #w] #w_spec #EQ >(lookup_map … EQ) normalize nodelta 367 >(lookup_map … w_spec) normalize nodelta [2: %] @eq_f @eqFF' 368  cases(id_is_in_map A B tag m1 F id') cases(id_is_in_map A B tag m2 F' id') 369 #H9 #H10 #H11 #H12 % #H13 [ @H9 @H7 @H12 assumption  @H11 @H8 @H10 assumption] 370 ] 371 ] 372 qed. 373 374 (* 375 definition well_formed_register_env : 376 ∀prog : ertl_program .∀sigma : (sigma_map prog). 377 register_env beval → Prop ≝ 378 λprog,sigma,psd_reg.∀id,bv. lookup ?? psd_reg id = Some ? bv → 379 sigma_beval_opt prog sigma bv ≠ None ?. 380 *) 381 *) 382 383 definition map : ∀tag,A,B. identifier_map tag A → (A → B) → identifier_map tag B ≝ 384 λtag,A,B,m,f.match m with 385 [an_id_map p ⇒ an_id_map … (map ?? f p)]. 386 387 lemma lookup_map : ∀A,B : Type[0]. 388 ∀tag : identifierTag. 389 ∀m : identifier_map tag A. 390 ∀ f:A → B. 391 ∀ id. 392 lookup tag B (map tag A B m f) id = 393 ! a ← lookup tag A m id; return f a. 394 #A #B #tag * #m #f * #id normalize >lookup_opt_map % 395 qed. 396 397 lemma update_leaf_fail: ∀tag,A,i,v. 398 update tag A (empty_map ??) i v = Error ? [MSG MissingId; CTX … i]. 399 #ta #A ** [*: #x] #v normalize % 400 qed. 401 402 lemma update_def : ∀tag,A,m,i,v. 403 update tag A m i v = 404 match lookup tag A m i with 405 [ Some _ ⇒ OK ? (add tag A m i v) 406  None ⇒ Error ? [MSG MissingId; CTX … i] 407 ]. 408 #tag #A #m #i #v inversion(update tag A m i v) 409 [ #m' #EQm' cases(update_ok_to_lookup ?????? EQm') * #_ 410 #H #_ elim H cases(lookup tag A m i) [#H @⊥ @H %] 411 #x #_ normalize <EQm' lapply EQm' cases i cases m cases m' m m' i 412 normalize #m' #m #i inversion(update A i v m) normalize [#_ #ABS destruct] 413 #m'' #EQm'' #EQ destruct(EQ) @eq_f @eq_f lapply EQm'' EQm'' lapply i i 414 lapply m' m' elim m [#m' * [2,3: #z] normalize #EQ destruct] 415 #opt_a #l #r #Hl #Hr #m' * [2,3: #z] normalize 416 [3: cases opt_a normalize [2: #y] #EQ destruct % 417 *: inversion(update A z v ?) [2,4: #m''] #EQm'' normalize #EQ destruct 418 [<(Hr … EQm'')  <(Hl … EQm'')] % 419 ] 420  #err cases m m cases i i #i #m normalize inversion(update A i v m) [2:#m'] 421 #EQerr normalize #EQ destruct lapply EQerr lapply i elim m 422 [ normalize #x #_ %] #opt_a #l #r #Hl #Hr * [2,3:#z] normalize 423 [3: cases opt_a [2:#w] normalize #EQ destruct % 424 *: inversion(update A z v ?) [2,4: #m'] #EQm' normalize #EQ destruct 425 [lapply(Hr … EQm')  lapply(Hl … EQm')] cases(lookup_opt A z ?) [2,4: #a] 426 normalize #EQ destruct % 427 ] 428 ] 429 qed. 430 431 lemma map_add : ∀tag : identifierTag.∀A,B : Type[0].∀ f: A → B.∀m,id,v. 432 map tag A B (add tag A m id v) f = add tag B (map tag A B m f) id (f v). 433 #tag #A #B #f * #m * #id #v normalize @eq_f lapply v v lapply id id elim m 434 [ #id elim id [#v %] #x #IH #id normalize >IH normalize inversion(pm_set ? ? ? ?) 435 normalize // cases x normalize [2,3,5,6: #y] #EQ destruct 436  #opt_a #l #r #Hl #Hr * [2,3: #x #v normalize cases opt_a normalize [2: #a %] 437 cases (map_opt ? ? ? l) normalize [2: //] cases (map_opt ? ? ? r) normalize 438 //] #v normalize cases opt_a [2,4: #a] normalize // 439 [ cases(map_opt ? ? ? l) normalize // >Hr cases(map_opt ? ? ? r) normalize 440 [2: #opt_b #lb #rb] inversion(pm_set B x ? ?) normalize // cases x [2,3,5,6: #y] 441 normalize #EQ destruct 442  >Hl cases(map_opt ? ? ? l) normalize [2: #opt_b #lb #rb] 443 inversion (pm_set B x ? ?) normalize // 444 [1,2: cases x [2,3,5,6: #y] normalize #EQ destruct] 445 #opt_b' #lb' #rb' #_ normalize #_ #EQ cases(map_opt ? ? ? r) 446 normalize nodelta [%] #opt_b'' #lb'' #rb'' >EQ % 447 ] 448 qed. 449 450 451 definition restrict : ∀tag.∀A,B. 452 identifier_map tag A → identifier_map tag B → identifier_map tag A ≝ 453 λtag,A,B,m1,m2.an_id_map … 454 (merge A B A (λo,o'.match o' with [None ⇒ None ?  Some _ ⇒ o]) 455 (match m1 with [an_id_map p1 ⇒ p1]) 456 (match m2 with [an_id_map p2 ⇒ p2])). 457 458 interpretation "identifier map restriction" 'intersects a b = (restrict ??? a b). 459 460 unification hint 0 ≔ tag ; R ≟ identifier tag ⊢ list R ≡ list (identifier tag). 461 462 lemma map_update_commute : ∀tag : identifierTag.∀A,B : Type[0].∀f : A → B. ∀m,id,v. 463 update tag B (map tag A B m f) id (f v) = 464 !m' ← update tag A m id v; return map tag A B m' f. 465 #tag #A #B #f #m #id #v >update_def >update_def >lookup_map 466 cases (lookup tag A m id) [%] #a >m_return_bind >m_return_bind normalize nodelta 467 whd in ⊢ (???%); @eq_f @sym_eq @map_add 468 qed. 469 470 definition is_leaf ≝ λA.λpm : positive_map A. 471 match pm with [ pm_leaf ⇒ true  _ ⇒ false ]. 472 (* 473 let rec pm_clean A (pm : positive_map A) on pm : positive_map A ≝ 474 match pm with 475 [ pm_leaf ⇒ pm_leaf ? 476  pm_node o l r ⇒ 477 let l' ≝ pm_clean … l in 478 let r' ≝ pm_clean … r in 479 match o with 480 [ Some _ ⇒ pm_node … o l' r' 481  None ⇒ 482 if is_leaf … l' ∧ is_leaf … r' then pm_leaf ? else 483 pm_node … o l' r' 484 ] 485 ]. 486 487 definition clean ≝ λtag,A.λm : identifier_map tag A. 488 match m with [ an_id_map pm ⇒ an_id_map tag A (pm_clean … pm) ]. 489 *) 145 include "common/ExtraIdentifiers.ma". 146 490 147 491 148 definition sigma_register_env : 492 ∀prog : ertl_program.∀sigma : (sigma_map prog). 493 register_env beval → list register → register_env beval ≝ 494 λprog,sigma,psd_env,ids. 495 let m' ≝ map ??? psd_env (λbv.sigma_beval prog sigma bv) in 149 ertl_program → lbl_funct → 150 list register → 151 register_env beval → register_env beval ≝ 152 λprog,f_lbls,ids,psd_env. 153 let m' ≝ map ??? psd_env (λbv.sigma_beval prog f_lbls bv) in 496 154 m' ∖ ids. 497 155 498 (* 499 definition well_formed_ertl_psd_env : 500 ∀prog : ertl_program. ∀sigma : (sigma_map prog). 501 ertl_psd_env → Prop≝ 502 λprog,sigma,psd_env.well_formed_register_env prog sigma (psd_regs psd_env). 503 *) 504 (* 505 let rec well_formed_frames 506 (prog : ertl_program) (sigma : (sigma_map prog)) 507 (l : list ertl_psd_env) on l : Prop ≝ 508 match l with 509 [nil ⇒ True 510  cons a tl ⇒ well_formed_ertl_psd_env prog sigma a ∧ 511 well_formed_frames prog sigma tl 512 ]. 513 *) 514 515 516 lemma lookup_restrict : ∀tag,A,B.∀a : identifier_map tag A.∀b : identifier_map tag B. 517 ∀i.lookup ?? (a ∩ b) i = if i ∈ b then lookup … a i else None ?. 518 #tag #A #B * #a * #b * #i normalize >lookup_opt_merge [2: %] cases (lookup_opt B i b) 519 [2: #b] normalize % qed. 520 521 522 lemma lookup_set_minus : ∀tag,A,B. ∀a : identifier_map tag A. ∀b : identifier_map tag B. 523 ∀i. lookup ?? (a ∖ b) i = if i ∈ b then None ? else lookup … a i. 524 #tag #A #B * #a * #b * #i normalize >lookup_opt_merge [2: %] cases(lookup_opt B i b) 525 [2: #b] % qed. 526 527 (* 528 lemma clean_add : ∀tag,A,m,i,v.clean … (add tag A m i v) = add tag A (clean … m) i v. 529 #tag #A * #m * #i #v normalize @eq_f 530 lapply m m 531 elim i i 532 [ * [%] 533 * [2: #x] #l #r [%] normalize 534 cases (pm_clean A l) normalize // cases (pm_clean A r) // 535 *: #i #IH * normalize 536 [1,3: >IH cases i // ] 537 * [2,4: #x] #l #r normalize 538 [1,2: >IH % ] 539 >IH cases i cases (pm_clean A l) cases (pm_clean A r) normalize // 540 ] 541 qed. 542 543 lemma clean_lookup : ∀tag,A,m,i.lookup … (clean tag A m) i = lookup … m i. 544 #tag #A * #m * #i normalize lapply i i elim m 545 [#i %] * [2: #a] #l #r #Hl #Hr * [2,3,5,6: #x] normalize in ⊢ (???%); 546 [1,3:<Hr2,4:<Hl] normalize try % [3: @if_elim #_ %] 547 cases(pm_clean A l) in Hl; normalize 548 [2: #opt_a1 #l1 #r1 #_ % 549 3: #H cases(pm_clean A r) normalize // 550  #H cases(pm_clean A r) in Hr; normalize // 551  #opt_a1 #l1 #r1 #H cases x normalize // 552 ] 553 qed. 554 555 556 lemma clean_update : ∀tag,A,m,i,v. 557 ! m' ← update tag A m i v; return clean … m' = 558 update tag A (clean … m) i v. 559 #tag #A #m #i #v 560 >update_def >update_def >clean_lookup cases (lookup tag A m i) 561 [ % ] 562 #m' >m_return_bind normalize nodelta >clean_add % 563 qed. 564 *) 565 lemma lookup_eq_id_map : ∀tag : identifierTag. ∀ A : Type[0]. 566 ∀m,m' : identifier_map tag A. 567 (∀id. lookup … m id = lookup … m' id 568 ∧ (id_is_in A tag m id ↔ id_is_in A tag m' id)) → m=m'. 569 #tag #A * #m * #m' #H @eq_f @lookup_eq #id lapply(H (an_identifier tag id)) 570 * #H1 #H2 % // assumption 571 qed. 572 573 (* 574 lemma clean_leaf : ∀tag : identifierTag . ∀ A : Type[0]. 575 ∀m : identifier_map tag A. (∀ id. lookup … m id = None ?) → 576 clean ?? m = empty_map ??. 577 #tag #A * #m elim m [#_ %] #opt_a #l #r #Hl #Hr #H normalize @eq_f 578 lapply(H (an_identifier tag one)) normalize #EQ >EQ EQ normalize 579 lapply(Hl ?) [2: lapply(Hr ?)] 580 [1,3: * #id [lapply(H (an_identifier tag (p1 id)))  lapply(H (an_identifier tag (p0 id)))] 581 #H assumption 582  normalize #EQ #EQ1 destruct >e0 >e1 normalize % 583 ] 584 qed. 585 *) 586 lemma id_is_in_lookup : ∀tag,A,m,id,v. 587 lookup tag A m id = Some ? v → id_is_in A tag m id. 588 #tag #A * #m * #id #a normalize lapply m m elim id 589 [*: #x #IH] * normalize [1,3,5: #EQ destruct] #opt_a #l #r [ #_ %] #H [%3 %2] 590 @IH assumption 591 qed. 592 (* 593 lemma pm_clean_leaf : ∀ A : Type[0]. 594 ∀m : positive_map A. (∀ id. lookup_opt … id m = None ?) → 595 pm_clean ? m = pm_leaf …. 596 #A #m elim m [ #id %] #opt_a #l #r #Hl #Hr #H normalize lapply(H one) normalize 597 #EQ >EQ normalize >Hl [normalize >Hr [ %]] #id [@(H (p1 id))@(H (p0 id))] 598 qed. 599 600 601 lemma pm_clean_canonic : ∀A,m,n.(∀i.lookup_opt A i m = lookup_opt A i n) → 602 pm_clean ? m = pm_clean ? n. 603 #A #m #n lapply m m elim n 604 [ @pm_clean_leaf ] 605 * [2: #x] #l #r #IHl #IHr * 606 [1,3: #H @sym_eq @pm_clean_leaf #id @sym_eq @H ] #opt #l' #r' #H 607 lapply (H one) normalize in ⊢ (%→?); #EQ destruct 608 whd in ⊢ (??%%); 609 >(IHl l') [1,3: >(IHr r') [1,3 : % ]] #i 610 [1,2: @(H (p1 i)) *: @(H (p0 i)) ] qed. 611 612 613 lemma clean_canonic : ∀tag,A,m,n.(∀i.lookup tag A m i = lookup tag A n i) → 614 clean ?? m = clean ?? n. 615 #tag #A * #m * #n #H normalize @eq_f @pm_clean_canonic #i 616 lapply(H (an_identifier tag i)) 617 normalize // 618 qed. 619 *) 620 lemma update_fail_lookup : ∀tag,A,m,i,v,e.update tag A m i v = Error … e → 621 e = [MSG MissingId; CTX … i] ∧ lookup … m i = None ?. 622 #tag #A #m #i #v #errmsg >update_def cases(lookup tag A m i) [2: #a] normalize 623 #EQ destruct % // 624 qed. 625 626 lemma lookup_hit_update : ∀tag,A,m,i,v.i ∈ m → 627 ∃m'.update tag A m i v = OK ? m'. 628 #tag #A #m #i #v #H % [2: >update_def lapply(in_map_domain … m i) >H * #v #EQ >EQ 629 normalize %] 630 qed. 631 632 lemma lookup_miss_update : ∀tag,A,m,i,v.lookup tag A m i = None ? → 633 update … m i v = Error … [MSG MissingId; CTX … i]. 634 #tag #A #m #i #v #EQ >update_def >EQ normalize % 635 qed. 636 637 lemma update_ok_old_lookup : ∀tag,A,m,i,v,m'.update tag A m i v = OK ? m' → 638 i ∈ m. 639 #tag #A #m #i #v #m' >update_def inversion(lookup tag A m i) [2: #a] #EQ normalize 640 #EQ destruct >EQ normalize @I 641 qed. 642 643 lemma lookup_update_ok : ∀tag,A,m,i,v,m',i'.update tag A m i v = OK ? m' → 644 lookup … m' i' = if eq_identifier ? i' i then Some ? v else lookup … m i'. 645 #tag #A #m #i #v #m' #i' >update_def inversion(lookup tag A m i) [2: #a] #EQ 646 normalize nodelta #EQ1 destruct @eq_identifier_elim 647 [ #H normalize nodelta >H @lookup_add_hit 648  #H normalize nodelta @lookup_add_miss assumption 649 ] 650 qed. 651 652 lemma mem_set_restrict : ∀tag,A,B.∀a : identifier_map tag A.∀b : identifier_map tag B. 653 ∀i.i ∈ a ∩ b = (i ∈ a ∧ i ∈ b). 654 #tag #A #B * #a * #b * #i normalize >lookup_opt_merge [2: %] cases(lookup_opt B i b) 655 [2: #a1] normalize [2: @if_elim #_ %] cases(lookup_opt A i a) [2: #a2] normalize % 656 qed. 657 (* 658 lemma merge_eq : ∀A.∀p : positive_map A.∀choice. merge 659 *) 660 (* 661 lemma add_restrict : ∀tag,A,B.∀a : identifier_map tag A. ∀b : identifier_map tag B. 662 ∀i,v.i∈b → add tag A (a ∩ b) i v = (add tag A a i v) ∩ b. 663 #tag #A #B * #a * #b * #i #v normalize inversion(lookup_opt B i b) normalize [#_ *] 664 #v1 #EQv1 * @eq_f lapply EQv1 lapply v1 lapply a lapply b a b v1 elim i normalize 665 [ * normalize [#b #v #EQ destruct] #opt_a #l #r * 666 [#v #EQ destruct normalize %] #opt_b #l1 #r1 #v #EQ destruct normalize cases opt_b 667 normalize [2: #x %] cases(merge A B A ? l1 l) normalize [2: #opt_a2 #l2 #r2 %] 668 cases(merge A B A ? r1 r) // 669 *: #x #IH * [2,4: #opt_b #l1 #r1] #p1 normalize [3,4: #i #EQ destruct] cases p1 p1 670 [2,4: #opt_a #l2 #r2] normalize #v #H cases opt_b [2,4,6,8: #b] normalize 671 [1,2,5,6: <IH try assumption [1,2: cases opt_a [2,4: #a] normalize try %] 672 cases(merge A B A ? l2 l1) normalize // lapply H [1,4: cases r1 *: cases l1] 673 normalize [1,3,5,7,9,11: #EQ destruct] #opt_b4 #l4 #r4 cases x normalize 674 [1,4,7,10,13,16: #EQ destruct normalize // cases(merge A B A ? ? ?) normalize //] 675 #x #H normalize cases(merge A B A ? ? ?) normalize // 676 *: <IH try assumption 677 [1,3: cases(map_opt ? ? ? l1) normalize // lapply H cases r1 normalize 678 [1,3: #EQ destruct] #opt_b2 #l2 #r2 cases x [1,4: //] #x normalize // 679 *: lapply H cases x normalize [2,3,5,6: #y] cases l1 normalize 680 [1,3,5,7,9,11: #EQ destruct] #opt_b2 #l2 #r2 #H // 681 ] 682 ] 683 ] 684 qed. 685 686 lemma update_restrict : ∀tag,A,B.∀a : identifier_map tag A.∀b : identifier_map tag B. 687 ∀i,v.i ∈ b → update ?? (a ∩ b) i v = 688 ! a' ← update ?? a i v ; return a' ∩ b. 689 #tag #A #B #a #b #id #v #H 690 lapply (in_map_domain … b id) >H * #ignore #EQ_lookup_b 691 (*<clean_update*) 692 inversion (update tag A a id v) 693 [2: #e #EQ cases (update_fail_lookup ?????? EQ) #EQ1 #EQ2 destruct 694 >lookup_miss_update [%] 695 >lookup_restrict >H assumption ] 696 #m' #EQ >m_return_bind 697 cases (lookup_hit_update ?? (a∩b) id v ?) 698 [2: >mem_set_restrict >H >(update_ok_old_lookup ?????? EQ) % ] 699 #m'' >update_def >update_def in EQ; >lookup_restrict >H normalize nodelta 700 cases(lookup tag A a id) normalize nodelta [#ABS destruct] #v1 #EQ #EQ'' destruct 701 whd in ⊢ (??%%); @eq_f @add_restrict assumption 702 qed. 703 *) 704 lemma add_set_minus : ∀tag,A,B.∀a : identifier_map tag A.∀b : identifier_map tag B. 705 ∀i,v.¬(i ∈ b) → add tag A (a ∖ b) i v = (add tag A a i v) ∖ b. 706 #tag #A #B * #a * #b * #i #v @notb_elim @if_elim normalize [#_ *] 707 @if_elim [2: #_ *] @if_elim [#_ *] inversion(lookup_opt B i b) normalize [2: #x #_ *] 708 #H * * * * @eq_f lapply H H lapply v v lapply b b lapply a a elim i 709 [ * 710 [ * [2: #opt_b #l #r] #v normalize in ⊢ (% → ?); #EQ destruct [2: %] 711 normalize in ⊢ (??%%); cases (map_opt ??? l) // normalize cases(map_opt ??? r) 712 normalize // 713  * [2: #a] #l #r * [2,4: #opt_b #l1 #r1] #v normalize in ⊢ (% → ?); #EQ destruct 714 normalize [3: % 1,2: cases(merge ???? l l1) // cases(merge ???? r r1) //] 715 cases(map_opt ??? l) normalize // cases(map_opt ??? r) // 716 ] 717 2,3: #x #IH * [2,4: #opt_a #l #r] * [2,4,6,8: #opt_b #l1 #r1] #v 718 normalize in ⊢ (% → ?); #H whd in match (pm_set ????) in ⊢ (???%); 719 whd in match (merge ??????) in ⊢ (???%); 720 [1,2,3,4: <IH try assumption whd in match (pm_set ????) in ⊢ (??%?); 721 whd in match (merge ??????) in ⊢ (??%?); cases opt_b normalize 722 [2,4,6,8: #b] [5,6: cases opt_a normalize //] 723 [1,2,3,4: cases (merge ???? l l1) normalize [2,4,6,8: #opt_a2 #l2 #r2] 724 // cases (merge ???? r r1) normalize 725 [2,4,6,8,10,12: #opt_a3 #l3 #r3] inversion(pm_set ????) 726 normalize // cases x 727 [2,3,5,6,8,9,11,12,14,15,17,18,20,21,23,24 : #y] 728 normalize #EQ destruct 729 *: cases(map_opt ??? l1) normalize [2,4,6,8: #opt_a2 #l2 #r2] // 730 cases(map_opt ??? r1) normalize [2,4,6,8,10,12: #opt_a3 #l3 #r3] 731 inversion(pm_set ????) normalize // cases x 732 [2,3,5,6,8,9,11,12,14,15,17,18,20,21,23,24 : #y] 733 normalize #EQ destruct 734 ] 735 *: whd in match (pm_set ????) in ⊢ (??%?); 736 whd in match (merge ??????) in ⊢ (??%?); [1,2: cases opt_a [2,4: #a]] 737 normalize 738 [1,2: @eq_f2 [1,4:%]  cases(map_opt ??? l) [2: #opt_a1 #l1 #r1] normalize 739  cases(map_opt ??? r) [2: #opt_a1 #l1 #r1] normalize] 740 [1,3,4: lapply(map_add tag A A (λx.x) (an_id_map … r) (an_identifier ? x) v) 741 2,5,6: lapply(map_add tag A A (λx.x) (an_id_map … l) (an_identifier ? x) v) 742 *: lapply(map_add tag A A (λx.x) (an_id_map … (pm_leaf ?)) (an_identifier ? x) v) 743 ] normalize #EQ destruct >e0 try % [4,5: cases x [2,3,5,6: #y] normalize %] 744 cases(map_opt ????) [2,4,6: #opt_a1 #l1 #r1] normalize 745 inversion(pm_set ????) normalize // cases x [2,3,5,6,8,9,11,12: #y] 746 normalize #EQ1 destruct 747 ] 748 ] 749 qed. 750 751 lemma update_set_minus : ∀tag,A,B.∀a : identifier_map tag A.∀b : identifier_map tag B. 752 ∀i,v.¬(i ∈ b) → update ?? (a ∖ b) i v = 753 ! a' ← update ?? a i v ; return a' ∖ b. 754 #tag #A #B #a #b #id #v #H >update_def >lookup_set_minus @if_elim 755 [ #H1 @⊥ lapply H1 lapply H @notb_elim >H1 normalize *] #_ >update_def 756 cases (lookup tag A a id) normalize [ %] #a @eq_f @add_set_minus assumption 757 qed. 758 759 760 record good_state_transformation 761 (prog : ertl_program) 762 (def_in : joint_closed_internal_function ERTL (prog_var_names ?? prog)) : 763 Type[0] ≝ 764 { f_lbls : label → option (list label) 765 ; f_regs : label → option (list register) 766 ; part_partition_f_lbls : partial_partition … f_lbls 767 ; part_partion_f_regs : partial_partition … f_regs 768 ; freshness_lab : let def_out ≝ translate_internal … def_in in 769 (∀l.opt_All … (All … 770 (λlbl.¬fresh_for_univ … lbl (joint_if_luniverse … def_in) ∧ 771 fresh_for_univ … lbl (joint_if_luniverse … def_out))) (f_lbls l)) 772 ; freshness_regs : let def_out ≝ translate_internal … def_in in 773 (∀l.opt_All … (All … 774 (λreg.¬fresh_for_univ … reg (joint_if_runiverse … def_in) ∧ 775 fresh_for_univ … reg (joint_if_runiverse … def_out))) (f_regs l)) 776 ; multi_fetch_ok : let def_out ≝ translate_internal … def_in in 777 let f_step ≝ translate_step ? in 778 let f_fin ≝ translate_fin_step ? in 779 ∀l,s.stmt_at … (joint_if_code … def_in) l = Some ? s → 780 ∃lbls,regs.f_lbls l = Some ? lbls ∧ f_regs l = Some ? regs ∧ 781 match s with 782 [ sequential s' nxt ⇒ 783 l ~❨f_step l s', lbls, regs❩~> nxt in joint_if_code … def_out 784  final s' ⇒ 785 l ~❨f_fin l s', lbls, regs❩~> it in joint_if_code … def_out 786  FCOND abs _ _ _ ⇒ Ⓧabs 787 ] 788 }. 789 790 definition get_internal_function_from_ident : 791 ∀ p: sem_params. ∀ globals : list ident . ∀ge : genv_t (joint_function p globals). 792 ident → option (joint_closed_internal_function p globals) ≝ 793 λp,globals,ge,id. 794 ! bl ← (find_symbol (joint_function p globals) ge id); 795 ! bl' ← (code_block_of_block bl); 796 ! 〈f,fn〉 ← res_to_opt … (fetch_internal_function ? ge bl'); 797 return fn. 798 799 definition get_sigma_from_good_state : 800 ∀prog : ertl_program. 801 (∀ fn : joint_closed_internal_function ERTL (prog_var_names ?? prog). 802 good_state_transformation prog fn) → sigma_map prog ≝ 803 λprog,good,fn,searched. 804 !〈res,s〉 ← find ?? (joint_if_code … fn) 805 (λlbl.λ_. match (f_lbls … (good fn)) lbl with 806 [None ⇒ false 807 Some lbls ⇒ 808 match lbls with 809 [nil ⇒ eq_identifier … searched lbl 810 cons hd tl ⇒ let last ≝ last_ne … «hd::tl,I» in 811 eq_identifier … searched last 812 ] 813 ]); 814 return res. 815 816 817 definition sigma_frames : ∀prog : ertl_program. 818 (∀fn.good_state_transformation prog fn) → 819 list (register_env beval × ident) → (list (register_env beval × ident)) ≝ 820 λprog,good,frms. 821 let sigma ≝ get_sigma_from_good_state … good in 822 foldr ?? 823 (λx,tl.let 〈reg_env,id〉 ≝ x in 824 match get_internal_function_from_ident 825 ERTL_semantics (prog_var_names … prog) 826 (globalenv_noinit … prog) id with 827 [Some fn ⇒ 828 〈(sigma_register_env prog sigma reg_env 829 (added_registers … fn (f_regs … (good fn)))),id〉 :: tl 830 None ⇒ [ ] 831 ]) ([ ]) frms. 832 833 834 (* 835 lemma sigma_empty_frames_commute : 836 ∀prog : ertl_program. ∀ sigma : (sigma_map prog). 837 ∃prf. 838 sigma_frames prog sigma [] prf = []. 839 #p #s % normalize % 840 qed. 841 842 843 let rec sigma_bit_vector_trie_opt (prog : ertl_program) 844 (sigma : (sigma_map prog)) (n : nat) (t : BitVectorTrie beval n) 845 on t : option … (BitVectorTrie beval n) ≝ 846 match t with 847 [Leaf bv ⇒ ! bv' ← (sigma_beval_opt prog sigma bv); 848 return Leaf … bv' 849 Node n1 b1 b2 ⇒ ! b1' ← (sigma_bit_vector_trie_opt prog sigma n1 b1); 850 ! b2' ← (sigma_bit_vector_trie_opt prog sigma n1 b2); 851 return Node … n1 b1' b2' 852 Stub n1 ⇒ return Stub … n1 853 ]. 854 855 856 definition well_formed_hw_register_env : 857 ∀ prog : ertl_program. ∀ sigma : (sigma_map prog). 858 hw_register_env → Prop ≝ 859 λprog,sigma,regs.sigma_bit_vector_trie_opt prog sigma 6 (reg_env … regs) ≠ None ?. 860 *) 861 862 156 157 definition sigma_frames_opt : ertl_program → 158 lbl_funct → regs_funct → 159 list (register_env beval × (Σb:block.block_region b=Code)) → 160 option (list (register_env beval × (Σb:block.block_region b=Code))) ≝ 161 λprog,f_lbls,f_regs,frms. 162 let globals ≝ prog_var_names … prog in 163 let ge ≝ globalenv_noinit … prog in 164 m_list_map ? ? ? 165 (λx.let 〈reg_env,bl〉 ≝ x in 166 ! 〈id,fn〉 ← res_to_opt … (fetch_internal_function … ge bl); 167 return 〈sigma_register_env prog f_lbls 168 (added_registers ERTL globals fn (f_regs bl)) reg_env,bl〉) frms. 169 170 definition sigma_frames : ertl_program → 171 lbl_funct → regs_funct → 172 option (list (register_env beval × (Σb:block.block_region b=Code))) → 173 option (list (register_env beval × (Σb:block.block_region b=Code))) ≝ 174 λprog,f_lbls,f_regs,frms. 175 ! frames ← frms; 176 sigma_frames_opt prog f_lbls f_regs frames. 177 863 178 include "common/BitVectorTrieMap.ma". 864 179 865 definition sigma_hw_register_env : 866 ∀prog: ertl_program. ∀sigma : (sigma_map prog). 867 hw_register_env → hw_register_env ≝ 868 λprog,sigma,h_reg.mk_hw_register_env 869 (map ? ? (sigma_beval prog sigma) 6 (reg_env … h_reg)) (other_bit … h_reg). 870 871 872 definition sigma_regs : 873 ∀prog : ertl_program. ∀sigma : (sigma_map prog). 874 (register_env beval)×hw_register_env→ list register → 180 definition sigma_hw_register_env :ertl_program → 181 lbl_funct → hw_register_env → hw_register_env ≝ 182 λprog,f_lbls,h_reg.mk_hw_register_env 183 (map ? ? (sigma_beval prog f_lbls) 6 (reg_env … h_reg)) (other_bit … h_reg). 184 185 definition sigma_regs :ertl_program → 186 lbl_funct → list register → 187 (register_env beval)×hw_register_env→ 875 188 (register_env beval)×hw_register_env ≝ 876 λprog,sigma,regs,ids.let 〈x,y〉≝ regs in 877 〈sigma_register_env prog sigma x ids, 878 sigma_hw_register_env prog sigma y〉. 879 (* 880 lemma sigma_empty_regsT_commute : 881 ∀prog : ertl_program. ∀sigma : (sigma_map prog). 882 ∀ptr.∃ prf. 883 empty_regsT ERTLptr_semantics ptr = 884 sigma_regs prog sigma (empty_regsT ERTL_semantics ptr) prf. 885 #prog #sigma #ptr % 886 [ @hide_prf whd in match well_formed_regs; normalize nodelta % 887 [whd in match well_formed_ertl_psd_env; normalize nodelta #id #bv 888 normalize in ⊢ (%→?); #EQ destruct 889  normalize % #EQ destruct 890 ] 891  % ] 892 qed. 893 894 axiom sigma_load_sp_commute : 895 ∀prog : ertl_program.∀sigma : (sigma_map prog). 896 ∀regs,ptr. 897 load_sp ERTL_semantics regs = return ptr 898 → ∃prf. 899 load_sp ERTLptr_semantics (sigma_regs prog sigma regs prf) = return ptr. 900 901 axiom sigma_save_sp_commute : 902 ∀prog : ertl_program. ∀sigma : (sigma_map prog). 903 ∀reg,ptr,prf1. ∃prf2. 904 save_sp ERTLptr_semantics (sigma_regs prog sigma reg prf1) ptr = 905 sigma_regs prog sigma (save_sp ERTL_semantics reg ptr) prf2. 906 907 definition well_formed_state : 908 ∀prog : ertl_program. ∀sigma : sigma_map prog. 909 state ERTL_semantics → Prop ≝ 910 λprog,sigma,st. 911 well_formed_frames prog sigma (st_frms … st) ∧ 912 sigma_is_opt prog sigma (istack … st) ≠ None ? ∧ 913 well_formed_regs prog sigma (regs … st) ∧ 914 well_formed_mem prog sigma (m … st). 915 *) 916 917 definition sigma_state : ∀prog : ertl_program. 918 (∀fn.good_state_transformation prog fn) → 919 state ERTLptr_semantics → list register → 920 state ERTL_semantics ≝ 921 λprog,good,st,ids. 922 let sigma ≝ get_sigma_from_good_state … good in 923 mk_state ? 924 (sigma_frames prog good (st_frms ERTLptr_semantics st)) 925 (sigma_is ? sigma (istack … st)) 926 (carry … st) 927 (sigma_regs ? sigma (regs … st) ids) 928 (sigma_mem ? sigma (m … st)). 929 189 λprog,f_lbls,ids,regs.let 〈x,y〉≝ regs in 190 〈sigma_register_env prog f_lbls ids x, 191 sigma_hw_register_env prog f_lbls y〉. 930 192 931 193 definition dummy_state : state ERTL_semantics ≝ 932 194 mk_state ERTL_semantics 933 [ ] empty_is BBundef 〈empty_map ? ?,mk_hw_register_env … (Stub …) BBundef〉 empty. 195 (None ?) empty_is BBundef 〈empty_map ? ?,mk_hw_register_env … (Stub …) BBundef〉 empty. 196 197 definition sigma_state : ertl_program → 198 lbl_funct → regs_funct → list register → 199 state ERTLptr_semantics → state ERTL_semantics ≝ 200 λprog,f_lbls,f_regs,restr,st. 201 mk_state ERTL_semantics 202 (sigma_frames prog f_lbls f_regs (st_frms ERTLptr_semantics st)) 203 (sigma_is prog f_lbls (istack … st)) 204 (carry … st) 205 (sigma_regs prog f_lbls restr (regs … st)) 206 (sigma_mem prog f_lbls (m … st)). 934 207 935 208 definition dummy_state_pc : state_pc ERTL_semantics ≝ 936 209 mk_state_pc ? dummy_state (null_pc one) (null_pc one). 937 210 938 definition sigma_state_pc : 939 ∀prog : ertl_program. 940 (∀fn.good_state_transformation prog fn) → 941 state_pc ERTLptr_semantics → 942 state_pc ERTL_semantics ≝ 943 λprog,good,st. 944 let sigma ≝ get_sigma_from_good_state … good in 945 let ge ≝ globalenv_noinit … prog in 946 if eqZb (block_id (pc_block (pc … st))) (1) then (* check for dummy pc *) 947 dummy_state_pc 948 else 949 match (fetch_internal_function (joint_closed_internal_function ERTL 950 (prog_var_names (joint_function ERTL) ℕ prog)) ge (pc_block (pc … st))) with 951 [OK x ⇒ let 〈i,fd〉 ≝ x in 952 mk_state_pc ? 953 (sigma_state prog good st (added_registers … fd (f_regs … (good fd)))) 954 (pc … st) (sigma_stored_pc prog sigma (last_pop … st)) 955 Error msg ⇒ dummy_state_pc]. 956 957 958 definition ERTLptrStatusSimulation : 959 ∀ prog : ertl_program. 960 let trans_prog ≝ ertl_to_ertlptr prog in 961 ∀stack_sizes.(∀fn.good_state_transformation prog fn) → 962 status_rel (ERTL_status prog stack_sizes) (ERTLptr_status trans_prog stack_sizes) ≝ 963 λprog,stack_sizes,good. 964 let trans_prog ≝ ertl_to_ertlptr prog in 965 mk_status_rel ?? 966 (* sem_rel ≝ *) (λs1:ERTL_status prog stack_sizes 967 .λs2:ERTLptr_status trans_prog stack_sizes 968 .s1=sigma_state_pc prog good s2) 969 (* call_rel ≝ *) 970 (λs1:Σs:ERTL_status prog stack_sizes 971 .as_classifier (ERTL_status prog stack_sizes) s cl_call 972 .λs2:Σs:ERTLptr_status trans_prog stack_sizes 973 .as_classifier (ERTLptr_status trans_prog stack_sizes) s cl_call 974 .let sigma ≝ get_sigma_from_good_state … good in 975 pc (mk_prog_params ERTL_semantics prog stack_sizes) s1 976 =sigma_stored_pc prog sigma 977 (pc 978 (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_sizes) 979 s2)) 980 (* sim_final ≝ *) ?. 981 cases daemon 982 qed. 983 984 lemma fetch_function_no_minus_one : 985 ∀F,V,i,p,bl. 986 block_id (pi1 … bl) = 1 → 987 fetch_function … (globalenv (λvars.fundef (F vars)) V i p) 988 bl = Error … [MSG BadFunction]. 989 #F#V#i#p ** #r #id #EQ1 destruct 990 whd in match fetch_function; normalize nodelta 991 >globalenv_no_minus_one 992 cases (symbol_for_block ???) normalize // 993 qed. 994 995 lemma fetch_function_no_zero : 996 ∀F,V,i,p,bl. 997 block_id (pi1 … bl) = 0 → 998 fetch_function … (globalenv (λvars.fundef (F vars)) V i p) 999 bl = Error … [MSG BadFunction]. 1000 #F#V#i#p ** #r #id #EQ1 destruct 1001 whd in match fetch_function; normalize nodelta 1002 >globalenv_no_zero 1003 cases (symbol_for_block ???) normalize // 1004 qed. 1005 1006 (*DOPPIONI dei LEMMI in LINEARISE_PROOF*) 1007 lemma symbol_for_block_match: 1008 ∀M:matching.∀initV,initW. 1009 (∀v,w. match_var_entry M v w → 1010 size_init_data_list (initV (\snd v)) = size_init_data_list (initW (\snd w))) → 1011 ∀p: program (m_A M) (m_V M). ∀p': program (m_B M) (m_W M). 1012 ∀MATCH:match_program … M p p'. 1013 ∀b: block. 1014 symbol_for_block … (globalenv … initW p') b = 1015 symbol_for_block … (globalenv … initV p) b. 1016 * #A #B #V #W #match_fn #match_var #initV #initW #H 1017 #p #p' * #Mvars #Mfn #Mmain 1018 #b 1019 whd in match symbol_for_block; normalize nodelta 1020 whd in match globalenv in ⊢ (???%); normalize nodelta 1021 whd in match (globalenv_allocmem ????); 1022 change with (add_globals ?????) in match (foldl ?????); 1023 >(proj1 … (add_globals_match … initW … Mvars)) 1024 [ % *:] 1025 [ * #idr #v * #idr' #w #MVE % 1026 [ inversion MVE 1027 #H1 #H2 #H3 #H4 #H5 #H6 #H7 #H8 destruct % 1028  @(H … MVE) 1029 ] 1030  @(matching_fns_get_same_blocks … Mfn) 1031 #f #g @match_funct_entry_id 1032 ] 1033 qed. 1034 1035 lemma symbol_for_block_transf : 1036 ∀A,B,V,init.∀prog_in : program A V. 1037 ∀trans : ∀vars.A vars → B vars. 1038 let prog_out ≝ transform_program … prog_in trans in 1039 ∀bl. 1040 symbol_for_block … (globalenv … init prog_out) bl = 1041 symbol_for_block … (globalenv … init prog_in) bl. 1042 #A #B #V #iV #p #tf @(symbol_for_block_match … (transform_program_match … tf ?)) 1043 #v0 #w0 * // 1044 qed. 1045 1046 lemma fetch_function_transf : 1047 ∀A,B,V,init.∀prog_in : program A V. 1048 ∀trans : ∀vars.A vars → B vars. 1049 let prog_out ≝ transform_program … prog_in trans in 1050 ∀bl,i,f. 1051 fetch_function … (globalenv … init prog_in) bl = 1052 return 〈i, f〉 1053 → fetch_function … (globalenv … init prog_out) bl = 1054 return 〈i, trans … f〉. 1055 #A #B #V #init #prog_in #trans #bl #i #f 1056 whd in match fetch_function; normalize nodelta 1057 #H lapply (opt_eq_from_res ???? H) H 1058 #H @('bind_inversion H) H #id #eq_symbol_for_block 1059 #H @('bind_inversion H) H #fd #eq_find_funct 1060 whd in ⊢ (??%?→?); #EQ destruct(EQ) 1061 >(symbol_for_block_transf … trans) >eq_symbol_for_block >m_return_bind 1062 >(find_funct_ptr_transf A B … eq_find_funct) % 1063 qed. 1064 1065 1066 lemma fetch_internal_function_transf : 1067 ∀A,B.∀prog_in : program (λvars.fundef (A vars)) ℕ. 1068 ∀trans : ∀vars.A vars → B vars. 1069 let prog_out ≝ transform_program … prog_in (λvars.transf_fundef … (trans vars)) in 1070 ∀bl,i,f. 1071 fetch_internal_function … (globalenv_noinit … prog_in) bl = 1072 return 〈i, f〉 1073 → fetch_internal_function … (globalenv_noinit … prog_out) bl = 1074 return 〈i, trans … f〉. 1075 #A #B #prog #trans #bl #i #f 1076 whd in match fetch_internal_function; normalize nodelta 1077 #H @('bind_inversion H) * #id * #fd normalize nodelta #EQfetch 1078 whd in ⊢ (??%%→?); #EQ destruct(EQ) 1079 >(fetch_function_transf … EQfetch) % 1080 qed. 1081 1082 (* 1083 definition good_local_sigma : 1084 ∀globals. 1085 ∀g:codeT ERTLptr globals. 1086 (Σl.bool_to_Prop (code_has_label … g l)) → 1087 codeT ERTL globals → 1088 (label → option label) → Prop ≝ 1089 λglobals,g,c,sigma. 1090 ∀l,l'.sigma l = Some ? l' → 1091 ∃s. stmt_at … g l = Some ? s ∧ 1092 All ? (λl.sigma l ≠ None ?) (stmt_labels … s) ∧ 1093 (match s with 1094 [ sequential s' nxt ⇒ 1095 match s' with 1096 [ step_seq _ ⇒ 1097 (stmt_at … c n = Some ? (sequential … s' it)) ∧ 1098 ((sigma nxt = Some ? (S n)) ∨ 1099 (stmt_at … c (S n) = Some ? (GOTO … nxt))) 1100  COND a ltrue ⇒ 1101 (stmt_at … c n = Some ? (sequential … s' it) ∧ sigma nxt = Some ? (S n)) ∨ 1102 (stmt_at … c n = Some ? (FCOND … I a ltrue nxt)) 1103 ] 1104  final s' ⇒ 1105 stmt_at … c n = Some ? (final … s') 1106  FCOND abs _ _ _ ⇒ Ⓧabs 1107 ]). 1108 1109 *) 211 definition sigma_state_pc : ertl_program → lbl_funct → regs_funct → 212 state_pc ERTLptr_semantics → state_pc ERTL_semantics ≝ 213 λprog,f_lbls,f_regs,st. 214 let ge ≝ globalenv_noinit … prog in 215 let globals ≝ prog_var_names … prog in 216 match fetch_internal_function … ge (pc_block (pc … st)) with 217 [ OK y ⇒ let 〈i,fn〉 ≝ y in 218 let added ≝ added_registers ERTL globals fn 219 (f_regs (pc_block (pc … st))) in 220 mk_state_pc ? 221 (sigma_state prog f_lbls f_regs added st) 222 (pc … st) (sigma_stored_pc prog f_lbls (last_pop … st)) 223  Error e ⇒ dummy_state_pc 224 ]. 225 1110 226 1111 227 lemma ps_reg_retrieve_ok : ∀prog : ertl_program. 1112 ∀ sigma : sigma_map prog. ∀r,restr.228 ∀f_lbls : lbl_funct. ∀r,restr. 1113 229 preserving1 ?? res_preserve1 … 1114 ( λregs.sigma_regs prog sigma regs restr)1115 (sigma_beval prog sigma)230 (sigma_regs prog f_lbls restr) 231 (sigma_beval prog f_lbls) 1116 232 (λregs.ps_reg_retrieve regs r) 1117 233 (λregs.ps_reg_retrieve regs r). 1118 #prog # sigma#r #restr * #psd_r #hw_r whd in match ps_reg_retrieve;234 #prog #f_lbls #r #restr * #psd_r #hw_r whd in match ps_reg_retrieve; 1119 235 whd in match reg_retrieve; normalize nodelta @opt_to_res_preserve1 1120 236 whd in match sigma_regs; whd in match sigma_register_env; normalize nodelta … … 1125 241 1126 242 lemma hw_reg_retrieve_ok : ∀prog : ertl_program. 1127 ∀ sigma : sigma_map prog. ∀r,restr.243 ∀f_lbls : lbl_funct. ∀r,restr. 1128 244 preserving1 ?? res_preserve1 … 1129 ( λregs.sigma_regs prog sigma regs restr)1130 (sigma_beval prog sigma)245 (sigma_regs prog f_lbls restr) 246 (sigma_beval prog f_lbls) 1131 247 (λregs.hw_reg_retrieve regs r) 1132 248 (λregs.hw_reg_retrieve regs r). 1133 #prog # sigma#r #restr * #psd_r * #hw_r #b whd in match hw_reg_retrieve;249 #prog #f_lbls #r #restr * #psd_r * #hw_r #b whd in match hw_reg_retrieve; 1134 250 whd in match hwreg_retrieve; normalize nodelta whd in match sigma_regs; 1135 251 whd in match sigma_hw_register_env; normalize nodelta 1136 change with (sigma_beval prog sigmaBVundef) in ⊢ (???????(??(?????%))?);252 change with (sigma_beval prog f_lbls BVundef) in ⊢ (???????(??(?????%))?); 1137 253 #bv >lookup_map whd in ⊢ (???% → ?); #EQ destruct 1138 254 %{(lookup beval 6 (bitvector_of_register r) hw_r BVundef)} … … 1142 258 1143 259 lemma ps_reg_store_ok : ∀prog : ertl_program. 1144 ∀sigma : sigma_map prog. ∀r,restr. 260 ∀f_lbls : lbl_funct. ∀r,restr. 261 ¬(r ∈ (set_from_list RegisterTag restr)) → 1145 262 preserving21 ?? res_preserve1 … 1146 (sigma_beval prog sigma)1147 ( λregs.sigma_regs prog sigma regs restr)1148 ( λregs.sigma_regs prog sigma regs restr)263 (sigma_beval prog f_lbls) 264 (sigma_regs prog f_lbls restr) 265 (sigma_regs prog f_lbls restr) 1149 266 (ps_reg_store r) 1150 267 (ps_reg_store r). 1151 #prog # sigma #r #restrwhd in match ps_reg_store; normalize nodelta268 #prog #f_lbls #r #restr #Hreg whd in match ps_reg_store; normalize nodelta 1152 269 #bv * #psd_r #hw_r @mfr_bind1 1153 [ @( λr.sigma_register_env prog sigma rrestr)270 [ @(sigma_register_env prog f_lbls restr) 1154 271  whd in match reg_store; whd in match sigma_regs; normalize nodelta 1155 #x #x_spec lapply(update_ok_to_lookup ?????? x_spec) * * #_ #EQpsd #_ 272 #x #x_spec %{(add RegisterTag beval psd_r r bv)} % // whd in x_spec : (???%); 273 destruct whd in match sigma_register_env; normalize nodelta >map_add 274 >add_set_minus [%  assumption] 275  #z @mfr_return_eq1 % 276 qed. 277 (* 278 lapply(update_ok_to_lookup ?????? x_spec) * * #_ #EQpsd #_ 1156 279 lapply x_spec x_spec lapply EQpsd EQpsd whd in match sigma_register_env; 1157 280 normalize nodelta >lookup_set_minus @if_elim [ #_ * #H @⊥ @H %] … … 1162 285 whd in ⊢ (???% → ?); #EQ destruct %{〈x,hw_r〉} % // 1163 286 ] 1164 qed. 287 qed.*) 1165 288 1166 289 1167 290 lemma hw_reg_store_ok : ∀prog : ertl_program. 1168 ∀ sigma : sigma_map prog. ∀r,restr.291 ∀f_lbls : lbl_funct. ∀r,restr. 1169 292 preserving21 ?? res_preserve1 … 1170 (sigma_beval prog sigma)1171 ( λregs.sigma_regs prog sigma regs restr)1172 ( λregs.sigma_regs prog sigma regs restr)293 (sigma_beval prog f_lbls) 294 (sigma_regs prog f_lbls restr) 295 (sigma_regs prog f_lbls restr) 1173 296 (hw_reg_store r) 1174 297 (hw_reg_store r). 1175 298 #prog #sigma #r #restr whd in match hw_reg_store; normalize nodelta 1176 #bv * #psd_r * #hw_r #b whd in match hwreg_store; whd in match sigma_regs; normalize nodelta 299 #bv * #psd_r * #hw_r #b whd in match hwreg_store; whd in match sigma_regs; 300 normalize nodelta 1177 301 whd in match sigma_hw_register_env; normalize nodelta <insert_map * #psd_r' 1178 302 * #hw_r' #b' whd in ⊢ (???% → ?); #EQ destruct % [2: % [%] % ] 1179 303 qed. 1180 304 305 definition move_dst_not_fresh : list register → move_dst → Prop ≝ 306 λrestr,mv.match mv with 307 [PSD r ⇒ bool_to_Prop (¬(r ∈ (set_from_list RegisterTag restr))) 308  _ ⇒ True 309 ]. 1181 310 1182 311 lemma ertl_eval_move_ok : ∀prog : ertl_program. 1183 ∀sigma : sigma_map prog. ∀ restr,pm. 312 ∀f_lbls : lbl_funct. ∀ restr,pm. 313 move_dst_not_fresh restr (\fst pm) → 1184 314 preserving1 ?? res_preserve1 … 1185 ( λregs.sigma_regs prog sigma regs restr)1186 ( λregs.sigma_regs prog sigma regs restr)315 (sigma_regs prog f_lbls restr) 316 (sigma_regs prog f_lbls restr) 1187 317 (λregs.ertl_eval_move regs pm) 1188 318 (λregs.ertl_eval_move regs pm). 1189 #prog #sigma #restr * #mv_dst #arg_dst # pm whd in match ertl_eval_move;319 #prog #sigma #restr * #mv_dst #arg_dst #Hpm #pm whd in match ertl_eval_move; 1190 320 normalize nodelta @mfr_bind1 [@(sigma_beval prog sigma) 1191 321  cases arg_dst normalize nodelta … … 1193 323 @mfr_return1] 1194 324 * #r normalize nodelta [@ps_reg_retrieve_ok @hw_reg_retrieve_ok] 1195  #bv cases mv_dst #r normalize nodelta [@ps_reg_store_ok  @hw_reg_store_ok] 325  #bv cases mv_dst in Hpm; #r #Hpm normalize nodelta [@ps_reg_store_ok assumption 326  @hw_reg_store_ok 327 ] 1196 328 ] 1197 329 qed. 1198 330 1199 331 lemma ps_arg_retrieve_ok : ∀prog : ertl_program. 1200 ∀ sigma : sigma_map prog. ∀a,restr.332 ∀f_lbls : lbl_funct. ∀a,restr. 1201 333 preserving1 ?? res_preserve1 … 1202 ( λregs.sigma_regs prog sigma regs restr)1203 (sigma_beval prog sigma)334 (sigma_regs prog f_lbls restr) 335 (sigma_beval prog f_lbls) 1204 336 (λregs.ps_arg_retrieve regs a) 1205 337 (λregs.ps_arg_retrieve regs a). … … 1213 345 1214 346 lemma pop_ok : 1215 ∀prog : ertl_program. 1216 ∀good : (∀fn.good_state_transformation prog fn). 1217 ∀restr. 347 ∀prog : ertl_program.∀f_lbls : lbl_funct. 348 ∀f_regs : regs_funct.∀restr. 1218 349 preserving1 ?? res_preserve1 ???? 1219 ( λst.sigma_state prog good strestr)350 (sigma_state prog f_lbls f_regs restr) 1220 351 (λx.let 〈bv,st〉 ≝ x in 1221 〈let sigma ≝ get_sigma_from_good_state … good in 1222 sigma_beval prog sigma bv, 1223 sigma_state prog good st restr〉) 352 〈sigma_beval prog f_lbls bv, 353 sigma_state prog f_lbls f_regs restr st〉) 1224 354 (pop ERTL_semantics) 1225 355 (pop ERTLptr_semantics). 1226 #prog # good #restrwhd in match pop; normalize nodelta #st @mfr_bind1356 #prog #f_lbls #f_regs #id whd in match pop; normalize nodelta #st @mfr_bind1 1227 357 [@(λx.let 〈bv,is〉 ≝ x in 1228 let sigma ≝ get_sigma_from_good_state … good in 1229 〈sigma_beval prog sigma bv, 1230 sigma_is prog sigma is 〉) 1231  whd in match is_pop; normalize nodelta whd in match sigma_state; normalize nodelta 1232 cases(istack ? st) normalize nodelta 358 〈sigma_beval prog f_lbls bv, 359 sigma_is prog f_lbls is 〉) 360  whd in match is_pop; normalize nodelta whd in match sigma_state; 361 normalize nodelta cases(istack ? st) normalize nodelta 1233 362 [@res_preserve_error1 1234 363 2,3: #bv1 [2: #bv2] * #bv3 #is1 whd in ⊢ (??%% → ?); #EQ destruct 1235 364 % [2,4: % [1,3: %*: %] *:] 1236 365 ] 1237  * #bv #is * #bv1 #st whd in ⊢ (??%% → ?); #EQ destruct % [2: % [%] %]366  * #bv #is normalize nodelta @mfr_return_eq1 % 1238 367 ] 1239 368 qed. … … 1241 370 lemma push_ok : 1242 371 ∀prog : ertl_program. 1243 ∀ good : (∀fn.good_state_transformation prog fn).1244 ∀ restr.372 ∀f_lbls : lbl_funct. 373 ∀f_regs : regs_funct.∀restr. 1245 374 preserving21 ?? res_preserve1 … 1246 ( λst.sigma_state prog good strestr)1247 ( let sigma ≝ get_sigma_from_good_state … good in sigma_beval prog sigma)1248 ( λst.sigma_state prog good strestr)375 (sigma_state prog f_lbls f_regs restr) 376 (sigma_beval prog f_lbls) 377 (sigma_state prog f_lbls f_regs restr) 1249 378 (push ERTL_semantics) 1250 379 (push ERTLptr_semantics). 1251 #prog # good#restr whd in match push; normalize nodelta #st #bv @mfr_bind11252 [ @( let sigma ≝ get_sigma_from_good_state … good in sigma_is ? sigma)380 #prog #f_lbls #f_regs #restr whd in match push; normalize nodelta #st #bv @mfr_bind1 381 [ @(sigma_is prog f_lbls) 1253 382  whd in match is_push; normalize nodelta whd in match sigma_state; normalize nodelta 1254 383 cases (istack ? st) [2,3: #bv [2: #bv']] whd in match sigma_is in ⊢ (???????%?); … … 1259 388 1260 389 lemma be_opaccs_ok : 1261 ∀prog : ertl_program. ∀sigma : sigma_map prog. 1262 ∀ op. 390 ∀prog : ertl_program. ∀f_lbls : lbl_funct. ∀ op. 1263 391 preserving21 ?? res_preserve1 ?????? 1264 (sigma_beval prog sigma)1265 (sigma_beval prog sigma)392 (sigma_beval prog f_lbls) 393 (sigma_beval prog f_lbls) 1266 394 (λx.let 〈bv1,bv2〉 ≝ x in 1267 〈sigma_beval prog sigmabv1,1268 sigma_beval prog sigmabv2〉)395 〈sigma_beval prog f_lbls bv1, 396 sigma_beval prog f_lbls bv2〉) 1269 397 (be_opaccs op) 1270 398 (be_opaccs op). … … 1290 418 qed. 1291 419 1292 lemma be_op1_ok : ∀prog : ertl_program. ∀sigma : sigma_map prog.420 lemma be_op1_ok : ∀prog : ertl_program. ∀f_lbls : lbl_funct. 1293 421 ∀ op. 1294 422 preserving1 ?? res_preserve1 … 1295 (sigma_beval prog sigma)1296 (sigma_beval prog sigma)423 (sigma_beval prog f_lbls) 424 (sigma_beval prog f_lbls) 1297 425 (be_op1 op) 1298 426 (be_op1 op). … … 1309 437 qed. 1310 438 1311 lemma res_preserve_error11 : ∀X,Y,F,e,n. (∃e'.n = Error … e') → 1312 res_preserve1 X Y F n (Error … e). 1313 #X #Y #F #e #n * #e' #n_spec >n_spec @res_preserve_error1 1314 qed. 1315 1316 1317 lemma be_op2_ok : ∀prog : ertl_program. ∀sigma : sigma_map prog. 439 440 lemma be_op2_ok : ∀prog : ertl_program. ∀f_lbls : lbl_funct. 1318 441 ∀ b,op. 1319 442 preserving21 ?? res_preserve1 … 1320 (sigma_beval prog sigma)1321 (sigma_beval prog sigma)1322 (λx.let 〈bv,b〉≝ x in 〈sigma_beval prog sigmabv,b〉)443 (sigma_beval prog f_lbls) 444 (sigma_beval prog f_lbls) 445 (λx.let 〈bv,b〉≝ x in 〈sigma_beval prog f_lbls bv,b〉) 1323 446 (be_op2 b op) 1324 447 (be_op2 b op). … … 1365 488 ] normalize nodelta try @res_preserve_error1 1366 489 @mfr_return_eq1 % 1367 3,6,9,12,15,18: #bi cases(op2 ?????) #by #bi1 normalize nodelta490 3,6,9,12,15,18: #bi try(@mfr_return_eq1 %) cases(op2 ?????) #by #bi1 normalize nodelta 1368 491 @mfr_return_eq1 % 1369 492 ] … … 1412 535 qed. 1413 536 1414 lemma pointer_of_address_ok : ∀prog : ertl_program. ∀sigma : sigma_map prog.537 lemma pointer_of_address_ok : ∀prog : ertl_program.∀f_lbls : lbl_funct. 1415 538 preserving1 … res_preserve1 … 1416 (λx.let 〈bv1,bv2〉 ≝ x in〈sigma_beval prog sigmabv1,1417 sigma_beval prog sigmabv2〉)539 (λx.let 〈bv1,bv2〉 ≝ x in〈sigma_beval prog f_lbls bv1, 540 sigma_beval prog f_lbls bv2〉) 1418 541 (λx.x) 1419 542 pointer_of_address pointer_of_address. … … 1432 555 qed. 1433 556 1434 lemma beloadv_ok : ∀prog : ertl_program. ∀ sigma : sigma_map prog.557 lemma beloadv_ok : ∀prog : ertl_program. ∀f_lbls : lbl_funct. 1435 558 ∀ptr. 1436 559 preserving1 … opt_preserve1 … 1437 (sigma_mem prog sigma)1438 (sigma_beval prog sigma)560 (sigma_mem prog f_lbls) 561 (sigma_beval prog f_lbls) 1439 562 (λm.beloadv m ptr) 1440 563 (λm.beloadv m ptr). … … 1450 573 qed. 1451 574 1452 lemma bestorev_ok : ∀prog : ertl_program.∀ sigma : sigma_map prog.575 lemma bestorev_ok : ∀prog : ertl_program.∀f_lbls : lbl_funct. 1453 576 ∀ptr. 1454 577 preserving21 … opt_preserve1 … 1455 (sigma_mem prog sigma)1456 (sigma_beval prog sigma)1457 (sigma_mem prog sigma)578 (sigma_mem prog f_lbls) 579 (sigma_beval prog f_lbls) 580 (sigma_mem prog f_lbls) 1458 581 (λm.bestorev m ptr) 1459 582 (λm.bestorev m ptr). … … 1534 657 qed. 1535 658 1536 lemma match_reg_elim : ∀ A : Type[0]. ∀ P : A → Prop. ∀ r : region.1537 ∀f : (r = XData) → A. ∀g : (r = Code) → A. (∀ prf : r = XData.P (f prf)) →1538 (∀ prf : r = Code.P (g prf)) →1539 P ((match r return λx.(r = x → ?) with1540 [XData ⇒ f  Code ⇒ g])(refl ? r)).1541 #A #P * #f #g #H1 #H2 normalize nodelta [ @H1  @H2]1542 qed.1543 1544 659 1545 660 lemma sp_ok : ∀prog : ertl_program. 1546 ∀ good : (∀fn.good_state_transformation prog fn).1547 ∀ restr.661 ∀f_lbls : lbl_funct. 662 ∀f_regs : regs_funct.∀restr. 1548 663 preserving1 … res_preserve1 … 1549 (λst.sigma_state prog good st restr)664 (λst.sigma_state prog f_lbls f_regs restr st) 1550 665 (λx.x) 1551 666 (sp ERTL_semantics) 1552 667 (sp ERTLptr_semantics). 1553 #prog # good#restr #st whd in match sp; normalize nodelta668 #prog #f_lbls #f_regs #restr #st whd in match sp; normalize nodelta 1554 669 whd in match (load_sp ??); whd in match (load_sp ??); whd in match sigma_state; 1555 670 normalize nodelta whd in match sigma_regs; normalize nodelta … … 1558 673 #pt #EQ lapply(jmeq_to_eq ??? EQ) EQ whd in match hwreg_retrieve; normalize nodelta 1559 674 whd in match sigma_hw_register_env; normalize nodelta 1560 change with (sigma_beval ? (get_sigma_from_good_state … good)BVundef) in ⊢ (??(?(???(?????%)(?????%)))? → ?);675 change with (sigma_beval prog f_lbls BVundef) in ⊢ (??(?(???(?????%)(?????%)))? → ?); 1561 676 >lookup_map >lookup_map 1562 677 cases(lookup beval 6 (bitvector_of_register RegisterSPL) (reg_env hw_r) BVundef) … … 1579 694 1580 695 lemma set_sp_ok : ∀prog : ertl_program. 1581 ∀ good : (∀fn.good_state_transformation prog fn).1582 ∀ restr.∀ptr,st.1583 set_sp ? ptr (sigma_state prog good st restr) =1584 sigma_state prog good (set_sp ? ptr st) restr.1585 #prog # good#restr #ptr #st whd in match set_sp; whd in match sigma_state;696 ∀f_lbls : lbl_funct. 697 ∀f_regs : regs_funct.∀restr.∀ptr,st. 698 set_sp ? ptr (sigma_state prog f_lbls f_regs restr st) = 699 sigma_state prog f_lbls f_regs restr (set_sp ? ptr st). 700 #prog #f_lbls #f_regs #restr #ptr #st whd in match set_sp; whd in match sigma_state; 1586 701 normalize nodelta @eq_f2 [2: %] whd in match (save_sp ???); 1587 702 whd in match (save_sp ???); whd in match sigma_regs; normalize nodelta … … 1592 707 qed. 1593 708 709 (*TO BE MOVED IN TranslateUtils.ma *) 710 include "utilities/listb_extra.ma". 711 lemma not_in_added_registers : ∀p : graph_params. 712 ∀globals : list ident.∀fn,f_regs,r. 713 (∀lbl. code_has_label p globals (joint_if_code … fn) lbl → 714 opt_All … (λl.¬(bool_to_Prop (r ∈ l))) (f_regs lbl)) → 715 ¬ (r ∈ (set_from_list RegisterTag (added_registers p globals fn f_regs))). 716 #p #globals #fn #f_regs #r #H whd in match added_registers; normalize nodelta 717 @foldi_ind [@I] #lbl #labels_fn #stmt #regs * #lbl_not_in_fn #EQstmt #IH 718 lapply(Prop_notb … IH) IH * #IH 719 lapply(H lbl ?) 720 [whd in match code_has_label; whd in match code_has_point; normalize nodelta 721 whd in match (stmt_at ????); >EQstmt @I] cases(f_regs lbl) 722 [ #_ @notb_Prop % assumption] 723 #l whd in ⊢ (% → ?); normalize nodelta * #H1 @notb_elim @if_elim [2: #_ @I] #ABS 724 lapply(mem_list_as_set … ABS) #ABS' cases(Exists_append … ABS') #ABS'' 725 [ @H1 @Exists_memb lapply ABS'' elim l [ *] #hd #tl #IH whd in ⊢ (% → %); 726 * [ #EQ >EQ % %] #H %2 @IH @H 727  @IH @list_as_set_mem assumption 728 ] 729 qed. 730 731 include alias "basics/lists/listb.ma". 732 733 (*RIFARE!!!*) 1594 734 lemma eval_seq_no_pc_no_call_ok : 1595 735 ∀prog : ertl_program. 1596 let trans_prog ≝ (ertl_to_ertlptr prog) in 1597 ∀good : (∀fn.good_state_transformation prog fn). 1598 ∀stack_size. ∀id. ∀fn : (joint_closed_internal_function ??) .∀seq. 736 let trans_prog ≝ ertl_to_ertlptr prog in 737 ∀f_lbls : lbl_funct. ∀f_regs : regs_funct. 738 ∀stack_size. 739 ∀bl.∀id. ∀fn : (joint_closed_internal_function ? (prog_var_names ?? prog)). 740 ∀fn_out : (joint_closed_internal_function ? (prog_var_names ?? trans_prog)). 741 ∀seq. 742 (∀l. code_has_label … (joint_if_code … fn) l → 743 opt_All … 744 (λlabs.(All … (λreg.bool_to_Prop(¬(reg ∈ labs))) 745 (get_used_registers_from_seq … (functs … ERTL) seq))) 746 (f_regs bl l)) → 1599 747 preserving1 ?? res_preserve1 ???? 1600 ( λst.sigma_state prog good st (added_registers … fn (f_regs … (good fn))))1601 ( λst.sigma_state prog good st (added_registers … fn (f_regs … (good fn))))748 (sigma_state prog f_lbls f_regs (added_registers … fn (f_regs bl))) 749 (sigma_state prog f_lbls f_regs (added_registers … fn (f_regs bl))) 1602 750 (eval_seq_no_pc ERTL_semantics 1603 751 (globals (mk_prog_params ERTL_semantics prog stack_size)) 1604 752 (ev_genv (mk_prog_params ERTL_semantics prog stack_size)) id fn seq) 1605 753 (eval_seq_no_pc ERTLptr_semantics 1606 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_size))1607 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_size)) id (translate_internal … fn) (seq_embed … seq)).1608 #prog #good #stack_size #f #fn * 1609 whd in match eval_seq_no_pc; normalize nodelta 1610 [ #c #st @mfr_return1 1611  #c#st @mfr_return11612  #pm # st whd in match pair_reg_move; normalize nodelta754 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_size)) 755 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_size)) 756 id fn_out (seq_embed … seq)). 757 #prog #f_lbls #f_regs #stack_size #bl #f #fn #fn_out #seq #fresh_regs 758 cases seq in fresh_regs; 759 [ #c #_ #st @mfr_return1 760  #pm #fesh_regs #st whd in match pair_reg_move; normalize nodelta 1613 761 @mfr_bind1 1614 [ 2: change with (ertl_eval_move ??) in ⊢ (???????%%); @ertl_eval_move_ok 762 [ 2: change with (ertl_eval_move ??) in ⊢ (???????%%); @ertl_eval_move_ok 763 whd in match move_dst_not_fresh; normalize nodelta cases pm in fesh_regs; 764 * [#r1  #R1] #m_src [2: #_ @I] normalize nodelta #fresh_regs 765 @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 766 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H 1615 767   #regs @mfr_return_eq1 % 1616 768 ] 1617  #r # st @mfr_bind1769  #r #fresh_regs #st @mfr_bind1 1618 770 [2: @pop_ok  1619 771  * #bv #st whd in match acca_store; normalize nodelta @mfr_bind1 1620 [2: @ps_reg_store_ok  772 [2: @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl 773 lapply(fresh_regs lbl Hlbl) 774 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1621 775  #regs @mfr_return_eq1 % 1622 776 ] 1623 777 ] 1624  #r # st @mfr_bind1778  #r #_ #st @mfr_bind1 1625 779 [2: whd in match acca_arg_retrieve; normalize nodelta @ps_arg_retrieve_ok  1626 780  #bv @push_ok … … 1631 785 #dpl 1632 786 change with ((dph_reg ERTL) → ?) 1633 #dph # st @mfr_bind11634 [ @( λst.sigma_state prog good st (added_registers … fn (f_regs … (good fn))))787 #dph #fresh_regs #st @mfr_bind1 788 [ @(sigma_state prog f_lbls f_regs (added_registers … fn (f_regs bl))) 1635 789  whd in match dpl_store; normalize nodelta @mfr_bind1 1636 790 [2: @opt_safe_elim #bl #EQbl 1637 791 @opt_safe_elim #bl' 1638 792 >(find_symbol_transf … 1639 (λvars.transf_fundef … (λfn.( translate_internal… fn))) prog i) in ⊢ (%→?);793 (λvars.transf_fundef … (λfn.(b_graph_translate … fn))) prog i) in ⊢ (%→?); 1640 794 >EQbl #EQ destruct whd in match sigma_state; normalize nodelta 1641 change with (sigma_beval prog (get_sigma_from_good_state … good)(BVptr …))795 change with (sigma_beval prog f_lbls (BVptr …)) 1642 796 in ⊢ (???????(?????%?)?); 1643 @ps_reg_store_ok  797 @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 798 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1644 799  #regs @mfr_return_eq1 % 1645 800 ] 1646 801  #st1 @opt_safe_elim #bl #EQbl @opt_safe_elim #bl' 1647 1648 (λvars.transf_fundef … (λfn.( translate_internal… fn))) prog i) in ⊢ (%→?);802 >(find_symbol_transf … 803 (λvars.transf_fundef … (λfn.(b_graph_translate … fn))) prog i) in ⊢ (%→?); 1649 804 >EQbl #EQ destruct whd in match dph_store; normalize nodelta @mfr_bind1 1650 805 [2: whd in match sigma_state; normalize nodelta 1651 change with (sigma_beval prog (get_sigma_from_good_state … good)(BVptr …))806 change with (sigma_beval prog f_lbls (BVptr …)) 1652 807 in ⊢ (???????(?????%?)?); 1653 @ps_reg_store_ok  808 @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 809 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #_ whd in ⊢ (% → ?); * #H 810 #_ @Prop_notb @H 1654 811  #regs @mfr_return_eq1 % 1655 812 ] 1656 ] 1657  #op #a #b #arg1 #arg2 # st @mfr_bind1813 ] 814  #op #a #b #arg1 #arg2 #fresh_regs #st @mfr_bind1 1658 815 [2: whd in match acca_arg_retrieve; whd in match sigma_state; normalize nodelta 1659 816 @ps_arg_retrieve_ok  … … 1664 821 [2: @be_opaccs_ok  1665 822  * #bv3 #bv4 normalize nodelta @mfr_bind1 1666 [ @( λst.sigma_state prog good st (added_registers … fn (f_regs … (good fn))))823 [ @(sigma_state prog f_lbls f_regs (added_registers … fn (f_regs bl))) 1667 824  whd in match acca_store; normalize nodelta @mfr_bind1 1668 [2: @ps_reg_store_ok  825 [2: @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl 826 lapply(fresh_regs lbl Hlbl) 827 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1669 828  #regs @mfr_return_eq1 % 1670 829 ] 1671 830  #st1 whd in match accb_store; normalize nodelta @mfr_bind1 1672 831 [2: whd in match sigma_state; normalize nodelta 1673 @ps_reg_store_ok  832 @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl 833 lapply(fresh_regs lbl Hlbl) 834 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #_ * #H #_ 835 @Prop_notb @H  1674 836  #regs @mfr_return_eq1 % 1675 837 ] … … 1678 840 ] 1679 841 ] 1680  #op #r1 #r2 # st @mfr_bind11681 [ @(sigma_beval prog (get_sigma_from_good_state … good))842  #op #r1 #r2 #fresh_regs #st @mfr_bind1 843 [ @(sigma_beval prog f_lbls) 1682 844  whd in match acca_retrieve; normalize nodelta @ps_reg_retrieve_ok 1683 845  #bv1 @mfr_bind1 1684 [ @(sigma_beval prog (get_sigma_from_good_state … good))846 [ @(sigma_beval prog f_lbls) 1685 847  @be_op1_ok 1686 848  #bv2 whd in match acca_store; normalize nodelta @mfr_bind1 1687 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok  849 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok 850 @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 851 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1688 852  #regs @mfr_return_eq1 % 1689 853 ] 1690 854 ] 1691 855 ] 1692  #op2 #r1 #r2 #arg # st @mfr_bind1856  #op2 #r1 #r2 #arg #fresh_regs #st @mfr_bind1 1693 857 [2: whd in match acca_arg_retrieve; normalize nodelta @ps_arg_retrieve_ok  1694 858  #bv @mfr_bind1 … … 1697 861 [2: @be_op2_ok  1698 862  * #bv2 #b @mfr_bind1 1699 [ @( λst.sigma_state prog good st (added_registers … fn (f_regs … (good fn))))863 [ @(sigma_state prog f_lbls f_regs (added_registers … fn (f_regs bl))) 1700 864  whd in match acca_store; normalize nodelta @mfr_bind1 1701 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok  865 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok 866 @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 867 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1702 868  #regs @mfr_return_eq1 % 1703 869 ] … … 1707 873 ] 1708 874 ] 1709  # st@mfr_return_eq1 %1710  # st@mfr_return_eq1 %1711  #r1 #dpl #dph # st @mfr_bind1875  #_ #st @mfr_return_eq1 % 876  #_ #st @mfr_return_eq1 % 877  #r1 #dpl #dph #fresh_regs #st @mfr_bind1 1712 878 [2: whd in match dph_arg_retrieve; normalize nodelta @ps_arg_retrieve_ok  1713 879  #bv @mfr_bind1 … … 1719 885 [2: @opt_to_res_preserve1 @beloadv_ok  1720 886  #bv2 whd in match acca_store; normalize nodelta @mfr_bind1 1721 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok  887 [2: whd in match sigma_state; normalize nodelta @ps_reg_store_ok 888 @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 889 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H  1722 890  #regs @mfr_return_eq1 % 1723 891 ] … … 1726 894 ] 1727 895 ] 1728  #dpl #dph #r # st @mfr_bind1896  #dpl #dph #r #_ #st @mfr_bind1 1729 897 [2: whd in match dph_arg_retrieve; normalize nodelta @ps_arg_retrieve_ok  1730 898  #bv @mfr_bind1 … … 1743 911 ] 1744 912 ] 1745  #ext # st whd in ⊢ (???????%%); whd in match (stack_sizes ????); cases (stack_size f)913  #ext #fresh_regs #st whd in ⊢ (???????%%); whd in match (stack_sizes ????); cases (stack_size f) 1746 914 normalize nodelta 1747 915 [ @res_preserve_error1 1748  #n cases ext normalize nodelta1749 [1,2: @mfr_bind1916  #n cases ext in fresh_regs; normalize nodelta 917 [1,2: #_ @mfr_bind1 1750 918 [1,4: @(λx.x) 1751 919 2,5: @sp_ok 1752 920 3,6: #ptr @mfr_return_eq1 >set_sp_ok % 1753 921 ] 1754  #r whd in match ps_reg_store_status; normalize nodelta @mfr_bind1922  #r #fresh_regs whd in match ps_reg_store_status; normalize nodelta @mfr_bind1 1755 923 [2: whd in match sigma_state; normalize nodelta 1756 change with (sigma_beval ? (get_sigma_from_good_state … good)(BVByte ?))924 change with (sigma_beval prog f_lbls (BVByte ?)) 1757 925 in ⊢ (???????(??%?)?); 1758 @ps_reg_store_ok 926 @ps_reg_store_ok @not_in_added_registers #lbl #Hlbl lapply(fresh_regs lbl Hlbl) 927 cases(f_regs bl lbl) [ #_ @I] #labs whd in ⊢ (% → %); * #H #_ @Prop_notb @H 1759 928  1760 929  #regs @mfr_return_eq1 % … … 1766 935 1767 936 lemma partial_inj_sigma : ∀ prog : ertl_program. 1768 ∀good : (∀fn.good_state_transformation prog fn). 1769 let sigma ≝ (get_sigma_from_good_state … good) in 1770 ∀fn,lbl1,lbl2. sigma fn lbl1 ≠ None ? → sigma fn lbl1 = sigma fn lbl2 → lbl1 = lbl2. 1771 #prog #good #fn #lbl1 #lbl2 inversion(get_sigma_from_good_state … lbl1) 1772 [#_ * #H @⊥ @H %] #lbl1' whd in match get_sigma_from_good_state; normalize nodelta 1773 #H @('bind_inversion H) H * #lbl1'' #stmt1 #H1 whd in ⊢ (??%? → ?); #EQ destruct 1774 #_ #H lapply(sym_eq ??? H) H #H @('bind_inversion H) H * #lbl2' #stmt2 #H2 937 ∀f_lbls : lbl_funct. 938 let sigma ≝ get_sigma prog f_lbls in 939 ∀id,lbl1,lbl2. sigma id lbl1 ≠ None ? → sigma id lbl1 = sigma id lbl2 → lbl1 = lbl2. 940 #prog #good #bl #lbl1 #lbl2 inversion(get_sigma … lbl1) 941 [#_ * #H @⊥ @H %] #lbl1' whd in match get_sigma; normalize nodelta 942 #H @('bind_inversion H) H #bl' whd in match code_block_of_block; normalize nodelta 943 @match_reg_elim [#_ #ABS destruct] #prf #EQ destruct #H @('bind_inversion H) H 944 * #id #fn #H lapply(res_eq_from_opt ??? H) H #EQfn #H @('bind_inversion H) H 945 * #lbl1'' #stmt1 #H1 whd in ⊢ (??%? → ?); #EQ destruct 946 #_ #H lapply(sym_eq ??? H) H >m_return_bind >EQfn >m_return_bind 947 #H @('bind_inversion H) H * #lbl2' #stmt2 #H2 1775 948 whd in ⊢ (??%? → ?); #EQ destruct lapply(find_predicate ?????? H1) 1776 lapply(find_predicate ?????? H2) cases(f_lbls ????) normalize nodelta [*] 1777 * normalize nodelta 1778 [@eq_identifier_elim #EQ1 * @eq_identifier_elim #EQ2 * >EQ1 >EQ2 % ] 1779 #lb #tl @eq_identifier_elim #EQ1 * @eq_identifier_elim #EQ2 * >EQ1 >EQ2 % 1780 qed. 949 lapply(find_predicate ?????? H2) cases(good ??) normalize nodelta [*] 950 * 951 [ normalize nodelta @eq_identifier_elim #EQ1 * 952 @eq_identifier_elim #EQ2 * >EQ1 >EQ2 % 953  #lb #tl whd in match split_on_last; normalize nodelta whd in match (foldr ?????); 954 cases( foldr label (option (list label×label)) … tl) normalize nodelta 955 [2: * #x #lb1] @eq_identifier_elim #EQ1 * @eq_identifier_elim #EQ2 * 956 >EQ1 >EQ2 % 957 ] 958 qed. 1781 959 1782 960 lemma pc_of_label_eq : 1783 ∀p,p'.let pars ≝ m ake_sem_graph_params p p' in961 ∀p,p'.let pars ≝ mk_sem_graph_params p p' in 1784 962 ∀globals,ge,bl,i_fn,lbl. 1785 963 fetch_internal_function ? ge bl = return i_fn → … … 1793 971 lemma pop_ra_ok : 1794 972 ∀prog : ertl_program. 1795 ∀ good : (∀fn.good_state_transformation prog fn).973 ∀f_lbls : lbl_funct. ∀f_regs : regs_funct. 1796 974 ∀restr. 1797 975 preserving1 … res_preserve1 … 1798 ( λst.sigma_state prog good strestr)976 (sigma_state prog f_lbls f_regs restr) 1799 977 (λx.let 〈st,pc〉 ≝ x in 1800 let sigma ≝ (get_sigma_from_good_state … good) in 1801 〈sigma_state prog good st restr, 1802 sigma_stored_pc ? sigma pc〉) 978 〈sigma_state prog f_lbls f_regs restr st, 979 sigma_stored_pc prog f_lbls pc〉) 1803 980 (pop_ra ERTL_semantics) 1804 (pop_ra ERTLptr_semantics). 1805 #prog #good #restr #st whd in match pop_ra; normalize nodelta @mfr_bind1 981 (pop_ra ERTLptr_semantics). 982 #prog #f_lbls #f_regs #restr1 #st whd in match pop_ra; normalize nodelta 983 @mfr_bind1 1806 984 [  @pop_ok ] * #bv #st1 @mfr_bind1 [  @pop_ok] * #bv1 #st2 @mfr_bind1 1807 [ @(sigma_stored_pc ? (get_sigma_from_good_state … good))985 [ @(sigma_stored_pc prog f_lbls) 1808 986  whd in match pc_of_bevals; normalize nodelta 1809 987 cases bv [   #ptr1 #ptr2 #p  #by  #p  #ptr #p  #pc #p] … … 1822 1000 whd in match sigma_pc_opt; normalize nodelta @if_elim 1823 1001 [ #H2 #EQ lapply(sym_eq ??? EQ) EQ @if_elim [#_ whd in ⊢ (??%% → ?); #EQ destruct %] 1824 #H3 #H @('bind_inversion H) H #x #_ #H @('bind_inversion H) H #y #_ 1825 cases sigma_pc1 in H2; #bl_pc1 #z #H2 whd in ⊢ (??%? → ?); #EQ destruct >H2 in H3; * 1002 #H3 #H @('bind_inversion H) H #x #H4 whd in ⊢ (??%? → ?); #EQ destruct >H2 in H3; * 1826 1003  #H2 @if_elim 1827 [ #H3 #H @('bind_inversion H) H #x1 #_ #H @('bind_inversion H) H #lbl1 #_ 1828 cases pc in H2; #bl #z #H2 whd in match pc_of_point; normalize nodelta whd in ⊢ (??%? → ?); 1829 #EQ destruct >H3 in H2; * 1004 [ #H3 #H @('bind_inversion H) H #x1 #_ whd in match pc_of_point; normalize nodelta 1005 whd in ⊢ (??%? → ?); #EQ destruct >H3 in H2; * 1830 1006  #H3 lapply sigma_pc1_spec; whd in match sigma_pc_opt; normalize nodelta @if_elim 1831 [#H >H in H3; *] #_ #EQ >EQ @('bind_inversion EQ) EQ #x #x_spec 1832 lapply(res_eq_from_opt ??? x_spec) x_spec #x_spec #H @('bind_inversion H) * #lbl 1833 #lbl_spec whd in match pc_of_point; normalize nodelta cases sigma_pc1 #bl1 #lbl1 1834 whd in match (offset_of_point ??); whd in ⊢ (??%? → ?); #EQ destruct cases pc #bl2 #p2 1835 #H @('bind_inversion H) H #x1 #x1_spec lapply(res_eq_from_opt ??? x1_spec) x1_spec #x1_spec 1836 #H @('bind_inversion H) H * #lbl2 #lbl2_spec 1007 [#H >H in H3; *] #_ #EQ >EQ @('bind_inversion EQ) EQ * #x cases pc1 #bl1 #pos1 1008 whd in match (point_of_pc ??); #x_spec whd in match (pc_of_point ???); 1837 1009 whd in match (offset_of_point ??); whd in ⊢ (??%? → ?); #EQ destruct 1838 <lbl_spec in lbl2_spec; #EQsig >x_spec in x1_spec; whd in ⊢ (??%% → ?); #EQ destruct 1839 lapply(partial_inj_sigma … EQsig) 1840 [>EQsig >lbl_spec % #ABS destruct] whd in match point_of_pc; normalize nodelta 1841 whd in match (point_of_offset ??); whd in match (point_of_offset ??); 1842 #EQ destruct cases pc1 #bl #p % 1010 #H @('bind_inversion H) H * #lbl cases pc #bl #pos whd in match (point_of_pc ??); 1011 #lbl_spec whd in match pc_of_point; normalize nodelta 1012 whd in match (offset_of_point ??); whd in ⊢ (??%? → ?); #EQ destruct 1013 @eq_f cut(an_identifier LabelTag pos = an_identifier LabelTag pos1 → pos = pos1) 1014 [ #EQ destruct %] #APP @APP @(partial_inj_sigma prog f_lbls bl1 …) 1015 [ >lbl_spec % #EQ destruct] >x_spec >lbl_spec % 1843 1016 ] 1844 1017 ] 1845 1018  #pc @mfr_return_eq1 % 1846 1019 ] 1020 qed. 1021 1022 lemma pc_block_eq : ∀prog : ertl_program. ∀f_lbls,pc. 1023 sigma_pc_opt prog f_lbls pc ≠ None ? → 1024 pc_block … pc = pc_block … (sigma_stored_pc prog f_lbls pc). 1025 #prog #sigma * #bl #pos whd in match sigma_stored_pc; normalize nodelta 1026 inversion(sigma_pc_opt ???) [ #_ * #H @⊥ @H %] #pc 1027 whd in match sigma_pc_opt; normalize nodelta @if_elim 1028 [#_ whd in ⊢ (??%? → ?); #EQ destruct #_ %] #_ 1029 #H @('bind_inversion H) H * #lbl #_ 1030 whd in ⊢ (??%? → ?); #EQ destruct 1031 #_ % 1032 qed. 1033 1034 include "joint/extra_joint_semantics.ma". 1035 1036 lemma pop_frame_ok : ∀prog : ertl_program. 1037 let trans_prog ≝ ertl_to_ertlptr prog in 1038 ∀f_lbls : lbl_funct. ∀f_regs : regs_funct. 1039 ∀restr. 1040 preserving1 ?? res_preserve1 ???? 1041 (sigma_state prog f_lbls f_regs restr) 1042 (λx.let 〈st,pc〉 ≝ x in 1043 match fetch_internal_function ? (globalenv_noinit … prog) 1044 (pc_block pc) with 1045 [ OK y ⇒ let 〈id,f〉 ≝ y in 1046 〈sigma_state prog f_lbls f_regs 1047 (added_registers ERTL (prog_var_names … prog) f 1048 (f_regs (pc_block pc))) st, 1049 sigma_stored_pc prog f_lbls pc〉 1050  Error e ⇒ 〈dummy_state,null_pc one〉 1051 ]) 1052 (ertl_pop_frame) 1053 (ertl_pop_frame). 1054 #prog #f_lbls #f_regs #restr #st whd in match ertl_pop_frame; normalize nodelta 1055 @mfr_bind1 1056 [ @(λx.match sigma_frames_opt prog f_lbls f_regs x with [Some l ⇒ l  None ⇒ [ ]]) 1057  @opt_to_res_preserve1 whd in match sigma_state; normalize nodelta 1058 cases(st_frms … st) [@opt_preserve_none1] #l whd in match sigma_frames; 1059 normalize nodelta >m_return_bind #x #x_spec %{l} % [%] >x_spec % 1060  * normalize nodelta [@res_preserve_error1] * #loc_mem #bl #tl normalize nodelta 1061 inversion(sigma_frames_opt ????) normalize nodelta [ #_ @res_preserve_error1] 1062 #l whd in match sigma_frames_opt; whd in match m_list_map; normalize nodelta 1063 whd in match (foldr ?????); normalize nodelta inversion(fetch_internal_function ???) 1064 normalize nodelta [2: #e #_ #ABS destruct(ABS)] * #f #fn #EQfn 1065 #H @('bind_inversion H) H #l1 1066 change with (sigma_frames_opt prog f_lbls f_regs tl = ? → ?) #EQl1 1067 whd in ⊢ (??%? → ?); #EQ destruct(EQ) @mfr_bind1 1068 [2: whd in match sigma_state; whd in match set_regs; whd in match set_frms; 1069 normalize nodelta 1070 cut( 〈sigma_register_env prog f_lbls 1071 (added_registers ERTL (prog_var_names (joint_function ERTL) ℕ prog) fn 1072 (f_regs bl)) 1073 loc_mem, 1074 \snd (sigma_regs prog f_lbls restr (regs ERTLptr_semantics st))〉 = 1075 sigma_regs prog f_lbls 1076 (added_registers ERTL (prog_var_names (joint_function ERTL) ℕ prog) fn 1077 (f_regs bl)) (〈loc_mem,\snd (regs ERTL_state st)〉)) [ 1078 whd in match sigma_regs; normalize nodelta cases(regs … st) #x1 #x2 1079 %] #EQ >EQ EQ <EQl1 in ⊢ (???????%?); 1080 change with (sigma_state prog f_lbls f_regs 1081 (added_registers ERTL (prog_var_names … prog) fn (f_regs bl)) 1082 (mk_state ? (Some ? tl) (istack … st) (carry … st) (〈loc_mem,\snd (regs … st)〉) 1083 (m … st))) in ⊢ (???????(??%)?); @pop_ra_ok  1084  * #st1 #pc1 @if_elim normalize nodelta [2: #_ @res_preserve_error1] 1085 normalize nodelta @eq_block_elim [2: #_ *] #EQbl1 * @if_elim 1086 [2: >EQbl1 @eq_block_elim [#_ *] * #H @⊥ @H <pc_block_eq [%] % 1087 cases bl in EQbl1 EQfn; #p1 #p2 #EQ destruct lapply p2 1088 whd in match sigma_stored_pc; normalize nodelta cases(sigma_pc_opt ???) 1089 normalize nodelta [2: #pc2] #p2 [#_ #EQ destruct] 1090 >fetch_internal_function_no_zero [2: %] #EQ destruct 1091  @eq_block_elim [2: #_ *] #EQbl11 * @mfr_return_eq1 normalize nodelta 1092 cases bl in EQbl11 EQfn; #p1 #p2 #EQ destruct 1093 lapply p2 cases(pc_block pc1) #p11 #p22 #e #EQfn1 >EQfn1 % 1094 ] 1095 ] 1096 ] 1097 qed. 1098 1099 (* 1100 whd in match sigma_frames_opt; whd in match m_list_map; normalize nodelta 1101 whd in match sigma_state in ⊢ (???????%%); normalize nodelta 1102 cases(st_frms … st) normalize nodelta [ @res_preserve_error1] 1103 * #loc_mem #bl #tl inversion(sigma_frames ????) 1104 [ #_ normalize nodelta @res_preserve_error1] * #loc_mem1 #bl1 #tl1 1105 whd in match sigma_frames; normalize nodelta inversion(sigma_frames_opt ????) 1106 [ #_ normalize nodelta #_ #ABS destruct] #l whd in match sigma_frames_opt; 1107 whd in match m_list_map; normalize nodelta whd in match (foldr ?????); 1108 normalize nodelta inversion(fetch_internal_function ???) 1109 [2: #e #_ whd in ⊢ (??%% → ?); #ABS destruct] * #id1 #fn1 #EQfn1 >m_return_bind 1110 normalize nodelta #H @('bind_inversion H) H #l1 1111 change with (sigma_frames_opt ???? = ? → ?) #EQl1 1112 cut (sigma_frames prog f_lbls f_regs tl = l1) 1113 [whd in match sigma_frames; normalize nodelta >EQl1 %] #EQl11 1114 cases l [ whd in ⊢ (??%? → ?); #EQ destruct] #x #y 1115 whd in ⊢ (??%? → ?); #EQ1 #_ #EQ2 destruct @mfr_bind1 1116 [2: whd in match set_regs; whd in match set_frms; normalize nodelta 1117 >EQl1 in ⊢ (???????%?); normalize nodelta 1118 cut(sigma_regs prog f_lbls (added_registers ERTL (prog_var_names … prog) fn1 (f_regs bl1)) 1119 〈loc_mem,\snd (regs … st)〉 = 〈map RegisterTag beval beval loc_mem 1120 (λbv:beval.sigma_beval prog f_lbls bv)∖ 1121 added_registers ERTL (prog_var_names … prog) fn1 (f_regs bl1), 1122 \snd (sigma_regs prog f_lbls restr (regs ERTLptr_semantics st))〉) 1123 [ whd in match sigma_regs; normalize nodelta @eq_f2 [ %] cases(regs ? st) 1124 #x #y %] #EQ <EQ EQ 1125 change with (sigma_state ???? (set_regs ERTL_semantics 〈loc_mem,\snd (regs … st)〉 1126 (set_frms ERTL_semantics tl st))) in ⊢ (???????(??%)?); 1127 @pop_ra_ok  1128  * #st1 #pc1 @if_elim [2: #_ @res_preserve_error1] normalize nodelta 1129 @eq_block_elim [2: #_ *] #EQbl1 * @if_elim 1130 [2: >EQbl1 @eq_block_elim [#_ *] * #H @⊥ @H <pc_block_eq [%] % 1131 cases bl1 in EQbl1 EQfn1; #p1 #p2 #EQ destruct lapply p2 1132 whd in match sigma_stored_pc; normalize nodelta cases(sigma_pc_opt ???) 1133 normalize nodelta [2: #pc2] #p2 [#_ #EQ destruct] 1134 >fetch_internal_function_no_zero [2: %] #EQ destruct 1135 ] @eq_block_elim [2: #_ *] #EQbl11 * @mfr_return_eq1 normalize nodelta 1136 cases bl1 in EQbl11 EQfn1; #p1 #p2 #EQ destruct 1137 lapply p2 cases(pc_block pc1) #p11 #p22 #e #EQfn1 >EQfn1 1138 % 1139 ] 1140 qed. 1141 *) 1142 1143 1144 definition ERTLptrStatusSimulation : 1145 ∀ prog : ertl_program. 1146 let trans_prog ≝ ertl_to_ertlptr prog in 1147 ∀stack_sizes.∀ f_lbls : lbl_funct. ∀ f_regs : regs_funct. 1148 ∀f_bl_r. 1149 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1150 translate_data prog f_bl_r f_lbls f_regs → 1151 status_rel (ERTL_status prog stack_sizes) (ERTLptr_status trans_prog stack_sizes) ≝ 1152 λprog,stack_sizes,f_lbls,f_regs,f_lb_r,good. 1153 let trans_prog ≝ ertl_to_ertlptr prog in 1154 mk_status_rel ?? 1155 (* sem_rel ≝ *) (λs1:ERTL_status prog stack_sizes 1156 .λs2:ERTLptr_status trans_prog stack_sizes 1157 .s1=sigma_state_pc prog f_lbls f_regs s2) 1158 (* call_rel ≝ *) 1159 (λs1:Σs:ERTL_status prog stack_sizes 1160 .as_classifier (ERTL_status prog stack_sizes) s cl_call 1161 .λs2:Σs:ERTLptr_status trans_prog stack_sizes 1162 .as_classifier (ERTLptr_status trans_prog stack_sizes) s cl_call 1163 . 1164 pc (mk_prog_params ERTL_semantics prog stack_sizes) s1 1165 =sigma_stored_pc prog f_lbls 1166 (pc 1167 (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_sizes) 1168 s2)) 1169 (* sim_final ≝ *) ?. 1170 cases daemon 1171 qed. 1172 1173 include "joint/semantics_blocks.ma". 1174 1175 lemma fetch_ok_sigma_pc_ok :∀prog : ertl_program. 1176 ∀ f_lbls,f_regs,id,fn,st. 1177 fetch_internal_function … (globalenv_noinit … prog) 1178 (pc_block (pc … (sigma_state_pc prog f_lbls f_regs st))) = return 〈id,fn〉 → 1179 pc … (sigma_state_pc prog f_lbls f_regs st) = pc … st. 1180 #prog #f_lbls #f_regs #id #fn #st whd in match sigma_state_pc; 1181 normalize nodelta cases(fetch_internal_function ?? (pc_block (pc … st))) 1182 normalize nodelta [* #id1 #fn1 #_ %] 1183 #e >fetch_internal_function_no_zero [2: %] whd in ⊢ (???% → ?); #EQ destruct(EQ) 1184 qed. 1185 1186 lemma fetch_ok_sigma_state_ok : ∀prog : ertl_program. 1187 ∀ f_lbls,f_regs,id,fn,st. 1188 fetch_internal_function … (globalenv_noinit … prog) 1189 (pc_block (pc … (sigma_state_pc prog f_lbls f_regs st))) = return 〈id,fn〉 → 1190 let added ≝ (added_registers ERTL (prog_var_names … prog) fn 1191 (f_regs (pc_block (pc … st)))) in 1192 st_no_pc … (sigma_state_pc prog f_lbls f_regs st) = 1193 sigma_state prog f_lbls f_regs added (st_no_pc … st). 1194 #prog #f_lbls #f_regs #id #fn #st #EQf whd in match sigma_state_pc; 1195 normalize nodelta <(fetch_ok_sigma_pc_ok … EQf) >EQf % 1196 qed. 1197 1198 lemma fetch_ok_sigma_pc_block_ok : ∀prog : ertl_program. 1199 ∀ f_lbls,id,fn,pc. 1200 fetch_internal_function … (globalenv_noinit … prog) 1201 (pc_block (sigma_stored_pc prog f_lbls pc)) = return 〈id,fn〉 → 1202 pc_block (sigma_stored_pc prog f_lbls pc) = pc_block pc. 1203 #prog #f_lbls #id #fn #pc #EQf <pc_block_eq [%] 1204 lapply EQf whd in match sigma_stored_pc; normalize nodelta 1205 cases(sigma_pc_opt ???) normalize nodelta [2: #pc #_ % #EQ destruct(EQ)] 1206 >fetch_internal_function_no_zero [2: %] whd in ⊢ (???% → ?); #EQ destruct(EQ) 1207 qed. 1208 1209 lemma fetch_stmt_ok_sigma_pc_ok : ∀prog : ertl_program. 1210 ∀ f_lbls,f_regs,id,fn,stmt,st. 1211 fetch_statement ERTL_semantics (prog_var_names … prog) 1212 (globalenv_noinit … prog) (pc … (sigma_state_pc prog f_lbls f_regs st)) = 1213 return 〈id,fn,stmt〉 → 1214 pc … (sigma_state_pc prog f_lbls f_regs st) = pc … st. 1215 #prog #f_lbls #f_regs #id #fn #stmt #st #H @('bind_inversion H) 1216 * #id1 #fn1 #EQfn1 #_ @(fetch_ok_sigma_pc_ok … EQfn1) 1217 qed. 1218 1219 lemma fetch_stmt_ok_sigma_state_ok : ∀prog : ertl_program. 1220 ∀ f_lbls,f_regs,id,fn,stmt,st. 1221 fetch_statement ERTL_semantics (prog_var_names … prog) 1222 (globalenv_noinit … prog) (pc … (sigma_state_pc prog f_lbls f_regs st)) = 1223 return 〈id,fn,stmt〉 → 1224 let added ≝ (added_registers ERTL (prog_var_names … prog) fn 1225 (f_regs (pc_block (pc … st)))) in 1226 st_no_pc … (sigma_state_pc prog f_lbls f_regs st) = 1227 sigma_state prog f_lbls f_regs added (st_no_pc … st). 1228 #prog #f_lbls #f_regs #id #fn #stmt #st #H @('bind_inversion H) H 1229 * #id1 #fn1 #EQfn1 #H @('bind_inversion H) H #stmt1 #_ 1230 whd in ⊢ (??%% → ?); #EQ destruct(EQ) @(fetch_ok_sigma_state_ok … EQfn1) 1231 qed. 1232 1233 lemma fetch_stmt_ok_sigma_pc_block_ok : ∀prog : ertl_program. 1234 ∀ f_lbls,id,fn,stmt,pc. 1235 fetch_statement ERTL_semantics (prog_var_names … prog) 1236 (globalenv_noinit … prog) (sigma_stored_pc prog f_lbls pc) = return 〈id,fn,stmt〉 → 1237 pc_block (sigma_stored_pc prog f_lbls pc) = pc_block pc. 1238 #prog #f_lbls #id #fn #stmt #st #H @('bind_inversion H) H 1239 * #id1 #fn1 #EQfn1 #H @('bind_inversion H) H #stmt1 #_ 1240 whd in ⊢ (??%% → ?); #EQ destruct(EQ) @(fetch_ok_sigma_pc_block_ok … EQfn1) 1241 qed. 1242 1243 lemma as_label_ok : ∀ prog : ertl_program. 1244 let trans_prog ≝ ertl_to_ertlptr prog in 1245 ∀ f_lbls,f_regs,stack_sizes. 1246 ∀f_bl_r. 1247 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1248 translate_data prog f_bl_r f_lbls f_regs → 1249 ∀st,fn,id,stmt. 1250 fetch_statement ERTL_semantics (prog_var_names … prog) 1251 (globalenv_noinit … prog) (pc … (sigma_state_pc prog f_lbls f_regs st)) = 1252 return 〈id,fn,stmt〉 → 1253 as_label (ERTLptr_status trans_prog stack_sizes) st = as_label 1254 (ERTL_status prog stack_sizes) (sigma_state_pc prog f_lbls f_regs st). 1255 #prog #f_lbls #f_regs #stack_size #f_lb_r #good #st #fn #id #stmt #EQfetch 1256 whd in match as_label; normalize nodelta change with (pc ? ?) in ⊢ (??(??%)(??%)); 1257 cases(b_graph_transform_program_fetch_statement … good … EQfetch) 1258 #init_data * #t_fn ** #EQt_fn whd in ⊢ (% → ?); cases(f_lb_r ?) 1259 normalize nodelta [2: #r #tl *] #EQinit destruct(EQinit) * #l_labs * #l_regs ** 1260 #_ #_ cases stmt in EQfetch; 1261 [ * [ #c  * [ #c_id  #c_ptr ] #c_arg #c_dest  #reg #lbl  #s ] #nxt  #fin  * ] 1262 #EQfetch normalize nodelta * #bl * [1,2,3,4,5: >if_merge_right in ⊢ (% → ?); try %] 1263 whd in ⊢ (%→?); cases l_regs normalize nodelta [2,4,5,8,10,12: [3: *] #x #y *] 1264 [1,2,4,5,6: #r #tl whd in ⊢ (% → ?); cases tl tl normalize nodelta [2: #r1 #tl1 *]] 1265 #EQ destruct(EQ) 1266 [1,2,3,4,6: * #pre_l * #mid1 * #mid2 * #post_l *** #EQmid1 1267 whd in match map_eval in ⊢ (% → ?); normalize nodelta 1268 whd in ⊢ (?????%?? → ?); 1269 whd in match (seq_list_in_code ???????) in ⊢ (%→?); * 1270 [1,2,3,4: #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (???%); 1271 destruct(EQmid1) * #nxt1 * #EQt_stmt #_ #_ 1272  * #lbl1 * #rest ** #EQ destruct(EQ) * #nxt1 * 1273 #EQt_stmt #_ #_ #_ #_ 1274 ] 1275  * #pre_l * #mid ** #EQmid whd in ⊢ (% → ?); * #EQ destruct(EQ) 1276 whd in EQmid : (???%); destruct(EQmid) #EQ destruct(EQ) 1277 whd in ⊢ (% → ?); #EQt_stmt 1278 ] 1279 whd in ⊢ (??%%); >EQfetch normalize nodelta whd in match fetch_statement; 1280 normalize nodelta >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQt_fn; 1281 #EQt_fn >EQt_fn >m_return_bind >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQt_stmt; 1282 #EQt_stmt >EQt_stmt % 1283 qed. 1284 1285 lemma fetch_ok_sigma_last_pop_ok :∀prog : ertl_program. 1286 ∀ f_lbls,f_regs,id,fn,st. 1287 fetch_internal_function … (globalenv_noinit … prog) 1288 (pc_block (pc … (sigma_state_pc prog f_lbls f_regs st))) = return 〈id,fn〉 → 1289 last_pop … (sigma_state_pc prog f_lbls f_regs st) = 1290 sigma_stored_pc prog f_lbls (last_pop … st). 1291 #prog #f_lbls #f_regs #id #fn #st whd in match sigma_state_pc; normalize nodelta 1292 cases(fetch_internal_function ?? (pc_block (pc … st))) normalize nodelta 1293 [ * #x #y #_ %] #e >fetch_internal_function_no_zero [2: %] whd in ⊢ (???% → ?); 1294 #EQ destruct(EQ) 1295 qed. 1296 1297 lemma fetch_stmt_ok_sigma_last_pop_ok :∀prog : ertl_program. 1298 ∀ f_lbls,f_regs,id,fn,stmt,st. 1299 fetch_statement ERTL_semantics (prog_var_names … prog) 1300 (globalenv_noinit … prog) (pc … (sigma_state_pc prog f_lbls f_regs st)) 1301 = return 〈id,fn,stmt〉 → 1302 last_pop … (sigma_state_pc prog f_lbls f_regs st) = 1303 sigma_stored_pc prog f_lbls (last_pop … st). 1304 #prog #f_lbls #f_regs #id #fn #stmt #st #H @('bind_inversion H) H 1305 * #id1 #fn1 #EQfn1 #H @('bind_inversion H) H #stmt1 #_ 1306 whd in ⊢ (??%% → ?); #EQ destruct(EQ) @(fetch_ok_sigma_last_pop_ok … EQfn1) 1307 qed. 1308 1309 lemma excluded_middle_list : 1310 ∀A : Type[0]. ∀P : A → Prop. (∀a.decidable … (P a)) → ∀ l. 1311 All … P l ∨ Exists … (λa.¬(P a)) l. 1312 #A #P #Dec #l elim l [% %] #hd #tl #IH 1313 cases IH [ cases(Dec hd) [ #H1 #H2 % whd % assumption  #H #_ %2 whd % assumption] 1314  #H %2 whd %2 assumption 1315 ] 1316 qed. 1317 1318 lemma eval_seq_no_call_ok : 1319 ∀prog. 1320 let trans_prog ≝ ertl_to_ertlptr prog in 1321 ∀ f_lbls,f_regs,stack_sizes. 1322 ∀f_bl_r. 1323 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1324 translate_data prog f_bl_r f_lbls f_regs → 1325 ∀st2 : state_pc ERTLptr_semantics. 1326 let st1 ≝ sigma_state_pc prog f_lbls f_regs st2 in 1327 ∀st1' : state_pc ERTL_semantics. 1328 ∀f,fn,stmt,nxt. 1329 fetch_statement ERTL_semantics 1330 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 1331 (ev_genv (mk_prog_params ERTL_semantics prog stack_sizes)) 1332 (pc … st1) = 1333 return 〈f, fn, sequential … (step_seq ERTL … stmt) nxt〉 → 1334 eval_state ERTL_semantics 1335 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 1336 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 1337 st1 = 1338 return st1' → 1339 ∃st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 1340 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 1341 st2 1342 st2'. 1343 if taaf_non_empty … taf then True else 1344 (¬as_costed (ERTL_status prog stack_sizes) st1 ∨ 1345 ¬as_costed (ERTL_status prog stack_sizes) st1'). 1346 #prog #f_lbls #f_regs #stack_size #f_bl_r #good #st2 #st1' #f #fn #stmt #nxt 1347 #EQfetch whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 1348 #H @('bind_inversion H)H #st_no_pc 1349 whd in match eval_statement_no_pc; normalize nodelta #EQnopc 1350 whd in match eval_statement_advance; normalize nodelta 1351 whd in match set_no_pc; whd in match next; whd in match set_pc; 1352 normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct(EQ) lapply EQfetch 1353 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) #EQfetch' 1354 lapply(fetch_statement_inv … EQfetch') * #EQfn #EQstmt 1355 cases(b_graph_transform_program_fetch_internal_function … good … EQfn) 1356 #init_data * #t_fn1 ** #EQt_fn1 whd in ⊢ (% → ?); cases (f_bl_r ?) normalize nodelta 1357 [2: #r #tl *] #EQ destruct(EQ) * #_ #_ #_ #_ #_ #_ #_ #fresh_regs #_ #_ #stmt_at_spec 1358 cases(stmt_at_spec … EQstmt) #labs * #regs ** #EQlabs #EQregs normalize nodelta 1359 >if_merge_right in ⊢ (% → ?); [2: %] whd in ⊢ (% → ?); * #bl * whd in ⊢ (% → ?); 1360 cases regs in EQregs; regs [2: #x #y #_ *] #EQregs normalize nodelta #EQ destruct(EQ) 1361 #eval_spec 1362 lapply(err_eq_from_io ????? EQnopc) EQnopc >(fetch_stmt_ok_sigma_state_ok … EQfetch) 1363 #EQnopc 1364 cases(eval_seq_no_pc_no_call_ok prog f_lbls f_regs ????????? EQnopc) 1365 [2: @(t_fn1) 1366  #stnopc'' * #EQstnopc'' #EQsem % 1367 [ % [@stnopc''  @(succ_pc ERTL_semantics (pc … st2) nxt)  @(last_pop … st2)]] 1368 % 1369 [ whd in match sigma_state_pc; normalize nodelta @('bind_inversion EQfetch) 1370 * #f1 #fn1 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) #EQfn1 1371 #H @('bind_inversion H) H #stmt1 #_ whd in ⊢ (??%% → ?); #EQ destruct(EQ) 1372 >EQfn1 normalize nodelta >EQsem % ] 1373 % [ @(produce_trace_any_any_free_coerced) [ @f  @t_fn1 6: @eval_spec  @EQt_fn1] 1374 whd in match repeat_eval_seq_no_pc; normalize nodelta whd in ⊢ (??%?); 1375 >EQstnopc'' %] @if_elim [#_ @I] #_ %1 % whd in match as_costed; 1376 normalize nodelta * #H @H whd in ⊢ (??%?); >EQfetch % 1377  #lbl whd in match code_has_label; whd in match code_has_point; normalize nodelta 1378 inversion(stmt_at ????) [#_ *] #stmt1 #EQstmt1 #_ cases(stmt_at_spec … EQstmt1) 1379 #labels * #registers ** #_ #EQregisters #_ labels >EQregisters whd 1380 cases(excluded_middle_list ? (λreg.bool_to_Prop(¬(reg∈registers))) ? 1381 (get_used_registers_from_seq … (functs ERTL) stmt)) 1382 [3: #a cases(¬a∈registers) // 1: #H assumption] #H @⊥ 1383 cases(Exists_All … H (regs_are_in_univers … (pi2 ?? fn) … EQstmt)) 1384 #reg ** #H1 #H2 @H1 H1 @notb_Prop % #H1 lapply(fresh_regs … lbl) >EQregisters 1385 whd in ⊢ (% → ?); #H3 lapply(All_memb … H3 H1) ** #H4 #_ @H4 assumption 1386 ] 1387 qed. 1388 1389 lemma eval_goto_ok : 1390 ∀prog : ertl_program. 1391 let trans_prog ≝ ertl_to_ertlptr prog in 1392 ∀ f_lbls,f_regs,stack_sizes. 1393 ∀f_bl_r. 1394 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1395 translate_data prog f_bl_r f_lbls f_regs → 1396 ∀st2. 1397 let st1 ≝ (sigma_state_pc prog f_lbls f_regs st2) in 1398 ∀st1',f,fn,nxt. 1399 fetch_statement ERTL_semantics … 1400 (globalenv_noinit ? prog) (pc … st1) = 1401 return 〈f, fn, final … (GOTO ERTL … nxt)〉 → 1402 eval_state ERTL_semantics 1403 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 1404 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 1405 st1 = 1406 return st1' → 1407 ∃ st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 1408 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 1409 st2 1410 st2'. 1411 bool_to_Prop (taaf_non_empty … taf). 1412 #prog #f_lbls #f_regs #stack_size #f_bl_r #good #st2 #st1' #f #fn #nxt #EQfetch 1413 whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 1414 whd in match eval_statement_no_pc; normalize nodelta 1415 >m_return_bind whd in match eval_statement_advance; whd in match set_no_pc; 1416 whd in match goto; normalize nodelta #H lapply(err_eq_from_io ????? H) H 1417 #H @('bind_inversion H) H #new_pc lapply(fetch_statement_inv … EQfetch) * 1418 #EQfn #_ >(pc_of_label_eq … EQfn) whd in ⊢ (??%% → ??%% → ?); 1419 #EQ1 #EQ2 destruct(EQ1 EQ2) 1420 % [ % [ @st2  @(mk_program_counter (pc_block (pc … st2)) 1421 (offset_of_point ERTL_semantics nxt))  @(last_pop … st2)]] 1422 % [ >(fetch_stmt_ok_sigma_state_ok … EQfetch) >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 1423 >(fetch_stmt_ok_sigma_last_pop_ok … EQfetch) whd in match sigma_state_pc; 1424 normalize nodelta >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQfn; #EQfn 1425 >EQfn %] 1426 cases(b_graph_transform_program_fetch_statement … good … EQfetch) 1427 #init_data * #t_fn1 ** #EQt_fn1 whd in ⊢ (% → ?); cases (f_bl_r ?) normalize nodelta 1428 [2: #r #tl *] #EQ destruct(EQ) * #labs ** 1429 [2: #hd #tl ** #_ #_ ** #pre #inst * whd in ⊢ (%→?); *] ** #EQlabs #EQf_regs 1430 whd in match translate_fin_step; normalize nodelta * #bl * 1431 whd in ⊢ (% → ?); #EQ destruct(EQ) ** 1432 [2: #lb #tl * #mid ** #EQmid whd in ⊢ (% → ?); * #ABS destruct(ABS)] * #mid ** 1433 whd in ⊢ (???% → ?); #EQ destruct(EQ) * #_ #_ change with (stmt_at ???? = ? → ?) 1434 #EQstmt >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQt_fn1; #EQt_fn1 1435 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQstmt; #EQstmt 1436 %{(taaf_step … (taa_base …) …)} 1437 [ whd in match as_classifier; normalize nodelta whd in ⊢ (??%?); 1438 whd in match fetch_statement; normalize nodelta 1439 >EQt_fn1 >m_return_bind >EQstmt % 1440  whd whd in match eval_state; normalize nodelta whd in match fetch_statement; 1441 normalize nodelta >EQt_fn1 >m_return_bind >EQstmt >m_return_bind 1442 whd in match eval_statement_no_pc; normalize nodelta >m_return_bind 1443 whd in match eval_statement_advance; normalize nodelta 1444 whd in match goto; normalize nodelta >(pc_of_label_eq … EQt_fn1) % 1445 ] @I 1446 qed. 1447 1448 lemma code_block_of_block_eq : ∀bl : Σb.block_region b = Code. 1449 code_block_of_block bl = return bl. 1450 * #bl #prf whd in match code_block_of_block; normalize nodelta @match_reg_elim 1451 [ >prf in ⊢ (% → ?); #ABS destruct(ABS)] #prf1 % 1452 qed. 1453 1454 (* 1455 lemma list_elim_on_last : ∀A : Type[0].∀ P : (list A) → Prop. ∀ l. 1456 P ([ ]) → (∀pre,last. P (pre@[last])) → P l. 1457 #A #P #l #H1 #H2 cut(∀A.∀l : list A.l = [ ] ∨ ∃pre,last. l = pre@[last]) 1458 [ #A #l elim l [ %1 %  #a #tl * [ #EQ destruct %2 %{([ ])} %{a} %] 1459 * #l1 * #a1 #EQ destruct %2 %{(a::l1)} %{a1} %]] #APP1 1460 lapply(APP1 … l) * [ #EQ >EQ assumption] 1461 * #pre * #last #EQ >EQ @H2 1462 qed.*) 1463 1464 lemma split_on_last_append : ∀A : Type[0]. ∀pre : list A. 1465 ∀ last : A. split_on_last ? (pre@[last]) = return 〈pre,last〉. 1466 #A #pre elim pre [#last %] #a #tl #IH #last whd in ⊢ (??%?);lapply(IH last) 1467 whd in ⊢ (??%? → ?); #EQ >EQ % 1468 qed. 1469 1470 lemma append_All : ∀A : Type[0]. ∀ P : A → Prop. ∀l1,l2 : list A. 1471 All ? P (l1 @ l2) → All ? P l1 ∧ All ? P l2. 1472 #A #P #l1 elim l1 1473 [ #l2 change with l2 in ⊢ (???% → ?); #H % //] 1474 #a #tl #IH #l2 change with (P a ∧ All A P (tl @ l2)) in ⊢ (% → ?); 1475 * #H1 #H2 lapply(IH … H2) * #H3 #H4 % // whd % // 1476 qed. 1477 1478 include alias "common/Identifiers.ma". 1479 1480 lemma get_sigma_idempotent : 1481 ∀prog : ertl_program. 1482 ∀ f_lbls,f_regs. 1483 ∀f_bl_r. 1484 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1485 translate_data prog f_bl_r f_lbls f_regs → 1486 ∀id,fn,bl,pt,stmt. 1487 fetch_internal_function … (globalenv_noinit … prog) bl = return 〈id,fn〉 → 1488 stmt_at ERTL (prog_var_names … prog) (joint_if_code … fn) pt = return stmt → 1489 f_lbls bl pt = return [ ] → get_sigma prog f_lbls bl pt = return pt. 1490 #prog #f_lbls #f_regs #f_bl_r #good #id #fn #bl #pt #stmt #EQfn #EQstmt #EQlabels 1491 cases(b_graph_transform_program_fetch_internal_function … good … EQfn) 1492 #init_data * #calling' ** #EQcalling' whd in ⊢ (% → ?); cases(f_bl_r ?) 1493 [2,4: #x #y *] normalize nodelta #EQ destruct(EQ) * #_ #_ #_ #_ #_ 1494 #_ #fresh_labs #_ #_ #_ #H lapply(H … EQstmt) H * #lbls * #regs ** >EQlabels 1495 whd in ⊢ (??%? → ?); #EQ destruct(EQ) #EQregs cases stmt in EQstmt; normalize nodelta 1496 [3: * 2: * [#lbl  *] #EQstmt * #bl * whd in ⊢ (% → ?); cases regs in EQregs; 1497 [2,4: #x #y #_ *] #EQregs normalize nodelta #EQ destruct(EQ) whd in ⊢ (%→?); 1498 * #pref * #mid ** #EQmid whd in ⊢ (% → ?); * #EQ1 #EQ2 destruct(EQ1 EQ2) 1499 whd in ⊢ (% → ?); #EQt_stmt 1500  * [#c  * [#c_id#c_ptr] #args #dest  #r #lbl  #seq ] #nxt #EQstmt 1501 whd in ⊢ (% → ?); * #bl >if_merge_right [2,4,6,8,10: %] * whd in ⊢ (% → ?); 1502 cases regs in EQregs; normalize nodelta 1503 [2,4,5,8,10: [1,2,4,5: #x #y] #_ *6: #r * [2: #x #y] ] 1504 #EQregs [1,2: whd in ⊢ (% → ?); [*]] #EQ destruct(EQ) whd in ⊢ (% → ?); 1505 * #l1 * #mid1 * #mid2 * #l2 *** #EQmid1 whd in ⊢ (%→ ?); 1506 [ * #mid * #rest ** #EQ destruct(EQ) whd in ⊢ (% → ?); * #nxt1 * 1507 #EQlow change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 1508 whd in ⊢ (% → ?); * #mid3 * #rest1 ** #EQ destruct(EQ) 1509 whd in EQmid1 : (???%); destruct(EQmid1) whd in e0 : (???%); 1510 destruct(e0) ] * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (???%); 1511 destruct(EQmid1) whd in ⊢ (% → ?); * #nxt1 * #EQt_stmt #EQ destruct(EQ) 1512 whd in ⊢ (% → ?); * #_ #EQ destruct(EQ) 1513 ] whd in match get_sigma; normalize nodelta >code_block_of_block_eq >m_return_bind 1514 >EQfn >m_return_bind inversion(find ????) 1515 [1,3,5,7,9,11: #EQfind @⊥ lapply(find_none ?????? EQfind EQstmt) >EQlabels 1516 normalize nodelta @eq_identifier_elim [1,3,5,7,9,11: #_ * *: * #H #_ @H %]] 1517 * #lbl #s #EQfind >m_return_bind lapply(find_predicate ?????? EQfind) 1518 inversion(f_lbls ??) [1,3,5,7,9,11: #_ *] #l @(list_elim_left … l …) 1519 normalize nodelta [1,3,5,7,9,11: #_ @eq_identifier_elim 1520 [1,3,5,7,9,11: #EQ destruct(EQ) #_ % *: #_ *]] 1521 #last #pre #_ #EQlbl >split_on_last_append normalize nodelta @eq_identifier_elim 1522 [2,4,6,8,10,12: #_ *] #EQ lapply EQlbl destruct(EQ) #EQlbl #_ @⊥ 1523 lapply(fresh_labs lbl) >EQlbl whd in ⊢ (% → ?); #H lapply(append_All … H) H 1524 * #_ whd in ⊢ (% → ?); *** #H #_ #_ @H H @(code_is_in_universe … (pi2 ?? fn)) 1525 whd in match code_has_label; whd in match code_has_point; normalize nodelta 1526 >EQstmt @I 1527 qed. 1528 1529 lemma append_absurd : ∀A : Type[0]. ∀l : list A. ∀ a : A. 1530 l @ [a] = [ ] → False. 1531 #A * [2: #x #y] #a normalize #EQ destruct 1532 qed. 1533 1534 lemma last_append_eq : ∀A : Type[0].∀l1,l2 : list A. ∀a1,a2: A. 1535 l1 @ [a1] = l2 @ [a2] → a1 = a2. 1536 #A #l1 elim l1 [ * [2: #hd #tl] #a1 #a2 normalize #EQ destruct [2: %] 1537 @⊥ lapply(sym_eq ??? e0) e0 #e0 @(append_absurd ??? e0)] #hd #tl #IH 1538 * [ #a1 #a2 normalize #EQ destruct @⊥ @(append_absurd ??? e0)] 1539 #hd1 #tl1 #a1 #a2 normalize #EQ destruct(EQ) @(IH tl1 a1 a2 e0) 1540 qed. 1541 1542 lemma get_sigma_last : 1543 ∀prog : ertl_program. 1544 ∀ f_lbls,f_regs. 1545 ∀f_bl_r. 1546 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1547 translate_data prog f_bl_r f_lbls f_regs → 1548 ∀id,fn,bl,pt,stmt,pre,last. 1549 fetch_internal_function … (globalenv_noinit … prog) bl = return 〈id,fn〉 → 1550 stmt_at ERTL (prog_var_names … prog) (joint_if_code … fn) pt = return stmt → 1551 f_lbls bl pt = return (pre@[last]) → get_sigma prog f_lbls bl last = return pt. 1552 #prog #f_lbls #f_regs #f_bl_r #good #id #fn #bl #pt #stmt #pre #last 1553 #EQfn #EQstmt #EQlabels 1554 cases(b_graph_transform_program_fetch_internal_function … good … EQfn) 1555 #init_data * #calling' ** #EQcalling' whd in ⊢ (% → ?); cases(f_bl_r ?) 1556 [2,4: #x #y *] normalize nodelta #EQ destruct(EQ) * #_ #_ #_ #_ #pp_labs 1557 #_ #fresh_labs #_ #_ #_ #H lapply(H … EQstmt) H * #lbls * #regs ** >EQlabels 1558 whd in ⊢ (??%? → ?); #EQ destruct(EQ) #EQregs cases stmt in EQstmt; normalize nodelta 1559 [3: * 1560 2: * [#lbl  *] #EQstmt whd in ⊢ (%→ ?); * #bl * 1561 *: * [#c  * [ #c_id  #c_ptr] #args #dest  #r #lbl  #seq ] #nxt #EQstmt 1562 >if_merge_right [2,4,6,8,10: %] whd in ⊢ (% → ?); * #bl * 1563 ] whd in ⊢ (% → ?); cases regs in EQregs; normalize nodelta 1564 [2,4,6,8,9,12,14: [1,2,3,4,6,7: #x #y] #_ *10: #r #tl] #EQregs 1565 [ whd in ⊢ (% → ?); cases tl in EQregs; normalize nodelta [2: #x #y #_ *] #EQregs] 1566 #EQbl destruct(EQbl) whd in ⊢ (%→?); [2,3: * #pref * #mid ***: * #l1 * #mid1 * #mid2 * #l2 ***] 1567 #EQmid1 whd in ⊢ (% → ?); 1568 [1,2,4,5,6,7: * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (??%%); destruct(EQmid1) 1569 [3,4,5,6: whd in ⊢ (% → ?); * #nxt1 * #EQt_stmt #EQ destruct(EQ) ] 1570 whd in ⊢ (% → ?); * [1,2,3,4: #e0] @⊥ @(append_absurd ??? e0)] 1571 * #mid * #rest ** #EQ destruct(EQ) whd in ⊢ (% → ?); * #nxt1 * #_ 1572 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1573 * #mid3 * #rest1 ** #EQ destruct(EQ) whd in ⊢ (% → ?); * #nxt1 * #_ 1574 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1575 * #mid4 * #rest2 ** #EQ destruct(EQ) whd in ⊢ (% → ?); * #nxt1 * #_ 1576 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1577 * #mid5 * #rest3 ** #EQ destruct(EQ) whd in ⊢ (% → ?); * #nxt1 * #_ 1578 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1579 * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in ⊢ (% → ?); * #nxt1 * #EQcall 1580 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1581 * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (??%%); destruct(EQmid1) 1582 >e0 in EQlabels; #EQlabels whd in match get_sigma; normalize nodelta 1583 >code_block_of_block_eq >m_return_bind >EQfn >m_return_bind 1584 inversion(find ????) 1585 [ #EQfind @⊥ lapply(find_none ?????? EQfind EQstmt) >EQlabels 1586 normalize nodelta @eq_identifier_elim [ #_ *] * #H #_ @H 1587 whd in EQmid1 : (??%%); destruct(EQmid1) @(last_append_eq ????? e1) ] 1588 * #lbl #s #EQfind >m_return_bind lapply(find_predicate ?????? EQfind) 1589 inversion(f_lbls ??) [ #_ normalize nodelta *] #labels 1590 @(list_elim_left … labels …) labels normalize nodelta 1591 [ #EQl @eq_identifier_elim [2: #_ *] #EQ lapply EQl destruct(EQ) #EQl 1592 lapply(fresh_labs pt) >EQlabels <e0 whd in ⊢ (% → ?); 1593 #H lapply(append_All … H) H * #_ whd in ⊢ (% → ?); *** #H #_ #_ #_ @⊥ @H 1594 @(code_is_in_universe … (pi2 ?? fn)) whd in match code_has_label; 1595 whd in match code_has_point; normalize nodelta whd in match (stmt_at ????); 1596 >(find_lookup ?????? EQfind) @I 1597  #last1 #pre1 #_ #EQl >split_on_last_append normalize nodelta @eq_identifier_elim 1598 [2: #_ *] #EQ lapply EQl destruct(EQ) #EQl #_ lapply pp_labs 1599 whd in match partial_partition; normalize nodelta * #_ #H lapply(H lbl pt) 1600 >EQl <e0 in EQlabels; #EQlabels >EQlabels whd in ⊢ (% → ?); H #H 1601 >(H last1 ? ?) [%] >(memb_append_l2 ? last1 ? [last1] ?) /2 by / 1602 ] 1603 qed. 1604 1605 lemma fetch_call_commute : 1606 ∀prog : ertl_program. 1607 let trans_prog ≝ ertl_to_ertlptr prog in 1608 ∀ f_lbls,f_regs. 1609 ∀f_bl_r. 1610 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1611 translate_data prog f_bl_r f_lbls f_regs → 1612 ∀id,fn,c_id,c_args,c_dest,nxt,pc. 1613 fetch_statement ERTL_semantics 1614 (prog_var_names … prog) (globalenv_noinit … prog) pc = 1615 return 〈id,fn, sequential ? ?(CALL ERTL_semantics ? c_id c_args c_dest) nxt〉 → 1616 ∃fn',pc'. sigma_stored_pc prog f_lbls pc' = pc ∧ 1617 fetch_statement ERTLptr_semantics 1618 (prog_var_names … trans_prog) (globalenv_noinit … trans_prog) pc' = 1619 return 〈id,fn', sequential ? ?(CALL ERTLptr_semantics ? c_id c_args c_dest) nxt〉. 1620 #prog #f_lbls #f_regs #f_bl_r #good #id #fn * [ #c_id  #c_ptr ] #c_args #c_dest 1621 #nxt #pc #EQfetch lapply(fetch_statement_inv … EQfetch) * #EQfn #EQstmt 1622 cases(b_graph_transform_program_fetch_internal_function … good … EQfn) 1623 #init_data * #calling' ** #EQcalling' whd in ⊢ (% → ?); cases(f_bl_r ?) 1624 [2,4: #x #y *] normalize nodelta #EQ destruct(EQ) * #_ #_ #_ #_ #pp_labs 1625 #_ #fresh_labs #_ #_ #_ #H cases(H … EQstmt) H #labels * #registers 1626 ** #EQlabels #EQregisters normalize nodelta >if_merge_right [2,4: %] 1627 whd in match translate_step; 1628 normalize nodelta whd in ⊢ (% → ?); * #bl * whd in ⊢ (% → ?); 1629 cases registers in EQregisters; registers normalize nodelta 1630 [2,3: [ #x #y] #_ *4: #r #tl] #EQregisters 1631 [ whd in ⊢ (% → ?); cases tl in EQregisters; tl [2: #x #y #_ *] normalize nodelta 1632 #EQregisters] #EQ destruct(EQ) whd in ⊢ (% → ?); * 1633 #pre_l * #mid1 * #mid2 * #post_l *** #EQmid1 whd in ⊢ (% → ?); 1634 [ * #mid * #resg ** #EQ destruct(EQ) whd in ⊢ (% → ?); 1635 * #nxt1 * #EQlow change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 1636 whd in ⊢ (% → ?); * #mid3 * #rest1 ** #EQ destruct(EQ) * #nxt1 * 1637 #EQpush1 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 1638 whd in ⊢ (% → ?); * #mid4 * #rest2 ** #EQ destruct(EQ) * #nxt1 * #EQhigh 1639 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1640 * #mid5 * #rest3 ** #EQ destruct(EQ) * #nxt1 * #EQpush2 1641 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 1642 ] * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (??%%); destruct(EQmid1) 1643 whd in ⊢ (% → ?); * #nxt1 * #EQcall #EQ destruct(EQ) whd in ⊢ (% → ?); 1644 * #EQ destruct(EQ) change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 1645 %{calling'} 1646 [ %{(pc_of_point ERTLptr_semantics (pc_block pc) mid1)} 1647  %{pc} 1648 ] % 1649 [1,3: whd in match sigma_stored_pc; whd in match sigma_pc_opt; normalize nodelta 1650 @eqZb_elim change with (pc_block pc) in match (pc_block ?) in ⊢ (% → ?); 1651 [1,3: #EQbl >fetch_internal_function_no_minus_one in EQfn; try assumption 1652 #EQ destruct(EQ)] #_ normalize nodelta 1653 [2: >(get_sigma_idempotent … good … EQfn EQstmt EQlabels) 1654 *: change with (pc_block pc) in match (pc_block ?); 1655 >point_of_pc_of_point >(get_sigma_last … good … EQfn EQstmt EQlabels) 1656 ] >m_return_bind normalize nodelta >pc_of_point_of_pc % 1657 *: whd in match fetch_statement; normalize nodelta >EQcalling' >m_return_bind 1658 [>point_of_pc_of_point ] >EQcall % 1659 ] 1847 1660 qed. 1848 1661 1849 lemma pc_block_eq : ∀prog : ertl_program. 1850 ∀sigma : sigma_map prog. 1851 ∀pc,id,fn. 1852 fetch_internal_function (joint_closed_internal_function ERTL 1853 (prog_var_names (joint_function ERTL) ℕ prog)) 1854 (globalenv_noinit (joint_function ERTL) prog) (pc_block … pc) 1855 = return 〈id,fn〉→ 1856 sigma fn (point_of_pc ERTL_semantics pc) ≠ None ? → 1857 pc_block … pc = pc_block … (sigma_stored_pc prog sigma pc). 1858 #prog #sigma * #bl #pos #id #fn #EQfn #EQlbl whd in match sigma_stored_pc; 1859 normalize nodelta whd in match sigma_pc_opt; normalize nodelta @if_elim [ #_ %] 1860 #_ >EQfn >m_return_bind >(opt_to_opt_safe … EQlbl) >m_return_bind % 1861 qed. 1662 1663 1664 lemma next_of_call_pc_ok : ∀prog : ertl_program. 1665 let trans_prog ≝ ertl_to_ertlptr prog in 1666 ∀ f_lbls,f_regs.∀f_bl_r. 1667 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1668 translate_data prog f_bl_r f_lbls f_regs → 1669 ∀pc,lb. 1670 next_of_call_pc ERTL_semantics (prog_var_names … prog) (globalenv_noinit … prog) 1671 pc = return lb → 1672 ∃pc'. sigma_stored_pc prog f_lbls pc' = pc ∧ 1673 next_of_call_pc ERTLptr_semantics (prog_var_names … trans_prog) 1674 (globalenv_noinit … trans_prog) pc' = return lb. 1675 #prog #f_lbls #f_regs #f_bl_r #good #pc #lb whd in match next_of_call_pc; 1676 normalize nodelta #H @('bind_inversion H) H ** #id #fn 1677 * [ *[ #c  #c_id #c_arg #c_dest  #reg #lbl  #seq ] #prox  #fin  *] 1678 #EQfetch normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct(EQ) 1679 cases(fetch_call_commute … good … EQfetch) #fn1 * #pc1 * #EQpc1 #EQt_fetch 1680 %{pc1} % [assumption] >EQt_fetch % 1681 qed. 1682 1683 lemma next_of_call_pc_error : ∀pars.∀prog : program ? ℕ. ∀init,pc. 1684 (block_id (pi1 … (pc_block pc)) = 0 ∨ block_id (pi1 … (pc_block pc)) = 1) → 1685 next_of_call_pc pars (prog_var_names … prog) (globalenv … init prog) 1686 pc = Error ? [MSG BadFunction]. 1687 #pars #prg #init #pc * #EQ whd in match next_of_call_pc; normalize nodelta 1688 whd in match fetch_statement; normalize nodelta 1689 [ >fetch_internal_function_no_zero  >fetch_internal_function_no_minus_one] 1690 // 1691 qed. 1692 1693 lemma next_of_call_pc_inv : ∀pars.∀prog : program ? ℕ. ∀init. 1694 ∀pc,nxt. 1695 next_of_call_pc pars (prog_var_names … prog) 1696 (globalenv … init prog) pc = return nxt → 1697 ∃id,fn,c_id,c_args,c_dest. 1698 fetch_statement pars 1699 (prog_var_names … prog) (globalenv … init prog) pc = 1700 return 〈id,fn, sequential ? ?(CALL pars ? c_id c_args c_dest) nxt〉. 1701 #pars #prog #init #pc #nxt whd in match next_of_call_pc; normalize nodelta 1702 #H @('bind_inversion H) H ** #id #fn * 1703 [ *[ #c  #c_id #c_arg #c_dest  #reg #lbl  #seq ] #prox  #fin  #H #r #l #l ] 1704 #EQfetch normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct(EQ) 1705 %{id} %{fn} %{c_id} %{c_arg} %{c_dest} assumption 1706 qed. 1707 1708 lemma sigma_stored_pc_inj : ∀ prog : ertl_program. 1709 ∀f_lbls,pc,pc'. sigma_pc_opt prog f_lbls pc ≠ None ? → 1710 sigma_pc_opt prog f_lbls pc = sigma_pc_opt prog f_lbls pc' → 1711 pc = pc'. 1712 #prog #f_lbls ** #id #EQblid #off ** #id' #EQblid' #off' 1713 * inversion(sigma_pc_opt ???) [#_ #H @⊥ @H %] 1714 #pc1 whd in match sigma_pc_opt; normalize nodelta @if_elim 1715 [ @eqZb_elim [2: #_ *] #EQbl * whd in ⊢ (??%? → ?); #EQ destruct #_ 1716 #H lapply(sym_eq ??? H) H @if_elim [#_ whd in ⊢ (??%? → ?); #EQ destruct %] 1717 @eqZb_elim [ #_ *] * #EQbl' #_ #H @('bind_inversion H) H #lb #EQlb 1718 whd in ⊢ (??%? → ?); #EQ destruct @⊥ @EQbl' assumption] @eqZb_elim [#_ *] * #EQbl #_ 1719 #H @('bind_inversion H) H * #lb #EQlb whd in ⊢ (??%? → ?); #EQ destruct #_ 1720 #H lapply(sym_eq ??? H) H @if_elim 1721 [ @eqZb_elim [2: #_ *] #EQbl' #_ whd in ⊢ (??%? → ?); #EQ destruct @⊥ @EQbl @EQbl'] 1722 #_ #H @('bind_inversion H) H * #lb' #EQlb' whd in ⊢ (??%? → ?); 1723 whd in match (pc_of_point ???); whd in match (offset_of_point ??); 1724 whd in match (offset_of_point ??); #EQ destruct @eq_f 1725 cut(an_identifier LabelTag off = an_identifier LabelTag off') [2: #EQ destruct %] 1726 @(partial_inj_sigma prog f_lbls id) [>EQlb % #ABS destruct  >EQlb >EQlb' %] 1727 qed. 1728 1729 lemma eval_return_ok : 1730 ∀prog : ertl_program. 1731 let trans_prog ≝ ertl_to_ertlptr prog in 1732 ∀ f_lbls,f_regs,stack_sizes. 1733 ∀f_bl_r. 1734 ∀ good :b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1735 translate_data prog f_bl_r f_lbls f_regs. 1736 ∀st2, st1',f,fn. 1737 let st1 ≝ sigma_state_pc prog f_lbls f_regs st2 in 1738 fetch_statement ERTL_semantics … 1739 (globalenv_noinit ? prog) (pc … st1) = 1740 return 〈f, fn, final … (RETURN ERTL … )〉 → 1741 eval_state ERTL_semantics 1742 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 1743 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 1744 st1 = 1745 return st1' → 1746 joint_classify (mk_prog_params ERTLptr_semantics trans_prog stack_sizes) 1747 st2 = cl_return ∧ 1748 ∃st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 1749 ∃st2_after_ret. 1750 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) (* always empty in this case *) 1751 st2_after_ret 1752 st2'. 1753 (if taaf_non_empty … taf then 1754 ¬as_costed (ERTLptr_status trans_prog stack_sizes) 1755 st2_after_ret 1756 else True) ∧ 1757 eval_state … (ev_genv … (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) st2 = 1758 return st2_after_ret ∧ 1759 ret_rel ?? (ERTLptrStatusSimulation prog stack_sizes ??? good) st1' st2_after_ret. 1760 #prog #f_lbls #f_regs #stack_size #f_bl_r #good #st2 #st1' #f #fn #EQfetch 1761 whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 1762 #H @('bind_inversion H) H #st1_tmp whd in ⊢ (??%%→?); #EQ destruct 1763 whd in match set_no_pc in ⊢ (%→?); whd in match eval_statement_advance in ⊢ (%→?); 1764 whd in match eval_return; normalize nodelta #H lapply(err_eq_from_io ????? H) H 1765 #H @('bind_inversion H) H * #n_st #n_pc change with (ertl_pop_frame ? = ? → ?) 1766 >(fetch_stmt_ok_sigma_state_ok … EQfetch) #EQpop_frame 1767 cases(pop_frame_ok ?????? EQpop_frame) * #t_n_st #t_n_pc * #EQt_pop_frame 1768 normalize nodelta 1769 inversion (fetch_internal_function ??) normalize nodelta 1770 [ * #id1 #fn1  #err ] normalize nodelta #EQfetch_fn1 #EQ destruct(EQ) 1771 #H @('bind_inversion H) H #next_of_n_pc 1772 [2: >next_of_call_pc_error [2: % %] whd in ⊢ (???% → ?); #EQ destruct(EQ)] 1773 #EQnext_of_n_pc cases(next_of_call_pc_ok … good … EQnext_of_n_pc) 1774 #pc1 * #EQpc1 cut(pc1 = t_n_pc) 1775 [ @(sigma_stored_pc_inj prog f_lbls) 1776 lapply EQnext_of_n_pc; <EQpc1 whd in match sigma_stored_pc; normalize nodelta 1777 inversion(sigma_pc_opt ???) [1,3: #_ >next_of_call_pc_error [2,4: % %] 1778 whd in ⊢ (???% → ?); #EQ destruct #x #_ #_ % #EQ destruct] #x #EQx #_ 1779 lapply EQnext_of_n_pc whd in match sigma_stored_pc; normalize nodelta 1780 inversion (sigma_pc_opt ???) [ #_ >next_of_call_pc_error [2: % %] 1781 whd in ⊢ (???% → ?); #EQ destruct] #y #EQy #_ lapply EQpc1 1782 whd in match sigma_stored_pc; normalize nodelta >EQx >EQy normalize nodelta 1783 #EQ destruct % 1784 ] #EQ destruct(EQ) #EQnxt whd in match next; whd in match set_last_pop; 1785 whd in match set_pc; normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct(EQ) 1786 cases(b_graph_transform_program_fetch_statement … good … EQfetch) 1787 #init_data * #t_fn1 ** #EQt_fn1 whd in ⊢ (% → ?); cases (f_bl_r ?) normalize nodelta 1788 [2: #r #tl *] #EQ destruct(EQ) * #labs ** 1789 [2: #hd #tl ** #_ #_ * #ibl * whd in ⊢ (%→?); *] ** #EQlabs #EQf_regs 1790 whd in match translate_fin_step; normalize nodelta * #bl * 1791 whd in ⊢ (% → ?); #EQ destruct(EQ) ** 1792 [2: #lb #tl * #mid ** #EQmid whd in ⊢ (% → ?); * #ABS destruct(ABS)] * #mid ** 1793 whd in ⊢ (???% → ?); #EQ destruct(EQ) * #_ #_ change with (stmt_at ???? = ? → ?) 1794 #EQstmt % 1795 [ whd in match joint_classify; normalize nodelta whd in match fetch_statement; 1796 normalize nodelta <(fetch_stmt_ok_sigma_pc_ok … EQfetch) >EQt_fn1 >m_return_bind 1797 >EQstmt % 1798  % 1799 [ % 1800 [ @t_n_st 1801  @(succ_pc ERTL_semantics (sigma_stored_pc prog f_lbls t_n_pc) next_of_n_pc) 1802  @t_n_pc] 1803 ] 1804 % 1805 [ whd in match sigma_state_pc; normalize nodelta 1806 lapply(next_of_call_pc_inv … EQnext_of_n_pc) * #id2 * #fn2 * #c_id * #c_arg 1807 * #c_dest #EQfetch1 whd in match (succ_pc ???); 1808 >(fetch_stmt_ok_sigma_pc_block_ok … EQfetch1) >EQfetch_fn1 1809 normalize nodelta % 1810 ] 1811 % 1812 [ % 1813 [ @t_n_st 1814  @(succ_pc ERTL_semantics (sigma_stored_pc prog f_lbls t_n_pc) next_of_n_pc) 1815  @t_n_pc] 1816 ] 1817 %{(taaf_base … )} normalize nodelta % [% [@I]] 1818 [ whd in match fetch_statement; normalize nodelta <(fetch_stmt_ok_sigma_pc_ok … EQfetch) 1819 >EQt_fn1 >m_return_bind >EQstmt >m_return_bind whd in match eval_statement_no_pc; 1820 normalize nodelta >m_return_bind whd in match eval_statement_advance; 1821 whd in match eval_return; normalize nodelta 1822 change with (ertl_pop_frame ?) in match (pop_frame ????????); 1823 >EQt_pop_frame >m_return_bind >EQnxt >m_return_bind whd in match next; 1824 whd in match set_pc; whd in match set_last_pop; whd in match succ_pc; 1825 normalize nodelta lapply(next_of_call_pc_inv … EQnext_of_n_pc) 1826 * #id2 * #fn2 * #c_id * #c_arg * #c_dest #EQfetch1 whd in match (succ_pc ???); 1827 >(fetch_stmt_ok_sigma_pc_block_ok … EQfetch1) % 1828  whd * #s1_pre #s1_call 1829 cases (joint_classify_call … s1_call) 1830 * #calling_i #calling * #call_spec * #arg * #dest * #nxt' #EQfetch_call 1831 * #s2_pre #s2_call whd in ⊢ (% → ?); >EQfetch_call normalize nodelta 1832 * #s1_pre_prf #EQpc_s2_pre whd in ⊢ (% → ?); #EQ1 1833 >EQ1 in EQfetch_call; #EQfetch_call 1834 cases(fetch_call_commute … good … EQfetch_call) #calling' * #pc1 * 1835 #EQ1 cut(pc … s2_pre = pc1) 1836 [ @(sigma_stored_pc_inj prog f_lbls) lapply(EQfetch_call) 1837 whd in match sigma_stored_pc; normalize nodelta inversion(sigma_pc_opt ???) 1838 [1,3: #_ >fetch_statement_no_zero [2,4: %] #EQ destruct(EQ) #x #_ #_ % #EQ destruct] 1839 #pc2 #EQpc2 #_ lapply EQ1 whd in match sigma_stored_pc; 1840 normalize nodelta >EQpc2 normalize nodelta cases(sigma_pc_opt ???) 1841 [2: #x normalize nodelta #EQ >EQ %] normalize nodelta #EQ <EQ in EQpc2; 1842 #EQ1 lapply EQfetch_call >fetch_statement_no_zero [ #ABS destruct(ABS)] 1843 whd in match sigma_stored_pc; normalize nodelta >EQ1 % 1844 ] #EQ2 destruct(EQ2) #EQt_fetch_call whd >EQt_fetch_call normalize nodelta % 1845 [ >EQ1 in s1_pre_prf; #EQ @(sigma_stored_pc_inj prog f_lbls) 1846 lapply EQnext_of_n_pc whd in match sigma_stored_pc; normalize nodelta 1847 inversion(sigma_pc_opt ???) [1,3: #_ >next_of_call_pc_error [2,4: % %] 1848 whd in ⊢ (???% → ?); #EQ destruct] #pc1 #EQpc1 #_ [ % #EQ destruct] 1849 lapply EQ whd in match sigma_stored_pc; normalize nodelta 1850 >EQpc1 normalize nodelta inversion(sigma_pc_opt ???) 1851 [2: #pc2 #_ normalize nodelta #EQ >EQ %] normalize nodelta 1852 #ABS #ABS1 lapply EQnext_of_n_pc whd in match sigma_stored_pc; 1853 normalize nodelta >EQpc1 >ABS1 normalize nodelta 1854 >next_of_call_pc_error [2: % %] whd in ⊢ (???% → ?); #EQ destruct 1855  whd in match succ_pc; normalize nodelta 1856 change with next_of_n_pc in match (point_of_succ ???); 1857 change with nxt' in match (point_of_succ ???); 1858 lapply EQpc_s2_pre whd in match succ_pc; normalize nodelta 1859 change with next_of_n_pc in match (point_of_succ ???); 1860 change with nxt' in match (point_of_succ ???); #EQ >EQ 1861 cut(pc_block (pc … s1_pre) = pc_block (pc … s2_pre)) 1862 [2: #EQ >EQ %] >EQ1 <(pc_block_eq prog f_lbls …) [%] 1863 lapply EQfetch_call whd in match sigma_stored_pc; normalize nodelta 1864 cases(sigma_pc_opt ???) [ >fetch_statement_no_zero [2: %] #EQ destruct] 1865 #x #_ % #EQ destruct 1866 ] 1867 ] 1868 ] 1869 qed. 1870 1871 lemma bool_of_beval_ok : ∀prog : ertl_program. 1872 ∀f_lbls. preserving1 … res_preserve1 … 1873 (sigma_beval prog f_lbls) 1874 (λx.x) 1875 (bool_of_beval) 1876 (bool_of_beval). 1877 #prog #f_lbls * [   #ptr1 #ptr2 #p  #by  #p  #ptr #p  #pc1 #p1] 1878 whd in match bool_of_beval; normalize nodelta try @res_preserve_error1 1879 try @mfr_return1 whd in match sigma_beval; normalize nodelta 1880 cases (sigma_pc_opt ???) normalize nodelta [2: #pc] @res_preserve_error1 1881 qed. 1882 1883 lemma eval_cond_ok : 1884 ∀prog. 1885 let trans_prog ≝ ertl_to_ertlptr prog in 1886 ∀ f_lbls,f_regs,stack_sizes. 1887 ∀f_bl_r. 1888 ∀ good :b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1889 translate_data prog f_bl_r f_lbls f_regs. 1890 ∀st2,st1',f,fn,a,ltrue,lfalse. 1891 let st1 ≝ sigma_state_pc prog f_lbls f_regs st2 in 1892 fetch_statement ERTL_semantics … 1893 (globalenv_noinit ? prog) (pc … st1) = 1894 return 〈f, fn, sequential … (COND ERTL … a ltrue) lfalse〉 → 1895 eval_state ERTL_semantics 1896 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 1897 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 1898 st1 = return st1' → 1899 as_costed (ERTL_status prog stack_sizes) st1' → 1900 ∃ st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 1901 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 1902 st2 st2'. 1903 bool_to_Prop (taaf_non_empty … taf). 1904 #prog #f_lbls #f_regs #stack_size #f_bl_r #good #st2 #st1' #f #fn #a #ltrue #lfalse 1905 #EQfetch whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 1906 whd in match eval_statement_no_pc; normalize nodelta >m_return_bind 1907 whd in match eval_statement_advance; normalize nodelta 1908 change with (ps_reg_retrieve ??) in match (acca_retrieve ?????); 1909 #H lapply(err_eq_from_io ????? H) H #H @('bind_inversion H) H 1910 #bv >(fetch_stmt_ok_sigma_state_ok … EQfetch) in ⊢ (% → ?); whd in match set_no_pc; 1911 normalize nodelta #EQbv #H @('bind_inversion H) H * #EQbool normalize nodelta 1912 lapply(fetch_statement_inv … EQfetch) * #EQfn #_ 1913 [ whd in match goto; normalize nodelta >(pc_of_label_eq ??????? EQfn) >m_return_bind 1914  whd in match next; normalize nodelta 1915 ] whd in match set_pc; normalize nodelta 1916 >(fetch_stmt_ok_sigma_state_ok … EQfetch) whd in match set_no_pc; normalize nodelta 1917 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) >(fetch_stmt_ok_sigma_last_pop_ok … EQfetch) 1918 whd in ⊢ (??%% → ?); #EQ destruct #n_cost 1919 %{(mk_state_pc ? (st_no_pc … st2) 1920 (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) ?) 1921 (last_pop … st2))} [ @ltrue 3: @lfalse] 1922 % [1,3: whd in match sigma_state_pc; normalize nodelta 1923 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQfn; #EQfn >EQfn %] 1924 cases(b_graph_transform_program_fetch_statement … good … EQfetch) 1925 #init_data * #t_fn1 ** #EQt_fn1 whd in ⊢ (% → ?); cases (f_bl_r ?) normalize nodelta 1926 [2,4: #r #tl *] #EQ destruct(EQ) >if_merge_right in ⊢ (% → ?); [2,4: %] * #labs ** 1927 [2,4: #hd #tl ** #_ #_ *** #pre #inst #post * whd in ⊢ (%→?); *] ** #EQlabs #EQf_regs 1928 whd in match translate_step; normalize nodelta * #bl * 1929 whd in ⊢ (% → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); * #l1 * #mid1 * #mid2 * #l2 1930 *** #EQmid1 whd in ⊢ (% → ?); * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in ⊢ (% → ?); * 1931 #nxt1 * #EQcond #EQ destruct(EQ) whd in ⊢ (% → ?); * #EQ1 #EQ2 destruct(EQ1 EQ2) 1932 whd in EQmid1 : (??%%); destruct(EQmid1) 1933 %{(taaf_step_jump … (taa_base …) …) I} 1934 [2,5: whd whd in ⊢ (??%?); whd in match fetch_statement; normalize nodelta 1935 <(fetch_stmt_ok_sigma_pc_ok … EQfetch) >EQt_fn1 >m_return_bind 1936 >EQcond % 1937 3,6: whd whd in match eval_state; normalize nodelta whd in match eval_statement_no_pc; 1938 normalize nodelta whd in match fetch_statement; normalize nodelta 1939 <(fetch_stmt_ok_sigma_pc_ok … EQfetch) >EQt_fn1 >m_return_bind 1940 >EQcond >m_return_bind normalize nodelta >m_return_bind 1941 whd in match eval_statement_advance; normalize nodelta 1942 change with (ps_reg_retrieve ??) in match (acca_retrieve ?????); 1943 cases(ps_reg_retrieve_ok … EQbv) #bv1 * #EQbv1 #EQsem >EQbv1 1944 >m_return_bind >EQsem in EQbool; #EQbool cases(bool_of_beval_ok … EQbool) 1945 #bool1 * #EQbool1 #EQ destruct(EQ) >EQbool1 >m_return_bind normalize nodelta 1946 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) [2: %] whd in match goto; 1947 normalize nodelta >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQt_fn1; #EQt_fn1 1948 >(pc_of_label_eq … EQt_fn1) >m_return_bind % 1949 *: lapply n_cost whd in match as_costed; normalize nodelta 1950 [ cut((mk_state_pc ERTL_semantics 1951 (sigma_state prog f_lbls f_regs 1952 (added_registers ERTL (prog_var_names (joint_function ERTL) ℕ prog) fn 1953 (f_regs (pc_block (pc ERTLptr_semantics st2)))) st2) 1954 (pc_of_point ERTL_semantics (pc_block (pc ERTLptr_semantics st2)) ltrue) 1955 (sigma_stored_pc prog f_lbls (last_pop ERTLptr_semantics st2))) = 1956 sigma_state_pc prog f_lbls f_regs (mk_state_pc ERTLptr_semantics st2 1957 (pc_of_point ERTLptr_semantics (pc_block (pc ERTLptr_semantics st2)) ltrue) 1958 (last_pop ERTLptr_semantics st2))) [ whd in match sigma_state_pc; normalize nodelta 1959 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQfn; #EQfn >EQfn %] 1960 #EQ >EQ >(as_label_ok … good … (mk_state_pc ERTLptr_semantics st2 1961 (pc_of_point ERTLptr_semantics (pc_block (pc ERTLptr_semantics st2)) ltrue) 1962 (last_pop ERTLptr_semantics st2))) [#H @H] cases daemon (*needs lemma see below *) 1963  cut((mk_state_pc ERTL_semantics 1964 (sigma_state prog f_lbls f_regs 1965 (added_registers ERTL (prog_var_names (joint_function ERTL) ℕ prog) fn 1966 (f_regs (pc_block (pc ERTLptr_semantics st2)))) st2) 1967 (succ_pc ERTL_semantics (pc ERTLptr_semantics st2) 1968 (point_of_succ ERTLptr_semantics 1969 (point_of_pc ERTLptr_semantics 1970 (pc ERTL_semantics (sigma_state_pc prog f_lbls f_regs st2))) nxt1)) 1971 (sigma_stored_pc prog f_lbls (last_pop ERTLptr_semantics st2))) = 1972 sigma_state_pc prog f_lbls f_regs (mk_state_pc ERTLptr_semantics st2 1973 (pc_of_point ERTLptr_semantics (pc_block (pc ERTLptr_semantics st2)) 1974 (point_of_succ ERTLptr_semantics 1975 (point_of_pc ERTLptr_semantics 1976 (pc ERTL_semantics (sigma_state_pc prog f_lbls f_regs st2))) nxt1)) 1977 (last_pop ERTLptr_semantics st2))) [ whd in match sigma_state_pc; normalize nodelta 1978 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in EQfn; #EQfn >EQfn %] #EQ >EQ 1979 >(as_label_ok … good … (mk_state_pc ERTLptr_semantics st2 1980 (pc_of_point ERTLptr_semantics (pc_block (pc ERTLptr_semantics st2)) 1981 (point_of_succ ERTLptr_semantics 1982 (point_of_pc ERTLptr_semantics 1983 (pc ERTL_semantics (sigma_state_pc prog f_lbls f_regs st2))) nxt1)) 1984 (last_pop ERTLptr_semantics st2))) [#H @H] cases daemon (*needs lemma see below ! *) 1985 ] 1986 qed. 1987 1988 lemma eval_cost_ok : 1989 ∀prog. 1990 let trans_prog ≝ ertl_to_ertlptr prog in 1991 ∀ f_lbls,f_regs,stack_sizes. 1992 ∀f_bl_r. 1993 ∀ good :b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 1994 translate_data prog f_bl_r f_lbls f_regs. 1995 ∀st2,st1',f,fn,c,nxt. 1996 let st1 ≝ sigma_state_pc prog f_lbls f_regs st2 in 1997 fetch_statement ERTL_semantics … 1998 (globalenv_noinit ? prog) (pc … st1) = 1999 return 〈f, fn, sequential … (COST_LABEL ERTL … c) nxt〉 → 2000 eval_state ERTL_semantics 2001 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2002 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 2003 st1 = return st1' → 2004 ∃ st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 2005 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 2006 st2 st2'. 2007 bool_to_Prop (taaf_non_empty … taf). 2008 #prog #f_lbls #f_regs #stack_Size #f_bl_r #good #st2 #st1' #f #fn #c #nxt 2009 #EQfetch whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 2010 whd in match eval_statement_no_pc; normalize nodelta >m_return_bind 2011 whd in match eval_statement_advance; normalize nodelta 2012 >(fetch_stmt_ok_sigma_state_ok … EQfetch) whd in match set_no_pc; 2013 normalize nodelta >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 2014 >(fetch_stmt_ok_sigma_last_pop_ok … EQfetch) whd in match next; 2015 whd in match set_pc; normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct(EQ) 2016 %{(set_pc ? (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) nxt) st2)} 2017 % [ whd in match sigma_state_pc; normalize nodelta 2018 lapply(fetch_statement_inv … EQfetch) >(fetch_stmt_ok_sigma_pc_ok … EQfetch) * 2019 #EQfn #_ >EQfn %] lapply EQfetch >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 2020 #EQfetch' 2021 cases(b_graph_transform_program_fetch_statement … good … EQfetch') 2022 #init_data * #t_fn ** #EQt_fn whd in ⊢ (% → ?); cases(f_bl_r ?) [2: #x #y *] 2023 normalize nodelta #EQ destruct(EQ) * #lbls * #regs ** #_ #_ whd in ⊢ (% → ?); 2024 * #bl * >if_merge_right [2: %] whd in ⊢ (% → ?); cases regs [2: #x #y *] 2025 normalize nodelta #EQ destruct(EQ) whd in ⊢ (% → ?); * #l1 * #mid1 * #mid2 * #l2 2026 *** #EQmid whd in ⊢ (% → ?); * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid : (???%); 2027 destruct(EQmid) whd in ⊢ (% → ?); * #nxt1 * #EQstmt #EQ destruct(EQ) 2028 whd in ⊢ (% → ?); * #EQ1 #EQ2 destruct(EQ1 EQ2) %{(taaf_step … (taa_base …) …)} 2029 [1,2: whd [ whd in ⊢ (??%?);  whd in match eval_state; ] 2030 whd in match fetch_statement; normalize nodelta >EQt_fn >m_return_bind 2031 >EQstmt [%] >m_return_bind whd in match eval_statement_no_pc; 2032 normalize nodelta >m_return_bind %] @I 2033 qed. 2034 2035 lemma block_of_call_ok : ∀prog: ertl_program. 2036 let trans_prog ≝ ertl_to_ertlptr prog in 2037 ∀ f_lbls,f_regs. 2038 ∀called,restr. preserving1 … res_preserve1 … 2039 (sigma_state prog f_lbls f_regs restr) 2040 (λx.x) 2041 (block_of_call ERTL_semantics (prog_var_names … prog) 2042 (globalenv_noinit … prog) called) 2043 (block_of_call ERTLptr_semantics (prog_var_names … trans_prog) 2044 (globalenv_noinit … trans_prog) called). 2045 #prog #f_lbls #f_regs #called #restr #st whd in match block_of_call; normalize nodelta 2046 @mfr_bind1 2047 [ @(λx.x) 2048  cases(called) [#c_id  #c_ptr] normalize nodelta 2049 [ @opt_to_res_preserve1 #bl #EQbl %{bl} % [2: %] 2050 >(find_symbol_transf … 2051 (λvars.transf_fundef … (λfn.(b_graph_translate … fn))) prog c_id) 2052 assumption 2053  @mfr_bind1 2054 [2: whd in match dpl_arg_retrieve; normalize nodelta @(ps_arg_retrieve_ok)  2055  #bv1 @mfr_bind1 2056 [2: whd in match dph_arg_retrieve; normalize nodelta @(ps_arg_retrieve_ok)  2057  #bv2 @mfr_bind1 2058 [ @(λx.x) 2059  whd in match pointer_of_bevals; normalize nodelta 2060 cases bv1 normalize nodelta 2061 [   #ptr1 #ptr2 #p  #by  #p  #ptr #p  #pc1 #p1] 2062 try @res_preserve_error1 2063 [ cases bv2 [   #ptr1' #ptr2' #p'  #by'  #p'  #ptr' #p'  #pc1' #p1'] 2064 normalize nodelta 2065 [1,2,3,4,5: @res_preserve_error1 2066  @if_elim #_ [@mfr_return_eq1 %  @res_preserve_error1] 2067 ] 2068 ] whd in match sigma_beval; normalize nodelta cases(sigma_pc_opt ???) 2069 normalize nodelta [2,4: #pc ] @res_preserve_error1 2070  2071 #ptr @if_elim #_ [@mfr_return_eq1 %  @res_preserve_error1] 2072 ] 2073 ] 2074 ] 2075 ] 2076  #bl @opt_to_res_preserve1 whd in match code_block_of_block; normalize nodelta 2077 @match_reg_elim [ #_ @opt_preserve_none1  #prf @mfr_return_eq1 %] 2078 ] 2079 qed. 2080 2081 lemma bvpc_sigma_pc_to_sigma_beval : ∀prog : ertl_program. 2082 ∀f_lbls,pc,p. sigma_pc_opt prog f_lbls pc ≠ None ? → 2083 BVpc (sigma_stored_pc prog f_lbls pc) p = 2084 sigma_beval prog f_lbls (BVpc pc p). 2085 #prog #f_lbls #pc #p #prf whd in match sigma_stored_pc; 2086 whd in match sigma_beval; normalize nodelta lapply prf 2087 cases(sigma_pc_opt ???) [ * #H @⊥ @H %  #pc' #_ % ] 2088 qed. 2089 2090 lemma push_ra_ok : ∀prog : ertl_program. 2091 ∀f_lbls,f_regs,restr,pc. sigma_pc_opt prog f_lbls pc ≠ None ? → 2092 preserving1 ?? res_preserve1 … 2093 (sigma_state prog f_lbls f_regs restr) 2094 (sigma_state prog f_lbls f_regs restr) 2095 (λst.push_ra ERTL_semantics st (sigma_stored_pc prog f_lbls pc)) 2096 (λst.push_ra ERTLptr_semantics st pc). 2097 #prog #f_lbls #f_regs #restr #pc #prf #st whd in match push_ra; normalize nodelta 2098 @mfr_bind1 2099 [ @(sigma_state prog f_lbls f_regs restr) 2100  >(bvpc_sigma_pc_to_sigma_beval … prf) @push_ok 2101  #st' >(bvpc_sigma_pc_to_sigma_beval … prf) @push_ok 2102 ] qed. 2103 2104 lemma ertl_save_frame_ok : ∀prog : ertl_program. 2105 ∀f_lbls.∀f_regs : regs_funct.∀kind,restr. 2106 preserving1 ?? res_preserve1 ???? 2107 (λst. match fetch_internal_function … (globalenv_noinit … prog) 2108 (pc_block (pc … st)) with 2109 [ OK y ⇒ let 〈f,fn〉 ≝ y in 2110 let added ≝ added_registers … (prog_var_names … prog) fn 2111 (f_regs (pc_block (pc … st))) in 2112 mk_state_pc ? (sigma_state prog f_lbls f_regs added st) 2113 (sigma_stored_pc prog f_lbls (pc … st)) 2114 (sigma_stored_pc prog f_lbls (last_pop … st)) 2115  Error e ⇒ dummy_state_pc 2116 ]) 2117 (sigma_state prog f_lbls f_regs restr) 2118 (ertl_save_frame kind it) 2119 (match kind with 2120 [ID ⇒ ertlptr_save_frame ID it 2121 PTR ⇒ λst. !st' ← push_ra … st (pc … st); 2122 ertlptr_save_frame ID it (set_no_pc … st' st) 2123 ]). 2124 xxxxxxxxxxxxxxxxxxx 2125 #prog #f_lbls #f_regs #kind #restr #st whd in match ertl_save_frame; 2126 whd in match ertlptr_save_frame; normalize nodelta @mfr_bind1 2127 [2: cases(fetch_internal_function ???) normalize nodelta 2128 [ * #id #fn normalize nodelta 2129 2130 change with (st_no_pc … st) in ⊢ (???????(??(?????%)?)(??%?)); 2131 @push_ra_ok 2132 2133 lemma eval_call_ok : 2134 ∀prog : ertl_program. 2135 let trans_prog ≝ ertl_to_ertlptr prog in 2136 ∀ f_lbls,f_regs,stack_sizes. 2137 ∀f_bl_r. 2138 ∀ good :b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 2139 translate_data prog f_bl_r f_lbls f_regs. 2140 ∀st2,st1',f,fn,called,args,dest,nxt. 2141 let st1 ≝ sigma_state_pc prog f_lbls f_regs st2 in 2142 fetch_statement ERTL_semantics … 2143 (globalenv_noinit ? prog) (pc … st1) = 2144 return 〈f, fn, 2145 sequential … (CALL ERTL … called args dest ) nxt〉 → 2146 eval_state … (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) st1 = 2147 return st1' → 2148 ∃is_call,st2_pre_call,is_call'. 2149 as_call_ident (ERTLptr_status trans_prog stack_sizes) 2150 («st2_pre_call,is_call'») = as_call_ident (ERTL_status prog stack_sizes) 2151 («st1, is_call») ∧ 2152 (pc … st1) = sigma_stored_pc prog f_lbls (pc … st2_pre_call) ∧ 2153 ∃taa2 : trace_any_any (ERTLptr_status trans_prog stack_sizes) st2 st2_pre_call. 2154 ∃ st2'. st1' = sigma_state_pc prog f_lbls f_regs st2' ∧ 2155 eval_state ERTLptr_semantics … 2156 (ev_genv … (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) st2_pre_call 2157 =return st2'. 2158 #prog #f_lbls #f_regs #stack_size #f_bl_r #good #st2 #st1' #f #fn * [#c_id  #c_ptr] 2159 #args #dest #nxt #EQfetch lapply EQfetch >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 2160 #EQfetch' lapply(fetch_statement_inv … EQfetch') * #EQfn normalize nodelta #EQstmt 2161 cases(b_graph_transform_program_fetch_internal_function … good … EQfn) 2162 #init_data * #calling' ** #EQcalling' whd in ⊢ (% → ?); cases(f_bl_r ?) 2163 [2,4: #x #y *] normalize nodelta #EQ destruct(EQ) * #_ #_ #_ #_ #pp_labs 2164 #_ #fresh_labs #fresh_regs #_ #_ #H cases(H … EQstmt) H #labels * #registers 2165 ** #EQlabels #EQregisters normalize nodelta >if_merge_right [2,4: %] 2166 whd in match translate_step; 2167 normalize nodelta whd in ⊢ (% → ?); * #bl * whd in ⊢ (% → ?); 2168 cases registers in EQregisters; registers normalize nodelta 2169 [2,3: [ #x #y] #_ *4: #r #tl] #EQregisters 2170 [ whd in ⊢ (% → ?); cases tl in EQregisters; tl [2: #x #y #_ *] normalize nodelta 2171 #EQregisters] #EQ destruct(EQ) whd in ⊢ (% → ?); * 2172 #pre_l * #mid1 * #mid2 * #post_l *** #EQmid1 whd in ⊢ (% → ?); 2173 [ * #mid * #resg ** #EQ destruct(EQ) whd in ⊢ (% → ?); 2174 * #nxt1 * #EQlow change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 2175 whd in ⊢ (% → ?); * #mid3 * #rest1 ** #EQ destruct(EQ) * #nxt1 * 2176 #EQpush1 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 2177 whd in ⊢ (% → ?); * #mid4 * #rest2 ** #EQ destruct(EQ) * #nxt1 * #EQhigh 2178 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 2179 * #mid5 * #rest3 ** #EQ destruct(EQ) * #nxt1 * #EQpush2 2180 change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) whd in ⊢ (% → ?); 2181 ] * #EQ1 #EQ2 destruct(EQ1 EQ2) whd in EQmid1 : (??%%); destruct(EQmid1) 2182 whd in ⊢ (% → ?); * #nxt1 * #EQcall #EQ destruct(EQ) whd in ⊢ (% → ?); 2183 * #EQ destruct(EQ) change with nxt1 in ⊢ (??%? → ?); #EQ destruct(EQ) 2184 whd in match eval_state; normalize nodelta >EQfetch 2185 >m_return_bind whd in match eval_statement_no_pc; normalize nodelta >m_return_bind 2186 whd in match eval_statement_advance; whd in match eval_call; normalize nodelta 2187 >(fetch_stmt_ok_sigma_state_ok … EQfetch) >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 2188 >(fetch_stmt_ok_sigma_last_pop_ok … EQfetch) #H @('bind_inversion H) H 2189 #c_bl whd in match set_no_pc; normalize nodelta #H lapply(err_eq_from_io ????? H) H 2190 #EQc_bl cases(block_of_call_ok ??????? EQc_bl) #c_bl' * #EQc_bl' #EQ destruct(EQ) 2191 #H @('bind_inversion H) H * #f1 * [1,3: #fn1 *: #ext_f] #EQfn1 normalize nodelta 2192 [3,4: #H @('bind_inversion H) H #st whd in match eval_external_call; normalize nodelta 2193 #H @('bind_inversion H) H #list_val #_ #H @('bind_inversion H) H #x 2194 #_ #H @('bind_inversion H) H #y whd in match do_io; normalize nodelta 2195 whd in ⊢ (???% → ?); #ABS destruct(ABS) ] #H lapply(err_eq_from_io ????? H) H 2196 #H @('bind_inversion H) H #st1'' >(fetch_stmt_ok_sigma_pc_ok … EQfetch) 2197 >(fetch_stmt_ok_sigma_last_pop_ok … EQfetch) whd in match kind_of_call; 2198 normalize nodelta change with (ertl_save_frame ? it ?) in ⊢ (??%? → ?); 2199 [2: @PTR 4: @ID] #EQst1'' #H @('bind_inversion H) H #st1''' 2200 whd in match eval_internal_call; normalize nodelta #H @('bind_inversion H) H 2201 #s_size #H lapply(opt_eq_from_res ???? H) H 2202 change with (stack_size ?) in ⊢ (??%? → ?); #EQs_size whd in ⊢ (??%? → ?); 2203 whd in ⊢ (???% → ?); #EQ destruct(EQ) whd in ⊢ (??%% → ?); #EQ destruct(EQ) % 2204 [1,3: @hide_prf whd in ⊢ (??%?); >EQfetch %] 2205 [ letin pairpc ≝ (beval_pair_of_pc (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) mid1)) 2206 letin st2_pre ≝ (mk_state_pc ? 2207 (mk_state ? (st_frms … st2) (both_is (\fst pairpc) (\snd pairpc)) 2208 (carry … st2) (〈add ?? (\fst (regs … st2)) r (\snd pairpc),\snd(regs … st2)〉) 2209 (m … st2)) 2210 (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) mid1) 2211 (last_pop … st2)) 2212 %{st2_pre} 2213  %{st2} 2214 ] % 2215 [1,3: @hide_prf whd in ⊢ (??%?); whd in match fetch_statement; normalize nodelta 2216 >EQcalling' >m_return_bind [>point_of_pc_of_point ] >EQcall >m_return_bind % ] 2217 % 2218 [1,3: % 2219 [1,3: whd in ⊢ (??%%); whd in match fetch_statement in ⊢ (??%?); 2220 normalize nodelta >EQcalling' in ⊢ (??(match % with [_ ⇒ ?  _ ⇒ ?])?); 2221 >m_return_bind in ⊢ (??(match % with [_ ⇒ ?  _ ⇒ ?])?); 2222 [ >point_of_pc_of_point in ⊢ (??(match % with [_ ⇒ ?  _ ⇒ ?])?);] 2223 >EQcall in ⊢ (??(match % with [_ ⇒ ?  _ ⇒ ?])?); normalize nodelta 2224 >(fetch_stmt_ok_sigma_pc_ok … EQfetch) in ⊢ (???(match % with [_ ⇒ ?  _ ⇒ ?])); 2225 >EQfetch' in ⊢ (???(match % with [_ ⇒ ?  _ ⇒ ?])); % 2226 *: whd in match sigma_stored_pc; whd in match sigma_pc_opt; normalize nodelta 2227 @if_elim change with (pc_block(pc … st2)) in match (pc_block ?); 2228 [1,3: @eqZb_elim [2,4: #_ *] #EQbl #_ 2229 >fetch_internal_function_no_minus_one in EQcalling'; [2,4: assumption] 2230 whd in ⊢ (???% → ?); #ABS destruct(ABS) ] #_ 2231 [ >point_of_pc_of_point >(get_sigma_last … good … EQfn EQstmt EQlabels) 2232  >(get_sigma_idempotent … good … EQfn EQstmt EQlabels) 2233 ] 2234 >m_return_bind >pc_of_point_of_pc % 2235 ] 2236 4: %{(taa_base …)} 2237 2: letin st2'' ≝ (mk_state_pc ? 2238 (mk_state ? (st_frms … st2) (empty_is) (carry … st2) 2239 (〈add ?? (\fst (regs … st2)) r (\fst pairpc),\snd(regs … st2)〉) 2240 (m … st2)) (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) mid) 2241 (last_pop … st2)) 2242 letin st2''' ≝ (mk_state_pc ? (set_istack ? (one_is (\fst pairpc)) st2'') 2243 (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) mid3) 2244 (last_pop … st2)) 2245 letin st2''''≝ (mk_state_pc ? (mk_state ? (st_frms … st2) (istack … st2''') 2246 (carry … st2) 2247 (〈add ?? (\fst (regs … st2''')) r (\snd pairpc),\snd (regs … st2)〉) (m … st2''')) 2248 (pc_of_point ERTLptr_semantics (pc_block (pc … st2)) mid4) (last_pop … st2)) 2249 %{(taa_step ? st2 st2'' st2_pre ??? 2250 (taa_step ? st2'' st2''' st2_pre ??? 2251 (taa_step ? st2''' st2'''' st2_pre ??? 2252 (taa_step ? st2'''' st2_pre st2_pre ??? (taa_base …)))))} 2253 [3,6,7,10: % whd in ⊢ (% → ?); * #H @H whd in ⊢ (??%?); 2254 whd in match fetch_statement; normalize nodelta >EQcalling' >m_return_bind 2255 [ >point_of_pc_of_point >EQhigh 2256  >point_of_pc_of_point >EQcall 2257  >point_of_pc_of_point >EQpush2 2258  >point_of_pc_of_point >EQpush1 ] % 2259 1,2,4,5,8,9,11,12: whd 2260 [1,3,6,8: whd in match eval_state; normalize nodelta 2261 *: whd in ⊢ (??%?); 2262 ] 2263 whd in match fetch_statement; normalize nodelta >EQcalling' >m_return_bind 2264 [1,5: >point_of_pc_of_point >EQpush1 >m_return_bind [2: %] 2265 2,6: >point_of_pc_of_point >EQpush2 >m_return_bind [2: %] 2266 3,7: >point_of_pc_of_point >EQhigh >m_return_bind [2: %] 2267 *: >EQlow >m_return_bind [2: %] 2268 ] 2269 whd in match eval_statement_no_pc; whd in match eval_seq_no_pc; normalize nodelta 2270 whd in match (eval_ext_seq ?????????); whd in match (get_pc_from_label ?????); 2271 whd in match block_of_funct_id; normalize nodelta 2272 [1,2: whd in match acca_arg_retrieve; normalize nodelta 2273 change with (ps_reg_retrieve ??) in match (acca_arg_retrieve_ ?????); 2274 whd in match ps_reg_retrieve; whd in match reg_retrieve; normalize nodelta 2275 >lookup_add_hit >m_return_bind [% >add_idempotent %] 2276 *: @('bind_inversion EQfn) * #f2 * #fn2 whd in match fetch_function; 2277 normalize nodelta #H lapply(opt_eq_from_res ???? H) H 2278 #H @('bind_inversion H) H #f3 #EQf3 #H @('bind_inversion H) H 2279 #fn4 #_ whd in ⊢ (??%%→ ??%% → ?); #EQ1 #EQ2 destruct(EQ1 EQ2) 2280 >(find_symbol_transf … 2281 (λvars.transf_fundef … (λfn.(b_graph_translate … fn))) prog f) 2282 >(symbol_of_block_rev … EQf3) >m_return_bind >code_block_of_block_eq 2283 normalize nodelta >(pc_of_label_eq … EQcalling') normalize nodelta 2284 whd in match ps_reg_store_status; normalize nodelta >m_return_bind [%] 2285 whd in match eval_statement_advance; normalize nodelta whd in match set_no_pc; 2286 normalize nodelta whd in match next; whd in match set_pc; normalize nodelta 2287 @eq_f @eq_f3 [2,3: %] whd in match set_regs; normalize nodelta 2288 cut(istack … st2 = empty_is) 2289 [ @('bind_inversion EQst1'') #new_st whd in match push_ra; normalize nodelta 2290 #H @('bind_inversion H) H #new_st' whd in match push; normalize nodelta 2291 #H @('bind_inversion H) H #new_is whd in match sigma_state; normalize nodelta 2292 cases(istack ? st2) [ #_ #_ #_ #_ % 3: #bv1 #bv2 whd in ⊢ (??%% → ?); #EQ destruct] 2293 #bv1 whd in ⊢ (??%% → ?); #EQ destruct(EQ) whd in match set_istack; normalize nodelta 2294 whd in ⊢ (??%% → ?); #EQ destruct #H @('bind_inversion H) H #new_is2 whd in ⊢ (??%% → ?); 2295 #EQ destruct(EQ) ] #EQ >EQ % 2296 ] 2297 ] 2298 ] 2299 cases(b_graph_transform_program_fetch_internal_function … good c_bl' f1 fn1 ?) 2300 [2,4: whd in match fetch_internal_function; normalize nodelta lapply(err_eq_from_io ????? EQfn1) 2301 EQfn1 #EQfn1 >EQfn1 %] 2302 #init * #t_fn1 ** #EQt_fn1 #_ * #_ #_ #_ #EQentry #_ #_ #_ #_ #_ #_ #_ 2303 [2: %{(mk_state_pc ? (set_frms ERTL_state (〈\fst (regs … st2_pre),pc_block(pc … st2)〉 :: (st_frms … st2)) 2304 (set_regs ERTL_state (〈empty_map …,\snd (regs … st2)〉) st2_pre)) 2305 (pc_of_point (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2306 c_bl' (joint_if_entry … t_fn1)) 2307 (last_pop … st2))} 2308  @('bind_inversion EQst1'') #new_st 2309 cut(pc … st2 = sigma_stored_pc prog f_lbls (pc … st2)) 2310 [ whd in match sigma_stored_pc; whd in match sigma_pc_opt; normalize nodelta 2311 @if_elim [ @eqZb_elim [2: #_ *] #EQbl >fetch_internal_function_no_minus_one in EQfn; [2: //] #EQ destruct] 2312 #_ >(get_sigma_idempotent … good … EQfn EQstmt EQlabels) >m_return_bind >pc_of_point_of_pc %] 2313 #EQ >EQ #EQnew_st cases(push_ra_ok … EQnew_st) 2314 [2: lapply EQ whd in match sigma_stored_pc; normalize nodelta cases(sigma_pc_opt ???) [2: #x #_ % #EQ destruct] 2315 normalize nodelta #ABS >fetch_internal_function_no_zero in EQfn; [2: >ABS %] #EQ destruct] 2316 #t_new_st * #EQt_new_st #new_st_t_new_st whd in ⊢ (???% → ?); #EQ destruct(EQ) 2317 %{(mk_state_pc ? (set_frms ERTL_state (〈(\fst (regs … t_new_st)), pc_block (pc … st2)〉 :: (st_frms … st2)) 2318 (set_regs ERTL_state (〈empty_map …,\snd(regs … st2)〉) t_new_st)) 2319 (pc_of_point (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2320 c_bl' (joint_if_entry … t_fn1)) 2321 (last_pop … st2))} 2322 ] % 2323 [1,3: whd in match sigma_state_pc; normalize nodelta whd in match fetch_internal_function; 2324 normalize nodelta lapply(err_eq_from_io ????? EQfn1) EQfn1 #EQfn1 >EQfn1 >m_return_bind 2325 normalize nodelta @eq_f3 try % [2,4: >EQentry %] whd in match sigma_state; normalize nodelta 2326 whd in match set_frms; whd in match set_regs; normalize nodelta 2327 [ @('bind_inversion EQst1'') #new_st #H @('bind_inversion H) H #new_st1 2328 #H @('bind_inversion H) H #new_is whd in match is_push; normalize nodelta 2329 whd in match sigma_state; normalize nodelta cases (istack … st2) normalize nodelta 2330 [3: #bv1 #bv2 whd in ⊢ (???% → ?); #EQ destruct(EQ) 2: #bv] whd in ⊢ (??%% → ?); 2331 #EQ destruct(EQ) whd in ⊢ (??%% → ?); #EQ destruct(EQ) whd in ⊢ (??%% → ?); #EQ destruct 2332 whd in ⊢ (???% → ?); #EQ destruct(EQ) 2333 ] 2334 cut(∀ a1,a2,b1,b2,c1,c2,d1,d2,e1,e2.a1=a2 → b1 = b2 → c1 = c2 → d1 = d2 → e1 = e2 → 2335 mk_state ERTL_semantics a1 b1 c1 d1 e1 = 2336 mk_state ERTL_semantics a2 b2 c2 d2 e2) 2337 [1,3: #H1 #H2 #H3 #H4 #H5 #H6 #H7 #H8 #H9 #H10 #H11 #H12 #H13 #H14 #H15 //] 2338 #APP @APP 2339 [ whd in match sigma_frames in ⊢ (???%); normalize nodelta whd in match sigma_frames_opt; 2340 whd in match m_list_map; normalize nodelta whd in match (foldr ?????); 2341 normalize nodelta >EQfn >m_return_bind normalize nodelta 2342 check coerced_step_list_in_code 2343 whd in match sigma_frames; whd in match sigma_frames_opt; whd in match m_list_map; 2344 normalize nodelta cases(foldr ? (Option ?) ???) [% 2345 // 2346 whd in ⊢ 2347 xxxxxxxxxxxxxxxxxxxxxxxx 2348 2349 change with c_bl' in match (pc_block ?) in ⊢ (???%); >EQfn1 2350 change with (ge … (ev_genv (mk_prog_params ERTL_semantics prog stack_size))) 2351 in match (globalenv_noinit ? prog); >EQfn1 2352 change with 2353 2354 #EQnew_st whd in ⊢ (???% → ?); #EQ destruct(EQ) cases(push_ra_ok ???????? EQnew_st) 2355 2356 xxxxxxxxxxx 2357 lapply EQfn whd in match fetch_internal_function; whd in match fetch_function; 2358 normalize nodelta 2359 check find_symbol 2360 letin (*〈addrl,addrh〉*) x ≝ beval_pair_of_pc ? % 2361 2362 2363 2364 %{(mk_state_pc ? 2365 (mk_state ? (st_frms … st2) 2366 (both_is (\snd (beval_pair_of_pc (pc … st2))) 2367 (\fst (beval_pair_of_pc (pc … st2)))) 2368 (carry … st2) (regs … st2) (m … st2)) 2369 (pc … st2) 2370 (last_pop … st2))} 2371 2372 2373 1862 2374 1863 2375 inductive ex_Type1 (A:Type[1]) (P:A → Prop) : Prop ≝ … … 1865 2377 (*interpretation "exists in Type[1]" 'exists x = (ex_Type1 ? x).*) 1866 2378 1867 include "joint/semantics_blocks.ma". 1868 1869 lemma fetch_internal_function_no_zero : 1870 ∀F,V,i,p,bl. 1871 block_id (pi1 … bl) = 0 → 1872 fetch_internal_function ? 1873 1874 (globalenv (λvars.fundef (F vars)) V i p) bl = 1875 Error ? [MSG BadFunction]. 1876 #F #V #i #p #bl #EQbl whd in match fetch_internal_function; 1877 normalize nodelta >fetch_function_no_zero [2: assumption] % 1878 qed. 1879 1880 lemma fetch_internal_function_no_minus_one : 1881 ∀F,V,i,p,bl. 1882 block_id (pi1 … bl) = 1 → 1883 fetch_internal_function ? 1884 1885 (globalenv (λvars.fundef (F vars)) V i p) bl = 1886 Error ? [MSG BadFunction]. 1887 #F #V #i #p #bl #EQbl whd in match fetch_internal_function; 1888 normalize nodelta >fetch_function_no_minus_one [2: assumption] % 1889 qed. 1890 1891 lemma fetch_statement_no_zero : 1892 ∀pars,prog,stack_size,pc. 1893 block_id(pi1 … (pc_block pc)) = 0 → 1894 fetch_statement pars (prog_var_names … prog) 1895 (ev_genv (mk_prog_params pars prog stack_size)) pc = 1896 Error ? [MSG BadFunction]. 1897 #pars #vars #ge #pc #EQpc whd in match fetch_statement; normalize nodelta 1898 >fetch_internal_function_no_zero [2: assumption] % 1899 qed. 1900 1901 lemma fetch_statement_no_minus_one : 1902 ∀pars,prog,stack_size,pc. 1903 block_id(pi1 … (pc_block pc)) = 1 → 1904 fetch_statement pars (prog_var_names … prog) 1905 (ev_genv (mk_prog_params pars prog stack_size)) pc = 1906 Error ? [MSG BadFunction]. 1907 #pars #vars #ge #pc #EQpc whd in match fetch_statement; normalize nodelta 1908 >fetch_internal_function_no_minus_one [2: assumption] % 1909 qed. 1910 1911 1912 2379 lemma ertl_to_ertlptr_ok: 2380 ∀prog. 2381 let trans_prog ≝ ertl_to_ertlptr prog in 2382 ∀ f_lbls,f_regs,stack_sizes. 2383 ∀f_bl_r. 2384 b_graph_transform_program_props ERTL_semantics ERTLptr_semantics 2385 translate_data prog f_bl_r f_lbls f_regs → 2386 ex_Type1 … (λR. 2387 status_simulation 2388 (ERTL_status prog stack_sizes) (ERTLptr_status trans_prog stack_sizes) R). 2389 #prog #f_lbls #f_regs #stack_size #f_bl_r #good % 2390 [@ERTLptrStatusSimulation assumption] 2391 whd in match status_simulation; normalize nodelta 2392 whd in match ERTL_status; whd in match ERTLptr_status; normalize nodelta 2393 whd in ⊢ (% → % → % → % → ?); #st1 #st1' #st2 2394 change with 2395 (eval_state ERTL_semantics (prog_var_names ???) ?? = ? → ?) 2396 #EQeval @('bind_inversion EQeval) 2397 ** #id #fn #stmt #H lapply (err_eq_from_io ????? H) H #EQfetch 2398 #_ whd in match ERTLptrStatusSimulation; normalize nodelta #EQst2 destruct 2399 cases stmt in EQfetch; stmt 2400 [ * [ #cost  #called_id #args #dest #reg #lbl  #seq] #nxt  #fin_step  *] 2401 #EQfetch 2402 change with (joint_classify ??) in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); 2403 [ (*COST*) whd in match joint_classify; normalize nodelta >EQfetch >m_return_bind 2404 normalize nodelta 2405 cases(eval_cost_ok … good … EQfetch EQeval) #st2' * #EQst2' * #taf #tafne 2406 %{st2'} %{taf} >tafne normalize nodelta % [ % [@I  assumption]] 2407 whd >EQst2' >(as_label_ok … good … st2') [%] cases daemon (* needs lemma see below!! *) 2408  (*CALL*) whd in match joint_classify; normalize nodelta >EQfetch >m_return_bind 2409 normalize nodelta #is_call_st1 2410 cases(eval_call_ok … good … EQfetch EQeval) #is_call_st1' 2411 * #st2_pre_call * #is_call_st2_pre_call * * #Hcall 2412 #call_rel * #taa * #st2' * #sem_rel #eval_rel 2413 %{(«st2_pre_call,is_call_st2_pre_call»)} % [ % assumption] 2414 %{st2'} %{st2'} %{taa} %{(taa_base …)} % [ % assumption] 2415 whd >sem_rel >(as_label_ok … good … st2') [%] cases daemon (*TODO*) 2416  (*COND*) whd in match joint_classify; normalize nodelta >EQfetch >m_return_bind 2417 normalize nodelta #n_costed 2418 cases(eval_cond_ok … good … EQfetch EQeval) [2: @n_costed] 2419 #st2' * #EQst2' * #taf #tafne %{st2'} %{taf} >tafne % [% [@Iassumption]] 2420 whd >EQst2' >(as_label_ok … good … st2') [%] cases daemon (*TODO*) 2421  (*seq*) whd in match joint_classify; normalize nodelta >EQfetch >m_return_bind 2422 normalize nodelta 2423 cases (eval_seq_no_call_ok … good … EQfetch EQeval) 2424 #st3 * #EQ destruct * #taf #taf_spec %{st3} %{taf} 2425 % [% //] whd >(as_label_ok … good … st3) [%] 2426 cases daemon (*needs lemma about preservation of fetch_statement *) 2427  cases fin_step in EQfetch; 2428 [ (*GOTO*) #lbl #EQfetch whd in match joint_classify; normalize nodelta 2429 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); normalize nodelta 2430 cases (eval_goto_ok … good … EQfetch EQeval) 2431 #st3 * #EQ destruct * #taf #tarne %{st3} %{taf} >tarne normalize nodelta 2432 % [% //] whd >(as_label_ok … good … st3) [%] 2433 cases daemon (*needs lemma about preservation of fetch_statement *) 2434  (*RETURN*) #EQfetch 2435 whd in match joint_classify; normalize nodelta 2436 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); normalize nodelta 2437 cases (eval_return_ok … good … EQfetch EQeval) #is_ret 2438 * #st3 * #EQ destruct * #after_ret * #taf ** #taf_prf #EQeval' #ret_prf 2439 % [2: % [2: % [2: %{(taa_base …)} %{taf}] *: ] *:] 2440 % [2: whd >(as_label_ok … good … st3) [%] cases daemon (*needs lemma *)] 2441 % [2: assumption] % [2: %] % [2: assumption] % assumption 2442  (*TAILCALL*) * 2443 ] 2444 ] 2445 qed. 2446 2447 (* 1913 2448 lemma foo : 1914 2449 ∀P1_unser,P2_unser: unserialized_params. … … 2062 2597 #taaf #Htaaf %{st''} 2063 2598 % [%] cases daemon 2064 qed. 2065 2066 lemma lookup_opt_none_transf : 2067 ∀prog : ertl_program. 2068 let trans_prog ≝ ertl_to_ertlptr prog in 2069 ∀x.lookup_opt 2070 (fundef 2071 (joint_closed_internal_function ERTL 2072 (prog_var_names (joint_function ERTL) ℕ prog))) x 2073 (functions 2074 (fundef 2075 (joint_closed_internal_function ERTL 2076 (prog_var_names (joint_function ERTL) ℕ prog))) 2077 (globalenv_noinit (joint_function ERTL) prog)) =None ? → 2078 lookup_opt 2079 (fundef 2080 (joint_closed_internal_function ERTLptr 2081 (prog_var_names (joint_function ERTLptr) ℕ trans_prog))) x 2082 (functions 2083 (fundef 2084 (joint_closed_internal_function ERTLptr 2085 (prog_var_names (joint_function ERTLptr) ℕ trans_prog))) 2086 (globalenv_noinit (joint_function ERTLptr) trans_prog)) =None ?. 2087 #prog #x #EQlookup 2088 whd in match ertl_to_ertlptr in ⊢ (??(???(??%))?); whd in match transform_program; 2089 whd in match transf_program; normalize nodelta whd in match globalenv_noinit; 2090 whd in match globalenv; whd in match globalenv_allocmem; 2091 whd in match add_globals; normalize nodelta 2092 cases daemon 2093 qed. 2094 2095 2096 2097 lemma fetch_function_none : 2098 ∀prog : ertl_program. 2099 let trans_prog ≝ ertl_to_ertlptr prog in 2100 ∀bl. 2101 fetch_function 2102 (fundef 2103 (joint_closed_internal_function ERTL 2104 (prog_var_names (joint_function ERTL) ℕ prog))) 2105 (globalenv_noinit (joint_function ERTL) prog) bl = Error ? [MSG BadFunction] → 2106 fetch_function 2107 (fundef 2108 (joint_closed_internal_function ERTLptr 2109 (prog_var_names (joint_function ERTLptr) ℕ trans_prog))) 2110 (globalenv_noinit (joint_function ERTLptr) trans_prog) bl = Error ? [MSG BadFunction]. 2111 #prog #bl whd in match fetch_function in ⊢ (% → ?); normalize nodelta 2112 <(symbol_for_block_transf … (λn:ℕ.[Init_space n]) prog … 2113 (λvars.transf_fundef … (translate_internal …)) bl) 2114 change with (symbol_for_block 2115 (fundef 2116 (joint_closed_internal_function ERTLptr 2117 (prog_var_names (joint_function ERTLptr) ℕ (ertl_to_ertlptr prog)))) 2118 (globalenv_noinit (joint_function ERTLptr) (ertl_to_ertlptr prog)) bl) 2119 in match (symbol_for_block ???); 2120 whd in match fetch_function; normalize nodelta cases(symbol_for_block ???) [#_ %] 2121 #id >m_return_bind inversion(find_funct_ptr ???) 2122 [2: #x #_ whd in ⊢ (??%% → ?); #EQ destruct] whd in match find_funct_ptr; 2123 normalize nodelta cases(block_region bl) normalize nodelta [ #_ #_ >m_return_bind %] 2124 cases(block_id bl) normalize nodelta [1,2: [2: #x] #_ #_ >m_return_bind %] 2125 #x whd in match globalenv_noinit; whd in match globalenv; normalize nodelta 2126 whd in match globalenv_allocmem; normalize nodelta #EQlookup 2127 >(lookup_opt_none_transf … EQlookup) #_ % 2128 qed. 2129 2130 lemma fetch_function_err : 2131 ∀F,ge,bl,e. fetch_function F ge bl = Error ? e → e = [MSG BadFunction]. 2132 #F #ge #bl #e whd in match fetch_function; normalize nodelta 2133 cases(symbol_for_block ???) [ normalize #EQ destruct %] 2134 #id >m_return_bind cases(find_funct_ptr ???) normalize [2: #x] 2135 #EQ destruct % 2136 qed. 2137 2138 2139 lemma fetch_internal_function_none : 2140 ∀ prog : ertl_program. 2141 let trans_prog ≝ ertl_to_ertlptr prog in 2142 ∀bl. 2143 fetch_internal_function 2144 (joint_closed_internal_function ERTL 2145 (prog_var_names (joint_function ERTL) ℕ prog)) 2146 (globalenv_noinit (joint_function ERTL) prog) bl = Error ? [MSG BadFunction] → 2147 fetch_internal_function 2148 (joint_closed_internal_function ERTLptr 2149 (prog_var_names (joint_function ERTLptr) ℕ trans_prog)) 2150 (globalenv_noinit (joint_function ERTLptr) trans_prog) bl = Error ? [MSG BadFunction]. 2151 #prog #bl whd in match fetch_internal_function; normalize nodelta 2152 inversion(fetch_function ???) 2153 [2: #err_msg #EQfetch lapply(fetch_function_err … EQfetch) #EQ destruct #_ 2154 >(fetch_function_none … EQfetch) %] * #f * #fn #EQfetch >m_return_bind 2155 normalize nodelta whd in ⊢ (??%? → ?); #EQ destruct 2156 >(fetch_function_transf … (λvars.transf_fundef … (translate_internal …)) … EQfetch) 2157 >m_return_bind % 2158 qed. 2159 2160 lemma fetch_internal_function_err : 2161 ∀F,ge,bl,e. fetch_internal_function F ge bl = Error ? e → e = [MSG BadFunction]. 2162 #F #ge #bl #e whd in match fetch_internal_function; normalize nodelta 2163 inversion(fetch_function ???) 2164 [2: #e #EQf lapply(fetch_function_err … EQf) #EQ destruct whd in ⊢ (??%? → ?); 2165 #EQ destruct %] * #id * #fn #EQf >m_return_bind normalize nodelta 2166 whd in ⊢ (??%? → ?); #EQ destruct % 2167 qed. 2168 2169 2170 2171 2172 lemma as_label_ok : ∀ prog : ertl_program. 2173 let trans_prog ≝ ertl_to_ertlptr prog in 2174 ∀ good,stack_sizes,st. 2175 as_label (ERTLptr_status trans_prog stack_sizes) st = as_label 2176 (ERTL_status prog stack_sizes) (sigma_state_pc prog good st). 2177 #prog #good #stack_size #st whd in match as_label; normalize nodelta 2178 whd in match (as_pc_of ? ?); whd in match (as_pc_of ? ?); 2179 whd in match sigma_state_pc; normalize nodelta @if_elim 2180 [ @eqZb_elim [2: #_ *] #EQbl * whd in match (as_label_of_pc ??); 2181 >fetch_statement_no_minus_one [2: assumption] normalize nodelta 2182 whd in match (as_label_of_pc ??); >fetch_statement_no_zero [2: %] %] 2183 #_ inversion(fetch_internal_function ???) 2184 [2: #e #EQf lapply(fetch_internal_function_err … EQf) #EQ destruct normalize nodelta 2185 whd in match (as_label_of_pc ??); whd in match fetch_statement; normalize nodelta 2186 >(fetch_internal_function_none … EQf) whd in ⊢ (??%%); 2187 >fetch_statement_no_zero [2: %] % ] * #f #fn #EQf normalize nodelta 2188 whd in match (as_label_of_pc ??) in ⊢ (???%); whd in match fetch_statement; 2189 normalize nodelta >EQf >m_return_bind inversion(stmt_at ????) [cases daemon (*to discuss with Paolo*)] 2190 * [ * [ * [ #id  #addr ] #args #dst  #acc_r #lbl  #seq ] #nxt  #fin  *] 2191 #EQstmt_at >m_return_bind normalize nodelta 2192 cases(multi_fetch_ok … (good fn) … EQstmt_at) 2193 #labs * #regs ** #EQlabs #EQregs normalize nodelta whd in match translate_step; 2194 normalize nodelta 2195 [1,3,4: * #step_block * whd in match (bind_new_instantiates ?????); 2196 cases regs in EQregs; [2,4,6: #r #tl #EQ normalize nodelta *] 2197 #EQregs normalize nodelta #EQ destruct * #dst * 2198 whd in match (step_list_in_code ???????); cases labs in EQlabs; 2199 [2,4,6: #lb #tl #EQ normalize nodelta *] #EQlabs normalize nodelta 2200 #EQ destruct * #nxt1 * #EQ_s_stmt #EQ destruct 2201 whd in match (as_label_of_pc ??); whd in match fetch_statement; 2202 normalize nodelta 2203 >(fetch_internal_function_transf … (λvars.translate_internal …) … EQf) 2204 >m_return_bind >EQ_s_stmt >m_return_bind normalize nodelta [1,2: %] 2205 cases seq 2206 [#str %  #c %  #H1 %  #H3 %  #x %  #H5 #H6 #H7 #H8 % 2207  #H10 #H11 #H12 #H13 #H14 %  #H16 #H17 #H18 %  #H20 #H21 #H22 #H23 % 2208  %  %  #H25 #H26 #H27 %  #H29 #H30 #H31 %  #H33 %] 2209  * #step_block whd in match (bind_new_instantiates ?????); 2210 cases regs in EQregs; [ #EQ normalize nodelta **] #reg #tl #EQregs 2211 normalize nodelta whd in match (bind_new_instantiates ?????); 2212 cases tl in EQregs; [2: #reg1 #tl1 #EQ normalize nodelta **] 2213 #EQreg normalize nodelta * #EQ destruct * #dst * 2214 whd in match (step_list_in_code ???????); cases labs in EQlabs; 2215 [ #_ normalize nodelta *] #lbl #tl #EQlabs normalize nodelta * 2216 * #nxt1 * #EQ_s_stmt #_ #_ #_ whd in match (as_label_of_pc ??); 2217 whd in match fetch_statement; normalize nodelta 2218 >(fetch_internal_function_transf … (λvars.translate_internal …) … EQf) 2219 >m_return_bind >EQ_s_stmt >m_return_bind normalize nodelta % 2220  (whd in match translate_fin_step; normalize nodelta) * 2221 #fin_block * whd in match (bind_new_instantiates ?????); cases regs in EQregs; 2222 [2: #r #tl #_ normalize nodelta *] #EQregs normalize nodelta #EQ destruct 2223 * #list_l * #lbl ** #EQ destruct whd in match (step_list_in_code ???????); 2224 normalize nodelta cases list_l in EQlabs; [2: #lbl1 #tl #_ normalize nodelta *] 2225 #EQlabs normalize nodelta #EQ destruct whd in match fin_step_in_code; 2226 normalize nodelta #EQ_s_stmt whd in match (as_label_of_pc ??); 2227 whd in match fetch_statement; normalize nodelta 2228 >(fetch_internal_function_transf … (λvars.translate_internal …) … EQf) 2229 >m_return_bind >EQ_s_stmt >m_return_bind normalize nodelta % 2230 ] 2231 qed. 2232 2233 (* 2234 #H1 #H2 #H3 * 2235 2236 ∀P1_unser,P2_unser: unserialized_params. 2237 ∀P1_sem_unser,P2_sem_unser. 2238 ∀init,translate_step. 2239 ∀translate_fin_step. 2240 ∀closed_graph_translate. 2241 ∀prog. 2242 ∀stack_size. 2243 ∀sigma_state_pc. 2244 (∀s. pc_block (pc … (sigma_state_pc s)) = pc_block … (pc … s)) → 2245 ∀st : state_pc P2_sem. 2246 ∀st' : state_pc P1_sem. 2247 ∀f. 2248 ∀fn: joint_closed_internal_function P1_sem (globals (mk_prog_params P1_sem prog stack_size)). 2249 luniverse_ok … fn → 2250 ∀stmt,nxt. 2251 (∀pre_Instrs',last_Instrs',dst. 2252 ∃st''.∃st'''.∃st''''. 2253 repeat_eval_seq_no_pc (mk_prog_params P2_sem trans_prog stack_size) 2254 f (translate_internal ? fn) (map_eval ?? pre_Instrs' dst) st = return st''' ∧ 2255 eval_seq_no_pc ? (prog_var_names … trans_prog) (ev_genv … (mk_prog_params P2_sem trans_prog stack_size)) 2256 f (translate_internal … fn) (last_Instrs' dst) st''' = return st'''' ∧ 2257 st'' = (mk_state_pc (mk_prog_params P2_sem trans_prog stack_size) 2258 st'''' (pc_of_point P2_sem (pc_block (pc … (sigma_state_pc st))) dst) (last_pop … st)) ∧ 2259 st' = sigma_state_pc st'' ∧ 2260 let P2_prog_params ≝ mk_prog_params P2_sem trans_prog stack_size in 2261 let P2_globals ≝ globals P2_prog_params in 2262 All 2263 (joint_seq … P2_globals) 2264 (no_cost_label … P2_globals) 2265 (map_eval (code_point P2_sem) (joint_seq … P2_globals) pre_Instrs' dst)) → 2266 2267 2268 2269 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta @if_elim 2270 [ #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2271 #EQbl inversion(fetch_internal_function ?? (pc_block (pc ? st))) normalize nodelta 2272 [2: #err #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2273 * #id1 #fn1 #EQfn normalize nodelta #EQfetch lapply(fetch_statement_inv … EQfetch) 2274 * >EQfn #EQ destruct normalize nodelta #EQstmt 2275 cases(multi_fetch_ok … (good fn) ?? EQstmt) 2276 #list_b_last * #fresh_registers ** #EQlist_b_last #EQfresh_registers 2277 normalize nodelta * #Instrs * #fresh_registers_spec whd in ⊢ (% → ?); 2278 @pair_elim #pre_Instrs #last_Instrs #EQInstrs * #dst * #Multi_fetch #STEP_in_code 2279 #EQeval 2280 cut((list 2281 (code_point ERTLptr 2282 →joint_seq ERTLptr (prog_var_names (joint_function ERTL) ℕ prog)))) [ cases daemon (*Paolo should fix the lemma*)] 2283 #pre_Instrs' 2284 cut((code_point ERTLptr 2285 →joint_seq ERTLptr (prog_var_names (joint_function ERTL) ℕ prog))) [ cases daemon (*Paolo should fix the lemma*)] 2286 #last_Instrs' 2287 letin list_map ≝ cic:/matita/basics/lists/list/map.fix(0,3,1) 2288 cut(∃st''.∃st'''.∃st''''. 2289 repeat_eval_seq_no_pc (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2290 f (translate_internal ? fn) (map_eval ?? pre_Instrs' dst) st = return st''' ∧ 2291 eval_seq_no_pc ? (prog_var_names … (ertl_to_ertlptr prog)) (ev_genv … (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size)) 2292 f (translate_internal … fn) (last_Instrs' dst) st''' = return st'''' ∧ 2293 st'' = (mk_state_pc (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2294 st'''' (pc_of_point ERTLptr_semantics (pc_block (pc … st)) dst) 2295 (last_pop … st)) ∧ 2296 st' = sigma_state_pc ? good st'') 2297 [ cases daemon (*to be generalized and TO be moved into an other lemma *)] 2298 * #st'' * #st''' * #st'''' *** #REPEAT #EVAL_NO_PC_Last #EQst'' #EQst' %{st''} % [assumption] 2299 lapply(produce_trace_any_any_free … REPEAT) 2300 [ cases daemon (* Pass dependent *) 2301  cases daemon (* should be @Multi_fetch *) 2302  @(fetch_internal_function_transf … (λvars. translate_internal …) … EQfn) 2303  @dst 2304  @list_b_last (*wrong, should dst be destination or the last of list_b_last *) 2305 ] #TAAF 2306 lapply(produce_step_trace (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2307 (mk_state_pc (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2308 st''' (pc_of_point ERTLptr_semantics (pc_block (pc … st)) dst) 2309 (last_pop … st)) f (translate_internal ? fn) (last_Instrs' dst) nxt st'''' (fetch_internal_function_transf … (λvars. translate_internal …) … EQfn) 2310 ? EVAL_NO_PC_Last) [cases daemon (* should be @STEP_in_code *)] 2311 #LAST_STEP 2312 letin taaf_last ≝ (taaf_step ???? TAAF LAST_STEP) 2313 2314 cut(dst = (point_of_pc 2315 (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2316 (pc … st))) [cases daemon (*TODO it is true since pre_Instr is empty *)] 2317 #EQ <EQ whd in match step_in_code; normalize nodelta 2318 cases STEP_in_code #x * #x_spec #x_spec' %{x} % 2319 [ >x_spec in ⊢ (??%?); @eq_f @eq_f2 [2: %] cases daemon (*should be % *)  2320 [<EVAL_NO_PC_Last in ⊢ (???%); @eq_f % 2321 2322 2323 2324 whd in match eval_state; normalize nodelta >EQfetch >m_return_bind 2325 lapply EQfetch EQfetch whd in match sigma_state_pc in ⊢ (% → ?); 2326 normalize nodelta @if_elim 2327 [ #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2328 #EQbl inversion(fetch_internal_function ?? (pc_block (pc ? st))) normalize nodelta 2329 [2: #err #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2330 * #id1 #fn1 #EQfn normalize nodelta #EQfetch lapply(fetch_statement_inv … EQfetch) 2331 * >EQfn #EQ destruct normalize nodelta #EQstmt 2332 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta @if_elim 2333 [#H >H in EQbl; *] #_ >EQfn normalize nodelta whd in match eval_statement_no_pc; 2334 normalize nodelta #H @('bind_inversion H) H #ex_st_nopc 2335 #H lapply (err_eq_from_io ????? H) H #EQnopc whd in match eval_statement_advance; 2336 normalize nodelta whd in match set_no_pc; normalize nodelta 2337 whd in ⊢ (??%% → ?); #EQ destruct cases(eval_seq_no_pc_no_call_ok … EQnopc) 2338 #sigma_st_nopc * #EQsigma_st_nopc #sem_rel % 2339 [ % [@sigma_st_nopc 2340  @(succ_pc ERTL_semantics (pc ERTLptr_semantics st) nxt) 2341  @(last_pop … st) 2342 ] 2343 ] % whd in match sigma_state_pc; 2344 2345 2346 2347 qed.*) 2348 2349 lemma ertl_to_ertlptr_ok: 2350 ∀prog. 2351 let trans_prog ≝ ertl_to_ertlptr prog in 2352 ∀good : (∀fn.good_state_transformation prog fn). 2353 ∀stack_sizes. 2354 ex_Type1 … (λR. 2355 status_simulation 2356 (ERTL_status prog stack_sizes) (ERTLptr_status trans_prog stack_sizes) R). 2357 #prog #good #stack_size % [@ERTLptrStatusSimulation assumption] 2358 whd in match status_simulation; normalize nodelta 2359 whd in match ERTL_status; whd in match ERTLptr_status; normalize nodelta 2360 whd in ⊢ (% → % → % → % → ?); #st1 #st1' #st2 2361 change with 2362 (eval_state ERTL_semantics (prog_var_names ???) ?? = ? → ?) 2363 #EQeval @('bind_inversion EQeval) 2364 ** #id #fn #stmt #H lapply (err_eq_from_io ????? H) H #EQfetch 2365 #_ whd in match ERTLptrStatusSimulation; normalize nodelta #EQst2 destruct 2366 cases stmt in EQfetch; stmt 2367 [ * [ #called_id #args #dest #reg #lbl  #seq] #nxt  #fin_step  *] #EQfetch 2368 change with (joint_classify ??) in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); 2369 [ (*CALL*) cases daemon 2370  (*COND*) cases daemon 2371  (*seq*) whd in match joint_classify; normalize nodelta >EQfetch >m_return_bind 2372 normalize nodelta cases (eval_seq_no_call_ok ????????? EQfetch EQeval) 2373 #st3 * #EQ destruct * #taf #tafne %{st3} %{taf} >tafne normalize nodelta 2374 % [% //] whd >as_label_ok [2:assumption] % 2375 2376 2377 lapply(produce_trace_any_any_free 2378 (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2379 st2 id (translate_internal ? fn)) #PRODUCE_TAAF 2380 cases stmt in EQfetch; stmt 2381 [ * [ #called_id #args #dest #reg #lbl  #seq] #nxt  #fin_step  *] #EQfetch 2382 normalize nodelta 2383 2384 2385 lapply EQfetch EQfetch whd in match sigma_state_pc in ⊢ (% → ?); 2386 normalize nodelta @if_elim 2387 [ #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2388 #EQbl inversion(fetch_internal_function ?? (pc_block (pc ? st2))) normalize nodelta 2389 [2: #err #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2390 * #id1 #fn1 #EQfn normalize nodelta #EQfetch lapply(fetch_statement_inv … EQfetch) 2391 * >EQfn #EQ destruct normalize nodelta #EQstmt 2392 2393 ? ? ?? ? ???) 2394 2395 2396 2397 cases stmt in EQfetch; stmt 2398 [ * [ #called_id #args #dest #reg #lbl  #seq] #nxt  #fin_step  *] #EQstmt 2399 change with (joint_classify ??) in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); 2400 whd in match joint_classify; normalize nodelta >EQstmt >m_return_bind 2401 normalize nodelta lapply(fetch_statement_inv … EQstmt) * #fn_spec 2402 #stmt_spec 2403 cases(multi_fetch_ok … (good fn) ?? stmt_spec) #f_labs * #f_regs ** #f_labs_spec 2404 #f_regs_spec normalize nodelta * #list_instr * #b_new_f_regs 2405 whd in ⊢ (% → ?); normalize nodelta 2406 [1,2,3: @pair_elim #list_instr1 #rgt #last_ne_spec * #last_lab * 2407 #list_instr1_spec #last_step 2408 lapply(fetch_internal_function_transf … 2409 (λvars. translate_internal …) … fn_spec) 2410 change with ((fetch_internal_function 2411 (joint_closed_internal_function ? (prog_var_names … (ertl_to_ertlptr prog))) 2412 (globalenv_noinit … (ertl_to_ertlptr prog)) ?) = ? → ?) 2413 #EQtrans_fn 2414 check prog_params 2415 lapply(produce_trace_any_any_free 2416 (mk_prog_params ERTLptr_semantics (ertl_to_ertlptr prog) stack_size) 2417 ? id (translate_internal ? fn) ? ? ?? EQtrans_fn ???) [2: @EQtrans_fn 2418 2419 2420 2421 2422 2423 lapply EQstmt whd in match sigma_state_pc in ⊢ (% → ?); 2424 normalize nodelta @if_elim 2425 [1,3: #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2426 #EQbl inversion(fetch_internal_function ?? (pc_block (pc ? st2))) normalize nodelta 2427 [2,4: #err #_ >fetch_statement_no_zero [2,4: %] whd in ⊢ (???% → ?); #ABS destruct] 2428 * #id1 #fn1 #EQfn1 normalize nodelta #EQstmt1 lapply(fetch_statement_inv … EQstmt1) 2429 * >EQfn1 #EQ destruct normalize nodelta #EQstmtat 2430 2431 2432 2433 2434 [ (*CALL*) 2435 cases daemon (*TODO*) 2436  whd in match joint_classify; normalize nodelta 2437 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); 2438 normalize nodelta 2439 #n_cost 2440 cases (eval_cond_ok … EQfetch EQeval n_cost) 2441 #st3 * #EQ destruct * #taf #tafne %{st3} %{taf} 2442 % [ % [2: %] >tafne normalize nodelta @I] whd >as_label_ok % 2443  whd in match joint_classify; normalize nodelta 2444 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); 2445 normalize nodelta 2446 cases (eval_seq_no_call_ok ????????? EQfetch EQeval) 2447 #st3 * #EQ destruct * #taf #tafne %{st3} %{taf} >tafne normalize nodelta 2448 % [% //] whd >as_label_ok [2:assumption] % 2449  (*FIN*) 2450 cases fin_step in EQfetch; 2451 [ (*GOTO*) #lbl #EQfetch whd in match joint_classify; normalize nodelta 2452 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); normalize nodelta 2453 cases (eval_goto_ok … EQfetch EQeval) 2454 #st3 * #EQ destruct * #taf #tarne %{st3} %{taf} >tarne normalize nodelta 2455 % [% //] whd >as_label_ok [2:assumption] % 2456  (*RETURN*) #EQfetch 2457 whd in match joint_classify; normalize nodelta 2458 >EQfetch in ⊢ (match % with [ _ ⇒ ?  _ ⇒ ? ]); normalize nodelta 2459 cases (eval_return_ok … EQfetch EQeval) #is_ret 2460 * #st3 * #EQ destruct * #after_ret * #taf ** #taf_prf #EQeval' #ret_prf 2461 % [2: % [2: % [2: %{(taa_base …)} %{taf}] *: ] *:] 2462 % [2: whd >as_label_ok %] % [2: assumption] % [2: %] % [2: assumption] 2463 % assumption 2464  (*TAILCALL*) #fl #called #args #EQfetch 2465 cases (eval_tailcall_ok … EQfetch EQeval) #st3 * #EQ destruct * #is_tailcall 2466 * #is_tailcall' * #eq_call #EQeval' >is_tailcall normalize nodelta 2467 #prf %{«?, is_tailcall'»} %{eq_call} 2468 % [2: % [2: %{(taa_base …)} %{(taa_base …)} % [ %{EQeval'} % ]  ]  ] 2469 whd >as_label_ok % 2470 ] 2471 ] 2472 qed. 2473 2474 @('bind_inversion EQfetch) * #id1 #fn1 #EQfn #H @('bind_inversion H) H 2475 #stmt1 #H lapply(opt_eq_from_res ???? H) H #EQstmt whd in ⊢ (??%% → ?); 2476 #EQ destruct 2477 2478 (* 2479 lemma push_ra_ok : ∀prog : ertl_program. 2480 ∀good : (∀fn.good_state_transformation prog fn).∀restr. 2481 preserving21 … res_preserve1 … 2482 (sigma_state_pc prog good) 2483 (\l 2484 (λst.sigma_state prog good st restr) 2485 (push_ra ERTL_semantics) 2486 (push_ra ERTLptr_semantics). 2487 #prog #good #restr #st #pc whd in match push_ra; normalize nodelta @mfr_bind1 2488 [2: whd in match sigma_stored_pc; normalize nodelta 2489 2490 [2: #x 2491 2492 2493 lemma ertlptr_save_frame_ok : ∀prog : ertl_program. 2494 ∀good : (∀fn.good_state_transformation prog fn). 2495 ∀id. 2496 preserving1 … res_preserve1 … 2497 (sigma_state_pc prog good) 2498 (λst. match get_internal_function_from_ident 2499 ERTL_semantics (prog_var_names … prog) 2500 (globalenv_noinit … prog) id with 2501 [None ⇒ dummy_state 2502 Some fd ⇒ 2503 sigma_state prog good st (added_registers … fd (f_regs … (good fd))) 2504 ]) 2505 (ertl_save_frame ID it id) 2506 (ertlptr_save_frame ID it id). 2507 #prog #good #id #st whd in match ertl_save_frame; whd in match ertlptr_save_frame; 2508 normalize nodelta @mfr_bind1 2509 [2: whd in match push_ra; normalize nodelta @mfr_bind1 2510 xxxxxxxxxxxx 2511 2512 2513 2514 lemma fetch_statement_commute : 2515 ∀prog : ertl_program. 2516 let trans_prog ≝ (ertl_to_ertlptr prog) in 2517 ∀sigma : sigma_map trans_prog. 2518 ∀stack_sizes,id,fn,stmt,pc. 2519 fetch_statement ERTL_semantics 2520 (globals (mk_prog_params ERTL_semantics prog stack_sizes)) 2521 (ev_genv (mk_prog_params ERTL_semantics prog stack_sizes)) 2522 pc = return 〈id,fn,stmt〉 → 2523 match stmt with 2524 [ sequential seq nxt ⇒ 2525 match seq with 2526 [ CALL ids args dest ⇒ 2527 match ids with 2528 [ inl i ⇒ 2529 fetch_statement ERTLptr_semantics 2530 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2531 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2532 pc = 2533 return 〈id, 2534 translate_internal … fn, 2535 sequential ?? (CALL ERTLptr ? (inl ?? i) args dest) nxt〉 2536  inr p ⇒ ?(* 2537 ∃reg,lbl. 2538 fetch_statement ERTLptr_semantics 2539 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2540 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2541 pc = return 〈id,translate_internal … fn,sequential ?? (extension_seq ERTLptr ? (LOW_ADDRESS reg lbl)) nxt〉 2542 ∧ ∃ nxt'. 2543 ! pc' ← get_pc_from_label ? ? (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2544 id nxt; 2545 fetch_statement ERTLptr_semantics 2546 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2547 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2548 pc' = return 〈id,translate_internal … fn,sequential ?? (step_seq ERTLptr ? (PUSH … (Reg … reg))) nxt'〉 2549 ∧ ∃ nxt''. 2550 ! pc' ← get_pc_from_label ? ? (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2551 id nxt'; 2552 fetch_statement ERTLptr_semantics 2553 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2554 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2555 pc' = return 〈id,translate_internal … fn,sequential ?? (extension_seq ERTLptr ? (HIGH_ADDRESS reg lbl)) nxt''〉 2556 ∧ ∃ nxt'''. 2557 ! pc' ← get_pc_from_label ? ? (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2558 id nxt''; 2559 fetch_statement ERTLptr_semantics 2560 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2561 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2562 pc' = return 〈id,translate_internal … fn,sequential ?? (step_seq ERTLptr ? (PUSH … (Reg … reg))) nxt'''〉 2563 ∧ ∃ nxt''''. 2564 ! pc' ← get_pc_from_label ? ? (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2565 id nxt'''; 2566 fetch_statement ERTLptr_semantics 2567 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2568 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2569 pc' = return 〈id,translate_internal … fn,sequential ?? (CALL ERTLptr ? (inr ?? p) args dest) nxt''''〉 2570 ∧ sigma (translate_internal … fn) nxt''' = return point_of_pc ERTL_semantics pc *) 2571 ] 2572  COND r lbl ⇒ 2573 fetch_statement ERTLptr_semantics 2574 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2575 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2576 pc = 2577 return 〈id, 2578 translate_internal … fn, 2579 sequential ?? (COND ERTLptr ? r lbl) nxt〉 2580  step_seq s ⇒ 2581 fetch_statement ERTLptr_semantics 2582 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2583 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2584 pc = 2585 return 〈id, 2586 translate_internal … fn, 2587 sequential ?? (step_seq ERTLptr … (translate_step_seq ? s)) nxt〉 2588 ] 2589  final fin ⇒ 2590 fetch_statement ERTLptr_semantics 2591 (globals (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2592 (ev_genv (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2593 pc = return 〈id,(translate_internal … fn),final … (joint_fin_step_id fin)〉 2594  FCOND abs _ _ _ ⇒ Ⓧabs 2595 ]. 2596 cases daemon 2597 qed. 2598 2599 lemma eval_seq_no_call_ok : 2600 ∀prog. 2601 let trans_prog ≝ ertl_to_ertlptr prog in 2602 ∀sigma : sigma_map trans_prog.∀stack_sizes. 2603 (*? →*) 2604 ∀st,st',f,fn,stmt,nxt. 2605 fetch_statement ERTL_semantics 2606 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2607 (ev_genv (mk_prog_params ERTL_semantics prog stack_sizes)) 2608 (pc … (sigma_state_pc ? sigma st)) = 2609 return 〈f, fn, sequential … (step_seq ERTL … stmt) nxt〉 → 2610 eval_state ERTL_semantics 2611 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2612 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 2613 (sigma_state_pc ? sigma st) = 2614 return st' → 2615 ∃st''. st' = sigma_state_pc ? sigma st'' ∧ 2616 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 2617 st 2618 st''. 2619 bool_to_Prop (taaf_non_empty … taf). 2620 #prog #sigma #stack_size #st1 #st2 #f #fn #stmt #nxt #EQf whd in match eval_state; 2621 normalize nodelta >EQf >m_return_bind whd in match eval_statement_advance; 2622 whd in match eval_statement_no_pc; normalize nodelta 2623 #H @('bind_inversion H) H #st_no_pc #EQ lapply(err_eq_from_io ????? EQ) EQ 2624 #EQeval whd in ⊢ (??%% → ?); #EQ destruct lapply EQf 2625 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta @if_elim 2626 [ #EQbl 2627  #pc_st1_spec inversion(fetch_internal_function ???) [2: #e #_] 2628 ] 2629 [1,2: whd in match dummy_state_pc; whd in match null_pc; 2630 whd in match fetch_statement; normalize nodelta whd in match fetch_internal_function; 2631 normalize nodelta lapply(fetch_function_no_zero ??????) 2632 [2,9: @( «mk_block Code OZ,refl region Code») 2633 1,8: % 3,10: @prog 7,14: #EQ >EQ *:] whd in ⊢ (??%% → ?); #EQ destruct] 2634 * #f1 #fn1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #fn1_spec normalize nodelta 2635 whd in match fetch_statement; normalize nodelta >fn1_spec 2636 >m_return_bind #H @('bind_inversion H) H #stmt1 #EQ 2637 lapply(opt_eq_from_res ???? EQ) EQ #stmt1_spec whd in ⊢ (??%% → ?); #EQ destruct 2638 lapply EQeval EQeval whd in match sigma_state_pc in ⊢ (% → ?); 2639 normalize nodelta @if_elim [#H >H in pc_st1_spec; *] #_ >fn1_spec 2640 normalize nodelta #EQeval cases(eval_seq_no_pc_no_call_ok ???????? EQeval) 2641 #st_no_pc' * #EQeval' #EQst_no_pc' 2642 whd in match set_no_pc; normalize nodelta 2643 % [ % [@st_no_pc'@(succ_pc ERTL_semantics (pc ERTL_semantics (sigma_state_pc prog sigma st1)) 2644 nxt) @(last_pop ? st1)]] 2645 % [ whd in match sigma_state_pc; normalize nodelta 2646 @if_elim [#H >H in pc_st1_spec; *] #_ >fn1_spec normalize nodelta 2647 @if_elim [#H >H in pc_st1_spec; *] #_ >fn1_spec normalize nodelta 2648 >EQst_no_pc' %] 2649 %{(taaf_step … (taa_base …) …)} 2650 [3: //] lapply(fetch_statement_commute ? sigma ????? EQf) normalize nodelta 2651 whd in match sigma_state_pc; normalize nodelta 2652 @if_elim [1,3:#H >H in pc_st1_spec; *] #_ >fn1_spec normalize nodelta 2653 #EQf1 2654 [ whd in match as_classifier; normalize nodelta whd in match (as_classify ??); 2655 >EQf1 normalize nodelta % 2656  whd in match (as_execute ???); whd in match eval_state; normalize nodelta 2657 >EQf1 >m_return_bind whd in match eval_statement_no_pc; normalize nodelta 2658 >EQeval' >m_return_bind % 2659 ] 2660 qed. 2661 2662 2663 lemma eval_goto_ok : 2664 ∀prog : ertl_program. 2665 let trans_prog ≝ ertl_to_ertlptr prog in 2666 ∀stack_sizes. 2667 ∀sigma : sigma_map trans_prog. 2668 ∀st,st',f,fn,nxt. 2669 fetch_statement ERTL_semantics … 2670 (globalenv_noinit ? prog) (pc … (sigma_state_pc ? sigma st)) = 2671 return 〈f, fn, final … (GOTO ERTL … nxt)〉 → 2672 eval_state ERTL_semantics 2673 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2674 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 2675 (sigma_state_pc ? sigma st) = 2676 return st' → 2677 ∃ st''. st' = sigma_state_pc ? sigma st'' ∧ 2678 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 2679 st 2680 st''. 2681 bool_to_Prop (taaf_non_empty … taf). 2682 #prog #stack_sizes #sigma #st #st' #f #fn #nxt 2683 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2684 @if_elim 2685 [ #EQbl whd in match dummy_state_pc; whd in match null_pc; 2686 whd in match fetch_statement; whd in match fetch_internal_function; 2687 normalize nodelta lapply(fetch_function_no_zero ??????) 2688 [2: @( «mk_block Code OZ,refl region Code») 2689  %  @prog 7: #EQ >EQ *:] whd in ⊢ (??%% → ?); #EQ destruct] 2690 #Hbl inversion(fetch_internal_function ???) 2691 [2: #e #_ normalize nodelta whd in match dummy_state_pc; whd in match null_pc; 2692 whd in match fetch_statement; whd in match fetch_internal_function; 2693 normalize nodelta lapply(fetch_function_no_zero ??????) 2694 [2: @( «mk_block Code OZ,refl region Code») 2695  %  @prog 7: #EQ >EQ *:] whd in ⊢ (??%% → ?); #EQ destruct] 2696 * #f1 #fn1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #fn1_spec normalize nodelta 2697 #EQf lapply EQf whd in match fetch_statement; normalize nodelta >fn1_spec 2698 >m_return_bind #H @('bind_inversion H) H #stmt' #_ whd in ⊢ (??%% → ?); 2699 #EQ destruct whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2700 @if_elim [#H >H in Hbl; *] #_ >fn1_spec normalize nodelta whd in match eval_state; 2701 normalize nodelta >EQf >m_return_bind whd in match eval_statement_advance; 2702 whd in match eval_statement_no_pc; normalize nodelta >m_return_bind 2703 whd in match goto; normalize nodelta #H lapply (err_eq_from_io ????? H) H 2704 #H @('bind_inversion H) H #pc' whd in match set_no_pc; normalize nodelta 2705 >(pc_of_label_eq … fn1_spec) whd in ⊢ (???% → ?); #EQ whd in ⊢ (??%% → ?); #EQ1 2706 destruct lapply (fetch_statement_commute … sigma … stack_sizes … EQf) 2707 normalize nodelta #EQf' % 2708 [ % [ @st 2709  @(mk_program_counter 2710 (pc_block (pc ERTLptr_semantics st)) 2711 (offset_of_point ERTL_semantics nxt)) 2712  @(last_pop … st) 2713 ] 2714 ] % 2715 [ whd in match sigma_state_pc; normalize nodelta @if_elim [#H >H in Hbl; *] 2716 >fn1_spec normalize nodelta #_ % ] 2717 %{(taaf_step … (taa_base …) …)} 2718 [ whd in match as_classifier; normalize nodelta whd in match (as_classify ??); 2719 >EQf' normalize nodelta % 2720  whd in match (as_execute ???); whd in match eval_state; normalize nodelta 2721 >EQf' >m_return_bind whd in match eval_statement_no_pc; 2722 whd in match eval_statement_advance; normalize nodelta >m_return_bind 2723 whd in match goto; normalize nodelta whd in match pc_of_label; normalize nodelta 2724 lapply(fetch_internal_function_transf ??????? fn1_spec) 2725 [ #vars @translate_internal ] #EQ >EQ >m_return_bind % 2726  % 2727 ] 2728 qed. 2729 *) 2730 2731 2732 2733 2734 2735 lemma eval_return_ok : 2736 ∀prog : ertl_program. 2737 let trans_prog ≝ ertl_to_ertlptr prog in 2738 ∀stack_sizes. 2739 ∀sigma : sigma_map trans_prog. 2740 ∀st,st',f,fn. 2741 fetch_statement ERTL_semantics … 2742 (globalenv_noinit ? prog) (pc … (sigma_state_pc ? sigma st)) = 2743 return 〈f, fn, final … (RETURN ERTL … )〉 → 2744 eval_state ERTL_semantics 2745 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2746 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 2747 (sigma_state_pc ? sigma st) = 2748 return st' → 2749 joint_classify (mk_prog_params ERTLptr_semantics trans_prog stack_sizes) 2750 st = Some ? cl_return ∧ 2751 ∃ st''. st' = sigma_state_pc ? sigma st'' ∧ 2752 ∃st2_after_ret. 2753 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 2754 st2_after_ret 2755 st''. 2756 (if taaf_non_empty … taf then 2757 ¬as_costed (ERTLptr_status trans_prog stack_sizes) 2758 st2_after_ret 2759 else True) ∧ 2760 eval_state … (ev_genv … (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) st = 2761 return st2_after_ret ∧ 2762 ret_rel ?? (ERTLptrStatusSimulation prog stack_sizes sigma) st' st2_after_ret. 2763 #prog #stack_size #sigma #st #st' #f #fn 2764 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2765 @if_elim 2766 [ #EQbl whd in match dummy_state_pc; whd in match null_pc; 2767 whd in match fetch_statement; whd in match fetch_internal_function; 2768 normalize nodelta >(fetch_function_no_zero ??????) [2: %] 2769 whd in ⊢ (??%% → ?); #EQ destruct ] 2770 #Hbl inversion(fetch_internal_function ???) 2771 [2: #e #_ normalize nodelta whd in match dummy_state_pc; whd in match null_pc; 2772 whd in match fetch_statement; whd in match fetch_internal_function; 2773 normalize nodelta lapply(fetch_function_no_zero ??????) 2774 [2: @( «mk_block Code OZ,refl region Code») 2775  %  @prog 7: #EQ >EQ *:] whd in ⊢ (??%% → ?); #EQ destruct] 2776 * #f1 #fn1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #fn1_spec normalize nodelta 2777 #EQf lapply EQf whd in match fetch_statement; normalize nodelta >fn1_spec 2778 >m_return_bind #H @('bind_inversion H) H #stmt' #_ whd in ⊢ (??%% → ?); 2779 #EQ destruct whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2780 @if_elim [#H >H in Hbl; *] #_ >fn1_spec normalize nodelta 2781 whd in match eval_state; normalize nodelta >EQf >m_return_bind 2782 whd in match eval_statement_no_pc; whd in match eval_statement_advance; 2783 normalize nodelta >m_return_bind 2784 #H lapply (err_eq_from_io ????? H) H #H @('bind_inversion H) H 2785 * #st1 #pc1 #EQpop whd in match next_of_call_pc; normalize nodelta 2786 >m_bind_bind #H @('bind_inversion H) H ** #f1 #fn1 * normalize nodelta 2787 [ * [ #c_id #args #dest  #r #lbl  #seq ] #nxt  #fin  * ] 2788 #EQf1 normalize nodelta [2,3,4: whd in ⊢ (??%% → ?); #EQ destruct] 2789 >m_return_bind whd in ⊢ (??%% → ?); #EQ destruct 2790 lapply (fetch_statement_commute prog sigma stack_size … EQf) 2791 normalize nodelta #EQf' 2792 % [ whd in match joint_classify; normalize nodelta >EQf' >m_return_bind %] 2793 change with (pop_ra ?? = ?) in EQpop; whd in match set_no_pc in EQpop; 2794 normalize nodelta in EQpop; 2795 cases(pop_ra_ok ? sigma stack_size fn ?? EQpop) * #st3 #pc3 * #st3_spec 2796 normalize nodelta #EQ destruct whd in match set_last_pop; whd in match succ_pc; 2797 normalize nodelta whd in match (point_of_succ ???); 2798 % [ % [ @st3  @(pc_of_point ERTL_semantics (pc_block … pc3) nxt)  @pc3] ] 2799 % [ @('bind_inversion EQf1) * #f3 #fn3 whd in match sigma_stored_pc; 2800 normalize nodelta inversion(sigma_pc_opt ???) normalize nodelta 2801 [ #_ #H @('bind_inversion H) H #x whd in match null_pc; normalize nodelta 2802 >fetch_function_no_zero [2: %] whd in ⊢ (???% → ?); #EQ destruct 2803  #pc4 whd in match sigma_pc_opt; normalize nodelta @if_elim 2804 [ #bl3_spec @('bind_inversion EQf1) #x #H @('bind_inversion H) H 2805 #x1 >fetch_function_no_minus_one [ whd in ⊢ (???% → ?); #EQ destruct] 2806 lapply bl3_spec @eqZb_elim #EQ * whd in match sigma_stored_pc; 2807 normalize nodelta whd in match sigma_pc_opt; normalize nodelta 2808 >bl3_spec normalize nodelta assumption 2809  #bl3_spec #H @('bind_inversion H) H * #id4 #fn4 2810 #H lapply(res_eq_from_opt ??? H) H #fn4_spec 2811 #H @('bind_inversion H) H #lbl4 #lbl4_spec whd in ⊢ (??%? → ?); #EQ 2812 destruct #fn3_spec #H @('bind_inversion H) H #stmt1 #_ 2813 whd in ⊢ (??%% → ?); #EQ destruct 2814 >(fetch_internal_function_transf … fn3_spec) in fn4_spec; 2815 whd in ⊢ (??%% → ?); #EQ destruct 2816 ] 2817 ] 2818 whd in match sigma_state_pc; normalize nodelta @if_elim 2819 [ >(pc_block_eq prog sigma ????) in bl3_spec; 2820 [2: >lbl4_spec % #ABS destruct 2821 3: >(fetch_internal_function_transf … fn3_spec) % *:] 2822 #bl3_spec whd in match pc_of_point; normalize nodelta #EQ >EQ in bl3_spec; * 2823  #_ cases daemon 2824 ] 2825 ] cases daemon 2826 qed. 2827 2828 (* 2829 lemma ertl_allocate_local_ok : ∀ prog : ertl_program. 2830 let trans_prog ≝ ertl_to_ertlptr prog in 2831 ∀sigma : sigma_map. 2832 ∀stack_size. 2833 ∀id,regs. 2834 ertl_allocate_local id (sigma_regs ? sigma getLocalsFromId( 2835 *) 2836 2837 lemma eval_tailcall_ok : 2838 ∀prog. 2839 let trans_prog ≝ ertl_to_ertlptr prog in 2840 ∀stack_sizes. 2841 ∀sigma : sigma_map trans_prog. 2842 ∀st,st',f,fn,fl,called,args. 2843 fetch_statement ERTL_semantics … 2844 (globalenv_noinit ? prog) (pc … (sigma_state_pc ? sigma st)) = 2845 return 〈f, fn, final … (TAILCALL ERTL … fl called args)〉 → 2846 eval_state ERTL_semantics 2847 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 2848 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 2849 (sigma_state_pc ? sigma st) = 2850 return st' → 2851 ∃ st''. st' = sigma_state_pc ? sigma st'' ∧ 2852 ∃is_tailcall, is_tailcall'. 2853 joint_tailcall_ident (mk_prog_params ERTLptr_semantics trans_prog stack_sizes) «st, is_tailcall'» = 2854 joint_tailcall_ident (mk_prog_params ERTL_semantics prog stack_sizes) «(sigma_state_pc ? sigma st), is_tailcall» ∧ 2855 eval_state … (ev_genv … (mk_prog_params ERTLptr_semantics trans_prog stack_sizes)) 2856 st = return st''. 2857 #prog #stack_size #sigma #st #st' #f #fn #fl #called #args 2858 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2859 @if_elim 2860 [ #EQbl whd in match dummy_state_pc; whd in match null_pc; 2861 whd in match fetch_statement; whd in match fetch_internal_function; 2862 normalize nodelta >(fetch_function_no_zero ??????) [2: %] 2863 whd in ⊢ (??%% → ?); #EQ destruct ] 2864 #Hbl inversion(fetch_internal_function ???) 2865 [2: #e #_ normalize nodelta whd in match dummy_state_pc; whd in match null_pc; 2866 whd in match fetch_statement; whd in match fetch_internal_function; 2867 normalize nodelta lapply(fetch_function_no_zero ??????) 2868 [2: @( «mk_block Code OZ,refl region Code») 2869  %  @prog 7: #EQ >EQ *:] whd in ⊢ (??%% → ?); #EQ destruct] 2870 * #f1 #fn1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #fn1_spec normalize nodelta 2871 #EQf lapply EQf whd in match fetch_statement; normalize nodelta >fn1_spec 2872 >m_return_bind #H @('bind_inversion H) H #stmt' #_ whd in ⊢ (??%% → ?); 2873 #EQ destruct whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 2874 @if_elim [#H >H in Hbl; *] #_ >fn1_spec normalize nodelta 2875 whd in match eval_state; normalize nodelta >EQf >m_return_bind 2876 whd in match eval_statement_no_pc; whd in match eval_statement_advance; 2877 normalize nodelta >m_return_bind whd in match eval_tailcall; 2878 normalize nodelta #H @('bind_inversion H) H #bl whd in match set_no_pc; 2879 normalize nodelta #bl_spec #H @('bind_inversion H) H * #id1 * [#int_f  #ext_f] 2880 #H lapply(err_eq_from_io ????? H) H #id1_spec normalize nodelta 2881 [2: #H @('bind_inversion H) H #st1 whd in match eval_external_call; normalize nodelta 2882 #H @('bind_inversion H) H #l_val #_ #H @('bind_inversion H) H #le #_ 2883 #H @('bind_inversion H) H #x whd in match do_io; normalize nodelta 2884 whd in ⊢ (???% → ?); #EQ destruct ] 2885 #H lapply(err_eq_from_io ????? H) H #H @('bind_inversion H) H #st1 2886 whd in match eval_internal_call; normalize nodelta whd in match (stack_sizes ????); 2887 #H @('bind_inversion H) H #n #H lapply(opt_eq_from_res ???? H) H #n_spec 2888 whd in match(setup_call ???????); >m_return_bind 2889 whd in ⊢ (??%% → ?); #EQ destruct whd in match sigma_state in ⊢ (% → ?); 2890 normalize nodelta whd in ⊢ (??%% → ?); #EQ destruct 2891 % [ % 2892 [ % 2893 [ @(st_frms ERTLptr_semantics st) 2894  @(istack ERTLptr_semantics st) 2895  @(carry ERTLptr_semantics st) 2896  cases daemon 2897  @(m ERTLptr_semantics st) 2898 ] 2899  @(mk_program_counter bl 2900 (offset_of_point ERTL_semantics 2901 (joint_if_entry ERTL_semantics 2902 (prog_var_names (joint_function ERTL_semantics) ℕ prog) int_f))) 2903  @(last_pop ERTLptr_semantics st) 2904 ] 2905 ] 2906 % [ whd in match sigma_state_pc; normalize nodelta @if_elim whd in match pc_of_point; 2907 normalize nodelta 2908 [ #Hbl >fetch_function_no_minus_one in id1_spec; 2909 [2: lapply Hbl @eqZb_elim Hbl #Hbl * @Hbl] whd in ⊢ (???% → ?); 2910 #EQ destruct(EQ) 2911 ] #_ whd in match fetch_internal_function; normalize nodelta >id1_spec 2912 >m_return_bind normalize nodelta cases daemon (*TO BE COmpleted *) 2913 ] cases daemon (*TO BE COMPLETED*) 2914 qed. 2915 2916 2917 2918 2919 lemma as_label_ok : ∀ prog : ertl_program. 2920 let trans_prog ≝ ertl_to_ertlptr prog in 2921 ∀ sigma : sigma_map trans_prog. 2922 ∀stack_sizes. 2923 ∀ st. 2924 as_label (ERTLptr_status trans_prog stack_sizes) st = as_label 2925 (ERTL_status prog stack_sizes) (sigma_state_pc prog sigma st). 2926 #prog #sigma #stack_size * #st #pc #lp 2927 whd in match as_label; normalize nodelta whd in match (as_pc_of ??) in ⊢ (??%%); 2928 whd in match (as_label_of_pc ??) in ⊢ (??%%); 2929 2930 2931 (* 2932 2933 whd in match fetch_statement; normalize nodelta 2934 whd in match sigma_state_pc; normalize nodelta @if_elim 2935 [ #EQbl whd in match fetch_internal_function; normalize nodelta >m_bind_bind 2936 lapply(fetch_function_no_minus_one ??????) [2: @(pc_block pc)  lapply EQbl 2937 @eqZb_elim #H * @H @(ertl_to_ertlptr prog) 7: #EQ >EQ *:] normalize nodelta 2938 whd in match dummy_state_pc; whd in match (as_label_of_pc ??); whd in match null_pc; 2939 whd in match fetch_statement; normalize nodelta whd in match fetch_internal_function; 2940 normalize nodelta >m_bind_bind 2941 lapply(fetch_function_no_zero ??????) [2: @( «mk_block Code OZ,refl region Code») 2942  %  @prog 7: #EQ >EQ *:] % 2943  inversion ( fetch_internal_function 2944 (joint_closed_internal_function ERTL 2945 (prog_var_names (joint_function ERTL) ℕ prog)) 2946 (globalenv_noinit (joint_function ERTL) prog) (pc_block pc)) 2947 [ * #id #fn #fn_spec #_ lapply(fetch_internal_function_transf ??????? fn_spec) 2948 [ @(λvars,fn.translate_internal … fn) ] #EQ >EQ >m_return_bind normalize nodelta 2949 whd in match (as_label_of_pc ??); 2950 whd in match fetch_statement; normalize nodelta >fn_spec >m_return_bind 2951 cases daemon (*serve specifica su sigma TODO*) 2952  #err #EQ lapply(jmeq_to_eq ??? EQ) EQ #fetch_err #_ normalize nodelta 2953 whd in match dummy_state_pc; 2954 whd in match (as_label_of_pc ??); whd in match null_pc; 2955 whd in match fetch_statement; normalize nodelta 2956 whd in match fetch_internal_function in ⊢ (???%); 2957 normalize nodelta 2958 lapply(fetch_function_no_zero ??????) [2: @( «mk_block Code OZ,refl region Code») 2959  %  @prog 7: #EQ >EQ in ⊢ (???%); *:] normalize nodelta EQ 2960 lapply fetch_err fetch_err whd in match fetch_internal_function; normalize nodelta 2961 inversion(fetch_function ???) 2962 [* #id * #fn #fn_spec >m_return_bind normalize nodelta [whd in ⊢ (??%? → ?); #EQ destruct] 2963 #EQ destruct lapply(jmeq_to_eq ??? fn_spec) fn_spec #fn_spec 2964 lapply(fetch_function_transf ????????? fn_spec) [ #v @transf_fundef [2:@translate_internal ]] 2965 #EQ >EQ >m_return_bind % 2966  #err1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #EQfetch whd in ⊢ (??%? → ?); #EQ destruct 2967 normalize nodelta lapply EQfetch EQfetch whd in match fetch_function; 2968 normalize nodelta check joint_function 2969 lapply(symbol_for_block_transf ? ? ? ? prog (λvars.?) (pc_block pc)) 2970 [@transf_fundef [2: @translate_internal] 4: #EQ >EQ in ⊢ (? → %); *:] 2971 cases(symbol_for_block ???) [ whd in ⊢ (??%% → ?); #EQ destruct %] 2972 #id >m_return_bind inversion(find_funct_ptr ???) 2973 [2: #fn1 #_ >m_return_bind whd in ⊢ (??%? → ?); #EQ destruct] 2974 #EQf whd in ⊢ (??%? → ?); #EQ destruct 2975 lapply(find_funct_ptr_none ??????? EQf) (*forse e' falso*) 2976 [#vars @transf_fundef [2: @translate_internal]] 2977 #EQ >EQ % 2978 ] 2979 ] 2980 ]*) 2981 cases daemon 2982 qed. 2983 2984 lemma bool_of_beval_ok : ∀prog : ertlptr_program. 2985 ∀sigma : sigma_map prog. 2986 preserving1 … res_preserve1 … 2987 (sigma_beval prog sigma) 2988 (λx.x) 2989 (bool_of_beval) 2990 (bool_of_beval). 2991 #prog #sigma whd in match bool_of_beval; normalize nodelta 2992 * normalize nodelta 2993 [   #ptr1 #ptr2 #p  #by  #p  #ptr #p  #pc #p] 2994 try @res_preserve_error1 #x 2995 [1,2,3,4: whd in ⊢ (???% → ?); #EQ destruct 2996 [1,4: %{true} % // 2997 3: %{false} % // 2998  %{(eq_bv 8 (zero 8) by)} % // 2999 ] 3000  whd in match sigma_beval; normalize nodelta cases(sigma_pc_opt ? ? ?) 3001 normalize nodelta [2: #pc1] whd in ⊢ (???% → ?); #EQ destruct 3002 ] 3003 qed. 3004 3005 lemma eval_cond_ok : 3006 ∀prog. 3007 let trans_prog ≝ ertl_to_ertlptr prog in 3008 ∀stack_sizes. 3009 ∀sigma : sigma_map trans_prog. 3010 ∀st,st',f,fn,a,ltrue,lfalse. 3011 fetch_statement ERTL_semantics … 3012 (globalenv_noinit ? prog) (pc … (sigma_state_pc ? sigma st)) = 3013 return 〈f, fn, sequential … (COND ERTL … a ltrue) lfalse〉 → 3014 eval_state ERTL_semantics 3015 (prog_var_names (joint_function ERTL_semantics) ℕ prog) 3016 (ev_genv … (mk_prog_params ERTL_semantics prog stack_sizes)) 3017 (sigma_state_pc ? sigma st) = 3018 return st' → 3019 as_costed (ERTL_status prog stack_sizes) 3020 st' → 3021 ∃ st''. st' = sigma_state_pc ? sigma st'' ∧ 3022 ∃taf : trace_any_any_free (ERTLptr_status trans_prog stack_sizes) 3023 st st''. 3024 bool_to_Prop (taaf_non_empty … taf). 3025 #prog #stack_size #sigma #st #st' #f #fn #a #lb_t #lb_f 3026 whd in match sigma_state_pc in ⊢ (% → ?); normalize nodelta 3027 @if_elim 3028 [ #EQbl whd in match dummy_state_pc; whd in match null_pc; 3029 whd in match fetch_statement; whd in match fetch_internal_function; 3030 normalize nodelta >(fetch_function_no_zero ??????) [2: %] 3031 whd in ⊢ (??%% → ?); #EQ destruct ] 3032 #Hbl inversion(fetch_internal_function ???) 3033 [2: #e #_ normalize nodelta whd in match dummy_state_pc; whd in match null_pc; 3034 whd in match fetch_statement; whd in match fetch_internal_function; 3035 normalize nodelta >(fetch_function_no_zero ??????) [2: %] 3036 whd in ⊢ (??%% → ?); #EQ destruct] 3037 * #f1 #fn1 #EQ lapply(jmeq_to_eq ??? EQ) EQ #fn1_spec normalize nodelta 3038 #EQf lapply EQf whd in match fetch_statement; normalize nodelta >fn1_spec 3039 >m_return_bind #H @('bind_inversion H) H #stmt' #_ whd in ⊢ (??%% → ?); 3040 #EQ destruct whd in match eval_state; whd in match eval_statement_no_pc; 3041 whd in match eval_statement_advance; whd in match sigma_state_pc in ⊢ (% → ?); 3042 normalize nodelta @if_elim [#H >H in Hbl; *] #_ >fn1_spec normalize nodelta 3043 >EQf >m_return_bind normalize nodelta >m_return_bind 3044 #H lapply(err_eq_from_io ????? H) H #H @('bind_inversion H) H #bv 3045 change with (ps_reg_retrieve ?? = ? → ?) whd in match set_no_pc; 3046 whd in match sigma_state in ⊢ (??(?%?)? → ?); normalize nodelta #bv_spec 3047 #H @('bind_inversion H) H * #EQbv normalize nodelta 3048 [ whd in match goto; normalize nodelta >pc_of_label_eq [2: assumption 3:] 3049 >m_return_bind whd in match pc_of_point; normalize nodelta whd in ⊢ (??%% → ?); 3050 whd in match set_pc; normalize nodelta #EQ destruct 3051  whd in match next; whd in match set_pc; normalize nodelta whd in match (succ_pc ???); 3052 whd in match (point_of_succ ???); whd in ⊢ (??%% → ?); #EQ destruct 3053 ] 3054 whd in match as_costed; normalize nodelta * #n_cost % 3055 [1,3: % [1,4: @st 3056 2,5: @(mk_program_counter 3057 (pc_block (pc ERTLptr_semantics st)) 3058 (offset_of_point ERTL_semantics ?)) [ @lb_t  @lb_f] 3059 3,6: @(last_pop ? st) 3060 ] 3061 ] 3062 % [1,3: whd in match sigma_state_pc; normalize nodelta @if_elim 3063 [1,3: #EQ >EQ in Hbl; *] #_ >fn1_spec %] 3064 %{(taaf_step_jump … (taa_base …) …) I} 3065 lapply (fetch_statement_commute prog sigma … stack_size … EQf) 3066 normalize nodelta #EQf' 3067 [1,4: whd in match as_costed; normalize nodelta >as_label_ok [2,4: @sigma] 3068 % #H @n_cost <H whd in match sigma_state_pc; normalize nodelta 3069 @if_elim [1,3: #EQ >EQ in Hbl; *] #_ >fn1_spec % 3070 2,5: whd in match as_classifier; normalize nodelta whd in match (as_classify ??); 3071 normalize nodelta >EQf' % 3072 *: whd in match (as_execute ???); whd in match eval_state; normalize nodelta 3073 >EQf' >m_return_bind whd in match eval_statement_no_pc; normalize nodelta 3074 >m_return_bind whd in match eval_statement_advance; normalize nodelta 3075 change with (ps_reg_retrieve ??) in ⊢ (??(????(????%?))?); 3076 cases(ps_reg_retrieve_ok ????? ? bv_spec) #bv' * #bv_spec' #bv_bv' 3077 >bv_spec' >m_return_bind >bv_bv' in EQbv; #EQbv 3078 cases(bool_of_beval_ok ? sigma ? ? EQbv) #b1 * #b1_spec #EQ destruct 3079 >b1_spec >m_return_bind normalize nodelta [2: %] whd in match goto; 3080 normalize nodelta whd in match set_no_pc; normalize nodelta 3081 >pc_of_label_eq 3082 [ % 3083  lapply(fetch_internal_function_transf ????????) 3084 [3: @f 2: @fn  whd in ⊢ (???%); <fn1_spec in ⊢ (???%); % 3085   #vars @translate_internal 9: #EQ >EQ in ⊢ (??%?); % *:] 3086  3087 ] 3088 ] 3089 qed. 3090 3091 3092 lemma 3093 find_funct_ptr_none: 3094 ∀A,B,V,iV. ∀p: program A V. ∀transf: (∀vs. A vs → B vs). 3095 ∀b: block. 3096 find_funct_ptr ? (globalenv … iV p) b = None ? → 3097 find_funct_ptr ? (globalenv … iV (transform_program … p transf)) b = None ?. 3098 #A #B #V #i #p #transf #b 3099 whd in match find_funct_ptr; normalize nodelta 3100 cases b b * normalize nodelta [#x #_ %] * normalize nodelta 3101 [1,2: [2: #x] #_ %] #x whd in match globalenv; normalize nodelta 3102 whd in match globalenv_allocmem; normalize nodelta 3103 cases daemon (*forse e' falso *) 3104 qed. 3105 3106 3107 3108 3109 3110 3111 2599 qed. *)
Note: See TracChangeset
for help on using the changeset viewer.