1 | include "basics/logic.ma". |
---|
2 | |
---|
3 | include "common/AST.ma". |
---|
4 | include "common/CostLabel.ma". |
---|
5 | include "common/FrontEndOps.ma". |
---|
6 | include "common/Registers.ma". |
---|
7 | |
---|
8 | include "ASM/Vector.ma". |
---|
9 | include "common/Graphs.ma". |
---|
10 | |
---|
11 | inductive statement : Type[0] ≝ |
---|
12 | | St_skip : label → statement |
---|
13 | | St_cost : costlabel → label → statement |
---|
14 | | St_const : register → constant → label → statement |
---|
15 | | St_op1 : ∀t,t'. unary_operation t' t → register → register → label → statement (* destination source *) |
---|
16 | | St_op2 : binary_operation → register → register → register → label → statement (* destination source1 source2 *) |
---|
17 | | St_load : memory_chunk → register → register → label → statement |
---|
18 | | St_store : memory_chunk → register → register → label → statement |
---|
19 | | St_call_id : ident → list register → option register → label → statement |
---|
20 | | St_call_ptr : register → list register → option register → label → statement |
---|
21 | | St_tailcall_id : ident → list register → statement |
---|
22 | | St_tailcall_ptr : register → list register → statement |
---|
23 | | St_cond : register → label → label → statement |
---|
24 | | St_jumptable : register → list label → statement |
---|
25 | | St_return : statement |
---|
26 | . |
---|
27 | |
---|
28 | definition env_has : list (register × typ) → register → typ → Prop ≝ |
---|
29 | λl,r,t. Exists ? (λx. 〈r,t〉 = x) l. |
---|
30 | |
---|
31 | definition statement_typed : list (register × typ) → statement → Prop ≝ |
---|
32 | λe,s. match s with |
---|
33 | [ St_op1 t t' _ r r' _ ⇒ env_has e r t ∧ env_has e r' t' |
---|
34 | | _ ⇒ True |
---|
35 | ]. |
---|
36 | |
---|
37 | definition labels_P : (label → Prop) → statement → Prop ≝ |
---|
38 | λP,s. match s with |
---|
39 | [ St_skip l ⇒ P l |
---|
40 | | St_cost _ l ⇒ P l |
---|
41 | | St_const _ _ l ⇒ P l |
---|
42 | | St_op1 _ _ _ _ _ l ⇒ P l |
---|
43 | | St_op2 _ _ _ _ l ⇒ P l |
---|
44 | | St_load _ _ _ l ⇒ P l |
---|
45 | | St_store _ _ _ l ⇒ P l |
---|
46 | | St_call_id _ _ _ l ⇒ P l |
---|
47 | | St_call_ptr _ _ _ l ⇒ P l |
---|
48 | | St_tailcall_id _ _ ⇒ True |
---|
49 | | St_tailcall_ptr _ _ ⇒ True |
---|
50 | | St_cond _ l1 l2 ⇒ P l1 ∧ P l2 |
---|
51 | | St_jumptable _ ls ⇒ All ? P ls |
---|
52 | | St_return ⇒ True |
---|
53 | ]. |
---|
54 | |
---|
55 | lemma labels_P_mp : ∀P,Q. (∀l. P l → Q l) → ∀s.labels_P P s → labels_P Q s. |
---|
56 | #P #Q #H * /3/ |
---|
57 | #r #l #l' * /3/ |
---|
58 | qed. |
---|
59 | |
---|
60 | definition labels_present : graph statement → statement → Prop ≝ |
---|
61 | λg,s. labels_P (present ?? g) s. |
---|
62 | |
---|
63 | definition forall_nodes : ∀A.∀P:A → Prop. graph A → Prop ≝ |
---|
64 | λA,P,g. ∀l,n. lookup ?? g l = Some ? n → P n. |
---|
65 | |
---|
66 | definition graph_closed : graph statement → Prop ≝ |
---|
67 | λg. forall_nodes ? (labels_present g) g. |
---|
68 | definition graph_typed : list (register × typ) → graph statement → Prop ≝ |
---|
69 | λe. forall_nodes ? (statement_typed e). |
---|
70 | |
---|
71 | record internal_function : Type[0] ≝ |
---|
72 | { f_labgen : universe LabelTag |
---|
73 | ; f_reggen : universe RegisterTag |
---|
74 | ; f_result : option (register × typ) |
---|
75 | ; f_params : list (register × typ) |
---|
76 | ; f_locals : list (register × typ) |
---|
77 | ; f_stacksize : nat |
---|
78 | ; f_graph : graph statement |
---|
79 | ; f_closed : graph_closed f_graph |
---|
80 | ; f_typed : graph_typed (f_locals @ f_params) f_graph |
---|
81 | ; f_entry : Σl:label. present ?? f_graph l |
---|
82 | ; f_exit : Σl:label. present ?? f_graph l |
---|
83 | }. |
---|
84 | |
---|
85 | (* Note that the global variables will be initialised by the code in main |
---|
86 | by this stage, so the only initialisation data is the amount of space to |
---|
87 | allocate. *) |
---|
88 | |
---|
89 | definition RTLabs_program ≝ program (λ_.fundef internal_function) nat. |
---|
90 | |
---|
91 | |
---|
92 | |
---|
93 | |
---|
94 | (* Define a notion of sound labellings of RTLabs programs. *) |
---|
95 | |
---|
96 | let rec successors (s : statement) : list label ≝ |
---|
97 | match s with |
---|
98 | [ St_skip l ⇒ [l] |
---|
99 | | St_cost _ l ⇒ [l] |
---|
100 | | St_const _ _ l ⇒ [l] |
---|
101 | | St_op1 _ _ _ _ _ l ⇒ [l] |
---|
102 | | St_op2 _ _ _ _ l ⇒ [l] |
---|
103 | | St_load _ _ _ l ⇒ [l] |
---|
104 | | St_store _ _ _ l ⇒ [l] |
---|
105 | | St_call_id _ _ _ l ⇒ [l] |
---|
106 | | St_call_ptr _ _ _ l ⇒ [l] |
---|
107 | | St_tailcall_id _ _ ⇒ [ ] |
---|
108 | | St_tailcall_ptr _ _ ⇒ [ ] |
---|
109 | | St_cond _ l1 l2 ⇒ [l1; l2] |
---|
110 | | St_jumptable _ ls ⇒ ls |
---|
111 | | St_return ⇒ [ ] |
---|
112 | ]. |
---|
113 | |
---|
114 | definition is_cost_label : statement → bool ≝ |
---|
115 | λs. match s with [ St_cost _ _ ⇒ true | _ ⇒ false ]. |
---|
116 | |
---|
117 | inductive steps_to_label_bound (g:graph statement) : label → nat → Prop ≝ |
---|
118 | | stlb_refl : ∀l,n,H. is_cost_label (lookup_present … g l H) → steps_to_label_bound g l n |
---|
119 | | stlb_step : ∀l,n,H. |
---|
120 | (∀l'. Exists label (λl0. l0 = l') (successors (lookup_present … g l H)) → steps_to_label_bound g l' n) → |
---|
121 | steps_to_label_bound g l (S n). |
---|
122 | |
---|
123 | discriminator nat. |
---|
124 | |
---|
125 | lemma steps_to_label_bound_inv_step : ∀g,l,n. |
---|
126 | steps_to_label_bound g l n → |
---|
127 | ∀H. ¬ (bool_to_Prop (is_cost_label (lookup_present … g l H))) → |
---|
128 | (∀l'. Exists label (λl0. l0 = l') (successors (lookup_present … g l H)) → steps_to_label_bound g l' (pred n)). |
---|
129 | #g #l0 #n0 #H1 inversion H1 |
---|
130 | [ #l #n #H2 #C #E1 #E2 #_ destruct #H3 #H4 @⊥ @(absurd ? C H4) |
---|
131 | | #l #n #H2 #IH #_ #E1 #E2 #_ destruct #H3 #NC @IH |
---|
132 | ] qed. |
---|
133 | |
---|
134 | definition soundly_labelled_pc ≝ λg,l. ∃n. steps_to_label_bound g l n. |
---|
135 | |
---|
136 | let rec soundly_labelled_fn (fn : internal_function) : Prop ≝ |
---|
137 | soundly_labelled_pc (f_graph fn) (f_entry fn). |
---|
138 | |
---|