LSS.thy

theory LSS
  imports Main
begin

type_synonym Var = nat
type_synonym Def = nat
type_synonym MuVar = nat

(* Source language type *)
datatype ST =
STFun ST ST |
STProd "ST list" |
STSum "ST list" |
STMu MuVar ST |
STVar MuVar

(* Source language expression *)
datatype SE =
SETup "SE list" |
SEProj nat SE |
SEInj "ST list" nat SE |
SEFold MuVar ST SE |
SEUnfold SE |
SELet Var SE SE |
SEMatch ST SE "(Var * SE) list" |
SELam Var ST SE Var ST SE ST |
SEApp SE SE |
SEVar Var |
SEDef Def |
(* In a small departure from the formalism presented in the paper, we forbid polymorphic recursion
   by construction by requiring that definitions always refer to themselves via the "SESelf"
   construct, which stands in for an "SEDef" referring to the current definition. Distinguishing
   references to the current definition from references to other definitions slightly simplifies
   proofs of the correctness of type inference. *)
SESelf Def ST

(* Source language program *)
datatype SP =
SPEntry Def |
SPDef Def ST SE SP

(* Source language typing context for variables *)
type_synonym STCV = "Var \<Rightarrow> ST option"
(* Source language typing context for definitions *)
type_synonym STCD = "Def \<Rightarrow> ST option"
(* Source language "self" context -- contains typing information about the current definition *)
datatype STCS = STCS (stcs_defs: STCD) (stcs_self_d: Def) (stcs_self_t: ST)

(* Substitution for source type level mu variables *)
fun st_subst :: "(MuVar \<Rightarrow> ST) \<Rightarrow> ST \<Rightarrow> ST" where
"st_subst m (STFun t1 t2) = STFun (st_subst m t1) (st_subst m t2)" |
"st_subst m (STProd ts) = STProd (map (st_subst m) ts)" |
"st_subst m (STSum ts) = STSum (map (st_subst m) ts)" |
"st_subst m (STMu u t) = STMu u (st_subst (m(u := STVar u)) t)" |
"st_subst m (STVar u) = m u"

(* Typing judgement for source expressions *)
function tj_se :: "STCS \<Rightarrow> STCV \<Rightarrow> SE \<Rightarrow> ST \<Rightarrow> bool" where
tj_se_tup: "tj_se sc gc (SETup es) t0 = (\<exists> ts.
  length es = length ts \<and>
  (\<forall> (e_el, t_el) \<in> set (zip es ts). tj_se sc gc e_el t_el) \<and>
  t0 = STProd ts
)" |
tj_se_proj: "tj_se sc gc (SEProj i e) t0 = (\<exists> ts.
  i < length ts \<and>
  tj_se sc gc e (STProd ts) \<and>
  t0 = ts ! i
)" |
tj_se_inj: "tj_se sc gc (SEInj ts i e) t0 = (
  i < length ts \<and>
  tj_se sc gc e (ts ! i) \<and>
  t0 = STSum ts
)" |
tj_se_fold: "tj_se sc gc (SEFold u t e) t0 = (
  tj_se sc gc e (st_subst (STVar(u := STMu u t)) t) \<and>
  t0 = STMu u t
)" |
tj_se_unfold: "tj_se sc gc (SEUnfold e) t0 = (\<exists> u t.
  tj_se sc gc e (STMu u t) \<and>
  t0 = (st_subst (STVar(u := STMu u t)) t)
)" |
tj_se_let: "tj_se sc gc (SELet x e1 e2) t0 = (\<exists> t.
  gc x = None \<and>
  tj_se sc gc e1 t \<and>
  tj_se sc (gc(x := Some t)) e2 t0
)" |
tj_se_match: "tj_se sc gc (SEMatch t_ret e_dis cases) t0 = (\<exists> ts.
  length ts = length cases \<and>
  tj_se sc gc e_dis (STSum ts) \<and>
  (\<forall> (t_case, (x_case, e_case)) \<in> set (zip ts cases).
    gc x_case = None \<and>
    tj_se sc (gc(x_case := Some t_case)) e_case t_ret
  ) \<and>
  t0 = t_ret
)" |
tj_se_lam: "tj_se sc gc (SELam x t1 e1 y t2 e2 t3) t0 = (
  tj_se sc gc e1 t1 \<and>
  tj_se sc (Map.empty(x := Some t1, y := Some t2)) e2 t3 \<and>
  t0 = STFun t2 t3
)" |
tj_se_app: "tj_se sc gc (SEApp e1 e2) t0 = (\<exists> t_arg.
  tj_se sc gc e1 (STFun t_arg t0) \<and>
  tj_se sc gc e2 t_arg
)" |
tj_se_var: "tj_se sc gc (SEVar x) t0 = (gc x = Some t0)" |
tj_se_def: "tj_se sc gc (SEDef d) t0 = (stcs_defs sc d = Some t0)" |
tj_se_self: "tj_se sc gc (SESelf d t) t0 = (stcs_self_d sc = d \<and> stcs_self_t sc = t \<and> t0 = t)"
  by(pat_completeness) auto
termination apply(relation "measure (\<lambda> (_, _, e, _). SE.size_SE e)", auto)
   apply (meson le_imp_less_Suc order_refl set_zip_leftD size_list_estimation')
proof -
  fix e_dis cases ts t_case x_case e_case
  assume in_list: "(t_case :: ST, x_case :: Var, e_case :: SE) \<in> set (zip ts cases)"
  then have "(x_case, e_case) \<in> set cases"
    by (meson in_set_zipE)
  then have "size_list (size_prod (\<lambda>_. 0) size_SE) cases \<ge> size_SE e_case"
  proof(induct cases arbitrary: x_case e_case)
    case Nil
    then show ?case by auto
  next
    case (Cons case_hd case_tl)
    then show ?case apply(case_tac "e_case = snd case_hd")
      apply (simp add: size_prod_simp)
      by fastforce
  qed
  then show "size_SE e_case
       < Suc (size_list (size_prod (\<lambda>x. 0) size_SE) cases +
              size_SE e_dis)"
    by auto
qed

(* Lambda set variable *)
type_synonym LSVar = nat

(* Annotated language lambda set *)
datatype ALS =
ALSVar LSVar |
ALSSet "(Var * AT * Var * AT * AE * AT) list" |
ALSMuVar MuVar |
ALSMu MuVar ALS
(* Annotated language type *)
and AT =
ATFun ALS AT AT |
ATProd "AT list" |
ATSum "AT list" |
ATMu MuVar AT |
ATVar MuVar
(* Annotated language expression *)
and AE =
AETup "AE list" |
AEProj nat AE |
AEInj "AT list" nat AE |
AEFold MuVar AT AE |
AEUnfold AE |
AELet Var AE AE |
AEMatch AT AE "(Var * AE) list" |
AELam ALS Var AT AE Var AT AE AT |
AEApp ALS AE AE |
AEVar Var |
AEDef Def "ALS list" |
AESelf Def AT

(* Annotated language lambda *)
type_synonym AL = "Var * AT * Var * AT * AE * AT"

(* Annotated language lambda set constraint -- these are of the form 'lambda \<in> set' *)
type_synonym ALSC = "AL * ALS"

(* Annotated language program *)
datatype AP =
APEntry Def |
APDef Def "LSVar list" "ALSC list" AT AE AP

(* Substitution for lambda set level mu variables *)
fun
  als_mu_subst :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> ALS \<Rightarrow> ALS" and
  at_mu_subst :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> AT \<Rightarrow> AT" and
  ae_mu_subst :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> AE \<Rightarrow> AE"
  where
"als_mu_subst m (ALSVar v) = ALSVar v" |
"als_mu_subst m (ALSSet s) = ALSSet (map (\<lambda> (x, t1, y, t2, e, t3). (x, at_mu_subst m t1, y, at_mu_subst m t2, ae_mu_subst m e, at_mu_subst m t3)) s)" |
"als_mu_subst m (ALSMuVar u) = m u" |
"als_mu_subst m (ALSMu u a) = ALSMu u (als_mu_subst (m(u := ALSMuVar u)) a)" |
"at_mu_subst m (ATFun a t1 t2) = ATFun (als_mu_subst m a) (at_mu_subst m t1) (at_mu_subst m t2)" |
"at_mu_subst m (ATProd ts) = ATProd (map (at_mu_subst m) ts)" |
"at_mu_subst m (ATSum ts) = ATSum (map (at_mu_subst m) ts)" |
"at_mu_subst m (ATMu u t) = ATMu u (at_mu_subst m t)" |
"at_mu_subst m (ATVar u) = ATVar u" |
"ae_mu_subst m (AETup es) = AETup (map (ae_mu_subst m) es)" |
"ae_mu_subst m (AEProj i e) = AEProj i (ae_mu_subst m e)" |
"ae_mu_subst m (AEInj ts i e) = AEInj (map (at_mu_subst m) ts) i (ae_mu_subst m e)" |
"ae_mu_subst m (AEFold u t e) = AEFold u (at_mu_subst m t) (ae_mu_subst m e)" |
"ae_mu_subst m (AEUnfold e) = AEUnfold (ae_mu_subst m e)" |
"ae_mu_subst m (AELet x e1 e2) = AELet x (ae_mu_subst m e1) (ae_mu_subst m e2)" |
"ae_mu_subst m (AEMatch t e cases) = AEMatch (at_mu_subst m t) (ae_mu_subst m e) (map (\<lambda>(case_x, case_e). (case_x, ae_mu_subst m case_e)) cases)" |
"ae_mu_subst m (AELam a x t1 e1 y t2 e2 t3) = AELam (als_mu_subst m a) x (at_mu_subst m t1) (ae_mu_subst m e1) y (at_mu_subst m t2) (ae_mu_subst m e2) (at_mu_subst m t3)" |
"ae_mu_subst m (AEApp a e1 e2) = AEApp (als_mu_subst m a) (ae_mu_subst m e1) (ae_mu_subst m e2)" |
"ae_mu_subst m (AEVar v) = AEVar v" |
"ae_mu_subst m (AEDef d as) = AEDef d (map (als_mu_subst m) as)" |
"ae_mu_subst m (AESelf d_self t_self) = (AESelf d_self (at_mu_subst m t_self))"

fun al_mu_subst :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> AL \<Rightarrow> AL" where
"al_mu_subst m (x, t1, y, t2, e, t3) = (x, at_mu_subst m t1, y, at_mu_subst m t2, ae_mu_subst m e, at_mu_subst m t3)"

(* Substitution for lambda set variables *)
fun
  als_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> ALS \<Rightarrow> ALS" and
  at_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> AT \<Rightarrow> AT" and
  ae_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> AE \<Rightarrow> AE"
  where
"als_lsv_subst m (ALSVar v) = m v" |
"als_lsv_subst m (ALSSet s) = ALSSet (map (\<lambda> (x, t1, y, t2, e, t3). (x, at_lsv_subst m t1, y, at_lsv_subst m t2, ae_lsv_subst m e, at_lsv_subst m t3)) s)" |
"als_lsv_subst m (ALSMuVar u) = ALSMuVar u" |
"als_lsv_subst m (ALSMu u a) = ALSMu u (als_lsv_subst m a)" |

"at_lsv_subst m (ATFun a t1 t2) = ATFun (als_lsv_subst m a) (at_lsv_subst m t1) (at_lsv_subst m t2)" |
"at_lsv_subst m (ATProd ts) = ATProd (map (at_lsv_subst m) ts)" |
"at_lsv_subst m (ATSum ts) = ATSum (map (at_lsv_subst m) ts)" |
"at_lsv_subst m (ATMu u t) = ATMu u (at_lsv_subst m t)" |
"at_lsv_subst m (ATVar u) = ATVar u" |

"ae_lsv_subst m (AETup es) = AETup (map (ae_lsv_subst m) es)" |
"ae_lsv_subst m (AEProj i e) = AEProj i (ae_lsv_subst m e)" |
"ae_lsv_subst m (AEInj ts i e) = AEInj (map (at_lsv_subst m) ts) i (ae_lsv_subst m e)" |
"ae_lsv_subst m (AEFold u t e) = AEFold u (at_lsv_subst m t) (ae_lsv_subst m e)" |
"ae_lsv_subst m (AEUnfold e) = AEUnfold (ae_lsv_subst m e)" |
"ae_lsv_subst m (AELet x e1 e2) = AELet x (ae_lsv_subst m e1) (ae_lsv_subst m e2)" |
"ae_lsv_subst m (AEMatch t e cases) = AEMatch (at_lsv_subst m t) (ae_lsv_subst m e) (map (\<lambda>(case_x, case_e). (case_x, ae_lsv_subst m case_e)) cases)" |
"ae_lsv_subst m (AELam a x t1 e1 y t2 e2 t3) = AELam (als_lsv_subst m a) x (at_lsv_subst m t1) (ae_lsv_subst m e1) y (at_lsv_subst m t2) (ae_lsv_subst m e2) (at_lsv_subst m t3)" |
"ae_lsv_subst m (AEApp a e1 e2) = AEApp (als_lsv_subst m a) (ae_lsv_subst m e1) (ae_lsv_subst m e2)" |
"ae_lsv_subst m (AEVar v) = AEVar v" |
"ae_lsv_subst m (AEDef d as) = AEDef d (map (als_lsv_subst m) as)" |
"ae_lsv_subst m (AESelf d_self t_self) = (AESelf d_self (at_lsv_subst m t_self))"

(* Merging this case into the above definition blows the termination checker *)
fun al_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> AL \<Rightarrow> AL" where
"al_lsv_subst m (x, t1, y, t2, e, t3) = (x, at_lsv_subst m t1, y, at_lsv_subst m t2, ae_lsv_subst m e, at_lsv_subst m t3)"

(* Substitution for annotated type level mu variables *)
fun at_subst :: "(MuVar \<Rightarrow> AT) \<Rightarrow> AT \<Rightarrow> AT" where
"at_subst m (ATFun a t1 t2) = ATFun a (at_subst m t1) (at_subst m t2)" |
"at_subst m (ATProd ts) = ATProd (map (at_subst m) ts)" |
"at_subst m (ATSum ts) = ATSum (map (at_subst m) ts)" |
"at_subst m (ATMu u t) = ATMu u (at_subst (m(u := ATVar u)) t)" |
"at_subst m (ATVar u) = m u"

(* Annotated language typing context for values *)
type_synonym ATCV = "Var \<Rightarrow> AT option"
(* Annotated language typing context for definitions *)
type_synonym ATCD = "Def \<Rightarrow> ((LSVar list) * AT * (ALSC list)) option"
(* Annotated language "self" context -- contains typing information about the current definition *)
datatype ATCS = ATCS (atcs_defs: ATCD) (atcs_self_d: Def) (atcs_self_t: AT)

fun upd_w_list :: "('a * 'b) list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" where
"upd_w_list xs f = foldr (\<lambda> (x, y) new_f. (new_f(x := y))) xs f"

fun lsv_inst :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS)" where
"lsv_inst xs ys = upd_w_list (zip xs ys) ALSVar"

(* Typing judgement for annotated expressions *)
function tj_ae :: "ATCS \<Rightarrow> ATCV \<Rightarrow> AE \<Rightarrow> AT \<Rightarrow> bool" where
tj_ae_tup: "tj_ae sc gc (AETup es) t0 = (\<exists> ts.
  length es = length ts \<and>
  (\<forall> (e_el, t_el) \<in> set (zip es ts). tj_ae sc gc e_el t_el) \<and>
  t0 = ATProd ts
)" |
tj_ae_proj: "tj_ae sc gc (AEProj i e) t0 = (\<exists> ts.
  i < length ts \<and>
  tj_ae sc gc e (ATProd ts) \<and>
  t0 = ts ! i
)" |
tj_ae_inj: "tj_ae sc gc (AEInj ts i e) t0 = (
  i < length ts \<and>
  tj_ae sc gc e (ts ! i) \<and>
  t0 = ATSum ts
)" |
tj_ae_fold: "tj_ae sc gc (AEFold u t e) t0 = (
  tj_ae sc gc e (at_subst (ATVar(u := ATMu u t)) t) \<and>
  t0 = ATMu u t
)" |
tj_ae_unfold: "tj_ae sc gc (AEUnfold e) t0 = (\<exists> u t.
  tj_ae sc gc e (ATMu u t) \<and>
  t0 = (at_subst (ATVar(u := ATMu u t)) t)
)" |
tj_ae_let: "tj_ae sc gc (AELet x e1 e2) t0 = (\<exists> t.
  gc x = None \<and>
  tj_ae sc gc e1 t \<and>
  tj_ae sc (gc(x := Some t)) e2 t0
)" |
tj_ae_match: "tj_ae sc gc (AEMatch t_ret e_dis cases) t0 = (\<exists> ts.
  length ts = length cases \<and>
  tj_ae sc gc e_dis (ATSum ts) \<and>
  (\<forall> (t_case, (x_case, e_case)) \<in> set (zip ts cases).
    gc x_case = None \<and>
    tj_ae sc (gc(x_case := Some t_case)) e_case t_ret
  ) \<and>
  t0 = t_ret
)" |
tj_ae_lam: "tj_ae sc gc (AELam a x t1 e1 y t2 e2 t3) t0 = (
  tj_ae sc gc e1 t1 \<and>
  tj_ae sc (Map.empty(x := Some t1, y := Some t2)) e2 t3 \<and>
  t0 = ATFun a t2 t3
)" |
tj_ae_app: "tj_ae sc gc (AEApp a e1 e2) t0 = (\<exists> t_arg.
  tj_ae sc gc e1 (ATFun a t_arg t0) \<and>
  tj_ae sc gc e2 t_arg
)" |
tj_ae_var: "tj_ae sc gc (AEVar x) t0 = (gc x = Some t0)" |
tj_ae_def: "tj_ae sc gc (AEDef d as) t0 = (\<exists> vs t cs.
  atcs_defs sc d = Some (vs, t, cs) \<and>
  length vs = length as \<and>
  t0 = at_lsv_subst (lsv_inst vs as) t
)" |
tj_ae_self: "tj_ae sc gc (AESelf d t) t0 = (atcs_self_d sc = d \<and> atcs_self_t sc = t \<and> t0 = t)"
  by(pat_completeness) auto
termination apply(relation "measure (\<lambda> (_, _, e, _). AE.size_AE e)", auto)
   apply (meson le_imp_less_Suc order_refl set_zip_leftD size_list_estimation')
proof -
  fix t_ret e_dis cases ts t_case x_case e_case
  assume in_list: "(t_case :: AT, x_case :: Var, e_case :: AE) \<in> set (zip ts cases)"
  then have "(x_case, e_case) \<in> set cases"
    by (meson in_set_zipE)
  then have "size_list (size_prod (\<lambda>_. 0) size_AE) cases \<ge> size_AE e_case"
  proof(induct cases arbitrary: x_case e_case)
    case Nil
    then show ?case by auto
  next
    case (Cons case_hd case_tl)
    then show ?case apply(case_tac "e_case = snd case_hd")
      apply (simp add: size_prod_simp)
      by fastforce
  qed
  then show "size_AE e_case
       < Suc (size_list (size_prod (\<lambda>x. 0) size_AE) cases +
              size_AT t_ret +
              size_AE e_dis)"
    by auto
qed

(* Annotated constraints context: constraints *)
type_synonym ACC = "ALSC list"

(* Constraint judgement for lambda set constraints *)
inductive cj_alsc :: "ALSC list \<Rightarrow> ALSC \<Rightarrow> bool" where
cj_alsc_assumption: "c \<in> set q \<Longrightarrow> cj_alsc q c" |
cj_alsc_set: "s \<in> set a \<Longrightarrow> cj_alsc q (s, ALSSet a)" |
cj_alsc_mu: "
  cj_alsc q (l, als_mu_subst (ALSMuVar(u := ALSMu u a)) a) \<Longrightarrow>
    cj_alsc q (l, ALSMu u a)
"

fun cj_alsc_all :: "ALSC list \<Rightarrow> ALSC list \<Rightarrow> bool" where
"cj_alsc_all q1 q2 = (\<forall> c \<in> set q2. cj_alsc q1 c)"

fun alsc_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> ALSC \<Rightarrow> ALSC" where
"alsc_lsv_subst m ((x, t1, y, t2, e, t3), a) = ((x, at_lsv_subst m t1, y, at_lsv_subst m t2, ae_lsv_subst m e, at_lsv_subst m t3), als_lsv_subst m a)"

fun alsc_lsv_subst_all :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> ALSC list \<Rightarrow> ALSC list" where
"alsc_lsv_subst_all m q = map (alsc_lsv_subst m) q"

fun alsc_mu_subst :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> ALSC \<Rightarrow> ALSC" where
"alsc_mu_subst m (l, a) = (al_mu_subst m l, als_mu_subst m a)"

fun alsc_mu_subst_all :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> ACC \<Rightarrow> ACC" where
"alsc_mu_subst_all m cc = map (alsc_mu_subst m) cc"

(* Constraint judgement for annotated expressions *)
fun cj_ae :: "ATCD \<Rightarrow> ACC \<Rightarrow> AE \<Rightarrow> bool" where
"cj_ae dc cc (AETup es) = (\<forall> e \<in> set es. cj_ae dc cc e)" |
"cj_ae dc cc (AEProj _ e) = cj_ae dc cc e" |
"cj_ae dc cc (AEInj _ _ e) = cj_ae dc cc e" |
"cj_ae dc cc (AEFold _ _ e) = cj_ae dc cc e" |
"cj_ae dc cc (AEUnfold e) = cj_ae dc cc e" |
"cj_ae dc cc (AELet _ e1 e2) = (cj_ae dc cc e1 \<and> cj_ae dc cc e2)" |
"cj_ae dc cc (AEMatch _ e_dis cases) = (cj_ae dc cc e_dis \<and> (\<forall> (_, e_case) \<in> set cases. cj_ae dc cc e_case))" |
"cj_ae dc cc (AELam a x t1 e1 y t2 e2 t3) = (cj_alsc cc ((x, t1, y, t2, e2, t3), a) \<and> cj_ae dc cc e1 \<and> cj_ae dc cc e2)" |
"cj_ae dc cc (AEApp _ e1 e2) = (cj_ae dc cc e1 \<and> cj_ae dc cc e2)" |
"cj_ae dc cc (AEVar _) = True" |
"cj_ae dc cc (AEDef d as) = (
  case dc d of
    Some (vs, _, cs) \<Rightarrow> length vs = length as \<and> cj_alsc_all cc (alsc_lsv_subst_all (lsv_inst vs as) cs) |
    None \<Rightarrow> False
)" |
"cj_ae dc cc (AESelf _ _) = True"

fun connected_components_step :: "(nat * nat) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> nat)" where
"connected_components_step (x, y) f = (\<lambda> z. if f z = min (f x) (f y) then max (f x) (f y) else f z)"

fun connected_components :: "(nat * nat) list \<Rightarrow> (nat \<Rightarrow> nat)" where
"connected_components edges = foldr connected_components_step edges id"

lemma connected_components_equiv: "(x, y) \<in> set edges \<Longrightarrow> connected_components edges x = connected_components edges y"
  apply(induct edges)
  by(auto)

fun
  ti_fresh_t_list :: "nat \<Rightarrow> ST list \<Rightarrow> nat * (AT list)" and
  ti_fresh_t :: "nat \<Rightarrow> ST \<Rightarrow> nat * AT" where
"ti_fresh_t_list count0 ts = (
  foldr
    (\<lambda> t (count_step, ts').
      let (count_step', t') = ti_fresh_t count_step t in (count_step', t' # ts'))
    ts
    (count0, [])
)" |
"ti_fresh_t count0 (STFun t1 t2) = (
  let
    (count1, t1') = ti_fresh_t count0 t1;
    (count2, t2') = ti_fresh_t count1 t2
  in (count2 + 1, (ATFun (ALSVar count2) t1' t2'))
)" |
"ti_fresh_t count0 (STProd ts) = (
  let (count_final, ts'_all) = ti_fresh_t_list count0 ts
  in (count_final, ATProd ts'_all)
)" |
"ti_fresh_t count0 (STSum ts) = (
  let (count_final, ts'_all) = ti_fresh_t_list count0 ts
  in (count_final, ATSum ts'_all)
)" |
"ti_fresh_t count0 (STMu u t) = (
  let (count, t') = ti_fresh_t count0 t in
  (count, ATMu u t')
)" |
"ti_fresh_t count0 (STVar u) = (count0, ATVar u)
"

fun ti_fresh_e :: "ATCD \<Rightarrow> nat \<Rightarrow> SE \<Rightarrow> nat * AE" where
"ti_fresh_e dc count0 (SETup es) = (
  let (count_final, es'_all) = (
    foldr (\<lambda> t (count_step, es').
      let (count_step', e') = ti_fresh_e dc count_step t in (count_step', e' # es')
    ) es (count0, []))
  in (count_final, AETup es'_all)
)" |
"ti_fresh_e dc count0 (SEProj i e) = (
  let (count1, e') = ti_fresh_e dc count0 e in
  (count1, AEProj i e')
)" |
"ti_fresh_e dc count0 (SEInj ts i e) = (
  let (count_ts, ts'_all) = (
    foldr (\<lambda> t (count_step, ts').
      let (count_step', t') = ti_fresh_t count_step t in (count_step', t' # ts')
    ) ts (count0, []));
      (count_final, e') = ti_fresh_e dc count_ts e
  in (count_final, AEInj ts'_all i e')
)" |
"ti_fresh_e dc count0 (SEFold u t e) = (
  let
    (count1, t') = ti_fresh_t count0 t;
    (count2, e') = ti_fresh_e dc count1 e
  in (count2, AEFold u t' e')
)" |
"ti_fresh_e dc count0 (SEUnfold e) = (
  let (count1, e') = ti_fresh_e dc count0 e
  in (count1, AEUnfold e')
)" |
"ti_fresh_e dc count0 (SELet x e1 e2) = (
  let
    (count1, e1') = ti_fresh_e dc count0 e1;
    (count2, e2') = ti_fresh_e dc count1 e2
  in (count2, AELet x e1' e2')
)" |
"ti_fresh_e dc count0 (SEMatch t e cases) = (
  let
    (count1, t') = ti_fresh_t count0 t;
    (count2, e') = ti_fresh_e dc count0 e;
    (count_final, cases'_final) = (
      foldr (\<lambda> (x, e_case) (count_step, cases').
        let (count_step', e_case') = ti_fresh_e dc count_step e_case in (count_step', (x, e_case') # cases')
    ) cases (count2, []))
  in (count_final, AEMatch t' e' cases'_final)
)" |
"ti_fresh_e dc count0 (SELam x t1 e1 y t2 e2 t3) = (
  let
    (count1, t1') = ti_fresh_t count0 t1;
    (count2, e1') = ti_fresh_e dc count1 e1;
    (count3, t2') = ti_fresh_t count2 t2;
    (count4, e2') = ti_fresh_e dc count3 e2;
    (count5, t3') = ti_fresh_t count4 t3
  in (count5 + 1, AELam (ALSVar count5) x t1' e1' y t2' e2' t3')
)" |
"ti_fresh_e dc count0 (SEApp e1 e2) = (
  let
    (count1, e1') = ti_fresh_e dc count0 e1;
    (count2, e2') = ti_fresh_e dc count1 e2
  in (count2 + 1, AEApp (ALSVar count2) e1' e2')
)" |
"ti_fresh_e dc count0 (SEVar x) = (count0, AEVar x)" |
(* The "None" case here is unnecessary, but it allows us to prove that the annotated expression
   refines the source expression unconditionally *)
"ti_fresh_e dc count0 (SEDef d) = (
  case dc d of
    Some (vs, _) \<Rightarrow> let (count'_all, as_all) = foldr (\<lambda> _ (count', as_all).
        (count' + 1, (ALSVar count') # as_all)
      ) vs (count0, []) in
      (count'_all, AEDef d as_all) |
    None \<Rightarrow> (count0, AEDef d [])
)" |
"ti_fresh_e dc count0 (SESelf d t) = (
  let (count1, t') = ti_fresh_t count0 t in
  (count1, AESelf d t')
)"

fun strip_at :: "AT \<Rightarrow> ST" where
"strip_at (ATFun a t1 t2) = STFun (strip_at t1) (strip_at t2)" |
"strip_at (ATProd ts) = STProd (map strip_at ts)" |
"strip_at (ATSum ts) = STSum (map strip_at ts)" |
"strip_at (ATMu u t) = STMu u (strip_at t)" |
"strip_at (ATVar u) = STVar u"

fun strip_ae :: "AE \<Rightarrow> SE" where
"strip_ae (AETup es) = SETup (map strip_ae es)" |
"strip_ae (AEProj i e) = SEProj i (strip_ae e)" |
"strip_ae (AEInj ts i e) = SEInj (map strip_at ts) i (strip_ae e)" |
"strip_ae (AEFold u t e) = SEFold u (strip_at t) (strip_ae e)" |
"strip_ae (AEUnfold e) = SEUnfold (strip_ae e)" |
"strip_ae (AELet x e1 e2) = SELet x (strip_ae e1) (strip_ae e2)" |
"strip_ae (AEMatch t e cases) = SEMatch (strip_at t) (strip_ae e) (map (\<lambda>(case_x, case_e). (case_x, strip_ae case_e)) cases)" |
"strip_ae (AELam a x t1 e1 y t2 e2 t3) = SELam x (strip_at t1) (strip_ae e1) y (strip_at t2) (strip_ae e2) (strip_at t3)" |
"strip_ae (AEApp a e1 e2) = SEApp (strip_ae e1) (strip_ae e2)" |
"strip_ae (AEVar x) = SEVar x" |
"strip_ae (AEDef d as) = SEDef d" |
"strip_ae (AESelf d t) = SESelf d (strip_at t)"

fun strip_ap :: "AP \<Rightarrow> SP" where
"strip_ap (APEntry d) = SPEntry d" |
"strip_ap (APDef d _ _ t e p) = SPDef d (strip_at t) (strip_ae e) (strip_ap p)"

fun strip_atcv :: "ATCV \<Rightarrow> STCV" where
"strip_atcv gc = (map_option strip_at) \<circ> gc"

fun strip_atcd :: "ATCD \<Rightarrow> STCD" where
"strip_atcd dc = (map_option (\<lambda> (_, t, _). strip_at t)) \<circ> dc"

fun strip_atcs :: "ATCS \<Rightarrow> STCS" where
"strip_atcs sc = (STCS (strip_atcd (atcs_defs sc)) (atcs_self_d sc) (strip_at (atcs_self_t sc)))"

(* ST/AT refinement *)
fun rj_st_at :: "ST \<Rightarrow> AT \<Rightarrow> bool" where
"rj_st_at t t' = (t = strip_at t')"

(* SE/AE refinement *)
fun rj_se_ae :: "SE \<Rightarrow> AE \<Rightarrow> bool" where
"rj_se_ae e e' = (e = strip_ae e')"

(* SP/AP refinement *)
fun rj_sp_ap :: "SP \<Rightarrow> AP \<Rightarrow> bool" where
"rj_sp_ap p p' = (p = strip_ap p')"

(* STCV/ATCV refinement *)
fun rj_stcv_atcv :: "STCV \<Rightarrow> ATCV \<Rightarrow> bool" where
"rj_stcv_atcv gc gc' = (gc = strip_atcv gc')"

(* STCD/ATCD refinement *)
fun rj_stcd_atcd :: "STCD \<Rightarrow> ATCD \<Rightarrow> bool" where
"rj_stcd_atcd dc dc' = (dc = strip_atcd dc')"

(* STCS/ATCS refinement *)
fun rj_stcs_atcs :: "STCS \<Rightarrow> ATCS \<Rightarrow> bool" where
"rj_stcs_atcs sc sc' = (sc = strip_atcs sc')"

lemma at_lsv_subst_preserve_strip: "strip_at (at_lsv_subst m t) = strip_at t"
  by(induct_tac t, auto)

lemma ae_lsv_subst_preserve_strip: "strip_ae (ae_lsv_subst m e) = strip_ae e"
proof -
  have "True \<and> True \<and> ?thesis"
    apply(induct e rule: ALS_AT_AE.induct)
    using at_lsv_subst_preserve_strip by auto
  then show ?thesis by auto
qed

lemma at_mu_subst_preserve_strip: "strip_at (at_subst m t) = st_subst (strip_at \<circ> m) (strip_at t)"
  by(induct t arbitrary: m, auto, simp add: fun_upd_comp)

lemma ti_fresh_refine_t: "rj_st_at t (snd (ti_fresh_t count t))"
proof(induct t arbitrary: count)
case (STFun t1 t2)
  then show ?case
    apply(simp)
    by(simp add: split_def)
next
  case (STProd ts)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct ts)
    by(auto)
next
  case (STSum ts)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct ts)
    by(auto)
next
  case (STMu x1 t)
  then show ?case
    apply(simp)
    by(simp add: split_def)
next
  case (STVar x)
  then show ?case
    by(auto)
qed

lemma ti_fresh_refine_e: "rj_se_ae e (snd (ti_fresh_e dc count e))"
proof(induct e arbitrary: count)
case (SETup es)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct es)
    by(auto)
next
case (SEProj i e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEInj ts i e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct ts)
    using ti_fresh_refine_t apply(auto)
    done
next
  case (SEFold u t e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_refine_t apply(auto)
    done
next
  case (SEUnfold e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SELet x e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEMatch x e cases)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_refine_t apply(auto)
  proof(induct cases)
    case Nil
    then show ?case
      apply(auto)
      done
    next
      case (Cons a cases)
      then show ?case
        apply(auto)
         apply (metis (no_types, lifting) fst_conv prod_eqI snd_conv)
        by blast
    qed
next
  case (SELam x t1 e1 y t2 e2 t3)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_refine_t apply(auto)
    done
next
  case (SEApp e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEVar x)
  then show ?case
    apply(simp)
    done
next
  case (SEDef x)
  then show ?case
    apply(simp)
    apply(split option.split)
    apply(simp add: split_def)
    apply(auto)
    by (metis sndI strip_ae.simps(11))
next
  case (SESelf d t)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_refine_t apply(auto)
    done
qed

lemma tj_se_ae_refine: "
  tj_se sc gc e0 t0 \<Longrightarrow>
  tj_ae sc' gc' e0' t0' \<Longrightarrow>
  rj_stcs_atcs sc sc' \<Longrightarrow>
  rj_stcv_atcv gc gc' \<Longrightarrow>
  rj_se_ae e0 e0' \<Longrightarrow>
  rj_st_at t0 t0'
"
proof(induct e0 arbitrary: e0' sc sc' gc gc' t0 t0')
  case (SETup es)
  obtain ts where ts_obtain: "t0 = STProd ts"
    using SETup.prems by auto
  obtain es' where es'_obtain: "e0' = AETup es' \<and> es = map strip_ae es'"
    using SETup.prems by(case_tac e0', auto)
  obtain ts' where ts'_obtain: "t0' = ATProd ts'"
    using SETup.prems es'_obtain by auto

  have each_refines: "\<And>i. i < length es \<Longrightarrow> rj_st_at (ts ! i) (ts' ! i)"
  proof -
    fix i
    assume i_range: "i < length es"
    show "rj_st_at (ts ! i) (ts' ! i)"
    proof(rule SETup.hyps)
      show "(es ! i) \<in> set es"
        using SETup.prems i_range by auto

      have "(es ! i, ts ! i) \<in> set (zip es ts)"
        using i_range SETup.prems(1) ts_obtain apply auto
        by (metis fst_conv in_set_zip snd_conv)
      then show "tj_se sc gc (es ! i) (ts ! i)"
        using SETup.prems(1) ts_obtain by auto

      have "(es' ! i, ts' ! i) \<in> set (zip es' ts')"
        using i_range SETup.prems(2) es'_obtain ts'_obtain in_set_zip by force
      then show "tj_ae sc' gc' (es' ! i) (ts' ! i)"
        using SETup.prems(2) es'_obtain ts'_obtain by auto

      show "rj_stcs_atcs sc sc'"
        using SETup.prems by auto

      show "rj_stcv_atcv gc gc'"
        using SETup.prems by auto

      show "rj_se_ae (es ! i) (es' ! i)"
        using SETup.prems i_range es'_obtain by auto
    qed
  qed
  then show ?case
    using ts_obtain ts'_obtain SETup.prems es'_obtain apply auto
    by (simp add: nth_equalityI)
next
  case (SEProj i e)
  obtain ts where ts_obtain: "tj_se sc gc e (STProd ts)"
    using SEProj.prems by auto
  obtain e' where e'_obtain: "e0' = AEProj i e' \<and> e = strip_ae e'"
    using SEProj.prems by(case_tac e0', auto)
  obtain ts' where ts'_obtain: "tj_ae sc' gc' e' (ATProd ts')"
    using SEProj.prems e'_obtain by auto

  have ts_refine: "rj_st_at (STProd ts) (ATProd ts')"
  proof(rule SEProj.hyps)
    show "tj_se sc gc e (STProd ts)"
      using ts_obtain .

    show "tj_ae sc' gc' e' (ATProd ts')"
      using ts'_obtain .

    show "rj_stcs_atcs sc sc'"
      using SEProj.prems by auto

    show "rj_stcv_atcv gc gc'"
      using SEProj.prems by auto

    show "rj_se_ae e e'"
      using e'_obtain by auto
  qed
  then have "rj_st_at (ts ! i) (ts' ! i)"
    using SEProj.prems ts_obtain e'_obtain ts'_obtain apply auto
    by (metis SEProj.hyps SEProj.prems(3) SEProj.prems(4) ST.inject(2) length_map nth_map rj_se_ae.elims(3) rj_st_at.simps)
  then show ?case
    using SEProj.prems apply auto
    using SEProj.hyps e'_obtain by fastforce
next
  case (SEInj ts i e)
  have t0_decomp: "t0 = STSum ts"
    using SEInj.prems by auto
  obtain ts' e' where ts'_e'_obtain: "e0' = AEInj ts' i e'"
    using SEInj.prems by(case_tac e0', auto)
  then show ?case
    using SEInj.prems t0_decomp ts'_e'_obtain by auto
next
  case (SEFold u t e)
  obtain t' e' where t'_e'_obtain: "e0' = AEFold u t' e' \<and> rj_st_at t t' \<and> rj_se_ae e e'"
    using SEFold.prems by(case_tac e0', auto)
  then show ?case
    using SEFold.prems by auto
next
  case (SEUnfold e)
  obtain u t where u_t_obtain: "tj_se sc gc e (STMu u t) \<and> t0 = st_subst (STVar(u := STMu u t)) t"
    using SEUnfold.prems by auto
  obtain e' where e'_obtain: "e0' = AEUnfold e' \<and> rj_se_ae e e'"
    using SEUnfold.prems by(case_tac e0', auto)
  obtain t' where t'_obtain: "tj_ae sc' gc' e' (ATMu u t') \<and> t0' = at_subst (ATVar(u := ATMu u t')) t' \<and> rj_st_at t t'"
    using SEUnfold.prems(2) e'_obtain apply(auto)
    using SEUnfold.hyps SEUnfold.prems(3) SEUnfold.prems(4) u_t_obtain
    by (metis (mono_tags, lifting) ST.inject(4) e'_obtain rj_st_at.elims(2) strip_at.simps(4))
  have "(STVar(u := STMu u t)) = strip_at \<circ> (ATVar(u := ATMu u t'))"
    using t'_obtain by auto
  then have "strip_at (at_subst (ATVar(u := ATMu u t')) t') = st_subst (STVar(u := STMu u t)) t"
    using t'_obtain at_mu_subst_preserve_strip by auto
  then show ?case
    using u_t_obtain e'_obtain t'_obtain by simp
next
  case (SELet x e1 e2)
  obtain t_var where t_var_obtain: "tj_se sc gc e1 t_var"
    using SELet.prems by auto
  obtain e1' e2' where e1'_e2'_obtain: "e0' = AELet x e1' e2' \<and> rj_se_ae e1 e1' \<and> rj_se_ae e2 e2'"
    using SELet.prems by(case_tac e0', auto)
  obtain t_var' where t_var'_obtain: "tj_ae sc' gc' e1' t_var' \<and> tj_ae sc' (gc'(x := Some t_var')) e2' t0'"
    using SELet.prems e1'_e2'_obtain by(auto)

  have t_var_refine: "rj_st_at t_var t_var'"
  proof(rule SELet.hyps(1))
    show "tj_se sc gc e1 t_var"
      using t_var_obtain by auto

    show "tj_ae sc' gc' e1' t_var'"
      using t_var'_obtain by auto

    show "rj_stcs_atcs sc sc'"
      using SELet.prems by auto

    show "rj_stcv_atcv gc gc'"
      using SELet.prems by auto

    show "rj_se_ae e1 e1'"
      using e1'_e2'_obtain by auto
  qed

  show ?case
  proof(rule SELet.hyps(2))
    show "tj_se sc (gc(x := Some t_var)) e2 t0"
      using SELet.prems t_var_obtain apply(auto)
      by (metis SELet.hyps(1) SELet.prems(3) SELet.prems(4) e1'_e2'_obtain rj_st_at.elims(2) t_var'_obtain)

    show "tj_ae sc' (gc'(x := Some t_var')) e2' t0'"
      using t_var'_obtain by auto

    show "rj_stcs_atcs sc sc'"
      using SELet.prems by auto

    show "rj_stcv_atcv (gc(x := Some t_var)) (gc'(x := Some t_var'))"
      using SELet.prems t_var_refine by auto

    show "rj_se_ae e2 e2'"
      using e1'_e2'_obtain by auto
  qed
next
  case (SEMatch t_ret e_dis cases)
  obtain t_ret' e_dis' cases' where t_ret'_obtain: "e0' = AEMatch t_ret' e_dis' cases' \<and> rj_st_at t_ret t_ret'"
    using SEMatch.prems by(case_tac e0', auto)
  then show ?case
    using SEMatch.prems by auto
next
  case (SELam x t1 e1 y t2 e2 t3)
  obtain a t1' e1' t2' e2' t3' where e0'_decomp: "e0' = AELam a x t1' e1' y t2' e2' t3' \<and> rj_st_at t2 t2' \<and> rj_st_at t3 t3'"
    using SELam.prems by(case_tac e0', auto)
  then show ?case
    using SELam.prems by auto
next
  case (SEApp e1 e2)
  obtain a e1' e2' where a_e1'_e2'_obtain: "e0' = AEApp a e1' e2' \<and> rj_se_ae e1 e1' \<and> rj_se_ae e2 e2'"
    using SEApp.prems by(case_tac e0', auto)
  obtain t_arg where t_arg_obtain: "tj_se sc gc e1 (STFun t_arg t0) \<and> tj_se sc gc e2 t_arg"
    using SEApp.prems by auto
  obtain t_arg' where t_arg'_obtain: "tj_ae sc' gc' e1' (ATFun a t_arg' t0') \<and> tj_ae sc' gc' e2' t_arg'"
    using SEApp.prems a_e1'_e2'_obtain by auto

  have "rj_st_at (STFun t_arg t0) (ATFun a t_arg' t0')"
  proof(rule SEApp.hyps(1))
    show "tj_se sc gc e1 (STFun t_arg t0)"
      using t_arg_obtain by auto

    show "tj_ae sc' gc' e1' (ATFun a t_arg' t0')"
      using t_arg'_obtain by auto

    show "rj_stcs_atcs sc sc'"
      using SEApp.prems by auto

    show "rj_stcv_atcv gc gc'"
      using SEApp.prems by auto

    show "rj_se_ae e1 e1'"
      using a_e1'_e2'_obtain by auto
  qed
  then show ?case by auto
next
  case (SEVar x)
  have "e0' = AEVar x"
    using SEVar.prems by(case_tac e0', auto)
  then show ?case
    using SEVar.prems by auto
next
  case (SEDef d)
  obtain as where e0'_decomp: "e0' = AEDef d as"
    using SEDef.prems by(case_tac e0', auto)
  then show ?case
    using SEDef.prems at_lsv_subst_preserve_strip by auto
next
  case (SESelf d t)
  obtain t' where e0'_decomp: "e0' = AESelf d t' \<and> rj_st_at t t'"
    using SESelf.prems by(case_tac e0', auto)
  then show ?case
    using SESelf.prems by auto
qed

(* Definition well-formed: source expression *)
fun dwf_se :: "STCD \<Rightarrow> SE \<Rightarrow> bool" where
"dwf_se dc (SETup es) = (\<forall> e \<in> set es. dwf_se dc e)" |
"dwf_se dc (SEProj i e) = dwf_se dc e" |
"dwf_se dc (SEInj ts i e) = dwf_se dc e" |
"dwf_se dc (SEFold u t e) = dwf_se dc e" |
"dwf_se dc (SEUnfold e) = dwf_se dc e" |
"dwf_se dc (SELet x e1 e2) = (dwf_se dc e1 \<and> dwf_se dc e2)" |
"dwf_se dc (SEMatch t e cases) = (dwf_se dc e \<and> (\<forall> (_, e_case) \<in> set cases. dwf_se dc e_case))" |
"dwf_se dc (SELam x t1 e1 y t2 e2 t3) = (dwf_se dc e1 \<and> dwf_se dc e2)" |
"dwf_se dc (SEApp e1 e2) = (dwf_se dc e1 \<and> dwf_se dc e2)" |
"dwf_se dc (SEVar x) = True" |
"dwf_se dc (SEDef d) = (dc d \<noteq> None)" |
"dwf_se dc (SESelf _ _) = True"

(* Definition well-formed: annotated expression *)
fun dwf_ae :: "ATCD \<Rightarrow> AE \<Rightarrow> bool" where
"dwf_ae dc (AETup es) = (\<forall> e \<in> set es. dwf_ae dc e)" |
"dwf_ae dc (AEProj i e) = dwf_ae dc e" |
"dwf_ae dc (AEInj ts i e) = dwf_ae dc e" |
"dwf_ae dc (AEFold u t e) = dwf_ae dc e" |
"dwf_ae dc (AEUnfold e) = dwf_ae dc e" |
"dwf_ae dc (AELet x e1 e2) = (dwf_ae dc e1 \<and> dwf_ae dc e2)" |
"dwf_ae dc (AEMatch t e cases) = (dwf_ae dc e \<and> (\<forall> (_, e_case) \<in> set cases. dwf_ae dc e_case))" |
"dwf_ae dc (AELam a x t1 e1 y t2 e2 t3) = (dwf_ae dc e1 \<and> dwf_ae dc e2)" |
"dwf_ae dc (AEApp a e1 e2) = (dwf_ae dc e1 \<and> dwf_ae dc e2)" |
"dwf_ae dc (AEVar x) = True" |
"dwf_ae dc (AEDef d as) = (case dc d of Some (vs, _) \<Rightarrow> (length vs = length as) | None \<Rightarrow> False)" |
"dwf_ae dc (AESelf _ _) = True"

lemma ti_fresh_dwf_e:
  assumes dc_refine: "rj_stcd_atcd dc dc'"
  shows "
    dwf_se dc e \<Longrightarrow>
    dwf_ae dc' (snd (ti_fresh_e dc' count e))
  "
proof(induct e arbitrary: count)
case (SETup es)
  then show ?case
    apply(simp)
    apply(simp add : split_def)
    apply(induct es)
     apply(auto)
    done
next
case (SEProj i e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEInj ts i e)
  then show ?case
    apply(simp)
    apply(simp add : split_def)
    done
next
  case (SEFold u t e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEUnfold e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SELet x e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEMatch t e cases)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
  proof(induct cases)
    case Nil
    then show ?case
      apply(simp)
      done
  next
    case (Cons a cases)
    then show ?case
      apply(simp)
      using snds.intros by blast
  qed
next
  case (SELam x t1 e1 y t2 e2 t3)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEApp e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEVar x)
  then show ?case
    apply(auto)
    done
next
  case (SEDef d)
  obtain vs t where vs_obtain: "dc' d = Some (vs, t)"
    using dc_refine SEDef
    by (case_tac "dc' d", auto)
  let ?fold_f = "\<lambda> _ (count', as_all). (count' + 1, (ALSVar count') # as_all)"
  have "length vs = length (snd (foldr ?fold_f vs (count, [])))"
    apply(induct vs)
     apply(auto)
    by (smt (verit, del_insts) case_prod_conv length_Cons snd_conv surj_pair)
  then show ?case
    using vs_obtain
    apply(auto)
    by (simp add: case_prod_beta')
next
  case (SESelf d t)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
qed

(* Full flexibility *)

fun ff_als :: "ALS \<Rightarrow> bool" where
"ff_als (ALSVar v) = True" |
"ff_als _ = False"

fun ff_at :: "AT \<Rightarrow> bool" where
"ff_at (ATFun a t1 t2) = (ff_als a \<and> ff_at t1 \<and> ff_at t2)" |
"ff_at (ATProd ts) = (\<forall> t \<in> set ts. ff_at t)" |
"ff_at (ATSum ts) = (\<forall> t \<in> set ts. ff_at t)" |
"ff_at (ATMu u t) = ff_at t" |
"ff_at (ATVar u) = True"

fun ff_ae :: "AE \<Rightarrow> bool" where
"ff_ae (AETup es) = (\<forall> e \<in> set es. ff_ae e)" |
"ff_ae (AEProj i e) = ff_ae e" |
"ff_ae (AEInj ts i e) = ((\<forall> t \<in> set ts. ff_at t) \<and> ff_ae e)" |
"ff_ae (AEFold u t e) = (ff_at t \<and> ff_ae e)" |
"ff_ae (AEUnfold e) = ff_ae e" |
"ff_ae (AELet x e1 e2) = (ff_ae e1 \<and> ff_ae e2)" |
"ff_ae (AEMatch t e cases) = (ff_at t \<and> ff_ae e \<and> (\<forall> (_, e_case) \<in> set cases. ff_ae e_case))" |
"ff_ae (AELam a x t1 e1 y t2 e2 t3) = (ff_als a \<and> ff_ae e1 \<and> ff_at t1 \<and> ff_ae e2 \<and> ff_at t2 \<and> ff_at t3)" |
"ff_ae (AEApp a e1 e2) = (ff_als a \<and> ff_ae e1 \<and> ff_ae e2)" |
"ff_ae (AEVar x) = True" |
"ff_ae (AEDef d as) = (\<forall> a \<in> set as. ff_als a)" |
"ff_ae (AESelf d t) = ff_at t"

lemma ti_fresh_ff_t: "ff_at (snd (ti_fresh_t count t))"
proof(induct t arbitrary: count)
case (STFun t1 t2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (STProd ts)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct ts)
     apply(auto)
    done
next
  case (STSum ts)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    apply(induct ts)
     apply(auto)
    done
next
  case (STMu u t)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (STVar x)
  then show ?case
    apply(simp)
    done
qed

lemma ti_fresh_ff_e: "ff_ae (snd (ti_fresh_e dc count e))"
proof(induct e arbitrary: count)
case (SETup es)
  then show ?case
    apply(simp)
    apply(simp add : split_def)
    apply(induct es)
     apply(auto)
    done
next
case (SEProj i e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEInj ts i e)
  then show ?case
    apply(simp)
    apply(simp add : split_def)
    apply(induct ts)
    using ti_fresh_ff_t apply(auto)
    done
next
  case (SEFold u t e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_ff_t apply(auto)
    done
next
  case (SEUnfold e)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SELet x e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEMatch t e cases)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_ff_t apply(auto)
  proof(induct cases)
    case Nil
    then show ?case
      apply(simp)
      done
  next
    case (Cons a cases)
    then show ?case
      apply(simp)
      by (metis (no_types, lifting) prod.exhaust_sel)
  qed
next
  case (SELam x t1 e1 y t2 e2 t3)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_ff_t apply(auto)
    done
next
  case (SEApp e1 e2)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    done
next
  case (SEVar x)
  then show ?case
    apply(auto)
    done
next
  case (SEDef d)
  show ?case
  proof(cases "dc d")
    case None
    then show ?thesis by auto
  next
    case (Some entry)
    obtain vs t as where decomp: "entry = (vs, t, as)"
      by (case_tac entry, auto)
    let ?fold_f = "\<lambda> _ (count', as_all). (count' + 1, (ALSVar count') # as_all)"
    have "
      ff_ae (snd (
        let (count'_all, as_all) = foldr ?fold_f vs (count, []) in
        (count'_all, AEDef d as_all)
      ))
    "
      apply(induct_tac vs)
       apply(auto)
      by(simp add: split_def)
    then show ?thesis
      using Some decomp
      by auto
  qed
next
  case (SESelf d t)
  then show ?case
    apply(simp)
    apply(simp add: split_def)
    using ti_fresh_ff_t apply(auto)
    done
qed

fun list_union :: "'a set list \<Rightarrow> 'a set" where
"list_union xs = (\<Union> x \<in> set xs. x)"

function
  free_al :: "AL \<Rightarrow> LSVar set" and
  free_als :: "ALS \<Rightarrow> LSVar set" and
  free_at :: "AT \<Rightarrow> LSVar set" and
  free_ae :: "AE \<Rightarrow> LSVar set"
  where
"free_al (x, t1, y, t2, e, t3) = free_at t1 \<union> free_at t2 \<union> free_ae e \<union> free_at t3" |
"free_als (ALSVar v) = {v}" |
"free_als (ALSSet ls) = list_union (map free_al ls)" |
"free_als (ALSMu u a) = free_als a" |
"free_als (ALSMuVar u) = {}" |
"free_at (ATFun a t1 t2) = free_als a \<union> free_at t1 \<union> free_at t2" |
"free_at (ATProd ts) = list_union (map free_at ts)" |
"free_at (ATSum ts) = list_union (map free_at ts)" |
"free_at (ATMu u t) = free_at t" |
"free_at (ATVar u) = {}" |
"free_ae (AETup es) = list_union (map free_ae es)" |
"free_ae (AEProj i e) = free_ae e" |
"free_ae (AEInj ts i e) = list_union (map free_at ts) \<union> free_ae e" |
"free_ae (AEFold u t e) = free_at t \<union> free_ae e" |
"free_ae (AEUnfold e) = free_ae e" |
"free_ae (AELet x e1 e2) = free_ae e1 \<union> free_ae e2" |
"free_ae (AEMatch t e cases) = free_at t \<union> free_ae e \<union> list_union (map (\<lambda> (_, e_case). free_ae e_case) cases)" |
"free_ae (AELam a x t1 e1 y t2 e2 t3) = free_als a \<union> free_at t1 \<union> free_ae e1 \<union> free_at t2 \<union> free_ae e2 \<union> free_at t3" |
"free_ae (AEApp a e1 e2) = free_als a \<union> free_ae e1 \<union> free_ae e2" |
"free_ae (AEVar x) = {}" |
"free_ae (AEDef d as) = list_union (map free_als as)" |
"free_ae (AESelf d t) = free_at t"
  by (pat_completeness) auto
termination by(size_change)

fun free_alsc :: "ALSC \<Rightarrow> LSVar set" where
"free_alsc (l, a) = free_al l \<union> free_als a"

fun free_acc :: "ACC \<Rightarrow> LSVar set" where
"free_acc cc = (\<Union>c \<in> set cc. free_alsc c)"

(* Definition well-formed: ATCD *)
fun dwf_atcd :: "ATCD \<Rightarrow> bool" where
"dwf_atcd dc = (\<forall> d. (case dc d of Some (vs, t, cs) \<Rightarrow> free_at t = set vs \<and> free_acc cs \<subseteq> set vs | None \<Rightarrow> True))"

function ti_unif_ae :: "ATCS \<Rightarrow> ATCV \<Rightarrow> AE \<Rightarrow> (AT * ((AT * AT) list))"
  where
"ti_unif_ae sc gc (AETup es) = (
  let results = map (ti_unif_ae sc gc) es in
  (ATProd (map fst results), concat (map snd results))
)" |
"ti_unif_ae sc gc (AEProj i e) = (
  let (t, cs) = ti_unif_ae sc gc e in
  case t of
    ATProd ts \<Rightarrow> (ts!i, cs) |
    _ \<Rightarrow> undefined
)" |
"ti_unif_ae sc gc (AEInj ts i e) = (
  let (t_e, cs) = ti_unif_ae sc gc e in
  (ATSum ts, (t_e, ts!i) # cs)
)" |
"ti_unif_ae sc gc (AEFold u t e) = (
  let (t_e, cs) = ti_unif_ae sc gc e in
  (ATMu u t, (at_subst (ATVar(u := ATMu u t)) t, t_e) # cs)
)" |
"ti_unif_ae sc gc (AEUnfold e) = (
  let (t_e, cs) = ti_unif_ae sc gc e in
  case t_e of
    ATMu u t \<Rightarrow> (at_subst (ATVar(u := ATMu u t)) t, cs) |
    _ \<Rightarrow> undefined
)" |
"ti_unif_ae sc gc (AELet x e1 e2) = (
  let (t1, cs1) = ti_unif_ae sc gc e1 in
  let (t2, cs2) = ti_unif_ae sc (gc(x := Some t1)) e2 in
  (t2, cs1 @ cs2)
)" |
"ti_unif_ae sc gc (AEMatch t_ret e_dis cases) = (
  let (t_e_dis, cs_e_dis) = ti_unif_ae sc gc e_dis in
  case t_e_dis of
    ATSum ts \<Rightarrow>
      let cs_cases =
        map
          (\<lambda> (t_case, x_case, e_case).
            let (t_ret_case, cs_case) = ti_unif_ae sc (gc(x_case := Some t_case)) e_case in
            (t_ret, t_ret_case) # cs_case)
          (zip ts cases)
      in (t_ret, cs_e_dis @ concat cs_cases)
    | _ \<Rightarrow> undefined
)" |
"ti_unif_ae sc gc (AELam a x t1 e1 y t2 e2 t3) = (
  let (t_e1, cs_e1) = ti_unif_ae sc gc e1 in
  let (t_e2, cs_e2) = ti_unif_ae sc ((\<lambda> _. None)(x := Some t1, y := Some t2)) e2 in
  (ATFun a t2 t3, (t_e1, t1) # (t_e2, t3) # (cs_e1 @ cs_e2))
)" |
"ti_unif_ae sc gc (AEApp a e1 e2) = (
  let (t_e1, cs_e1) = ti_unif_ae sc gc e1 in
  let (t_e2, cs_e2) = ti_unif_ae sc gc e2 in
  case t_e1 of
    ATFun _ t_arg t_ret \<Rightarrow> (t_ret, (t_e1, ATFun a t_e2 t_ret) # cs_e1 @ cs_e2)
    | _ \<Rightarrow> undefined
)" |
"ti_unif_ae sc gc (AEVar x) = (the (gc x), [])" |
"ti_unif_ae sc gc (AEDef d as) = (
  let (vs, t, _) = the (atcs_defs sc d) in
  (at_lsv_subst (lsv_inst vs as) t, [])
)" |
"ti_unif_ae sc gc (AESelf d t) =
  (t, [(atcs_self_t sc, t)])
"
by (pat_completeness) auto
termination apply(relation "measure (\<lambda> (_, _, e). size_AE e)") apply(auto)
   apply (meson Suc_n_not_le_n not_le_imp_less size_list_estimation')
proof -
  fix ts cases t_case x_case e_case t_ret e_dis
  assume triple_in: "(t_case :: AT, x_case :: Var, e_case :: AE) \<in> set (zip ts cases)"
  then have pair_in: "(x_case, e_case) \<in> set cases"
    by (meson in_set_zipE)
  then show "size_AE e_case
       < Suc (size_list (size_prod (\<lambda>x. 0) size_AE)
               cases +
              size_AT t_ret +
              size_AE e_dis)"
  proof(induct cases arbitrary: t_ret e_dis x_case e_case)
    case Nil
    then show ?case by auto
  next
    case (Cons cases_hd cases_tl)
    then show ?case
    proof(cases "cases_hd = (x_case, e_case)")
      case True
      then show ?thesis
        by simp
    next
      case False
      have "(x_case, e_case) \<in> set cases_tl"
        using False Cons.prems by auto
      then show ?thesis
        using Cons.hyps apply(auto)
        by (metis add_Suc_right group_cancel.add1 less_SucI trans_less_add2)
    qed
  qed
qed

fun eq_sat :: "('a * 'a) \<Rightarrow> bool" where
"eq_sat (x, y) = (x = y)"

fun eqs_sat :: "('a * 'a) list \<Rightarrow> bool" where
"eqs_sat ps = (\<forall> p \<in> set ps. eq_sat p)"

fun eq_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> (AT * AT) \<Rightarrow> (AT * AT)" where
"eq_lsv_subst m (t1, t2) = (at_lsv_subst m t1, at_lsv_subst m t2)"

fun lsvar_eq_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> (LSVar * LSVar) \<Rightarrow> (ALS * ALS)" where
"lsvar_eq_lsv_subst m (v1, v2) = (m v1, m v2)"

fun eqs_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> (AT * AT) list \<Rightarrow> (AT * AT) list" where
"eqs_lsv_subst m ps = map (eq_lsv_subst m) ps"

fun lsvar_eqs_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> (LSVar * LSVar) list \<Rightarrow> (ALS * ALS) list" where
"lsvar_eqs_lsv_subst m ps = map (lsvar_eq_lsv_subst m) ps"

fun atcv_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> ATCV \<Rightarrow> ATCV" where
"atcv_lsv_subst m gc = (map_option (at_lsv_subst m)) \<circ> gc"

fun atcs_lsv_subst :: "(LSVar \<Rightarrow> ALS) \<Rightarrow> ATCS \<Rightarrow> ATCS" where
"atcs_lsv_subst m (ATCS dc self_d self_t) = (ATCS dc self_d (at_lsv_subst m self_t))"

lemma ti_unif_ae_refine: "
  tj_se sc gc e0 t0 \<Longrightarrow>
  rj_stcs_atcs sc sc' \<Longrightarrow>
  rj_stcv_atcv gc gc' \<Longrightarrow>
  rj_se_ae e0 e0' \<Longrightarrow>
  rj_st_at t0 (fst (ti_unif_ae sc' gc' e0'))
"
(
  is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?result t0 sc' gc' e0'"
  is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> rj_st_at t0 ?t0'"
)
proof(induct e0 arbitrary: e0' sc sc' gc gc' t0)
  case (SETup es)
  obtain ts where ts_obtain: "t0 = STProd ts"
    using SETup.prems(1) apply(auto) done
  obtain es' where es'_obtain: "e0' = AETup es'"
    using SETup.prems(4) apply(case_tac e0') apply(auto) done
  have es_length: "length es = length es'"
    using es'_obtain SETup.prems(4) apply(auto) done
  have ts_length: "length ts = length es'"
    using es_length ts_obtain SETup.prems(1) apply(auto) done
  have "\<And>i. i < length es' \<Longrightarrow> ?result (ts!i) sc' gc' (es'!i)"
    (is "\<And>i. ?i_length i \<Longrightarrow> ?conclusion i")
  proof -
    fix i
    assume i_length: "?i_length i"
    show "?conclusion i"
    proof(rule SETup.hyps)
      show "es!i \<in> set es" using i_length es_length apply(auto) done
      show "tj_se sc gc (es!i) (ts!i)"
        using es_length ts_length i_length SETup.prems(1) ts_obtain apply(auto)
        by (simp add: list_all2I list_all2_nthD)
      show "rj_stcs_atcs sc sc'" using SETup.prems(2) apply(auto) done
      show "rj_stcv_atcv gc gc'" using SETup.prems(3) apply(auto) done
      show "rj_se_ae (es!i) (es'!i)"
        using es'_obtain i_length SETup.prems(4) apply(auto) done
    qed
  qed
  then show ?case
    using ts_obtain es'_obtain ts_length apply(auto)
    by (simp add: nth_equalityI)
next
  case (SEProj i e)
  obtain ts where ts_obtain: "i < length ts \<and> tj_se sc gc e (STProd ts) \<and> t0 = ts!i"
    using SEProj.prems by auto
  obtain e' where e'_obtain: "e0' = AEProj i e'"
    using SEProj.prems by(case_tac e0', auto)
  have "?result (STProd ts) sc' gc' e'"
  proof(rule SEProj.hyps)
    show "tj_se sc gc e (STProd ts)" using ts_obtain by auto
    show "rj_stcs_atcs sc sc'" using SEProj.prems(2) by auto
    show "rj_stcv_atcv gc gc'" using SEProj.prems(3) by auto
    show "rj_se_ae e e'" using SEProj.prems(4) e'_obtain by auto
  qed
  then show ?case
    using ts_obtain e'_obtain
    apply(auto) apply(simp add: split_def) apply(case_tac "fst (ti_unif_ae sc' gc' e')") by auto
next
  case (SEInj ts i e)
  obtain e' ts' where e'_ts'_obtain: "e0' = AEInj ts' i e' \<and> ts = map strip_at ts' \<and> rj_se_ae e e'"
    using SEInj.prems(4)
    apply(case_tac e0') apply(auto) done
  show ?case
    using e'_ts'_obtain SEInj.prems
    apply(auto) apply(case_tac "ti_unif_ae sc' gc' e'") by auto
next
  case (SEFold u t e)
  obtain e' t' where e'_t'_obtain: "e0' = AEFold u t' e' \<and> rj_st_at t t' \<and> rj_se_ae e e'"
    using SEFold.prems(4)
    apply(case_tac e0') apply(auto) done
  show ?case
    using e'_t'_obtain SEFold.prems
    apply(auto) apply(case_tac "ti_unif_ae sc' gc' e'") apply(auto) done
next
  case (SEUnfold e)
  obtain u t where u_t_obtain: "tj_se sc gc e (STMu u t) \<and> t0 = (st_subst (STVar(u := STMu u t)) t)"
    using SEUnfold.prems apply(auto) done
  obtain e' where e'_obtain: "e0' = AEUnfold e' \<and> rj_se_ae e e'"
    using SEUnfold.prems apply(case_tac e0') apply(auto) done
  have result_t_e': "?result (STMu u t) sc' gc' e'"
    using SEUnfold.hyps SEUnfold.prems(2) SEUnfold.prems(3) e'_obtain u_t_obtain by blast
  let ?t0' = "fst (ti_unif_ae sc' gc' e0')"
  let ?e'_unif_ty = "fst (ti_unif_ae sc' gc' e')"
  obtain t' where t'_obtain: "?e'_unif_ty = ATMu u t'"
    using result_t_e' apply(case_tac ?e'_unif_ty) apply(auto) done
  have t0'_decomp: "?t0' = at_subst (ATVar(u := ATMu u t')) t'"
    using t'_obtain e'_obtain apply(auto) apply(simp add: split_def) done
  have "
    st_subst
     (STVar(u := STMu u (strip_at t')))
     (strip_at t') =
    st_subst
     (strip_at \<circ> ATVar(u := ATMu u t'))
     (strip_at t')"
    by (metis comp_def fun_upd_def strip_at.simps(4) strip_at.simps(5))
  then show ?case
    using t0'_decomp t'_obtain u_t_obtain result_t_e' at_mu_subst_preserve_strip apply(auto) done
next
  case (SELet x e1 e2)
  obtain t1 where t1_t2_obtain: "tj_se sc gc e1 t1 \<and> tj_se sc (gc(x := Some t1)) e2 t0"
    using SELet.prems apply(auto) done
  obtain e1' e2' where e1'_e2'_obtain: "e0' = AELet x e1' e2' \<and> rj_se_ae e1 e1'\<and> rj_se_ae e2 e2'"
    using SELet.prems apply(case_tac e0') apply(auto) done
  let ?t1' = "fst (ti_unif_ae sc' gc' e1')"
  have result_1: "?result t1 sc' gc' e1'"
    using SELet.hyps(1) SELet.prems(2) SELet.prems(3) e1'_e2'_obtain t1_t2_obtain by blast
  have result_2: "?result t0 sc' (gc'(x := Some ?t1')) e2'"
  proof(rule SELet.hyps(2))
    show "tj_se sc (gc(x := Some t1)) e2 t0" using t1_t2_obtain apply(auto) done
    show "rj_stcs_atcs sc sc'" using SELet.prems apply(auto) done
    show "rj_stcv_atcv (gc(x := Some t1)) (gc'(x := Some ?t1'))"
      using result_1 SELet.prems(3) apply(auto) done
    show "rj_se_ae e2 e2'" using e1'_e2'_obtain apply(auto) done
  qed
  show ?case
    using result_2 e1'_e2'_obtain SELet.prems(4) apply(auto) apply(simp add: split_def)
    by (metis fun_upd_other fun_upd_same)
next
  case (SEMatch t_ret e_dis cases)
  obtain t'_ret e'_dis cases' where
    e0'_decomp: "e0' = AEMatch t'_ret e'_dis cases'" and
    e'_dis_refine: "rj_se_ae e_dis e'_dis"
    using SEMatch.prems(4) apply(case_tac e0') apply(auto) done
  obtain ts where ts_obtain: "tj_se sc gc e_dis (STSum ts) \<and> length ts = length cases"
    using SEMatch.prems(1) apply(auto) done
  let ?e'_dis_unif_ty = "(fst (ti_unif_ae sc' gc' e'_dis))"
  have "rj_st_at (STSum ts) ?e'_dis_unif_ty"
    using SEMatch.hyps(1) SEMatch.prems e'_dis_refine ts_obtain apply(blast) done
  then obtain ts' where ts'_obtain: "?e'_dis_unif_ty = ATSum ts'"
    apply(case_tac ?e'_dis_unif_ty) apply(auto) done
  then show ?case
    using SEMatch.prems e0'_decomp apply(auto) apply(simp add: split_def) done
next
  case (SELam x t1 e1 y t2 e2 t3)
  obtain a t1' e1' t2' e2' t3' where e0'_decomp: "e0' = AELam a x t1' e1' y t2' e2' t3'"
    using SELam.prems(4) apply(case_tac e0') apply(auto) done
  show ?case
    using e0'_decomp SELam.prems(1,4) apply(auto) apply(simp add: split_def) done
next
  case (SEApp e1 e2)
  obtain a e1' e2' where e0'_decomp: "e0' = AEApp a e1' e2'"
    using SEApp.prems(4) apply(case_tac e0') apply(auto) done
  obtain t_arg where t_arg_obtain: "tj_se sc gc e1 (STFun t_arg t0) \<and> tj_se sc gc e2 t_arg"
    using SEApp.prems(1) apply(auto) done
  have result_1: "?result (STFun t_arg t0) sc' gc' e1'"
    using SEApp.hyps(1) e0'_decomp t_arg_obtain SEApp.prems by fastforce
  show ?case
    using result_1 e0'_decomp
    apply(auto) apply(simp add: split_def) apply(case_tac "fst (ti_unif_ae sc' gc' e1')") by auto
next
  case (SEVar x)
  obtain x' where x'_obtain: "e0' = AEVar x'"
    using SEVar.prems by(case_tac e0', auto)
  then have "rj_st_at (the (gc x)) (the (gc' x'))"
    using SEVar.prems by auto
  then show ?case using x'_obtain SEVar.prems
    by (metis tj_se_var fst_conv option.sel ti_unif_ae.simps(10))
next
  case (SEDef d)
  obtain a where a_obtain: "e0' = AEDef d a"
    using SEDef.prems(4) apply(case_tac e0') apply(auto) done
  show ?case
    using a_obtain at_lsv_subst_preserve_strip SEDef.prems apply(auto) done
next
  case (SESelf d t)
  obtain t' where t'_obtain: "e0' = AESelf d t' \<and> rj_st_at t t'"
    using SESelf.prems apply(case_tac e0') apply(auto) done
  show ?case
    using t'_obtain SESelf.prems apply(auto) done
qed

lemma at_lsv_mu_subst_comm: "at_lsv_subst m1 (at_subst m2 t) = at_subst (at_lsv_subst m1 \<circ> m2) (at_lsv_subst m1 t)"
  apply(induct t arbitrary: m1 m2) apply(auto)
  by (metis (no_types, lifting) at_lsv_subst.simps(5) fun_upd_comp)

fun lsv_subst_free_als :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> ALS \<Rightarrow> bool" where
"lsv_subst_free_als vs as m a = (free_als a \<subseteq> set vs \<longrightarrow>
    als_lsv_subst m (als_lsv_subst (lsv_inst vs as) a) = als_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) a)"

fun lsv_subst_free_at :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> AT \<Rightarrow> bool" where
"lsv_subst_free_at vs as m t = (free_at t \<subseteq> set vs \<longrightarrow>
    at_lsv_subst m (at_lsv_subst (lsv_inst vs as) t) = at_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) t)"

fun lsv_subst_free_ae :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> AE \<Rightarrow> bool" where
"lsv_subst_free_ae vs as m e = (free_ae e \<subseteq> set vs \<longrightarrow>
    ae_lsv_subst m (ae_lsv_subst (lsv_inst vs as) e) = ae_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) e)"

fun lsv_subst_free_al :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> AL \<Rightarrow> bool" where
"lsv_subst_free_al vs as m (_, t1, _, t2, e, t3) = (
    lsv_subst_free_at vs as m t1 \<and>
    lsv_subst_free_at vs as m t2 \<and>
    lsv_subst_free_ae vs as m e \<and>
    lsv_subst_free_at vs as m t3)"

lemma lsv_subst_free:
  assumes
    length_vs_as: "length vs = length as"
  shows
    "lsv_subst_free_als vs as m a \<and> lsv_subst_free_at vs as m t \<and> lsv_subst_free_ae vs as m e"
proof(induct rule: ALS_AT_AE.induct)
  case (ALSVar v)
  show ?case
    using length_vs_as
  proof(induct vs arbitrary: as)
    case Nil
    then show ?case apply(auto) done
  next
    case (Cons head_vs tail_vs)
    obtain head_as tail_as where ht_obtain: "head_as # tail_as = as \<and> length tail_as = length tail_vs"
      using Cons.prems apply(auto)
      by (metis Suc_length_conv)
    show ?case
      using ht_obtain Cons.hyps apply(case_tac "head_vs = v") apply(auto) done
  qed
next
  case (ALSSet s)
  have result_i: "\<And>i. i < length s \<Longrightarrow> lsv_subst_free_al vs as m (s!i)"
  proof -
    fix i
    assume i_bound: "i < length s"
    obtain x t1 y t2 e t3 where decomp: "(s!i) = (x, t1, y, t2, e, t3)"
      apply(case_tac "(s!i)") apply(auto) done
    have result_t1: "lsv_subst_free_at vs as m t1"
      using ALSSet.prems ALSSet.hyps(1) i_bound decomp apply(auto) by (metis nth_mem)
    have result_t2: "lsv_subst_free_at vs as m t2"
      using ALSSet.prems ALSSet.hyps(2) i_bound decomp apply(auto) by (metis nth_mem)
    have result_e: "lsv_subst_free_ae vs as m e"
      using ALSSet.prems ALSSet.hyps(3) i_bound decomp apply(auto) by (metis nth_mem)
    have result_t3: "lsv_subst_free_at vs as m t3"
      using ALSSet.prems ALSSet.hyps(4) i_bound decomp apply(auto) by (metis nth_mem)
    show "?thesis i"
      using result_t1 result_t2 result_e result_t3 decomp apply(auto) done
  qed
  have result_i': "\<And>i.
    i < length s \<Longrightarrow>
    free_als (ALSSet s) \<subseteq> set vs \<Longrightarrow>
      al_lsv_subst m (al_lsv_subst (lsv_inst vs as) (s!i)) =
      al_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) (s!i)"
  proof -
    fix i
    assume i_bound: "i < length s"
    assume subset: "free_als (ALSSet s) \<subseteq> set vs"
    obtain x t1 y t2 e t3 where decomp: "(s!i) = (x, t1, y, t2, e, t3)"
      apply(case_tac "(s!i)") apply(auto) done
    have "(s!i) \<in> set s"
      using i_bound by auto
    then have "free_al (s!i) \<subseteq> set vs"
      using i_bound subset decomp apply(induct s arbitrary: i)
       apply(auto)[1]
      apply (case_tac i)
      apply(auto)
      by blast
    then show "?thesis i"
      using result_i i_bound decomp apply(auto) by (force,force,force,force)
  qed
  have "free_als (ALSSet s) \<subseteq> set vs \<Longrightarrow>
    map (\<lambda> l. al_lsv_subst m (al_lsv_subst (lsv_inst vs as) l)) s =
      map (\<lambda> l. al_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) l) s"
    using result_i' by (metis (no_types, lifting) in_set_conv_nth map_cong)
  then show ?case
    apply(simp only: lsv_subst_free_als.simps als_lsv_subst.simps al_lsv_subst.simps map_map comp_def split_def)
    by fastforce
next
  case (ALSMuVar x)
  then show ?case apply(auto) done
next
  case (ALSMu x1 x2)
  then show ?case apply(auto) done
next
  case (ATFun x1 x2 x3)
  then show ?case apply(auto) done
next
  case (ATProd ts)
  then show ?case apply(induct ts) apply(auto) done
next
  case (ATSum ts)
  then show ?case apply(induct ts) apply(auto) done
next
  case (ATMu x1 x2)
  then show ?case apply(auto) done
next
  case (ATVar x)
  then show ?case apply(auto) done
next
  case (AETup es)
  then show ?case apply(induct es) apply(auto) done
next
  case (AEProj x1 x2)
  then show ?case apply(auto) done
next
  case (AEInj ts i e)
  then show ?case apply(induct ts) apply(auto) done
next
  case (AEFold x1 x2 x3)
  then show ?case apply(auto) done
next
  case (AEUnfold x)
  then show ?case apply(auto) done
next
  case (AELet x1 x2 x3)
  then show ?case apply(auto) done
next
  case (AEMatch t_ret e_dis cases)
  then show ?case
    apply(induct cases)
     apply(auto)
     apply(blast)
    by fastforce
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case apply(auto) done
next
  case (AEApp x1 x2 x3)
  then show ?case apply(auto) done
next
  case (AEVar x)
  then show ?case apply(auto) done
next
  case (AEDef d as)
  then show ?case apply(induct as) apply(auto) done
next
  case (AESelf x1 x2)
  then show ?case apply(auto) done
qed

fun lsv_subst_free_alsc :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> ALSC \<Rightarrow> bool" where
"lsv_subst_free_alsc vs as m c = (free_alsc c \<subseteq> set vs \<longrightarrow>
    alsc_lsv_subst m (alsc_lsv_subst (lsv_inst vs as) c) = alsc_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) c)"

lemma lsv_subst_free_alsc: "length as = length vs \<Longrightarrow> lsv_subst_free_alsc vs as m c"
  apply(case_tac c)
  apply(simp only: lsv_subst_free_alsc.simps)
  using lsv_subst_free by auto

fun lsv_subst_free_alsc_all :: "LSVar list \<Rightarrow> ALS list \<Rightarrow> (LSVar \<Rightarrow> ALS) \<Rightarrow> ACC \<Rightarrow> bool" where
"lsv_subst_free_alsc_all vs as m cc = (free_acc cc \<subseteq> set vs \<longrightarrow>
    alsc_lsv_subst_all m (alsc_lsv_subst_all (lsv_inst vs as) cc) = alsc_lsv_subst_all (lsv_inst vs (map (als_lsv_subst m) as)) cc)"

lemma lsv_subst_free_alsc_all: "length as = length vs \<Longrightarrow> lsv_subst_free_alsc_all vs as m cc"
  apply(induct cc)
   apply simp
  using lsv_subst_free_alsc by auto

lemma ti_unif_ae_subst: "
  rj_stcs_atcs sc sc' \<Longrightarrow>
  rj_stcv_atcv gc gc' \<Longrightarrow>
  rj_se_ae e0 e0' \<Longrightarrow>
  tj_se sc gc e0 t0 \<Longrightarrow>
  eqs_sat (eqs_lsv_subst m cs) \<Longrightarrow>
  (t0', cs) = ti_unif_ae sc' gc' e0' \<Longrightarrow>
  dwf_ae (atcs_defs sc') e0' \<Longrightarrow>
  dwf_atcd (atcs_defs sc') \<Longrightarrow>
    tj_ae
      (atcs_lsv_subst m sc')
      (atcv_lsv_subst m gc')
      (ae_lsv_subst m e0')
      (at_lsv_subst m t0')
"
(is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?result m sc' gc' e0' t0'")
proof(induct e0 arbitrary: e0' sc sc' gc gc' t0 t0' cs m)
  case (SETup es)
  obtain ts where ts_obtain: "t0 = STProd ts"
    using SETup.prems(4) by(auto)
  obtain es' where es'_obtain: "e0' = AETup es' \<and> es = map strip_ae es'"
    using SETup.prems(3) apply(case_tac e0') by(auto)
  obtain ts' where ts'_obtain: "t0' = ATProd ts'"
    using es'_obtain SETup.prems(6) by(auto)
  have "\<And>i. i < length es' \<Longrightarrow> ?result m sc' gc' (es'!i) (ts'!i)"
    (is "\<And>i. ?i_length i \<Longrightarrow> ?conclusion i")
  proof -
    fix i
    assume i_length: "?i_length i"
    then have i_length_es: "i < length es" using es'_obtain by auto
    show "?conclusion i"
    proof(rule SETup.hyps(1))
      show "es!i \<in> set es" using i_length es'_obtain by auto
      show "rj_stcs_atcs sc sc'" using SETup.prems(1) by auto
      show "rj_stcv_atcv gc gc'" using SETup.prems(2) by auto
      show "rj_se_ae (es!i) (es'!i)" using i_length es'_obtain by auto
      have "(es ! i, ts ! i) \<in> set (zip es ts)"
        using i_length ts_obtain i_length_es SETup.prems(4) apply(simp add: split_def)
        by (metis fst_conv in_set_zip snd_conv)
      then show "tj_se sc gc (es!i) (ts!i)"
        using SETup.prems(4) ts_obtain by(auto)
      let ?cs_i = "snd (ti_unif_ae sc' gc' (es'!i))"
      have "es' ! i \<in> set es'"
        using i_length by auto
      then have "set ?cs_i \<subseteq> set cs"
        using SETup.prems(6) es'_obtain apply(simp add: split_def)
        by blast
      then show "eqs_sat (eqs_lsv_subst m ?cs_i)" using SETup.prems(5) apply(simp add: split_def)
        by blast
      show "(ts' ! i, ?cs_i) = ti_unif_ae sc' gc' (es' ! i)"
        using i_length ts'_obtain es'_obtain SETup.prems(6) by(auto)
      show "dwf_ae (atcs_defs sc') (es' ! i)"
        using SETup.prems(7) i_length es'_obtain by auto
      show "dwf_atcd (atcs_defs sc')"
        using SETup.prems(8) by auto
    qed
  qed
  then show ?case
    using es'_obtain ts'_obtain apply(auto)
    using SETup.prems(6) apply(simp)
    (* TODO: whether this works is non-deterministic *)
    by (smt (verit, best) fst_conv in_set_zip length_map nth_map snd_conv)
next
  case (SEProj i e)
  obtain ts where ts_obtain: "i < length ts \<and> tj_se sc gc e (STProd ts) \<and> t0 = ts ! i"
    using SEProj.prems(4) by(auto)
  obtain e' where e'_obtain: "e0' = AEProj i e' \<and> rj_se_ae e e'"
    using SEProj.prems(3) by(case_tac e0', auto)
  let ?t' = "fst (ti_unif_ae sc' gc' e')"
  have t'_refine: "rj_st_at (STProd ts) ?t'"
    using SEProj.prems ts_obtain e'_obtain ti_unif_ae_refine by auto
  obtain ts' where ts'_obtain: "?t' = ATProd ts' \<and> ts = map strip_at ts'"
    using t'_refine by(case_tac ?t', auto)
  have e'_type: "?result m sc' gc' e' ?t'"
  proof(rule SEProj.hyps)
    show "rj_stcs_atcs sc sc'" using SEProj.prems by auto
    show "rj_stcv_atcv gc gc'" using SEProj.prems by auto
    show "rj_se_ae e e'" using e'_obtain by auto
    show "tj_se sc gc e (STProd ts)" using ts_obtain by auto
    show "eqs_sat (eqs_lsv_subst m cs)" using SEProj.prems by auto
    show "(?t', cs) = ti_unif_ae sc' gc' e'"
      using SEProj.prems(6) e'_obtain ts_obtain ts'_obtain apply(auto) apply(simp add: split_def)
      by (metis prod.exhaust_sel)
    show "dwf_ae (atcs_defs sc') e'"
      using e'_obtain SEProj.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEProj.prems(8) by auto
  qed
  then show ?case
    using e'_obtain ts'_obtain SEProj.prems(6) apply(auto) apply(simp add: split_def)
    by (metis length_map nth_map ts_obtain)
next
  case (SEInj ts i e)
  have e_type: "tj_se sc gc e (ts ! i)" using SEInj.prems(4) by(auto)
  obtain ts' e' where ts'_e'_obtain: "e0' = AEInj ts' i e' \<and> ts = map strip_at ts' \<and> rj_se_ae e e'"
    using SEInj.prems(3) by(case_tac e0', auto)
  let ?t' = "fst (ti_unif_ae sc' gc' e')"
  let ?cs_e' = "snd (ti_unif_ae sc' gc' e')"
  have e'_type: "?result m sc' gc' e' ?t'"
  proof(rule SEInj.hyps)
    show "rj_stcs_atcs sc sc'" using SEInj.prems by auto
    show "rj_se_ae e e'" using ts'_e'_obtain  by auto
    show "rj_stcv_atcv gc gc'" using SEInj.prems by auto
    show "tj_se sc gc e (ts ! i)" using e_type by auto
    have "set ?cs_e' \<subseteq> set cs"
      using SEInj.prems(6) ts'_e'_obtain apply(auto) by(simp add: split_def)
    then show "eqs_sat (eqs_lsv_subst m ?cs_e')" using SEInj.prems(5) by(auto)
    show "(?t', ?cs_e') = ti_unif_ae sc' gc' e'" by auto
    show "dwf_ae (atcs_defs sc') e'"
      using ts'_e'_obtain SEInj.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEInj.prems(8) by auto
  qed
  have t'_compat: "at_lsv_subst m (ts' ! i) = at_lsv_subst m ?t'"
    using SEInj.prems(5) SEInj.prems(6) ts'_e'_obtain apply(auto) by(simp add: split_def)
  have "?result m sc' gc' (AEInj ts' i e') (ATSum ts')"
    using SEInj.prems ts'_e'_obtain e'_type t'_compat by auto
  then show ?case
    using SEInj.prems ts'_e'_obtain apply(auto) by(simp add: split_def)
next
  case (SEFold u t e)
  have t0_decomp: "t0 = STMu u t"
    using SEFold.prems(4) by(auto)
  have e_type: "tj_se sc gc e (st_subst (STVar(u := STMu u t)) t)"
    using SEFold.prems(4) by(auto)
  obtain t' e' where t'_e'_obtain: "e0' = AEFold u t' e' \<and> rj_st_at t t' \<and> rj_se_ae e e'"
    using SEFold.prems(3) by(case_tac e0', auto)
  let ?e'_ty = "fst (ti_unif_ae sc' gc' e')"
  have sub_eq: "(at_lsv_subst m (at_subst (ATVar(u := ATMu u t')) t')) = at_lsv_subst m ?e'_ty"
    using SEFold.prems(5,6) t'_e'_obtain apply(auto) by(simp add: split_def)
  let ?e'_cs = "snd (ti_unif_ae sc' gc' e')"
  have sub_result: "?result m sc' gc' e' ?e'_ty"
  proof(rule SEFold.hyps)
    show "rj_stcs_atcs sc sc'" using SEFold.prems by auto
    show "rj_stcv_atcv gc gc'" using SEFold.prems by auto
    show "rj_se_ae e e'" using t'_e'_obtain by auto
    show "tj_se sc gc e (st_subst (STVar(u := STMu u t)) t)" using e_type by auto
    show "eqs_sat (eqs_lsv_subst m ?e'_cs)"
      using SEFold.prems(5,6) t'_e'_obtain apply(simp add: split_def) apply(auto)
      by (metis (no_types, lifting) eq_lsv_subst.simps eq_sat.simps list.set_intros(2) snd_conv)
    show "(?e'_ty, ?e'_cs) = ti_unif_ae sc' gc' e'" by auto
    show "dwf_ae (atcs_defs sc') e'"
      using t'_e'_obtain SEFold.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEFold.prems(8) by auto
  qed
  have t0'_decomp: "t0' = ATMu u t'"
    using t'_e'_obtain SEFold.prems(6) apply(simp add: split_def)
    by (metis (no_types, lifting) fst_conv)
  have subst_exchange: "at_lsv_subst m (at_subst (ATVar(u := ATMu u t')) t') = at_subst (at_lsv_subst m \<circ> (ATVar(u := ATMu u t'))) (at_lsv_subst m t')"
    using at_lsv_mu_subst_comm by auto
  have subst_exchange_full: "at_lsv_subst m (at_subst (ATVar(u := ATMu u t')) t') = at_subst (ATVar(u := ATMu u (at_lsv_subst m t'))) (at_lsv_subst m t')"
    using subst_exchange apply(auto)
    apply(simp add: comp_def fun_upd_def if_distrib) by(simp only: at_lsv_subst.simps)
  have subst_e'_ty: "
    tj_ae
      (atcs_lsv_subst m sc')
      (atcv_lsv_subst m gc')
      (ae_lsv_subst m e')
      (at_subst (ATVar(u := ATMu u (at_lsv_subst m t'))) (at_lsv_subst m t'))"
    using subst_exchange_full sub_result sub_eq
    by (metis (mono_tags, lifting))
  show ?case
    using t0'_decomp t'_e'_obtain apply(simp only: tj_ae.simps ae_lsv_subst.simps at_lsv_subst.simps)
    using subst_e'_ty by simp
next
  case (SEUnfold e)
  obtain e' where e'_obtain: "e0' = AEUnfold e' \<and> rj_se_ae e e'"
    using SEUnfold.prems(3) by(case_tac e0', auto)
  obtain u t where u_t_obtain: "tj_se sc gc e (STMu u t) \<and> t0 = st_subst (STVar(u := STMu u t)) t"
    using SEUnfold.prems(4) by(case_tac t0, auto)
  let ?e'_ty = "fst (ti_unif_ae sc' gc' e')"
  have e'_ty_refine: "rj_st_at (STMu u t) ?e'_ty"
  proof(rule ti_unif_ae_refine)
    show "tj_se sc gc e (STMu u t)" using u_t_obtain by auto
    show "rj_stcs_atcs sc sc'" using SEUnfold.prems by auto
    show "rj_stcv_atcv gc gc'" using SEUnfold.prems by auto
    show "rj_se_ae e e'" using e'_obtain by auto
  qed
  obtain t' where t'_obtain: "?e'_ty = ATMu u t' \<and> rj_st_at t t'"
    using e'_ty_refine by(case_tac ?e'_ty, auto)
  let ?e'_cs = "snd (ti_unif_ae sc' gc' e')"
  have sub_result: "?result m sc' gc' e' ?e'_ty"
  proof(rule SEUnfold.hyps)
    show "rj_stcs_atcs sc sc'" using SEUnfold.prems by auto
    show "rj_stcv_atcv gc gc'" using SEUnfold.prems by auto
    show "rj_se_ae e e'" using e'_obtain by auto
    show "tj_se sc gc e (STMu u t)" using u_t_obtain by auto
    show "eqs_sat (eqs_lsv_subst m ?e'_cs)"
      using SEUnfold.prems(5,6) e'_obtain e'_ty_refine t'_obtain by(simp add: split_def)
    show "(?e'_ty, ?e'_cs) = ti_unif_ae sc' gc' e'" by auto
    show "dwf_ae (atcs_defs sc') e'"
      using e'_obtain SEUnfold.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEUnfold.prems(8) by auto
  qed
  show ?case
    using e'_obtain proof(simp only: tj_ae.simps ae_lsv_subst.simps, intro exI conjI)
    show "tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc') (ae_lsv_subst m e') (ATMu u (at_lsv_subst m t'))"
      using sub_result at_lsv_mu_subst_comm apply(auto)
      by (metis at_lsv_subst.simps(4) atcv_lsv_subst.simps sub_result t'_obtain)
    show "at_lsv_subst m t0' = at_subst (ATVar(u := ATMu u (at_lsv_subst m t'))) (at_lsv_subst m t')"
      using t'_obtain SEUnfold.prems(6) e'_obtain apply(simp add: split_def)
      using at_lsv_mu_subst_comm apply(auto)
      by (metis at_lsv_subst.simps(4) at_lsv_subst.simps(5) comp_apply fun_upd_apply)
  qed
next
  case (SELet x e1 e2)
  obtain e1' e2' where e1'_e2'_obtain: "e0' = AELet x e1' e2' \<and> rj_se_ae e1 e1' \<and> rj_se_ae e2 e2'"
    using SELet.prems(3) apply(case_tac e0') apply(auto) done
  obtain t1 where t1_obtain: "tj_se sc gc e1 t1 \<and> tj_se sc (gc(x := Some t1)) e2 t0"
    using SELet.prems(4) apply(auto) done
  let ?t1' = "fst (ti_unif_ae sc' gc' e1')"
  let ?e1'_cs = "snd (ti_unif_ae sc' gc' e1')"
  have result_1: "?result m sc' gc' e1' ?t1'"
  proof(rule SELet.hyps(1))
    show "rj_stcs_atcs sc sc'" using SELet.prems by auto
    show "rj_stcv_atcv gc gc'" using SELet.prems by auto
    show "rj_se_ae e1 e1'" using e1'_e2'_obtain by auto
    show "tj_se sc gc e1 t1" using t1_obtain by auto
    have "set ?e1'_cs \<subseteq> set cs" using SELet.prems(6) e1'_e2'_obtain apply(auto) apply(simp add: split_def) done
    then show "eqs_sat (eqs_lsv_subst m ?e1'_cs)" using SELet.prems(5) apply(auto) done
    show "(?t1', ?e1'_cs) = ti_unif_ae sc' gc' e1'" by auto
    show "dwf_ae (atcs_defs sc') e1'" using e1'_e2'_obtain SELet.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')" using SELet.prems(8) by auto
  qed
  let ?t2' = "fst (ti_unif_ae sc' (gc'(x := Some ?t1')) e2')"
  let ?e2'_cs = "snd (ti_unif_ae sc' (gc'(x := Some ?t1')) e2')"
  have result_2: "?result m sc' (gc'(x := Some ?t1')) e2' ?t2'"
  proof(rule SELet.hyps(2))
    show "rj_stcs_atcs sc sc'" using SELet.prems by auto
    have "rj_st_at t1 ?t1'"
    proof(rule ti_unif_ae_refine)
      show "tj_se sc gc e1 t1" using t1_obtain by auto
      show "rj_stcs_atcs sc sc'" using SELet.prems by auto
      show "rj_stcv_atcv gc gc'" using SELet.prems by auto
      show "rj_se_ae e1 e1'" using e1'_e2'_obtain by auto
    qed
    then show "rj_stcv_atcv (gc(x := Some t1)) (gc'(x := Some ?t1'))"
      using SELet.prems(2) result_1 apply(auto) done
    show "rj_se_ae e2 e2'" using e1'_e2'_obtain by auto
    show "tj_se sc (gc(x := Some t1)) e2 t0" using t1_obtain by auto
    show "eqs_sat (eqs_lsv_subst m ?e2'_cs)"
      using SELet.prems(5,6) e1'_e2'_obtain apply(auto) apply(simp add: split_def) apply(auto)
      by (metis Un_iff eq_lsv_subst.simps eq_sat.simps)
    show "(?t2', ?e2'_cs) = ti_unif_ae sc' (gc'(x := Some ?t1')) e2'" by auto
    show "dwf_ae (atcs_defs sc') e2'" using e1'_e2'_obtain SELet.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')" using SELet.prems(8) by auto
  qed
  have gc'_no_shadow: "gc' x = None"
    using SELet.prems(2,4) apply(auto) done
  show ?case
    using e1'_e2'_obtain apply(simp only: tj_ae.simps ae_lsv_subst.simps)
  proof(intro exI; intro conjI)
    show "atcv_lsv_subst m gc' x = None"
      using gc'_no_shadow by auto
    show "tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc') (ae_lsv_subst m e1') (at_lsv_subst m ?t1')"
      using result_1 .
    show "tj_ae (atcs_lsv_subst m sc') ((atcv_lsv_subst m gc')(x := Some (at_lsv_subst m ?t1'))) (ae_lsv_subst m e2') (at_lsv_subst m t0')"
      using result_2 SELet.prems(6) e1'_e2'_obtain apply(auto) apply(simp add: split_def)
      by (metis atcv_lsv_subst.simps map_option_o_map_upd result_2)
  qed
next
  case (SEMatch t_ret e_dis cases)
  obtain t_ret' e_dis' cases'
    where t_ret'_e_dis'_cases'_obtain: "
      e0' = AEMatch t_ret' e_dis' cases' \<and>
      rj_st_at t_ret t_ret' \<and>
      rj_se_ae e_dis e_dis' \<and>
      cases = map (\<lambda> (x, e'). (x, strip_ae e')) cases'
    "
    using SEMatch.prems(3) by(case_tac e0', auto)
  obtain ts
    where ts_obtain: "
      tj_se sc gc e_dis (STSum ts) \<and>
      length ts = length cases \<and>
      (\<forall> i. i < length cases \<longrightarrow> (gc (fst (cases ! i)) = None \<and> tj_se sc (gc(fst (cases ! i) := Some (ts ! i))) (snd (cases ! i)) t_ret))
    "
    using SEMatch.prems(4) apply(auto, simp add: split_def)
    by (metis fst_conv in_set_zip snd_conv)
  let ?e_dis'_infer = "ti_unif_ae sc' gc' e_dis'"
  let ?e_dis'_ty = "fst ?e_dis'_infer"
  let ?e_dis'_cs = "snd ?e_dis'_infer"
  have e_dis'_ty_refine: "rj_st_at (STSum ts) ?e_dis'_ty"
  proof(rule ti_unif_ae_refine)
    show "tj_se sc gc e_dis (STSum ts)" using ts_obtain by auto
    show "rj_stcs_atcs sc sc'" using SEMatch.prems by auto
    show "rj_stcv_atcv gc gc'" using SEMatch.prems by auto
    show "rj_se_ae e_dis e_dis'" using t_ret'_e_dis'_cases'_obtain by auto
  qed
  obtain ts' where ts'_obtain: "?e_dis'_ty = ATSum ts' \<and> ts = map strip_at ts'"
    using e_dis'_ty_refine by(case_tac ?e_dis'_ty, auto)
  have sub_result_e_dis': "?result m sc' gc' e_dis' ?e_dis'_ty"
  proof(rule SEMatch.hyps(1))
    show "rj_stcs_atcs sc sc'" using SEMatch.prems by auto
    show "rj_stcv_atcv gc gc'" using SEMatch.prems by auto
    show "rj_se_ae e_dis e_dis'" using t_ret'_e_dis'_cases'_obtain by auto
    show "tj_se sc gc e_dis (STSum ts)" using ts_obtain by auto
    have "set ?e_dis'_cs \<subseteq> set cs"
      using SEMatch.prems(6) t_ret'_e_dis'_cases'_obtain ts'_obtain
      by(auto, simp add: split_def)
    then show "eqs_sat (eqs_lsv_subst m ?e_dis'_cs)"
      using SEMatch.prems(5) by auto
    show "(?e_dis'_ty, ?e_dis'_cs) = ?e_dis'_infer" by auto
    show "dwf_ae (atcs_defs sc') e_dis'" using t_ret'_e_dis'_cases'_obtain SEMatch.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')" using SEMatch.prems(8) by auto
  qed
  have sub_result_cases: "\<And>i. i < length cases \<Longrightarrow> ?result m sc' (gc'(fst (cases ! i) := Some (ts' ! i))) (snd (cases' ! i)) t_ret'"
  proof -
    fix i
    assume i_bound: "i < length cases"
    let ?x = "fst (cases ! i)"
    let ?e = "snd (cases ! i)"
    let ?e' = "snd (cases' ! i)"
    let ?t = "ts ! i"
    let ?t' = "ts' ! i"
    have x_same: "fst (cases' ! i) = ?x"
      using t_ret'_e_dis'_cases'_obtain i_bound by(simp add: split_def)
    let ?sub_gc = "gc(?x := Some ?t)"
    let ?sub_gc' = "gc'(?x := Some ?t')"
    let ?e'_infer = "ti_unif_ae sc' ?sub_gc' ?e'"
    let ?e'_ty = "fst ?e'_infer"
    let ?e'_cs = "snd ?e'_infer"
    have "length ts' = length cases" "length cases' = length cases"
      using ts_obtain ts'_obtain t_ret'_e_dis'_cases'_obtain by auto
    then have in_zip: "(?t', (?x, ?e')) \<in> set (zip ts' cases')"
      using i_bound x_same
      by (metis fst_conv in_set_zip prod.collapse snd_conv)
    then have cs_subset: "set ?e'_cs \<subseteq> set cs"
      using SEMatch.prems(6) t_ret'_e_dis'_cases'_obtain e_dis'_ty_refine ts'_obtain
      by(auto, simp add: split_def Let_def, fastforce)
    have sub_result: "?result m sc' ?sub_gc' ?e' ?e'_ty"
    proof(rule SEMatch.hyps(2))
      show "rj_stcs_atcs sc sc'" using SEMatch.prems by auto
      show "rj_stcv_atcv ?sub_gc ?sub_gc'"
        using SEMatch.prems(2) x_same ts'_obtain apply(auto)
        using i_bound ts_obtain by auto
      show "(?x, ?e) \<in> set cases" using i_bound by auto
      show "?e \<in> Basic_BNFs.snds (?x, ?e)" by(simp add: snds.intros)
      show "rj_se_ae ?e ?e'" using t_ret'_e_dis'_cases'_obtain i_bound by(simp add: split_def)
      show "tj_se sc ?sub_gc ?e t_ret" using SEMatch.prems(4) ts_obtain i_bound by auto
      show "eqs_sat (eqs_lsv_subst m ?e'_cs)"
        using cs_subset SEMatch.prems(5) by auto
      show "(?e'_ty, ?e'_cs) = ?e'_infer" by auto
      show "dwf_ae (atcs_defs sc') ?e'"
        using t_ret'_e_dis'_cases'_obtain i_bound SEMatch.prems(7) by(simp add: split_def)
      show "dwf_atcd (atcs_defs sc')" using SEMatch.prems(8) by auto
    qed
    have "(t_ret', ?e'_ty) \<in> set cs"
      using in_zip SEMatch.prems(6) t_ret'_e_dis'_cases'_obtain e_dis'_ty_refine ts'_obtain
      apply(auto, simp add: split_def Let_def)
      by fastforce
    then have "at_lsv_subst m t_ret' = at_lsv_subst m ?e'_ty"
      using SEMatch.prems(5) by auto
    then show "?result m sc' ?sub_gc' ?e' t_ret'"
      using sub_result by auto
  qed
  then show ?case
    using t_ret'_e_dis'_cases'_obtain proof(simp only: tj_ae.simps ae_lsv_subst.simps, intro exI conjI)
    show "length (map (at_lsv_subst m) ts') = length (map (\<lambda>(case_x, case_e). (case_x, ae_lsv_subst m case_e)) cases')"
      using ts_obtain ts'_obtain t_ret'_e_dis'_cases'_obtain by auto
    show "tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc') (ae_lsv_subst m e_dis') (ATSum (map (at_lsv_subst m) ts'))"
      using sub_result_e_dis' ts'_obtain apply auto
      using at_lsv_subst.simps(3) atcv_lsv_subst.simps sub_result_e_dis' by presburger
    show "
      \<forall>(t_case, x_case, e_case) \<in> set (zip (map (at_lsv_subst m) ts') (map (\<lambda>(case_x, case_e). (case_x, ae_lsv_subst m case_e)) cases')).
       atcv_lsv_subst m gc' x_case = None \<and>
       tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc'(x_case \<mapsto> t_case)) e_case (at_lsv_subst m t_ret')
    "
    proof(intro ballI, simp only: split_def, intro conjI)
      fix entry
      let ?entries = "(zip (map (at_lsv_subst m) ts') (map (\<lambda>p. (fst p, ae_lsv_subst m (snd p))) cases'))"
      assume entry_in: "entry \<in> set ?entries"
      obtain i where i_obtain: "entry = ?entries ! i \<and> i < length ?entries"
        using entry_in
        by (metis (no_types, lifting) in_set_conv_nth)
      have "cases = map (\<lambda>(x, e'). (x, strip_ae e')) cases'"
        using t_ret'_e_dis'_cases'_obtain by auto
      then have "fst (cases ! i) = fst (snd entry) \<and> i < length cases"
        using i_obtain
        by (metis (no_types, lifting) \<open>length (map (at_lsv_subst m) ts') = length (map (\<lambda>(case_x, case_e). (case_x, ae_lsv_subst m case_e)) cases')\<close> fst_conv length_map map_snd_zip nth_map nth_zip prod.case_eq_if sndI)
      then have "(ts ! i, (fst (snd entry), snd (cases ! i))) \<in> set (zip ts cases)"
        using ts_obtain
        by (metis fst_conv in_set_zip snd_conv surjective_pairing)
      then show "atcv_lsv_subst m gc' (fst (snd entry)) = None"
        using SEMatch.prems(2) ts_obtain apply(simp add: split_def) apply auto
        by (metis \<open>fst (cases ! i) = fst (snd entry) \<and> i < length cases\<close>)
      show "tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc'(fst (snd entry) \<mapsto> fst entry)) (snd (snd entry)) (at_lsv_subst m t_ret')"
        using i_obtain sub_result_cases t_ret'_e_dis'_cases'_obtain apply auto
        using \<open>fst (cases ! i) = fst (snd entry) \<and> i < length cases\<close> sub_result_cases by fastforce
    qed
    show "at_lsv_subst m t0' = at_lsv_subst m t_ret'"
      using SEMatch.prems(6) t_ret'_e_dis'_cases'_obtain e_dis'_ty_refine ts'_obtain
      by(simp add: split_def Let_def)
  qed
next
  case (SELam x t1 e1 y t2 e2 t3)
  obtain a t1' e1' t2' e2' t3' where
    e0'_decomp: "e0' = AELam a x t1' e1' y t2' e2' t3'" and
    t1'_refine: "rj_st_at t1 t1'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    t2'_refine: "rj_st_at t2 t2'" and
    e2'_refine: " rj_se_ae e2 e2'" and
    t3'_refine: " rj_st_at t3 t3'"
    using SELam.prems(3) by(case_tac e0', auto)
  let ?e2_gc = "(\<lambda> _. None)(x := Some t1, y := Some t2)"
  have
    t0_decomp: "t0 = STFun t2 t3" and
    e1_ty: "tj_se sc gc e1 t1" and
    e2_ty: "tj_se sc ?e2_gc e2 t3"
    using SELam.prems(4) by auto
  let ?e1'_infer = "ti_unif_ae sc' gc' e1'"
  let ?e1'_ty = "fst ?e1'_infer"
  let ?e1'_cs = "snd ?e1'_infer"
  have sub_result_e1': "?result m sc' gc' e1' ?e1'_ty"
  proof(rule SELam.hyps(1))
    show "rj_stcs_atcs sc sc'" using SELam.prems(1) .
    show "rj_stcv_atcv gc gc'" using SELam.prems(2) .
    show "rj_se_ae e1 e1'" using e1'_refine .
    show "tj_se sc gc e1 t1" using e1_ty .
    show "eqs_sat (eqs_lsv_subst m ?e1'_cs)"
      using SELam.prems(5,6) e0'_decomp by(simp add: split_def Let_def)
    show "(?e1'_ty, ?e1'_cs) = ?e1'_infer" by auto
    show "dwf_ae (atcs_defs sc') e1'" using e0'_decomp SELam.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')" using SELam.prems(8) by auto
  qed
  let ?e2'_gc = "(\<lambda> _. None)(x := Some t1', y := Some t2')"
  let ?e2'_infer = "ti_unif_ae sc' ?e2'_gc e2'"
  let ?e2'_ty = "fst ?e2'_infer"
  let ?e2'_cs = "snd ?e2'_infer"
  have sub_result_e2': "?result m sc' ?e2'_gc e2' ?e2'_ty"
  proof(rule SELam.hyps(2))
    show "rj_stcs_atcs sc sc'" using SELam.prems(1) .
    show "rj_stcv_atcv ?e2_gc ?e2'_gc" using t1'_refine t2'_refine by auto
    show "rj_se_ae e2 e2'" using e2'_refine .
    show "tj_se sc ?e2_gc e2 t3" using e2_ty .
    show "eqs_sat (eqs_lsv_subst m ?e2'_cs)"
      using SELam.prems(5,6) e0'_decomp by(simp add: split_def Let_def)
    show "(?e2'_ty, ?e2'_cs) = ?e2'_infer" by auto
    show "dwf_ae (atcs_defs sc') e2'"
      using e0'_decomp SELam.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SELam.prems(8) by auto
  qed
  show ?case
  proof(simp only: e0'_decomp tj_ae.simps ae_lsv_subst.simps, intro conjI)
    show "tj_ae (atcs_lsv_subst m sc') (atcv_lsv_subst m gc') (ae_lsv_subst m e1') (at_lsv_subst m t1')"
      using sub_result_e1' SELam.prems(5,6) e0'_decomp apply(simp add: split_def Let_def)
      using atcv_lsv_subst.simps sub_result_e1' by presburger
    have subst_gc_equiv: "(atcv_lsv_subst m [x \<mapsto> t1', y \<mapsto> t2']) = [x \<mapsto> at_lsv_subst m t1', y \<mapsto> at_lsv_subst m t2']"
      by auto
    have "(?e2'_ty, t3') \<in> set cs"
      using SELam.prems(6) e0'_decomp by(simp add: split_def Let_def)
    then have "at_lsv_subst m ?e2'_ty = at_lsv_subst m t3'"
      using SELam.prems(5) by auto
    then show "tj_ae (atcs_lsv_subst m sc') [x \<mapsto> at_lsv_subst m t1', y \<mapsto> at_lsv_subst m t2'] (ae_lsv_subst m e2') (at_lsv_subst m t3')"
      using sub_result_e2' subst_gc_equiv by(simp only:)
    show "at_lsv_subst m t0' = ATFun (als_lsv_subst m a) (at_lsv_subst m t2') (at_lsv_subst m t3')"
      using SELam.prems(6) e0'_decomp by(simp add: split_def Let_def)
  qed
next
  case (SEApp e1 e2)
  obtain a e1' e2' where a_e1'_e2'_obtain: "e0' = AEApp a e1' e2' \<and> rj_se_ae e1 e1' \<and> rj_se_ae e2 e2'"
    using SEApp.prems by(case_tac e0', auto)
  obtain t_arg where t_arg_obtain: "tj_se sc gc e1 (STFun t_arg t0) \<and> tj_se sc gc e2 t_arg"
    using SEApp.prems(4) by auto
  let ?e1'_infer = "ti_unif_ae sc' gc' e1'"
  let ?e1'_ty = "fst ?e1'_infer"
  let ?e1'_cs = "snd ?e1'_infer"
  have e1'_ty_fun: "rj_st_at (STFun t_arg t0) ?e1'_ty"
  proof(rule ti_unif_ae_refine)
    show "tj_se sc gc e1 (STFun t_arg t0)" using t_arg_obtain by auto
    show "rj_stcs_atcs sc sc'" using SEApp.prems by auto
    show "rj_stcv_atcv gc gc'" using SEApp.prems by auto
    show "rj_se_ae e1 e1'" using a_e1'_e2'_obtain by auto
  qed
  obtain b t_arg' t_ret' where t_arg'_obtain: "?e1'_ty = ATFun b t_arg' t_ret'"
    using e1'_ty_fun by(case_tac ?e1'_ty, auto)
  have result_1: "?result m sc' gc' e1' ?e1'_ty"
  proof(rule SEApp.hyps(1))
    show "rj_stcs_atcs sc sc'" using SEApp.prems by auto
    show "rj_stcv_atcv gc gc'" using SEApp.prems by auto
    show "rj_se_ae e1 e1'" using a_e1'_e2'_obtain by auto
    show "tj_se sc gc e1 (STFun t_arg t0)" using t_arg_obtain by auto
    show "eqs_sat (eqs_lsv_subst m ?e1'_cs)"
      using SEApp.prems(5,6) a_e1'_e2'_obtain t_arg'_obtain by(simp add: split_def Let_def)
    show "(?e1'_ty, ?e1'_cs) = ?e1'_infer" by auto
    show "dwf_ae (atcs_defs sc') e1'"
      using a_e1'_e2'_obtain SEApp.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEApp.prems(8) by auto
  qed
  let ?e2'_infer = "ti_unif_ae sc' gc' e2'"
  let ?e2'_ty = "fst ?e2'_infer"
  let ?e2'_cs = "snd ?e2'_infer"
  have result_2: "?result m sc' gc' e2' ?e2'_ty"
  proof(rule SEApp.hyps(2))
    show "rj_stcs_atcs sc sc'" using SEApp.prems by auto
    show "rj_stcv_atcv gc gc'" using SEApp.prems by auto
    show "rj_se_ae e2 e2'" using a_e1'_e2'_obtain by auto
    show "tj_se sc gc e2 t_arg" using t_arg_obtain by auto
    show "eqs_sat (eqs_lsv_subst m ?e2'_cs)"
      using a_e1'_e2'_obtain SEApp.prems(5,6) t_arg'_obtain by(simp add: split_def Let_def)
    show "(?e2'_ty, ?e2'_cs) = ?e2'_infer" by auto
    show "dwf_ae (atcs_defs sc') e2'"
      using a_e1'_e2'_obtain SEApp.prems(7) by auto
    show "dwf_atcd (atcs_defs sc')"
      using SEApp.prems(8) by auto
  qed
  have app_constraint: "at_lsv_subst m ?e1'_ty = at_lsv_subst m (ATFun a ?e2'_ty t0')"
    using a_e1'_e2'_obtain SEApp.prems(5,6) t_arg'_obtain by(simp add: split_def Let_def)
  show ?case
    using a_e1'_e2'_obtain apply(simp only: ae_lsv_subst.simps tj_ae.simps)
    by (metis app_constraint at_lsv_subst.simps(1) result_1 result_2)
next
  case (SEVar x)
  obtain t' where t'_obtain: "gc x = Some t0 \<and> gc' x = Some t' \<and> rj_st_at t0 t'"
    using SEVar.prems(2,4) by(auto)
  have e0'_decomp: "e0' = AEVar x"
    using SEVar.prems(3) by(case_tac e0', auto)
  then show ?case
    using t'_obtain SEVar.prems(6) by simp
next
  case (SEDef d)
  obtain as where e0'_decomp: "e0' = AEDef d as"
    using SEDef.prems(3) by(case_tac e0', auto)
  obtain t where sc_entry: "stcs_defs sc d = Some t"
    using SEDef.prems(4) by auto
  obtain vs t' d_cs where
    sc'_entry: "atcs_defs sc' d = Some (vs, t', d_cs)" and
    t'_refine: "rj_st_at t t'"
    using SEDef.prems(1) sc_entry by auto
  then show ?case
    using e0'_decomp proof(simp only: tj_ae.simps ae_lsv_subst.simps, intro exI conjI)
    show "atcs_defs (atcs_lsv_subst m sc') d = Some (vs, t', d_cs)"
      using sc'_entry
      by (metis ATCS.collapse ATCS.sel(1) atcs_lsv_subst.simps)
    show length_same: "length vs = length (map (als_lsv_subst m) as)"
      using SEDef.prems(7) e0'_decomp sc'_entry by auto
    have entry_free: "free_at t' \<subseteq> set vs"
      using SEDef.prems(8) sc'_entry apply auto
      by (smt (z3) case_prodD option.simps(5))
    have t0'_decomp: "t0' = at_lsv_subst (lsv_inst vs as) t'"
      using SEDef.prems(6) e0'_decomp sc'_entry by(simp add: split_def Let_def)
    show "at_lsv_subst m t0' = at_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) t'"
      using length_same entry_free lsv_subst_free t0'_decomp by auto
  qed
next
  case (SESelf d t)
  obtain t' where e0'_decomp: "e0' = AESelf d t'" and t'_refine: "rj_st_at t t'"
    using SESelf.prems(3) by(case_tac e0'; auto)
  have matches_self_d: "atcs_self_d sc' = d"
    using SESelf.prems(1,4) e0'_decomp by(auto)
  have eq_in_cs: "(atcs_self_t sc', t') \<in> set cs"
    using e0'_decomp SESelf.prems(6) by auto
  have matches_self_t: "at_lsv_subst m (atcs_self_t sc') = at_lsv_subst m t'"
    using eq_in_cs SESelf.prems(5) by auto
  then show ?case
    proof(simp only: e0'_decomp tj_ae.simps ae_lsv_subst.simps, intro conjI)
    show "atcs_self_d (atcs_lsv_subst m sc') = d"
      using matches_self_d by(case_tac sc', auto)
    show "atcs_self_t (atcs_lsv_subst m sc') = at_lsv_subst m t'"
      using matches_self_t by(case_tac sc', auto)
    show "at_lsv_subst m t0' = at_lsv_subst m t'"
      using e0'_decomp SESelf.prems(6) by auto
  qed
qed

function (sequential) ti_eq_reduce :: "AT \<Rightarrow> AT \<Rightarrow> (LSVar * LSVar) list" where
"ti_eq_reduce (ATFun (ALSVar v1) arg1 ret1) (ATFun (ALSVar v2) arg2 ret2) = (
  (v1, v2) # ti_eq_reduce arg1 arg2 @ ti_eq_reduce ret1 ret2
)" |
"ti_eq_reduce (ATProd ts1) (ATProd ts2) = (concat (map2 ti_eq_reduce ts1 ts2))" |
"ti_eq_reduce (ATSum ts1) (ATSum ts2) = (concat (map2 ti_eq_reduce ts1 ts2))" |
"ti_eq_reduce (ATMu _ t1) (ATMu _ t2) = ti_eq_reduce t1 t2" |
"ti_eq_reduce (ATVar _) (ATVar _) = []" |
"ti_eq_reduce _ _ = undefined"
  by (pat_completeness) auto
termination apply(relation "measure (\<lambda> (t1, t2). size_AT t1 + size_AT t2)")
       apply(auto)
   apply (metis add_Suc_right add_Suc_shift add_strict_mono in_set_zipE less_irrefl_nat not_less_eq size_list_estimation)
  apply (metis add_Suc_right add_Suc_shift add_strict_mono in_set_zipE less_irrefl_nat not_less_eq size_list_estimation)
  done

lemma ti_eq_reduce_ff: "
  rj_st_at t t1 \<Longrightarrow>
  rj_st_at t t2 \<Longrightarrow>
  ff_at t1 \<Longrightarrow>
  ff_at t2 \<Longrightarrow>
  eqs_sat (lsvar_eqs_lsv_subst m (ti_eq_reduce t1 t2)) \<Longrightarrow>
    at_lsv_subst m t1 = at_lsv_subst m t2
"
proof(induct t arbitrary: t1 t2)
  case (STFun arg ret)
  obtain a1 arg1 ret1 where
    t1_decomp: "t1 = ATFun a1 arg1 ret1" and
    arg1_refine: "rj_st_at arg arg1" and
    ret1_refine: "rj_st_at ret ret1"
    using STFun.prems(1) by(case_tac t1, auto)
  obtain a2 arg2 ret2 where
    t2_decomp: "t2 = ATFun a2 arg2 ret2" and
    arg2_refine: "rj_st_at arg arg2" and
    ret2_refine: "rj_st_at ret ret2"
    using STFun.prems(2) by(case_tac t2, auto)
  obtain v1 where a1_decomp: "a1 = ALSVar v1"
    using STFun.prems(3) t1_decomp by(case_tac a1, auto)
  obtain v2 where a2_decomp: "a2 = ALSVar v2"
    using STFun.prems(4) t2_decomp by(case_tac a2, auto)
  have v1_v2_constraint_in: "(v1, v2) \<in> set (ti_eq_reduce t1 t2)"
    using t1_decomp t2_decomp a1_decomp a2_decomp by auto
  have v1_v2_subst_eq: "m v1 = m v2"
    using STFun.prems(5) v1_v2_constraint_in by auto
  have arg_result: "at_lsv_subst m arg1 = at_lsv_subst m arg2"
  proof(rule STFun.hyps(1))
    show "rj_st_at arg arg1" using arg1_refine .
    show "rj_st_at arg arg2" using arg2_refine .
    show "ff_at arg1" using STFun.prems(3) t1_decomp by auto
    show "ff_at arg2" using STFun.prems(4) t2_decomp by auto
    show "eqs_sat (lsvar_eqs_lsv_subst m (ti_eq_reduce arg1 arg2))"
      using STFun.prems(5) t1_decomp t2_decomp a1_decomp a2_decomp by auto
  qed
  have ret_result: "at_lsv_subst m ret1 = at_lsv_subst m ret2"
  proof(rule STFun.hyps(2))
    show "rj_st_at ret ret1" using ret1_refine .
    show "rj_st_at ret ret2" using ret2_refine .
    show "ff_at ret1" using STFun.prems(3) t1_decomp by auto
    show "ff_at ret2" using STFun.prems(4) t2_decomp by auto
    show "eqs_sat (lsvar_eqs_lsv_subst m (ti_eq_reduce ret1 ret2))"
      using STFun.prems(5) t1_decomp t2_decomp a1_decomp a2_decomp by auto
  qed
  then show ?case
    using v1_v2_subst_eq t1_decomp t2_decomp a1_decomp a2_decomp arg_result ret_result by auto
next
  case (STProd ts)
  obtain ts1 where t1_decomp: "t1 = ATProd ts1" and ts1_refine: "map strip_at ts1 = ts"
    using STProd.prems(1) by(case_tac t1, auto)
  obtain ts2 where t2_decomp: "t2 = ATProd ts2" and ts2_refine: "map strip_at ts2 = ts"
    using STProd.prems(2) by(case_tac t2, auto)
  have elem_result: "\<And>i. i < length ts \<Longrightarrow> at_lsv_subst m (ts1 ! i) = at_lsv_subst m (ts2 ! i)"
  proof -
    fix i
    assume i_bound: "i < length ts"
    show "at_lsv_subst m (ts1 ! i) = at_lsv_subst m (ts2 ! i)"
    proof(rule STProd.hyps)
      show "(ts ! i) \<in> set ts" using i_bound by auto
      show "rj_st_at (ts ! i) (ts1 ! i)" using i_bound ts1_refine by auto
      show "rj_st_at (ts ! i) (ts2 ! i)" using i_bound ts2_refine by auto
      show "ff_at (ts1 ! i)" using STProd.prems(3) i_bound t1_decomp ts1_refine by auto
      show "ff_at (ts2 ! i)" using STProd.prems(4) i_bound t2_decomp ts2_refine by auto
      have "i < length (zip ts1 ts2)"
        using i_bound ts1_refine ts2_refine
        by (metis length_map length_zip min.idem)
      then have pair_in: "(ts1 ! i, ts2 ! i) \<in> set (zip ts1 ts2)"
        by (metis list_update_id set_update_memI zip_update)
      have eqs_subset: "set (ti_eq_reduce (ts1 ! i) (ts2 ! i)) \<subseteq> set (ti_eq_reduce t1 t2)"
        using i_bound t1_decomp t2_decomp ts1_refine ts2_refine pair_in by auto
      show "eqs_sat (lsvar_eqs_lsv_subst m (ti_eq_reduce (ts1 ! i) (ts2 ! i)))"
        using STProd.prems(5) eqs_subset by auto
    qed
  qed
  have list_result: "map (at_lsv_subst m) ts1 = map (at_lsv_subst m) ts2"
    using elem_result ts1_refine ts2_refine
    by (metis (mono_tags, lifting) length_map nth_equalityI nth_map)
  show ?case
    using list_result t1_decomp t2_decomp by auto
next
  case (STSum ts)
  obtain ts1 where t1_decomp: "t1 = ATSum ts1" and ts1_refine: "map strip_at ts1 = ts"
    using STSum.prems(1) by(case_tac t1, auto)
  obtain ts2 where t2_decomp: "t2 = ATSum ts2" and ts2_refine: "map strip_at ts2 = ts"
    using STSum.prems(2) by(case_tac t2, auto)
  have elem_result: "\<And>i. i < length ts \<Longrightarrow> at_lsv_subst m (ts1 ! i) = at_lsv_subst m (ts2 ! i)"
  proof -
    fix i
    assume i_bound: "i < length ts"
    show "at_lsv_subst m (ts1 ! i) = at_lsv_subst m (ts2 ! i)"
    proof(rule STSum.hyps)
      show "(ts ! i) \<in> set ts" using i_bound by auto
      show "rj_st_at (ts ! i) (ts1 ! i)" using i_bound ts1_refine by auto
      show "rj_st_at (ts ! i) (ts2 ! i)" using i_bound ts2_refine by auto
      show "ff_at (ts1 ! i)" using STSum.prems(3) i_bound t1_decomp ts1_refine by auto
      show "ff_at (ts2 ! i)" using STSum.prems(4) i_bound t2_decomp ts2_refine by auto
      have "i < length (zip ts1 ts2)"
        using i_bound ts1_refine ts2_refine
        by (metis length_map length_zip min.idem)
      then have pair_in: "(ts1 ! i, ts2 ! i) \<in> set (zip ts1 ts2)"
        by (metis list_update_id set_update_memI zip_update)
      have eqs_subset: "set (ti_eq_reduce (ts1 ! i) (ts2 ! i)) \<subseteq> set (ti_eq_reduce t1 t2)"
        using i_bound t1_decomp t2_decomp ts1_refine ts2_refine pair_in by auto
      show "eqs_sat (lsvar_eqs_lsv_subst m (ti_eq_reduce (ts1 ! i) (ts2 ! i)))"
        using STSum.prems(5) eqs_subset by auto
    qed
  qed
  have list_result: "map (at_lsv_subst m) ts1 = map (at_lsv_subst m) ts2"
    using elem_result ts1_refine ts2_refine
    by (metis (mono_tags, lifting) length_map nth_equalityI nth_map)
  show ?case
    using list_result t1_decomp t2_decomp by auto
next
  case (STMu u inner)
  obtain inner1 where t1_decomp: "t1 = ATMu u inner1" and inner1_refine: "rj_st_at inner inner1"
    using STMu.prems(1) by(case_tac t1, auto)
  obtain inner2 where t2_decomp: "t2 = ATMu u inner2" and inner2_refine: "rj_st_at inner inner2"
    using STMu.prems(2) by(case_tac t2, auto)
  have inner_result: "at_lsv_subst m inner1 = at_lsv_subst m inner2"
    using t1_decomp t2_decomp inner1_refine inner2_refine STMu.prems STMu.hyps by auto
  show ?case
    using inner_result t1_decomp t2_decomp by auto
next
  case (STVar u)
  show ?case
    using STVar.prems(1,2) apply(case_tac t1, auto) apply(case_tac t2, auto) done
qed

fun eq_good :: "(AT * AT) \<Rightarrow> bool" where
"eq_good (t1, t2) = (strip_at t1 = strip_at t2 \<and> ff_at t1 \<and> ff_at t2)"

fun ff_atcd :: "ATCD \<Rightarrow> bool" where
"ff_atcd dc = (\<forall> d. (case dc d of Some (_, t, _) \<Rightarrow> ff_at t | None \<Rightarrow> True))"

fun ff_atcs :: "ATCS \<Rightarrow> bool" where
"ff_atcs sc = (ff_atcd (atcs_defs sc) \<and> ff_at (atcs_self_t sc))"

fun ff_atcv :: "ATCV \<Rightarrow> bool" where
"ff_atcv gc = (\<forall> x. (case gc x of Some t \<Rightarrow> ff_at t | None \<Rightarrow> True))"

fun dwf_ff_atcd :: "ATCD \<Rightarrow> bool" where
"dwf_ff_atcd dc = (dwf_atcd dc \<and> ff_atcd dc)"

fun dwf_ff_atcs :: "ATCS \<Rightarrow> bool" where
"dwf_ff_atcs sc = (dwf_ff_atcd (atcs_defs sc) \<and> ff_atcs sc)"

fun rj_dwf_ff_atcs :: "STCS \<Rightarrow> ATCS \<Rightarrow> bool" where
"rj_dwf_ff_atcs sc sc' = (rj_stcs_atcs sc sc' \<and> dwf_ff_atcs sc')"

lemma at_subst_ff: "
  (\<And> u. ff_at (m u)) \<Longrightarrow>
  ff_at t \<Longrightarrow>
  ff_at (at_subst m t)
"
  apply(induct t arbitrary: m)
  by auto

lemma lsv_subst_ff_rec:
  assumes m_ff: "\<And>v. ff_als (m v)"
  shows "
    (ff_als a \<longrightarrow> ff_als (als_lsv_subst m a)) \<and>
    (ff_at t \<longrightarrow> ff_at (at_lsv_subst m t)) \<and>
    (ff_ae e \<longrightarrow> ff_ae (ae_lsv_subst m e))
  "
  (is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
  apply(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  using m_ff by auto

lemma at_lsv_subst_ff: "
  (\<And>v. ff_als (m v)) \<Longrightarrow>
  ff_at t \<Longrightarrow>
  ff_at (at_lsv_subst m t)
"
  using lsv_subst_ff_rec by auto

lemma ae_lsv_subst_ff: "
  (\<And>v. ff_als (m v)) \<Longrightarrow>
  ff_ae e \<Longrightarrow>
  ff_ae (ae_lsv_subst m e)
"
  using lsv_subst_ff_rec by auto

lemma union_zip_length: "length xs = length ys \<Longrightarrow>  (\<Union>p \<in> set (zip xs ys). f (fst p) (snd p)) = (\<Union>i < length xs. f (xs ! i) (ys ! i))"
  apply(induct xs arbitrary: ys)
  apply auto
  apply (metis fst_conv in_set_zip lessThan_iff snd_conv)
  by (metis (mono_tags, lifting) add.right_neutral add_Suc_right fst_conv in_set_zip list.size(4) snd_conv)

lemma ti_unif_ae_eqs_rec: "
  rj_dwf_ff_atcs sc sc' \<Longrightarrow>
  rj_stcv_atcv gc gc' \<Longrightarrow>
  rj_se_ae e0 e0' \<Longrightarrow>
  tj_se sc gc e0 t0 \<Longrightarrow>
  ff_atcv gc' \<Longrightarrow>
  ff_ae e0' \<Longrightarrow>
  dwf_ae (atcs_defs sc') e0' \<Longrightarrow>
    ff_at (fst (ti_unif_ae sc' gc' e0')) \<and>
    (\<forall> c \<in> set (snd (ti_unif_ae sc' gc' e0')). eq_good c)
"
(
  is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?result sc' gc' e0'"
  is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> (?result1 sc' gc' e0') \<and> (?result2 sc' gc' e0')"
  is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> (ff_at (?t0' sc' gc' e0')) \<and> (\<forall> c \<in> set (?cs sc' gc' e0'). eq_good c)"
)
proof(induct e0 arbitrary: gc gc' e0' t0)
  case (SETup es)
  obtain es' where e0'_decomp: "e0' = AETup es'" and es'_refine: "map strip_ae es' = es"
    using SETup.prems(3) by(case_tac e0', auto)
  have es'_length: "length es' = length es"
    using es'_refine by auto
  obtain ts where ts_length: "length ts = length es" and ts_typed: "\<And>i. i < length ts \<Longrightarrow> tj_se sc gc (es ! i) (ts ! i)"
    using SETup.prems(4) apply(auto) apply(simp add: split_def)
    by (metis (no_types, lifting) fst_conv length_zip list_update_id min_less_iff_conj set_update_memI snd_conv zip_update)
  have elem_result: "\<And>i. i < length es \<Longrightarrow> ?result sc' gc' (es' ! i)"
  proof(rule SETup.hyps)
    fix i
    assume i_bound: "i < length es"
    show "es ! i \<in> set es" using i_bound by auto
    show "rj_dwf_ff_atcs sc sc'" using SETup.prems(1) .
    show "rj_stcv_atcv gc gc'" using SETup.prems(2) .
    show "rj_se_ae (es ! i) (es' ! i)" using es'_refine i_bound by auto
    show "tj_se sc gc (es ! i) (ts ! i)" using i_bound ts_length ts_typed by auto
    show "ff_atcv gc'" using SETup.prems(5) .
    show "ff_ae (es' ! i)" using SETup.prems(6) e0'_decomp i_bound es'_length by auto
    show "dwf_ae (atcs_defs sc') (es' ! i)" using SETup.prems(7) e0'_decomp i_bound es'_length by auto
  qed
  show ?case
  proof
    have "\<And>i. i < length es' \<Longrightarrow> ?result1 sc' gc' (es' ! i)"
      using elem_result e0'_decomp es'_length by auto
    then show "?result1 sc' gc' e0'"
      using e0'_decomp apply auto
      by (metis in_set_conv_nth)
    have "\<And>i. i < length es' \<Longrightarrow> ?result2 sc' gc' (es' ! i)"
      using elem_result e0'_decomp es'_length by auto
    then show "?result2 sc' gc' e0'"
      using e0'_decomp apply auto
      by (metis eq_good.simps in_set_conv_nth)+
  qed
next
  case (SEProj i e)
  obtain e' where e0'_decomp: "e0' = AEProj i e'" and e'_refine: "rj_se_ae e e'"
    using SEProj.prems(3) by(case_tac e0', auto)
  obtain ts where ts_type: "tj_se sc gc e (STProd ts)" and i_bound: "i < length ts"
    using SEProj.prems(4) by auto
  have e'_type: "rj_st_at (STProd ts) (?t0' sc' gc' e')"
    using ti_unif_ae_refine e0'_decomp e'_refine ts_type SEProj.prems by auto
  have e'_result: "?result sc' gc' e'"
  proof(rule SEProj.hyps)
    show "rj_dwf_ff_atcs sc sc'" using SEProj.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEProj.prems(2) .
    show "rj_se_ae e e'" using e'_refine .
    show "tj_se sc gc e (STProd ts)" using ts_type .
    show "ff_atcv gc'" using SEProj.prems(5) .
    show "ff_ae e'" using SEProj.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e'" using SEProj.prems(7) e0'_decomp by auto
  qed
  show ?case
    using e'_result e0'_decomp e'_type i_bound
    apply(simp add: split_def Let_def)
    by(case_tac "?t0' sc' gc' e'", auto)
next
  case (SEInj ts i e)
  obtain ts' e' where
    e0'_decomp: "e0' = AEInj ts' i e'" and
    ts'_refine: "map strip_at ts' = ts" and
    e'_refine: "rj_se_ae e e'"
    using SEInj.prems(3) by(case_tac e0', auto)
  have e_type: "tj_se sc gc e (ts ! i)" and i_bound: "i < length ts"
    using SEInj.prems(4) by auto
  have e'_result: "?result sc' gc' e'"
  proof(rule SEInj.hyps)
    show "rj_dwf_ff_atcs sc sc'" using SEInj.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEInj.prems(2) .
    show "rj_se_ae e e'" using e'_refine .
    show "tj_se sc gc e (ts ! i)" using e_type .
    show "ff_atcv gc'" using SEInj.prems(5) .
    show "ff_ae e'" using SEInj.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e'" using SEInj.prems(7) e0'_decomp by auto
  qed
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using SEInj.prems(6) e0'_decomp by(simp add: split_def Let_def)
    show "?result2 sc' gc' e0'"
      using e0'_decomp apply(simp only: ti_unif_ae.simps Let_def split_def snd_conv)
      using e'_result apply auto
      using SEInj.prems(1) SEInj.prems(2) e'_refine e_type i_bound ti_unif_ae_refine ts'_refine apply force
      using SEInj.prems(6) i_bound ts'_refine by force
  qed
next
  case (SEFold u t e)
  obtain t' e' where
    e0'_decomp: "e0' = AEFold u t' e'" and
    t'_refine: "rj_st_at t t'" and
    e'_refine: "rj_se_ae e e'"
    using SEFold.prems(3) by(case_tac e0', auto)
  have e_type: "tj_se sc gc e (st_subst (STVar(u := STMu u t)) t)"
    using SEFold.prems(4) by auto
  have e'_result: "?result sc' gc' e'"
  proof(rule SEFold.hyps)
    show "rj_dwf_ff_atcs sc sc'" using SEFold.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEFold.prems(2) .
    show "rj_se_ae e e'" using e'_refine .
    show "tj_se sc gc e (st_subst (STVar(u := STMu u t)) t)" using e_type .
    show "ff_atcv gc'" using SEFold.prems(5) .
    show "ff_ae e'" using SEFold.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e'" using SEFold.prems(7) e0'_decomp by auto
  qed
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp apply(simp only: ti_unif_ae.simps Let_def split_def fst_conv)
      using SEFold.prems(6) by auto
    have "eq_good (at_subst (ATVar(u := ATMu u t')) t', fst (ti_unif_ae sc' gc' e'))"
    proof(simp only: eq_good.simps, intro conjI)
      have refine_e'_type: "rj_st_at (st_subst (STVar(u := STMu u t)) t) (?t0' sc' gc' e')"
        using ti_unif_ae_refine e0'_decomp e_type SEFold.prems by auto
      have refine_at_subst: "rj_st_at (st_subst (STVar(u := STMu u t)) t) (at_subst (ATVar(u := ATMu u t')) t')"
        using t'_refine at_mu_subst_preserve_strip apply auto
        by (metis comp_apply fun_upd_apply strip_at.simps(4) strip_at.simps(5))
      show "strip_at (at_subst (ATVar(u := ATMu u t')) t') = strip_at (?t0' sc' gc' e')"
        using refine_e'_type refine_at_subst by auto
      show "ff_at (at_subst (ATVar (u := ATMu u t')) t')"
        using SEFold.prems(6) t'_refine e0'_decomp at_subst_ff by auto
      show "ff_at (fst (ti_unif_ae sc' gc' e'))"
        using e'_result by auto
    qed
    then show "?result2 sc' gc' e0'"
      using e0'_decomp apply(simp only: ti_unif_ae.simps Let_def split_def snd_conv)
      using t'_refine e'_result apply(induct t arbitrary: t') by auto
  qed
next
  case (SEUnfold e)
  obtain e' where e0'_decomp: "e0' = AEUnfold e'" and e'_refine: "rj_se_ae e e'"
    using SEUnfold.prems(3) by(case_tac e0', auto)
  obtain u t where e_type: "tj_se sc gc e (STMu u t)"
    using SEUnfold.prems(4) by auto
  have e'_type_refine: "rj_st_at (STMu u t) (?t0' sc' gc' e')"
    using ti_unif_ae_refine e0'_decomp e'_refine SEUnfold.prems e_type by auto
  obtain t' where e'_type_decomp: "?t0' sc' gc' e' = ATMu u t'" and t'_refine: "rj_st_at t t'"
    using e'_type_refine by(case_tac "?t0' sc' gc' e'", auto)
  have e'_result: "?result sc' gc' e'"
  proof(rule SEUnfold.hyps)
    show "rj_dwf_ff_atcs sc sc'" using SEUnfold.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEUnfold.prems(2) .
    show "rj_se_ae e e'" using e'_refine .
    show "tj_se sc gc e (STMu u t)" using e_type .
    show "ff_atcv gc'" using SEUnfold.prems(5) .
    show "ff_ae e'" using SEUnfold.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e'" using SEUnfold.prems(7) e0'_decomp by auto
  qed
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e'_result at_subst_ff e0'_decomp e'_type_refine e'_type_decomp
      by(simp add: Let_def split_def)
    show "?result2 sc' gc' e0'"
      using e'_result e0'_decomp e'_type_decomp by(simp add: split_def)
  qed
next
  case (SELet x e1 e2)
  obtain e1' e2' where e0'_decomp: "e0' = AELet x e1' e2'" and e1'_refine: "rj_se_ae e1 e1'" and e2'_refine: "rj_se_ae e2 e2'"
    using SELet.prems(3) by(case_tac e0', auto)
  obtain t1 t2 where e1_type: "tj_se sc gc e1 t1" and e2_type: "tj_se sc (gc(x := Some t1)) e2 t2"
    using SELet.prems(4) by auto
  have e1'_result: "?result sc' gc' e1'"
  proof(rule SELet.hyps(1))
    show "rj_dwf_ff_atcs sc sc'" using SELet.prems(1) .
    show "rj_stcv_atcv gc gc'" using SELet.prems(2) .
    show "rj_se_ae e1 e1'" using e1'_refine .
    show "tj_se sc gc e1 t1" using e1_type .
    show "ff_atcv gc'" using SELet.prems(5) .
    show "ff_ae e1'" using SELet.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e1'" using SELet.prems(7) e0'_decomp by auto
  qed
  have e2'_result: "?result sc' (gc'(x := Some (?t0' sc' gc' e1'))) e2'"
  proof(rule SELet.hyps(2))
    show "rj_dwf_ff_atcs sc sc'" using SELet.prems(1) .
    have "rj_st_at t1 (?t0' sc' gc' e1')"
      using ti_unif_ae_refine e0'_decomp e1_type SELet.prems by auto
    then show "rj_stcv_atcv (gc(x := Some t1)) (gc'(x := Some (?t0' sc' gc' e1')))"
      using SELet.prems(2) by auto
    show "rj_se_ae e2 e2'" using e2'_refine .
    show "tj_se sc (gc(x := Some t1)) e2 t2" using e2_type .
    show "ff_atcv (gc'(x := Some (?t0' sc' gc' e1')))"
      using SELet.prems(5) e0'_decomp e1'_result by auto
    show "ff_ae e2'" using SELet.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e2'" using SELet.prems(7) e0'_decomp by auto
  qed
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp apply(simp add: split_def Let_def) using e2'_result by blast
    show "?result2 sc' gc' e0'"
      using e0'_decomp apply(simp add: split_def Let_def) using e1'_result e2'_result by blast
  qed
next
  case (SEMatch ret e_dis cases)
  obtain ret' e_dis' cases' where
    e0'_decomp: "e0' = AEMatch ret' e_dis' cases'" and
    ret'_refine: "rj_st_at ret ret'" and
    e_dis'_refine: "rj_se_ae e_dis e_dis'" and
    cases'_refine: "map (\<lambda> (x, e_case'). (x, strip_ae e_case')) cases' = cases"
    using SEMatch.prems(3) by(case_tac e0', auto)
  obtain ts where
    e_dis_type: "tj_se sc gc e_dis (STSum ts)" and
    ts_length: "length ts = length cases" and
    case_types: "\<And>i. i < length cases \<Longrightarrow> tj_se sc (gc(fst (cases ! i) := Some (ts ! i))) (snd (cases ! i)) ret"
    using SEMatch.prems(4) apply(simp add: split_def)
    by (metis fst_conv in_set_zip snd_conv)
  have e_dis'_result: "?result sc' gc' e_dis'"
  proof(rule SEMatch.hyps(1))
    show "rj_dwf_ff_atcs sc sc'" using SEMatch.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEMatch.prems(2) .
    show "rj_se_ae e_dis e_dis'" using e_dis'_refine .
    show "tj_se sc gc e_dis (STSum ts)" using e_dis_type .
    show "ff_atcv gc'" using SEMatch.prems(5) .
    show "ff_ae e_dis'" using SEMatch.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e_dis'" using SEMatch.prems(7) e0'_decomp by auto
  qed
  have e_dis'_type_refine: "rj_st_at (STSum ts) (?t0' sc' gc' e_dis')"
    using e_dis'_refine e_dis_type SEMatch.prems(1,2) ti_unif_ae_refine by auto
  obtain ts' where e_dis'_type_decomp: "?t0' sc' gc' e_dis' = ATSum ts'" and ts'_refine: "map strip_at ts' = ts"
    using e_dis'_type_refine by(case_tac "?t0' sc' gc' e_dis'", auto)
  let ?var = "\<lambda> i. fst (cases ! i)"
  let ?var' = "\<lambda> i. fst (cases' ! i)"
  let ?e_case = "\<lambda> i. snd (cases ! i)"
  let ?e_case' = "\<lambda> i. snd (cases' ! i)"
  let ?gc_case = "\<lambda> i. (gc(?var i := Some (ts ! i)))"
  let ?gc_case' = "\<lambda> i. (gc'(?var' i := Some (ts' ! i)))"
  have vars_equal: "\<And>i. i < length cases \<Longrightarrow> fst (cases ! i) = fst (cases' ! i)"
    using cases'_refine by(simp add: split_def, force)
  have case_result: "\<And>i. i < length cases \<Longrightarrow> ?result sc' (?gc_case' i) (?e_case' i)"
  proof -
    fix i
    assume i_bound: "i < length cases"
    show "?thesis i"
    proof(rule SEMatch.hyps(2))
      show "cases ! i \<in> set cases" using i_bound by auto
      show "?e_case i \<in> Basic_BNFs.snds (cases ! i)" by (simp add: snds.intros)
      show "rj_dwf_ff_atcs sc sc'" using SEMatch.prems(1) .
      show "rj_stcv_atcv (?gc_case i) (?gc_case' i)"
        using SEMatch.prems(2) ts'_refine ts_length vars_equal i_bound by auto
      show "rj_se_ae (?e_case i) (?e_case' i)"
        using cases'_refine i_bound
        by (metis (no_types, lifting) case_prod_conv length_map nth_map old.prod.inject prod.collapse rj_se_ae.elims(1))
      show "tj_se sc (?gc_case i) (?e_case i) ret"
        using i_bound case_types by auto
      show "ff_atcv (?gc_case' i)"
        using SEMatch.prems(5) e0'_decomp e_dis'_result e_dis'_type_decomp i_bound apply auto
        by (metis length_map nth_mem ts'_refine ts_length)
      show "ff_ae (?e_case' i)"
        using SEMatch.prems(6) e0'_decomp i_bound cases'_refine by(simp add: split_def, force)
      show "dwf_ae (atcs_defs sc') (?e_case' i)"
        using SEMatch.prems(7) e0'_decomp i_bound cases'_refine by(simp add: split_def, force)
    qed
  qed
  have case_type_refine: "\<And>i. i < length cases \<Longrightarrow> rj_st_at ret (?t0' sc' (?gc_case' i) (?e_case' i))"
  proof(rule ti_unif_ae_refine)
    fix i
    assume i_bound: "i < length cases"
    show "tj_se sc (?gc_case i) (?e_case i) ret" using i_bound case_types by auto
    show "rj_stcs_atcs sc sc'" using SEMatch.prems(1) by auto
    show "rj_stcv_atcv (?gc_case i) (?gc_case' i)"
      using SEMatch.prems(2) ts'_refine ts_length vars_equal i_bound by auto
    show "rj_se_ae (?e_case i) (?e_case' i)"
      using cases'_refine i_bound length_map nth_map apply(simp add: split_def)
      by force
  qed
  let ?case_infer_ty = "\<lambda> i. ?t0' sc' (?gc_case' i) (?e_case' i)"
  have case_eq_good: "\<And>i. i < length cases \<Longrightarrow> eq_good (ret', ?case_infer_ty i)"
  proof(simp only: eq_good.simps, intro conjI)
    fix i
    assume i_bound: "i < length cases"
    show "strip_at ret' = strip_at (?case_infer_ty i)"
      using case_type_refine ret'_refine i_bound by auto
    show "ff_at ret'"
      using SEMatch.prems(6) e0'_decomp by auto
    show "ff_at (?case_infer_ty i)"
      using case_result i_bound by auto
  qed
  let ?cs_1 = "(\<Union>i < length cases. set (?cs sc' (?gc_case' i) (?e_case' i)))"
  let ?sub_expr_cs = "set (?cs sc' gc' e_dis') \<union> ?cs_1"
  have sub_expr_cs_good: "\<And>c. c \<in> ?sub_expr_cs \<Longrightarrow> eq_good c"
    using e_dis'_result case_result cases'_refine by fastforce
  let ?cs_2 = "(\<Union>i < length cases. {(ret', ?case_infer_ty i)})"
  let ?full_cs = "?sub_expr_cs \<union> ?cs_2"
  have full_cs_good: "\<And>c. c \<in> ?full_cs \<Longrightarrow> eq_good c"
    using case_eq_good sub_expr_cs_good by auto
  let ?cs_computed = "set (?cs sc' gc' e_dis') \<union>
        (\<Union>x\<in>set (zip ts' cases').
            insert (ret', (?t0' sc' (gc'(fst (snd x) := Some (fst x))) (snd (snd x))))
             (set (?cs sc' (gc'(fst (snd x) := Some (fst x))) (snd (snd x)))))"
  let ?cs_computed_1 = "(\<Union>x\<in>set (zip ts' cases'). set (?cs sc' (gc'(fst (snd x) := Some (fst x))) (snd (snd x))))"
  let ?cs_computed_2 = "(\<Union>x\<in>set (zip ts' cases'). {(ret', (?t0' sc' (gc'(fst (snd x) := Some (fst x))) (snd (snd x))))})"
  let ?cs_computed' = "set (?cs sc' gc' e_dis') \<union> ?cs_computed_1 \<union> ?cs_computed_2"
  have cs_computed'_eq: "?cs_computed = ?cs_computed'"
    by auto
  have length_cases_ts': "length cases = length ts'"
    using ts_length ts'_refine by auto
  have cs_computed_1_eq: "?cs_computed_1 = ?cs_1"
    apply(simp only: length_cases_ts')
    apply(rule union_zip_length)
    using length_cases_ts' cases'_refine by auto
  have cs_computed_2_eq: "?cs_computed_2 = ?cs_2"
    apply(simp only: length_cases_ts')
    apply(rule union_zip_length)
    using length_cases_ts' cases'_refine by auto
  have cs_computed_eq: "?cs_computed = ?full_cs"
    by(simp only: cs_computed_1_eq cs_computed_2_eq cs_computed'_eq)
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp SEMatch.prems(6) e_dis'_type_decomp by(simp add: split_def)
    show "?result2 sc' gc' e0'"
      using e0'_decomp SEMatch.prems(6) e_dis'_type_decomp apply(simp add: split_def Let_def)
      apply(simp only: cs_computed_eq)
      using full_cs_good by simp
  qed
next
  case (SELam x t1 e1 y t2 e2 t3)
  obtain a t1' e1' t2' e2' t3' where
    e0'_decomp: "e0' = AELam a x t1' e1' y t2' e2' t3'" and
    t1'_refine: "rj_st_at t1 t1'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    t2'_refine: "rj_st_at t2 t2'" and
    e2'_refine: "rj_se_ae e2 e2'" and
    t3'_refine: "rj_st_at t3 t3'"
    using SELam.prems(3) by(case_tac e0', auto)
  have
    e1_type: "tj_se sc gc e1 t1" and
    e2_type: "tj_se sc ((\<lambda> _. None)(x := Some t1, y := Some t2)) e2 t3"
    using SELam.prems(4) by auto
  have e1'_result: "?result sc' gc' e1'"
  proof(rule SELam.hyps(1))
    show "rj_dwf_ff_atcs sc sc'" using SELam.prems(1) .
    show "rj_stcv_atcv gc gc'" using SELam.prems(2) .
    show "rj_se_ae e1 e1'" using e1'_refine .
    show "tj_se sc gc e1 t1" using e1_type .
    show "ff_atcv gc'" using SELam.prems(5) .
    show "ff_ae e1'" using SELam.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e1'" using SELam.prems(7) e0'_decomp by auto
  qed
  have e2'_result: "?result sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2'"
  proof(rule SELam.hyps(2))
    show "rj_dwf_ff_atcs sc sc'" using SELam.prems(1) .
    show "rj_stcv_atcv ((\<lambda> _. None)(x := Some t1, y := Some t2)) ((\<lambda> _. None)(x := Some t1', y := Some t2'))"
      using t1'_refine t2'_refine by auto
    show "rj_se_ae e2 e2'" using e2'_refine .
    show "tj_se sc ((\<lambda> _. None)(x := Some t1, y := Some t2)) e2 t3" using e2_type .
    show "ff_atcv ((\<lambda> _. None)(x := Some t1', y := Some t2'))"
      using SELam.prems(6) e0'_decomp by auto
    show "ff_ae e2'"
      using SELam.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e2'"
      using SELam.prems(7) e0'_decomp by auto
  qed
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp apply(simp only: ti_unif_ae.simps Let_def split_def fst_conv)
      using SELam.prems(6) e0'_decomp by auto
    have e1'_constraints_good: "?result2 sc' gc' e1'"
      using e1'_result by auto
    have e2'_constraints_good: "?result2 sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2'"
      using e2'_result by auto
    have constraint1_good: "eq_good (?t0' sc' gc' e1', t1')"
      using SELam.prems(1) SELam.prems(2) SELam.prems(6) e0'_decomp e1'_refine e1'_result e1_type t1'_refine ti_unif_ae_refine by force
    have constraint2_good: "eq_good (?t0' sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2', t3')"
    proof(simp only: eq_good.simps, intro conjI)
      have t3_refine_infer: "rj_st_at t3 (?t0' sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2')"
      proof(rule ti_unif_ae_refine)
        show "tj_se sc ((\<lambda> _. None)(x := Some t1, y := Some t2)) e2 t3" using e2_type .
        show "rj_stcs_atcs sc sc'" using SELam.prems(1) by auto
        show "rj_stcv_atcv ((\<lambda> _. None)(x := Some t1, y := Some t2)) ((\<lambda> _. None)(x := Some t1', y := Some t2'))"
          using t1'_refine t2'_refine by auto
        show "rj_se_ae e2 e2'" using e2'_refine .
      qed
      show "strip_at (?t0' sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2') = strip_at t3'"
        using t3_refine_infer t3'_refine by auto
      show "ff_at (?t0' sc' ((\<lambda> _. None)(x := Some t1', y := Some t2')) e2')"
        using e2'_result by auto
      show "ff_at t3'"
        using SELam.prems(6) e0'_decomp by auto
    qed
    show "?result2 sc' gc' e0'"
      using e0'_decomp apply(simp only: ti_unif_ae.simps Let_def split_def snd_conv)
      using e1'_constraints_good e2'_constraints_good constraint1_good constraint2_good by fastforce
  qed
next
  case (SEApp e1 e2)
  obtain a e1' e2' where
    e0'_decomp: "e0' = AEApp a e1' e2'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    e2'_refine: "rj_se_ae e2 e2'"
    using SEApp.prems(3) by(case_tac e0', auto)
  obtain t_arg where e1_type: "tj_se sc gc e1 (STFun t_arg t0)" and e2_type: "tj_se sc gc e2 t_arg"
    using SEApp.prems(4) by auto
  have e1'_result: "?result sc' gc' e1'"
  proof(rule SEApp.hyps(1))
    show "rj_dwf_ff_atcs sc sc'" using SEApp.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEApp.prems(2) .
    show "rj_se_ae e1 e1'" using e1'_refine .
    show "tj_se sc gc e1 (STFun t_arg t0)" using e1_type .
    show "ff_atcv gc'" using SEApp.prems(5) .
    show "ff_ae e1'" using SEApp.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e1'" using SEApp.prems(7) e0'_decomp by auto
  qed
  have e2'_result: "?result sc' gc' e2'"
  proof(rule SEApp.hyps(2))
    show "rj_dwf_ff_atcs sc sc'" using SEApp.prems(1) .
    show "rj_stcv_atcv gc gc'" using SEApp.prems(2) .
    show "rj_se_ae e2 e2'" using e2'_refine .
    show "tj_se sc gc e2 t_arg" using e2_type .
    show "ff_atcv gc'" using SEApp.prems(5) .
    show "ff_ae e2'" using SEApp.prems(6) e0'_decomp by auto
    show "dwf_ae (atcs_defs sc') e2'" using SEApp.prems(7) e0'_decomp by auto
  qed
  have e1'_type_refine: "rj_st_at (STFun t_arg t0) (?t0' sc' gc' e1')"
    using e1_type e1'_refine e1_type ti_unif_ae_refine SEApp.prems(2) SEApp.prems(1) by force
  obtain e1'_lsv e1'_arg_ty e1'_ret_ty where e1'_ty_decomp: "?t0' sc' gc' e1' = ATFun e1'_lsv e1'_arg_ty e1'_ret_ty"
    using e1'_type_refine by(case_tac "?t0' sc' gc' e1'", auto)
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp e1'_ty_decomp e1'_result e2'_result by(simp add: split_def Let_def)
    show "?result2 sc' gc' e0'"
      using e0'_decomp e1'_ty_decomp e1'_result e2'_result apply(simp add: split_def Let_def)
      using SEApp.prems(1) SEApp.prems(2) SEApp.prems(6) e1'_type_refine e2'_refine e2_type ti_unif_ae_refine by fastforce
  qed
next
  case (SEVar x)
  have e0'_decomp: "e0' = AEVar x"
    using SEVar.prems(3) by(case_tac e0', auto)
  have x_in_gc: "gc x \<noteq> None"
    using SEVar.prems(4) by auto
  have x_in_gc': "gc' x \<noteq> None"
    using SEVar.prems(2) x_in_gc by auto
  show ?case
      using x_in_gc' e0'_decomp SEVar.prems(5) apply auto
      by (metis option.simps(5))
next
  case (SEDef d)
  obtain as where e0'_decomp: "e0' = AEDef d as"
    using SEDef.prems(3) by(case_tac e0', auto)
  obtain t where sc_entry: "stcs_defs sc d = Some t"
    using SEDef.prems(4) by auto
  obtain params t' d_cs where sc'_entry: "atcs_defs sc' d = Some (params, t', d_cs)" and t'_refine: "rj_st_at t t'"
    using SEDef.prems(1) sc_entry by auto
  show ?case
  proof
    have params_as_length: "length params = length as"
      using SEDef.prems(7) e0'_decomp sc'_entry by auto
    have as_ff: "\<And>a. a \<in> set as \<Longrightarrow> ff_als a"
      using SEDef.prems(6) e0'_decomp by auto
    have subst_ff: "\<And>v. ff_als
          (foldr (\<lambda>p new_f. new_f(fst p := snd p))
            (zip params as) ALSVar v)"
      using params_as_length as_ff
      apply(induct params arbitrary: as)
       apply auto
      by(case_tac as, auto)
    show "?result1 sc' gc' e0'"
      using e0'_decomp SEDef.prems(6,7) sc'_entry apply(simp add: split_def Let_def)
      apply(rule at_lsv_subst_ff)
      using subst_ff apply auto
      using SEDef.prems(1) apply auto
      by (metis (no_types, lifting) case_prod_conv option.simps(5))
    show "?result2 sc' gc' e0'"
      using e0'_decomp sc'_entry by auto
  qed
next
  case (SESelf d t)
  obtain t' where e0'_decomp: "e0' = AESelf d t'" and t'_refine: "rj_st_at t t'"
    using SESelf.prems(3) by(case_tac e0', auto)
  have sc_t_eq: "stcs_self_t sc = t"
    using SESelf.prems(4) by auto
  show ?case
  proof
    show "?result1 sc' gc' e0'"
      using e0'_decomp SESelf.prems(6) by simp
    show "?result2 sc' gc' e0'"
      using SESelf.prems(1,6) sc_t_eq e0'_decomp t'_refine by auto
  qed
qed

lemma ti_unif_ae_eqs: "
  rj_dwf_ff_atcs sc sc' \<Longrightarrow>
  rj_stcv_atcv gc gc' \<Longrightarrow>
  rj_se_ae e0 e0' \<Longrightarrow>
  tj_se sc gc e0 t0 \<Longrightarrow>
  ff_atcv gc' \<Longrightarrow>
  ff_ae e0' \<Longrightarrow>
  dwf_ae (atcs_defs sc') e0' \<Longrightarrow>
  (t0', cs) = ti_unif_ae sc' gc' e0' \<Longrightarrow>
    ff_at t0' \<and> (\<forall> c \<in> set cs. eq_good c)
"
  using ti_unif_ae_eqs_rec
  by (metis fst_conv snd_conv)

fun ti_pre_def :: "ATCD \<Rightarrow> Def \<Rightarrow> ST \<Rightarrow> SE \<Rightarrow> nat * AT * AE" where
"ti_pre_def dc def t e = (
  let (count, t') = ti_fresh_t 0 t in
  let (count', e') = ti_fresh_e dc count e in
  let (t'', cs) = ti_unif_ae (ATCS dc def t') (\<lambda> _. None) e' in
  let cs' = (t', t'') # cs in
  let cs'_reduce = concat (map (\<lambda> (t1, t2). ti_eq_reduce t1 t2) cs') in
  let m_lsvar = connected_components cs'_reduce in
  let m = (\<lambda> v. ALSVar (m_lsvar v)) in
  (count', at_lsv_subst m t', ae_lsv_subst m e')
)"

lemma tj_dwf_se: "tj_se sc gc e t \<Longrightarrow> dwf_se (stcs_defs sc) e"
  apply(induct e arbitrary: gc t) apply auto
   apply (metis case_prod_conv in_set_impl_in_set_zip1)
  by (metis (no_types, lifting) case_prodD in_set_impl_in_set_zip2)

lemma ti_pre_tj:
  fixes
    dc dc' def t t' e e'
  assumes
    dc_refine: "rj_stcd_atcd dc dc'" and
    dc_good: "dwf_ff_atcd dc'" and
    e_typed: "tj_se (STCS dc def t) Map.empty e t" and
    result_decomp: "(count, t', e') = ti_pre_def dc' def t e"
  shows "
    tj_ae (ATCS dc' def t') Map.empty e' t' \<and>
    ff_at t' \<and>
    ff_ae e' \<and>
    rj_st_at t t' \<and>
    rj_se_ae e e'
  " (is "?thesis_typed \<and> _ \<and> _ \<and> _ \<and> _")
proof(intro conjI)
  let ?fresh_t_result = "ti_fresh_t 0 t"
  let ?count = "fst ?fresh_t_result"
  let ?t' = "snd ?fresh_t_result"
  let ?fresh_e_result = "ti_fresh_e dc' ?count e"
  let ?count' = "fst ?fresh_e_result"
  let ?e' = "snd ?fresh_e_result"
  let ?unif_result = "ti_unif_ae (ATCS dc' def ?t') Map.empty ?e'"
  let ?t'' = "fst ?unif_result"
  let ?cs = "snd ?unif_result"
  let ?cs' = "(?t', ?t'') # ?cs"
  let ?cs'_reduce = "concat (map (\<lambda> (t1, t2). ti_eq_reduce t1 t2) ?cs')"
  let ?m_lsvar = "connected_components ?cs'_reduce"
  let ?m = "(\<lambda> v. ALSVar (?m_lsvar v))"
  let ?t_final = "at_lsv_subst ?m ?t''"
  let ?e_final = "ae_lsv_subst ?m ?e'"

  have t'_refine: "rj_st_at t ?t'"
    using ti_fresh_refine_t .
  have e'_refine: "rj_se_ae e ?e'"
    using ti_fresh_refine_e .
  have t'_ff: "ff_at ?t'"
    using ti_fresh_ff_t .
  have e'_ff: "ff_ae ?e'"
    using ti_fresh_ff_e .
  have e'_dwf: "dwf_ae dc' ?e'"
    using ti_fresh_dwf_e dc_refine e_typed
    by (metis STCS.sel(1) tj_dwf_se)

  have "ff_at ?t'' \<and> (\<forall> c \<in> set ?cs. eq_good c)"
  proof(rule ti_unif_ae_eqs)
    show "rj_dwf_ff_atcs (STCS dc def t) (ATCS dc' def ?t')"
      using t'_refine t'_ff dc_refine dc_good by auto
    show "rj_stcv_atcv Map.empty Map.empty" by auto
    show "rj_se_ae e ?e'" using e'_refine .
    show "tj_se (STCS dc def t) Map.empty e t" using e_typed .
    show "ff_atcv Map.empty" by auto
    show "ff_ae ?e'" using e'_ff .
    show "dwf_ae (atcs_defs (ATCS dc' def ?t')) ?e'"
      using e'_dwf by auto
    show "(?t'', ?cs) = ?unif_result" by auto
  qed
  then have
    t''_ff: "ff_at ?t''" and
    cs_good: "\<And>c. c \<in> set ?cs \<Longrightarrow> eq_good c"
    by auto

  have t''_refine: "rj_st_at t ?t''"
  proof(rule ti_unif_ae_refine)
    show "tj_se (STCS dc def t) Map.empty e t" using e_typed .
    show "rj_stcs_atcs (STCS dc def t) (ATCS dc' def ?t')"
      using dc_refine t'_refine by auto
    show "rj_stcv_atcv Map.empty Map.empty" by auto
    show "rj_se_ae e ?e'" using e'_refine .
  qed

  have rec_eq_good: "eq_good (?t', ?t'')"
  proof(simp only: eq_good.simps, intro conjI)
    show "strip_at ?t' = strip_at ?t''" using t''_refine t'_refine by auto
    show "ff_at ?t'" using t'_ff .
    show "ff_at ?t''" using t''_ff .
  qed

  have cs'_good: "\<And> c. c \<in> set ?cs' \<Longrightarrow> eq_good c"
    using cs_good rec_eq_good by auto

  have cs'_reduce_sat: "eqs_sat (lsvar_eqs_lsv_subst ?m ?cs'_reduce)"
  proof(simp only: eqs_sat.simps, intro ballI)
    fix c
    assume c_in: "c \<in> set (lsvar_eqs_lsv_subst ?m ?cs'_reduce)"
    obtain a b where
      c_decomp: "c = (?m a, ?m b)" and
      a_b_in: "(a, b) \<in> set ?cs'_reduce"
      using c_in by(auto, blast)
    have "?m a = ?m b"
      using connected_components_equiv a_b_in
      by blast
    then show "eq_sat c"
      using c_decomp by auto
  qed

  have cs'_sat: "eqs_sat (eqs_lsv_subst ?m ?cs')"
  proof(simp only: eqs_sat.simps, intro ballI)
    fix c
    assume c_in: "c \<in> set (eqs_lsv_subst ?m ?cs')"
    obtain a b where
      c_decomp: "c = (at_lsv_subst ?m a, at_lsv_subst ?m b)" and
      a_b_in: "(a, b) \<in> set ?cs'"
      using c_in by(case_tac c, auto)
    have a_b_good: "eq_good (a, b)"
      using a_b_in cs'_good
      by blast
    have "at_lsv_subst ?m a = at_lsv_subst ?m b"
    proof(rule ti_eq_reduce_ff)
      let ?common = "strip_at a"
      show "rj_st_at ?common a" by auto
      show "rj_st_at ?common b" using a_b_good by auto
      show "ff_at a" using a_b_good by auto
      show "ff_at b" using a_b_good by auto
      have reduced_in: "set (ti_eq_reduce a b) \<subseteq> set ?cs'_reduce"
        using a_b_in by auto
      show "eqs_sat (lsvar_eqs_lsv_subst ?m (ti_eq_reduce a b))"
        using cs'_reduce_sat reduced_in apply(auto)
        by (smt (z3) ALS.inject(1) UN_I UnCI a_b_in eq_sat.simps image_eqI insert_iff list.simps(15) lsvar_eq_lsv_subst.simps mem_Collect_eq old.prod.case)
    qed
    then show "eq_sat c"
      using c_decomp by auto
  qed

  have body_typed: "tj_ae (atcs_lsv_subst ?m (ATCS dc' def ?t')) (atcv_lsv_subst ?m Map.empty) ?e_final ?t_final"
  proof(rule ti_unif_ae_subst)
    show "rj_stcs_atcs (STCS dc def t) (ATCS dc' def ?t')"
      using dc_refine t'_refine by auto
    show "rj_stcv_atcv Map.empty Map.empty" by auto
    show "rj_se_ae e ?e'"
      using e'_refine .
    show "tj_se (STCS dc def t) Map.empty e t"
      using e_typed .
    show "eqs_sat (eqs_lsv_subst ?m ?cs)" using cs'_sat by auto
    show "(?t'', ?cs) = ti_unif_ae (ATCS dc' def ?t') Map.empty ?e'" by auto
    show "dwf_ae (atcs_defs (ATCS dc' def ?t')) ?e'" using e'_dwf by auto
    show "dwf_atcd (atcs_defs (ATCS dc' def ?t'))" using dc_good by auto
  qed

  have rec_compat: "?t_final = at_lsv_subst ?m ?t'"
    using cs'_sat by auto

  show ?thesis_typed
    using result_decomp body_typed rec_compat by(simp add: split_def Let_def)

  have "ff_at ?t_final"
  proof(rule at_lsv_subst_ff)
    show "\<And>v. ff_als (?m v)" by auto
    show "ff_at ?t''" using t''_ff .
  qed
  then show "ff_at t'"
    using result_decomp rec_compat by(simp add: split_def Let_def)

  have "ff_ae ?e_final"
  proof(rule ae_lsv_subst_ff)
    show "\<And>v. ff_als (?m v)" by auto
    show "ff_ae ?e'" using e'_ff .
  qed
  then show "ff_ae e'"
    using result_decomp by(simp add: split_def Let_def)

  have "rj_st_at t ?t_final"
    using at_lsv_subst_preserve_strip t''_refine by simp
  then show "rj_st_at t t'"
    using result_decomp rec_compat by(simp add: split_def Let_def)

  have "rj_se_ae e ?e_final"
    using ae_lsv_subst_preserve_strip e'_refine by simp
  then show "rj_se_ae e e'"
    using result_decomp by(simp add: split_def Let_def)
qed

lemma lsv_subst_tj:
  assumes sc_dwf: "dwf_atcd (atcs_defs sc)"
  shows "
  tj_ae sc gc e0' t0' \<Longrightarrow>
  dwf_ae (atcs_defs sc) e0' \<Longrightarrow>
  tj_ae (atcs_lsv_subst m sc) (atcv_lsv_subst m gc) (ae_lsv_subst m e0') (at_lsv_subst m t0')
"
(is "?orig_typed gc e0' t0' \<Longrightarrow> ?dwf e0' \<Longrightarrow> ?subst_typed gc e0' t0'")
proof(induct "strip_ae e0'" arbitrary: gc e0' t0')
  case (SETup es)
  obtain es' where e0'_decomp: "e0' = AETup es'" and es'_refine: "map strip_ae es' = es"
    using SETup.hyps(2) by(case_tac e0', auto)
  obtain n where es_length: "length es = n" and es'_length: "length es' = n"
    using es'_refine by auto
  obtain ts' where
    t0'_decomp: "t0' = ATProd ts'" and
    ts'_length: "length ts' = n" and
    elem_typed: "\<forall>(e', t') \<in> set (zip es' ts'). tj_ae sc gc e' t'"
    using SETup.prems(1) e0'_decomp es'_length apply(simp add: split_def)
    by blast
  have elem_result: "\<And>i. i < n \<Longrightarrow> ?subst_typed gc (es' ! i) (ts' ! i)"
  proof -
    fix i
    assume i_bound: "i < n"
    show "?subst_typed gc (es' ! i) (ts' ! i)"
    proof(rule SETup.hyps(1))
      show "strip_ae (es' ! i) \<in> set es"
        using es'_refine es'_length i_bound by auto
      show "?orig_typed gc (es' ! i) (ts' ! i)"
        using elem_typed es'_length ts'_length i_bound apply(simp add: split_def)
        by (metis fst_conv in_set_zip snd_conv)
      show "?dwf (es' ! i)"
        using SETup.prems(2) e0'_decomp i_bound es'_length by auto
    qed
  qed
  show ?case
    apply(simp only: e0'_decomp tj_ae.simps ae_lsv_subst.simps)
    using elem_result es'_length ts'_length apply(simp add: split_def)
    by (smt (verit, del_insts) at_lsv_subst.simps(2) atcv_lsv_subst.simps elem_result in_set_zip length_map nth_map t0'_decomp)
next
  case (SEProj i e)
  obtain e' where
    e0'_decomp: "e0' = AEProj i e'" and
    e'_refine: "rj_se_ae e e'"
    using SEProj.hyps(2) by(case_tac e0', auto)
  obtain ts' where
    t0'_decomp: "t0' = ts' ! i" and
    e'_type: "tj_ae sc gc e' (ATProd ts')" and
    i_bound: "i < length ts'"
    using SEProj.prems(1) e0'_decomp by auto
  have e'_result: "?subst_typed gc e' (ATProd ts')"
  proof(rule SEProj.hyps(1))
    show "e = strip_ae e'" using e'_refine by auto
    show "tj_ae sc gc e' (ATProd ts')" using e'_type by auto
    show "?dwf e'" using SEProj.prems(2) e0'_decomp by auto
  qed
  then show ?case
    using e'_result e0'_decomp i_bound t0'_decomp apply auto
    by (metis at_lsv_subst.simps(2) atcv_lsv_subst.simps e'_result length_map nth_map)
next
  case (SEInj ts i e)
  obtain ts' e' where
    e0'_decomp: "e0' = AEInj ts' i e'" and
    ts'_refine: "map strip_at ts' = ts" and
    e'_refine: "rj_se_ae e e'"
    using SEInj.hyps(2) by(case_tac e0', auto)
  have
    t0'_decomp: "t0' = ATSum ts'" and
    e'_type: "?orig_typed gc e' (ts' ! i)" and
    i_bound: "i < length ts'"
    using SEInj.prems(1) e0'_decomp by auto
  have e'_result: "?subst_typed gc e' (ts' ! i)"
  proof(rule SEInj.hyps(1))
    show "e = strip_ae e'" using e'_refine by auto
    show "tj_ae sc gc e' (ts' ! i)" using e'_type .
    show "?dwf e'" using SEInj.prems(2) e0'_decomp by auto
  qed
  then show ?case
    using e0'_decomp i_bound t0'_decomp apply auto
    using atcv_lsv_subst.simps e'_result by presburger
next
  case (SEFold u t e)
  obtain t' e' where
    e0'_decomp: "e0' = AEFold u t' e'" and
    t'_refine: "rj_st_at t t'" and
    e'_refine: "rj_se_ae e e'"
    using SEFold.hyps(2) by(case_tac e0', auto)
  have
    t0'_decomp: "t0' = ATMu u t'" and
    e'_type: "?orig_typed gc e' (at_subst (ATVar(u := ATMu u t')) t')"
    using SEFold.prems(1) e0'_decomp by auto
  have e'_result: "?subst_typed gc e' (at_subst (ATVar(u := ATMu u t')) t')"
  proof(rule SEFold.hyps(1))
    show "e = strip_ae e'" using e'_refine by auto
    show "?orig_typed gc e' (at_subst (ATVar(u := ATMu u t')) t')" using e'_type by auto
    show "?dwf e'" using SEFold.prems(2) e0'_decomp by auto
  qed
  have "at_lsv_subst m (at_subst (ATVar(u := ATMu u t')) t') = at_subst (ATVar(u := ATMu u (at_lsv_subst m t'))) (at_lsv_subst m t')"
    using at_lsv_mu_subst_comm apply auto
    by (metis at_lsv_subst.simps(4) at_lsv_subst.simps(5) comp_apply fun_upd_apply)
  then show ?case
    using e0'_decomp t0'_decomp apply auto
    using atcv_lsv_subst.simps e'_result by presburger
next
  case (SEUnfold e)
  obtain e' where
    e0'_decomp: "e0' = AEUnfold e'" and
    e'_refine: "rj_se_ae e e'"
    using SEUnfold.hyps(2) by(case_tac e0', auto)
  obtain u t' where
    t0'_decomp: "t0' = at_subst (ATVar(u := ATMu u t')) t'" and
    e'_type: "?orig_typed gc e' (ATMu u t')"
    using SEUnfold.prems(1) e0'_decomp by auto
  have e'_result: "?subst_typed gc e' (ATMu u t')"
  proof(rule SEUnfold.hyps(1))
    show "e = strip_ae e'" using e'_refine by auto
    show "?orig_typed gc e' (ATMu u t')" using e'_type by auto
    show "?dwf e'" using SEUnfold.prems(2) e0'_decomp by auto
  qed
  have "at_lsv_subst m (at_subst (ATVar(u := ATMu u t')) t') = at_subst (ATVar(u := ATMu u (at_lsv_subst m t'))) (at_lsv_subst m t')"
    using at_lsv_mu_subst_comm apply auto
    by (metis at_lsv_subst.simps(4) at_lsv_subst.simps(5) comp_apply fun_upd_apply)
  then show ?case
    using e0'_decomp t0'_decomp apply auto
    by (metis at_lsv_subst.simps(4) atcv_lsv_subst.simps e'_result)
next
  case (SELet x e1 e2)
  obtain e1' e2' where
    e0'_decomp: "e0' = AELet x e1' e2'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    e2'_refine: "rj_se_ae e2 e2'"
    using SELet.hyps(3) by(case_tac e0', auto)
  obtain t1' where
    e1'_type: "?orig_typed gc e1' t1'" and
    e2'_type: "?orig_typed (gc(x := Some t1')) e2' t0'" and
    x_fresh: "gc x = None"
    using SELet.prems(1) e0'_decomp by(simp only: tj_ae.simps, blast)
  have e1'_result: "?subst_typed gc e1' t1'"
  proof(rule SELet.hyps(1))
    show "e1 = strip_ae e1'" using e1'_refine by auto
    show "?orig_typed gc e1' t1'" using e1'_type .
    show "?dwf e1'" using SELet.prems(2) e0'_decomp by auto
  qed
  have e2'_result: "?subst_typed (gc(x := Some t1')) e2' t0'"
  proof(rule SELet.hyps(2))
    show "e2 = strip_ae e2'" using e2'_refine by auto
    show "?orig_typed (gc(x := Some t1')) e2' t0'" using e2'_type .
    show "?dwf e2'" using SELet.prems(2) e0'_decomp by auto
  qed
  then show ?case
    using e0'_decomp e2'_type x_fresh apply(auto)
    by (metis (no_types, lifting) atcv_lsv_subst.simps e1'_result e2'_result map_option_o_map_upd)
next
  case (SEMatch ret e_dis cases)
  obtain ret' e_dis' cases' where
    e0'_decomp: "e0' = AEMatch ret' e_dis' cases'" and
    ret'_refine: "rj_st_at ret ret'" and
    e_dis'_refine: "rj_se_ae e_dis e_dis'" and
    cases'_refine: "map (\<lambda>(x, e_case'). (x, strip_ae e_case')) cases' = cases"
    using SEMatch.hyps(3) by(case_tac e0', auto)
  obtain ts' where
    t0'_decomp: "t0' = ret'" and
    e_dis'_type: "?orig_typed gc e_dis' (ATSum ts')" and
    ts'_length: "length ts' = length cases'" and
    case_type: "\<forall>(t', (x, e_case')) \<in> set (zip ts' cases'). (gc x = None \<and> ?orig_typed (gc(x := Some t')) e_case' ret')"
    using SEMatch.prems(1) e0'_decomp apply(simp only: tj_ae.simps)
    by blast
  have e_dis'_result: "?subst_typed gc e_dis' (ATSum ts')"
  proof(rule SEMatch.hyps(1))
    show "e_dis = strip_ae e_dis'" using e_dis'_refine by auto
    show "?orig_typed gc e_dis' (ATSum ts')" using e_dis'_type .
    show "?dwf e_dis'" using SEMatch.prems(2) e0'_decomp by auto
  qed
  have case_result: "\<And>i. i < length cases' \<Longrightarrow> (gc (fst (cases' ! i)) = None \<and> ?subst_typed (gc(fst (cases' ! i) := Some (ts' ! i))) (snd (cases' ! i)) ret')"
  proof
    fix i
    assume i_bound: "i < length cases'"
    show "gc (fst (cases' ! i)) = None"
      using case_type i_bound apply(simp only: split_def)
      by (metis in_set_impl_in_set_zip2 nth_mem snd_eqD ts'_length)
    show "?subst_typed (gc(fst (cases' ! i) := Some (ts' ! i))) (snd (cases' ! i)) ret'"
    proof(rule SEMatch.hyps(2))
      show "(cases ! i) \<in> set cases" using i_bound cases'_refine by auto
      show "strip_ae (snd (cases' ! i)) \<in> Basic_BNFs.snds (cases ! i)"
        by (metis (no_types, lifting) case_prod_conv cases'_refine i_bound nth_map old.prod.inject prod.collapse snds.simps)
      have "(ts' ! i, cases' ! i) \<in> set (zip ts' cases')"
        using i_bound ts'_length
        by (metis in_set_conv_nth length_zip min_less_iff_conj nth_zip)
      then show "?orig_typed (gc(fst (cases' ! i) := Some (ts' ! i))) (snd (cases' ! i)) ret'"
        using case_type i_bound apply(simp only: split_def)
        by (metis fst_conv snd_conv)
      show "?dwf (snd (cases' ! i))" using SEMatch.prems(2) e0'_decomp i_bound nth_mem by fastforce
    qed
  qed
  have case_result_zip: "\<And>p. p \<in> set (zip ts' cases') \<Longrightarrow> (gc (fst (snd p)) = None \<and> ?subst_typed (gc(fst (snd p) := Some (fst p))) (snd (snd p)) ret')"
    using case_result ts'_length
    by (metis in_set_zip)
  show ?case
    apply(simp only: e0'_decomp t0'_decomp tj_ae.simps ae_lsv_subst.simps)
    apply(intro exI[where ?x = "map (at_lsv_subst m) ts'"] conjI)
    using ts'_length apply simp
    using e_dis'_result apply(simp only: at_lsv_subst.simps)
    using case_result_zip apply(simp add: split_def)
     apply (smt (verit, ccfv_SIG) atcv_lsv_subst.simps case_result fst_conv in_set_zip length_map map_option_o_map_upd nth_map snd_conv)
    apply simp
    done
next
  case (SELam x t1 e1 y t2 e2 t3)
  obtain a t1' e1' t2' e2' t3' where
    e0'_decomp: "e0' = AELam a x t1' e1' y t2' e2' t3'" and
    t1'_refine: "rj_st_at t1 t1'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    t2'_refine: "rj_st_at t2 t2'" and
    e2'_refine: "rj_se_ae e2 e2'" and
    t3'_refine: "rj_st_at t3 t3'"
    using SELam.hyps(3) by(case_tac e0', auto)
  have
    t0'_decomp: "t0' = ATFun a t2' t3'" and
    e1'_type: "?orig_typed gc e1' t1'" and
    e2'_type: "?orig_typed (Map.empty(x := Some t1', y := Some t2')) e2' t3'"
    using SELam.prems(1) e0'_decomp LSS.tj_ae_lam by(blast)+
  have e1'_result: "?subst_typed gc e1' t1'"
  proof(rule SELam.hyps(1))
    show "e1 = strip_ae e1'" using e1'_refine by auto
    show "?orig_typed gc e1' t1'" using e1'_type .
    show "?dwf e1'" using SELam.prems(2) e0'_decomp by auto
  qed
  have e2'_result: "?subst_typed (Map.empty(x := Some t1', y := Some t2')) e2' t3'"
  proof(rule SELam.hyps(2))
    show "e2 = strip_ae e2'" using e2'_refine by auto
    show "?orig_typed (Map.empty(x := Some t1', y := Some t2')) e2' t3'" using e2'_type .
    show "?dwf e2'" using SELam.prems(2) e0'_decomp by auto
  qed
  show ?case
    using e0'_decomp t0'_decomp apply(auto)
    using atcv_lsv_subst.simps e1'_result apply presburger
    by (smt (z3) atcv_lsv_subst.elims dom_eq_empty_conv dom_map_option_comp e2'_result map_option_o_map_upd)
next
  case (SEApp e1 e2)
  obtain a e1' e2' where
    e0'_decomp: "e0' = AEApp a e1' e2'" and
    e1'_refine: "rj_se_ae e1 e1'" and
    e2'_refine: "rj_se_ae e2 e2'"
    using SEApp.hyps(3) by(case_tac e0', auto)
  obtain t_arg' where
    e1'_type: "?orig_typed gc e1' (ATFun a t_arg' t0')" and
    e2'_type: "?orig_typed gc e2' t_arg'"
    using SEApp.prems(1) e0'_decomp by auto
  have e1'_result: "?subst_typed gc e1' (ATFun a t_arg' t0')"
  proof(rule SEApp.hyps(1))
    show "e1 = strip_ae e1'" using e1'_refine by auto
    show "?orig_typed gc e1' (ATFun a t_arg' t0')" using e1'_type .
    show "?dwf e1'" using SEApp.prems(2) e0'_decomp by auto
  qed
  have e2'_result: "?subst_typed gc e2' t_arg'"
  proof(rule SEApp.hyps(2))
    show "e2 = strip_ae e2'" using e2'_refine by auto
    show "?orig_typed gc e2' t_arg'" using e2'_type .
    show "?dwf e2'" using SEApp.prems(2) e0'_decomp by auto
  qed
  show ?case
    using e0'_decomp apply auto
    by (metis at_lsv_subst.simps(1) atcv_lsv_subst.simps e1'_result e2'_result)
next
  case (SEVar x)
  have e0'_decomp: "e0' = AEVar x"
    using SEVar.hyps(1) by(case_tac e0', auto)
  then show ?case
    using SEVar.prems e0'_decomp by auto
next
  case (SEDef d)
  obtain as where e0'_decomp: "e0' = AEDef d as"
    using SEDef.hyps by(case_tac e0', auto)
  obtain vs t_sig d_cs where d_entry: "atcs_defs sc d = Some (vs, t_sig, d_cs)"
    using SEDef.prems(1) e0'_decomp by auto
  have as_length: "length as = length vs"
    using SEDef.prems(2) e0'_decomp d_entry by simp
  have subst_free: "lsv_subst_free_at vs as m t_sig"
    using lsv_subst_free sc_dwf as_length by auto
  have "free_at t_sig \<subseteq> set vs"
    using d_entry sc_dwf
    by (smt (z3) case_prodD dwf_atcd.elims(2) option.simps(5) subset_iff) 
  then have subst_sig: "at_lsv_subst m (at_lsv_subst (lsv_inst vs as) t_sig) = at_lsv_subst (lsv_inst vs (map (als_lsv_subst m) as)) t_sig"
    using sc_dwf d_entry subst_free by auto
  show ?case
    using SEDef.prems e0'_decomp subst_sig
    (* TODO: whether this works is non-deterministic *)
    by (smt (z3) ATCS.collapse ATCS.sel(1) LSS.tj_ae_def ae_lsv_subst.simps(11) atcs_lsv_subst.simps d_entry length_map old.prod.inject option.inject)
next
  case (SESelf d t)
  obtain t' where e0'_decomp: "e0' = AESelf d t'"
    using SESelf.hyps(1) by(case_tac e0', auto)
  then show ?case
    using SESelf.prems e0'_decomp apply auto
    apply (metis ATCS.collapse ATCS.sel(2) atcs_lsv_subst.simps)
    by (metis ATCS.collapse ATCS.sel(3) atcs_lsv_subst.simps)
qed

lemma lsv_subst_dwf:
  assumes orig_dwf: "dwf_ae dc e0"
  shows "dwf_ae dc (ae_lsv_subst m e0)"
proof -
  have "\<And>e. True \<and> True \<and> (dwf_ae dc e \<longrightarrow> dwf_ae dc (ae_lsv_subst m e))"
    apply(rule ALS_AT_AE.induct[where
          ?P1.0 = "\<lambda> _. True" and
          ?P2.0 = "\<lambda> _. True" and
          ?P3.0 = "\<lambda> e. (dwf_ae dc e \<longrightarrow> dwf_ae dc (ae_lsv_subst m e))"])
    by (auto, metis length_map)
  then show ?thesis
    using orig_dwf by auto
qed

fun ti_collect_ae :: "ATCD \<Rightarrow> AE \<Rightarrow> ACC" where
"ti_collect_ae dc (AETup es) = concat (map (ti_collect_ae dc) es)" |
"ti_collect_ae dc (AEProj _ e) = ti_collect_ae dc e" |
"ti_collect_ae dc (AEInj _ _ e) = ti_collect_ae dc e" |
"ti_collect_ae dc (AEFold _ _ e) = ti_collect_ae dc e" |
"ti_collect_ae dc (AEUnfold e) = ti_collect_ae dc e" |
"ti_collect_ae dc (AELet _ e1 e2) = ti_collect_ae dc e1 @ ti_collect_ae dc e2" |
"ti_collect_ae dc (AEMatch _ e_dis cases) = ti_collect_ae dc e_dis @ concat (map (\<lambda> (_, e). ti_collect_ae dc e) cases)" |
"ti_collect_ae dc (AELam a x t1 e1 y t2 e2 t3) = ((x, t1, y, t2, e2, t3), a) # ti_collect_ae dc e1 @ ti_collect_ae dc e2" |
"ti_collect_ae dc (AEApp _ e1 e2) = ti_collect_ae dc e1 @ ti_collect_ae dc e2" |
"ti_collect_ae dc (AEVar x) = []" |
"ti_collect_ae dc (AEDef d as) = (
  case dc d of
    Some (vs, _, cs) \<Rightarrow> alsc_lsv_subst_all (lsv_inst vs as) cs |
    None \<Rightarrow> []
)" |
"ti_collect_ae dc (AESelf _ _) = []"

lemma ae_induct_simple: "
  (\<And>x. (\<And>xa. xa \<in> set x \<Longrightarrow> p xa) \<Longrightarrow> p (AETup x)) \<Longrightarrow>
  (\<And>x1 x2. p x2 \<Longrightarrow> p (AEProj x1 x2)) \<Longrightarrow>
  (\<And>x1 x2 x3. p x3 \<Longrightarrow> p (AEInj x1 x2 x3)) \<Longrightarrow>
  (\<And>x1 x2 x3. p x3 \<Longrightarrow> p (AEFold x1 x2 x3)) \<Longrightarrow>
  (\<And>x. p x \<Longrightarrow> p (AEUnfold x)) \<Longrightarrow>
  (\<And>x1 x2 x3. p x2 \<Longrightarrow> p x3 \<Longrightarrow> p (AELet x1 x2 x3)) \<Longrightarrow>
  (\<And>x1 x2 x3.
      p x2 \<Longrightarrow>
      (\<And>x3a x3aa. x3a \<in> set x3 \<Longrightarrow> x3aa \<in> Basic_BNFs.snds x3a \<Longrightarrow> p x3aa) \<Longrightarrow>
      p (AEMatch x1 x2 x3)) \<Longrightarrow>
  (\<And>x1 x2 x3 x4 x5 x6 x7 x8.
      p x4 \<Longrightarrow> p x7 \<Longrightarrow> p (AELam x1 x2 x3 x4 x5 x6 x7 x8)) \<Longrightarrow>
  (\<And>x1 x2 x3. p x2 \<Longrightarrow> p x3 \<Longrightarrow> p (AEApp x1 x2 x3)) \<Longrightarrow>
  (\<And>x. p (AEVar x)) \<Longrightarrow>
  (\<And>x1 x2. p (AEDef x1 x2)) \<Longrightarrow>
  (\<And>x1 x2. p (AESelf x1 x2)) \<Longrightarrow> p e
"
  by(rule AE.induct, auto)

lemma ti_collect_cj:
  assumes dc_dwf: "dwf_atcd dc"
  shows "
    dwf_ae dc e \<Longrightarrow>
    cj_alsc_all cc (ti_collect_ae dc e) \<Longrightarrow>
    cj_ae dc cc e
  "
  apply(induct e rule: ae_induct_simple)
  apply auto
  using UnI2 apply blast
  apply(case_tac "dc x1") apply simp
  apply(simp add: split_def)
  by force

lemma als_induct_simple: "
    (\<And>x. p (ALSVar x)) \<Longrightarrow>
    (\<And>x. p (ALSSet x)) \<Longrightarrow>
    (\<And>x. p (ALSMuVar x)) \<Longrightarrow>
    (\<And>x1 x2. p x2 \<Longrightarrow> p (ALSMu x1 x2)) \<Longrightarrow>
    p a
"
  by(rule ALS.induct, auto)

lemma at_induct_simple: "
  (\<And>x1 x2 x3. p x2 \<Longrightarrow> p x3 \<Longrightarrow> p (ATFun x1 x2 x3)) \<Longrightarrow>
  (\<And>x. (\<And>xa. xa \<in> set x \<Longrightarrow> p xa) \<Longrightarrow> p (ATProd x)) \<Longrightarrow>
  (\<And>x. (\<And>xa. xa \<in> set x \<Longrightarrow> p xa) \<Longrightarrow> p (ATSum x)) \<Longrightarrow>
  (\<And>x1 x2. p x2 \<Longrightarrow> p (ATMu x1 x2)) \<Longrightarrow>
  (\<And>x. p (ATVar x)) \<Longrightarrow>
  p t
"
  by(rule AT.induct, auto)

function
  free_als_mu_al :: "AL \<Rightarrow> LSVar set" and
  free_als_mu_als :: "ALS \<Rightarrow> LSVar set" and
  free_als_mu_at :: "AT \<Rightarrow> LSVar set" and
  free_als_mu_ae :: "AE \<Rightarrow> LSVar set"
  where
"free_als_mu_al (x, t1, y, t2, e, t3) = free_als_mu_at t1 \<union> free_als_mu_at t2 \<union> free_als_mu_ae e \<union> free_als_mu_at t3" |
"free_als_mu_als (ALSVar v) = {}" |
"free_als_mu_als (ALSSet ls) = list_union (map free_als_mu_al ls)" |
"free_als_mu_als (ALSMu u a) = Set.remove u (free_als_mu_als a)" |
"free_als_mu_als (ALSMuVar u) = {u}" |
"free_als_mu_at (ATFun a t1 t2) = free_als_mu_als a \<union> free_als_mu_at t1 \<union> free_als_mu_at t2" |
"free_als_mu_at (ATProd ts) = list_union (map free_als_mu_at ts)" |
"free_als_mu_at (ATSum ts) = list_union (map free_als_mu_at ts)" |
"free_als_mu_at (ATMu u t) = free_als_mu_at t" |
"free_als_mu_at (ATVar u) = {}" |
"free_als_mu_ae (AETup es) = list_union (map free_als_mu_ae es)" |
"free_als_mu_ae (AEProj i e) = free_als_mu_ae e" |
"free_als_mu_ae (AEInj ts i e) = list_union (map free_als_mu_at ts) \<union> free_als_mu_ae e" |
"free_als_mu_ae (AEFold u t e) = free_als_mu_at t \<union> free_als_mu_ae e" |
"free_als_mu_ae (AEUnfold e) = free_als_mu_ae e" |
"free_als_mu_ae (AELet x e1 e2) = free_als_mu_ae e1 \<union> free_als_mu_ae e2" |
"free_als_mu_ae (AEMatch t e cases) = free_als_mu_at t \<union> free_als_mu_ae e \<union> list_union (map (\<lambda> (_, e_case). free_als_mu_ae e_case) cases)" |
"free_als_mu_ae (AELam a x t1 e1 y t2 e2 t3) = free_als_mu_als a \<union> free_als_mu_at t1 \<union> free_als_mu_ae e1 \<union> free_als_mu_at t2 \<union> free_als_mu_ae e2 \<union> free_als_mu_at t3" |
"free_als_mu_ae (AEApp a e1 e2) = free_als_mu_als a \<union> free_als_mu_ae e1 \<union> free_als_mu_ae e2" |
"free_als_mu_ae (AEVar x) = {}" |
"free_als_mu_ae (AEDef d as) = list_union (map free_als_mu_als as)" |
"free_als_mu_ae (AESelf d t) = free_als_mu_at t"
  by (pat_completeness) auto
termination by(size_change)

fun free_als_mu_alsc :: "ALSC \<Rightarrow> LSVar set" where
"free_als_mu_alsc (l, a) = free_als_mu_al l \<union> free_als_mu_als a"

fun free_als_mu_alsc_all :: "ACC \<Rightarrow> LSVar set" where
"free_als_mu_alsc_all cs = (\<Union> (free_als_mu_alsc ` set cs))"

(* mu vars unmodified by a substitution *)
fun unmod_mu_vars :: "(MuVar \<Rightarrow> ALS) \<Rightarrow> MuVar set" where
"unmod_mu_vars m = {u. m u = ALSMuVar u}"

lemma mu_subst_no_free_rec: "
  (\<forall> m. free_als_mu_als a \<subseteq> unmod_mu_vars m \<longrightarrow> als_mu_subst m a = a) \<and>
  (\<forall> m. free_als_mu_at t \<subseteq> unmod_mu_vars m \<longrightarrow> at_mu_subst m t = t) \<and>
  (\<forall> m. free_als_mu_ae e \<subseteq> unmod_mu_vars m \<longrightarrow> ae_mu_subst m e = e)
"
proof(induct rule: ALS_AT_AE.induct)
  case (ALSVar v)
  then show ?case by auto
next
  case (ALSSet s)
  show ?case
  proof(intro allI impI)
    fix m
    assume no_free: "free_als_mu_als (ALSSet s) \<subseteq> unmod_mu_vars m"
    have elem_result: "
      \<And>x t1 y t2 e t3.
        (x, t1, y, t2, e, t3) \<in> set s \<Longrightarrow>
        at_mu_subst m t1 = t1 \<and>
        ae_mu_subst m e = e \<and>
        at_mu_subst m t2 = t2 \<and>
        at_mu_subst m t3 = t3
    "
    proof(intro conjI)
      fix x t1 y t2 e t3
      assume in_set: "(x, t1, y, t2, e, t3) \<in> set s"
      have "free_als_mu_at t1 \<subseteq> free_als_mu_als (ALSSet s)"
        using in_set by(induct s, auto)
      then have "free_als_mu_at t1 \<subseteq> unmod_mu_vars m"
        using no_free by auto
      then show "at_mu_subst m t1 = t1"
        using in_set ALSSet.hyps(1) by auto

      have "free_als_mu_ae e \<subseteq> free_als_mu_als (ALSSet s)"
        using in_set by(induct s, auto)
      then have "free_als_mu_ae e \<subseteq> unmod_mu_vars m"
        using no_free by auto
      then show "ae_mu_subst m e = e"
        using in_set ALSSet.hyps(3) by auto

      have "free_als_mu_at t2 \<subseteq> free_als_mu_als (ALSSet s)"
        using in_set by(induct s, auto)
      then have "free_als_mu_at t2 \<subseteq> unmod_mu_vars m"
        using no_free by auto
      then show "at_mu_subst m t2 = t2"
        using in_set ALSSet.hyps(2) by auto

      have "free_als_mu_at t3 \<subseteq> free_als_mu_als (ALSSet s)"
        using in_set by(induct s, auto)
      then have "free_als_mu_at t3 \<subseteq> unmod_mu_vars m"
        using no_free by auto
      then show "at_mu_subst m t3 = t3"
        using in_set ALSSet.hyps(4) by auto
    qed
    show "als_mu_subst m (ALSSet s) = ALSSet s"
      using no_free elem_result apply(induct s)
       apply(simp)
      apply(case_tac a)
      apply simp
      by presburger
  qed
next
  case (ALSMuVar u)
  then show ?case by auto
next
  case (ALSMu u a)
  show ?case
  proof(intro allI impI)
    fix m
    assume "free_als_mu_als (ALSMu u a) \<subseteq> unmod_mu_vars m"
    then have "free_als_mu_als a \<subseteq> unmod_mu_vars (m(u := ALSMuVar u))"
      by auto
    then show "als_mu_subst m (ALSMu u a) = ALSMu u a"
      using ALSMu.hyps by auto
  qed
next
  case (ATFun a t1 t2)
  then show ?case by simp
next
  case (ATProd ts)
  then show ?case by (simp add: UN_subset_iff map_idI)
next
  case (ATSum ts)
  then show ?case by (simp add: UN_subset_iff map_idI)
next
  case (ATMu u t)
  then show ?case by auto
next
  case (ATVar u)
  then show ?case by auto
next
  case (AETup es)
  then show ?case by (simp add: UN_subset_iff map_idI)
next
  case (AEProj i e)
  then show ?case by auto
next
  case (AEInj ts i e)
  then show ?case by (simp add: UN_subset_iff map_idI)
next
  case (AEFold u t e)
  then show ?case by auto
next
  case (AEUnfold e)
  then show ?case by auto
next
  case (AELet x e1 e2)
  then show ?case by auto
next
  case (AEMatch t e cases)
  show ?case
  proof(intro allI impI)
    fix m
    assume no_free: "free_als_mu_ae (AEMatch t e cases) \<subseteq> unmod_mu_vars m"
    have result_t: "at_mu_subst m t = t"
      using no_free AEMatch.hyps(1) by auto
    have result_e: "ae_mu_subst m e = e"
      using no_free AEMatch.hyps(2) by auto
    have "\<forall> (case_x, case_e) \<in> set cases. free_als_mu_ae case_e \<subseteq> unmod_mu_vars m"
      using no_free by auto
    then have result_cases: "\<forall> (case_x, case_e) \<in> set cases. ae_mu_subst m case_e = case_e"
      using AEMatch.hyps(3) by auto
    show "ae_mu_subst m (AEMatch t e cases) = AEMatch t e cases"
      using result_t result_e result_cases by (simp add: case_prod_beta map_idI)
  qed
next
  case (AELam a x t1 e1 y t2 e2 t3)
  then show ?case by auto
next
  case (AEApp a e1 e2)
  then show ?case by auto
next
  case (AEVar v)
  then show ?case by auto
next
  case (AEDef d as)
  then show ?case by (simp add: UN_subset_iff map_idI)
next
  case (AESelf d_self t_self)
  then show ?case by auto
qed

lemma mu_subst_no_free_als: "
  free_als_mu_als a \<subseteq> unmod_mu_vars m \<Longrightarrow> als_mu_subst m a = a
"
  using mu_subst_no_free_rec by auto

lemma mu_subst_no_free_at: "
  free_als_mu_at t \<subseteq> unmod_mu_vars m \<Longrightarrow> at_mu_subst m t = t
"
  using mu_subst_no_free_rec by auto

lemma mu_subst_no_free_ae: "
  free_als_mu_ae e \<subseteq> unmod_mu_vars m \<Longrightarrow> ae_mu_subst m e = e
"
  using mu_subst_no_free_rec by auto

lemma als_lsv_mu_subst_comm_rec:
  assumes no_free: "\<And>v. free_als_mu_als (m1 v) = {}"
  shows "
    (\<forall> m2.
      als_lsv_subst m1 (als_mu_subst m2 a) = als_mu_subst ((als_lsv_subst m1) \<circ> m2) (als_lsv_subst m1 a)) \<and>
    (\<forall> m2.
      at_lsv_subst m1 (at_mu_subst m2 t) = at_mu_subst ((als_lsv_subst m1) \<circ> m2) (at_lsv_subst m1 t)) \<and>
    (\<forall> m2.
      ae_lsv_subst m1 (ae_mu_subst m2 e) = ae_mu_subst ((als_lsv_subst m1) \<circ> m2) (ae_lsv_subst m1 e))
  "
(is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
proof(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  case (ALSVar x)
  then show ?case
    using mu_subst_no_free_als no_free by auto
next
  case (ALSSet x)
  then show ?case
    apply(simp add: split_def)
    by (meson fsts.intros snds.intros)
next
  case (ALSMuVar x)
  then show ?case by auto
next
  case (ALSMu u a)
  show ?case
  proof(intro allI)
    fix m2
    have "
      als_lsv_subst m1 (als_mu_subst m2 a) =
      als_mu_subst ((als_lsv_subst m1) \<circ> m2) (als_lsv_subst m1 a)
    "
      using ALSMu.hyps by(simp only:)
    then show "
      als_lsv_subst m1 (als_mu_subst m2 (ALSMu u a)) =
      als_mu_subst (als_lsv_subst m1 \<circ> m2) (als_lsv_subst m1 (ALSMu u a))
    "
      apply(auto)
      by (metis ALSMu als_lsv_subst.simps(3) fun_upd_comp)
  qed
next
  case (ATFun x1 x2 x3)
  then show ?case by auto
next
  case (ATProd x)
  then show ?case by auto
next
  case (ATSum x)
  then show ?case by auto
next
  case (ATMu x1 x2)
  then show ?case by auto
next
  case (ATVar x)
  then show ?case by auto
next
  case (AETup x)
  then show ?case by auto
next
  case (AEProj x1 x2)
  then show ?case by auto
next
  case (AEInj x1 x2 x3)
  then show ?case by auto
next
  case (AEFold x1 x2 x3)
  then show ?case by auto
next
  case (AEUnfold x)
  then show ?case by auto
next
  case (AELet x1 x2 x3)
  then show ?case by auto
next
  case (AEMatch x1 x2 x3)
  then show ?case by auto
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (AEApp x1 x2 x3)
  then show ?case by auto
next
  case (AEVar x)
  then show ?case by auto
next
  case (AEDef x1 x2)
  then show ?case by auto
next
case (AESelf x1 x2)
  then show ?case by auto
qed

lemma als_lsv_mu_subst_comm_als:
  assumes no_free: "\<And>v. free_als_mu_als (m1 v) = {}"
  shows "
      als_lsv_subst m1 (als_mu_subst m2 a) =
      als_mu_subst ((als_lsv_subst m1) \<circ> m2) (als_lsv_subst m1 a)
  "
  using als_lsv_mu_subst_comm_rec no_free by auto

lemma lsv_subst_cj_alsc:
  assumes no_free: "\<And>v. free_als_mu_als (m v) = {}"
  shows "cj_alsc cc c \<Longrightarrow>
  cj_alsc (alsc_lsv_subst_all m cc) (alsc_lsv_subst m c)
"
proof(induct rule: cj_alsc.induct)
  case case_assumption: (cj_alsc_assumption c cc)
  show ?case
    using cj_alsc_assumption case_assumption by auto
next
  case case_set: (cj_alsc_set l a cc)
  show ?case
    using case_set cj_alsc_set apply auto
    apply(case_tac l)
    apply(simp add: split_def)
    by (metis (no_types, lifting) fst_conv in_set_conv_nth length_map nth_map snd_conv)
next
  case case_cj_alsc_mu: (cj_alsc_mu cc l u a)
  have "(als_lsv_subst m \<circ> ALSMuVar(u := ALSMu u a)) = ALSMuVar(u := ALSMu u (als_lsv_subst m a))"
    by(simp add: comp_def, auto)
  then have subst_eq: "
    (als_lsv_subst m (als_mu_subst (ALSMuVar(u := ALSMu u a)) a)) =
    als_mu_subst (ALSMuVar(u := ALSMu u (als_lsv_subst m a))) (als_lsv_subst m a)"
    using als_lsv_mu_subst_comm_als[where ?m1.0 = m and ?m2.0 = "ALSMuVar(u := ALSMu u a)" and ?a = a] no_free by auto
  show ?case
    apply(case_tac l)
    apply(simp only: alsc_lsv_subst.simps als_lsv_subst.simps)
    apply(rule cj_alsc_mu)
    using subst_eq case_cj_alsc_mu.hyps by auto
qed

lemma lsv_subst_cj_alsc_all:
  assumes no_free: "\<And>v. free_als_mu_als (m v) = {}"
  shows "cj_alsc_all cc cs \<Longrightarrow> cj_alsc_all (alsc_lsv_subst_all m cc) (alsc_lsv_subst_all m cs)"
  apply(induct cs)
   apply(simp)
  using lsv_subst_cj_alsc no_free by auto

lemma lsv_subst_cj_ae:
  assumes dc_dwf: "dwf_atcd dc"
  assumes no_free: "\<And>v. free_als_mu_als (m v) = {}"
  shows "
    cj_ae dc cc e \<Longrightarrow>
    cj_ae dc (alsc_lsv_subst_all m cc) (ae_lsv_subst m e)
  "
proof(induct e rule: ae_induct_simple)
  (* AETup *)
  case (1 x)
  then show ?case by auto
next
  (* AEProj *)
  case (2 x1 x2)
  then show ?case by auto
next
  (* AEInj *)
  case (3 x1 x2 x3)
  then show ?case by auto
next
  (* AEFold *)
  case (4 x1 x2 x3)
  then show ?case by auto
next
  (* AEUnfold *)
  case (5 x)
  then show ?case by auto
next
  (* AELet *)
  case (6 x1 x2 x3)
  then show ?case by auto
next
  (* AEMatch *)
  case (7 x1 x2 x3)
  then show ?case by auto
next
  (* AELam *)
  case (8 a x t1 e1 y t2 e2 t3)
  then show ?case
    apply simp
    using lsv_subst_cj_alsc no_free
    by force
next
  (* AEApp *)
  case (9 x1 x2 x3)
  then show ?case by auto
next
  (* AEVar *)
  case (10 x)
  then show ?case by auto
next
  (* AEDef *)
  case AEDef: (11 d as)
  obtain vs t cs where dc_entry: "dc d = Some (vs, t, cs)"
    using AEDef.prems by(case_tac "dc d", auto)
  have cj_subst_outer: "cj_alsc_all (alsc_lsv_subst_all m cc) (alsc_lsv_subst_all m (alsc_lsv_subst_all (lsv_inst vs as) cs))"
    apply(rule lsv_subst_cj_alsc_all)
    using no_free AEDef.prems dc_entry by auto
  have "lsv_subst_free_alsc_all vs as m cs"
    using lsv_subst_free_alsc_all AEDef.prems dc_entry by simp
  moreover have "free_acc cs \<subseteq> set vs"
    using dc_entry dc_dwf apply simp
    by (metis (mono_tags, lifting) case_prodD free_acc.simps option.simps(5))
  ultimately have outer_inner_eq: "
    (alsc_lsv_subst_all m (alsc_lsv_subst_all (lsv_inst vs as) cs)) =
    (alsc_lsv_subst_all (lsv_inst vs (map (als_lsv_subst m) as)) cs)
  "
    by auto
  then have "cj_alsc_all (alsc_lsv_subst_all m cc)
         (alsc_lsv_subst_all (lsv_inst vs (map (als_lsv_subst m) as)) cs)"
    using cj_subst_outer by auto
  then show ?case
    using dc_entry AEDef.prems by auto
next
  (* AESelf *)
  case (12 x1 x2)
  then show ?case by auto
qed

function
  max_als_mu_al :: "AL \<Rightarrow> MuVar" and
  max_als_mu_als :: "ALS \<Rightarrow> MuVar" and
  max_als_mu_at :: "AT \<Rightarrow> MuVar" and
  max_als_mu_ae :: "AE \<Rightarrow> MuVar"
  where
"max_als_mu_al (_, t1, _, t2, e, t3) = (
  Max {max_als_mu_at t1, max_als_mu_at t2, max_als_mu_ae e, max_als_mu_at t3}
)" |
"max_als_mu_als (ALSVar _) = 0" |
"max_als_mu_als (ALSSet s) = Max (max_als_mu_al ` set s)" |
"max_als_mu_als (ALSMu u a) = max u (max_als_mu_als a)" |
"max_als_mu_als (ALSMuVar u) = u" |
"max_als_mu_at (ATProd ts) = Max (max_als_mu_at ` set ts)" |
"max_als_mu_at (ATSum ts) = Max (max_als_mu_at ` set ts)" |
"max_als_mu_at (ATFun a t1 t2) = Max {max_als_mu_als a, max_als_mu_at t1, max_als_mu_at t2}" |
"max_als_mu_at (ATMu _ t) = max_als_mu_at t" |
"max_als_mu_at (ATVar _) = 0" |
"max_als_mu_ae (AETup es) = Max (max_als_mu_ae ` set es)" |
"max_als_mu_ae (AEProj _ e) = max_als_mu_ae e" |
"max_als_mu_ae (AEInj ts _ e) = max (Max (max_als_mu_at ` set ts)) (max_als_mu_ae e)" |
"max_als_mu_ae (AEFold _ t e) = max (max_als_mu_at t) (max_als_mu_ae e)" |
"max_als_mu_ae (AEUnfold e) = max_als_mu_ae e" |
"max_als_mu_ae (AELet _ e1 e2) = max (max_als_mu_ae e1) (max_als_mu_ae e2)" |
"max_als_mu_ae (AEMatch ret e_dis cases) = (
  Max {max_als_mu_at ret, max_als_mu_ae e_dis, Max ((\<lambda>(_, e_case). max_als_mu_ae e_case) ` set cases)}
)" |
"max_als_mu_ae (AELam a x t1 e1 y t2 e2 t3) = (
  Max {
    max_als_mu_als a,
    max_als_mu_at t1,
    max_als_mu_ae e1,
    max_als_mu_at t2,
    max_als_mu_ae e2,
    max_als_mu_at t3
  }
)" |
"max_als_mu_ae (AEApp a e1 e2) = Max {max_als_mu_als a, max_als_mu_ae e1, max_als_mu_ae e2}" |
"max_als_mu_ae (AEVar _) = 0" |
"max_als_mu_ae (AEDef _ as) = Max (max_als_mu_als ` set as)" |
"max_als_mu_ae (AESelf _ t) = max_als_mu_at t"
  by(pat_completeness) auto
termination by(size_change)

lemma lsv_mu_subst_equiv_max_rec: "
  (u > max_als_mu_als a \<longrightarrow>
    als_mu_subst (ALSMuVar(u := a')) (als_lsv_subst (ALSVar(v := ALSMuVar u)) a) =
    als_lsv_subst (ALSVar(v := a')) a
  ) \<and>
  (u > max_als_mu_at t \<longrightarrow>
    at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
    at_lsv_subst (ALSVar(v := a')) t
  ) \<and>
  (u > max_als_mu_ae e \<longrightarrow>
    ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
    ae_lsv_subst (ALSVar(v := a')) e
  )
"
(is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
proof(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  case (ALSVar x)
  then show ?case by auto
next
  case (ALSSet s)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_als (ALSSet s)"
    have "
      \<And> x t1 y t2 e t3.
        (x, t1, y, t2, e, t3) \<in> set s \<Longrightarrow>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t1) =
          at_lsv_subst (ALSVar(v := a')) t1 \<and>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t2) =
          at_lsv_subst (ALSVar(v := a')) t2 \<and>
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
          ae_lsv_subst (ALSVar(v := a')) e \<and>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t3) =
          at_lsv_subst (ALSVar(v := a')) t3
    "
    proof -
      fix x t1 y t2 e t3
      assume in_set: "(x, t1, y, t2, e, t3) \<in> set s"
      have elem_leq_tup: "
        max_als_mu_at t1 \<le> max_als_mu_al (x, t1, y, t2, e, t3) \<and>
        max_als_mu_at t2 \<le> max_als_mu_al (x, t1, y, t2, e, t3) \<and>
        max_als_mu_ae e \<le> max_als_mu_al (x, t1, y, t2, e, t3) \<and>
        max_als_mu_at t3 \<le> max_als_mu_al (x, t1, y, t2, e, t3)
      "
        by auto
      have elem_le_set: "
        max_als_mu_at t1 \<le> max_als_mu_als (ALSSet s) \<and>
        max_als_mu_at t2 \<le> max_als_mu_als (ALSSet s) \<and>
        max_als_mu_ae e \<le> max_als_mu_als (ALSSet s) \<and>
        max_als_mu_at t3 \<le> max_als_mu_als (ALSSet s)
      "
        using in_set
        apply(auto)
        by (metis List.finite_set Max_ge_iff elem_leq_tup empty_iff finite_imageI image_eqI)+
      have elem_lt_u: "
        max_als_mu_at t1 < u \<and>
        max_als_mu_at t2 < u \<and>
        max_als_mu_ae e < u \<and>
        max_als_mu_at t3 < u
      "
        using elem_le_set u_greater
        by auto

      have "
        u > max_als_mu_at t1 \<longrightarrow>
          at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t1) =
            at_lsv_subst (ALSVar(v := a')) t1
      "
        apply(rule ALSSet.hyps(1))
        using in_set by auto
      moreover
      have "
        u > max_als_mu_at t2 \<longrightarrow>
          at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t2) =
            at_lsv_subst (ALSVar(v := a')) t2
      "
        apply(rule ALSSet.hyps(2))
        using in_set by auto
      moreover
      have "
        u > max_als_mu_ae e \<longrightarrow>
          ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
            ae_lsv_subst (ALSVar(v := a')) e
      "
        apply(rule ALSSet.hyps(3))
        using in_set by auto
      moreover
      have "
        u > max_als_mu_at t3 \<longrightarrow>
          at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t3) =
            at_lsv_subst (ALSVar(v := a')) t3
      "
        apply(rule ALSSet.hyps(4))
        using in_set by auto
      ultimately
      show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t1) =
          at_lsv_subst (ALSVar(v := a')) t1 \<and>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t2) =
          at_lsv_subst (ALSVar(v := a')) t2 \<and>
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
          ae_lsv_subst (ALSVar(v := a')) e \<and>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t3) =
          at_lsv_subst (ALSVar(v := a')) t3
      "
        using elem_lt_u by auto
    qed
    then show "
      als_mu_subst (ALSMuVar(u := a')) (als_lsv_subst (ALSVar(v := ALSMuVar u)) (ALSSet s)) =
        als_lsv_subst (ALSVar(v := a')) (ALSSet s)
    "
      by auto
  qed
next
  case (ALSMuVar x)
  then show ?case by auto
next
  case (ALSMu x1 x2)
  then show ?case 
    apply(auto)
    by (smt (z3) fun_upd_triv nat_neq_iff)
next
  case (ATFun x1 x2 x3)
  then show ?case by auto
next
  case (ATProd ts)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_at (ATProd ts)"
    have "
      \<And> t. t \<in> set ts \<Longrightarrow>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
    "
    proof -
      fix t
      assume in_set: "t \<in> set ts"
      have "max_als_mu_at (ATProd ts) \<ge> max_als_mu_at t"
        using in_set by auto
      then have "u > max_als_mu_at t"
        using u_greater by auto
      then show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
      "
        using in_set ATProd apply(auto)
        using ATProd by blast
    qed
    then show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) (ATProd ts)) =
          at_lsv_subst (ALSVar(v := a')) (ATProd ts)
    "
      by auto
  qed
next
  case (ATSum ts)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_at (ATSum ts)"
    have "
      \<And> t. t \<in> set ts \<Longrightarrow>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
    "
    proof -
      fix t
      assume in_set: "t \<in> set ts"
      have "max_als_mu_at (ATProd ts) \<ge> max_als_mu_at t"
        using in_set by auto
      then have "u > max_als_mu_at t"
        using u_greater by auto
      then show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
      "
        using in_set ATSum apply(auto)
        using ATSum by blast
    qed
    then show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) (ATSum ts)) =
          at_lsv_subst (ALSVar(v := a')) (ATSum ts)
    "
      by auto
  qed
next
  case (ATMu x1 x2)
  then show ?case by auto
next
  case (ATVar x)
  then show ?case by auto
next
  case (AETup es)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_ae (AETup es)"
    have "
      \<And> e. e \<in> set es \<Longrightarrow>
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
          ae_lsv_subst (ALSVar(v := a')) e
    "
    proof -
      fix e
      assume in_set: "e \<in> set es"
      have "max_als_mu_ae (AETup es) \<ge> max_als_mu_ae e"
        using in_set by auto
      then have "u > max_als_mu_ae e"
        using u_greater by auto
      then show "
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
          ae_lsv_subst (ALSVar(v := a')) e
      "
        using in_set AETup apply(auto)
        using AETup by blast
    qed
    then show "
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) (AETup es)) =
          ae_lsv_subst (ALSVar(v := a')) (AETup es)
    "
      by auto
  qed
next
  case (AEProj x1 x2)
  then show ?case by auto
next
  case (AEInj ts i e)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_ae (AEInj ts i e)"
    have result_ts: "
      \<And> t. t \<in> set ts \<Longrightarrow>
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
    "
    proof -
      fix t
      assume in_set: "t \<in> set ts"
      have "max_als_mu_at (ATProd ts) \<ge> max_als_mu_at t"
        using in_set by auto
      then have "u > max_als_mu_at t"
        using u_greater by auto
      then show "
        at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t) =
          at_lsv_subst (ALSVar(v := a')) t
      "
        using in_set AEInj.hyps(1) apply(auto)
        using AEInj.hyps(1) by blast
    qed
    have "max_als_mu_ae (AEInj ts i e) \<ge> max_als_mu_ae e"
      by auto
    then have "u > max_als_mu_ae e"
      using u_greater by auto
    then have result_e: "
      ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e) =
        ae_lsv_subst (ALSVar(v := a')) e
    "
      using AEInj.hyps(2) by blast
    show "
      ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) (AEInj ts i e)) =
        ae_lsv_subst (ALSVar(v := a')) (AEInj ts i e)
    "
      using result_ts result_e by auto
  qed
next
  case (AEFold x1 x2 x3)
  then show ?case by auto
next
  case (AEUnfold x)
  then show ?case by auto
next
  case (AELet x1 x2 x3)
  then show ?case by auto
next
  case (AEMatch t_dis e_dis cases)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_ae (AEMatch t_dis e_dis cases)"
    have result_cases: "
      \<And> x_case e_case. (x_case, e_case) \<in> set cases \<Longrightarrow>
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e_case) =
          ae_lsv_subst (ALSVar(v := a')) e_case
    "
    proof -
      fix x_case e_case
      assume in_set: "(x_case, e_case) \<in> set cases"
      have "Max ((\<lambda>(_, e_case'). max_als_mu_ae e_case') ` set cases) \<ge> max_als_mu_ae e_case"
        using in_set Max_ge
        by (simp add: rev_image_eqI)
      then have "max_als_mu_ae (AEMatch t_dis e_dis cases) \<ge> max_als_mu_ae e_case"
        by auto
      then have case_lt_u: "u > max_als_mu_ae e_case"
        using u_greater by auto
      have "
        u > max_als_mu_ae e_case \<longrightarrow>
          ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e_case) =
            ae_lsv_subst (ALSVar(v := a')) e_case
      "
        apply(rule AEMatch.hyps(3))
        using in_set by auto
     then show "
       ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e_case) =
         ae_lsv_subst (ALSVar(v := a')) e_case
      "
       using case_lt_u by auto
    qed
    have "max_als_mu_ae (AEMatch t_dis e_dis cases) \<ge> max_als_mu_at t_dis"
      by auto
    then have "u > max_als_mu_at t_dis"
      using u_greater by auto
    then have result_t_dis: "
      at_mu_subst (ALSMuVar(u := a')) (at_lsv_subst (ALSVar(v := ALSMuVar u)) t_dis) =
        at_lsv_subst (ALSVar(v := a')) t_dis
    "
      using AEMatch.hyps(1) by (simp only:)
    have "max_als_mu_ae (AEMatch t_dis e_dis cases) \<ge> max_als_mu_ae e_dis"
      by auto
    then have "u > max_als_mu_ae e_dis"
      using u_greater by auto
    then have result_e_dis: "
     ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) e_dis) =
       ae_lsv_subst (ALSVar(v := a')) e_dis
    "
      using AEMatch.hyps(2) by (simp only:)
    show "
      ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) (AEMatch t_dis e_dis cases)) =
        ae_lsv_subst (ALSVar(v := a')) (AEMatch t_dis e_dis cases)
    "
      using result_cases result_t_dis result_e_dis by auto
  qed
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (AEApp x1 x2 x3)
  then show ?case by auto
next
  case (AEVar x)
  then show ?case by auto
next
  case (AEDef d as)
  show ?case
  proof(intro impI)
    assume u_greater: "u > max_als_mu_ae (AEDef d as)"
    have "
      \<And> a. a \<in> set as \<Longrightarrow>
        als_mu_subst (ALSMuVar(u := a')) (als_lsv_subst (ALSVar(v := ALSMuVar u)) a) =
          als_lsv_subst (ALSVar(v := a')) a
    "
    proof -
      fix a
      assume in_set: "a \<in> set as"
      have "max_als_mu_ae (AEDef d as) \<ge> max_als_mu_als a"
        using in_set by auto
      then have "u > max_als_mu_als a"
        using u_greater by auto
      then show "
        als_mu_subst (ALSMuVar(u := a')) (als_lsv_subst (ALSVar(v := ALSMuVar u)) a) =
          als_lsv_subst (ALSVar(v := a')) a
      "
        using in_set AEDef apply(auto)
        using AEDef by blast
    qed
    then show "
        ae_mu_subst (ALSMuVar(u := a')) (ae_lsv_subst (ALSVar(v := ALSMuVar u)) (AEDef d as)) =
          ae_lsv_subst (ALSVar(v := a')) (AEDef d as)
    "
      by auto
  qed
next
  case (AESelf x1 x2)
  then show ?case by auto
qed

lemma lsv_mu_subst_equiv_max_al: "
  u > max_als_mu_al l \<Longrightarrow>
    al_mu_subst (ALSMuVar(u := a')) (al_lsv_subst (ALSVar(v := ALSMuVar u)) l) =
    al_lsv_subst (ALSVar(v := a')) l
"
  apply(case_tac l)
  using lsv_mu_subst_equiv_max_rec by auto

lemma lsv_mu_subst_equiv_max_als: "
  u > max_als_mu_als a \<Longrightarrow>
    als_mu_subst (ALSMuVar(u := a')) (als_lsv_subst (ALSVar(v := ALSMuVar u)) a) =
    als_lsv_subst (ALSVar(v := a')) a
"
  using lsv_mu_subst_equiv_max_rec by auto

fun max_als_mu_alsc :: "ALSC \<Rightarrow> MuVar" where
"max_als_mu_alsc (l, a) = max (max_als_mu_al l) (max_als_mu_als a)"

lemma lsv_mu_subst_equiv_max_alsc: "
  u > max_als_mu_alsc c \<Longrightarrow>
    alsc_mu_subst (ALSMuVar(u := a')) (alsc_lsv_subst (ALSVar(v := ALSMuVar u)) c) =
    alsc_lsv_subst (ALSVar(v := a')) c
"
  apply(case_tac c)
  using lsv_mu_subst_equiv_max_rec by auto

fun max_als_mu_alsc_all :: "ACC \<Rightarrow> MuVar" where
"max_als_mu_alsc_all cs = Max (max_als_mu_alsc ` set cs)"

lemma lsv_mu_subst_equiv_max_alsc_all: "
  u > max_als_mu_alsc_all cs \<Longrightarrow>
    alsc_mu_subst_all (ALSMuVar(u := a')) (alsc_lsv_subst_all (ALSVar(v := ALSMuVar u)) cs) =
    alsc_lsv_subst_all (ALSVar(v := a')) cs
"
  apply(induct cs)
  using lsv_mu_subst_equiv_max_alsc by auto

fun incident_constrs :: "ACC \<Rightarrow> LSVar \<Rightarrow> ACC" where
"incident_constrs cs v = filter (\<lambda> (_, a). a = ALSVar v) cs"

fun other_constrs :: "ACC \<Rightarrow> LSVar \<Rightarrow> ACC" where
"other_constrs cs v = filter (\<lambda> (_, a). a \<noteq> ALSVar v) cs"

fun ti_solution_for :: "ACC \<Rightarrow> LSVar \<Rightarrow> ALS" where
"ti_solution_for cc v = (
  let incident = incident_constrs cc v in
  let ls = map fst incident in
  if v \<in> \<Union> (free_al ` set ls) then
    let u = max_als_mu_alsc_all incident + 1 in
    ALSMu u (ALSSet (map (al_lsv_subst (ALSVar(v := ALSMuVar u))) ls))
  else
    ALSSet ls
)"

lemma lsv_subst_absent_rec: "
  (v \<notin> free_als a \<longrightarrow> als_lsv_subst (ALSVar(v := a')) a = a) \<and>
  (v \<notin> free_at t \<longrightarrow> at_lsv_subst (ALSVar(v := a')) t = t) \<and>
  (v \<notin> free_ae e \<longrightarrow> ae_lsv_subst (ALSVar(v := a')) e = e)
"
(is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
proof(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  case (ALSVar x)
  then show ?case by auto
next
  case (ALSSet s)
  show ?case
  proof(intro impI)
    assume not_in: "v \<notin> free_als (ALSSet s)"
    have "
      \<And> x t1 y t2 e t3.
        (x, t1, y, t2, e, t3) \<in> set s \<Longrightarrow>
        at_lsv_subst (ALSVar(v := a')) t1 = t1 \<and>
        at_lsv_subst (ALSVar(v := a')) t2 = t2 \<and>
        ae_lsv_subst (ALSVar(v := a')) e = e \<and>
        at_lsv_subst (ALSVar(v := a')) t3 = t3
    "
    proof(intro conjI)
      fix x t1 y t2 e t3
      assume in_set: "(x, t1, y, t2, e, t3) \<in> set s"
      have "v \<notin> free_at t1"
        using not_in in_set by auto
      moreover have "v \<notin> free_at t1 \<longrightarrow> at_lsv_subst (ALSVar(v := a')) t1 = t1"
        apply(rule ALSSet.hyps(1))
        using in_set by auto
      ultimately show "at_lsv_subst (ALSVar(v := a')) t1 = t1"
        by auto
      have "v \<notin> free_at t2"
        using not_in in_set by auto
      moreover have "v \<notin> free_at t2 \<longrightarrow> at_lsv_subst (ALSVar(v := a')) t2 = t2"
        apply(rule ALSSet.hyps(2))
        using in_set by auto
      ultimately show "at_lsv_subst (ALSVar(v := a')) t2 = t2"
        by auto
      have "v \<notin> free_ae e"
        using not_in in_set by auto
      moreover have "v \<notin> free_ae e \<longrightarrow> ae_lsv_subst (ALSVar(v := a')) e = e"
        apply(rule ALSSet.hyps(3))
        using in_set by auto
      ultimately show "ae_lsv_subst (ALSVar(v := a')) e = e"
        by auto
      have "v \<notin> free_at t3"
        using not_in in_set by auto
      moreover have "v \<notin> free_at t3 \<longrightarrow> at_lsv_subst (ALSVar(v := a')) t3 = t3"
        apply(rule ALSSet.hyps(4))
        using in_set by auto
      ultimately show "at_lsv_subst (ALSVar(v := a')) t3 = t3"
        by auto
    qed
    then show "als_lsv_subst (ALSVar(v := a')) (ALSSet s) = (ALSSet s)"
      apply(simp)
      apply(rule map_idI)
      by fastforce
  qed
next
  case (ALSMuVar x)
  then show ?case by auto
next
  case (ALSMu x1 x2)
  then show ?case by auto
next
  case (ATFun x1 x2 x3)
  then show ?case by auto
next
  case (ATProd x)
  then show ?case
    apply(auto)
    using map_idI by auto
next
  case (ATSum x)
  then show ?case
    apply(auto)
    using map_idI by auto
next
  case (ATMu x1 x2)
  then show ?case by auto
next
  case (ATVar x)
  then show ?case by auto
next
  case (AETup x)
  then show ?case
    apply(auto)
    using map_idI by auto
next
  case (AEProj x1 x2)
  then show ?case by auto
next
  case (AEInj x1 x2 x3)
  then show ?case
    apply(auto)
    using map_idI by auto
next
  case (AEFold x1 x2 x3)
  then show ?case by auto
next
  case (AEUnfold x)
  then show ?case by auto
next
  case (AELet x1 x2 x3)
  then show ?case by auto
next
  case (AEMatch t_dis e_dis cases)
  show ?case
  proof(intro impI)
    assume not_in: "v \<notin> free_ae (AEMatch t_dis e_dis cases)"
    have "v \<notin> free_at t_dis"
      using not_in by auto
    then have result_t_dis: "at_lsv_subst (ALSVar(v := a')) t_dis = t_dis"
      using AEMatch.hyps(1)
      by blast
    have "v \<notin> free_ae e_dis"
      using not_in by auto
    then have result_e_dis: "ae_lsv_subst (ALSVar(v := a')) e_dis = e_dis"
      using AEMatch.hyps(2)
      by blast
    have result_cases: "
      \<And> x_case e_case.
        (x_case, e_case) \<in> set cases \<Longrightarrow>
        ae_lsv_subst (ALSVar(v := a')) e_case = e_case
    "
    proof -
      fix x_case e_case
      assume in_set: "(x_case, e_case) \<in> set cases"
      have not_in_case: "v \<notin> free_ae e_case"
        using not_in in_set by auto
      have "v \<notin> free_ae e_case \<longrightarrow> ae_lsv_subst (ALSVar(v := a')) e_case = e_case"
        apply(rule AEMatch.hyps(3))
        using in_set by auto
      then show "ae_lsv_subst (ALSVar(v := a')) e_case = e_case"
        using not_in_case by auto
    qed
    show "ae_lsv_subst (ALSVar(v := a')) (AEMatch t_dis e_dis cases) = AEMatch t_dis e_dis cases"
      using result_t_dis result_e_dis result_cases
      apply(auto)
      by (metis (no_types, lifting) case_prod_Pair_iden map_idI split_cong)
  qed
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (AEApp x1 x2 x3)
  then show ?case by auto
next
  case (AEVar x)
  then show ?case by auto
next
  case (AEDef x1 x2)
  then show ?case
    apply(auto)
    using map_idI by auto
next
  case (AESelf x1 x2)
  then show ?case by auto
qed

lemma lsv_subst_absent_at: "
  v \<notin> free_at t \<Longrightarrow> at_lsv_subst (ALSVar(v := a')) t = t
"
  using lsv_subst_absent_rec by auto

lemma lsv_subst_absent_al: "
  v \<notin> free_al l \<Longrightarrow> al_lsv_subst (ALSVar(v := a')) l = l
"
  apply(case_tac l)
  using lsv_subst_absent_rec by auto

lemma max_al_in_leq: "c \<in> set cs \<Longrightarrow> max_als_mu_al (fst c) \<le> max_als_mu_alsc_all cs"
proof -
  assume c_in: "c \<in> set cs"
  have "max_als_mu_al (fst c) \<le> max_als_mu_alsc c"
    apply(case_tac c)
    by auto
  moreover have "max_als_mu_alsc c \<le> max_als_mu_alsc_all cs"
    using c_in by auto
  finally show ?thesis
    by auto
qed

lemma ti_solution_for_incident_cj: "
  cj_alsc_all [] (alsc_lsv_subst_all (ALSVar(v := ti_solution_for cc v)) (incident_constrs cc v))
"
(is "cj_alsc_all [] ?new_cs")
proof -
  have "\<And>c. c \<in> set ?new_cs \<Longrightarrow> cj_alsc [] c"
  proof -
    fix c
    assume c_in: "c \<in> set ?new_cs"
    let ?incident = "incident_constrs cc v"
    let ?ls = "map fst ?incident"
    let ?sol = "ti_solution_for cc v"
    let ?subst = "ALSVar(v := ?sol)"
    obtain l where c_decomp: "c = (l, ?sol)"
      using c_in by auto
    obtain c_orig where
      c_orig_in: "c_orig \<in> set ?incident" and
      c_orig_new: "c = alsc_lsv_subst ?subst c_orig"
      using c_in by auto
    obtain l_orig where
      c_orig_decomp: "c_orig = (l_orig, ALSVar v)" and
      l_orig_new: "l = al_lsv_subst ?subst l_orig"
      using c_orig_in c_orig_new c_decomp by auto
    show "cj_alsc [] c"
    proof(cases "v \<in> \<Union> (free_al ` set ?ls)")
      case cyclic: True
      let ?u = "max_als_mu_alsc_all ?incident + 1"
      let ?set_als = "ALSSet (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls)"
      let ?mu_als = "ALSMu ?u ?set_als"
      have sol_mu: "?sol = ?mu_als"
        using cyclic by(simp add: Let_def)
      have max_leq: "max_als_mu_al l_orig \<le> max_als_mu_alsc_all ?incident"
        using c_orig_decomp c_orig_in max_al_in_leq
        by (metis fst_conv) 
      have l_orig_mu_lsv_equiv: "
        al_mu_subst (ALSMuVar(?u := ?mu_als)) (al_lsv_subst (ALSVar(v := ALSMuVar ?u)) l_orig) =
        al_lsv_subst ?subst l_orig"
        apply(simp only: sol_mu)
        apply(rule lsv_mu_subst_equiv_max_al)
        using max_leq by auto
      have "(al_lsv_subst (ALSVar(v := ALSMuVar ?u)) l_orig) \<in> set (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls)"
        using c_orig_in c_orig_decomp
        by (metis fst_conv image_eqI image_set) 
      then have "
        al_mu_subst (ALSMuVar(?u := ?mu_als)) (al_lsv_subst (ALSVar(v := ALSMuVar ?u)) l_orig) \<in>
        set (map (al_mu_subst (ALSMuVar(?u := ?mu_als))) (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls))"
        by (metis (no_types, lifting) image_eqI set_map)
      then have l_in_set: "
        l \<in>
        set (map (al_mu_subst (ALSMuVar(?u := ?mu_als))) (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls))"
        using l_orig_new l_orig_mu_lsv_equiv by auto
      have mu_subst_set_expand: "
        als_mu_subst (ALSMuVar(?u := ?mu_als)) ?set_als =
        ALSSet (map (al_mu_subst (ALSMuVar(?u := ?mu_als))) (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls))"
        by auto
      have set_cj: "cj_alsc [] (l, als_mu_subst (ALSMuVar(?u := ?mu_als)) ?set_als)"
        apply(simp only: mu_subst_set_expand)
        apply(rule cj_alsc_set)
        using l_in_set .
      have "cj_alsc [] (l, ?mu_als)"
        apply(rule cj_alsc_mu)
        using set_cj by auto
      then show ?thesis
        using sol_mu c_decomp by auto
    next
      case simple: False
      have sol_set: "?sol = ALSSet ?ls"
        using simple by(simp add: Let_def)
      have v_not_free: "v \<notin> free_al l_orig"
        using simple c_orig_in l_orig_new apply auto
        using c_orig_decomp by force
      have "l = l_orig"
        apply(simp only: l_orig_new)
        apply(rule lsv_subst_absent_al)
        using v_not_free .
      then have l_in: "l \<in> set ?ls"
        using c_orig_in c_orig_decomp
        by (metis fst_conv image_eqI image_set)
      then have "cj_alsc [] (l, ALSSet (map fst ?incident))"
        by(rule cj_alsc_set) 
      then show ?thesis
        using sol_set c_decomp by auto
    qed
  qed
  then show ?thesis
    by auto
qed

lemma acc_compose_alsc: "
  cj_alsc_all cc1 cc2 \<Longrightarrow>
  cj_alsc cc2 c \<Longrightarrow>
  cj_alsc cc1 c
"
proof -
  have "cj_alsc cc2 c \<Longrightarrow> (cj_alsc_all cc1 cc2 \<longrightarrow> cj_alsc cc1 c)"
  proof(induct rule: cj_alsc.induct)
    case case_assumption: (cj_alsc_assumption c cc)
    then show ?case by auto
  next
    case case_set: (cj_alsc_set s a q)
    show ?case
      apply(intro impI)
      apply(rule cj_alsc_set)
      using case_set by auto
  next
    case case_mu: (cj_alsc_mu q l u a)
    then show ?case
      apply(intro impI)
      apply(rule cj_alsc_mu)
      using case_mu by auto
  qed
  then show "cj_alsc_all cc1 cc2 \<Longrightarrow> cj_alsc cc2 c \<Longrightarrow> cj_alsc cc1 c"
    by auto
qed

lemma acc_compose_all: "
  cj_alsc_all cc1 cc2 \<Longrightarrow>
  cj_alsc_all cc2 cc3 \<Longrightarrow>
  cj_alsc_all cc1 cc3
"
  using acc_compose_alsc by auto

lemma acc_weaken: "
  set cc2 \<subseteq> set cc1 \<Longrightarrow>
  cj_alsc_all cc1 cc2
"
proof -
  assume subset: "set cc2 \<subseteq> set cc1"
  have "\<And>c. c \<in> set cc2 \<Longrightarrow> cj_alsc cc1 c"
    apply(rule cj_alsc_assumption)
    using subset by auto
  then show ?thesis
    by auto
qed

lemma ti_solution_for_other_cj: "
  cj_alsc_all
    (alsc_lsv_subst_all (ALSVar(v := ti_solution_for cc v)) (other_constrs cc v))
    (alsc_lsv_subst_all (ALSVar(v := ti_solution_for cc v)) cc)
"
proof -
  let ?apply_subst = "alsc_lsv_subst_all (ALSVar(v := ti_solution_for cc v))"
  have entail_self: "cj_alsc_all (?apply_subst (other_constrs cc v)) (?apply_subst (other_constrs cc v))"
    apply(rule acc_weaken)
    apply simp
    done
  have entail_incident: "cj_alsc_all (?apply_subst (other_constrs cc v)) (?apply_subst (incident_constrs cc v))"
    apply(rule acc_compose_all)
     apply(rule acc_weaken[where ?cc2.0 = "[]"])
     apply simp
    apply(rule ti_solution_for_incident_cj)
    done
  have entail_concat: "
    cj_alsc_all
      (?apply_subst (other_constrs cc v))
      (?apply_subst (other_constrs cc v) @ ?apply_subst (incident_constrs cc v))"
    using entail_self entail_incident by auto
  moreover have concat_eq: "set (?apply_subst (other_constrs cc v) @ ?apply_subst (incident_constrs cc v)) = set (?apply_subst cc)"
    by auto
  ultimately show ?thesis
    by auto
qed

lemma acc_compose_ae:
  assumes cc_entail: "cj_alsc_all cc1 cc2"
  shows "cj_ae dc cc2 e \<Longrightarrow> cj_ae dc cc1 e"
  apply(induct e rule: ae_induct_simple) apply auto
  using cc_entail acc_compose_alsc apply auto
  by (smt (z3) acc_compose_all case_prodD case_prodI2 cc_entail disjE_realizer2 le_boolE le_boolI')

lemma ff_no_mu_free_rec: "
  (ff_als a \<longrightarrow> free_als_mu_als a = {}) \<and>
  (ff_at t \<longrightarrow> free_als_mu_at t = {}) \<and>
  (ff_ae e \<longrightarrow> free_als_mu_ae e = {})
"
  apply(induct rule: ALS_AT_AE.induct)
  by auto

lemma ff_no_mu_free_at: "ff_at t \<Longrightarrow> free_als_mu_at t = {}"
  using ff_no_mu_free_rec by auto

lemma ff_no_mu_free_ae: "ff_ae e \<Longrightarrow> free_als_mu_ae e = {}"
  using ff_no_mu_free_rec by auto

fun atcd_no_mu_free :: "ATCD \<Rightarrow> bool" where
"atcd_no_mu_free dc = (\<forall> d.
  case dc d of
    Some (_, _, cs) \<Rightarrow> (free_als_mu_alsc_all cs = {}) |
    None \<Rightarrow> True
)"

lemma lsv_subst_mu_free_union_rec:
  assumes m_free_bound: "\<And>v. free_als_mu_als (m v) \<subseteq> f"
  shows "
    (free_als_mu_als (als_lsv_subst m a) \<subseteq> free_als_mu_als a \<union> f) \<and>
    (free_als_mu_at (at_lsv_subst m t) \<subseteq> free_als_mu_at t \<union> f) \<and>
    (free_als_mu_ae (ae_lsv_subst m e) \<subseteq> free_als_mu_ae e \<union> f)
  "
(is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
proof(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  case (ALSVar x)
  then show ?case using m_free_bound by auto
next
  case (ALSSet s)
  show ?case
  proof -
    have "
      \<And> x t1 y t2 e t3.
        (x, t1, y, t2, e, t3) \<in> set s \<Longrightarrow>
        (free_als_mu_at (at_lsv_subst m t1) \<subseteq> free_als_mu_at t1 \<union> f) \<and>
        (free_als_mu_at (at_lsv_subst m t2) \<subseteq> free_als_mu_at t2 \<union> f) \<and>
        (free_als_mu_ae (ae_lsv_subst m e) \<subseteq> free_als_mu_ae e \<union> f) \<and>
        (free_als_mu_at (at_lsv_subst m t3) \<subseteq> free_als_mu_at t3 \<union> f)
    "
      using ALSSet by auto
    then show "
      free_als_mu_als (als_lsv_subst m (ALSSet s)) \<subseteq> free_als_mu_als (ALSSet s) \<union> f
    "
      using subset_iff by fastforce
  qed
next
  case (ALSMuVar x)
  then show ?case by auto
next
  case (ALSMu x1 x2)
  then show ?case by auto
next
  case (ATFun x1 x2 x3)
  then show ?case by auto
next
  case (ATProd x)
  then show ?case by auto
next
  case (ATSum x)
  then show ?case by auto
next
  case (ATMu x1 x2)
  then show ?case by auto
next
  case (ATVar x)
  then show ?case by auto
next
  case (AETup x)
  then show ?case by auto
next
  case (AEProj x1 x2)
  then show ?case by auto
next
  case (AEInj x1 x2 x3)
  then show ?case by auto
next
  case (AEFold x1 x2 x3)
  then show ?case by auto
next
  case (AEUnfold x)
  then show ?case by auto
next
  case (AELet x1 x2 x3)
  then show ?case by auto
next
  case (AEMatch t_dis e_dis cases)
  then show ?case
    apply(simp add: split_def)
    apply(auto)
    by fastforce
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (AEApp x1 x2 x3)
  then show ?case by auto
next
  case (AEVar x)
  then show ?case by auto
next
  case (AEDef x1 x2)
  then show ?case by auto
next
  case (AESelf x1 x2)
  then show ?case by auto
qed

lemma lsv_subst_lsv_free_image_rec:
  shows "
    (free_als (als_lsv_subst m a) \<subseteq> (\<Union> v \<in> free_als a. free_als (m v))) \<and>
    (free_at (at_lsv_subst m t) \<subseteq> (\<Union> v \<in> free_at t. free_als (m v))) \<and>
    (free_ae (ae_lsv_subst m e) \<subseteq> (\<Union> v \<in> free_ae e. free_als (m v)))
  "
    (is "?result_als a \<and> ?result_at t \<and> ?result_ae e")
proof(induct rule: ALS_AT_AE.induct[where ?P1.0 = ?result_als and ?P2.0 = ?result_at and ?P3.0 = ?result_ae])
  case (ALSVar x)
  then show ?case by auto
next
  case (ALSSet s)
  show ?case
  proof -
    have "
      \<And> l. l \<in> set s \<Longrightarrow>
        free_al (al_lsv_subst m l) \<subseteq> (\<Union> v \<in> free_al l. free_als (m v))
    "
    proof -
      fix l
      assume in_set: "l \<in> set s"
      obtain x t1 y t2 e t3 where decomp: "(x, t1, y, t2, e, t3) = l"
        apply(case_tac l)
        by auto
      have "free_at (at_lsv_subst m t1) \<subseteq> (\<Union> v \<in> free_at t1. free_als(m v))"
        using in_set decomp ALSSet.hyps(1) by fastforce
      moreover
      have "free_at (at_lsv_subst m t2) \<subseteq> (\<Union> v \<in> free_at t2. free_als(m v))"
        using in_set decomp ALSSet.hyps(2) by fastforce
      moreover
      have "free_ae (ae_lsv_subst m e) \<subseteq> (\<Union> v \<in> free_ae e. free_als(m v))"
        using in_set decomp ALSSet.hyps(3) by fastforce
      moreover
      have "free_at (at_lsv_subst m t3) \<subseteq> (\<Union> v \<in> free_at t3. free_als(m v))"
        using in_set decomp ALSSet.hyps(4) by fastforce
      ultimately show "free_al (al_lsv_subst m l) \<subseteq> (\<Union> v \<in> free_al l. free_als (m v))"
        using decomp by fastforce
    qed
    moreover have "
      free_als (als_lsv_subst m (ALSSet s)) =
        (\<Union> l \<in> set s. free_al (al_lsv_subst m l))
    "
      by auto
    ultimately have "
      free_als (als_lsv_subst m (ALSSet s)) \<subseteq>
        (\<Union> l \<in> set s. (\<Union> v \<in> free_al l. free_als (m v)))
    "
      by (simp add: SUP_le_iff SUP_upper2)
    then show ?case
      by auto
  qed
next
  case (ALSMuVar x)
  then show ?case by auto
next
  case (ALSMu x1 x2)
  then show ?case by auto
next
  case (ATFun x1 x2 x3)
  then show ?case by auto
next
  case (ATProd x)
  then show ?case by auto
next
  case (ATSum x)
  then show ?case by auto
next
  case (ATMu x1 x2)
  then show ?case by auto
next
  case (ATVar x)
  then show ?case by auto
next
  case (AETup x)
  then show ?case by auto
next
  case (AEProj x1 x2)
  then show ?case by auto
next
  case (AEInj x1 x2 x3)
  then show ?case by auto
next
  case (AEFold x1 x2 x3)
  then show ?case by auto
next
  case (AEUnfold x)
  then show ?case by auto
next
  case (AELet x1 x2 x3)
  then show ?case by auto
next
  case (AEMatch t_dis e_dis cases)
  have result_cases: "
    list_union
        (map (\<lambda>(_, e_case). free_ae e_case)
          (map (\<lambda>(x_case, e_case). (x_case, ae_lsv_subst m e_case))
            cases))
    \<subseteq> (\<Union> v \<in> list_union (map (\<lambda>(_, e_case). free_ae e_case) cases). free_als (m v))
  "
    using AEMatch.hyps(3)
    apply(simp add: split_def)
    by (smt (verit, ccfv_SIG) SUP_upper2 Union_least imageE snds.intros)
  show ?case
    using AEMatch result_cases by auto
next
  case (AELam x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (AEApp x1 x2 x3)
  then show ?case by auto
next
  case (AEVar x)
  then show ?case by auto
next
  case (AEDef x1 x2)
  then show ?case by auto
next
  case (AESelf x1 x2)
  then show ?case by auto
qed

lemma lsv_inst_mu_free_subset:
  assumes no_free_as': "\<And> a'. a' \<in> set as' \<Longrightarrow> free_als_mu_als a' \<subseteq> f"
  shows "\<And> a. free_als_mu_als ((lsv_inst vs as') a) \<subseteq> f"
  using no_free_as'
  apply(induct as' arbitrary: vs)
   apply(auto)
  apply(case_tac vs)
   apply(auto)
  by (metis (mono_tags) subset_iff)

lemma lsv_subst_no_mu_free_als:
  assumes no_free_as': "\<And> a'. a' \<in> set as' \<Longrightarrow> free_als_mu_als a' = {}"
  shows "free_als_mu_als a = {} \<Longrightarrow> (free_als_mu_als (als_lsv_subst (lsv_inst vs as') a)) = {}"
  using no_free_as' lsv_subst_mu_free_union_rec lsv_inst_mu_free_subset
  by (metis Un_empty_left subset_empty)

lemma lsv_subst_no_mu_free_at:
  assumes no_free_as': "\<And> a'. a' \<in> set as' \<Longrightarrow> free_als_mu_als a' = {}"
  shows "free_als_mu_at t = {} \<Longrightarrow> (free_als_mu_at (at_lsv_subst (lsv_inst vs as') t)) = {}"
  using no_free_as' lsv_subst_mu_free_union_rec lsv_inst_mu_free_subset
  by (metis Un_empty_left subset_empty)

lemma lsv_subst_no_mu_free_ae:
  assumes no_free_as': "\<And> a'. a' \<in> set as' \<Longrightarrow> free_als_mu_als a' = {}"
  shows "free_als_mu_ae e = {} \<Longrightarrow> (free_als_mu_ae (ae_lsv_subst (lsv_inst vs as') e)) = {}"
  using no_free_as' lsv_subst_mu_free_union_rec lsv_inst_mu_free_subset
  by (metis Un_empty_left subset_empty)

lemma ti_collect_no_mu_free:
  assumes dc_no_mu_free: "atcd_no_mu_free dc"
  shows "
    free_als_mu_ae e = {} \<Longrightarrow>
    free_als_mu_alsc_all (ti_collect_ae dc e) = {}
  "
proof(induct e rule: ae_induct_simple)
  case (1 x)
  then show ?case by auto
next
  case (2 x1 x2)
  then show ?case by auto
next
  case (3 x1 x2 x3)
  then show ?case by auto
next
  case (4 x1 x2 x3)
  then show ?case by auto
next
  case (5 x)
  then show ?case by auto
next
  case (6 x1 x2 x3)
  then show ?case by auto
next
  case AEMatch: (7 t_dis e_dis cases)
  then show ?case
    apply(simp add: split_def)
    by (meson snds.intros)
next
  case (8 x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (9 x1 x2 x3)
  then show ?case by auto
next
  case (10 x)
  then show ?case by auto
next
  case AEDef: (11 d as)
  show ?case
  proof(induct "dc d")
    case None
    then show ?case by auto
  next
    case (Some option)
    show ?case
    proof -
      obtain vs t cs where decomp: "(vs, t, cs) = option"
        by (metis prod_cases3)
      have "free_als_mu_alsc_all cs = {}"
        using Some decomp dc_no_mu_free
        apply(simp only: atcd_no_mu_free.simps)
        by (metis (mono_tags, lifting) case_prod_conv option.simps(5))
      then have no_free_cs: "\<And> c. c \<in> set cs \<Longrightarrow> free_als_mu_alsc c = {}"
        by auto
      have no_free_as: "\<And> a. a \<in> set as \<Longrightarrow> free_als_mu_als a = {}"
        using AEDef.prems by auto
      then have no_free_c: "\<And> c. c \<in> set cs \<Longrightarrow> free_als_mu_alsc (alsc_lsv_subst (lsv_inst vs as) c) = {}"
        using no_free_cs no_free_as lsv_subst_no_mu_free_als lsv_subst_no_mu_free_at lsv_subst_no_mu_free_ae
        by auto
      have "ti_collect_ae dc (AEDef d as) = alsc_lsv_subst_all (lsv_inst vs as) cs"
        using Some decomp
        apply(simp only: ti_collect_ae.simps)
        by (metis old.prod.case option.simps(5))
      then show ?thesis
        using no_free_c by auto
    qed
  qed
next
  case (12 x1 x2)
  then show ?case by auto
qed

lemma lsv_subst_mu_free_union_als: "
  (\<And>v. free_als_mu_als (m v) \<subseteq> f) \<Longrightarrow>
  free_als_mu_als (als_lsv_subst m a) \<subseteq> free_als_mu_als a \<union> f
"
  using lsv_subst_mu_free_union_rec by auto

lemma lsv_subst_mu_free_union_ae: "
  (\<And>v. free_als_mu_als (m v) \<subseteq> f) \<Longrightarrow>
  free_als_mu_ae (ae_lsv_subst m e) \<subseteq> free_als_mu_ae e \<union> f
"
  using lsv_subst_mu_free_union_rec by auto

lemma lsv_subst_mu_free_union_alsc: "
  (\<And>v. free_als_mu_als (m v) \<subseteq> f) \<Longrightarrow>
  free_als_mu_alsc (alsc_lsv_subst m c) \<subseteq> free_als_mu_alsc c \<union> f
"
  apply(case_tac "fst c")
  apply(case_tac c)
  using lsv_subst_mu_free_union_rec
  apply auto
  by(blast)+

lemma lsv_subst_mu_free_union_alsc_all: "
  (\<And>v. free_als_mu_als (m v) \<subseteq> f) \<Longrightarrow>
  free_als_mu_alsc_all (alsc_lsv_subst_all m cc) \<subseteq> free_als_mu_alsc_all cc \<union> f
"
  apply(induct cc)
   apply(auto)[1]
  apply simp
  using lsv_subst_mu_free_union_alsc
  by (metis (mono_tags, lifting) subset_trans sup_assoc sup_ge2)

lemma lsv_subst_lsv_free_image_als: "
  free_als (als_lsv_subst m a) \<subseteq> (\<Union> v \<in> free_als a. free_als (m v))
"
  using lsv_subst_lsv_free_image_rec by auto

lemma lsv_subst_lsv_free_image_ae: "
  free_ae (ae_lsv_subst m e) \<subseteq> (\<Union> v \<in> free_ae e. free_als (m v))
"
  using lsv_subst_lsv_free_image_rec by auto

lemma lsv_subst_lsv_free_image_al: "
  free_al (al_lsv_subst m l) \<subseteq> (\<Union> v \<in> free_al l. free_als (m v))
"
  apply(case_tac "l")
  using lsv_subst_lsv_free_image_rec apply auto
  by(blast)+

lemma lsv_subst_lsv_free_image_alsc: "
  free_alsc (alsc_lsv_subst m c) \<subseteq> (\<Union> v \<in> free_alsc c. free_als (m v))
"
  apply(case_tac "fst c")
  apply(case_tac c)
  using lsv_subst_lsv_free_image_rec
  apply auto
  by(blast)+

lemma lsv_subst_lsv_free_image_alsc_all: "
  free_acc (alsc_lsv_subst_all m cc) \<subseteq> (\<Union> v \<in> free_acc cc. free_als (m v))
"
  apply(induct cc)
   apply(auto)[1]
  apply simp
  using lsv_subst_lsv_free_image_alsc
  by (metis (no_types, lifting) le_supI1 subset_trans sup_ge2)

lemma ti_collect_lsv_free:
  assumes
    dc_dwf: "dwf_atcd dc"
  shows "dwf_ae dc e \<Longrightarrow> free_acc (ti_collect_ae dc e) \<subseteq> free_ae e"
proof(induct e rule: ae_induct_simple)
case (1 x)
then show ?case by auto
next
  case (2 x1 x2)
  then show ?case by auto
next
  case (3 x1 x2 x3)
then show ?case by auto
next
  case (4 x1 x2 x3)
  then show ?case by auto
next
  case (5 x)
then show ?case by auto
next
  case (6 x1 x2 x3)
  then show ?case by auto
next
  case (7 x1 x2 x3)
  then show ?case
    apply(simp add: split_def)
    by fastforce
next
  case (8 x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case by auto
next
  case (9 x1 x2 x3)
  then show ?case by auto
next
  case (10 x)
  then show ?case by auto
next
  case AEDef: (11 d as)
  obtain vs t cc where dc_entry: "dc d = Some (vs, t, cc)" and vs_length: "length vs = length as"
    using AEDef.prems by(case_tac "dc d", auto)
  let ?subst = "lsv_inst vs as"
  have cc_subst_free_bound: "
    free_acc (alsc_lsv_subst_all ?subst cc) \<subseteq> (\<Union> v \<in> free_acc cc. free_als (?subst v))"
    by(rule lsv_subst_lsv_free_image_alsc_all)
  have "\<And>v. v \<in> free_acc cc \<Longrightarrow> ?subst v \<in> set as"
  proof -
    fix v
    assume v_in: "v \<in> free_acc cc"
    have v_in_vs: "v \<in> set vs"
      using dc_entry dc_dwf apply auto
      by (smt (z3) curryI curry_case_prod in_mono option.simps(5) v_in)
    show "?subst v \<in> set as"
      using v_in_vs vs_length apply(induct vs arbitrary: v as)
       apply simp
      apply(case_tac as)
      by auto
  qed
  then have "(\<Union> v \<in> free_acc cc. free_als (?subst v)) \<subseteq> free_ae (AEDef d as)"
    by auto
  then have "free_acc (alsc_lsv_subst_all ?subst cc) \<subseteq> free_ae (AEDef d as)"
    using cc_subst_free_bound by auto
  then show ?case
    by(simp only: ti_collect_ae.simps dc_entry option.simps(5) split_def fst_conv snd_conv)
next
case (12 x1 x2)
  then show ?case by auto
qed

lemma ti_solution_for_no_mu_free:
  assumes orig_no_mu_free: "free_als_mu_alsc_all cc = {}"
  shows "free_als_mu_als (ti_solution_for cc v) = {}"
proof -
  let ?incident = "incident_constrs cc v"
  let ?ls = "map fst ?incident"
  let ?sol = "ti_solution_for cc v"
  have set_no_mu_free: "free_als_mu_als (ALSSet ?ls) = {}"
    using orig_no_mu_free by auto
  show ?thesis
  proof(cases "v \<in> \<Union> (free_al ` set ?ls)")
    case cyclic: True
    let ?u = "max_als_mu_alsc_all ?incident + 1"
    let ?set_als = "ALSSet (map (al_lsv_subst (ALSVar(v := ALSMuVar ?u))) ?ls)"
    let ?mu_als = "ALSMu ?u ?set_als"
    have sol_mu: "?sol = ?mu_als"
      using cyclic by(simp add: Let_def)
    have free_bound: "
      free_als_mu_als (als_lsv_subst (ALSVar(v := ALSMuVar ?u)) (ALSSet ?ls)) \<subseteq>
      free_als_mu_als (ALSSet ?ls) \<union> {?u}"
      apply(rule lsv_subst_mu_free_union_als)
      by auto
    have set_subst_simp: "als_lsv_subst (ALSVar(v := ALSMuVar ?u)) (ALSSet ?ls) = ?set_als"
      by auto
    have "free_als_mu_als ?set_als \<subseteq> free_als_mu_als (ALSSet ?ls) \<union> {?u}"
      using free_bound by(simp only: set_subst_simp)
    then have set_als_free_bound: "free_als_mu_als ?set_als \<subseteq> {?u}"
      using set_no_mu_free by auto
    have "free_als_mu_als ?mu_als = Set.remove ?u (free_als_mu_als ?set_als)"
      by auto
    moreover have "... = {}"
      using set_als_free_bound
      by (smt (z3) insertE member_remove subset_empty subset_eq)
    finally have "free_als_mu_als ?mu_als = {}"
      by auto
    then show ?thesis
      using sol_mu by auto
  next
    case simple: False
    then show ?thesis
      using set_no_mu_free ti_solution_for.simps by presburger
  qed
qed

lemma ti_solution_for_lsv_remove: "free_als (ti_solution_for cc v) \<subseteq> Set.remove v (free_acc cc)"
proof -
  let ?incident = "incident_constrs cc v"
  let ?ls = "map fst ?incident"
  let ?sol = "ti_solution_for cc v"
  show ?thesis
  proof(cases "v \<in> \<Union> (free_al ` set ?ls)")
    case cyclic: True
    let ?u = "max_als_mu_alsc_all ?incident + 1"
    let ?subst = "ALSVar(v := ALSMuVar ?u)"
    let ?set_als = "ALSSet (map (al_lsv_subst ?subst) ?ls)"
    let ?mu_als = "ALSMu ?u ?set_als"
    have sol_mu: "?sol = ?mu_als"
      using cyclic by(simp add: Let_def)
    have subst_remove: "\<And>v'. v' \<in> free_acc cc \<Longrightarrow> free_als (?subst v') \<subseteq> Set.remove v (free_acc cc)"
      apply(case_tac "v' = v")
      by auto
    have "\<And>l. free_al (al_lsv_subst ?subst l) \<subseteq> (\<Union> v' \<in> free_al l. free_als (?subst v'))"
      by(rule lsv_subst_lsv_free_image_al)
    moreover have "\<And>l. l \<in> set ?ls \<Longrightarrow> free_al l \<subseteq> \<Union> (free_al ` set ?ls)"
      by auto
    moreover have "\<Union> (free_al ` set ?ls) \<subseteq> free_acc cc"
      by auto
    ultimately have "\<And>l. l \<in> set ?ls \<Longrightarrow>
      free_al (al_lsv_subst ?subst l) \<subseteq> (\<Union> v' \<in> free_acc cc. free_als (?subst v'))"
      by (meson UN_mono order_refl order_trans)
    moreover have "free_als ?set_als \<subseteq> (\<Union> l \<in> set ?ls. free_al (al_lsv_subst ?subst l))"
      by auto
    ultimately have "free_als ?set_als \<subseteq> (\<Union> v' \<in> free_acc cc. free_als (?subst v'))"
      by (smt (z3) UN_iff subset_iff)
    then have "free_als ?set_als \<subseteq> Set.remove v (free_acc cc)"
      using subst_remove by auto
    then have "free_als ?mu_als \<subseteq> Set.remove v (free_acc cc)"
      by auto
    then show ?thesis
      using sol_mu by auto
  next
    case simple: False
    have sol_set: "?sol = ALSSet ?ls"
      using simple by(simp add: Let_def)
    have "free_als (ALSSet ?ls) \<subseteq> (free_acc cc)"
      by auto
    then have "free_als (ALSSet ?ls) \<subseteq> Set.remove v (free_acc cc)"
      using simple by fastforce
    then show ?thesis
      using sol_set by auto
  qed
qed

fun ti_internalize_one :: "AT \<Rightarrow> ACC * AE \<Rightarrow> LSVar \<Rightarrow> ACC * AE" where
"ti_internalize_one t_sig (cc, e_body) v = (
  if v \<in> free_at t_sig then
    (cc, e_body)
  else
    let sol = ti_solution_for cc v in
    let cc' = alsc_lsv_subst_all (ALSVar(v := sol)) (other_constrs cc v) in
    let e_body' = ae_lsv_subst (ALSVar(v := sol)) e_body in
    (cc', e_body')
)"

fun alsc_only_vars :: "ALSC \<Rightarrow> bool" where
"alsc_only_vars (_, ALSVar v) = True" |
"alsc_only_vars (_, _) = False"

fun alsc_only_vars_all :: "ACC \<Rightarrow> bool" where
"alsc_only_vars_all cc = (\<forall> c \<in> set cc. alsc_only_vars c)"

fun atcd_alsc_only_vars :: "ATCD \<Rightarrow> bool" where
"atcd_alsc_only_vars dc =
  (\<forall> d. case dc d of None \<Rightarrow> True | Some (_, _, cc) \<Rightarrow> alsc_only_vars_all cc)"

fun no_internal_up_to_alsc_all :: "AT \<Rightarrow> LSVar \<Rightarrow> ACC \<Rightarrow> bool" where
"no_internal_up_to_alsc_all t_sig v cc= ({v' \<in> free_acc cc. v' < v} \<subseteq> free_at t_sig)"

fun no_internal_up_to_ae :: "AT \<Rightarrow> LSVar \<Rightarrow> AE \<Rightarrow> bool" where
"no_internal_up_to_ae t_sig v e = ({v' \<in> free_ae e. v' < v} \<subseteq> free_at t_sig)"

fun internalization_invariant :: "ATCD \<Rightarrow> Def \<Rightarrow> AT \<Rightarrow> nat \<Rightarrow> LSVar \<Rightarrow> SE \<Rightarrow> (ACC * AE) \<Rightarrow> bool" where
"internalization_invariant dc d t_sig count v e_src (cc, e) = (
  dwf_ae dc e \<and>
  tj_ae (ATCS dc d t_sig) Map.empty e t_sig \<and>
  cj_ae dc cc e \<and>
  alsc_only_vars_all cc \<and>
  free_als_mu_alsc_all cc = {} \<and>
  free_als_mu_ae e = {} \<and>
  free_acc cc \<subseteq> free_at t_sig \<union> {v'. v \<le> v' \<and> v' < count} \<and>
  free_ae e \<subseteq> free_at t_sig \<union> {v'. v \<le> v' \<and> v' < count} \<and>
  rj_se_ae e_src e
)"

lemma alsc_only_vars_lsv_subst_other:
  assumes
    orig_only_vars: "alsc_only_vars_all cc" and
    v_absent: "ALSVar v \<notin> (snd ` set cc)"
  shows "alsc_only_vars_all (alsc_lsv_subst_all (ALSVar(v := a')) cc)"
proof -
  let ?subst = "(ALSVar(v := a'))"
  have "\<And>c. c \<in> set cc \<Longrightarrow> alsc_only_vars (alsc_lsv_subst ?subst c)"
  proof -
    fix c
    assume c_in: "c \<in> set cc"
    obtain l v' where c_decomp: "c = (l, ALSVar v')"
      using c_in orig_only_vars by(case_tac c, case_tac "snd c", auto)
    have "v' \<noteq> v"
      using v_absent c_in c_decomp by force
    then show "alsc_only_vars (alsc_lsv_subst ?subst c)"
      using c_decomp by(case_tac l, auto)
  qed
  then show ?thesis
    by auto
qed

lemma ti_internalize_one_preserve_invariant:
  assumes dc_dwf: "dwf_atcd dc"
  assumes orig_invariant: "internalization_invariant dc d t_sig count v e_src state"
  shows "internalization_invariant dc d t_sig count (v + 1) e_src (ti_internalize_one t_sig state v)"
    (is "internalization_invariant _ _ _ _ _ _ ?state'")
proof -
  obtain cc e where state_decomp: "state = (cc, e)"
    by(case_tac state, auto)
  obtain cc' e' where state'_decomp: "?state' = (cc', e')"
    by(case_tac ?state', auto)
  let ?allowed_vars = "free_at t_sig \<union> {v'. v \<le> v' \<and> v' < count}"
  let ?new_allowed_vars = "free_at t_sig \<union> {v'. v + 1 \<le> v' \<and> v' < count}"
  show ?thesis
  proof(cases "v \<in> free_at t_sig")
    case in_sig: True
    have
      cc'_sol: "cc' = cc" and
      e'_sol: "e' = e"
      using in_sig state_decomp state'_decomp by auto
    have "\<And>v''. v'' \<in> ?allowed_vars \<longleftrightarrow> v'' \<in> ?new_allowed_vars"
      using in_sig by(case_tac "v'' = v", auto)
    then have "?allowed_vars = ?new_allowed_vars"
      by auto
    then show ?thesis
      using orig_invariant state_decomp state'_decomp cc'_sol e'_sol by auto
  next
    case internal: False
    let ?sol = "ti_solution_for cc v"
    let ?subst = "ALSVar(v := ?sol)"
    let ?other_cc = "other_constrs cc v"
    have
      cc'_sol: "cc' = alsc_lsv_subst_all ?subst ?other_cc" and
      e'_sol: "e' = ae_lsv_subst ?subst e"
      using state_decomp state'_decomp internal by(simp_all add: Let_def)
    have sol_no_mu_free: "free_als_mu_als ?sol = {}"
      apply(rule ti_solution_for_no_mu_free)
      using orig_invariant state_decomp by auto
    show ?thesis
    proof(simp only: state'_decomp internalization_invariant.simps, intro conjI)
      have e_dwf: "dwf_ae dc e"
        using orig_invariant state_decomp by auto
      have e_subst_dwf: "dwf_ae dc (ae_lsv_subst ?subst e)"
        apply(rule lsv_subst_dwf)
        using e_dwf .
      then show "dwf_ae dc e'"
        using e'_sol by auto

      have e_cj: "cj_ae dc cc e"
        using orig_invariant state_decomp by auto
      have e_subst_cj: "cj_ae dc (alsc_lsv_subst_all ?subst cc) (ae_lsv_subst ?subst e)"
        apply(rule lsv_subst_cj_ae)
        using dc_dwf sol_no_mu_free e_cj by auto
      have cc'_entails: "cj_alsc_all (alsc_lsv_subst_all ?subst ?other_cc) (alsc_lsv_subst_all ?subst cc)"
        by(rule ti_solution_for_other_cj)
      show "cj_ae dc cc' e'"
        apply(rule acc_compose_ae[where ?cc2.0 = "alsc_lsv_subst_all ?subst cc"])
        using cc'_sol cc'_entails apply(auto)[1]
        using e_subst_cj e'_sol by auto

      have cc_only_vars: "alsc_only_vars_all cc"
        using orig_invariant state_decomp by auto
      have "alsc_only_vars_all (alsc_lsv_subst_all ?subst ?other_cc)"
        apply(rule alsc_only_vars_lsv_subst_other)
        using cc_only_vars by auto
      then show "alsc_only_vars_all cc'"
        using cc'_sol by auto

      have t_sig_same: "at_lsv_subst ?subst t_sig = t_sig"
        apply(rule lsv_subst_absent_at)
        using internal by auto

      have e_tj: "tj_ae (ATCS dc d t_sig) Map.empty e t_sig"
        using orig_invariant state_decomp by auto
      have "
      tj_ae
        (atcs_lsv_subst ?subst (ATCS dc d t_sig))
        (atcv_lsv_subst ?subst Map.empty)
        (ae_lsv_subst ?subst e)
        (at_lsv_subst ?subst t_sig)"
        apply(rule lsv_subst_tj)
        using dc_dwf e_tj e_dwf by auto
      then have "
      tj_ae
        (ATCS dc d t_sig)
        Map.empty
        (ae_lsv_subst ?subst e)
        t_sig
    "
        using t_sig_same by auto
      then show "tj_ae (ATCS dc d t_sig) Map.empty e' t_sig"
        using e'_sol by auto

      have cc_no_mu_free: "free_als_mu_alsc_all cc = {}"
        using orig_invariant state_decomp by auto
      have "free_als_mu_alsc_all (alsc_lsv_subst_all ?subst cc) \<subseteq> free_als_mu_alsc_all cc \<union> {}"
        apply(rule lsv_subst_mu_free_union_alsc_all)
        using sol_no_mu_free by auto
      then have "free_als_mu_alsc_all (alsc_lsv_subst_all ?subst cc) = {}"
        using cc_no_mu_free by auto
      then show "free_als_mu_alsc_all cc' = {}"
        using cc'_sol by auto

      have e_no_mu_free: "free_als_mu_ae e = {}"
        using orig_invariant state_decomp by auto
      have "free_als_mu_ae (ae_lsv_subst ?subst e) \<subseteq> free_als_mu_ae e \<union> {}"
        apply(rule lsv_subst_mu_free_union_ae)
        using sol_no_mu_free by auto
      then have "free_als_mu_ae (ae_lsv_subst ?subst e) = {}"
        using e_no_mu_free by auto
      then show "free_als_mu_ae e' = {}"
        using e'_sol by auto

      have cc_allowed: "free_acc cc \<subseteq> ?allowed_vars"
        using orig_invariant state_decomp by auto
      have "free_als (ti_solution_for cc v) \<subseteq> Set.remove v (free_acc cc)"
        by(rule ti_solution_for_lsv_remove)
      then have sol_allowed: "free_als (ti_solution_for cc v) \<subseteq> ?new_allowed_vars"
        using cc_allowed by fastforce
      have subst_allowed: "\<And>v'. v' \<in> ?allowed_vars \<Longrightarrow> free_als (?subst v') \<subseteq> ?new_allowed_vars"
        apply(case_tac "v' = v")
         apply simp
        using sol_allowed by auto

      have "free_acc (alsc_lsv_subst_all ?subst ?other_cc) \<subseteq> (\<Union> v' \<in> free_acc ?other_cc. free_als (?subst v'))"
        by(rule lsv_subst_lsv_free_image_alsc_all)
      moreover have "free_acc ?other_cc \<subseteq> free_acc cc"
        by auto
      ultimately have "free_acc (alsc_lsv_subst_all ?subst ?other_cc) \<subseteq> (\<Union> v' \<in> free_acc cc. free_als (?subst v'))"
        by (metis (no_types, lifting) SUP_mono order_trans subset_iff)
      then have "free_acc (alsc_lsv_subst_all ?subst ?other_cc) \<subseteq> ?new_allowed_vars"
        using cc_allowed subst_allowed by auto
      then show "free_acc cc' \<subseteq> ?new_allowed_vars"
        using cc'_sol by auto

      have e_allowed: "free_ae e \<subseteq> ?allowed_vars"
        using orig_invariant state_decomp by auto
      have "free_ae (ae_lsv_subst ?subst e) \<subseteq> (\<Union> v' \<in> free_ae e. free_als (?subst v'))"
        by(rule lsv_subst_lsv_free_image_ae)
      then have "free_ae (ae_lsv_subst ?subst e) \<subseteq> ?new_allowed_vars"
        using e_allowed subst_allowed by auto
      then show "free_ae e' \<subseteq> ?new_allowed_vars"
        using e'_sol by auto

      have "rj_se_ae e_src e"
        using orig_invariant state_decomp by auto
      then have "rj_se_ae e_src (ae_lsv_subst ?subst e)"
        using ae_lsv_subst_preserve_strip by auto
      then show "rj_se_ae e_src e'"
        using e'_sol by auto
    qed
  qed
qed

function ti_internalize_all_rec :: "nat \<Rightarrow> LSVar \<Rightarrow> AT \<Rightarrow> ACC * AE \<Rightarrow> ACC * AE" where
"ti_internalize_all_rec count v t_sig state = (
  if v < count then
    ti_internalize_all_rec count (v + 1) t_sig (ti_internalize_one t_sig state v)
  else
    state
)"
  by(pat_completeness) auto
termination by(relation "measure (\<lambda> (count, v, _, _). count - v)", auto)

lemma ti_internalize_all_rec_invariant:
  assumes dc_dwf: "dwf_atcd dc"
  shows "
      v \<le> count \<Longrightarrow>
      internalization_invariant dc d t_sig count v e_src state \<Longrightarrow>
      internalization_invariant dc d t_sig count count e_src (ti_internalize_all_rec count v t_sig state)
    "
(is "_ \<Longrightarrow> _ \<Longrightarrow> internalization_invariant _ _ _ _ _ _ ?state_final")
  apply(induct "count - v" arbitrary: v state)
  using dc_dwf ti_internalize_one_preserve_invariant by auto

fun ti_internalize_all :: "nat \<Rightarrow> AT \<Rightarrow> ACC * AE \<Rightarrow> ACC * AE" where
"ti_internalize_all count t_sig state = ti_internalize_all_rec count 0 t_sig state"

fun internalization_postcondition :: "ATCD \<Rightarrow> Def \<Rightarrow> AT \<Rightarrow> SE \<Rightarrow> (ACC * AE) \<Rightarrow> bool" where
"internalization_postcondition dc d t_sig e_src (cc, e) = (
  dwf_ae dc e \<and>
  tj_ae (ATCS dc d t_sig) Map.empty e t_sig \<and>
  cj_ae dc cc e \<and>
  alsc_only_vars_all cc \<and>
  free_als_mu_alsc_all cc = {} \<and>
  free_als_mu_ae e = {} \<and>
  free_acc cc \<subseteq> free_at t_sig \<and>
  free_ae e \<subseteq> free_at t_sig \<and>
  rj_se_ae e_src e
)"

lemma ti_internalize_all_correct:
  assumes prems: "
    dwf_atcd dc \<and>
    dwf_ae dc e \<and>
    tj_ae (ATCS dc d t_sig) Map.empty e t_sig \<and>
    cj_ae dc cc e \<and>
    alsc_only_vars_all cc \<and>
    free_als_mu_alsc_all cc = {} \<and>
    free_als_mu_ae e = {} \<and>
    (\<forall> v \<in> (free_acc cc). v < count) \<and>
    (\<forall> v \<in> (free_ae e). v < count) \<and>
    rj_se_ae e_src e
  "
  shows "internalization_postcondition dc d t_sig e_src (ti_internalize_all count t_sig (cc, e))"
proof -
  have init_invariant: "internalization_invariant dc d t_sig count 0 e_src (cc, e)"
    using prems by auto
  have "internalization_invariant dc d t_sig count count e_src (ti_internalize_all_rec count 0 t_sig (cc, e))"
    apply(rule ti_internalize_all_rec_invariant)
    using init_invariant prems by auto
  then show ?thesis
    apply(case_tac "ti_internalize_all count t_sig (cc, e)")
    apply(case_tac "ti_internalize_all_rec count 0 t_sig (cc, e)")
    apply(simp only: internalization_invariant.simps internalization_postcondition.simps)
    apply simp
    by (metis (no_types, lifting) Collect_empty_eq Un_empty_right not_le)
qed

(* First-order check *)
fun fo_st :: "ST \<Rightarrow> bool" where
"fo_st (STProd ts) = (\<forall> t \<in> set ts. fo_st t)" |
"fo_st (STSum ts) = (\<forall> t \<in> set ts. fo_st t)" |
"fo_st (STMu _ t) = fo_st t" |
"fo_st (STVar _) = True" |
"fo_st (STFun _ _) = False"

fun fo_at :: "AT \<Rightarrow> bool" where
"fo_at t = fo_st (strip_at t)"

fun tj_sp :: "STCD \<Rightarrow> SP \<Rightarrow> bool" where
"tj_sp dc (SPEntry d) = (case dc d of None \<Rightarrow> False | Some t \<Rightarrow> fo_st t)" |
"tj_sp dc (SPDef d t e p) = (
  dc d = None \<and>
  tj_se (STCS dc d t) Map.empty e t \<and>
  tj_sp (dc(d := Some t)) p
)"

fun tj_ap :: "ATCD \<Rightarrow> AP \<Rightarrow> bool" where
"tj_ap dc (APEntry d) = (case dc d of None \<Rightarrow> False | Some ([], t, []) \<Rightarrow> fo_at t)" |
"tj_ap dc (APDef d vs cc t e p) = (
  dc d = None \<and>
  tj_ae (ATCS dc d t) Map.empty e t \<and>
  cj_ae dc cc e \<and>
  free_at t = set vs \<and>
  free_acc cc \<subseteq> set vs \<and>
  free_ae e \<subseteq> set vs \<and>
  tj_ap (dc(d := Some (vs, t, cc))) p
)"

fun ti_full_def :: "ATCD \<Rightarrow> Def \<Rightarrow> ST \<Rightarrow> SE \<Rightarrow> LSVar list * ACC * AT * AE" where
"ti_full_def dc d t e = (
  let (_, t', e') = ti_pre_def dc d t e in
  let cc = ti_collect_ae dc e' in
  let count = Max (free_at t' \<union> free_ae e') + 1 in
  let (cc', e'') = ti_internalize_all count t' (cc, e') in
  (sorted_list_of_set (free_at t'), cc', t', e'')
)"

lemma lsv_free_finite_rec: "
  finite (free_als a) \<and>
  finite (free_at t) \<and>
  finite (free_ae e)
"
  apply(induct rule: ALS_AT_AE.induct)
  by auto

lemma tj_dwf_ae: "tj_ae sc gc e t \<Longrightarrow> dwf_ae (atcs_defs sc) e"
  apply(induct e arbitrary: gc t rule: ae_induct_simple) apply auto
  apply (metis in_set_impl_in_set_zip1 old.prod.case)
  by (metis (no_types, lifting) case_prodD in_set_impl_in_set_zip2)

lemma ti_collect_only_vars:
  assumes
    dc_only_vars: "atcd_alsc_only_vars dc"
  shows
    "ff_ae e \<Longrightarrow> alsc_only_vars_all (ti_collect_ae dc e)"
proof(induct e rule: ae_induct_simple)
case (1 x)
then show ?case by auto
next
  case (2 x1 x2)
  then show ?case by auto
next
  case (3 x1 x2 x3)
  then show ?case by auto
next
  case (4 x1 x2 x3)
  then show ?case by auto
next
  case (5 x)
  then show ?case by auto
next
  case (6 x1 x2 x3)
then show ?case by auto
next
  case (7 x1 x2 x3)
  then show ?case by auto
next
  case (8 x1 x2 x3 x4 x5 x6 x7 x8)
  then show ?case
    apply auto
    by (metis alsc_only_vars.simps(1) ff_als.elims(2))
next
  case (9 x1 x2 x3)
  then show ?case by auto
next
  case (10 x)
  then show ?case by auto
next
  case AEDef: (11 d as)
  show ?case
  proof(cases "dc d")
    case None
    then show ?thesis by auto
  next
    case (Some entry)
    obtain vs t cc where entry_decomp: "entry = (vs, t, cc)" by(case_tac entry, auto)
    have cc_only_vars: "alsc_only_vars_all cc"
      using entry_decomp dc_only_vars apply auto
      by (metis Some alsc_only_vars_all.simps case_prodD option.simps(5))
    let ?subst = "lsv_inst vs as"
    have "\<And>v. \<exists> v'. ?subst v = ALSVar v'"
      using AEDef.prems
      apply(induct vs arbitrary: as)
       apply simp
      apply(case_tac as)
       apply simp
      apply auto
      by (meson ff_als.elims(2))
    then have "\<And>c. c \<in> set cc \<Longrightarrow> alsc_only_vars (alsc_lsv_subst ?subst c)"
      apply(case_tac "c")
      using cc_only_vars apply(case_tac "snd c", auto)
      by (metis alsc_only_vars.simps(1))
    then show ?thesis
      apply(simp only: alsc_only_vars_all.simps ti_collect_ae.simps Some option.simps(5) split_def fst_conv snd_conv entry_decomp)
      by auto
  qed
next
  case (12 x1 x2)
  then show ?case by auto
qed

(* Post-condition for ti_full_def *)
fun ti_full_def_post :: "ATCD \<Rightarrow> Def \<Rightarrow> LSVar list \<Rightarrow> ACC \<Rightarrow> ST \<Rightarrow> SE \<Rightarrow> AT \<Rightarrow> AE \<Rightarrow> bool" where
"ti_full_def_post dc' d vs cc t e t' e' = (
    tj_ae (ATCS dc' d t') Map.empty e' t' \<and>
    cj_ae dc' cc e' \<and>
    alsc_only_vars_all cc \<and>
    free_als_mu_alsc_all cc = {} \<and>
    free_als_mu_at t' = {} \<and>
    free_als_mu_ae e' = {} \<and>
    free_acc cc \<subseteq> set vs \<and>
    free_at t' = set vs \<and>
    free_ae e' \<subseteq> set vs \<and>
    ff_at t' \<and>
    rj_st_at t t' \<and>
    rj_se_ae e e'
)"

lemma ti_full_def_correct:
  assumes
    dc_refine: "rj_stcd_atcd dc dc'" and
    dc_dwf_ff: "dwf_ff_atcd dc'" and
    dc_no_mu_free: "atcd_no_mu_free dc'" and
    dc_alsc_only_vars: "atcd_alsc_only_vars dc'" and
    orig_tj: "tj_se (STCS dc d t) Map.empty e t" and
    ti_full_out: "(vs, cc, t', e') = ti_full_def dc' d t e"
  shows "ti_full_def_post dc' d vs cc t e t' e'"
proof(simp only: ti_full_def_post.simps, intro conjI)
  let ?ti_pre_result = "ti_pre_def dc' d t e"
  let ?t' = "fst (snd ?ti_pre_result)"
  let ?e' = "snd (snd ?ti_pre_result)"
  let ?cc = "ti_collect_ae dc' ?e'"
  let ?count = "Max (free_at ?t' \<union> free_ae ?e') + 1"
  let ?ti_internalize_all_result = "ti_internalize_all ?count ?t' (?cc, ?e')"
  let ?cc' = "fst ?ti_internalize_all_result"
  let ?e'' = "snd ?ti_internalize_all_result"
  let ?vs = "sorted_list_of_set (free_at ?t')"

  have
    vs_sol: "vs = ?vs" and
    cc_sol: "cc = ?cc'" and
    t'_sol: "t' = ?t'" and
    e'_sol: "e' = ?e''"
    using ti_full_out by(simp_all add: split_def Let_def)

  have pre_tj: "
    tj_ae (ATCS dc' d ?t') Map.empty ?e' ?t' \<and>
    ff_at ?t' \<and>
    ff_ae ?e' \<and>
    rj_st_at t ?t' \<and>
    rj_se_ae e ?e'
  "
  proof(rule ti_pre_tj)
    show "rj_stcd_atcd dc dc'" using dc_refine .
    show "dwf_ff_atcd dc'" using dc_dwf_ff .
    show "tj_se (STCS dc d t) Map.empty e t" using orig_tj .
    show "(fst ?ti_pre_result, ?t', ?e') = ?ti_pre_result" by auto
  qed

  have pre_dwf: "dwf_ae dc' ?e'"
    using pre_tj tj_dwf_ae
    by (metis ATCS.sel(1))

  have cc_cj: "cj_ae dc' ?cc ?e'"
  proof(rule ti_collect_cj)
    show "dwf_atcd dc'" using dc_dwf_ff by auto
    show "dwf_ae dc' ?e'" using pre_dwf .
    show "cj_alsc_all ?cc ?cc" by(rule acc_weaken, auto)
  qed

  have cc_only_vars: "alsc_only_vars_all ?cc"
    apply(rule ti_collect_only_vars)
    using dc_alsc_only_vars pre_tj by auto

  have e'_no_free: "free_als_mu_ae ?e' = {}"
    apply(rule ff_no_mu_free_ae)
    using pre_tj by auto

  have t'_no_mu_free: "free_als_mu_at ?t' = {}"
    apply(rule ff_no_mu_free_at)
    using pre_tj by auto

  have cc_no_mu_free: "free_als_mu_alsc_all ?cc = {}"
  proof(rule ti_collect_no_mu_free)
    show "atcd_no_mu_free dc'" using dc_no_mu_free .
    show "free_als_mu_ae ?e' = {}" using e'_no_free .
  qed

  have cc_free: "free_acc ?cc \<subseteq> free_ae ?e'"
  proof(rule ti_collect_lsv_free)
    show "dwf_atcd dc'"
      using dc_dwf_ff by auto

    have "dwf_ae (atcs_defs (ATCS dc' d ?t')) ?e'"
      apply(rule tj_dwf_ae)
      using pre_tj by auto
    then show "dwf_ae dc' ?e'"
      by auto
  qed

  have free_finite: "finite (free_at ?t' \<union> free_ae ?e')"
    using lsv_free_finite_rec by auto

  have "internalization_postcondition dc' d ?t' e ?ti_internalize_all_result"
  proof(rule ti_internalize_all_correct, intro conjI)
    show "dwf_atcd dc'" using dc_dwf_ff by auto
    show "dwf_ae dc' ?e'" using pre_dwf .
    show "tj_ae (ATCS dc' d ?t') Map.empty ?e' ?t'" using pre_tj by auto
    show "cj_ae dc' ?cc ?e'" using cc_cj .
    show "alsc_only_vars_all ?cc" using cc_only_vars .
    show "free_als_mu_alsc_all ?cc = {}" using cc_no_mu_free .
    show "free_als_mu_ae ?e' = {}" using e'_no_free .
    show "\<forall> v \<in> free_acc ?cc. v < ?count"
      using cc_free free_finite
      by (smt (verit, best) Max_less_iff equals0D less_add_one subsetD sup_ge2) 
    show "\<forall> v \<in> free_ae ?e'. v < ?count"
      using free_finite
      by (metis Max_ge in_mono inf_sup_ord(4) le_neq_implies_less less_add_one trans_less_add1)
    show "rj_se_ae e ?e'"
      using pre_tj by auto
  qed
  then have intern_post: "internalization_postcondition dc' d ?t' e (?cc', ?e'')"
    by auto

  have "tj_ae (ATCS dc' d ?t') Map.empty ?e'' ?t'"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "tj_ae (ATCS dc' d t') Map.empty e' t'"
    using t'_sol e'_sol by auto

  have "cj_ae dc' ?cc' ?e''"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "cj_ae dc' cc e'"
    using cc_sol e'_sol by auto

  have "alsc_only_vars_all ?cc'"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "alsc_only_vars_all cc"
    using cc_sol by auto

  have "free_als_mu_alsc_all ?cc' = {}"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "free_als_mu_alsc_all cc = {}"
    using cc_sol by auto

  show "free_als_mu_at t' = {}"
    using t'_sol t'_no_mu_free by auto

  have "free_als_mu_ae ?e'' = {}"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "free_als_mu_ae e' = {}"
    using e'_sol by auto

  have "free_acc ?cc' \<subseteq> free_at ?t'"
    using intern_post by(simp only: internalization_postcondition.simps)
  then have "free_acc ?cc' \<subseteq> set ?vs"
    using lsv_free_finite_rec set_sorted_list_of_set by blast
  then show "free_acc cc \<subseteq> set vs"
    using cc_sol vs_sol by auto

  have vs_t'_free: "free_at ?t' = set ?vs"
    using lsv_free_finite_rec by auto
  then show "free_at t' = set vs"
    using t'_sol vs_sol by auto

  have "free_ae ?e'' \<subseteq> free_at ?t'"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "free_ae e' \<subseteq> set vs"
    using e'_sol vs_sol vs_t'_free by auto

  have "ff_at ?t'"
    using pre_tj by auto
  then show "ff_at t'"
    using t'_sol by auto

  have "rj_st_at t ?t'"
    using pre_tj by auto
  then show "rj_st_at t t'"
    using t'_sol by auto

  have "rj_se_ae e ?e''"
    using intern_post by(simp only: internalization_postcondition.simps)
  then show "rj_se_ae e e'"
    using e'_sol by auto
qed

fun ti_program_rec :: "ATCD \<Rightarrow> SP \<Rightarrow> AP" where
"ti_program_rec dc (SPEntry d) = APEntry d" |
"ti_program_rec dc (SPDef d t e p) = (
  let (vs, cc, t', e') = ti_full_def dc d t e in
  APDef d vs cc t' e' (ti_program_rec (dc(d := Some (vs, t', cc))) p)
)"

lemma fo_no_free_at: "fo_at t \<Longrightarrow> free_at t = {}"
  by(induct t rule: at_induct_simple, auto)

lemma acc_only_vars_no_free_empty: "
  alsc_only_vars_all cc \<Longrightarrow>
  free_acc cc = {} \<Longrightarrow>
  cc = []
"
  apply(induct cc)
   apply auto
  by (metis alsc_only_vars.simps(2) alsc_only_vars.simps(3) alsc_only_vars.simps(4) free_als.elims insert_not_empty)

lemma ti_program_rec_correct: "
  rj_stcd_atcd dc dc' \<Longrightarrow>
  dwf_ff_atcd dc' \<Longrightarrow>
  atcd_no_mu_free dc' \<Longrightarrow>
  atcd_alsc_only_vars dc' \<Longrightarrow>
  tj_sp dc p \<Longrightarrow>
  tj_ap dc' (ti_program_rec dc' p) \<and> rj_sp_ap p (ti_program_rec dc' p)
"
(is "_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?result dc' p")
proof(induct p arbitrary: dc dc')
  case (SPEntry d)
  obtain t where dc_entry: "dc d = Some t"
    using SPEntry.prems(5) by(case_tac "dc d", auto)
  obtain vs t' cc where
    dc'_entry: "dc' d = Some (vs, t', cc)" and
    t'_refine: "rj_st_at t t'"
    using SPEntry.prems(1) dc_entry by auto
  have free_eq: "free_at t' = set vs"
    using SPEntry.prems(2) dc'_entry
    by (smt (z3) case_prodD dwf_ff_atcd.simps dwf_atcd.simps option.simps(5))
  have t'_fo: "fo_at t'"
    using dc_entry t'_refine SPEntry.prems(5) by auto
  then have no_free: "free_at t' = {}"
    using fo_no_free_at by auto
  have no_vs: "vs = []"
    using no_free free_eq by auto
  have "alsc_only_vars_all cc"
    using dc'_entry SPEntry.prems(4)
    by (metis atcd_alsc_only_vars.simps case_prodD option.simps(5)) 
  moreover have "free_acc cc = {}"
    using SPEntry.prems(2) dc'_entry apply(simp del: free_acc.simps)
    by (smt (z3) curryI curry_case_prod no_free option.simps(5) subset_empty)
  ultimately have no_cc: "cc = []"
    using acc_only_vars_no_free_empty by auto
  show ?case
    using t'_fo dc'_entry no_vs no_cc by(simp)
next
  case (SPDef d t e p)
  let ?ti_def_result = "ti_full_def dc' d t e"
  obtain vs cc t' e' where def_r_decomp: "?ti_def_result = (vs, cc, t', e')"
    by(case_tac ?ti_def_result, auto)
  have def_post: "ti_full_def_post dc' d vs cc t e t' e'"
  proof(rule ti_full_def_correct)
    show "rj_stcd_atcd dc dc'" using SPDef.prems(1) .
    show "dwf_ff_atcd dc'" using SPDef.prems(2) .
    show "atcd_no_mu_free dc'" using SPDef.prems(3) .
    show "atcd_alsc_only_vars dc'" using SPDef.prems(4) .
    show "tj_se (STCS dc d t) Map.empty e t"
      using SPDef.prems(5) by auto
    show "(vs, cc, t', e') = ?ti_def_result" using def_r_decomp by auto
  qed
  let ?new_dc' = "dc'(d := Some (vs, t', cc))"
  have sub_result: "?result ?new_dc' p"
  proof(rule SPDef.hyps)
    have t_refine: "rj_st_at t t'"
      using def_post by auto
    show "rj_stcd_atcd (dc(d := Some t)) ?new_dc'"
      using SPDef.prems(1) def_post t_refine by auto
    have "\<And>d'.
      case ?new_dc' d' of
        None \<Rightarrow> True |
        Some (d_vs, d_t, d_cc) \<Rightarrow>
          ff_at d_t \<and> free_at d_t = set d_vs \<and> free_acc d_cc \<subseteq> set d_vs"
      apply(case_tac "d' = d")
      using def_post apply simp
      apply(case_tac "dc' d'")
       apply simp
      using SPDef.prems(2) apply simp
      by (metis (no_types, lifting) case_prodD case_prodE case_prodI free_acc.simps option.simps(5))
    then show "dwf_ff_atcd ?new_dc'"
      apply(simp only: dwf_ff_atcd.simps dwf_atcd.simps ff_atcd.simps)
      apply(intro conjI allI)
       apply (smt (z3) SPDef.prems(2) case_prodE case_prodI dwf_atcd.simps dwf_ff_atcd.simps fun_upd_def option.simps(5))
      by (smt (z3) SPDef.prems(2) case_prodE case_prodI dwf_ff_atcd.simps ff_atcd.simps fun_upd_def option.simps(5))
    show "atcd_no_mu_free ?new_dc'"
      using SPDef.prems(3) def_post by auto
    show "atcd_alsc_only_vars ?new_dc'"
      using SPDef.prems(4) def_post by auto
    show "tj_sp (dc(d := Some t)) p"
      using SPDef.prems(5) by auto
  qed
  show ?case
    apply(simp only: def_r_decomp tj_ap.simps ti_program_rec.simps Let_def split_def fst_conv snd_conv)
  proof(intro conjI)
    show "dc' d = None"
      using SPDef.prems(5,1) by auto
    show "tj_ae (ATCS dc' d t') Map.empty e' t'"
      using def_post by auto
    show "cj_ae dc' cc e'"
      using def_post by auto
    show "free_at t' = set vs"
      using def_post by auto
    show "free_acc cc \<subseteq> set vs"
      using def_post by auto
    show "free_ae e' \<subseteq> set vs"
      using def_post by auto
    show "tj_ap ?new_dc' (ti_program_rec ?new_dc' p)"
      by(simp only: sub_result)
    have "rj_st_at t t'"
      using def_post by auto
    moreover have "rj_se_ae e e'"
      using def_post by auto
    ultimately show "rj_sp_ap (SPDef d t e p) (APDef d vs cc t' e' (ti_program_rec ?new_dc' p))"
      using sub_result by(simp only: rj_sp_ap.simps, simp)
  qed
qed

fun ti_program :: "SP \<Rightarrow> AP" where
"ti_program p = ti_program_rec Map.empty p"

theorem ti_program_correct: "
  tj_sp Map.empty p \<Longrightarrow>
  tj_ap Map.empty (ti_program p) \<and> rj_sp_ap p (ti_program p)
"
  using ti_program_rec_correct by auto

end