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

(* Specifications: *)
Lemma halted_loc_check_aux: forall mu m1 v1 b1 b2 delta (WD: SM_wd mu),
join (foreign_of mu)
(fun b =>
if locBlocksSrc mu b && REACH m1 (exportedSrc mu (v1 :: nil)) b
then local_of mu b
else None) b1 = Some (b2, delta) ->
locvisible_of mu b1= Some (b2, delta).
Lemma halted_loc_check: forall mu m1 m2 v1 v2
(MInj: Mem.inject (locvisible_of 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*)
Lemma get_freelist:
forall fbl m m' (FL: Mem.free_list m fbl = Some m') b
(H: forall b' lo hi, In (b', lo, hi) fbl -> b' <> b) z,
ZMap.get z (Mem.mem_contents m') !! b =
ZMap.get z (Mem.mem_contents m) !! b.
Lemma intern_incr_vis_inv: forall mu nu (WDmu: SM_wd mu) (WDnu: SM_wd nu)
(INC: intern_incr mu nu)
b1 b2 d (AI: as_inj mu b1 = Some(b2,d))
(VIS: vis nu b1 = true), vis mu b1 = true.
Lemma intern_incr_vis: forall mu nu (INC: intern_incr mu nu)
b (VIS: vis mu b = true), vis nu b = true.
Lemma restrict_sm_intern_incr: forall mu1 mu2 (WD2 : SM_wd mu2)
(INC : intern_incr mu1 mu2),
intern_incr (restrict_sm mu1 (vis mu1))
(restrict_sm mu2 (vis mu2)).
Lemma intern_incr_restrict: forall mu1 mu2 (WD2 : SM_wd mu2)
(INC : intern_incr mu1 mu2),
inject_incr (restrict (as_inj mu1) (vis mu1))
(restrict (as_inj mu2) (vis mu2)).
Lemma vis_restrict_sm: forall mu X,
vis (restrict_sm mu X) = vis mu.
Lemma reachD: forall m R L b (RCH :reach m (fun u => R u = true) L b),
exists r, R r = true /\ reach m (fun bb => bb=r) L b.
Lemma reachD': forall m R L b (RCH :reach m (fun u => R u = true)  L b),
exists r, R r = true /\ reach m (fun bb => bb=r) L b /\
match rev L with nil => True
| HD::TL => exists z, HD = (r,z)
end.
(*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.
Lemma encode_val_pointer_inv':
forall chunk v b ofs n B1 mvl,
encode_val chunk v = B1++Pointer b ofs n :: mvl ->
chunk = Mint32 /\ v = Vptr b ofs.
Lemma list_split: forall {A} n (L:list A) (Hn : (n < length L)%nat),
exists vl1 u vl2,
L = vl1 ++ u :: vl2 /\
length vl1 = n.
Lemma REACH_Store: forall m chunk b i v m'
(ST: Mem.store chunk m b (Int.unsigned i) v = Some m')
Roots (VISb: Roots b = true)
(VISv : forall b', getBlocks (v :: nil) b' = true ->
Roots b' = true)
(R: REACH_closed m Roots),
REACH_closed m' Roots.
(*similar proof as Lemma REACH_Store. *)
Lemma REACH_Storebytes: forall m b i bytes m'
(ST: Mem.storebytes m b (Int.unsigned i) bytes = Some m')
Roots (VISb: Roots b = true)
(VISv : forall b' z n, In (Pointer b' z n) bytes ->
Roots b' = true)
(R: REACH_closed m Roots),
REACH_closed m' Roots.
Lemma REACH_load_vis: forall chunk m b i b1 ofs1
(LD: Mem.load chunk m b (Int.unsigned i) = Some (Vptr b1 ofs1))
mu (VIS: vis mu b = true),
REACH m (vis mu) b1 = true.