Hint Extern 1 (CandidateProperty _ _ _ _) =>
context_candidate : typeclass_instances.
(** *** 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.
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.
(** 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.
(** 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.
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).
Ltac subrel_monotonicity :=
lazymatch goal with |- ?Q => apply (subrel_monotonicity (Q:=Q)) end;
Delay.split_conjunction.
(** ** 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 ].
Hint Extern 1 (CommonPrefix ?m1 ?m2 ?f) =>
common_prefix m1 m2 f; constructor : typeclass_instances.
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.
(** Then, we can use the following [RElim] instance to obtain the behavior of the [f_equal] tactic.  In practice, I find that [f_equal_relim] is too broadly applicable. In situations where a relational property is missing or inapplicable for some reason, we would like [repeat rstep] to leave us in a situation where we can examine what is going wrong, or do a manual proof when necessary. If we use [f_equal]-like behavior as a default, we will instead be left several step further, where it is no longer obvious which function is involved, and where the goal may not be provable anymore.  With that said, if you would like to switch [f_equal] on, you can register [f_equal_elim] as an instance with the following hint: << Hint Extern 1 (RElim (@eq (_ -> _)) _ _ _ _) => eapply f_equal_relim : typeclass_instances. >> *)

(* 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.