1 | include "joint/Joint.ma". |
---|
2 | |
---|
3 | definition fresh_reg: |
---|
4 | ∀pars0,globals. joint_internal_function … (rtl_ertl_params pars0 globals) → (joint_internal_function … (rtl_ertl_params pars0 globals)) × register ≝ |
---|
5 | λpars0,globals,def. |
---|
6 | let 〈r,runiverse〉 ≝ fresh … (joint_if_runiverse … def) in |
---|
7 | 〈set_locals ?? (set_runiverse ?? def runiverse) (r::joint_if_locals ?? def), r〉. |
---|
8 | |
---|
9 | let rec fresh_regs (pars0:?) (globals: list ident) (def: joint_internal_function … (rtl_ertl_params pars0 globals)) (n: nat) on n ≝ |
---|
10 | match n with |
---|
11 | [ O ⇒ 〈def, [ ]〉 |
---|
12 | | S n' ⇒ |
---|
13 | let 〈def', regs'〉 ≝ fresh_regs pars0 globals def n' in |
---|
14 | let 〈def', reg〉 ≝ fresh_reg … def' in |
---|
15 | 〈def', reg :: regs'〉 |
---|
16 | ]. |
---|
17 | |
---|
18 | lemma fresh_regs_length: |
---|
19 | ∀pars0,globals.∀def: joint_internal_function … (rtl_ertl_params pars0 globals). ∀n: nat. |
---|
20 | |(\snd (fresh_regs … def n))| = n. |
---|
21 | #pars0 #globals #def #n elim n |
---|
22 | [ % |
---|
23 | | #m whd in ⊢ (? → ??(??%)?) whd in ⊢ (? → ??(??match % with [ _ ⇒ ?])?) |
---|
24 | cases (fresh_regs pars0 globals def m) normalize nodelta |
---|
25 | #def' #regs #EQ change in EQ with (|regs| = m) <EQ |
---|
26 | @refl |
---|
27 | ] |
---|
28 | qed. |
---|
29 | |
---|
30 | definition fresh_regs_strong: |
---|
31 | ∀pars0,globals. joint_internal_function … (rtl_ertl_params pars0 globals) → |
---|
32 | ∀n: nat. Σregs: (joint_internal_function … (rtl_ertl_params pars0 globals)) × (list register). |\snd regs| = n ≝ |
---|
33 | λpars0,globals,def,n.fresh_regs pars0 globals def n. // |
---|
34 | qed. |
---|
35 | |
---|
36 | definition fresh_label: |
---|
37 | ∀pars0,globals. joint_internal_function … (graph_params pars0 globals) → label × (joint_internal_function … (graph_params pars0 globals)) ≝ |
---|
38 | λpars0,globals,def. |
---|
39 | let 〈r,luniverse〉 ≝ fresh … (joint_if_luniverse … def) in |
---|
40 | 〈r,set_luniverse … def luniverse〉. |
---|
41 | |
---|
42 | let rec add_translates |
---|
43 | (pars1: params1) (globals: list ident) |
---|
44 | (translate_list: list ?) (start_lbl: label) (dest_lbl: label) |
---|
45 | (def: joint_internal_function … (graph_params pars1 globals)) |
---|
46 | on translate_list ≝ |
---|
47 | match translate_list with |
---|
48 | [ nil ⇒ add_graph … start_lbl (GOTO … dest_lbl) def |
---|
49 | | cons trans translate_list ⇒ |
---|
50 | match translate_list with |
---|
51 | [ nil ⇒ trans start_lbl dest_lbl def |
---|
52 | | _ ⇒ |
---|
53 | let 〈tmp_lbl, def〉 ≝ fresh_label … def in |
---|
54 | let def ≝ trans start_lbl tmp_lbl def in |
---|
55 | add_translates pars1 globals translate_list tmp_lbl dest_lbl def]]. |
---|
56 | |
---|
57 | definition adds_graph ≝ |
---|
58 | λpars1:params1.λglobals. λstmt_list: list (label → joint_statement (graph_params_ pars1) globals). |
---|
59 | add_translates … (map ?? (λf,start_lbl,dest_lbl. add_graph pars1 ? start_lbl (f dest_lbl)) stmt_list). |
---|