(* This tactic recognizes an application of the user's [traverse_term] function that is really a [subst] operation, and folds it. *)
Ltac recognize_subst :=
rewrite recognize_subst by eauto with typeclass_instances;
try rewrite lift_zero; (* useful when [k1] is zero *)
repeat rewrite plus_0_l. (* useful when [k1] is zero *)
Ltac recognize_subst_in h :=
rewrite recognize_subst in h by eauto with typeclass_instances;
try rewrite lift_zero in h; (* useful when [k1] is zero *)
repeat rewrite plus_0_l in h. (* useful when [k1] is zero *)
(* This tactic is used to simplify an application of [subst] to a concrete term, such as [TApp t1 t2], where [TApp] is a user-defined constructor of the user-defined type of [term]s. We assume that the user has manually rewritten one occurrence of [subst] using the lemma [expand_subst], so as to indicate where simplification is desired. Thus, one instance of [traverse] must be visible in a hypothesis or in the goal. We start there and do the rest of the work. *)
Ltac simpl_subst :=
match goal with
(* Case: [_traverse] appears in the goal. *)
(* this binds the meta-variable [_traverse] to the user's [traverse_term] *)
|- context[?_traverse (fun l x : nat => subst_idx (lift l 0 ?v) (l + ?k) x) _ _] =>
(* this causes the reduction of the fixpoint: *)
unfold _traverse; fold _traverse;
(* we now have a term of the form [TApp (traverse_term ...) (traverse_term ...)]. There remains to recognize the definition of [subst]. *)
plus_0_r; (* useful when we have traversed a binder: 1 + 0 is 1 *)
(* use [recognize_subst] at the specific type of the [_traverse] function that we have just simplified *)
match type of _traverse with (nat -> nat -> ?V) -> nat -> ?T -> ?T =>
repeat rewrite (@recognize_subst V _ _ T _ _ _ _ _) by eauto with typeclass_instances
end;
repeat rewrite plus_0_l; (* useful when [k1] is zero and we are at a leaf *)
repeat rewrite lift_zero (* useful when [k1] is zero and we are at a leaf *)
(* Case: [_traverse] appears in a hypothesis. *)
(* this binds the meta-variable [_traverse] to the user's [traverse_term] *)
| h: context[?_traverse (fun l x : nat => subst_idx (lift l 0 ?v) (l + ?k) x) _ _] |- _ =>
(* this causes the reduction of the fixpoint: *)
unfold _traverse in h; fold _traverse in h;
(* we now have a term of the form [TApp (traverse_term ...) (traverse_term ...)]. There remains to recognize the definition of [subst]. *)
plus_0_r_in h; (* useful when we have traversed a binder: 1 + 0 is 1 *)
(* use [recognize_subst] at the specific type of the [_traverse] function that we have just simplified *)
match type of _traverse with (nat -> nat -> ?V) -> nat -> ?T -> ?T =>
repeat rewrite (@recognize_subst V _ _ T _ _ _ _ _) in h by eauto with typeclass_instances
end;
repeat rewrite plus_0_l in h; (* useful when [k1] is zero and we are at a leaf *)
repeat rewrite lift_zero in h (* useful when [k1] is zero and we are at a leaf *)
end.
(* This tactic attempts to simplify all occurrences of [subst] in the goal. *)
Ltac simpl_subst_goal :=
(* this replaces [subst] with applications of [traverse] *)
repeat rewrite @expand_subst;
(* this replaces the generic [traverse] with the user's [_traverse] functions *)
simpl (@traverse _ _ _);
(* this simplifies applications of each [_traverse] function and folds them back *)
repeat simpl_subst;
(* if we have exposed applications of [subst_idx], try simplifying them away *)
repeat subst_idx;
(* if this exposes uses of [var], replace them with the user's [TVar] constructor *)
simpl var.
Hint Extern 1 (subst _ _ _ = _) => simpl_subst_goal : simpl_subst_goal.
Hint Extern 1 (_ = subst _ _ _) => simpl_subst_goal : simpl_subst_goal.
(* This tactic attempts to simplify all occurrences of [subst] in the goal and the hypotheses. *)
Ltac simpl_subst_all :=
repeat rewrite @expand_subst in *;
simpl (@traverse _ _ _) in *;
repeat simpl_subst;
repeat subst_idx_all;
simpl var in *.
(* This tactic attempts to simplify all occurrences of [subst] in a specific hypothesis. *)
Ltac simpl_subst_in h :=
repeat rewrite @expand_subst in h;
simpl (@traverse _ _ _) in h;
repeat simpl_subst;
repeat subst_idx_in h;
simpl var in h.
(* ---------------------------------------------------------------------------- *)
(* Our definition of [subst] in terms of [traverse] satisfies all of the desired properties. *)
Instance SubstVar_Traverse:
forall `{Var V, Traverse V V},
TraverseIdentifiesVar ->
TraverseVarIsIdentity ->
SubstVar.
Instance SubstLift_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseFunctorial V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@TraverseVarIsIdentity V _ T _ ->
@SubstLift T _ V _.
Instance LiftSubst1_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseRelative V V _ ->
@TraverseRelative V T _ -> (* TraverseExtensional *)
@TraverseFunctorial V _ V _ ->
@TraverseFunctorial V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@LiftSubst1 V _ T _ _.
Instance LiftSubst2_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseRelative V V _ ->
@TraverseRelative V T _ -> (* TraverseExtensional *)
@TraverseFunctorial V _ V _ ->
@TraverseFunctorial V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@LiftSubst2 V _ T _ _.
(* [LiftSubst1] and [LiftSubst2] imply [LiftSubst]. No surprise, since the latter law is just a combination of the former two. *)
Instance LiftSubst_LiftSubst12 `{Lift V, Lift T, Subst V T} :
LiftSubst1 ->
LiftSubst2 ->
LiftSubst.
Instance SubstSubst_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseRelative V V _ ->
@TraverseRelative V T _ -> (* TraverseExtensional *)
@TraverseIdentifiesVar V _ _ ->
@TraverseVarIsIdentity V _ V _ ->
@TraverseFunctorial V _ V _ ->
@TraverseFunctorial V _ T _ ->
@SubstSubst V _ _ T _.
Instance Pun1_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseFunctorial V _ T _ ->
@TraverseVarIsIdentity V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@Pun1 V _ T _ _.
Instance Pun2_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseFunctorial V _ T _ ->
@TraverseVarIsIdentity V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@Pun2 V _ T _ _.
Instance PunPun_Traverse:
forall `{Var V, Traverse V V, Traverse V T},
@TraverseRelative V T _ -> (* TraverseExtensional *)
@TraverseFunctorial V _ T _ ->
@TraverseIdentifiesVar V _ _ ->
@PunPun V _ T _ _.
(* ------------------------------------------------------------------------------ *)
(* Properties of the predicate [closed]. *)
(* This technical lemma helps prove [closed_monotonic] below. *)

Lemma closed_increment:
forall `{Lift T},
LiftLift ->
forall k t,
closed k t ->
closed (1 + k) t.