Section CMCONSTR.
Variable sp: val.
Variable e: env.
Variable m: mem.
(*(Sstore chunk addr al b) effsstep tge (State f (store chunk a1 a2) k sp e m) E0 (State f Sskip k sp e m').*)
(** Correctness of instruction selection for operators *)
End CMCONSTR.
(** Recognition of calls to built-in functions *)
(** Compatibility of evaluation functions with the "less defined than" relation. *)
Ltac TrivialExists :=
match goal with
| [ |- exists v, Some ?x = Some v /\ _ ] => exists x; split; auto
| _ => idtac
end.
(*Lemma eval_unop_lessdef: forall op v1 v1' v, eval_unop op v1 = Some v -> Val.lessdef v1 v1' -> exists v', eval_unop op v1' = Some v' /\ Val.lessdef v v'.  (** Lenb: replace eval_unop_lessdef with eval_unop from Cminorgenproof; this requires the additio of Require Import Float above Compatibility of [eval_unop] with respect to [val_inject]. *)
(*Lemma eval_binop_lessdef: forall op v1 v1' v2 v2' v m m', eval_binop op v1 v2 m = Some v -> Val.lessdef v1 v1' -> Val.lessdef v2 v2' -> Mem.extends m m' -> exists v', eval_binop op v1' v2' m' = Some v' /\ Val.lessdef v v'. *)
(** Lenb: same for binops Compatibility of [eval_binop] with respect to [val_inject]. *)
(*Lenb: fom Cminorgenproof: *)
Remark val_inject_val_of_bool:
forall f b, val_inject f (Val.of_bool b) (Val.of_bool b).
(*Lenb: fom Cminorgenproof: *)
Remark val_inject_val_of_optbool:
forall f ob, val_inject f (Val.of_optbool ob) (Val.of_optbool ob).
(*Lenb: fom Cminorgenproof: *)
Ltac TrivialExistsCMINORGEN :=
match goal with
| [ |- exists y, Some ?x = Some y /\ val_inject _ _ _ ] =>
exists x; split; [auto | try(econstructor; eauto)]
| [ |- exists y, _ /\ val_inject _ (Vint ?x) _ ] =>
exists (Vint x); split; [eauto with evalexpr | constructor]
| [ |- exists y, _ /\ val_inject _ (Vfloat ?x) _ ] =>
exists (Vfloat x); split; [eauto with evalexpr | constructor]
| [ |- exists y, _ /\ val_inject _ (Vlong ?x) _ ] =>
exists (Vlong x); split; [eauto with evalexpr | constructor]
| _ => idtac
end.
(** * Semantic preservation for instruction selection. *)
(** Relationship between the local environments. *)
(* Definition env_lessdef (e1 e2: env) : Prop := forall id v1, e1!id = Some v1 -> exists v2, e2!id = Some v2 /\ Val.lessdef v1 v2. *)
Definition env_inject j (e1 e2: env) : Prop :=
forall id v1, e1!id = Some v1 -> exists v2, e2!id = Some v2 /\ val_inject j v1 v2.
(* Lemma set_locals_lessdef: forall e1 e2, env_lessdef e1 e2 -> forall il, env_lessdef (set_locals il e1) (set_locals il e2). Lemma set_locals_inject: forall j e1 e2, env_inject j e1 e2 -> forall il, env_inject j (set_locals il e1) (set_locals il e2).  Lemma lessdef_inject: forall v j (Hv: forall b1, getBlocks (v::nil) b1 = true -> j b1 = Some(b1,0)) v' (LD: Val.lessdef v v'), val_inject j v v'. (* Lemma inject_lessdef: forall v j (Hv: forall b1, getBlocks (v::nil) b1 = true -> j b1 = Some(b1,0)) v' (INJ: val_inject j v v'), Val.lessdef v v'. *)
(** Semantic preservation for expressions. *)
(*NEW*)
Definition sp_preserved (j:meminj) (sp sp':val) :=
exists b i b', sp = Vptr b i /\ sp' = Vptr b' i /\
j b = Some(b',0).
(*Lenb: these conditions are modified*)
(*Lenb: these conditions are new here*)
(* Lemma sel_exprlist_correct: forall sp e m a v, Cminor.eval_exprlist ge sp e m a v -> forall e' le m', env_lessdef e e' -> Mem.extends m m' -> exists v', eval_exprlist tge sp e' m' le (sel_exprlist hf a) v' /\ Val.lessdef_list v v'. *)
(** Semantic preservation for functions and statements. *)
Inductive match_cont (*NEW:*)(j:meminj): Cminor.cont -> CminorSel.cont -> Prop :=
| match_cont_stop:
match_cont j Cminor.Kstop Kstop
| match_cont_seq: forall s k k',
match_cont j k k' ->
match_cont j (Cminor.Kseq s k) (Kseq (sel_stmt hf ge s) k')
| match_cont_block: forall k k',
match_cont j k k' ->
match_cont j (Cminor.Kblock k) (Kblock k')
(*sp' and sp_preserved_condition are new*)
| match_cont_call: forall id f sp e k sp' e' k',
match_cont j k k' ->
(*env_lessdef e e' ->*)
env_inject j e e' -> sp_preserved j sp sp' ->
match_cont j (Cminor.Kcall id f sp e k) (Kcall id (sel_function hf ge f) sp' e' k').
Inductive match_states (j:meminj) : CMin_core -> mem -> CMinSel_core -> mem -> Prop :=
| match_state: forall f s k s' k' sp e m sp' e' m',
s' = sel_stmt hf ge s ->
match_cont j k k' ->
(*      env_lessdef e e' -> Mem.extends m m' ->*)
env_inject j e e' -> Mem.inject j m m' -> sp_preserved j sp sp' ->
match_states j
(CMin_State f s k sp e) m
(CMinSel_State (sel_function hf ge f) s' k' sp' e') m'
| match_callstate: forall f args args' k k' m m',
match_cont j k k' ->
(*      Val.lessdef_list args args' -> Mem.extends m m' ->*)
val_list_inject j args args' -> Mem.inject j m m' ->
match_states j
(CMin_Callstate f args k) m
(CMinSel_Callstate (sel_fundef hf ge f) args' k') m'
| match_returnstate: forall v v' k k' m m',
match_cont j k k' ->
(*Val.lessdef v v' -> Mem.extends m m' ->*)
val_inject j v v' -> Mem.inject j m m' ->
match_states j
(CMin_Returnstate v k) m
(CMinSel_Returnstate v' k') m'
| match_builtin_1: forall ef args args' optid f sp e k m al sp' e' k' m',
match_cont j k k' ->
(*Val.lessdef_list args args' -> env_lessdef e e' -> Mem.extends m m' -> *)
val_list_inject j args args' -> env_inject j e e' -> Mem.inject j m m' ->
sp_preserved j sp sp' ->
CminorSel.eval_exprlist tge sp' e' m' nil al args' ->
match_states j
(CMin_Callstate (External ef) args (Cminor.Kcall optid f sp e k)) m
(CMinSel_State (sel_function hf ge f) (Sbuiltin optid ef al) k' sp' e') m'
| match_builtin_2: forall v v' optid f sp e k m sp' e' m' k',
match_cont j k k' ->
(*Val.lessdef v v' -> env_lessdef e e' -> Mem.extends m m' ->*)
val_inject j v v' -> env_inject j e e' -> Mem.inject j m m' -> sp_preserved j sp sp' ->
match_states j
(CMin_Returnstate v (Cminor.Kcall optid f sp e k)) m
(CMinSel_State (sel_function hf ge f) Sskip k' sp' (set_optvar optid v' e')) m'.
Definition Match_cores (d:CMin_core) mu c1 m1 c2 m2:Prop :=
match_states (restrict (as_inj mu) (vis mu)) c1 m1 c2 m2 /\
REACH_closed m1 (vis mu) /\
meminj_preserves_globals ge (as_inj mu) /\
globalfunction_ptr_inject (as_inj mu) /\
(forall b, isGlobalBlock ge b = true -> frgnBlocksSrc mu b = true) /\
sm_valid mu m1 m2 /\ SM_wd mu /\ Mem.inject (as_inj mu) m1 m2.
Remark call_cont_commut:
forall (*New: j*) j k k', match_cont j k k' -> match_cont j (Cminor.call_cont k) (call_cont k').
Remark find_label_commut:
forall j lbl s k k',
match_cont j k k' ->
match Cminor.find_label lbl s k, find_label lbl (sel_stmt hf ge s) k' with
| None, None => True
| Some(s1, k1), Some(s1', k1') => s1' = sel_stmt hf ge s1 /\ match_cont j k1 k1'
| _, _ => False
end.
(*Lenb: changed type of s from Cminor.state to CMin_core, adapted the constructor names, and removed one _ in each clause*)
Definition measure (s: CMin_core) : nat :=
match s with
| CMin_Callstate _ _ _ => 0%nat
| CMin_State _ _ _ _ _ => 1%nat
| CMin_Returnstate _ _ => 2%nat
end.
(*FreshS/T: fresh blocks in src/tgt language*)
Definition sm_add_intern (mu: SM_Injection) j FreshS FreshT : SM_Injection :=
Build_SM_Injection (fun b => locBlocksSrc mu b || FreshS b)
(fun b => locBlocksTgt mu b || FreshT b)
(pubBlocksSrc mu) (pubBlocksTgt mu)
(join (local_of mu) (fun b => match extern_of mu b with
None => j b | Some _ => None end))
(extBlocksSrc mu) (extBlocksTgt mu)
(frgnBlocksSrc mu) (frgnBlocksTgt mu) (extern_of mu).

Lemma Match_eff_diagram_strong_perm:
forall (GDE : genvs_domain_eq ge tge)
st1 m1 st1' m1' (U1 : block -> Z -> bool)
(CS: effstep cmin_eff_sem ge U1 st1 m1 st1' m1')
st2 mu m2
(EffSrc: forall b ofs, U1 b ofs = true ->
Mem.valid_block m1 b -> vis mu b = true)
(MC: Match_cores st1 mu st1 m1 st2 m2)
(R: list_norepet (map fst (prog_defs prog))),
exists st2' m2' (U2 : block -> Z -> bool),
(effstep_plus cminsel_eff_sem tge U2 st2 m2 st2' m2' \/
(measure st1' < measure st1)%nat /\
effstep_star cminsel_eff_sem tge U2 st2 m2 st2' m2')
/\ exists mu',
intern_incr mu mu' /\
sm_inject_separated mu mu' m1 m2 /\
sm_locally_allocated mu mu' m1 m2 m1' m2' /\
Match_cores st1' mu' st1' m1' st2' m2' /\
SM_wd mu' /\
sm_valid mu' m1' m2' /\
(forall b2 ofs,
U2 b2 ofs = true ->
Mem.valid_block m2 b2 /\
(locBlocksTgt mu b2 = false ->
exists (b1 : block) (delta1 : Z),
foreign_of mu b1 = Some (b2, delta1) /\
U1 b1 (ofs - delta1) = true /\
Mem.perm m1 b1 (ofs - delta1) Max Nonempty)).