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_init_cores: forall (v1 v2 : val) (sig : signature) entrypoints
(EP: In (v1, v2, sig) entrypoints)
(entry_points_ok : forall (v1 v2 : val) (sig : signature),
In (v1, v2, sig) entrypoints ->
exists
(b : Values.block) (f1 : Cminor.fundef) (f2 : fundef),
v1 = Vptr b Int.zero /\
v2 = Vptr b Int.zero /\
Genv.find_funct_ptr ge b = Some f1 /\
Genv.find_funct_ptr tge b = Some f2)
(vals1 : list val) (c1 : CMin_core) (m1 : mem) (j : meminj)
(vals2 : list val) (m2 : mem) (DomS DomT : Values.block -> bool)
(CSM_Ini :initial_core cmin_eff_sem ge v1 vals1 = Some c1)
(Inj: Mem.inject j m1 m2)
(VInj: Forall2 (val_inject j) vals1 vals2)
(PG: meminj_preserves_globals ge j)
(R : list_norepet (map fst (prog_defs prog)))
(J: forall b1 b2 d, j b1 = Some (b2, d) ->
DomS b1 = true /\ DomT b2 = true)
(RCH: forall b, REACH m2
(fun b' : Values.block => isGlobalBlock tge b' || getBlocks vals2 b') b =
true -> DomT b = true)
(InitMem : exists m0 : mem, Genv.init_mem prog = Some m0
/\ Ple (Mem.nextblock m0) (Mem.nextblock m1)
/\ Ple (Mem.nextblock m0) (Mem.nextblock m2))
(GDE: genvs_domain_eq ge tge)
(HDomS: forall b : Values.block, DomS b = true -> Mem.valid_block m1 b)
(HDomT: forall b : Values.block, DomT b = true -> Mem.valid_block m2 b),
exists c2 : CMinSel_core,
initial_core cminsel_eff_sem tge v2 vals2 = Some c2 /\
Match_cores c1
(initial_SM DomS DomT
(REACH m1
(fun b : Values.block => isGlobalBlock ge b || getBlocks vals1 b))
(REACH m2
(fun b : Values.block => isGlobalBlock tge b || getBlocks vals2 b))
j) c1 m1 c2 m2.