source: src/joint/linearise.ma @ 2473

Last change on this file since 2473 was 2473, checked in by tranquil, 8 years ago

put some generic stuff we need in the back end in extraGlobalenvs (with some axioms that are
in the commented section of Globalenvs)
linearise now has a full spec

File size: 27.3 KB
Line 
1include "joint/TranslateUtils.ma".
2include "common/extraGlobalenvs.ma".
3include "utilities/hide.ma".
4
5definition graph_to_lin_statement :
6  ∀p : unserialized_params.∀globals.
7  joint_statement (mk_graph_params p) globals → joint_statement (mk_lin_params p) globals ≝
8  λp,globals,stmt.match stmt return λ_.joint_statement (mk_lin_params ?) ? with
9  [ sequential c _ ⇒ sequential … c it
10  | final c ⇒ final … c
11  ].
12
13lemma graph_to_lin_labels :
14  ∀p : unserialized_params.∀globals,s.
15  stmt_labels … (graph_to_lin_statement p globals s) =
16  stmt_explicit_labels … s.
17#p#globals * [//] * //
18qed.
19
20(* discard all elements passing test, return first element failing it *)
21(* and the rest of the list, if any. *)
22let rec chop A (test : A → bool) (l : list A) on l : option (A × (list A)) ≝
23  match l with
24  [ nil ⇒ None ?
25  | cons x l' ⇒ if test x then chop A test l' else return 〈x, l'〉
26  ].
27
28lemma chop_ok : ∀A,f,l.
29  match chop A f l with
30  [ Some pr ⇒
31    let x ≝ \fst pr in
32    let post ≝ \snd pr in
33    ∃pre.All ? (λx.bool_to_Prop (f x)) pre ∧
34    l = pre @ x :: post ∧ ¬bool_to_Prop (f x)
35  | None ⇒ All A (λx.bool_to_Prop (f x)) l
36  ].
37#A #f #l elim l
38[ %
39| #hd #tl #IH whd in match (chop ???);
40  elim (true_or_false_Prop (f hd)) #H >H normalize nodelta
41  [ lapply IH elim (chop ???) normalize nodelta
42    [ #G %{H G}
43    | #pr * #pre ** #H1 #H2 #H3 %{(hd :: pre)} %{H3} %
44      [ %{H H1}
45      | >H2 %
46      ]
47    ]
48  | %{[ ]} %{H} %%
49  ]
50]
51qed.
52 
53unification hint 0 ≔ p, globals;
54lp ≟ lin_params_to_params p,
55sp ≟ stmt_pars lp,
56js ≟ joint_statement sp globals,
57lo ≟ labelled_obj LabelTag js
58(*----------------------------*)⊢
59list lo ≡ codeT lp globals.
60
61
62definition graph_visit_ret_type ≝ λp,globals.λg : codeT (mk_graph_params p) globals.
63  λentry : label.
64  (Σ〈visited'   : identifier_map LabelTag ℕ,
65   required'  : identifier_set LabelTag,
66   generated' : codeT (mk_lin_params p) globals〉.'hide (
67      And (And (And (And
68        (lookup ?? visited' entry = Some ? 0)
69        (required' ⊆ visited'))
70        (∃last.stmt_at … generated' 0 = Some ? (final … last)))
71        (code_forall_labels … (λl.bool_to_Prop (l∈required')) (rev … generated')))
72        (∀l,n.lookup ?? visited' l = Some ? n →
73          And (bool_to_Prop (code_has_label … (rev ? generated') l))
74            (∃s.And (And
75              (lookup … g l = Some ? s)
76              (nth_opt … n (rev … generated') = Some ? 〈Some ? l, graph_to_lin_statement … s〉))
77              (opt_All ?
78                (λnext.Or (lookup … visited' next = Some ? (S n))
79                  (nth_opt … (S n) (rev … generated') = Some ? 〈None ?, GOTO … next〉))
80                (stmt_implicit_label … s)))))).
81               
82unification hint 0 ≔ tag ⊢ identifier_set tag ≡ identifier_map tag unit.
83
84include alias "common/Identifiers.ma".
85
86lemma lookup_safe_elim : ∀tag,A.∀P : A → Prop.∀m,i,prf.
87  (∀x.lookup tag A m i = Some ? x → P x) → P (lookup_safe tag A m i prf).
88#tag #A #P #m #i #prf #H @H @lookup_eq_safe qed.
89
90let rec graph_visit
91  (p : unserialized_params)
92  (globals: list ident)
93  (g : codeT (mk_graph_params p) globals)
94  (* = graph (joint_statement (mk_graph_params p) globals *)
95  (required: identifier_set LabelTag)
96  (visited: identifier_map LabelTag ℕ) (* the reversed index of labels in the new code *)
97  (generated: codeT (mk_lin_params p) globals)
98  (* ≝ list ((option label)×(joint_statement (mk_lin_params p) globals)) *)
99  (visiting: list label)
100  (gen_length : ℕ)
101  (n: nat)
102  (entry : label)
103  (g_prf : code_closed … g)
104  (required_prf1 : ∀i.i∈required → Or (In ? visiting i) (bool_to_Prop (i∈visited)))
105  (required_prf2 : code_forall_labels … (λl.bool_to_Prop (l ∈ required)) (rev … generated))
106  (generated_prf1 : ∀l,n.lookup … visited l = Some ? n → hide_Prop (
107    And (bool_to_Prop (code_has_label … (rev ? generated) l))
108    (∃s.And (And
109      (lookup … g l = Some ? s)
110      (nth_opt ? n (rev … generated) = Some ? 〈Some ? l, graph_to_lin_statement … s〉))
111      (opt_All ? (λnext.match lookup … visited next with
112                     [ Some n' ⇒ Or (n' = S n) (nth_opt ? (S n) (rev ? generated) = Some ? 〈None ?, GOTO … next〉)
113                     | None ⇒ And (nth_opt ? 0 visiting = Some ? next) (S n = gen_length) ]) (stmt_implicit_label … s)))))
114  (generated_prf2 : ∀l.lookup … visited l = None ? → does_not_occur … l (rev ? generated))
115  (generated_prf3 : (∃last.stmt_at … generated 0 = Some ? (final … last)) ∨
116     (¬All ? (λx.bool_to_Prop (x∈visited)) visiting))
117  (visiting_prf : All … (λl.bool_to_Prop (l∈g)) visiting)
118  (gen_length_prf : gen_length = length ? generated)
119  (entry_prf : Or (And (And (visiting = [entry]) (gen_length = 0)) (Not (bool_to_Prop (entry∈visited))))
120                  (lookup … visited entry = Some ? 0))
121  (n_prf : le (id_map_size … g) (plus n (id_map_size … visited)))
122  on n
123  : graph_visit_ret_type … g entry ≝
124  match chop ? (λx.x∈visited) visiting
125  return λx.? → graph_visit_ret_type … g entry with
126  [ None ⇒ λH.
127    «〈visited, required, generated〉, ?»
128  | Some pr ⇒ λH.
129    let vis_hd ≝ \fst pr in
130    let vis_tl ≝ \snd pr in
131    match n return λx.? → graph_visit_ret_type … g entry with
132    [ O ⇒ λn_prf'.⊥
133    | S n' ⇒ λn_prf'.
134      (* add the label to the visited ones *)
135      let visited' ≝ add … visited vis_hd gen_length in
136      (* take l's statement *)
137      let hd_vis_in_g ≝ (hide_prf ? ?) in
138      let statement ≝ lookup_safe ?? g vis_hd hd_vis_in_g in 
139      (* translate it to its linear version *)
140      let translated_statement ≝ graph_to_lin_statement p globals statement in
141      (* add the translated statement to the code (which will be reversed later) *)
142      let generated' ≝ 〈Some … vis_hd, translated_statement〉 :: generated in
143      let required' ≝ union_set ??? (set_from_list … (stmt_explicit_labels … statement)) required in
144      (* put successors in the visiting worklist *)
145      let visiting' ≝ stmt_labels … statement @ vis_tl in
146      (* finally, check the implicit successor *)
147      (* if it has been already visited, we need to add a GOTO *)
148      let add_req_gen ≝
149        match stmt_implicit_label … statement
150        with
151        [ Some next ⇒
152          if next ∈ visited' then
153            〈1, {(next)}, [〈None label, (GOTO … next : joint_statement ??)〉]〉
154          else 〈0, ∅, [ ]〉
155        | None ⇒ 〈0, ∅, [ ]〉
156        ] in
157      (* prepare a common utility to deal with add_req_gen *)
158      let add_req_gen_prf :
159        ∀P : (ℕ × (identifier_set LabelTag) × (codeT (mk_lin_params p) globals)) → Prop.
160        (opt_All ? (λnext.¬bool_to_Prop (next ∈ visited')) (stmt_implicit_label … statement) →
161         P 〈0,∅,[ ]〉) →
162        (∀next.stmt_implicit_label … statement = Some ? next →
163          next ∈ visited' →
164          P 〈1, {(next)}, [〈None ?, GOTO (mk_lin_params p) next〉]〉) →
165        P add_req_gen ≝ hide_prf ?? in
166      graph_visit ???
167        (union_set ??? (\snd (\fst add_req_gen)) required')
168        visited'
169        (\snd add_req_gen @ generated')
170        visiting'
171        (plus (\fst (\fst add_req_gen)) (S gen_length))
172        n' entry g_prf ?????????
173    ] n_prf
174  ] (chop_ok ? (λx.x∈visited) visiting).
175whd
176[ (* base case, visiting is all visited *)
177  %[%[%[%]]]
178  [ elim entry_prf
179    [ ** #eq_visiting #gen_length_O #entry_vis >eq_visiting in H; * >entry_vis *
180    | //
181    ]
182  | #l #l_req
183    elim (required_prf1 … l_req) #G
184    [ @(All_In … H G)
185    | assumption
186    ]
187  | cases generated_prf3 [//]
188    * #ABS @⊥ @ABS assumption
189  | assumption
190  | #l #n #H elim (generated_prf1 … H)
191    #H1 * #s ** #H2 #H3 #H4
192    % [assumption] %{s} %
193    [% assumption
194    | @(opt_All_mp … H4) -l #l
195      lapply (in_map_domain … visited l)
196      elim (true_or_false_Prop (l∈visited)) #l_vis >l_vis
197      normalize nodelta [ * #n' ] #EQlookup >EQlookup
198      normalize nodelta *
199      [ #EQn' % >EQn' %
200      | #H %2{H}
201      | #H' lapply (All_nth … H … H') >l_vis *
202      ]
203    ]
204  ]
205(* first, close goals where add_gen_req plays no role *)
206|13: (* vis_hd is in g *)
207  elim H #pre ** #_ #H2 #_
208  @(All_split … visiting_prf … H2)
209|2: (* n = 0 absrud *)
210  elim H #pre ** #_ #H2 #H3
211  @(absurd … n_prf')
212  @lt_to_not_le
213  lapply (add_size … visited vis_hd 0 (* dummy value *))
214  >H3 normalize nodelta
215  whd in match (lt ? ?);
216  whd in match (1 + ?);
217  #EQ <EQ @subset_card @add_subset
218  [ @(All_split ? (λx.bool_to_Prop (x∈g)) ????? H2) @(All_mp … visiting_prf)
219    #a elim g #gm whd in ⊢ (?→?%); #H >(lookup_eq_safe … H) %
220  | #l #H
221    elim (generated_prf1 … (lookup_eq_safe … H)) #_ * #s ** #s_in_g #_ #_
222    whd in ⊢ (?%); >s_in_g %
223  ]
224|8:
225  elim H #pre ** #_ #H2 #_
226  @All_append
227  [ elim(g_prf … vis_hd statement ?) [2:@lookup_eq_safe] #G1 #G2
228    @(All_append … G1)
229    whd in G2; lapply G2 elim statement normalize nodelta #s [2: #_ %]
230    #l #G' %{G'} %
231  | >H2 in visiting_prf;
232    #H' lapply (All_append_r … H') -H' * #_ //
233  ]
234|10:
235  elim H #pre ** #_ #H2 #H3 -add_req_gen_prf
236  %2 elim entry_prf
237  [ ** >H2 cases pre
238    [2: #x' #pre' #ABS normalize in ABS; destruct(ABS)
239      cases pre' in e0; [2: #x'' #pre''] #ABS' normalize in ABS'; destruct(ABS')
240    |1: #EQ normalize in EQ; destruct(EQ)
241      #eq_gen_length #_
242      >lookup_add_hit >eq_gen_length %
243    ]
244  | #lookup_entry cut (entry ≠ vis_hd)
245    [ % whd in match vis_hd; #entry_vis_hd <entry_vis_hd in H3;
246      whd in ⊢ (?(?%)→?); >lookup_entry * #ABS @ABS % ]
247    #entry_not_vis_hd >(lookup_add_miss ?????? entry_not_vis_hd) assumption
248  ]
249|11:
250  elim H #pre ** #_ #_ #H3
251  >commutative_plus
252  >add_size >H3 normalize nodelta
253  whd in match (1 + ?);
254  >commutative_plus
255  assumption
256|12: (* add_req_gen utility *)
257  #P whd in match add_req_gen;
258  elim (stmt_implicit_label ???)
259  [ #H #_ @H % ]
260  #next normalize nodelta elim (true_or_false_Prop (next ∈ visited')) #next_vis
261  >next_vis normalize nodelta
262  [ #_ #H @H [% | assumption]
263  | #H #_ @H whd >next_vis % *
264  ]
265| elim H #pre ** #H1 #H2 #_
266  #i >mem_set_union
267  #H elim (orb_Prop_true … H) -H
268  [ @add_req_gen_prf [ #_ >mem_set_empty * ]
269    #next #_ #next_vis #H >(mem_set_singl_to_eq … H) %2 assumption
270  | >mem_set_union
271    #H elim (orb_Prop_true … H) -H
272    [ #i_expl %1 @Exists_append_l @Exists_append_r
273      @mem_list_as_set
274      @i_expl
275    | (* i was already required *)
276      #i_req
277      elim (required_prf1 … i_req)
278      [ >H2 #H elim (Exists_append … H) -H
279        [ (* i in preamble → i∈visited *)
280          #i_pre %2 >mem_set_add @orb_Prop_r
281          lapply (All_In … H1 i_pre) #H @H
282        | *
283          [ (* i is vis_hd *)
284            #eq_i >eq_i %2 @mem_set_add_id
285          | (* i in vis_tl → i∈visiting' *)
286            #i_post % @Exists_append_r assumption
287          ]
288        ]
289      | (* i in visited *)
290        #i_vis %2 >mem_set_add @orb_Prop_r assumption
291      ]
292    ]
293  ]
294|4,5,6: change with reverse in match rev;
295  >reverse_append whd in match (reverse ??); >rev_append_def
296  >associative_append
297  [ #pt #s
298    @(leb_elim (S pt) (|generated|)) #cmp
299    whd in match (stmt_at ????);
300    [ >nth_opt_append_l [2: >length_reverse assumption ]
301      change with (stmt_at ???? = ? → ?)
302      #EQ lapply(required_prf2 … EQ) @All_mp
303      #l #l_req >mem_set_union @orb_Prop_r
304      >mem_set_union @orb_Prop_r @l_req
305    | >nth_opt_append_r [2: >length_reverse @not_lt_to_le assumption ]
306      cases (pt - ?)
307      [ whd in match (nth_opt ???); whd in ⊢ (??%?→?);
308        #EQ destruct(EQ) whd
309        >graph_to_lin_labels in ⊢ (???%);
310        whd in match required';
311        generalize in match (stmt_explicit_labels … statement);
312        #l @list_as_set_All
313        #i >mem_set_union >mem_set_union
314        #i_l @orb_Prop_r @orb_Prop_l @i_l
315      | @add_req_gen_prf
316        [ #_ | #next #_ #next_vis *
317          [ whd in ⊢ (??%?→?);
318            #EQ' destruct(EQ') whd %{I} >mem_set_union
319            @orb_Prop_l @mem_set_add_id ]]
320        #n whd in ⊢ (??%?→?); #ABS destruct(ABS)
321      ]
322    ]
323  | elim H #pre ** #H1 #H2 #H3
324    #i whd in match visited';
325    @(eq_identifier_elim … i vis_hd)
326    [ #EQi >EQi -i #pos
327      >lookup_add_hit #EQpos (* too slow: destruct(EQpos) *)
328      cut (gen_length = pos)
329      [1,3,5: (* BUG: -graph_visit *) -visited destruct(EQpos) %]
330      -EQpos #EQpos <EQpos -pos
331      %
332      [ >lin_code_has_label
333        @add_req_gen_prf
334        [ #_
335        | #next #_ #next_vis
336          change with (? @ ([?] @ [?])) in match (? @ [? ; ?]);
337          <associative_append >occurs_exactly_once_None
338        ]
339        >occurs_exactly_once_Some_eq >eq_identifier_refl
340        normalize nodelta
341        @generated_prf2
342        lapply (in_map_domain … visited vis_hd)
343        >H3 normalize nodelta //
344      | %{statement}
345        % [ % ]
346        [ @lookup_eq_safe
347        | <associative_append @nth_opt_append_hit_l
348          >nth_opt_append_r
349          >rev_length
350          <gen_length_prf
351          [<minus_n_n] %
352        | @add_req_gen_prf
353          [ lapply (refl … (stmt_implicit_label ?? statement))
354            cases (stmt_implicit_label ???) in ⊢ (???%→%);
355            [#_ #_ %]
356            #next #K change with (¬bool_to_Prop (?∈?)→?) #next_vis
357          | #next #K >K #next_vis
358          ] whd
359          >mem_set_add in next_vis;
360          @eq_identifier_elim
361          [1,3: #EQnext >EQnext * [#ABS elim(ABS I)]
362            >lookup_add_hit
363          |*: #NEQ >(lookup_add_miss … visited … NEQ)
364            change with (?∈?) in match (false∨?);
365            #next_vis lapply(in_map_domain … visited next) >next_vis
366            whd in ⊢ (% → ?); [2: * #s ]
367            #EQlookup >EQlookup
368          ] whd
369          [1,2: %2 <associative_append
370            >nth_opt_append_r >append_length >rev_length >commutative_plus
371            <gen_length_prf
372            [1,3: <minus_n_n ] %
373          | % [2: %] @nth_opt_append_hit_l whd in match (stmt_labels … statement);
374            >K %
375          ]
376        ]
377      ]
378    | #NEQ #n_i >(lookup_add_miss … visited … NEQ)
379      #Hlookup elim (generated_prf1 … Hlookup)
380      #G1 * #s ** #G2 #G3 #G4
381      %
382      [ >lin_code_has_label <associative_append
383        >occurs_exactly_once_append
384        @orb_Prop_l @andb_Prop
385        [ >occurs_exactly_once_Some_eq
386          >eq_identifier_false [2: % #ABS >ABS in NEQ; * #ABS' @ABS' % ]
387          normalize nodelta >lin_code_has_label in G1; #K @K
388        | @add_req_gen_prf
389          [ #_ % | #next #_ #_ % ]
390        ]
391      | %{s}
392        % [ % ]
393        [ assumption
394        | @nth_opt_append_hit_l assumption
395        | @(opt_All_mp … G4)
396          #x
397          @(eq_identifier_elim … x vis_hd) #Heq
398          [ >Heq
399            lapply (in_map_domain … visited vis_hd)
400            >H3 normalize nodelta in ⊢ (%→?);
401            #EQlookup >EQlookup * #nth_opt_visiting #gen_length_eq
402            >lookup_add_hit %1 >gen_length_eq %
403          | >(lookup_add_miss ?????? Heq)
404            lapply (in_map_domain … visited x)
405            elim (true_or_false_Prop (x∈visited)) #x_vis >x_vis
406            normalize nodelta in ⊢ (%→?); [ * #n' ]
407            #EQlookupx >EQlookupx whd in ⊢ (%→%); *
408            [ #G %1{G}
409            | #G %2 @nth_opt_append_hit_l
410              assumption
411            | #G elim(absurd ?? Heq)
412              (* BUG (but useless): -required -g -generated *)
413              >H2 in G; lapply H1 cases pre
414              [ #_
415              | #hd #tl * #hd_vis #_
416              ] normalize #EQ' destruct(EQ')
417              [ %
418              | >x_vis in hd_vis; *
419              ]
420            ]
421          ]
422        ]
423      ]
424    ]
425  | #i whd in match visited';
426    @(eq_identifier_elim … i vis_hd) #Heq
427    [ >Heq >lookup_add_hit #ABS destruct(ABS) ]
428    >(lookup_add_miss ?????? Heq)
429    #i_n_vis
430    >does_not_occur_append @andb_Prop
431    [ @generated_prf2 assumption
432    | change with (bool_to_Prop (¬eq_identifier ??? ∧ ?))
433      >eq_identifier_false [2: % #ABS <ABS in Heq; * #ABS' @ABS' % ]
434      @add_req_gen_prf [ #_ | #next #_ #_ ] %
435    ]
436  ]
437| @add_req_gen_prf
438  [ #K | #next #K #next_vis %1 %{(GOTO … next)} % ]
439  whd in match generated'; whd in match translated_statement;
440  lapply K whd in match visiting';
441  whd in match (stmt_labels ???); cases statement #last
442  [2: #_ %1 %{last} % ] #next whd in ⊢ (%→?); #next_vis
443  %2 % * >next_vis *
444| whd in match generated';
445  @add_req_gen_prf [ #_ | #next #_ #_ ] normalize >gen_length_prf %
446]
447qed.
448
449(* CSC: The branch compression (aka tunneling) optimization is not implemented
450   in Matita *)
451definition branch_compress
452  ≝ λp: graph_params.λglobals.λg:codeT p globals.
453    λentry : Σl.bool_to_Prop (code_has_label … g l).g.
454 
455lemma branch_compress_closed : ∀p,globals,g,l.code_closed ?? g →
456  code_closed … (branch_compress p globals g l).
457#p#globals#g#l#H @H qed.
458
459lemma branch_compress_has_entry : ∀p,globals,g,l.
460  code_has_label … (branch_compress p globals g l) l.
461#p#globals#g*#l#l_prf @l_prf qed.
462
463definition filter_labels ≝ λtag,A.λtest : identifier tag → bool.λc : list (labelled_obj tag A).
464  map ??
465    (λs. let 〈l_opt,x〉 ≝ s in
466      〈! l ← l_opt ; if test l then return l else None ?, x〉) c.
467     
468lemma does_not_occur_filter_labels :
469  ∀tag,A,test,id,c.
470    does_not_occur ?? id (filter_labels tag A test c) =
471      (does_not_occur ?? id c ∨ ¬ test id).
472#tag #A #test #id #c elim c
473[ //
474| ** [2: #lbl] #s #tl #IH
475  whd in match (filter_labels ????); normalize nodelta
476  whd in match (does_not_occur ????) in ⊢ (??%%);
477  [2: @IH]
478  normalize in match (! l ← ? ; ?); >IH
479  @(eq_identifier_elim ?? lbl id) #Heq [<Heq]
480  elim (test lbl) normalize nodelta
481  change with (eq_identifier ???) in match (instruction_matches_identifier ????);
482  [1,2: >eq_identifier_refl [2: >commutative_orb] normalize %
483  |*: >(eq_identifier_false ??? Heq) normalize nodelta %
484  ]
485]
486qed.
487
488lemma occurs_exactly_once_filter_labels :
489  ∀tag,A,test,id,c.
490    occurs_exactly_once ?? id (filter_labels tag A test c) =
491      (occurs_exactly_once ?? id c ∧ test id).
492#tag #A #test #id #c elim c
493[ //
494| ** [2: #lbl] #s #tl #IH
495  whd in match (filter_labels ????); normalize nodelta
496  whd in match (occurs_exactly_once ????) in ⊢ (??%%);
497  [2: @IH]
498  normalize in match (! l ← ? ; ?); >IH
499  >does_not_occur_filter_labels
500  @(eq_identifier_elim ?? lbl id) #Heq [<Heq]
501  elim (test lbl) normalize nodelta
502  change with (eq_identifier ???) in match (instruction_matches_identifier ????);
503  [1,2: >eq_identifier_refl >commutative_andb [ >(commutative_andb ? true) >commutative_orb | >(commutative_andb ? false)] normalize %
504  |*: >(eq_identifier_false ??? Heq) normalize nodelta %
505  ]
506]
507qed.
508
509lemma nth_opt_filter_labels : ∀tag,A,test,instrs,n.
510  nth_opt ? n (filter_labels tag A test instrs) =
511  ! 〈lopt, s〉 ← nth_opt ? n instrs ;
512  return 〈 ! lbl ← lopt; if test lbl then return lbl else None ?, s〉.
513#tag #A #test #instrs elim instrs
514[ * [2: #n'] %
515| * #lopt #s #tl #IH * [2: #n']
516  whd in match (filter_labels ????); normalize nodelta
517  whd in match (nth_opt ???) in ⊢ (??%%); [>IH] %
518]
519qed.
520
521lemma stmt_at_filter_labels : ∀p : lin_params.∀globals,test.∀c : codeT p globals.
522∀i.stmt_at p globals (filter_labels ?? test c) i = stmt_at p globals c i.
523#p#globals#test #c#i
524whd in ⊢ (??%%); >nth_opt_filter_labels
525elim (nth_opt ???); //
526qed.
527
528lemma option_bind_inverse : ∀A,B.∀m : option A.∀f : A → option B.∀r.
529  ! x ← m ; f x = return r →
530  ∃x.m = return x ∧ f x = return r.
531#A #B * normalize [2:#x] #f #r #EQ destruct
532%{x} %{EQ} %
533qed.
534
535lemma nth_opt_reverse_hit :
536  ∀A,l,n.n < |l| → nth_opt A n (reverse ? l) = nth_opt A (|l| - (S n)) l.
537#A #l elim l
538[ #n #ABS normalize in ABS; @⊥ -A /2 by absurd/
539| #hd #tl #IH #n #lim whd in match (reverse ??); >rev_append_def
540  @(leb_elim (S n) (|tl|)) #H
541  [ >nth_opt_append_l [2: >length_reverse @H ]
542    >(IH … H) >(minus_Sn_m … H) %
543  | >(le_to_le_to_eq … (le_S_S_to_le … lim) (not_lt_to_le … H))
544    >nth_opt_append_r >length_reverse [2: % ]
545    <minus_n_n <minus_n_n %
546  ]
547]
548qed.
549
550lemma nth_opt_reverse_hit_inv :
551  ∀A,l,n.n < |l| → nth_opt A (|l| - (S n)) (reverse ? l) = nth_opt A n l.
552#A #l #n #H <(reverse_reverse ? l) in ⊢ (???%); @sym_eq
553<length_reverse @nth_opt_reverse_hit >length_reverse @H
554qed.
555
556
557definition good_local_sigma :
558  ∀p:unserialized_params.
559  ∀globals.
560  ∀g:codeT (mk_graph_params p) globals.
561  (Σl.bool_to_Prop (code_has_label … g l)) →
562  codeT (mk_lin_params p) globals →
563  (label → option ℕ) → Prop ≝
564  λp,globals,g,entry,c,sigma.
565    sigma entry = Some ? 0 ∧
566    ∀l,n.sigma l = Some ? n →
567      ∃s. lookup … g l = Some ? s ∧
568        opt_Exists ?
569          (λls.let 〈lopt, ts〉 ≝ ls in
570            opt_All ? (eq ? l) lopt ∧
571            ts = graph_to_lin_statement … s ∧
572            opt_All ?
573              (λnext.Or (sigma next = Some ? (S n))
574              (nth_opt … (S n) c = Some ? 〈None ?, GOTO … next〉))
575              (stmt_implicit_label … s)) (nth_opt … n c).
576
577definition linearise_code:
578 ∀p : unserialized_params.∀globals.
579  ∀g : codeT (mk_graph_params p) globals.code_closed … g →
580  ∀entry : (Σl.bool_to_Prop (code_has_label … g l))
581  .Σ〈c, sigma〉.
582    good_local_sigma … g entry c sigma ∧
583    code_closed … c
584       (* ∧
585      ∃ sigma : identifier_map LabelTag ℕ.
586      lookup … sigma entry = Some ? 0 ∧
587      ∀l,n.lookup … sigma l = Some ? n →
588        ∃s. lookup … g l = Some ? s ∧
589          opt_Exists ?
590            (λls.let 〈lopt, ts〉 ≝ ls in
591              opt_All ? (eq ? l) lopt ∧
592              ts = graph_to_lin_statement … s ∧
593              opt_All ?
594                (λnext.Or (lookup … sigma next = Some ? (S n))
595                (nth_opt … (S n) c = Some ? 〈None ?, GOTO … next〉))
596                (stmt_implicit_label … s)) (nth_opt … n c)*)
597
598 λp,globals,g,g_prf,entry_sig.
599    let g ≝ branch_compress (mk_graph_params p) ? g entry_sig in
600    let g_prf ≝ branch_compress_closed … g entry_sig g_prf in
601    match graph_visit p globals g ∅ (empty_map …) [ ] [entry_sig] 0 (|g|)
602      (entry_sig) g_prf ?????????
603    with
604    [ mk_Sig triple H ⇒
605      let sigma ≝ \fst (\fst triple) in
606      let required ≝ \snd (\fst triple) in
607      let crev ≝ \snd triple in
608      let lbld_code ≝ rev ? crev in
609      〈filter_labels … (λl.l∈required) lbld_code, lookup … sigma〉 ].
610[ cases (graph_visit ????????????????????)
611 (* done later *)
612| #i >mem_set_empty *
613|3,4: #a #b whd in ⊢ (??%?→?); #ABS destruct(ABS)
614| #l #_ %
615| %2 % * >mem_set_empty *
616| % [2: %] @(branch_compress_has_entry … g entry_sig)
617| %
618| % % [% %] cases (pi1 … entry_sig) normalize #_ % //
619| >commutative_plus change with (? ≤ |g|) %
620]
621**
622#visited #required #generated normalize nodelta ****
623#entry_O #req_vis #last_fin #labels_in_req #sigma_prop
624%
625[ % [assumption]
626  #lbl #n #eq_lookup elim (sigma_prop ?? eq_lookup)
627  #lbl_in_gen * #stmt ** #stmt_in_g #nth_opt_is_stmt #succ_is_in
628  % [2: % [ assumption ] |]
629  >nth_opt_filter_labels in ⊢ (???%);
630  >nth_opt_is_stmt >m_return_bind whd >m_return_bind
631  % [ % ]
632  [ elim (lbl ∈ required) %
633  | %
634  | lapply succ_is_in
635    lapply (refl … (stmt_implicit_label … stmt))
636    cases (stmt_implicit_label … stmt) in ⊢ (???%→%); [#_ #_ %]
637    #next #EQ_next *
638    [ #H %1{H} ]
639    #H %2
640    >nth_opt_filter_labels >H %
641  ]
642| #i #s
643  >stmt_at_filter_labels #EQ
644  %
645  [ @stmt_forall_labels_explicit
646    @(All_mp … (labels_in_req … EQ))
647    #l #l_req >lin_code_has_label
648    >occurs_exactly_once_filter_labels >l_req
649    >commutative_andb whd in ⊢ (?%);
650    elim (sigma_prop ?? (lookup_eq_safe … (req_vis … l_req)))
651    >lin_code_has_label #H #_ @H
652  | lapply EQ cases s #s' [2: #_ % ]
653    * -EQ #EQ change with (bool_to_Prop (code_has_point ????))
654    whd in match (point_of_succ ???);
655    >lin_code_has_point @leb_elim [ #_ % ] >length_map >length_reverse
656    #INEQ
657    cut (|generated| = S i)
658    [ @(le_to_le_to_eq … (not_lt_to_le … INEQ) )
659      elim (option_bind_inverse ????? EQ) #x * #EQ1 #EQ2
660      <length_reverse
661      @(nth_opt_hit_length … EQ1)
662    ] #EQ_length
663    elim last_fin #fin #EQ'
664    lapply EQ whd in match (stmt_at ????);
665    >nth_opt_reverse_hit >EQ_length [2: % ] <minus_n_n
666    change with (stmt_at ???? = ? → ?)
667    >EQ' #ABS destruct(ABS)
668  ]
669]
670qed.
671
672definition linearise_int_fun :
673  ∀p : unserialized_params.
674  ∀globals.
675    ∀fn_in : joint_closed_internal_function (mk_graph_params p) globals
676     .Σ〈fn_out : joint_closed_internal_function (mk_lin_params p) globals,
677        sigma : ?〉.
678        good_local_sigma … (joint_if_code … fn_in) (joint_if_entry … fn_in)
679          (joint_if_code … fn_out) sigma
680     (* ∃sigma : identifier_map LabelTag ℕ.
681        let g ≝ joint_if_code ?? (pi1 … fin) in
682        let c ≝ joint_if_code ?? (pi1 … fout) in
683        let entry ≝ joint_if_entry ?? (pi1 … fin) in
684         lookup … sigma entry = Some ? 0 ∧
685          ∀l,n.lookup … sigma l = Some ? n →
686            ∃s. lookup … g l = Some ? s ∧
687              opt_Exists ?
688                (λls.let 〈lopt, ts〉 ≝ ls in
689                  opt_All ? (eq ? l) lopt ∧
690                  ts = graph_to_lin_statement … s ∧
691                  opt_All ?
692                    (λnext.Or (lookup … sigma next = Some ? (S n))
693                    (nth_opt … (S n) c = Some ? 〈None ?, GOTO … next〉))
694                    (stmt_implicit_label … s)) (nth_opt … n c)*) ≝
695  λp,globals,f_sig.
696  let code_sigma ≝ linearise_code …
697    (joint_if_code … f_sig)
698    (pi2 … f_sig)
699    (joint_if_entry … f_sig) in
700  let code ≝ \fst code_sigma in
701  let sigma ≝ \snd code_sigma in
702  let entry : Σpt.bool_to_Prop (code_has_point … code pt) ≝ «0, hide_prf ??» in
703  〈«mk_joint_internal_function (mk_lin_params p) globals
704   (joint_if_luniverse ?? f_sig) (joint_if_runiverse ?? f_sig)
705   (joint_if_result ?? f_sig) (joint_if_params ?? f_sig) (joint_if_locals ?? f_sig)
706   (joint_if_stacksize ?? f_sig) code entry entry (* exit is dummy! *), ?»,
707   sigma〉.
708normalize nodelta
709cases (linearise_code ?????) * #code #sigma normalize nodelta * #H1 #H2
710[ @H2
711| @H1
712| cases H1 #H3 #H4 elim (H4 … H3)
713  #s * #_ >lin_code_has_point cases code
714  [ * | #hd #tl #_ % ]
715]
716qed.
717
718definition linearise : ∀p : unserialized_params.
719  program (joint_function (mk_graph_params p)) ℕ →
720  program (joint_function (mk_lin_params p)) ℕ
721   ≝
722  λp,pr.transform_program ??? pr
723    (λglobals.transf_fundef ?? (λf_in.\fst (linearise_int_fun p globals f_in))).
724
725
726definition good_sigma :
727  ∀p:unserialized_params.
728  ∀prog_in : joint_program (mk_graph_params p).
729  ((Σi.is_internal_function_of_program … prog_in i) → label → option ℕ) → Prop ≝
730  λp,prog_in,sigma.
731  let prog_out ≝ linearise … prog_in in
732  ∀i.
733  let fn_in ≝ prog_if_of_function ?? prog_in i in
734  let fn_out ≝ prog_if_of_function ?? prog_out «i, hide_prf ??» in
735  let sigma_local ≝ sigma i in
736  good_local_sigma ?? (joint_if_code ?? fn_in) (joint_if_entry … fn_in)
737          (joint_if_code ?? fn_out) sigma_local.
738@if_propagate @(pi2 … i)
739qed.
740
741lemma linearise_spec : ∀p,prog.∃sigma.good_sigma p prog sigma.
742#p #prog
743letin sigma ≝
744  (λi.
745    let fn_in ≝ prog_if_of_function ?? prog i in
746    \snd (linearise_int_fun … fn_in))
747%{sigma}
748* #i #i_prf >(prog_if_of_function_transform … i_prf)
749normalize nodelta
750cases (linearise_int_fun ???) * #fn_out #sigma_loc
751normalize nodelta #prf @prf
752qed.
Note: See TracBrowser for help on using the repository browser.