(* * Copyright (c) 2009-2012, Andrew Appel, Robert Dockins and Aquinas Hobor. * This presentation of Permission Algebras and Separation Algebras * includes ideas from a discussion with Jonas Jensen and also from * a paper by Francois Pottier. *)
Set Implicit Arguments.
Class Join (t: Type) : Type := join: t -> t -> t -> Prop.
(* "Permission Algebra": commutative semigroup, such that if units exist, they must have certain properties. *)
Class Perm_alg (t: Type) {J: Join t} : Type :=
mkPerm   {
join_eq: forall {x y z z'}, join x y z -> join x y z' -> z = z';
join_assoc: forall {a b c d e}, join a b d -> join d c e ->
{f : t & join b c f /\ join a f e};
join_comm: forall {a b c}, join a b c -> join b a c;
join_positivity: forall {a a' b b'}, join a a' b -> join b b' a -> a=b
}.
Arguments Perm_alg _ {J}.
Definition unit_for {t}{J: Join t} (e a: t) := join e a a.
Definition identity {t} {J: Join t} (e: t) := forall a b, join e a b -> a=b.
Hint Extern 2 (@join _ _ _ _ _) =>
(eapply join_comm; trivial;
try eassumption;
(* This next line looks superfluous, but it is not: it catches the case where H is join at a function type, where the goal is join at an applied function. *)
match goal with H: @join _ _ _ _ _ |- _ => apply H end)
: core.
(* Hint Immediate @join_comm. *)
Hint Unfold unit_for : core.
(* Sep_alg: additional properties that makes a Permission Algebra into a Separation Algebra. *)
Class Sep_alg A {J: Join A} : Type :=
mkSep {
core: A -> A;
core_unit: forall t, unit_for (core t) t;
join_core: forall {a b c}, join a b c -> core a = core c
}.
Arguments Sep_alg _ {J}.
(* Disj_alg: adds the property that no nonempty element can join with itself. *)
Class Disj_alg  (t: Type) {J: Join t} :=
join_self: forall {a b}, join a a b -> identity a.
Arguments Disj_alg _ {J}.
(* Sing_alg: adds the property that makes the Permission Algebra into a single-unit Separation Algebra.  (this is the "traditional" kind of Separation Algebra).   *)
Class Sing_alg A {J: Join A}{SA: Sep_alg A} :=
mkSing {
the_unit: A;
the_unit_core: forall a, core a = the_unit
}.
Arguments Sing_alg _ {J} {SA}.
Arguments mkSing [A] [J] [SA] _ _.
(* Positive Permission Algebra: there are no units, every element is nonempty *)
Class Pos_alg  {A} {J: Join A} :=
no_units: forall e a, ~unit_for e a.
Arguments Pos_alg _ {J}.
(* Has the "cross-split" property described in Dockins et al, "A fresh look at separation algebras and share accounting", 2009 *)
Class Cross_alg (t: Type)  `{J: Join t} :=
cross_split :
forall a b c d z : t,
join a b z ->
join c d z ->
{ x:(t*t*t*t) &  match x with (ac,ad,bc,bd) =>
join ac ad a /\ join bc bd b /\ join ac bc c /\ join ad bd d
end
}.
Arguments Cross_alg _ {J}.
(* Has the "triple join" property  *)
Class Trip_alg {A} {J: Join A} :=
triple_join_exists:
forall (a b c ab bc ac : A), join a b ab -> join b c bc -> join a c ac ->
{abc | join ab c abc}.
Arguments Trip_alg _ {J}.
(* We do NOT yet introduce "emp" as a notation or synonym for "identity". This is because "emp" is a predicate of Separation Logic, but this file contains only Separation Algebras.  Some separation logics have predicates that are not just "t -> Prop", and therefore it is premature in this file to define "emp". *)
(** * Lemmas about separation algebras. *)
(** Elements [a] and [b] join. *)
Definition joins {A} {J: Join A} (a b : A) : Prop :=
exists c, join a b c.
Definition overlap {A}{J: Join A} (a b: A) := ~(joins a b).
(** Elememt [a] is a subelement of [c] .  This relation forms a partial order. *)
Definition join_sub {A} `{Join A} (a c : A) : Prop :=
exists b, join a b c.
Hint Resolve @join_sub_refl : core.
(* Note: there are two other conceivable conclusions from the above premises: "joins b b" and "join_sub b a".  Neither must follow, since neither is true on the bools, but also neither is a contradiction since both are true on Z *)
Definition sub_silhouette {A} `{Perm_alg A} (a b: A) : Prop :=
forall c, joins c b -> joins c a.
Definition same_silhouette {A} `{Perm_alg A} (a b: A) : Prop :=
forall c, joins c a <-> joins c b.
Hint Resolve @join_joins @join_joins' @join_join_sub @join_join_sub' : core.
Definition nonidentity {A} `{Perm_alg A} (a: A) := ~(identity a).

Lemma unit_core{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A}:
forall {a}, unit_for a a -> a = (core a).