Ltac unify_injection:=
match goal with
[H: ?mu ?x = _,H0: ?mu ?x = _ |- _] =>
match type of mu with
| meminj => rewrite H in H0; invert H0
| block -> option (block * Z) => rewrite H in H0; invert H0
end
end.
Local Ltac unify_mapping:=
match goal with
[H: ?a !! ?x ?y = Some _ ,
H0: ?a !! ?x ?y = _ |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = None ,
H0: ?a !! ?x ?y = _ |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = Some _ ,
H0: _ = ?a !! ?x ?y |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = None ,
H0: _ = ?a !! ?x ?y |- _] => rewrite H in H0
end.
Definition inject_lock' size mu (b_lock:block) (ofs_lock: Z) (m1 m2:mem):=
exists b_lock' delt,
mu b_lock = Some (b_lock', delt) /\
( forall ofs0,
Intv.In ofs0 (ofs_lock, (ofs_lock + size)%Z) ->
memval_inject mu
(ZMap.get ofs0 (Mem.mem_contents m1) !! b_lock)
(ZMap.get (ofs0 + delt)%Z
(Mem.mem_contents m2) !! b_lock')).
Definition inject_lock := inject_lock' LKSIZE.
Instance inject_lock_morphism:
Proper (Logic.eq ==> Logic.eq ==> Logic.eq ==>
content_equiv ==> content_equiv ==> iff) inject_lock.
Definition option_implication {A B} (oa:option A) (ob: option B):=
match oa, ob with | Some _, None => False | _, _ => True end.
Definition map_option_implication {A B} (m1:PTree.t A) (m2:PTree.t B):=
forall b, option_implication (m1 ! b) (m2 ! b).
Definition at_least_Some {A} (x:option A):=
option_implication (Some tt) x.
Definition perm_image (f:meminj) (a1: access_map): Prop:=
forall b1 ofs, at_least_Some (a1 !! b1 ofs) ->
exists b2 delta, f b1 = Some (b2, delta).
Instance proper_perm_image:
Proper (Logic.eq ==> access_map_equiv ==> iff) perm_image.
(* The injection maps to every visible location *)
Definition perm_surj (mu:meminj) (a1 a2: access_map):=
forall b2 ofs_delt,
at_least_Some (a2 !! b2 ofs_delt) ->
exists b1 ofs delt, mu b1 = Some (b2, delt) /\
ofs_delt = ofs + delt /\
a2 !! b2 ofs_delt = a1 !! b1 ofs.
(* The injection maps all visible locations*)
Definition access_map_injected (f:meminj) (pmap1 pmap2: access_map):=
forall (b1 b2 : block) (delt ofs: Z),
f b1 = Some (b2, delt) ->
Mem.perm_order'' (pmap2 !! b2 (ofs+delt)%Z) (pmap1 !! b1 ofs).
intros. intros ?????.
do 2 rewrite getMaxPerm_correct.
destruct (permission_at m1 b1 ofs Max) eqn:HH.
- rewrite <- mem_lemmas.po_oo.
eapply Mem.mi_perm; eauto.
+ apply H.
+ unfold Mem.perm.
unfold permission_at in HH; rewrite HH.
simpl. apply perm_refl.
- apply event_semantics.po_None.
Qed.
intros. intros ?????.
do 2 rewrite getCurPerm_correct.
destruct (permission_at m1 b1 ofs Cur) eqn:HH.
- rewrite <- mem_lemmas.po_oo.
eapply Mem.mi_perm; eauto.
+ apply H.
+ unfold Mem.perm.
unfold permission_at in HH;
rewrite HH.
simpl.
apply perm_refl.
- apply event_semantics.po_None.
Qed.
(* bounded_maps*)
(* New permissions*)
(* Permissions *)
Global Instance perm_preimage_setoid:
Proper (Logic.eq ==> access_map_equiv ==>
access_map_equiv ==> iff) perm_surj.
Instance access_map_injected_morphism:
Proper (Logic.eq ==> access_map_equiv  ==> access_map_equiv ==> Logic.iff)
access_map_injected.
Definition mi_memval_perm (f:meminj) (perm1:access_map) cont1 cont2:=
forall b1 b2 delta ofs,
f b1 = Some (b2, delta) ->
Mem.perm_order' (perm1 !! b1 ofs) Readable ->
memval_inject f (ZMap.get ofs cont1 !! b1)
(ZMap.get (ofs + delta) cont2 !! b2).
Instance proper_mi_memval_perm:
Proper (Logic.eq ==> access_map_equiv ==>
Logic.eq ==> Logic.eq ==> iff)
mi_memval_perm.
Definition mi_perm_inv_perm f perm1 perm2 m1:=
forall (b1 : block) (ofs : Z) (b2 : block)
(delta : Z) (p : permission),
f b1 = Some (b2, delta) ->
Mem.perm_order' (perm2 !! b2 (ofs + delta)) p ->
Mem.perm_order' (perm1 !! b1 ofs) p
\/ ~ Mem.perm m1 b1 ofs Max Nonempty.
Instance proper_mi_perm_inv_perm:
Proper (Logic.eq ==> access_map_equiv ==> access_map_equiv ==>
Max_equiv ==> iff) mi_perm_inv_perm.

Lemma inject_restr:
forall mu m1 m2 perm1 perm2,
forall (Hlt1: permMapLt perm1 (getMaxPerm m1))
(Hlt2: permMapLt perm2 (getMaxPerm m2)),
mi_perm_perm mu perm1 perm2 ->
mi_memval_perm mu perm1 (Mem.mem_contents m1) (Mem.mem_contents m2) ->
mi_perm_inv_perm mu perm1 perm2 m1 ->
Mem.inject mu m1 m2 ->
Mem.inject mu (restrPermMap Hlt1) (restrPermMap Hlt2).