Require Export Monotonicity.
(** Kripke logical relations generalize logical relations along the lines of the Kripke semantics of modal logic. A Kripke logical relation is indexed by a set of worlds equipped with an accessibility relation.  This is useful when reasoning about stateful systems, because in that context the way we want to relate different components may evolve with the system state. Then, the Kripke world is essentially the relational counterpart to the state of the system, and the accessibility relation specifies how this world may evolve alongside the state (it denotes a notion of "possible future", for instance). *)
(** * Kripke frames and logical relations *)
(** Kripke frames specify the set of worlds over which a KLR is indexed and an associated accessibility relation. For a given Kripke frame, the type [klr] is a [W]-indexed version of [rel]. *)
Definition klr W A B: Type :=
W -> rel A B.
Class KripkeFrame (L: Type) (W: Type) :=
{
acc: L -> rel W W;
}.
Infix "~>" := (acc tt) (at level 70).
Delimit Scope klr_scope with klr.
Bind Scope klr_scope with klr.
(** * Operations on KLRs *)
Inductive klr_sum {WA A1 A2 WB B1 B2} RA RB: klr (WA + WB) (A1 + B1) (A2 + B2) :=
| klr_inl w a1 a2 :
RA w a1 a2 ->
klr_sum RA RB (inl w) (inl a1) (inl a2)
| klr_inr w b1 b2 :
RB w b1 b2 ->
klr_sum RA RB (inr w) (inr b1) (inr b2).
(** * Kripke relators *)
(** Just like relators allow us to construct complex relations from simpler ones in a structure-preserving way, Kripke relators allow us to build complex Kripke relations from simpler Kripke relations. *)
(** ** Lifted relators *)
(** First, we lift usual relators to obtain a Kripke version, basically as the pointwise extension over worlds of the original ones. *)
(** *** Lifiting operators *)
Section LIFT.
Context `{kf: KripkeFrame}.
Context {A1 B1 A2 B2 A B: Type}.
(** For elementary relations, the corresponding Kripke relation can just ignore the Kripke world. *)
Definition k (R: rel A B): klr W A B :=
fun w => R.
Global Instance k_rel var:
Monotonic k (var ++> - ==> var).

(* Specifications: *)
Lemma k_rintro R (w: W) (x: A) (y: B):
RIntro (R x y) (k R w) x y.
Lemma k_relim (R: rel A B) w x y P Q:
RElim R x y P Q ->
RElim (k R w) x y P Q.