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_AfterExternal:
forall mu st1 st2 m1 e vals1 m2 ef_sig vals2 e' ef_sig'
(MemInjMu : Mem.inject (as_inj mu) m1 m2)
(MatchMu : Match_cores st1 mu st1 m1 st2 m2)
(AtExtSrc : at_external cmin_eff_sem st1 = Some (e, ef_sig, vals1))
(AtExtTgt : at_external cminsel_eff_sem st2 = Some (e', ef_sig', vals2))
(ValInjMu : Forall2 (val_inject (restrict (as_inj mu) (vis mu))) vals1 vals2)
(pubSrc' : Values.block -> bool)
(pubSrcHyp : pubSrc' =
(fun b : Values.block =>
locBlocksSrc mu b && REACH m1 (exportedSrc mu vals1) b))
(pubTgt' : Values.block -> bool)
(pubTgtHyp : pubTgt' =
(fun b : Values.block =>
locBlocksTgt mu b && REACH m2 (exportedTgt mu vals2) b))
nu
(NuHyp : nu = replace_locals mu pubSrc' pubTgt')
nu' ret1 m1' ret2 m2'
(INC : extern_incr nu nu')
(SEP : sm_inject_separated nu nu' m1 m2)
(WDnu' : SM_wd nu')
(SMvalNu' : sm_valid nu' m1' m2')
(MemInjNu' : Mem.inject (as_inj nu') m1' m2')
(RValInjNu' : val_inject (as_inj nu') ret1 ret2)
(FwdSrc : mem_forward m1 m1')
(FwdTgt : mem_forward m2 m2')
(frgnSrc' : Values.block -> bool)
(frgnSrcHyp : frgnSrc' =
(fun b : Values.block =>
DomSrc nu' b &&
(negb (locBlocksSrc nu' b) &&
REACH m1' (exportedSrc nu' (ret1 :: nil)) b)))
(frgnTgt' : Values.block -> bool)
(frgnTgtHyp : frgnTgt' =
(fun b : Values.block =>
DomTgt nu' b &&
(negb (locBlocksTgt nu' b) &&
REACH m2' (exportedTgt nu' (ret2 :: nil)) b)))
mu'
(Mu'Hyp : mu' = replace_externs nu' frgnSrc' frgnTgt')
(UnchPrivSrc : Mem.unchanged_on
(fun (b : Values.block) (_ : Z) =>
locBlocksSrc nu b = true /\ pubBlocksSrc nu b = false) m1
m1')
(UnchLOOR : Mem.unchanged_on (local_out_of_reach nu m1) m2 m2'),
exists (st1' : CMin_core) (st2' : CMinSel_core),
after_external cmin_eff_sem (Some ret1) st1 = Some st1' /\
after_external cminsel_eff_sem (Some ret2) st2 = Some st2' /\
Match_cores st1' mu' st1' m1' st2' m2'.