(* This code was automatically generated by Autosubst 2.0 Beta.

The following inductive types were generated:
ty : Type
tm : Type
vl : Type

The following variable constructors were generated:
var_ty : Type
var_vl : Type

Autosubst 2 uses vectors of substitutions. The types of the generated substiutions are listed below:
subst_of subst_of_ty := index -> ty
subst_of subst_of_tm := (index -> ty, index -> vl)
subst_of subst_of_vl := (index -> ty, index -> vl)

Autosubst 2 furthermore generated the following instantiation operations:
subst_ty : subst_of subst_of_ty -> ty -> ty,
also accessible as s.[sigma]
subst_tm : subst_of subst_of_tm -> tm -> tm,
also accessible as s.[sigma]
subst_vl : subst_of subst_of_vl -> vl -> vl,
also accessible as s.[sigma]

See the generated dot-graph for further details.

Automation has been extended to include the generated definitions. The tactic asimpl simplifies goals containing substiution expressions, autosubst corresponds to now asimpl.

If Autosubst 2 does not behave as expected, we are grateful for a short mail to autosubst@ps.uni-saarland.de.
Thank you!
*)

Require Export Autosubst2.
Set Implicit Arguments.
Require Import Lists.List.
Import ListNotations.
Set Typeclasses Filtered Unification.

Inductive ty  : Type :=
  | var_ty : index -> ty
  | arr : ty -> ty -> ty
  | all : ty -> ty.

Definition congr_arr {s0 s1 t0 t1: ty} (E0: s0 = t0) (E1: s1 = t1) : arr s0 s1 = arr t0 t1 :=
  apc (ap arr E0) (E1).

Definition congr_all {s0 t0: ty} (E0: s0 = t0) : all s0 = all t0 :=
  ap all E0.

Definition subst_of_ty  : list Type :=
  [ty: Type].

Definition toVarRen_ty (xi: ren_of subst_of_ty) : _ :=
  let xi := xi in xi.

Definition upren_ty_ty (xi: ren_of subst_of_ty) : ren_of subst_of_ty :=
  let xi_ty := xi in up_ren xi_ty.

Fixpoint ren_ty (xi: ren_of subst_of_ty) (s: ty) : ty :=
  match s with
  | var_ty x => var_ty ((toVarRen_ty xi) x)
  | arr s0 s1 => arr ((ren_ty xi s0)) ((ren_ty xi s1))
  | all s0 => all ((ren_ty (upren_ty_ty xi) s0))
  end.

Definition toVar_ty (sigma: subst_of subst_of_ty) : _ :=
  let sigma := sigma in sigma.

Definition eq_toVar_ty {sigma tau: subst_of subst_of_ty} (E: eq_of_subst sigma tau) (n: index) : toVar_ty sigma n = toVar_ty tau n.
  rename sigma into sigma_ty. rename tau into tau_ty. rename E into E_ty.
  exact (E_ty n).
Defined.

Definition compren_ty (sigma: subst_of subst_of_ty) (xi: ren_of subst_of_ty) : subst_of subst_of_ty :=
  match sigma with
  | sigma_ty => fun x => ren_ty xi (sigma_ty x)
  end.

Definition up_ty_ty (sigma: subst_of subst_of_ty) : subst_of subst_of_ty :=
  match compren_ty sigma S with
  | sigma_ty => scons (var_ty 0) sigma_ty
  end.

Fixpoint subst_ty (sigma: subst_of subst_of_ty) (s: ty) : ty :=
  match s with
  | var_ty x =>  ((toVar_ty sigma) x)
  | arr s0 s1 => arr ((subst_ty sigma s0)) ((subst_ty sigma s1))
  | all s0 => all ((subst_ty (up_ty_ty sigma) s0))
  end.

Definition comp_ty (sigma tau: subst_of subst_of_ty) : subst_of subst_of_ty :=
  match sigma with
  | sigma_ty => fun x => subst_ty tau (sigma_ty x)
  end.

Definition substMixin_ty  : substMixin ty :=
  {|subst_of_substType := subst_of_ty;inst_of_substType := subst_ty|}.

Canonical Structure substType_ty  : substType :=
  Eval hnf in @Pack ty substMixin_ty ty.

Definition upId_ty_ty (sigma_ty: index -> ty) (E_ty: sigma_ty == var_ty) : @eq_of_subst subst_of_ty (up_ty_ty sigma_ty) var_ty :=
  fun n => match n return (match up_ty_ty sigma_ty with
  | tau_ty => tau_ty n = var_ty  n
  end) with
  | 0 => eq_refl
  | S n => ap (ren_ty S) (E_ty n)
  end.

Fixpoint id_ty (sigma_ty: index -> ty) (E_ty: sigma_ty == var_ty) (s: ty) : subst_ty sigma_ty s = s :=
  match s with
  | var_ty n => E_ty n
  | arr s0 s1 => apc (ap arr (id_ty _ E_ty s0)) ((id_ty _ E_ty s1))
  | all s0 => ap all (match upId_ty_ty _ E_ty with
      | E_ty => id_ty _ E_ty s0
      end)
  end.

Definition toSubst_ty (xi: ren_of subst_of_ty) : subst_of subst_of_ty :=
  match xi with
  | xi_ty => fun x => var_ty (xi_ty x)
  end.

Fixpoint compTrans_ren_ren_ty (xi_ty zeta_ty theta_ty: ren) (E_ty: funcomp (xi_ty) (zeta_ty) == theta_ty) (s: ty)
           : ren_ty zeta_ty (ren_ty xi_ty s) = ren_ty theta_ty s :=
  match s with
  | var_ty n => ap var_ty (E_ty n)
  | arr s0 s1 => apc (ap arr (compTrans_ren_ren_ty xi_ty zeta_ty theta_ty E_ty s0)) ((compTrans_ren_ren_ty xi_ty zeta_ty theta_ty E_ty s1))
  | all s0 => ap all (compTrans_ren_ren_ty (up_ren xi_ty) (up_ren zeta_ty) (up_ren theta_ty) (up_ren_ren xi_ty zeta_ty theta_ty E_ty) s0)
  end.

Definition compE_ren_ren_ty (xi_ty zeta_ty: ren) (s: ty) : ren_ty zeta_ty (ren_ty xi_ty s) = ren_ty (funcomp xi_ty zeta_ty) s :=
  compTrans_ren_ren_ty xi_ty zeta_ty (funcomp xi_ty zeta_ty) (fun _ => eq_refl) s.

Definition up_ren_subst_ty_ty (xi_ty: ren) (theta_ty tau_ty: index -> ty) (E_ty: (fun x =>  theta_ty (xi_ty x)) == tau_ty)
  : @eq_of_subst subst_of_ty (comp_ty (toSubst_ty (upren_ty_ty xi_ty)) (up_ty_ty theta_ty)) (up_ty_ty tau_ty) :=
  fun n => match n return match comp_ty (toSubst_ty (upren_ty_ty xi_ty)) (up_ty_ty theta_ty), up_ty_ty tau_ty with
  | xi_ty, tau_ty => xi_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n => ap (ren_ty S) (E_ty n)
  end.

Fixpoint compTrans_ren_subst_ty (xi_ty: ren) (tau_ty theta_ty: index -> ty) (E_ty: (fun x =>  tau_ty (xi_ty x)) == theta_ty) (s: ty)
           : subst_ty tau_ty (ren_ty xi_ty s) = subst_ty theta_ty s :=
  match s with
  | var_ty n =>  (E_ty n)
  | arr s0 s1 => apc (ap arr (compTrans_ren_subst_ty xi_ty _ _ E_ty s0)) ((compTrans_ren_subst_ty xi_ty _ _ E_ty s1))
  | all s0 => ap all (match up_ren_subst_ty_ty xi_ty tau_ty theta_ty E_ty with
      | E_ty => compTrans_ren_subst_ty (up_ren xi_ty) _ _ E_ty s0
      end)
  end.

Definition compE_ren_subst_ty (xi_ty: ren) (tau_ty: index -> ty) (s: ty)
  : subst_ty tau_ty (ren_ty xi_ty s) = subst_ty (funcomp xi_ty tau_ty) s :=
  compTrans_ren_subst_ty xi_ty tau_ty (funcomp xi_ty tau_ty) (fun _ => eq_refl) s.

Definition up_subst_ren_ty_ty (sigma_ty: index -> ty)
  (rho_ty: ren)
  (tau_ty: index -> ty)
  (E_ty: (fun x =>  ren_ty rho_ty (sigma_ty x)) == tau_ty)
  : @eq_of_subst subst_of_ty (compren_ty (up_ty_ty sigma_ty) (upren_ty_ty rho_ty)) (up_ty_ty tau_ty) :=
  fun n => match n return match compren_ty (up_ty_ty sigma_ty) (upren_ty_ty rho_ty), up_ty_ty tau_ty with
  | sigma_ty, tau_ty => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_ren_ty S (up_ren rho_ty) (sigma_ty n)) (eq_trans (eq_sym (compE_ren_ren_ty rho_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end.

Fixpoint compTrans_subst_ren_ty (sigma_ty: index -> ty)
           (zeta_ty: ren)
           (theta_ty: index -> ty)
           (E_ty: (fun x =>  ren_ty zeta_ty (sigma_ty x)) == theta_ty)
           (s: ty) : ren_ty zeta_ty (subst_ty sigma_ty s) = subst_ty theta_ty s :=
  match s with
  | var_ty n =>  (E_ty n)
  | arr s0 s1 => apc (ap arr (compTrans_subst_ren_ty _ zeta_ty _ E_ty s0)) ((compTrans_subst_ren_ty _ zeta_ty _ E_ty s1))
  | all s0 => ap all (match up_subst_ren_ty_ty sigma_ty zeta_ty theta_ty E_ty with
      | E_ty => compTrans_subst_ren_ty _ (up_ren zeta_ty) _ E_ty s0
      end)
  end.

Definition compE_subst_ren_ty (sigma_ty: index -> ty) (zeta_ty: ren) (s: ty)
  : ren_ty zeta_ty (subst_ty sigma_ty s) = subst_ty (fun n => ren_ty (zeta_ty) (sigma_ty n)) s :=
  compTrans_subst_ren_ty sigma_ty zeta_ty (fun n => ren_ty (zeta_ty) (sigma_ty n)) (fun _ => eq_refl) s.

Definition up_subst_subst_ty_ty (sigma_ty theta_ty tau_ty: index -> ty) (E_ty: (fun x =>  subst_ty theta_ty (sigma_ty x)) == tau_ty)
  : @eq_of_subst subst_of_ty (comp_ty (up_ty_ty sigma_ty) (up_ty_ty theta_ty)) (up_ty_ty tau_ty) :=
  fun n => match n return match comp_ty (up_ty_ty sigma_ty) (up_ty_ty theta_ty), up_ty_ty tau_ty with
  | sigma_ty, tau_ty => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_subst_ty S _ (sigma_ty n)) (eq_trans (eq_sym (compE_subst_ren_ty theta_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end.

Fixpoint compTrans_subst_subst_ty (sigma_ty tau_ty theta_ty: index -> ty)
           (E_ty: (fun x =>  subst_ty tau_ty (sigma_ty x)) == theta_ty)
           (s: ty) : subst_ty tau_ty (subst_ty sigma_ty s) = subst_ty theta_ty s :=
  match s with
  | var_ty n =>  (E_ty n)
  | arr s0 s1 => apc (ap arr (compTrans_subst_subst_ty _ _ _ E_ty s0)) ((compTrans_subst_subst_ty _ _ _ E_ty s1))
  | all s0 => ap all (match up_subst_subst_ty_ty sigma_ty tau_ty theta_ty E_ty with
      | E_ty => compTrans_subst_subst_ty _ _ _ E_ty s0
      end)
  end.

Definition compE_subst_subst_ty (sigma_ty tau_ty: index -> ty) (s: ty)
  : subst_ty tau_ty (subst_ty sigma_ty s) = subst_ty (fun n => subst_ty (tau_ty) (sigma_ty n)) s :=
  compTrans_subst_subst_ty sigma_ty tau_ty (fun n => subst_ty (tau_ty) (sigma_ty n)) (fun _ => eq_refl) s.

Definition eq_up_ty_ty {sigma tau: subst_of subst_of_ty} (E: eq_of_subst sigma tau) : eq_of_subst (up_ty_ty sigma) (up_ty_ty tau).
  rename sigma into sigma_ty. rename tau into tau_ty. rename E into E_ty.
  exact (fun i: index => match i return (var_ty 0 .: sigma_ty >>> ren_ty S) i = (var_ty 0 .: tau_ty >>> ren_ty S) i with 0 => eq_refl
                                                                                | S j => ap _ (E_ty j) end).
Defined.

Fixpoint subst_eq_ty {sigma tau: subst_of subst_of_ty} (E: eq_of_subst sigma tau) (s: ty) : subst_ty sigma s = subst_ty tau s :=
  match s with
  | var_ty n => eq_toVar_ty E n
  | arr s0 s1 => congr_arr (subst_eq_ty E s0) (subst_eq_ty E s1)
  | all s0 => congr_all (subst_eq_ty (eq_up_ty_ty E) s0)
  end.

Class AsimplInst_ty (s: ty) (sigma: subst_of subst_of_ty) (t: ty) := asimplInstEqn_ty : (subst_ty sigma) s = t .
Hint Mode AsimplInst_ty + + - : typeclass_instance.

Class AsimplSubst_ty (sigma tau: subst_of subst_of_ty) := asimplSubstEqn_ty : match sigma, tau with
| sigma_ty, tau_ty => (forall x, sigma_ty x = tau_ty x)
end .
Hint Mode AsimplSubst_ty + - : typeclass_instance.

Class AsimplComp_ty (sigma tau theta: subst_of subst_of_ty) := asimplCompEqn_ty : match comp_ty sigma tau, theta with
| sigma_tau_ty, theta_ty => (forall x, sigma_tau_ty x = theta_ty x)
end .
Hint Mode AsimplComp_ty + + - : typeclass_instance.

Instance AsimplToVar_ty (sigma_ty: index -> ty) : AsimplGen (toVar_ty sigma_ty) sigma_ty.
Proof. intros x. reflexivity. Qed.

Instance AsimplAsimplInst_ty (s t: ty)
(sigma sigma': subst_of subst_of_ty)
(E_sigma: AsimplSubst_ty sigma sigma')
(E: AsimplInst_ty s sigma' t) : Asimpl (subst_ty sigma s) t.
Proof. rewrite <- E. apply subst_eq_ty. assumption. Qed.

Instance AsimplInstRefl_ty (s: ty) (sigma: subst_of subst_of_ty) : AsimplInst_ty s sigma (s.[ sigma ]) |100.
Proof. reflexivity. Qed.

Instance AsimplInstVar_ty (x y: index)
(sigma: subst_of subst_of_ty)
(sigma': index -> ty)
(s: ty)
(E: AsimplIndex x y)
(E': AsimplGen (toVar_ty sigma) sigma')
(E'': AsimplVarInst y sigma' s) : AsimplInst_ty (var_ty x) sigma s.
Proof. rewrite E. rewrite <- E''. apply E'.  Qed.

Instance asimplInst_arr (s0 s1 s0' s1': _)
(sigma theta_0 theta_1: subst_of subst_of_ty)
(E_0': AsimplSubst_ty (sigma) theta_0)
(E_1': AsimplSubst_ty (sigma) theta_1)
(E_0: AsimplInst_ty s0 theta_0 s0')
(E_1: AsimplInst_ty s1 theta_1 s1') : AsimplInst_ty (arr s0 s1) sigma (arr s0' s1').
Admitted.
Instance asimplInst_all (s0 s0': _)
(sigma theta_0: subst_of subst_of_ty)
(E_0': AsimplSubst_ty ((up_ty_ty sigma)) theta_0)
(E_0: AsimplInst_ty s0 theta_0 s0') : AsimplInst_ty (all s0) sigma (all s0').
Admitted.

Instance AsimplId_ty (s: ty) : AsimplInst_ty s var_ty s.
Proof. apply id_ty; reflexivity. Qed.

Instance AsimplInstInst_ty (s t: ty)
(sigma sigma' tau sigma_tau: subst_of subst_of_ty)
(E1: AsimplSubst_ty sigma sigma')
(E2: AsimplComp_ty sigma' tau sigma_tau)
(E3: AsimplInst_ty s sigma_tau t) : AsimplInst_ty (subst_ty sigma s) tau t.
Admitted.

Instance AsimplSubstRefl_ty (sigma: subst_of subst_of_ty) : AsimplSubst_ty sigma sigma | 100.
Admitted.

Instance AsimplSubstComp_ty (sigma sigma' tau tau' theta: subst_of subst_of_ty)
(E_sigma: AsimplSubst_ty sigma sigma')
(E_tau: AsimplSubst_ty tau tau')
(E: AsimplComp_ty sigma' tau' theta) : AsimplSubst_ty (comp_ty sigma tau) theta |90.
Admitted.

Instance AsimplSubstCongr_ty (sigma_ty tau_ty: index -> ty) (E_ty: AsimplGen sigma_ty tau_ty) : AsimplSubst_ty sigma_ty tau_ty |95.
Proof. repeat split; assumption. Qed.

Instance AsimplCompRefl_ty (sigma tau: subst_of subst_of_ty) : AsimplComp_ty sigma tau (comp_ty sigma tau) | 100.
Admitted.

Instance AsimplCompIdL_ty (sigma: subst_of subst_of_ty)
(tau: index -> ty)
(E: AsimplGen (toVar_ty sigma) tau) : AsimplComp var_ty (subst_ty sigma) tau.
Admitted.

Instance AsimplCompIdR_ty (sigma: index -> ty) : AsimplComp sigma (subst_ty var_ty) sigma.
Proof. intros x. apply id_ty; reflexivity. Qed.

Instance AsimplCompAsso_ty (sigma tau theta tau_theta sigma_tau_theta: subst_of subst_of_ty)
(E: AsimplComp_ty tau theta tau_theta)
(E': AsimplComp_ty sigma tau_theta sigma_tau_theta) : AsimplComp_ty (comp_ty sigma tau) theta sigma_tau_theta.
Admitted.

Instance AsimplCompCongr_ty (sigma_ty theta_ty: index -> ty)
(tau_ty tau: subst_of subst_of_ty)
(E_ty: AsimplSubst_ty (tau) tau_ty)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty) : AsimplComp_ty sigma_ty tau theta_ty.
Admitted.

Instance AsimplCompCongr'_ty (sigma_ty theta_ty: index -> ty)
(tau_ty tau: subst_of subst_of_ty)
(E_ty: AsimplSubst_ty (tau) tau_ty)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty) : AsimplComp (subst_ty sigma_ty) (subst_ty tau) (subst_ty theta_ty).
Admitted.

Instance AsimplRefl_ty (s: ty) : Asimpl s s | 100.
Proof. reflexivity. Qed.

Instance AsimplGenComp_ty (sigma sigma': index -> ty)
(tau tau': subst_of subst_of_ty)
(theta: index -> ty)
(E: AsimplGen sigma sigma')
(E': AsimplSubst_ty tau tau')
(E'': AsimplComp sigma' (subst_ty tau') theta) : AsimplGen (sigma >>> (subst_ty tau) ) theta.
Proof. intros x. rewrite <- E''. simpl. rewrite E. now apply subst_eq_ty . Qed.

Instance AsimplSubstUp_ty_ty (sigma_ty tau_ty: index -> ty)
(E_ty: AsimplGen (var_ty 0 .: sigma_ty >>> (subst_ty ((S >>> var_ty)))) tau_ty) : AsimplSubst_ty (up_ty_ty sigma_ty) tau_ty.
Admitted.

Typeclasses Opaque toVar_ty.

Inductive tm  : Type :=

  | app : tm -> tm -> tm
  | tapp : tm -> ty -> tm
  | vt : vl -> tm
 with vl  : Type :=
  | var_vl : index -> vl
  | lam : ty -> tm -> vl
  | tlam : tm -> vl.

Definition congr_app {s0 s1 t0 t1: tm} (E0: s0 = t0) (E1: s1 = t1) : app s0 s1 = app t0 t1 :=
  apc (ap app E0) (E1).

Definition congr_tapp {s0: tm} {s1: ty} {t0: tm} {t1: ty} (E0: s0 = t0) (E1: s1 = t1) : tapp s0 s1 = tapp t0 t1 :=
  apc (ap tapp E0) (E1).

Definition congr_vt {s0 t0: vl} (E0: s0 = t0) : vt s0 = vt t0 :=
  ap vt E0.

Definition congr_lam {s0: ty} {s1: tm} {t0: ty} {t1: tm} (E0: s0 = t0) (E1: s1 = t1) : lam s0 s1 = lam t0 t1 :=
  apc (ap lam E0) (E1).

Definition congr_tlam {s0 t0: tm} (E0: s0 = t0) : tlam s0 = tlam t0 :=
  ap tlam E0.

Definition subst_of_tm  : list Type :=
  [ty: Type;vl: Type].

Definition subst_of_vl  : list Type :=
  [ty: Type;vl: Type].

Definition toVarRen_tm (xi: ren_of subst_of_tm) : _ :=
  let (_, _) := xi in xi.

Definition toVarRen_vl (xi: ren_of subst_of_vl) : _ :=
  let (_, xi) := xi in xi.

Definition castren_tm_ty (xi: ren_of subst_of_tm) : ren_of subst_of_ty :=
  let (xi_ty, _) := xi in xi_ty.

Definition castren_tm_vl (xi: ren_of subst_of_tm) : ren_of subst_of_vl :=
  let (xi_ty, xi_vl) := xi in (xi_ty, xi_vl).

Definition castren_vl_ty (xi: ren_of subst_of_vl) : ren_of subst_of_ty :=
  let (xi_ty, _) := xi in xi_ty.

Definition castren_vl_tm (xi: ren_of subst_of_vl) : ren_of subst_of_tm :=
  let (xi_ty, xi_vl) := xi in (xi_ty, xi_vl).

Definition upren_tm_ty (xi: ren_of subst_of_tm) : ren_of subst_of_tm :=
  let (xi_ty, xi_vl) := xi in (up_ren xi_ty, xi_vl).

Definition upren_tm_vl (xi: ren_of subst_of_tm) : ren_of subst_of_tm :=
  let (xi_ty, xi_vl) := xi in (xi_ty, up_ren xi_vl).

Definition upren_vl_ty (xi: ren_of subst_of_vl) : ren_of subst_of_vl :=
  let (xi_ty, xi_vl) := xi in (up_ren xi_ty, xi_vl).

Definition upren_vl_vl (xi: ren_of subst_of_vl) : ren_of subst_of_vl :=
  let (xi_ty, xi_vl) := xi in (xi_ty, up_ren xi_vl).

Fixpoint ren_tm (xi: ren_of subst_of_tm) (s: tm) : tm :=
  match s with

  | app s0 s1 => app ((ren_tm xi s0)) ((ren_tm xi s1))
  | tapp s0 s1 => tapp ((ren_tm xi s0)) ((ren_ty (castren_tm_ty xi) s1))
  | vt s0 => vt ((ren_vl (castren_tm_vl xi) s0))
  end
 with ren_vl (xi: ren_of subst_of_vl) (s: vl) : vl :=
  match s with
  | var_vl x => var_vl ((toVarRen_vl xi) x)
  | lam s0 s1 => lam ((ren_ty (castren_vl_ty xi) s0)) ((ren_tm (upren_vl_vl (castren_vl_tm xi)) s1))
  | tlam s0 => tlam ((ren_tm (upren_vl_ty (castren_vl_tm xi)) s0))
  end.

Definition toVar_tm (sigma: subst_of subst_of_tm) : _ :=
  let (_, _) := sigma in sigma.

Definition toVar_vl (sigma: subst_of subst_of_vl) : _ :=
  let (_, sigma) := sigma in sigma.

Definition eq_toVar_vl {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) (n: index) : toVar_vl sigma n = toVar_vl tau n.
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (E_vl n).
Defined.

Definition compren_tm (sigma: subst_of subst_of_tm) (xi: ren_of subst_of_tm) : subst_of subst_of_tm :=
  match sigma with
  | (sigma_ty, sigma_vl) => (fun x => ren_ty (castren_tm_ty xi) (sigma_ty x), fun x => ren_vl (castren_tm_vl xi) (sigma_vl x))
  end.

Definition compren_vl (sigma: subst_of subst_of_vl) (xi: ren_of subst_of_vl) : subst_of subst_of_vl :=
  match sigma with
  | (sigma_ty, sigma_vl) => (fun x => ren_ty (castren_vl_ty xi) (sigma_ty x), fun x => ren_vl xi (sigma_vl x))
  end.

Definition up_tm_ty (sigma: subst_of subst_of_tm) : subst_of subst_of_tm :=
  match compren_tm sigma (S, idren) with
  | (sigma_ty, sigma_vl) => (scons (var_ty 0) sigma_ty, sigma_vl)
  end.

Definition up_tm_vl (sigma: subst_of subst_of_tm) : subst_of subst_of_tm :=
  match compren_tm sigma (idren, S) with
  | (sigma_ty, sigma_vl) => (sigma_ty, scons (var_vl 0) sigma_vl)
  end.

Definition up_vl_ty (sigma: subst_of subst_of_vl) : subst_of subst_of_vl :=
  match compren_vl sigma (S, idren) with
  | (sigma_ty, sigma_vl) => (scons (var_ty 0) sigma_ty, sigma_vl)
  end.

Definition up_vl_vl (sigma: subst_of subst_of_vl) : subst_of subst_of_vl :=
  match compren_vl sigma (idren, S) with
  | (sigma_ty, sigma_vl) => (sigma_ty, scons (var_vl 0) sigma_vl)
  end.

Definition cast_tm_ty (sigma: subst_of subst_of_tm) : subst_of subst_of_ty :=
  let (sigma_ty, _) := sigma in sigma_ty.

Definition cast_tm_vl (sigma: subst_of subst_of_tm) : subst_of subst_of_vl :=
  let (sigma_ty, sigma_vl) := sigma in (sigma_ty, sigma_vl).

Definition cast_vl_ty (sigma: subst_of subst_of_vl) : subst_of subst_of_ty :=
  let (sigma_ty, _) := sigma in sigma_ty.

Definition cast_vl_tm (sigma: subst_of subst_of_vl) : subst_of subst_of_tm :=
  let (sigma_ty, sigma_vl) := sigma in (sigma_ty, sigma_vl).

Definition eq_cast_tm_ty {sigma tau: subst_of subst_of_tm} (E: eq_of_subst sigma tau) : eq_of_subst (cast_tm_ty sigma) (cast_tm_ty tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (E_ty).
Defined.

Definition eq_cast_tm_vl {sigma tau: subst_of subst_of_tm} (E: eq_of_subst sigma tau) : eq_of_subst (cast_tm_vl sigma) (cast_tm_vl tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (E_ty) (E_vl)).
Defined.

Definition eq_cast_vl_ty {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) : eq_of_subst (cast_vl_ty sigma) (cast_vl_ty tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (E_ty).
Defined.

Definition eq_cast_vl_tm {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) : eq_of_subst (cast_vl_tm sigma) (cast_vl_tm tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (E_ty) (E_vl)).
Defined.

Fixpoint subst_tm (sigma: subst_of subst_of_tm) (s: tm) : tm :=
  match s with

  | app s0 s1 => app ((subst_tm sigma s0)) ((subst_tm sigma s1))
  | tapp s0 s1 => tapp ((subst_tm sigma s0)) ((subst_ty (cast_tm_ty sigma) s1))
  | vt s0 => vt ((subst_vl (cast_tm_vl sigma) s0))
  end
 with subst_vl (sigma: subst_of subst_of_vl) (s: vl) : vl :=
  match s with
  | var_vl x =>  ((toVar_vl sigma) x)
  | lam s0 s1 => lam ((subst_ty (cast_vl_ty sigma) s0)) ((subst_tm (up_vl_vl (cast_vl_tm sigma)) s1))
  | tlam s0 => tlam ((subst_tm (up_vl_ty (cast_vl_tm sigma)) s0))
  end.

Definition comp_tm (sigma tau: subst_of subst_of_tm) : subst_of subst_of_tm :=
  match sigma with
  | (sigma_ty, sigma_vl) => (fun x => subst_ty (cast_tm_ty tau) (sigma_ty x), fun x => subst_vl (cast_tm_vl tau) (sigma_vl x))
  end.

Definition comp_vl (sigma tau: subst_of subst_of_vl) : subst_of subst_of_vl :=
  match sigma with
  | (sigma_ty, sigma_vl) => (fun x => subst_ty (cast_vl_ty tau) (sigma_ty x), fun x => subst_vl tau (sigma_vl x))
  end.

Definition substMixin_tm  : substMixin tm :=
  {|subst_of_substType := subst_of_tm;inst_of_substType := subst_tm|}.

Definition substMixin_vl  : substMixin vl :=
  {|subst_of_substType := subst_of_vl;inst_of_substType := subst_vl|}.

Canonical Structure substType_tm  : substType :=
  Eval hnf in @Pack tm substMixin_tm tm.

Canonical Structure substType_vl  : substType :=
  Eval hnf in @Pack vl substMixin_vl vl.

Definition upId_tm_ty (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl)
  : @eq_of_subst subst_of_tm (up_tm_ty (sigma_ty, sigma_vl)) (var_ty, var_vl) :=
  conj (fun n => match n return (match up_tm_ty (sigma_ty, sigma_vl) with
  | (tau_ty, tau_vl) => tau_ty n = var_ty  n
  end) with
  | 0 => eq_refl
  | S n => ap (ren_ty (castren_tm_ty (S, idren))) (E_ty n)
  end) (fun n => ap (ren_vl (castren_tm_vl (S, idren))) (E_vl n)).

Definition upId_tm_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl)
  : @eq_of_subst subst_of_tm (up_tm_vl (sigma_ty, sigma_vl)) (var_ty, var_vl) :=
  conj (fun n => ap (ren_ty (castren_tm_ty (idren, S))) (E_ty n)) (fun n => match n return (match up_tm_vl (sigma_ty, sigma_vl) with
  | (tau_ty, tau_vl) => tau_vl n = var_vl  n
  end) with
  | 0 => eq_refl
  | S n => ap (ren_vl (castren_tm_vl (idren, S))) (E_vl n)
  end).

Definition upId_vl_ty (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl)
  : @eq_of_subst subst_of_vl (up_vl_ty (sigma_ty, sigma_vl)) (var_ty, var_vl) :=
  conj (fun n => match n return (match up_vl_ty (sigma_ty, sigma_vl) with
  | (tau_ty, tau_vl) => tau_ty n = var_ty  n
  end) with
  | 0 => eq_refl
  | S n => ap (ren_ty (castren_vl_ty (S, idren))) (E_ty n)
  end) (fun n => ap (ren_vl (S, idren)) (E_vl n)).

Definition upId_vl_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl)
  : @eq_of_subst subst_of_vl (up_vl_vl (sigma_ty, sigma_vl)) (var_ty, var_vl) :=
  conj (fun n => ap (ren_ty (castren_vl_ty (idren, S))) (E_ty n)) (fun n => match n return (match up_vl_vl (sigma_ty, sigma_vl) with
  | (tau_ty, tau_vl) => tau_vl n = var_vl  n
  end) with
  | 0 => eq_refl
  | S n => ap (ren_vl (idren, S)) (E_vl n)
  end).

Fixpoint id_tm (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl) (s: tm)
           : subst_tm (sigma_ty, sigma_vl) s = s :=
  match s with

  | app s0 s1 => apc (ap app (id_tm _ _ E_ty E_vl s0)) ((id_tm _ _ E_ty E_vl s1))
  | tapp s0 s1 => apc (ap tapp (id_tm _ _ E_ty E_vl s0)) ((id_ty _ E_ty s1))
  | vt s0 => ap vt (id_vl _ _ E_ty E_vl s0)
  end
 with id_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) (E_ty: sigma_ty == var_ty) (E_vl: sigma_vl == var_vl) (s: vl)
        : subst_vl (sigma_ty, sigma_vl) s = s :=
  match s with
  | var_vl n => E_vl n
  | lam s0 s1 => apc (ap lam (id_ty _ E_ty s0)) ((match upId_tm_vl _ _ E_ty E_vl with
      | conj (E_ty) (E_vl) => id_tm _ _ E_ty E_vl s1
      end))
  | tlam s0 => ap tlam (match upId_tm_ty _ _ E_ty E_vl with
      | conj (E_ty) (E_vl) => id_tm _ _ E_ty E_vl s0
      end)
  end.

Definition toSubst_tm (xi: ren_of subst_of_tm) : subst_of subst_of_tm :=
  match xi with
  | (xi_ty, xi_vl) => (fun x => var_ty (xi_ty x), fun x => var_vl (xi_vl x))
  end.

Definition toSubst_vl (xi: ren_of subst_of_vl) : subst_of subst_of_vl :=
  match xi with
  | (xi_ty, xi_vl) => (fun x => var_ty (xi_ty x), fun x => var_vl (xi_vl x))
  end.

Fixpoint compTrans_ren_ren_tm (xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl: ren)
           (E_ty: funcomp (xi_ty) (zeta_ty) == theta_ty)
           (E_vl: funcomp (xi_vl) (zeta_vl) == theta_vl)
           (s: tm) : ren_tm (zeta_ty, zeta_vl) (ren_tm (xi_ty, xi_vl) s) = ren_tm (theta_ty, theta_vl) s :=
  match s with

  | app s0 s1 =>
      apc (ap app (compTrans_ren_ren_tm xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl s0)) ((compTrans_ren_ren_tm xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl s1))
  | tapp s0 s1 =>
      apc (ap tapp (compTrans_ren_ren_tm xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl s0)) ((compTrans_ren_ren_ty xi_ty zeta_ty theta_ty E_ty s1))
  | vt s0 => ap vt (compTrans_ren_ren_vl xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl s0)
  end
 with compTrans_ren_ren_vl (xi_ty xi_vl zeta_ty zeta_vl theta_ty theta_vl: ren)
        (E_ty: funcomp (xi_ty) (zeta_ty) == theta_ty)
        (E_vl: funcomp (xi_vl) (zeta_vl) == theta_vl)
        (s: vl) : ren_vl (zeta_ty, zeta_vl) (ren_vl (xi_ty, xi_vl) s) = ren_vl (theta_ty, theta_vl) s :=
  match s with
  | var_vl n => ap var_vl (E_vl n)
  | lam s0 s1 =>
      apc (ap lam (compTrans_ren_ren_ty xi_ty zeta_ty theta_ty E_ty s0)) ((compTrans_ren_ren_tm xi_ty (up_ren xi_vl) zeta_ty (up_ren zeta_vl) theta_ty (up_ren theta_vl) E_ty (up_ren_ren xi_vl zeta_vl theta_vl E_vl) s1))
  | tlam s0 =>
      ap tlam (compTrans_ren_ren_tm (up_ren xi_ty) xi_vl (up_ren zeta_ty) zeta_vl (up_ren theta_ty) theta_vl (up_ren_ren xi_ty zeta_ty theta_ty E_ty) E_vl s0)
  end.

Definition compE_ren_ren_tm (xi_ty xi_vl zeta_ty zeta_vl: ren) (s: tm) : ren_tm (zeta_ty, zeta_vl) (ren_tm (xi_ty
                                                                                , xi_vl) s) = ren_tm ((funcomp xi_ty zeta_ty)
                                                                                , (funcomp xi_vl zeta_vl)) s :=
  compTrans_ren_ren_tm xi_ty xi_vl zeta_ty zeta_vl (funcomp xi_ty zeta_ty) (funcomp xi_vl zeta_vl) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition compE_ren_ren_vl (xi_ty xi_vl zeta_ty zeta_vl: ren) (s: vl) : ren_vl (zeta_ty, zeta_vl) (ren_vl (xi_ty
                                                                                , xi_vl) s) = ren_vl ((funcomp xi_ty zeta_ty)
                                                                                , (funcomp xi_vl zeta_vl)) s :=
  compTrans_ren_ren_vl xi_ty xi_vl zeta_ty zeta_vl (funcomp xi_ty zeta_ty) (funcomp xi_vl zeta_vl) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition up_ren_subst_tm_ty (xi_ty xi_vl: ren)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  theta_ty (xi_ty x)) == tau_ty)
  (E_vl: (fun x =>  theta_vl (xi_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (comp_tm (toSubst_tm (upren_tm_ty (xi_ty
                                                                                , xi_vl))) (up_tm_ty (theta_ty
                                                                                , theta_vl))) (up_tm_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match comp_tm (toSubst_tm (upren_tm_ty (xi_ty, xi_vl))) (up_tm_ty (theta_ty, theta_vl)), up_tm_ty (tau_ty
                                                                                , tau_vl) with
  | (xi_ty, xi_vl), (tau_ty, tau_vl) => xi_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n => ap (ren_ty (castren_tm_ty (S, idren))) (E_ty n)
  end) (fun n => ap (ren_vl (castren_tm_vl (S, idren))) (E_vl n)).

Definition up_ren_subst_tm_vl (xi_ty xi_vl: ren)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  theta_ty (xi_ty x)) == tau_ty)
  (E_vl: (fun x =>  theta_vl (xi_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (comp_tm (toSubst_tm (upren_tm_vl (xi_ty
                                                                                , xi_vl))) (up_tm_vl (theta_ty
                                                                                , theta_vl))) (up_tm_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => ap (ren_ty (castren_tm_ty (idren, S))) (E_ty n)) (fun n => match n return match comp_tm (toSubst_tm (upren_tm_vl (xi_ty
                                                                                , xi_vl))) (up_tm_vl (theta_ty
                                                                                , theta_vl)), up_tm_vl (tau_ty
                                                                                , tau_vl) with
  | (xi_ty, xi_vl), (tau_ty, tau_vl) => xi_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n => ap (ren_vl (castren_tm_vl (idren, S))) (E_vl n)
  end).

Definition up_ren_subst_vl_ty (xi_ty xi_vl: ren)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  theta_ty (xi_ty x)) == tau_ty)
  (E_vl: (fun x =>  theta_vl (xi_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (comp_vl (toSubst_vl (upren_vl_ty (xi_ty
                                                                                , xi_vl))) (up_vl_ty (theta_ty
                                                                                , theta_vl))) (up_vl_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match comp_vl (toSubst_vl (upren_vl_ty (xi_ty, xi_vl))) (up_vl_ty (theta_ty, theta_vl)), up_vl_ty (tau_ty
                                                                                , tau_vl) with
  | (xi_ty, xi_vl), (tau_ty, tau_vl) => xi_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n => ap (ren_ty (castren_vl_ty (S, idren))) (E_ty n)
  end) (fun n => ap (ren_vl (S, idren)) (E_vl n)).

Definition up_ren_subst_vl_vl (xi_ty xi_vl: ren)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  theta_ty (xi_ty x)) == tau_ty)
  (E_vl: (fun x =>  theta_vl (xi_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (comp_vl (toSubst_vl (upren_vl_vl (xi_ty
                                                                                , xi_vl))) (up_vl_vl (theta_ty
                                                                                , theta_vl))) (up_vl_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => ap (ren_ty (castren_vl_ty (idren, S))) (E_ty n)) (fun n => match n return match comp_vl (toSubst_vl (upren_vl_vl (xi_ty
                                                                                , xi_vl))) (up_vl_vl (theta_ty
                                                                                , theta_vl)), up_vl_vl (tau_ty
                                                                                , tau_vl) with
  | (xi_ty, xi_vl), (tau_ty, tau_vl) => xi_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n => ap (ren_vl (idren, S)) (E_vl n)
  end).

Fixpoint compTrans_ren_subst_tm (xi_ty xi_vl: ren)
           (tau_ty: index -> ty)
           (tau_vl: index -> vl)
           (theta_ty: index -> ty)
           (theta_vl: index -> vl)
           (E_ty: (fun x =>  tau_ty (xi_ty x)) == theta_ty)
           (E_vl: (fun x =>  tau_vl (xi_vl x)) == theta_vl)
           (s: tm) : subst_tm (tau_ty, tau_vl) (ren_tm (xi_ty, xi_vl) s) = subst_tm (theta_ty, theta_vl) s :=
  match s with

  | app s0 s1 =>
      apc (ap app (compTrans_ren_subst_tm xi_ty xi_vl _ _ _ _ E_ty E_vl s0)) ((compTrans_ren_subst_tm xi_ty xi_vl _ _ _ _ E_ty E_vl s1))
  | tapp s0 s1 => apc (ap tapp (compTrans_ren_subst_tm xi_ty xi_vl _ _ _ _ E_ty E_vl s0)) ((compTrans_ren_subst_ty xi_ty _ _ E_ty s1))
  | vt s0 => ap vt (compTrans_ren_subst_vl xi_ty xi_vl _ _ _ _ E_ty E_vl s0)
  end
 with compTrans_ren_subst_vl (xi_ty xi_vl: ren)
        (tau_ty: index -> ty)
        (tau_vl: index -> vl)
        (theta_ty: index -> ty)
        (theta_vl: index -> vl)
        (E_ty: (fun x =>  tau_ty (xi_ty x)) == theta_ty)
        (E_vl: (fun x =>  tau_vl (xi_vl x)) == theta_vl)
        (s: vl) : subst_vl (tau_ty, tau_vl) (ren_vl (xi_ty, xi_vl) s) = subst_vl (theta_ty, theta_vl) s :=
  match s with
  | var_vl n =>  (E_vl n)
  | lam s0 s1 =>
      apc (ap lam (compTrans_ren_subst_ty xi_ty _ _ E_ty s0)) ((match up_ren_subst_vl_vl xi_ty xi_vl tau_ty tau_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_ren_subst_tm xi_ty (up_ren xi_vl) _ _ _ _ E_ty E_vl s1
      end))
  | tlam s0 => ap tlam (match up_ren_subst_vl_ty xi_ty xi_vl tau_ty tau_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_ren_subst_tm (up_ren xi_ty) xi_vl _ _ _ _ E_ty E_vl s0
      end)
  end.

Definition compE_ren_subst_tm (xi_ty xi_vl: ren) (tau_ty: index -> ty) (tau_vl: index -> vl) (s: tm) : subst_tm (tau_ty
                                                                                , tau_vl) (ren_tm (xi_ty
                                                                                , xi_vl) s) = subst_tm ((funcomp xi_ty tau_ty)
                                                                                , (funcomp xi_vl tau_vl)) s :=
  compTrans_ren_subst_tm xi_ty xi_vl tau_ty tau_vl (funcomp xi_ty tau_ty) (funcomp xi_vl tau_vl) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition compE_ren_subst_vl (xi_ty xi_vl: ren) (tau_ty: index -> ty) (tau_vl: index -> vl) (s: vl) : subst_vl (tau_ty
                                                                                , tau_vl) (ren_vl (xi_ty
                                                                                , xi_vl) s) = subst_vl ((funcomp xi_ty tau_ty)
                                                                                , (funcomp xi_vl tau_vl)) s :=
  compTrans_ren_subst_vl xi_ty xi_vl tau_ty tau_vl (funcomp xi_ty tau_ty) (funcomp xi_vl tau_vl) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition up_subst_ren_tm_ty (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (rho_ty rho_vl: ren)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  ren_ty rho_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  ren_vl (rho_ty, rho_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (compren_tm (up_tm_ty (sigma_ty
                                                                                , sigma_vl)) (upren_tm_ty (rho_ty
                                                                                , rho_vl))) (up_tm_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match compren_tm (up_tm_ty (sigma_ty, sigma_vl)) (upren_tm_ty (rho_ty, rho_vl)), up_tm_ty (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_ren_ty S (up_ren rho_ty) (sigma_ty n)) (eq_trans (eq_sym (compE_ren_ren_ty rho_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end) (fun n => eq_trans (compE_ren_ren_vl S idren (up_ren rho_ty) rho_vl (sigma_vl n)) (eq_trans (eq_sym (compE_ren_ren_vl rho_ty rho_vl S idren (sigma_vl n))) (ap (ren_vl (S
                                                                                , idren)) (E_vl n)))).

Definition up_subst_ren_tm_vl (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (rho_ty rho_vl: ren)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  ren_ty rho_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  ren_vl (rho_ty, rho_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (compren_tm (up_tm_vl (sigma_ty
                                                                                , sigma_vl)) (upren_tm_vl (rho_ty
                                                                                , rho_vl))) (up_tm_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => eq_trans (compE_ren_ren_ty idren rho_ty (sigma_ty n)) (eq_trans (eq_sym (compE_ren_ren_ty rho_ty idren (sigma_ty n))) (ap (ren_ty idren) (E_ty n)))) (fun n => match n return match compren_tm (up_tm_vl (sigma_ty
                                                                                , sigma_vl)) (upren_tm_vl (rho_ty
                                                                                , rho_vl)), up_tm_vl (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_ren_vl idren S rho_ty (up_ren rho_vl) (sigma_vl n)) (eq_trans (eq_sym (compE_ren_ren_vl rho_ty rho_vl idren S (sigma_vl n))) (ap (ren_vl (idren
                                                                                , S)) (E_vl n)))
  end).

Definition up_subst_ren_vl_ty (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (rho_ty rho_vl: ren)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  ren_ty rho_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  ren_vl (rho_ty, rho_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (compren_vl (up_vl_ty (sigma_ty
                                                                                , sigma_vl)) (upren_vl_ty (rho_ty
                                                                                , rho_vl))) (up_vl_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match compren_vl (up_vl_ty (sigma_ty, sigma_vl)) (upren_vl_ty (rho_ty, rho_vl)), up_vl_ty (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_ren_ty S (up_ren rho_ty) (sigma_ty n)) (eq_trans (eq_sym (compE_ren_ren_ty rho_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end) (fun n => eq_trans (compE_ren_ren_vl S idren (up_ren rho_ty) rho_vl (sigma_vl n)) (eq_trans (eq_sym (compE_ren_ren_vl rho_ty rho_vl S idren (sigma_vl n))) (ap (ren_vl (S
                                                                                , idren)) (E_vl n)))).

Definition up_subst_ren_vl_vl (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (rho_ty rho_vl: ren)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  ren_ty rho_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  ren_vl (rho_ty, rho_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (compren_vl (up_vl_vl (sigma_ty
                                                                                , sigma_vl)) (upren_vl_vl (rho_ty
                                                                                , rho_vl))) (up_vl_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => eq_trans (compE_ren_ren_ty idren rho_ty (sigma_ty n)) (eq_trans (eq_sym (compE_ren_ren_ty rho_ty idren (sigma_ty n))) (ap (ren_ty idren) (E_ty n)))) (fun n => match n return match compren_vl (up_vl_vl (sigma_ty
                                                                                , sigma_vl)) (upren_vl_vl (rho_ty
                                                                                , rho_vl)), up_vl_vl (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_ren_vl idren S rho_ty (up_ren rho_vl) (sigma_vl n)) (eq_trans (eq_sym (compE_ren_ren_vl rho_ty rho_vl idren S (sigma_vl n))) (ap (ren_vl (idren
                                                                                , S)) (E_vl n)))
  end).

Fixpoint compTrans_subst_ren_tm (sigma_ty: index -> ty)
           (sigma_vl: index -> vl)
           (zeta_ty zeta_vl: ren)
           (theta_ty: index -> ty)
           (theta_vl: index -> vl)
           (E_ty: (fun x =>  ren_ty zeta_ty (sigma_ty x)) == theta_ty)
           (E_vl: (fun x =>  ren_vl (zeta_ty, zeta_vl) (sigma_vl x)) == theta_vl)
           (s: tm) : ren_tm (zeta_ty, zeta_vl) (subst_tm (sigma_ty, sigma_vl) s) = subst_tm (theta_ty, theta_vl) s :=
  match s with

  | app s0 s1 =>
      apc (ap app (compTrans_subst_ren_tm _ _ zeta_ty zeta_vl _ _ E_ty E_vl s0)) ((compTrans_subst_ren_tm _ _ zeta_ty zeta_vl _ _ E_ty E_vl s1))
  | tapp s0 s1 => apc (ap tapp (compTrans_subst_ren_tm _ _ zeta_ty zeta_vl _ _ E_ty E_vl s0)) ((compTrans_subst_ren_ty _ zeta_ty _ E_ty s1))
  | vt s0 => ap vt (compTrans_subst_ren_vl _ _ zeta_ty zeta_vl _ _ E_ty E_vl s0)
  end
 with compTrans_subst_ren_vl (sigma_ty: index -> ty)
        (sigma_vl: index -> vl)
        (zeta_ty zeta_vl: ren)
        (theta_ty: index -> ty)
        (theta_vl: index -> vl)
        (E_ty: (fun x =>  ren_ty zeta_ty (sigma_ty x)) == theta_ty)
        (E_vl: (fun x =>  ren_vl (zeta_ty, zeta_vl) (sigma_vl x)) == theta_vl)
        (s: vl) : ren_vl (zeta_ty, zeta_vl) (subst_vl (sigma_ty, sigma_vl) s) = subst_vl (theta_ty, theta_vl) s :=
  match s with
  | var_vl n =>  (E_vl n)
  | lam s0 s1 =>
      apc (ap lam (compTrans_subst_ren_ty _ zeta_ty _ E_ty s0)) ((match up_subst_ren_vl_vl sigma_ty sigma_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_subst_ren_tm _ _ zeta_ty (up_ren zeta_vl) _ _ E_ty E_vl s1
      end))
  | tlam s0 => ap tlam (match up_subst_ren_vl_ty sigma_ty sigma_vl zeta_ty zeta_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_subst_ren_tm _ _ (up_ren zeta_ty) zeta_vl _ _ E_ty E_vl s0
      end)
  end.

Definition compE_subst_ren_tm (sigma_ty: index -> ty) (sigma_vl: index -> vl) (zeta_ty zeta_vl: ren) (s: tm) : ren_tm (zeta_ty
                                                                                , zeta_vl) (subst_tm (sigma_ty
                                                                                , sigma_vl) s) = subst_tm ((fun n => ren_ty (zeta_ty) (sigma_ty n))
                                                                                , (fun n => ren_vl ((zeta_ty
                                                                                , zeta_vl)) (sigma_vl n))) s :=
  compTrans_subst_ren_tm sigma_ty sigma_vl zeta_ty zeta_vl (fun n => ren_ty (zeta_ty) (sigma_ty n)) (fun n => ren_vl ((zeta_ty
                                                                                , zeta_vl)) (sigma_vl n)) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition compE_subst_ren_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) (zeta_ty zeta_vl: ren) (s: vl) : ren_vl (zeta_ty
                                                                                , zeta_vl) (subst_vl (sigma_ty
                                                                                , sigma_vl) s) = subst_vl ((fun n => ren_ty (zeta_ty) (sigma_ty n))
                                                                                , (fun n => ren_vl ((zeta_ty
                                                                                , zeta_vl)) (sigma_vl n))) s :=
  compTrans_subst_ren_vl sigma_ty sigma_vl zeta_ty zeta_vl (fun n => ren_ty (zeta_ty) (sigma_ty n)) (fun n => ren_vl ((zeta_ty
                                                                                , zeta_vl)) (sigma_vl n)) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition up_subst_subst_tm_ty (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  subst_ty theta_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  subst_vl (theta_ty, theta_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (comp_tm (up_tm_ty (sigma_ty
                                                                                , sigma_vl)) (up_tm_ty (theta_ty
                                                                                , theta_vl))) (up_tm_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match comp_tm (up_tm_ty (sigma_ty, sigma_vl)) (up_tm_ty (theta_ty, theta_vl)), up_tm_ty (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_subst_ty S _ (sigma_ty n)) (eq_trans (eq_sym (compE_subst_ren_ty theta_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end) (fun n => eq_trans (compE_ren_subst_vl S idren _ _ (sigma_vl n)) (eq_trans (eq_sym (compE_subst_ren_vl theta_ty theta_vl S idren (sigma_vl n))) (ap (ren_vl (S
                                                                                , idren)) (E_vl n)))).

Definition up_subst_subst_tm_vl (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  subst_ty theta_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  subst_vl (theta_ty, theta_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_tm (comp_tm (up_tm_vl (sigma_ty
                                                                                , sigma_vl)) (up_tm_vl (theta_ty
                                                                                , theta_vl))) (up_tm_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => eq_trans (compE_ren_subst_ty idren _ (sigma_ty n)) (eq_trans (eq_sym (compE_subst_ren_ty theta_ty idren (sigma_ty n))) (ap (ren_ty idren) (E_ty n)))) (fun n => match n return match comp_tm (up_tm_vl (sigma_ty
                                                                                , sigma_vl)) (up_tm_vl (theta_ty
                                                                                , theta_vl)), up_tm_vl (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_subst_vl idren S _ _ (sigma_vl n)) (eq_trans (eq_sym (compE_subst_ren_vl theta_ty theta_vl idren S (sigma_vl n))) (ap (ren_vl (idren
                                                                                , S)) (E_vl n)))
  end).

Definition up_subst_subst_vl_ty (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  subst_ty theta_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  subst_vl (theta_ty, theta_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (comp_vl (up_vl_ty (sigma_ty
                                                                                , sigma_vl)) (up_vl_ty (theta_ty
                                                                                , theta_vl))) (up_vl_ty (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => match n return match comp_vl (up_vl_ty (sigma_ty, sigma_vl)) (up_vl_ty (theta_ty, theta_vl)), up_vl_ty (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_ty n = tau_ty n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_subst_ty S _ (sigma_ty n)) (eq_trans (eq_sym (compE_subst_ren_ty theta_ty S (sigma_ty n))) (ap (ren_ty S) (E_ty n)))
  end) (fun n => eq_trans (compE_ren_subst_vl S idren _ _ (sigma_vl n)) (eq_trans (eq_sym (compE_subst_ren_vl theta_ty theta_vl S idren (sigma_vl n))) (ap (ren_vl (S
                                                                                , idren)) (E_vl n)))).

Definition up_subst_subst_vl_vl (sigma_ty: index -> ty)
  (sigma_vl: index -> vl)
  (theta_ty: index -> ty)
  (theta_vl: index -> vl)
  (tau_ty: index -> ty)
  (tau_vl: index -> vl)
  (E_ty: (fun x =>  subst_ty theta_ty (sigma_ty x)) == tau_ty)
  (E_vl: (fun x =>  subst_vl (theta_ty, theta_vl) (sigma_vl x)) == tau_vl) : @eq_of_subst subst_of_vl (comp_vl (up_vl_vl (sigma_ty
                                                                                , sigma_vl)) (up_vl_vl (theta_ty
                                                                                , theta_vl))) (up_vl_vl (tau_ty
                                                                                , tau_vl)) :=
  conj (fun n => eq_trans (compE_ren_subst_ty idren _ (sigma_ty n)) (eq_trans (eq_sym (compE_subst_ren_ty theta_ty idren (sigma_ty n))) (ap (ren_ty idren) (E_ty n)))) (fun n => match n return match comp_vl (up_vl_vl (sigma_ty
                                                                                , sigma_vl)) (up_vl_vl (theta_ty
                                                                                , theta_vl)), up_vl_vl (tau_ty
                                                                                , tau_vl) with
  | (sigma_ty, sigma_vl), (tau_ty, tau_vl) => sigma_vl n = tau_vl n
  end with
  | 0 => eq_refl
  | S n =>
      eq_trans (compE_ren_subst_vl idren S _ _ (sigma_vl n)) (eq_trans (eq_sym (compE_subst_ren_vl theta_ty theta_vl idren S (sigma_vl n))) (ap (ren_vl (idren
                                                                                , S)) (E_vl n)))
  end).

Fixpoint compTrans_subst_subst_tm (sigma_ty: index -> ty)
           (sigma_vl: index -> vl)
           (tau_ty: index -> ty)
           (tau_vl: index -> vl)
           (theta_ty: index -> ty)
           (theta_vl: index -> vl)
           (E_ty: (fun x =>  subst_ty tau_ty (sigma_ty x)) == theta_ty)
           (E_vl: (fun x =>  subst_vl (tau_ty, tau_vl) (sigma_vl x)) == theta_vl)
           (s: tm) : subst_tm (tau_ty, tau_vl) (subst_tm (sigma_ty, sigma_vl) s) = subst_tm (theta_ty, theta_vl) s :=
  match s with

  | app s0 s1 => apc (ap app (compTrans_subst_subst_tm _ _ _ _ _ _ E_ty E_vl s0)) ((compTrans_subst_subst_tm _ _ _ _ _ _ E_ty E_vl s1))
  | tapp s0 s1 => apc (ap tapp (compTrans_subst_subst_tm _ _ _ _ _ _ E_ty E_vl s0)) ((compTrans_subst_subst_ty _ _ _ E_ty s1))
  | vt s0 => ap vt (compTrans_subst_subst_vl _ _ _ _ _ _ E_ty E_vl s0)
  end
 with compTrans_subst_subst_vl (sigma_ty: index -> ty)
        (sigma_vl: index -> vl)
        (tau_ty: index -> ty)
        (tau_vl: index -> vl)
        (theta_ty: index -> ty)
        (theta_vl: index -> vl)
        (E_ty: (fun x =>  subst_ty tau_ty (sigma_ty x)) == theta_ty)
        (E_vl: (fun x =>  subst_vl (tau_ty, tau_vl) (sigma_vl x)) == theta_vl)
        (s: vl) : subst_vl (tau_ty, tau_vl) (subst_vl (sigma_ty, sigma_vl) s) = subst_vl (theta_ty, theta_vl) s :=
  match s with
  | var_vl n =>  (E_vl n)
  | lam s0 s1 =>
      apc (ap lam (compTrans_subst_subst_ty _ _ _ E_ty s0)) ((match up_subst_subst_vl_vl sigma_ty sigma_vl tau_ty tau_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_subst_subst_tm _ _ _ _ _ _ E_ty E_vl s1
      end))
  | tlam s0 => ap tlam (match up_subst_subst_vl_ty sigma_ty sigma_vl tau_ty tau_vl theta_ty theta_vl E_ty E_vl with
      | conj (E_ty) (E_vl) => compTrans_subst_subst_tm _ _ _ _ _ _ E_ty E_vl s0
      end)
  end.

Definition compE_subst_subst_tm (sigma_ty: index -> ty) (sigma_vl: index -> vl) (tau_ty: index -> ty) (tau_vl: index -> vl) (s: tm)
  : subst_tm (tau_ty, tau_vl) (subst_tm (sigma_ty, sigma_vl) s) = subst_tm ((fun n => subst_ty (tau_ty) (sigma_ty n))
                                                                           , (fun n => subst_vl ((tau_ty, tau_vl)) (sigma_vl n))) s :=
  compTrans_subst_subst_tm sigma_ty sigma_vl tau_ty tau_vl (fun n => subst_ty (tau_ty) (sigma_ty n)) (fun n => subst_vl ((tau_ty
                                                                                , tau_vl)) (sigma_vl n)) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition compE_subst_subst_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) (tau_ty: index -> ty) (tau_vl: index -> vl) (s: vl)
  : subst_vl (tau_ty, tau_vl) (subst_vl (sigma_ty, sigma_vl) s) = subst_vl ((fun n => subst_ty (tau_ty) (sigma_ty n))
                                                                           , (fun n => subst_vl ((tau_ty, tau_vl)) (sigma_vl n))) s :=
  compTrans_subst_subst_vl sigma_ty sigma_vl tau_ty tau_vl (fun n => subst_ty (tau_ty) (sigma_ty n)) (fun n => subst_vl ((tau_ty
                                                                                , tau_vl)) (sigma_vl n)) (fun _ => eq_refl) (fun _ => eq_refl) s.

Definition eq_up_tm_ty {sigma tau: subst_of subst_of_tm} (E: eq_of_subst sigma tau) : eq_of_subst (up_tm_ty sigma) (up_tm_ty tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (fun i: index => match i return (var_ty 0 .: sigma_ty >>> ren_ty (castren_tm_ty (S
                                                                                , idren))) i = (var_ty 0 .: tau_ty >>> ren_ty (castren_tm_ty (S
                                                                                , idren))) i
  with 0 => eq_refl | S j => ap _ (E_ty j) end) (fun i: index => ap _ (E_vl i))).
Defined.

Definition eq_up_tm_vl {sigma tau: subst_of subst_of_tm} (E: eq_of_subst sigma tau) : eq_of_subst (up_tm_vl sigma) (up_tm_vl tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (fun i: index => ap _ (E_ty i)) (fun i: index => match i return (var_vl 0 .: sigma_vl >>> ren_vl (castren_tm_vl (idren
                                                                                , S))) i = (var_vl 0 .: tau_vl >>> ren_vl (castren_tm_vl (idren
                                                                                , S))) i
  with 0 => eq_refl | S j => ap _ (E_vl j) end)).
Defined.

Definition eq_up_vl_ty {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) : eq_of_subst (up_vl_ty sigma) (up_vl_ty tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (fun i: index => match i return (var_ty 0 .: sigma_ty >>> ren_ty (castren_vl_ty (S
                                                                                , idren))) i = (var_ty 0 .: tau_ty >>> ren_ty (castren_vl_ty (S
                                                                                , idren))) i
  with 0 => eq_refl | S j => ap _ (E_ty j) end) (fun i: index => ap _ (E_vl i))).
Defined.

Definition eq_up_vl_vl {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) : eq_of_subst (up_vl_vl sigma) (up_vl_vl tau).
  destruct sigma as (sigma_ty & sigma_vl). destruct tau as (tau_ty & tau_vl). destruct E as (E_ty & E_vl).
  exact (conj (fun i: index => ap _ (E_ty i)) (fun i: index => match i return (var_vl 0 .: sigma_vl >>> ren_vl (idren
                                                                                , S)) i = (var_vl 0 .: tau_vl >>> ren_vl (idren
                                                                                , S)) i
  with 0 => eq_refl | S j => ap _ (E_vl j) end)).
Defined.

Fixpoint subst_eq_tm {sigma tau: subst_of subst_of_tm} (E: eq_of_subst sigma tau) (s: tm) : subst_tm sigma s = subst_tm tau s :=
  match s with

  | app s0 s1 => congr_app (subst_eq_tm E s0) (subst_eq_tm E s1)
  | tapp s0 s1 => congr_tapp (subst_eq_tm E s0) (subst_eq_ty (eq_cast_tm_ty E) s1)
  | vt s0 => congr_vt (subst_eq_vl (eq_cast_tm_vl E) s0)
  end
 with subst_eq_vl {sigma tau: subst_of subst_of_vl} (E: eq_of_subst sigma tau) (s: vl) : subst_vl sigma s = subst_vl tau s :=
  match s with
  | var_vl n => eq_toVar_vl E n
  | lam s0 s1 => congr_lam (subst_eq_ty (eq_cast_vl_ty E) s0) (subst_eq_tm (eq_up_tm_vl (eq_cast_vl_tm E)) s1)
  | tlam s0 => congr_tlam (subst_eq_tm (eq_up_tm_ty (eq_cast_vl_tm E)) s0)
  end.

Class AsimplInst_tm (s: tm) (sigma: subst_of subst_of_tm) (t: tm) := asimplInstEqn_tm : (subst_tm sigma) s = t .
Hint Mode AsimplInst_tm + + - : typeclass_instance.

Class AsimplSubst_tm (sigma tau: subst_of subst_of_tm) := asimplSubstEqn_tm : match sigma, tau with
| (sigma_ty, sigma_vl), (tau_ty, tau_vl) => (forall x, sigma_ty x = tau_ty x) /\ ((forall x, sigma_vl x = tau_vl x))
end .
Hint Mode AsimplSubst_tm + - : typeclass_instance.

Class AsimplComp_tm (sigma tau theta: subst_of subst_of_tm) := asimplCompEqn_tm : match comp_tm sigma tau, theta with
| (sigma_tau_ty, sigma_tau_vl), (theta_ty, theta_vl) => (forall x, sigma_tau_ty x = theta_ty x) /\ ((forall x, sigma_tau_vl x = theta_vl x))
end .
Hint Mode AsimplComp_tm + + - : typeclass_instance.

Class AsimplInst_vl (s: vl) (sigma: subst_of subst_of_vl) (t: vl) := asimplInstEqn_vl : (subst_vl sigma) s = t .
Hint Mode AsimplInst_vl + + - : typeclass_instance.

Class AsimplSubst_vl (sigma tau: subst_of subst_of_vl) := asimplSubstEqn_vl : match sigma, tau with
| (sigma_ty, sigma_vl), (tau_ty, tau_vl) => (forall x, sigma_ty x = tau_ty x) /\ ((forall x, sigma_vl x = tau_vl x))
end .
Hint Mode AsimplSubst_vl + - : typeclass_instance.

Class AsimplComp_vl (sigma tau theta: subst_of subst_of_vl) := asimplCompEqn_vl : match comp_vl sigma tau, theta with
| (sigma_tau_ty, sigma_tau_vl), (theta_ty, theta_vl) => (forall x, sigma_tau_ty x = theta_ty x) /\ ((forall x, sigma_tau_vl x = theta_vl x))
end .
Hint Mode AsimplComp_vl + + - : typeclass_instance.

Instance AsimplCast_tm_ty (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau: subst_of subst_of_ty)
(E: AsimplSubst_ty sigma_ty tau) : AsimplSubst_ty ((cast_tm_ty (sigma_ty, sigma_vl))) tau.
Proof. apply E. Qed.
Typeclasses Opaque cast_tm_ty.
Instance AsimplCast_tm_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau: subst_of subst_of_vl)
(E: AsimplSubst_vl (sigma_ty, sigma_vl) tau) : AsimplSubst_vl ((cast_tm_vl (sigma_ty, sigma_vl))) tau.
Proof. apply E. Qed.
Typeclasses Opaque cast_tm_vl.

Instance AsimplAsimplInst_tm (s t: tm)
(sigma sigma': subst_of subst_of_tm)
(E_sigma: AsimplSubst_tm sigma sigma')
(E: AsimplInst_tm s sigma' t) : Asimpl (subst_tm sigma s) t.
Proof. rewrite <- E. apply subst_eq_tm. assumption. Qed.

Instance AsimplInstRefl_tm (s: tm) (sigma: subst_of subst_of_tm) : AsimplInst_tm s sigma (s.[ sigma ]) |100.
Proof. reflexivity. Qed.

Instance asimplInst_app (s0 s1 s0' s1': _)
(sigma theta_0 theta_1: subst_of subst_of_tm)
(E_0': AsimplSubst_tm (sigma) theta_0)
(E_1': AsimplSubst_tm (sigma) theta_1)
(E_0: AsimplInst_tm s0 theta_0 s0')
(E_1: AsimplInst_tm s1 theta_1 s1') : AsimplInst_tm (app s0 s1) sigma (app s0' s1').
Admitted.
Instance asimplInst_tapp (s0 s1 s0' s1': _)
(sigma theta_0: subst_of subst_of_tm)
(theta_1: subst_of subst_of_ty)
(E_0': AsimplSubst_tm (sigma) theta_0)
(E_1': AsimplSubst_ty (((cast_tm_ty sigma))) theta_1)
(E_0: AsimplInst_tm s0 theta_0 s0')
(E_1: AsimplInst_ty s1 theta_1 s1') : AsimplInst_tm (tapp s0 s1) sigma (tapp s0' s1').
Admitted.
Instance asimplInst_vt (s0 s0': _)
(sigma: subst_of subst_of_tm)
(theta_0: subst_of subst_of_vl)
(E_0': AsimplSubst_vl (((cast_tm_vl sigma))) theta_0)
(E_0: AsimplInst_vl s0 theta_0 s0') : AsimplInst_tm (vt s0) sigma (vt s0').
Admitted.

Instance AsimplId_tm (s: tm) : AsimplInst_tm s (var_ty, var_vl) s.
Proof. apply id_tm; reflexivity. Qed.

Instance AsimplInstInst_tm (s t: tm)
(sigma sigma' tau sigma_tau: subst_of subst_of_tm)
(E1: AsimplSubst_tm sigma sigma')
(E2: AsimplComp_tm sigma' tau sigma_tau)
(E3: AsimplInst_tm s sigma_tau t) : AsimplInst_tm (subst_tm sigma s) tau t.
Admitted.

Instance AsimplSubstRefl_tm (sigma: subst_of subst_of_tm) : AsimplSubst_tm sigma sigma | 100.
Admitted.

Instance AsimplSubstComp_tm (sigma sigma' tau tau' theta: subst_of subst_of_tm)
(E_sigma: AsimplSubst_tm sigma sigma')
(E_tau: AsimplSubst_tm tau tau')
(E: AsimplComp_tm sigma' tau' theta) : AsimplSubst_tm (comp_tm sigma tau) theta |90.
Admitted.

Instance AsimplSubstCongr_tm (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen sigma_ty tau_ty)
(E_vl: AsimplGen sigma_vl tau_vl) : AsimplSubst_tm (sigma_ty, sigma_vl) (tau_ty, tau_vl) |95.
Proof. repeat split; assumption. Qed.

Instance AsimplCompRefl_tm (sigma tau: subst_of subst_of_tm) : AsimplComp_tm sigma tau (comp_tm sigma tau) | 100.
Admitted.

Instance AsimplCompIdR_tm (sigma: index -> tm) : AsimplComp sigma (subst_tm (var_ty, var_vl)) sigma.
Proof. intros x. apply id_tm; reflexivity. Qed.

Instance AsimplCompAsso_tm (sigma tau theta tau_theta sigma_tau_theta: subst_of subst_of_tm)
(E: AsimplComp_tm tau theta tau_theta)
(E': AsimplComp_tm sigma tau_theta sigma_tau_theta) : AsimplComp_tm (comp_tm sigma tau) theta sigma_tau_theta.
Admitted.

Instance AsimplCompCongr_tm (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(theta_ty: index -> ty)
(theta_vl: index -> vl)
(tau_ty: subst_of subst_of_ty)
(tau_vl: subst_of subst_of_vl)
(tau: subst_of subst_of_tm)
(E_ty: AsimplSubst_ty ((cast_tm_ty tau)) tau_ty)
(E_vl: AsimplSubst_vl ((cast_tm_vl tau)) tau_vl)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty)
(E_vl': AsimplComp sigma_vl (subst_vl tau_vl) theta_vl) : AsimplComp_tm (sigma_ty, sigma_vl) tau (theta_ty, theta_vl).
Admitted.

Instance AsimplCompCongr'_tm (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(theta_ty: index -> ty)
(theta_vl: index -> vl)
(tau_ty: subst_of subst_of_ty)
(tau_vl: subst_of subst_of_vl)
(tau: subst_of subst_of_tm)
(E_ty: AsimplSubst_ty ((cast_tm_ty tau)) tau_ty)
(E_vl: AsimplSubst_vl ((cast_tm_vl tau)) tau_vl)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty)
(E_vl': AsimplComp sigma_vl (subst_vl tau_vl) theta_vl) : AsimplComp (subst_tm (sigma_ty, sigma_vl)) (subst_tm tau) (subst_tm (theta_ty
                                                                                , theta_vl)).
Admitted.

Instance AsimplRefl_tm (s: tm) : Asimpl s s | 100.
Proof. reflexivity. Qed.

Instance AsimplGenComp_tm (sigma sigma': index -> tm)
(tau tau': subst_of subst_of_tm)
(theta: index -> tm)
(E: AsimplGen sigma sigma')
(E': AsimplSubst_tm tau tau')
(E'': AsimplComp sigma' (subst_tm tau') theta) : AsimplGen (sigma >>> (subst_tm tau) ) theta.
Proof. intros x. rewrite <- E''. simpl. rewrite E. now apply subst_eq_tm . Qed.

Instance AsimplSubstUp_tm_ty (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen (var_ty 0 .: sigma_ty >>> (subst_ty ((cast_tm_ty ((S >>> var_ty, id >>> var_vl)))))) tau_ty)
(E_vl: AsimplGen ( sigma_vl >>> (subst_vl ((cast_tm_vl ((S >>> var_ty, id >>> var_vl)))))) tau_vl) : AsimplSubst_tm (up_tm_ty (sigma_ty
                                                                                , sigma_vl)) (tau_ty
                                                                                , tau_vl).
Admitted.

Instance AsimplSubstUp_tm_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen ( sigma_ty >>> (subst_ty ((cast_tm_ty ((id >>> var_ty, S >>> var_vl)))))) tau_ty)
(E_vl: AsimplGen (var_vl 0 .: sigma_vl >>> (subst_vl ((cast_tm_vl ((id >>> var_ty
                                                                   , S >>> var_vl)))))) tau_vl) : AsimplSubst_tm (up_tm_vl (sigma_ty
                                                                                , sigma_vl)) (tau_ty
                                                                                , tau_vl).
Admitted.

Instance AsimplCast_vl_ty (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau: subst_of subst_of_ty)
(E: AsimplSubst_ty sigma_ty tau) : AsimplSubst_ty ((cast_vl_ty (sigma_ty, sigma_vl))) tau.
Proof. apply E. Qed.
Typeclasses Opaque cast_vl_ty.

Instance AsimplToVar_vl (sigma_ty: index -> ty) (sigma_vl: index -> vl) : AsimplGen (toVar_vl (sigma_ty, sigma_vl)) sigma_vl.
Proof. intros x. reflexivity. Qed.

Instance AsimplAsimplInst_vl (s t: vl)
(sigma sigma': subst_of subst_of_vl)
(E_sigma: AsimplSubst_vl sigma sigma')
(E: AsimplInst_vl s sigma' t) : Asimpl (subst_vl sigma s) t.
Proof. rewrite <- E. apply subst_eq_vl. assumption. Qed.

Instance AsimplInstRefl_vl (s: vl) (sigma: subst_of subst_of_vl) : AsimplInst_vl s sigma (s.[ sigma ]) |100.
Proof. reflexivity. Qed.

Instance AsimplInstVar_vl (x y: index)
(sigma: subst_of subst_of_vl)
(sigma': index -> vl)
(s: vl)
(E: AsimplIndex x y)
(E': AsimplGen (toVar_vl sigma) sigma')
(E'': AsimplVarInst y sigma' s) : AsimplInst_vl (var_vl x) sigma s.
Proof. rewrite E. rewrite <- E''. apply E'.  Qed.

Instance asimplInst_lam (s0 s1 s0' s1': _)
(sigma: subst_of subst_of_vl)
(theta_0: subst_of subst_of_ty)
(theta_1: subst_of subst_of_tm)
(E_0': AsimplSubst_ty (((cast_vl_ty sigma))) theta_0)
(E_1': AsimplSubst_tm ((up_vl_vl ((cast_vl_tm sigma)))) theta_1)
(E_0: AsimplInst_ty s0 theta_0 s0')
(E_1: AsimplInst_tm s1 theta_1 s1') : AsimplInst_vl (lam s0 s1) sigma (lam s0' s1').
Admitted.
Instance asimplInst_tlam (s0 s0': _)
(sigma: subst_of subst_of_vl)
(theta_0: subst_of subst_of_tm)
(E_0': AsimplSubst_tm ((up_vl_ty ((cast_vl_tm sigma)))) theta_0)
(E_0: AsimplInst_tm s0 theta_0 s0') : AsimplInst_vl (tlam s0) sigma (tlam s0').
Admitted.

Instance AsimplId_vl (s: vl) : AsimplInst_vl s (var_ty, var_vl) s.
Proof. apply id_vl; reflexivity. Qed.

Instance AsimplInstInst_vl (s t: vl)
(sigma sigma' tau sigma_tau: subst_of subst_of_vl)
(E1: AsimplSubst_vl sigma sigma')
(E2: AsimplComp_vl sigma' tau sigma_tau)
(E3: AsimplInst_vl s sigma_tau t) : AsimplInst_vl (subst_vl sigma s) tau t.
Admitted.

Instance AsimplSubstRefl_vl (sigma: subst_of subst_of_vl) : AsimplSubst_vl sigma sigma | 100.
Admitted.

Instance AsimplSubstComp_vl (sigma sigma' tau tau' theta: subst_of subst_of_vl)
(E_sigma: AsimplSubst_vl sigma sigma')
(E_tau: AsimplSubst_vl tau tau')
(E: AsimplComp_vl sigma' tau' theta) : AsimplSubst_vl (comp_vl sigma tau) theta |90.
Admitted.

Instance AsimplSubstCongr_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen sigma_ty tau_ty)
(E_vl: AsimplGen sigma_vl tau_vl) : AsimplSubst_vl (sigma_ty, sigma_vl) (tau_ty, tau_vl) |95.
Proof. repeat split; assumption. Qed.

Instance AsimplCompRefl_vl (sigma tau: subst_of subst_of_vl) : AsimplComp_vl sigma tau (comp_vl sigma tau) | 100.
Admitted.

Instance AsimplCompIdL_vl (sigma: subst_of subst_of_vl)
(tau: index -> vl)
(E: AsimplGen (toVar_vl sigma) tau) : AsimplComp var_vl (subst_vl sigma) tau.
Admitted.

Instance AsimplCompIdR_vl (sigma: index -> vl) : AsimplComp sigma (subst_vl (var_ty, var_vl)) sigma.
Proof. intros x. apply id_vl; reflexivity. Qed.

Instance AsimplCompAsso_vl (sigma tau theta tau_theta sigma_tau_theta: subst_of subst_of_vl)
(E: AsimplComp_vl tau theta tau_theta)
(E': AsimplComp_vl sigma tau_theta sigma_tau_theta) : AsimplComp_vl (comp_vl sigma tau) theta sigma_tau_theta.
Admitted.

Instance AsimplCompCongr_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(theta_ty: index -> ty)
(theta_vl: index -> vl)
(tau_ty: subst_of subst_of_ty)
(tau_vl tau: subst_of subst_of_vl)
(E_ty: AsimplSubst_ty ((cast_vl_ty tau)) tau_ty)
(E_vl: AsimplSubst_vl (tau) tau_vl)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty)
(E_vl': AsimplComp sigma_vl (subst_vl tau_vl) theta_vl) : AsimplComp_vl (sigma_ty, sigma_vl) tau (theta_ty, theta_vl).
Admitted.

Instance AsimplCompCongr'_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(theta_ty: index -> ty)
(theta_vl: index -> vl)
(tau_ty: subst_of subst_of_ty)
(tau_vl tau: subst_of subst_of_vl)
(E_ty: AsimplSubst_ty ((cast_vl_ty tau)) tau_ty)
(E_vl: AsimplSubst_vl (tau) tau_vl)
(E_ty': AsimplComp sigma_ty (subst_ty tau_ty) theta_ty)
(E_vl': AsimplComp sigma_vl (subst_vl tau_vl) theta_vl) : AsimplComp (subst_vl (sigma_ty, sigma_vl)) (subst_vl tau) (subst_vl (theta_ty
                                                                                , theta_vl)).
Admitted.

Instance AsimplRefl_vl (s: vl) : Asimpl s s | 100.
Proof. reflexivity. Qed.

Instance AsimplGenComp_vl (sigma sigma': index -> vl)
(tau tau': subst_of subst_of_vl)
(theta: index -> vl)
(E: AsimplGen sigma sigma')
(E': AsimplSubst_vl tau tau')
(E'': AsimplComp sigma' (subst_vl tau') theta) : AsimplGen (sigma >>> (subst_vl tau) ) theta.
Proof. intros x. rewrite <- E''. simpl. rewrite E. now apply subst_eq_vl . Qed.

Instance AsimplSubstUp_vl_ty (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen (var_ty 0 .: sigma_ty >>> (subst_ty ((cast_vl_ty ((S >>> var_ty, id >>> var_vl)))))) tau_ty)
(E_vl: AsimplGen ( sigma_vl >>> (subst_vl (((S >>> var_ty, id >>> var_vl))))) tau_vl) : AsimplSubst_vl (up_vl_ty (sigma_ty
                                                                                , sigma_vl)) (tau_ty
                                                                                , tau_vl).
Admitted.

Instance AsimplSubstUp_vl_vl (sigma_ty: index -> ty)
(sigma_vl: index -> vl)
(tau_ty: index -> ty)
(tau_vl: index -> vl)
(E_ty: AsimplGen ( sigma_ty >>> (subst_ty ((cast_vl_ty ((id >>> var_ty, S >>> var_vl)))))) tau_ty)
(E_vl: AsimplGen (var_vl 0 .: sigma_vl >>> (subst_vl (((id >>> var_ty, S >>> var_vl))))) tau_vl) : AsimplSubst_vl (up_vl_vl (sigma_ty
                                                                                , sigma_vl)) (tau_ty
                                                                                , tau_vl).
Admitted.

Typeclasses Opaque toVar_vl.


Require Import List.
Require Import ListSet.
Require Import Coqlib.
Require Import Metatheory.
Require Import Maps.
Require Import Lattice.
Require Import Kildall.
Require Import Iteration.
Require Import cfg.
Require Import reach.
Require Import Dipaths.

Require Import syntax.
Require Import infrastructure.
Require Import infrastructure_props.
Import LLVMsyntax.
Import LLVMinfra.

(* This file proves more properties of declarative dominations. *)
Module DecDom.

Local Open Scope dom.

Ltac unfold_cfg f :=
  unfold imm_domination, reachable, strict_domination, domination;
  intros;
  match goal with
  | Hentry: getEntryLabel f = Some ?entry |- _ =>
      apply getEntryLabel__getEntryBlock in Hentry;
      destruct Hentry as [[] [Hentry EQ]]; simpl in EQ; subst entry;
      rewrite Hentry in *
  | |- _ =>
      remember (getEntryBlock f) as R;
      destruct R as [[]|]; try congruence
  end.

Lemma sdom_isnt_refl: forall f l1 l2 (Hreach: f ~>* l2)
  (Hdom12 : strict_domination f l1 l2),
  l1 <> l2.
Proof.
  unfold_cfg f.
  eapply ACfg.sdom_isnt_refl; eauto.
Qed.

Lemma dom_tran: forall (f:fdef) (l1 l2 l3:l),
  f |= l1 >>= l2 -> f |= l2 >>= l3 -> f |= l1 >>= l3.
Proof.
  unfold_cfg f.
  eapply ACfg.dom_tran; eauto.
Qed.

Lemma everything_dominates_unreachable_blocks :
  forall f l1 l2 (Hreach: ~ f ~>* l2)
  (Hentry: getEntryBlock f <> None),
  f |= l1 >>= l2.
Proof.
  unfold_cfg f.
  eapply ACfg.everything_dominates_unreachable_blocks; eauto.
Qed.

Lemma everything_sdominates_unreachable_blocks :
  forall f l1 l2 (Hreach: ~ f ~>* l2)
  (Hentry: getEntryBlock f <> None),
  f |= l1 >> l2.
Proof.
  unfold_cfg f.
  eapply ACfg.everything_sdominates_unreachable_blocks; eauto.
Qed.

Lemma sdom_reachable : forall f l1 l2,
  f ~>* l2 -> f |= l1 >> l2 -> f ~>* l1.
Proof.
  unfold_cfg f.
  eapply ACfg.sdom_reachable; eauto.
Qed.

Lemma dom_reachable : forall f l1 l2,
  f ~>* l2 -> f |= l1 >>= l2 -> f ~>* l1.
Proof.
  unfold_cfg f.
  eapply ACfg.dom_reachable; eauto.
Qed.

Lemma sdom_dom: forall f l1 l2,
  f |= l1 >> l2 -> f |= l1 >>= l2.
Proof.
  unfold_cfg f.
  eapply ACfg.sdom_dom; eauto.
Qed.

Lemma dom_sdom: forall f l1 l2,
  f |= l1 >>= l2 -> l1 <> l2 -> f |= l1 >> l2.
Proof.
  unfold_cfg f.
  eapply ACfg.dom_sdom; eauto.
Qed.

Lemma domination_has_entry: forall f l1 l2 (Hdom: f |= l1 >>= l2),
  getEntryBlock f <> None.
Proof.
  intros.
  unfold domination in Hdom.
  intro EQ. rewrite EQ in Hdom. auto.
Qed.

Lemma strict_domination__getEntryLabel: forall f l1 l2
  (Hsdom: f |= l1 >> l2),
  exists e, getEntryLabel f = Some e.
Proof.
  unfold strict_domination.
  intros.
  inv_mbind. symmetry in HeqR.
  apply getEntryBlock__getEntryLabel in HeqR. eauto.
Qed.

Section dom_acyclic_tran.

Variable f:fdef.

Hypothesis getEntryBlock_inv : forall
  (l3 : l)
  (l' : l)
  (ps : phinodes)
  (cs : cmds)
  (tmn : terminator)
  (HBinF : blockInFdefB (l3, stmts_intro ps cs tmn) f = true)
  (Hsucc : In l' (successors_terminator tmn)) a s0
  (H : getEntryBlock f = Some (a, s0)),
  l' <> a.

Lemma entry_has_no_preds: forall (l5 : l) s5
  (HeqR : Some (l5, s5) = getEntryBlock f)
  (a0 : ATree.elt) (Hin: In l5 ((successors f) !!! a0)),
  False.
Proof.
  intros.
  eapply successors__blockInFdefB in Hin; eauto.
  destruct Hin as [ps0 [cs0 [tmn0 [HBinF' Hinsucc]]]].
  symmetry in HeqR. destruct f.
  eapply getEntryBlock_inv in Hinsucc; eauto.
Qed.

Lemma dom_acyclic: forall (l1 l2:l)
  (H: f ~>* l2) (H0: f |= l1 >> l2),
  ~ f |= l2 >>= l1.
Proof.
  unfold_cfg f.
  eapply ACfg.dom_acyclic; eauto using entry_has_no_preds.
Qed.

Lemma sdom_tran1: forall (l1 l2 l3:l),
  f |= l1 >> l2 -> f |= l2 >>= l3 -> f |= l1 >> l3.
Proof.
  unfold_cfg f.
  eapply ACfg.sdom_tran1; eauto using entry_has_no_preds.
Qed.

Lemma sdom_tran2: forall (l1 l2 l3:l),
  f |= l1 >>= l2 -> f |= l2 >> l3 -> f |= l1 >> l3.
Proof.
  unfold_cfg f.
  eapply ACfg.sdom_tran2; eauto using entry_has_no_preds.
Qed.

Lemma sdom_tran: forall (l1 l2 l3:l),
  f |= l1 >> l2 -> f |= l2 >> l3 -> f |= l1 >> l3.
Proof.
  intros. apply sdom_dom in H0. eapply sdom_tran1; eauto.
Qed.

Lemma idom_isnt_refl: forall l1 l2 (Hreach: f ~>* l2)
  (Hdom12 : f |= l1 >>> l2),
  l1 <> l2.
Proof.
  unfold_cfg f.
  eapply ACfg.idom_isnt_refl; eauto.
Qed.

Lemma idom_sdom: forall l1 l2 (Hdom12 : f |= l1 >>> l2),
  f |= l1 >> l2.
Proof.
  intros. destruct Hdom12. auto.
Qed.

Lemma idom_injective: forall p l1 l2
  (Hidom1 : f |= p >>> l1) (Hidom2 : f |= p >>> l2)
  (Hrd1 : f ~>* l1) (Hrd2 : f ~>* l2)
  (Hneq : l1 <> l2)
  (Hdec : f |= l1 >> l2 \/ f |= l2 >> l1),
  False.
Proof.
  unfold_cfg f.
  eapply ACfg.idom_injective in Hdec; eauto using entry_has_no_preds.
Qed.

End dom_acyclic_tran.

Lemma sdom_dec : forall f l1 l2,
  f |= l1 >> l2 \/ ~ f |= l1 >> l2.
Proof.
  unfold_cfg f; auto.
  apply ACfg.sdom_dec; auto.
Qed.

Lemma non_sdom__inv: forall f l1 l2 be (Hentry: getEntryBlock f = Some be)
  (Hnsdom: ~ f |= l1 >> l2),
  exists vl, exists al, D_walk (vertexes_fdef f) (arcs_fdef f)
    (index l2) (index (getBlockLabel be)) vl al /\
    ~ (In (index l1) vl /\ l1 <> l2).
Proof.
  unfold_cfg f; auto.
  inv Hentry.
  eapply ACfg.non_sdom__inv; eauto.
Qed.

Lemma sdom_ordered : forall f l1 l2 l3
  (Hneq: l1 <> l2) (Hreach: f ~>* l3)
  (Hsdom: f |= l1 >> l3)
  (Hsdom': f |= l2 >> l3),
  f |= l1 >> l2 \/ f |= l2 >> l1.
Proof.
  unfold_cfg f; auto.
  eapply ACfg.sdom_ordered; eauto.
Qed.

Lemma entry_doms_others: forall f entry l1  (Hnentry: l1 <> entry)
  (H: getEntryLabel f = Some entry),
  f |= entry >> l1.
Proof.
  unfold_cfg f; auto.
  eapply ACfg.entry_doms_others; eauto.
Qed.

Close Scope dom.

End DecDom.


From Rupicola Require Import Lib.Core Lib.Notations Lib.Tactics.

Module ExprReflection.
  Section with_parameters.
    Context {width: Z} {BW: Bitwidth width} {word: word.word width} {memT: map.map word Byte.byte}.
    Context {localsT: map.map String.string word}.
    Context {env: map.map String.string (list String.string * list String.string * Syntax.cmd)}.
    Context {ext_spec: bedrock2.Semantics.ExtSpec}.
    Context {word_ok : word.ok word} {mem_ok : map.ok memT}.
    Context {locals_ok : map.ok localsT}.
    Context {env_ok : map.ok env}.
    Context {ext_spec_ok : Semantics.ext_spec.ok ext_spec}.

    Section Core.
      Class expr_denotation T :=
        { er_T2w: T -> word;
          er_default: T;
          er_op: Type;
          er_opfun: er_op -> T -> T -> T;
          er_opname: er_op -> bopname.bopname;
          er_opfun_morphism: forall op (x y: T),
              er_T2w ((er_opfun op) x y) =
              Semantics.interp_binop (er_opname op) (er_T2w x) (er_T2w y) }.

      Context {T} {er: expr_denotation T}.

      Inductive AST :=
      | ELit (z: Z) (t: T) (ok: word.of_Z z = er_T2w t)
      | EVar (nm: string)
      | EOp (op: er_op) (l r: AST).

      Context (locals: localsT)
              (concrete_locals: map.rep (map := SortedListString.map T)).

      Fixpoint interp ast :=
        match ast with
        | ELit z t _ => t
        | EVar nm => match map.get concrete_locals nm with
                    | Some v => v
                    | None => er_default
                    end
        | EOp op l r => (er_opfun op) (interp l) (interp r)
        end.

      Fixpoint compile ast :=
        match ast with
        | ELit z t _ => expr.literal z
        | EVar nm => expr.var nm
        | EOp op l r => expr.op (er_opname op) (compile l) (compile r)
        end.

      Definition is_some {A} (o: option A) :=
        if o then true else false.

      Fixpoint witness ast :=
        match ast with
        | ELit z t _ => True
        | EVar nm => map.get concrete_locals nm <> None
        | EOp op l r => witness r /\ witness l
        end.

      Fixpoint witnessb ast acc :=
        match ast with          (* FIXME use naive word representation for equality checks *)
        | ELit z t _ => acc
        | EVar nm => is_some (map.get concrete_locals nm) && acc
        | EOp op l r => witnessb r (witnessb l acc)
        end%bool.

      Lemma witnessb_decreasing ast :
        witnessb ast false = false.
      Proof.
        induction ast; cbn; intros; rewrite ?Bool.andb_false_r;
          congruence.
      Qed.

      Lemma witnessb_sound ast :
        witnessb ast true = true ->
        witness ast.
      Proof.
        induction ast; cbn; intros H; rewrite ?Bool.andb_true_r in H.
        - eauto.
        - destruct lookup; cbn in *; congruence.
        - destruct (witnessb ast1 true); [ solve [eauto] | ].
          rewrite witnessb_decreasing in H; discriminate.
      Qed.

      Lemma interp_sound' ast:
        forall (P: word -> Prop) mem,
          witness ast ->
          P (er_T2w (interp ast)) ->
          map.mapped_compat er_T2w concrete_locals locals ->
          WeakestPrecondition.expr mem locals (compile ast) P.
      Proof.
        induction ast; cbn -[map.get]; intros P mem Hw HP Heq.
        - destruct ok; red; unfold dlet; congruence.
        - specialize (Heq nm); destruct map.get.
          + red; eauto.
          + exfalso; apply Hw; reflexivity.
        - apply IHast1; intuition.
          apply IHast2; intuition.
          rewrite <- er_opfun_morphism.
          congruence.
      Qed.

      Lemma interp_sound ast mem:
        witnessb ast true = true ->
        map.mapped_compat er_T2w concrete_locals locals ->
        WeakestPrecondition.dexpr mem locals (compile ast) (er_T2w (interp ast)).
      Proof.
        intros; apply interp_sound'; eauto using witnessb_sound.
      Qed.

      Lemma interp_complete ast:
        forall (P: word -> Prop) mem,
          witness ast ->
          map.mapped_compat er_T2w concrete_locals locals ->
          WeakestPrecondition.expr mem locals (compile ast) P ->
          P (er_T2w (interp ast)).
      Proof.
        induction ast; cbn -[map.get]; intros P mem H Heq HP; red in HP.
        - destruct ok; unfold dlet in HP; congruence.
        - destruct HP as (x & Heq' & HP).
          destruct map.get eqn:?.
          + erewrite Heq in Heq' by eassumption.
            inversion Heq'; subst; eassumption.
          + exfalso. eapply H; reflexivity.
        - destruct H.
          rewrite er_opfun_morphism.
          eapply IHast2; intuition.
          eapply IHast1; intuition.
          eassumption.
      Qed.
    End Core.

    Instance expr_word_denotation : expr_denotation word :=
      {| er_T2w w := w;
         er_default := word.of_Z 0;
         er_op := bopname.bopname;
         er_opname op := op;
         er_opfun op :=
           match op with
           | bopname.add => word.add
           | bopname.sub => word.sub
           | bopname.mul => word.mul
           | bopname.mulhuu => word.mulhuu
           | bopname.divu => word.divu
           | bopname.remu => word.modu
           | bopname.and => word.and
           | bopname.or => word.or
           | bopname.xor => word.xor
           | bopname.sru => word.sru
           | bopname.slu => word.slu
           | bopname.srs => word.srs
           | bopname.lts => fun x y => word.b2w (word.lts x y)
           | bopname.ltu => fun x y => word.b2w (word.ltu x y)
           | bopname.eq => fun x y => word.b2w (word.eqb x y)
           end;
         er_opfun_morphism :=
           ltac:(destruct op; intros; cbn;
                repeat lazymatch goal with
                       | [  |- context[if ?x then _ else _] ] => destruct x
                       | _ => reflexivity
                       end) |}.

    Inductive ReifiedZOpp := RZ_add | RZ_sub | RZ_mul | RZ_land | RZ_lor | RZ_lxor.

    Instance expr_Z_denotation : expr_denotation Z :=
      {| er_T2w z := word.of_Z z;
         er_default := 0%Z;
         er_op := ReifiedZOpp;
         er_opname zop :=
           match zop with
           | RZ_add => bopname.add
           | RZ_sub => bopname.sub
           | RZ_mul => bopname.mul
           | RZ_land => bopname.and
           | RZ_lor => bopname.or
           | RZ_lxor => bopname.xor
           end;
         er_opfun zop :=
           match zop with
           | RZ_add => Z.add
           | RZ_sub => Z.sub
           | RZ_mul => Z.mul
           | RZ_land => Z.land
           | RZ_lor => Z.lor
           | RZ_lxor => Z.lxor
           end;
         er_opfun_morphism :=
           ltac:(destruct op; intros; cbn;
                eauto using word.morph_and, word.morph_or, word.morph_xor,
                word.ring_morph_add, word.ring_morph_mul, word.ring_morph_sub;
                reflexivity) |}.

    Lemma compile_expr {A} (to_W: A -> word)
          [tr mem locals functions] (a: A) (e: expr) :
      let v := a in
      forall {P} {pred: P v -> predicate}
        {k: nlet_eq_k P v} {k_impl}
        var,

        WeakestPrecondition.dexpr mem locals e (to_W v) ->

        (let v := v in
         <{ Trace := tr;
            Memory := mem;
            Locals := map.put locals var (to_W v);
            Functions := functions }>
         k_impl
         <{ pred (k v eq_refl) }>) ->

        <{ Trace := tr;
           Memory := mem;
           Locals := locals;
           Functions := functions }>
        cmd.seq (cmd.set var e) k_impl
        <{ pred (nlet_eq [var] v k) }>.
    Proof. repeat straightline; eauto. Qed.

    Definition compile_expr_w := compile_expr (fun w => w).
    Definition compile_expr_bool := compile_expr (fun b => word.b2w b).
    Definition compile_expr_byte := compile_expr (fun b => word_of_byte b).
    Definition compile_expr_nat := compile_expr (fun n => word.of_Z (Z.of_nat n)).
    Definition compile_expr_Z := compile_expr (fun z => word.of_Z z).
  End with_parameters.

  Ltac find_key_by_value bs v0 :=
    lazymatch bs with
    | [] => constr:(@None string)
    | (?k, ?v) :: ?bs =>
      lazymatch v with
      | v0 => constr:(Some k)
      | _ => find_key_by_value bs v0
      end
    end.

  Ltac expr_reify_word W bindings w :=
    let expr_reify_op nm l r :=
        let l := expr_reify_word W bindings l in
        let r := expr_reify_word W bindings r in
        constr:(EOp (word:=W) (er := expr_word_denotation) nm l r) in
    lazymatch w with (* FIXME add reification support for gt, ge, le, neg; also for Byte constants *)
    | word.add ?l ?r    => expr_reify_op bopname.add l r
    | word.sub ?l ?r    => expr_reify_op bopname.sub l r
    | word.mul ?l ?r    => expr_reify_op bopname.mul l r
    | word.mulhuu ?l ?r => expr_reify_op bopname.mulhuu l r
    | word.divu ?l ?r   => expr_reify_op bopname.divu l r
    | word.modu ?l ?r   => expr_reify_op bopname.remu l r
    | word.and ?l ?r    => expr_reify_op bopname.and l r
    | word.or ?l ?r     => expr_reify_op bopname.or l r
    | word.xor ?l ?r    => expr_reify_op bopname.xor l r
    | word.sru ?l ?r    => expr_reify_op bopname.sru l r
    | word.slu ?l ?r    => expr_reify_op bopname.slu l r
    | word.srs ?l ?r    => expr_reify_op bopname.srs l r
    | word.b2w (word.lts ?l ?r) => expr_reify_op bopname.lts l r
    | word.b2w (word.ltu ?l ?r) => expr_reify_op bopname.ltu l r
    | word.b2w (word.eqb ?l ?r) => expr_reify_op bopname.eq l r
    | _ =>
      lazymatch find_key_by_value bindings w with
      | Some ?k => constr:(EVar (word:=W) (er := expr_word_denotation) k)
      | None =>
        lazymatch w with
        | word.of_Z ?z =>
          constr:(ELit (word:=W) (er := expr_word_denotation)
                       z (word.of_Z z) eq_refl)
        | _ =>
          constr:(ELit (word:=W) (er := expr_word_denotation)
                       (word.unsigned w) w (word.of_Z_unsigned w))
        end
      end
    end.

  Ltac expr_reify_Z bindings z :=
    let expr_reify_op nm l r :=
        let l := expr_reify_Z bindings l in
        let r := expr_reify_Z bindings r in
        constr:(EOp (er := expr_Z_denotation) nm l r) in
    lazymatch z with
    | Z.add ?l ?r  => expr_reify_op RZ_add l r
    | Z.sub ?l ?r  => expr_reify_op RZ_sub l r
    | Z.mul ?l ?r  => expr_reify_op RZ_mul l r
    | Z.land ?l ?r => expr_reify_op RZ_land l r
    | Z.lor ?l ?r  => expr_reify_op RZ_lor l r
    | Z.lxor ?l ?r => expr_reify_op RZ_lxor l r
    | _ =>
      lazymatch find_key_by_value bindings z with
      | Some ?k => constr:(EVar (er := expr_Z_denotation) k)
      | None => constr:(ELit (er := expr_Z_denotation) z z eq_refl)
      end
    end.

  (* Swapping out the whole goal with `change` is more robust than swapping out
     just `val` with `change val with …` (the latter sometimes fails to find
     `val` in the goal). *)

  Ltac change_goal_change term :=
    change term.

  Ltac change_goal_replace term :=
    lazymatch goal with
    | [  |- ?g ] =>
      (* FIXME why is `by (vm_cast_no_check (@eq_refl Prop g))` slower? *)
      replace g with term by reflexivity
    end.

  Lemma change_goal {P Q: Prop} : Q = P -> P -> Q.
  Proof. intros -> ?; assumption. Qed.

  Ltac change_goal_refine term :=
    lazymatch goal with (* FIXME why is `@eq_refl Prop g <: g = term` slower? *)
    | [  |- ?g ] => simple refine (change_goal (@eq_refl Prop g : g = term) _)
    end.

  Ltac change_goal term :=
    (* `refine` is faster than `replace`, which is faster than `change` *)
    change_goal_refine term.

  Tactic Notation "_reify_change_dexpr"
         constr(mem) constr(locals) constr(expr)
         open_constr(reifier) constr(reified) constr(bindings) :=
    unify expr (compile reified);
    change_goal (WeakestPrecondition.dexpr
                   mem locals (compile reified)
                   (er_T2w (expr_denotation := reifier)
                           (interp (er := reifier)
                                   (map.of_list (map := SortedListString.map _) bindings)
                                   reified))).

  Ltac reify_change_dexpr_w :=
    lazymatch goal with
    | [  |- WeakestPrecondition.dexpr ?mem ?locals ?expr ?val ] =>
      lazymatch locals with
      | map.of_list ?bindings =>
        lazymatch type of val with
        | @word.rep _ ?W =>
          let reified := expr_reify_word W bindings val in
          _reify_change_dexpr mem locals expr expr_word_denotation reified bindings
        end
      | _ => fail 0 locals "is not a list of bindings"
      end
    | [  |- ?g ] => fail 0 g "is not a dexpr goal"
    end.

  Ltac zify_bindings bs :=
    lazymatch bs with
    | [] => constr:(@List.nil (string * Z))
    | (?k, ?w) :: ?tl =>
      let z := lazymatch w with
              | @word.of_Z _ _ ?z => constr:(z)
              | _                 => constr:(word.unsigned w)
              end in
      let tl := zify_bindings tl in
      constr:((k, z) :: tl)
    end.

  Ltac reify_change_dexpr_z :=
    lazymatch goal with
    | [  |- WeakestPrecondition.dexpr ?mem ?locals ?expr ?val ] =>
      lazymatch locals with
      | map.of_list ?bindings =>
        lazymatch val with
        | word.of_Z ?z =>
          let z_bindings := zify_bindings bindings in
          let z_bindings := type_term z_bindings in
          let reified := expr_reify_Z z_bindings z in
          _reify_change_dexpr mem locals expr expr_Z_denotation reified z_bindings
        end
      | _ => fail 0 locals "is not a list of bindings"
      end
    | [  |- ?g ] => fail 0 g "is not a dexpr goal"
    end.

  Ltac reify_change_dexpr_locals :=
    lazymatch goal with
    | [  |- WeakestPrecondition.dexpr _ ?locals _ _ ] =>
      let bindings := map_to_list locals in
      set_change locals with (map.of_list bindings)
    | [  |- ?g ] => fail 0 g "is not a dexpr goal"
    end.

  Ltac reify_change_dexpr :=
    lazymatch goal with
    | [  |- WeakestPrecondition.dexpr _ _ _ ?val ] =>
      reify_change_dexpr_locals;
      lazymatch val with
      | word.of_Z ?z => reify_change_dexpr_z
      | _ => reify_change_dexpr_w
      end
    | [  |- ?g ] => fail 0 g "is not a dexpr goal"
    end.

  Ltac compile_prove_reified_dexpr :=
    eapply interp_sound;
    [ reflexivity |
      eapply map.mapped_compat_of_list;
      lazymatch goal with
      | |- context[expr_Z_denotation] => (* LATER Use reification to speed up this rewrite *)
        cbv [List.map fst snd er_T2w expr_Z_denotation]; rewrite ?word.of_Z_unsigned
      | _ => idtac
      end; reflexivity
      | .. ].

  Ltac compile_let_as_expr :=
    lazymatch goal with
    | [ |- WP_nlet_eq ?v ] =>
      lazymatch type of v with
      | word.rep       => simple apply compile_expr_w
      | bool              => simple apply compile_expr_bool
      | Init.Byte.byte => simple apply compile_expr_byte
      | nat              => simple apply compile_expr_nat
      | Z              => simple apply compile_expr_Z
      | ?t             => fail "Unrecognized type" t
      end; cbv beta in *
    | [  |- ?g ] => fail 0 g "is not a Rupicola goal"
    end.
End ExprReflection.

Ltac compile_expr :=
  (* LATER: Consider clearing local hypotheses here, since large contexts make
     `apply` slow (but careful not to remove [map.ok]). *)
  ExprReflection.reify_change_dexpr;
  ExprReflection.compile_prove_reified_dexpr.

Ltac compile_assignment :=
  ExprReflection.compile_let_as_expr;
  [ ExprReflection.compile_expr | .. ].

(* For dexpr side conditions: *)
#[export] Hint Extern 8 (WeakestPrecondition.dexpr _ _ _ _) =>
  compile_expr : compiler_side_conditions.

(* For let-bound exprs: *)
#[export] Hint Extern 8 =>
  compile_assignment; shelve : compiler.
  (* Higher priority than compilation lemmas for individual operations *)

Section Tests.
  Context {width: Z} {BW: Bitwidth width} {word: word.word width}.
  Context {mem: map.map word Byte.byte} {locals: map.map String.string word}.
  Context {word_ok : word.ok word} {mem_ok : map.ok mem}.
  Context {locals_ok : map.ok locals}.

  Context (m: mem).

  #[local] Notation dexpr m e x :=
    (WeakestPrecondition.dexpr (mem := mem) (locals := locals) map.empty m e x).

  Local Goal {e | forall z,
          dexpr #{ "z" => word.of_Z z }# e
                (word.of_Z (Z.land 3 z)) }.
  Proof. eexists; intros; compile_expr. Qed.

  Local Goal {e | forall w,
          dexpr #{ "w" => w }# e
                (word.and (word.of_Z 3) w) }.
  Proof. eexists; intros; compile_expr. Qed.

  Local Goal {e | forall b,
          dexpr #{ "b" => word_of_byte b }# e
                (word_of_byte (byte.and Byte.x03 b)) }.
  Proof. Fail eexists; intros; compile_expr. Abort. (* TODO *)

  Local Goal {e | forall b,
          dexpr #{ "b" => word.b2w b }# e
                (word.b2w (andb b false)) }.
  Proof. Fail eexists; intros; compile_expr. Abort. (* TODO *)

  Local Goal {e | forall x b,
          dexpr #{ "x" => word.of_Z x; "b" => word_of_byte b }# e
                (word.add (word.of_Z (Z.add x x))
                          (word_of_byte (byte.and b b))) }.
  Proof. Fail eexists; intros; compile_expr. Abort. (* TODO *)
End Tests.