(* ---------------------------------------------------------------------------- *)

(* 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
}.(* ---------------------------------------------------------------------------- *)

(* 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] 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
}.(* 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
}.(* 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] 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
}.(* [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
}.(* 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
}.(* ---------------------------------------------------------------------------- *)

(* 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
}.(* [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
}.(* 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
  ].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)
}.(* ---------------------------------------------------------------------------- *)

(* 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 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)
}.(* [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)
}.

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).