Section PRESERVATION.
Variables prog tprog: program.
Hypothesis TRANSL: match_prog prog tprog.
Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.
Proof (Genv.find_funct_transf TRANSL).
Proof (Genv.find_funct_ptr_transf TRANSL).
Proof (Genv.find_symbol_transf TRANSL).
Proof (Genv.senv_transf TRANSL).
(** The proof of semantic preservation is a simulation argument based on diagrams of the following form: << st1 --------------- st2 |                   | t|                  ?|t |                   | v                   v st1'--------------- st2' >> The [match_states] predicate, defined below, captures the precondition between states [st1] and [st2], as well as the postcondition between [st1'] and [st2'].  One transition in the source code (left) can correspond to zero or one transition in the transformed code (right).  The "zero transition" case occurs when executing a [Lgoto] instruction in the source code that has been removed by tunneling.  In the definition of [match_states], what changes between the original and transformed codes is mainly the control-flow (in particular, the current program point [pc]), but also some values and memory states, since some [Vundef] values can become more defined as a consequence of eliminating useless [Lcond] instructions. *)
Definition tunneled_block (f: function) (b: bblock) :=
tunnel_block (record_gotos f) b.
Definition tunneled_code (f: function) :=
PTree.map1 (tunneled_block f) (fn_code f).
Definition locmap_lessdef (ls1 ls2: locset) : Prop :=
forall l, Val.lessdef (ls1 l) (ls2 l).
Inductive match_stackframes: stackframe -> stackframe -> Prop :=
| match_stackframes_intro:
forall f sp ls0 bb tls0,
locmap_lessdef ls0 tls0 ->
match_stackframes
(Stackframe f sp ls0 bb)
(Stackframe (tunnel_function f) sp tls0 (tunneled_block f bb)).
Inductive match_states: state -> state -> Prop :=
| match_states_intro:
forall s f sp pc ls m ts tls tm
(STK: list_forall2 match_stackframes s ts)
(LS: locmap_lessdef ls tls)
(MEM: Mem.extends m tm),
match_states (State s f sp pc ls m)
(State ts (tunnel_function f) sp (branch_target f pc) tls tm)
| match_states_block:
forall s f sp bb ls m ts tls tm
(STK: list_forall2 match_stackframes s ts)
(LS: locmap_lessdef ls tls)
(MEM: Mem.extends m tm),
match_states (Block s f sp bb ls m)
(Block ts (tunnel_function f) sp (tunneled_block f bb) tls tm)
| match_states_interm:
forall s f sp pc bb ls m ts tls tm
(STK: list_forall2 match_stackframes s ts)
(LS: locmap_lessdef ls tls)
(MEM: Mem.extends m tm),
match_states (Block s f sp (Lbranch pc :: bb) ls m)
(State ts (tunnel_function f) sp (branch_target f pc) tls tm)
| match_states_call:
forall s f ls m ts tls tm
(STK: list_forall2 match_stackframes s ts)
(LS: locmap_lessdef ls tls)
(MEM: Mem.extends m tm),
match_states (Callstate s f ls m)
(Callstate ts (tunnel_fundef f) tls tm)
| match_states_return:
forall s ls m ts tls tm
(STK: list_forall2 match_stackframes s ts)
(LS: locmap_lessdef ls tls)
(MEM: Mem.extends m tm),
match_states (Returnstate s ls m)
(Returnstate ts tls tm).
(** Properties of [locmap_lessdef] *)
(* Lemma locmap_undef_lessdef: forall ll ls1 ls2, locmap_lessdef ls1 ls2 -> locmap_lessdef (Locmap.undef ll ls1) (Locmap.undef ll ls2).  Lemma locmap_undef_lessdef_1: forall ll ls1 ls2, locmap_lessdef ls1 ls2 -> locmap_lessdef (Locmap.undef ll ls1) ls2. *)
(** To preserve non-terminating behaviours, we show that the transformed code cannot take an infinity of "zero transition" cases. We use the following [measure] function over source states, which decreases strictly in the "zero transition" case. *)
Definition measure (st: state) : nat :=
match st with
| State s f sp pc ls m => (count_gotos f pc * 2)%nat
| Block s f sp (Lbranch pc :: _) ls m => (count_gotos f pc * 2 + 1)%nat
| Block s f sp bb ls m => 0%nat
| Callstate s f ls m => 0%nat
| Returnstate s ls m => 0%nat
end.

Lemma tunnel_step_correct:
forall st1 t st2, step ge st1 t st2 ->
forall st1' (MS: match_states st1 st1'),
(exists st2', step tge st1' t st2' /\ match_states st2 st2')
\/ (measure st2 < measure st1 /\ t = E0 /\ match_states st2 st1')%nat.