(** Now we need to choose which one of these lemmas to apply in a
  given situation, and compute the appropriate values for [p].
  We compute [p] by essentially counting the products in the type of
  the related terms [m]. Note that we need to make sure we "open up"
  types such as [subrel] to expose the products, accomplished here by
  using [eval cbv]. *)

(** FIXME: [count_unapplied_params] fails if [m] has a dependent type,
  due to [t'] being a term under binders rather than a closed term.
  This means [monotonicity] can't handle goal where the related terms
  have dependent types if the corresponding relational property is
  about a partial application. *)

Ltac count_unapplied_params m :=
  let rec count t :=
    lazymatch t with
      | forall x, ?t' => let n := count t' in constr:(S n)
      | _ => constr:(O)
    end in
  let t := type of m in
  let t := eval cbv in t in
  count t.Ltac query_params m1 m2 :=
  let rec head t := lazymatch t with ?t' _ => head t' | _ => t end in
  let h1 := head m1 in
  let p1 := count_unapplied_params m1 in
  let h2 := head m2 in
  let p2 := count_unapplied_params m2 in
  first
    [ not_evar h1; not_evar h2; eapply (query_params_both h1 h2 p1 p2)
    | not_evar h1; is_evar  h2; eapply (query_params_one h1 p1)
    | is_evar  h1; not_evar h2; eapply (query_params_one h2 p2) ].Hint Extern 1 (CommonPrefix ?m1 ?m2 ?f) =>
  common_prefix m1 m2 f; constructor : typeclass_instances.(** Now that we can figure out how many parameters to drop, we use
  that information to construct the pair of prefixes we use to locate
  the relational property. We try the following (in this order):
    - the whole applications [f x1 ... xn] and [g y1 ... yn];
    - prefixes constructed as above from user-declared [Params] instances;
    - the smallest prefix we can obtain by dropping arguments from
      both applications simulataneously.

  Again, we need to take into account that either application could
  contain an eixstential variable. When we encounter an existential
  variable while chopping off arguments, we short-circuit the process
  and simply generate a new evar to serve as the shortened version. *)

Ltac pass_evar_to k :=
  let Av := fresh "A" in evar (Av : Type);
  let A := eval red in Av in clear Av;
  let av := fresh "a" in evar (av : A);
  let a := eval red in av in clear av;
  k a.(** The class [RemoveParams] implements the concurrent removal of [n]
  parameters from applications [m1] and [m2]. *)

Class RemoveParams {A B C D} (n: nat) (m1: A) (m2: B) (f: C) (g: D).Ltac remove_params_from n m k :=
  lazymatch n with
    | O => k m
    | S ?n' =>
      lazymatch m with
        | ?m' _ => remove_params_from n' m' k
        | _ => is_evar m; pass_evar_to k
      end
  end.Ltac remove_params n m1 m2 f g :=
  remove_params_from n m1 ltac:(fun m1' => unify f m1';
    remove_params_from n m2 ltac:(fun m2' => unify g m2')).Hint Extern 1 (RemoveParams ?n ?m1 ?m2 ?f ?g) =>
  remove_params n m1 m2 f g; constructor : typeclass_instances.(** The class [RemoveAllParams] implements the concurrent removal of
  as many arguments as possible. *)

Class RemoveAllParams {A B C D} (m1: A) (m2: B) (f: C) (g: D).Ltac remove_all_params_from m k :=
  lazymatch m with
    | ?m' _ => remove_all_params_from m' k
    | _ => not_evar m; k m
  end.Ltac remove_all_params m1 m2 f g :=
  first
    [ is_evar m2;
      remove_all_params_from m1
        ltac:(fun m1' => unify f m1'; pass_evar_to ltac:(fun m2' => unify g m2'))
    | is_evar m1;
      remove_all_params_from m2
        ltac:(fun m2' => unify g m2'; pass_evar_to ltac:(fun m1' => unify f m1'))
    | lazymatch m1 with ?m1' _ =>
        lazymatch m2 with ?m2' _ =>
          remove_all_params m1' m2' f g
        end
      end
    | not_evar m1; unify f m1;
      not_evar m2; unify g m2 ].(** *** Selecting a relational property *)

(** With this machinery in place, we can implement the search for
  candidate relational properties to use in conjunction with a given
  goal [Q]. *)

Class CandidateProperty {A B} (R': rel A B) f g (Q: Prop) :=
  candidate_related: R' f g.(** *** Selecting a relational property *)

(** With this machinery in place, we can implement the search for
  candidate relational properties to use in conjunction with a given
  goal [Q]. *)

Class CandidateProperty {A B} (R': rel A B) f g (Q: Prop) :=
  candidate_related: R' f g.Instance as_is_candidate {A B} (R R': rel A B) m1 m2:
  Related m1 m2 R' ->
  CandidateProperty R' m1 m2 (R m1 m2) | 10.Instance remove_params_candidate {A B C D} R (m1: A) (m2: B) R' (f: C) (g: D) n:
  QueryParams m1 m2 n ->
  RemoveParams n m1 m2 f g ->
  Related f g R' ->
  CandidateProperty R' f g (R m1 m2) | 20.Instance remove_all_params_candidate {A B C D} R (m1:A) (m2:B) R' (f:C) (g:D):
  RemoveAllParams m1 m2 f g ->
  Related f g R' ->
  CandidateProperty R' f g (R m1 m2) | 30.

Lemma flip_context_candidate {A B} (R: rel A B) x y : R y x -> flip R x y.