(* Definitions of the basic modalities. *)
Definition laterM {A} `{ageable A} : modality
:= exist _ laterR valid_rel_later.
(* Definition necM {A} `{ageable A} : modality := exist _ necR valid_rel_nec. *)
Hint Resolve rt_refl rt_trans t_trans.
Hint Unfold necR.
Obligation Tactic := unfold hereditary; intuition;
first [eapply pred_hereditary; eauto; fail | eauto ].
(* Definitions of the basic propositional conectives. *)
(* Lifting pure mathematical facts to predicates *)
Program Definition prop {A} `{ageable A}  (P: Prop) : pred A := (fun _  => P).
Definition TT {A} `{ageable A}: pred A := prop True.
Definition FF  {A} `{ageable A}: pred A := prop False.
Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A :=
fun a:A => forall a':A, necR a a' -> P a' -> Q a'.
Next Obligation.
apply H1; auto.
apply rt_trans with a'; auto.
apply rt_step; auto.
Qed.
Program Definition orp {A} `{ageable A} (P Q:pred A) : pred A :=
fun a:A => P a \/ Q a.
Next Obligation.
left; eapply pred_hereditary; eauto.
right; eapply pred_hereditary; eauto.
Qed.
Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A :=
fun a:A => P a /\ Q a.
(* Universal and exp quantification *)
Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A
:= fun a => forall b, f b a.
Next Obligation.
apply pred_hereditary with a; auto.
apply H1.
Qed.
Program Definition exp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A
:= fun a => exists b, f b a.
Next Obligation.
destruct H1; exists x; eapply pred_hereditary; eauto.
Qed.
(* Definition of the "box" modal operator.  This operator turns modalities (relations) into a "necessarily" type operator. *)
Program Definition box {A} `{ageable A} (M:modality) (P:pred A) : pred A :=
fun a:A => forall a', M a a' -> P a'.
Next Obligation.
destruct M as [M [H3 H4]]; simpl in *.
destruct (H4 _ _ H2 _ H0).
apply pred_hereditary with x; auto.
apply H1; auto.
Qed.
(* Definition of the "diamond" modal operator.  This operator turns modalities into a "possibly" type operator.  _However_, note that this is NOT the boolean dual to "box", as usually found in accounts of modal logic. Instead, this is the "proof-theoretic" dual as found in Restall's "A Introduction to Substructural Logic" (2000). *)
Program Definition diamond {A} `{ageable A} (M:modality) (P:pred A) : pred A :=
fun a:A => exists a', M a' a /\ P a'.
Next Obligation.
destruct M as [M [H3 H4]]; simpl in *.
destruct H1 as [x [? ?]].
destruct (H3 _ _ H0 _ H1).
exists x0; split; auto.
apply pred_hereditary with x; auto.
Qed.
Definition boxy {A} `{ageable A} (m: modality) (p: pred A): Prop :=  box m p = p.
(* A pile of notations for the operators we have defined *)
Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity).
Notation "'EX'  x ':' T ',' P " := (exp (fun x:T => P%pred)) (at level 65, x at level 99) : pred.
Notation "'ALL'  x ':' T  ',' P " := (allp (fun x:T => P%pred)) (at level 65, x at level 99) : 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 "'[]' e" := (box necM e) (at level 30, right associativity): pred. *)
Notation "'|>' e" := (box laterM e) (at level 30, right associativity): pred.
Notation "'!!' e" := (prop e) (at level 25) : pred.

Lemma and3 {A} `{ageable A} : forall (X P Q R:pred A),
X |-- (P --> Q) --> (P --> R) --> (P --> Q && R).