(** ** Semantic preservation for the translation of expressions *)
Section CORRECTNESS_EXPR.
Variable sp: val.
Variable e: env.
Variable m: mem.
(** The proof of semantic preservation for the translation of expressions is a simulation argument based on diagrams of the following form: << I /\ P e, le, m, a ------------- State cs code sp ns rs tm ||                      | ||                      |* ||                      | \/                      v e, le, m, v ------------ State cs code sp nd rs' tm' I /\ Q >> where [tr_expr code map pr a ns nd rd] is assumed to hold. The left vertical arrow represents an evaluation of the expression [a]. The right vertical arrow represents the execution of zero, one or several instructions in the generated RTL flow graph [code].  The invariant [I] is the agreement between Cminor environments and RTL register environment, as captured by [match_envs].  The precondition [P] includes the well-formedness of the compilation environment [mut].  The postconditions [Q] state that in the final register environment [rs'], register [rd] contains value [v], and the registers in the set of preserved registers [pr] are unchanged, as are the registers in the codomain of [map].  We formalize this simulation property by the following predicate parameterized by the CminorSel evaluation (left arrow).  *)
Definition transl_expr_prop
(le: letenv) (a: expr) (v: val) : Prop :=
forall tm cs f map pr ns nd rd rs dst
(MWF: map_wf map)
(TE: tr_expr f.(fn_code) map pr a ns nd rd dst)
(ME: match_env map e le rs)
(EXT: Mem.extends m tm),
exists rs', exists tm',
star step tge (State cs f sp ns rs tm) E0 (State cs f sp nd rs' tm')
/\ match_env map (set_optvar dst v e) le rs'
/\ Val.lessdef v rs'#rd
/\ (forall r, In r pr -> rs'#r = rs#r)
/\ Mem.extends m tm'.
Definition transl_exprlist_prop
(le: letenv) (al: exprlist) (vl: list val) : Prop :=
forall tm cs f map pr ns nd rl rs
(MWF: map_wf map)
(TE: tr_exprlist f.(fn_code) map pr al ns nd rl)
(ME: match_env map e le rs)
(EXT: Mem.extends m tm),
exists rs', exists tm',
star step tge (State cs f sp ns rs tm) E0 (State cs f sp nd rs' tm')
/\ match_env map e le rs'
/\ Val.lessdef_list vl rs'##rl
/\ (forall r, In r pr -> rs'#r = rs#r)
/\ Mem.extends m tm'.
Definition transl_condexpr_prop
(le: letenv) (a: condexpr) (v: bool) : Prop :=
forall tm cs f map pr ns ntrue nfalse rs
(MWF: map_wf map)
(TE: tr_condition f.(fn_code) map pr a ns ntrue nfalse)
(ME: match_env map e le rs)
(EXT: Mem.extends m tm),
exists rs', exists tm',
plus step tge (State cs f sp ns rs tm) E0 (State cs f sp (if v then ntrue else nfalse) rs' tm')
/\ match_env map e le rs'
/\ (forall r, In r pr -> rs'#r = rs#r)
/\ Mem.extends m tm'.
(** The correctness of the translation is a huge induction over the CminorSel evaluation derivation for the source program.  To keep the proof manageable, we put each case of the proof in a separate lemma.  There is one lemma for each CminorSel evaluation rule. It takes as hypotheses the premises of the CminorSel evaluation rule, plus the induction hypotheses, that is, the [transl_expr_prop], etc, corresponding to the evaluations of sub-expressions or sub-statements. *)

(* Specifications: *)
Lemma transl_expr_Evar_correct:
forall (le : letenv) (id : positive) (v: val),
e ! id = Some v ->
transl_expr_prop le (Evar id) v.
Lemma transl_expr_Eop_correct:
forall (le : letenv) (op : operation) (args : exprlist)
(vargs : list val) (v : val),
eval_exprlist ge sp e m le args vargs ->
transl_exprlist_prop le args vargs ->
eval_operation ge sp op vargs m = Some v ->
transl_expr_prop le (Eop op args) v.
Lemma transl_expr_Eload_correct:
forall (le : letenv) (chunk : memory_chunk) (addr : Op.addressing)
(args : exprlist) (vargs : list val) (vaddr v : val),
eval_exprlist ge sp e m le args vargs ->
transl_exprlist_prop le args vargs ->
Op.eval_addressing ge sp addr vargs = Some vaddr ->
Mem.loadv chunk m vaddr = Some v ->
transl_expr_prop le (Eload chunk addr args) v.
Lemma transl_expr_Econdition_correct:
forall (le : letenv) (a: condexpr) (ifso ifnot : expr)
(va : bool) (v : val),
eval_condexpr ge sp e m le a va ->
transl_condexpr_prop le a va ->
eval_expr ge sp e m le (if va then ifso else ifnot) v ->
transl_expr_prop le (if va then ifso else ifnot) v ->
transl_expr_prop le (Econdition a ifso ifnot) v.
Lemma transl_expr_Elet_correct:
forall (le : letenv) (a1 a2 : expr) (v1 v2 : val),
eval_expr ge sp e m le a1 v1 ->
transl_expr_prop le a1 v1 ->
eval_expr ge sp e m (v1 :: le) a2 v2 ->
transl_expr_prop (v1 :: le) a2 v2 ->
transl_expr_prop le (Elet a1 a2) v2.
Lemma transl_expr_Eletvar_correct:
forall (le : list val) (n : nat) (v : val),
nth_error le n = Some v ->
transl_expr_prop le (Eletvar n) v.