(* Require Import VST.concurrency.lib.Coqlib3. *)
Set Bullet Behavior "Strict Subproofs".
(** *Extension to rewrite library:*)
(*    We add partially reflexive relations: https://coq.inria.fr/refman/addendum/generalized-rewriting.html#rewriting-and-non-reflexive-relations *)
Class PartReflexive {A:Type} (P: A -> Prop) R:=
{ PReflex: forall x : A, P x -> R x x }.
intros. eapply H; auto.
Qed.
(* This ensures that when ProperProxy is ebing resolved, partial reflexivity is considered *)
Hint Extern 3 (ProperProxy ?R _) =>
not_evar R; class_apply @part_reflexive_proper_proxy;
try typeclasses eauto; eauto
: typeclass_instances.
(* We present two more relations that help take advantage of the above.*)
Inductive trieq {A : Type} (x : A) : A -> A -> Prop :=
| triew_refl: trieq x x x.
Hint Resolve (triew_refl).
Instance trieq_PartReflexive: forall A (x:A), PartReflexive (eq x) (trieq x).
Definition eq_P {A : Type} (P:A -> Prop) (x y: A) : Prop :=
(x = y) /\ P x.
Instance eq_P_PartReflexive: forall {A P}, PartReflexive P (@eq_P A P).
(* End rewrite extension*)
Ltac rewrite_getPerm_goal:=
match goal with
| [|- context[(?f ?m) !! ?b ?ofs ?k] ] =>
replace ((f m) !! b ofs k) with (permission_at m b ofs k)
by reflexivity;
match k with
| Cur => rewrite <- getCurPerm_correct
| Max => rewrite <- getMaxPerm_correct
end
end.
Ltac rewrite_getPerm_hyp:=
match goal with
| [H: context[(?f ?m) !! ?b ?ofs ?k]|- _ ] =>
replace ((f m) !! b ofs k) with (permission_at m b ofs k) in H
by reflexivity;
match k with
| Cur => rewrite <- getCurPerm_correct in H
| Max => rewrite <- getMaxPerm_correct in H
end
end.
Ltac rewrite_getPerm := first [rewrite_getPerm_goal|rewrite_getPerm_hyp].
Definition access_map_equiv (a1 a2: access_map): Prop :=
forall b, a1 !! b =  a2 !! b.
Instance access_map_equiv_Equivalence: Equivalence access_map_equiv.
Ltac destruct_address_range b ofs b0 ofs0 n:=
let Hrange:= fresh "Hrange" in
let Hneq:= fresh "Hneq" in
destruct (Coqlib.peq b b0) as [Hneq | Hneq];
[subst b0;
destruct (Intv.In_dec ofs0
(ofs, ofs + BinInt.Z.of_nat(n))%Z )
as [Hrange | Hrange]
| ].
Instance setPermBlock_access_map_equiv:
Proper (eq ==> eq ==> eq ==>
access_map_equiv ==> eq_P (lt 0) ==>  access_map_equiv)
(setPermBlock ).
Definition Max_equiv (m1 m2: mem): Prop :=
access_map_equiv (getMaxPerm m1) (getMaxPerm m2).
Global Instance Equivalenc_Max_equiv:
Equivalence Max_equiv.
Definition Cur_equiv (m1 m2: mem): Prop :=
access_map_equiv (getCurPerm m1) (getCurPerm m2).
Global Instance Equivalenc_Cur_equiv:
Equivalence Cur_equiv.
Definition content_equiv (m1 m2: mem):=
forall b ofs,
ZMap.get ofs (Mem.mem_contents m1) !! b =
ZMap.get ofs (Mem.mem_contents m2) !! b.
Global Instance Equivalenc_content_equiv:
Equivalence content_equiv.
Instance Proper_perm_max:
Proper (Max_equiv ==> eq ==> eq ==> (trieq Max) ==> eq ==> iff) Mem.perm.
Instance Proper_perm_cur:
Proper (Cur_equiv ==> eq ==> eq ==> (trieq Cur) ==> eq ==> iff) Mem.perm.
Instance Proper_perm:
Proper (mem_equiv ==> eq ==> eq ==> eq ==> eq ==> iff) Mem.perm.
Instance Proper_perm_Max:
Proper (Max_equiv ==> eq ==> eq ==> trieq Max ==> eq ==> iff) Mem.perm.
Instance range_perm_mem_equiv:
Proper (mem_equiv ==> eq ==>  eq ==>  eq ==>  eq ==>  eq ==> iff) Mem.range_perm.
Instance range_perm_mem_equiv_Max:
Proper (Max_equiv ==> eq ==>  eq ==>  eq ==>  trieq Max  ==>  eq ==> iff) Mem.range_perm.
Instance range_perm_mem_equiv_Cur:
Proper (Cur_equiv ==> eq ==>  eq ==>  eq ==>  trieq Cur  ==>  eq ==> iff) Mem.range_perm.
Instance mem_inj_equiv:
Proper ( eq ==> mem_equiv ==> mem_equiv ==> iff) Mem.mem_inj.
Instance Proper_nextblock:
Proper (mem_equiv ==> Logic.eq) Mem.nextblock.
Instance Proper_no_overlap_max_equiv:
Proper (Logic.eq ==> Max_equiv ==> iff)
Mem.meminj_no_overlap.
Instance Proper_no_overlap_mem_equiv:
Proper (eq ==> mem_equiv ==> iff) Mem.meminj_no_overlap.
Instance mem_inject_equiv:
Proper  ( eq ==> mem_equiv ==> mem_equiv ==> iff) Mem.inject.
Instance permMapLt_equiv:
Proper (access_map_equiv ==> access_map_equiv ==> iff)
permMapLt.

Lemma restrPermMap_idempotent:
forall perm0 perm1 m1 Hlt0 Hlt1 Hlt2,
mem_equiv (@restrPermMap perm1 m1 Hlt1)
(@restrPermMap perm1 (@restrPermMap perm0 m1 Hlt0) Hlt2).