Global Instance k2_unfold RR (R1: klr W A1 B1) (R2: klr W A2 B2) w:
Related (RR (R1 w) (R2 w)) (k2 RR R1 R2 w) subrel.
End LIFT.
Global Instance k_rel_params: Params (@k) 4.
Global Instance k1_rel_params: Params (@k1) 5.
Global Instance k2_rel_params: Params (@k2) 6.
Hint Extern 0 (RIntro _ (k _ _) _ _) =>
eapply k_rintro : typeclass_instances.
Hint Extern 1 (RElim (k _ _) _ _ _ _) =>
eapply k_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (k1 _ _ _) _ _) =>
eapply k1_rintro : typeclass_instances.
Hint Extern 1 (RElim (k1 _ _ _) _ _ _ _) =>
eapply k1_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (k2 _ _ _ _) _ _) =>
eapply k2_rintro : typeclass_instances.
Hint Extern 1 (RElim (k2 _ _ _ _) _ _ _ _) =>
eapply k2_relim : typeclass_instances.
(** *** Usual relators *)
(** Using the lifting operators defined above, we can provide a set of usual Kripke relators for various types. *)
Section USUAL.
Context `{kf: KripkeFrame}.
Definition arrow_klr {A1 A2 B1 B2} :=
k2 (W:=W) (@arrow_rel A1 A2 B1 B2).
Definition arrow_pointwise_klr A {B1 B2} :=
k1 (W:=W) (@arrow_pointwise_rel A B1 B2).
Definition prod_klr {A1 A2 B1 B2} :=
k2 (W:=W) (@prod_rel A1 A2 B1 B2).
Definition sum_klr {A1 A2 B1 B2} :=
k2 (W:=W) (@sum_rel A1 A2 B1 B2).
Definition list_klr {A1 A2} :=
k1 (W:=W) (@list_rel A1 A2).
Definition set_kle {A B} (R: klr W A B): klr W (A -> Prop) (B -> Prop) :=
fun w sA sB => forall a, sA a -> exists b, sB b /\ R w a b.
Definition set_kge {A B} (R: klr W A B): klr W (A -> Prop) (B -> Prop) :=
fun w sA sB => forall b, sB b -> exists a, sA a /\ R w a b.
Definition klr_union {W A B} :=
k2 (W:=W) (@rel_union A B).
Definition klr_inter {W A B} :=
k2 (W:=W) (@rel_inter A B).
Definition klr_curry {W A1 B1 C1 A2 B2 C2} :=
k1 (W:=W) (@rel_curry A1 B1 C1 A2 B2 C2).
End USUAL.
Notation "RA ==> RB" := (arrow_klr RA RB)
(at level 55, right associativity) : klr_scope.
Notation "RA ++> RB" := (arrow_klr RA RB)
(at level 55, right associativity) : klr_scope.
Notation "RA --> RB" := (arrow_klr (k1 flip RA) RB)
(at level 55, right associativity) : klr_scope.
Notation "- ==> R" := (arrow_pointwise_klr _ R) : klr_scope.
Infix "*" := prod_klr : klr_scope.
Infix "+" := sum_klr : klr_scope.
Infix "\/" := klr_union : klr_scope.
Infix "/\" := klr_inter : klr_scope.
Notation "% R" := (klr_curry R) : klr_scope.
Hint Extern 0 (RIntro _ (arrow_klr _ _ _) _ _) =>
eapply k2_rintro : typeclass_instances.
Hint Extern 1 (RElim (arrow_klr _ _ _) _ _ _ _) =>
eapply k2_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (arrow_pointwise_klr _ _ _) _ _) =>
eapply k1_rintro : typeclass_instances.
Hint Extern 1 (RElim (arrow_pointwise_klr _ _ _) _ _ _ _) =>
eapply k1_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (prod_klr _ _ _) _ _) =>
eapply k2_rintro : typeclass_instances.
Hint Extern 1 (RElim (prod_klr _ _ _) _ _ _ _) =>
eapply k2_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (sum_klr _ _ _) _ _) =>
eapply k2_rintro : typeclass_instances.
Hint Extern 1 (RElim (sum_klr _ _ _) _ _ _ _) =>
eapply k2_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (list_klr _ _) _ _) =>
eapply k1_rintro : typeclass_instances.
Hint Extern 1 (RElim (list_klr _ _) _ _ _ _) =>
eapply k1_relim : typeclass_instances.
Hint Extern 0 (RIntro _ (klr_curry _ _) _ _) =>
eapply k1_rintro : typeclass_instances.
Hint Extern 1 (RElim (klr_curry _ _) _ _ _ _) =>
eapply k1_relim : typeclass_instances.
(** ** Modal relators *)
(** In addition to the usual relators defined above, we can define Kripke-specific relators corresponding to the box and diamond modalities. *)
Section MODALITIES.
Context `{kf: KripkeFrame}.
(** The box modality asserts that the relation holds at all possible future worlds. *)
Definition klr_box {A B} (l: L) (R: klr W A B): klr W A B :=
fun w x y => forall w', acc l w w' -> R w' x y.
Global Instance klr_box_subrel {A B}:
Monotonic (@klr_box A B) (- ==> (- ==> subrel) ++> (- ==> subrel)).

(* Specifications: *)
Lemma klr_box_rintro {A B} l (R: klr W A B) w x y:
RIntro (forall w' (Hw': acc l w w'), R w' x y) (klr_box l R w) x y.
Lemma klr_box_relim {A B} l (R: klr W A B) w w' x y P Q:
RElim (R w') x y P Q ->
RElim (klr_box l R w) x y (acc l w w' /\ P) Q.