Module MemErasure.
(** The values of the erased memory may be more defined and its permissions are top.*)
(** In retrospect setting the permissions to top was a bad choice. It should have been that the permissions of the erased memory are above the permissions of the other memory. This would make it more reusable and it wouldn't need a second definition for free. *)
Local Notation "a # b" := (PMap.get b a) (at level 1).
Record mem_erasure (m m': mem) :=
{ perm_le:
forall b ofs k,
Mem.valid_block m' b ->
(Mem.mem_access m')#b ofs k = Some Freeable;
erased_contents: forall b ofs,
memval_erasure (ZMap.get ofs ((Mem.mem_contents m) # b))
(ZMap.get ofs ((Mem.mem_contents m') # b));
erased_nb: Mem.nextblock m = Mem.nextblock m'
}.
Proof with eauto with val_erasure.
intros.
destruct v1,v2; simpl in *; inv Hval_erasure; auto;
unfold Val.cmpu, Val.cmpu_bool; simpl; eauto with val_erasure;
do 2 rewrite andb_if;
repeat match goal with
| [|- context[match ?Expr with | _ => _ end]] =>
destruct Expr eqn:?
end; simpl; eauto with val_erasure.
- eapply mem_erasure_valid_pointer_guard in Heqb2; eauto.
congruence.
- eapply mem_erasure_valid_pointer_guard in Heqb2; eauto.
congruence.
-  subst.
apply andb_false_iff in Heqb3.
destruct Heqb3 as [Heqb3 | Heqb3];
eapply mem_erasure_valid_pointer_guard in Heqb3; eauto;
congruence.
- apply andb_false_iff in Heqb3.
destruct Heqb3 as [Heqb3 | Heqb3].
eapply mem_erasure_valid_pointer in Heqb0; eauto.
exfalso; now eauto.
eapply mem_erasure_valid_pointer in Heqb2; eauto.
exfalso; now eauto.
Qed.
Proof with eauto with val_erasure.
intros.
destruct v1,v2; simpl in *; inv Hval_erasure; auto;
unfold Val.cmplu, Val.cmplu_bool; simpl; eauto with val_erasure;
do 2 rewrite andb_if;
repeat match goal with
| [|- context[match ?Expr with | _ => _ end]] =>
destruct Expr eqn:?
end; simpl; eauto with val_erasure.
Qed.
Hint Resolve val_erasure_cmplu : val_erasure.
Hint Resolve mem_erasure_idempotent mem_erasure_dilute_1
mem_erasure_restr: mem_erasure.
Record mem_erasure' (m m': mem) :=
{ perm_le':
forall b ofs k,
Mem.valid_block m b->
Mem.perm_order'' ((Mem.mem_access m')#b ofs k)
((Mem.mem_access m)#b ofs k);
erased_contents': forall b ofs,
memval_erasure (ZMap.get ofs ((Mem.mem_contents m) # b))
(ZMap.get ofs ((Mem.mem_contents m') # b));
erased_nb': Mem.nextblock m = Mem.nextblock m'
}.

Lemma mem_free_erasure':
forall m m' lo hi m2 b
(Herased: mem_erasure m m')
(Hfree: Mem.free m b lo hi = Some m2),
exists m2',
Mem.free m' b lo hi = Some m2' /\
mem_erasure' m2 m2'.