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_RC: forall d mu c1 m1 c2 m2 (MC: MATCH d mu c1 m1 c2 m2), REACH_closed m1 (vis mu).
Lemma MATCH_restrict: forall d mu c1 m1 c2 m2 X (MC: MATCH d mu c1 m1 c2 m2) (HX: forall b : block, vis mu b = true -> X b = true) (RX: REACH_closed m1 X), MATCH d (restrict_sm mu X) c1 m1 c2 m2.
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_PG: forall d mu c1 m1 c2 m2 (MC: MATCH d mu c1 m1 c2 m2), meminj_preserves_globals ge (extern_of mu) /\ (forall b : block, isGlobalBlock ge b = true -> frgnBlocksSrc mu b = true).
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 MATCH_corestep: 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 z => EmptyEffect b z = false) m m'))*) (GDE : genvs_domain_eq ge tge) (st1 : CL_core) (m1 : mem) (st1' : CL_core) (m1' : mem) (* (CS: corestep (clight_eff_sem FE FE_FWD FE_UNCH) ge st1 m1 st1' m1')*) (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'.
Lemma restrict_vis_foreign: forall mu (WD: SM_wd mu) b1 b2 delta (R: restrict (as_inj mu) (vis mu) b1 = Some (b2, delta)) (LT: locBlocksTgt mu b2 = false), foreign_of mu b1 = Some (b2, delta).
Lemma Match_effcore_diagram: forall (* (FE : Clight.function -> list val -> mem -> Clight.env -> Clight.temp_env -> mem -> Prop) (FE_FWD : forall (f : Clight.function) (vargs : list val) (m : mem) (e : Clight.env) (lenv : Clight.temp_env) (m' : mem), FE f vargs m e lenv m' -> mem_forward m m') (FE_UNCH : forall (f : Clight.function) (vargs : list val) (m : mem) (e : Clight.env) (lenv : Clight.temp_env) (m' : mem), 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) (st1 : CL_core) (m1 : mem) (st1' : CL_core) (m1' : mem) (U1 : block -> Z -> bool) (* (EFFSTEP: effstep (clight_eff_sem FE FE_FWD FE_UNCH) ge U1 st1 m1 st1' m1')*) (EFFSTEP: effstep CL_eff_sem2 ge U1 st1 m1 st1' m1') (st2 : CSharpMin_core) (mu : SM_Injection) (m2 : mem) (UHyp: forall b z, U1 b z = true -> Mem.valid_block m1 b -> vis mu b = true) (MC: MATCH st1 mu st1 m1 st2 m2), exists (st2' : CSharpMin_core) (m2' : mem) (mu' : SM_Injection), (exists U2 : block -> Z -> bool, (effstep_plus csharpmin_eff_sem tge U2 st2 m2 st2' m2' /\ (forall (b : block) (ofs : Z), U2 b ofs = true -> Mem.valid_block m2 b /\ (locBlocksTgt mu b = false -> exists (b1 : block) (delta1 : Z), foreign_of mu b1 = Some (b, delta1) /\ U1 b1 (ofs - delta1) = true /\ Mem.perm m1 b1 (ofs - delta1) Max Nonempty)))) /\ 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'.
Theorem transl_program_correct: forall (R: list_norepet (map fst (prog_defs prog))) entrypoints (entry_points_ok : forall v1 v2 sig, 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) (init_mem: exists m0, Genv.init_mem prog = Some m0) (* (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 z => EmptyEffect b z = false) m m'), SM_simulation.SM_simulation_inject (clight_eff_sem FE FE_FWD FE_UNCH) csharpmin_eff_sem ge tge entrypoints.*) , SM_simulation.SM_simulation_inject CL_eff_sem2 csharpmin_eff_sem ge tge entrypoints.