1 | include "ASM/ASM.ma". |
---|
2 | include "ASM/Arithmetic.ma". |
---|
3 | include "ASM/Fetch.ma". |
---|
4 | include "ASM/Status.ma". |
---|
5 | include "utilities/extralib.ma". |
---|
6 | include "ASM/Assembly.ma". |
---|
7 | |
---|
8 | include alias "basics/lists/list.ma". |
---|
9 | include alias "arithmetics/nat.ma". |
---|
10 | include alias "basics/logic.ma". |
---|
11 | |
---|
12 | (* Internal types *) |
---|
13 | |
---|
14 | (* ppc_pc_map: program length × (pseudo program counter ↦ 〈pc, jump_length〉) *) |
---|
15 | definition ppc_pc_map ≝ ℕ × (BitVectorTrie (ℕ × jump_length) 16). |
---|
16 | |
---|
17 | (* The different properties that we want/need to prove at some point *) |
---|
18 | (* Anything that's not in the program doesn't end up in the policy *) |
---|
19 | definition out_of_program_none: list labelled_instruction → ppc_pc_map → Prop ≝ |
---|
20 | λprefix.λsigma. |
---|
21 | ∀i:ℕ.i ≥ |prefix| → i < 2^16 → bvt_lookup_opt … (bitvector_of_nat 16 i) (\snd sigma) = None ?. |
---|
22 | |
---|
23 | (* If instruction i is a jump, then there will be something in the policy at |
---|
24 | * position i *) |
---|
25 | definition is_jump' ≝ |
---|
26 | λx:preinstruction Identifier. |
---|
27 | match x with |
---|
28 | [ JC _ ⇒ True |
---|
29 | | JNC _ ⇒ True |
---|
30 | | JZ _ ⇒ True |
---|
31 | | JNZ _ ⇒ True |
---|
32 | | JB _ _ ⇒ True |
---|
33 | | JNB _ _ ⇒ True |
---|
34 | | JBC _ _ ⇒ True |
---|
35 | | CJNE _ _ ⇒ True |
---|
36 | | DJNZ _ _ ⇒ True |
---|
37 | | _ ⇒ False |
---|
38 | ]. |
---|
39 | |
---|
40 | definition is_jump ≝ |
---|
41 | λinstr:pseudo_instruction. |
---|
42 | match instr with |
---|
43 | [ Instruction i ⇒ is_jump' i |
---|
44 | | Call _ ⇒ True |
---|
45 | | Jmp _ ⇒ True |
---|
46 | | _ ⇒ False |
---|
47 | ]. |
---|
48 | |
---|
49 | definition is_jump_to ≝ |
---|
50 | λx:pseudo_instruction.λd:Identifier. |
---|
51 | match x with |
---|
52 | [ Instruction i ⇒ match i with |
---|
53 | [ JC j ⇒ d = j |
---|
54 | | JNC j ⇒ d = j |
---|
55 | | JZ j ⇒ d = j |
---|
56 | | JNZ j ⇒ d = j |
---|
57 | | JB _ j ⇒ d = j |
---|
58 | | JNB _ j ⇒ d = j |
---|
59 | | CJNE _ j ⇒ d = j |
---|
60 | | DJNZ _ j ⇒ d = j |
---|
61 | | _ ⇒ False |
---|
62 | ] |
---|
63 | | Call c ⇒ d = c |
---|
64 | | Jmp j ⇒ d = j |
---|
65 | | _ ⇒ False |
---|
66 | ]. |
---|
67 | |
---|
68 | definition jump_not_in_policy: list labelled_instruction → ppc_pc_map → Prop ≝ |
---|
69 | λprefix.λsigma. |
---|
70 | ∀i:ℕ.i < |prefix| → |
---|
71 | ¬is_jump (\snd (nth i ? prefix 〈None ?, Comment []〉)) → |
---|
72 | \snd (bvt_lookup … (bitvector_of_nat 16 i) (\snd sigma) 〈0,short_jump〉) = short_jump. |
---|
73 | |
---|
74 | (* if the instruction 〈p,a〉 is a jump to label l, then label l is at address a *) |
---|
75 | (* definition labels_okay: label_map → ppc_pc_map → Prop ≝ |
---|
76 | λlabels.λsigma. |
---|
77 | bvt_forall ?? (\snd sigma) (λn.λx. |
---|
78 | let 〈pc,addr_nat〉 ≝ x in |
---|
79 | ∃id:Identifier.lookup_def … labels id 0 = addr_nat |
---|
80 | ). *) |
---|
81 | |
---|
82 | (* Between two policies, jumps cannot decrease *) |
---|
83 | definition jmpeqb: jump_length → jump_length → bool ≝ |
---|
84 | λj1.λj2. |
---|
85 | match j1 with |
---|
86 | [ short_jump ⇒ match j2 with [ short_jump ⇒ true | _ ⇒ false ] |
---|
87 | | medium_jump ⇒ match j2 with [ medium_jump ⇒ true | _ ⇒ false ] |
---|
88 | | long_jump ⇒ match j2 with [ long_jump ⇒ true | _ ⇒ false ] |
---|
89 | ]. |
---|
90 | |
---|
91 | lemma jmpeqb_to_eq: ∀j1,j2.jmpeqb j1 j2 → j1 = j2. |
---|
92 | #j1 #j2 cases j1 cases j2 |
---|
93 | [1,5,9: / by /] |
---|
94 | #H cases H |
---|
95 | qed. |
---|
96 | |
---|
97 | definition jmple: jump_length → jump_length → Prop ≝ |
---|
98 | λj1.λj2. |
---|
99 | match j1 with |
---|
100 | [ short_jump ⇒ |
---|
101 | match j2 with |
---|
102 | [ short_jump ⇒ False |
---|
103 | | _ ⇒ True |
---|
104 | ] |
---|
105 | | medium_jump ⇒ |
---|
106 | match j2 with |
---|
107 | [ long_jump ⇒ True |
---|
108 | | _ ⇒ False |
---|
109 | ] |
---|
110 | | long_jump ⇒ False |
---|
111 | ]. |
---|
112 | |
---|
113 | definition jmpleq: jump_length → jump_length → Prop ≝ |
---|
114 | λj1.λj2.jmple j1 j2 ∨ j1 = j2. |
---|
115 | |
---|
116 | definition policy_increase: list labelled_instruction → ppc_pc_map → |
---|
117 | ppc_pc_map → Prop ≝ |
---|
118 | λprogram.λop.λp. |
---|
119 | ∀i.i < |program| → |
---|
120 | let 〈opc,oj〉 ≝ bvt_lookup … (bitvector_of_nat 16 i) (\snd op) 〈0,short_jump〉 in |
---|
121 | let 〈pc,j〉 ≝ bvt_lookup … (bitvector_of_nat 16 i) (\snd p) 〈0,short_jump〉 in |
---|
122 | (*opc ≤ pc ∧*) jmpleq oj j. |
---|
123 | |
---|
124 | (* Policy safety *) |
---|
125 | (*definition policy_safe: list labelled_instruction → label_map → ppc_pc_map → Prop ≝ |
---|
126 | λprogram.λlabels.λsigma. |
---|
127 | ∀i.i < |program| → |
---|
128 | let 〈pc,j〉 ≝ bvt_lookup … (bitvector_of_nat 16 i) (\snd sigma) 〈0,false〉 in |
---|
129 | let 〈label,instr〉 ≝ nth i ? program 〈None ?, Comment [ ]〉 in |
---|
130 | ∀dest.is_jump_to instr dest → |
---|
131 | let paddr ≝ lookup_def … labels dest 0 in |
---|
132 | let addr ≝ \fst (bvt_lookup … (bitvector_of_nat 16 paddr) (\snd sigma) 〈0,false〉) in |
---|
133 | match j with |
---|
134 | [ None ⇒ True |
---|
135 | | Some j ⇒ match j with |
---|
136 | [ short_jump ⇒ |
---|
137 | if leb pc addr |
---|
138 | then le (addr - pc) 126 |
---|
139 | else le (pc - addr) 129 |
---|
140 | | medium_jump ⇒ |
---|
141 | let a ≝ bitvector_of_nat 16 addr in |
---|
142 | let p ≝ bitvector_of_nat 16 pc in |
---|
143 | let 〈fst_5_addr, rest_addr〉 ≝ split bool 5 11 a in |
---|
144 | let 〈fst_5_pc, rest_pc〉 ≝ split bool 5 11 p in |
---|
145 | eq_bv 5 fst_5_addr fst_5_pc = true |
---|
146 | | long_jump ⇒ True |
---|
147 | ] |
---|
148 | ].*) |
---|
149 | |
---|
150 | (* this is the instruction size as determined by the distance from origin to destination *) |
---|
151 | (*definition instruction_size_sigma: label_map → ppc_pc_map → Word → pseudo_instruction → ℕ ≝ |
---|
152 | λlabels.λsigma.λpc.λi. |
---|
153 | \fst (assembly_1_pseudoinstruction |
---|
154 | (λid.bitvector_of_nat 16 (lookup_def … labels id 0)) |
---|
155 | (λi.bitvector_of_nat 16 (\fst (bvt_lookup ?? i (\snd sigma) 〈0,false〉))) pc |
---|
156 | (λx.zero 16) i).*) |
---|
157 | |
---|
158 | (* this is the instruction size as determined by the jump length given *) |
---|
159 | definition expand_relative_jump_internal_unsafe: |
---|
160 | jump_length → ([[relative]] → preinstruction [[relative]]) → list instruction ≝ |
---|
161 | λjmp_len:jump_length.λi. |
---|
162 | match jmp_len with |
---|
163 | [ short_jump ⇒ [ RealInstruction (i (RELATIVE (zero 8))) ] |
---|
164 | | medium_jump ⇒ [ ] (* this should not happen *) |
---|
165 | | long_jump ⇒ |
---|
166 | [ RealInstruction (i (RELATIVE (bitvector_of_nat ? 2))); |
---|
167 | SJMP (RELATIVE (bitvector_of_nat ? 3)); (* LJMP size? *) |
---|
168 | LJMP (ADDR16 (zero 16)) |
---|
169 | ] |
---|
170 | ]. |
---|
171 | @I |
---|
172 | qed. |
---|
173 | |
---|
174 | definition expand_relative_jump_unsafe: |
---|
175 | jump_length → preinstruction Identifier → list instruction ≝ |
---|
176 | λjmp_len:jump_length.λi. |
---|
177 | match i with |
---|
178 | [ JC jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JC ?) |
---|
179 | | JNC jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JNC ?) |
---|
180 | | JB baddr jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JB ? baddr) |
---|
181 | | JZ jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JZ ?) |
---|
182 | | JNZ jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JNZ ?) |
---|
183 | | JBC baddr jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JBC ? baddr) |
---|
184 | | JNB baddr jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (JNB ? baddr) |
---|
185 | | CJNE addr jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (CJNE ? addr) |
---|
186 | | DJNZ addr jmp ⇒ expand_relative_jump_internal_unsafe jmp_len (DJNZ ? addr) |
---|
187 | | ADD arg1 arg2 ⇒ [ ADD ? arg1 arg2 ] |
---|
188 | | ADDC arg1 arg2 ⇒ [ ADDC ? arg1 arg2 ] |
---|
189 | | SUBB arg1 arg2 ⇒ [ SUBB ? arg1 arg2 ] |
---|
190 | | INC arg ⇒ [ INC ? arg ] |
---|
191 | | DEC arg ⇒ [ DEC ? arg ] |
---|
192 | | MUL arg1 arg2 ⇒ [ MUL ? arg1 arg2 ] |
---|
193 | | DIV arg1 arg2 ⇒ [ DIV ? arg1 arg2 ] |
---|
194 | | DA arg ⇒ [ DA ? arg ] |
---|
195 | | ANL arg ⇒ [ ANL ? arg ] |
---|
196 | | ORL arg ⇒ [ ORL ? arg ] |
---|
197 | | XRL arg ⇒ [ XRL ? arg ] |
---|
198 | | CLR arg ⇒ [ CLR ? arg ] |
---|
199 | | CPL arg ⇒ [ CPL ? arg ] |
---|
200 | | RL arg ⇒ [ RL ? arg ] |
---|
201 | | RR arg ⇒ [ RR ? arg ] |
---|
202 | | RLC arg ⇒ [ RLC ? arg ] |
---|
203 | | RRC arg ⇒ [ RRC ? arg ] |
---|
204 | | SWAP arg ⇒ [ SWAP ? arg ] |
---|
205 | | MOV arg ⇒ [ MOV ? arg ] |
---|
206 | | MOVX arg ⇒ [ MOVX ? arg ] |
---|
207 | | SETB arg ⇒ [ SETB ? arg ] |
---|
208 | | PUSH arg ⇒ [ PUSH ? arg ] |
---|
209 | | POP arg ⇒ [ POP ? arg ] |
---|
210 | | XCH arg1 arg2 ⇒ [ XCH ? arg1 arg2 ] |
---|
211 | | XCHD arg1 arg2 ⇒ [ XCHD ? arg1 arg2 ] |
---|
212 | | RET ⇒ [ RET ? ] |
---|
213 | | RETI ⇒ [ RETI ? ] |
---|
214 | | NOP ⇒ [ RealInstruction (NOP ?) ] |
---|
215 | ]. |
---|
216 | |
---|
217 | definition instruction_size_jmplen: |
---|
218 | jump_length → pseudo_instruction → ℕ ≝ |
---|
219 | λjmp_len. |
---|
220 | λi. |
---|
221 | let pseudos ≝ match i with |
---|
222 | [ Cost cost ⇒ [ ] |
---|
223 | | Comment comment ⇒ [ ] |
---|
224 | | Call call ⇒ |
---|
225 | match jmp_len with |
---|
226 | [ short_jump ⇒ [ ] (* this should not happen *) |
---|
227 | | medium_jump ⇒ [ ACALL (ADDR11 (zero 11)) ] |
---|
228 | | long_jump ⇒ [ LCALL (ADDR16 (zero 16)) ] |
---|
229 | ] |
---|
230 | | Mov d trgt ⇒ |
---|
231 | [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inr ? ? 〈DPTR, DATA16 (zero 16)〉))))] |
---|
232 | | Instruction instr ⇒ expand_relative_jump_unsafe jmp_len instr |
---|
233 | | Jmp jmp ⇒ |
---|
234 | match jmp_len with |
---|
235 | [ short_jump ⇒ [ SJMP (RELATIVE (zero 8)) ] |
---|
236 | | medium_jump ⇒ [ AJMP (ADDR11 (zero 11)) ] |
---|
237 | | long_jump ⇒ [ LJMP (ADDR16 (zero 16)) ] |
---|
238 | ] |
---|
239 | ] in |
---|
240 | let mapped ≝ map ? ? assembly1 pseudos in |
---|
241 | let flattened ≝ flatten ? mapped in |
---|
242 | let pc_len ≝ length ? flattened in |
---|
243 | pc_len. |
---|
244 | @I. |
---|
245 | qed. |
---|
246 | |
---|
247 | (* new safety condition: policy corresponds to program and resulting program is compact *) |
---|
248 | definition policy_compact: list labelled_instruction → label_map → ppc_pc_map → Prop ≝ |
---|
249 | λprogram.λlabels.λsigma. |
---|
250 | ∀n:ℕ.S n < |program| → |
---|
251 | match bvt_lookup_opt … (bitvector_of_nat ? n) (\snd sigma) with |
---|
252 | [ None ⇒ False |
---|
253 | | Some x ⇒ let 〈pc,j〉 ≝ x in |
---|
254 | match bvt_lookup_opt … (bitvector_of_nat ? (S n)) (\snd sigma) with |
---|
255 | [ None ⇒ False |
---|
256 | | Some x1 ⇒ let 〈pc1,j1〉 ≝ x1 in |
---|
257 | pc1 = instruction_size (λid.bitvector_of_nat ? (lookup_def ?? labels id 0)) |
---|
258 | (λppc.let 〈x,y〉 ≝ bvt_lookup ?? ppc (\snd sigma) 〈0,short_jump〉 in |
---|
259 | 〈bitvector_of_nat ? x, jmpeqb y long_jump〉) |
---|
260 | (bitvector_of_nat ? pc) (\snd (nth n ? program 〈None ?, Comment []〉)) |
---|
261 | ] |
---|
262 | ]. |
---|
263 | |
---|
264 | (* Definitions and theorems for the jump_length type (itself defined in Assembly) *) |
---|
265 | definition max_length: jump_length → jump_length → jump_length ≝ |
---|
266 | λj1.λj2. |
---|
267 | match j1 with |
---|
268 | [ long_jump ⇒ long_jump |
---|
269 | | medium_jump ⇒ |
---|
270 | match j2 with |
---|
271 | [ medium_jump ⇒ medium_jump |
---|
272 | | _ ⇒ long_jump |
---|
273 | ] |
---|
274 | | short_jump ⇒ |
---|
275 | match j2 with |
---|
276 | [ short_jump ⇒ short_jump |
---|
277 | | _ ⇒ long_jump |
---|
278 | ] |
---|
279 | ]. |
---|
280 | |
---|
281 | lemma dec_jmple: ∀x,y:jump_length.Sum (jmple x y) (¬(jmple x y)). |
---|
282 | #x #y cases x cases y /3 by inl, inr, nmk, I/ |
---|
283 | qed. |
---|
284 | |
---|
285 | lemma jmpleq_max_length: ∀ol,nl. |
---|
286 | jmpleq ol (max_length ol nl). |
---|
287 | #ol #nl cases ol cases nl |
---|
288 | /2 by or_introl, or_intror, I/ |
---|
289 | qed. |
---|
290 | |
---|
291 | lemma dec_eq_jump_length: ∀a,b:jump_length.Sum (a = b) (a ≠ b). |
---|
292 | #a #b cases a cases b /2/ |
---|
293 | %2 @nmk #H destruct (H) |
---|
294 | qed. |
---|
295 | |
---|
296 | definition policy_isize_sum ≝ |
---|
297 | λprefix:list labelled_instruction.λlabels:label_map.λsigma:ppc_pc_map. |
---|
298 | (\fst sigma) = foldl_strong (option Identifier × pseudo_instruction) |
---|
299 | (λacc.ℕ) |
---|
300 | prefix |
---|
301 | (λhd.λx.λtl.λp.λacc. |
---|
302 | acc + (instruction_size (λid.bitvector_of_nat ? (lookup_def ?? labels id 0)) |
---|
303 | (λppc.let 〈x,y〉 ≝ bvt_lookup ?? ppc (\snd sigma) 〈0,short_jump〉 in |
---|
304 | 〈bitvector_of_nat ? x, jmpeqb y long_jump〉) |
---|
305 | (bitvector_of_nat 16 (\fst sigma)) (\snd x))) |
---|
306 | 0. |
---|
307 | |
---|
308 | (* The function that creates the label-to-address map *) |
---|
309 | definition create_label_map: ∀program:list labelled_instruction. |
---|
310 | (Σlabels:label_map. |
---|
311 | ∀l.occurs_exactly_once ?? l program → |
---|
312 | bitvector_of_nat ? (lookup_def ?? labels l 0) = |
---|
313 | address_of_word_labels_code_mem program l |
---|
314 | ) ≝ |
---|
315 | λprogram. |
---|
316 | \fst (create_label_cost_map program). |
---|
317 | #l #Hl lapply (pi2 ?? (create_label_cost_map program)) @pair_elim |
---|
318 | #labels #costs #EQ normalize nodelta #H @(H l Hl) |
---|
319 | qed. |
---|
320 | |
---|
321 | definition select_reljump_length: label_map → ppc_pc_map → ppc_pc_map → ℕ → ℕ → |
---|
322 | Identifier → jump_length ≝ |
---|
323 | λlabels.λold_sigma.λinc_sigma.λadded.λppc.λlbl. |
---|
324 | let paddr ≝ lookup_def … labels lbl 0 in |
---|
325 | if leb ppc paddr (* forward jump *) |
---|
326 | then |
---|
327 | let addr ≝ \fst (bvt_lookup … (bitvector_of_nat 16 paddr) (\snd old_sigma) 〈0,short_jump〉) |
---|
328 | + added in |
---|
329 | if leb (addr - \fst inc_sigma) 126 |
---|
330 | then short_jump |
---|
331 | else long_jump |
---|
332 | else |
---|
333 | let addr ≝ \fst (bvt_lookup … (bitvector_of_nat 16 paddr) (\snd inc_sigma) 〈0,short_jump〉) in |
---|
334 | if leb (\fst inc_sigma - addr) 129 |
---|
335 | then short_jump |
---|
336 | else long_jump. |
---|
337 | |
---|
338 | definition select_call_length: label_map → ppc_pc_map → ppc_pc_map → ℕ → ℕ → |
---|
339 | Identifier → jump_length ≝ |
---|
340 | λlabels.λold_sigma.λinc_sigma.λadded.λppc.λlbl. |
---|
341 | let paddr ≝ lookup_def ? ? labels lbl 0 in |
---|
342 | let addr ≝ |
---|
343 | if leb ppc paddr (* forward jump *) |
---|
344 | then \fst (bvt_lookup … (bitvector_of_nat ? paddr) (\snd old_sigma) 〈0,short_jump〉) |
---|
345 | + added |
---|
346 | else \fst (bvt_lookup … (bitvector_of_nat ? paddr) (\snd inc_sigma) 〈0,short_jump〉) in |
---|
347 | let 〈fst_5_addr, rest_addr〉 ≝ split ? 5 11 (bitvector_of_nat ? addr) in |
---|
348 | let 〈fst_5_pc, rest_pc〉 ≝ split ? 5 11 (bitvector_of_nat ? (\fst inc_sigma)) in |
---|
349 | if eq_bv ? fst_5_addr fst_5_pc |
---|
350 | then medium_jump |
---|
351 | else long_jump. |
---|
352 | |
---|
353 | definition select_jump_length: label_map → ppc_pc_map → ppc_pc_map → ℕ → ℕ → |
---|
354 | Identifier → jump_length ≝ |
---|
355 | λlabels.λold_sigma.λinc_sigma.λadded.λppc.λlbl. |
---|
356 | let paddr ≝ lookup_def … labels lbl 0 in |
---|
357 | if leb ppc paddr (* forward jump *) |
---|
358 | then |
---|
359 | let addr ≝ \fst (bvt_lookup … (bitvector_of_nat 16 paddr) (\snd old_sigma) 〈0,short_jump〉) |
---|
360 | + added in |
---|
361 | if leb (addr - \fst inc_sigma) 126 |
---|
362 | then short_jump |
---|
363 | else select_call_length labels old_sigma inc_sigma added ppc lbl |
---|
364 | else |
---|
365 | let addr ≝ \fst (bvt_lookup … (bitvector_of_nat 16 paddr) (\snd inc_sigma) 〈0,short_jump〉) in |
---|
366 | if leb (\fst inc_sigma - addr) 129 |
---|
367 | then short_jump |
---|
368 | else select_call_length labels old_sigma inc_sigma added ppc lbl. |
---|
369 | |
---|
370 | definition jump_expansion_step_instruction: label_map → ppc_pc_map → ppc_pc_map → |
---|
371 | ℕ → ℕ → preinstruction Identifier → option jump_length ≝ |
---|
372 | λlabels.λold_sigma.λinc_sigma.λadded.λppc.λi. |
---|
373 | match i with |
---|
374 | [ JC j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
375 | | JNC j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
376 | | JZ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
377 | | JNZ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
378 | | JB _ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
379 | | JBC _ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
380 | | JNB _ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
381 | | CJNE _ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
382 | | DJNZ _ j ⇒ Some ? (select_reljump_length labels old_sigma inc_sigma added ppc j) |
---|
383 | | _ ⇒ None ? |
---|
384 | ]. |
---|
385 | |
---|
386 | lemma dec_is_jump: ∀x.Sum (is_jump x) (¬is_jump x). |
---|
387 | #i cases i |
---|
388 | [#id cases id |
---|
389 | [1,2,3,6,7,33,34: |
---|
390 | #x #y %2 whd in match (is_jump ?); /2 by nmk/ |
---|
391 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32: |
---|
392 | #x %2 whd in match (is_jump ?); /2 by nmk/ |
---|
393 | |35,36,37: %2 whd in match (is_jump ?); /2 by nmk/ |
---|
394 | |9,10,14,15: #x %1 / by I/ |
---|
395 | |11,12,13,16,17: #x #y %1 / by I/ |
---|
396 | ] |
---|
397 | |2,3: #x %2 /2 by nmk/ |
---|
398 | |4,5: #x %1 / by I/ |
---|
399 | |6: #x #y %2 /2 by nmk/ |
---|
400 | ] |
---|
401 | qed. |
---|
402 | |
---|
403 | lemma geb_to_leb: ∀a,b:ℕ.geb a b = leb b a. |
---|
404 | #a #b / by refl/ |
---|
405 | qed. |
---|
406 | |
---|
407 | (* The first step of the jump expansion: everything to short. |
---|
408 | * The third condition of the dependent type implies jump_in_policy; |
---|
409 | * I've left it in for convenience of type-checking. *) |
---|
410 | definition jump_expansion_start: |
---|
411 | ∀program:(Σl:list labelled_instruction.|l| < 2^16). |
---|
412 | ∀labels:label_map. |
---|
413 | Σpolicy:option ppc_pc_map. |
---|
414 | match policy with |
---|
415 | [ None ⇒ True |
---|
416 | | Some p ⇒ |
---|
417 | And (And (out_of_program_none (pi1 ?? program) p) |
---|
418 | (jump_not_in_policy (pi1 ?? program) p)) |
---|
419 | (\fst p < 2^16) |
---|
420 | ] ≝ |
---|
421 | λprogram.λlabels. |
---|
422 | let final_policy ≝ foldl_strong (option Identifier × pseudo_instruction) |
---|
423 | (λprefix.Σpolicy:ppc_pc_map. |
---|
424 | And (out_of_program_none prefix policy) |
---|
425 | (jump_not_in_policy prefix policy)) |
---|
426 | program |
---|
427 | (λprefix.λx.λtl.λprf.λp. |
---|
428 | let 〈pc,sigma〉 ≝ p in |
---|
429 | let 〈label,instr〉 ≝ x in |
---|
430 | let isize ≝ instruction_size_jmplen short_jump instr in |
---|
431 | 〈pc + isize, |
---|
432 | match instr with |
---|
433 | [ Instruction i ⇒ match i with |
---|
434 | [ JC jmp ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
435 | | JNC _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
436 | | JZ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
437 | | JNZ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
438 | | JB _ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
439 | | JNB _ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
440 | | JBC _ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
441 | | CJNE _ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
442 | | DJNZ _ _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
443 | | _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
444 | ] |
---|
445 | | Call c ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
446 | | Jmp j ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
447 | | _ ⇒ bvt_insert … (bitvector_of_nat 16 (|prefix|)) 〈pc,short_jump〉 sigma |
---|
448 | ]〉 |
---|
449 | ) 〈0, Stub ? ?〉 in |
---|
450 | if geb (\fst final_policy) 2^16 then |
---|
451 | None ? |
---|
452 | else |
---|
453 | Some ? (pi1 ?? final_policy). |
---|
454 | [ / by I/ |
---|
455 | | lapply p -p generalize in match (foldl_strong ?????); * #p #Hp #hg |
---|
456 | @conj [ @Hp | @not_le_to_lt @leb_false_to_not_le <geb_to_leb @hg ] |
---|
457 | | @conj |
---|
458 | [ (* out_of_program_none *) |
---|
459 | #i >append_length <commutative_plus #Hi normalize in Hi; #Hi2 |
---|
460 | cases (le_to_or_lt_eq … Hi) -Hi #Hi |
---|
461 | cases p -p #p cases p -p #pc #p #Hp cases x -x #l #pi cases pi |
---|
462 | [1,7: #id cases id normalize nodelta |
---|
463 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
464 | [1,2,3,6,7,24,25: #x #y |
---|
465 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] >lookup_opt_insert_miss |
---|
466 | [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
467 | @bitvector_of_nat_abs |
---|
468 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
469 | @Hi2 |
---|
470 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
471 | @(transitive_lt … Hi2) @le_S_to_le @Hi |
---|
472 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
473 | @sym_neq @lt_to_not_eq @le_S_to_le @Hi |
---|
474 | ] |
---|
475 | ] |
---|
476 | @(proj1 ?? Hp i ? Hi2) @le_S_to_le @le_S_to_le @Hi |
---|
477 | |38,39,40,41,42,43,44,45,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74: |
---|
478 | [1,2,3,6,7,24,25: #x #y |
---|
479 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
480 | >lookup_opt_insert_miss |
---|
481 | [2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
482 | @bitvector_of_nat_abs |
---|
483 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
484 | @Hi2 |
---|
485 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
486 | @(transitive_lt … Hi2) <Hi @le_n |
---|
487 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
488 | @sym_neq @lt_to_not_eq <Hi @le_n |
---|
489 | ] |
---|
490 | ] |
---|
491 | <Hi @(proj1 ?? Hp (S (|prefix|)) (le_S ?? (le_n (|prefix|))) ?) |
---|
492 | >Hi @Hi2 |
---|
493 | |9,10,11,12,13,14,15,16,17: |
---|
494 | [1,2,6,7: #x |3,4,5,8,9: #x #id] >lookup_opt_insert_miss |
---|
495 | [2,4,6,8,10,12,14,16,18: @bitvector_of_nat_abs |
---|
496 | [1,4,7,10,13,16,19,22,25: @Hi2 |
---|
497 | |2,5,8,11,14,17,20,23,26: @(transitive_lt … Hi2) @le_S_to_le @Hi |
---|
498 | |3,6,9,12,15,18,21,24,27: @sym_neq @lt_to_not_eq @le_S_to_le @Hi |
---|
499 | ] |
---|
500 | |1,3,5,7,9,11,13,15,17: |
---|
501 | @(proj1 ?? Hp i ? Hi2) @le_S_to_le @le_S_to_le @Hi |
---|
502 | ] |
---|
503 | |46,47,48,49,50,51,52,53,54: |
---|
504 | [1,2,6,7: #x |3,4,5,8,9: #x #id] >lookup_opt_insert_miss |
---|
505 | [2,4,6,8,10,12,14,16,18: @bitvector_of_nat_abs |
---|
506 | [1,4,7,10,13,16,19,22,25: @Hi2 |
---|
507 | |2,5,8,11,14,17,20,23,26: @(transitive_lt … Hi2) <Hi @le_n |
---|
508 | |3,6,9,12,15,18,21,24,27: @sym_neq @lt_to_not_eq <Hi @le_n |
---|
509 | ] |
---|
510 | |1,3,5,7,9,11,13,15,17: |
---|
511 | @(proj1 ?? Hp i ? Hi2) <Hi @le_S @le_n |
---|
512 | ] |
---|
513 | ] |
---|
514 | |2,3,6,8,9,12: [3,6: #w] #z >lookup_opt_insert_miss |
---|
515 | [2,4,6,8,10,12: @bitvector_of_nat_abs |
---|
516 | [1,4,7,10,13,16: @Hi2 |
---|
517 | |2,8,11: @(transitive_lt … Hi2) @le_S_to_le @Hi |
---|
518 | |5,14,17: @(transitive_lt … Hi2) <Hi @le_n |
---|
519 | |3,9,12: @sym_neq @lt_to_not_eq @le_S_to_le @Hi |
---|
520 | |6,15,18: <Hi @sym_neq @lt_to_not_eq @le_n |
---|
521 | ] |
---|
522 | ] |
---|
523 | [1,3,4: @(proj1 ?? Hp i ? Hi2) @le_S_to_le @le_S_to_le @Hi |
---|
524 | |2,5,6: |
---|
525 | <Hi @(proj1 ?? Hp (S (|prefix|)) (le_S ?? (le_n (|prefix|))) ?) |
---|
526 | >Hi @Hi2 |
---|
527 | ] |
---|
528 | |4,5,10,11: #dst normalize nodelta >lookup_opt_insert_miss |
---|
529 | [2,4,6,8: @bitvector_of_nat_abs |
---|
530 | [1,4,7,10: @Hi2 |
---|
531 | |2,5: @(transitive_lt … Hi2) @le_S_to_le @Hi |
---|
532 | |8,11: @(transitive_lt … Hi2) <Hi @le_n |
---|
533 | |3,6: @sym_neq @lt_to_not_eq @le_S_to_le @Hi |
---|
534 | |9,12: @sym_neq @lt_to_not_eq <Hi @le_n |
---|
535 | ] |
---|
536 | |1,3: @(proj1 ?? Hp i ? Hi2) @le_S_to_le @le_S_to_le @Hi |
---|
537 | |5,7: @(proj1 ?? Hp i ? Hi2) <Hi @le_S @le_n |
---|
538 | ] |
---|
539 | ] |
---|
540 | | (* jump_not_in_policy *) #i >append_length <commutative_plus |
---|
541 | #Hi normalize in Hi; cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
542 | [ cases p -p #p cases p -p #pc #sigma #Hp cases x #l #ins cases ins |
---|
543 | [ #pi cases pi normalize nodelta |
---|
544 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
545 | [1,2,3,6,7,24,25: #x #y |
---|
546 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] >lookup_insert_miss |
---|
547 | [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55: |
---|
548 | >(nth_append_first ? i prefix ?? Hi) @((proj2 ?? Hp) i Hi) |
---|
549 | |2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
550 | @bitvector_of_nat_abs |
---|
551 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
552 | @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
553 | @le_plus_a @Hi |
---|
554 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
555 | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
556 | @le_plus_n_r |
---|
557 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
558 | @lt_to_not_eq @Hi |
---|
559 | ] |
---|
560 | ] |
---|
561 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] >lookup_insert_miss |
---|
562 | [1,3,5,7,9,11,13,15,17: |
---|
563 | >(nth_append_first ? i prefix ?? Hi) @((proj2 ?? Hp) i Hi) |
---|
564 | |2,4,6,8,10,12,14,16,18: |
---|
565 | @bitvector_of_nat_abs |
---|
566 | [1,4,7,10,13,16,19,22,25: |
---|
567 | @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
568 | @le_plus_a @Hi |
---|
569 | |2,5,8,11,14,17,20,23,26: |
---|
570 | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
571 | @le_plus_n_r |
---|
572 | |3,6,9,12,15,18,21,24,27: |
---|
573 | @lt_to_not_eq @Hi |
---|
574 | ] |
---|
575 | ] |
---|
576 | ] |
---|
577 | |2,3,4,5,6: #x [5: #y] >lookup_insert_miss |
---|
578 | [1,3,5,7,9: |
---|
579 | >(nth_append_first ? i prefix ?? Hi) @((proj2 ?? Hp) i Hi) |
---|
580 | |2,4,6,8,10: |
---|
581 | @bitvector_of_nat_abs |
---|
582 | [1,4,7,10,13: |
---|
583 | @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
584 | @le_plus_a @Hi |
---|
585 | |2,5,8,11,14: |
---|
586 | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
587 | @le_plus_n_r |
---|
588 | |3,6,9,12,15: |
---|
589 | @lt_to_not_eq @Hi |
---|
590 | ] |
---|
591 | ] |
---|
592 | ] |
---|
593 | | >Hi >nth_append_second [2: @le_n] <minus_n_n whd in match (nth ????); |
---|
594 | cases p -p #p cases p -p #pc #sigma #Hp cases x #lbl #ins cases ins |
---|
595 | normalize nodelta |
---|
596 | [2,3,6: #x [3: #y] >lookup_insert_hit #_ / by / |
---|
597 | |4,5: #x #H @⊥ cases H #H2 @H2 / by I/ |
---|
598 | |1: #pi cases pi |
---|
599 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
600 | [1,2,3,6,7,24,25: #x #y |
---|
601 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
602 | #_ >lookup_insert_hit / by / |
---|
603 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
604 | #H @⊥ cases H #H2 @H2 / by I/ |
---|
605 | ] |
---|
606 | ] |
---|
607 | ] |
---|
608 | ] |
---|
609 | | @conj |
---|
610 | [ #i #_ #Hi2 / by refl/ |
---|
611 | | #i #H @⊥ @(absurd … H) @not_le_Sn_O |
---|
612 | ] |
---|
613 | ] |
---|
614 | qed. |
---|
615 | |
---|
616 | definition policy_equal ≝ |
---|
617 | λprogram:list labelled_instruction.λp1,p2:ppc_pc_map. |
---|
618 | (* \fst p1 = \fst p2 ∧ *) |
---|
619 | (∀n:ℕ.n < |program| → |
---|
620 | let pc1 ≝ bvt_lookup … (bitvector_of_nat 16 n) (\snd p1) 〈0,short_jump〉 in |
---|
621 | let pc2 ≝ bvt_lookup … (bitvector_of_nat 16 n) (\snd p2) 〈0,short_jump〉 in |
---|
622 | \snd pc1 = \snd pc2). |
---|
623 | |
---|
624 | (*definition nec_plus_ultra ≝ |
---|
625 | λprogram:list labelled_instruction.λp:ppc_pc_mapjump_expansion_policy. |
---|
626 | ¬(∀i.i < |program| → \snd (bvt_lookup … (bitvector_of_nat 16 i) (\snd p) 〈0,0,short_jump〉) = long_jump). *) |
---|
627 | |
---|
628 | (*include alias "common/Identifiers.ma".*) |
---|
629 | include alias "ASM/BitVector.ma". |
---|
630 | include alias "basics/lists/list.ma". |
---|
631 | include alias "arithmetics/nat.ma". |
---|
632 | include alias "basics/logic.ma". |
---|
633 | |
---|
634 | lemma blerpque: ∀a,b,i. |
---|
635 | is_jump i → instruction_size_jmplen (max_length a b) i = instruction_size_jmplen a i → |
---|
636 | (max_length a b) = a. |
---|
637 | #a #b #i cases i |
---|
638 | [1: #pi cases pi |
---|
639 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
640 | [1,2,3,6,7,24,25: #x #y |
---|
641 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
642 | #H cases H |
---|
643 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
644 | #_ cases a cases b |
---|
645 | [1,5,7,8,9: #_ / by refl/ |
---|
646 | |10,14,16,17,18: #_ / by refl/ |
---|
647 | |19,23,25,26,27: #_ / by refl/ |
---|
648 | |28,32,34,35,36: #_ / by refl/ |
---|
649 | |37,41,43,44,45: #_ / by refl/ |
---|
650 | |46,50,52,53,54: #_ / by refl/ |
---|
651 | |55,59,61,62,63: #_ / by refl/ |
---|
652 | |64,68,70,71,72: #_ / by refl/ |
---|
653 | |73,77,79,80,81: #_ / by refl/ |
---|
654 | |2,3,4,6: cases x #a cases a |
---|
655 | [1,2,3,4,8,9,16,17,18,19: #b #Hb cases Hb |
---|
656 | |20,21,22,23,27,28,35,36,37,38: #b #Hb cases Hb |
---|
657 | |39,40,41,42,46,47,54,55,56,57: #b #Hb cases Hb |
---|
658 | |58,59,60,61,65,66,73,74,75,76: #b #Hb cases Hb |
---|
659 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
660 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
661 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
662 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
663 | |15,34,53,72: #b #Hb #H normalize in H; destruct (H) |
---|
664 | ] |
---|
665 | |11,12,13,15: cases x #a cases a |
---|
666 | [1,2,3,4,8,9,16,17,18,19: #b #Hb cases Hb |
---|
667 | |20,21,22,23,27,28,35,36,37,38: #b #Hb cases Hb |
---|
668 | |39,40,41,42,46,47,54,55,56,57: #b #Hb cases Hb |
---|
669 | |58,59,60,61,65,66,73,74,75,76: #b #Hb cases Hb |
---|
670 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
671 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
672 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
673 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
674 | |15,34,53,72: #b #Hb #H normalize in H; destruct (H) |
---|
675 | ] |
---|
676 | |20,21,22,24: cases x #a cases a |
---|
677 | [1,2,3,4,8,9,16,17,18,19: #b #Hb cases Hb |
---|
678 | |20,21,22,23,27,28,35,36,37,38: #b #Hb cases Hb |
---|
679 | |39,40,41,42,46,47,54,55,56,57: #b #Hb cases Hb |
---|
680 | |58,59,60,61,65,66,73,74,75,76: #b #Hb cases Hb |
---|
681 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
682 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
683 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
684 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
685 | |15,34,53,72: #b #Hb #H normalize in H; destruct (H) |
---|
686 | ] |
---|
687 | |29,30,31,33: cases x #a cases a #a1 #a2 |
---|
688 | [1,3,5,7: cases a2 #b cases b |
---|
689 | [2,3,4,9,15,16,17,18,19: #b #Hb cases Hb |
---|
690 | |21,22,23,28,34,35,36,37,38: #b #Hb cases Hb |
---|
691 | |40,41,42,47,53,54,55,56,57: #b #Hb cases Hb |
---|
692 | |59,60,61,66,72,73,74,75,76: #b #Hb cases Hb |
---|
693 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
694 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
695 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
696 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
697 | |1,8: #b #Hb #H normalize in H; destruct (H) |
---|
698 | |20,27: #b #Hb #H normalize in H; destruct (H) |
---|
699 | |39,46: #b #Hb #H normalize in H; destruct (H) |
---|
700 | |58,65: #b #Hb #H normalize in H; destruct (H) |
---|
701 | ] |
---|
702 | |2,4,6,8: cases a1 #b cases b |
---|
703 | [1,3,8,9,15,16,17,18,19: #b #Hb cases Hb |
---|
704 | |20,22,27,28,34,35,36,37,38: #b #Hb cases Hb |
---|
705 | |39,41,46,47,53,54,55,56,57: #b #Hb cases Hb |
---|
706 | |58,60,65,66,72,73,74,75,76: #b #Hb cases Hb |
---|
707 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
708 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
709 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
710 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
711 | |2,4: #b #Hb #H normalize in H; destruct (H) |
---|
712 | |21,23: #b #Hb #H normalize in H; destruct (H) |
---|
713 | |40,42: #b #Hb #H normalize in H; destruct (H) |
---|
714 | |59,61: #b #Hb #H normalize in H; destruct (H) |
---|
715 | ] |
---|
716 | ] |
---|
717 | |38,39,40,42: cases x #a cases a |
---|
718 | [2,3,8,9,15,16,17,18,19: #b #Hb cases Hb |
---|
719 | |21,22,27,28,34,35,36,37,38: #b #Hb cases Hb |
---|
720 | |40,41,46,47,53,54,55,56,57: #b #Hb cases Hb |
---|
721 | |59,60,65,66,72,73,74,75,76: #b #Hb cases Hb |
---|
722 | |5,6,7,10,11,12,13,14: #Hb cases Hb |
---|
723 | |24,25,26,29,30,31,32,33: #Hb cases Hb |
---|
724 | |43,44,45,48,49,50,51,52: #Hb cases Hb |
---|
725 | |62,63,64,67,68,69,70,71: #Hb cases Hb |
---|
726 | |1,4: #b #Hb #H normalize in H; destruct (H) |
---|
727 | |20,23: #b #Hb #H normalize in H; destruct (H) |
---|
728 | |39,42: #b #Hb #H normalize in H; destruct (H) |
---|
729 | |58,61: #b #Hb #H normalize in H; destruct (H) |
---|
730 | ] |
---|
731 | |47,48,49,51: cases x #a #H normalize in H; destruct (H) |
---|
732 | |56,57,58,60: cases x #a #H normalize in H; destruct (H) |
---|
733 | |65,66,67,69: cases x #a #H normalize in H; destruct (H) |
---|
734 | |74,75,76,78: cases x #a #H normalize in H; destruct (H) |
---|
735 | ] |
---|
736 | ] |
---|
737 | |2,3,6: #x [3: #y] #H cases H |
---|
738 | |4,5: #id #_ cases a cases b |
---|
739 | [2,3,4,6,11,12,13,15: normalize #H destruct (H) |
---|
740 | |1,5,7,8,9,10,14,16,17,18: #H / by refl/ |
---|
741 | ] |
---|
742 | ] |
---|
743 | qed. |
---|
744 | |
---|
745 | lemma etblorp: ∀a,b,i.is_jump i → |
---|
746 | instruction_size_jmplen a i ≤ instruction_size_jmplen (max_length a b) i. |
---|
747 | #a #b #i cases i |
---|
748 | [2,3,6: #x [3: #y] #H cases H |
---|
749 | |4,5: #id #_ cases a cases b / by le_n/ |
---|
750 | |1: #pi cases pi |
---|
751 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
752 | [1,2,3,6,7,24,25: #x #y |
---|
753 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
754 | #H cases H |
---|
755 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
756 | #_ cases a cases b |
---|
757 | [2,3: cases x #ad cases ad |
---|
758 | [15,34: #b #Hb / by le_n/ |
---|
759 | |1,2,3,4,8,9,16,17,18,19,20,21,22,23,27,28,35,36,37,38: #b] #Hb cases Hb |
---|
760 | |1,4,5,6,7,8,9: / by le_n/ |
---|
761 | |11,12: cases x #ad cases ad |
---|
762 | [15,34: #b #Hb / by le_n/ |
---|
763 | |1,2,3,4,8,9,16,17,18,19,20,21,22,23,27,28,35,36,37,38: #b] #Hb cases Hb |
---|
764 | |10,13,14,15,16,17,18: / by le_n/ |
---|
765 | |20,21: cases x #ad cases ad |
---|
766 | [15,34: #b #Hb / by le_n/ |
---|
767 | |1,2,3,4,8,9,16,17,18,19,20,21,22,23,27,28,35,36,37,38: #b] #Hb cases Hb |
---|
768 | |19,22,23,24,25,26,27: / by le_n/ |
---|
769 | |29,30: cases x #ad cases ad #a1 #a2 |
---|
770 | [ cases a2 #ad2 cases ad2 |
---|
771 | ] |
---|
772 | ] |
---|
773 | ] |
---|
774 | ] |
---|
775 | cases daemon (* XXX see if it works first *) |
---|
776 | qed. |
---|
777 | |
---|
778 | lemma minus_zero_to_le: ∀n,m:ℕ.n - m = 0 → n ≤ m. |
---|
779 | #n |
---|
780 | elim n |
---|
781 | [ #m #_ @le_O_n |
---|
782 | | #n' #Hind #m cases m |
---|
783 | [ #H -n whd in match (minus ??) in H; >H @le_n |
---|
784 | | #m' -m #H whd in match (minus ??) in H; @le_S_S @Hind @H |
---|
785 | ] |
---|
786 | ] |
---|
787 | qed. |
---|
788 | |
---|
789 | lemma plus_zero_zero: ∀n,m:ℕ.n + m = 0 → m = 0. |
---|
790 | #n #m #Hn @sym_eq @le_n_O_to_eq <Hn >commutative_plus @le_plus_n_r |
---|
791 | qed. |
---|
792 | |
---|
793 | (* One step in the search for a jump expansion fixpoint. *) |
---|
794 | definition jump_expansion_step: ∀program:(Σl:list labelled_instruction.|l| < 2^16). |
---|
795 | ∀labels:(Σlm:label_map. ∀i:ℕ.lt i (|program|) → |
---|
796 | ∀l.occurs_exactly_once ?? l program → |
---|
797 | is_label (nth i ? program 〈None ?, Comment [ ]〉) l → |
---|
798 | lookup … lm l = Some ? i). |
---|
799 | ∀old_policy:(Σpolicy:ppc_pc_map. |
---|
800 | And (And (out_of_program_none program policy) |
---|
801 | (jump_not_in_policy program policy)) |
---|
802 | (\fst policy < 2^16)). |
---|
803 | (Σx:bool × (option ppc_pc_map). |
---|
804 | let 〈no_ch,y〉 ≝ x in |
---|
805 | match y with |
---|
806 | [ None ⇒ (* nec_plus_ultra program old_policy *) True |
---|
807 | | Some p ⇒ And (And (And (And (And (out_of_program_none program p) |
---|
808 | (jump_not_in_policy program p)) |
---|
809 | (policy_increase program old_policy p)) |
---|
810 | (policy_compact program labels p)) |
---|
811 | (no_ch = true → policy_equal program old_policy p)) |
---|
812 | (\fst p < 2^16) |
---|
813 | ]) |
---|
814 | ≝ |
---|
815 | λprogram.λlabels.λold_sigma. |
---|
816 | let 〈final_added, final_policy〉 ≝ |
---|
817 | foldl_strong (option Identifier × pseudo_instruction) |
---|
818 | (λprefix.Σx:ℕ × ppc_pc_map. |
---|
819 | let 〈added,policy〉 ≝ x in |
---|
820 | And (And (And (And (out_of_program_none prefix policy) |
---|
821 | (jump_not_in_policy prefix policy)) |
---|
822 | (policy_increase prefix old_sigma policy)) |
---|
823 | (policy_compact prefix labels policy)) |
---|
824 | (added = 0 → policy_equal prefix old_sigma policy)) |
---|
825 | program |
---|
826 | (λprefix.λx.λtl.λprf.λacc. |
---|
827 | let 〈inc_added, inc_pc_sigma〉 ≝ (pi1 ?? acc) in |
---|
828 | let 〈label,instr〉 ≝ x in |
---|
829 | (* Now, we must add the current ppc and its pc translation. |
---|
830 | * Three possibilities: |
---|
831 | * - Instruction is not a jump; i.e. constant size whatever the sigma we use; |
---|
832 | * - Instruction is a backward jump; we can use the sigma we're constructing, |
---|
833 | * since it will already know the translation of its destination; |
---|
834 | * - Instruction is a forward jump; we must use the old sigma (the new sigma |
---|
835 | * does not know the translation yet), but compensate for the jumps we |
---|
836 | * have lengthened. |
---|
837 | *) |
---|
838 | let add_instr ≝ match instr with |
---|
839 | [ Jmp j ⇒ Some ? (select_jump_length labels old_sigma inc_pc_sigma inc_added (|prefix|) j) |
---|
840 | | Call c ⇒ Some ? (select_call_length labels old_sigma inc_pc_sigma inc_added (|prefix|) c) |
---|
841 | | Instruction i ⇒ jump_expansion_step_instruction labels old_sigma inc_pc_sigma inc_added (|prefix|) i |
---|
842 | | _ ⇒ None ? |
---|
843 | ] in |
---|
844 | let 〈inc_pc, inc_sigma〉 ≝ inc_pc_sigma in |
---|
845 | let 〈old_pc,old_length〉 ≝ bvt_lookup … (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉 in |
---|
846 | let old_size ≝ instruction_size_jmplen old_length instr in |
---|
847 | let 〈new_length, isize〉 ≝ match add_instr with |
---|
848 | [ None ⇒ 〈short_jump, instruction_size_jmplen short_jump instr〉 |
---|
849 | | Some pl ⇒ 〈max_length old_length pl, instruction_size_jmplen (max_length old_length pl) instr〉 |
---|
850 | ] in |
---|
851 | let new_added ≝ match add_instr with |
---|
852 | [ None ⇒ inc_added |
---|
853 | | Some x ⇒ plus inc_added (minus isize old_size) |
---|
854 | ] in |
---|
855 | 〈new_added, 〈plus inc_pc isize, bvt_insert … (bitvector_of_nat ? (|prefix|)) 〈inc_pc, new_length〉 inc_sigma〉〉 |
---|
856 | ) 〈0, 〈0, Stub ??〉〉 in |
---|
857 | if geb (\fst final_policy) 2^16 then |
---|
858 | 〈eqb final_added 0, None ?〉 |
---|
859 | else |
---|
860 | 〈eqb final_added 0, Some ? final_policy〉. |
---|
861 | [ / by I/ |
---|
862 | | normalize nodelta lapply p generalize in match (foldl_strong ?????); * #x #H #H2 |
---|
863 | >H2 in H; normalize nodelta -H2 -x #H @conj |
---|
864 | [ @conj |
---|
865 | [ @(proj1 ?? H) |
---|
866 | | #H2 @(proj2 ?? H) @eqb_true_to_eq @H2 |
---|
867 | ] |
---|
868 | | @not_le_to_lt @leb_false_to_not_le <geb_to_leb @p1 |
---|
869 | ] |
---|
870 | | lapply (pi2 ?? acc) >p cases inc_pc_sigma #inc_pc #inc_sigma |
---|
871 | lapply (refl ? (bvt_lookup … (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉)) |
---|
872 | cases (bvt_lookup … (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉) in ⊢ (???% → %); |
---|
873 | #old_pc #old_length #Holdeq #Hpolicy @pair_elim #added #policy normalize nodelta |
---|
874 | @pair_elim #new_length #isize normalize nodelta #Heq1 #Heq2 |
---|
875 | @conj [ @conj [ @conj [ @conj |
---|
876 | [ (* out_of_program_none *) #i >append_length <commutative_plus #Hi normalize in Hi; #Hi2 |
---|
877 | cases instr in Heq2; normalize nodelta |
---|
878 | #x [6: #y] #H <(proj2 ?? (pair_destruct ?????? H)) >lookup_opt_insert_miss |
---|
879 | [1,3,5,7,9,11: @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))) i ? Hi2) |
---|
880 | @le_S_to_le @Hi |
---|
881 | |2,4,6,8,10,12: @bitvector_of_nat_abs |
---|
882 | [1,4,7,10,13,16: @Hi2 |
---|
883 | |2,5,8,11,14,17: @(transitive_lt … Hi2) @Hi |
---|
884 | |3,6,9,12,15,18: @sym_neq @lt_to_not_eq @Hi |
---|
885 | ] |
---|
886 | ] |
---|
887 | | (* jump_not_in_policy *) #i >append_length <commutative_plus #Hi normalize in Hi; |
---|
888 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
889 | [ <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_miss |
---|
890 | [ >(nth_append_first ? i prefix ?? Hi) |
---|
891 | @(proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))) i Hi) |
---|
892 | | @bitvector_of_nat_abs |
---|
893 | [ @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
894 | @le_plus_a @Hi |
---|
895 | | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
896 | @le_plus_n_r |
---|
897 | | @lt_to_not_eq @Hi |
---|
898 | ] |
---|
899 | ] |
---|
900 | | >Hi <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_hit |
---|
901 | >nth_append_second |
---|
902 | [ <minus_n_n whd in match (nth ????); cases instr in Heq1; |
---|
903 | [4,5: #x #_ #H cases H #H2 @⊥ @H2 / by I/ |
---|
904 | |2,3,6: #x [3: #y] #Heq1 <(proj1 ?? (pair_destruct ?????? Heq1)) #_ / by / |
---|
905 | |1: #pi cases pi |
---|
906 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
907 | [1,2,3,6,7,24,25: #x #y |
---|
908 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] #Heq1 |
---|
909 | <(proj1 ?? (pair_destruct ?????? Heq1)) #_ / by / |
---|
910 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
911 | #_ #H @⊥ cases H #H2 @H2 / by I/ |
---|
912 | ] |
---|
913 | ] |
---|
914 | | @le_n |
---|
915 | ] |
---|
916 | ] |
---|
917 | ] |
---|
918 | | (* policy_increase *) #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
919 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi; #Hi |
---|
920 | [ lapply (proj2 ?? (proj1 ?? (proj1 ?? Hpolicy)) i Hi) |
---|
921 | <(proj2 ?? (pair_destruct ?????? Heq2)) |
---|
922 | @pair_elim #opc #oj #EQ1 >lookup_insert_miss |
---|
923 | [ @pair_elim #pc #j #EQ2 / by / |
---|
924 | | @bitvector_of_nat_abs |
---|
925 | [ @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus @le_plus_a |
---|
926 | @Hi |
---|
927 | | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S @le_plus_n_r |
---|
928 | | @lt_to_not_eq @Hi |
---|
929 | ] |
---|
930 | ] |
---|
931 | | >Hi <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_hit |
---|
932 | cases (dec_is_jump instr) |
---|
933 | [ cases instr in Heq1; normalize nodelta |
---|
934 | [ #pi cases pi |
---|
935 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
936 | [1,2,3,6,7,24,25: #x #y |
---|
937 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] #_ #Hj cases Hj |
---|
938 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
939 | whd in match jump_expansion_step_instruction; normalize nodelta #Heq1 |
---|
940 | <(proj1 ?? (pair_destruct ?????? Heq1)) #_ >Holdeq normalize nodelta |
---|
941 | @jmpleq_max_length |
---|
942 | ] |
---|
943 | |2,3,6: #x [3: #y] #_ #Hj cases Hj |
---|
944 | |4,5: #x #Heq1 #_ <(proj1 ?? (pair_destruct ?????? Heq1)) >Holdeq normalize nodelta |
---|
945 | @jmpleq_max_length |
---|
946 | ] |
---|
947 | | lapply Heq1 -Heq1; lapply (refl ? instr); cases instr in ⊢ (???% → %); normalize nodelta |
---|
948 | [ #pi cases pi |
---|
949 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
950 | [1,2,3,6,7,24,25: #x #y |
---|
951 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
952 | whd in match jump_expansion_step_instruction; normalize nodelta #Heqi #Heq1 |
---|
953 | #Hj <(proj1 ?? (pair_destruct ?????? Heq1)) |
---|
954 | lapply (proj2 ?? (proj1 ?? (pi2 ?? old_sigma)) (|prefix|) ??) |
---|
955 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
956 | >prf >nth_append_second |
---|
957 | [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55: |
---|
958 | <minus_n_n whd in match (nth ????); >p1 >Heqi @Hj |
---|
959 | |2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
960 | @le_n |
---|
961 | ] |
---|
962 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
963 | >prf >append_length <plus_n_Sm @le_S_S @le_plus_n_r |
---|
964 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
965 | cases (lookup ?? (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉) |
---|
966 | #a #b #H >H normalize nodelta %2 @refl |
---|
967 | ] |
---|
968 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] |
---|
969 | #_ #_ #abs cases abs #ABS @⊥ @ABS / by I/ |
---|
970 | ] |
---|
971 | |2,3,6: #x [3: #y] #Heqi #Heq1 #Hj <(proj1 ?? (pair_destruct ?????? Heq1)) |
---|
972 | lapply (proj2 ?? (proj1 ?? (pi2 ?? old_sigma)) (|prefix|) ??) |
---|
973 | [1,4,7: >prf >nth_append_second |
---|
974 | [1,3,5: <minus_n_n whd in match (nth ????); >p1 >Heqi @Hj |
---|
975 | |2,4,6: @le_n |
---|
976 | ] |
---|
977 | |2,5,8: >prf >append_length <plus_n_Sm @le_S_S @le_plus_n_r |
---|
978 | |3,6,9: cases (lookup ?? (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉) |
---|
979 | #a #b #H >H normalize nodelta %2 @refl |
---|
980 | ] |
---|
981 | |4,5: #x #_ #_ #abs cases abs #ABS @⊥ @ABS / by I/ |
---|
982 | ] |
---|
983 | ] |
---|
984 | ] |
---|
985 | ] |
---|
986 | | (* policy_compact *) (*XXX*) cases daemon |
---|
987 | ] |
---|
988 | | (* added = 0 → policy_equal *) lapply (proj2 ?? Hpolicy) |
---|
989 | lapply Heq2 -Heq2 lapply Heq1 -Heq1 lapply (refl ? instr) |
---|
990 | cases instr in ⊢ (???% → % → % → %); normalize nodelta |
---|
991 | [ #pi cases pi normalize nodelta |
---|
992 | [1,2,3,4,5,6,7,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37: |
---|
993 | [1,2,3,6,7,24,25: #x #y |
---|
994 | |4,5,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23: #x] |
---|
995 | #Hins #Heq1 #Heq2 #Hold <(proj1 ?? (pair_destruct ?????? Heq2)) #Hadded |
---|
996 | #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
997 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
998 | [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55: |
---|
999 | <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_miss |
---|
1000 | [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55: |
---|
1001 | @(Hold Hadded i Hi) |
---|
1002 | |2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
1003 | @bitvector_of_nat_abs |
---|
1004 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
1005 | @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
1006 | @le_plus_a @Hi |
---|
1007 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
1008 | @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
1009 | @le_plus_n_r |
---|
1010 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
1011 | @lt_to_not_eq @Hi |
---|
1012 | ] |
---|
1013 | ] |
---|
1014 | |2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
1015 | <(proj2 ?? (pair_destruct ?????? Heq2)) >Hi >lookup_insert_hit |
---|
1016 | lapply (proj2 ?? (proj1 ?? (pi2 ?? old_sigma)) (|prefix|) ??) |
---|
1017 | [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,61,64,67,70,73,76,79,82: |
---|
1018 | >prf >nth_append_second |
---|
1019 | [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55: |
---|
1020 | <minus_n_n whd in match (nth ????); >p1 >Hins @nmk #H @H |
---|
1021 | |2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56: |
---|
1022 | @le_n |
---|
1023 | ] |
---|
1024 | |2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47,50,53,56,59,62,65,68,71,74,77,80,83: |
---|
1025 | >prf >append_length <plus_n_Sm @le_S_S @le_plus_n_r |
---|
1026 | |3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57,60,63,66,69,72,75,78,81,84: |
---|
1027 | cases (bvt_lookup … (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉) |
---|
1028 | #a #b #H >H <(proj1 ?? (pair_destruct ?????? Heq1)) normalize nodelta @refl |
---|
1029 | ] |
---|
1030 | ] |
---|
1031 | |9,10,11,12,13,14,15,16,17: #x [3,4,5,8,9: #y] #Hins #Heq1 #Heq2 #Hold |
---|
1032 | <(proj1 ?? (pair_destruct ?????? Heq2)) <(proj2 ?? (pair_destruct ?????? Heq1)) |
---|
1033 | #H #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1034 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
1035 | [1,3,5,7,9,11,13,15,17: <(proj2 ?? (pair_destruct ?????? Heq2)) |
---|
1036 | >lookup_insert_miss |
---|
1037 | [1,3,5,7,9,11,13,15,17: @(Hold ? i Hi) |
---|
1038 | [1,2,3,4,5,6,7,8,9: @sym_eq @le_n_O_to_eq <H @le_plus_n_r] |
---|
1039 | ] |
---|
1040 | @bitvector_of_nat_abs |
---|
1041 | [1,4,7,10,13,16,19,22,25: @(transitive_lt … (pi2 ?? program)) >prf |
---|
1042 | >append_length >commutative_plus @le_plus_a @Hi |
---|
1043 | |2,5,8,11,14,17,20,23,26: @(transitive_lt … (pi2 ?? program)) >prf |
---|
1044 | >append_length <plus_n_Sm @le_S_S |
---|
1045 | |3,6,9,12,15,18,21,24,27: @lt_to_not_eq @Hi |
---|
1046 | ] @le_plus_n_r |
---|
1047 | |2,4,6,8,10,12,14,16,18: <(proj2 ?? (pair_destruct ?????? Heq2)) >Hi |
---|
1048 | >lookup_insert_hit <(proj1 ?? (pair_destruct ?????? Heq1)) |
---|
1049 | >Holdeq normalize nodelta @sym_eq @blerpque |
---|
1050 | [3,6,9,12,15,18,21,24,27: |
---|
1051 | elim (le_to_or_lt_eq … (minus_zero_to_le … (plus_zero_zero … H))) |
---|
1052 | [1,3,5,7,9,11,13,15,17: #H @⊥ @(absurd ? H) @le_to_not_lt @etblorp |
---|
1053 | |2,4,6,8,10,12,14,16,18: #H @H |
---|
1054 | ] |
---|
1055 | / by I/ |
---|
1056 | |2,5,8,11,14,17,20,23,26: / by I/ |
---|
1057 | ] |
---|
1058 | ] |
---|
1059 | ] |
---|
1060 | |2,3,6: #x [3: #y] #Hins #Heq1 #Heq2 #Hold <(proj1 ?? (pair_destruct ?????? Heq2)) |
---|
1061 | #Hadded #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1062 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
1063 | [1,3,5: <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_miss |
---|
1064 | [1,3,5: @(Hold Hadded i Hi) |
---|
1065 | |2,4,6: @bitvector_of_nat_abs |
---|
1066 | [1,4,7: @(transitive_lt … (pi2 ?? program)) >prf >append_length >commutative_plus |
---|
1067 | @le_plus_a @Hi |
---|
1068 | |2,5,8: @(transitive_lt … (pi2 ?? program)) >prf >append_length <plus_n_Sm @le_S_S |
---|
1069 | @le_plus_n_r |
---|
1070 | |3,6,9: @lt_to_not_eq @Hi |
---|
1071 | ] |
---|
1072 | ] |
---|
1073 | |2,4,6: <(proj2 ?? (pair_destruct ?????? Heq2)) >Hi >lookup_insert_hit |
---|
1074 | lapply (proj2 ?? (proj1 ?? (pi2 ?? old_sigma)) (|prefix|) ??) |
---|
1075 | [1,4,7: >prf >nth_append_second |
---|
1076 | [1,3,5: <minus_n_n whd in match (nth ????); >p1 >Hins @nmk #H @H |
---|
1077 | |2,4,6: @le_n |
---|
1078 | ] |
---|
1079 | |2,5,8: >prf >append_length <plus_n_Sm @le_S_S @le_plus_n_r |
---|
1080 | |3,6,9: cases (bvt_lookup … (bitvector_of_nat ? (|prefix|)) (\snd old_sigma) 〈0,short_jump〉) |
---|
1081 | #a #b #H >H <(proj1 ?? (pair_destruct ?????? Heq1)) normalize nodelta @refl |
---|
1082 | ] |
---|
1083 | ] |
---|
1084 | |4,5: #x #Hins #Heq1 #Heq2 #Hold |
---|
1085 | <(proj1 ?? (pair_destruct ?????? Heq2)) <(proj2 ?? (pair_destruct ?????? Heq1)) |
---|
1086 | #H #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1087 | cases (le_to_or_lt_eq … (le_S_S_to_le … Hi)) -Hi #Hi |
---|
1088 | [1,3: <(proj2 ?? (pair_destruct ?????? Heq2)) >lookup_insert_miss |
---|
1089 | [1,3: @(Hold ? i Hi) |
---|
1090 | [1,2: @sym_eq @le_n_O_to_eq <H @le_plus_n_r] |
---|
1091 | ] |
---|
1092 | @bitvector_of_nat_abs |
---|
1093 | [1,4: @(transitive_lt … (pi2 ?? program)) >prf |
---|
1094 | >append_length >commutative_plus @le_plus_a @Hi |
---|
1095 | |2,5: @(transitive_lt … (pi2 ?? program)) >prf |
---|
1096 | >append_length <plus_n_Sm @le_S_S |
---|
1097 | |3,6: @lt_to_not_eq @Hi |
---|
1098 | ] @le_plus_n_r |
---|
1099 | |2,4: <(proj2 ?? (pair_destruct ?????? Heq2)) >Hi >lookup_insert_hit |
---|
1100 | <(proj1 ?? (pair_destruct ?????? Heq1))>Holdeq normalize nodelta |
---|
1101 | @sym_eq @blerpque |
---|
1102 | [3,6: elim (le_to_or_lt_eq … (minus_zero_to_le … (plus_zero_zero … H))) |
---|
1103 | [1,3: #H @⊥ @(absurd ? H) @le_to_not_lt @etblorp |
---|
1104 | |2,4: #H @H |
---|
1105 | ] |
---|
1106 | / by I/ |
---|
1107 | |2,5: / by I/ |
---|
1108 | ] |
---|
1109 | ] |
---|
1110 | ] |
---|
1111 | ] |
---|
1112 | | normalize nodelta @conj [ @conj [ @conj [ @conj |
---|
1113 | [ #i #Hi / by refl/ |
---|
1114 | | / by refl/ |
---|
1115 | ]]]] |
---|
1116 | [3: #_] |
---|
1117 | #i #Hi @⊥ @(absurd ? Hi) @not_le_Sn_O |
---|
1118 | ] |
---|
1119 | qed. |
---|
1120 | |
---|
1121 | |
---|
1122 | (* old proof | lapply (pi2 ?? acc) >p #Hpolicy normalize nodelta in Hpolicy; |
---|
1123 | cases (dec_eq_jump_length new_length old_length) #Hlength normalize nodelta |
---|
1124 | @conj [1,3: @conj [1,3: @conj [1,3: @conj [1,3: @conj [1,3: @conj |
---|
1125 | [1,3: (* out_of_policy_none *) |
---|
1126 | #i >append_length <commutative_plus #Hi normalize in Hi; |
---|
1127 | #Hi2 >lookup_opt_insert_miss |
---|
1128 | [1,3: @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))))) i (le_S_to_le … Hi)) @Hi2 |
---|
1129 | |2,4: >eq_bv_sym @bitvector_of_nat_abs |
---|
1130 | [1,4: @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1131 | @le_S_S @le_plus_n_r |
---|
1132 | |2,5: @Hi2 |
---|
1133 | |3,6: @lt_to_not_eq @Hi |
---|
1134 | ] |
---|
1135 | ] |
---|
1136 | |2,4: (* labels_okay *) |
---|
1137 | @lookup_forall #i cases i -i #i cases i -i #p #a #j #n #Hl |
---|
1138 | elim (insert_lookup_opt ?? 〈p,a,j〉 ???? Hl) -Hl #Hl |
---|
1139 | [1,3: elim (forall_lookup … (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy)))))) ? n Hl) |
---|
1140 | #i #Hi @(ex_intro ?? i Hi) |
---|
1141 | |2,4: normalize nodelta normalize nodelta in p2; cases instr in p2; |
---|
1142 | [2,3,8,9: #x #abs normalize nodelta in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1143 | |6,12: #x #y #abs normalize nodelta in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1144 | |1,7: #pi cases pi |
---|
1145 | [35,36,37,72,73,74: #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1146 | |1,2,3,6,7,33,34,38,39,40,43,44,70,71: |
---|
1147 | #x #y #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1148 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,41,42,45,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69: |
---|
1149 | #x #abs normalize in abs;lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1150 | |9,10,14,15,46,47,51,52: |
---|
1151 | #id normalize nodelta whd in match (jump_expansion_step_instruction ???); |
---|
1152 | whd in match (select_reljump_length ???); >p3 |
---|
1153 | lapply (refl ? (lookup_def ?? (pi1 ?? labels) id 〈0,\fst pol〉)) |
---|
1154 | cases (lookup_def ?? labels id 〈0,\fst pol〉) in ⊢ (???% → %); #q1 #q2 |
---|
1155 | normalize nodelta #H |
---|
1156 | >(pair_eq1 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1157 | >(pair_eq2 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) lapply (refl ? (leb (\fst pol) q2)) |
---|
1158 | cases (leb (\fst pol) q2) in ⊢ (???% → %); #Hle1 |
---|
1159 | [1,3,5,7,9,11,13,15: lapply (refl ? (leb (q2-\fst pol) 126)) cases (leb (q2-\fst pol) 126) in ⊢ (???% → %); |
---|
1160 | |2,4,6,8,10,12,14,16: lapply (refl ? (leb (\fst pol-q2) 129)) cases (leb (\fst pol-q2) 129) in ⊢ (???% → %); |
---|
1161 | ] |
---|
1162 | #Hle2 normalize nodelta #Hli @(ex_intro ?? id) >H |
---|
1163 | <(pair_eq1 ?????? (Some_eq ??? Hli)) @refl |
---|
1164 | |11,12,13,16,17,48,49,50,53,54: |
---|
1165 | #x #id normalize nodelta whd in match (jump_expansion_step_instruction ???); |
---|
1166 | whd in match (select_reljump_length ???); >p3 |
---|
1167 | lapply (refl ? (lookup_def ?? labels id 〈0,\fst pol〉)) |
---|
1168 | cases (lookup_def ?? labels id 〈0,\fst pol〉) in ⊢ (???% → %); #q1 #q2 |
---|
1169 | normalize nodelta #H |
---|
1170 | >(pair_eq1 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1171 | >(pair_eq2 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) lapply (refl ? (leb (\fst pol) q2)) |
---|
1172 | cases (leb (\fst pol) q2) in ⊢ (???% → %); #Hle1 |
---|
1173 | [1,3,5,7,9,11,13,15,17,19: lapply (refl ? (leb (q2-\fst pol) 126)) cases (leb (q2-\fst pol) 126) in ⊢ (???% → %); |
---|
1174 | |2,4,6,8,10,12,14,16,18,20: lapply (refl ? (leb (\fst pol-q2) 129)) cases (leb (\fst pol-q2) 129) in ⊢ (???% → %); |
---|
1175 | ] |
---|
1176 | #Hle2 normalize nodelta #Hli @(ex_intro ?? id) >H |
---|
1177 | <(pair_eq1 ?????? (Some_eq ??? Hli)) @refl |
---|
1178 | ] |
---|
1179 | |4,5,10,11: #id normalize nodelta whd in match (select_jump_length ???); |
---|
1180 | whd in match (select_call_length ???); >p3 |
---|
1181 | lapply (refl ? (lookup_def ?? labels id 〈0,\fst pol〉)) |
---|
1182 | cases (lookup_def ?? labels id 〈0,\fst pol〉) in ⊢ (???% → %); #q1 #q2 |
---|
1183 | normalize nodelta #H |
---|
1184 | [1,3: cases (leb (\fst pol) q2) |
---|
1185 | [1,3: cases (leb (q2-\fst pol) 126) |2,4: cases (leb (\fst pol-q2) 129) ] |
---|
1186 | [1,3,5,7: normalize nodelta #H2 >(pair_eq1 ?????? (Some_eq ??? H2)) in H; |
---|
1187 | #Hli @(ex_intro ?? id) lapply (proj2 ?? Hl) |
---|
1188 | #H >(pair_eq1 ?????? (pair_eq1 ?????? H)) |
---|
1189 | >(pair_eq2 ?????? (pair_eq1 ?????? H)) >Hli @refl] |
---|
1190 | ] |
---|
1191 | cases (split ? 5 11 (bitvector_of_nat 16 q2)) #n1 #n2 |
---|
1192 | cases (split ? 5 11 (bitvector_of_nat 16 (\fst pol))) #m1 #m2 |
---|
1193 | normalize nodelta cases (eq_bv ? n1 m1) |
---|
1194 | normalize nodelta #H2 >(pair_eq1 ?????? (Some_eq ??? H2)) in H; #H |
---|
1195 | @(ex_intro ?? id) lapply (proj2 ?? Hl) #H2 |
---|
1196 | >(pair_eq1 ?????? (pair_eq1 ?????? H2)) >(pair_eq2 ?????? (pair_eq1 ?????? H2)) |
---|
1197 | >H @refl |
---|
1198 | ] |
---|
1199 | ] |
---|
1200 | ] |
---|
1201 | |2,4: (* jump_in_policy *) |
---|
1202 | #i #Hi cases (le_to_or_lt_eq … Hi) -Hi; |
---|
1203 | [1,3: >append_length <commutative_plus #Hi normalize in Hi; |
---|
1204 | >(nth_append_first ?? prefix ??(le_S_S_to_le ?? Hi)) @conj |
---|
1205 | [1,3: #Hj lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy)))) i (le_S_S_to_le … Hi)) |
---|
1206 | #Hacc elim (proj1 ?? Hacc Hj) #h #n elim n -n #n #H elim H -H #j #Hj |
---|
1207 | @(ex_intro ?? h (ex_intro ?? n (ex_intro ?? j ?))) whd in match (snd ???); |
---|
1208 | >lookup_opt_insert_miss [1,3: @Hj |2,4: @bitvector_of_nat_abs ] |
---|
1209 | [3,6: @(lt_to_not_eq i (|prefix|)) @(le_S_S_to_le … Hi) |
---|
1210 | |1,4: @(transitive_lt ??? (le_S_S_to_le ?? Hi)) |
---|
1211 | ] |
---|
1212 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1213 | @le_S_S @le_plus_n_r |
---|
1214 | |2,4: lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy)))) i (le_S_S_to_le … Hi)) |
---|
1215 | #Hacc #H elim H -H; #h #H elim H -H; #n #H elim H -H #j #Hl |
---|
1216 | @(proj2 ?? Hacc) @(ex_intro ?? h (ex_intro ?? n (ex_intro ?? j ?))) |
---|
1217 | <Hl @sym_eq @lookup_opt_insert_miss @bitvector_of_nat_abs |
---|
1218 | [3,6: @lt_to_not_eq @(le_S_S_to_le … Hi) |
---|
1219 | |1,4: @(transitive_lt ??? (le_S_S_to_le ?? Hi)) |
---|
1220 | ] |
---|
1221 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1222 | @le_S_S @le_plus_n_r |
---|
1223 | ] |
---|
1224 | |2,4: >append_length <commutative_plus #Hi normalize in Hi; >(injective_S … Hi) |
---|
1225 | >(nth_append_second ?? prefix ?? (le_n (|prefix|))) |
---|
1226 | <minus_n_n whd in match (nth ????); normalize nodelta in p2; cases instr in p2; |
---|
1227 | [1,7: #pi | 2,3,8,9: #x | 4,5,10,11: #id | 6,12: #x #y] #Hinstr @conj normalize nodelta |
---|
1228 | [5,7,9,11,21,23: #H @⊥ @H (* instr is not a jump *) |
---|
1229 | |6,8,10,12,22,24: normalize nodelta in Hinstr; lapply (jmeq_to_eq ??? Hinstr) |
---|
1230 | #H destruct (H) |
---|
1231 | |13,15,17,19: (* instr is a jump *) #_ @(ex_intro ?? (\fst pol)) |
---|
1232 | @(ex_intro ?? addr) @(ex_intro ?? (max_length old_length ai)) |
---|
1233 | @lookup_opt_insert_hit |
---|
1234 | |14,16,18,20: #_ / by I/ |
---|
1235 | |1,2,3,4: cases pi in Hinstr; |
---|
1236 | [35,36,37,109,110,111: #Hinstr #H @⊥ @H |
---|
1237 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,78,79,82,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106: |
---|
1238 | #x #Hinstr #H @⊥ @H |
---|
1239 | |1,2,3,6,7,33,34,75,76,77,80,81,107,108: #x #y #Hinstr #H @⊥ @H |
---|
1240 | |9,10,14,15,83,84,88,89: #id #Hinstr #_ |
---|
1241 | @(ex_intro ?? (\fst pol)) @(ex_intro ?? addr) @(ex_intro ?? (max_length old_length ai)) |
---|
1242 | @lookup_opt_insert_hit |
---|
1243 | |11,12,13,16,17,85,86,87,90,91: #x #id #Hinstr #_ |
---|
1244 | @(ex_intro ?? (\fst pol)) @(ex_intro ?? addr) @(ex_intro ?? (max_length old_length ai)) |
---|
1245 | @lookup_opt_insert_hit |
---|
1246 | |72,73,74,146,147,148: #Hinstr lapply (jmeq_to_eq ??? Hinstr) #H normalize in H; destruct (H) |
---|
1247 | |41,42,45,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,115,116,119,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143: |
---|
1248 | #x #Hinstr lapply (jmeq_to_eq ??? Hinstr) #H normalize in H; destruct (H) |
---|
1249 | |38,39,40,43,44,70,71,112,113,114,117,118,144,145: #x #y #Hinstr lapply (jmeq_to_eq ??? Hinstr) #H |
---|
1250 | normalize in H; destruct (H) |
---|
1251 | |46,47,51,52,120,121,125,126: #id #Hinstr #_ / by I/ |
---|
1252 | |48,49,50,53,54,122,123,124,127,128: #x #id #Hinstr #_ / by I/ |
---|
1253 | ] |
---|
1254 | ] |
---|
1255 | ] |
---|
1256 | ] |
---|
1257 | |2,4: (* policy increase *) |
---|
1258 | #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1259 | cases (le_to_or_lt_eq … Hi) -Hi; #Hi |
---|
1260 | [1,3: >lookup_insert_miss |
---|
1261 | [1,3: @(proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))) i (le_S_S_to_le … Hi)) |
---|
1262 | |2,4: @bitvector_of_nat_abs |
---|
1263 | [3,6: @lt_to_not_eq @(le_S_S_to_le … Hi) |
---|
1264 | |1,4: @(transitive_lt ??? (le_S_S_to_le … Hi)) |
---|
1265 | ] |
---|
1266 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1267 | @le_S_S @le_plus_n_r |
---|
1268 | ] |
---|
1269 | |2: >(injective_S … Hi) normalize nodelta in Hlength; >lookup_insert_hit normalize nodelta |
---|
1270 | >Hlength @pair_elim #l1 #l2 #Hl @pair_elim #y1 #y2 #Hy |
---|
1271 | >Hl %2 @refl |
---|
1272 | |4: cases daemon (* XXX get rest of proof done first *) |
---|
1273 | ] |
---|
1274 | ] |
---|
1275 | |2,4: (* policy_safe *) |
---|
1276 | @lookup_forall #x cases x -x #x cases x -x #p #a #j #n normalize nodelta #Hl |
---|
1277 | elim (insert_lookup_opt ?? 〈p,a,j〉 ???? Hl) -Hl #Hl |
---|
1278 | [1,3: @(forall_lookup … (proj2 ?? (proj1 ?? (proj1 ?? Hpolicy))) ? n Hl) |
---|
1279 | |2,4: normalize nodelta in p2; cases instr in p2; |
---|
1280 | [2,3,8,9: #x #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1281 | |6,12: #x #y #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1282 | |1,7: #pi cases pi normalize nodelta |
---|
1283 | [35,36,37,72,73,74: #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1284 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,41,42,45,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69: |
---|
1285 | #x #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1286 | |1,2,3,6,7,33,34,38,39,40,43,44,70,71: |
---|
1287 | #x #y #abs normalize in abs; lapply (jmeq_to_eq ??? abs) #H destruct (H) |
---|
1288 | |9,10,14,15,46,47,51,52: #id >p3 whd in match (jump_expansion_step_instruction ???); |
---|
1289 | whd in match (select_reljump_length ???); |
---|
1290 | cases (lookup_def ?? labels id 〈0,\fst pol〉) #q1 #q2 normalize nodelta |
---|
1291 | >(pair_eq1 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1292 | >(pair_eq2 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) lapply (refl ? (leb (\fst pol) q2)) |
---|
1293 | cases (leb (\fst pol) q2) in ⊢ (???% → %); #Hle1 |
---|
1294 | [1,3,5,7,9,11,13,15: lapply (refl ? (leb (q2-\fst pol) 126)) cases (leb (q2-\fst pol) 126) in ⊢ (???% → %); |
---|
1295 | |2,4,6,8,10,12,14,16: lapply (refl ? (leb (\fst pol-q2) 129)) cases (leb (\fst pol-q2) 129) in ⊢ (???% → %); |
---|
1296 | ] |
---|
1297 | #Hle2 normalize nodelta #Hli |
---|
1298 | <(pair_eq1 ?????? (Some_eq ??? Hli)) >Hle1 |
---|
1299 | >(pair_eq2 ?????? (proj2 ?? Hl)) <(pair_eq2 ?????? (Some_eq ??? Hli)) |
---|
1300 | cases (\snd (lookup ?? (bitvector_of_nat ? (|prefix|)) (\snd old_policy) ?)) |
---|
1301 | [1,7,13,19,25,31,37,43,49,55,61,67,73,79,85,91: @(leb_true_to_le … Hle2) |
---|
1302 | ] normalize @I (* much faster than / by I/, strangely enough *) |
---|
1303 | |11,12,13,16,17,48,49,50,53,54: #x #id >p3 whd in match (jump_expansion_step_instruction ???); |
---|
1304 | whd in match (select_reljump_length ???); |
---|
1305 | cases (lookup_def ?? labels id 〈0,\fst pol〉) #q1 #q2 normalize nodelta |
---|
1306 | >(pair_eq1 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1307 | >(pair_eq2 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) lapply (refl ? (leb (\fst pol) q2)) |
---|
1308 | cases (leb (\fst pol) q2) in ⊢ (???% → %); #Hle1 |
---|
1309 | [1,3,5,7,9,11,13,15,17,19: lapply (refl ? (leb (q2-\fst pol) 126)) cases (leb (q2-\fst pol) 126) in ⊢ (???% → %); |
---|
1310 | |2,4,6,8,10,12,14,16,18,20: lapply (refl ? (leb (\fst pol-q2) 129)) cases (leb (\fst pol-q2) 129) in ⊢ (???% → %); |
---|
1311 | ] |
---|
1312 | #Hle2 normalize nodelta #Hli |
---|
1313 | <(pair_eq1 ?????? (Some_eq ??? Hli)) >Hle1 >(pair_eq2 ?????? (proj2 ?? Hl)) |
---|
1314 | <(pair_eq2 ?????? (Some_eq ??? Hli)) |
---|
1315 | cases (\snd (lookup ?? (bitvector_of_nat ? (|prefix|)) (\snd old_policy) ?)) |
---|
1316 | [1,7,13,19,25,31,37,43,49,55,61,67,73,79,85,91,97,103,109,115: @(leb_true_to_le … Hle2) |
---|
1317 | ] normalize @I (* vide supra *) |
---|
1318 | ] |
---|
1319 | |4,5,10,11: #id >p3 normalize nodelta whd in match (select_jump_length ???); |
---|
1320 | whd in match (select_call_length ???); cases (lookup_def ?? labels id 〈0,\fst pol〉) |
---|
1321 | #q1 #q2 normalize nodelta |
---|
1322 | >(pair_eq1 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1323 | >(pair_eq2 ?????? (pair_eq1 ?????? (proj2 ?? Hl))) |
---|
1324 | [1,3: lapply (refl ? (leb (\fst pol) q2)) cases (leb (\fst pol) q2) in ⊢ (???% → %); #Hle1 |
---|
1325 | [1,3: lapply (refl ? (leb (q2-\fst pol) 126)) cases (leb (q2-\fst pol) 126) in ⊢ (???% → %); |
---|
1326 | |2,4: lapply (refl ? (leb (\fst pol-q2) 129)) cases (leb (\fst pol-q2) 129) in ⊢ (???% → %); |
---|
1327 | ] |
---|
1328 | #Hle2 normalize nodelta |
---|
1329 | ] |
---|
1330 | [2,4,6,8,9,10: lapply (refl ? (split ? 5 11 (bitvector_of_nat ? q2))) |
---|
1331 | cases (split ??? (bitvector_of_nat ? q2)) in ⊢ (???% → %); #x1 #x2 #Hle3 |
---|
1332 | lapply (refl ? (split ? 5 11 (bitvector_of_nat ? (\fst pol)))) |
---|
1333 | cases (split ??? (bitvector_of_nat ? (\fst pol))) in ⊢ (???% → %); #y1 #y2 #Hle4 |
---|
1334 | normalize nodelta lapply (refl ? (eq_bv 5 x1 y1)) |
---|
1335 | cases (eq_bv 5 x1 y1) in ⊢ (???% → %); #Hle5 |
---|
1336 | ] |
---|
1337 | #Hli <(pair_eq1 ?????? (Some_eq ??? Hli)) >(pair_eq2 ?????? (proj2 ?? Hl)) |
---|
1338 | <(pair_eq2 ?????? (Some_eq ??? Hli)) |
---|
1339 | cases (\snd (lookup ?? (bitvector_of_nat ? (|prefix|)) (\snd old_policy) ?)) |
---|
1340 | [2,8,14,20,26,32: >Hle3 @Hle5 |
---|
1341 | |37,40,43,46: >Hle1 @(leb_true_to_le … Hle2) |
---|
1342 | ] normalize @I (* here too *) |
---|
1343 | ] |
---|
1344 | ] |
---|
1345 | ] |
---|
1346 | |2,4: (* changed *) |
---|
1347 | normalize nodelta #Hc [2: destruct (Hc)] #i #Hi cases (le_to_or_lt_eq … Hi) -Hi |
---|
1348 | >append_length >commutative_plus #Hi |
---|
1349 | normalize in Hi; |
---|
1350 | [ >lookup_insert_miss |
---|
1351 | [ @(proj2 ?? (proj1 ?? Hpolicy) Hc i (le_S_S_to_le … Hi)) |
---|
1352 | | @bitvector_of_nat_abs |
---|
1353 | [3: @lt_to_not_eq @(le_S_S_to_le … Hi) |
---|
1354 | |1: @(transitive_lt ??? (le_S_S_to_le … Hi)) |
---|
1355 | ] |
---|
1356 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1357 | @le_S_S @le_plus_n_r |
---|
1358 | ] |
---|
1359 | | >(injective_S … Hi) >lookup_insert_hit normalize nodelta in Hlength; >Hlength |
---|
1360 | normalize nodelta @pair_elim #l1 #l2 #Hl @pair_elim #y1 #y2 #Hy >Hl @refl |
---|
1361 | ] |
---|
1362 | ] |
---|
1363 | |2,4: (* policy_isize_sum XXX *) cases daemon |
---|
1364 | ] |
---|
1365 | | (* Case where add_instr = None *) normalize nodelta lapply (pi2 ?? acc) >p >p1 |
---|
1366 | normalize nodelta #Hpolicy |
---|
1367 | @conj [ @conj [ @conj [ @conj [ @conj [ @conj |
---|
1368 | [ (* out_of_program_none *) #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1369 | #Hi2 @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))))) i (le_S_to_le ?? Hi) Hi2) |
---|
1370 | | (* labels_okay *) @lookup_forall #x cases x -x #x cases x #p #a #j #lbl #Hl normalize nodelta |
---|
1371 | elim (forall_lookup … (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy)))))) ? lbl Hl) |
---|
1372 | #id #Hid @(ex_intro … id Hid) |
---|
1373 | ] |
---|
1374 | | (* jump_in_policy *) #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1375 | elim (le_to_or_lt_eq … Hi) -Hi #Hi |
---|
1376 | [ >(nth_append_first ?? prefix ?? (le_S_S_to_le ?? Hi)) |
---|
1377 | @(proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy)))) i (le_S_S_to_le ?? Hi)) |
---|
1378 | | >(injective_S … Hi) @conj |
---|
1379 | [ >(nth_append_second ?? prefix ?? (le_n (|prefix|))) <minus_n_n whd in match (nth ????); |
---|
1380 | normalize nodelta in p2; cases instr in p2; |
---|
1381 | [ #pi cases pi |
---|
1382 | [1,2,3,6,7,33,34: #x #y #_ #H @⊥ @H |
---|
1383 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32: #x #_ #H @⊥ @H |
---|
1384 | |9,10,14,15: #id (* normalize segfaults here *) normalize nodelta |
---|
1385 | whd in match (jump_expansion_step_instruction ???); |
---|
1386 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1387 | |11,12,13,16,17: #x #id normalize nodelta |
---|
1388 | whd in match (jump_expansion_step_instruction ???); |
---|
1389 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1390 | |35,36,37: #_ #H @⊥ @H |
---|
1391 | ] |
---|
1392 | |2,3: #x #_ #H @⊥ @H |
---|
1393 | |4,5: #id normalize nodelta #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1394 | |6: #x #id #_ #H @⊥ @H |
---|
1395 | ] |
---|
1396 | | #H elim H -H #p #H elim H -H #a #H elim H -H #j #H |
---|
1397 | >(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))))) (|prefix|) (le_n (|prefix|)) ?) in H; |
---|
1398 | [ #H destruct (H) |
---|
1399 | | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1400 | @le_S_S @le_plus_n_r |
---|
1401 | ] |
---|
1402 | ] |
---|
1403 | ] |
---|
1404 | ] |
---|
1405 | | (* policy_increase *) #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1406 | elim (le_to_or_lt_eq … Hi) -Hi #Hi |
---|
1407 | [ @(proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))) i (le_S_S_to_le … Hi)) |
---|
1408 | | >(injective_S … Hi) >lookup_opt_lookup_miss |
---|
1409 | [ >lookup_opt_lookup_miss |
---|
1410 | [ normalize nodelta %2 @refl |
---|
1411 | | @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))))) (|prefix|) (le_n (|prefix|)) ?) |
---|
1412 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1413 | @le_S_S @le_plus_n_r |
---|
1414 | ] |
---|
1415 | | @(proj1 ?? (jump_not_in_policy (pi1 … program) «pi1 ?? old_policy,proj1 ?? (proj1 ?? (pi2 ?? old_policy))» (|prefix|) ?)) >prf |
---|
1416 | [ >append_length normalize <plus_n_Sm @le_S_S @le_plus_n_r |
---|
1417 | | >(nth_append_second ?? prefix ?? (le_n (|prefix|))) <minus_n_n >p1 |
---|
1418 | whd in match (nth ????); normalize nodelta in p2; cases instr in p2; |
---|
1419 | [ #pi cases pi |
---|
1420 | [1,2,3,6,7,33,34: #x #y #_ normalize /2 by nmk/ |
---|
1421 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32: #x #_ normalize /2 by nmk/ |
---|
1422 | |9,10,14,15: #id (* normalize segfaults here *) normalize nodelta |
---|
1423 | whd in match (jump_expansion_step_instruction ???); |
---|
1424 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1425 | |11,12,13,16,17: #x #id normalize nodelta |
---|
1426 | whd in match (jump_expansion_step_instruction ???); |
---|
1427 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1428 | |35,36,37: #_ normalize /2 by nmk/ |
---|
1429 | ] |
---|
1430 | |2,3: #x #_ normalize /2 by nmk/ |
---|
1431 | |4,5: #id normalize nodelta #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1432 | |6: #x #id #_ normalize /2 by nmk/ |
---|
1433 | ] |
---|
1434 | ] |
---|
1435 | ] |
---|
1436 | ] |
---|
1437 | ] |
---|
1438 | | (* policy_safe *) @lookup_forall #x cases x -x #x cases x -x #p #a #j #n #Hl |
---|
1439 | @(forall_lookup … (proj2 ?? (proj1 ?? (proj1 ?? Hpolicy))) ? n Hl) |
---|
1440 | ] |
---|
1441 | | (* changed *) #Hc #i >append_length >commutative_plus #Hi normalize in Hi; |
---|
1442 | elim (le_to_or_lt_eq … Hi) -Hi #Hi |
---|
1443 | [ @(proj2 ?? (proj1 ?? Hpolicy) Hc i (le_S_S_to_le … Hi)) |
---|
1444 | | >(injective_S … Hi) >lookup_opt_lookup_miss |
---|
1445 | [ >lookup_opt_lookup_miss |
---|
1446 | [ normalize nodelta @refl |
---|
1447 | | @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpolicy))))) (|prefix|) (le_n (|prefix|)) ?) |
---|
1448 | @(transitive_lt … (pi2 ?? program)) >prf >append_length normalize <plus_n_Sm |
---|
1449 | @le_S_S @le_plus_n_r |
---|
1450 | ] |
---|
1451 | | @(proj1 ?? (jump_not_in_policy (pi1 … program) «pi1 ?? old_policy,proj1 ?? (proj1 ?? (pi2 ?? old_policy))» (|prefix|) ?)) >prf |
---|
1452 | [ >append_length normalize <plus_n_Sm @le_S_S @le_plus_n_r |
---|
1453 | | >(nth_append_second ?? prefix ?? (le_n (|prefix|))) <minus_n_n >p1 |
---|
1454 | whd in match (nth ????); normalize nodelta in p2; cases instr in p2; |
---|
1455 | [ #pi cases pi |
---|
1456 | [1,2,3,6,7,33,34: #x #y #_ normalize /2 by nmk/ |
---|
1457 | |4,5,8,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32: #x #_ normalize /2 by nmk/ |
---|
1458 | |9,10,14,15: #id (* normalize segfaults here *) normalize nodelta |
---|
1459 | whd in match (jump_expansion_step_instruction ???); |
---|
1460 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1461 | |11,12,13,16,17: #x #id normalize nodelta |
---|
1462 | whd in match (jump_expansion_step_instruction ???); |
---|
1463 | #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1464 | |35,36,37: #_ normalize /2 by nmk/ |
---|
1465 | ] |
---|
1466 | |2,3: #x #_ normalize /2 by nmk/ |
---|
1467 | |4,5: #id normalize nodelta #H lapply (jmeq_to_eq ??? H) #H2 destruct (H2) |
---|
1468 | |6: #x #id #_ normalize /2 by nmk/ |
---|
1469 | ] |
---|
1470 | ] |
---|
1471 | ] |
---|
1472 | ] |
---|
1473 | ] |
---|
1474 | | (* XXX policy_isize_sum *) cases daemon |
---|
1475 | ] |
---|
1476 | | @conj [ @conj [ @conj [ @conj [ @conj [ @conj |
---|
1477 | [ #i #Hi / by refl/ |
---|
1478 | | / by I/ |
---|
1479 | ] |
---|
1480 | | #i #Hi @conj [ >nth_nil #H @⊥ @H | #H elim H #x #H1 elim H1 #y #H2 elim H2 #z #H3 |
---|
1481 | normalize in H3; destruct (H3) ] |
---|
1482 | ] |
---|
1483 | | #i #Hi @⊥ @(absurd (i<0)) [ @Hi | @(not_le_Sn_O) ] |
---|
1484 | ] |
---|
1485 | | / by I/ |
---|
1486 | ] |
---|
1487 | | #_ #i #Hi @⊥ @(absurd (i < 0)) [ @Hi | @not_le_Sn_O ] |
---|
1488 | ] |
---|
1489 | | / by refl/ |
---|
1490 | ] |
---|
1491 | ] |
---|
1492 | qed.*) |
---|
1493 | |
---|
1494 | (* this might be replaced by a coercion: (∀x.A x → B x) → Σx.A x → Σx.B x *) |
---|
1495 | (* definition weaken_policy: |
---|
1496 | ∀program,op. |
---|
1497 | option (Σp:jump_expansion_policy. |
---|
1498 | And (And (And (And (out_of_program_none program p) |
---|
1499 | (labels_okay (create_label_map program op) p)) |
---|
1500 | (jump_in_policy program p)) (policy_increase program op p)) |
---|
1501 | (policy_safe p)) → |
---|
1502 | option (Σp:jump_expansion_policy.And (out_of_program_none program p) |
---|
1503 | (jump_in_policy program p)) ≝ |
---|
1504 | λprogram.λop.λx. |
---|
1505 | match x return λ_.option (Σp.And (out_of_program_none program p) (jump_in_policy program p)) with |
---|
1506 | [ None ⇒ None ? |
---|
1507 | | Some z ⇒ Some ? (mk_Sig ?? (pi1 ?? z) ?) |
---|
1508 | ]. |
---|
1509 | @conj |
---|
1510 | [ @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (pi2 ?? z))))) |
---|
1511 | | @(proj2 ?? (proj1 ?? (proj1 ?? (pi2 ?? z)))) |
---|
1512 | ] |
---|
1513 | qed. *) |
---|
1514 | |
---|
1515 | (* This function executes n steps from the starting point. *) |
---|
1516 | (*let rec jump_expansion_internal (program: Σl:list labelled_instruction.lt (|l|) 2^16) |
---|
1517 | (n: ℕ) on n:(Σx:bool × ℕ × (option jump_expansion_policy). |
---|
1518 | let 〈ch,pc,y〉 ≝ x in |
---|
1519 | match y with |
---|
1520 | [ None ⇒ pc > 2^16 |
---|
1521 | | Some p ⇒ And (out_of_program_none program p) (jump_in_policy program p) |
---|
1522 | ]) ≝ |
---|
1523 | match n with |
---|
1524 | [ O ⇒ 〈0,Some ? (pi1 … (jump_expansion_start program))〉 |
---|
1525 | | S m ⇒ let 〈ch,pc,z〉 as p1 ≝ (pi1 ?? (jump_expansion_internal program m)) in |
---|
1526 | match z return λx. z=x → Σa:bool × ℕ × (option jump_expansion_policy).? with |
---|
1527 | [ None ⇒ λp2.〈pc,None ?〉 |
---|
1528 | | Some op ⇒ λp2.pi1 … (jump_expansion_step program (create_label_map program op) «op,?») |
---|
1529 | ] (refl … z) |
---|
1530 | ].*) |
---|
1531 | |
---|
1532 | |
---|
1533 | let rec jump_expansion_internal (program: Σl:list labelled_instruction.lt (length ? l) 2^16) (n: ℕ) |
---|
1534 | on n:(Σx:bool × (option ppc_pc_map). |
---|
1535 | let 〈c,pol〉 ≝ x in |
---|
1536 | match pol with |
---|
1537 | [ None ⇒ True |
---|
1538 | | Some x ⇒ |
---|
1539 | And (And |
---|
1540 | (out_of_program_none program x) |
---|
1541 | (policy_isize_sum program (create_label_map program) x)) |
---|
1542 | (\fst x < 2^16) |
---|
1543 | ]) ≝ |
---|
1544 | let labels ≝ create_label_map program in |
---|
1545 | match n with |
---|
1546 | [ O ⇒ 〈true,pi1 ?? (jump_expansion_start program labels)〉 |
---|
1547 | | S m ⇒ let 〈ch,z〉 as p1 ≝ (pi1 ?? (jump_expansion_internal program m)) in |
---|
1548 | match z return λx. z=x → Σa:bool × (option ppc_pc_map).? with |
---|
1549 | [ None ⇒ λp2.〈false,None ?〉 |
---|
1550 | | Some op ⇒ λp2.if ch |
---|
1551 | then pi1 ?? (jump_expansion_step program labels «op,?») |
---|
1552 | else (jump_expansion_internal program m) |
---|
1553 | ] (refl … z) |
---|
1554 | ]. |
---|
1555 | [ normalize nodelta cases (jump_expansion_start program (create_label_map program)) |
---|
1556 | #p cases p |
---|
1557 | [ / by I/ |
---|
1558 | | #pm / by I/ |
---|
1559 | ] |
---|
1560 | | lapply (pi2 ?? (jump_expansion_internal program m)) <p1 >p2 normalize nodelta / by / |
---|
1561 | | lapply (pi2 ?? (jump_expansion_internal program m)) <p1 >p2 normalize nodelta / by / |
---|
1562 | | normalize nodelta cases (jump_expansion_step program labels «op,?») |
---|
1563 | #p cases p -p #p #r cases r normalize nodelta |
---|
1564 | [ #H / by I/ |
---|
1565 | | #j #H @conj |
---|
1566 | [ @conj |
---|
1567 | [ @(proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? H))))) |
---|
1568 | | @(proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? H))))) |
---|
1569 | ] |
---|
1570 | | @(proj2 ?? H) |
---|
1571 | ] |
---|
1572 | ] |
---|
1573 | ] |
---|
1574 | qed. |
---|
1575 | |
---|
1576 | lemma pe_int_refl: ∀program.reflexive ? (policy_equal program). |
---|
1577 | #program whd #x whd #n #Hn |
---|
1578 | cases (bvt_lookup … (bitvector_of_nat 16 n) (\snd x) 〈0,short_jump〉) |
---|
1579 | #y #z normalize nodelta @refl |
---|
1580 | qed. |
---|
1581 | |
---|
1582 | lemma pe_int_sym: ∀program.symmetric ? (policy_equal program). |
---|
1583 | #program whd #x #y #Hxy whd #n #Hn |
---|
1584 | lapply (Hxy n Hn) cases (bvt_lookup … (bitvector_of_nat ? n) (\snd x) 〈0,short_jump〉) |
---|
1585 | #x1 #x2 |
---|
1586 | cases (bvt_lookup … (bitvector_of_nat ? n) (\snd y) 〈0,short_jump〉) |
---|
1587 | #y1 #y2 normalize nodelta // |
---|
1588 | qed. |
---|
1589 | |
---|
1590 | lemma pe_int_trans: ∀program.transitive ? (policy_equal program). |
---|
1591 | #program whd #x #y #z whd in match (policy_equal ???); whd in match (policy_equal ?y ?); |
---|
1592 | whd in match (policy_equal ? x z); #Hxy #Hyz #n #Hn lapply (Hxy n Hn) -Hxy |
---|
1593 | lapply (Hyz n Hn) -Hyz cases (bvt_lookup … (bitvector_of_nat ? n) (\snd x) 〈0,short_jump〉) |
---|
1594 | #x1 #x2 |
---|
1595 | cases (bvt_lookup … (bitvector_of_nat ? n) (\snd y) 〈0,short_jump〉) #y1 #y2 |
---|
1596 | cases (bvt_lookup … (bitvector_of_nat ? n) (\snd z) 〈0,short_jump〉) #z1 #z2 |
---|
1597 | normalize nodelta // |
---|
1598 | qed. |
---|
1599 | |
---|
1600 | definition policy_equal_opt ≝ |
---|
1601 | λprogram:list labelled_instruction.λp1,p2:option ppc_pc_map. |
---|
1602 | match p1 with |
---|
1603 | [ Some x1 ⇒ match p2 with |
---|
1604 | [ Some x2 ⇒ policy_equal program x1 x2 |
---|
1605 | | _ ⇒ False |
---|
1606 | ] |
---|
1607 | | None ⇒ p2 = None ? |
---|
1608 | ]. |
---|
1609 | |
---|
1610 | lemma pe_refl: ∀program.reflexive ? (policy_equal_opt program). |
---|
1611 | #program whd #x whd cases x |
---|
1612 | [ // |
---|
1613 | | #y @pe_int_refl |
---|
1614 | ] |
---|
1615 | qed. |
---|
1616 | |
---|
1617 | lemma pe_sym: ∀program.symmetric ? (policy_equal_opt program). |
---|
1618 | #program whd #x #y #Hxy whd cases y in Hxy; |
---|
1619 | [ cases x |
---|
1620 | [ // |
---|
1621 | | #x' #H @⊥ @(absurd ? H) /2 by nmk/ |
---|
1622 | ] |
---|
1623 | | #y' cases x |
---|
1624 | [ #H @⊥ @(absurd ? H) whd in match (policy_equal_opt ???); @nmk #H destruct (H) |
---|
1625 | | #x' #H @pe_int_sym @H |
---|
1626 | ] |
---|
1627 | ] |
---|
1628 | qed. |
---|
1629 | |
---|
1630 | lemma pe_trans: ∀program.transitive ? (policy_equal_opt program). |
---|
1631 | #program whd #x #y #z cases x |
---|
1632 | [ #Hxy #Hyz >Hxy in Hyz; // |
---|
1633 | | #x' cases y |
---|
1634 | [ #H @⊥ @(absurd ? H) /2 by nmk/ |
---|
1635 | | #y' cases z |
---|
1636 | [ #_ #H @⊥ @(absurd ? H) /2 by nmk/ |
---|
1637 | | #z' @pe_int_trans |
---|
1638 | ] |
---|
1639 | ] |
---|
1640 | ] |
---|
1641 | qed. |
---|
1642 | |
---|
1643 | definition step_none: ∀program.∀n. |
---|
1644 | (\snd (pi1 ?? (jump_expansion_internal program n))) = None ? → |
---|
1645 | ∀k.(\snd (pi1 ?? (jump_expansion_internal program (n+k)))) = None ?. |
---|
1646 | #program #n lapply (refl ? (jump_expansion_internal program n)) |
---|
1647 | cases (jump_expansion_internal program n) in ⊢ (???% → %); |
---|
1648 | #x1 cases x1 #p1 #j1 -x1; #H1 #Heqj #Hj #k elim k |
---|
1649 | [ <plus_n_O >Heqj @Hj |
---|
1650 | | #k' -k <plus_n_Sm whd in match (jump_expansion_internal program (S (n+k'))); |
---|
1651 | lapply (refl ? (jump_expansion_internal program (n+k'))) |
---|
1652 | cases (jump_expansion_internal program (n+k')) in ⊢ (???% → % → %); |
---|
1653 | #x2 cases x2 -x2 #c2 #p2 normalize nodelta #H #Heqj2 |
---|
1654 | cases p2 in H Heqj2; |
---|
1655 | [ #H #Heqj2 #_ whd in match (jump_expansion_internal ??); |
---|
1656 | >Heqj2 normalize nodelta @refl |
---|
1657 | | #x #H #Heqj2 #abs destruct (abs) |
---|
1658 | ] |
---|
1659 | ] |
---|
1660 | qed. |
---|
1661 | |
---|
1662 | lemma pe_step: ∀program:(Σl:list labelled_instruction.|l| < 2^16). |
---|
1663 | ∀n.policy_equal_opt program (\snd (pi1 ?? (jump_expansion_internal program n))) |
---|
1664 | (\snd (pi1 ?? (jump_expansion_internal program (S n)))) → |
---|
1665 | policy_equal_opt program (\snd (pi1 ?? (jump_expansion_internal program (S n)))) |
---|
1666 | (\snd (pi1 ?? (jump_expansion_internal program (S (S n))))). |
---|
1667 | #program #n #Heq |
---|
1668 | cases daemon (* XXX *) |
---|
1669 | qed. |
---|
1670 | |
---|
1671 | (* this is in the stdlib, but commented out, why? *) |
---|
1672 | theorem plus_Sn_m1: ∀n,m:nat. S m + n = m + S n. |
---|
1673 | #n (elim n) normalize /2 by S_pred/ qed. |
---|
1674 | |
---|
1675 | lemma equal_remains_equal: ∀program:(Σl:list labelled_instruction.|l| < 2^16).∀n:ℕ. |
---|
1676 | policy_equal_opt program (\snd (pi1 … (jump_expansion_internal program n))) |
---|
1677 | (\snd (pi1 … (jump_expansion_internal program (S n)))) → |
---|
1678 | ∀k.k ≥ n → policy_equal_opt program (\snd (pi1 … (jump_expansion_internal program n))) |
---|
1679 | (\snd (pi1 … (jump_expansion_internal program k))). |
---|
1680 | #program #n #Heq #k #Hk elim (le_plus_k … Hk); #z #H >H -H -Hk -k; |
---|
1681 | lapply Heq -Heq; lapply n -n; elim z -z; |
---|
1682 | [ #n #Heq <plus_n_O @pe_refl |
---|
1683 | | #z #Hind #n #Heq <plus_Sn_m1 whd in match (plus (S n) z); |
---|
1684 | @(pe_trans … (\snd (pi1 … (jump_expansion_internal program (S n))))) |
---|
1685 | [ @Heq |
---|
1686 | | @Hind @pe_step @Heq |
---|
1687 | ] |
---|
1688 | ] |
---|
1689 | qed. |
---|
1690 | |
---|
1691 | (* this number monotonically increases over iterations, maximum 2*|program| *) |
---|
1692 | let rec measure_int (program: list labelled_instruction) (policy: ppc_pc_map) (acc: ℕ) |
---|
1693 | on program: ℕ ≝ |
---|
1694 | match program with |
---|
1695 | [ nil ⇒ acc |
---|
1696 | | cons h t ⇒ match (\snd (bvt_lookup ?? (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉)) with |
---|
1697 | [ long_jump ⇒ measure_int t policy (acc + 2) |
---|
1698 | | medium_jump ⇒ measure_int t policy (acc + 1) |
---|
1699 | | _ ⇒ measure_int t policy acc |
---|
1700 | ] |
---|
1701 | ]. |
---|
1702 | |
---|
1703 | lemma measure_plus: ∀program.∀policy.∀x,d:ℕ. |
---|
1704 | measure_int program policy (x+d) = measure_int program policy x + d. |
---|
1705 | #program #policy #x #d generalize in match x; -x elim d |
---|
1706 | [ // |
---|
1707 | | -d; #d #Hind elim program |
---|
1708 | [ / by refl/ |
---|
1709 | | #h #t #Hd #x whd in match (measure_int ???); whd in match (measure_int ?? x); |
---|
1710 | cases (\snd (bvt_lookup … (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉)) |
---|
1711 | [ normalize nodelta @Hd |
---|
1712 | |2,3: normalize nodelta >associative_plus >(commutative_plus (S d) ?) <associative_plus |
---|
1713 | @Hd |
---|
1714 | ] |
---|
1715 | ] |
---|
1716 | ] |
---|
1717 | qed. |
---|
1718 | |
---|
1719 | lemma measure_le: ∀program.∀policy. |
---|
1720 | measure_int program policy 0 ≤ 2*|program|. |
---|
1721 | #program #policy elim program |
---|
1722 | [ normalize @le_n |
---|
1723 | | #h #t #Hind whd in match (measure_int ???); |
---|
1724 | cases (\snd (lookup ?? (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉)) |
---|
1725 | [ normalize nodelta @(transitive_le ??? Hind) /2 by monotonic_le_times_r/ |
---|
1726 | |2,3: normalize nodelta >measure_plus <times_n_Sm >(commutative_plus 2 ?) |
---|
1727 | @le_plus [1,3: @Hind |2,4: / by le_n/ ] |
---|
1728 | ] |
---|
1729 | ] |
---|
1730 | qed. |
---|
1731 | |
---|
1732 | (* uses the second part of policy_increase *) |
---|
1733 | lemma measure_incr_or_equal: ∀program:Σl:list labelled_instruction.|l|<2^16. |
---|
1734 | ∀policy:Σp:ppc_pc_map. |
---|
1735 | out_of_program_none program p ∧ |
---|
1736 | policy_isize_sum program (create_label_map program) p ∧ \fst p < 2^16. |
---|
1737 | ∀l.|l| ≤ |program| → ∀acc:ℕ. |
---|
1738 | match \snd (jump_expansion_step program (create_label_map program) policy) with |
---|
1739 | [ None ⇒ True |
---|
1740 | | Some p ⇒ measure_int l policy acc ≤ measure_int l p acc |
---|
1741 | ]. |
---|
1742 | #program #policy #l elim l -l; |
---|
1743 | [ #Hp #acc cases (jump_expansion_step ???) #pi1 cases pi1 #p #q -pi1; cases q [ // | #x #_ @le_n ] |
---|
1744 | | #h #t #Hind #Hp #acc |
---|
1745 | lapply (refl ? (jump_expansion_step program (create_label_map program) policy)) |
---|
1746 | cases (jump_expansion_step ???) in ⊢ (???% → %); #pi1 cases pi1 -pi1 #c #r cases r |
---|
1747 | [ / by I/ |
---|
1748 | | #x normalize nodelta #Hx #Hjeq lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hx))) (|t|) Hp) |
---|
1749 | whd in match (measure_int ???); whd in match (measure_int ? x ?); |
---|
1750 | cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉) |
---|
1751 | #x1 #x2 cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) (\snd x) 〈0,short_jump〉) |
---|
1752 | #y1 #y2 normalize nodelta #Hblerp cases (proj2 ?? Hblerp) cases x2 cases y2 |
---|
1753 | [1,4,5,7,8,9: #H cases H |
---|
1754 | |2,3,6: #_ normalize nodelta |
---|
1755 | [1,2: @(transitive_le ? (measure_int t x acc)) |
---|
1756 | |3: @(transitive_le ? (measure_int t x (acc+1))) |
---|
1757 | ] |
---|
1758 | [2,4,5,6: >measure_plus [1,2: @le_plus_n_r] >measure_plus @le_plus / by le_n/] |
---|
1759 | >Hjeq in Hind; #Hind @Hind @(transitive_le … Hp) @le_n_Sn |
---|
1760 | |11,12,13,15,16,17: #H destruct (H) |
---|
1761 | |10,14,18: normalize nodelta #_ >Hjeq in Hind; #Hind @Hind @(transitive_le … Hp) @le_n_Sn |
---|
1762 | ] |
---|
1763 | ] |
---|
1764 | ] |
---|
1765 | qed. |
---|
1766 | |
---|
1767 | (* these lemmas seem superfluous, but not sure how *) |
---|
1768 | lemma bla: ∀a,b:ℕ.a + a = b + b → a = b. |
---|
1769 | #a elim a |
---|
1770 | [ normalize #b // |
---|
1771 | | -a #a #Hind #b cases b [ /2 by le_n_O_to_eq/ | -b #b normalize |
---|
1772 | <plus_n_Sm <plus_n_Sm #H |
---|
1773 | >(Hind b (injective_S ?? (injective_S ?? H))) // ] |
---|
1774 | ] |
---|
1775 | qed. |
---|
1776 | |
---|
1777 | lemma sth_not_s: ∀x.x ≠ S x. |
---|
1778 | #x cases x |
---|
1779 | [ // | #y // ] |
---|
1780 | qed. |
---|
1781 | |
---|
1782 | lemma measure_full: ∀program.∀policy. |
---|
1783 | measure_int program policy 0 = 2*|program| → ∀i.i<|program| → |
---|
1784 | is_jump (nth i ? program 〈None ?,Comment []〉) → |
---|
1785 | (\snd (bvt_lookup ?? (bitvector_of_nat ? i) (\snd policy) 〈0,short_jump〉)) = long_jump. |
---|
1786 | #program #policy elim program in ⊢ (% → ∀i.% → ? → %); |
---|
1787 | [ #Hm #i #Hi @⊥ @(absurd … Hi) @not_le_Sn_O |
---|
1788 | | #h #t #Hind #Hm #i #Hi #Hj |
---|
1789 | cases (le_to_or_lt_eq … Hi) -Hi |
---|
1790 | [ #Hi @Hind |
---|
1791 | [ whd in match (measure_int ???) in Hm; |
---|
1792 | cases (\snd (bvt_lookup … (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉)) in Hm; |
---|
1793 | normalize nodelta |
---|
1794 | [ #H @⊥ @(absurd ? (measure_le t policy)) >H @lt_to_not_le /2 by lt_plus, le_n/ |
---|
1795 | | >measure_plus >commutative_plus #H @⊥ @(absurd ? (measure_le t policy)) |
---|
1796 | <(plus_to_minus … (sym_eq … H)) @lt_to_not_le normalize /2 by le_n/ |
---|
1797 | | >measure_plus <times_n_Sm >commutative_plus /2 by injective_plus_r/ |
---|
1798 | ] |
---|
1799 | | @(le_S_S_to_le … Hi) |
---|
1800 | | @Hj |
---|
1801 | ] |
---|
1802 | | #Hi >(injective_S … Hi) whd in match (measure_int ???) in Hm; |
---|
1803 | cases (\snd (bvt_lookup … (bitvector_of_nat ? (|t|)) (\snd policy) 〈0,short_jump〉)) in Hm; |
---|
1804 | normalize nodelta |
---|
1805 | [ #Hm @⊥ @(absurd ? (measure_le t policy)) >Hm @lt_to_not_le /2 by lt_plus, le_n/ |
---|
1806 | | >measure_plus >commutative_plus #H @⊥ @(absurd ? (measure_le t policy)) |
---|
1807 | <(plus_to_minus … (sym_eq … H)) @lt_to_not_le normalize /2 by le_n/ |
---|
1808 | | >measure_plus <times_n_Sm >commutative_plus /2 by injective_plus_r/ |
---|
1809 | ] |
---|
1810 | ] |
---|
1811 | ] |
---|
1812 | qed. |
---|
1813 | |
---|
1814 | (* uses second part of policy_increase *) |
---|
1815 | lemma measure_special: ∀program:(Σl:list labelled_instruction.|l| < 2^16). |
---|
1816 | ∀policy:Σp:ppc_pc_map. |
---|
1817 | out_of_program_none program p ∧ policy_isize_sum program (create_label_map program) p ∧ \fst p < 2^16. |
---|
1818 | match (\snd (pi1 ?? (jump_expansion_step program (create_label_map program) policy))) with |
---|
1819 | [ None ⇒ True |
---|
1820 | | Some p ⇒ measure_int program policy 0 = measure_int program p 0 → policy_equal program policy p ]. |
---|
1821 | #program #policy lapply (refl ? (pi1 ?? (jump_expansion_step program (create_label_map program) policy))) |
---|
1822 | cases (jump_expansion_step program (create_label_map program) policy) in ⊢ (???% → %); |
---|
1823 | #p cases p -p #ch #pol normalize nodelta cases pol |
---|
1824 | [ / by I/ |
---|
1825 | | #p normalize nodelta #Hpol #eqpol lapply (le_n (|program|)) |
---|
1826 | @(list_ind ? (λx.|x| ≤ |pi1 ?? program| → |
---|
1827 | measure_int x policy 0 = measure_int x p 0 → |
---|
1828 | policy_equal x policy p) ?? (pi1 ?? program)) |
---|
1829 | [ #_ #_ #i #Hi @⊥ @(absurd ? Hi) @not_le_Sn_O |
---|
1830 | | #h #t #Hind #Hp #Hm #i #Hi cases (le_to_or_lt_eq … Hi) -Hi; |
---|
1831 | [ #Hi @Hind |
---|
1832 | [ @(transitive_le … Hp) / by / |
---|
1833 | | whd in match (measure_int ???) in Hm; whd in match (measure_int ? p ?) in Hm; |
---|
1834 | lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpol))) (|t|) Hp) #Hinc |
---|
1835 | cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) ? 〈0,short_jump〉) in Hm Hinc; #x1 #x2 |
---|
1836 | cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) ? 〈0,short_jump〉); #y1 #y2 |
---|
1837 | #Hm #Hinc lapply Hm -Hm; lapply Hinc -Hinc; normalize nodelta |
---|
1838 | cases x2 cases y2 normalize nodelta |
---|
1839 | [1: / by / |
---|
1840 | |2,3: >measure_plus #_ #H @⊥ @(absurd ? (eq_plus_S_to_lt … H)) @le_to_not_lt |
---|
1841 | lapply (measure_incr_or_equal program policy t ? 0) |
---|
1842 | [1,3: @(transitive_le … Hp) @le_n_Sn ] >eqpol / by / |
---|
1843 | |4,7,8: #H elim (proj2 ?? H) #H2 [1,3,5: cases H2 |2,4,6: destruct (H2) ] |
---|
1844 | |5: >measure_plus >measure_plus >commutative_plus >(commutative_plus ? 1) |
---|
1845 | #_ #H @(injective_plus_r … H) |
---|
1846 | |6: >measure_plus >measure_plus |
---|
1847 | change with (1+1) in match (2); >assoc_plus1 >(commutative_plus 1 (measure_int ???)) |
---|
1848 | #_ #H @⊥ @(absurd ? (eq_plus_S_to_lt … H)) @le_to_not_lt @monotonic_le_plus_l |
---|
1849 | lapply (measure_incr_or_equal program policy t ? 0) |
---|
1850 | [ @(transitive_le … Hp) @le_n_Sn ] >eqpol / by / |
---|
1851 | |9: >measure_plus >measure_plus >commutative_plus >(commutative_plus ? 2) |
---|
1852 | #_ #H @(injective_plus_r … H) |
---|
1853 | ] |
---|
1854 | | @(le_S_S_to_le … Hi) |
---|
1855 | ] |
---|
1856 | | #Hi >(injective_S … Hi) whd in match (measure_int ???) in Hm; |
---|
1857 | whd in match (measure_int ? p ?) in Hm; |
---|
1858 | lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? Hpol))) (|t|) Hp) |
---|
1859 | cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) ? 〈0,short_jump〉) in |
---|
1860 | Hm; |
---|
1861 | #x1 #x2 |
---|
1862 | cases (bvt_lookup ?? (bitvector_of_nat ? (|t|)) ? 〈0,short_jump〉); |
---|
1863 | #y1 #y2 |
---|
1864 | normalize nodelta cases x2 cases y2 normalize nodelta |
---|
1865 | cases daemon |
---|
1866 | (* [1,5,9: #_ #_ // |
---|
1867 | |4,7,8: #_ #H elim H #H2 [1,3,5: @⊥ @H2 |2,4,6: destruct (H2) ] |
---|
1868 | |2,3: >measure_plus #H #_ @⊥ @(absurd ? (eq_plus_S_to_lt … H)) @le_to_not_lt |
---|
1869 | lapply (measure_incr_or_equal program policy t ? 0) |
---|
1870 | [1,3: @(transitive_le … Hp) @le_n_Sn ] >eqpol / by / |
---|
1871 | |6: >measure_plus >measure_plus |
---|
1872 | change with (1+1) in match (2); >assoc_plus1 >(commutative_plus 1 (measure_int ???)) |
---|
1873 | #H #_ @⊥ @(absurd ? (eq_plus_S_to_lt … H)) @le_to_not_lt @monotonic_le_plus_l |
---|
1874 | lapply (measure_incr_or_equal program policy t ? 0) |
---|
1875 | [ @(transitive_le … Hp) @le_n_Sn ] >eqpol / by / |
---|
1876 | ] *) |
---|
1877 | ] |
---|
1878 | ] |
---|
1879 | qed. |
---|
1880 | |
---|
1881 | lemma le_to_eq_plus: ∀n,z. |
---|
1882 | n ≤ z → ∃k.z = n + k. |
---|
1883 | #n #z elim z |
---|
1884 | [ #H cases (le_to_or_lt_eq … H) |
---|
1885 | [ #H2 @⊥ @(absurd … H2) @not_le_Sn_O |
---|
1886 | | #H2 @(ex_intro … 0) >H2 // |
---|
1887 | ] |
---|
1888 | | #z' #Hind #H cases (le_to_or_lt_eq … H) |
---|
1889 | [ #H' elim (Hind (le_S_S_to_le … H')) #k' #H2 @(ex_intro … (S k')) |
---|
1890 | >H2 >plus_n_Sm // |
---|
1891 | | #H' @(ex_intro … 0) >H' // |
---|
1892 | ] |
---|
1893 | ] |
---|
1894 | qed. |
---|
1895 | |
---|
1896 | (* probably needs some kind of not_jump → short *) |
---|
1897 | lemma measure_zero: ∀l.∀program:Σl:list labelled_instruction.|l| < 2^16. |
---|
1898 | match jump_expansion_start program (create_label_map program) with |
---|
1899 | [ None ⇒ True |
---|
1900 | | Some p ⇒ |l| ≤ |program| → measure_int l p 0 = 0 |
---|
1901 | ]. |
---|
1902 | #l #program lapply (refl ? (jump_expansion_start program (create_label_map program))) |
---|
1903 | cases (jump_expansion_start program (create_label_map program)) in ⊢ (???% → %); #p #Hp #EQ |
---|
1904 | cases p in Hp EQ; |
---|
1905 | [ / by I/ |
---|
1906 | | #pl normalize nodelta #Hpl #EQ elim l |
---|
1907 | [ / by refl/ |
---|
1908 | | #h #t #Hind #Hp |
---|
1909 | cases daemon (* |
---|
1910 | cases (dec_is_jump (nth (|t|) ? program 〈None ?, Comment []〉)) #Hj |
---|
1911 | [ normalize nodelta @Hind @le_S_to_le ] |
---|
1912 | @Hp |
---|
1913 | | >(lookup_opt_lookup_miss … (proj1 ?? (jump_not_in_policy program (pi1 ?? (jump_expansion_start program)) (|t|) ?) Hj) 〈0,0,short_jump〉) |
---|
1914 | [ normalize nodelta @Hind @le_S_to_le @Hp |
---|
1915 | | @Hp |
---|
1916 | | % |
---|
1917 | [ @(proj1 ?? (proj1 ?? (pi2 ?? (jump_expansion_start program)))) |
---|
1918 | | @(proj2 ?? (proj1 ?? (pi2 ?? (jump_expansion_start program)))) |
---|
1919 | ] |
---|
1920 | ] |
---|
1921 | ]*) |
---|
1922 | ] |
---|
1923 | qed. |
---|
1924 | |
---|
1925 | (* the actual computation of the fixpoint *) |
---|
1926 | definition je_fixpoint: ∀program:(Σl:list labelled_instruction.|l| < 2^16). |
---|
1927 | Σp:option ppc_pc_map. |
---|
1928 | And (match p with |
---|
1929 | [ None ⇒ True |
---|
1930 | | Some pol ⇒ And (And ( |
---|
1931 | (out_of_program_none program pol)) |
---|
1932 | (policy_isize_sum program (create_label_map program) pol)) |
---|
1933 | (policy_compact program (create_label_map program) pol) |
---|
1934 | ]) |
---|
1935 | (∃n.∀k.n < k → |
---|
1936 | policy_equal_opt program (\snd (pi1 ?? (jump_expansion_internal program k))) p). |
---|
1937 | #program @(\snd (pi1 ?? (jump_expansion_internal program (2*|program|)))) |
---|
1938 | cases daemon |
---|
1939 | |
---|
1940 | (* old proof |
---|
1941 | cases (dec_bounded_exists (λk.policy_equal (pi1 ?? program) |
---|
1942 | (\snd (pi1 ?? (jump_expansion_internal program k))) |
---|
1943 | (\snd (pi1 ?? (jump_expansion_internal program (S k))))) ? (2*|program|)) |
---|
1944 | cases daemon |
---|
1945 | [ #Hex elim Hex -Hex #x #Hx @(ex_intro … x) #k #Hk |
---|
1946 | @pe_trans |
---|
1947 | [ @(\snd (pi1 ?? (jump_expansion_internal program x))) |
---|
1948 | | @pe_sym @equal_remains_equal |
---|
1949 | [ @(proj2 ?? Hx) |
---|
1950 | | @le_S_S_to_le @le_S @Hk |
---|
1951 | ] |
---|
1952 | | @equal_remains_equal |
---|
1953 | [ @(proj2 ?? Hx) |
---|
1954 | | @le_S_S_to_le @le_S @(proj1 ?? Hx) |
---|
1955 | ] |
---|
1956 | ] |
---|
1957 | | #Hnex lapply (not_exists_forall … Hnex) -Hnex; #Hfa @(ex_intro … (2*|program|)) #k #Hk |
---|
1958 | @pe_sym @equal_remains_equal |
---|
1959 | [ lapply (refl ? (jump_expansion_internal program (2*|program|))) |
---|
1960 | cases (jump_expansion_internal program (2*|program|)) in ⊢ (???% → %); |
---|
1961 | #x cases x -x #Fch #Fpol normalize nodelta #HFpol cases Fpol in HFpol; normalize nodelta |
---|
1962 | [ (* if we're at None in 2*|program|, we're at None in S 2*|program| too *) |
---|
1963 | #HFpol #EQ whd in match (jump_expansion_internal ??); >EQ |
---|
1964 | normalize nodelta / by / |
---|
1965 | | #Fp #HFp #EQ whd in match (jump_expansion_internal ??); |
---|
1966 | >EQ normalize nodelta |
---|
1967 | lapply (refl ? (jump_expansion_step program (create_label_map program Fp) «Fp,?»)) |
---|
1968 | [ @HFp |
---|
1969 | | lapply (measure_full program Fp ?) |
---|
1970 | [ @le_to_le_to_eq |
---|
1971 | [ @measure_le |
---|
1972 | | cut (∀x:ℕ.x ≤ 2*|program| → |
---|
1973 | ∃p.(\snd (pi1 ?? (jump_expansion_internal program x)) = Some ? p ∧ |
---|
1974 | x ≤ measure_int program p 0)) |
---|
1975 | [ #x elim x |
---|
1976 | [ #Hx @(ex_intro ?? (jump_expansion_start program)) @conj |
---|
1977 | [ whd in match (jump_expansion_internal ??); @refl |
---|
1978 | | @le_O_n |
---|
1979 | ] |
---|
1980 | | -x #x #Hind #Hx |
---|
1981 | lapply (refl ? (jump_expansion_internal program (S x))) |
---|
1982 | cases (jump_expansion_internal program (S x)) in ⊢ (???% → %); |
---|
1983 | #z cases z -z #Sxch #Sxpol cases Sxpol -Sxpol normalize nodelta |
---|
1984 | [ #H #HeqSxpol @⊥ elim (le_to_eq_plus ?? Hx) #k #Hk |
---|
1985 | @(absurd … (step_none program (S x) ? k)) |
---|
1986 | [ >HeqSxpol / by / |
---|
1987 | | <Hk >EQ @nmk #H destruct (H) |
---|
1988 | ] |
---|
1989 | | #Sxpol #HSxpol #HeqSxpol @(ex_intro ?? Sxpol) @conj |
---|
1990 | [ @refl |
---|
1991 | | elim (Hind (transitive_le … (le_n_Sn x) Hx)) |
---|
1992 | #xpol #Hxpol @(le_to_lt_to_lt … (proj2 ?? Hxpol)) |
---|
1993 | lapply (measure_incr_or_equal program xpol program (le_n (|program|)) 0) |
---|
1994 | [ cases (jump_expansion_internal program x) in Hxpol; |
---|
1995 | #z cases z -z #xch #xpol normalize nodelta #H #H2 >(proj1 ?? H2) in H; |
---|
1996 | normalize nodelta / by / |
---|
1997 | | lapply (Hfa x Hx) lapply HeqSxpol -HeqSxpol |
---|
1998 | whd in match (jump_expansion_internal program (S x)); |
---|
1999 | lapply (refl ? (jump_expansion_internal program x)) |
---|
2000 | lapply Hxpol -Hxpol cases (jump_expansion_internal program x) in ⊢ (% → ???% → %); |
---|
2001 | #z cases z -z #xch #b normalize nodelta #H #Heq >(proj1 ?? Heq) in H; |
---|
2002 | #H #Heq cases xch in Heq; #Heq normalize nodelta |
---|
2003 | [ lapply (refl ? (jump_expansion_step program (create_label_map (pi1 ?? program) xpol) «xpol,H»)) |
---|
2004 | cases (jump_expansion_step ???) in ⊢ (???% → %); #z cases z -z #a #c |
---|
2005 | normalize nodelta cases c normalize nodelta |
---|
2006 | [ #H1 #Heq #H2 destruct (H2) |
---|
2007 | | #d #H1 #Heq #H2 destruct (H2) #Hfull #H2 elim (le_to_or_lt_eq … H2) |
---|
2008 | [ / by / |
---|
2009 | | #H3 lapply (measure_special program «xpol,H») >Heq |
---|
2010 | normalize nodelta #H4 @⊥ |
---|
2011 | @(absurd … (H4 H3)) |
---|
2012 | @Hfull |
---|
2013 | ] |
---|
2014 | ] |
---|
2015 | | lapply (refl ? (jump_expansion_step program (create_label_map (pi1 ?? program) xpol) «xpol,H»)) |
---|
2016 | cases (jump_expansion_step ???) in ⊢ (???% → %); #z cases z -z #a #c |
---|
2017 | normalize nodelta cases c normalize nodelta |
---|
2018 | [ #H1 #Heq #H2 #H3 #_ @⊥ @(absurd ?? H3) @pe_refl |
---|
2019 | | #d #H1 #Heq #H2 #H3 @⊥ @(absurd ?? H3) @pe_refl |
---|
2020 | ] |
---|
2021 | ] |
---|
2022 | ] |
---|
2023 | ] |
---|
2024 | ] |
---|
2025 | ] |
---|
2026 | | #H elim (H (2*|program|) (le_n ?)) #plp >EQ #Hplp |
---|
2027 | >(Some_eq ??? (proj1 ?? Hplp)) @(proj2 ?? Hplp) |
---|
2028 | ] |
---|
2029 | ] |
---|
2030 | | #Hfull cases (jump_expansion_step program (create_label_map program Fp) «Fp,?») in ⊢ (???% → %); |
---|
2031 | #x cases x -x #Gch #Gpol cases Gpol normalize nodelta |
---|
2032 | [ #H #EQ2 @⊥ @(absurd ?? H) @Hfull |
---|
2033 | | #Gp #HGp #EQ2 cases Fch |
---|
2034 | [ normalize nodelta #i #Hi |
---|
2035 | lapply (refl ? (lookup ?? (bitvector_of_nat 16 i) (\snd Fp) 〈0,0,short_jump〉)) |
---|
2036 | cases (lookup ?? (bitvector_of_nat 16 i) (\snd Fp) 〈0,0,short_jump〉) in ⊢ (???% → %); |
---|
2037 | #x cases x -x #p #a #j normalize nodelta #H |
---|
2038 | lapply (proj2 ?? (proj1 ?? (proj1 ?? (proj1 ?? (proj1 ?? HGp)))) i Hi) lapply (Hfull i Hi) >H |
---|
2039 | #H2 >H2 normalize nodelta cases (lookup ?? (bitvector_of_nat 16 i) (\snd Gp) 〈0,0,short_jump〉) |
---|
2040 | #x cases x -x #p #a #j' cases j' normalize nodelta #H elim H -H #H |
---|
2041 | [1,3: @⊥ @H |
---|
2042 | |2,4: destruct (H) |
---|
2043 | |5,6: @refl |
---|
2044 | ] |
---|
2045 | | normalize nodelta /2 by pe_int_refl/ |
---|
2046 | ] |
---|
2047 | ] |
---|
2048 | ] |
---|
2049 | ] |
---|
2050 | ] |
---|
2051 | | @le_S_S_to_le @le_S @Hk |
---|
2052 | ] |
---|
2053 | | #n cases (jump_expansion_internal program n) cases (jump_expansion_internal program (S n)) |
---|
2054 | #x cases x -x #nch #npol normalize nodelta #Hnpol |
---|
2055 | #x cases x -x #Sch #Spol normalize nodelta #HSpol |
---|
2056 | cases npol in Hnpol; cases Spol in HSpol; |
---|
2057 | [ #Hnpol #HSpol %1 // |
---|
2058 | |2,3: #x #Hnpol #HSpol %2 @nmk whd in match (policy_equal ???); // |
---|
2059 | #H destruct (H) |
---|
2060 | |4: #np #Hnp #Sp #HSp whd in match (policy_equal ???); @dec_bounded_forall #m |
---|
2061 | cases (bvt_lookup ?? (bitvector_of_nat 16 m) ? 〈0,0,short_jump〉) |
---|
2062 | #x cases x -x #x1 #x2 #x3 |
---|
2063 | cases (bvt_lookup ?? (bitvector_of_nat ? m) ? 〈0,0,short_jump〉) |
---|
2064 | #y cases y -y #y1 #y2 #y3 normalize nodelta |
---|
2065 | @dec_eq_jump_length |
---|
2066 | ] |
---|
2067 | ] *) |
---|
2068 | qed. |
---|
2069 | |
---|
2070 | nclude alias "arithmetics/nat.ma". |
---|
2071 | include alias "basics/logic.ma". |
---|
2072 | |
---|
2073 | check create_label_cost_map |
---|
2074 | |
---|
2075 | (* The glue between Policy and Assembly. *) |
---|
2076 | definition jump_expansion': |
---|
2077 | ∀program:preamble × (Σl:list labelled_instruction.|l| < 2^16). |
---|
2078 | option (Σsigma:Word → Word × bool. |
---|
2079 | ∀ppc: Word. |
---|
2080 | let pc ≝ \fst (sigma ppc) in |
---|
2081 | let labels ≝ \fst (create_label_cost_map (\snd program)) in |
---|
2082 | let lookup_labels ≝ λx. bitvector_of_nat ? (lookup_def ?? labels x 0) in |
---|
2083 | let instruction ≝ \fst (fetch_pseudo_instruction (\snd program) ppc) in |
---|
2084 | let next_pc ≝ \fst (sigma (add … ppc (bitvector_of_nat ? 1))) in |
---|
2085 | (nat_of_bitvector … ppc ≤ |\snd program| → |
---|
2086 | next_pc = add … pc (bitvector_of_nat … (instruction_size lookup_labels sigma ppc instruction))) |
---|
2087 | ∧ |
---|
2088 | ((nat_of_bitvector … ppc < |\snd program| → |
---|
2089 | nat_of_bitvector … pc < nat_of_bitvector … next_pc) |
---|
2090 | ∨ |
---|
2091 | (nat_of_bitvector … ppc = |\snd program| → next_pc = (zero …)))). |
---|
2092 | ≝ λprogram. |
---|
2093 | let policy ≝ pi1 … (je_fixpoint (\snd program)) in |
---|
2094 | match policy with |
---|
2095 | [ None ⇒ None ? |
---|
2096 | | Some x ⇒ Some ? |
---|
2097 | «λppc.let 〈pc,jl〉 ≝ bvt_lookup ?? ppc (\snd x) 〈0,short_jump〉 in |
---|
2098 | 〈bitvector_of_nat 16 pc,jmpeqb jl long_jump〉,?» |
---|
2099 | ]. |
---|
2100 | cases daemon |
---|
2101 | qed. |
---|