Require Export Coq.Program.Basics.
Require Export Coq.Relations.Relation_Definitions.
Require Export Coq.Classes.Morphisms.
Require Setoid.
Require Export Delay.
(** * 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 (NotEvar ?x) =>
not_evar x; constructor : 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.
Hint Extern 1 (Convertible ?x ?y) =>
eapply eq_refl : typeclass_instances.
(** 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.
Delimit Scope rel_scope with rel.
Bind Scope rel_scope with rel.
(** Make sure that the existing definitions based on [Relation_Definitions.relation] use our [rel_scope] as well. *)
Bind Scope rel_scope with Relation_Definitions.relation.
(** ** 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 [Reflexivity] - 20 [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. *)
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. This encourages proper hygiene when declaring instances, since extraneous or too broadly applicable instance will cause failures (rather than silently add weight to the system). This also enables the user to investigate failures by stepping through the process using the [rstep] tactic. *)
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.
Hint Extern 1 (RAutoSubgoals _) =>
rauto_split : typeclass_instances.
(** If [rauto] is run under the [delayed] tactical and we don't know how to make progress, bail out. *)
Hint Extern 1000 (RAuto _) =>
red; solve [ delay ] : typeclass_instances.
(** ** Reflexivity *)
(** This is an early check to solve easy goals where a reflexive relation is applied to two identical arguments, however we are careful not to cause any instantiation of existential variables. The [Monotonicity] strategy provides a more general way to use reflexivity. *)
Ltac no_evars t :=
lazymatch t with
| ?f ?x => no_evars f; no_evars x
| ?m => not_evar m
end.

Lemma reflexivity_rstep {A} (R: rel A A) (x: A) :
Reflexive R ->
RStep True (R x x).