(* 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.

(* Specifications: *)
(* Rules for the propositional connectives *)
Lemma modus_ponens {A} `{ageable A} : forall (X P Q:pred A),
X |-- P ->
X |-- (P --> Q) ->
X |-- Q.
Lemma andp_right {A} `{ageable A} : forall (X P Q:pred A),
X |-- P ->
X |-- Q ->
X |-- P && Q.
Lemma pred_ext' {A} `{ageable A}: forall (p1 p2:pred A),
app_pred p1 = app_pred p2 ->
p1 = p2.
Lemma pred_ext : forall A `{ageable A} (P Q:pred A),
derives P Q -> derives Q P -> P = Q.
Lemma andp_dup {A}{agA: ageable A}: forall P: pred A, P && P = P.
Lemma andp_left1{A}{agA: ageable A}: forall P Q R: pred A,  P |-- R -> P && Q |-- R.
Lemma andp_left2{A}{agA: ageable A}: forall P Q R: pred A,  Q |-- R -> P && Q |-- R.
Lemma orp_left{A}{agA: ageable A}: forall P Q R: pred A,  P |-- R -> Q |-- R -> P || Q |-- R.
Lemma orp_right1{A}{agA: ageable A}: forall P Q R: pred A,  P |-- Q -> P |-- Q || R.
Lemma orp_right2{A}{agA: ageable A}: forall P Q R: pred A,  P |-- R -> P |-- Q || R.
Lemma derives_trans {A}`{ageable A}:
forall P Q R: pred A, P |-- Q -> Q |-- R -> P |-- R.
Lemma exp_left:
forall {B A: Type}{agA: ageable A}(p: B -> pred A) q,
(forall x, p x |-- q) ->
exp p |-- q.
Lemma and1 {A} `{ageable A} : forall (X P Q:pred A),
X |-- P && Q --> P.
Lemma and2 {A} `{ageable A} : forall (X P Q:pred A),
X |-- P && Q --> Q.
Lemma and3 {A} `{ageable A} : forall (X P Q R:pred A),
X |-- (P --> Q) --> (P --> R) --> (P --> Q && R).
Lemma or1 {A} `{ageable A} : forall (X P Q:pred A),
X |-- P --> P || Q.
Lemma or2 {A} `{ageable A} : forall (X P Q:pred A),
X |-- Q --> P || Q.
Lemma or3 {A} `{ageable A} : forall (X P Q R:pred A),
X |-- (P --> R) --> (Q --> R) --> (P || Q --> R).
Lemma TTrule {A} `{ageable A} : forall X P,
X |-- P --> TT.
Lemma FFrule {A} `{ageable A} : forall X P,
X |-- FF --> P.
Lemma distribution {A} `{ageable A} : forall (X P Q R:pred A),
X |-- P && (Q || R) --> (P && Q) || (P && R).
(* Characterize the relation between conjunction and implication *)
Lemma imp_andp_adjoint {A} `{ageable A} : forall (P Q R:pred A),
(P && Q) |-- R <-> P |-- (Q --> R).