Inductive term : Set :=
| Srt : sort -> term
| Ref : nat -> term
| Abs : term -> term -> term
| App : term -> term -> term
| Prod : term -> term -> term.
(* Variable bindings and free variables *)
Inductive subt_bind (T M : term) : term -> Prop :=
| Bsbt_abs : subt_bind T M (Abs T M)
| Bsbt_prod : subt_bind T M (Prod T M).
Inductive subt_nobind (m : term) : term -> Prop :=
| Nbsbt_abs : forall n : term, subt_nobind m (Abs m n)
| Nbsbt_app_l : forall v : term, subt_nobind m (App m v)
| Nbsbt_app_r : forall u : term, subt_nobind m (App u m)
| Nbsbt_prod : forall n : term, subt_nobind m (Prod m n).
Hint Resolve Bsbt_abs Bsbt_prod Nbsbt_abs Nbsbt_app_l Nbsbt_app_r
Nbsbt_prod: pts.
Inductive free_db : nat -> term -> Prop :=
| Db_srt : forall (n : nat) (s : sort), free_db n (Srt s)
| Db_ref : forall k n : nat, k > n -> free_db k (Ref n)
| Db_abs :
forall (k : nat) (A M : term),
free_db k A -> free_db (S k) M -> free_db k (Abs A M)
| Db_app :
forall (k : nat) (u v : term),
free_db k u -> free_db k v -> free_db k (App u v)
| Db_prod :
forall (k : nat) (A B : term),
free_db k A -> free_db (S k) B -> free_db k (Prod A B).
Hint Resolve Db_srt Db_ref Db_abs Db_app Db_prod: pts.
(* Relocation and substitution *)
Fixpoint lift_rec (n : nat) (t : term) {struct t} :
nat -> term :=
fun k =>
match t with
| Srt s => Srt s
| Ref i =>
Ref match le_gt_dec k i with
| left _ => n + i
| right _ => i
end
| Abs a m => Abs (lift_rec n a k) (lift_rec n m (S k))
| App u v => App (lift_rec n u k) (lift_rec n v k)
| Prod a b => Prod (lift_rec n a k) (lift_rec n b (S k))
end.
Definition lift (n : nat) (N : term) := lift_rec n N 0.
Fixpoint subst_rec (ts t : term) {struct t} : nat -> term :=
fun k =>
match t with
| Srt s => Srt s
| Ref i =>
match lt_eq_lt_dec k i with
| inleft (left _) => Ref (pred i)
| inleft (right _) => lift k ts
| inright _ => Ref i
end
| Abs a m => Abs (subst_rec ts a k) (subst_rec ts m (S k))
| App u v => App (subst_rec ts u k) (subst_rec ts v k)
| Prod a b => Prod (subst_rec ts a k) (subst_rec ts b (S k))
end.
Definition subst (N M : term) := subst_rec N M 0.
intros; exists (lift n t); trivial.
Qed.
intros; exists (subst u v); trivial.
Qed.
Proof fun M : term => lift_rec0 M 0.
Proof fun (M : term) (k : nat) => permute_lift_rec M 1 k 1 0 (le_O_n k).

Lemma commut_lift_subst_rec :
forall (M N : term) (n p k : nat),
k <= p ->
lift_rec n (subst_rec N M p) k = subst_rec N (lift_rec n M k) (n + p).