Ltac context_candidate :=
  let rec is_prefix f m :=
    first
      [ unify f m
      | lazymatch m with ?n _ => is_prefix f n end ] in
  let rec is_prefixable f m :=
    first
      [ is_evar f
      | is_evar m
      | unify f m
      | lazymatch m with ?n _ => is_prefixable f n end ] in
  multimatch goal with
    | H: _ ?f ?g |- @CandidateProperty ?A ?B ?R ?x ?y (_ ?m ?n) =>
      red;
      once first
        [ is_prefix f m; is_prefixable g n
        | is_prefix g n; is_prefixable f m
        | is_prefix g m; is_prefixable f n; apply flip_context_candidate
        | is_prefix f n; is_prefixable g m; apply flip_context_candidate ];
      eexact H
  end.(** *** Using [subrel] *)

(** It is not obvious at what point in the process [subrel] should be
  hooked in. One thing we crucially want to avoid is an open-ended
  [subrel] search enumerating all possibilities to be filtered later,
  with a high potential for exponential blow-up should the user be a
  little too liberal with the [subrel] instances they declare.

  Here I choose to have it kick in after a candidate property has been
  selected, and we know how to apply it to a goal. Then we use
  [subrel] to bridge any gap between that goal and the actual one,
  through the [RImpl] class below.

  This is a conservative solution which precludes many interesting
  usages of [subrel]. For instance, suppose we have a relational
  property alogn the lines of [Monotonic f ((R1 ++> R1) ∩ (R2 ++> R2))].
  We would want to be able to use it to show that [f] preserve [R1] or
  [R2] individually (because [subrel (R1 ++> R1) ((R1 ++> R1) ∩ (R2
  ++> R2))], but also together (because [subrel (R1 ∩ R2 ++> R1 ∩ R2)
  ((R1 ++> R1) ∩ (R2 ++> R2))]). This cannot be done using this
  approach, which does not act on the relational property itself but
  only the goal we're attempting to prove.

  Perhaps in the future we can extend this by acting at the level of
  [RElim]. In any case, we should provide explicit guidelines for when
  to declare [subrel] instances, and how. *)

Class RImpl (P Q: Prop): Prop :=
  rimpl: P -> Q.(** *** Using [subrel] *)

(** It is not obvious at what point in the process [subrel] should be
  hooked in. One thing we crucially want to avoid is an open-ended
  [subrel] search enumerating all possibilities to be filtered later,
  with a high potential for exponential blow-up should the user be a
  little too liberal with the [subrel] instances they declare.

  Here I choose to have it kick in after a candidate property has been
  selected, and we know how to apply it to a goal. Then we use
  [subrel] to bridge any gap between that goal and the actual one,
  through the [RImpl] class below.

  This is a conservative solution which precludes many interesting
  usages of [subrel]. For instance, suppose we have a relational
  property alogn the lines of [Monotonic f ((R1 ++> R1) ∩ (R2 ++> R2))].
  We would want to be able to use it to show that [f] preserve [R1] or
  [R2] individually (because [subrel (R1 ++> R1) ((R1 ++> R1) ∩ (R2
  ++> R2))], but also together (because [subrel (R1 ∩ R2 ++> R1 ∩ R2)
  ((R1 ++> R1) ∩ (R2 ++> R2))]). This cannot be done using this
  approach, which does not act on the relational property itself but
  only the goal we're attempting to prove.

  Perhaps in the future we can extend this by acting at the level of
  [RElim]. In any case, we should provide explicit guidelines for when
  to declare [subrel] instances, and how. *)

Class RImpl (P Q: Prop): Prop :=
  rimpl: P -> Q.(** While we give priority to [rimpl_refl] below, when it doesn't work
  we use [RAuto] to establish a [subrel] property. The [Monotonic]
  instances we declared alongside relators can be used conjunction
  with [Monotonicity] to break up [subrel] goals along the structure
  of the relations being considered. This may end up causing loops
  (especially in failure cases), so it may be necessary to add some
  flag in the context to prevent [rimpl_subrel] from being used when
  discharging the [subrel] goals themselves. *)

Global Instance rimpl_refl {A B} (R : rel A B) m n:
  RImpl (R m n) (R m n).Global Instance rimpl_subrel {A B} (R R': rel A B) m n:
  NonDelayed (RAuto (subrel R R')) ->
  RImpl (R m n) (R' m n).Global Instance rimpl_flip_subrel {A B} R R' (x: A) (y: B):
  NonDelayed (RAuto (subrel R (flip R'))) ->
  RImpl (R x y) (R' y x) | 2.(** *** Main tactic *)

(** With these components, defining the [monotonicity] tactic is
  straightforward: identify a candidate property, then figure out a
  way to apply it to the goal [Q] using the [RElim] class. We first
  define a [Monotonicity] typeclass that captures this behavior with
  full backtracking ability. *)

Class Monotonicity (P Q: Prop): Prop :=
  monotonicity: P -> Q.(** The Ltac tactic simply applies [monotonicity]; typeclass
  resolution will do the rest. Note that using [apply] naively is too
  lenient because in a goal of type [A -> B], it will end up unifying
  [A] with [P] and [B] with [Q] instead of setting [Q := A -> B] and
  generating a new subgoal for [P] as expected. On the other hand,
  using [refine] directly is too restrictive because it will not unify
  the type of [monotonicity] against the goal if existential variables
  are present in one or the other. Hence we constrain apply just
  enough, so as to handle both of these cases. *)

Ltac monotonicity :=
  lazymatch goal with |- ?Q => apply (monotonicity (Q:=Q)) end;
  Delay.split_conjunction.Global Instance apply_candidate {A B} (R: rel A B) m n P Q Q':
  CandidateProperty R m n Q ->
  RElim R m n P Q' ->
  RImpl Q' Q ->
  Monotonicity P Q.(** Another way to use [Monotonicity] is to hook it as an [RStep]
  instance. *)

Global Instance monotonicity_rstep {A B} (P: Prop) (R: rel A B) m n:
  Monotonicity P (R m n) ->
  RStep P (R m n) | 50.(** *** [subrel] constraint as a subgoal *)

(** When [monotonicity] fails it can be hard to figure out what is
  going wrong, especially if the problem occurs in the [subrel] goal
  of [rimpl_subrel]. The following tactic emits this constraint as a
  subgoal instead of solving it with [RAuto], so that the user can
  figure out what's broken and/or prove it manually in contexts where
  an automatic resolution is tricky.  *)

Class SubrelMonotonicity (P Q: Prop): Prop :=
  subrel_monotonicity: P -> Q.Ltac subrel_monotonicity :=
  lazymatch goal with |- ?Q => apply (subrel_monotonicity (Q:=Q)) end;
  Delay.split_conjunction.Global Instance apply_candidate_subrel {A B C D} (R: rel A B) m n P Rc Rg x y:
  CandidateProperty R m n (Rg x y) ->
  RElim R m n P (Rc x y) ->
  SubrelMonotonicity (@subrel C D Rc Rg /\ P) (Rg x y).(** ** Generic instances *)

(** When all else fail, we would like to fall back on a behavior
  similar to that of [f_equal]. To that end, we add a default
  [CandidateProperty] that identifies the longest common prefix of the
  applications in the goal and asserts that they are equal. *)

Class CommonPrefix {A B C} (m1: A) (m2: B) (f: C).Ltac common_prefix m1 m2 f :=
  first
    [ not_evar m1; not_evar m2;
      unify m1 m2; unify f m1
    | lazymatch m1 with ?m1' _ =>
        lazymatch m2 with ?m2' _ =>
          common_prefix m1' m2' f
        end
      end
    | unify m1 m2; unify f m1 ].Global Instance eq_candidate {A B C} R (m1: A) (m2: B) (f: C):
  CommonPrefix m1 m2 f ->
  CandidateProperty eq f f (R m1 m2) | 100.

(* Specifications: *)
Lemma f_equal_relim {A B} f g m n P Q: RElim eq (f m) (g n) P Q -> RElim (@eq (A -> B)) f g (m = n /\ P) Q.