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. *)
(* If [ws] is 1, then the two cases considered above, namely [k <= s] and [k >= s + ws], are exhaustive. Now, what happens when [k] is comprised between [s] and [s + ws]? The following law answers this question. This law also covers the extreme cases where [k = s] and [k = s + ws], which may seem surprising, since they are already covered by [lift_lift]. The law below states that, in this case, the two [lift] operations can be combined into a single one. Note that the exact value of [k] is irrelevant as long as it lies within this interval. *)
Class LiftLiftFuse `{Lift T} := {
lift_lift_fuse:
forall t k s wk ws,
s <= k <= s + ws ->
lift wk k (lift ws s t) = lift (wk + ws) s t
}.
(* [subst] identifies [var] and simplifies to [subst_idx]. *)
(* This law alone is probably not of great interest to the client, who needs a more general way of simplifying the application of [subst] to a constructor. We name this property because it is used by some of our lemmas. *)
Class SubstVar `{Var A, Subst A A} := {
subst_var:
forall a k x,
subst a k (var x) = subst_idx a k x
}.
(* A substitution for the variable [k] vanishes when it reaches an end-of-scope marker for the variable [k]. This is expressed by the following law. *)
Class SubstLift `{Lift T, Subst V T} := {
subst_lift:
forall v k t,
subst v k (shift k t) =
t
}.
(* [lift] and [subst] commute. *)
(* Roughly speaking, [end k in let s = v in t] is equivalent to [let s = (end k in v) in (end k in t)]. At least, that is the idea. The ``technical adjustments'' make it quite difficult to understand what is going on in detail. *)
(* Below, we propose two laws, which cover the cases [k <= s] and [s <= k]. It may seem somewhat troubling that these cases are not disjoint! When [k = s], the two right-hand sides differ in a certain manner that is described by the law [PunPun] shown further on. *)
(* We also offer a general law, which unifies these two laws, and arbitrarily gives preference to the second law in the case where [k = s]. It is not clear whether this complex general law is of any use in practice. *)
Class LiftSubst1 `{Lift V, Lift T, Subst V T} := {
lift_subst_1:
forall t k v s w,
k <= s ->
lift w k (subst v s t) =
subst (lift w k v) (w + s) (lift w k t)
}.
Class LiftSubst2 `{Lift V, Lift T, Subst V T} := {
lift_subst_2:
forall t k v s w,
s <= k ->
lift w k (subst v s t) =
subst (lift w k v) s (lift w (1 + k) t)
}.
Class LiftSubst `{Lift V, Lift T, Subst V T} := {
lift_subst:
forall t k v s w,
lift w k (subst v s t) =
subst (lift w k v) (lift w (1 + k) s) (lift w (shift s k) t)
}.
(* [subst] commutes with itself. *)
(* Roughly speaking, [let s = v in let k = w in t] is equivalent to [let k = (let s = v in w) in let s = v in t], again with ``technical adjustments''. *)
(* This law covers only the case where [k <= s]. I am not sure what can be said about the other case. Of course the law can be read from right to left, and this says something about the case where [k >= 1 + s], but only if the values [v] and [w] are of a specific form. Maybe there is nothing more to be said. *)
Class SubstSubst `{Lift V, Subst V V, Subst V T} := {
subst_subst:
forall t k v s w,
k <= s ->
subst v s (subst w k t) =
subst (subst v s w) k (subst (shift k v) (1 + s) t)
}.
(* Substituting [x] for [x] is the identity. This is known as a pun. *)
(* In a de Bruijn setting, it does not even make sense to speak of replacing a variable with itself, because in the term [subst v k t], the value [v] and the variable [k] inhabit different spaces. *)
(* Instead, we can write [let S k = k in end k in t]. This introduces [S k] as an alias for [k], then forgets about [k], so [S k] is renumbered and becomes [k] again. Or we can write [let k = k in end S k in t]. This introduces [k] as an alias for the old [k], which gets renumbered and becomes [S k], then forgets about [S k]. In each of these two cases, we introduce a new variable and forget about the old one; the apparent difference lies in how we number the new variable, but this makes no deep difference. We give the variants of the law for puns, plus a law that helps recognize these two variants as equal. *)
Class Pun1 `{Var V, Lift T, Subst V T} := {
pun_1:
forall t k,
subst (var k) (S k) (shift k t) = t
}.
Class Pun2 `{Var V, Lift T, Subst V T} := {
pun_2:
forall t k,
subst (var k) k (shift (S k) t) = t
}.
Class PunPun `{Var V, Lift T, Subst V T} := {
pun_pun:
forall v w k t,
subst v (w + k) (lift w k t) =
subst v k (lift w (1 + k) t)
}.
(* [rotate 1] exchanges the variables [0] and [1], so it is own inverse. *)
Class Rotate1SelfInverse `{Var V, Lift T, Subst V T} := {
rotate1_self_inverse:
forall t,
rotate 1 (rotate 1 t) = t
}.
(* ---------------------------------------------------------------------------- *)
(* ---------------------------------------------------------------------------- *)
(* A few consequences of the properties that the user proves about [traverse]. *)
(* We could present these properties in the form of classes, as opposed to lemmas. This would be perhaps slightly more convenient but also more confusing. It is seems preferable to work directly with the basic classes that the user knows about. *)
(* [traverse] is compatible with extensional equality. *)
(* A composition of [traverse] with [traverse_var] simplifies to a single call to [traverse]. In other words, composing a substitution and a (not necessarily bijective) renaming yields another substitution. *)
(* ---------------------------------------------------------------------------- *)
(* This internal tactic helps prove goals by examination of all cases. *)
Ltac just_do_it :=
unfold subst, Subst_idx, subst_idx, lift, Lift_idx, var, Var_idx;
intros; solve [ dblib_by_cases; eauto with f_equal omega ].
(* The following two lemmas re-state the definition of [lift] at type [nat]. *)
(* This tactic applies whichever of the above two lemmas is applicable. *)
Create HintDb lift_idx_hints.
(* more hints to be added later on into this database *)
Ltac lift_idx :=
first [ rewrite @lift_idx_recent by solve [ omega | eauto with lift_idx_hints ]
| rewrite @lift_idx_old by omega ].
Hint Extern 1 => lift_idx : lift_idx.
Ltac lift_idx_in h :=
first [ rewrite @lift_idx_recent in h by solve [ omega | eauto with lift_idx_hints ]
| rewrite @lift_idx_old in h by omega ].
Ltac lift_idx_all :=
first [ rewrite @lift_idx_recent in * by solve [ omega | eauto with lift_idx_hints ]
| rewrite @lift_idx_old in * by omega ].
(* This tactic finds an occurrence of [lift _ _ _] at type [nat] and examines both cases. *)
Ltac destruct_lift_idx :=
match goal with |- context[@lift nat _ _ ?y ?x] =>
destruct (le_gt_dec y x); lift_idx
end.
(* Our definition of [lift] at type [nat] satisfies the properties listed above. *)
Instance LiftVar_idx: @LiftVar nat _ _.
(* This tactic applies whichever of the above three lemmas is applicable. *)
Ltac subst_idx :=
first [
rewrite @subst_idx_identity by omega
| rewrite @subst_idx_miss_1 by omega
| rewrite @subst_idx_miss_2 by omega
].
Ltac subst_idx_in h :=
first [
rewrite @subst_idx_identity in h by omega
| rewrite @subst_idx_miss_1 in h by omega
| rewrite @subst_idx_miss_2 in h by omega
].
Ltac subst_idx_all :=
first [
rewrite @subst_idx_identity in * by omega
| rewrite @subst_idx_miss_1 in * by omega
| rewrite @subst_idx_miss_2 in * by omega
].
(* A little lemma: replacing a variable with a variable always yields a variable. *)
(* ---------------------------------------------------------------------------- *)
(* This is our generic definition of [lift] in terms of [traverse]. *)
Instance Lift_Traverse `{Var V, Traverse V T} : Lift T := {
lift w k t :=
traverse (fun l x => var (lift w (l + k) x)) 0 t
}.
(* This lemma repeats the definition (!) and is useful when rewriting. *)
(* This auxiliary tactic simplifies expressions of the form [x + 0] in the goal. It does *not* affect [x + ?y] where [y] is a meta-variable. *)
Ltac plus_0_r :=
repeat match goal with |- context[?x + 0] => rewrite (plus_0_r x) end.
Ltac plus_0_r_in h :=
repeat match type of h with context[?x + 0] => rewrite (plus_0_r x) in h end.
(* It is worth noting that instead of writing: traverse (fun l x => var (lift w (l + k) x)) 0 t one might have instead written: traverse (fun l x => var (lift w l x)) k t Indeed, because [traverse] is relative, these two expressions are equivalent. The following lemma states this fact. When used as a rewriting rule, it recognizes a general form of the above expressions and replaces it with an application of [lift]. *)

Lemma recognize_lift:
forall `{Var V, Traverse V T},
TraverseRelative ->
forall w k1 k2 t,
forall traverse_,
traverse_ = traverse -> (* helps rewrite *)
traverse_ (fun l x => var (lift w (l + k2) x)) k1 t =
lift w (k1 + k2) t.