(* * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor. * *)
Definition compareR {A} {JA: Join A}{SA: Sep_alg A}{AG: ageable A} : relation A
:= comparable.
Definition extendR  {A} {JA: Join A}{PA: Perm_alg A}{AG: ageable A} : relation A := join_sub.
Definition compareM {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : modality
:= exist _ compareR valid_rel_compare.
Definition extendM {A}{JA: Join A}{PA: Perm_alg A}{AG: ageable A}{XA: Age_alg A} : modality
:= exist _ extendR valid_rel_extend.
(* Definitions of the BI connectives. *)
Obligation Tactic := unfold hereditary; intros; try solve [intuition].
Program Definition emp {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : pred A := identity.
Next Obligation.
repeat intro.
destruct (unage_join _ H1 H) as [a0' [b' [? [? ?]]]].
apply H0 in H2. subst b'. unfold age in H3, H4. congruence.
Qed.
Program Definition sepcon {A}  {JA: Join A}{PA: Perm_alg A}{AG: ageable A}{XA: Age_alg A} (p q:pred A) : pred A := fun x:A =>
exists y:A, exists z:A, join y z x /\ p y /\ q z.
Next Obligation.
destruct H0 as [y [z [? [? ?]]]].
destruct (age1_join2 _ H0 H) as [w [v [? [? ?]]]].
exists w; exists v; split; auto.
split.
apply pred_hereditary with y; auto.
apply pred_hereditary with z; auto.
Qed.
Program Definition wand {A}  {JA: Join A}{PA: Perm_alg A}{AG: ageable A}{XA: Age_alg A} (p q:pred A) : pred A := fun x =>
forall x' y z, necR x x' -> join x' y z -> p y -> q z.
Next Obligation.
apply H0 with x' y; auto.
apply rt_trans with a'; auto.
apply rt_step; auto.
Qed.
Notation "P '*' Q" := (sepcon P Q) : pred.
Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
Notation "'%' e"  := (box extendM e)(at level 30, right associativity): pred.

Lemma compareM_refl {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : reflexive _ compareM.