(** * Prerequisites *)

(** Some instances that would normally cause loops can be used
  nontheless if we insist that some parameters cannot be existential
  variables. One way to do this is to use this guard class, similar in
  spirit to [Unconvertible]. *)

Class NotEvar {A} (x: A).Hint Extern 1 (Convertible ?x ?y) =>
  eapply eq_refl : typeclass_instances.(** This version of [Unconvertible] does not assume that [a] and [b]
  have convertible types. *)

Class Unconvertible {A B} (a: A) (b: B) := unconvertible : unit.Ltac unconvertible a b :=
  first
    [ unify a b with typeclass_instances; fail 1
    | exact tt ].Hint Extern 1 (Unconvertible ?a ?b) =>
  unconvertible a b : typeclass_instances.(** Sometimes we may want to introduce an auxiliary variable to help
  with unification. *)

Class Convertible {A} (x y: A) :=
  convertible: x = y.(** Sometimes we may want to introduce an auxiliary variable to help
  with unification. *)

Class Convertible {A} (x y: A) :=
  convertible: x = y.(** The following class can be used to inhibit backtracking. *)

Class Once P := once : P.(** The following class can be used to inhibit backtracking. *)

Class Once P := once : P.Hint Extern 1 (Once ?P) =>
  red; once typeclasses eauto : typeclass_instances.(** * Relations *)

(** The constructions in [Coq.Relations.Relation_Definitions] are only
  concerned with relations within a single type, so that [relation A]
  is defined as [A -> A -> Prop]. We will need more general
  relations, and so I define [rel A B] as [A -> B -> Prop]. *)

Definition rel (A1 A2: Type) := A1 -> A2 -> Prop.(** ** Proof step *)

(** This is a catch-all class for any applicable strategy allowing us
  to make progress towards solving a relational goal. The proposition
  [P] should encode the new subgoals, in the format expected by
  [Delay.split_conjunction], and is decomposed accordingly in the
  [rstep] tactic.

  At the moment, the following priorities are used for our different
  [RStep] instances. Generally speaking, the most specific, quick
  tactics should be registered with higher priority (lower numbers),
  and the more general, slow tactics that are likely to instantiate
  evars incorrectly or spawn them too early should have lower priority
  (higher numbers):

    - 10 [RIntro]
    - 30 [preorder]
    - 40 [RDestruct]
    - 50 [Monotonicity] (includes [Reflexivity] -- we may want to split)
    - 70 [RExists] *)

Class RStep (P Q: Prop) :=
  rstep: P -> Q.Ltac rstep :=
  lazymatch goal with
    | |- ?Q =>
      apply (rstep (Q := Q));
      Delay.split_conjunction
  end.(** ** Proof automation *)

(** The following class solves the goal [Q] automatically. The
  typeclass resolution process allows for backtracking, trying every
  possible [RStep] at a given time. *)

Class RAuto (Q: Prop) :=
  rauto : Q.Ltac rauto :=
  lazymatch goal with
    | |- ?Q =>
      apply (rauto (Q := Q));
      Delay.split_conjunction
  end.(** After applying each step, we need to decompose the premise into
  individual subgoals, wrapping each one into a new [RAuto] goal so
  that the process continues.

  Note the use of [Once] below: while choosing a step to apply next
  can involve some backtracking, once a step has been chosen [RAuto]
  never backtracks. This avoids exponential blow up in the search
  space, so that [RAuto] remains efficient even in case of failure.
  From a usability perspective, it also encourages proper hygiene when
  declaring instances, since extraneous or too broadly applicable
  instance will cause failures (rather than silently add weight to the
  system). *)

Class RAutoSubgoals (P: Prop) :=
  rauto_subgoals : P.(** After applying each step, we need to decompose the premise into
  individual subgoals, wrapping each one into a new [RAuto] goal so
  that the process continues.

  Note the use of [Once] below: while choosing a step to apply next
  can involve some backtracking, once a step has been chosen [RAuto]
  never backtracks. This avoids exponential blow up in the search
  space, so that [RAuto] remains efficient even in case of failure.
  From a usability perspective, it also encourages proper hygiene when
  declaring instances, since extraneous or too broadly applicable
  instance will cause failures (rather than silently add weight to the
  system). *)

Class RAutoSubgoals (P: Prop) :=
  rauto_subgoals : P.Global Instance rauto_rstep P Q:
  Once (RStep P Q) ->
  RAutoSubgoals P ->
  RAuto Q.Ltac rauto_split :=
  red;
  Delay.split_conjunction;
  lazymatch goal with
    | |- ?Q => change (RAuto Q)
  end.(** ** Introduction rules *)

(** In effect, [RIntro] is pretty much identical to [RStep], but we
  like to separate introduction rules and the [rintro] tactic. *)

Class RIntro {A B} (P: Prop) (R: rel A B) (m: A) (n: B): Prop :=
  rintro: P -> R m n.Ltac rintro :=
  lazymatch goal with
    | |- ?R ?m ?n =>
      apply (rintro (R:=R) (m:=m) (n:=n));
      Delay.split_conjunction
  end.Global Instance rintro_rstep:
  forall `(RIntro), RStep P (R m n) | 10.(** Most introduction rules are entierly reversible. For instance,
  suppose we use the introduction rule for [++>] on a goal of the form
  [(R1 ++> R2) f g], to obtain [Hxy: R1 x y |- R2 (f x) (g y)]. If at
  a later stage we manage to prove our old goal [Hfg: (R1 ++> R2) f g],
  we can always use the elimination rule for [++>] in conjunction with
  the two hypotheses to prove [R2 (f x) (g y)].

  On the other hand, whenever a new existential variable is involved,
  this reversibility is lost: the time of introduction of the evar
  determines what a valid instantiation is, and there is no way to go
  back if we want to use components introduced later, say by
  destructing one of the hypotheses.

  For this reason, we want such introduction rules to be used only as
  a last resort, and segregate them as instances of the following
  class rather than [RIntro]. Moreover, to make sure that we don't
  leave the user in a dead-end, we only use it if we can immediately
  solve the resulting subgoal. *)

Class RExists {A B} (P: Prop) (R: rel A B) (m: A) (n: B): Prop :=
  rexists: P -> R m n.(** Most introduction rules are entierly reversible. For instance,
  suppose we use the introduction rule for [++>] on a goal of the form
  [(R1 ++> R2) f g], to obtain [Hxy: R1 x y |- R2 (f x) (g y)]. If at
  a later stage we manage to prove our old goal [Hfg: (R1 ++> R2) f g],
  we can always use the elimination rule for [++>] in conjunction with
  the two hypotheses to prove [R2 (f x) (g y)].

  On the other hand, whenever a new existential variable is involved,
  this reversibility is lost: the time of introduction of the evar
  determines what a valid instantiation is, and there is no way to go
  back if we want to use components introduced later, say by
  destructing one of the hypotheses.

  For this reason, we want such introduction rules to be used only as
  a last resort, and segregate them as instances of the following
  class rather than [RIntro]. Moreover, to make sure that we don't
  leave the user in a dead-end, we only use it if we can immediately
  solve the resulting subgoal. *)

Class RExists {A B} (P: Prop) (R: rel A B) (m: A) (n: B): Prop :=
  rexists: P -> R m n.Ltac reexists :=
  lazymatch goal with
    | |- ?R ?m ?n =>
      apply (rexists (R:=R) (m:=m) (n:=n));
      Delay.split_conjunction
  end.Global Instance rexists_rstep {A B} P R (m:A) (n:B):
  RExists P R m n ->
  NonDelayed (RAutoSubgoals P) ->
  RStep True (R m n) | 70.(** ** Using relations *)

(** As we extend our relations language with new relators, we need to
  be able to extend the ways in which corresponding relational
  properties can be applied to a given goal. The following type class
  expresses that the relational property [R m n] can be applied to a
  goal of type [Q], generating the subgoal [P]. *)

Class RElim {A B} (R: rel A B) (m: A) (n: B) (P Q: Prop): Prop :=
  relim: R m n -> P -> Q.Ltac relim H :=
  lazymatch goal with
    | |- ?Q =>
      apply (relim (Q:=Q) H)
  end.(** The resolution process is directed by the syntax of [R]. We define
  an instance for each function relator. The base case simply uses the
  relational property as-is. *)

Global Instance relim_base {A B} (R: rel A B) m n:
  RElim R m n True (R m n) | 10.(** ** Destructing relational hypotheses *)

(** To make progress when the goal relates two pattern matching
  constructions, we need to show that the two matched terms are
  related, then destruct that hypothesis in a such a way that the two
  terms reduce to constructors.

  For most relators of inductive types, the constructors of the
  relator will simply follow the constructors of the corresponding
  type, so that destructing the relational hypothesis in the usual way
  will produce the desired outcome. However, sometimes it is more
  convenient to define such relators in a different way (see for
  instance [prod_rel]). In that case, we can use the following
  typeclass to specify an alternative way to destruct corresponding
  hypotheses.

  An instance of [RDestruct] is somewhat similar to a stylized
  induction principle. [T] expands to a conjunction of subgoals in the
  format expected by [Delay.split_conjunction]. For instance, the
  induction principle for [sum_rel] is:
<<
    sum_rel_ind:
      forall ...,
        (forall a1 a2, RA a1 a2 -> P (inl a1) (inl a2)) ->
        (forall b1 b2, RB b1 b2 -> P (inr b1) (inr b2)) ->
        (forall p1 p2, (RA + RB) p1 p2 -> P p1 p2)
>>
  A corresponding instance of [RDestruct] would be:
<<
    sum_rdestruct:
      RDestruct
        (sum_rel RA RB)
        (fun P =>
          (forall a1 a2, RA a1 a2 -> P (inl a1) (inl a2)) /\
          (forall b1 b2, RB b1 b2 -> P (inr b1) (inr b2)))
>>
  In the case of [sum_rel] however, which is defined as an inductive
  type with similar structure to [sum], we can rely on the default
  instance of [RDestruct], which simply uses the [destruct] tactic. *)

Class RDestruct {A B: Type} (R: rel A B) (T: rel A B -> Prop) :=
  rdestruct m n: R m n -> forall P, T P -> P m n.(** ** Destructing relational hypotheses *)

(** To make progress when the goal relates two pattern matching
  constructions, we need to show that the two matched terms are
  related, then destruct that hypothesis in a such a way that the two
  terms reduce to constructors.

  For most relators of inductive types, the constructors of the
  relator will simply follow the constructors of the corresponding
  type, so that destructing the relational hypothesis in the usual way
  will produce the desired outcome. However, sometimes it is more
  convenient to define such relators in a different way (see for
  instance [prod_rel]). In that case, we can use the following
  typeclass to specify an alternative way to destruct corresponding
  hypotheses.

  An instance of [RDestruct] is somewhat similar to a stylized
  induction principle. [T] expands to a conjunction of subgoals in the
  format expected by [Delay.split_conjunction]. For instance, the
  induction principle for [sum_rel] is:
<<
    sum_rel_ind:
      forall ...,
        (forall a1 a2, RA a1 a2 -> P (inl a1) (inl a2)) ->
        (forall b1 b2, RB b1 b2 -> P (inr b1) (inr b2)) ->
        (forall p1 p2, (RA + RB) p1 p2 -> P p1 p2)
>>
  A corresponding instance of [RDestruct] would be:
<<
    sum_rdestruct:
      RDestruct
        (sum_rel RA RB)
        (fun P =>
          (forall a1 a2, RA a1 a2 -> P (inl a1) (inl a2)) /\
          (forall b1 b2, RB b1 b2 -> P (inr b1) (inr b2)))
>>
  In the case of [sum_rel] however, which is defined as an inductive
  type with similar structure to [sum], we can rely on the default
  instance of [RDestruct], which simply uses the [destruct] tactic. *)

Class RDestruct {A B: Type} (R: rel A B) (T: rel A B -> Prop) :=
  rdestruct m n: R m n -> forall P, T P -> P m n.(** See the [RDestruct] library for the corresponding instance of
  [RStep], the default instance of [RDestruct], and a way to control
  whether or not we should keep equations for the destructed terms. *)

(** ** Monotonicity properties *)

(** We use the class [Related] for the user to declare monotonicity
  properties. This is a generalization of [Morphisms.Proper] from the
  Coq standard library: although we expect that most of the time the
  left- and right-hand side terms will be identical, they could be
  slightly different partial applications of the same function.

  Usually the differing arguments will be implicit, so that the user
  can still rely on the [Monotonic] notation below. Occasionally, you
  may need to spell out the two different terms and use the actual
  class instead.

  Note that the argument order below eschews the precedent of [Proper],
  which has the relation first, followed by the proper element. This is
  deliberate: we want the type parameters [A] and [B] to be unified in
  priority against the type of [f] and [g], rather than that of [R].
  In particular, the relator [forall_rel] yields an eta-expanded type
  of the form [(fun x => T x) x] for its arguments. When [A] and [B]
  take this peculiar form, instances declared using [forall_rel]
  become unusable (I assume because no second-order unification is
  performed when looking up the typeclass instance database). By
  contrast the type of [f] and [g] is much more likely to be in a
  "reasonable" form. *)

Class Related {A B} (f: A) (g: B) (R: rel A B) :=
  related: R f g.(** See the [RDestruct] library for the corresponding instance of
  [RStep], the default instance of [RDestruct], and a way to control
  whether or not we should keep equations for the destructed terms. *)

(** ** Monotonicity properties *)

(** We use the class [Related] for the user to declare monotonicity
  properties. This is a generalization of [Morphisms.Proper] from the
  Coq standard library: although we expect that most of the time the
  left- and right-hand side terms will be identical, they could be
  slightly different partial applications of the same function.

  Usually the differing arguments will be implicit, so that the user
  can still rely on the [Monotonic] notation below. Occasionally, you
  may need to spell out the two different terms and use the actual
  class instead.

  Note that the argument order below eschews the precedent of [Proper],
  which has the relation first, followed by the proper element. This is
  deliberate: we want the type parameters [A] and [B] to be unified in
  priority against the type of [f] and [g], rather than that of [R].
  In particular, the relator [forall_rel] yields an eta-expanded type
  of the form [(fun x => T x) x] for its arguments. When [A] and [B]
  take this peculiar form, instances declared using [forall_rel]
  become unusable (I assume because no second-order unification is
  performed when looking up the typeclass instance database). By
  contrast the type of [f] and [g] is much more likely to be in a
  "reasonable" form. *)

Class Related {A B} (f: A) (g: B) (R: rel A B) :=
  related: R f g.Notation "'@' 'Monotonic' T m R" := (@Related T T m m R%rel)
  (at level 10, T at next level, R at next level, m at next level).Notation Monotonic m R := (Related m m R%rel).

Lemma unfold_monotonic_rstep {A B} (R: rel A B) m n: RStep (R m n) (Related m n R).