(** Pointwise reflexive *)

Ltac rewrite_relation_fun :=
  (* If we're looking for a default rewrite relation on a
    function type, we favor pointwise equality *)
  class_apply @rewrite_relation_pointwise ||
  (* The relation might be already determined to be (eq ==> _) instead of a
    pointwise equality, but we want to treat them the same. No point in
    backtracking on the previous instance though *)
  class_apply @rewrite_relation_eq_dom.Ltac eq_rewrite_relation A :=
  solve [unshelve class_apply @eq_rewrite_relation].#[global]
Hint Extern 2 (ProperProxy ?R _) => 
  not_evar R; class_apply @proper_proper_proxy : typeclass_instances.(* This tactics takes a type and (partially defined) relation and tries
   to find all instances matching it which completely determine the relation,
   feeding them to kont. *)
Ltac find_rewrite_relation A R kont :=
  assert (@RewriteRelation A R); [solve [unshelve typeclasses eauto]|]; kont R.(** This hint helps infer "generic" reflexive relations, based only on the type of the
    carrier, when the relation is only partially defined (contains evars). *)

Ltac reflexive_proxy_tac A R :=
  tryif has_evar R then
    (* If the user declared a specific rewrite relation on the type, we favor it.
      By default, [iff] and and [impl] are favored for Prop,
      pointwise equality for function types and finally leibniz equality. *)
    find_rewrite_relation A R ltac:(fun RA =>
      class_apply (@reflexive_reflexive_proxy A RA))
      (* The [Reflexive] subgoal produced here will need no backtracking,
          being a Prop goal without existential variables,
          but we don't have `cut` to explicitely say it. *)
  else
    (* If the relation is determined then we look for a relexivity proof on it *)
    class_apply @reflexive_reflexive_proxy.Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature))
    (right associativity, at level 55) : signature_scope.Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature))
    (right associativity, at level 55) : signature_scope.Notation " R --> R' " := (@respectful _ _ (flip (R%signature)) (R'%signature))
    (right associativity, at level 55) : signature_scope.(** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f]
    by repeated introductions and setoid rewrites. It should work
    fine when [f] is a combination of already known morphisms and
    quantifiers. *)

Ltac solve_respectful t :=
 match goal with
   | |- respectful _ _ _ _ =>
     let H := fresh "H" in
     intros ? ? H; solve_respectful ltac:(setoid_rewrite H; t)
   | _ => t; reflexivity
 end.Ltac solve_proper := unfold Proper; solve_respectful ltac:(idtac).(** [forall_def] reifies the dependent product as a definition. *)
  
  Definition forall_def : Type := forall x : A, P x.(** Dependent pointwise lifting of a relation on the range. *)
  
  Definition forall_relation 
             (sig : forall a, relation (P a)) : relation (forall x, P x) :=
    fun f g => forall a, sig a (f a) (g a).

Lemma subrelation_proper `(mor : Proper A R' m) `(unc : Unconvertible (relation A) R R') `(sub : subrelation A R' R) : Proper R m.