(** ** Semantic preservation for the translation of statements *)
(** The simulation diagram for the translation of statements and functions is a "star" diagram of the form: << I                         I S1 ------- R1             S1 ------- R1 |          |              |          | t |        + | t      or  t |        * | t    and |S2| < |S1| v          v              v          | S2 ------- R2             S2 ------- R2 I                         I >> where [I] is the [match_states] predicate defined below.  It includes: - Agreement between the Cminor statement under consideration and the current program point in the RTL control-flow graph, as captured by the [tr_stmt] predicate. - Agreement between the Cminor continuation and the RTL control-flow graph and call stack, as captured by the [tr_cont] predicate below. - Agreement between Cminor environments and RTL register environments, as captured by [match_envs].  *)
Inductive tr_fun (tf: function) (map: mapping) (f: CminorSel.function)
(ngoto: labelmap) (nret: node) (rret: option reg) : Prop :=
| tr_fun_intro: forall nentry r,
rret = ret_reg f.(CminorSel.fn_sig) r ->
tr_stmt tf.(fn_code) map f.(fn_body) nentry nret nil ngoto nret rret ->
tf.(fn_stacksize) = f.(fn_stackspace) ->
tr_fun tf map f ngoto nret rret.
Inductive tr_cont: RTL.code -> mapping ->
CminorSel.cont -> node -> list node -> labelmap -> node -> option reg ->
list RTL.stackframe -> Prop :=
| tr_Kseq: forall c map s k nd nexits ngoto nret rret cs n,
tr_stmt c map s nd n nexits ngoto nret rret ->
tr_cont c map k n nexits ngoto nret rret cs ->
tr_cont c map (Kseq s k) nd nexits ngoto nret rret cs
| tr_Kblock: forall c map k nd nexits ngoto nret rret cs,
tr_cont c map k nd nexits ngoto nret rret cs ->
tr_cont c map (Kblock k) nd (nd :: nexits) ngoto nret rret cs
| tr_Kstop: forall c map ngoto nret rret cs,
c!nret = Some(Ireturn rret) ->
match_stacks Kstop cs ->
tr_cont c map Kstop nret nil ngoto nret rret cs
| tr_Kcall: forall c map optid f sp e k ngoto nret rret cs,
c!nret = Some(Ireturn rret) ->
match_stacks (Kcall optid f sp e k) cs ->
tr_cont c map (Kcall optid f sp e k) nret nil ngoto nret rret cs
with match_stacks: CminorSel.cont -> list RTL.stackframe -> Prop :=
| match_stacks_stop:
match_stacks Kstop nil
| match_stacks_call: forall optid f sp e k r tf n rs cs map nexits ngoto nret rret,
map_wf map ->
tr_fun tf map f ngoto nret rret ->
match_env map e nil rs ->
reg_map_ok map r optid ->
tr_cont tf.(fn_code) map k n nexits ngoto nret rret cs ->
match_stacks (Kcall optid f sp e k) (Stackframe r tf sp n rs :: cs).
Inductive match_states: CminorSel.state -> RTL.state -> Prop :=
| match_state:
forall f s k sp e m tm cs tf ns rs map ncont nexits ngoto nret rret
(MWF: map_wf map)
(TS: tr_stmt tf.(fn_code) map s ns ncont nexits ngoto nret rret)
(TF: tr_fun tf map f ngoto nret rret)
(TK: tr_cont tf.(fn_code) map k ncont nexits ngoto nret rret cs)
(ME: match_env map e nil rs)
(MEXT: Mem.extends m tm),
match_states (CminorSel.State f s k sp e m)
(RTL.State cs tf sp ns rs tm)
| match_callstate:
forall f args targs k m tm cs tf
(TF: transl_fundef f = OK tf)
(MS: match_stacks k cs)
(LD: Val.lessdef_list args targs)
(MEXT: Mem.extends m tm),
match_states (CminorSel.Callstate f args k m)
(RTL.Callstate cs tf targs tm)
| match_returnstate:
forall v tv k m tm cs
(MS: match_stacks k cs)
(LD: Val.lessdef v tv)
(MEXT: Mem.extends m tm),
match_states (CminorSel.Returnstate v k m)
(RTL.Returnstate cs tv tm).

(* Specifications: *)
Lemma match_stacks_call_cont:
forall c map k ncont nexits ngoto nret rret cs,
tr_cont c map k ncont nexits ngoto nret rret cs ->
match_stacks (call_cont k) cs /\ c!nret = Some(Ireturn rret).
Lemma tr_cont_call_cont:
forall c map k ncont nexits ngoto nret rret cs,
tr_cont c map k ncont nexits ngoto nret rret cs ->
tr_cont c map (call_cont k) nret nil ngoto nret rret cs.
Lemma tr_find_label:
forall c map lbl n (ngoto: labelmap) nret rret s' k' cs,
ngoto!lbl = Some n ->
forall s k ns1 nd1 nexits1,
find_label lbl s k = Some (s', k') ->
tr_stmt c map s ns1 nd1 nexits1 ngoto nret rret ->
tr_cont c map k nd1 nexits1 ngoto nret rret cs ->
exists ns2, exists nd2, exists nexits2,
c!n = Some(Inop ns2)
/\ tr_stmt c map s' ns2 nd2 nexits2 ngoto nret rret
/\ tr_cont c map k' nd2 nexits2 ngoto nret rret cs.
Theorem transl_step_correct:
forall S1 t S2, CminorSel.step ge S1 t S2 ->
forall R1, match_states S1 R1 ->
exists R2,
(plus RTL.step tge R1 t R2 \/ (star RTL.step tge R1 t R2 /\ lt_state S2 S1))
/\ match_states S2 R2.
Lemma transl_initial_states:
forall S, CminorSel.initial_state prog S ->
exists R, RTL.initial_state tprog R /\ match_states S R.
Lemma transl_final_states:
forall S R r,
match_states S R -> CminorSel.final_state S r -> RTL.final_state R r.
Theorem transf_program_correct:
forward_simulation (CminorSel.semantics prog) (RTL.semantics tprog).