Require Coq.Wellfounded.Wellfounded. (* Can't Import this, because that brings the identifier B into
scope, which breaks things like `{ageable B}  in this file.
Stupid feature of Coq, that the B in `{ageable B} is not unambiguously a
binding occurrence of B.  *)
Declare Scope pred.
Delimit Scope pred with pred.
Local Open Scope pred.
Definition pred (A:Type) := A -> Prop.
Bind Scope pred with pred.
Definition derives (A:Type) (P Q:pred A) := forall a:A, P a -> Q a.
Arguments derives [A] _ _.
Definition prop {A: Type}  (P: Prop) : pred A := (fun _  => P).
Hint Unfold prop : core.
Definition TT {A}: pred A := prop True.
Definition FF  {A}: pred A := prop False.
Set Implicit Arguments.
Definition imp {A}  (P Q:pred A) :=
fun a:A => P a -> Q a.
Definition orp {A} (P Q:pred A) :=
fun a:A => P a \/ Q a.
Definition andp {A} (P Q:pred A) :=
fun a:A => P a /\ Q a.
Definition allp {A B: Type} (f: B -> pred A) : pred A
:= fun a => forall b, f b a.
Definition exp {A B: Type} (f: B -> pred A) : pred A
:= fun a => exists b, f b a.
Notation "'emp'" := identity.
Definition sepcon {A} {JA: Join A}(p q:pred A) := fun z:A =>
exists x:A, exists y:A, join x y z /\ p x /\ q y.
Definition wand {A}  {JA: Join A}  (p q:pred A) := fun y =>
forall x z, join x y z -> p x -> q z.
Declare Scope pred_derives.
Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity) : pred_derives.
Open Scope pred_derives.
Notation "'EX' x .. y , P " :=
(exp (fun x => .. (exp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
Notation "'ALL' x .. y , P " :=
(allp (fun x => .. (allp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
Infix "||" := orp (at level 50, left associativity) : pred.
Infix "&&" := andp (at level 40, left associativity) : pred.
Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : pred.
Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred.
Notation "P '*' Q" := (sepcon P Q) : pred.
Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
Notation "'!!' e" := (prop e) (at level 25) : pred.
Definition precise {A}  {JA: Join A}{PA: Perm_alg A}  (P: pred A) : Prop :=
forall w w1 w2, P w1 -> P w2 -> join_sub w1 w -> join_sub w2 w -> w1=w2.
Definition precise2  {A} {JA: Join A}{PA: Perm_alg A}  (P: pred A) : Prop :=
forall Q R, P * (Q && R) = (P * Q) && (P * R).
Definition exactly {A} (x: A) : pred A := fun w => w=x.
intros.
extensionality w; apply prop_ext; split; unfold prop, andp; simpl; intros; intuition.
Qed.
Hint Resolve @TT_i : core.
intros; unfold andp,  TT, prop; extensionality w.
apply prop_ext; intuition.
Qed.
Definition ewand {A} {JA: Join A} (P Q: pred A) : pred A :=
fun w => exists w1, exists w2, join w1 w w2 /\ P w1 /\ Q w2.
(* Notation "P '-o' Q" := (ewand P Q) (at level 60, right associativity). *)
Hint Resolve @derives_refl : core.
Hint Resolve @derives_TT : core.
Definition superprecise {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} (P: pred A) :=
forall w1 w2, P w1 -> P w2 -> comparable w1 w2 -> w1=w2.
Definition list_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} : list (pred A) -> pred A := fold_right sepcon emp.
Hint Resolve @exactly_i : core.
Hint Resolve @superprecise_exactly : core.

Lemma find_overlap {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
Cross_alg A ->
forall S P Q R, (S * P) && (Q * R) |--
EX SQ:_, EX SR:_, EX PQ:_, EX PR:_,
(((SQ* SR) && S)*((PQ* PR) && P)) &&
(((SQ* PQ) && Q)*((SR* PR) && R)) &&
!! (superprecise SQ /\ superprecise SR /\ superprecise PQ /\ superprecise PR).