(*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).

(* Specifications: *)
Lemma sm_add_intern_wd: forall mu j FreshS FreshT (WD: SM_wd mu) (HFreshS: forall b, FreshS b =true -> DomSrc mu b = false) (HFreshT: forall b, FreshT b =true -> DomTgt mu b = false) (JDomTgt: forall b1 b2 d, j b1 = Some (b2,d) -> as_inj mu b1 = Some(b2,d) \/ (FreshS b1 = true /\ FreshT b2 = true)), SM_wd (sm_add_intern mu j FreshS FreshT).
Lemma sm_add_intern_incr: forall mu j FreshS FreshT (INC : inject_incr (as_inj mu) j) mu' (Heqmu' : mu' = sm_add_intern mu j FreshS FreshT), intern_incr mu mu'.
Lemma sm_add_intern_as_inj: forall mu j FreshS FreshT, as_inj (sm_add_intern mu j FreshS FreshT) = join (as_inj mu) (fun b => match extern_of mu b with None => j b | Some _ => None end).
Lemma sm_add_intern_incr2: forall mu j FreshS FreshT (INC : inject_incr (as_inj mu) j) mu' (Heqmu' : mu' = sm_add_intern mu j FreshS FreshT), inject_incr j (as_inj mu').
Lemma sm_add_intern_DomSrc: forall mu j FreshS FreshT, DomSrc (sm_add_intern mu j FreshS FreshT) = fun b => DomSrc mu b || FreshS b.
Lemma sm_add_intern_DomTgt: forall mu j FreshS FreshT, DomTgt (sm_add_intern mu j FreshS FreshT) = fun b => DomTgt mu b || FreshT b.
Lemma sm_add_intern_sep: forall mu j FreshS FreshT (HFreshS: forall b, FreshS b =true -> DomSrc mu b = false) (HFreshT: forall b, FreshT b =true -> DomTgt mu b = false) (JDomTgt: forall b1 b2 d, j b1 = Some (b2,d) -> as_inj mu b1 = Some(b2,d) \/ (FreshS b1 = true /\ FreshT b2 = true)) mu' (Heqmu' : mu' = sm_add_intern mu j FreshS FreshT) m1 m2 (WD: SM_wd mu) (HFreshSm1: forall b, FreshS b =true -> ~Mem.valid_block m1 b) (HFreshTm2: forall b, FreshT b =true -> ~Mem.valid_block m2 b), sm_inject_separated mu mu' m1 m2.
Lemma sm_add_localloc: forall mu j m1 m2 m1' m2' mu' (Heqmu' : mu' = sm_add_intern mu j (freshloc m1 m1') (freshloc m2 m2')), sm_locally_allocated mu mu' m1 m2 m1' m2'.
Lemma Match_corestep: forall (GDE : genvs_domain_eq ge tge) st1 m1 st1' m1' (CS: corestep cmin_eff_sem ge st1 m1 st1' m1') st2 mu m2 (MC: Match_cores st1 mu st1 m1 st2 m2) (R: list_norepet (map fst (prog_defs prog))), exists st2' m2', (corestep_plus cminsel_eff_sem tge st2 m2 st2' m2' \/ (measure st1' < measure st1)%nat /\ corestep_star cminsel_eff_sem tge 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'.
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.
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)).
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'.
Theorem transl_program_correct: forall (TRANSL: sel_program prog = OK tprog) (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), SM_simulation.SM_simulation_inject cmin_eff_sem cminsel_eff_sem ge tge entrypoints.