Module MemObsEq.
(* A compcert injection would not work because it allows permissions to go up *)
(* Moreover, we require that undefined values are matched by the target memory, unlike compcert injections. Although the latter is not neccessary and in retrospect may be a limiting factor. For example we would be able to reuse this development for our final erasure if we allowed undefined values to become more defined. *)
(** Weak injection between memories *)
Record weak_mem_obs_eq (f : memren) (mc mf : mem) :=
{
domain_invalid: forall b, ~(Mem.valid_block mc b) -> f b = None;
domain_valid: forall b, Mem.valid_block mc b -> exists b', f b = Some b';
codomain_valid: forall b1 b2, f b1 = Some b2 -> Mem.valid_block mf b2;
injective: forall b1 b1' b2, f b1 = Some b2 ->
f b1' = Some b2 ->
b1 = b1';
perm_obs_weak :
forall b1 b2 ofs (Hrenaming: f b1 = Some b2),
Mem.perm_order''
(permission_at mc b1 ofs Cur)
(permission_at mf b2 ofs Cur)}.
(** Strong injection between memories *)
Record strong_mem_obs_eq (f : memren) (mc mf : mem) :=
{ perm_obs_strong :
forall b1 b2 ofs (Hrenaming: f b1 = Some b2),
permission_at mf b2 ofs Cur =
(permission_at mc b1 ofs Cur);
val_obs_eq :
forall b1 b2 ofs (Hrenaming: f b1 = Some b2)
(Hperm: Mem.perm mc b1 ofs Cur Readable),
memval_obs_eq f (Maps.ZMap.get ofs mc.(Mem.mem_contents)#b1)
(Maps.ZMap.get ofs mf.(Mem.mem_contents)#b2)}.
(** Renaming between memories *)
Record mem_obs_eq (f : memren) (mc mf : mem) :=
{ weak_obs_eq : weak_mem_obs_eq f mc mf;
strong_obs_eq : strong_mem_obs_eq f mc mf }.
Proof with eauto with renamings id_renamings val_renamings.
intros.
constructor; constructor;
eauto with id_renamings; unfold id_ren; intros;
repeat match goal with
| [H: context[valid_block_dec ?M ?B] |- _] =>
destruct (valid_block_dec M B); simpl in *
| [H: _ = Some _ |- _] => inv H; clear H
end; auto.
rewrite setMaxPerm_Cur;
apply po_refl.
rewrite setMaxPerm_Cur; auto.
destruct (ZMap.get ofs (Mem.mem_contents m) # b2) eqn:Hget;
constructor.
destruct v0; constructor.
specialize (H _ v _ _ Hget).
simpl in H.
(*this gives an anomaly: erewrite Coqlib2.if_true with (E:= {Mem.valid_block m b} + {~ Mem.valid_block m b}). *)
destruct (valid_block_dec m b); simpl; tauto.
Qed.
Proof with eauto with renamings id_renamings val_renamings.
intros.
constructor; constructor;
eauto with id_renamings; unfold id_ren; intros;
repeat match goal with
| [H: context[valid_block_dec ?M ?B] |- _] =>
destruct (valid_block_dec M B); simpl in *
| [H: _ = Some _ |- _] => inv H; clear H
end; auto.
now apply po_refl.
destruct (ZMap.get ofs (Mem.mem_contents m) # b2) eqn:Hget;
constructor.
destruct v0; constructor.
specialize (H _ v _ _ Hget).
simpl in H.
destruct (valid_block_dec m b); simpl; tauto.
Qed.
Transparent Mem.load.
Opaque Mem.load.
Transparent Mem.loadbytes.
Opaque Mem.loadbytes.
(** ** Lemmas about [Mem.store] and [mem_obs_eq]*)
(** Storing related values on related memories results in related memories*)
Transparent Mem.store.
Opaque Mem.store.
Transparent Mem.storebytes.
Opaque Mem.storebytes.
Transparent Mem.free.
Opaque Mem.free.

Lemma alloc_obs_eq:
forall f m m' lo hi m2 m2' b b'
(Hobs_eq: mem_obs_eq f m m')
(Halloc: Mem.alloc m lo hi = (m2, b))
(Halloc': Mem.alloc m' lo hi = (m2', b')),
exists f',
f' b = Some b' /\
mem_obs_eq f' m2 m2' /\
ren_incr f f' /\
ren_separated f f' m m' /\
(exists p : positive,
Mem.nextblock m2 = (Mem.nextblock m + p)%positive /\
Mem.nextblock m2' = (Mem.nextblock m' + p)%positive) /\
(forall b0 : block,
Mem.valid_block m2' b0 ->
~ Mem.valid_block m' b0 ->
f'
(Z.to_pos
match - Z.pos_sub (Mem.nextblock m') (Mem.nextblock m) with
| 0 => Z.pos b0
| Z.pos y' => Z.pos (b0 + y')
| Z.neg y' => Z.pos_sub b0 y'
end) = Some b0 /\
f
(Z.to_pos
match - Z.pos_sub (Mem.nextblock m') (Mem.nextblock m) with
| 0 => Z.pos b0
| Z.pos y' => Z.pos (b0 + y')
| Z.neg y' => Z.pos_sub b0 y'
end) = None) /\
(Mem.nextblock m = Mem.nextblock m' ->
(forall b1 b3 : block, f b1 = Some b3 -> b1 = b3) ->
forall b1 b0 : block, f' b1 = Some b0 -> b1 = b0).