(** ** Order on relations *)

(** This is our generalization of [subrelation]. Like the original it
  constitutes a preorder, and the union and intersection of relations
  are the corresponding join and meet. *)

Definition subrel {A B}: rel (rel A B) (rel A B) :=
  fun R1 R2 => forall x y, R1 x y -> R2 x y.Global Instance subrel_preorder A B:
  @PreOrder (rel A B) subrel.Global Instance eq_subrel {A} (R: rel A A):
  Reflexive R ->
  Related eq R subrel.Instance subrel_impl_relim {A B} (R1 R2 : rel A B) x1 x2 y1 y2 P Q:
  RElim impl (R1 x1 y1) (R2 x2 y2) P Q ->
  RElim subrel R1 R2 (x1 = x2 /\ y1 = y2 /\ P) Q.(** * Core relators *)

(** First, we introduce the core relators necessary for everything
  else, namely those for function types. The next section provides a
  more comprehensive library which covers many of the basic inductive
  type constructors as well. *)

(** *** Non-dependent function types *)

(** First, I define relators for non-dependent functions. This
  generalizes [respectful]. *)

Definition arrow_rel {A1 A2 B1 B2}:
  rel A1 A2 -> rel B1 B2 -> rel (A1 -> B1) (A2 -> B2) :=
    fun RA RB f g => forall x y, RA x y -> RB (f x) (g y).Notation "RA ==> RB" := (arrow_rel RA RB)
  (at level 55, right associativity) : rel_scope.Notation "RA ++> RB" := (arrow_rel RA RB)
  (at level 55, right associativity) : rel_scope.Notation "RA --> RB" := (arrow_rel (flip RA) RB)
  (at level 55, right associativity) : rel_scope.Global Instance arrow_subrel {A1 A2 B1 B2}:
  Monotonic (@arrow_rel A1 A2 B1 B2) (subrel --> subrel ++> subrel).Global Instance arrow_subrel_params:
  Params (@arrow_rel) 4.

(* Specifications: *)
Lemma arrow_rintro {A1 A2 B1 B2} (RA: rel A1 A2) (RB: rel B1 B2) f g: RIntro (forall x y, RA x y -> RB (f x) (g y)) (RA ++> RB) f g.
Lemma arrow_relim {A1 A2 B1 B2} RA RB f g m n P Q: @RElim B1 B2 RB (f m) (g n) P Q -> @RElim (A1 -> B1) (A2 -> B2) (RA ++> RB) f g (RA m n /\ P) Q.