Section LINEARIZATION.
Variable prog: LTL.program.
Variable tprog: Linear.program.
Hypothesis TRANSF: match_prog prog tprog.
Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.
Proof (Genv.find_funct_transf_partial TRANSF).
Proof (Genv.find_funct_ptr_transf_partial TRANSF).
Proof (Genv.find_symbol_transf_partial TRANSF).
Proof (Genv.senv_transf_partial TRANSF).
(** * Correctness of reachability analysis *)
(** The entry point of the function is reachable. *)
(** The successors of a reachable instruction are reachable. *)
(** * Properties of node enumeration *)
(** An enumeration of CFG nodes is correct if the following conditions hold: - All nodes for reachable basic blocks must be in the list. - The list is without repetition (so that no code duplication occurs).  We prove that the result of the [enumerate] function satisfies both conditions. *)
(** * Properties related to labels *)
(** If labels are globally unique and the Linear code [c] contains a subsequence [Llabel lbl :: c1], then [find_label lbl c] returns [c1]. *)
Fixpoint unique_labels (c: code) : Prop :=
match c with
| nil => True
| Llabel lbl :: c => ~(In (Llabel lbl) c) /\ unique_labels c
| i :: c => unique_labels c
end.
(** Correctness of the [starts_with] test. *)
(** Connection between [find_label] and linearization. *)
Remark linearize_body_cons:
forall f pc enum,
linearize_body f (pc :: enum) =
match f.(LTL.fn_code)!pc with
| None => linearize_body f enum
| Some b => Llabel pc :: linearize_block b (linearize_body f enum)
end.
(** Unique label property for linearized code. *)
(** Correctness of [add_branch]. *)
(** * Correctness of linearization *)
(** The proof of semantic preservation is a simulation argument of the "star" kind: << st1 --------------- st2 |                   | t|                  t| + or ( 0 \/ |st1'| < |st1| ) |                   | v                   v st1'--------------- st2' >> The invariant (horizontal lines above) is the [match_states] predicate defined below.  It captures the fact that the flow of data is the same in the source and linearized codes. Moreover, whenever the source state is at node [pc] in its control-flow graph, the transformed state is at a code sequence [c] that starts with the label [pc]. *)
Inductive match_stackframes: LTL.stackframe -> Linear.stackframe -> Prop :=
| match_stackframe_intro:
forall f sp bb ls tf c,
transf_function f = OK tf ->
(forall pc, In pc (successors_block bb) -> (reachable f)!!pc = true) ->
is_tail c tf.(fn_code) ->
match_stackframes
(LTL.Stackframe f sp ls bb)
(Linear.Stackframe tf sp ls (linearize_block bb c)).
Inductive match_states: LTL.state -> Linear.state -> Prop :=
| match_states_add_branch:
forall s f sp pc ls m tf ts c
(STACKS: list_forall2 match_stackframes s ts)
(TRF: transf_function f = OK tf)
(REACH: (reachable f)!!pc = true)
(TAIL: is_tail c tf.(fn_code)),
match_states (LTL.State s f sp pc ls m)
(Linear.State ts tf sp (add_branch pc c) ls m)
| match_states_cond_taken:
forall s f sp pc ls m tf ts cond args c
(STACKS: list_forall2 match_stackframes s ts)
(TRF: transf_function f = OK tf)
(REACH: (reachable f)!!pc = true)
(JUMP: eval_condition cond (reglist ls args) m = Some true),
match_states (LTL.State s f sp pc (undef_regs (destroyed_by_cond cond) ls) m)
(Linear.State ts tf sp (Lcond cond args pc :: c) ls m)
| match_states_jumptable:
forall s f sp pc ls m tf ts arg tbl c n
(STACKS: list_forall2 match_stackframes s ts)
(TRF: transf_function f = OK tf)
(REACH: (reachable f)!!pc = true)
(ARG: ls (R arg) = Vint n)
(JUMP: list_nth_z tbl (Int.unsigned n) = Some pc),
match_states (LTL.State s f sp pc (undef_regs destroyed_by_jumptable ls) m)
(Linear.State ts tf sp (Ljumptable arg tbl :: c) ls m)
| match_states_block:
forall s f sp bb ls m tf ts c
(STACKS: list_forall2 match_stackframes s ts)
(TRF: transf_function f = OK tf)
(REACH: forall pc, In pc (successors_block bb) -> (reachable f)!!pc = true)
(TAIL: is_tail c tf.(fn_code)),
match_states (LTL.Block s f sp bb ls m)
(Linear.State ts tf sp (linearize_block bb c) ls m)
| match_states_call:
forall s f ls m tf ts,
list_forall2 match_stackframes s ts ->
transf_fundef f = OK tf ->
match_states (LTL.Callstate s f ls m)
(Linear.Callstate ts tf ls m)
| match_states_return:
forall s ls m ts,
list_forall2 match_stackframes s ts ->
match_states (LTL.Returnstate s ls m)
(Linear.Returnstate ts ls m).
Definition measure (S: LTL.state) : nat :=
match S with
| LTL.State s f sp pc ls m => 0%nat
| LTL.Block s f sp bb ls m => 1%nat
| _ => 0%nat
end.
Remark match_parent_locset:
forall s ts, list_forall2 match_stackframes s ts -> parent_locset ts = LTL.parent_locset s.

Theorem transf_program_correct:
forward_simulation (LTL.semantics prog) (Linear.semantics tprog).