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
].
Hint Extern 1 (_ = lift _ _ (lift _ _ _)) => lift_lift_hint : lift_lift.
Hint Extern 1 (lift _ _ (lift _ _ _) = _) => lift_lift_hint : lift_lift.
Ltac subst_lift_hint :=
first [
rewrite subst_lift; reflexivity
| rewrite subst_lift
].
Hint Extern 1 (subst _ _ (lift _ _ _) = _) => subst_lift_hint : subst_lift.
Hint Extern 1 (_ = subst _ _ (lift _ _ _)) => subst_lift_hint : subst_lift.
Hint Extern 1 (subst _ _ _ = _) => subst_lift_hint : subst_lift.
Hint Extern 1 (_ = subst _ _ _) => subst_lift_hint : 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
].
Hint Extern 1 (_ = lift _ _ (subst _ _ _)) => lift_subst_hint : lift_subst.
Hint Extern 1 (lift _ _ (subst _ _ _) = _) => lift_subst_hint : lift_subst.
Hint Extern 1 (_ = lift _ _ (lift _ _ (subst _ _ _))) => do 2 lift_subst_hint : lift_subst.
Hint Extern 1 (lift _ _ (lift _ _ (subst _ _ _)) = _) => do 2 lift_subst_hint : lift_subst.
Hint Extern 1
(lift _ _ _ = subst (lift _ _ _) _ (lift _ _ _)) => lift_subst_hint : lift_subst.
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
].
Hint Extern 1 (_ = subst _ _ (subst _ _ _)) => subst_subst_hint : subst_subst.
Hint Extern 1 (subst _ _ (subst _ _ _) = _) => subst_subst_hint : subst_subst.
Ltac lift_lift_fuse_hint :=
rewrite lift_lift_fuse by omega.
Hint Extern 1 (lift _ _ (lift _ _ _) = _) => lift_lift_fuse_hint : lift_lift_fuse.
Hint Extern 1 (_ = lift _ _ (lift _ _ _)) => lift_lift_fuse_hint : lift_lift_fuse.
(* ------------------------------------------------------------------------------ *)
(* Miscellaneous lemmas, often combinations and/or special cases of the above lemmas. *)
(* Lifts are invariant under translation. *)

(* Specifications: *)
Lemma translate_lift:
forall w x y z,
lift w x y = z ->
forall k,
lift w (k + x) (k + y) = k + z.