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

(* Specifications: *)
Lemma traverse_extensional: forall `{Traverse V T}, TraverseRelative -> forall f g, (forall l x, f l x = g l x) -> forall t l, traverse f l t = traverse g l t.
Lemma traverse_traverse_var: forall `{Var V, Traverse V V, Traverse V T}, @TraverseFunctorial V _ T _ -> @TraverseRelative V T _ -> (* TraverseExtensional *) @TraverseIdentifiesVar V _ _ -> forall f g t l, traverse g l (traverse_var f l t) = traverse (fun l x => g l (f l x)) l t.