(** * 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.

(* Specifications: *)
Theorem transf_step_correct:
forall s1 t s2, LTL.step ge s1 t s2 ->
forall s1' (MS: match_states s1 s1'),
(exists s2', plus Linear.step tge s1' t s2' /\ match_states s2 s2')
\/ (measure s2 < measure s1 /\ t = E0 /\ match_states s2 s1')%nat.
Lemma transf_initial_states:
forall st1, LTL.initial_state prog st1 ->
exists st2, Linear.initial_state tprog st2 /\ match_states st1 st2.
Lemma transf_final_states:
forall st1 st2 r,
match_states st1 st2 -> LTL.final_state st1 r -> Linear.final_state st2 r.
Theorem transf_program_correct:
forward_simulation (LTL.semantics prog) (Linear.semantics tprog).