Instance Rotate1SelfInverse_Algebraic:
  forall `{Var V, Lift V, Lift T, Subst V V, Subst V T},
  @LiftVar V _ _ ->
  @SubstVar V _ _ ->
  @LiftLift T _ ->
  @LiftSubst2 V _ T _ _ ->
  @SubstSubst V _ _ T _ ->
  @Pun2 V _ T _ _ ->
  @Rotate1SelfInverse V _ T _ _.(* The above algebraic proof was admittedly quite tricky and obscure. Perhaps
   one could come up with a simpler approach. If we are willing to give up a
   tiny bit of generality and assume that [lift] and [subst] arise out of
   [traverse], then we can give a simple proof, as usual, by going down to the
   leaves and using [just_do_it] there. I have done this proof, so here it is,
   for the record. *)

Instance Rotate1SelfInverse_Traverse:
  forall `{Var V, Traverse V V, Traverse V T},
  @TraverseVarIsIdentity V _ T _ ->
  @TraverseIdentifiesVar V _ _ ->
  @TraverseFunctorial V _ T _ ->
  @Rotate1SelfInverse V _ T _ _.(* ------------------------------------------------------------------------------ *)

(* These tactics are supposed to help the user prove properties of her
   custom [traverse] functions. They should work out of the box. *)

Ltac prove_traverse_identifies_var :=
  reflexivity.Ltac prove_traverse_var_injective :=
  let t2 := fresh "t2" in
  intros ? ? t1; induction t1; intro t2; destruct t2; simpl;
  intros ? h; inversion h;
  f_equal;
  eauto using @traverse_var_injective with typeclass_instances.(* The lemma [traverse_var_injective] can be useful if the [traverse]
     function at hand calls another [traverse] function which has already
     been proved injective. *)

Ltac prove_traverse_functorial :=
  intros ? ? t; induction t; intros;
  (* We do not use [simpl] because it is too brutal. We just want to unfold
     the definition of [traverse], exposing a call to the user's [_traverse],
     and then perform one step of reduction, exploiting the user's definition
     of [_traverse] as a Fixpoint. *)
  simpl (@traverse _ _ _) at 1 2 3; (* not 4! *)
  match goal with |- ?_traverse _ _ (?_traverse _ _ _) = ?_traverse _ _ _ =>
    unfold _traverse; fold _traverse
  end;
  f_equal; eauto using @traverse_functorial with typeclass_instances.Ltac prove_traverse_relative :=
  intros ? ? ? t; induction t; intros; subst;
  (* We do not use [simpl] because it is too brutal. We just want to unfold
     the definition of [traverse], exposing a call to the user's [_traverse],
     and then perform one step of reduction, exploiting the user's definition
     of [_traverse] as a Fixpoint. Once we have done that, we do not want to
     simplify further -- in particular, if the right-hand side of the user's
     Fixpoint contains occurrences of [traverse], we do not want to unfold
     them. *)
  simpl (@traverse _ _ _);
  match goal with |- ?_traverse _ _ _ = ?_traverse _ _ _ =>
    unfold _traverse; fold _traverse
  end;
  eauto using @traverse_relative with f_equal omega typeclass_instances.Ltac prove_traverse_var_is_identity :=
  intros ? ? t; induction t; intros;
  (* We do not use [simpl] because it is too brutal. We just want to unfold
     the definition of [traverse], exposing a call to the user's [_traverse],
     and then perform one step of reduction, exploiting the user's definition
     of [_traverse] as a Fixpoint. *)
  simpl (@traverse _ _ _);
  match goal with |- ?_traverse _ _ _ = _ =>
    unfold _traverse; fold _traverse
  end;
  f_equal; eauto using @traverse_var_is_identity with typeclass_instances.(* ------------------------------------------------------------------------------ *)

(* The following hint databases help [eauto] solve equality goals that involve
   the above laws. They can be very useful provided one takes care to organize
   one's proof in such a way that these equality goals appear. This is usually
   done by letting explicit equality hypotheses appear in the statement that
   one is trying to establish by induction. *)

(* Using [reflexivity] just after a [rewrite] is often successful, and should
   prevent [eauto] from erring too far away. However, sometimes, this is too
   restrictive: for instance, multiple successive rewrites may be required.
   Thus, we also use hints that involve just a [rewrite]; this allows [eauto]
   to continue searching. *)

Ltac lift_lift_hint :=
  first [
    rewrite lift_lift by omega; reflexivity
  | rewrite <- lift_lift by omega; reflexivity
  | rewrite lift_lift by omega
  | rewrite <- lift_lift by omega
  ].Ltac subst_lift_hint :=
  first [
    rewrite subst_lift; reflexivity
  | rewrite subst_lift
  ].Ltac lift_subst_hint :=
  first [
    rewrite lift_subst_1 by omega; reflexivity
  | rewrite lift_subst_2 by omega; reflexivity
  | rewrite <- lift_subst_1 by omega; reflexivity
  | rewrite <- lift_subst_2 by omega; reflexivity
  | rewrite lift_subst_1 by omega
  | rewrite lift_subst_2 by omega
  | rewrite <- lift_subst_1 by omega
  | rewrite <- lift_subst_2 by omega
  ].Ltac subst_subst_hint :=
  first [
    rewrite subst_subst by omega; reflexivity
  | rewrite <- subst_subst by omega; reflexivity
  | rewrite subst_subst by omega
  | rewrite <- subst_subst by omega
  ].Ltac lift_lift_fuse_hint :=
  rewrite lift_lift_fuse by omega.

(* Specifications: *)
Lemma translate_lift: forall w x y z, lift w x y = z -> forall k, lift w (k + x) (k + y) = k + z.
Lemma lift_one_lift_zero: forall `{LiftLiftFuse T} t, shift 1 (shift 0 t) = shift 0 (shift 0 t).
Lemma lift_lift_fuse_successor: forall `{LiftLiftFuse T} t s wk, lift wk s (shift s t) = lift (S wk) s t.