Goal forall mu Etgt Esrc m2 m2' (WD: SM_wd mu) m1
(TgtHyp: forall b ofs, Etgt b ofs = true ->
(Mem.valid_block m2 b /\
(locBlocksTgt mu b = false ->
exists b1 delta1, foreign_of mu b1 = Some(b,delta1) /\
Esrc b1 (ofs-delta1) = true /\ Mem.perm m1 b1 (ofs-delta1) Max Nonempty)))
(Unch2: Mem.unchanged_on (fun b z => Etgt b z = false) m2 m2')
(*(SrcHyp: forall b ofs, Esrc b ofs = true -> vis mu b = true)*)
nu (WDnu: SM_wd nu)
(X1: forall b, locBlocksTgt nu b = true -> locBlocksTgt mu b = false)
(X2: forall b1 b2 d, foreign_of mu b1 = Some(b2, d) ->
locBlocksSrc nu b1 || locBlocksTgt nu b2 = true ->
pub_of nu b1 = Some(b2,d)),
Mem.unchanged_on (fun b2 z => locBlocksTgt nu b2 = true /\
forall b1 d, (as_inj nu) b1 = Some (b2,d) ->
loc_out_of_bounds m1 b1 (z-d)) m2 m2'.
Inductive match_freelists (j:meminj): list (block * Z * Z) -> list (block * Z * Z) -> Prop :=
match_freelists_nil: match_freelists j nil nil
| match_freelists_cons: forall b1 lo1 hi1 t1 b2 lo2 hi2 t2 delta,
j b1 = Some (b2,delta) ->
lo2 = lo1+delta -> hi2 = hi1+delta ->
match_freelists j t1 t2 ->
match_freelists j ((b1,lo1,hi1)::t1) ((b2,lo2,hi2)::t2).
(***********************************************************************)
Goal forall mu (WD: SM_wd mu) m1 m2 m2'
(U: Mem.unchanged_on (local_out_of_reach mu m1) m2 m2'),
Mem.unchanged_on (fun b ofs => pubBlocksTgt mu b = true /\
loc_out_of_reach (pub_of mu) m1 b ofs) m2 m2'.
Goal forall mu (WD: SM_wd mu) m1 m2 m2'
(U: Mem.unchanged_on (local_out_of_reach mu m1) m2 m2'),
Mem.unchanged_on (fun b ofs => locBlocksTgt mu b = true /\
pubBlocksTgt mu b = false) m2 m2'.
intros.
eapply mem_unchanged_on_sub; try eassumption.
intros. unfold local_out_of_reach. destruct H.
split; trivial. intros.
remember (pubBlocksSrc mu b0) as d.
destruct d; try (right; reflexivity).
apply eq_sym in Heqd.
destruct (pubSrc _ WD _ Heqd) as [b2 [dd [PUB TGT]]].
apply pub_in_local in PUB. rewrite PUB in H1. inv H1.
rewrite TGT in H0. discriminate.
Qed.
Goal forall mu m1 m2 m2' (WD:SM_wd mu)
(U1: Mem.unchanged_on (fun b ofs => locBlocksTgt mu b = true /\
pubBlocksTgt mu b = false) m2 m2')
(U2: Mem.unchanged_on (fun b ofs => pubBlocksTgt mu b = true /\
loc_out_of_reach (pub_of mu) m1 b ofs) m2 m2'),
Mem.unchanged_on (local_out_of_reach mu m1) m2 m2'.
intros.
destruct U1 as [P1 C1]. destruct U2 as [P2 C2].
split; intros.
clear C1 C2.
specialize (P1 b ofs k p). specialize (P2 b ofs k p).
remember (locBlocksTgt mu b) as d.
destruct d; apply eq_sym in Heqd; simpl in *.
remember (pubBlocksTgt mu b) as q.
destruct q; apply eq_sym in Heqq; simpl in *.
clear P1.
apply P2; trivial. split; trivial.
intros b0; intros.
destruct H. destruct (H2 b0 delta).
apply pub_in_local; trivial.
assumption.
unfold pub_of in H1. destruct mu. simpl in *.  rewrite H3 in H1.  discriminate.
apply P1; trivial. split; trivial.
clear P1.
remember (pubBlocksTgt mu b) as q.
destruct q; apply eq_sym in Heqq; simpl in *.
assert (locBlocksTgt mu b = true). eapply (pubBlocksLocalTgt _ WD). eassumption.
rewrite H1 in Heqd. discriminate.
destruct H. rewrite H in Heqd. discriminate.
destruct H.
clear P1 P2.
specialize (C1 b ofs). specialize (C2 b ofs).
rewrite H in *.
remember (pubBlocksTgt mu b) as d.
destruct d; apply eq_sym in Heqd.
clear C1. apply C2; trivial; clear C2.
split; trivial. intros b1; intros.
destruct (pub_locBlocks _ WD _ _ _ H2).
apply pub_in_local in H2.
destruct (H1 _ _ H2). assumption. rewrite H5 in *. inv H3.
clear C2. apply C1; eauto.
Qed.
(*selected standard assumptions:*)
(*One might consider variants that require Mem.inject j ma m2 on smaller injections j than as_inj mu, omething like this: core_halted : forall cd mu c1 m1 c2 m2 v1, match_state cd mu c1 m1 c2 m2 -> halted Sem1 c1 = Some v1 ->  exists v2, Mem.inject (locvisible_of mu) m1 m2 /\ val_inject (locvisible_of mu) v1 v2;  (-follows from halted_loc_check:-) /\ exists pubSrc' pubTgt' nu, (pubSrc' = fun b => (locBlocksSrc mu b) && (REACH m1 (exportedSrc mu (v1::nil)) b)) /\ (pubTgt' = fun b => (locBlocksTgt mu b) && (REACH m2 (exportedTgt mu (v2::nil)) b)) /\ (nu = replace_locals mu pubSrc' pubTgt') /\ val_inject (shared_of nu) v1 v2 /\ halted Sem2 c2 = Some v2 /\ Mem.inject (shared_of nu) m1 m2; (*/\ val_valid v2 m2*)
But this would mean to carry the invariant Mem.inject (locvisible_of mu) m1 m2
around, ie through corediagram, afterexternal etc (ie require match_state
to imply Mem.inject loc_visible ...
This maybe possible, but is maybe not required.
*)
(* Goal (*Lemma halted_check:*) forall mu m1 m2 v1 v2 *)
(*       (MInj: Mem.inject (as_inj mu) m1 m2) *)
(*       (VInj: val_inject (locvisible_of mu) v1 v2) (WD: SM_wd mu), *)
(*       exists pubSrc' pubTgt' nu,  *)
(*         (pubSrc' = fun b => (locBlocksSrc mu b) && *)
(*                             (REACH m1 (exportedSrc mu (v1::nil)) b)) *)
(*         /\ *)
(*         (pubTgt' = fun b => (locBlocksTgt mu b) && *)
(*                             (REACH m2 (exportedTgt mu (v2::nil)) b)) *)
(*         /\ *)
(*         (nu = replace_locals mu pubSrc' pubTgt') *)
(*          /\ SM_wd nu /\ *)
(*         val_inject (shared_of nu) v1 v2 /\ *)
(*         Mem.inject (shared_of nu) m1 m2. (*/\ val_valid v2 m2*) *)
(* Proof. intros. eexists; eexists; eexists. *)
(*   split. reflexivity. *)
(*   split. reflexivity. *)
(*   split. reflexivity. *)
(*   split.  *)
(*       apply replace_locals_wd; trivial. *)
(*       intros. rewrite andb_true_iff in H. destruct H.  *)
(*       assert (VALS12: Forall2 (val_inject (as_inj mu)) (v1 :: nil) (v2 :: nil)). *)
(*         constructor. eapply val_inject_incr; try eassumption. *)
(*                       unfold locvisible_of, join; simpl. *)
(*                       intros b; intros. remember (foreign_of mu b).  *)
(*                       destruct o; apply eq_sym in Heqo. *)
(*                          destruct p. inv H1. apply foreign_in_all; eassumption. *)
(*                       apply local_in_all; eassumption. *)
(*         constructor. *)
(*       destruct (REACH_local_REACH _ WD _ _ (v1::nil) (v2::nil) MInj VALS12 _ H0 H) *)
(*         as [b2 [d1 [LOC12 R2]]]. *)
(*       exists b2, d1. rewrite LOC12, R2. *)
(*       destruct (local_locBlocks _ WD _ _ _ LOC12) as [_ [? _]]. *)
(*       rewrite H1. intuition. *)
(*       intros. apply andb_true_iff in H. intuition. *)
(*   rewrite replace_locals_shared.  *)
(*   split. inv VInj; try constructor. *)
(*          econstructor. *)
(*          unfold locvisible_of in H. *)
(*          apply joinI. *)
(*          destruct (joinD_Some _ _ _ _ _ H); clear H. *)
(*             left; eassumption. *)
(*          destruct H0. right. split; trivial. *)
(*          remember (locBlocksSrc mu b1 && REACH m1 (exportedSrc mu (Vptr b1 ofs1 :: nil)) b1) as d.  *)
(*               destruct d; apply eq_sym in Heqd. assumption. *)
(*          apply andb_false_iff in Heqd.  *)
(*               destruct (local_locBlocks _ WD _ _ _ H0) as [? [? [? [? ?]]]]. *)
(*               rewrite H1 in *. *)
(*               destruct Heqd; try discriminate. *)
(*               assert (REACH m1 (exportedSrc mu (Vptr b1 ofs1 :: nil)) b1 = true). *)
(*                 apply REACHAX. exists nil. constructor. *)
(*                 unfold exportedSrc, sharedSrc, getBlocks. simpl. *)
(*                  destruct (eq_block b1 b1). simpl. trivial. *)
(*                  exfalso. apply n; trivial. *)
(*               rewrite H7 in H6. inv H6. *)
(*            reflexivity. *)
(*     split. *)
(*          (*goal Mem.mem_inj*)  *)
(*            split; intros.  *)
(*            (*subgoal mi_perm*) *)
(*              apply halted_check_aux in H; trivial.  *)
(*              eapply MInj; try eassumption. *)
(*            (*subgoal mi_align*) *)
(*              apply halted_check_aux in H; trivial.  *)
(*              eapply MInj; try eassumption. *)
(*            (*subgoal mi_memval*) *)
(*              assert (X:= halted_check_aux _ _ _ _ _ _ WD H); trivial. *)
(*              assert (MV:= Mem.mi_memval _ _ _ (Mem.mi_inj _ _ _ MInj) _ _ _ _ X H0). clear X. *)
(*              inv MV; try econstructor; try reflexivity. *)
(*                    apply joinI. *)
(*                    remember (foreign_of mu b0) as f. *)
(*                    destruct f; apply eq_sym in Heqf. *)
(*                       destruct p. rewrite (foreign_in_all _ _ _ _ Heqf) in H3. left; trivial. *)
(*                    right. split; trivial. *)
(* (*THIS Need not hold - if we want to enforce that there are no *)
(* pointers to unknown, we can probably do so by adding *)
(*  the match_inject_clause:  *)
(*     match_validblocks: forall d j c1 m1 c2 m2,  *)
(*           match_state d j c1 m1 c2 m2 -> *)
(*           mem_inject (as_inj mu) m1 m2 /\ *)
(*           mem_inject (locvisible mu) m1 m2, *)
(*    or add an invariant reach_closed  *)
(* and /or tweaking match_norm. cf the Lemma halted_loc_check below. *)
(* *) *)
(* Qed. *)

(*We can always "normalize" a reach-chain so that there's only a single root, and the root at most occurs once in the chain*)
Lemma reachD'': forall m R L b (RCH :reach m (fun u => R u = true) L b),
exists r M, R r = true /\ reach m (fun bb => bb=r) M b /\
match rev M with nil => True
| HD::TL => exists z, HD = (r,z) /\ (forall zz, ~ In (r,zz) TL) /\
(forall x zx, R x = true -> In (x,zx) M -> x=r)
end.