1 | |
---|
2 | (* Replace initialisation of global variables with equivalent Cminor code. *) |
---|
3 | |
---|
4 | include "Cminor/syntax.ma". |
---|
5 | include "common/Globalenvs.ma". |
---|
6 | |
---|
7 | (* XXX having to specify the return type in the match is annoying. *) |
---|
8 | definition init_expr : init_data → option (𝚺t:typ. expr t) ≝ |
---|
9 | λinit. |
---|
10 | match init return λ_.option (𝚺t:typ. expr t) with |
---|
11 | [ Init_int8 i ⇒ Some ? (mk_DPair ?? (ASTint I8 Unsigned) (Cst ? (Ointconst I8 Unsigned i))) |
---|
12 | | Init_int16 i ⇒ Some ? (mk_DPair ?? (ASTint I16 Unsigned) (Cst ? (Ointconst I16 Unsigned i))) |
---|
13 | | Init_int32 i ⇒ Some ? (mk_DPair ?? (ASTint I32 Unsigned) (Cst ? (Ointconst I32 Unsigned i))) |
---|
14 | | Init_float32 f ⇒ Some ? (mk_DPair ?? (ASTfloat F32) (Cst ? (Ofloatconst F32 f))) |
---|
15 | | Init_float64 f ⇒ Some ? (mk_DPair ?? (ASTfloat F64) (Cst ? (Ofloatconst F64 f))) |
---|
16 | | Init_space n ⇒ None ? |
---|
17 | | Init_null ⇒ Some ? (mk_DPair ?? ASTptr (Op1 (ASTint I8 Unsigned) ? (Optrofint ??) (Cst ? (Ointconst I8 Unsigned (zero ?))))) |
---|
18 | | Init_addrof id off ⇒ Some ? (mk_DPair ?? ASTptr (Cst ? (Oaddrsymbol id off))) |
---|
19 | ]. |
---|
20 | |
---|
21 | (* None of the additional code introduces locals, labels or returns. *) |
---|
22 | definition stmt_inv : stmt → Prop ≝ |
---|
23 | stmt_P (λs. stmt_vars (λ_.λ_.False) s ∧ stmt_labels (λ_.False) s ∧ match s with [ St_return _ ⇒ False | _ ⇒ True ]). |
---|
24 | |
---|
25 | discriminator option. |
---|
26 | discriminator DPair. |
---|
27 | |
---|
28 | (* Produces a few extra skips - hopefully the compiler will optimise these |
---|
29 | away. *) |
---|
30 | |
---|
31 | definition init_datum : ident → region → init_data → nat (*offset*) → Σs:stmt. stmt_inv s ≝ |
---|
32 | λid,r,init,off. |
---|
33 | match init_expr init with |
---|
34 | [ None ⇒ St_skip |
---|
35 | | Some x ⇒ |
---|
36 | match x with [ mk_DPair t e ⇒ |
---|
37 | St_store t (Cst ? (Oaddrsymbol id off)) e |
---|
38 | ] |
---|
39 | ]. |
---|
40 | % /3/ |
---|
41 | cases init in p; [ 7: | 8: #a #b | *: #a ] #p normalize in p; |
---|
42 | destruct;/4 by stmt_labels_mp, conj/ |
---|
43 | qed. |
---|
44 | |
---|
45 | definition init_var : ident → region → list init_data → Σs:stmt. stmt_inv s ≝ |
---|
46 | λid,r,init. |
---|
47 | \snd (foldr ?? |
---|
48 | (λdatum,os. |
---|
49 | let 〈off,s〉 ≝ os in |
---|
50 | 〈off + (size_init_data datum), St_seq (init_datum id r datum off) s〉) |
---|
51 | 〈0, mk_Sig ? (λx.stmt_inv x) St_skip ?〉 init). |
---|
52 | [ % /3/ |
---|
53 | | elim init |
---|
54 | [ % /3/ |
---|
55 | | #h #t #IH whd in ⊢ (?(???%)); @breakup_pair |
---|
56 | % |
---|
57 | [ /3/ |
---|
58 | | % [ @(pi2 … (init_datum …)) | @IH ] |
---|
59 | ] |
---|
60 | ] qed. |
---|
61 | |
---|
62 | definition init_vars : list (ident × region × (list init_data)) → Σs:stmt. stmt_inv s ≝ |
---|
63 | λvars. foldr ? (Σs:stmt. stmt_inv s) |
---|
64 | (λvar,s. mk_Sig ? (λx.stmt_inv x ) (St_seq s (init_var (\fst (\fst var)) (\snd (\fst var)) (\snd var))) ?) (mk_Sig ? (λx.stmt_inv x ) St_skip ?) vars. |
---|
65 | [ % [ /3/ | % [ @(pi2 … s) | @(pi2 … (init_var …)) ] ] |
---|
66 | | /4/ |
---|
67 | ] qed. |
---|
68 | |
---|
69 | lemma no_labels : ∀s. stmt_inv s → labels_of s = [ ]. |
---|
70 | #s elim s // |
---|
71 | [ #s1 #s2 #IH1 #IH2 * #_ * #H1 #H2 whd in ⊢ (??%?); |
---|
72 | >(IH1 H1) >(IH2 H2) @refl |
---|
73 | | #sz #sg #e #s1 #s2 #IH1 #IH2 * #_ * #H1 #H2 whd in ⊢ (??%?); |
---|
74 | >(IH1 H1) >(IH2 H2) @refl |
---|
75 | | #l #s #IH * * * #_ * |
---|
76 | | #l #s #IH * #_ #H @(IH H) |
---|
77 | ] qed. |
---|
78 | |
---|
79 | (* FIXME: we need to add a new initialisation function instead of augmenting |
---|
80 | main, because this currently breaks a recursive main function. *) |
---|
81 | |
---|
82 | definition add_statement : costlabel → ident → (Σs:stmt. stmt_inv s) → |
---|
83 | list (ident × (fundef internal_function)) → |
---|
84 | list (ident × (fundef internal_function)) ≝ |
---|
85 | λcost,id,s. match s with [ mk_Sig s H ⇒ |
---|
86 | map ?? |
---|
87 | (λidf. |
---|
88 | let 〈id',f'〉 ≝ idf in |
---|
89 | match ident_eq id id' with |
---|
90 | [ inl _ ⇒ |
---|
91 | match f' with |
---|
92 | [ Internal f ⇒ 〈id, Internal ? (mk_internal_function |
---|
93 | (f_return f) |
---|
94 | (f_params f) |
---|
95 | (f_vars f) |
---|
96 | (f_distinct f) |
---|
97 | (f_stacksize f) |
---|
98 | (St_cost cost (St_seq s (f_body f))) |
---|
99 | ?)〉 |
---|
100 | | External f ⇒ 〈id, External ? f〉 (* Error ? *) |
---|
101 | ] |
---|
102 | | inr _ ⇒ 〈id',f'〉 ]) ]. |
---|
103 | % |
---|
104 | [ % // |
---|
105 | | % |
---|
106 | [ % // |
---|
107 | | % [ @(stmt_P_mp … H) #s * * #V #L #R % |
---|
108 | [ @(stmt_vars_mp … V) #i #t * |
---|
109 | | @(stmt_labels_mp … L) #l * |
---|
110 | | cases s in R ⊢ %; // #x * |
---|
111 | ] |
---|
112 | | whd in match (labels_of ?); >(no_labels … H) @(f_inv f) |
---|
113 | ] |
---|
114 | ] |
---|
115 | ] qed. |
---|
116 | |
---|
117 | definition empty_vars : list (ident × region × (list init_data)) → |
---|
118 | list (ident × region × nat) ≝ |
---|
119 | map ?? (λv. 〈〈\fst (\fst v), \snd (\fst v)〉, |
---|
120 | size_init_data_list (\snd v)〉). |
---|
121 | |
---|
122 | definition replace_init : costlabel → Cminor_program → Cminor_noinit_program ≝ |
---|
123 | λcost,p. |
---|
124 | mk_program ?? |
---|
125 | (empty_vars (prog_vars ?? p)) |
---|
126 | (add_statement cost (prog_main ?? p) (init_vars (prog_vars ?? p)) (prog_funct ?? p)) |
---|
127 | (prog_main ?? p). |
---|