(** ** The [transport] tactic *)

(** Often, we know that a number of terms are related, and need to
  transport hypotheses built out the the left-hand sides into ones
  with similar shapes, but built out of the right-hand sides. For
  instance, in cirumstances where [rauto] can establish
  [option_rel R x y], we will want to turn a hypothesis of the form
  [x = Some a] into one of the form [y = Some b], and remember that
  [R a b]. This is the role of the [transport] tactic. *)

(** *** Transportable hypotheses *)

(* To make the tactic extensible, we use the following typeclass to
  declare patterns of relations and hypothesis shapes that can be
  handled in this way. *)

Class Transport {A B} (R: rel A B) (a: A) (b: B) (PA: Prop) (PB: Prop) :=
  transport: R a b -> PA -> PB.Ltac transport H :=
  revert H;
  lazymatch goal with
    | |- ?PA -> ?Q =>
      apply (transport_in_goal (PA:=PA) Q)
  end;
  intro H;
  split_hyp H.(** One stereotypical example is [option_le]: the [Transport] instance
  defined in the [OptionRel] library allows us to transport hypothese
  of the form [x = Some a] into hypotheses of the form [y = Some b],
  with [a] and [b] related by [R] whenever [x] and [y] are related by
  [option_le R], and similarly for [None] and [option_rel].

  Other instances are declared below. *)

Global Instance prod_rel_transport_eq_pair {A1 B1 A2 B2} (R1: rel A1 B1) (R2: rel A2 B2) x y a1 a2:
  Transport (prod_rel R1 R2) x y (x = (a1, a2)) (exists b1 b2, y = (b1, b2) /\ R1 a1 b1 /\ R2 a2 b2).Ltac set_le_transport keyword :=
  lazymatch goal with
    | |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
      lazymatch PA with
        | context [keyword] =>
          let Xv := fresh "X" in evar (Xv: Type);
          let X := eval red in Xv in clear Xv;
          unify B (X -> Prop);
          eapply set_le_transport
      end
  end.Ltac rel_curry_set_le_transport keyword :=
  lazymatch goal with
    | |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
      lazymatch PA with
        | context [keyword] =>
          let Xv := fresh "X" in evar (Xv: Type);
          let X := eval red in Xv in clear Xv;
          let Yv := fresh "Y" in evar (Yv: Type);
          let Y := eval red in Yv in clear Yv;
          unify B (X -> Y -> Prop);
          eapply rel_curry_set_le_transport
      end
  end.Ltac rel_curry2_set_le_transport keyword :=
  lazymatch goal with
    | |- @Transport ?A ?B ?R ?a ?b ?PA ?PB =>
      lazymatch PA with
        | context [keyword] =>
          let Xv := fresh "X" in evar (Xv: Type);
          let X := eval red in Xv in clear Xv;
          let Yv := fresh "Y" in evar (Yv: Type);
          let Y := eval red in Yv in clear Yv;
          let Zv := fresh "Y" in evar (Yv: Type);
          let Z := eval red in Yv in clear Yv;
          unify B (X -> Y -> Z -> Prop);
          eapply rel_curry2_set_le_transport
      end
  end.

Lemma impl_transport P Q: Transport impl P Q P Q.