Set Implicit Arguments.
Generalizable All Variables.
(* ---------------------------------------------------------------------------- *)
(* Terminology. *)
(* A variable, represented as a de Bruijn index, is [k]-free if it is greater than or equal to [k]. It is [k]-bound otherwise. This terminology is useful when one traverses a term and [k] represents the number of binders that have been entered. *)
(* ---------------------------------------------------------------------------- *)
(* Operations provided by the client. *)
(* We expect the client to define a type [V] of values and a type [T] of terms. These types may coincide, but need not coincide. The client provides a number of operations on values and terms, described below, and the library provides lifting and substitution operations. Lifting maps values to values and terms to terms, while substitution allows substituting values for variables within terms. *)
(* Our use of the terminology ``value'' and ``term'' is arbitrary. It is inspired by the operational semantics of the call-by-value lambda-calculus. The point is that [V] -- the type of the things that are substituted for variables -- and [T] -- the type of the things within which substitution is performed -- need not coincide. *)
(* Since values are substituted for variables, and since we need an identity substitution, there follows that a variable must be a value, or, more precisely, there must exist a function that maps variables to values. *)
Class Var (V : Type) := {
var:
nat -> V
}.
(* Let us immediately define [var] at variables. This may help clarify things, and it is used in the statement of some laws below. *)
Instance Var_idx : Var nat := {
var x := x
}.
(* [traverse] can be thought of as a semantic substitution function. The idea is, [traverse f l t] traverses the term [t], incrementing the index [l] whenever a binder is entered, and, at every variable [x], it invokes [f l x]. This produces a value, which is grafted instead of [x]. *)
(* The definition of [traverse] is the main task that we require of the client. Via the manner in which [l] is incremented, this function determines the binding structure of terms. *)
Class Traverse (V T : Type) := {
traverse:
(nat -> nat -> V) -> (nat -> T -> T)
}.
(* [traverse_var] is a specialization of [traverse] to the case where [f] maps variables to variables. *)
Notation traverse_var f := (traverse (fun l x => var (f l x))).
(* We expect the client to establish the following properties of [traverse]. *)
(* If [f] is injective, then [traverse_var f] is injective. *)
(* This reflects the fact that [traverse] preserves the structure of the term. It acts only on variables. *)
Class TraverseVarInjective `{Var V, Traverse V T} := {
traverse_var_injective:
forall f,
(forall x1 x2 l, f l x1 = f l x2 -> x1 = x2) ->
forall t1 t2 l,
traverse_var f l t1 = traverse_var f l t2 ->
t1 = t2
}.
(* Two successive traversals can be fused. *)
(* This law is analogous to the law that describes the composition of two syntactic substitutions -- see [SubstSubst] below. *)
Class TraverseFunctorial `{Traverse V V, Traverse V T} := {
traverse_functorial:
forall f g t l,
traverse g l (traverse f l t) = traverse (fun l x => traverse g l (f l x)) l t
}.
(* [traverse] is position-independent. That is, adding [p] to the argument of [traverse] leads to adding [p] to the argument of every call to [f]. Furthermore, [traverse] is compatible with extensional equality. *)
Class TraverseRelative `{Traverse V T} := {
traverse_relative:
forall f g p t m l,
(forall l x, f (l + p) x = g l x) ->
m = l + p ->
traverse f m t =
traverse g l t
}.
(* [traverse] identifies [var] and simplifies to a call to [f]. *)
Class TraverseIdentifiesVar `{Var V, Traverse V V} := {
traverse_identifies_var:
forall f l x,
traverse f l (var x) = f l x
}.
(* The application of [traverse_var] to the identity is the identity. *)
Class TraverseVarIsIdentity `{Var V, Traverse V T} := {
traverse_var_is_identity:
forall f,
(forall l x, f l x = var x) ->
forall t l,
traverse f l t = t
}.
(* ---------------------------------------------------------------------------- *)
(* Operations provided by the library. *)
(* [lift w k t] is the term obtained by adding [w] to the [k]-free variables of the term [t]. *)
Class Lift (T : Type) := {
lift:
nat -> nat -> T -> T
}.
(* Let us immediately define [lift] at variables. This may help clarify things, and it is used in the statement of some laws below. *)
Instance Lift_idx : Lift nat := {
lift w k x :=
if le_gt_dec k x then w + x else x
}.
(* [shift k t] is an abbreviation for [lift 1 k t]. *)
(* From a programming language point of view, [shift] can be understood as an end-of-scope construct. That is, if we are working in a context where the variable [k] exists, then writing [shift k .] allows us to go back to a context where this variable does not exist any more. In this context, we can place a term [t] that makes sense in the absence of this variable. Thus, [shift k t] can be read intuitively as [end k in t], that is, end the scope of the variable [k] before interpreting the term [t]. *)
Notation shift :=
(lift 1).
(* [subst v k t] is the term obtained by substituting the value [v] for the variable [k] in the term [t]. *)
(* From a programming language point of view, [subst] can be understood as a [let] construct. That is, [subst v k t] is in a certain sense equivalent to [let k = v in t]. It is a binding construct for the variable [k], in the sense that if [subst v k t] is used in a context where [k] does not exist, then inside the sub-term [t], the variable [k] exists. *)
Class Subst (V T : Type) := {
subst:
V -> nat -> T -> T
}.
(* Let us immediately define [subst] at variables. This may help clarify things, and it is used in the statement of some laws below. This definition does not constitute an instance of the class [Subst] because we need a heterogeneous version of substitution, one that maps variables to values, as a basic building block. A homogeneous instance definition follows. *)
(* Note that [subst_idx] depends on [var]. *)
Definition subst_idx `{Var V} (v : V) (k x : nat) : V :=
match lt_eq_lt_dec x k with
| inleft (left _)  => var x
| inleft (right _) => v
| inright _        => var (x - 1)
end.
Instance Subst_idx : Subst nat nat := {
subst := subst_idx
}.
(* The predicate [closed k t] means that the term [t] is [k]-closed, that is, it has no [k]-free variables. In particular, if [k] is 0, then [t] is closed. *)
(* We defined [closed] in terms of [lift]: a term is closed if and only if it is invariant under shifting (lifting by one). We show that this implies that it is also invariant under arbitrary lifting and under substitution. It is important to use a quantifier-free definition of closedness, as this makes it much easier to write tactics that construct and destruct closedness assertions. *)
Definition closed `{Lift T} k t :=
shift k t = t.
(* [rotate n] maps the variable [0] to the variable [n], maps [n] to [n-1], ..., [1] to [0]. It preserves every variable above [n]. In particular, [rotate 1] exchanges the variables [0] and [1]. *)
Definition rotate `{Var V, Lift T, Subst V T} (n : nat) (t : T) : T :=
subst (var n) 0 (shift (S n) t).
(* ---------------------------------------------------------------------------- *)
(* Properties of these operations. *)
(* [lift] commutes with [var]. *)
(* This law alone is probably not of great interest to the client, who needs a more general way of simplifying the application of [lift] to a constructor. We name this property because it is used by some of our lemmas. *)
Class LiftVar `{Var A, Lift A} := {
lift_var:
forall w k x,
lift w k (var x) = var (lift w k x)
}.
(* [lift 0] is the identity. *)
Class LiftZero `{Lift T} := {
lift_zero:
forall k t,
lift 0 k t = t
}.
(* [lift] is injective. *)
Class LiftInjective `{Lift T} := {
lift_injective:
forall w k t1 t2,
lift w k t1 = lift w k t2 ->
t1 = t2
}.
Ltac lift_injective :=
match goal with h: lift ?w ?k ?t1 = lift ?w ?k ?t2 |- _ =>
generalize (lift_injective _ _ _ _ h); clear h; intro h; try (subst t1)
end.
(* [lift] commutes with itself. *)
(* In the special case where [wk] and [ws] are 1, the law becomes: [k <= s -> shift k (shift s t) = shift (1 + s) (shift k t)]. Since [k] is the smaller index, it is always called [k], regardless of whether [s] is or is not in scope. Conversely, since [s] is the larger index, it is called [s] when [k] is not in scope, but it is called [1 + s] when [k] is in scope. The law expresses the fact that ending the scope of [k] first, then the scope of [s], is the same as ending the scope of [1 + s], then the scope of [k]. It is a commutation law with a slight technical adjustment. *)
(* Roughly speaking, [end k in end s in t] is equivalent to [end s in end k in t]. *)
Class LiftLift `{Lift T} := {
lift_lift:
forall t k s wk ws,
k <= s ->
lift wk k (lift ws s t) = lift ws (wk + s) (lift wk k t)
}.
(* One might wonder whether it is sufficient for this law to consider the case where [k <= s] holds. What happens in the other cases? Well, one can check that if [k >= s + ws] holds, then the law applies in the other direction. The following lemma proves this. *)

Lemma lift_lift_reversed:
forall `{Lift T},
LiftLift ->
forall wk k ws s t,
k >= s + ws ->
lift wk k (lift ws s t) = lift ws s (lift wk (k - ws) t).