Definition MATCH (d:CL_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.

(* Specifications: *)
Lemma MATCH_wd: forall d mu c1 m1 c2 m2
(MC: MATCH d mu c1 m1 c2 m2), SM_wd mu.
Lemma MATCH_valid: forall d mu c1 m1 c2 m2
(MC: MATCH d mu c1 m1 c2 m2), sm_valid mu m1 m2.
Lemma MATCH_initial: forall v1 v2 sig entrypoints
(EP: In (v1, v2, sig) entrypoints)
(entry_points_ok : forall (v1 v2 : val) (sig : signature),
In (v1, v2, sig) entrypoints ->
exists b f1 f2,
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 c1 m1 j vals2 m2 (DomS DomT : block -> bool)
(FE : Clight.function -> list val -> mem -> Clight.env -> Clight.temp_env -> mem -> Prop)
(FE_FWD : forall f vargs m e lenv m', FE f vargs m e lenv m' ->
mem_forward m m')
(FE_UNCH : forall f vargs m e lenv m', FE f vargs m e lenv m' ->
Mem.unchanged_on
(fun (b : block) (z : Z) => EmptyEffect b z = false) m m')
(Ini: initial_core (clight_eff_sem FE FE_FWD FE_UNCH) 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 delta, j b1 = Some (b2, delta) ->
(DomS b1 = true /\ DomT b2 = true))
(RCH: forall b, REACH m2
(fun b' : 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 : block, DomS b = true -> Mem.valid_block m1 b)
(HDomT: forall b : block, DomT b = true -> Mem.valid_block m2 b),
exists c2,
initial_core csharpmin_eff_sem tge v2 vals2 = Some c2 /\
MATCH c1
(initial_SM DomS DomT
(REACH m1 (fun b : block => isGlobalBlock ge b || getBlocks vals1 b))
(REACH m2 (fun b : block => isGlobalBlock tge b || getBlocks vals2 b))
j) c1 m1 c2 m2.
Lemma MATCH_afterExternal: forall
(FE : Clight.function -> list val -> mem ->
Clight.env -> Clight.temp_env -> mem -> Prop)
(FE_FWD : forall f vargs m e lenv m',
FE f vargs m e lenv m' -> mem_forward m m')
(FE_UNCH : forall f vargs m e lenv m',
FE f vargs m e lenv m' ->
Mem.unchanged_on
(fun (b : block) (z : Z) => EmptyEffect b z = false) m m')
(GDE : genvs_domain_eq ge tge)
mu st1 st2 m1 e vals1 m2 ef_sig vals2 e' ef_sig'
(MemInjMu : Mem.inject (as_inj mu) m1 m2)
(MatchMu: MATCH st1 mu st1 m1 st2 m2)
(AtExtSrc : at_external (clight_eff_sem FE FE_FWD FE_UNCH) st1 = Some (e, ef_sig, vals1))
(AtExtTgt : at_external csharpmin_eff_sem st2 = Some (e', ef_sig', vals2))
(ValInjMu : Forall2 (val_inject (restrict (as_inj mu) (vis mu))) vals1 vals2)
(pubSrc' : block -> bool)
(pubSrcHyp : pubSrc' =
(fun b : block =>
locBlocksSrc mu b && REACH m1 (exportedSrc mu vals1) b))
(pubTgt' : block -> bool)
(pubTgtHyp: pubTgt' =
(fun b : 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' : block -> bool)
(frgnSrcHyp: frgnSrc' =
(fun b : block => DomSrc nu' b &&
(negb (locBlocksSrc nu' b) && REACH m1' (exportedSrc nu' (ret1 :: nil)) b)))
(frgnTgt' : block -> bool)
(frgnTgtHyp: frgnTgt' =
(fun b : 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 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' : CL_core) (st2' : CSharpMin_core),
after_external (clight_eff_sem FE FE_FWD FE_UNCH) (Some ret1) st1 =Some st1' /\
after_external csharpmin_eff_sem (Some ret2) st2 = Some st2' /\
MATCH st1' mu' st1' m1' st2' m2'.
Lemma transl_expr_correctMu: forall e le m a v te tle tm mu
(EVAL: Clight.eval_expr ge e le m a v)
(MENV : match_env (restrict (as_inj mu) (vis mu)) e te)
(TENV : match_tempenv (restrict (as_inj mu) (vis mu)) le tle)
(INJ : Mem.inject (as_inj mu) m tm)
(PG : meminj_preserves_globals ge (as_inj mu))
(RC: REACH_closed m (vis mu))
(GLOB: forall b, isGlobalBlock ge b = true -> frgnBlocksSrc mu b = true),
forall ta, transl_expr a = OK ta ->
exists tv, val_inject (restrict (as_inj mu) (vis mu)) v tv /\
eval_expr tge te tle tm ta tv.
Lemma transl_arglist_correctMu:
forall e le m al tyl vl mu te tle tm
(EVAL:Clight.eval_exprlist ge e le m al tyl vl)
(MENV : match_env (restrict (as_inj mu) (vis mu)) e te)
(TENV : match_tempenv (restrict (as_inj mu) (vis mu)) le tle)
(INJ : Mem.inject (as_inj mu) m tm)
(PG : meminj_preserves_globals ge (as_inj mu))
(RC: REACH_closed m (vis mu))
(GLOB: forall b, isGlobalBlock ge b = true -> frgnBlocksSrc mu b = true),
forall tal, transl_arglist al tyl = OK tal ->
exists tvl, val_list_inject (restrict (as_inj mu) (vis mu)) vl tvl /\
Csharpminor.eval_exprlist tge te tle tm tal tvl.
Lemma blocks_of_bindingD: forall l b lo hi
(I: In (b,lo,hi) (map block_of_binding l)),
lo=0 /\ exists x, In (x,(b,hi)) l.
Lemma blocks_of_envD: forall te b lo hi
(I:In (b, lo, hi) (blocks_of_env te)),
lo = 0 /\ exists x, te!x=Some(b,hi).
Lemma MATCH_corestep: forall
(GDE : genvs_domain_eq ge tge)
(st1 : CL_core) (m1 : mem) (st1' : CL_core) (m1' : mem)
(CS: corestep CL_eff_sem2 ge st1 m1 st1' m1')
(st2 : CSharpMin_core) (mu : SM_Injection) (m2 : mem)
(MC: MATCH st1 mu st1 m1 st2 m2),
exists (st2' : CSharpMin_core) (m2' : mem) (mu' : SM_Injection),
corestep_plus csharpmin_eff_sem tge st2 m2 st2' m2' /\
intern_incr mu mu' /\
sm_inject_separated mu mu' m1 m2 /\
sm_locally_allocated mu mu' m1 m2 m1' m2' /\
MATCH st1' mu' st1' m1' st2' m2' /\
SM_wd mu' /\ sm_valid mu' m1' m2'.