diff --git a/thys/First_Order_Terms/Unification.thy b/thys/First_Order_Terms/Unification.thy
--- a/thys/First_Order_Terms/Unification.thy
+++ b/thys/First_Order_Terms/Unification.thy
@@ -1,579 +1,579 @@
 (*
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 Author:  René Thiemann <rene.thiemann@uibk.ac.at>
 License: LGPL
 *)
 subsection \<open>A Concrete Unification Algorithm\<close>
 
 theory Unification
   imports
     Abstract_Unification
     Option_Monad
 begin
 
 definition
   "decompose s t =
     (case (s, t) of
       (Fun f ss, Fun g ts) \<Rightarrow> if f = g then zip_option ss ts else None
     | _ \<Rightarrow> None)"
 
 lemma decompose_same_Fun[simp]: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "decompose (Fun f ss) (Fun f ss) = Some (zip ss ss)"
   by (simp add: decompose_def)
 
 lemma decompose_Some [dest]:
   "decompose (Fun f ss) (Fun g ts) = Some E \<Longrightarrow>
     f = g \<and> length ss = length ts \<and> E = zip ss ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 lemma decompose_None [dest]:
   "decompose (Fun f ss) (Fun g ts) = None \<Longrightarrow> f \<noteq> g \<or> length ss \<noteq> length ts"
   by (cases "f = g") (auto simp: decompose_def)
 
 text \<open>Applying a substitution to a list of equations.\<close>
 definition
   subst_list :: "('f, 'v) subst \<Rightarrow> ('f, 'v) equation list \<Rightarrow> ('f, 'v) equation list"
   where
     "subst_list \<sigma> ys = map (\<lambda>p. (fst p \<cdot> \<sigma>, snd p \<cdot> \<sigma>)) ys"
 
 lemma mset_subst_list [simp]:
   "mset (subst_list (subst x t) ys) = subst_mset (subst x t) (mset ys)"
   by (auto simp: subst_mset_def subst_list_def)
 
 lemma subst_list_append:
   "subst_list \<sigma> (xs @ ys) = subst_list \<sigma> xs @ subst_list \<sigma> ys"
 by (auto simp: subst_list_def)
 
 function (sequential)
   unify ::
     "('f, 'v) equation list \<Rightarrow> ('v \<times> ('f, 'v) term) list \<Rightarrow> ('v \<times> ('f, 'v) term) list option"
 where
   "unify [] bs = Some bs"
 | "unify ((Fun f ss, Fun g ts) # E) bs =
     (case decompose (Fun f ss) (Fun g ts) of
       None \<Rightarrow> None
     | Some us \<Rightarrow> unify (us @ E) bs)"
 | "unify ((Var x, t) # E) bs =
     (if t = Var x then unify E bs
     else if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
 | "unify ((t, Var x) # E) bs =
     (if x \<in> vars_term t then None
     else unify (subst_list (subst x t) E) ((x, t) # bs))"
   by pat_completeness auto
 termination
   by (standard, rule wf_inv_image [of "unif\<inverse>" "mset \<circ> fst", OF wf_converse_unif])
      (force intro: UNIF1.intros simp: unif_def union_commute)+
 
 lemma unify_append_prefix_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es1. fst e = snd e) \<Longrightarrow> unify (es1 @ es2) bs = unify es2 bs"
 proof (induction "es1 @ es2" bs arbitrary: es1 es2 bs rule: unify.induct)
   case (1 bs)
   thus ?case by simp
 next
   case (2 f ss g ts E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun f ss, Fun g ts)" and E_def: "E = es1' @ es2"
       using "2" by simp_all
     hence "f = g" and "ss = ts"
       using "2.prems" local.Cons by auto
     hence "unify (es1 @ es2) bs = unify ((zip ts ts @ es1') @ es2) bs"
       by (simp add: Cons e_def)
     also have "\<dots> = unify es2 bs"
     proof (rule "2.hyps"(1))
       show "decompose (Fun f ss) (Fun g ts) = Some (zip ts ts)"
         by (simp add: \<open>f = g\<close> \<open>ss = ts\<close>)
     next
       show "zip ts ts @ E = (zip ts ts @ es1') @ es2"
         by (simp add: E_def)
     next
       show "\<forall>e\<in>set (zip ts ts @ es1'). fst e = snd e"
         using "2.prems" by (auto simp: Cons zip_same)
     qed
     finally show ?thesis .
   qed
 next
   case (3 x t E bs)
   show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Var x, t)" and E_def: "E = es1' @ es2"
       using 3 by simp_all
     show ?thesis
     proof (cases "t = Var x")
       case True
       show ?thesis
         using 3(1)[OF True E_def]
         using "3.hyps"(3) "3.prems" local.Cons by fastforce
     next
       case False
       thus ?thesis
         using "3.prems" e_def local.Cons by force
     qed
   qed
 next
   case (4 v va x E bs)
   then show ?case
   proof (cases es1)
     case Nil
     thus ?thesis by simp
   next
     case (Cons e es1')
     hence e_def: "e = (Fun v va, Var x)" and E_def: "E = es1' @ es2"
       using 4 by simp_all
     thus ?thesis
       using "4.prems" local.Cons by fastforce
   qed
 qed
 
 corollary unify_Cons_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "fst e = snd e \<Longrightarrow> unify (e # es) bs = unify es bs"
   by (rule unify_append_prefix_same[of "[_]", simplified])
 
 corollary unify_same: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "(\<forall>e \<in> set es. fst e = snd e) \<Longrightarrow> unify es bs = Some bs"
   by (rule unify_append_prefix_same[of _ "[]", simplified])
 
 definition subst_of :: "('v \<times> ('f, 'v) term) list \<Rightarrow> ('f, 'v) subst"
   where
     "subst_of ss = List.foldr (\<lambda>(x, t) \<sigma>. \<sigma> \<circ>\<^sub>s subst x t) ss Var"
 
 text \<open>Computing the mgu of two terms.\<close>
-fun mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'v) subst option" where
+definition mgu :: "('f, 'v) term \<Rightarrow> ('f, 'v) term \<Rightarrow> ('f, 'v) subst option" where
   "mgu s t =
     (case unify [(s, t)] [] of
       None \<Rightarrow> None
     | Some res \<Rightarrow> Some (subst_of res))"
 
 lemma subst_of_simps [simp]:
   "subst_of [] = Var"
   "subst_of ((x, Var x) # ss) = subst_of ss"
   "subst_of (b # ss) = subst_of ss \<circ>\<^sub>s subst (fst b) (snd b)"
   by (simp_all add: subst_of_def split: prod.splits)
 
 lemma subst_of_append [simp]:
   "subst_of (ss @ ts) = subst_of ts \<circ>\<^sub>s subst_of ss"
   by (induct ss) (auto simp: ac_simps)
 
 text \<open>The concrete algorithm \<open>unify\<close> can be simulated by the inference
   rules of \<open>UNIF\<close>.\<close>
 lemma unify_Some_UNIF:
   assumes "unify E bs = Some cs"
   shows "\<exists>ds ss. cs = ds @ bs \<and> subst_of ds = compose ss \<and> UNIF ss (mset E) {#}"
 using assms
 proof (induction E bs arbitrary: cs rule: unify.induct)
   case (2 f ss g ts E bs)
   then obtain us where "decompose (Fun f ss) (Fun g ts) = Some us"
     and [simp]: "f = g" "length ss = length ts" "us = zip ss ts"
     and "unify (us @ E) bs = Some cs" by (auto split: option.splits)
   from "2.IH" [OF this(1, 5)] obtain xs ys
     where "cs = xs @ bs"
     and [simp]: "subst_of xs = compose ys"
     and *: "UNIF ys (mset (us @ E)) {#}" by auto
   then have "UNIF (Var # ys) (mset ((Fun f ss, Fun g ts) # E)) {#}"
     by (force intro: UNIF1.decomp simp: ac_simps)
   moreover have "cs = xs @ bs" by fact
   moreover have "subst_of xs = compose (Var # ys)" by simp
   ultimately show ?case by blast
 next
   case (3 x t E bs)
   show ?case
   proof (cases "t = Var x")
     assume "t = Var x"
     then show ?case
       using 3 by auto (metis UNIF.step compose_simps(2) UNIF1.trivial)
   next
     assume "t \<noteq> Var x"
     with 3 obtain xs ys
       where [simp]: "cs = (ys @ [(x, t)]) @ bs"
       and [simp]: "subst_of ys = compose xs"
       and "x \<notin> vars_term t"
       and "UNIF xs (mset (subst_list (subst x t) E)) {#}"
         by (cases "x \<in> vars_term t") force+
     then have "UNIF (subst x t # xs) (mset ((Var x, t) # E)) {#}"
       by (force intro: UNIF1.Var_left simp: ac_simps)
     moreover have "cs = (ys @ [(x, t)]) @ bs" by simp
     moreover have "subst_of (ys @ [(x, t)]) = compose (subst x t # xs)" by simp
     ultimately show ?case by blast
   qed
 next
   case (4 f ss x E bs)
   with 4 obtain xs ys
     where [simp]: "cs = (ys @ [(x, Fun f ss)]) @ bs"
     and [simp]: "subst_of ys = compose xs"
     and "x \<notin> vars_term (Fun f ss)"
     and "UNIF xs (mset (subst_list (subst x (Fun f ss)) E)) {#}"
       by (cases "x \<in> vars_term (Fun f ss)") force+
   then have "UNIF (subst x (Fun f ss) # xs) (mset ((Fun f ss, Var x) # E)) {#}"
     by (force intro: UNIF1.Var_right simp: ac_simps)
   moreover have "cs = (ys @ [(x, Fun f ss)]) @ bs" by simp
   moreover have "subst_of (ys @ [(x, Fun f ss)]) = compose (subst x (Fun f ss) # xs)" by simp
   ultimately show ?case by blast
 qed force
 
 lemma unify_sound:
   assumes "unify E [] = Some cs"
   shows "is_imgu (subst_of cs) (set E)"
 proof -
   from unify_Some_UNIF [OF assms] obtain ss
     where "subst_of cs = compose ss"
     and "UNIF ss (mset E) {#}" by auto
   with UNIF_empty_imp_is_mgu_compose [OF this(2)]
     and UNIF_idemp [OF this(2)]
     show ?thesis
       by (auto simp add: is_imgu_def is_mgu_def)
          (metis subst_compose_assoc)
 qed
 
 text \<open>If \<open>unify\<close> gives up, then the given set of equations
   cannot be reduced to the empty set by \<open>UNIF\<close>.\<close>
 lemma unify_None:
   assumes "unify E ss = None"
   shows "\<exists>E'. E' \<noteq> {#} \<and> (mset E, E') \<in> unif\<^sup>!"
 using assms
 proof (induction E ss rule: unify.induct)
   case (1 bs)
   then show ?case by simp
 next
   case (2 f ss g ts E bs)
   moreover
   { assume *: "decompose (Fun f ss) (Fun g ts) = None"
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Fun f ss, Fun g ts)#}"] obtain \<sigma>
         where "(mset E + {#(Fun f ss, Fun g ts)#}, {#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover have "{#(Fun f ss \<cdot> \<sigma>, Fun g ts \<cdot> \<sigma>)#} \<in> NF unif"
         using decompose_None [OF *]
         by (auto simp: single_is_union NF_def unif_def elim!: UNIF1.cases)
            (metis length_map)
       ultimately show ?thesis
         by auto (metis normalizability_I add_mset_not_empty)
     next
       case False
       moreover have "\<not> unifiable {(Fun f ss, Fun g ts)}"
         using * by (auto simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Fun f ss, Fun g ts) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   moreover
   { fix us
     assume *: "decompose (Fun f ss) (Fun g ts) = Some us"
       and "unify (us @ E) bs = None"
     from "2.IH" [OF this] obtain E'
       where "E' \<noteq> {#}" and "(mset (us @ E), E') \<in> unif\<^sup>!" by blast
     moreover have "(mset ((Fun f ss, Fun g ts) # E), mset (us @ E)) \<in> unif"
     proof -
       have "g = f" and "length ss = length ts" and "us = zip ss ts"
         using * by auto
       then show ?thesis
         by (auto intro: UNIF1.decomp simp: unif_def ac_simps)
     qed
     ultimately have ?case by auto }
   ultimately show ?case by (auto split: option.splits)
 next
   case (3 x t E bs)
   { assume [simp]: "t = Var x"
     obtain E' where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset E) \<in> unif"
       by (auto intro: UNIF1.trivial simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 3 by auto
     moreover have "(mset ((Var x, t) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_left simp: unif_def)
     ultimately have ?case by auto }
   moreover
   { assume *: "t \<noteq> Var x" "x \<in> vars_term t"
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(Var x, t)#}"] obtain \<sigma>
         where "(mset E + {#(Var x, t)#}, {#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis set_mset_single)
       ultimately show ?thesis by auto
     next
       case False
       moreover have "\<not> unifiable {(Var x, t)}"
         using * by (force simp: unifiable_def)
       ultimately have "\<not> unifiable (set ((Var x, t) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis
         by (simp add: not_unifiable_imp_not_empty_NF)
     qed }
   ultimately show ?case by blast
 next
   case (4 f ss x E bs)
   define t where "t = Fun f ss"
   { assume *: "x \<notin> vars_term t"
     then obtain E' where "E' \<noteq> {#}"
       and "(mset (subst_list (subst x t) E), E') \<in> unif\<^sup>!" using 4 by (auto simp: t_def)
     moreover have "(mset ((t, Var x) # E), mset (subst_list (subst x t) E)) \<in> unif"
       using * by (auto intro: UNIF1.Var_right simp: unif_def)
     ultimately have ?case by (auto simp: t_def) }
   moreover
   { assume "x \<in> vars_term t"
     then have *: "x \<in> vars_term t" "t \<noteq> Var x" by (auto simp: t_def)
     then have "x \<in> vars_term t" "is_Fun t" by auto
     then have "\<not> unifiable {(Var x, t)}" by (rule in_vars_is_Fun_not_unifiable)
     then have **: "\<not> unifiable {(Var x \<cdot> \<sigma>, t \<cdot> \<sigma>)}" for \<sigma> :: "('b, 'a) subst"
       using subst_set_reflects_unifiable [of \<sigma> "{(Var x, t)}"] by (auto simp: subst_set_def)
     have ?case
     proof (cases "unifiable (set E)")
       case True
       then have "(mset E, {#}) \<in> unif\<^sup>*"
         by (simp add: unifiable_imp_empty)
       from unif_rtrancl_mono [OF this, of "{#(t, Var x)#}"] obtain \<sigma>
         where "(mset E + {#(t, Var x)#}, {#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}) \<in> unif\<^sup>*"
         by (auto simp: subst_mset_def)
       moreover obtain E' where "E' \<noteq> {#}"
         and "({#(t \<cdot> \<sigma>, Var x \<cdot> \<sigma>)#}, E') \<in> unif\<^sup>!"
         using not_unifiable_imp_not_empty_NF and **
           by (metis unifiable_insert_swap set_mset_single)
       ultimately show ?thesis by (auto simp: t_def)
     next
       case False
       moreover have "\<not> unifiable {(t, Var x)}"
         using * by (simp add: unifiable_def)
       ultimately have "\<not> unifiable (set ((t, Var x) # E))" by (auto simp: unifiable_def unifiers_def)
       then show ?thesis by (simp add: not_unifiable_imp_not_empty_NF t_def)
     qed }
   ultimately show ?case by blast
 qed
 
 lemma unify_complete:
   assumes "unify E bs = None"
   shows "unifiers (set E) = {}"
 proof -
   from unify_None [OF assms] obtain E'
     where "E' \<noteq> {#}" and "(mset E, E') \<in> unif\<^sup>!" by blast
   then have "\<not> unifiable (set E)"
     using irreducible_reachable_imp_not_unifiable by force
   then show ?thesis
     by (auto simp: unifiable_def)
 qed
 
 lemma mgu_complete:
   "mgu s t = None \<Longrightarrow> unifiers {(s, t)} = {}"
 proof -
   assume "mgu s t = None"
-  then have "unify [(s, t)] [] = None" by (cases "unify [(s, t)] []", auto)
+  then have "unify [(s, t)] [] = None" by (cases "unify [(s, t)] []", auto simp: mgu_def)
   then have "unifiers (set [(s, t)]) = {}" by (rule unify_complete)
   then show ?thesis by simp
 qed
 
 lemma finite_subst_domain_subst_of:
   "finite (subst_domain (subst_of xs))"
 proof (induct xs)
   case (Cons x xs)
   moreover have "finite (subst_domain (subst (fst x) (snd x)))" by (metis finite_subst_domain_subst)
   ultimately show ?case
     using subst_domain_compose [of "subst_of xs" "subst (fst x) (snd x)"]
     by (simp del: subst_subst_domain) (metis finite_subset infinite_Un)
 qed simp
 
 lemma unify_subst_domain: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_subst_domain:
   assumes "mgu s t = Some \<sigma>"
   shows "subst_domain \<sigma> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<sigma> = subst_of xs"
-    using assms by (simp split: option.splits)
+    using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain by fastforce
 qed
 
 lemma mgu_finite_subst_domain:
   "mgu s t = Some \<sigma> \<Longrightarrow> finite (subst_domain \<sigma>)"
   by (drule mgu_subst_domain) (simp add: finite_subset)
 
 lemma unify_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "range_vars (subst_of xs) \<subseteq> (\<Union>e \<in> set E. vars_term (fst e) \<union> vars_term (snd e))"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_range_vars_subset
     by (metis (mono_tags, lifting) multiset.set_map set_mset_mset vars_mset_def)
 qed
 
 lemma mgu_range_vars: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "range_vars \<mu> \<subseteq> vars_term s \<union> vars_term t"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
-    using assms by (simp split: option.splits)
+    using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_range_vars by fastforce
 qed
 
 lemma unify_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes unif: "unify E [] = Some xs"
   shows "subst_domain (subst_of xs) \<inter> range_vars (subst_of xs) = {}"
 proof -
   from unify_Some_UNIF[OF unif] obtain xs' where
     "subst_of xs = compose xs'" and "UNIF xs' (mset E) {#}"
     by auto
   thus ?thesis
     using UNIF_subst_domain_range_vars_Int by metis
 qed
 
 lemma mgu_subst_domain_range_vars_disjoint: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes "mgu s t = Some \<mu>"
   shows "subst_domain \<mu> \<inter> range_vars \<mu> = {}"
 proof -
   obtain xs where "unify [(s, t)] [] = Some xs" and "\<mu> = subst_of xs"
-    using assms by (simp split: option.splits)
+    using assms by (simp add: mgu_def split: option.splits)
   thus ?thesis
     using unify_subst_domain_range_vars_disjoint by metis
 qed
 
 lemma mgu_sound:
   assumes "mgu s t = Some \<sigma>"
   shows "is_imgu \<sigma> {(s, t)}"
 proof -
   obtain ss where "unify [(s, t)] [] = Some ss"
     and "\<sigma> = subst_of ss"
-    using assms by (auto split: option.splits)
+    using assms by (auto simp: mgu_def split: option.splits)
   then have "is_imgu \<sigma> (set [(s, t)])" by (metis unify_sound)
   then show ?thesis by simp
 qed
 
 corollary subst_apply_term_eq_subst_apply_term_if_mgu: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   assumes mgu_t_u: "mgu t u = Some \<mu>"
   shows "t \<cdot> \<mu> = u \<cdot> \<mu>"
   using mgu_sound[OF mgu_t_u]
   by (simp add: is_imgu_def unifiers_def)
 
 lemma mgu_same: "mgu t t = Some Var" \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
-  by (simp add: unify_same)
+  by (simp add: mgu_def unify_same)
 
 lemma ex_mgu_if_subst_apply_term_eq_subst_apply_term: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes t u :: "('f, 'v) Term.term" and \<sigma> :: "('f, 'v) subst"
   assumes t_eq_u: "t \<cdot> \<sigma> = u \<cdot> \<sigma>"
   shows "\<exists>\<mu> :: ('f, 'v) subst. Unification.mgu t u = Some \<mu>"
 proof -
   from t_eq_u have "unifiers {(t, u)} \<noteq> {}"
     unfolding unifiers_def by auto
   then obtain xs where unify: "unify [(t, u)] [] = Some xs"
     using unify_complete
     by (metis list.set(1) list.set(2) not_Some_eq)
 
   show ?thesis
   proof (rule exI)
     show "Unification.mgu t u = Some (subst_of xs)"
-      using unify by simp
+      using unify by (simp add: mgu_def)
   qed
 qed
 
 lemma mgu_is_Var_if_not_in_equations: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations" and x :: 'v
   assumes
     mgu_\<mu>: "is_mgu \<mu> E" and
     x_not_in: "x \<notin> (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))"
   shows "is_Var (\<mu> x)"
 proof -
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   with x_not_in have "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x"
     by (simp add: \<tau>_def)
   thus "is_Var (\<mu> x)"
     by (metis subst_apply_eq_Var subst_compose term.disc(1))
 qed
 
 corollary mgu_ball_is_Var: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   "is_mgu \<mu> E \<Longrightarrow> \<forall>x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e)). is_Var (\<mu> x)"
   by (rule ballI) (rule mgu_is_Var_if_not_in_equations[folded Compl_iff])
 
 lemma mgu_inj_on: \<^marker>\<open>contributor \<open>Martin Desharnais\<close>\<close>
   fixes \<mu> :: "('f, 'v) subst" and E :: "('f, 'v) equations"
   assumes mgu_\<mu>: "is_mgu \<mu> E"
   shows "inj_on \<mu> (- (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)))"
 proof (rule inj_onI)
   fix x y
   assume
     x_in: "x \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     y_in: "y \<in> - (\<Union>e\<in>E. vars_term (fst e) \<union> vars_term (snd e))" and
     "\<mu> x = \<mu> y"
 
   from mgu_\<mu> have unif_\<mu>: "\<mu> \<in> unifiers E" and minimal_\<mu>: "\<forall>\<tau> \<in> unifiers E. \<exists>\<gamma>. \<tau> = \<mu> \<circ>\<^sub>s \<gamma>"
     by (simp_all add: is_mgu_def)
 
   define \<tau> :: "('f, 'v) subst" where
     "\<tau> = (\<lambda>x. if x \<in> (\<Union>e \<in> E. vars_term (fst e) \<union> vars_term (snd e)) then \<mu> x else Var x)"
 
   have \<open>\<tau> \<in> unifiers E\<close>
     unfolding unifiers_def mem_Collect_eq
   proof (rule ballI)
     fix e assume "e \<in> E"
     with unif_\<mu> have "fst e \<cdot> \<mu> = snd e \<cdot> \<mu>"
       by blast
     moreover from \<open>e \<in> E\<close> have "fst e \<cdot> \<tau> = fst e \<cdot> \<mu>" and "snd e \<cdot> \<tau> = snd e \<cdot> \<mu>"
       unfolding term_subst_eq_conv
       by (auto simp: \<tau>_def)
     ultimately show "fst e \<cdot> \<tau> = snd e \<cdot> \<tau>"
       by simp
   qed
   with minimal_\<mu> obtain \<gamma> where "\<mu> \<circ>\<^sub>s \<gamma> = \<tau>"
     by auto
   hence "(\<mu> \<circ>\<^sub>s \<gamma>) x = Var x" and "(\<mu> \<circ>\<^sub>s \<gamma>) y = Var y"
     using ComplD[OF x_in] ComplD[OF y_in]
     by (simp_all add: \<tau>_def)
   with \<open>\<mu> x = \<mu> y\<close> show "x = y"
     by (simp add: subst_compose_def)
 qed
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Intruder_Deduction.thy
@@ -1,1193 +1,1193 @@
 (*  Title:      Intruder_Deduction.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>Dolev-Yao Intruder Model\<close>
 theory Intruder_Deduction
 imports Messages More_Unification
 begin
 
 subsection \<open>Syntax for the Intruder Deduction Relations\<close>
 consts INTRUDER_SYNTH::"('f,'v) terms \<Rightarrow> ('f,'v) term \<Rightarrow> bool" (infix "\<turnstile>\<^sub>c" 50)
 consts INTRUDER_DEDUCT::"('f,'v) terms \<Rightarrow> ('f,'v) term \<Rightarrow> bool" (infix "\<turnstile>" 50)
 
 
 subsection \<open>Intruder Model Locale\<close>
 text \<open>
   The intruder model is parameterized over arbitrary function symbols (e.g, cryptographic operators)
   and variables. It requires three functions:
   - \<open>arity\<close> that assigns an arity to each function symbol.
   - \<open>public\<close> that partitions the function symbols into those that will be available to the intruder
     and those that will not.
   - \<open>Ana\<close>, the analysis interface, that defines how messages can be decomposed (e.g., decryption).
 \<close>
 locale intruder_model =
   fixes arity :: "'fun \<Rightarrow> nat"
     and public :: "'fun \<Rightarrow> bool"
     and Ana :: "('fun,'var) term \<Rightarrow> (('fun,'var) term list \<times> ('fun,'var) term list)"
   assumes Ana_keys_fv: "\<And>t K R. Ana t = (K,R) \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t"
     and Ana_keys_wf: "\<And>t k K R f T.
       Ana t = (K,R) \<Longrightarrow> (\<And>g S. Fun g S \<sqsubseteq> t \<Longrightarrow> length S = arity g)
                     \<Longrightarrow> k \<in> set K \<Longrightarrow> Fun f T \<sqsubseteq> k \<Longrightarrow> length T = arity f"
     and Ana_var[simp]: "\<And>x. Ana (Var x) = ([],[])"
     and Ana_fun_subterm: "\<And>f T K R. Ana (Fun f T) = (K,R) \<Longrightarrow> set R \<subseteq> set T"
     and Ana_subst: "\<And>t \<delta> K R. \<lbrakk>Ana t = (K,R); K \<noteq> [] \<or> R \<noteq> []\<rbrakk> \<Longrightarrow> Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
 begin
 
 lemma Ana_subterm: assumes "Ana t = (K,T)" shows "set T \<subset> subterms t"
 using assms
 by (cases t)
    (simp add: psubsetI,
     metis Ana_fun_subterm Fun_gt_params UN_I term.order_refl
           params_subterms psubsetI subset_antisym subset_trans)
 
 lemma Ana_subterm': "s \<in> set (snd (Ana t)) \<Longrightarrow> s \<sqsubseteq> t"
 using Ana_subterm by (cases "Ana t") auto
 
 lemma Ana_vars: assumes "Ana t = (K,M)" shows "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \<subseteq> fv t"
 by (rule Ana_keys_fv[OF assms]) (use Ana_subterm[OF assms] subtermeq_vars_subset in auto)
 
 abbreviation \<V> where "\<V> \<equiv> UNIV::'var set"
 abbreviation \<Sigma>n ("\<Sigma>\<^sup>_") where "\<Sigma>\<^sup>n \<equiv> {f::'fun. arity f = n}"
 abbreviation \<Sigma>npub ("\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>_") where "\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n \<equiv> {f. public f} \<inter> \<Sigma>\<^sup>n"
 abbreviation \<Sigma>npriv ("\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>_") where "\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n \<equiv> {f. \<not>public f} \<inter> \<Sigma>\<^sup>n"
 abbreviation \<Sigma>\<^sub>p\<^sub>u\<^sub>b where "\<Sigma>\<^sub>p\<^sub>u\<^sub>b \<equiv> (\<Union>n. \<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n)"
 abbreviation \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> (\<Union>n. \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n)"
 abbreviation \<Sigma> where "\<Sigma> \<equiv> (\<Union>n. \<Sigma>\<^sup>n)"
 abbreviation \<C> where "\<C> \<equiv> \<Sigma>\<^sup>0"
 abbreviation \<C>\<^sub>p\<^sub>u\<^sub>b where "\<C>\<^sub>p\<^sub>u\<^sub>b \<equiv> {f. public f} \<inter> \<C>"
 abbreviation \<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> {f. \<not>public f} \<inter> \<C>"
 abbreviation \<Sigma>\<^sub>f where "\<Sigma>\<^sub>f \<equiv> \<Sigma> - \<C>"
 abbreviation \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b where "\<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<equiv> \<Sigma>\<^sub>f \<inter> \<Sigma>\<^sub>p\<^sub>u\<^sub>b"
 abbreviation \<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v where "\<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<equiv> \<Sigma>\<^sub>f \<inter> \<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v"
 
 lemma disjoint_fun_syms: "\<Sigma>\<^sub>f \<inter> \<C> = {}" by auto
 lemma id_union_univ: "\<Sigma>\<^sub>f \<union> \<C> = UNIV" "\<Sigma> = UNIV" by auto
 lemma const_arity_eq_zero[dest]: "c \<in> \<C> \<Longrightarrow> arity c = 0" by simp
 lemma const_pub_arity_eq_zero[dest]: "c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> arity c = 0 \<and> public c" by simp
 lemma const_priv_arity_eq_zero[dest]: "c \<in> \<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v \<Longrightarrow> arity c = 0 \<and> \<not>public c" by simp
 lemma fun_arity_gt_zero[dest]: "f \<in> \<Sigma>\<^sub>f \<Longrightarrow> arity f > 0" by fastforce
 lemma pub_fun_public[dest]: "f \<in> \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> public f" by fastforce
 lemma pub_fun_arity_gt_zero[dest]: "f \<in> \<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b \<Longrightarrow> arity f > 0" by fastforce
 
 lemma \<Sigma>\<^sub>f_unfold: "\<Sigma>\<^sub>f = {f::'fun. arity f > 0}" by auto
 lemma \<C>_unfold: "\<C> = {f::'fun. arity f = 0}" by auto
 lemma \<C>pub_unfold: "\<C>\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f = 0 \<and> public f}" by auto
 lemma \<C>priv_unfold: "\<C>\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f = 0 \<and> \<not>public f}" by auto
 lemma \<Sigma>npub_unfold: "(\<Sigma>\<^sub>p\<^sub>u\<^sub>b\<^sup>n) = {f::'fun. arity f = n \<and> public f}" by auto
 lemma \<Sigma>npriv_unfold: "(\<Sigma>\<^sub>p\<^sub>r\<^sub>i\<^sub>v\<^sup>n) = {f::'fun. arity f = n \<and> \<not>public f}" by auto
 lemma \<Sigma>fpub_unfold: "\<Sigma>\<^sub>f\<^sub>p\<^sub>u\<^sub>b = {f::'fun. arity f > 0 \<and> public f}" by auto
 lemma \<Sigma>fpriv_unfold: "\<Sigma>\<^sub>f\<^sub>p\<^sub>r\<^sub>i\<^sub>v = {f::'fun. arity f > 0 \<and> \<not>public f}" by auto
 lemma \<Sigma>n_m_eq: "\<lbrakk>(\<Sigma>\<^sup>n) \<noteq> {}; (\<Sigma>\<^sup>n) = (\<Sigma>\<^sup>m)\<rbrakk> \<Longrightarrow> n = m" by auto
 
 
 subsection \<open>Term Well-formedness\<close>
 definition "wf\<^sub>t\<^sub>r\<^sub>m t \<equiv> \<forall>f T. Fun f T \<sqsubseteq> t \<longrightarrow> length T = arity f"
 
 abbreviation "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T \<equiv> \<forall>t \<in> T. wf\<^sub>t\<^sub>r\<^sub>m t"
 
 lemma Ana_keys_wf': "Ana t = (K,T) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> k \<in> set K \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m k"
 using Ana_keys_wf unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by metis
 
 lemma wf_trm_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
 
 lemma wf_trm_subst_range_Var[simp]: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" by simp
 
 lemma wf_trm_subst_range_iff: "(\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)) \<longleftrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
 by force
 
 lemma wf_trm_subst_rangeD: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)"
 by (metis wf_trm_subst_range_iff)
 
 lemma wf_trm_subst_rangeI[intro]:
   "(\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 by (metis wf_trm_subst_range_iff)
 
 lemma wf_trmI[intro]:
   assumes "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t" "length T = arity f"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
 using assms unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 
 lemma wf_trm_subterm: "\<lbrakk>wf\<^sub>t\<^sub>r\<^sub>m t; s \<sqsubset> t\<rbrakk> \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m s"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto
 
 lemma wf_trm_subtermeq:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \<sqsubseteq> t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m s"
 proof (cases "s = t")
   case False thus "wf\<^sub>t\<^sub>r\<^sub>m s" using assms(2) wf_trm_subterm[OF assms(1)] by simp
 qed (metis assms(1))
 
 lemma wf_trm_param:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "t \<in> set T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t"
 by (meson assms subtermeqI'' wf_trm_subtermeq)
 
 lemma wf_trm_param_idx:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
     and "i < length T"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (T ! i)"
 using wf_trm_param[OF assms(1), of "T ! i"] assms(2)
 by fastforce
 
 lemma wf_trm_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
 proof
   show "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
   proof (induction t)
     case (Fun f T)
     hence "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
       by (meson wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans)
     hence "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" using Fun.IH by auto
     moreover have "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f"
       using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
     ultimately show ?case by fastforce
   qed (simp add: wf_trm_subst_rangeD[OF assms])
 
   show "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
   proof (induction t)
     case (Fun f T)
     hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set (map (\<lambda>s. s \<cdot> \<delta>) T)" for t
       by (metis that wf\<^sub>t\<^sub>r\<^sub>m_def Fun_param_is_subterm term.order_trans subst_apply_term.simps(2)) 
     hence "wf\<^sub>t\<^sub>r\<^sub>m t" when "t \<in> set T" for t using that Fun.IH by auto
     moreover have "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f"
       using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
     ultimately show ?case by fastforce
   qed (simp add: assms)
 qed
 
 lemma wf_trm_subst_singleton:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" shows "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> Var(v := t'))"
 proof -
   have "wf\<^sub>t\<^sub>r\<^sub>m ((Var(v := t')) w)" for w using assms(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by simp
   thus ?thesis using assms(1) wf_trm_subst[of "Var(v := t')" t, OF wf_trm_subst_rangeI] by simp
 qed
 
 lemma wf_trm_subst_rm_vars:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> rm_vars X \<delta>)"
 using assms
 proof (induction t)
   case (Fun f T)
   have "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" when "t \<in> set T" for t
     using that wf_trm_param[of f "map (\<lambda>t. t \<cdot> \<delta>) T"] Fun.prems
     by auto
   hence "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> rm_vars X \<delta>)" when "t \<in> set T" for t using that Fun.IH by simp
   moreover have "length T = arity f" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   ultimately show ?case unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 qed simp
 
 lemma wf_trm_subst_rm_vars': "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> v) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (rm_vars X \<delta> v)"
 by auto
 
 lemma wf_trms_subst:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by (metis (no_types, lifting) assms imageE wf_trm_subst)
 
 lemma wf_trms_subst_rm_vars:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t rm_vars X \<delta>)"
 using assms wf_trm_subst_rm_vars by blast
 
 lemma wf_trms_subst_rm_vars':
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (rm_vars X \<delta>))"
 using assms by force  
 
 lemma wf_trms_subst_compose:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
 using assms subst_img_comp_subset' wf_trm_subst by blast 
 
 lemma wf_trm_subst_compose:
   fixes \<delta>::"('fun, 'v) subst"
   assumes "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)" "\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m ((\<theta> \<circ>\<^sub>s \<delta>) x)"
 using wf_trm_subst[of \<delta> "\<theta> x", OF wf_trm_subst_rangeI[OF assms(2)]] assms(1)
       subst_subst_compose[of "Var x" \<theta> \<delta>]
       subst_apply_term.simps(1)[of x \<theta>]
       subst_apply_term.simps(1)[of x "\<theta> \<circ>\<^sub>s \<delta>"]
 by argo
 
 lemma wf_trms_Var_range:
   assumes "subst_range \<delta> \<subseteq> range Var"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 using assms by fastforce
 
 lemma wf_trms_subst_compose_Var_range:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     and "subst_range \<delta> \<subseteq> range Var"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<delta> \<circ>\<^sub>s \<theta>))"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
 using assms wf_trms_subst_compose wf_trms_Var_range by metis+
 
 lemma wf_trm_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (induct t) auto
 
 lemma wf_trms_subst_inv: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
 using wf_trm_subst_inv by fast
 
 lemma wf_trm_subterms: "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms t)"
 using wf_trm_subterm by blast
 
 lemma wf_trms_subterms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subterms\<^sub>s\<^sub>e\<^sub>t M)"
 using wf_trm_subterms by blast
 
 lemma wf_trm_arity: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T) \<Longrightarrow> length T = arity f"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast
 
 lemma wf_trm_subterm_arity: "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> Fun f T \<sqsubseteq> t \<Longrightarrow> length T = arity f"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by blast
 
 lemma unify_list_wf_trm:
   assumes "Unification.unify E B = Some U" "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
   and "\<forall>(v,t) \<in> set B. wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "\<forall>(v,t) \<in> set U. wf\<^sub>t\<^sub>r\<^sub>m t"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case (1 B U) thus ?case by auto
 next
   case (2 f T g S E B U)
   have wf_fun: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" using "2.prems"(2) by auto
   from "2.prems"(1) obtain E' where *: "decompose (Fun f T) (Fun g S) = Some E'"
     and [simp]: "f = g" "length T = length S" "E' = zip T S"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   hence "t \<sqsubset> Fun f T" "t' \<sqsubset> Fun g S" when "(t,t') \<in> set E'" for t t'
     using that by (metis zip_arg_subterm(1), metis zip_arg_subterm(2))
   hence "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" when "(t,t') \<in> set E'" for t t'
     using wf_trm_subterm wf_fun \<open>f = g\<close> that by blast+
   thus ?case using "2.IH"[OF * ** _ "2.prems"(3)] "2.prems"(2) by fastforce
 next
   case (3 v t E B)
   hence *: "\<forall>(w,x) \<in> set ((v, t) # B). wf\<^sub>t\<^sub>r\<^sub>m x"
       and **: "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t"
     by auto
 
   show ?case
   proof (cases "t = Var v")
     case True thus ?thesis using "3.prems" "3.IH"(1) by auto
   next
     case False
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using \<open>t \<noteq> Var v\<close> "3.prems"(1) by auto
     moreover have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
       using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>] "3.prems"(2)
       unfolding subst_list_def subst_def by auto
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> _ _ *] by metis
   qed
 next
   case (4 f T v E B U)
   hence *: "\<forall>(w,x) \<in> set ((v, Fun f T) # B). wf\<^sub>t\<^sub>r\<^sub>m x"
       and **: "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
     by auto
 
   have "v \<notin> fv (Fun f T)" using "4.prems"(1) by force
   hence "Unification.unify (subst_list (subst v (Fun f T)) E) ((v, Fun f T)#B) = Some U"
     using "4.prems"(1) by auto
   moreover have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f T)) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
     using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)\<close>] "4.prems"(2)
     unfolding subst_list_def subst_def by auto
   ultimately show ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f T)\<close> _ _ *] by metis
 qed
 
 lemma mgu_wf_trm:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> v)"
 proof -
   from assms obtain \<sigma>' where "subst_of \<sigma>' = \<sigma>" "\<forall>(v,t) \<in> set \<sigma>'. wf\<^sub>t\<^sub>r\<^sub>m t"
-    using unify_list_wf_trm[of "[(s,t)]" "[]"] by (auto split: option.splits)
+    using unify_list_wf_trm[of "[(s,t)]" "[]"] by (auto simp: mgu_def split: option.splits)
   thus ?thesis
   proof (induction \<sigma>' arbitrary: \<sigma> v rule: List.rev_induct)
     case (snoc x \<sigma>' \<sigma> v)
     define \<theta> where "\<theta> = subst_of \<sigma>'"
     hence "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> v)" for v using snoc.prems(2) snoc.IH[of \<theta>] by fastforce 
     moreover obtain w t where x: "x = (w,t)" by (metis surj_pair) 
     hence \<sigma>: "\<sigma> = Var(w := t) \<circ>\<^sub>s \<theta>" using snoc.prems(1) by (simp add: subst_def \<theta>_def)
     moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" using snoc.prems(2) x by auto
     ultimately show ?case using wf_trm_subst[of _ t] unfolding subst_compose_def by auto
   qed (simp add: wf\<^sub>t\<^sub>r\<^sub>m_def)
 qed
 
 lemma mgu_wf_trms:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 using mgu_wf_trm[OF assms] by simp
 
 subsection \<open>Definitions: Intruder Deduction Relations\<close>
 text \<open>
   A standard Dolev-Yao intruder.
 \<close>
 inductive intruder_deduct::"('fun,'var) terms \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
 where
   Axiom[simp]:   "t \<in> M \<Longrightarrow> intruder_deduct M t"
 | Compose[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> intruder_deduct M t\<rbrakk>
                   \<Longrightarrow> intruder_deduct M (Fun f T)"
 | Decompose:     "\<lbrakk>intruder_deduct M t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> intruder_deduct M k;
                    t\<^sub>i \<in> set T\<rbrakk>
                   \<Longrightarrow> intruder_deduct M t\<^sub>i"
 
 text \<open>
   A variant of the intruder relation which limits the intruder to composition only.
 \<close>
 inductive intruder_synth::"('fun,'var) terms \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
 where
   AxiomC[simp]:   "t \<in> M \<Longrightarrow> intruder_synth M t"
 | ComposeC[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> intruder_synth M t\<rbrakk>
                     \<Longrightarrow> intruder_synth M (Fun f T)"
 
 adhoc_overloading INTRUDER_DEDUCT intruder_deduct
 adhoc_overloading INTRUDER_SYNTH intruder_synth
 
 lemma intruder_deduct_induct[consumes 1, case_names Axiom Compose Decompose]:
   assumes "M \<turnstile> t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> M \<turnstile> t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M t\<rbrakk> \<Longrightarrow> P M (Fun f T)"
           "\<And>t K T t\<^sub>i. \<lbrakk>M \<turnstile> t; P M t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> M \<turnstile> k;
                        \<And>k. k \<in> set K \<Longrightarrow> P M k; t\<^sub>i \<in> set T\<rbrakk> \<Longrightarrow> P M t\<^sub>i"
   shows "P M t"
 using assms by (induct rule: intruder_deduct.induct) blast+
 
 lemma intruder_synth_induct[consumes 1, case_names AxiomC ComposeC]:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "\<And>t. t \<in> M \<Longrightarrow> P M t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> M \<turnstile>\<^sub>c t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M t\<rbrakk> \<Longrightarrow> P M (Fun f T)"
   shows "P M t"
 using assms by (induct rule: intruder_synth.induct) auto
 
 
 subsection \<open>Definitions: Analyzed Knowledge and Public Ground Well-formed Terms (PGWTs)\<close>
 definition analyzed::"('fun,'var) terms \<Rightarrow> bool" where
   "analyzed M \<equiv> \<forall>t. M \<turnstile> t \<longleftrightarrow> M \<turnstile>\<^sub>c t"
 
 definition analyzed_in where
   "analyzed_in t M \<equiv> \<forall>K R. (Ana t = (K,R) \<and> (\<forall>k \<in> set K. M \<turnstile>\<^sub>c k)) \<longrightarrow> (\<forall>r \<in> set R. M \<turnstile>\<^sub>c r)"
 
 definition decomp_closure::"('fun,'var) terms \<Rightarrow> ('fun,'var) terms \<Rightarrow> bool" where
   "decomp_closure M M' \<equiv> \<forall>t. M \<turnstile> t \<and> (\<exists>t' \<in> M. t \<sqsubseteq> t') \<longleftrightarrow> t \<in> M'"
 
 inductive public_ground_wf_term::"('fun,'var) term \<Rightarrow> bool" where
   PGWT[simp]: "\<lbrakk>public f; arity f = length T;
                 \<And>t. t \<in> set T \<Longrightarrow> public_ground_wf_term t\<rbrakk>
                   \<Longrightarrow> public_ground_wf_term (Fun f T)"
 
 abbreviation "public_ground_wf_terms \<equiv> {t. public_ground_wf_term t}"
 
 lemma public_const_deduct:
   assumes "c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b"
   shows "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
 proof -
   have "arity c = 0" "public c" using const_arity_eq_zero \<open>c \<in> \<C>\<^sub>p\<^sub>u\<^sub>b\<close> by auto
   thus "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
     using intruder_synth.ComposeC[OF _ \<open>public c\<close>, of "[]"]
           intruder_deduct.Compose[OF _ \<open>public c\<close>, of "[]"]
     by auto
 qed
 
 lemma public_const_deduct'[simp]:
   assumes "arity c = 0" "public c"
   shows "M \<turnstile> Fun c []" "M \<turnstile>\<^sub>c Fun c []"
 using intruder_deduct.Compose[of "[]" c] intruder_synth.ComposeC[of "[]" c] assms by simp_all
 
 lemma private_fun_deduct_in_ik:
   assumes t: "M \<turnstile> t" "Fun f T \<in> subterms t"
     and f: "\<not>public f"
   shows "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
 using t
 proof (induction t rule: intruder_deduct.induct)
   case Decompose thus ?case by (meson Ana_subterm psubsetD term.order_trans)
 qed (auto simp add: f in_subterms_Union)
 
 lemma private_fun_deduct_in_ik':
   assumes t: "M \<turnstile> Fun f T"
     and f: "\<not>public f"
   shows "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
 by (rule private_fun_deduct_in_ik[OF t term.order_refl f])
 
 lemma pgwt_public: "\<lbrakk>public_ground_wf_term t; Fun f T \<sqsubseteq> t\<rbrakk> \<Longrightarrow> public f"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_ground: "public_ground_wf_term t \<Longrightarrow> fv t = {}"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_fun: "public_ground_wf_term t \<Longrightarrow> \<exists>f T. t = Fun f T"
 using pgwt_ground[of t] by (cases t) auto
 
 lemma pgwt_arity: "\<lbrakk>public_ground_wf_term t; Fun f T \<sqsubseteq> t\<rbrakk> \<Longrightarrow> arity f = length T"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_wellformed: "public_ground_wf_term t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m t"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_deducible: "public_ground_wf_term t \<Longrightarrow> M \<turnstile>\<^sub>c t"
 by (induct t rule: public_ground_wf_term.induct) auto
 
 lemma pgwt_is_empty_synth: "public_ground_wf_term t \<longleftrightarrow> {} \<turnstile>\<^sub>c t"
 proof -
   { fix M::"('fun,'var) term set" assume "M \<turnstile>\<^sub>c t" "M = {}" hence "public_ground_wf_term t"
       by (induct t rule: intruder_synth.induct) auto
   }
   thus ?thesis using pgwt_deducible by auto
 qed
 
 lemma ideduct_synth_subst_apply:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "{} \<turnstile>\<^sub>c t" "\<And>v. M \<turnstile>\<^sub>c \<theta> v"
   shows "M \<turnstile>\<^sub>c t \<cdot> \<theta>"
 proof -
   { fix M'::"('fun,'var) term set" assume "M' \<turnstile>\<^sub>c t" "M' = {}" hence "M \<turnstile>\<^sub>c t \<cdot> \<theta>"
     proof (induction t rule: intruder_synth.induct)
       case (ComposeC T f M')
       hence "length (map (\<lambda>t. t \<cdot> \<theta>) T) = arity f" "\<And>x. x \<in> set (map (\<lambda>t. t \<cdot> \<theta>) T) \<Longrightarrow> M \<turnstile>\<^sub>c x"
         by auto
       thus ?case using intruder_synth.ComposeC[of "map (\<lambda>t. t \<cdot> \<theta>) T" f M] \<open>public f\<close> by fastforce
     qed simp
   }
   thus ?thesis using assms by metis
 qed
   
 
 subsection \<open>Lemmata: Monotonicity, Deduction of Private Constants, etc.\<close>
 context
 begin
 lemma ideduct_mono:
   "\<lbrakk>M \<turnstile> t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> M' \<turnstile> t"
 proof (induction rule: intruder_deduct.induct)
   case (Decompose M t K T t\<^sub>i)
   have "\<forall>k. k \<in> set K \<longrightarrow> M' \<turnstile> k" using Decompose.IH \<open>M \<subseteq> M'\<close> by simp
   moreover have "M' \<turnstile> t" using Decompose.IH \<open>M \<subseteq> M'\<close> by simp
   ultimately show ?case using Decompose.hyps intruder_deduct.Decompose by blast
 qed auto
 
 lemma ideduct_synth_mono:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   shows "\<lbrakk>M \<turnstile>\<^sub>c t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> M' \<turnstile>\<^sub>c t"
 by (induct rule: intruder_synth.induct) auto
 
 context
 begin
 
 \<comment> \<open>Used by \<open>inductive_set\<close>\<close>
 private lemma ideduct_mono_set[mono_set]:
   "M \<subseteq> N \<Longrightarrow> M \<turnstile> t \<longrightarrow> N \<turnstile> t"
   "M \<subseteq> N \<Longrightarrow> M \<turnstile>\<^sub>c t \<longrightarrow> N \<turnstile>\<^sub>c t"
 using ideduct_mono ideduct_synth_mono by (blast, blast)
 
 end
 
 lemma ideduct_reduce:
   "\<lbrakk>M \<union> M' \<turnstile> t; \<And>t'. t' \<in> M' \<Longrightarrow> M \<turnstile> t'\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 proof (induction rule: intruder_deduct_induct)
   case Decompose thus ?case using intruder_deduct.Decompose by blast 
 qed auto
 
 lemma ideduct_synth_reduce:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   shows "\<lbrakk>M \<union> M' \<turnstile>\<^sub>c t; \<And>t'. t' \<in> M' \<Longrightarrow> M \<turnstile>\<^sub>c t'\<rbrakk> \<Longrightarrow> M \<turnstile>\<^sub>c t"
 by (induct rule: intruder_synth_induct) auto
 
 lemma ideduct_mono_eq:
   assumes "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile> t" shows "M \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<turnstile> t"
 proof
   show "M \<union> N \<turnstile> t \<Longrightarrow> M' \<union> N \<turnstile> t"
   proof (induction t rule: intruder_deduct_induct)
     case (Axiom t) thus ?case
     proof (cases "t \<in> M")
       case True
       hence "M \<turnstile> t" using intruder_deduct.Axiom by metis
       thus ?thesis using assms ideduct_mono[of M' t "M' \<union> N"] by simp
     qed auto
   next
     case (Compose T f) thus ?case using intruder_deduct.Compose by auto
   next
     case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M' \<union> N" t K T] by auto
   qed
 
   show "M' \<union> N \<turnstile> t \<Longrightarrow> M \<union> N \<turnstile> t"
   proof (induction t rule: intruder_deduct_induct)
     case (Axiom t) thus ?case
     proof (cases "t \<in> M'")
       case True
       hence "M' \<turnstile> t" using intruder_deduct.Axiom by metis
       thus ?thesis using assms ideduct_mono[of M t "M \<union> N"] by simp
     qed auto
   next
     case (Compose T f) thus ?case using intruder_deduct.Compose by auto
   next
     case (Decompose t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose[of "M \<union> N" t K T] by auto
   qed
 qed
 
 lemma deduct_synth_subterm:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "s \<in> subterms t" "\<forall>m \<in> M. \<forall>s \<in> subterms m. M \<turnstile>\<^sub>c s"
   shows "M \<turnstile>\<^sub>c s"
 using assms by (induct t rule: intruder_synth.induct) auto
 
 lemma deduct_if_synth[intro, dest]: "M \<turnstile>\<^sub>c t \<Longrightarrow> M \<turnstile> t"
 by (induct rule: intruder_synth.induct) auto
 
 private lemma ideduct_ik_eq: assumes "\<forall>t \<in> M. M' \<turnstile> t" shows "M' \<turnstile> t \<longleftrightarrow> M' \<union> M \<turnstile> t"
 by (meson assms ideduct_mono ideduct_reduce sup_ge1)
 
 private lemma synth_if_deduct_empty: "{} \<turnstile> t \<Longrightarrow> {} \<turnstile>\<^sub>c t"
 proof (induction t rule: intruder_deduct_induct)
   case (Decompose t K M m)
   then obtain f T where "t = Fun f T" "m \<in> set T"
     using Ana_fun_subterm Ana_var by (cases t) fastforce+
   with Decompose.IH(1) show ?case by (induction rule: intruder_synth_induct) auto
 qed auto
 
 private lemma ideduct_deduct_synth_mono_eq:
   assumes "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile>\<^sub>c t" "M \<subseteq> M'"
   and "\<forall>t. M' \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<union> D \<turnstile>\<^sub>c t"
   shows "M \<union> N \<turnstile> t \<longleftrightarrow> M' \<union> N \<union> D \<turnstile>\<^sub>c t"
 proof -
   have "\<forall>m \<in> M'. M \<turnstile> m" using assms(1) by auto
   hence "\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile> t" by (metis assms(1,2) deduct_if_synth ideduct_reduce sup.absorb2)
   hence "\<forall>t. M' \<union> N \<turnstile> t \<longleftrightarrow> M \<union> N \<turnstile> t" by (meson ideduct_mono_eq)
   thus ?thesis by (meson assms(3))
 qed
 
 lemma ideduct_subst: "M \<turnstile> t \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> t \<cdot> \<delta>"
 proof (induction t rule: intruder_deduct_induct)
   case (Compose T f)
   hence "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f" "\<And>t. t \<in> set T \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> t \<cdot> \<delta>" by auto
   thus ?case using intruder_deduct.Compose[OF _ Compose.hyps(2), of "map (\<lambda>t. t \<cdot> \<delta>) T"] by auto
 next
   case (Decompose t K M' m')
   hence "Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
         "\<And>k. k \<in> set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile> k"
         "m' \<cdot> \<delta> \<in> set (M' \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
     using Ana_subst[OF Decompose.hyps(2)] by fastforce+
   thus ?case using intruder_deduct.Decompose[OF Decompose.IH(1)] by metis
 qed simp
 
 lemma ideduct_synth_subst:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term" and \<delta>::"('fun,'var) subst"
   shows "M \<turnstile>\<^sub>c t \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile>\<^sub>c t \<cdot> \<delta>"
 proof (induction t rule: intruder_synth_induct)
   case (ComposeC T f)
   hence "length (map (\<lambda>t. t \<cdot> \<delta>) T) = arity f" "\<And>t. t \<in> set T \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> \<turnstile>\<^sub>c t \<cdot> \<delta>" by auto
   thus ?case using intruder_synth.ComposeC[OF _ ComposeC.hyps(2), of "map (\<lambda>t. t \<cdot> \<delta>) T"] by auto
 qed simp
 
 lemma ideduct_vars:
   assumes "M \<turnstile> t"
   shows "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using assms 
 proof (induction t rule: intruder_deduct_induct)
   case (Decompose t K T t\<^sub>i) thus ?case
     using Ana_vars(2) fv_subset by blast 
 qed auto
 
 lemma ideduct_synth_vars:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t"
   shows "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using assms by (induct t rule: intruder_synth_induct) auto
 
 lemma ideduct_synth_priv_fun_in_ik:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c t" "f \<in> funs_term t" "\<not>public f"
   shows "f \<in> \<Union>(funs_term ` M)"
 using assms by (induct t rule: intruder_synth_induct) auto
 
 lemma ideduct_synth_priv_const_in_ik:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "M \<turnstile>\<^sub>c Fun c []" "\<not>public c"
   shows "Fun c [] \<in> M"
 using intruder_synth.cases[OF assms(1)] assms(2) by fast
 
 lemma ideduct_synth_ik_replace:
   fixes M::"('fun,'var) terms" and t::"('fun,'var) term"
   assumes "\<forall>t \<in> M. N \<turnstile>\<^sub>c t"
     and "M \<turnstile>\<^sub>c t"
   shows "N \<turnstile>\<^sub>c t"
 using assms(2,1) by (induct t rule: intruder_synth.induct) auto
 end
 
 subsection \<open>Lemmata: Analyzed Intruder Knowledge Closure\<close>
 lemma deducts_eq_if_analyzed: "analyzed M \<Longrightarrow> M \<turnstile> t \<longleftrightarrow> M \<turnstile>\<^sub>c t"
 unfolding analyzed_def by auto
 
 lemma closure_is_superset: "decomp_closure M M' \<Longrightarrow> M \<subseteq> M'"
 unfolding decomp_closure_def by force
 
 lemma deduct_if_closure_deduct: "\<lbrakk>M' \<turnstile> t; decomp_closure M M'\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 proof (induction t rule: intruder_deduct.induct)
   case (Decompose M' t K T t\<^sub>i)
   thus ?case using intruder_deduct.Decompose[OF _ \<open>Ana t = (K,T)\<close> _ \<open>t\<^sub>i \<in> set T\<close>] by simp
 qed (auto simp add: decomp_closure_def)
 
 lemma deduct_if_closure_synth: "\<lbrakk>decomp_closure M M'; M' \<turnstile>\<^sub>c t\<rbrakk> \<Longrightarrow> M \<turnstile> t"
 using deduct_if_closure_deduct by blast
 
 lemma decomp_closure_subterms_composable:
   assumes "decomp_closure M M'"
   and "M' \<turnstile>\<^sub>c t'" "M' \<turnstile> t" "t \<sqsubseteq> t'"
   shows "M' \<turnstile>\<^sub>c t"
 using \<open>M' \<turnstile>\<^sub>c t'\<close> assms
 proof (induction t' rule: intruder_synth.induct)
   case (AxiomC t' M')
   have "M \<turnstile> t" using \<open>M' \<turnstile> t\<close> deduct_if_closure_deduct AxiomC.prems(1) by blast
   moreover
   { have "\<exists>s \<in> M. t' \<sqsubseteq> s" using \<open>t' \<in> M'\<close> AxiomC.prems(1) unfolding decomp_closure_def by blast
     hence "\<exists>s \<in> M. t \<sqsubseteq> s" using \<open>t \<sqsubseteq> t'\<close> term.order_trans by auto
   }
   ultimately have "t \<in> M'" using AxiomC.prems(1) unfolding decomp_closure_def by blast
   thus ?case by simp
 next
   case (ComposeC T f M')
   let ?t' = "Fun f T"
   { assume "t = ?t'" have "M' \<turnstile>\<^sub>c t" using \<open>M' \<turnstile>\<^sub>c ?t'\<close> \<open>t = ?t'\<close> by simp }
   moreover
   { assume "t \<noteq> ?t'"
     have "\<exists>x \<in> set T. t \<sqsubseteq> x" using \<open>t \<sqsubseteq> ?t'\<close> \<open>t \<noteq> ?t'\<close> by simp
     hence "M' \<turnstile>\<^sub>c t" using ComposeC.IH ComposeC.prems(1,3) ComposeC.hyps(3) by blast
   }
   ultimately show ?case using cases_simp[of "t = ?t'" "M' \<turnstile>\<^sub>c t"] by simp
 qed
 
 lemma decomp_closure_analyzed:
   assumes "decomp_closure M M'"
   shows "analyzed M'"
 proof -
   { fix t assume "M' \<turnstile> t" have "M' \<turnstile>\<^sub>c t" using \<open>M' \<turnstile> t\<close> assms
     proof (induction t rule: intruder_deduct.induct)
       case (Decompose M' t K T t\<^sub>i) 
       hence "M' \<turnstile> t\<^sub>i" using Decompose.hyps intruder_deduct.Decompose by blast
       moreover have "t\<^sub>i \<sqsubseteq> t"
         using Decompose.hyps(4) Ana_subterm[OF Decompose.hyps(2)] by blast
       moreover have "M' \<turnstile>\<^sub>c t" using Decompose.IH(1) Decompose.prems by blast
       ultimately show "M' \<turnstile>\<^sub>c t\<^sub>i" using decomp_closure_subterms_composable Decompose.prems by blast
     qed auto
   }
   moreover have "\<forall>t. M \<turnstile>\<^sub>c t \<longrightarrow> M \<turnstile> t" by auto
   ultimately show ?thesis by (auto simp add: decomp_closure_def analyzed_def)
 qed
 
 lemma analyzed_if_all_analyzed_in:
   assumes M: "\<forall>t \<in> M. analyzed_in t M"
   shows "analyzed M"
 proof (unfold analyzed_def, intro allI iffI)
   fix t
   assume t: "M \<turnstile> t"
   thus "M \<turnstile>\<^sub>c t"
   proof (induction t rule: intruder_deduct_induct)
     case (Decompose t K T t\<^sub>i)
     { assume "t \<in> M"
       hence ?case
         using M Decompose.IH(2) Decompose.hyps(2,4)
         unfolding analyzed_in_def by fastforce
     } moreover {
       fix f S assume "t = Fun f S" "\<And>s. s \<in> set S \<Longrightarrow> M \<turnstile>\<^sub>c s"
       hence ?case using Ana_fun_subterm[of f S] Decompose.hyps(2,4) by blast
     } ultimately show ?case using intruder_synth.cases[OF Decompose.IH(1), of ?case] by blast
   qed simp_all
 qed auto
 
 lemma analyzed_is_all_analyzed_in:
   "(\<forall>t \<in> M. analyzed_in t M) \<longleftrightarrow> analyzed M"
 proof
   show "analyzed M \<Longrightarrow> \<forall>t \<in> M. analyzed_in t M"
     unfolding analyzed_in_def analyzed_def
     by (auto intro: intruder_deduct.Decompose[OF intruder_deduct.Axiom])
 qed (rule analyzed_if_all_analyzed_in)
 
 lemma ik_has_synth_ik_closure:
   fixes M :: "('fun,'var) terms"
   shows "\<exists>M'. (\<forall>t. M \<turnstile> t \<longleftrightarrow> M' \<turnstile>\<^sub>c t) \<and> decomp_closure M M' \<and> (finite M \<longrightarrow> finite M')"
 proof -
   let ?M' = "{t. M \<turnstile> t \<and> (\<exists>t' \<in> M. t \<sqsubseteq> t')}"
 
   have M'_closes: "decomp_closure M ?M'" unfolding decomp_closure_def by simp
   hence "M \<subseteq> ?M'" using closure_is_superset by simp
 
   have "\<forall>t. ?M' \<turnstile>\<^sub>c t \<longrightarrow> M \<turnstile> t" using deduct_if_closure_synth[OF M'_closes] by blast 
   moreover have "\<forall>t. M \<turnstile> t \<longrightarrow> ?M' \<turnstile> t" using ideduct_mono[OF _ \<open>M \<subseteq> ?M'\<close>] by simp
   moreover have "analyzed ?M'" using decomp_closure_analyzed[OF M'_closes] .
   ultimately have "\<forall>t. M \<turnstile> t \<longleftrightarrow> ?M' \<turnstile>\<^sub>c t" unfolding analyzed_def by blast
   moreover have "finite M \<longrightarrow> finite ?M'" by auto
   ultimately show ?thesis using M'_closes by blast
 qed
 
 lemma deducts_eq_if_empty_ik:
   "{} \<turnstile> t \<longleftrightarrow> {} \<turnstile>\<^sub>c t"
 using analyzed_is_all_analyzed_in[of "{}"] deducts_eq_if_analyzed[of "{}" t] by blast
 
 
 subsection \<open>Intruder Variants: Numbered and Composition-Restricted Intruder Deduction Relations\<close>
 text \<open>
   A variant of the intruder relation which restricts composition to only those terms that satisfy
   a given predicate Q.
 \<close>
 inductive intruder_deduct_restricted::
   "('fun,'var) terms \<Rightarrow> (('fun,'var) term \<Rightarrow> bool) \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
   ("\<langle>_;_\<rangle> \<turnstile>\<^sub>r _" 50)
 where
   AxiomR[simp]:   "t \<in> M \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t"
 | ComposeR[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; Q (Fun f T)\<rbrakk>
                     \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r Fun f T"
 | DecomposeR:     "\<lbrakk>\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r k; t\<^sub>i \<in> set T\<rbrakk>
                     \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t\<^sub>i"
 
 text \<open>
   A variant of the intruder relation equipped with a number representing the height of the
   derivation tree (i.e., \<open>\<langle>M; k\<rangle> \<turnstile>\<^sub>n t\<close> iff k is the maximum number of applications of the compose
   and decompose rules in any path of the derivation tree for \<open>M \<turnstile> t\<close>).
 \<close>
 inductive intruder_deduct_num::
   "('fun,'var) terms \<Rightarrow> nat \<Rightarrow> ('fun,'var) term \<Rightarrow> bool"
   ("\<langle>_; _\<rangle> \<turnstile>\<^sub>n _" 50)
 where
   AxiomN[simp]:   "t \<in> M \<Longrightarrow> \<langle>M; 0\<rangle> \<turnstile>\<^sub>n t"
 | ComposeN[simp]: "\<lbrakk>length T = arity f; public f; \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t\<rbrakk>
                     \<Longrightarrow> \<langle>M; Suc (Max (insert 0 (steps ` set T)))\<rangle> \<turnstile>\<^sub>n Fun f T"
 | DecomposeN:     "\<lbrakk>\<langle>M; n\<rangle> \<turnstile>\<^sub>n t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; steps k\<rangle> \<turnstile>\<^sub>n k; t\<^sub>i \<in> set T\<rbrakk>
                     \<Longrightarrow> \<langle>M; Suc (Max (insert n (steps ` set K)))\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
 
 lemma intruder_deduct_restricted_induct[consumes 1, case_names AxiomR ComposeR DecomposeR]:
   assumes "\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t" "\<And>t. t \<in> M \<Longrightarrow> P M Q t"
           "\<And>T f. \<lbrakk>length T = arity f; public f;
                   \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r t;
                   \<And>t. t \<in> set T \<Longrightarrow> P M Q t; Q (Fun f T)
                   \<rbrakk> \<Longrightarrow> P M Q (Fun f T)"
           "\<And>t K T t\<^sub>i. \<lbrakk>\<langle>M; Q\<rangle> \<turnstile>\<^sub>r t; P M Q t; Ana t = (K, T); \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; Q\<rangle> \<turnstile>\<^sub>r k;
                        \<And>k. k \<in> set K \<Longrightarrow> P M Q k; t\<^sub>i \<in> set T\<rbrakk> \<Longrightarrow> P M Q t\<^sub>i"
   shows "P M Q t"
 using assms by (induct t rule: intruder_deduct_restricted.induct) blast+
 
 lemma intruder_deduct_num_induct[consumes 1, case_names AxiomN ComposeN DecomposeN]:
   assumes "\<langle>M; n\<rangle> \<turnstile>\<^sub>n t" "\<And>t. t \<in> M \<Longrightarrow> P M 0 t"
           "\<And>T f steps.
               \<lbrakk>length T = arity f; public f;
                \<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t;
                \<And>t. t \<in> set T \<Longrightarrow> P M (steps t) t\<rbrakk>
               \<Longrightarrow> P M (Suc (Max (insert 0 (steps ` set T)))) (Fun f T)"
           "\<And>t K T t\<^sub>i steps n.
               \<lbrakk>\<langle>M; n\<rangle> \<turnstile>\<^sub>n t; P M n t; Ana t = (K, T);
                \<And>k. k \<in> set K \<Longrightarrow> \<langle>M; steps k\<rangle> \<turnstile>\<^sub>n k;
                t\<^sub>i \<in> set T; \<And>k. k \<in> set K \<Longrightarrow> P M (steps k) k\<rbrakk>
               \<Longrightarrow> P M (Suc (Max (insert n (steps ` set K)))) t\<^sub>i"
   shows "P M n t"
 using assms by (induct rule: intruder_deduct_num.induct) blast+
 
 lemma ideduct_restricted_mono:
   "\<lbrakk>\<langle>M; P\<rangle> \<turnstile>\<^sub>r t; M \<subseteq> M'\<rbrakk> \<Longrightarrow> \<langle>M'; P\<rangle> \<turnstile>\<^sub>r t"
 proof (induction rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i)
   have "\<forall>k. k \<in> set K \<longrightarrow> \<langle>M'; P\<rangle> \<turnstile>\<^sub>r k" using DecomposeR.IH \<open>M \<subseteq> M'\<close> by simp
   moreover have "\<langle>M'; P\<rangle> \<turnstile>\<^sub>r t" using DecomposeR.IH \<open>M \<subseteq> M'\<close> by simp
   ultimately show ?case
     using DecomposeR
           intruder_deduct_restricted.DecomposeR[OF _ DecomposeR.hyps(2) _ DecomposeR.hyps(4)]
     by blast
 qed auto
 
 
 subsection \<open>Lemmata: Intruder Deduction Equivalences\<close>
 lemma deduct_if_restricted_deduct: "\<langle>M;P\<rangle> \<turnstile>\<^sub>r m \<Longrightarrow> M \<turnstile> m"
 proof (induction m rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i) thus ?case using intruder_deduct.Decompose by blast
 qed simp_all
 
 lemma restricted_deduct_if_restricted_ik:
   assumes "\<langle>M;P\<rangle> \<turnstile>\<^sub>r m" "\<forall>m \<in> M. P m"
   and P: "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
   shows "P m"
 using assms(1)
 proof (induction m rule: intruder_deduct_restricted_induct)
   case (DecomposeR t K T t\<^sub>i)
   obtain f S where "t = Fun f S" using Ana_var \<open>t\<^sub>i \<in> set T\<close> \<open>Ana t = (K, T)\<close> by (cases t) auto
   thus ?case using DecomposeR assms(2) P Ana_subterm by blast
 qed (simp_all add: assms(2))
 
 lemma deduct_restricted_if_synth:
   assumes P: "P m" "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
   and m: "M \<turnstile>\<^sub>c m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 using m P(1)
 proof (induction m rule: intruder_synth_induct)
   case (ComposeC T f)
   hence "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t" when t: "t \<in> set T" for t
     using t P(2) subtermeqI''[of _ T f]
     by fastforce
   thus ?case
     using intruder_deduct_restricted.ComposeR[OF ComposeC.hyps(1,2)] ComposeC.prems(1)
     by metis
 qed simp
 
 lemma deduct_zero_in_ik:
   assumes "\<langle>M; 0\<rangle> \<turnstile>\<^sub>n t" shows "t \<in> M"
 proof -
   { fix k assume "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t" hence "k > 0 \<or> t \<in> M" by (induct t) auto
   } thus ?thesis using assms by auto
 qed
 
 lemma deduct_if_deduct_num: "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t \<Longrightarrow> M \<turnstile> t"
 by (induct t rule: intruder_deduct_num.induct)
    (metis intruder_deduct.Axiom,
     metis intruder_deduct.Compose,
     metis intruder_deduct.Decompose)
 
 lemma deduct_num_if_deduct: "M \<turnstile> t \<Longrightarrow> \<exists>k. \<langle>M; k\<rangle> \<turnstile>\<^sub>n t"
 proof (induction t rule: intruder_deduct_induct)
   case (Compose T f)
   then obtain steps where *: "\<forall>t \<in> set T. \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" by moura
   then obtain n where "\<forall>t \<in> set T. steps t \<le> n"
     using finite_nat_set_iff_bounded_le[of "steps ` set T"]
     by auto
   thus ?case using ComposeN[OF Compose.hyps(1,2), of M steps] * by force
 next
   case (Decompose t K T t\<^sub>i)
   hence "\<And>u. u \<in> insert t (set K) \<Longrightarrow> \<exists>k. \<langle>M; k\<rangle> \<turnstile>\<^sub>n u" by auto
   then obtain steps where *: "\<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" "\<forall>t \<in> set K. \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t" by moura
   then obtain n where "steps t \<le> n" "\<forall>t \<in> set K. steps t \<le> n"
     using finite_nat_set_iff_bounded_le[of "steps ` insert t (set K)"]
     by auto
   thus ?case using DecomposeN[OF _ Decompose.hyps(2) _ Decompose.hyps(4), of M _ steps] * by force
 qed (metis AxiomN)
 
 lemma deduct_normalize:
   assumes M: "\<forall>m \<in> M. \<forall>f T. Fun f T \<sqsubseteq> m \<longrightarrow> P f T"
   and t: "\<langle>M; k\<rangle> \<turnstile>\<^sub>n t" "Fun f T \<sqsubseteq> t" "\<not>P f T"
   shows "\<exists>l \<le> k. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t)"
 using t
 proof (induction t rule: intruder_deduct_num_induct)
   case (AxiomN t) thus ?case using M by auto
 next
   case (ComposeN T' f' steps) thus ?case
   proof (cases "Fun f' T' = Fun f T")
     case True
     hence "\<langle>M; Suc (Max (insert 0 (steps ` set T')))\<rangle> \<turnstile>\<^sub>n Fun f T" "T = T'"
       using intruder_deduct_num.ComposeN[OF ComposeN.hyps] by auto
     moreover have "\<And>t. t \<in> set T \<Longrightarrow> \<langle>M; steps t\<rangle> \<turnstile>\<^sub>n t"
       using True ComposeN.hyps(3) by auto
     moreover have "\<And>t. t \<in> set T \<Longrightarrow> steps t < Suc (Max (insert 0 (steps ` set T)))"
       using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"]
       by auto
     ultimately show ?thesis by auto
   next
     case False
     then obtain t' where t': "t' \<in> set T'" "Fun f T \<sqsubseteq> t'" using ComposeN by auto
     hence "\<exists>l \<le> steps t'. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t)"
       using ComposeN.IH[OF _ _ ComposeN.prems(2)] by auto
     moreover have "steps t' < Suc (Max (insert 0 (steps ` set T')))"
       using Max_less_iff[of "insert 0 (steps ` set T')" "Suc (Max (insert 0 (steps ` set T')))"]
       using t'(1) by auto
     ultimately show ?thesis using ComposeN.hyps(3)[OF t'(1)]
       by (meson Suc_le_eq le_Suc_eq le_trans)
   qed
 next
   case (DecomposeN t K T' t\<^sub>i steps n)
   hence *: "Fun f T \<sqsubseteq> t"
     using term.order_trans[of "Fun f T" t\<^sub>i t] Ana_subterm[of t K T']
     by blast
   have "\<exists>l \<le> n. (\<langle>M; l\<rangle> \<turnstile>\<^sub>n Fun f T) \<and> (\<forall>t' \<in> set T. \<exists>j < l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t')"
     using DecomposeN.IH(1)[OF * DecomposeN.prems(2)] by auto
   moreover have "n < Suc (Max (insert n (steps ` set K)))"
       using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"]
       by auto
   ultimately show ?case using DecomposeN.hyps(4) by (meson Suc_le_eq le_Suc_eq le_trans)
 qed
 
 lemma deduct_inv:
   assumes "\<langle>M; n\<rangle> \<turnstile>\<^sub>n t"
   shows "t \<in> M \<or>
          (\<exists>f T. t = Fun f T \<and> public f \<and> length T = arity f \<and> (\<forall>t \<in> set T. \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n t)) \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M.
             (\<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n m) \<and> (\<forall>k \<in> set (fst (Ana m)). \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n k) \<and>
             t \<in> set (snd (Ana m)))"
     (is "?P t n \<or> ?Q t n \<or> ?R t n")
 using assms
 proof (induction n arbitrary: t rule: nat_less_induct)
   case (1 n t) thus ?case
   proof (cases n)
     case 0
     hence "t \<in> M" using deduct_zero_in_ik "1.prems"(1) by metis
     thus ?thesis by auto
   next
     case (Suc n')
     hence "\<langle>M; Suc n'\<rangle> \<turnstile>\<^sub>n t"
           "\<forall>m < Suc n'. \<forall>x. (\<langle>M; m\<rangle> \<turnstile>\<^sub>n x) \<longrightarrow> ?P x m \<or> ?Q x m \<or> ?R x m"
       using "1.prems" "1.IH" by blast+
     hence "?P t (Suc n') \<or> ?Q t (Suc n') \<or> ?R t (Suc n')"
     proof (induction t rule: intruder_deduct_num_induct)
       case (AxiomN t) thus ?case by simp
     next
       case (ComposeN T f steps)
       have "\<And>t. t \<in> set T \<Longrightarrow> steps t < Suc (Max (insert 0 (steps ` set T)))"
           using Max_less_iff[of "insert 0 (steps ` set T)" "Suc (Max (insert 0 (steps ` set T)))"]
           by auto
       thus ?case using ComposeN.hyps by metis
     next
       case (DecomposeN t K T t\<^sub>i steps n)
       have 0: "n < Suc (Max (insert n (steps ` set K)))"
               "\<And>k. k \<in> set K \<Longrightarrow> steps k < Suc (Max (insert n (steps ` set K)))"
         using Max_less_iff[of "insert n (steps ` set K)" "Suc (Max (insert n (steps ` set K)))"]
         by auto
 
       have IH1: "?P t j \<or> ?Q t j \<or> ?R t j" when jt: "j < n" "\<langle>M; j\<rangle> \<turnstile>\<^sub>n t" for j t
         using jt DecomposeN.prems(1) 0(1)
         by simp
 
       have IH2: "?P t n \<or> ?Q t n \<or> ?R t n"
         using DecomposeN.IH(1) IH1
         by simp
 
       have 1: "\<forall>k \<in> set (fst (Ana t)). \<exists>l < Suc (Max (insert n (steps ` set K))). \<langle>M; l\<rangle> \<turnstile>\<^sub>n k"
         using DecomposeN.hyps(1,2,3) 0(2)
         by auto
     
       have 2: "t\<^sub>i \<in> set (snd (Ana t))"
         using DecomposeN.hyps(2,4)
         by fastforce
     
       have 3: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M" when "t \<in> set (snd (Ana m))" "m \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M" for m
         using that(1) Ana_subterm[of m _ "snd (Ana m)"] in_subterms_subset_Union[OF that(2)]
         by (metis (no_types, lifting) prod.collapse psubsetD subsetCE subsetD) 
     
       have 4: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?R t n"
         using that 0(1) 1 2 3 DecomposeN.hyps(1)
         by (metis (no_types, lifting)) 
     
       have 5: "?R t\<^sub>i (Suc (Max (insert n (steps ` set K))))" when "?P t n"
         using that 0(1) 1 2 DecomposeN.hyps(1)
         by blast
     
       have 6: ?case when *: "?Q t n"
       proof -
         obtain g S where g:
             "t = Fun g S" "public g" "length S = arity g" "\<forall>t \<in> set S. \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n t"
           using * by moura
         then obtain l where l: "l < n" "\<langle>M; l\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
           using 0(1) DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T] by blast
     
         have **: "l < Suc (Max (insert n (steps ` set K)))" using l(1) 0(1) by simp
     
         show ?thesis using IH1[OF l] less_trans[OF _ **] by fastforce
       qed
 
       show ?case using IH2 4 5 6 by argo
     qed
     thus ?thesis using Suc by fast
   qed
 qed
 
 lemma deduct_inv':
   assumes "M \<turnstile> Fun f ts"
   shows "Fun f ts \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<forall>t \<in> set ts. M \<turnstile> t)"
 proof -
   obtain k where k: "intruder_deduct_num M k (Fun f ts)"
     using deduct_num_if_deduct[OF assms] by fast
 
   have "Fun f ts \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<forall>t \<in> set ts. \<exists>l. intruder_deduct_num M l t)"
     using deduct_inv[OF k] Ana_subterm'[of "Fun f ts"] in_subterms_subset_Union by blast
   thus ?thesis using deduct_if_deduct_num by blast
 qed
 
 lemma restricted_deduct_if_deduct:
   assumes M: "\<forall>m \<in> M. \<forall>f T. Fun f T \<sqsubseteq> m \<longrightarrow> P (Fun f T)"
   and P_subterm: "\<forall>f T t. M \<turnstile> Fun f T \<longrightarrow> P (Fun f T) \<longrightarrow> t \<in> set T \<longrightarrow> P t"
   and P_Ana_key: "\<forall>t K T k. M \<turnstile> t \<longrightarrow> P t \<longrightarrow> Ana t = (K, T) \<longrightarrow> M \<turnstile> k \<longrightarrow> k \<in> set K \<longrightarrow> P k"
   and m: "M \<turnstile> m" "P m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 proof -
   { fix k assume "\<langle>M; k\<rangle> \<turnstile>\<^sub>n m"
     hence ?thesis using m(2)
     proof (induction k arbitrary: m rule: nat_less_induct)
       case (1 n m) thus ?case
       proof (cases n)
         case 0
         hence "m \<in> M" using deduct_zero_in_ik "1.prems"(1) by metis
         thus ?thesis by auto
       next
         case (Suc n')
         hence "\<langle>M; Suc n'\<rangle> \<turnstile>\<^sub>n m"
               "\<forall>m < Suc n'. \<forall>x. (\<langle>M; m\<rangle> \<turnstile>\<^sub>n x) \<longrightarrow> P x \<longrightarrow> \<langle>M;P\<rangle> \<turnstile>\<^sub>r x"
           using "1.prems" "1.IH" by blast+
         thus ?thesis using "1.prems"(2)
         proof (induction m rule: intruder_deduct_num_induct)
           case (ComposeN T f steps)
           have *: "steps t < Suc (Max (insert 0 (steps ` set T)))" when "t \<in> set T" for t
             using Max_less_iff[of "insert 0 (steps ` set T)"] that
             by blast
 
           have **: "P t" when "t \<in> set T" for t
             using P_subterm ComposeN.prems(2) that
                   Fun_param_is_subterm[OF that]
                   intruder_deduct.Compose[OF ComposeN.hyps(1,2)]
                   deduct_if_deduct_num[OF ComposeN.hyps(3)]
             by blast
 
           have "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t" when "t \<in> set T" for t
             using ComposeN.prems(1) ComposeN.hyps(3)[OF that] *[OF that] **[OF that]
             by blast
           thus ?case
             by (metis intruder_deduct_restricted.ComposeR[OF ComposeN.hyps(1,2)] ComposeN.prems(2))
         next
           case (DecomposeN t K T t\<^sub>i steps l)
           show ?case
           proof (cases "P t")
             case True
             hence "\<And>k. k \<in> set K \<Longrightarrow> P k"
               using P_Ana_key DecomposeN.hyps(1,2,3) deduct_if_deduct_num
               by blast
             moreover have
                 "\<And>k m x. k \<in> set K \<Longrightarrow> m < steps k \<Longrightarrow> \<langle>M; m\<rangle> \<turnstile>\<^sub>n x \<Longrightarrow> P x \<Longrightarrow> \<langle>M;P\<rangle> \<turnstile>\<^sub>r x"
             proof -
               fix k m x assume *: "k \<in> set K" "m < steps k" "\<langle>M; m\<rangle> \<turnstile>\<^sub>n x" "P x"
               have "steps k \<in> insert l (steps ` set K)" using *(1) by simp
               hence "m < Suc (Max (insert l (steps ` set K)))"
                 using less_trans[OF *(2), of "Suc (Max (insert l (steps ` set K)))"]
                       Max_less_iff[of "insert l (steps ` set K)"
                                       "Suc (Max (insert l (steps ` set K)))"]
                 by auto
               thus "\<langle>M;P\<rangle> \<turnstile>\<^sub>r x" using DecomposeN.prems(1) *(3,4) by simp
             qed
             ultimately have "\<And>k. k \<in> set K \<Longrightarrow> \<langle>M; P\<rangle> \<turnstile>\<^sub>r k"
               using DecomposeN.IH(2) by auto
             moreover have "\<langle>M; P\<rangle> \<turnstile>\<^sub>r t"
               using True DecomposeN.prems(1) DecomposeN.hyps(1) le_imp_less_Suc
                     Max_less_iff[of "insert l (steps ` set K)" "Suc (Max (insert l (steps ` set K)))"]
               by blast
             ultimately show ?thesis
               using intruder_deduct_restricted.DecomposeR[OF _ DecomposeN.hyps(2)
                                                              _ DecomposeN.hyps(4)]
               by metis
           next
             case False
             obtain g S where gS: "t = Fun g S" using DecomposeN.hyps(2,4) by (cases t) moura+
             hence *: "Fun g S \<sqsubseteq> t" "\<not>P (Fun g S)" using False by force+
             have "\<exists>j<l. \<langle>M; j\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
               using gS DecomposeN.hyps(2,4) Ana_fun_subterm[of g S K T]
                     deduct_normalize[of M "\<lambda>f T. P (Fun f T)", OF M DecomposeN.hyps(1) *]
               by force
             hence "\<exists>j<Suc (Max (insert l (steps ` set K))). \<langle>M; j\<rangle> \<turnstile>\<^sub>n t\<^sub>i"
               using Max_less_iff[of "insert l (steps ` set K)"
                                     "Suc (Max (insert l (steps ` set K)))"]
                     less_trans[of _ l "Suc (Max (insert l (steps ` set K)))"]
               by blast
             thus ?thesis using DecomposeN.prems(1,2) by meson
           qed
         qed auto
       qed
     qed
   } thus ?thesis using deduct_num_if_deduct m(1) by metis
 qed
 
 lemma restricted_deduct_if_deduct':
   assumes "\<forall>m \<in> M. P m"
     and "\<forall>t t'. P t \<longrightarrow> t' \<sqsubseteq> t \<longrightarrow> P t'"
     and "\<forall>t K T k. P t \<longrightarrow> Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> P k"
     and "M \<turnstile> m" "P m"
   shows "\<langle>M; P\<rangle> \<turnstile>\<^sub>r m"
 using restricted_deduct_if_deduct[of M P m] assms
 by blast
 
 lemma private_const_deduct:
   assumes c: "\<not>public c" "M \<turnstile> (Fun c []::('fun,'var) term)"
   shows "Fun c [] \<in> M \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. M \<turnstile> m \<and> (\<forall>k \<in> set (fst (Ana m)). M \<turnstile> m) \<and>
                              Fun c [] \<in> set (snd (Ana m)))"
 proof -
   obtain n where "\<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun c []"
     using c(2) deduct_num_if_deduct by moura
   hence "Fun c [] \<in> M \<or>
          (\<exists>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M.
             (\<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n m) \<and>
             (\<forall>k \<in> set (fst (Ana m)). \<exists>l < n. \<langle>M; l\<rangle> \<turnstile>\<^sub>n k) \<and> Fun c [] \<in> set (snd (Ana m)))"
     using deduct_inv[of M n "Fun c []"] c(1) by fast
   thus ?thesis using deduct_if_deduct_num[of M] by blast
 qed
 
 lemma private_fun_deduct_in_ik'':
   assumes t: "M \<turnstile> Fun f T" "Fun c [] \<in> set T" "\<forall>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. Fun f T \<notin> set (snd (Ana m))"
     and c: "\<not>public c" "Fun c [] \<notin> M" "\<forall>m \<in> subterms\<^sub>s\<^sub>e\<^sub>t M. Fun c [] \<notin> set (snd (Ana m))"
   shows "Fun f T \<in> M"
 proof -
   have *: "\<nexists>n. \<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun c []"
     using private_const_deduct[OF c(1)] c(2,3) deduct_if_deduct_num
     by blast
 
   obtain n where n: "\<langle>M; n\<rangle> \<turnstile>\<^sub>n Fun f T"
     using t(1) deduct_num_if_deduct
     by blast
 
   show ?thesis
     using deduct_inv[OF n] t(2,3) *
     by blast
 qed
 
 end
 
 subsection \<open>Executable Definitions for Code Generation\<close>
 fun intruder_synth' where
   "intruder_synth' pu ar M (Var x) = (Var x \<in> M)"
 | "intruder_synth' pu ar M (Fun f T) = (
     Fun f T \<in> M \<or> (pu f \<and> length T = ar f \<and> list_all (intruder_synth' pu ar M) T))"
 
 definition "wf\<^sub>t\<^sub>r\<^sub>m' ar t \<equiv> (\<forall>s \<in> subterms t. is_Fun s \<longrightarrow> ar (the_Fun s) = length (args s))"
 
 definition "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' ar M \<equiv> (\<forall>t \<in> M. wf\<^sub>t\<^sub>r\<^sub>m' ar t)"
 
 definition "analyzed_in' An pu ar t M \<equiv> (case An t of
     (K,T) \<Rightarrow> (\<forall>k \<in> set K. intruder_synth' pu ar M k) \<longrightarrow> (\<forall>s \<in> set T. intruder_synth' pu ar M s))"
 
 lemma (in intruder_model) intruder_synth'_induct[consumes 1, case_names Var Fun]:
   assumes "intruder_synth' public arity M t"
           "\<And>x. intruder_synth' public arity M (Var x) \<Longrightarrow> P (Var x)"
           "\<And>f T. (\<And>z. z \<in> set T \<Longrightarrow> intruder_synth' public arity M z \<Longrightarrow> P z) \<Longrightarrow>
                   intruder_synth' public arity M (Fun f T) \<Longrightarrow> P (Fun f T) "
   shows "P t"
 using assms by (induct public arity M t rule: intruder_synth'.induct) auto
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m_code[code_unfold]:
   "wf\<^sub>t\<^sub>r\<^sub>m t = wf\<^sub>t\<^sub>r\<^sub>m' arity t"
 unfolding wf\<^sub>t\<^sub>r\<^sub>m_def wf\<^sub>t\<^sub>r\<^sub>m'_def
 by auto
 
 lemma (in intruder_model) wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[code_unfold]:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M = wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity M"
 using wf\<^sub>t\<^sub>r\<^sub>m_code
 unfolding wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s'_def
 by auto
 
 lemma (in intruder_model) intruder_synth_code[code_unfold]:
   "intruder_synth M t = intruder_synth' public arity M t"
   (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B"
   proof (induction t rule: intruder_synth_induct)
     case (AxiomC t) thus ?case by (cases t) auto
   qed (fastforce simp add: list_all_iff)
 
   show "?B \<Longrightarrow> ?A"
   proof (induction t rule: intruder_synth'_induct)
     case (Fun f T) thus ?case
     proof (cases "Fun f T \<in> M")
       case False
       hence "public f" "length T = arity f" "list_all (intruder_synth' public arity M) T"
         using Fun.hyps by fastforce+
       thus ?thesis
         using Fun.IH intruder_synth.ComposeC[of T f M] Ball_set[of T]
         by blast
     qed simp
   qed simp
 qed
 
 lemma (in intruder_model) analyzed_in_code[code_unfold]:
   "analyzed_in t M = analyzed_in' Ana public arity t M"
 using intruder_synth_code[of M]
 unfolding analyzed_in_def analyzed_in'_def
 by fastforce
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/More_Unification.thy
@@ -1,3335 +1,3299 @@
 (*
 Based on src/HOL/ex/Unification.thy packaged with Isabelle/HOL 2015 having the following license:
 
 ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER.
 
 Copyright (c) 1986-2015,
   University of Cambridge,
   Technische Universitaet Muenchen,
   and contributors.
 
   All rights reserved.
 
 Redistribution and use in source and binary forms, with or without 
 modification, are permitted provided that the following conditions are 
 met:
 
 * Redistributions of source code must retain the above copyright 
 notice, this list of conditions and the following disclaimer.
 
 * Redistributions in binary form must reproduce the above copyright 
 notice, this list of conditions and the following disclaimer in the 
 documentation and/or other materials provided with the distribution.
 
 * Neither the name of the University of Cambridge or the Technische
 Universitaet Muenchen nor the names of their contributors may be used
 to endorse or promote products derived from this software without
 specific prior written permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 
 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 
 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 
 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 
 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 
 (*  Title:      More_Unification.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 
     Originally based on src/HOL/ex/Unification.thy (Isabelle/HOL 2015) by:
     Author:     Martin Coen, Cambridge University Computer Laboratory
     Author:     Konrad Slind, TUM & Cambridge University Computer Laboratory
     Author:     Alexander Krauss, TUM
 *)
 
 section \<open>Definitions and Properties Related to Substitutions and Unification\<close>
 
 theory More_Unification
   imports Messages "First_Order_Terms.Unification"
 begin
 
 subsection \<open>Substitutions\<close>
 
 abbreviation subst_apply_list (infix "\<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 51) where
   "T \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>t. t \<cdot> \<theta>) T"  
 
 abbreviation subst_apply_pair (infixl "\<cdot>\<^sub>p" 60) where
   "d \<cdot>\<^sub>p \<theta> \<equiv> (case d of (t,t') \<Rightarrow> (t \<cdot> \<theta>, t' \<cdot> \<theta>))"
 
 abbreviation subst_apply_pair_set (infixl "\<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t" 60) where
   "M \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta> \<equiv> (\<lambda>d. d \<cdot>\<^sub>p \<theta>) ` M"
 
 definition subst_apply_pairs (infix "\<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 51) where
   "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> \<equiv> map (\<lambda>f. f \<cdot>\<^sub>p \<theta>) F"
 
 abbreviation subst_more_general_than (infixl "\<preceq>\<^sub>\<circ>" 50) where
   "\<sigma> \<preceq>\<^sub>\<circ> \<theta> \<equiv> \<exists>\<gamma>. \<theta> = \<sigma> \<circ>\<^sub>s \<gamma>"
 
 abbreviation subst_support (infix "supports" 50) where
   "\<theta> supports \<delta> \<equiv> (\<forall>x. \<theta> x \<cdot> \<delta> = \<delta> x)"
 
 abbreviation rm_var where
   "rm_var v s \<equiv> s(v := Var v)"
 
 abbreviation rm_vars where
   "rm_vars vs \<sigma> \<equiv> (\<lambda>v. if v \<in> vs then Var v else \<sigma> v)"
 
 definition subst_elim where
   "subst_elim \<sigma> v \<equiv> \<forall>t. v \<notin> fv (t \<cdot> \<sigma>)"
 
 definition subst_idem where
   "subst_idem s \<equiv> s \<circ>\<^sub>s s = s"
 
 lemma subst_support_def: "\<theta> supports \<tau> \<longleftrightarrow> \<tau> = \<theta> \<circ>\<^sub>s \<tau>"
 unfolding subst_compose_def by metis
 
 lemma subst_supportD: "\<theta> supports \<delta> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>"
 using subst_support_def by auto
 
 lemma rm_vars_empty[simp]: "rm_vars {} s = s" "rm_vars (set []) s = s"
 by simp_all
 
 lemma rm_vars_singleton: "rm_vars {v} s = rm_var v s"
 by auto
 
 lemma subst_apply_terms_empty: "M \<cdot>\<^sub>s\<^sub>e\<^sub>t Var = M"
 by simp
 
 lemma subst_agreement: "(t \<cdot> r = t \<cdot> s) \<longleftrightarrow> (\<forall>v \<in> fv t. Var v \<cdot> r = Var v \<cdot> s)"
 by (induct t) auto
 
 lemma repl_invariance[dest?]: "v \<notin> fv t \<Longrightarrow> t \<cdot> s(v := u) = t \<cdot> s"
 by (simp add: subst_agreement)
 
 lemma subst_idx_map:
   assumes "\<forall>i \<in> set I. i < length T"
   shows "(map ((!) T) I) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = map ((!) (map (\<lambda>t. t \<cdot> \<delta>) T)) I"
 using assms by auto
 
 lemma subst_idx_map':
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K). i < length T"
   shows "(K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t (!) T) \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta> = K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t ((!) (map (\<lambda>t. t \<cdot> \<delta>) T))" (is "?A = ?B")
 proof -
   have "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   hence "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for i
     using that assms by auto
   hence "k \<cdot> (!) T \<cdot> \<delta> = k \<cdot> (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
     when "fv k \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (set K)" for k
     using that by (induction k) force+
   thus ?thesis by auto
 qed
 
 lemma subst_remove_var: "v \<notin> fv s \<Longrightarrow> v \<notin> fv (t \<cdot> Var(v := s))"
 by (induct t) simp_all
 
 lemma subst_set_map: "x \<in> set X \<Longrightarrow> x \<cdot> s \<in> set (map (\<lambda>x. x \<cdot> s) X)"
 by simp
 
 lemma subst_set_idx_map:
   assumes "\<forall>i \<in> I. i < length T"
   shows "(!) T ` I \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = (!) (map (\<lambda>t. t \<cdot> \<delta>) T) ` I" (is "?A = ?B")
 proof
   have *: "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   
   show "?A \<subseteq> ?B" using * assms by blast
   show "?B \<subseteq> ?A" using * assms by auto
 qed
 
 lemma subst_set_idx_map':
   assumes "\<forall>i \<in> fv\<^sub>s\<^sub>e\<^sub>t K. i < length T"
   shows "K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) T \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = K \<cdot>\<^sub>s\<^sub>e\<^sub>t (!) (map (\<lambda>t. t \<cdot> \<delta>) T)" (is "?A = ?B")
 proof
   have "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i < length T" for i
     using that by auto
   hence "T ! i \<cdot> \<delta> = (map (\<lambda>t. t \<cdot> \<delta>) T) ! i"
     when "i \<in> fv\<^sub>s\<^sub>e\<^sub>t K" for i
     using that assms by auto
   hence *: "k \<cdot> (!) T \<cdot> \<delta> = k \<cdot> (!) (map (\<lambda>t. t \<cdot> \<delta>) T)"
     when "fv k \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t K" for k
     using that by (induction k) force+
 
   show "?A \<subseteq> ?B" using * by auto
   show "?B \<subseteq> ?A" using * by force
 qed
 
 lemma subst_term_list_obtain:
   assumes "\<forall>i < length T. \<exists>s. P (T ! i) s \<and> S ! i = s \<cdot> \<delta>"
     and "length T = length S"
   shows "\<exists>U. length T = length U \<and> (\<forall>i < length T. P (T ! i) (U ! i)) \<and> S = map (\<lambda>u. u \<cdot> \<delta>) U"
 using assms
 proof (induction T arbitrary: S)
   case (Cons t T S')
   then obtain s S where S': "S' = s#S" by (cases S') auto
 
   have "\<forall>i < length T. \<exists>s. P (T ! i) s \<and> S ! i = s \<cdot> \<delta>" "length T = length S"
     using Cons.prems S' by force+
   then obtain U where U:
       "length T = length U" "\<forall>i < length T. P (T ! i) (U ! i)" "S = map (\<lambda>u. u \<cdot> \<delta>) U"
     using Cons.IH by moura
 
   obtain u where u: "P t u" "s = u \<cdot> \<delta>"
     using Cons.prems(1) S' by auto
 
   have 1: "length (t#T) = length (u#U)"
     using Cons.prems(2) U(1) by fastforce
 
   have 2: "\<forall>i < length (t#T). P ((t#T) ! i) ((u#U) ! i)"
     using u(1) U(2) by (simp add: nth_Cons')
 
   have 3: "S' = map (\<lambda>u. u \<cdot> \<delta>) (u#U)"
     using U u S' by simp
 
   show ?case using 1 2 3 by blast
 qed simp
 
 lemma subst_mono: "t \<sqsubseteq> u \<Longrightarrow> t \<cdot> s \<sqsubseteq> u \<cdot> s"
 by (induct u) auto
 
 lemma subst_mono_fv: "x \<in> fv t \<Longrightarrow> s x \<sqsubseteq> t \<cdot> s"
 by (induct t) auto
 
 lemma subst_mono_neq:
   assumes "t \<sqsubset> u"
   shows "t \<cdot> s \<sqsubset> u \<cdot> s"
 proof (cases u)
   case (Var v)
   hence False using \<open>t \<sqsubset> u\<close> by simp
   thus ?thesis ..
 next
   case (Fun f X)
   then obtain x where "x \<in> set X" "t \<sqsubseteq> x" using \<open>t \<sqsubset> u\<close> by auto
   hence "t \<cdot> s \<sqsubseteq> x \<cdot> s" using subst_mono by metis
 
   obtain Y where "Fun f X \<cdot> s = Fun f Y" by auto
   hence "x \<cdot> s \<in> set Y" using \<open>x \<in> set X\<close> by auto
   hence "x \<cdot> s \<sqsubset> Fun f X \<cdot> s" using \<open>Fun f X \<cdot> s = Fun f Y\<close> Fun_param_is_subterm by simp
   hence "t \<cdot> s \<sqsubset> Fun f X \<cdot> s" using \<open>t \<cdot> s \<sqsubseteq> x \<cdot> s\<close> by (metis term.dual_order.trans term.order.eq_iff)
   thus ?thesis using \<open>u = Fun f X\<close> \<open>t \<sqsubset> u\<close> by metis
 qed
 
 lemma subst_no_occs[dest]: "\<not>Var v \<sqsubseteq> t \<Longrightarrow> t \<cdot> Var(v := s) = t"
 by (induct t) (simp_all add: map_idI)
 
 lemma var_comp[simp]: "\<sigma> \<circ>\<^sub>s Var = \<sigma>" "Var \<circ>\<^sub>s \<sigma> = \<sigma>"
 unfolding subst_compose_def by simp_all
 
 lemma subst_comp_all: "M \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<delta> \<circ>\<^sub>s \<theta>) = (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subst_subst_compose[of _ \<delta> \<theta>] by auto
 
 lemma subst_all_mono: "M \<subseteq> M' \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s \<subseteq> M' \<cdot>\<^sub>s\<^sub>e\<^sub>t s"
 by auto
 
 lemma subst_comp_set_image: "(\<delta> \<circ>\<^sub>s \<theta>) ` X = \<delta> ` X \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subst_compose by fastforce
 
 lemma subst_ground_ident[dest?]: "fv t = {} \<Longrightarrow> t \<cdot> s = t"
 by (induct t, simp, metis subst_agreement empty_iff subst_apply_term_empty)
 
 lemma subst_ground_ident_compose:
   "fv (\<sigma> x) = {} \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<theta>) x = \<sigma> x"
   "fv (t \<cdot> \<sigma>) = {} \<Longrightarrow> t \<cdot> (\<sigma> \<circ>\<^sub>s \<theta>) = t \<cdot> \<sigma>"
 using subst_subst_compose[of t \<sigma> \<theta>]
 by (simp_all add: subst_compose_def subst_ground_ident)
 
 lemma subst_all_ground_ident[dest?]: "ground M \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s = M"
 proof -
   assume "ground M"
   hence "\<And>t. t \<in> M \<Longrightarrow> fv t = {}" by auto
   hence "\<And>t. t \<in> M \<Longrightarrow> t \<cdot> s = t" by (metis subst_ground_ident)
   moreover have "\<And>t. t \<in> M \<Longrightarrow> t \<cdot> s \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t s" by (metis imageI)
   ultimately show "M \<cdot>\<^sub>s\<^sub>e\<^sub>t s = M" by (simp add: image_cong)
 qed
 
 lemma subst_eqI[intro]: "(\<And>t. t \<cdot> \<sigma> = t \<cdot> \<theta>) \<Longrightarrow> \<sigma> = \<theta>"
 proof -
   assume "\<And>t. t \<cdot> \<sigma> = t \<cdot> \<theta>"
   hence "\<And>v. Var v \<cdot> \<sigma> = Var v \<cdot> \<theta>" by auto
   thus "\<sigma> = \<theta>" by auto
 qed
 
 lemma subst_cong: "\<lbrakk>\<sigma> = \<sigma>'; \<theta> = \<theta>'\<rbrakk> \<Longrightarrow> (\<sigma> \<circ>\<^sub>s \<theta>) = (\<sigma>' \<circ>\<^sub>s \<theta>')"
 by auto
 
 lemma subst_mgt_bot[simp]: "Var \<preceq>\<^sub>\<circ> \<theta>"
 by simp
 
 lemma subst_mgt_refl[simp]: "\<theta> \<preceq>\<^sub>\<circ> \<theta>"
 by (metis var_comp(1))
 
 lemma subst_mgt_trans: "\<lbrakk>\<theta> \<preceq>\<^sub>\<circ> \<delta>; \<delta> \<preceq>\<^sub>\<circ> \<sigma>\<rbrakk> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<sigma>"
 by (metis subst_compose_assoc)
 
 lemma subst_mgt_comp: "\<theta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<delta>"
 by auto
 
 lemma subst_mgt_comp': "\<theta> \<circ>\<^sub>s \<delta> \<preceq>\<^sub>\<circ> \<sigma> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<sigma>"
 by (metis subst_compose_assoc)
 
 lemma var_self: "(\<lambda>w. if w = v then Var v else Var w) = Var"
 using subst_agreement by auto
 
 lemma var_same[simp]: "Var(v := t) = Var \<longleftrightarrow> t = Var v"
 by (intro iffI, metis fun_upd_same, simp add: var_self)
 
 lemma subst_eq_if_eq_vars: "(\<And>v. (Var v) \<cdot> \<theta> = (Var v) \<cdot> \<sigma>) \<Longrightarrow> \<theta> = \<sigma>"
 by (auto simp add: subst_agreement)
 
 lemma subst_all_empty[simp]: "{} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = {}"
 by simp
 
 lemma subst_all_insert:"(insert t M) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta> = insert (t \<cdot> \<delta>) (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by auto
 
 lemma subst_apply_fv_subset: "fv t \<subseteq> V \<Longrightarrow> fv (t \<cdot> \<delta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V)"
 by (induct t) auto
 
 lemma subst_apply_fv_empty:
   assumes "fv t = {}"
   shows "fv (t \<cdot> \<sigma>) = {}"
 using assms subst_apply_fv_subset[of t "{}" \<sigma>]
 by auto
 
 lemma subst_compose_fv:
   assumes "fv (\<theta> x) = {}"
   shows "fv ((\<theta> \<circ>\<^sub>s \<sigma>) x) = {}"
 using assms subst_apply_fv_empty
 unfolding subst_compose_def by fast
 
 lemma subst_compose_fv':
   fixes \<theta> \<sigma>::"('a,'b) subst"
   assumes "y \<in> fv ((\<theta> \<circ>\<^sub>s \<sigma>) x)"
   shows "\<exists>z. z \<in> fv (\<theta> x)"
 using assms subst_compose_fv
 by fast
 
 lemma subst_apply_fv_unfold: "fv (t \<cdot> \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv t)"
 by (induct t) auto
 
 lemma subst_apply_fv_unfold_set: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>s\<^sub>e\<^sub>t (set ts)) = fv\<^sub>s\<^sub>e\<^sub>t (set ts \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)"
 by (simp add: subst_apply_fv_unfold)
 
 lemma subst_apply_fv_unfold': "fv (t \<cdot> \<delta>) = (\<Union>v \<in> fv t. fv (\<delta> v))"
 using subst_apply_fv_unfold by simp
 
 lemma subst_apply_fv_union: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv (t \<cdot> \<delta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t))"
 proof -
   have "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (V \<union> fv t)) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` V) \<union> fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv t)" by auto
   thus ?thesis using subst_apply_fv_unfold by metis
 qed
 
 lemma subst_elimI[intro]: "(\<And>t. v \<notin> fv (t \<cdot> \<sigma>)) \<Longrightarrow> subst_elim \<sigma> v"
 by (auto simp add: subst_elim_def)
 
 lemma subst_elimI'[intro]: "(\<And>w. v \<notin> fv (Var w \<cdot> \<theta>)) \<Longrightarrow> subst_elim \<theta> v"
 by (simp add: subst_elim_def subst_apply_fv_unfold') 
 
 lemma subst_elimD[dest]: "subst_elim \<sigma> v \<Longrightarrow> v \<notin> fv (t \<cdot> \<sigma>)"
 by (auto simp add: subst_elim_def)
 
 lemma subst_elimD'[dest]: "subst_elim \<sigma> v \<Longrightarrow> \<sigma> v \<noteq> Var v"
 by (metis subst_elim_def subst_apply_term.simps(1) term.set_intros(3))
 
 lemma subst_elimD''[dest]: "subst_elim \<sigma> v \<Longrightarrow> v \<notin> fv (\<sigma> w)"
 by (metis subst_elim_def subst_apply_term.simps(1))
 
 lemma subst_elim_rm_vars_dest[dest]:
   "subst_elim (\<sigma>::('a,'b) subst) v \<Longrightarrow> v \<notin> vs \<Longrightarrow> subst_elim (rm_vars vs \<sigma>) v"
 proof -
   assume assms: "subst_elim \<sigma> v" "v \<notin> vs"
   obtain f::"('a, 'b) subst \<Rightarrow> 'b \<Rightarrow> 'b" where
       "\<forall>\<sigma> v. (\<exists>w. v \<in> fv (Var w \<cdot> \<sigma>)) = (v \<in> fv (Var (f \<sigma> v) \<cdot> \<sigma>))"
     by moura
   hence *: "\<forall>a \<sigma>. a \<in> fv (Var (f \<sigma> a) \<cdot> \<sigma>) \<or> subst_elim \<sigma> a" by blast
   have "Var (f (rm_vars vs \<sigma>) v) \<cdot> \<sigma> \<noteq> Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>
         \<or> v \<notin> fv (Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>)"
     using assms(1) by fastforce
   moreover
   { assume "Var (f (rm_vars vs \<sigma>) v) \<cdot> \<sigma> \<noteq> Var (f (rm_vars vs \<sigma>) v) \<cdot> rm_vars vs \<sigma>"
     hence "rm_vars vs \<sigma> (f (rm_vars vs \<sigma>) v) \<noteq> \<sigma> (f (rm_vars vs \<sigma>) v)" by auto
     hence "f (rm_vars vs \<sigma>) v \<in> vs" by meson
     hence ?thesis using * assms(2) by force
   }
   ultimately show ?thesis using * by blast
 qed
 
 lemma occs_subst_elim: "\<not>Var v \<sqsubset> t \<Longrightarrow> subst_elim (Var(v := t)) v \<or> (Var(v := t)) = Var"
 proof (cases "Var v = t")
   assume "Var v \<noteq> t" "\<not>Var v \<sqsubset> t"
   hence "v \<notin> fv t" by (simp add: vars_iff_subterm_or_eq)
   thus ?thesis by (auto simp add: subst_remove_var)
 qed auto
 
 lemma occs_subst_elim': "\<not>Var v \<sqsubseteq> t \<Longrightarrow> subst_elim (Var(v := t)) v"
 proof -
   assume "\<not>Var v \<sqsubseteq> t"
   hence "v \<notin> fv t" by (auto simp add: vars_iff_subterm_or_eq)
   thus "subst_elim (Var(v := t)) v" by (simp add: subst_elim_def subst_remove_var)
 qed
 
 lemma subst_elim_comp: "subst_elim \<theta> v \<Longrightarrow> subst_elim (\<delta> \<circ>\<^sub>s \<theta>) v"
 by (auto simp add: subst_elim_def)
 
 lemma var_subst_idem: "subst_idem Var"
 by (simp add: subst_idem_def)
 
 lemma var_upd_subst_idem:
   assumes "\<not>Var v \<sqsubseteq> t" shows "subst_idem (Var(v := t))"
 unfolding subst_idem_def
 proof
   let ?\<theta> = "Var(v := t)"
   from assms have t_\<theta>_id: "t \<cdot> ?\<theta> = t" by blast
   fix s show "s \<cdot> (?\<theta> \<circ>\<^sub>s ?\<theta>) = s \<cdot> ?\<theta>"
     unfolding subst_compose_def
     by (induction s, metis t_\<theta>_id fun_upd_def subst_apply_term.simps(1), simp) 
 qed
 
 lemma zip_map_subst:
   "zip xs (xs \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) = map (\<lambda>t. (t, t \<cdot> \<delta>)) xs"
 by (induction xs) auto
 
 lemma map2_map_subst:
   "map2 f xs (xs \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>) = map (\<lambda>t. f t (t \<cdot> \<delta>)) xs"
 by (induction xs) auto
 
 
 subsection \<open>Lemmata: Domain and Range of Substitutions\<close>
 lemma range_vars_alt_def: "range_vars s \<equiv> fv\<^sub>s\<^sub>e\<^sub>t (subst_range s)"
 unfolding range_vars_def by simp
 
 lemma subst_dom_var_finite[simp]: "finite (subst_domain Var)" by simp
 
 lemma subst_range_Var[simp]: "subst_range Var = {}" by simp
 
 lemma range_vars_Var[simp]: "range_vars Var = {}" by fastforce
 
 lemma finite_subst_img_if_finite_dom: "finite (subst_domain \<sigma>) \<Longrightarrow> finite (range_vars \<sigma>)"
 unfolding range_vars_alt_def by auto
 
 lemma finite_subst_img_if_finite_dom': "finite (subst_domain \<sigma>) \<Longrightarrow> finite (subst_range \<sigma>)"
 by auto
 
 lemma subst_img_alt_def: "subst_range s = {t. \<exists>v. s v = t \<and> t \<noteq> Var v}"
 by (auto simp add: subst_domain_def)
 
 lemma subst_fv_img_alt_def: "range_vars s = (\<Union>t \<in> {t. \<exists>v. s v = t \<and> t \<noteq> Var v}. fv t)"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_domI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> v \<in> subst_domain \<sigma>"
 by (simp add: subst_domain_def)
 
 lemma subst_imgI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> \<sigma> v \<in> subst_range \<sigma>"
 by (simp add: subst_domain_def)
 
 lemma subst_fv_imgI[intro]: "\<sigma> v \<noteq> Var v \<Longrightarrow> fv (\<sigma> v) \<subseteq> range_vars \<sigma>"
 unfolding range_vars_alt_def by auto
 
 lemma subst_eqI':
   assumes "t \<cdot> \<delta> = t \<cdot> \<theta>" "subst_domain \<delta> = subst_domain \<theta>" "subst_domain \<delta> \<subseteq> fv t"
   shows "\<delta> = \<theta>"
 by (metis assms(2,3) term_subst_eq_rev[OF assms(1)] in_mono ext subst_domI)
 
 lemma subst_domain_subst_Fun_single[simp]:
   "subst_domain (Var(x := Fun f T)) = {x}" (is "?A = ?B")
 unfolding subst_domain_def by simp
 
 lemma subst_range_subst_Fun_single[simp]:
   "subst_range (Var(x := Fun f T)) = {Fun f T}" (is "?A = ?B")
 by simp
 
 lemma range_vars_subst_Fun_single[simp]:
   "range_vars (Var(x := Fun f T)) = fv (Fun f T)"
 unfolding range_vars_alt_def by force
 
 lemma var_renaming_is_Fun_iff:
   assumes "subst_range \<delta> \<subseteq> range Var"
   shows "is_Fun t = is_Fun (t \<cdot> \<delta>)"
 proof (cases t)
   case (Var x)
   hence "\<exists>y. \<delta> x = Var y" using assms by auto
   thus ?thesis using Var by auto
 qed simp
 
 lemma subst_fv_dom_img_subset: "fv t \<subseteq> subst_domain \<theta> \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> range_vars \<theta>"
 unfolding range_vars_alt_def by (induct t) auto
 
 lemma subst_fv_dom_img_subset_set: "fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subst_domain \<theta> \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> range_vars \<theta>"
 proof -
   assume assms: "fv\<^sub>s\<^sub>e\<^sub>t M \<subseteq> subst_domain \<theta>"
   obtain f::"'a set \<Rightarrow> (('b, 'a) term \<Rightarrow> 'a set) \<Rightarrow> ('b, 'a) terms \<Rightarrow> ('b, 'a) term" where
       "\<forall>x y z. (\<exists>v. v \<in> z \<and> \<not> y v \<subseteq> x) \<longleftrightarrow> (f x y z \<in> z \<and> \<not> y (f x y z) \<subseteq> x)"
     by moura
   hence *:
       "\<forall>T g A. (\<not> \<Union> (g ` T) \<subseteq> A \<or> (\<forall>t. t \<notin> T \<or> g t \<subseteq> A)) \<and>
                (\<Union> (g ` T) \<subseteq> A \<or> f A g T \<in> T \<and> \<not> g (f A g T) \<subseteq> A)"
     by (metis (no_types) SUP_le_iff)
   hence **: "\<forall>t. t \<notin> M \<or> fv t \<subseteq> subst_domain \<theta>" by (metis (no_types) assms fv\<^sub>s\<^sub>e\<^sub>t.simps)
   have "\<forall>t::('b, 'a) term. \<forall>f T. t \<notin> f ` T \<or> (\<exists>t'::('b, 'a) term. t = f t' \<and> t' \<in> T)" by blast
   hence "f (range_vars \<theta>) fv (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<notin> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<or>
          fv (f (range_vars \<theta>) fv (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)) \<subseteq> range_vars \<theta>"
     by (metis (full_types) ** subst_fv_dom_img_subset)
   thus ?thesis by (metis (no_types) * fv\<^sub>s\<^sub>e\<^sub>t.simps)
 qed
 
 lemma subst_fv_dom_ground_if_ground_img:
   assumes "fv t \<subseteq> subst_domain s" "ground (subst_range s)"
   shows "fv (t \<cdot> s) = {}"
 using subst_fv_dom_img_subset[OF assms(1)] assms(2) by force
 
 lemma subst_fv_dom_ground_if_ground_img':
   assumes "fv t \<subseteq> subst_domain s" "\<And>x. x \<in> subst_domain s \<Longrightarrow> fv (s x) = {}"
   shows "fv (t \<cdot> s) = {}"
 using subst_fv_dom_ground_if_ground_img[OF assms(1)] assms(2) by auto
 
 lemma subst_fv_unfold: "fv (t \<cdot> s) = (fv t - subst_domain s) \<union> fv\<^sub>s\<^sub>e\<^sub>t (s ` (fv t \<inter> subst_domain s))"
 proof (induction t)
   case (Var v) thus ?case
   proof (cases "v \<in> subst_domain s")
     case True thus ?thesis by auto
   next
     case False
     hence "fv (Var v \<cdot> s) = {v}" "fv (Var v) \<inter> subst_domain s = {}" by auto
     thus ?thesis by auto
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_fv_unfold_ground_img: "range_vars s = {} \<Longrightarrow> fv (t \<cdot> s) = fv t - subst_domain s"
 using subst_fv_unfold[of t s] unfolding range_vars_alt_def by auto
 
 lemma subst_img_update:
   "\<lbrakk>\<sigma> v = Var v; t \<noteq> Var v\<rbrakk> \<Longrightarrow> range_vars (\<sigma>(v := t)) = range_vars \<sigma> \<union> fv t"
 proof -
   assume "\<sigma> v = Var v" "t \<noteq> Var v"
   hence "(\<Union>s \<in> {s. \<exists>w. (\<sigma>(v := t)) w = s \<and> s \<noteq> Var w}. fv s) = fv t \<union> range_vars \<sigma>"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   thus "range_vars (\<sigma>(v := t)) = range_vars \<sigma> \<union> fv t"
     by (metis Un_commute subst_fv_img_alt_def)
 qed
 
 lemma subst_dom_update1: "v \<notin> subst_domain \<sigma> \<Longrightarrow> subst_domain (\<sigma>(v := Var v)) = subst_domain \<sigma>"
 by (auto simp add: subst_domain_def)
 
 lemma subst_dom_update2: "t \<noteq> Var v \<Longrightarrow> subst_domain (\<sigma>(v := t)) = insert v (subst_domain \<sigma>)"
 by (auto simp add: subst_domain_def)
 
 lemma subst_dom_update3: "t = Var v \<Longrightarrow> subst_domain (\<sigma>(v := t)) = subst_domain \<sigma> - {v}"
 by (auto simp add: subst_domain_def)
 
 lemma var_not_in_subst_dom[elim]: "v \<notin> subst_domain s \<Longrightarrow> s v = Var v"
 by (simp add: subst_domain_def)
 
 lemma subst_dom_vars_in_subst[elim]: "v \<in> subst_domain s \<Longrightarrow> s v \<noteq> Var v"
 by (simp add: subst_domain_def)
 
 lemma subst_not_dom_fixed: "\<lbrakk>v \<in> fv t; v \<notin> subst_domain s\<rbrakk> \<Longrightarrow> v \<in> fv (t \<cdot> s)" by (induct t) auto
 
 lemma subst_not_img_fixed: "\<lbrakk>v \<in> fv (t \<cdot> s); v \<notin> range_vars s\<rbrakk> \<Longrightarrow> v \<in> fv t"
 unfolding range_vars_alt_def by (induct t) force+
 
 lemma ground_range_vars[intro]: "ground (subst_range s) \<Longrightarrow> range_vars s = {}"
 unfolding range_vars_alt_def by metis
 
 lemma ground_subst_no_var[intro]: "ground (subst_range s) \<Longrightarrow> x \<notin> range_vars s"
 using ground_range_vars[of s] by blast
 
 lemma ground_img_obtain_fun:
   assumes "ground (subst_range s)" "x \<in> subst_domain s"
   obtains f T where "s x = Fun f T" "Fun f T \<in> subst_range s" "fv (Fun f T) = {}"
 proof -
   from assms(2) obtain t where t: "s x = t" "t \<in> subst_range s" by moura
   hence "fv t = {}" using assms(1) by auto
   thus ?thesis using t that by (cases t) simp_all
 qed
 
 lemma ground_term_subst_domain_fv_subset:
   "fv (t \<cdot> \<delta>) = {} \<Longrightarrow> fv t \<subseteq> subst_domain \<delta>"
 by (induct t) auto
 
 lemma ground_subst_range_empty_fv:
   "ground (subst_range \<theta>) \<Longrightarrow> x \<in> subst_domain \<theta> \<Longrightarrow> fv (\<theta> x) = {}"
 by simp
 
 lemma subst_Var_notin_img: "x \<notin> range_vars s \<Longrightarrow> t \<cdot> s = Var x \<Longrightarrow> t = Var x"
 using subst_not_img_fixed[of x t s] by (induct t) auto
 
 lemma fv_in_subst_img: "\<lbrakk>s v = t; t \<noteq> Var v\<rbrakk> \<Longrightarrow> fv t \<subseteq> range_vars s"
 unfolding range_vars_alt_def by auto
 
 lemma empty_dom_iff_empty_subst: "subst_domain \<theta> = {} \<longleftrightarrow> \<theta> = Var" by auto
 
 lemma subst_dom_cong: "(\<And>v t. \<theta> v = t \<Longrightarrow> \<delta> v = t) \<Longrightarrow> subst_domain \<theta> \<subseteq> subst_domain \<delta>"
 by (auto simp add: subst_domain_def)
 
 lemma subst_img_cong: "(\<And>v t. \<theta> v = t \<Longrightarrow> \<delta> v = t) \<Longrightarrow> range_vars \<theta> \<subseteq> range_vars \<delta>"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_dom_elim: "subst_domain s \<inter> range_vars s = {} \<Longrightarrow> fv (t \<cdot> s) \<inter> subst_domain s = {}"
 proof (induction t)
   case (Var v) thus ?case
     using fv_in_subst_img[of s] 
     by (cases "s v = Var v") (auto simp add: subst_domain_def)
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_dom_insert_finite: "finite (subst_domain s) = finite (subst_domain (s(v := t)))"
 proof
   assume "finite (subst_domain s)"
   have "subst_domain (s(v := t)) \<subseteq> insert v (subst_domain s)" by (auto simp add: subst_domain_def)
   thus "finite (subst_domain (s(v := t)))"
     by (meson \<open>finite (subst_domain s)\<close> finite_insert rev_finite_subset)
 next
   assume *: "finite (subst_domain (s(v := t)))"
   hence "finite (insert v (subst_domain s))"
   proof (cases "t = Var v")
     case True
     hence "finite (subst_domain s - {v})" by (metis * subst_dom_update3)
     thus ?thesis by simp
   qed (metis * subst_dom_update2[of t v s])
   thus "finite (subst_domain s)" by simp
 qed
 
 lemma trm_subst_disj: "t \<cdot> \<theta> = t \<Longrightarrow> fv t \<inter> subst_domain \<theta> = {}"
 proof (induction t)
   case (Fun f X)
   hence "map (\<lambda>x. x \<cdot> \<theta>) X = X" by simp
   hence "\<And>x. x \<in> set X \<Longrightarrow> x \<cdot> \<theta> = x" using map_eq_conv by fastforce
   thus ?case using Fun.IH by auto
 qed (simp add: subst_domain_def)
 
 lemma trm_subst_ident[intro]: "fv t \<inter> subst_domain \<theta> = {} \<Longrightarrow> t \<cdot> \<theta> = t"
 proof -
   assume "fv t \<inter> subst_domain \<theta> = {}"
   hence "\<forall>v \<in> fv t. \<forall>w \<in> subst_domain \<theta>. v \<noteq> w" by auto
   thus ?thesis
     by (metis subst_agreement subst_apply_term.simps(1) subst_apply_term_empty subst_domI)
 qed
 
 lemma trm_subst_ident'[intro]: "v \<notin> subst_domain \<theta> \<Longrightarrow> (Var v) \<cdot> \<theta> = Var v"
 using trm_subst_ident by (simp add: subst_domain_def)
 
 lemma trm_subst_ident''[intro]: "(\<And>x. x \<in> fv t \<Longrightarrow> \<theta> x = Var x) \<Longrightarrow> t \<cdot> \<theta> = t"
 proof -
   assume "\<And>x. x \<in> fv t \<Longrightarrow> \<theta> x = Var x"
   hence "fv t \<inter> subst_domain \<theta> = {}" by (auto simp add: subst_domain_def)
   thus ?thesis using trm_subst_ident by auto
 qed
 
 lemma set_subst_ident: "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> subst_domain \<theta> = {} \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = M"
 proof -
   assume "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> subst_domain \<theta> = {}"
   hence "\<forall>t \<in> M. t \<cdot> \<theta> = t" by auto
   thus ?thesis by force
 qed
 
 lemma trm_subst_ident_subterms[intro]:
   "fv t \<inter> subst_domain \<theta> = {} \<Longrightarrow> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = subterms t"
 using set_subst_ident[of "subterms t" \<theta>] fv_subterms[of t] by simp
 
 lemma trm_subst_ident_subterms'[intro]:
   "v \<notin> fv t \<Longrightarrow> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t Var(v := s) = subterms t"
 using trm_subst_ident_subterms[of t "Var(v := s)"]
 by (meson subst_no_occs trm_subst_disj vars_iff_subtermeq) 
 
 lemma const_mem_subst_cases:
   assumes "Fun c [] \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   shows "Fun c [] \<in> M \<or> Fun c [] \<in> \<theta> ` fv\<^sub>s\<^sub>e\<^sub>t M"
 proof -
   obtain m where m: "m \<in> M" "m \<cdot> \<theta> = Fun c []" using assms by auto
   thus ?thesis by (cases m) force+
 qed
 
 lemma const_mem_subst_cases':
   assumes "Fun c [] \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   shows "Fun c [] \<in> M \<or> Fun c [] \<in> subst_range \<theta>"
 using const_mem_subst_cases[OF assms] by force
 
 lemma fv_subterms_substI[intro]: "y \<in> fv t \<Longrightarrow> \<theta> y \<in> subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using image_iff vars_iff_subtermeq by fastforce 
 
 lemma fv_subterms_subst_eq[simp]: "fv\<^sub>s\<^sub>e\<^sub>t (subterms (t \<cdot> \<theta>)) = fv\<^sub>s\<^sub>e\<^sub>t (subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using fv_subterms by (induct t) force+
 
 lemma fv_subterms_set_subst: "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>))"
 using fv_subterms_subst_eq[of _ \<theta>] by auto
 
 lemma fv_subterms_set_subst': "fv\<^sub>s\<^sub>e\<^sub>t (subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using fv_subterms_set[of "M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"] fv_subterms_set_subst[of \<theta> M] by simp
 
 lemma fv_subst_subset: "x \<in> fv t \<Longrightarrow> fv (\<theta> x) \<subseteq> fv (t \<cdot> \<theta>)"
 by (metis fv_subset image_eqI subst_apply_fv_unfold)
 
 lemma fv_subst_subset': "fv s \<subseteq> fv t \<Longrightarrow> fv (s \<cdot> \<theta>) \<subseteq> fv (t \<cdot> \<theta>)"
 using fv_subst_subset by (induct s) force+
 
 lemma fv_subst_obtain_var:
   fixes \<delta>::"('a,'b) subst"
   assumes "x \<in> fv (t \<cdot> \<delta>)"
   shows "\<exists>y \<in> fv t. x \<in> fv (\<delta> y)"
 using assms by (induct t) force+
 
 lemma set_subst_all_ident: "fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<inter> subst_domain \<delta> = {} \<Longrightarrow> M \<cdot>\<^sub>s\<^sub>e\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>) = M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 by (metis set_subst_ident subst_comp_all)
 
 lemma subterms_subst:
   "subterms (t \<cdot> d) = (subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t d) \<union> subterms\<^sub>s\<^sub>e\<^sub>t (d ` (fv t \<inter> subst_domain d))"
 by (induct t) (auto simp add: subst_domain_def)
 
 lemma subterms_subst':
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv t. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
   shows "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> subst_domain \<theta>")
     case True
     hence "(\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)" using Var by simp
     hence "subterms (\<theta> x) = {\<theta> x}" by auto
     thus ?thesis by simp
   qed auto
 qed auto
 
 lemma subterms_subst'':
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using subterms_subst'[of _ \<theta>] assms by auto
 
 lemma subterms_subst_subterm:
   fixes \<theta>::"('a,'b) subst"
   assumes "\<forall>x \<in> fv a. (\<exists>f. \<theta> x = Fun f []) \<or> (\<exists>y. \<theta> x = Var y)"
     and "b \<in> subterms (a \<cdot> \<theta>)"
   shows "\<exists>c \<in> subterms a. c \<cdot> \<theta> = b"
 using subterms_subst'[OF assms(1)] assms(2) by auto
 
 lemma subterms_subst_subset: "subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<subseteq> subterms (t \<cdot> \<sigma>)"
 by (induct t) auto
 
 lemma subterms_subst_subset': "subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>)"
 using subterms_subst_subset by fast
 
 lemma subterms\<^sub>s\<^sub>e\<^sub>t_subst:
   fixes \<theta>::"('a,'b) subst"
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. t \<in> subterms (\<theta> x))"
 using assms subterms_subst[of _ \<theta>] by auto
 
 lemma rm_vars_dom: "subst_domain (rm_vars V s) = subst_domain s - V"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_dom_subset: "subst_domain (rm_vars V s) \<subseteq> subst_domain s"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_dom_eq':
   "subst_domain (rm_vars (UNIV - V) s) = subst_domain s \<inter> V"
 using rm_vars_dom[of "UNIV - V" s] by blast
 
 lemma rm_vars_dom_eqI:
   assumes "t \<cdot> \<delta> = t \<cdot> \<theta>"
   shows "subst_domain (rm_vars (UNIV - fv t) \<delta>) = subst_domain (rm_vars (UNIV - fv t) \<theta>)"
 by (meson assms Diff_iff UNIV_I term_subst_eq_rev)
 
 lemma rm_vars_img: "subst_range (rm_vars V s) = s ` subst_domain (rm_vars V s)"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_img_subset: "subst_range (rm_vars V s) \<subseteq> subst_range s"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_img_fv_subset: "range_vars (rm_vars V s) \<subseteq> range_vars s"
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma rm_vars_fv_obtain:
   assumes "x \<in> fv (t \<cdot> rm_vars X \<theta>) - X"
   shows "\<exists>y \<in> fv t - X. x \<in> fv (rm_vars X \<theta> y)"
 using assms by (induct t) (fastforce, force)
 
 lemma rm_vars_apply: "v \<in> subst_domain (rm_vars V s) \<Longrightarrow> (rm_vars V s) v = s v"
 by (auto simp add: subst_domain_def)
 
 lemma rm_vars_apply': "subst_domain \<delta> \<inter> vs = {} \<Longrightarrow> rm_vars vs \<delta> = \<delta>"
 by force
 
 lemma rm_vars_ident: "fv t \<inter> vs = {} \<Longrightarrow> t \<cdot> (rm_vars vs \<theta>) = t \<cdot> \<theta>"
 by (induct t) auto
 
 lemma rm_vars_fv_subset: "fv (t \<cdot> rm_vars X \<theta>) \<subseteq> fv t \<union> fv (t \<cdot> \<theta>)"
 by (induct t) auto
 
 lemma rm_vars_fv_disj:
   assumes "fv t \<inter> X = {}" "fv (t \<cdot> \<theta>) \<inter> X = {}"
   shows "fv (t \<cdot> rm_vars X \<theta>) \<inter> X = {}"
 using rm_vars_ident[OF assms(1)] assms(2) by auto
 
 lemma rm_vars_ground_supports:
   assumes "ground (subst_range \<theta>)"
   shows "rm_vars X \<theta> supports \<theta>"
 proof
   fix x
   have *: "ground (subst_range (rm_vars X \<theta>))"
     using rm_vars_img_subset[of X \<theta>] assms
     by (auto simp add: subst_domain_def)
   show "rm_vars X \<theta> x \<cdot> \<theta> = \<theta> x "
   proof (cases "x \<in> subst_domain (rm_vars X \<theta>)")
     case True
     hence "fv (rm_vars X \<theta> x) = {}" using * by auto
     thus ?thesis using True by auto
   qed (simp add: subst_domain_def)
 qed
 
 lemma rm_vars_split:
   assumes "ground (subst_range \<theta>)"
   shows "\<theta> = rm_vars X \<theta> \<circ>\<^sub>s rm_vars (subst_domain \<theta> - X) \<theta>"
 proof -
   let ?s1 = "rm_vars X \<theta>"
   let ?s2 = "rm_vars (subst_domain \<theta> - X) \<theta>"
 
   have doms: "subst_domain ?s1 \<subseteq> subst_domain \<theta>" "subst_domain ?s2 \<subseteq> subst_domain \<theta>"
     by (auto simp add: subst_domain_def)
 
   { fix x assume "x \<notin> subst_domain \<theta>"
     hence "\<theta> x = Var x" "?s1 x = Var x" "?s2 x = Var x" using doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose_def)
   } moreover {
     fix x assume "x \<in> subst_domain \<theta>" "x \<in> X"
     hence "?s1 x = Var x" "?s2 x = \<theta> x" using doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose_def)
   } moreover {
     fix x assume "x \<in> subst_domain \<theta>" "x \<notin> X"
     hence "?s1 x = \<theta> x" "fv (\<theta> x) = {}" using assms doms by auto
     hence "\<theta> x = (?s1 \<circ>\<^sub>s ?s2) x" by (simp add: subst_compose subst_ground_ident)
   } ultimately show ?thesis by blast
 qed
 
 lemma rm_vars_fv_img_disj:
   assumes "fv t \<inter> X = {}" "X \<inter> range_vars \<theta> = {}"
   shows "fv (t \<cdot> rm_vars X \<theta>) \<inter> X = {}"
 using assms
 proof (induction t)
   case (Var x)
   hence *: "(rm_vars X \<theta>) x = \<theta> x" by auto
   show ?case
   proof (cases "x \<in> subst_domain \<theta>")
     case True
     hence "\<theta> x \<in> subst_range \<theta>" by auto
     hence "fv (\<theta> x) \<inter> X = {}" using Var.prems(2) unfolding range_vars_alt_def by fastforce
     thus ?thesis using * by auto
   next
     case False thus ?thesis using Var.prems(1) by auto
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma subst_apply_dom_ident: "t \<cdot> \<theta> = t \<Longrightarrow> subst_domain \<delta> \<subseteq> subst_domain \<theta> \<Longrightarrow> t \<cdot> \<delta> = t"
 proof (induction t)
   case (Fun f T) thus ?case by (induct T) auto
 qed (auto simp add: subst_domain_def)
 
 lemma rm_vars_subst_apply_ident:
   assumes "t \<cdot> \<theta> = t"
   shows "t \<cdot> (rm_vars vs \<theta>) = t"
 using rm_vars_dom[of vs \<theta>] subst_apply_dom_ident[OF assms, of "rm_vars vs \<theta>"] by auto
 
 lemma rm_vars_subst_eq:
   "t \<cdot> \<delta> = t \<cdot> rm_vars (subst_domain \<delta> - subst_domain \<delta> \<inter> fv t) \<delta>"
 by (auto intro: term_subst_eq)
 
 lemma rm_vars_subst_eq':
   "t \<cdot> \<delta> = t \<cdot> rm_vars (UNIV - fv t) \<delta>"
 by (auto intro: term_subst_eq)
 
 lemma rm_vars_comp:
   assumes "range_vars \<delta> \<inter> vs = {}"
   shows "t \<cdot> rm_vars vs (\<delta> \<circ>\<^sub>s \<theta>) = t \<cdot> (rm_vars vs \<delta> \<circ>\<^sub>s rm_vars vs \<theta>)"
 using assms
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> vs")
     case True thus ?thesis using Var by auto
   next
     case False
     have "subst_domain (rm_vars vs \<theta>) \<inter> vs = {}" by (auto simp add: subst_domain_def)
     moreover have "fv (\<delta> x) \<inter> vs = {}"
       using Var False unfolding range_vars_alt_def by force
     ultimately have "\<delta> x \<cdot> (rm_vars vs \<theta>) = \<delta> x \<cdot> \<theta>"
       using rm_vars_ident by (simp add: subst_domain_def)
     moreover have "(rm_vars vs (\<delta> \<circ>\<^sub>s \<theta>)) x = (\<delta> \<circ>\<^sub>s \<theta>) x" by (metis False)
     ultimately show ?thesis using subst_compose by auto
   qed
 next
   case Fun thus ?case by auto
 qed
 
 lemma rm_vars_fv\<^sub>s\<^sub>e\<^sub>t_subst:
   assumes "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (rm_vars X \<theta> ` Y)"
   shows "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` Y) \<or> x \<in> X"
 using assms by auto
 
 lemma disj_dom_img_var_notin:
   assumes "subst_domain \<theta> \<inter> range_vars \<theta> = {}" "\<theta> v = t" "t \<noteq> Var v"
   shows "v \<notin> fv t" "\<forall>v \<in> fv (t \<cdot> \<theta>). v \<notin> subst_domain \<theta>"
 proof -
   have "v \<in> subst_domain \<theta>" "fv t \<subseteq> range_vars \<theta>"
     using fv_in_subst_img[of \<theta> v t, OF assms(2)] assms(2,3)
     by (auto simp add: subst_domain_def)
   thus "v \<notin> fv t" using assms(1) by auto
 
   have *: "fv t \<inter> subst_domain \<theta> = {}"
     using assms(1) \<open>fv t \<subseteq> range_vars \<theta>\<close>
     by auto
   hence "t \<cdot> \<theta> = t" by blast
   thus "\<forall>v \<in> fv (t \<cdot> \<theta>). v \<notin> subst_domain \<theta>" using * by auto
 qed
 
 lemma subst_sends_dom_to_img: "v \<in> subst_domain \<theta> \<Longrightarrow> fv (Var v \<cdot> \<theta>) \<subseteq> range_vars \<theta>"
 unfolding range_vars_alt_def by auto
 
 lemma subst_sends_fv_to_img: "fv (t \<cdot> s) \<subseteq> fv t \<union> range_vars s"
 proof (induction t)
   case (Var v) thus ?case
   proof (cases "Var v \<cdot> s = Var v")
     case True thus ?thesis by simp
   next
     case False
     hence "v \<in> subst_domain s" by (meson trm_subst_ident') 
     hence "fv (Var v \<cdot> s) \<subseteq> range_vars s"
       using subst_sends_dom_to_img by simp
     thus ?thesis by auto
   qed
 next
   case Fun thus ?case by auto
 qed 
 
 lemma ident_comp_subst_trm_if_disj:
   assumes "subst_domain \<sigma> \<inter> range_vars \<theta> = {}" "v \<in> subst_domain \<theta>"
   shows "(\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v"
 proof -
   from assms have " subst_domain \<sigma> \<inter> fv (\<theta> v) = {}"
     using fv_in_subst_img unfolding range_vars_alt_def by auto
   thus "(\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v" unfolding subst_compose_def by blast
 qed
 
 lemma ident_comp_subst_trm_if_disj': "fv (\<theta> v) \<inter> subst_domain \<sigma> = {} \<Longrightarrow> (\<theta> \<circ>\<^sub>s \<sigma>) v = \<theta> v"
 unfolding subst_compose_def by blast
 
 lemma subst_idemI[intro]: "subst_domain \<sigma> \<inter> range_vars \<sigma> = {} \<Longrightarrow> subst_idem \<sigma>"
 using ident_comp_subst_trm_if_disj[of \<sigma> \<sigma>]
       var_not_in_subst_dom[of _ \<sigma>]
       subst_eq_if_eq_vars[of \<sigma>]
 by (metis subst_idem_def subst_compose_def var_comp(2)) 
 
 lemma subst_idemI'[intro]: "ground (subst_range \<sigma>) \<Longrightarrow> subst_idem \<sigma>"
 proof (intro subst_idemI)
   assume "ground (subst_range \<sigma>)"
   hence "range_vars \<sigma> = {}" by (metis ground_range_vars)
   thus "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}" by blast
 qed
 
 lemma subst_idemE: "subst_idem \<sigma> \<Longrightarrow> subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
 proof -
   assume "subst_idem \<sigma>"
   hence "\<And>v. fv (\<sigma> v) \<inter> subst_domain \<sigma> = {}"
     unfolding subst_idem_def subst_compose_def by (metis trm_subst_disj)
   thus ?thesis
     unfolding range_vars_alt_def by auto
 qed
 
 lemma subst_idem_rm_vars: "subst_idem \<theta> \<Longrightarrow> subst_idem (rm_vars X \<theta>)"
 proof -
   assume "subst_idem \<theta>"
   hence "subst_domain \<theta> \<inter> range_vars \<theta> = {}" by (metis subst_idemE)
   moreover have
       "subst_domain (rm_vars X \<theta>) \<subseteq> subst_domain \<theta>"
       "range_vars (rm_vars X \<theta>) \<subseteq> range_vars \<theta>"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   ultimately show ?thesis by blast
 qed
 
 lemma subst_fv_bounded_if_img_bounded: "range_vars \<theta> \<subseteq> fv t \<union> V \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv t \<union> V"
 proof (induction t)
   case (Var v) thus ?case unfolding range_vars_alt_def by (cases "\<theta> v = Var v") auto
 qed (metis (no_types, lifting) Un_assoc Un_commute subst_sends_fv_to_img sup.absorb_iff2)
 
 lemma subst_fv_bound_singleton: "fv (t \<cdot> Var(v := t')) \<subseteq> fv t \<union> fv t'"
 using subst_fv_bounded_if_img_bounded[of "Var(v := t')" t "fv t'"]
 unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
 
 lemma subst_fv_bounded_if_img_bounded':
   assumes "range_vars \<theta> \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 proof
   fix v assume *:  "v \<in> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   
   obtain t where t: "t \<in> M" "t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" "v \<in> fv (t \<cdot> \<theta>)"
   proof -
     assume **: "\<And>t. \<lbrakk>t \<in> M; t \<cdot> \<theta> \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>; v \<in> fv (t \<cdot> \<theta>)\<rbrakk> \<Longrightarrow> thesis"
     have "v \<in> \<Union> (fv ` ((\<lambda>t. t \<cdot> \<theta>) ` M))" using * by (metis fv\<^sub>s\<^sub>e\<^sub>t.simps)
     hence "\<exists>t. t \<in> M \<and> v \<in> fv (t \<cdot> \<theta>)" by blast
     thus ?thesis using ** imageI by blast
   qed
 
   from \<open>t \<in> M\<close> obtain M' where "t \<notin> M'" "M = insert t M'" by (meson Set.set_insert) 
   hence "fv\<^sub>s\<^sub>e\<^sub>t M = fv t \<union> fv\<^sub>s\<^sub>e\<^sub>t M'" by simp
   hence "fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M" using subst_fv_bounded_if_img_bounded assms by simp
   thus "v \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using assms \<open>v \<in> fv (t \<cdot> \<theta>)\<close> by auto
 qed
 
 lemma ground_img_if_ground_subst: "(\<And>v t. s v = t \<Longrightarrow> fv t = {}) \<Longrightarrow> range_vars s = {}"
 unfolding range_vars_alt_def by auto
 
 lemma ground_subst_fv_subset: "ground (subst_range \<theta>) \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv t"
 using subst_fv_bounded_if_img_bounded[of \<theta>]
 unfolding range_vars_alt_def by force
 
 lemma ground_subst_fv_subset': "ground (subst_range \<theta>) \<Longrightarrow> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
 using subst_fv_bounded_if_img_bounded'[of \<theta> M]
 unfolding range_vars_alt_def by auto
 
 lemma subst_to_var_is_var[elim]: "t \<cdot> s = Var v \<Longrightarrow> \<exists>w. t = Var w"
 using subst_apply_term.elims by blast
 
 lemma subst_dom_comp_inI:
   assumes "y \<notin> subst_domain \<sigma>"
     and "y \<in> subst_domain \<delta>"
   shows "y \<in> subst_domain (\<sigma> \<circ>\<^sub>s \<delta>)"
 using assms subst_domain_subst_compose[of \<sigma> \<delta>] by blast
 
 lemma subst_comp_notin_dom_eq:
   "x \<notin> subst_domain \<theta>1 \<Longrightarrow> (\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x"
 unfolding subst_compose_def by fastforce
 
 lemma subst_dom_comp_eq:
   assumes "subst_domain \<theta> \<inter> range_vars \<sigma> = {}"
   shows "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) = subst_domain \<theta> \<union> subst_domain \<sigma>"
 proof (rule ccontr)
   assume "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) \<noteq> subst_domain \<theta> \<union> subst_domain \<sigma>"
   hence "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) \<subset> subst_domain \<theta> \<union> subst_domain \<sigma>"
     using subst_domain_compose[of \<theta> \<sigma>] by (simp add: subst_domain_def)
   then obtain v where "v \<notin> subst_domain (\<theta> \<circ>\<^sub>s \<sigma>)" "v \<in> subst_domain \<theta> \<union> subst_domain \<sigma>" by auto
   hence v_in_some_subst: "\<theta> v \<noteq> Var v \<or> \<sigma> v \<noteq> Var v" and "\<theta> v \<cdot> \<sigma> = Var v"
     unfolding subst_compose_def by (auto simp add: subst_domain_def)
   then obtain w where "\<theta> v = Var w" using subst_to_var_is_var by fastforce
   show False
   proof (cases "v = w")
     case True
     hence "\<theta> v = Var v" using \<open>\<theta> v = Var w\<close> by simp
     hence "\<sigma> v \<noteq> Var v" using v_in_some_subst by simp
     thus False using \<open>\<theta> v = Var v\<close> \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> by simp
   next
     case False
     hence "v \<in> subst_domain \<theta>" using v_in_some_subst \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> by auto 
     hence "v \<notin> range_vars \<sigma>" using assms by auto
     moreover have "\<sigma> w = Var v" using \<open>\<theta> v \<cdot> \<sigma> = Var v\<close> \<open>\<theta> v = Var w\<close> by simp
     hence "v \<in> range_vars \<sigma>" using \<open>v \<noteq> w\<close> subst_fv_imgI[of \<sigma> w] by simp
     ultimately show False ..
   qed
 qed
 
 lemma subst_img_comp_subset[simp]:
   "range_vars (\<theta>1 \<circ>\<^sub>s \<theta>2) \<subseteq> range_vars \<theta>1 \<union> range_vars \<theta>2"
 proof
   let ?img = "range_vars"
   fix x assume "x \<in> ?img (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   then obtain v t where vt: "x \<in> fv t" "t = (\<theta>1 \<circ>\<^sub>s \<theta>2) v" "t \<noteq> Var v"
     unfolding range_vars_alt_def subst_compose_def by (auto simp add: subst_domain_def)
 
   { assume "x \<notin> ?img \<theta>1" hence "x \<in> ?img \<theta>2"
       by (metis (no_types, opaque_lifting) fv_in_subst_img Un_iff subst_compose_def 
                 vt subsetCE subst_apply_term.simps(1) subst_sends_fv_to_img)
   }
   thus "x \<in> ?img \<theta>1 \<union> ?img \<theta>2" by auto
 qed
 
 lemma subst_img_comp_subset':
   assumes "t \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   shows "t \<in> subst_range \<theta>2 \<or> (\<exists>t' \<in> subst_range \<theta>1. t = t' \<cdot> \<theta>2)"
 proof -
   obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = t" "t \<noteq> Var x"
     using assms by (auto simp add: subst_domain_def)
   { assume "x \<notin> subst_domain \<theta>1"
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     hence ?thesis using x by auto
   } moreover {
     assume "x \<in> subst_domain \<theta>1" hence ?thesis using subst_compose x(2) by fastforce 
   } ultimately show ?thesis by metis
 qed
 
 lemma subst_img_comp_subset'':
   "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) \<subseteq>
    subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
 proof
   fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2))"
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "t \<in> subterms ((\<theta>1 \<circ>\<^sub>s \<theta>2) x)"
     by auto
   show "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True thus ?thesis
       using subst_compose[of \<theta>1 \<theta>2] x(2) subterms_subst
       by fastforce
   next
     case False
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     thus ?thesis using x by (auto simp add: subst_domain_def)
   qed
 qed
 
 lemma subst_img_comp_subset''':
   "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) - range Var \<subseteq>
    subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) - range Var \<union> ((subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
 proof
   fix t assume t: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)) - range Var"
   then obtain f T where fT: "t = Fun f T" by (cases t) simp_all
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "Fun f T \<in> subterms ((\<theta>1 \<circ>\<^sub>s \<theta>2) x)"
     using t by auto
   have "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) \<union> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True
     hence "Fun f T \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2)) \<union> (subterms (\<theta>1 x) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
       using x(2) subterms_subst[of "\<theta>1 x" \<theta>2]
       unfolding subst_compose[of \<theta>1 \<theta>2 x] by auto
     moreover have ?thesis when *: "Fun f T \<in> subterms (\<theta>1 x) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2"
     proof -
       obtain s where s: "s \<in> subterms (\<theta>1 x)" "Fun f T = s \<cdot> \<theta>2" using * by moura
       show ?thesis
       proof (cases s)
         case (Var y)
         hence "Fun f T \<in> subst_range \<theta>2" using s by force
         thus ?thesis by blast
       next
         case (Fun g S)
         hence "Fun f T \<in> (subterms (\<theta>1 x) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2" using s by blast
         thus ?thesis using True by auto
       qed
     qed
     ultimately show ?thesis by blast
   next
     case False
     hence "(\<theta>1 \<circ>\<^sub>s \<theta>2) x = \<theta>2 x" unfolding subst_compose_def by auto
     thus ?thesis using x by (auto simp add: subst_domain_def)
   qed
   thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>2) - range Var \<union>
             (subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>1) - range Var \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>2)"
     using fT by auto
 qed
 
 lemma subst_img_comp_subset_const:
   assumes "Fun c [] \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   shows "Fun c [] \<in> subst_range \<theta>2 \<or> Fun c [] \<in> subst_range \<theta>1 \<or>
          (\<exists>x. Var x \<in> subst_range \<theta>1 \<and> \<theta>2 x = Fun c [])"
 proof (cases "Fun c [] \<in> subst_range \<theta>2")
   case False
   then obtain t where t: "t \<in> subst_range \<theta>1" "Fun c [] = t \<cdot> \<theta>2" 
     using subst_img_comp_subset'[OF assms] by auto
   thus ?thesis by (cases t) auto
 qed (simp add: subst_img_comp_subset'[OF assms])
 
 lemma subst_img_comp_subset_const':
   fixes \<delta> \<tau>::"('f,'v) subst"
   assumes "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []"
   shows "\<delta> x = Fun c [] \<or> (\<exists>z. \<delta> x = Var z \<and> \<tau> z = Fun c [])"
 proof (cases "\<delta> x = Fun c []")
   case False
   then obtain t where "\<delta> x = t" "t \<cdot> \<tau> = Fun c []" using assms unfolding subst_compose_def by auto
   thus ?thesis by (cases t) auto
 qed simp
 
 lemma subst_img_comp_subset_ground:
   assumes "ground (subst_range \<theta>1)"
   shows "subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2) \<subseteq> subst_range \<theta>1 \<union> subst_range \<theta>2"
 proof
   fix t assume t: "t \<in> subst_range (\<theta>1 \<circ>\<^sub>s \<theta>2)"
   then obtain x where x: "x \<in> subst_domain (\<theta>1 \<circ>\<^sub>s \<theta>2)" "t = (\<theta>1 \<circ>\<^sub>s \<theta>2) x" by auto
 
   show "t \<in> subst_range \<theta>1 \<union> subst_range \<theta>2"
   proof (cases "x \<in> subst_domain \<theta>1")
     case True
     hence "fv (\<theta>1 x) = {}" using assms ground_subst_range_empty_fv by fast
     hence "t = \<theta>1 x" using x(2) unfolding subst_compose_def by blast
     thus ?thesis using True by simp
   next
     case False
     hence "t = \<theta>2 x" "x \<in> subst_domain \<theta>2"
       using x subst_domain_compose[of \<theta>1 \<theta>2]
       by (metis subst_comp_notin_dom_eq, blast)
     thus ?thesis using x by simp
   qed
 qed
 
 lemma subst_fv_dom_img_single:
   assumes "v \<notin> fv t" "\<sigma> v = t" "\<And>w. v \<noteq> w \<Longrightarrow> \<sigma> w = Var w"
   shows "subst_domain \<sigma> = {v}" "range_vars \<sigma> = fv t"
 proof -
   show "subst_domain \<sigma> = {v}" using assms by (fastforce simp add: subst_domain_def)
   have "fv t \<subseteq> range_vars \<sigma>" by (metis fv_in_subst_img assms(1,2) vars_iff_subterm_or_eq) 
   moreover have "\<And>v. \<sigma> v \<noteq> Var v \<Longrightarrow> \<sigma> v = t" using assms by fastforce
   ultimately show "range_vars \<sigma> = fv t"
     unfolding range_vars_alt_def
     by (auto simp add: subst_domain_def)
 qed
 
 lemma subst_comp_upd1:
   "\<theta>(v := t) \<circ>\<^sub>s \<sigma> = (\<theta> \<circ>\<^sub>s \<sigma>)(v := t \<cdot> \<sigma>)"
 unfolding subst_compose_def by auto
 
 lemma subst_comp_upd2:
   assumes "v \<notin> subst_domain s" "v \<notin> range_vars s"
   shows "s(v := t) = s \<circ>\<^sub>s (Var(v := t))"
 unfolding subst_compose_def
 proof -
   { fix w
     have "(s(v := t)) w = s w \<cdot> Var(v := t)"
     proof (cases "w = v")
       case True
       hence "s w = Var w" using \<open>v \<notin> subst_domain s\<close> by (simp add: subst_domain_def)
       thus ?thesis using \<open>w = v\<close> by simp
     next
       case False
       hence "(s(v := t)) w = s w" by simp
       moreover have "s w \<cdot> Var(v := t) = s w" using \<open>w \<noteq> v\<close> \<open>v \<notin> range_vars s\<close> 
         by (metis fv_in_subst_img fun_upd_apply insert_absorb insert_subset
                   repl_invariance subst_apply_term.simps(1) subst_apply_term_empty)
       ultimately show ?thesis ..
     qed
   }
   thus "s(v := t) = (\<lambda>w. s w \<cdot> Var(v := t))" by auto
 qed
 
 lemma ground_subst_dom_iff_img:
   "ground (subst_range \<sigma>) \<Longrightarrow> x \<in> subst_domain \<sigma> \<longleftrightarrow> \<sigma> x \<in> subst_range \<sigma>"
 by (auto simp add: subst_domain_def)
 
 lemma finite_dom_subst_exists:
   "finite S \<Longrightarrow> \<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S"
 proof (induction S rule: finite.induct)
   case (insertI A a)
   then obtain \<sigma>::"('f,'v) subst" where "subst_domain \<sigma> = A" by blast
   fix f::'f
   have "subst_domain (\<sigma>(a := Fun f [])) = insert a A"
     using \<open>subst_domain \<sigma> = A\<close>
     by (auto simp add: subst_domain_def)
   thus ?case by metis
 qed (auto simp add: subst_domain_def)
 
 lemma subst_inj_is_bij_betw_dom_img_if_ground_img:
   assumes "ground (subst_range \<sigma>)"
   shows "inj \<sigma> \<longleftrightarrow> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)" (is "?A \<longleftrightarrow> ?B")
 proof
   show "?A \<Longrightarrow> ?B" by (metis bij_betw_def injD inj_onI subst_range.simps)
 next
   assume ?B
   hence "inj_on \<sigma> (subst_domain \<sigma>)" unfolding bij_betw_def by auto
   moreover have "\<And>x. x \<in> UNIV - subst_domain \<sigma> \<Longrightarrow> \<sigma> x = Var x" by auto
   hence "inj_on \<sigma> (UNIV - subst_domain \<sigma>)"
     using inj_onI[of "UNIV - subst_domain \<sigma>"]
     by (metis term.inject(1))
   moreover have "\<And>x y. x \<in> subst_domain \<sigma> \<Longrightarrow> y \<notin> subst_domain \<sigma> \<Longrightarrow> \<sigma> x \<noteq> \<sigma> y"
     using assms by (auto simp add: subst_domain_def)
   ultimately show ?A by (metis injI inj_onD subst_domI term.inject(1))
 qed
 
 lemma bij_finite_ground_subst_exists:
   assumes "finite (S::'v set)" "infinite (U::('f,'v) term set)" "ground U"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> U"
 proof -
   obtain T' where "T' \<subseteq> U" "card T' = card S" "finite T'"
     by (meson assms(2) finite_Diff2 infinite_arbitrarily_large)
   then obtain f::"'v \<Rightarrow> ('f,'v) term" where f_bij: "bij_betw f S T'"
     using finite_same_card_bij[OF assms(1)] by metis
   hence *: "\<And>v. v \<in> S \<Longrightarrow> f v \<noteq> Var v"
     using \<open>ground U\<close> \<open>T' \<subseteq> U\<close> bij_betwE
     by fastforce
 
   let ?\<sigma> = "\<lambda>v. if v \<in> S then f v else Var v"
   have "subst_domain ?\<sigma> = S"
   proof
     show "subst_domain ?\<sigma> \<subseteq> S" by (auto simp add: subst_domain_def)
 
     { fix v assume "v \<in> S" "v \<notin> subst_domain ?\<sigma>"
       hence "f v = Var v" by (simp add: subst_domain_def)
       hence False using *[OF \<open>v \<in> S\<close>] by metis
     }
     thus "S \<subseteq> subst_domain ?\<sigma>" by blast
   qed
   hence "\<And>v w. \<lbrakk>v \<in> subst_domain ?\<sigma>; w \<notin> subst_domain ?\<sigma>\<rbrakk> \<Longrightarrow> ?\<sigma> w \<noteq> ?\<sigma> v"
     using \<open>ground U\<close> bij_betwE[OF f_bij] set_rev_mp[OF _ \<open>T' \<subseteq> U\<close>]
     by (metis (no_types, lifting) UN_iff empty_iff vars_iff_subterm_or_eq fv\<^sub>s\<^sub>e\<^sub>t.simps) 
   hence "inj_on ?\<sigma> (subst_domain ?\<sigma>)"
     using f_bij \<open>subst_domain ?\<sigma> = S\<close>
     unfolding bij_betw_def inj_on_def
     by metis
   hence "bij_betw ?\<sigma> (subst_domain ?\<sigma>) (subst_range ?\<sigma>)"
     using inj_on_imp_bij_betw[of ?\<sigma>] by simp
   moreover have "subst_range ?\<sigma> = T'"
     using \<open>bij_betw f S T'\<close> \<open>subst_domain ?\<sigma> = S\<close>
     unfolding bij_betw_def by auto 
   hence "subst_range ?\<sigma> \<subseteq> U" using \<open>T' \<subseteq> U\<close> by auto
   ultimately show ?thesis using \<open>subst_domain ?\<sigma> = S\<close> by (metis (lifting))
 qed
 
 lemma bij_finite_const_subst_exists:
   assumes "finite (S::'v set)" "finite (T::'f set)" "infinite (U::'f set)"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> (\<lambda>c. Fun c []) ` (U - T)"
 proof -
   obtain T' where "T' \<subseteq> U - T" "card T' = card S" "finite T'"
     by (meson assms(2,3) finite_Diff2 infinite_arbitrarily_large)
   then obtain f::"'v \<Rightarrow> 'f" where f_bij: "bij_betw f S T'"
     using finite_same_card_bij[OF assms(1)] by metis
 
   let ?\<sigma> = "\<lambda>v. if v \<in> S then Fun (f v) [] else Var v"
   have "subst_domain ?\<sigma> = S" by (simp add: subst_domain_def)
   moreover have "\<And>v w. \<lbrakk>v \<in> subst_domain ?\<sigma>; w \<notin> subst_domain ?\<sigma>\<rbrakk> \<Longrightarrow> ?\<sigma> w \<noteq> ?\<sigma> v" by auto
   hence "inj_on ?\<sigma> (subst_domain ?\<sigma>)"
     using f_bij unfolding bij_betw_def inj_on_def
     by (metis \<open>subst_domain ?\<sigma> = S\<close> term.inject(2))
   hence "bij_betw ?\<sigma> (subst_domain ?\<sigma>) (subst_range ?\<sigma>)"
     using inj_on_imp_bij_betw[of ?\<sigma>] by simp
   moreover have "subst_range ?\<sigma> = ((\<lambda>c. Fun c []) ` T')"
     using \<open>bij_betw f S T'\<close> unfolding bij_betw_def inj_on_def by (auto simp add: subst_domain_def)
   hence "subst_range ?\<sigma> \<subseteq> ((\<lambda>c. Fun c []) ` (U - T))" using \<open>T' \<subseteq> U - T\<close> by auto
   ultimately show ?thesis by (metis (lifting))
 qed
 
 lemma bij_finite_const_subst_exists':
   assumes "finite (S::'v set)" "finite (T::('f,'v) terms)" "infinite (U::'f set)"
   shows "\<exists>\<sigma>::('f,'v) subst. subst_domain \<sigma> = S
                           \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                           \<and> subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) ` U) - T"
 proof -
   have "finite (\<Union>(funs_term ` T))" using assms(2) by auto
   then obtain \<sigma> where \<sigma>:
       "subst_domain \<sigma> = S" "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
       "subst_range \<sigma> \<subseteq> (\<lambda>c. Fun c []) ` (U - (\<Union>(funs_term ` T)))"
     using bij_finite_const_subst_exists[OF assms(1) _ assms(3)] by blast
   moreover have "(\<lambda>c. Fun c []) ` (U - (\<Union>(funs_term ` T))) \<subseteq> ((\<lambda>c. Fun c []) ` U) - T" by auto
   ultimately show ?thesis by blast
 qed
 
 lemma bij_betw_iteI:
   assumes "bij_betw f A B" "bij_betw g C D" "A \<inter> C = {}" "B \<inter> D = {}"
   shows "bij_betw (\<lambda>x. if x \<in> A then f x else g x) (A \<union> C) (B \<union> D)"
 proof -
   have "bij_betw (\<lambda>x. if x \<in> A then f x else g x) A B"
     by (metis bij_betw_cong[of A f "\<lambda>x. if x \<in> A then f x else g x" B] assms(1))
   moreover have "bij_betw (\<lambda>x. if x \<in> A then f x else g x) C D"
     using bij_betw_cong[of C g "\<lambda>x. if x \<in> A then f x else g x" D] assms(2,3) by force
   ultimately show ?thesis using bij_betw_combine[OF _ _ assms(4)] by metis
 qed
 
 lemma subst_comp_split:
   assumes "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
   shows "\<theta> = (rm_vars (subst_domain \<theta> - V) \<theta>) \<circ>\<^sub>s (rm_vars V \<theta>)" (is ?P)
     and "\<theta> = (rm_vars V \<theta>) \<circ>\<^sub>s (rm_vars (subst_domain \<theta> - V) \<theta>)" (is ?Q)
 proof -
   let ?rm1 = "rm_vars (subst_domain \<theta> - V) \<theta>" and ?rm2 = "rm_vars V \<theta>"
   have "subst_domain ?rm2 \<inter> range_vars ?rm1 = {}"
        "subst_domain ?rm1 \<inter> range_vars ?rm2 = {}"
     using assms unfolding range_vars_alt_def by (force simp add: subst_domain_def)+
   hence *: "\<And>v. v \<in> subst_domain ?rm1 \<Longrightarrow> (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v"
            "\<And>v. v \<in> subst_domain ?rm2 \<Longrightarrow> (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v"
     using ident_comp_subst_trm_if_disj[of ?rm2 ?rm1]
           ident_comp_subst_trm_if_disj[of ?rm1 ?rm2]
     by (auto simp add: subst_domain_def)
   hence "\<And>v. v \<notin> subst_domain ?rm1 \<Longrightarrow> (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v"
         "\<And>v. v \<notin> subst_domain ?rm2 \<Longrightarrow> (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v"
     unfolding subst_compose_def by (auto simp add: subst_domain_def)
   hence "\<And>v. (?rm1 \<circ>\<^sub>s ?rm2) v = \<theta> v" "\<And>v. (?rm2 \<circ>\<^sub>s ?rm1) v = \<theta> v" using * by blast+
   thus ?P ?Q by auto
 qed
 
 lemma subst_comp_eq_if_disjoint_vars:
   assumes "(subst_domain \<delta> \<union> range_vars \<delta>) \<inter> (subst_domain \<gamma> \<union> range_vars \<gamma>) = {}"
   shows "\<gamma> \<circ>\<^sub>s \<delta> = \<delta> \<circ>\<^sub>s \<gamma>"
 proof -
   { fix x assume "x \<in> subst_domain \<gamma>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = \<gamma> x" "(\<delta> \<circ>\<^sub>s \<gamma>) x = \<gamma> x"
       using assms unfolding range_vars_alt_def by (force simp add: subst_compose)+
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by metis
   } moreover
   { fix x assume "x \<in> subst_domain \<delta>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = \<delta> x" "(\<delta> \<circ>\<^sub>s \<gamma>) x = \<delta> x"
       using assms
       unfolding range_vars_alt_def by (auto simp add: subst_compose subst_domain_def)
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by metis
   } moreover
   { fix x assume "x \<notin> subst_domain \<gamma>" "x \<notin> subst_domain \<delta>"
     hence "(\<gamma> \<circ>\<^sub>s \<delta>) x = (\<delta> \<circ>\<^sub>s \<gamma>) x" by (simp add: subst_compose subst_domain_def)
   } ultimately show ?thesis by auto
 qed
 
 lemma subst_eq_if_disjoint_vars_ground:
   fixes \<xi> \<delta>::"('f,'v) subst"
   assumes "subst_domain \<delta> \<inter> subst_domain \<xi> = {}" "ground (subst_range \<xi>)" "ground (subst_range \<delta>)" 
   shows "t \<cdot> \<delta> \<cdot> \<xi> = t \<cdot> \<xi> \<cdot> \<delta>"
 by (metis assms subst_comp_eq_if_disjoint_vars range_vars_alt_def
           subst_subst_compose sup_bot.right_neutral)
 
 lemma subst_img_bound: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t \<Longrightarrow> range_vars \<delta> \<subseteq> fv (t \<cdot> \<delta>)"
 proof -
   assume "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv t"
   hence "subst_domain \<delta> \<subseteq> fv t" by blast
   thus ?thesis
     by (metis (no_types) range_vars_alt_def le_iff_sup subst_apply_fv_unfold
               subst_apply_fv_union subst_range.simps)
 qed
 
 lemma subst_all_fv_subset: "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M \<Longrightarrow> fv (t \<cdot> \<theta>) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 proof -
   assume *: "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t M"
   { fix v assume "v \<in> fv t"
     hence "v \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using * by auto
     then obtain t' where "t' \<in> M" "v \<in> fv t'" by auto
     hence "fv (\<theta> v) \<subseteq> fv (t' \<cdot> \<theta>)"
       by (metis subst_apply_term.simps(1) subst_apply_fv_subset subst_apply_fv_unfold
                 subtermeq_vars_subset vars_iff_subtermeq) 
     hence "fv (\<theta> v) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)" using \<open>t' \<in> M\<close> by auto
   }
   thus ?thesis using subst_apply_fv_unfold[of t \<theta>] by auto
 qed
 
 lemma subst_support_if_mgt_subst_idem:
   assumes "\<theta> \<preceq>\<^sub>\<circ> \<delta>" "subst_idem \<theta>"
   shows "\<theta> supports \<delta>"
 proof -
   from \<open>\<theta> \<preceq>\<^sub>\<circ> \<delta>\<close> obtain \<sigma> where \<sigma>: "\<delta> = \<theta> \<circ>\<^sub>s \<sigma>" by blast
   hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> (\<theta> \<circ>\<^sub>s \<theta> \<circ>\<^sub>s \<sigma>)" by simp
   hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> (\<theta> \<circ>\<^sub>s \<sigma>)" using \<open>subst_idem \<theta> \<close> unfolding subst_idem_def by simp
   hence "\<And>v. \<theta> v \<cdot> \<delta> = Var v \<cdot> \<delta>" using \<sigma> by simp
   thus "\<theta> supports \<delta>" by simp
 qed
 
 lemma subst_support_iff_mgt_if_subst_idem:
   assumes "subst_idem \<theta>"
   shows "\<theta> \<preceq>\<^sub>\<circ> \<delta> \<longleftrightarrow> \<theta> supports \<delta>"
 proof
   show "\<theta> \<preceq>\<^sub>\<circ> \<delta> \<Longrightarrow> \<theta> supports \<delta>" by (fact subst_support_if_mgt_subst_idem[OF _ \<open>subst_idem \<theta>\<close>])
   show "\<theta> supports \<delta> \<Longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>" by (fact subst_supportD)
 qed
 
 lemma subst_support_comp:
   fixes \<theta> \<delta> \<I>::"('a,'b) subst"
   assumes "\<theta> supports \<I>" "\<delta> supports \<I>"
   shows "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>"
 by (metis (no_types) assms subst_agreement subst_apply_term.simps(1) subst_subst_compose)
 
 lemma subst_support_comp':
   fixes \<theta> \<delta> \<sigma>::"('a,'b) subst"
   assumes "\<theta> supports \<delta>"
   shows "\<theta> supports (\<delta> \<circ>\<^sub>s \<sigma>)" "\<sigma> supports \<delta> \<Longrightarrow> \<theta> supports (\<sigma> \<circ>\<^sub>s \<delta>)"
 using assms unfolding subst_support_def by (metis subst_compose_assoc, metis)
 
 lemma subst_support_comp_split:
   fixes \<theta> \<delta> \<I>::"('a,'b) subst"
   assumes "(\<theta> \<circ>\<^sub>s \<delta>) supports \<I>"
   shows "subst_domain \<theta> \<inter> range_vars \<theta> = {} \<Longrightarrow> \<theta> supports \<I>"
   and "subst_domain \<theta> \<inter> subst_domain \<delta> = {} \<Longrightarrow> \<delta> supports \<I>"
 proof -
   assume "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
   hence "subst_idem \<theta>" by (metis subst_idemI)
   have "\<theta> \<preceq>\<^sub>\<circ> \<I>" using assms subst_compose_assoc[of \<theta> \<delta> \<I>] unfolding subst_compose_def by metis
   show "\<theta> supports \<I>" using subst_support_if_mgt_subst_idem[OF \<open>\<theta> \<preceq>\<^sub>\<circ> \<I>\<close> \<open>subst_idem \<theta>\<close>] by auto
 next
   assume "subst_domain \<theta> \<inter> subst_domain \<delta> = {}"
   moreover have "\<forall>v \<in> subst_domain (\<theta> \<circ>\<^sub>s \<delta>). (\<theta> \<circ>\<^sub>s \<delta>) v \<cdot> \<I> = \<I> v" using assms by metis
   ultimately have "\<forall>v \<in> subst_domain \<delta>. \<delta> v \<cdot> \<I> = \<I> v"
     using var_not_in_subst_dom unfolding subst_compose_def
     by (metis IntI empty_iff subst_apply_term.simps(1))
   thus "\<delta> supports \<I>" by force
 qed
 
 lemma subst_idem_support: "subst_idem \<theta> \<Longrightarrow> \<theta> supports \<theta> \<circ>\<^sub>s \<delta>"
 unfolding subst_idem_def by (metis subst_support_def subst_compose_assoc)
 
 lemma subst_idem_iff_self_support: "subst_idem \<theta> \<longleftrightarrow> \<theta> supports \<theta>"
 using subst_support_def[of \<theta> \<theta>] unfolding subst_idem_def by auto
 
 lemma subterm_subst_neq: "t \<sqsubset> t' \<Longrightarrow> t \<cdot> s \<noteq> t' \<cdot> s"
 by (metis subst_mono_neq)
 
 lemma fv_Fun_subst_neq: "x \<in> fv (Fun f T) \<Longrightarrow> \<sigma> x \<noteq> Fun f T \<cdot> \<sigma>"
 using subterm_subst_neq[of "Var x" "Fun f T"] vars_iff_subterm_or_eq[of x "Fun f T"] by auto
 
 lemma subterm_subst_unfold:
   assumes "t \<sqsubseteq> s \<cdot> \<theta>"
   shows "(\<exists>s'. s' \<sqsubseteq> s \<and> t = s' \<cdot> \<theta>) \<or> (\<exists>x \<in> fv s. t \<sqsubset> \<theta> x)"
 using assms
 proof (induction s)
   case (Fun f T) thus ?case
   proof (cases "t = Fun f T \<cdot> \<theta>")
     case True thus ?thesis using Fun by auto
   next
     case False
     then obtain s' where s': "s' \<in> set T" "t \<sqsubseteq> s' \<cdot> \<theta>" using Fun by auto
     hence "(\<exists>s''. s'' \<sqsubseteq> s' \<and> t = s'' \<cdot> \<theta>) \<or> (\<exists>x \<in> fv s'. t \<sqsubset> \<theta> x)" by (metis Fun.IH)
     thus ?thesis using s'(1) by auto
   qed
 qed simp
 
 lemma subterm_subst_img_subterm:
   assumes "t \<sqsubseteq> s \<cdot> \<theta>" "\<And>s'. s' \<sqsubseteq> s \<Longrightarrow> t \<noteq> s' \<cdot> \<theta>"
   shows "\<exists>w \<in> fv s. t \<sqsubset> \<theta> w"
 using subterm_subst_unfold[OF assms(1)] assms(2) by force
 
 lemma subterm_subst_not_img_subterm:
   assumes "t \<sqsubseteq> s \<cdot> \<I>" "\<not>(\<exists>w \<in> fv s. t \<sqsubseteq> \<I> w)"
   shows "\<exists>f T. Fun f T \<sqsubseteq> s \<and> t = Fun f T \<cdot> \<I>"
 proof (rule ccontr)
   assume "\<not>(\<exists>f T. Fun f T \<sqsubseteq> s \<and> t = Fun f T \<cdot> \<I>)"
   hence "\<And>f T. Fun f T \<sqsubseteq> s \<Longrightarrow> t \<noteq> Fun f T \<cdot> \<I>" by simp
   moreover have "\<And>x. Var x \<sqsubseteq> s \<Longrightarrow> t \<noteq> Var x \<cdot> \<I>"
     using assms(2) vars_iff_subtermeq by force
   ultimately have "\<And>s'. s' \<sqsubseteq> s \<Longrightarrow> t \<noteq> s' \<cdot> \<I>" by (metis "term.exhaust")
   thus False using assms subterm_subst_img_subterm by blast
 qed
 
 lemma subst_apply_img_var:
   assumes "v \<in> fv (t \<cdot> \<delta>)" "v \<notin> fv t"
   obtains w where "w \<in> fv t" "v \<in> fv (\<delta> w)"
 using assms by (induct t) auto
 
 lemma subst_apply_img_var':
   assumes "x \<in> fv (t \<cdot> \<delta>)" "x \<notin> fv t"
   shows "\<exists>y \<in> fv t. x \<in> fv (\<delta> y)"
 by (metis assms subst_apply_img_var)
 
 lemma nth_map_subst:
   fixes \<theta>::"('f,'v) subst" and T::"('f,'v) term list" and i::nat
   shows "i < length T \<Longrightarrow> (map (\<lambda>t. t \<cdot> \<theta>) T) ! i = (T ! i) \<cdot> \<theta>"
 by (fact nth_map)
 
 lemma subst_subterm:
   assumes "Fun f T \<sqsubseteq> t \<cdot> \<theta>"
   shows "(\<exists>S. Fun f S \<sqsubseteq> t \<and> Fun f S \<cdot> \<theta> = Fun f T) \<or>
          (\<exists>s \<in> subst_range \<theta>. Fun f T \<sqsubseteq> s)"
 using assms subterm_subst_not_img_subterm by (cases "\<exists>s \<in> subst_range \<theta>. Fun f T \<sqsubseteq> s") fastforce+
 
 lemma subst_subterm':
   assumes "Fun f T \<sqsubseteq> t \<cdot> \<theta>"
   shows "\<exists>S. length S = length T \<and> (Fun f S \<sqsubseteq> t \<or> (\<exists>s \<in> subst_range \<theta>. Fun f S \<sqsubseteq> s))"
 using subst_subterm[OF assms] by auto
 
 lemma subst_subterm'':
   assumes "s \<in> subterms (t \<cdot> \<theta>)"
   shows "(\<exists>u \<in> subterms t. s = u \<cdot> \<theta>) \<or> s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>)"
 proof (cases s)
   case (Var x)
   thus ?thesis
     using assms subterm_subst_not_img_subterm vars_iff_subtermeq
     by (cases "s = t \<cdot> \<theta>") fastforce+
 next
   case (Fun f T)
   thus ?thesis
     using subst_subterm[of f T t \<theta>] assms
     by fastforce
 qed
 
 
 subsection \<open>More Small Lemmata\<close>
 lemma funs_term_subst: "funs_term (t \<cdot> \<theta>) = funs_term t \<union> (\<Union>x \<in> fv t. funs_term (\<theta> x))"
 by (induct t) auto
 
 lemma fv\<^sub>s\<^sub>e\<^sub>t_subst_img_eq:
   assumes "X \<inter> (subst_domain \<delta> \<union> range_vars \<delta>) = {}"
   shows "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` (Y - X)) = fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` Y) - X"
 using assms unfolding range_vars_alt_def by force
 
 lemma subst_Fun_index_eq:
   assumes "i < length T" "Fun f T \<cdot> \<delta> = Fun g T' \<cdot> \<delta>"
   shows "T ! i \<cdot> \<delta> = T' ! i \<cdot> \<delta>"
 proof -
   have "map (\<lambda>x. x \<cdot> \<delta>) T = map (\<lambda>x. x \<cdot> \<delta>) T'" using assms by simp
   thus ?thesis by (metis assms(1) length_map nth_map)
 qed
 
 lemma fv_exists_if_unifiable_and_neq:
   fixes t t'::"('a,'b) term" and \<delta> \<theta>::"('a,'b) subst"
   assumes "t \<noteq> t'" "t \<cdot> \<theta> = t' \<cdot> \<theta>"
   shows "fv t \<union> fv t' \<noteq> {}"
 proof
   assume "fv t \<union> fv t' = {}"
   hence "fv t = {}" "fv t' = {}" by auto
   hence "t \<cdot> \<theta> = t" "t' \<cdot> \<theta> = t'" by auto
   hence "t = t'" using assms(2) by metis
   thus False using assms(1) by auto
 qed
 
 lemma const_subterm_subst: "Fun c [] \<sqsubseteq> t \<Longrightarrow> Fun c [] \<sqsubseteq> t \<cdot> \<sigma>"
 by (induct t) auto
 
 lemma const_subterm_subst_var_obtain:
   assumes "Fun c [] \<sqsubseteq> t \<cdot> \<sigma>" "\<not>Fun c [] \<sqsubseteq> t"
   obtains x where "x \<in> fv t" "Fun c [] \<sqsubseteq> \<sigma> x"
 using assms by (induct t) auto
 
 lemma const_subterm_subst_cases:
   assumes "Fun c [] \<sqsubseteq> t \<cdot> \<sigma>"
   shows "Fun c [] \<sqsubseteq> t \<or> (\<exists>x \<in> fv t. x \<in> subst_domain \<sigma> \<and> Fun c [] \<sqsubseteq> \<sigma> x)"
 proof (cases "Fun c [] \<sqsubseteq> t")
   case False
   then obtain x where "x \<in> fv t" "Fun c [] \<sqsubseteq> \<sigma> x"
     using const_subterm_subst_var_obtain[OF assms] by moura
   thus ?thesis by (cases "x \<in> subst_domain \<sigma>") auto
 qed simp
 
 lemma const_subterms_subst_cases:
   assumes "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
   shows "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. x \<in> subst_domain \<sigma> \<and> Fun c [] \<sqsubseteq> \<sigma> x)"
 using assms const_subterm_subst_cases[of c _ \<sigma>] by auto
 
 lemma const_subterms_subst_cases':
   assumes "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<sigma>"
   shows "Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M \<or> Fun c [] \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t subst_range \<sigma>"
 using const_subterms_subst_cases[OF assms] by auto
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_fv_subset:
   assumes "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
   shows "fv (\<theta> x) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
   using assms
 proof (induction F)
   case (Cons f F)
   then obtain t t' where f: "f = (t,t')" by (metis surj_pair)
   show ?case
   proof (cases "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F")
     case True thus ?thesis
       using Cons.IH
       unfolding subst_apply_pairs_def
       by auto
   next
     case False
     hence "x \<in> fv t \<union> fv t'" using Cons.prems f by simp
     hence "fv (\<theta> x) \<subseteq> fv (t \<cdot> \<theta>) \<union> fv (t' \<cdot> \<theta>)" using fv_subst_subset[of x] by force
     thus ?thesis using f unfolding subst_apply_pairs_def by auto
   qed
 qed simp
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_step_subst: "fv\<^sub>s\<^sub>e\<^sub>t (\<delta> ` fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) = fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
 proof (induction F)
   case (Cons f F)
   obtain t t' where "f = (t,t')" by moura
   thus ?case
     using Cons
     by (simp add: subst_apply_pairs_def subst_apply_fv_unfold)
 qed (simp_all add: subst_apply_pairs_def)
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var:
   fixes \<delta>::"('a,'b) subst"
   assumes "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
   shows "\<exists>y \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. x \<in> fv (\<delta> y)"
   using assms 
 proof (induction F)
   case (Cons f F)
   then obtain t s where f: "f = (t,s)" by (metis surj_pair)
 
   from Cons.IH show ?case
   proof (cases "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)")
     case False
     hence "x \<in> fv (t \<cdot> \<delta>) \<or> x \<in> fv (s \<cdot> \<delta>)"
       using f Cons.prems
       by (simp add: subst_apply_pairs_def)
     hence "(\<exists>y \<in> fv t. x \<in> fv (\<delta> y)) \<or> (\<exists>y \<in> fv s. x \<in> fv (\<delta> y))" by (metis fv_subst_obtain_var)
     thus ?thesis using f by (auto simp add: subst_apply_pairs_def)
   qed (auto simp add: Cons.IH)
 qed (simp add: subst_apply_pairs_def)
 
 lemma pair_subst_ident[intro]: "(fv t \<union> fv t') \<inter> subst_domain \<theta> = {} \<Longrightarrow> (t,t') \<cdot>\<^sub>p \<theta> = (t,t')"
 by auto
 
 lemma pairs_substI[intro]:
   assumes "subst_domain \<theta> \<inter> (\<Union>(s,t) \<in> M. fv s \<union> fv t) = {}"
   shows "M \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta> = M"
 proof -
   { fix m assume M: "m \<in> M"
     then obtain s t where m: "m = (s,t)" by (metis surj_pair)
     hence "(fv s \<union> fv t) \<inter> subst_domain \<theta> = {}" using assms M by auto
     hence "m \<cdot>\<^sub>p \<theta> = m" using m by auto
   } thus ?thesis by (simp add: image_cong) 
 qed
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) = fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F))"
 proof (induction F)
   case (Cons g G)
   obtain t t' where "g = (t,t')" by (metis surj_pair)
   thus ?case
     using Cons.IH
     by (simp add: subst_apply_pairs_def subst_apply_fv_unfold)
 qed (simp add: subst_apply_pairs_def)
 
 lemma fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset:
   assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<subseteq> subst_domain \<sigma>"
   shows  "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
   using assms
 proof (induction F)
   case (Cons g G)
   hence IH: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
     by (simp add: subst_apply_pairs_def)
   obtain t t' where g: "g = (t,t')" by (metis surj_pair)
   hence "fv (t \<cdot> \<delta>) \<subseteq> subst_domain \<sigma>" "fv (t' \<cdot> \<delta>) \<subseteq> subst_domain \<sigma>"
     using Cons.prems by (simp_all add: subst_apply_pairs_def)
   hence "fv t \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>" "fv t' \<subseteq> subst_domain \<sigma> \<union> subst_domain \<delta>"
     using subst_apply_fv_unfold[of _ \<delta>] by force+
   thus ?case using IH g by (simp add: subst_apply_pairs_def)
 qed (simp add: subst_apply_pairs_def)
 
 lemma pairs_subst_comp: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> \<circ>\<^sub>s \<theta> = ((F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>)"
 by (induct F) (auto simp add: subst_apply_pairs_def)
 
 lemma pairs_substI'[intro]:
   "subst_domain \<theta> \<inter> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {} \<Longrightarrow> F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> = F"
 by (induct F) (force simp add: subst_apply_pairs_def)+
 
 lemma subst_pair_compose[simp]: "d \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) = d \<cdot>\<^sub>p \<delta> \<cdot>\<^sub>p \<I>"
 proof -
   obtain t s where "d = (t,s)" by moura
   thus ?thesis by auto
 qed
 
 lemma subst_pairs_compose[simp]: "D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t (\<delta> \<circ>\<^sub>s \<I>) = D \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
 by auto
 
 lemma subst_apply_pair_pair: "(t, s) \<cdot>\<^sub>p \<I> = (t \<cdot> \<I>, s \<cdot> \<I>)"
 by (rule prod.case)
 
 lemma subst_apply_pairs_nil[simp]: "[] \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> = []"
 unfolding subst_apply_pairs_def by simp
 
 lemma subst_apply_pairs_singleton[simp]: "[(t,s)] \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta> = [(t \<cdot> \<delta>,s \<cdot> \<delta>)]"
 unfolding subst_apply_pairs_def by simp
 
 lemma subst_apply_pairs_Var[iff]: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s Var = F" by (simp add: subst_apply_pairs_def)
 
 lemma subst_apply_pairs_pset_subst: "set (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta>) = set F \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<theta>"
 unfolding subst_apply_pairs_def by force
 
 
 subsection \<open>Finite Substitutions\<close>
 inductive_set fsubst::"('a,'b) subst set" where
   fvar:     "Var \<in> fsubst"
 | FUpdate:  "\<lbrakk>\<theta> \<in> fsubst; v \<notin> subst_domain \<theta>; t \<noteq> Var v\<rbrakk> \<Longrightarrow> \<theta>(v := t) \<in> fsubst"
 
 lemma finite_dom_iff_fsubst:
   "finite (subst_domain \<theta>) \<longleftrightarrow> \<theta> \<in> fsubst"
 proof
   assume "finite (subst_domain \<theta>)" thus "\<theta> \<in> fsubst"
   proof (induction "subst_domain \<theta>" arbitrary: \<theta> rule: finite.induct)
     case emptyI
     hence "\<theta> = Var" using empty_dom_iff_empty_subst by metis
     thus ?case using fvar by simp
   next
     case (insertI \<theta>'\<^sub>d\<^sub>o\<^sub>m v) thus ?case
     proof (cases "v \<in> \<theta>'\<^sub>d\<^sub>o\<^sub>m")
       case True
       hence "\<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>" using \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close> by auto
       thus ?thesis using insertI.hyps(2) by metis
     next
       case False
       let ?\<theta>' = "\<lambda>w. if w \<in> \<theta>'\<^sub>d\<^sub>o\<^sub>m then \<theta> w else Var w"
       have "subst_domain ?\<theta>' = \<theta>'\<^sub>d\<^sub>o\<^sub>m"
         using \<open>v \<notin> \<theta>'\<^sub>d\<^sub>o\<^sub>m\<close> \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close>
         by (auto simp add: subst_domain_def)
       hence "?\<theta>' \<in> fsubst" using insertI.hyps(2) by simp
       moreover have "?\<theta>'(v := \<theta> v) = (\<lambda>w. if w \<in> insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m then \<theta> w else Var w)" by auto
       hence "?\<theta>'(v := \<theta> v) = \<theta>"
         using \<open>insert v \<theta>'\<^sub>d\<^sub>o\<^sub>m = subst_domain \<theta>\<close>
         by (auto simp add: subst_domain_def)
       ultimately show ?thesis
         using FUpdate[of ?\<theta>' v "\<theta> v"] False insertI.hyps(3)
         by (auto simp add: subst_domain_def)
     qed
   qed
 next
   assume "\<theta> \<in> fsubst" thus "finite (subst_domain \<theta>)"
   by (induct \<theta>, simp, metis subst_dom_insert_finite)
 qed
 
 lemma fsubst_induct[case_names fvar FUpdate, induct set: finite]:
   assumes "finite (subst_domain \<delta>)" "P Var"
   and "\<And>\<theta> v t. \<lbrakk>finite (subst_domain \<theta>); v \<notin> subst_domain \<theta>; t \<noteq> Var v; P \<theta>\<rbrakk> \<Longrightarrow> P (\<theta>(v := t))"
   shows "P \<delta>"
 using assms finite_dom_iff_fsubst fsubst.induct by metis
 
 lemma fun_upd_fsubst: "s(v := t) \<in> fsubst \<longleftrightarrow> s \<in> fsubst"
 using subst_dom_insert_finite[of s] finite_dom_iff_fsubst by blast 
 
 lemma finite_img_if_fsubst: "s \<in> fsubst \<Longrightarrow> finite (subst_range s)"
 using finite_dom_iff_fsubst finite_subst_img_if_finite_dom' by blast
 
 
 subsection \<open>Unifiers and Most General Unifiers (MGUs)\<close>
 
 abbreviation Unifier::"('f,'v) subst \<Rightarrow> ('f,'v) term \<Rightarrow> ('f,'v) term \<Rightarrow> bool" where
   "Unifier \<sigma> t u \<equiv> (t \<cdot> \<sigma> = u \<cdot> \<sigma>)"
 
 abbreviation MGU::"('f,'v) subst \<Rightarrow> ('f,'v) term \<Rightarrow> ('f,'v) term \<Rightarrow> bool" where
   "MGU \<sigma> t u \<equiv> Unifier \<sigma> t u \<and> (\<forall>\<theta>. Unifier \<theta> t u \<longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<theta>)"
 
 lemma MGUI[intro]:
   shows "\<lbrakk>t \<cdot> \<sigma> = u \<cdot> \<sigma>; \<And>\<theta>::('f,'v) subst. t \<cdot> \<theta> = u \<cdot> \<theta> \<Longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<theta>\<rbrakk> \<Longrightarrow> MGU \<sigma> t u"
 by auto
 
 lemma UnifierD[dest]:
   fixes \<sigma>::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list"
   assumes "Unifier \<sigma> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
 proof -
   from assms show "f = g" by auto
 
   from assms have "Fun f X \<cdot> \<sigma> = Fun g Y \<cdot> \<sigma>" by auto
   hence "length (map (\<lambda>x. x \<cdot> \<sigma>) X) = length (map (\<lambda>x. x \<cdot> \<sigma>) Y)" by auto
   thus "length X = length Y" by auto
 qed
 
 lemma MGUD[dest]:
   fixes \<sigma>::"('f,'v) subst" and f g::'f and X Y::"('f,'v) term list"
   assumes "MGU \<sigma> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
 using assms by (auto intro!: UnifierD[of f X \<sigma> g Y])
 
 lemma MGU_sym[sym]: "MGU \<sigma> s t \<Longrightarrow> MGU \<sigma> t s" by auto
 lemma Unifier_sym[sym]: "Unifier \<sigma> s t \<Longrightarrow> Unifier \<sigma> t s" by auto
 
 lemma MGU_nil: "MGU Var s t \<longleftrightarrow> s = t" by fastforce
 
 lemma Unifier_comp: "Unifier (\<theta> \<circ>\<^sub>s \<delta>) t u \<Longrightarrow> Unifier \<delta> (t \<cdot> \<theta>) (u \<cdot> \<theta>)"
 by simp
 
 lemma Unifier_comp': "Unifier \<delta> (t \<cdot> \<theta>) (u \<cdot> \<theta>) \<Longrightarrow> Unifier (\<theta> \<circ>\<^sub>s \<delta>) t u"
 by simp
 
 lemma Unifier_excludes_subterm:
   assumes \<theta>: "Unifier \<theta> t u"
   shows "\<not>t \<sqsubset> u"
 proof
   assume "t \<sqsubset> u"
   hence "t \<cdot> \<theta> \<sqsubset> u \<cdot> \<theta>" using subst_mono_neq by metis
   hence "t \<cdot> \<theta> \<noteq> u \<cdot> \<theta>" by simp
   moreover from \<theta> have "t \<cdot> \<theta> = u \<cdot> \<theta>" by auto
   ultimately show False ..
 qed
 
 lemma MGU_is_Unifier: "MGU \<sigma> t u \<Longrightarrow> Unifier \<sigma> t u" by (rule conjunct1)
 
 lemma MGU_Var1:
   assumes "\<not>Var v \<sqsubset> t"
   shows "MGU (Var(v := t)) (Var v) t"
 proof (intro MGUI exI)
   show "Var v \<cdot> (Var(v := t)) = t \<cdot> (Var(v := t))" using assms subst_no_occs by fastforce
 next
   fix \<theta>::"('a,'b) subst" assume th: "Var v \<cdot> \<theta> = t \<cdot> \<theta>" 
   show "\<theta> = (Var(v := t)) \<circ>\<^sub>s \<theta>" 
   proof
     fix s show "s \<cdot> \<theta> = s \<cdot> ((Var(v := t)) \<circ>\<^sub>s \<theta>)" using th by (induct s) auto
   qed
 qed
 
 lemma MGU_Var2: "v \<notin> fv t \<Longrightarrow> MGU (Var(v := t)) (Var v) t"
 by (metis (no_types) MGU_Var1 vars_iff_subterm_or_eq)
 
 lemma MGU_Var3: "MGU Var (Var v) (Var w) \<longleftrightarrow> v = w" by fastforce
 
 lemma MGU_Const1: "MGU Var (Fun c []) (Fun d []) \<longleftrightarrow> c = d" by fastforce
 
 lemma MGU_Const2: "MGU \<theta> (Fun c []) (Fun d []) \<Longrightarrow> c = d" by auto
 
 lemma MGU_Fun:
   assumes "MGU \<theta> (Fun f X) (Fun g Y)"
   shows "f = g" "length X = length Y"
 proof -
   let ?F = "\<lambda>\<theta> X. map (\<lambda>x. x \<cdot> \<theta>) X"
   from assms have
     "\<lbrakk>f = g; ?F \<theta> X = ?F \<theta> Y; \<forall>\<theta>'. f = g \<and> ?F \<theta>' X = ?F \<theta>' Y \<longrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<theta>'\<rbrakk> \<Longrightarrow> length X = length Y"
     using map_eq_imp_length_eq by auto
   thus "f = g" "length X = length Y" using assms by auto
 qed
 
 lemma Unifier_Fun:
   assumes "Unifier \<theta> (Fun f (x#X)) (Fun g (y#Y))"
   shows "Unifier \<theta> x y" "Unifier \<theta> (Fun f X) (Fun g Y)"
 using assms by simp_all
 
 lemma Unifier_subst_idem_subst: 
   "subst_idem r \<Longrightarrow> Unifier s (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> Unifier (r \<circ>\<^sub>s s) (t \<cdot> r) (u \<cdot> r)"
 by (metis (no_types, lifting) subst_idem_def subst_subst_compose)
 
 lemma subst_idem_comp:
   "subst_idem r \<Longrightarrow> Unifier s (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> 
     (\<And>q. Unifier q (t \<cdot> r) (u \<cdot> r) \<Longrightarrow> s \<circ>\<^sub>s q = q) \<Longrightarrow>
     subst_idem (r \<circ>\<^sub>s s)"
 by (frule Unifier_subst_idem_subst, blast, metis subst_idem_def subst_compose_assoc)
 
 lemma Unifier_mgt: "\<lbrakk>Unifier \<delta> t u; \<delta> \<preceq>\<^sub>\<circ> \<theta>\<rbrakk> \<Longrightarrow> Unifier \<theta> t u" by auto
 
 lemma Unifier_support: "\<lbrakk>Unifier \<delta> t u; \<delta> supports \<theta>\<rbrakk> \<Longrightarrow> Unifier \<theta> t u"
 using subst_supportD Unifier_mgt by metis
 
 lemma MGU_mgt: "\<lbrakk>MGU \<sigma> t u; MGU \<delta> t u\<rbrakk> \<Longrightarrow> \<sigma> \<preceq>\<^sub>\<circ> \<delta>" by auto
 
 lemma Unifier_trm_fv_bound:
   "\<lbrakk>Unifier s t u; v \<in> fv t\<rbrakk> \<Longrightarrow> v \<in> subst_domain s \<union> range_vars s \<union> fv u"
 proof (induction t arbitrary: s u)
   case (Fun f X)
   hence "v \<in> fv (u \<cdot> s) \<or> v \<in> subst_domain s" by (metis subst_not_dom_fixed)
   thus ?case by (metis (no_types) Un_iff contra_subsetD subst_sends_fv_to_img)
 qed (metis (no_types) UnI1 UnI2 subsetCE no_var_subterm subst_sends_dom_to_img
             subst_to_var_is_var trm_subst_ident' vars_iff_subterm_or_eq)
 
 lemma Unifier_rm_var: "\<lbrakk>Unifier \<theta> s t; v \<notin> fv s \<union> fv t\<rbrakk> \<Longrightarrow> Unifier (rm_var v \<theta>) s t"
 by (auto simp add: repl_invariance)
 
 lemma Unifier_ground_rm_vars:
   assumes "ground (subst_range s)" "Unifier (rm_vars X s) t t'"
   shows "Unifier s t t'"
 by (rule Unifier_support[OF assms(2) rm_vars_ground_supports[OF assms(1)]])
 
 lemma Unifier_dom_restrict:
   assumes "Unifier s t t'" "fv t \<union> fv t' \<subseteq> S"
   shows "Unifier (rm_vars (UNIV - S) s) t t'"
 proof -
   let ?s = "rm_vars (UNIV - S) s"
   show ?thesis using term_subst_eq_conv[of t s ?s] term_subst_eq_conv[of t' s ?s] assms by auto
 qed
 
 
 subsection \<open>Well-formedness of Substitutions and Unifiers\<close>
 inductive_set wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set::"('a,'b) subst set" where
   Empty[simp]: "Var \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
 | Insert[simp]:
     "\<lbrakk>\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; v \<notin> subst_domain \<theta>;
       v \<notin> range_vars \<theta>; fv t \<inter> (insert v (subst_domain \<theta>)) = {}\<rbrakk>
       \<Longrightarrow> \<theta>(v := t) \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
 
 definition wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \<Rightarrow> bool" where
   "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<equiv> subst_domain \<theta> \<inter> range_vars \<theta> = {} \<and> finite (subst_domain \<theta>)"
 
 definition wf\<^sub>M\<^sub>G\<^sub>U::"('a,'b) subst \<Rightarrow> ('a,'b) term \<Rightarrow> ('a,'b) term \<Rightarrow> bool" where
   "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<equiv> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> MGU \<theta> s t \<and> subst_domain \<theta> \<union> range_vars \<theta> \<subseteq> fv s \<union> fv t"
 
 lemma wf_subst_subst_idem: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> subst_idem \<theta>" using subst_idemI[of \<theta>] unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by fast
 
 lemma wf_subst_properties: "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set = wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 proof
   show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> \<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof -
     assume "subst_domain \<theta> \<inter> range_vars \<theta> = {} \<and> finite (subst_domain \<theta>)"
     hence "finite (subst_domain \<theta>)" "subst_domain \<theta> \<inter> range_vars \<theta> = {}"
       by auto
     thus "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
     proof (induction \<theta> rule: fsubst_induct)
       case fvar thus ?case by simp
     next
       case (FUpdate \<delta> v t)
       have "subst_domain \<delta> \<subseteq> subst_domain (\<delta>(v := t))" "range_vars \<delta> \<subseteq> range_vars (\<delta>(v := t))"
         using FUpdate.hyps(2,3) subst_img_update
         unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def)+
       hence "subst_domain \<delta> \<inter> range_vars \<delta> = {}" using FUpdate.prems(1) by blast
       hence "\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set" using FUpdate.IH by metis
 
       have *: "range_vars (\<delta>(v := t)) = range_vars \<delta> \<union> fv t"
         using FUpdate.hyps(2) subst_img_update[OF _ FUpdate.hyps(3)]
         by fastforce
       hence "fv t \<inter> insert v (subst_domain \<delta>) = {}"
         using FUpdate.prems subst_dom_update2[OF FUpdate.hyps(3)] by blast
       moreover have "subst_domain (\<delta>(v := t)) = insert v (subst_domain \<delta>)"
         by (meson FUpdate.hyps(3) subst_dom_update2)
       hence "v \<notin> range_vars \<delta>" using FUpdate.prems * by blast
       ultimately show ?case using Insert[OF \<open>\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set\<close> \<open>v \<notin> subst_domain \<delta>\<close>] by metis
     qed
   qed
 
   show "\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set \<Longrightarrow> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct)
     case Empty thus ?case by simp
   next
     case (Insert \<sigma> v t)
     hence 1: "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}" by simp
     hence 2: "subst_domain (\<sigma>(v := t)) \<inter> range_vars \<sigma> = {}"
       using Insert.hyps(3) by (auto simp add: subst_domain_def)
     have 3: "fv t \<inter> subst_domain (\<sigma>(v := t)) = {}"
       using Insert.hyps(4) by (auto simp add: subst_domain_def)
     have 4: "\<sigma> v = Var v" using \<open>v \<notin> subst_domain \<sigma>\<close> by (simp add: subst_domain_def)
   
     from Insert.IH have "finite (subst_domain \<sigma>)" by simp
     hence 5: "finite (subst_domain (\<sigma>(v := t)))" using subst_dom_insert_finite[of \<sigma>] by simp
   
     have "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}"
     proof (cases "t = Var v")
       case True
       hence "range_vars (\<sigma>(v := t)) = range_vars \<sigma>"
         using 4 fun_upd_triv term.inject(1)
         unfolding range_vars_alt_def by (auto simp add: subst_domain_def) 
       thus "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}"
         using 1 2 3 by auto
     next
       case False
       hence "range_vars (\<sigma>(v := t)) = fv t \<union> (range_vars \<sigma>)"
         using 4 subst_img_update[of \<sigma> v] by auto
       thus "subst_domain (\<sigma>(v := t)) \<inter> range_vars (\<sigma>(v := t)) = {}" using 1 2 3 by blast
     qed
     thus ?case using 5 by blast 
   qed
 qed
 
 lemma wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct[consumes 1, case_names Empty Insert]:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "P Var"
   and "\<And>\<theta> v t. \<lbrakk>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>; P \<theta>; v \<notin> subst_domain \<theta>; v \<notin> range_vars \<theta>;
                 fv t \<inter> insert v (subst_domain \<theta>) = {}\<rbrakk>
                 \<Longrightarrow> P (\<theta>(v := t))"
   shows "P \<delta>"
 proof -
   from assms(1,3) wf_subst_properties have
     "\<delta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set"
     "\<And>\<theta> v t. \<lbrakk>\<theta> \<in> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set; P \<theta>; v \<notin> subst_domain \<theta>; v \<notin> range_vars \<theta>;
               fv t \<inter> insert v (subst_domain \<theta>) = {}\<rbrakk>
               \<Longrightarrow> P (\<theta>(v := t))"
     by blast+
   thus "P \<delta>" using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.induct assms(2) by blast
 qed  
 
 lemma wf_subst_fsubst: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<Longrightarrow> \<delta> \<in> fsubst"
 unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using finite_dom_iff_fsubst by blast 
 
 lemma wf_subst_nil: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 
 lemma wf_MGU_nil: "MGU Var s t \<Longrightarrow> wf\<^sub>M\<^sub>G\<^sub>U Var s t"
 using wf_subst_nil subst_domain_Var range_vars_Var
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by fast
 
 lemma wf_MGU_dom_bound: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<Longrightarrow> subst_domain \<theta> \<subseteq> fv s \<union> fv t" unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma wf_subst_single:
   assumes "v \<notin> fv t" "\<sigma> v = t" "\<And>w. v \<noteq> w \<Longrightarrow> \<sigma> w = Var w"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
 proof -
   have *: "subst_domain \<sigma> = {v}" by (metis subst_fv_dom_img_single(1)[OF assms])
 
   have "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
     using * assms subst_fv_dom_img_single(2)
     by (metis inf_bot_left insert_disjoint(1))
   moreover have "finite (subst_domain \<sigma>)" using * by simp
   ultimately show ?thesis by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 qed
 
 lemma wf_subst_reduction:
   "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s \<Longrightarrow> wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)"
 proof -
   assume "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s"
   moreover have "subst_domain (rm_var v s) \<subseteq> subst_domain s" by (auto simp add: subst_domain_def)
   moreover have "range_vars (rm_var v s) \<subseteq> range_vars s"
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   ultimately have "subst_domain (rm_var v s) \<inter> range_vars (rm_var v s) = {}"
     by (meson compl_le_compl_iff disjoint_eq_subset_Compl subset_trans wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   moreover have "finite (subst_domain (rm_var v s))"
     using \<open>subst_domain (rm_var v s) \<subseteq> subst_domain s\<close> \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t s\<close> rev_finite_subset
     unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by blast
   ultimately show "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_var v s)" by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 qed
 
 lemma wf_subst_compose:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2"
     and "subst_domain \<theta>1 \<inter> subst_domain \<theta>2 = {}"
     and "subst_domain \<theta>1 \<inter> range_vars \<theta>2 = {}"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta>1 \<circ>\<^sub>s \<theta>2)"
 using assms
 proof (induction \<theta>1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 next
   case (Insert \<sigma>1 v t)
   have "t \<noteq> Var v" using Insert.hyps(4) by auto
   hence dom1v_unfold: "subst_domain (\<sigma>1(v := t)) = insert v (subst_domain \<sigma>1)"
     using subst_dom_update2 by metis
   hence doms_disj: "subst_domain \<sigma>1 \<inter> subst_domain \<theta>2 = {}" 
     using Insert.prems(2) disjoint_insert(1) by blast
   moreover have dom_img_disj: "subst_domain \<sigma>1 \<inter> range_vars \<theta>2 = {}"
     using Insert.hyps(2) Insert.prems(3)
     by (fastforce simp add: subst_domain_def)
   ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma>1 \<circ>\<^sub>s \<theta>2)" using Insert.IH[OF \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2\<close>] by metis
 
   have dom_comp_is_union: "subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2) = subst_domain \<sigma>1 \<union> subst_domain \<theta>2"
     using subst_dom_comp_eq[OF dom_img_disj] .
 
   have "v \<notin> subst_domain \<theta>2"
     using Insert.prems(2) \<open>t \<noteq> Var v\<close>
     by (fastforce simp add: subst_domain_def)
   hence "\<theta>2 v = Var v" "\<sigma>1 v = Var v" using Insert.hyps(2) by (simp_all add: subst_domain_def)
   hence "(\<sigma>1 \<circ>\<^sub>s \<theta>2) v = Var v" "(\<sigma>1(v := t) \<circ>\<^sub>s \<theta>2) v = t \<cdot> \<theta>2" "((\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t)) v = t"
     unfolding subst_compose_def by simp_all
   
   have fv_t2_bound: "fv (t \<cdot> \<theta>2) \<subseteq> fv t \<union> range_vars \<theta>2" by (meson subst_sends_fv_to_img)
 
   have 1: "v \<notin> subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2)"
     using \<open>(\<sigma>1 \<circ>\<^sub>s \<theta>2) v = Var v\<close>
     by (auto simp add: subst_domain_def)
 
   have "insert v (subst_domain \<sigma>1) \<inter> range_vars \<theta>2 = {}"
     using Insert.prems(3) dom1v_unfold by blast
   hence "v \<notin> range_vars \<sigma>1 \<union> range_vars \<theta>2" using Insert.hyps(3) by blast
   hence 2: "v \<notin> range_vars (\<sigma>1 \<circ>\<^sub>s \<theta>2)" by (meson set_rev_mp subst_img_comp_subset)
 
   have "subst_domain \<theta>2 \<inter> range_vars \<theta>2 = {}"
     using \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2\<close> unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
   hence "fv (t \<cdot> \<theta>2) \<inter> subst_domain \<theta>2 = {}"
     using subst_dom_elim unfolding range_vars_alt_def by simp
   moreover have "v \<notin> range_vars \<theta>2" using Insert.prems(3) dom1v_unfold by blast
   hence "v \<notin> fv t \<union> range_vars \<theta>2" using Insert.hyps(4) by blast
   hence "v \<notin> fv (t \<cdot> \<theta>2)" using \<open>fv (t \<cdot> \<theta>2) \<subseteq> fv t \<union> range_vars \<theta>2\<close> by blast
   moreover have "fv (t \<cdot> \<theta>2) \<inter> subst_domain \<sigma>1 = {}"
     using dom_img_disj fv_t2_bound \<open>fv t \<inter> insert v (subst_domain \<sigma>1) = {}\<close> by blast
   ultimately have 3: "fv (t \<cdot> \<theta>2) \<inter> insert v (subst_domain (\<sigma>1 \<circ>\<^sub>s \<theta>2)) = {}"
     using dom_comp_is_union by blast
 
   have "\<sigma>1(v := t) \<circ>\<^sub>s \<theta>2 = (\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t \<cdot> \<theta>2)" using subst_comp_upd1[of \<sigma>1 v t \<theta>2] .
   moreover have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ((\<sigma>1 \<circ>\<^sub>s \<theta>2)(v := t \<cdot> \<theta>2))"
     using "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert"[OF _ 1 2 3] \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma>1 \<circ>\<^sub>s \<theta>2)\<close> wf_subst_properties by metis
   ultimately show ?case by presburger
 qed
 
 lemma wf_subst_append:
   fixes \<theta>1 \<theta>2::"('f,'v) subst"
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>1" "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2"
     and "subst_domain \<theta>1 \<inter> subst_domain \<theta>2 = {}"
     and "subst_domain \<theta>1 \<inter> range_vars \<theta>2 = {}"
     and "range_vars \<theta>1 \<inter> subst_domain \<theta>2 = {}"
   shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<lambda>v. if \<theta>1 v = Var v then \<theta>2 v else \<theta>1 v)"
 using assms
 proof (induction \<theta>1 rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case Empty thus ?case unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
 next
   case (Insert \<sigma>1 v t)
   let ?if = "\<lambda>w. if \<sigma>1 w = Var w then \<theta>2 w else \<sigma>1 w"
   let ?if_upd = "\<lambda>w. if (\<sigma>1(v := t)) w = Var w then \<theta>2 w else (\<sigma>1(v := t)) w"
 
   from Insert.hyps(4) have "?if_upd = ?if(v := t)" by fastforce
 
   have dom_insert: "subst_domain (\<sigma>1(v := t)) = insert v (subst_domain \<sigma>1)"
     using Insert.hyps(4) by (auto simp add: subst_domain_def)
 
   have "\<sigma>1 v = Var v" "t \<noteq> Var v" using Insert.hyps(2,4) by auto
   hence img_insert: "range_vars (\<sigma>1(v := t)) = range_vars \<sigma>1 \<union> fv t"
     using subst_img_update by metis
 
   from Insert.prems(2) dom_insert have "subst_domain \<sigma>1 \<inter> subst_domain \<theta>2 = {}"
     by (auto simp add: subst_domain_def)
   moreover have "subst_domain \<sigma>1 \<inter> range_vars \<theta>2 = {}"
     using Insert.prems(3) dom_insert
     by (simp add: subst_domain_def)
   moreover have "range_vars \<sigma>1 \<inter> subst_domain \<theta>2 = {}"
     using Insert.prems(4) img_insert
     by blast
   ultimately have "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if" using Insert.IH[OF Insert.prems(1)] by metis
   
   have dom_union: "subst_domain ?if = subst_domain \<sigma>1 \<union> subst_domain \<theta>2"
     by (auto simp add: subst_domain_def)
   hence "v \<notin> subst_domain ?if"
     using Insert.hyps(2) Insert.prems(2) dom_insert
     by (auto simp add: subst_domain_def)
   moreover have "v \<notin> range_vars ?if"
     using Insert.prems(3) Insert.hyps(3) dom_insert
     unfolding range_vars_alt_def by (auto simp add: subst_domain_def)
   moreover have "fv t \<inter> insert v (subst_domain ?if) = {}"
     using Insert.hyps(4) Insert.prems(4) img_insert
     unfolding range_vars_alt_def by (fastforce simp add: subst_domain_def)
   ultimately show ?case
     using wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_set.Insert \<open>wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t ?if\<close> \<open>?if_upd = ?if(v := t)\<close> wf_subst_properties
     by (metis (no_types, lifting))  
 qed
 
 lemma wf_subst_elim_append:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "subst_elim \<theta> v" "v \<notin> fv t"
   shows "subst_elim (\<theta>(w := t)) v"
 using assms
 proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case (Insert \<theta> v' t')
   hence "\<And>q. v \<notin> fv (Var q \<cdot> \<theta>(v' := t'))" using subst_elimD by blast
   hence "\<And>q. v \<notin> fv (Var q \<cdot> \<theta>(v' := t', w := t))" using \<open>v \<notin> fv t\<close> by simp
   thus ?case by (metis subst_elimI' subst_apply_term.simps(1)) 
 qed (simp add: subst_elim_def)
 
 lemma wf_subst_elim_dom:
   assumes "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
   shows "\<forall>v \<in> subst_domain \<theta>. subst_elim \<theta> v"
 using assms
 proof (induction \<theta> rule: wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_induct)
   case (Insert \<theta> w t)
   have dom_insert: "subst_domain (\<theta>(w := t)) \<subseteq> insert w (subst_domain \<theta>)"
     by (auto simp add: subst_domain_def)
   hence "\<forall>v \<in> subst_domain \<theta>. subst_elim (\<theta>(w := t)) v" using Insert.IH Insert.hyps(2,4)
     by (metis Insert.hyps(1) IntI disjoint_insert(2) empty_iff wf_subst_elim_append) 
   moreover have "w \<notin> fv t" using Insert.hyps(4) by simp
   hence "\<And>q. w \<notin> fv (Var q \<cdot> \<theta>(w := t))"
     by (metis fv_simps(1) fv_in_subst_img Insert.hyps(3) contra_subsetD 
               fun_upd_def singletonD subst_apply_term.simps(1)) 
   hence "subst_elim (\<theta>(w := t)) w" by (metis subst_elimI')
   ultimately show ?case using dom_insert by blast
 qed simp
 
 lemma wf_subst_support_iff_mgt: "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> \<theta> supports \<delta> \<longleftrightarrow> \<theta> \<preceq>\<^sub>\<circ> \<delta>"
 using subst_support_def subst_support_if_mgt_subst_idem wf_subst_subst_idem by blast 
 
 
 subsection \<open>Interpretations\<close>
 abbreviation interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t::"('a,'b) subst \<Rightarrow> bool" where
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<equiv> subst_domain \<theta> = UNIV \<and> ground (subst_range \<theta>)"
 
 lemma interpretation_substI:
   "(\<And>v. fv (\<theta> v) = {}) \<Longrightarrow> interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 proof -
   assume "\<And>v. fv (\<theta> v) = {}"
   moreover { fix v assume "fv (\<theta> v) = {}" hence "v \<in> subst_domain \<theta>" by auto }
   ultimately show ?thesis by auto
 qed
 
 lemma interpretation_grounds[simp]:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> fv (t \<cdot> \<theta>) = {}"
 using subst_fv_dom_ground_if_ground_img[of t \<theta>] by blast
 
 lemma interpretation_grounds_all:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> (\<And>v. fv (\<theta> v) = {})"
 by (metis range_vars_alt_def UNIV_I fv_in_subst_img subset_empty subst_dom_vars_in_subst)
 
 lemma interpretation_grounds_all':
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> ground (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 using subst_fv_dom_ground_if_ground_img[of _ \<theta>]
 by simp
 
 lemma interpretation_comp:
   assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" 
   shows "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<theta>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma>)"
 proof -
   have \<theta>_fv: "fv (\<theta> v) = {}" for v using interpretation_grounds_all[OF assms] by simp
   hence \<theta>_fv': "fv (t \<cdot> \<theta>) = {}" for t
     by (metis all_not_in_conv subst_elimD subst_elimI' subst_apply_term.simps(1))
 
   from assms have "(\<sigma> \<circ>\<^sub>s \<theta>) v \<noteq> Var v" for v
     unfolding subst_compose_def by (metis fv_simps(1) \<theta>_fv' insert_not_empty)
   hence "subst_domain (\<sigma> \<circ>\<^sub>s \<theta>) = UNIV" by (simp add: subst_domain_def)
   moreover have "fv ((\<sigma> \<circ>\<^sub>s \<theta>) v) = {}" for v unfolding subst_compose_def using \<theta>_fv' by simp
   hence "ground (subst_range (\<sigma> \<circ>\<^sub>s \<theta>))" by simp
   ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<sigma> \<circ>\<^sub>s \<theta>)" ..
 
   from assms have "(\<theta> \<circ>\<^sub>s \<sigma>) v \<noteq> Var v" for v
     unfolding subst_compose_def by (metis fv_simps(1) \<theta>_fv insert_not_empty subst_to_var_is_var)
   hence "subst_domain (\<theta> \<circ>\<^sub>s \<sigma>) = UNIV" by (simp add: subst_domain_def)
   moreover have "fv ((\<theta> \<circ>\<^sub>s \<sigma>) v) = {}" for v
     unfolding subst_compose_def by (simp add: \<theta>_fv trm_subst_ident) 
   hence "ground (subst_range (\<theta> \<circ>\<^sub>s \<sigma>))" by simp
   ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma>)" ..
 qed
 
 lemma interpretation_subst_exists:
   "\<exists>\<I>::('f,'v) subst. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
 proof -
   obtain c::"'f" where "c \<in> UNIV" by simp
   then obtain \<I>::"('f,'v) subst" where "\<And>v. \<I> v = Fun c []" by simp
   hence "subst_domain \<I> = UNIV" "ground (subst_range \<I>)"
     by (simp_all add: subst_domain_def)
   thus ?thesis by auto
 qed
 
 lemma interpretation_subst_exists':
   "\<exists>\<theta>::('f,'v) subst. subst_domain \<theta> = X \<and> ground (subst_range \<theta>)"
 proof -
   obtain \<I>::"('f,'v) subst" where \<I>: "subst_domain \<I> = UNIV" "ground (subst_range \<I>)"
     using interpretation_subst_exists by moura
   let ?\<theta> = "rm_vars (UNIV - X) \<I>"
   have 1: "subst_domain ?\<theta> = X" using \<I> by (auto simp add: subst_domain_def)
   hence 2: "ground (subst_range ?\<theta>)" using \<I> by force
   show ?thesis using 1 2 by blast
 qed
 
 lemma interpretation_subst_idem:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<Longrightarrow> subst_idem \<theta>"
 unfolding subst_idem_def
 using interpretation_grounds_all[of \<theta>] trm_subst_ident subst_eq_if_eq_vars
 by fastforce
 
 lemma subst_idem_comp_upd_eq:
   assumes "v \<notin> subst_domain \<I>" "subst_idem \<theta>"
   shows "\<I> \<circ>\<^sub>s \<theta> = \<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>"
 proof -
   from assms(1) have "(\<I> \<circ>\<^sub>s \<theta>) v = \<theta> v" unfolding subst_compose_def by auto
   moreover have "\<And>w. w \<noteq> v \<Longrightarrow> (\<I> \<circ>\<^sub>s \<theta>) w = (\<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>) w" unfolding subst_compose_def by auto
   moreover have "(\<I>(v := \<theta> v) \<circ>\<^sub>s \<theta>) v = \<theta> v" using assms(2) unfolding subst_idem_def subst_compose_def
     by (metis fun_upd_same) 
   ultimately show ?thesis by (metis fun_upd_same fun_upd_triv subst_comp_upd1)
 qed
 
 lemma interpretation_dom_img_disjoint:
   "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<Longrightarrow> subst_domain \<I> \<inter> range_vars \<I> = {}"
 unfolding range_vars_alt_def by auto
 
 
 subsection \<open>Basic Properties of MGUs\<close>
 lemma MGU_is_mgu_singleton: "MGU \<theta> t u = is_mgu \<theta> {(t,u)}"
 unfolding is_mgu_def unifiers_def by auto
 
 lemma Unifier_in_unifiers_singleton: "Unifier \<theta> s t \<longleftrightarrow> \<theta> \<in> unifiers {(s,t)}"
 unfolding unifiers_def by auto
 
 lemma subst_list_singleton_fv_subset:
   "(\<Union>x \<in> set (subst_list (subst v t) E). fv (fst x) \<union> fv (snd x))
     \<subseteq> fv t \<union> (\<Union>x \<in> set E. fv (fst x) \<union> fv (snd x))"
 proof (induction E)
   case (Cons x E)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?fvx = "fv (fst x) \<union> fv (snd x)"
   let ?fvxsubst = "fv (fst x \<cdot> Var(v := t)) \<union> fv (snd x \<cdot> Var(v := t))"
   have "?fvs (subst_list (subst v t) (x#E)) = ?fvxsubst \<union> ?fvs (subst_list (subst v t) E)"
     unfolding subst_list_def subst_def by auto
   hence "?fvs (subst_list (subst v t) (x#E)) \<subseteq> ?fvxsubst \<union> fv t \<union> ?fvs E"
     using Cons.IH by blast
   moreover have "?fvs (x#E) = ?fvx \<union> ?fvs E" by auto
   moreover have "?fvxsubst \<subseteq> ?fvx \<union> fv t" using subst_fv_bound_singleton[of _ v t] by blast
   ultimately show ?case unfolding range_vars_alt_def by auto
 qed (simp add: subst_list_def)
 
 lemma subst_of_dom_subset: "subst_domain (subst_of L) \<subseteq> set (map fst L)"
 proof (induction L rule: List.rev_induct)
   case (snoc x L)
   then obtain v t where x: "x = (v,t)" by (metis surj_pair)
   hence "subst_of (L@[x]) = Var(v := t) \<circ>\<^sub>s subst_of L"
     unfolding subst_of_def subst_def by (induct L) auto
   hence "subst_domain (subst_of (L@[x])) \<subseteq> insert v (subst_domain (subst_of L))"
     using x subst_domain_compose[of "Var(v := t)" "subst_of L"]
     by (auto simp add: subst_domain_def)
   thus ?case using snoc.IH x by auto
 qed simp
 
 lemma wf_MGU_is_imgu_singleton: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t \<Longrightarrow> is_imgu \<theta> {(s,t)}"
 proof -
   assume 1: "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t"
 
   have 2: "subst_idem \<theta>" by (metis wf_subst_subst_idem 1 wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   have 3: "\<forall>\<theta>' \<in> unifiers {(s,t)}. \<theta> \<preceq>\<^sub>\<circ> \<theta>'" "\<theta> \<in> unifiers {(s,t)}"
     by (metis 1 Unifier_in_unifiers_singleton wf\<^sub>M\<^sub>G\<^sub>U_def)+
 
   have "\<forall>\<tau> \<in> unifiers {(s,t)}. \<tau> = \<theta> \<circ>\<^sub>s \<tau>" by (metis 2 3 subst_idem_def subst_compose_assoc)
   thus "is_imgu \<theta> {(s,t)}" by (metis is_imgu_def \<open>\<theta> \<in> unifiers {(s,t)}\<close>)
 qed
 
-lemma mgu_subst_range_vars:
-  assumes "mgu s t = Some \<sigma>" shows "range_vars \<sigma> \<subseteq> vars_term s \<union> vars_term t"
-proof -
-  obtain xs where *: "Unification.unify [(s, t)] [] = Some xs" and [simp]: "subst_of xs = \<sigma>"
-    using assms by (simp split: option.splits)
-  from unify_Some_UNIF [OF *] obtain ss
-    where "compose ss = \<sigma>" and "UNIF ss {#(s, t)#} {#}" by auto
-  with UNIF_range_vars_subset [of ss "{#(s, t)#}" "{#}"]
-    show ?thesis by (metis vars_mset_singleton fst_conv snd_conv) 
-qed
-
-lemma mgu_subst_domain_range_vars_disjoint:
-  assumes "mgu s t = Some \<sigma>" shows "subst_domain \<sigma> \<inter> range_vars \<sigma> = {}"
-proof -
-  have "is_imgu \<sigma> {(s, t)}" using assms mgu_sound by simp
-  hence "\<sigma> = \<sigma> \<circ>\<^sub>s \<sigma>" unfolding is_imgu_def by blast
-  thus ?thesis by (metis subst_idemp_iff) 
-qed
-
-lemma mgu_same_empty: "mgu (t::('a,'b) term) t = Some Var"
-proof -
-  { fix E::"('a,'b) equation list" and U::"('b \<times> ('a,'b) term) list"
-    assume "\<forall>(s,t) \<in> set E. s = t"
-    hence "Unification.unify E U = Some U"
-    proof (induction E U rule: Unification.unify.induct)
-      case (2 f S g T E U)
-      hence *: "f = g" "S = T" by auto
-      moreover have "\<forall>(s,t) \<in> set (zip T T). s = t" by (induct T) auto
-      hence "\<forall>(s,t) \<in> set (zip T T@E). s = t" using "2.prems"(1) by auto
-      moreover have "zip_option S T = Some (zip S T)" using \<open>S = T\<close> by auto
-      hence **: "decompose (Fun f S) (Fun g T) = Some (zip S T)"
-        using \<open>f = g\<close> unfolding decompose_def by auto
-      ultimately have "Unification.unify (zip S T@E) U = Some U" using "2.IH" * by auto
-      thus ?case using ** by auto
-    qed auto
-  }
-  hence "Unification.unify [(t,t)] [] = Some []" by auto
-  thus ?thesis by auto
-qed
+lemmas mgu_subst_range_vars = mgu_range_vars
+
+lemmas mgu_same_empty = mgu_same
 
 lemma mgu_var: assumes "x \<notin> fv t" shows "mgu (Var x) t = Some (Var(x := t))"
 proof -
   have "unify [(Var x,t)] [] = Some [(x,t)]" using assms by (auto simp add: subst_list_def)
   moreover have "subst_of [(x,t)] = Var(x := t)" unfolding subst_of_def subst_def by simp
-  ultimately show ?thesis by simp
+  ultimately show ?thesis by (simp add: mgu_def)
 qed
 
 lemma mgu_gives_wellformed_subst:
   assumes "mgu s t = Some \<theta>" shows "wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
 using mgu_finite_subst_domain[OF assms] mgu_subst_domain_range_vars_disjoint[OF assms]
 unfolding wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
 by auto
 
 lemma mgu_gives_wellformed_MGU:
   assumes "mgu s t = Some \<theta>" shows "wf\<^sub>M\<^sub>G\<^sub>U \<theta> s t"
 using mgu_subst_domain[OF assms] mgu_sound[OF assms] mgu_subst_range_vars [OF assms]
       MGU_is_mgu_singleton[of s \<theta> t] is_imgu_imp_is_mgu[of \<theta> "{(s,t)}"]
       mgu_gives_wellformed_subst[OF assms]
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma mgu_gives_subst_idem: "mgu s t = Some \<theta> \<Longrightarrow> subst_idem \<theta>"
 using mgu_sound[of s t \<theta>] unfolding is_imgu_def subst_idem_def by auto
 
 lemma mgu_always_unifies: "Unifier \<theta> M N \<Longrightarrow> \<exists>\<delta>. mgu M N = Some \<delta>"
 using mgu_complete Unifier_in_unifiers_singleton by blast
 
 lemma mgu_gives_MGU: "mgu s t = Some \<theta> \<Longrightarrow> MGU \<theta> s t"
 using mgu_sound[of s t \<theta>, THEN is_imgu_imp_is_mgu] MGU_is_mgu_singleton by metis
 
 lemma mgu_vars_bounded[dest?]:
   "mgu M N = Some \<sigma> \<Longrightarrow> subst_domain \<sigma> \<union> range_vars \<sigma> \<subseteq> fv M \<union> fv N"
 using mgu_gives_wellformed_MGU unfolding wf\<^sub>M\<^sub>G\<^sub>U_def by blast
 
 lemma mgu_vars_bounded':
   assumes \<sigma>: "mgu M N = Some \<sigma>"
     and MN: "fv M = {} \<or> fv N = {}"
   shows "subst_domain \<sigma> = fv M \<union> fv N" (is ?A)
     and "range_vars \<sigma> = {}" (is ?B)
 proof -
   let ?C = "\<lambda>t. subst_domain \<sigma> = fv t"
 
   have 0: "fv N = {} \<Longrightarrow> subst_domain \<sigma> \<subseteq> fv M" "fv N = {} \<Longrightarrow> range_vars \<sigma> \<subseteq> fv M"
           "fv M = {} \<Longrightarrow> subst_domain \<sigma> \<subseteq> fv N" "fv M = {} \<Longrightarrow> range_vars \<sigma> \<subseteq> fv N"
     using mgu_vars_bounded[OF \<sigma>] by simp_all
 
   note 1 = mgu_gives_MGU[OF \<sigma>] mgu_subst_domain_range_vars_disjoint[OF \<sigma>]
   note 2 = subst_fv_imgI[of \<sigma>] subst_dom_vars_in_subst[of _ \<sigma>]
   note 3 = ground_term_subst_domain_fv_subset[of _ \<sigma>]
   note 4 = subst_apply_fv_empty[of _ \<sigma>]
 
   have "fv (\<sigma> x) = {}" when x: "x \<in> fv M" and N: "fv N = {}" for x
     using x N 0(1,2) 1 2[of x] 3[of M] 4[of N] by auto
   hence "?C M" ?B when N: "fv N = {}" using 0(1,2)[OF N] N by (fastforce, fastforce)
   moreover have "fv (\<sigma> x) = {}" when x: "x \<in> fv N" and M: "fv M = {}" for x
     using x M 0(3,4) 1 2[of x] 3[of N] 4[of M] by auto
   hence "?C N" ?B when M: "fv M = {}" using 0(3,4)[OF M] M by (fastforce, fastforce)
   ultimately show ?A ?B using MN by auto
 qed
 
 lemma mgu_eliminates[dest?]:
   assumes "mgu M N = Some \<sigma>"
   shows "(\<exists>v \<in> fv M \<union> fv N. subst_elim \<sigma> v) \<or> \<sigma> = Var"
   (is "?P M N \<sigma>")
 proof (cases "\<sigma> = Var")
   case False
   then obtain v where v: "v \<in> subst_domain \<sigma>" by auto
   hence "v \<in> fv M \<union> fv N" using mgu_vars_bounded[OF assms] by blast
   thus ?thesis using wf_subst_elim_dom[OF mgu_gives_wellformed_subst[OF assms]] v by blast
 qed simp
 
 lemma mgu_eliminates_dom:
   assumes "mgu x y = Some \<theta>" "v \<in> subst_domain \<theta>"
   shows "subst_elim \<theta> v"
 using mgu_gives_wellformed_subst[OF assms(1)]
 unfolding wf\<^sub>M\<^sub>G\<^sub>U_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_elim_def
 by (metis disjoint_iff_not_equal subst_dom_elim assms(2))
 
 lemma unify_list_distinct:
   assumes "Unification.unify E B = Some U" "distinct (map fst B)"
   and "(\<Union>x \<in> set E. fv (fst x) \<union> fv (snd x)) \<inter> set (map fst B) = {}"
   shows "distinct (map fst U)"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case 1 thus ?case by simp
 next
   case (2 f X g Y E B U)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'"
     and [simp]: "f = g" "length X = length Y" "E' = zip X Y"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   hence "\<And>t t'. (t,t') \<in> set E' \<Longrightarrow> fv t \<subseteq> fv (Fun f X) \<and> fv t' \<subseteq> fv (Fun g Y)"
     by (metis zip_arg_subterm subtermeq_vars_subset)
   hence "?fvs E' \<subseteq> fv (Fun f X) \<union> fv (Fun g Y)" by fastforce
   moreover have "fv (Fun f X) \<inter> set (map fst B) = {}" "fv (Fun g Y) \<inter> set (map fst B) = {}"
     using "2.prems"(3) by auto
   ultimately have "?fvs E' \<inter> set (map fst B) = {}" by blast
   moreover have "?fvs E \<inter> set (map fst B) = {}" using "2.prems"(3) by auto
   ultimately have "?fvs (E'@E) \<inter> set (map fst B) = {}" by auto
   thus ?case using "2.IH"[OF * ** "2.prems"(2)] by metis
 next
   case (3 v t E B)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?E' = "subst_list (subst v t) E"
   from "3.prems"(3) have "v \<notin> set (map fst B)" "fv t \<inter> set (map fst B) = {}" by force+
   hence *: "distinct (map fst ((v, t)#B))" using "3.prems"(2) by auto
 
   show ?case
   proof (cases "t = Var v")
     case True thus ?thesis using "3.prems" "3.IH"(1) by auto
   next
     case False
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using \<open>t \<noteq> Var v\<close> "3.prems"(1) by auto
     moreover have "?fvs ?E' \<inter> set (map fst ((v, t)#B)) = {}"
     proof -
       have "v \<notin> ?fvs ?E'"
         unfolding subst_list_def subst_def
         by (simp add: \<open>v \<notin> fv t\<close> subst_remove_var)
       moreover have "?fvs ?E' \<subseteq> fv t \<union> ?fvs E" by (metis subst_list_singleton_fv_subset)
       hence "?fvs ?E' \<inter> set (map fst B) = {}" using "3.prems"(3) by auto
       ultimately show ?thesis by auto
     qed 
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> _ *] by metis
   qed
 next
   case (4 f X v E B U)
   let ?fvs = "\<lambda>L. \<Union>x \<in> set L. fv (fst x) \<union> fv (snd x)"
   let ?E' = "subst_list (subst v (Fun f X)) E"
   have *: "?fvs E \<inter> set (map fst B) = {}" using "4.prems"(3) by auto
   from "4.prems"(1) have "v \<notin> fv (Fun f X)" by force
   from "4.prems"(3) have **: "v \<notin> set (map fst B)" "fv (Fun f X) \<inter> set (map fst B) = {}" by force+
   hence ***: "distinct (map fst ((v, Fun f X)#B))" using "4.prems"(2) by auto
   from "4.prems"(3) have ****: "?fvs ?E' \<inter> set (map fst ((v, Fun f X)#B)) = {}"
   proof -
     have "v \<notin> ?fvs ?E'"
       unfolding subst_list_def subst_def
       using \<open>v \<notin> fv (Fun f X)\<close> subst_remove_var[of v "Fun f X"] by simp
     moreover have "?fvs ?E' \<subseteq> fv (Fun f X) \<union> ?fvs E" by (metis subst_list_singleton_fv_subset)
     hence "?fvs ?E' \<inter> set (map fst B) = {}" using * ** by blast
     ultimately show ?thesis by auto
   qed
   have "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, Fun f X) # B) = Some U"
     using \<open>v \<notin> fv (Fun f X)\<close> "4.prems"(1) by auto
   thus ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f X)\<close> _ *** ****] by metis
 qed
 
 lemma mgu_None_is_subst_neq:
   fixes s t::"('a,'b) term" and \<delta>::"('a,'b) subst"
   assumes "mgu s t = None"
   shows "s \<cdot> \<delta> \<noteq> t \<cdot> \<delta>"
 using assms mgu_always_unifies by force
 
 lemma mgu_None_if_neq_ground:
   assumes "t \<noteq> t'" "fv t = {}" "fv t' = {}"
   shows "mgu t t' = None"
 proof (rule ccontr)
   assume "mgu t t' \<noteq> None"
   then obtain \<delta> where \<delta>: "mgu t t' = Some \<delta>" by auto
   hence "t \<cdot> \<delta> = t" "t' \<cdot> \<delta> = t'" using assms subst_ground_ident by auto
   thus False using assms(1) MGU_is_Unifier[OF mgu_gives_MGU[OF \<delta>]] by auto
 qed
 
 lemma mgu_None_commutes:
   "mgu s t = None \<Longrightarrow> mgu t s = None"
 using mgu_complete[of s t]
       Unifier_in_unifiers_singleton[of s _ t]
       Unifier_sym[of t _ s]
       Unifier_in_unifiers_singleton[of t _ s]
       mgu_sound[of t s]
 unfolding is_imgu_def
 by fastforce
 
 lemma mgu_img_subterm_subst:
   fixes \<delta>::"('f,'v) subst" and s t u::"('f,'v) term"
   assumes "mgu s t = Some \<delta>" "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>) - range Var"
   shows "u \<in> ((subterms s \<union> subterms t) - range Var) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 proof -
   define subterms_tuples::"('f,'v) equation list \<Rightarrow> ('f,'v) terms" where subtt_def:
     "subterms_tuples \<equiv> \<lambda>E. subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E) \<union> subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)"
   define subterms_img::"('f,'v) subst \<Rightarrow> ('f,'v) terms" where subti_def:
     "subterms_img \<equiv> \<lambda>d. subterms\<^sub>s\<^sub>e\<^sub>t (subst_range d)"
 
   define d where "d \<equiv> \<lambda>v t. subst v t::('f,'v) subst"
   define V where "V \<equiv> range Var::('f,'v) terms"
   define R where "R \<equiv> \<lambda>d::('f,'v) subst. ((subterms s \<union> subterms t) - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t d"
   define M where "M \<equiv> \<lambda>E d. subterms_tuples E \<union> subterms_img d"
   define Q where "Q \<equiv> (\<lambda>E d. M E d - V \<subseteq> R d - V)"
   define Q' where "Q' \<equiv> (\<lambda>E d d'. (M E d - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t d' \<subseteq> (R d - V) \<cdot>\<^sub>s\<^sub>e\<^sub>t (d'::('f,'v) subst))"
 
   have Q_subst: "Q (subst_list (subst v t') E) (subst_of ((v, t')#B))" 
     when v_fv: "v \<notin> fv t'" and Q_assm: "Q ((Var v, t')#E) (subst_of B)"
     for v t' E B
   proof -
     define E' where "E' \<equiv> subst_list (subst v t') E"
     define B' where "B' \<equiv> subst_of ((v, t')#B)"
 
     have E': "E' = subst_list (d v t') E"
         and B': "B' = subst_of B \<circ>\<^sub>s d v t'"
       using subst_of_simps(3)[of "(v, t')"]
       unfolding subst_def E'_def B'_def d_def by simp_all
 
     have vt_img_subt: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (d v t')) = subterms t'"
          and vt_dom: "subst_domain (d v t') = {v}"
       using v_fv by (auto simp add: subst_domain_def d_def subst_def)
 
     have *: "subterms u1 \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (fst ` set E)" "subterms u2 \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (snd ` set E)"
       when "(u1,u2) \<in> set E" for u1 u2
       using that by auto
 
     have **: "subterms\<^sub>s\<^sub>e\<^sub>t (d v t' ` (fv u \<inter> subst_domain (d v t'))) \<subseteq> subterms t'"
       for u::"('f,'v) term"
       using vt_dom unfolding d_def by force
 
     have 1: "subterms_tuples E' - V \<subseteq> (subterms t' - V) \<union> (subterms_tuples E - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t')"
       (is "?A \<subseteq> ?B")
     proof
       fix u assume "u \<in> ?A"
       then obtain u1 u2 where u12:
           "(u1,u2) \<in> set E"
           "u \<in> (subterms (u1 \<cdot> (d v t')) - V) \<union> (subterms (u2 \<cdot> (d v t')) - V)"
         unfolding subtt_def subst_list_def E'_def d_def by moura
       hence "u \<in> (subterms t' - V) \<union> (((subterms_tuples E) \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') - V)"
         using subterms_subst[of u1 "d v t'"] subterms_subst[of u2 "d v t'"]
               *[OF u12(1)] **[of u1] **[of u2]
         unfolding subtt_def subst_list_def by auto
       moreover have
           "(subterms_tuples E \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') - V \<subseteq>
            (subterms_tuples E - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t') \<union> {t'}"
         unfolding subst_def subtt_def V_def d_def by force
       ultimately show "u \<in> ?B" using u12 v_fv by auto
     qed
 
     have 2: "subterms_img B' - V \<subseteq>
              (subterms t' - V) \<union> (subterms_img (subst_of B) - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t')"
       using B' vt_img_subt subst_img_comp_subset'''[of "subst_of B" "d v t'"]
       unfolding subti_def subst_def V_def by argo
 
     have 3: "subterms_tuples ((Var v, t')#E) - V = (subterms t' - V) \<union> (subterms_tuples E - V)"
       by (auto simp add: subst_def subtt_def V_def)
 
     have "fv\<^sub>s\<^sub>e\<^sub>t (subterms t' - V) \<inter> subst_domain (d v t') = {}"
       using v_fv vt_dom fv_subterms[of t'] by fastforce
     hence 4: "subterms t' - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t' = subterms t' - V"
       using set_subst_ident[of "subterms t' - range Var" "d v t'"] by (simp add: V_def)
 
     have "M E' B' - V \<subseteq> M ((Var v, t')#E) (subst_of B) - V \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t'"
       using 1 2 3 4 unfolding M_def by blast
     moreover have "Q' ((Var v, t')#E) (subst_of B) (d v t')"
       using Q_assm unfolding Q_def Q'_def by auto
     moreover have "R (subst_of B) \<cdot>\<^sub>s\<^sub>e\<^sub>t d v t' = R (subst_of ((v,t')#B))"
       unfolding R_def d_def by auto 
     ultimately have
       "M (subst_list (d v t') E) (subst_of ((v, t')#B)) - V \<subseteq> R (subst_of ((v, t')#B)) - V"
       unfolding Q'_def E'_def B'_def d_def by blast
     thus ?thesis unfolding Q_def M_def R_def d_def by blast
   qed
 
   have "u \<in> subterms s \<union> subterms t - V \<cdot>\<^sub>s\<^sub>e\<^sub>t subst_of U"
     when assms':
       "unify E B = Some U"
       "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range (subst_of U)) - V"
       "Q E (subst_of B)"
     for E B U and T::"('f,'v) term list"
     using assms'
   proof (induction E B arbitrary: U rule: Unification.unify.induct)
     case (1 B) thus ?case by (auto simp add: Q_def M_def R_def subti_def)
   next
     case (2 g X h Y E B U)
     from "2.prems"(1) obtain E' where E':
         "decompose (Fun g X) (Fun h Y) = Some E'"
         "g = h" "length X = length Y" "E' = zip X Y"
         "Unification.unify (E'@E) B = Some U"
       by (auto split: option.splits)
     moreover have "subterms_tuples (E'@E) \<subseteq> subterms_tuples ((Fun g X, Fun h Y)#E)"
     proof
       fix u assume "u \<in> subterms_tuples (E'@E)"
       then obtain u1 u2 where u12: "(u1,u2) \<in> set (E'@E)" "u \<in> subterms u1 \<union> subterms u2"
         unfolding subtt_def by fastforce
       thus "u \<in> subterms_tuples ((Fun g X, Fun h Y)#E)"
       proof (cases "(u1,u2) \<in> set E'")
         case True
         hence "subterms u1 \<subseteq> subterms (Fun g X)" "subterms u2 \<subseteq> subterms (Fun h Y)"
           using E'(4) subterms_subset params_subterms subsetCE
           by (metis set_zip_leftD, metis set_zip_rightD)
         thus ?thesis using u12 unfolding subtt_def by auto
       next
         case False thus ?thesis using u12 unfolding subtt_def by fastforce
       qed
      qed
     hence "Q (E'@E) (subst_of B)" using "2.prems"(3) unfolding Q_def M_def by blast
     ultimately show ?case using "2.IH"[of E' U] "2.prems" by meson
   next
     case (3 v t' E B)
     show ?case
     proof (cases "t' = Var v")
       case True thus ?thesis
         using "3.prems" "3.IH"(1) unfolding Q_def M_def V_def subtt_def by auto
     next
       case False
       hence 1: "v \<notin> fv t'" using "3.prems"(1) by auto
       hence "unify (subst_list (subst v t') E) ((v, t')#B) = Some U"
         using False "3.prems"(1) by auto
       thus ?thesis
         using Q_subst[OF 1 "3.prems"(3)]
               "3.IH"(2)[OF False 1 _ "3.prems"(2)]
         by metis
     qed
   next
     case (4 g X v E B U)
     have 1: "v \<notin> fv (Fun g X)" using "4.prems"(1) not_None_eq by fastforce
     hence 2: "unify (subst_list (subst v (Fun g X)) E) ((v, Fun g X)#B) = Some U"
       using "4.prems"(1) by auto
 
     have 3: "Q ((Var v, Fun g X)#E) (subst_of B)"
       using "4.prems"(3) unfolding Q_def M_def subtt_def by auto
     
     show ?case
       using Q_subst[OF 1 3] "4.IH"[OF 1 2 "4.prems"(2)]
       by metis
   qed
   moreover obtain D where "unify [(s, t)] [] = Some D" "\<delta> = subst_of D"
-    using assms(1) by (auto split: option.splits)
+    using assms(1) by (auto simp: mgu_def split: option.splits)
   moreover have "Q [(s,t)] (subst_of [])"
     unfolding Q_def M_def R_def subtt_def subti_def
     by force
   ultimately show ?thesis using assms(2) unfolding V_def by auto
 qed
 
 lemma mgu_img_consts:
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v
   assumes "mgu s t = Some \<delta>" "Fun c [] \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>)"
   shows "Fun c [] \<in> subterms s \<union> subterms t"
 proof -
   obtain u where "u \<in> (subterms s \<union> subterms t) - range Var" "u \<cdot> \<delta> = Fun c []"
     using mgu_img_subterm_subst[OF assms(1), of "Fun c []"] assms(2) by force
   thus ?thesis by (cases u) auto
 qed
 
 lemma mgu_img_consts':
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and c::'f and z::'v
   assumes "mgu s t = Some \<delta>" "\<delta> z = Fun c []"
   shows "Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
 using mgu_img_consts[OF assms(1)] assms(2)
 by (metis Un_iff in_subterms_Union subst_imgI term.distinct(1)) 
 
 lemma mgu_img_composed_var_term:
   fixes \<delta>::"('f,'v) subst" and s t::"('f,'v) term" and f::'f and Z::"'v list"
   assumes "mgu s t = Some \<delta>" "Fun f (map Var Z) \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<delta>)"
   shows "\<exists>Z'. map \<delta> Z' = map Var Z \<and> Fun f (map Var Z') \<in> subterms s \<union> subterms t"
 proof -
   obtain u where u: "u \<in> (subterms s \<union> subterms t) - range Var" "u \<cdot> \<delta> = Fun f (map Var Z)"
     using mgu_img_subterm_subst[OF assms(1), of "Fun f (map Var Z)"] assms(2) by fastforce
   then obtain T where T: "u = Fun f T" "map (\<lambda>t. t \<cdot> \<delta>) T = map Var Z" by (cases u) auto
   have "\<forall>t \<in> set T. \<exists>x. t = Var x" using T(2) by (induct T arbitrary: Z) auto
   then obtain Z' where Z': "map Var Z' = T" by (metis ex_map_conv) 
   hence "map \<delta> Z' = map Var Z" using T(2) by (induct Z' arbitrary: T Z) auto
   thus ?thesis using u(1) T(1) Z' by auto
 qed
 
 lemma mgu_ground_instance_case:
   assumes t: "fv (t \<cdot> \<delta>) = {}"
   shows "mgu t (t \<cdot> \<delta>) = Some (rm_vars (UNIV - fv t) \<delta>)" (is ?A)
     and mgu_ground_commutes: "mgu t (t \<cdot> \<delta>) = mgu (t \<cdot> \<delta>) t" (is ?B)
 proof -
   define \<theta> where "\<theta> \<equiv> rm_vars (UNIV - fv t) \<delta>"
 
   have \<delta>: "t \<cdot> \<delta> = t \<cdot> \<theta>"
     using rm_vars_subst_eq'[of t \<delta>] unfolding \<theta>_def by metis
 
   have 0: "Unifier \<theta> t (t \<cdot> \<delta>)"
     using subst_ground_ident[OF t, of \<theta>] term_subst_eq[of t \<delta> \<theta>]
     unfolding \<theta>_def by (metis Diff_iff)
 
   obtain \<sigma> where \<sigma>: "mgu t (t \<cdot> \<theta>) = Some \<sigma>" "MGU \<sigma> t (t \<cdot> \<theta>)"
     using mgu_always_unifies[OF 0] mgu_gives_MGU[of t "t \<cdot> \<theta>"]
     unfolding \<delta> by blast
 
   have 1: "subst_domain \<sigma> = fv t"
     using t MGU_is_Unifier[OF \<sigma>(2)]
           subset_antisym[OF mgu_subst_domain[OF \<sigma>(1)]]
           ground_term_subst_domain_fv_subset[of t \<sigma>]
           subst_apply_fv_empty[OF t, of \<sigma>]
     unfolding \<delta> by auto
 
   have 2: "subst_domain \<theta> = fv t"
     using 0 rm_vars_dom[of "UNIV - fv t" \<delta>]
           ground_term_subst_domain_fv_subset[of t \<theta>]
           subst_apply_fv_empty[OF t, of \<theta>]
     unfolding \<theta>_def by auto
 
   have "\<sigma> x = \<theta> x" for x
     using 1 2 MGU_is_Unifier[OF \<sigma>(2)] term_subst_eq_conv[of t \<sigma> \<theta>]
           subst_ground_ident[OF t[unfolded \<delta>], of \<sigma>] subst_domI[of _ x]
     by metis
   hence "\<sigma> = \<theta>" by presburger
   thus A: ?A using \<sigma>(1) unfolding \<delta> \<theta>_def by blast
 
   have "Unifier \<theta> (t \<cdot> \<delta>) t" using 0 by simp
   then obtain \<sigma>' where \<sigma>': "mgu (t \<cdot> \<theta>) t = Some \<sigma>'" "MGU \<sigma>' (t \<cdot> \<theta>) t"
     using mgu_always_unifies mgu_gives_MGU[of "t \<cdot> \<theta>" t]
     unfolding \<delta> by fastforce
 
   have 3: "subst_domain \<sigma>' = fv t"
     using t MGU_is_Unifier[OF \<sigma>'(2)]
           subset_antisym[OF mgu_subst_domain[OF \<sigma>'(1)]]
           ground_term_subst_domain_fv_subset[of t \<sigma>']
           subst_apply_fv_empty[OF t, of \<sigma>']
     unfolding \<delta> by auto
 
   have "\<sigma>' x = \<theta> x" for x
     using 2 3 MGU_is_Unifier[OF \<sigma>'(2)] term_subst_eq_conv[of t \<sigma>' \<theta>]
           subst_ground_ident[OF t[unfolded \<delta>], of \<sigma>'] subst_domI[of _ x]
     by metis
   hence "\<sigma>' = \<theta>" by presburger
   thus ?B using A \<sigma>'(1) unfolding \<delta> \<theta>_def by argo
 qed
 
 
 subsection \<open>Lemmata: The "Inequality Lemmata"\<close>
 text \<open>Subterm injectivity (a stronger injectivity property)\<close>
 definition subterm_inj_on where
   "subterm_inj_on f A \<equiv> \<forall>x\<in>A. \<forall>y\<in>A. (\<exists>v. v \<sqsubseteq> f x \<and> v \<sqsubseteq> f y) \<longrightarrow> x = y"
 
 lemma subterm_inj_on_imp_inj_on: "subterm_inj_on f A \<Longrightarrow> inj_on f A"
 unfolding subterm_inj_on_def inj_on_def by fastforce
 
 lemma subst_inj_on_is_bij_betw:
   "inj_on \<theta> (subst_domain \<theta>) = bij_betw \<theta> (subst_domain \<theta>) (subst_range \<theta>)"
 unfolding inj_on_def bij_betw_def by auto
 
 lemma subterm_inj_on_alt_def:
     "subterm_inj_on f A \<longleftrightarrow>
      (inj_on f A \<and> (\<forall>s \<in> f`A. \<forall>u \<in> f`A. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u))"
     (is "?A \<longleftrightarrow> ?B")
 unfolding subterm_inj_on_def inj_on_def by fastforce
 
 lemma subterm_inj_on_alt_def':
     "subterm_inj_on \<theta> (subst_domain \<theta>) \<longleftrightarrow>
      (inj_on \<theta> (subst_domain \<theta>) \<and>
       (\<forall>s \<in> subst_range \<theta>. \<forall>u \<in> subst_range \<theta>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u))"
     (is "?A \<longleftrightarrow> ?B")
 by (metis subterm_inj_on_alt_def subst_range.simps)
 
 lemma subterm_inj_on_subset:
   assumes "subterm_inj_on f A"
     and "B \<subseteq> A"
   shows "subterm_inj_on f B"
 proof -
   have "inj_on f A" "\<forall>s\<in>f ` A. \<forall>u\<in>f ` A. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     using subterm_inj_on_alt_def[of f A] assms(1) by auto
   moreover have "f ` B \<subseteq> f ` A" using assms(2) by auto
   ultimately have "inj_on f B" "\<forall>s\<in>f ` B. \<forall>u\<in>f ` B. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     using inj_on_subset[of f A] assms(2) by blast+
   thus ?thesis by (metis subterm_inj_on_alt_def)
 qed
 
 lemma inj_subst_unif_consts:
   fixes \<I> \<theta> \<sigma>::"('f,'v) subst" and s t::"('f,'v) term"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)" "\<forall>x \<in> (fv s \<union> fv t) - X. \<exists>c. \<theta> x = Fun c []"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}" "ground (subst_range \<theta>)"
              "subst_domain \<theta> \<inter> X = {}"
   and \<I>: "ground (subst_range \<I>)" "subst_domain \<I> = subst_domain \<theta>"
   and unif: "Unifier \<sigma> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
   shows "\<exists>\<delta>. Unifier \<delta> (s \<cdot> \<I>) (t \<cdot> \<I>)"
 proof -
   let ?xs = "subst_domain \<theta>"
   let ?ys = "(fv s \<union> fv t) - ?xs"
 
   have "\<exists>\<delta>::('f,'v) subst. s \<cdot> \<delta> = t \<cdot> \<delta>" by (metis subst_subst_compose unif)
   then obtain \<delta>::"('f,'v) subst" where \<delta>: "mgu s t = Some \<delta>"
     using mgu_always_unifies by moura
   have 1: "\<exists>\<sigma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<sigma> = t \<cdot> \<theta> \<cdot> \<sigma>" by (metis unif)
   have 2: "\<And>\<gamma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<gamma> = t \<cdot> \<theta> \<cdot> \<gamma> \<Longrightarrow> \<delta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<gamma>" using mgu_gives_MGU[OF \<delta>] by simp
   have 3: "\<And>(z::'v) (c::'f). \<delta> z = Fun c [] \<Longrightarrow> Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
     by (rule mgu_img_consts'[OF \<delta>])
   have 4: "subst_domain \<delta> \<inter> range_vars \<delta> = {}"
     by (metis mgu_gives_wellformed_subst[OF \<delta>] wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   have 5: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv s \<union> fv t"
     by (metis mgu_gives_wellformed_MGU[OF \<delta>] wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   { fix x and \<gamma>::"('f,'v) subst" assume "x \<in> subst_domain \<theta>"
     hence "(\<theta> \<circ>\<^sub>s \<gamma>) x = \<theta> x"
       using \<theta>(4) ident_comp_subst_trm_if_disj[of \<gamma> \<theta>]
       unfolding range_vars_alt_def by fast
   }
   then obtain \<tau>::"('f,'v) subst" where \<tau>: "\<forall>x \<in> subst_domain \<theta>. \<theta> x = (\<delta> \<circ>\<^sub>s \<tau>) x" using 1 2 by moura
 
   have *: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> \<exists>y \<in> ?ys. \<delta> x = Var y"
   proof -
     fix x assume "x \<in> subst_domain \<delta> \<inter> ?xs"
     hence x: "x \<in> subst_domain \<delta>" "x \<in> subst_domain \<theta>" by auto
     then obtain c where c: "\<theta> x = Fun c []" using \<theta>(2,5) 5 by moura
     hence *: "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []" using \<tau> x by fastforce
     hence **: "x \<in> subst_domain (\<delta> \<circ>\<^sub>s \<tau>)" "Fun c [] \<in> subst_range (\<delta> \<circ>\<^sub>s \<tau>)"
       by (auto simp add: subst_domain_def)
     have "\<delta> x = Fun c [] \<or> (\<exists>z. \<delta> x = Var z \<and> \<tau> z = Fun c [])"
       by (rule subst_img_comp_subset_const'[OF *])
     moreover have "\<delta> x \<noteq> Fun c []"
     proof (rule ccontr)
       assume "\<not>\<delta> x \<noteq> Fun c []"
       hence "Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t" using 3 by metis
       moreover have "\<forall>u \<in> subst_range \<theta>. u \<notin> subterms s \<union> subterms t"
         using \<theta>(3) by force
       hence "Fun c [] \<notin> subterms s \<union> subterms t"
         by (metis c \<open>ground (subst_range \<theta>)\<close>x(2) ground_subst_dom_iff_img) 
       ultimately show False by auto
     qed
     moreover have "\<forall>x' \<in> subst_domain \<theta>. \<delta> x \<noteq> Var x'"
     proof (rule ccontr)
       assume "\<not>(\<forall>x' \<in> subst_domain \<theta>. \<delta> x \<noteq> Var x')"
       then obtain x' where x': "x' \<in> subst_domain \<theta>" "\<delta> x = Var x'" by moura
       hence "\<tau> x' = Fun c []" "(\<delta> \<circ>\<^sub>s \<tau>) x = Fun c []" using * unfolding subst_compose_def by auto
       moreover have "x \<noteq> x'"
         using x(1) x'(2) 4
         by (auto simp add: subst_domain_def)
       moreover have "x' \<notin> subst_domain \<delta>"
         using x'(2) mgu_eliminates_dom[OF \<delta>]
         by (metis (no_types) subst_elim_def subst_apply_term.simps(1) vars_iff_subterm_or_eq)
       moreover have "(\<delta> \<circ>\<^sub>s \<tau>) x = \<theta> x" "(\<delta> \<circ>\<^sub>s \<tau>) x' = \<theta> x'" using \<tau> x(2) x'(1) by auto
       ultimately show False
         using subterm_inj_on_imp_inj_on[OF \<theta>(1)] *
         by (simp add: inj_on_def subst_compose_def x'(2) subst_domain_def)
     qed
     ultimately show "\<exists>y \<in> ?ys. \<delta> x = Var y"
       by (metis 5 x(2) subtermeqI' vars_iff_subtermeq DiffI Un_iff subst_fv_imgI sup.orderE)
   qed
 
   have **: "inj_on \<delta> (subst_domain \<delta> \<inter> ?xs)"
   proof (intro inj_onI)
     fix x y assume *:
       "x \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "y \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<delta> x = \<delta> y"
     hence "(\<delta> \<circ>\<^sub>s \<tau>) x = (\<delta> \<circ>\<^sub>s \<tau>) y" unfolding subst_compose_def by auto
     hence "\<theta> x = \<theta> y" using \<tau> * by auto
     thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \<theta>(1)]] *(1,2) by simp
   qed
 
   define \<alpha> where "\<alpha> = (\<lambda>y'. if Var y' \<in> \<delta> ` (subst_domain \<delta> \<inter> ?xs)
                             then Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y'))
                             else Var y'::('f,'v) term)"
   have a1: "Unifier (\<delta> \<circ>\<^sub>s \<alpha>) s t" using mgu_gives_MGU[OF \<delta>] by auto
 
   define \<delta>' where "\<delta>' = \<delta> \<circ>\<^sub>s \<alpha>"
   have d1: "subst_domain \<delta>' \<subseteq> ?ys"
   proof
     fix z assume z: "z \<in> subst_domain \<delta>'"
     have "z \<in> ?xs \<Longrightarrow> z \<notin> subst_domain \<delta>'"
     proof (cases "z \<in> subst_domain \<delta>")
       case True
       moreover assume "z \<in> ?xs"
       ultimately have z_in: "z \<in> subst_domain \<delta> \<inter> ?xs" by simp
       then obtain y where y: "\<delta> z = Var y" "y \<in> ?ys" using * by moura
       hence "\<alpha> y = Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y))"
         using \<alpha>_def z_in by simp
       hence "\<alpha> y = Var z" by (metis y(1) z_in ** inv_into_f_eq)
       hence "\<delta>' z = Var z" using \<delta>'_def y(1) subst_compose_def[of \<delta> \<alpha>] by simp
       thus ?thesis by (simp add: subst_domain_def)
     next
       case False
       hence "\<delta> z = Var z" by (simp add: subst_domain_def)
       moreover assume "z \<in> ?xs"
       hence "\<alpha> z = Var z" using \<alpha>_def * by force
       ultimately show ?thesis
         using \<delta>'_def subst_compose_def[of \<delta> \<alpha>]
         by (simp add: subst_domain_def)
     qed
     moreover have "subst_domain \<alpha> \<subseteq> range_vars \<delta>"
       unfolding \<delta>'_def \<alpha>_def range_vars_alt_def
       by (auto simp add: subst_domain_def)
     hence "subst_domain \<delta>' \<subseteq> subst_domain \<delta> \<union> range_vars \<delta>"
       using subst_domain_compose[of \<delta> \<alpha>] unfolding \<delta>'_def by blast
     ultimately show "z \<in> ?ys" using 5 z by auto
   qed
   have d2: "Unifier (\<delta>' \<circ>\<^sub>s \<I>) s t" using a1 \<delta>'_def by auto
   have d3: "\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I> = \<delta>' \<circ>\<^sub>s \<I>"
   proof -
     { fix z::'v assume z: "z \<in> ?xs"
       then obtain u where u: "\<I> z = u" "fv u = {}" using \<I> by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = u" by (simp add: subst_compose subst_ground_ident)
       moreover have "z \<notin> subst_domain \<delta>'" using d1 z by auto
       hence "\<delta>' z = Var z" by (simp add: subst_domain_def)
       hence "(\<delta>' \<circ>\<^sub>s \<I>) z = u" using u(1) by (simp add: subst_compose)
       ultimately have "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by metis
     } moreover {
       fix z::'v assume "z \<in> ?ys"
       hence "z \<notin> subst_domain \<I>" using \<I>(2) by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose subst_domain_def)
     } moreover {
       fix z::'v assume "z \<notin> ?xs" "z \<notin> ?ys"
       hence "\<I> z = Var z" "\<delta>' z = Var z" using \<I>(2) d1 by blast+
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose)
     } ultimately show ?thesis by auto
   qed
 
   from d2 d3 have "Unifier (\<delta>' \<circ>\<^sub>s \<I>) (s \<cdot> \<I>) (t \<cdot> \<I>)" by (metis subst_subst_compose) 
   thus ?thesis by metis
 qed
 
 lemma inj_subst_unif_comp_terms:
   fixes \<I> \<theta> \<sigma>::"('f,'v) subst" and s t::"('f,'v) term"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)" "ground (subst_range \<theta>)"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}"
              "(fv s \<union> fv t) - subst_domain \<theta> \<subseteq> X"
   and tfr: "\<forall>f U. Fun f U \<in> subterms s \<union> subterms t \<longrightarrow> U = [] \<or> (\<exists>u \<in> set U. u \<notin> Var ` X)"
   and \<I>: "ground (subst_range \<I>)" "subst_domain \<I> = subst_domain \<theta>"
   and unif: "Unifier \<sigma> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
   shows "\<exists>\<delta>. Unifier \<delta> (s \<cdot> \<I>) (t \<cdot> \<I>)"
 proof -
   let ?xs = "subst_domain \<theta>"
   let ?ys = "(fv s \<union> fv t) - ?xs"
 
   have "ground (subst_range \<theta>)" using \<theta>(2) by auto
 
   have "\<exists>\<delta>::('f,'v) subst. s \<cdot> \<delta> = t \<cdot> \<delta>" by (metis subst_subst_compose unif)
   then obtain \<delta>::"('f,'v) subst" where \<delta>: "mgu s t = Some \<delta>"
     using mgu_always_unifies by moura
   have 1: "\<exists>\<sigma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<sigma> = t \<cdot> \<theta> \<cdot> \<sigma>" by (metis unif)
   have 2: "\<And>\<gamma>::('f,'v) subst. s \<cdot> \<theta> \<cdot> \<gamma> = t \<cdot> \<theta> \<cdot> \<gamma> \<Longrightarrow> \<delta> \<preceq>\<^sub>\<circ> \<theta> \<circ>\<^sub>s \<gamma>" using mgu_gives_MGU[OF \<delta>] by simp
   have 3: "\<And>(z::'v) (c::'f).  Fun c [] \<sqsubseteq> \<delta> z \<Longrightarrow> Fun c [] \<sqsubseteq> s \<or> Fun c [] \<sqsubseteq> t"
     using mgu_img_consts[OF \<delta>] by force
   have 4: "subst_domain \<delta> \<inter> range_vars \<delta> = {}"
     using mgu_gives_wellformed_subst[OF \<delta>]
     by (metis wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   have 5: "subst_domain \<delta> \<union> range_vars \<delta> \<subseteq> fv s \<union> fv t"
     using mgu_gives_wellformed_MGU[OF \<delta>]
     by (metis wf\<^sub>M\<^sub>G\<^sub>U_def)
 
   { fix x and \<gamma>::"('f,'v) subst" assume "x \<in> subst_domain \<theta>"
     hence "(\<theta> \<circ>\<^sub>s \<gamma>) x = \<theta> x"
       using \<open>ground (subst_range \<theta>)\<close> ident_comp_subst_trm_if_disj[of \<gamma> \<theta> x]
       unfolding range_vars_alt_def by blast
   }
   then obtain \<tau>::"('f,'v) subst" where \<tau>: "\<forall>x \<in> subst_domain \<theta>. \<theta> x = (\<delta> \<circ>\<^sub>s \<tau>) x" using 1 2 by moura
 
   have ***: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> fv (\<delta> x) \<subseteq> ?ys"
   proof -
     fix x assume "x \<in> subst_domain \<delta> \<inter> ?xs"
     hence x: "x \<in> subst_domain \<delta>" "x \<in> subst_domain \<theta>" by auto
     moreover have "\<not>(\<exists>x' \<in> ?xs. x' \<in> fv (\<delta> x))"
     proof (rule ccontr)
       assume "\<not>\<not>(\<exists>x' \<in> ?xs. x' \<in> fv (\<delta> x))"
       then obtain x' where x': "x' \<in> fv (\<delta> x)" "x' \<in> ?xs" by metis
       have "x \<noteq> x'" "x' \<notin> subst_domain \<delta>" "\<delta> x' = Var x'"
         using 4 x(1) x'(1) unfolding range_vars_alt_def by auto
       hence "(\<delta> \<circ>\<^sub>s \<tau>) x' \<sqsubseteq> (\<delta> \<circ>\<^sub>s \<tau>) x" "\<tau> x' = (\<delta> \<circ>\<^sub>s \<tau>) x'"
         using \<tau> x(2) x'(2)
         by (metis subst_compose subst_mono vars_iff_subtermeq x'(1),
             metis subst_apply_term.simps(1) subst_compose_def)
       hence "\<theta> x' \<sqsubseteq> \<theta> x" using \<tau> x(2) x'(2) by auto
       thus False
         using \<theta>(1) x'(2) x(2) \<open>x \<noteq> x'\<close>
         unfolding subterm_inj_on_def 
         by (meson subtermeqI') 
     qed
     ultimately show "fv (\<delta> x) \<subseteq> ?ys"
       using 5 subst_dom_vars_in_subst[of x \<delta>] subst_fv_imgI[of \<delta> x]
       by blast
   qed
 
   have **: "inj_on \<delta> (subst_domain \<delta> \<inter> ?xs)"
   proof (intro inj_onI)
     fix x y assume *:
       "x \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "y \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<delta> x = \<delta> y"
     hence "(\<delta> \<circ>\<^sub>s \<tau>) x = (\<delta> \<circ>\<^sub>s \<tau>) y" unfolding subst_compose_def by auto
     hence "\<theta> x = \<theta> y" using \<tau> * by auto
     thus "x = y" using inj_onD[OF subterm_inj_on_imp_inj_on[OF \<theta>(1)]] *(1,2) by simp
   qed
 
   have *: "\<And>x. x \<in> subst_domain \<delta> \<inter> subst_domain \<theta> \<Longrightarrow> \<exists>y \<in> ?ys. \<delta> x = Var y"
   proof (rule ccontr)
     fix xi assume xi_assms: "xi \<in> subst_domain \<delta> \<inter> subst_domain \<theta>" "\<not>(\<exists>y \<in> ?ys. \<delta> xi = Var y)"
     hence xi_\<theta>: "xi \<in> subst_domain \<theta>" and \<delta>_xi_comp: "\<not>(\<exists>y. \<delta> xi = Var y)"
       using ***[of xi] 5 by auto
     then obtain f T where f: "\<delta> xi = Fun f T" by (cases "\<delta> xi") moura
 
     have "\<exists>g Y'. Y' \<noteq> [] \<and> Fun g (map Var Y') \<sqsubseteq> \<delta> xi \<and> set Y' \<subseteq> ?ys"
     proof -
       have "\<forall>c. Fun c [] \<sqsubseteq> \<delta> xi \<longrightarrow> Fun c [] \<sqsubseteq> \<theta> xi"
         using \<tau> xi_\<theta> by (metis const_subterm_subst subst_compose)
       hence 1: "\<forall>c. \<not>(Fun c [] \<sqsubseteq> \<delta> xi)"
         using 3[of _ xi] xi_\<theta> \<theta>(3)
         by auto
       
       have "\<not>(\<exists>x. \<delta> xi = Var x)" using f by auto
       hence "\<exists>g S. Fun g S \<sqsubseteq> \<delta> xi \<and> (\<forall>s \<in> set S. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x))"
         using nonvar_term_has_composed_shallow_term[of "\<delta> xi"] by auto
       then obtain g S where gS: "Fun g S \<sqsubseteq> \<delta> xi" "\<forall>s \<in> set S. (\<exists>c. s = Fun c []) \<or> (\<exists>x. s = Var x)"
         by moura
 
       have "\<forall>s \<in> set S. \<exists>x. s = Var x"
         using 1 term.order_trans gS
         by (metis (no_types, lifting) UN_I term.order_refl subsetCE subterms.simps(2) sup_ge2)
       then obtain S' where 2: "map Var S' = S" by (metis ex_map_conv)
 
       have "S \<noteq> []" using 1 term.order_trans[OF _ gS(1)] by fastforce
       hence 3: "S' \<noteq> []" "Fun g (map Var S') \<sqsubseteq> \<delta> xi" using gS(1) 2 by auto
 
       have "set S' \<subseteq> fv (Fun g (map Var S'))" by simp
       hence 4: "set S' \<subseteq> fv (\<delta> xi)" using 3(2) fv_subterms by force
       
       show ?thesis using ***[OF xi_assms(1)] 2 3 4 by auto
     qed
     then obtain g Y' where g: "Y' \<noteq> []" "Fun g (map Var Y') \<sqsubseteq> \<delta> xi" "set Y' \<subseteq> ?ys" by moura
     then obtain X where X: "map \<delta> X = map Var Y'" "Fun g (map Var X) \<in> subterms s \<union> subterms t"
       using mgu_img_composed_var_term[OF \<delta>, of g Y'] by force
     hence "\<exists>(u::('f,'v) term) \<in> set (map Var X). u \<notin> Var ` ?ys"
       using \<theta>(4) tfr g(1) by fastforce
     then obtain j where j: "j < length X" "X ! j \<notin> ?ys"
       by (metis image_iff[of _ Var "fv s \<union> fv t - subst_domain \<theta>"] nth_map[of _ X Var]
                 in_set_conv_nth[of _ "map Var X"] length_map[of Var X])
 
     define yj' where yj': "yj' \<equiv> Y' ! j"
     define xj where xj: "xj \<equiv> X ! j"
 
     have "xj \<in> fv s \<union> fv t"
       using j X(1) g(3) 5 xj yj'
       by (metis length_map nth_map term.simps(1) in_set_conv_nth le_supE subsetCE subst_domI) 
     hence xj_\<theta>: "xj \<in> subst_domain \<theta>" using j unfolding xj by simp
 
     have len: "length X = length Y'" by (rule map_eq_imp_length_eq[OF X(1)])
     
     have "Var yj' \<sqsubseteq> \<delta> xi"
       using term.order_trans[OF _ g(2)] j(1) len unfolding yj' by auto
     hence "\<tau> yj' \<sqsubseteq> \<theta> xi"
       using \<tau> xi_\<theta> by (metis subst_apply_term.simps(1) subst_compose_def subst_mono) 
     moreover have \<delta>_xj_var: "Var yj' = \<delta> xj"
       using X(1) len j(1) nth_map
       unfolding xj yj' by metis
     hence "\<tau> yj' = \<theta> xj" using \<tau> xj_\<theta> by (metis subst_apply_term.simps(1) subst_compose_def) 
     moreover have "xi \<noteq> xj" using \<delta>_xi_comp \<delta>_xj_var by auto
     ultimately show False using \<theta>(1) xi_\<theta> xj_\<theta> unfolding subterm_inj_on_def by blast
   qed
 
   define \<alpha> where "\<alpha> = (\<lambda>y'. if Var y' \<in> \<delta> ` (subst_domain \<delta> \<inter> ?xs)
                             then Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y'))
                             else Var y'::('f,'v) term)"
   have a1: "Unifier (\<delta> \<circ>\<^sub>s \<alpha>) s t" using mgu_gives_MGU[OF \<delta>] by auto
 
   define \<delta>' where "\<delta>' = \<delta> \<circ>\<^sub>s \<alpha>"
   have d1: "subst_domain \<delta>' \<subseteq> ?ys"
   proof
     fix z assume z: "z \<in> subst_domain \<delta>'"
     have "z \<in> ?xs \<Longrightarrow> z \<notin> subst_domain \<delta>'"
     proof (cases "z \<in> subst_domain \<delta>")
       case True
       moreover assume "z \<in> ?xs"
       ultimately have z_in: "z \<in> subst_domain \<delta> \<inter> ?xs" by simp
       then obtain y where y: "\<delta> z = Var y" "y \<in> ?ys" using * by moura
       hence "\<alpha> y = Var ((inv_into (subst_domain \<delta> \<inter> ?xs) \<delta>) (Var y))"
         using \<alpha>_def z_in by simp
       hence "\<alpha> y = Var z" by (metis y(1) z_in ** inv_into_f_eq)
       hence "\<delta>' z = Var z" using \<delta>'_def y(1) subst_compose_def[of \<delta> \<alpha>] by simp
       thus ?thesis by (simp add: subst_domain_def)
     next
       case False
       hence "\<delta> z = Var z" by (simp add: subst_domain_def)
       moreover assume "z \<in> ?xs"
       hence "\<alpha> z = Var z" using \<alpha>_def * by force
       ultimately show ?thesis using \<delta>'_def subst_compose_def[of \<delta> \<alpha>] by (simp add: subst_domain_def)
     qed
     moreover have "subst_domain \<alpha> \<subseteq> range_vars \<delta>"
       unfolding \<delta>'_def \<alpha>_def range_vars_alt_def subst_domain_def
       by auto
     hence "subst_domain \<delta>' \<subseteq> subst_domain \<delta> \<union> range_vars \<delta>"
       using subst_domain_compose[of \<delta> \<alpha>]
       unfolding \<delta>'_def by blast
     ultimately show "z \<in> ?ys" using 5 z by blast
   qed
   have d2: "Unifier (\<delta>' \<circ>\<^sub>s \<I>) s t" using a1 \<delta>'_def by auto
   have d3: "\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I> = \<delta>' \<circ>\<^sub>s \<I>"
   proof -
     { fix z::'v assume z: "z \<in> ?xs"
       then obtain u where u: "\<I> z = u" "fv u = {}" using \<I> by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = u" by (simp add: subst_compose subst_ground_ident)
       moreover have "z \<notin> subst_domain \<delta>'" using d1 z by auto
       hence "\<delta>' z = Var z" by (simp add: subst_domain_def)
       hence "(\<delta>' \<circ>\<^sub>s \<I>) z = u" using u(1) by (simp add: subst_compose)
       ultimately have "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by metis
     } moreover {
       fix z::'v assume "z \<in> ?ys"
       hence "z \<notin> subst_domain \<I>" using \<I>(2) by auto
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose subst_domain_def)
     } moreover {
       fix z::'v assume "z \<notin> ?xs" "z \<notin> ?ys"
       hence "\<I> z = Var z" "\<delta>' z = Var z" using \<I>(2) d1 by blast+
       hence "(\<I> \<circ>\<^sub>s \<delta>' \<circ>\<^sub>s \<I>) z = (\<delta>' \<circ>\<^sub>s \<I>) z" by (simp add: subst_compose)
     } ultimately show ?thesis by auto
   qed
 
   from d2 d3 have "Unifier (\<delta>' \<circ>\<^sub>s \<I>) (s \<cdot> \<I>) (t \<cdot> \<I>)" by (metis subst_subst_compose) 
   thus ?thesis by metis
 qed
 
 context
 begin
 private lemma sat_ineq_subterm_inj_subst_aux:
   fixes \<I>::"('f,'v) subst"
   assumes "Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>)" "ground (subst_range \<I>)"
           "(fv s \<union> fv t) - X \<subseteq> subst_domain \<I>" "subst_domain \<I> \<inter> X = {}"
   shows "\<exists>\<delta>::('f,'v) subst. subst_domain \<delta> = X \<and> ground (subst_range \<delta>) \<and> s \<cdot> \<delta> \<cdot> \<I> = t \<cdot> \<delta> \<cdot> \<I>"
 proof -
   have "\<exists>\<sigma>. Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>) \<and> interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
   proof -
     obtain \<I>'::"('f,'v) subst" where *: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>'"
       using interpretation_subst_exists by metis
     hence "Unifier (\<sigma> \<circ>\<^sub>s \<I>') (s \<cdot> \<I>) (t \<cdot> \<I>)" using assms(1) by simp
     thus ?thesis using * interpretation_comp by blast
   qed
   then obtain \<sigma>' where \<sigma>': "Unifier \<sigma>' (s \<cdot> \<I>) (t \<cdot> \<I>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>'" by moura
   
   define \<sigma>'' where "\<sigma>'' = rm_vars (UNIV - X) \<sigma>'"
   
   have *: "fv (s \<cdot> \<I>) \<subseteq> X" "fv (t \<cdot> \<I>) \<subseteq> X"
     using assms(2,3) subst_fv_unfold_ground_img[of \<I>]
     unfolding range_vars_alt_def
     by (simp_all add: Diff_subset_conv Un_commute)
   hence **: "subst_domain \<sigma>'' = X" "ground (subst_range \<sigma>'')"
     using rm_vars_img_subset[of "UNIV - X" \<sigma>'] rm_vars_dom[of "UNIV - X" \<sigma>'] \<sigma>'(2)
     unfolding \<sigma>''_def by auto
   hence "\<And>t. t \<cdot> \<I> \<cdot> \<sigma>'' = t \<cdot> \<sigma>'' \<cdot> \<I>"
     using subst_eq_if_disjoint_vars_ground[OF _ _ assms(2)] assms(4) by blast
   moreover have "Unifier \<sigma>'' (s \<cdot> \<I>) (t \<cdot> \<I>)"
     using Unifier_dom_restrict[OF \<sigma>'(1)] \<sigma>''_def * by blast
   ultimately show ?thesis using ** by auto
 qed
 
 text \<open>
   The "inequality lemma": This lemma gives sufficient syntactic conditions for finding substitutions
   \<open>\<theta>\<close> under which terms \<open>s\<close> and \<open>t\<close> are not unifiable.
 
   This is useful later when establishing the typing results since we there want to find well-typed
   solutions to inequality constraints / "negative checks" constraints, and this lemma gives
   conditions for protocols under which such constraints are well-typed satisfiable if satisfiable.
 \<close>
 lemma sat_ineq_subterm_inj_subst:
   fixes \<theta> \<I> \<delta>::"('f,'v) subst"
   assumes \<theta>: "subterm_inj_on \<theta> (subst_domain \<theta>)"
              "ground (subst_range \<theta>)"
              "subst_domain \<theta> \<inter> X = {}"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<inter> (subterms s \<union> subterms t) = {}"
              "(fv s \<union> fv t) - subst_domain \<theta> \<subseteq> X"
   and tfr: "(\<forall>x \<in> (fv s \<union> fv t) - X. \<exists>c. \<theta> x = Fun c []) \<or>
             (\<forall>f U. Fun f U \<in> subterms s \<union> subterms t \<longrightarrow> U = [] \<or> (\<exists>u \<in> set U. u \<notin> Var ` X))"
   and \<I>: "\<forall>\<delta>::('f,'v) subst. subst_domain \<delta> = X \<and> ground (subst_range \<delta>) \<longrightarrow> s \<cdot> \<delta> \<cdot> \<I> \<noteq> t \<cdot> \<delta> \<cdot> \<I>"
          "(fv s \<union> fv t) - X \<subseteq> subst_domain \<I>" "subst_domain \<I> \<inter> X = {}" "ground (subst_range \<I>)"
          "subst_domain \<I> = subst_domain \<theta>"
   and \<delta>: "subst_domain \<delta> = X" "ground (subst_range \<delta>)"
   shows "s \<cdot> \<delta> \<cdot> \<theta> \<noteq> t \<cdot> \<delta> \<cdot> \<theta>"
 proof -
   have "\<forall>\<sigma>. \<not>Unifier \<sigma> (s \<cdot> \<I>) (t \<cdot> \<I>)"
     by (metis \<I>(1) sat_ineq_subterm_inj_subst_aux[OF _ \<I>(4,2,3)])
   hence "\<not>Unifier \<delta> (s \<cdot> \<theta>) (t \<cdot> \<theta>)"
     using inj_subst_unif_consts[OF \<theta>(1) _ \<theta>(4,2,3) \<I>(4,5)]
           inj_subst_unif_comp_terms[OF \<theta>(1,2,4,5) _ \<I>(4,5)]
           tfr
     by metis
   moreover have "subst_domain \<delta> \<inter> subst_domain \<theta> = {}" using \<theta>(2,3) \<delta>(1) by auto
   ultimately show ?thesis using \<delta> subst_eq_if_disjoint_vars_ground[OF _ \<theta>(2) \<delta>(2)] by metis
 qed
 end
 
 lemma ineq_subterm_inj_cond_subst:
   assumes "X \<inter> range_vars \<theta> = {}"
   and "\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t S \<longrightarrow> T = [] \<or> (\<exists>u \<in> set T. u \<notin> Var`X)"
   shows "\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<longrightarrow> T = [] \<or> (\<exists>u \<in> set T. u \<notin> Var`X)"
 proof (intro allI impI)
   let ?M = "\<lambda>S. subterms\<^sub>s\<^sub>e\<^sub>t S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   let ?N = "\<lambda>S. subterms\<^sub>s\<^sub>e\<^sub>t (\<theta> ` (fv\<^sub>s\<^sub>e\<^sub>t S \<inter> subst_domain \<theta>))"
 
   fix f T assume "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (S \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   hence 1: "Fun f T \<in> ?M S \<or> Fun f T \<in> ?N S"
     using subterms_subst[of _ \<theta>] by auto
 
   have 2: "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<Longrightarrow> \<forall>u \<in> set T. u \<notin> Var`X"
     using fv_subset_subterms[of "Fun f T" "subst_range \<theta>"] assms(1)
     unfolding range_vars_alt_def by force
 
   have 3: "\<forall>x \<in> subst_domain \<theta>. \<theta> x \<notin> Var`X"
   proof
     fix x assume "x \<in> subst_domain \<theta>"
     hence "fv (\<theta> x) \<subseteq> range_vars \<theta>"
       using subst_dom_vars_in_subst subst_fv_imgI
       unfolding range_vars_alt_def by auto
     thus "\<theta> x \<notin> Var`X" using assms(1) by auto
   qed
 
   show "T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var`X)" using 1
   proof
     assume "Fun f T \<in> ?M S"
     then obtain u where u: "u \<in> subterms\<^sub>s\<^sub>e\<^sub>t S" "u \<cdot> \<theta> = Fun f T" by fastforce
     show ?thesis
     proof (cases u)
       case (Var x)
       hence "Fun f T \<in> subst_range \<theta>" using u(2) by (simp add: subst_domain_def)
       hence "\<forall>u \<in> set T. u \<notin> Var`X" using 2 by force
       thus ?thesis by auto
     next
       case (Fun g S)
       hence "S = [] \<or> (\<exists>u \<in> set S. u \<notin> Var`X)" using assms(2) u(1) by metis
       thus ?thesis
       proof
         assume "S = []" thus ?thesis using u(2) Fun by simp
       next
         assume "\<exists>u \<in> set S. u \<notin> Var`X"
         then obtain u' where u': "u' \<in> set S" "u' \<notin> Var`X" by moura
         hence "u' \<cdot> \<theta> \<in> set T" using u(2) Fun by auto
         thus ?thesis using u'(2) 3 by (cases u') force+
       qed
     qed
   next
     assume "Fun f T \<in> ?N S"
     thus ?thesis using 2 by force
   qed
 qed
 
 
 subsection \<open>Lemmata: Sufficient Conditions for Term Matching\<close>
 definition subst_var_inv::"('a,'b) subst \<Rightarrow> 'b set \<Rightarrow> ('a,'b) subst" where
   "subst_var_inv \<delta> X \<equiv> (\<lambda>x. if Var x \<in> \<delta> ` X then Var ((inv_into X \<delta>) (Var x)) else Var x)"
 
 lemma subst_var_inv_subst_domain:
   assumes "x \<in> subst_domain (subst_var_inv \<delta> X)"
   shows "Var x \<in> \<delta> ` X"
 by (meson assms subst_dom_vars_in_subst subst_var_inv_def)
 
 lemma subst_var_inv_subst_domain':
   assumes "X \<subseteq> subst_domain \<delta>"
   shows "x \<in> subst_domain (subst_var_inv \<delta> X) \<longleftrightarrow> Var x \<in> \<delta> ` X"
 proof
   show "Var x \<in> \<delta> ` X \<Longrightarrow> x \<in> subst_domain (subst_var_inv \<delta> X)"
     by (metis (no_types, lifting) assms f_inv_into_f in_mono inv_into_into
           subst_domI subst_dom_vars_in_subst subst_var_inv_def term.inject(1))
 qed (rule subst_var_inv_subst_domain)
 
 lemma subst_var_inv_Var_range:
   "subst_range (subst_var_inv \<delta> X) \<subseteq> range Var"
 unfolding subst_var_inv_def by auto
 
 text \<open>Injective substitutions from variables to variables are invertible\<close>
 lemma inj_var_ran_subst_is_invertible:
   assumes \<delta>_inj_on_X: "inj_on \<delta> X"
     and \<delta>_var_on_X: "\<delta> ` X \<subseteq> range Var"
     and fv_t: "fv t \<subseteq> X"
   shows "t = t \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> X"
 proof -
   have "\<delta> x \<cdot> subst_var_inv \<delta> X = Var x" when x: "x \<in> X" for x
   proof -
     obtain y where y: "\<delta> x = Var y" using x \<delta>_var_on_X fv_t by auto
     hence "Var y \<in> \<delta> ` X" using x by simp
     thus ?thesis using y inv_into_f_eq[OF \<delta>_inj_on_X x y] unfolding subst_var_inv_def by simp
   qed
   thus ?thesis using fv_t by (simp add: subst_compose_def trm_subst_ident'' subset_eq)
 qed
 
 lemma inj_var_ran_subst_is_invertible':
   assumes \<delta>_inj_on_t: "inj_on \<delta> (fv t)"
     and \<delta>_var_on_t: "\<delta> ` fv t \<subseteq> range Var"
   shows "t = t \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> (fv t)"
 using assms inj_var_ran_subst_is_invertible by fast
 
 text \<open>Sufficient conditions for matching unifiable terms\<close>
 lemma inj_var_ran_unifiable_has_subst_match:
   assumes "t \<cdot> \<delta> = s \<cdot> \<delta>" "inj_on \<delta> (fv t)" "\<delta> ` fv t \<subseteq> range Var"
   shows "t = s \<cdot> \<delta> \<circ>\<^sub>s subst_var_inv \<delta> (fv t)"
 using assms inj_var_ran_subst_is_invertible by fastforce
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Typed_Model.thy
@@ -1,2203 +1,2203 @@
 (*  Title:      Typed_Model.thy
     Author:     Andreas Viktor Hess, DTU
     SPDX-License-Identifier: BSD-3-Clause
 *)
 
 section \<open>The Typed Model\<close>
 theory Typed_Model
 imports Lazy_Intruder
 begin
 
 text \<open>Term types\<close>
 type_synonym ('f,'v) term_type = "('f,'v) term"
 
 text \<open>Constructors for term types\<close>
 abbreviation (input) TAtom::"'v \<Rightarrow> ('f,'v) term_type" where
   "TAtom a \<equiv> Var a"
 
 abbreviation (input) TComp::"['f, ('f,'v) term_type list] \<Rightarrow> ('f,'v) term_type" where
   "TComp f ts \<equiv> Fun f ts"
 
 
 text \<open>
   The typed model extends the intruder model with a typing function \<open>\<Gamma>\<close> that assigns types to terms.
 \<close>
 locale typed_model = intruder_model arity public Ana
   for arity::"'fun \<Rightarrow> nat"
     and public::"'fun \<Rightarrow> bool"
     and Ana::"('fun,'var) term \<Rightarrow> (('fun,'var) term list \<times> ('fun,'var) term list)"
   +
   fixes \<Gamma>::"('fun,'var) term \<Rightarrow> ('fun,'atom::finite) term_type"
   assumes const_type: "\<And>c. arity c = 0 \<Longrightarrow> \<exists>a. \<forall>ts. \<Gamma> (Fun c ts) = TAtom a"
     and fun_type: "\<And>f ts. arity f > 0 \<Longrightarrow> \<Gamma> (Fun f ts) = TComp f (map \<Gamma> ts)"
     and \<Gamma>_wf: "\<And>x f ts. TComp f ts \<sqsubseteq> \<Gamma> (Var x) \<Longrightarrow> arity f > 0"
               "\<And>x. wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> (Var x))"
 begin
 
 
 subsection \<open>Definitions\<close>
 text \<open>The set of atomic types\<close>
 abbreviation "\<TT>\<^sub>a \<equiv> UNIV::('atom set)"
 
 text \<open>Well-typed substitutions\<close>
 definition wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t where
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<equiv> (\<forall>v. \<Gamma> (Var v) = \<Gamma> (\<sigma> v))"
 
 text \<open>The set of sub-message patterns (SMP)\<close>
 inductive_set SMP::"('fun,'var) terms \<Rightarrow> ('fun,'var) terms" for M where
   MP[intro]: "t \<in> M \<Longrightarrow> t \<in> SMP M"
 | Subterm[intro]: "\<lbrakk>t \<in> SMP M; t' \<sqsubseteq> t\<rbrakk> \<Longrightarrow> t' \<in> SMP M"
 | Substitution[intro]: "\<lbrakk>t \<in> SMP M; wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>; wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)\<rbrakk> \<Longrightarrow> (t \<cdot> \<delta>) \<in> SMP M"
 | Ana[intro]: "\<lbrakk>t \<in> SMP M; Ana t = (K,T); k \<in> set K\<rbrakk> \<Longrightarrow> k \<in> SMP M"
 
 text \<open>
   Type-flaw resistance for sets:
   Unifiable sub-message patterns must have the same type (unless they are variables)
 \<close>
 definition tfr\<^sub>s\<^sub>e\<^sub>t where
   "tfr\<^sub>s\<^sub>e\<^sub>t M \<equiv> (\<forall>s \<in> SMP M - (Var`\<V>). \<forall>t \<in> SMP M - (Var`\<V>). (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t)"
 
 text \<open>
   Type-flaw resistance for strand steps:
   - The terms in a satisfiable equality step must have the same types
   - Inequality steps must satisfy the conditions of the "inequality lemma"\<close>
 fun tfr\<^sub>s\<^sub>t\<^sub>p where
   "tfr\<^sub>s\<^sub>t\<^sub>p (Equality a t t') = ((\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t')"
 | "tfr\<^sub>s\<^sub>t\<^sub>p (Inequality X F) = (
       (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a) \<or>
       (\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X)))"
 | "tfr\<^sub>s\<^sub>t\<^sub>p _ = True"
 
 text \<open>
   Type-flaw resistance for strands:
   - The set of terms in strands must be type-flaw resistant
   - The steps of strands must be type-flaw resistant
 \<close>
 definition tfr\<^sub>s\<^sub>t where
   "tfr\<^sub>s\<^sub>t S \<equiv> tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S) \<and> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
 
 
 subsection \<open>Small Lemmata\<close>
 lemma tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \<longleftrightarrow>
     ((\<forall>a t t'. Equality a t t' \<in> set S \<and> (\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t') \<and>
     (\<forall>X F. Inequality X F \<in> set S \<longrightarrow> 
       (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)
     \<or> (\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))))"
   (is "?P S \<longleftrightarrow> ?Q S")
 proof
   show "?P S \<Longrightarrow> ?Q S"
   proof (induction S)
     case (Cons x S) thus ?case by (cases x) auto
   qed simp
 
   show "?Q S \<Longrightarrow> ?P S"
   proof (induction S)
     case (Cons x S) thus ?case by (cases x) auto
   qed simp
 qed
 
 lemma \<Gamma>_wf'': "TComp f T \<sqsubseteq> \<Gamma> t \<Longrightarrow> arity f > 0"
 proof (induction t)
   case (Var x) thus ?case using \<Gamma>_wf(1)[of f T x] by blast
 next
   case (Fun g S) thus ?case
     using fun_type[of g S] const_type[of g] by (cases "arity g") auto
 qed
 
 lemma \<Gamma>_wf': "wf\<^sub>t\<^sub>r\<^sub>m t \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> t)"
 proof (induction t)
   case (Fun f T)
   hence *: "arity f = length T" "\<And>t. t \<in> set T \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m (\<Gamma> t)" unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   { assume "arity f = 0" hence ?case using const_type[of f] by auto }
   moreover
   { assume "arity f > 0" hence ?case using fun_type[of f] * by force }
   ultimately show ?case by auto 
 qed (metis \<Gamma>_wf(2))
 
 lemma fun_type_inv: assumes "\<Gamma> t = TComp f T" shows "arity f > 0"
 using \<Gamma>_wf''(1)[of f T t] assms by simp_all
 
 lemma fun_type_inv_wf: assumes "\<Gamma> t = TComp f T" "wf\<^sub>t\<^sub>r\<^sub>m t" shows "arity f = length T"
 using \<Gamma>_wf'[OF assms(2)] assms(1) unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
 
 lemma const_type_inv: "\<Gamma> (Fun c X) = TAtom a \<Longrightarrow> arity c = 0"
 by (rule ccontr, simp add: fun_type)
 
 lemma const_type_inv_wf: assumes "\<Gamma> (Fun c X) = TAtom a" and "wf\<^sub>t\<^sub>r\<^sub>m (Fun c X)" shows "X = []"
 by (metis assms const_type_inv length_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
 
 lemma const_type': "\<forall>c \<in> \<C>. \<exists>a \<in> \<TT>\<^sub>a. \<forall>X. \<Gamma> (Fun c X) = TAtom a" using const_type by simp
 lemma fun_type': "\<forall>f \<in> \<Sigma>\<^sub>f. \<forall>X. \<Gamma> (Fun f X) = TComp f (map \<Gamma> X)" using fun_type by simp
 
 lemma fun_type_id_eq: "\<Gamma> (Fun f X) = TComp g Y \<Longrightarrow> f = g"
 by (metis const_type fun_type neq0_conv "term.inject"(2) "term.simps"(4))
 
 lemma fun_type_length_eq: "\<Gamma> (Fun f X) = TComp g Y \<Longrightarrow> length X = length Y"
 by (metis fun_type fun_type_id_eq fun_type_inv(1) length_map term.inject(2))
 
 lemma pgwt_type_map: 
   assumes "public_ground_wf_term t"
   shows "\<Gamma> t = TAtom a \<Longrightarrow> \<exists>f. t = Fun f []" "\<Gamma> t = TComp g Y \<Longrightarrow> \<exists>X. t = Fun g X \<and> map \<Gamma> X = Y"
 proof -
   let ?A = "\<Gamma> t = TAtom a \<longrightarrow> (\<exists>f. t = Fun f [])"
   let ?B = "\<Gamma> t = TComp g Y \<longrightarrow> (\<exists>X. t = Fun g X \<and> map \<Gamma> X = Y)"
   have "?A \<and> ?B"
   proof (cases "\<Gamma> t")
     case (Var a)
     obtain f X where "t = Fun f X" "arity f = length X"
       using pgwt_fun[OF assms(1)] pgwt_arity[OF assms(1)] by fastforce+
     thus ?thesis using const_type_inv \<open>\<Gamma> t = TAtom a\<close> by auto
   next
     case (Fun g Y)
     obtain f X where *: "t = Fun f X" using pgwt_fun[OF assms(1)] by force
     hence "f = g" "map \<Gamma> X = Y"
       using fun_type_id_eq \<open>\<Gamma> t = TComp g Y\<close> fun_type[OF fun_type_inv(1)[OF \<open>\<Gamma> t = TComp g Y\<close>]]
       by fastforce+
     thus ?thesis using *(1) \<open>\<Gamma> t = TComp g Y\<close> by auto 
   qed
   thus "\<Gamma> t = TAtom a \<Longrightarrow> \<exists>f. t = Fun f []" "\<Gamma> t = TComp g Y \<Longrightarrow> \<exists>X. t = Fun g X \<and> map \<Gamma> X = Y"
     by auto
 qed 
 
 lemma wt_subst_Var[simp]: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" by (metis wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_trm: "(\<And>v. v \<in> fv t \<Longrightarrow> \<Gamma> (Var v) = \<Gamma> (\<theta> v)) \<Longrightarrow> \<Gamma> t = \<Gamma> (t \<cdot> \<theta>)"
 proof (induction t)
   case (Fun f X)
   hence *: "\<And>x. x \<in> set X \<Longrightarrow> \<Gamma> x = \<Gamma> (x \<cdot> \<theta>)" by auto
   show ?case
   proof (cases "f \<in> \<Sigma>\<^sub>f")
     case True
     hence "\<forall>X. \<Gamma> (Fun f X) = TComp f (map \<Gamma> X)" using fun_type' by auto
     thus ?thesis using * by auto
   next
     case False
     hence "\<exists>a \<in> \<TT>\<^sub>a. \<forall>X. \<Gamma> (Fun f X) = TAtom a" using const_type' by auto
     thus ?thesis by auto
   qed
 qed auto
 
 lemma wt_subst_trm': "\<lbrakk>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>; \<Gamma> s = \<Gamma> t\<rbrakk> \<Longrightarrow> \<Gamma> (s \<cdot> \<sigma>) = \<Gamma> (t \<cdot> \<sigma>)"
 by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_trm'': "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma> \<Longrightarrow> \<Gamma> t = \<Gamma> (t \<cdot> \<sigma>)"
 by (metis wt_subst_trm wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
 
 lemma wt_subst_compose:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)"
 proof -
   have "\<And>v. \<Gamma> (\<theta> v) = \<Gamma> (\<theta> v \<cdot> \<delta>)" using wt_subst_trm \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis
   moreover have "\<And>v. \<Gamma> (Var v) = \<Gamma> (\<theta> v)" using \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by metis
   ultimately have "\<And>v. \<Gamma> (Var v) = \<Gamma> (\<theta> v \<cdot> \<delta>)" by metis
   thus ?thesis unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_compose_def by metis
 qed
 
 lemma wt_subst_TAtom_Var_cases:
   assumes \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
   and x: "\<Gamma> (Var x) = TAtom a"
   shows "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])"
 proof (cases "(\<exists>y. \<theta> x = Var y)")
   case False
   then obtain c T where c: "\<theta> x = Fun c T"
     by (cases "\<theta> x") simp_all
   hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun c T)"
     using \<theta>(2) by fastforce
   hence "T = []"
     using const_type_inv_wf[of c T a] x c wt_subst_trm''[OF \<theta>(1), of "Var x"]
     by fastforce
   thus ?thesis
     using c by blast
 qed simp
 
 lemma wt_subst_TAtom_fv:
   assumes \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)"
   and "\<forall>x \<in> fv t - X. \<exists>a. \<Gamma> (Var x) = TAtom a"
   shows "\<forall>x \<in> fv (t \<cdot> \<theta>) - fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` X). \<exists>a. \<Gamma> (Var x) = TAtom a"
 using assms(3)
 proof (induction t)
   case (Var x) thus ?case
   proof (cases "x \<in> X")
     case False
     with Var obtain a where "\<Gamma> (Var x) = TAtom a" by moura
     hence *: "\<Gamma> (\<theta> x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> x)" using \<theta> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
     show ?thesis
     proof (cases "\<theta> x")
       case (Var y) thus ?thesis using * by auto
     next
       case (Fun f T)
       hence "T = []" using * const_type_inv[of f T a] unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       thus ?thesis using Fun by auto
     qed
   qed auto
 qed fastforce
 
 lemma wt_subst_TAtom_subterms_subst:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x \<in> fv t. \<exists>a. \<Gamma> (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<theta> ` fv t)"
   shows "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 using assms(2,3)
 proof (induction t)
   case (Var x)
   obtain a where a: "\<Gamma> (Var x) = TAtom a" using Var.prems(1) by moura
   hence "\<Gamma> (\<theta> x) = TAtom a" using wt_subst_trm''[OF assms(1), of "Var x"] by simp
   hence "(\<exists>y. \<theta> x = Var y) \<or> (\<exists>c. \<theta> x = Fun c [])"
     using const_type_inv_wf Var.prems(2) by (cases "\<theta> x") auto
   thus ?case by auto
 next
   case (Fun f T)
   have "subterms (t \<cdot> \<theta>) = subterms t \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" when "t \<in> set T" for t
     using that Fun.prems(1,2) Fun.IH[OF that]
     by auto
   thus ?case by auto
 qed
 
 lemma wt_subst_TAtom_subterms_set_subst: 
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "\<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<exists>a. \<Gamma> (Var x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<theta> ` fv\<^sub>s\<^sub>e\<^sub>t M)"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) = subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
 proof
   show "subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
   proof
     fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
     then obtain s where s: "s \<in> M" "t \<in> subterms (s \<cdot> \<theta>)" by auto
     thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
       using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s]
       by auto
   qed
 
   show "subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
   proof
     fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
     then obtain s where s: "s \<in> M" "t \<in> subterms s \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>" by auto
     thus "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
       using assms(2,3) wt_subst_TAtom_subterms_subst[OF assms(1), of s]
       by auto
   qed
 qed
 
 lemma wt_subst_subst_upd:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "\<Gamma> (Var x) = \<Gamma> t"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta>(x := t))"
 using assms unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
 by (metis fun_upd_other fun_upd_same)
 
 lemma wt_subst_const_fv_type_eq:
   assumes "\<forall>x \<in> fv t. \<exists>a. \<Gamma> (Var x) = TAtom a"
     and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "\<forall>x \<in> fv (t \<cdot> \<delta>). \<exists>y \<in> fv t. \<Gamma> (Var x) = \<Gamma> (Var y)"
 using assms(1)
 proof (induction t)
   case (Var x)
   then obtain a where a: "\<Gamma> (Var x) = TAtom a" by moura
   show ?case
   proof (cases "\<delta> x")
     case (Fun f T)
     hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" "\<Gamma> (Fun f T) = TAtom a"
       using a wt_subst_trm''[OF \<delta>(1), of "Var x"] \<delta>(2) by fastforce+
     thus ?thesis using const_type_inv_wf Fun by fastforce
   qed (use a wt_subst_trm''[OF \<delta>(1), of "Var x"] in simp)
 qed fastforce
 
 lemma TComp_term_cases:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TComp f T"
   shows "(\<exists>v. t = Var v) \<or> (\<exists>T'. t = Fun f T' \<and> T = map \<Gamma> T' \<and> T' \<noteq> [])"
 proof (cases "\<exists>v. t = Var v")
   case False
   then obtain T' where T': "t = Fun f T'" "T = map \<Gamma> T'"
     using assms fun_type[OF fun_type_inv(1)[OF assms(2)]] fun_type_id_eq
     by (cases t) force+
   thus ?thesis using assms fun_type_inv(1) fun_type_inv_wf by fastforce
 qed metis
 
 lemma TAtom_term_cases:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TAtom \<tau>"
   shows "(\<exists>v. t = Var v) \<or> (\<exists>f. t = Fun f [])"
 using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) auto
 
 lemma subtermeq_imp_subtermtypeeq:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "s \<sqsubseteq> t"
   shows "\<Gamma> s \<sqsubseteq> \<Gamma> t"
 using assms(2,1)
 proof (induction t)
   case (Fun f T) thus ?case
   proof (cases "s = Fun f T")
     case False
     then obtain x where x: "x \<in> set T" "s \<sqsubseteq> x" using Fun.prems(1) by auto
     hence "wf\<^sub>t\<^sub>r\<^sub>m x" using wf_trm_subtermeq[OF Fun.prems(2)] Fun_param_is_subterm[of _ T f] by auto
     hence "\<Gamma> s \<sqsubseteq> \<Gamma> x" using Fun.IH[OF x] by simp
     moreover have "arity f > 0" using x fun_type_inv_wf Fun.prems
       by (metis length_pos_if_in_set term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def)
     ultimately show ?thesis using x Fun.prems fun_type[of f T] by auto
   qed simp
 qed simp
 
 lemma subterm_funs_term_in_type:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "Fun f T \<sqsubseteq> t" "\<Gamma> (Fun f T) = TComp f (map \<Gamma> T)"
   shows "f \<in> funs_term (\<Gamma> t)"
 using assms(2,1,3)
 proof (induction t)
   case (Fun f' T')
   hence [simp]: "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)" by (metis wf_trm_subtermeq)
   { fix a assume \<tau>: "\<Gamma> (Fun f' T') = TAtom a"
     hence "Fun f T = Fun f' T'" using Fun TAtom_term_cases subtermeq_Var_const by metis
     hence False using Fun.prems(3) \<tau> by simp
   }
   moreover
   { fix g S assume \<tau>: "\<Gamma> (Fun f' T') = TComp g S"
     hence "g = f'" "S = map \<Gamma> T'"
       using Fun.prems(2) fun_type_id_eq[OF \<tau>] fun_type[OF fun_type_inv(1)[OF \<tau>]]
       by auto
     hence \<tau>': "\<Gamma> (Fun f' T') = TComp f' (map \<Gamma> T')" using \<tau> by auto
     hence "g \<in> funs_term (\<Gamma> (Fun f' T'))" using \<tau> by auto
     moreover {
       assume "Fun f T \<noteq> Fun f' T'"
       then obtain x where "x \<in> set T'" "Fun f T \<sqsubseteq> x" using Fun.prems(1) by auto
       hence "f \<in> funs_term (\<Gamma> x)"
         using Fun.IH[OF _ _ _ Fun.prems(3), of x] wf_trm_subtermeq[OF \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f' T')\<close>, of x]
         by force
       moreover have "\<Gamma> x \<in> set (map \<Gamma> T')" using \<tau>' \<open>x \<in> set T'\<close> by auto
       ultimately have "f \<in> funs_term (\<Gamma> (Fun f' T'))" using \<tau>' by auto
     }
     ultimately have ?case by (cases "Fun f T = Fun f' T'") (auto simp add: \<open>g = f'\<close>)
   }
   ultimately show ?case by (cases "\<Gamma> (Fun f' T')") auto
 qed simp
 
 lemma wt_subst_fv_termtype_subterm:
   assumes "x \<in> fv (\<theta> y)"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "wf\<^sub>t\<^sub>r\<^sub>m (\<theta> y)"
   shows "\<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
 using subtermeq_imp_subtermtypeeq[OF assms(3) var_is_subterm[OF assms(1)]]
       wt_subst_trm''[OF assms(2), of "Var y"]
 by auto
 
 lemma wt_subst_fv\<^sub>s\<^sub>e\<^sub>t_termtype_subterm:
   assumes "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (\<theta> ` Y)"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
   shows "\<exists>y \<in> Y. \<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
 using wt_subst_fv_termtype_subterm[OF _ assms(2), of x] assms(1,3)
 by fastforce
 
 lemma funs_term_type_iff:
   assumes t: "wf\<^sub>t\<^sub>r\<^sub>m t"
     and f: "arity f > 0"
   shows "f \<in> funs_term (\<Gamma> t) \<longleftrightarrow> (f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x))))"
     (is "?P t \<longleftrightarrow> ?Q t")
 using t
 proof (induction t)
   case (Fun g T)
   hence IH: "?P s \<longleftrightarrow> ?Q s" when "s \<in> set T" for s
     using that wf_trm_subterm[OF _ Fun_param_is_subterm]
     by blast
   have 0: "arity g = length T" using Fun.prems unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
   show ?case
   proof (cases "f = g")
     case True thus ?thesis using fun_type[OF f] by simp
   next
     case False
     have "?P (Fun g T) \<longleftrightarrow> (\<exists>s \<in> set T. ?P s)"
     proof
       assume *: "?P (Fun g T)"
       hence "\<Gamma> (Fun g T) = TComp g (map \<Gamma> T)"
         using const_type[of g] fun_type[of g] by force
       thus "\<exists>s \<in> set T. ?P s" using False * by force
     next
       assume *: "\<exists>s \<in> set T. ?P s"
       hence "\<Gamma> (Fun g T) = TComp g (map \<Gamma> T)"
         using 0 const_type[of g] fun_type[of g] by force
       thus "?P (Fun g T)" using False * by force
     qed
     thus ?thesis using False f IH by auto
   qed
 qed simp
 
 lemma funs_term_type_iff':
   assumes M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and f: "arity f > 0"
   shows "f \<in> \<Union>(funs_term ` \<Gamma> ` M) \<longleftrightarrow>
         (f \<in> \<Union>(funs_term ` M) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. f \<in> funs_term (\<Gamma> (Var x))))" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then obtain t where "t \<in> M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \<in> funs_term (\<Gamma> t)" using M by moura
   thus ?B using funs_term_type_iff[OF _ f, of t] by auto
 next
   assume ?B
   then obtain t where "t \<in> M" "wf\<^sub>t\<^sub>r\<^sub>m t" "f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x)))"
     using M by auto
   thus ?A using funs_term_type_iff[OF _ f, of t] by blast
 qed
 
 lemma Ana_subterm_type:
   assumes "Ana t = (K,M)"
     and "wf\<^sub>t\<^sub>r\<^sub>m t"
     and "m \<in> set M"
   shows "\<Gamma> m \<sqsubseteq> \<Gamma> t"
 proof -
   have "m \<sqsubseteq> t" using Ana_subterm[OF assms(1)] assms(3) by auto
   thus ?thesis using subtermeq_imp_subtermtypeeq[OF assms(2)] by simp
 qed
 
 lemma wf_trm_TAtom_subterms:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> t = TAtom \<tau>"
   shows "subterms t = {t}"
 using assms const_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by (cases t) force+
 
 lemma wf_trm_TComp_subterm:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m s" "t \<sqsubset> s"
   obtains f T where "\<Gamma> s = TComp f T"
 proof (cases s)
   case (Var x) thus ?thesis using \<open>t \<sqsubset> s\<close> by simp
 next
   case (Fun g S)
   hence "length S > 0" using assms Fun_subterm_inside_params[of t g S] by auto
   hence "arity g > 0" by (metis \<open>wf\<^sub>t\<^sub>r\<^sub>m s\<close> \<open>s = Fun g S\<close> term.order_refl wf\<^sub>t\<^sub>r\<^sub>m_def) 
   thus ?thesis using fun_type \<open>s = Fun g S\<close> that by auto
 qed
 
 lemma SMP_empty[simp]: "SMP {} = {}"
 proof (rule ccontr)
   assume "SMP {} \<noteq> {}"
   then obtain t where "t \<in> SMP {}" by auto
   thus False by (induct t rule: SMP.induct) auto
 qed
 
 lemma SMP_I:
   assumes "s \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "t \<sqsubseteq> s \<cdot> \<delta>" "\<And>v. wf\<^sub>t\<^sub>r\<^sub>m (\<delta> v)"
   shows "t \<in> SMP M"
 using SMP.Substitution[OF SMP.MP[OF assms(1)] assms(2)] SMP.Subterm[of "s \<cdot> \<delta>" M t] assms(3,4)
 by (cases "t = s \<cdot> \<delta>") simp_all
 
 lemma SMP_wf_trm:
   assumes "t \<in> SMP M" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m t"
 using assms(1)
 by (induct t rule: SMP.induct)
    (use assms(2) in blast,
     use wf_trm_subtermeq in blast,
     use wf_trm_subst in blast,
     use Ana_keys_wf' in blast)
 
 lemma SMP_ikI[intro]: "t \<in> ik\<^sub>s\<^sub>t S \<Longrightarrow> t \<in> SMP (trms\<^sub>s\<^sub>t S)" by force
 
 lemma MP_setI[intro]: "x \<in> set S \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> trms\<^sub>s\<^sub>t S" by force
 
 lemma SMP_setI[intro]: "x \<in> set S \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" by force
 
 lemma SMP_subset_I:
   assumes M: "\<forall>t \<in> M. \<exists>s \<delta>. s \<in> N \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = s \<cdot> \<delta>"
   shows "SMP M \<subseteq> SMP N"
 proof
   fix t show "t \<in> SMP M \<Longrightarrow> t \<in> SMP N"
   proof (induction t rule: SMP.induct)
     case (MP t)
     then obtain s \<delta> where s: "s \<in> N" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = s \<cdot> \<delta>"
       using M by moura
     show ?case using SMP_I[OF s(1,2), of "s \<cdot> \<delta>"] s(3,4) wf_trm_subst_range_iff by fast
   qed (auto intro!: SMP.Substitution[of _ N])
 qed
 
 lemma SMP_union: "SMP (A \<union> B) = SMP A \<union> SMP B"
 proof
   show "SMP (A \<union> B) \<subseteq> SMP A \<union> SMP B"
   proof
     fix t assume "t \<in> SMP (A \<union> B)"
     thus "t \<in> SMP A \<union> SMP B" by (induct rule: SMP.induct) blast+
   qed
 
   { fix t assume "t \<in> SMP A" hence "t \<in> SMP (A \<union> B)" by (induct rule: SMP.induct) blast+ }
   moreover { fix t assume "t \<in> SMP B" hence "t \<in> SMP (A \<union> B)" by (induct rule: SMP.induct) blast+ }
   ultimately show "SMP A \<union> SMP B \<subseteq> SMP (A \<union> B)" by blast
 qed
 
 lemma SMP_append[simp]: "SMP (trms\<^sub>s\<^sub>t (S@S')) = SMP (trms\<^sub>s\<^sub>t S) \<union> SMP (trms\<^sub>s\<^sub>t S')" (is "?A = ?B")
 using SMP_union by simp
 
 lemma SMP_mono: "A \<subseteq> B \<Longrightarrow> SMP A \<subseteq> SMP B"
 proof -
   assume "A \<subseteq> B"
   then obtain C where "B = A \<union> C" by moura
   thus "SMP A \<subseteq> SMP B" by (simp add: SMP_union)
 qed
 
 lemma SMP_Union: "SMP (\<Union>m \<in> M. f m) = (\<Union>m \<in> M. SMP (f m))"
 proof
   show "SMP (\<Union>m\<in>M. f m) \<subseteq> (\<Union>m\<in>M. SMP (f m))"
   proof
     fix t assume "t \<in> SMP (\<Union>m\<in>M. f m)"
     thus "t \<in> (\<Union>m\<in>M. SMP (f m))" by (induct t rule: SMP.induct) force+
   qed
   show "(\<Union>m\<in>M. SMP (f m)) \<subseteq> SMP (\<Union>m\<in>M. f m)"
   proof
     fix t assume "t \<in> (\<Union>m\<in>M. SMP (f m))"
     then obtain m where "m \<in> M" "t \<in> SMP (f m)" by moura
     thus "t \<in> SMP (\<Union>m\<in>M. f m)" using SMP_mono[of "f m" "\<Union>m\<in>M. f m"] by auto
   qed
 qed
 
 lemma SMP_singleton_ex:
   "t \<in> SMP M \<Longrightarrow> (\<exists>m \<in> M. t \<in> SMP {m})"
   "m \<in> M \<Longrightarrow> t \<in> SMP {m} \<Longrightarrow> t \<in> SMP M"
 using SMP_Union[of "\<lambda>t. {t}" M] by auto
 
 lemma SMP_Cons: "SMP (trms\<^sub>s\<^sub>t (x#S)) = SMP (trms\<^sub>s\<^sub>t [x]) \<union> SMP (trms\<^sub>s\<^sub>t S)"
 using SMP_append[of "[x]" S] by auto
 
 lemma SMP_Nil[simp]: "SMP (trms\<^sub>s\<^sub>t []) = {}" 
 proof -
   { fix t assume "t \<in> SMP (trms\<^sub>s\<^sub>t [])" hence False by induct auto }
   thus ?thesis by blast
 qed
 
 lemma SMP_subset_union_eq: assumes "M \<subseteq> SMP N" shows "SMP N = SMP (M \<union> N)"
 proof -
   { fix t assume "t \<in> SMP (M \<union> N)" hence "t \<in> SMP N"
       using assms by (induction rule: SMP.induct) blast+
   }
   thus ?thesis using SMP_union by auto
 qed
 
 lemma SMP_subterms_subset: "subterms\<^sub>s\<^sub>e\<^sub>t M \<subseteq> SMP M"
 proof
   fix t assume "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t M"
   then obtain m where "m \<in> M" "t \<sqsubseteq> m" by auto
   thus "t \<in> SMP M" using SMP_I[of _ _ Var] by auto
 qed
 
 lemma SMP_SMP_subset: "N \<subseteq> SMP M \<Longrightarrow> SMP N \<subseteq> SMP M"
 by (metis SMP_mono SMP_subset_union_eq Un_commute Un_upper2)
 
 lemma wt_subst_rm_vars: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<Longrightarrow> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (rm_vars X \<delta>)"
 using rm_vars_dom unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
 
 lemma wt_subst_SMP_subset:
   assumes "trms\<^sub>s\<^sub>t S \<subseteq> SMP S'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP S'"
 proof
   fix t assume *: "t \<in> trms\<^sub>s\<^sub>t (S \<cdot>\<^sub>s\<^sub>t \<delta>)"
   show "t \<in> SMP S'" using trm_strand_subst_cong(2)[OF *]
   proof
     assume "\<exists>t'. t = t' \<cdot> \<delta> \<and> t' \<in> trms\<^sub>s\<^sub>t S"
     thus "t \<in> SMP S'" using assms SMP.Substitution by auto
   next
     assume "\<exists>X F. Inequality X F \<in> set S \<and> (\<exists>t'\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F. t = t' \<cdot> rm_vars (set X) \<delta>)"
     then obtain X F t' where **:
         "Inequality X F \<in> set S" "t'\<in>trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "t = t' \<cdot> rm_vars (set X) \<delta>"
       by force
     then obtain s where s: "s \<in> trms\<^sub>s\<^sub>t\<^sub>p (Inequality X F)" "t = s \<cdot> rm_vars (set X) \<delta>" by moura
     hence "s \<in> SMP (trms\<^sub>s\<^sub>t S)" using **(1) by force
     hence "t \<in> SMP (trms\<^sub>s\<^sub>t S)"
       using SMP.Substitution[OF _ wt_subst_rm_vars[OF assms(2)] wf_trms_subst_rm_vars'[OF assms(3)]]
       unfolding s(2) by blast
     thus "t \<in> SMP S'" by (metis SMP_union SMP_subset_union_eq UnCI assms(1))
   qed
 qed
 
 lemma MP_subset_SMP: "\<Union>(trms\<^sub>s\<^sub>t\<^sub>p ` set S) \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" "trms\<^sub>s\<^sub>t S \<subseteq> SMP (trms\<^sub>s\<^sub>t S)" "M \<subseteq> SMP M"
 by auto
 
 lemma SMP_fun_map_snd_subset: "SMP (trms\<^sub>s\<^sub>t (map Send1 X)) \<subseteq> SMP (trms\<^sub>s\<^sub>t [Send1 (Fun f X)])"
 proof
   fix t assume "t \<in> SMP (trms\<^sub>s\<^sub>t (map Send1 X))" thus "t \<in> SMP (trms\<^sub>s\<^sub>t [Send1 (Fun f X)])"
   proof (induction t rule: SMP.induct)
     case (MP t)
     hence "t \<in> set X" by auto
     hence "t \<sqsubset> Fun f X" by (metis subtermI')
     thus ?case using SMP.Subterm[of "Fun f X" "trms\<^sub>s\<^sub>t [Send1 (Fun f X)]" t] using SMP.MP by auto
   qed blast+
 qed
 
 lemma SMP_wt_subst_subset:
   assumes "t \<in> SMP (M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
   shows "t \<in> SMP M"
 using assms wf_trm_subst_range_iff[of \<I>] by (induct t rule: SMP.induct) blast+
 
 lemma SMP_wt_instances_subset:
   assumes "\<forall>t \<in> M. \<exists>s \<in> N. \<exists>\<delta>. t = s \<cdot> \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     and "t \<in> SMP M"
   shows "t \<in> SMP N"
 proof -
   obtain m where m: "m \<in> M" "t \<in> SMP {m}" using SMP_singleton_ex(1)[OF assms(2)] by blast
   then obtain n \<delta> where n: "n \<in> N" "m = n \<cdot> \<delta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using assms(1) by fast
 
   have "t \<in> SMP (N \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>)" using n(1,2) SMP_singleton_ex(2)[of m "N \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>", OF _ m(2)] by fast
   thus ?thesis using SMP_wt_subst_subset[OF _ n(3,4)] by blast
 qed
 
 lemma SMP_consts:
   assumes "\<forall>t \<in> M. \<exists>c. t = Fun c []"
     and "\<forall>t \<in> M. Ana t = ([], [])"
   shows "SMP M = M"
 proof
   show "SMP M \<subseteq> M"
   proof
     fix t show "t \<in> SMP M \<Longrightarrow> t \<in> M"
       apply (induction t rule: SMP.induct)
       by (use assms in auto)
   qed
 qed auto
 
 lemma SMP_subterms_eq:
   "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) = SMP M"
 proof
   show "SMP M \<subseteq> SMP (subterms\<^sub>s\<^sub>e\<^sub>t M)" using SMP_mono[of M "subterms\<^sub>s\<^sub>e\<^sub>t M"] by blast
   show "SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \<subseteq> SMP M"
   proof
     fix t show "t \<in> SMP (subterms\<^sub>s\<^sub>e\<^sub>t M) \<Longrightarrow> t \<in> SMP M" by (induction t rule: SMP.induct) blast+
   qed
 qed
 
 lemma SMP_funs_term:
   assumes t: "t \<in> SMP M" "f \<in> funs_term t \<or> (\<exists>x \<in> fv t. f \<in> funs_term (\<Gamma> (Var x)))"
     and f: "arity f > 0"
     and M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and Ana_f: "\<And>s K T. Ana s = (K,T) \<Longrightarrow> f \<in> \<Union>(funs_term ` set K) \<Longrightarrow> f \<in> funs_term s"
   shows "f \<in> \<Union>(funs_term ` M) \<or> (\<exists>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. f \<in> funs_term (\<Gamma> (Var x)))"
 using t
 proof (induction t rule: SMP.induct)
   case (Subterm t t')
   thus ?case by (metis UN_I vars_iff_subtermeq funs_term_subterms_eq(1) term.order_trans)
 next
   case (Substitution t \<delta>)
   show ?case
     using M SMP_wf_trm[OF Substitution.hyps(1)] wf_trm_subst[of \<delta> t, OF Substitution.hyps(3)]
           funs_term_type_iff[OF _ f] wt_subst_trm''[OF Substitution.hyps(2), of t]
           Substitution.prems Substitution.IH
     by metis
 next
   case (Ana t K T t')
   thus ?case
     using Ana_f[OF Ana.hyps(2)] Ana_keys_fv[OF Ana.hyps(2)]
     by fastforce
 qed auto
 
 lemma id_type_eq:
   assumes "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)"
   shows "f \<in> \<C> \<Longrightarrow> g \<in> \<C>" "f \<in> \<Sigma>\<^sub>f \<Longrightarrow> g \<in> \<Sigma>\<^sub>f"
 using assms const_type' fun_type' id_union_univ(1)
 by (metis UNIV_I UnE "term.distinct"(1))+
 
 lemma fun_type_arg_cong:
   assumes "f \<in> \<Sigma>\<^sub>f" "g \<in> \<Sigma>\<^sub>f" "\<Gamma> (Fun f (x#X)) = \<Gamma> (Fun g (y#Y))"
   shows "\<Gamma> x = \<Gamma> y" "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)"
 using assms fun_type' by auto
 
 lemma fun_type_arg_cong':
   assumes "f \<in> \<Sigma>\<^sub>f" "g \<in> \<Sigma>\<^sub>f" "\<Gamma> (Fun f (X@x#X')) = \<Gamma> (Fun g (Y@y#Y'))" "length X = length Y"
   shows "\<Gamma> x = \<Gamma> y"
 using assms
 proof (induction X arbitrary: Y)
   case Nil thus ?case using fun_type_arg_cong(1)[of f g x X' y Y'] by auto
 next
   case (Cons x' X Y'')
   then obtain y' Y where "Y'' = y'#Y" by (metis length_Suc_conv)
   hence "\<Gamma> (Fun f (X@x#X')) = \<Gamma> (Fun g (Y@y#Y'))" "length X = length Y"
     using Cons.prems(3,4) fun_type_arg_cong(2)[OF Cons.prems(1,2), of x' "X@x#X'"] by auto
   thus ?thesis using Cons.IH[OF Cons.prems(1,2)] by auto
 qed
 
 lemma fun_type_param_idx: "\<Gamma> (Fun f T) = Fun g S \<Longrightarrow> i < length T \<Longrightarrow> \<Gamma> (T ! i) = S ! i"
 by (metis fun_type fun_type_id_eq fun_type_inv(1) nth_map term.inject(2))
 
 lemma fun_type_param_ex:
   assumes "\<Gamma> (Fun f T) = Fun g (map \<Gamma> S)" "t \<in> set S"
   shows "\<exists>s \<in> set T. \<Gamma> s = \<Gamma> t"
 using fun_type_length_eq[OF assms(1)] length_map[of \<Gamma> S] assms(2)
       fun_type_param_idx[OF assms(1)] nth_map in_set_conv_nth
 by metis
 
 lemma tfr_stp_all_split:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p [x]"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (x#S) \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@x#S') \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')"
 by fastforce+
 
 lemma tfr_stp_all_append:
   assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')"
 using assms by fastforce
 
 lemma tfr_stp_all_wt_subst_apply:
   assumes "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
            "bvars\<^sub>s\<^sub>t S \<inter> range_vars \<theta> = {}"
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<theta>)"
 using assms(1,4)
 proof (induction S)
   case (Cons x S)
   hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S \<cdot>\<^sub>s\<^sub>t \<theta>)"
     using tfr_stp_all_split(2)[of x S]
     unfolding range_vars_alt_def by fastforce
   thus ?case
   proof (cases x)
     case (Equality a t t')
     hence "(\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t'" using Cons.prems by auto
     hence "(\<exists>\<delta>. Unifier \<delta> (t \<cdot> \<theta>) (t' \<cdot> \<theta>)) \<longrightarrow> \<Gamma> (t \<cdot> \<theta>) = \<Gamma> (t' \<cdot> \<theta>)"
       by (metis Unifier_comp' wt_subst_trm'[OF assms(2)])
     moreover have "(x#S) \<cdot>\<^sub>s\<^sub>t \<theta> = Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>)#(S \<cdot>\<^sub>s\<^sub>t \<theta>)"
       using \<open>x = Equality a t t'\<close> by auto
     ultimately show ?thesis using IH by auto
   next
     case (Inequality X F)
     let ?\<sigma> = "rm_vars (set X) \<theta>"
     let ?G = "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>"
 
     let ?P = "\<lambda>F X. \<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a"
     let ?Q = "\<lambda>F X.
       \<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X)"
 
     have 0: "set X \<inter> range_vars ?\<sigma> = {}"
       using Cons.prems(2) Inequality rm_vars_img_subset[of "set X"]
       by (auto simp add: subst_domain_def range_vars_alt_def)
 
     have 1: "?P F X \<or> ?Q F X" using Inequality Cons.prems by simp
 
     have 2: "fv\<^sub>s\<^sub>e\<^sub>t (?\<sigma> ` set X) = set X" by auto
 
     have "?P ?G X" when "?P F X" using that
     proof (induction F)
       case (Cons g G)
       obtain t t' where g: "g = (t,t')" by (metis surj_pair)
       
       have "\<forall>x \<in> (fv (t \<cdot> ?\<sigma>) \<union> fv (t' \<cdot> ?\<sigma>)) - set X. \<exists>a. \<Gamma> (Var x) = Var a"
       proof -
         have *: "\<forall>x \<in> fv t - set X. \<exists>a. \<Gamma> (Var x) = Var a"
                "\<forall>x \<in> fv t' - set X. \<exists>a. \<Gamma> (Var x) = Var a"
           using g Cons.prems by simp_all
 
         have **: "\<forall>x. wf\<^sub>t\<^sub>r\<^sub>m (?\<sigma> x)"
           using \<theta>(2) wf_trm_subst_range_iff[of \<theta>] wf_trm_subst_rm_vars'[of \<theta> _ "set X"] by simp
 
         show ?thesis
           using wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \<theta>(1)] ** *(1)]
                 wt_subst_TAtom_fv[OF wt_subst_rm_vars[OF \<theta>(1)] ** *(2)]
                 wt_subst_trm'[OF wt_subst_rm_vars[OF \<theta>(1), of "set X"]] 2
           by blast
       qed
       moreover have "\<forall>x\<in>fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>) - set X. \<exists>a. \<Gamma> (Var x) = Var a"
         using Cons by auto
       ultimately show ?case using g by (auto simp add: subst_apply_pairs_def)
     qed (simp add: subst_apply_pairs_def)
     hence "?P ?G X \<or> ?Q ?G X"
       using 1 ineq_subterm_inj_cond_subst[OF 0, of "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"] trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst[of F ?\<sigma>]
       by presburger
     moreover have "(x#S) \<cdot>\<^sub>s\<^sub>t \<theta> = Inequality X (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ?\<sigma>)#(S \<cdot>\<^sub>s\<^sub>t \<theta>)"
       using \<open>x = Inequality X F\<close> by auto
     ultimately show ?thesis using IH by simp
   qed auto
 qed simp
 
 lemma tfr_stp_all_same_type:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S') \<Longrightarrow> Unifier \<delta> t t' \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
 by force+
 
 lemma tfr_subset:
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t (A \<union> B) \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   "\<And>A B. tfr\<^sub>s\<^sub>e\<^sub>t B \<Longrightarrow> SMP A \<subseteq> SMP B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
 proof -
   show 1: "tfr\<^sub>s\<^sub>e\<^sub>t (A \<union> B) \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A" for A B
     using SMP_union[of A B] unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
 
   fix A B assume B: "tfr\<^sub>s\<^sub>e\<^sub>t B"
 
   show "A \<subseteq> B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   proof -
     assume "A \<subseteq> B"
     then obtain C where "B = A \<union> C" by moura
     thus ?thesis using B 1 by blast
   qed
 
   show "SMP A \<subseteq> SMP B \<Longrightarrow> tfr\<^sub>s\<^sub>e\<^sub>t A"
   proof -
     assume "SMP A \<subseteq> SMP B"
     then obtain C where "SMP B = SMP A \<union> C" by moura
     thus ?thesis using B unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
   qed
 qed
 
 lemma tfr_empty[simp]: "tfr\<^sub>s\<^sub>e\<^sub>t {}"
 unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
 
 lemma tfr_consts_mono:
   assumes "\<forall>t \<in> M. \<exists>c. t = Fun c []"
     and "\<forall>t \<in> M. Ana t = ([], [])"
     and "tfr\<^sub>s\<^sub>e\<^sub>t N"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (N \<union> M)"
 proof -
   { fix s t
     assume *: "s \<in> SMP (N \<union> M) - range Var" "t \<in> SMP (N \<union> M) - range Var" "\<exists>\<delta>. Unifier \<delta> s t"
     hence **: "is_Fun s" "is_Fun t" "s \<in> SMP N \<or> s \<in> M" "t \<in> SMP N \<or> t \<in> M"
       using assms(3) SMP_consts[OF assms(1,2)] SMP_union[of N M] by auto
     moreover have "\<Gamma> s = \<Gamma> t" when "s \<in> SMP N" "t \<in> SMP N"
       using that assms(3) *(3) **(1,2) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> M" "t \<in> M"
     proof -
       obtain c d where "s = Fun c []" "t = Fun d []" using st assms(1) by moura
       hence "s = t" using *(3) by fast
       thus ?thesis by metis
     qed
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> SMP N" "t \<in> M"
     proof -
       obtain c where "t = Fun c []" using st assms(1) by moura
       hence "s = t" using *(3) **(1,2) by auto
       thus ?thesis by metis
     qed
     moreover have "\<Gamma> s = \<Gamma> t" when st: "s \<in> M" "t \<in> SMP N"
     proof -
       obtain c where "s = Fun c []" using st assms(1) by moura
       hence "s = t" using *(3) **(1,2) by auto
       thus ?thesis by metis
     qed
     ultimately have "\<Gamma> s = \<Gamma> t" by metis
   } thus ?thesis by (metis tfr\<^sub>s\<^sub>e\<^sub>t_def)
 qed
 
 lemma dual\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>t\<^sub>p: "list_all tfr\<^sub>s\<^sub>t\<^sub>p S \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)"
 proof (induction S)
   case (Cons x S)
   have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Cons.prems by simp
   hence IH: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (dual\<^sub>s\<^sub>t S)" using Cons.IH by metis
   from Cons show ?case
   proof (cases x)
     case (Equality a t t')
     hence "(\<exists>\<delta>. Unifier \<delta> t t') \<Longrightarrow> \<Gamma> t = \<Gamma> t'" using Cons by auto
     thus ?thesis using Equality IH by fastforce
   next
     case (Inequality X F)
     have "set (dual\<^sub>s\<^sub>t (x#S)) = insert x (set (dual\<^sub>s\<^sub>t S))" using Inequality by auto
     moreover have "(\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = Var a) \<or>
             (\<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))" 
       using Cons.prems Inequality by auto
     ultimately show ?thesis using Inequality IH by auto
   qed auto
 qed simp
 
 lemma subst_var_inv_wt:
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst_var_inv \<delta> X)"
 using assms f_inv_into_f[of _ \<delta> X]
 unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def
 by presburger
 
 lemma subst_var_inv_wf_trms:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (subst_var_inv \<delta> X))"
 using f_inv_into_f[of _ \<delta> X]
 unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_var_inv_def
 by auto
 
 lemma unify_list_wt_if_same_type:
   assumes "Unification.unify E B = Some U" "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t"
   and "\<forall>(v,t) \<in> set B. \<Gamma> (Var v) = \<Gamma> t"
   shows "\<forall>(v,t) \<in> set U. \<Gamma> (Var v) = \<Gamma> t"
 using assms
 proof (induction E B arbitrary: U rule: Unification.unify.induct)
   case (2 f X g Y E B U)
   hence "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)" "\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)" by auto
 
   from "2.prems"(1) obtain E' where *: "decompose (Fun f X) (Fun g Y) = Some E'"
     and [simp]: "f = g" "length X = length Y" "E' = zip X Y"
     and **: "Unification.unify (E'@E) B = Some U"
     by (auto split: option.splits)
   
   have "\<forall>(s,t) \<in> set E'. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t"
   proof -
     { fix s t assume "(s,t) \<in> set E'"
       then obtain X' X'' Y' Y'' where "X = X'@s#X''" "Y = Y'@t#Y''" "length X' = length Y'"
         using zip_arg_subterm_split[of s t X Y] \<open>E' = zip X Y\<close> by metis
       hence "\<Gamma> (Fun f (X'@s#X'')) = \<Gamma> (Fun g (Y'@t#Y''))" by (metis \<open>\<Gamma> (Fun f X) = \<Gamma> (Fun g Y)\<close>)
       
       from \<open>E' = zip X Y\<close> have "\<forall>(s,t) \<in> set E'. s \<sqsubset> Fun f X \<and> t \<sqsubset> Fun g Y"
         using zip_arg_subterm[of _ _ X Y] by blast
       with \<open>(s,t) \<in> set E'\<close> have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t"
         using wf_trm_subterm \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun g Y)\<close> by (blast,blast)
       moreover have "f \<in> \<Sigma>\<^sub>f"
       proof (rule ccontr)
         assume "f \<notin> \<Sigma>\<^sub>f"
         hence "f \<in> \<C>" "arity f = 0" using const_arity_eq_zero[of f] by simp_all
         thus False using \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> * \<open>(s,t) \<in> set E'\<close> unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       qed
       hence "\<Gamma> s = \<Gamma> t"
         using fun_type_arg_cong' \<open>f \<in> \<Sigma>\<^sub>f\<close> \<open>\<Gamma> (Fun f (X'@s#X'')) = \<Gamma> (Fun g (Y'@t#Y''))\<close>
               \<open>length X' = length Y'\<close> \<open>f = g\<close>
         by metis
       ultimately have "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t" by metis+
     }
     thus ?thesis by blast
   qed
   moreover have "\<forall>(s,t) \<in> set E. wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t \<and> \<Gamma> s = \<Gamma> t" using "2.prems"(2) by auto
   ultimately show ?case using "2.IH"[OF * ** _ "2.prems"(3)] by fastforce
 next
   case (3 v t E B U)
   hence "\<Gamma> (Var v) = \<Gamma> t" "wf\<^sub>t\<^sub>r\<^sub>m t" by auto
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)"
       and *: "\<forall>(v, t) \<in> set ((v,t)#B). \<Gamma> (Var v) = \<Gamma> t"
              "\<And>t t'. (t,t') \<in> set E \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
     using "3.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto
 
   show ?case
   proof (cases "t = Var v")
     assume "t = Var v" thus ?case using 3 by auto
   next
     assume "t \<noteq> Var v"
     hence "v \<notin> fv t" using "3.prems"(1) by auto
     hence **: "Unification.unify (subst_list (subst v t) E) ((v, t)#B) = Some U"
       using Unification.unify.simps(3)[of v t E B] "3.prems"(1) \<open>t \<noteq> Var v\<close> by auto
     
     have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
       using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>] "3.prems"(2)
       unfolding subst_list_def subst_def by auto
     moreover have "\<forall>(s, t) \<in> set (subst_list (subst v t) E). \<Gamma> s = \<Gamma> t"
       using *(2)[THEN wt_subst_trm'[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v t)\<close>]] by (simp add: subst_list_def)
     ultimately show ?thesis using "3.IH"(2)[OF \<open>t \<noteq> Var v\<close> \<open>v \<notin> fv t\<close> ** _ *(1)] by auto
   qed
 next
   case (4 f X v E B U)
   hence "\<Gamma> (Var v) = \<Gamma> (Fun f X)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" by auto
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))"
       and *: "\<forall>(v, t) \<in> set ((v,(Fun f X))#B). \<Gamma> (Var v) = \<Gamma> t"
              "\<And>t t'. (t,t') \<in> set E \<Longrightarrow> \<Gamma> t = \<Gamma> t'"
     using "4.prems"(2,3) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def subst_def by auto
 
   have "v \<notin> fv (Fun f X)" using "4.prems"(1) by force
   hence **: "Unification.unify (subst_list (subst v (Fun f X)) E) ((v, (Fun f X))#B) = Some U"
     using Unification.unify.simps(3)[of v "Fun f X" E B] "4.prems"(1) by auto
   
   have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f X)) E). wf\<^sub>t\<^sub>r\<^sub>m s \<and> wf\<^sub>t\<^sub>r\<^sub>m t"
     using wf_trm_subst_singleton[OF _ \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close>] "4.prems"(2)
     unfolding subst_list_def subst_def by auto
   moreover have "\<forall>(s, t) \<in> set (subst_list (subst v (Fun f X)) E). \<Gamma> s = \<Gamma> t"
     using *(2)[THEN wt_subst_trm'[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (subst v (Fun f X))\<close>]] by (simp add: subst_list_def)
   ultimately show ?case using "4.IH"[OF \<open>v \<notin> fv (Fun f X)\<close> ** _ *(1)] by auto
 qed auto
 
 lemma mgu_wt_if_same_type:
   assumes "mgu s t = Some \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
 proof -
   let ?fv_disj = "\<lambda>v t S. \<not>(\<exists>(v',t') \<in> S - {(v,t)}. (insert v (fv t)) \<inter> (insert v' (fv t')) \<noteq> {})"
 
   from assms(1) obtain \<sigma>' where "Unification.unify [(s,t)] [] = Some \<sigma>'" "subst_of \<sigma>' = \<sigma>"
-    by (auto split: option.splits)
+    by (auto simp: mgu_def split: option.splits)
   hence "\<forall>(v,t) \<in> set \<sigma>'. \<Gamma> (Var v) = \<Gamma> t" "distinct (map fst \<sigma>')"
     using assms(2,3,4) unify_list_wt_if_same_type unify_list_distinct[of "[(s,t)]"] by auto
   thus "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" using \<open>subst_of \<sigma>' = \<sigma>\<close> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
   proof (induction \<sigma>' arbitrary: \<sigma> rule: List.rev_induct)
     case (snoc tt \<sigma>' \<sigma>)
     then obtain v t where tt: "tt = (v,t)" by (metis surj_pair)
     hence \<sigma>: "\<sigma> = subst v t \<circ>\<^sub>s subst_of \<sigma>'" using snoc.prems(3) by simp
     
     have "\<forall>(v,t) \<in> set \<sigma>'. \<Gamma> (Var v) = \<Gamma> t" "distinct (map fst \<sigma>')" using snoc.prems(1,2) by auto
     then obtain \<sigma>'' where \<sigma>'': "subst_of \<sigma>' = \<sigma>''" "\<forall>v. \<Gamma> (Var v) = \<Gamma> (\<sigma>'' v)" by (metis snoc.IH)
     hence "\<Gamma> t = \<Gamma> (t \<cdot> \<sigma>'')" for t using wt_subst_trm by blast
     hence "\<Gamma> (Var v) = \<Gamma> (\<sigma>'' v)" "\<Gamma> t = \<Gamma> (t \<cdot> \<sigma>'')" using \<sigma>''(2) by auto
     moreover have "\<Gamma> (Var v) = \<Gamma> t" using snoc.prems(1) tt by simp
     moreover have \<sigma>2: "\<sigma> = Var(v := t) \<circ>\<^sub>s \<sigma>'' " using \<sigma> \<sigma>''(1) unfolding subst_def by simp
     ultimately have "\<Gamma> (Var v) = \<Gamma> (\<sigma> v)" unfolding subst_compose_def by simp
 
     have "subst_domain (subst v t) \<subseteq> {v}" unfolding subst_def by (auto simp add: subst_domain_def)
     hence *: "subst_domain \<sigma> \<subseteq> insert v (subst_domain \<sigma>'')"
       using tt \<sigma> \<sigma>''(1) snoc.prems(2) subst_domain_compose[of _ \<sigma>'']
       by (auto simp add: subst_domain_def)
     
     have "v \<notin> set (map fst \<sigma>')" using tt snoc.prems(2) by auto
     hence "v \<notin> subst_domain \<sigma>''" using \<sigma>''(1) subst_of_dom_subset[of \<sigma>'] by auto
 
     { fix w assume "w \<in> subst_domain \<sigma>''"
       hence "\<sigma> w = \<sigma>'' w" using \<sigma>2 \<sigma>''(1) \<open>v \<notin> subst_domain \<sigma>''\<close> unfolding subst_compose_def by auto
       hence "\<Gamma> (Var w) = \<Gamma> (\<sigma> w)" using \<sigma>''(2) by simp
     }
     thus ?case using \<open>\<Gamma> (Var v) = \<Gamma> (\<sigma> v)\<close> * by force
   qed simp
 qed
 
 lemma wt_Unifier_if_Unifier:
   assumes s_t: "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m t" "\<Gamma> s = \<Gamma> t"
     and \<delta>: "Unifier \<delta> s t"
   shows "\<exists>\<theta>. Unifier \<theta> s t \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
 using mgu_always_unifies[OF \<delta>] mgu_gives_MGU[THEN MGU_is_Unifier[of s _ t]]
       mgu_wt_if_same_type[OF _ s_t] mgu_wf_trm[OF _ s_t(1,2)] wf_trm_subst_range_iff
 by fast
 
 end
 
 
 subsection \<open>Automatically Proving Type-Flaw Resistance\<close>
 subsubsection \<open>Definitions: Variable Renaming\<close>
 abbreviation "max_var t \<equiv> Max (insert 0 (snd ` fv t))"
 abbreviation "max_var_set X \<equiv> Max (insert 0 (snd ` X))"
 
 definition "var_rename n v \<equiv> Var (fst v, snd v + Suc n)"
 definition "var_rename_inv n v \<equiv> Var (fst v, snd v - Suc n)"
 
 
 subsubsection \<open>Definitions: Computing a Finite Representation of the Sub-Message Patterns\<close>
 text \<open>A sufficient requirement for a term to be a well-typed instance of another term\<close>
 definition is_wt_instance_of_cond where
   "is_wt_instance_of_cond \<Gamma> t s \<equiv> (
     \<Gamma> t = \<Gamma> s \<and> (case mgu t s of
       None \<Rightarrow> False
     | Some \<delta> \<Rightarrow> inj_on \<delta> (fv t) \<and> (\<forall>x \<in> fv t. is_Var (\<delta> x))))"
 
 definition has_all_wt_instances_of where
   "has_all_wt_instances_of \<Gamma> N M \<equiv> \<forall>t \<in> N. \<exists>s \<in> M. is_wt_instance_of_cond \<Gamma> t s"
 
 text \<open>This function computes a finite representation of the set of sub-message patterns\<close>
 definition SMP0 where
   "SMP0 Ana \<Gamma> M \<equiv> let
       f = \<lambda>t. Fun (the_Fun (\<Gamma> t)) (map Var (zip (args (\<Gamma> t)) [0..<length (args (\<Gamma> t))]));
       g = \<lambda>M'. map f (filter (\<lambda>t. is_Var t \<and> is_Fun (\<Gamma> t)) M')@
                concat (map (fst \<circ> Ana) M')@concat (map subterms_list M');
       h = remdups \<circ> g
     in while (\<lambda>A. set (h A) \<noteq> set A) h M"
 
 text \<open>These definitions are useful to refine an SMP representation set\<close>
 fun generalize_term where
   "generalize_term _ _ n (Var x) = (Var x, n)"
 | "generalize_term \<Gamma> p n (Fun f T) = (let \<tau> = \<Gamma> (Fun f T)
     in if p \<tau> then (Var (\<tau>, n), Suc n)
        else let (T',n') = foldr (\<lambda>t (S,m). let (t',m') = generalize_term \<Gamma> p m t in (t'#S,m'))
                                 T ([],n)
             in (Fun f T', n'))"
 
 definition generalize_terms where
   "generalize_terms \<Gamma> p \<equiv> map (fst \<circ> generalize_term \<Gamma> p 0)"
 
 definition remove_superfluous_terms where
   "remove_superfluous_terms \<Gamma> T \<equiv>
     let
       f = \<lambda>S t R. \<exists>s \<in> set S - R. s \<noteq> t \<and> is_wt_instance_of_cond \<Gamma> t s;
       g = \<lambda>S t (U,R). if f S t R then (U, insert t R) else (t#U, R);
       h = \<lambda>S. remdups (fst (foldr (g S) S ([],{})))
     in while (\<lambda>S. h S \<noteq> S) h T"
 
 
 subsubsection \<open>Definitions: Checking Type-Flaw Resistance\<close>
 definition is_TComp_var_instance_closed where
   "is_TComp_var_instance_closed \<Gamma> M \<equiv> \<forall>x \<in> fv\<^sub>s\<^sub>e\<^sub>t M. is_Fun (\<Gamma> (Var x)) \<longrightarrow>
       (\<exists>t \<in> M. is_Fun t \<and> \<Gamma> t = \<Gamma> (Var x) \<and> list_all is_Var (args t) \<and> distinct (args t))"
 
 definition finite_SMP_representation where
   "finite_SMP_representation arity Ana \<Gamma> M \<equiv>
     (M = {} \<or> card M > 0) \<and>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s' arity M \<and>
     has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M \<and>
     has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M \<and>
     is_TComp_var_instance_closed \<Gamma> M"
 
 definition comp_tfr\<^sub>s\<^sub>e\<^sub>t where
   "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M \<equiv>
     finite_SMP_representation arity Ana \<Gamma> M \<and>
     (let \<delta> = var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))
      in \<forall>s \<in> M. \<forall>t \<in> M. is_Fun s \<and> is_Fun t \<and> \<Gamma> s \<noteq> \<Gamma> t \<longrightarrow> mgu s (t \<cdot> \<delta>) = None)"
 
 fun comp_tfr\<^sub>s\<^sub>t\<^sub>p where
   "comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> (\<langle>_: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t) = (mgu t t' \<noteq> None \<longrightarrow> \<Gamma> t = \<Gamma> t')"
 | "comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t) = (
     (\<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. is_Var (\<Gamma> (Var x))) \<or>
     (\<forall>u \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F).
       is_Fun u \<longrightarrow> (args u = [] \<or> (\<exists>s \<in> set (args u). s \<notin> Var ` set X))))"
 | "comp_tfr\<^sub>s\<^sub>t\<^sub>p _ _ = True"
 
 definition comp_tfr\<^sub>s\<^sub>t where
   "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> M S \<equiv>
     list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma>) S \<and>
     list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (trms_list\<^sub>s\<^sub>t S) \<and>
     has_all_wt_instances_of \<Gamma> (trms\<^sub>s\<^sub>t S) M \<and>
     comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
 
 
 subsubsection \<open>Small Lemmata\<close>
 lemma max_var_set_mono:
   assumes "finite N"
     and "M \<subseteq> N"
   shows "max_var_set M \<le> max_var_set N"
 by (meson assms Max.subset_imp finite.insertI finite_imageI image_mono insert_mono insert_not_empty) 
 
 lemma less_Suc_max_var_set:
   assumes z: "z \<in> X"
     and X: "finite X"
   shows "snd z < Suc (max_var_set X)"
 proof -
   have "snd z \<in> snd ` X" using z by simp
   hence "snd z \<le> Max (insert 0 (snd ` X))" using X by simp
   thus ?thesis using X by simp
 qed
 
 lemma (in typed_model) finite_SMP_representationD:
   assumes "finite_SMP_representation arity Ana \<Gamma> M"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     and "is_TComp_var_instance_closed \<Gamma> M"
     and "finite M"
 using assms wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code[of M] unfolding finite_SMP_representation_def list_all_iff card_gt_0_iff
 by blast+
 
 lemma (in typed_model) is_wt_instance_of_condD:
   assumes t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
   obtains \<delta> where
     "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
     "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
 using t_instance_s unfolding is_wt_instance_of_cond_def Let_def by (cases "mgu t s") fastforce+
 
 lemma (in typed_model) is_wt_instance_of_condD':
   assumes t_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m t"
     and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     and t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
   shows "\<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = s \<cdot> \<delta>"
 proof -
   obtain \<delta> where s:
       "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
       "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
     by (metis is_wt_instance_of_condD[OF t_instance_s])
 
   have 0: "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" using s(1) t_wf_trm s_wf_trm by auto
 
   note 1 = mgu_wt_if_same_type[OF s(2) 0 s(1)]
 
   note 2 = conjunct1[OF mgu_gives_MGU[OF s(2)]]
 
   show ?thesis
     using s(1) inj_var_ran_unifiable_has_subst_match[OF 2 s(3,4)]
           wt_subst_compose[OF 1 subst_var_inv_wt[OF 1, of "fv t"]]
           wf_trms_subst_compose[OF mgu_wf_trms[OF s(2) 0] subst_var_inv_wf_trms[of \<delta> "fv t"]]
     by auto
 qed
 
 lemma (in typed_model) is_wt_instance_of_condD'':
   assumes s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     and t_instance_s: "is_wt_instance_of_cond \<Gamma> t s"
     and t_var: "t = Var x"
   shows "\<exists>y. s = Var y \<and> \<Gamma> (Var y) = \<Gamma> (Var x)"
 proof -
   obtain \<delta> where \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" and s: "Var x = s \<cdot> \<delta>"
     using is_wt_instance_of_condD'[OF _ s_wf_trm t_instance_s] t_var by auto
   obtain y where y: "s = Var y" using s by (cases s) auto
   show ?thesis using wt_subst_trm''[OF \<delta>] s y by metis
 qed
 
 lemma (in typed_model) has_all_wt_instances_ofD:
   assumes N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   obtains s \<delta> where
     "s \<in> M" "\<Gamma> t = \<Gamma> s" "mgu t s = Some \<delta>"
     "inj_on \<delta> (fv t)" "\<delta> ` (fv t) \<subseteq> range Var"
 by (metis t_in_N N_instance_M is_wt_instance_of_condD has_all_wt_instances_of_def)
 
 lemma (in typed_model) has_all_wt_instances_ofD':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   shows "\<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>"
 using assms is_wt_instance_of_condD' unfolding has_all_wt_instances_of_def by fast
 
 lemma (in typed_model) has_all_wt_instances_ofD'':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "Var x \<in> N"
   shows "\<exists>y. Var y \<in> M \<and> \<Gamma> (Var y) = \<Gamma> (Var x)"
 using assms is_wt_instance_of_condD'' unfolding has_all_wt_instances_of_def by fast
   
 lemma (in typed_model) has_all_instances_of_if_subset:
   assumes "N \<subseteq> M"
   shows "has_all_wt_instances_of \<Gamma> N M"
 using assms inj_onI mgu_same_empty
 unfolding has_all_wt_instances_of_def is_wt_instance_of_cond_def
 by (smt option.case_eq_if option.discI option.sel subsetD term.discI(1) term.inject(1))
 
 lemma (in typed_model) SMP_I':
   assumes N_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s N"
     and M_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and N_instance_M: "has_all_wt_instances_of \<Gamma> N M"
     and t_in_N: "t \<in> N"
   shows "t \<in> SMP M"
 using has_all_wt_instances_ofD'[OF N_wf_trms M_wf_trms N_instance_M t_in_N]
       SMP.Substitution[OF SMP.MP[of _ M]]
 by blast
 
 
 subsubsection \<open>Lemma: Proving Type-Flaw Resistance\<close>
 locale typed_model' = typed_model arity public Ana \<Gamma>
   for arity::"'fun \<Rightarrow> nat"
     and public::"'fun \<Rightarrow> bool"
     and Ana::"('fun,(('fun,'atom::finite) term_type \<times> nat)) term
               \<Rightarrow> (('fun,(('fun,'atom) term_type \<times> nat)) term list
                  \<times> ('fun,(('fun,'atom) term_type \<times> nat)) term list)"
     and \<Gamma>::"('fun,(('fun,'atom) term_type \<times> nat)) term \<Rightarrow> ('fun,'atom) term_type"
   +
   assumes \<Gamma>_Var_fst: "\<And>\<tau> n m. \<Gamma> (Var (\<tau>,n)) = \<Gamma> (Var (\<tau>,m))"
     and Ana_const: "\<And>c T. arity c = 0 \<Longrightarrow> Ana (Fun c T) = ([],[])"
     and Ana_subst'_or_Ana_keys_subterm:
       "(\<forall>f T \<delta> K R. Ana (Fun f T) = (K,R) \<longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,R \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)) \<or>
        (\<forall>t K R k. Ana t = (K,R) \<longrightarrow> k \<in> set K \<longrightarrow> k \<sqsubset> t)"
 begin
 
 lemma var_rename_inv_comp: "t \<cdot> (var_rename n \<circ>\<^sub>s var_rename_inv n) = t"
 proof (induction t)
   case (Fun f T)
   hence "map (\<lambda>t. t \<cdot> var_rename n \<circ>\<^sub>s var_rename_inv n) T = T" by (simp add: map_idI) 
   thus ?case by (metis subst_apply_term.simps(2)) 
 qed (simp add: var_rename_def var_rename_inv_def)
 
 lemma var_rename_fv_disjoint:
   "fv s \<inter> fv (t \<cdot> var_rename (max_var s)) = {}"
 proof -
   have 1: "\<forall>v \<in> fv s. snd v \<le> max_var s" by simp
   have 2: "\<forall>v \<in> fv (t \<cdot> var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto
   show ?thesis using 1 2 by force
 qed
 
 lemma var_rename_fv_set_disjoint:
   assumes "finite M" "s \<in> M"
   shows "fv s \<inter> fv (t \<cdot> var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}"
 proof -
   have 1: "\<forall>v \<in> fv s. snd v \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using assms
   proof (induction M rule: finite_induct)
     case (insert t M) thus ?case
     proof (cases "t = s")
       case False
       hence "\<forall>v \<in> fv s. snd v \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M)" using insert by simp
       moreover have "max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M) \<le> max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (insert t M))"
         using insert.hyps(1) insert.prems
         by force
       ultimately show ?thesis by auto
     qed simp
   qed simp
 
   have 2: "\<forall>v \<in> fv (t \<cdot> var_rename n). snd v > n" for n unfolding var_rename_def by (induct t) auto
 
   show ?thesis using 1 2 by force
 qed
 
 lemma var_rename_fv_set_disjoint':
   assumes "finite M"
   shows "fv\<^sub>s\<^sub>e\<^sub>t M \<inter> fv\<^sub>s\<^sub>e\<^sub>t (N \<cdot>\<^sub>s\<^sub>e\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))) = {}"
 using var_rename_fv_set_disjoint[OF assms] by auto
 
 lemma var_rename_is_renaming[simp]:
   "subst_range (var_rename n) \<subseteq> range Var"
   "subst_range (var_rename_inv n) \<subseteq> range Var"
 unfolding var_rename_def var_rename_inv_def by auto
 
 lemma var_rename_wt[simp]:
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename n)"
   "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n)"
 by (auto simp add: var_rename_def var_rename_inv_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def \<Gamma>_Var_fst)
 
 lemma var_rename_wt':
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "s = m \<cdot> \<delta>"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (var_rename_inv n \<circ>\<^sub>s \<delta>)" "s = m \<cdot> var_rename n \<cdot> var_rename_inv n \<circ>\<^sub>s \<delta>"
 using assms(2) wt_subst_compose[OF var_rename_wt(2)[of n] assms(1)] var_rename_inv_comp[of m n]
 by force+
 
 lemma var_rename_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_range[simp]:
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename n))"
   "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (var_rename_inv n))"
 using var_rename_is_renaming by fastforce+
 
 lemma Fun_range_case:
   "(\<forall>f T. Fun f T \<in> M \<longrightarrow> P f T) \<longleftrightarrow> (\<forall>u \<in> M. case u of Fun f T \<Rightarrow> P f T | _ \<Rightarrow> True)"
   "(\<forall>f T. Fun f T \<in> M \<longrightarrow> P f T) \<longleftrightarrow> (\<forall>u \<in> M. is_Fun u \<longrightarrow> P (the_Fun u) (args u))"
 by (auto split: "term.splits")
 
 lemma is_TComp_var_instance_closedD:
   assumes x: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "\<Gamma> (Var x) = TComp f T"
     and closed: "is_TComp_var_instance_closed \<Gamma> M"
   shows "\<exists>g U. Fun g U \<in> M \<and> \<Gamma> (Fun g U) = \<Gamma> (Var x) \<and> (\<forall>u \<in> set U. is_Var u) \<and> distinct U"
 using assms unfolding is_TComp_var_instance_closed_def list_all_iff list_ex_iff by fastforce
 
 lemma is_TComp_var_instance_closedD':
   assumes "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "TComp f T \<sqsubseteq> \<Gamma> (Var x)"
     and closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "\<exists>g U. Fun g U \<in> M \<and> \<Gamma> (Fun g U) = TComp f T \<and> (\<forall>u \<in> set U. is_Var u) \<and> distinct U"
 using assms(1,2)
 proof (induction "\<Gamma> (Var x)" arbitrary: x)
   case (Fun g U)
   note IH = Fun.hyps(1)
   have g: "arity g > 0" using Fun.hyps(2) fun_type_inv[of "Var x"] \<Gamma>_Var_fst by simp_all
   then obtain V where V:
       "Fun g V \<in> M" "\<Gamma> (Fun g V) = \<Gamma> (Var x)" "\<forall>v \<in> set V. \<exists>x. v = Var x"
       "distinct V" "length U = length V"
     using is_TComp_var_instance_closedD[OF Fun.prems(1) Fun.hyps(2)[symmetric] closed(1)]
     by (metis Fun.hyps(2) fun_type_id_eq fun_type_length_eq is_VarE)
   hence U: "U = map \<Gamma> V" using fun_type[OF g(1), of V] Fun.hyps(2) by simp
   hence 1: "\<Gamma> v \<in> set U" when v: "v \<in> set V" for v using v by simp
 
   have 2: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var z) = \<Gamma> (Var y)" when z: "Var z \<in> set V" for z
     using V(1) fv_subset_subterms Fun_param_in_subterms[OF z] by fastforce
 
   show ?case
   proof (cases "TComp f T = \<Gamma> (Var x)")
     case False
     then obtain u where u: "u \<in> set U" "TComp f T \<sqsubseteq> u"
       using Fun.prems(2) Fun.hyps(2) by moura
     then obtain y where y: "Var y \<in> set V" "\<Gamma> (Var y) = u" using U V(3) \<Gamma>_Var_fst by auto
     show ?thesis using IH[OF _ 2[OF y(1)]] u y(2) by metis
   qed (use V in fastforce)
 qed simp
 
 lemma TComp_var_instance_wt_subst_exists:
   assumes gT: "\<Gamma> (Fun g T) = TComp g (map \<Gamma> U)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun g T)"
     and U: "\<forall>u \<in> set U. \<exists>y. u = Var y" "distinct U"
   shows "\<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and> Fun g T = Fun g U \<cdot> \<theta>"
 proof -
   define the_i where "the_i \<equiv> \<lambda>y. THE x. x < length U \<and> U ! x = Var y"
   define \<theta> where \<theta>: "\<theta> \<equiv> \<lambda>y. if Var y \<in> set U then T ! the_i y else Var y"
 
   have g: "arity g > 0" using gT(1,2) fun_type_inv(1) by blast
 
   have UT: "length U = length T" using fun_type_length_eq gT(1) by fastforce
 
   have 1: "the_i y < length U \<and> U ! the_i y = Var y" when y: "Var y \<in> set U" for y
     using theI'[OF distinct_Ex1[OF U(2) y]] unfolding the_i_def by simp
 
   have 2: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     using \<theta> 1 gT(1) fun_type[OF g] UT
     unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
     by (metis (no_types, lifting) nth_map term.inject(2))
 
   have "\<forall>i<length T. U ! i \<cdot> \<theta> = T ! i"
     using \<theta> 1 U(1) UT distinct_Ex1[OF U(2)] in_set_conv_nth
     by (metis (no_types, lifting) subst_apply_term.simps(1))
   hence "T = map (\<lambda>t. t \<cdot> \<theta>) U" by (simp add: UT nth_equalityI)
   hence 3: "Fun g T = Fun g U \<cdot> \<theta>" by simp
 
   have "subst_range \<theta> \<subseteq> set T" using \<theta> 1 U(1) UT by (auto simp add: subst_domain_def)
   hence 4: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" using gT(2) wf_trm_param by auto
 
   show ?thesis by (metis 2 3 4)
 qed
 
 lemma TComp_var_instance_closed_has_Var:
   assumes closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and wf_\<delta>x: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
     and y_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     and t: "t \<sqsubseteq> \<delta> x"
     and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
   shows "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> t"
 proof (cases "\<Gamma> (Var x)")
   case (Var a)
   hence "t = \<delta> x"
     using t wf_\<delta>x \<delta>_wt
     by (metis (full_types) const_type_inv_wf fun_if_subterm subtermeq_Var_const(2) wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
   thus ?thesis using y_ex wt_subst_trm''[OF \<delta>_wt, of "Var x"] by fastforce
 next
   case (Fun f T)
   hence \<Gamma>_\<delta>x: "\<Gamma> (\<delta> x) = TComp f T" using wt_subst_trm''[OF \<delta>_wt, of "Var x"] by auto
 
   show ?thesis
   proof (cases "t = \<delta> x")
     case False
     hence t_subt_\<delta>x: "t \<sqsubset> \<delta> x" using t(1) \<Gamma>_\<delta>x by fastforce
 
     obtain T' where T': "\<delta> x = Fun f T'" using \<Gamma>_\<delta>x t_subt_\<delta>x fun_type_id_eq by (cases "\<delta> x") auto
     
     obtain g S where gS: "Fun g S \<sqsubseteq> \<delta> x" "t \<in> set S" using Fun_ex_if_subterm[OF t_subt_\<delta>x] by blast
   
     have gS_wf: "wf\<^sub>t\<^sub>r\<^sub>m (Fun g S)" by (rule wf_trm_subtermeq[OF wf_\<delta>x gS(1)])
     hence "arity g > 0" using gS(2) by (metis length_pos_if_in_set wf_trm_arity) 
     hence gS_\<Gamma>: "\<Gamma> (Fun g S) = TComp g (map \<Gamma> S)" using fun_type by blast
   
     obtain h U where hU:
         "Fun h U \<in> M" "\<Gamma> (Fun h U) = Fun g (map \<Gamma> S)" "\<forall>u \<in> set U. is_Var u"
       using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M]
             subtermeq_imp_subtermtypeeq[OF wf_\<delta>x] gS \<Gamma>_\<delta>x Fun gS_\<Gamma>
       by metis
   
     obtain y where y: "Var y \<in> set U" "\<Gamma> (Var y) = \<Gamma> t"
       using hU(3) fun_type_param_ex[OF hU(2) gS(2)] by fast
   
     have "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using hU(1) y(1) by force
     thus ?thesis using y(2) closed by metis
   qed (metis y_ex Fun \<Gamma>_\<delta>x)
 qed
 
 lemma TComp_var_instance_closed_has_Fun:
   assumes closed: "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and wf_\<delta>x: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)"
     and y_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     and t: "t \<sqsubseteq> \<delta> x"
     and \<delta>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     and t_\<Gamma>: "\<Gamma> t = TComp g T"
     and t_fun: "is_Fun t"
   shows "\<exists>m \<in> M. \<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and> t = m \<cdot> \<theta> \<and> is_Fun m"
 proof -
   obtain T'' where T'': "t = Fun g T''" using t_\<Gamma> t_fun fun_type_id_eq by blast
 
   have g: "arity g > 0" using t_\<Gamma> fun_type_inv[of t] by simp_all
 
   have "TComp g T \<sqsubseteq> \<Gamma> (Var x)" using \<delta>_wt t t_\<Gamma>
     by (metis wf_\<delta>x subtermeq_imp_subtermtypeeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def) 
   then obtain U where U:
       "Fun g U \<in> M" "\<Gamma> (Fun g U) = TComp g T" "\<forall>u \<in> set U. \<exists>y. u = Var y"
       "distinct U" "length T'' = length U"
     using is_TComp_var_instance_closedD'[OF y_ex _ closed wf_M]
     by (metis t_\<Gamma> T'' fun_type_id_eq fun_type_length_eq is_VarE)
   hence UT': "T = map \<Gamma> U" using fun_type[OF g, of U] by simp
 
   show ?thesis
     using TComp_var_instance_wt_subst_exists UT' T'' U(1,3,4) t t_\<Gamma> wf_\<delta>x wf_trm_subtermeq
     by (metis term.disc(2))
 qed
 
 lemma TComp_var_and_subterm_instance_closed_has_subterms_instances:
   assumes M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
     and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
     and t: "t \<sqsubseteq>\<^sub>s\<^sub>e\<^sub>t M"
     and s: "s \<sqsubseteq> t \<cdot> \<delta>"
     and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "\<exists>m \<in> M. \<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and> s = m \<cdot> \<theta>"
 using subterm_subst_unfold[OF s]
 proof
   assume "\<exists>s'. s' \<sqsubseteq> t \<and> s = s' \<cdot> \<delta>"
   then obtain s' where s': "s' \<sqsubseteq> t" "s = s' \<cdot> \<delta>" by blast
   then obtain \<theta> where \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "s' \<in> M \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>"
     using t has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
           term.order_trans[of s' t]
     by blast
   then obtain m where m: "m \<in> M" "s' = m \<cdot> \<theta>" by blast
 
   have "s = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" using s'(2) m(2) by simp
   thus ?thesis
     using m(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)] by blast
 next
   assume "\<exists>x \<in> fv t. s \<sqsubset> \<delta> x"
   then obtain x where x: "x \<in> fv t" "s \<sqsubset> \<delta> x" "s \<sqsubseteq> \<delta> x" by blast
 
   note 0 = TComp_var_instance_closed_has_Var[OF M_var_inst_cl M_wf]
   note 1 = has_all_wt_instances_ofD''[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
 
   have \<delta>x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" and s_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m s"
     using \<delta>(2) wf_trm_subterm[OF _ x(2)] by fastforce+
 
   have x_fv_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)"
     using x(1) s fv_subset_subterms[OF t] by auto
 
   obtain y where y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> s"
     using 0[of \<delta> x s, OF \<delta>x_wf x_fv_ex x(3) \<delta>(1)] by metis
   then obtain z where z: "Var z \<in> M" "\<Gamma> (Var z) = \<Gamma> s"
     using 1[of y] vars_iff_subtermeq_set[of y M] by metis
 
   define \<theta> where "\<theta> \<equiv> Var(z := s)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
   have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "s = Var z \<cdot> \<theta>"
     using z(2) s_wf_trm unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
   thus ?thesis using z(1) by blast
 qed
 
 context
 begin
 private lemma SMP_D_aux1:
   assumes "t \<in> SMP M"
     and closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                 "is_TComp_var_instance_closed \<Gamma> M"
     and wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
   shows "\<forall>x \<in> fv t. \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
 using assms(1)
 proof (induction t rule: SMP.induct)
   case (MP t) show ?case
   proof
     fix x assume x: "x \<in> fv t"
     hence "Var x \<in> subterms\<^sub>s\<^sub>e\<^sub>t M" using MP.hyps vars_iff_subtermeq by fastforce
     then obtain \<delta> s where \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
         and s: "s \<in> M" "Var x = s \<cdot> \<delta>"
       using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF wf_M] wf_M closed(1)] by blast
     then obtain y where y: "s = Var y" by (cases s) auto
     thus "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
       using s wt_subst_trm''[OF \<delta>(1), of "Var y"] by force
   qed
 next
   case (Subterm t t')
   hence "fv t' \<subseteq> fv t" using subtermeq_vars_subset by auto
   thus ?case using Subterm.IH by auto
 next
   case (Substitution t \<delta>)
   note IH = Substitution.IH
   show ?case
   proof
     fix x assume x: "x \<in> fv (t \<cdot> \<delta>)"
     then obtain y where y: "y \<in> fv t" "\<Gamma> (Var x) \<sqsubseteq> \<Gamma> (Var y)"
       using Substitution.hyps(2,3)
       by (metis subst_apply_img_var subtermeqI' subtermeq_imp_subtermtypeeq
                 vars_iff_subtermeq wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def wf_trm_subst_rangeD)
     let ?P = "\<lambda>x. \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)"
     show "?P x" using y IH
     proof (induction "\<Gamma> (Var y)" arbitrary: y t)
       case (Var a)
       hence "\<Gamma> (Var x) = \<Gamma> (Var y)" by auto
       thus ?case using Var(2,4) by auto
     next
       case (Fun f T)
       obtain z where z: "\<exists>w \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var z) = \<Gamma> (Var w)" "\<Gamma> (Var z) = \<Gamma> (Var y)"
         using Fun.prems(1,3) by blast
       show ?case
       proof (cases "\<Gamma> (Var x) = \<Gamma> (Var y)")
         case True thus ?thesis using Fun.prems by auto
       next
         case False
         then obtain \<tau> where \<tau>: "\<tau> \<in> set T" "\<Gamma> (Var x) \<sqsubseteq> \<tau>" using Fun.prems(2) Fun.hyps(2) by auto
         then obtain U where U:
             "Fun f U \<in> M" "\<Gamma> (Fun f U) = \<Gamma> (Var z)" "\<forall>u \<in> set U. \<exists>v. u = Var v" "distinct U"
           using is_TComp_var_instance_closedD'[OF z(1) _ closed(2) wf_M] Fun.hyps(2) z(2)
           by (metis fun_type_id_eq subtermeqI' is_VarE)
         hence 1: "\<forall>x \<in> fv (Fun f U). \<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var y) = \<Gamma> (Var x)" by force
 
         have "arity f > 0" using U(2) z(2) Fun.hyps(2) fun_type_inv(1) by metis
         hence "\<Gamma> (Fun f U) = TComp f (map \<Gamma> U)" using fun_type by auto
         then obtain u where u: "Var u \<in> set U" "\<Gamma> (Var u) = \<tau>"
           using \<tau>(1) U(2,3) z(2) Fun.hyps(2) by auto
         show ?thesis
           using Fun.hyps(1)[of u "Fun f U"] u \<tau> 1
           by force
       qed
     qed
   qed
 next
   case (Ana t K T k)
   have "fv k \<subseteq> fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto
   thus ?case using Ana.IH by auto
 qed
 
 private lemma SMP_D_aux2:
   fixes t::"('fun, ('fun, 'atom) term \<times> nat) term"
   assumes t_SMP: "t \<in> SMP M"
     and t_Var: "\<exists>x. t = Var x"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta>"
 proof -
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union> ((set \<circ> fst \<circ> Ana) ` M))"
   proof
     fix k assume "k \<in> \<Union>((set \<circ> fst \<circ> Ana) ` M)"
     then obtain m where m: "m \<in> M" "k \<in> set (fst (Ana m))" by force
     thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast
   qed
 
   note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
   note 1 = has_all_wt_instances_ofD'[OF M_Ana_wf M_wf M_Ana_cl]
 
   obtain x y where x: "t = Var x" and y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
     using t_Var SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce
   then obtain m \<delta> where m: "m \<in> M" "m \<cdot> \<delta> = Var y" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     using 0[of "Var y"] vars_iff_subtermeq_set[of y M] by fastforce
   obtain z where z: "m = Var z" using m(2) by (cases m) auto
 
   define \<theta> where "\<theta> \<equiv> Var(z := Var x)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
   have "\<Gamma> (Var z) = \<Gamma> (Var x)" using y(2) m(2) z wt_subst_trm''[OF \<delta>, of m] by argo
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
   moreover have "t = m \<cdot> \<theta>" using x z unfolding \<theta>_def by simp
   ultimately show ?thesis using m(1) by blast
 qed
 
 private lemma SMP_D_aux3:
   assumes hyps: "t' \<sqsubseteq> t" and wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t" and prems: "is_Fun t'"
     and IH:
       "((\<exists>f. t = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta>)) \<or>
        (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta> \<and> is_Fun m)"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "((\<exists>f. t' = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t' = m \<cdot> \<delta>)) \<or>
          (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t' = m \<cdot> \<delta> \<and> is_Fun m)"
 proof (cases "\<exists>f. t = Fun f [] \<or> t' = Fun f []")
   case True
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
     and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
     and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
     and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
   using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   note 0 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl]
   note 1 = TComp_var_instance_closed_has_Fun[OF M_var_inst_cl M_wf]
   note 2 = TComp_var_and_subterm_instance_closed_has_subterms_instances[
             OF M_var_inst_cl M_subterms_cl M_wf]
 
   have wf_t': "wf\<^sub>t\<^sub>r\<^sub>m t'" using hyps wf_t wf_trm_subterm by blast
 
   obtain c where "t = Fun c [] \<or> t' = Fun c []" using True by moura
   thus ?thesis
   proof
     assume c: "t' = Fun c []"
     show ?thesis
     proof (cases "\<exists>f. t = Fun f []")
       case True
       hence "t = t'" using c hyps by force
       thus ?thesis using IH by fast
     next
       case False
       note F = this
       then obtain m \<delta> where m: "m \<in> M" "t = m \<cdot> \<delta>"
           and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
         using IH by blast
 
       show ?thesis using subterm_subst_unfold[OF hyps[unfolded m(2)]]
       proof
         assume "\<exists>m'. m' \<sqsubseteq> m \<and> t' = m' \<cdot> \<delta>"
         then obtain m' where m': "m' \<sqsubseteq> m" "t' = m' \<cdot> \<delta>" by moura
         obtain n \<theta> where n: "n \<in> M" "m' = n \<cdot> \<theta>" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           using 0[of m'] m(1) m'(1) by blast
         have "t' = n \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" using m'(2) n(2) by auto
         thus ?thesis
           using c n(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)] by blast
       next
         assume "\<exists>x \<in> fv m. t' \<sqsubset> \<delta> x"
         then obtain x where x: "x \<in> fv m" "t' \<sqsubset> \<delta> x" "t' \<sqsubseteq> \<delta> x" by moura
         have \<delta>x_wf: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" using \<delta>(2) by fastforce
         
         have x_fv_ex: "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" using x m by auto
 
         show ?thesis
         proof (cases "\<Gamma> t'")
           case (Var a)
           show ?thesis
             using c m 2[OF _ hyps[unfolded m(2)] \<delta>]
             by fast
         next
           case (Fun g S)
           show ?thesis
             using c 1[of \<delta> x t', OF \<delta>x_wf x_fv_ex x(3) \<delta>(1) Fun]
             by blast
         qed
       qed
     qed
   qed (use IH hyps in simp)
 next
   case False
   note F = False
   then obtain m \<delta> where m:
       "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "t = m \<cdot> \<delta>" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using IH by moura
   obtain f T where fT: "t' = Fun f T" "arity f > 0" "\<Gamma> t' = TComp f (map \<Gamma> T)"
     using F prems fun_type wf_trm_subtermeq[OF wf_t hyps]
     by (metis is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
 
   have closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                "is_TComp_var_instance_closed \<Gamma> M"
     using M_SMP_repr unfolding finite_SMP_representation_def by metis+
 
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
     using finite_SMP_representationD[OF M_SMP_repr] by blast
 
   show ?thesis
   proof (cases "\<exists>x \<in> fv m. t' \<sqsubseteq> \<delta> x")
     case True
     then obtain x where x: "x \<in> fv m" "t' \<sqsubseteq> \<delta> x" by moura
     have 1: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using m(1) x(1) by auto
     have 2: "is_Fun (\<delta> x)" using prems x(2) by auto
     have 3: "wf\<^sub>t\<^sub>r\<^sub>m (\<delta> x)" using m(5) by (simp add: wf_trm_subst_rangeD)
     have "\<not>(\<exists>f. \<delta> x = Fun f [])" using F x(2) by auto
     hence "\<exists>f T. \<Gamma> (Var x) = TComp f T" using 2 3 m(2)
       by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
     moreover have "\<exists>f T. \<Gamma> t' = Fun f T"
       using False prems wf_trm_subtermeq[OF wf_t hyps]
       by (metis (no_types) fun_type is_FunE length_greater_0_conv subtermeqI' wf\<^sub>t\<^sub>r\<^sub>m_def)
     ultimately show ?thesis
       using TComp_var_instance_closed_has_Fun 1 x(2) m(2) prems closed 3 M_wf
       by metis
   next
     case False
     then obtain m' where m': "m' \<sqsubseteq> m" "t' = m' \<cdot> \<delta>" "is_Fun m'"
       using hyps m(3) subterm_subst_not_img_subterm
       by blast
     then obtain \<theta> m'' where \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "m'' \<in> M" "m' = m'' \<cdot> \<theta>"
       using m(1) has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf closed(1)] by blast
     hence t'_m'': "t' = m'' \<cdot> \<theta> \<circ>\<^sub>s \<delta>" using m'(2) by fastforce
 
     note \<theta>\<delta> = wt_subst_compose[OF \<theta>(1) m(2)] wf_trms_subst_compose[OF \<theta>(2) m(5)]
 
     show ?thesis
     proof (cases "is_Fun m''")
       case True thus ?thesis using \<theta>(3,4) m'(2,3) m(4) fT t'_m'' \<theta>\<delta> by blast
     next
       case False
       then obtain x where x: "m'' = Var x" by moura
       hence "\<exists>y \<in> fv\<^sub>s\<^sub>e\<^sub>t M. \<Gamma> (Var x) = \<Gamma> (Var y)" "t' \<sqsubseteq> (\<theta> \<circ>\<^sub>s \<delta>) x"
             "\<Gamma> (Var x) = Fun f (map \<Gamma> T)" "wf\<^sub>t\<^sub>r\<^sub>m ((\<theta> \<circ>\<^sub>s \<delta>) x)"
         using \<theta>\<delta> t'_m'' \<theta>(3) fv_subset[OF \<theta>(3)] fT(3) subst_apply_term.simps(1)[of x "\<theta> \<circ>\<^sub>s \<delta>"]
               wt_subst_trm''[OF \<theta>\<delta>(1), of "Var x"]
         by (fastforce, blast, argo, fastforce)
       thus ?thesis
         using x TComp_var_instance_closed_has_Fun[
                 of M "\<theta> \<circ>\<^sub>s \<delta>" x t' f "map \<Gamma> T", OF closed(2) M_wf _ _ _ \<theta>\<delta>(1) fT(3) prems]
         by blast
     qed
   qed
 qed
 
 lemma SMP_D:
   assumes "t \<in> SMP M" "is_Fun t"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "((\<exists>f. t = Fun f []) \<and> (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta>)) \<or>
          (\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta> \<and> is_Fun m)"
 proof -
   have wf_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
       and closed: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
                   "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
                   "is_TComp_var_instance_closed \<Gamma> M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   show ?thesis using assms(1,2)
   proof (induction t rule: SMP.induct)
     case (MP t)
     moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" "t = t \<cdot> Var" by simp_all
     ultimately show ?case by blast 
   next
     case (Subterm t t')
     hence t_fun: "is_Fun t" by auto
     note * = Subterm.hyps(2) SMP_wf_trm[OF Subterm.hyps(1) wf_M(1)]
              Subterm.prems Subterm.IH[OF t_fun] M_SMP_repr
     show ?case by (rule SMP_D_aux3[OF *])
   next
     case (Substitution t \<delta>)
     have wf: "wf\<^sub>t\<^sub>r\<^sub>m t" by (metis Substitution.hyps(1) wf_M(1) SMP_wf_trm)
     hence wf': "wf\<^sub>t\<^sub>r\<^sub>m (t \<cdot> \<delta>)" using Substitution.hyps(3) wf_trm_subst by blast
     show ?case
     proof (cases "\<Gamma> t")
       case (Var a)
       hence 1: "\<Gamma> (t \<cdot> \<delta>) = TAtom a" using Substitution.hyps(2) by (metis wt_subst_trm'') 
       then obtain c where c: "t \<cdot> \<delta> = Fun c []"
         using TAtom_term_cases[OF wf' 1] Substitution.prems by fastforce
       hence "(\<exists>x. t = Var x) \<or> t = t \<cdot> \<delta>" by (cases t) auto
       thus ?thesis
       proof
         assume t_Var: "\<exists>x. t = Var x"
         then obtain x where x: "t = Var x" "\<delta> x = Fun c []" "\<Gamma> (Var x) = TAtom a"
           using c 1 wt_subst_trm''[OF Substitution.hyps(2), of t] by force
         
         obtain m \<theta> where m: "m \<in> M" "t = m \<cdot> \<theta>" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           using SMP_D_aux2[OF Substitution.hyps(1) t_Var M_SMP_repr] by moura
 
         have "m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>) = Fun c []" using c m(2) by auto
         thus ?thesis
           using c m(1) wt_subst_compose[OF \<theta>(1) Substitution.hyps(2)]
                 wf_trms_subst_compose[OF \<theta>(2) Substitution.hyps(3)]
           by metis
       qed (use c Substitution.IH in auto)
     next
       case (Fun f T)
       hence 1: "\<Gamma> (t \<cdot> \<delta>) = TComp f T" using Substitution.hyps(2) by (metis wt_subst_trm'')
       have 2: "\<not>(\<exists>f. t = Fun f [])" using Fun TComp_term_cases[OF wf] by auto
       obtain T'' where T'': "t \<cdot> \<delta> = Fun f T''"
         using 1 2 fun_type_id_eq Fun Substitution.prems
         by fastforce
       have f: "arity f > 0" using fun_type_inv[OF 1] by metis
   
       show ?thesis
       proof (cases t)
         case (Fun g U)
         then obtain m \<theta> where m:
             "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "t = m \<cdot> \<theta>" "is_Fun m" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           using Substitution.IH Fun 2 by moura
         have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)" "t \<cdot> \<delta> = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
           using wt_subst_compose[OF m(2) Substitution.hyps(2)] m(3)
                 wf_trms_subst_compose[OF m(5) Substitution.hyps(3)]
           by auto
         thus ?thesis using m(1,4) by metis
       next
         case (Var x)
         then obtain y where y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
           using SMP_D_aux1[OF Substitution.hyps(1) closed(1,3) wf_M] Fun
           by moura
         hence 3: "\<Gamma> (Var y) = TComp f T" using Var Fun \<Gamma>_Var_fst by simp
         
         obtain h V where V:
             "Fun h V \<in> M" "\<Gamma> (Fun h V) = \<Gamma> (Var y)" "\<forall>u \<in> set V. \<exists>z. u = Var z" "distinct V"
           by (metis is_VarE is_TComp_var_instance_closedD[OF _ 3 closed(3)] y(1))
         moreover have "length T'' = length V" using 3 V(2) fun_type_length_eq 1 T'' by metis
         ultimately have TV: "T = map \<Gamma> V"
           by (metis fun_type[OF f(1)] 3 fun_type_id_eq term.inject(2))
   
         obtain \<theta> where \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "t \<cdot> \<delta> = Fun h V \<cdot> \<theta>"
           using TComp_var_instance_wt_subst_exists 1 3 T'' TV V(2,3,4) wf'
           by (metis fun_type_id_eq)
   
         have 9: "\<Gamma> (Fun h V) = \<Gamma> (\<delta> x)" using y(2) Substitution.hyps(2) V(2) 1 3 Var by auto
   
         show ?thesis using Var \<theta> 9 V(1) by force
       qed
     qed
   next
     case (Ana t K T k)
     have 1: "is_Fun t" using Ana.hyps(2,3) by auto
     then obtain f U where U: "t = Fun f U" by moura
   
     have 2: "fv k \<subseteq> fv t" using Ana_keys_fv[OF Ana.hyps(2)] Ana.hyps(3) by auto
   
     have wf_t: "wf\<^sub>t\<^sub>r\<^sub>m t"
       using SMP_wf_trm[OF Ana.hyps(1)] wf\<^sub>t\<^sub>r\<^sub>m_code wf_M
       by auto
     hence wf_k: "wf\<^sub>t\<^sub>r\<^sub>m k"
       using Ana_keys_wf'[OF Ana.hyps(2)] wf\<^sub>t\<^sub>r\<^sub>m_code Ana.hyps(3)
       by auto
   
     have wf_M_keys: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>((set \<circ> fst \<circ> Ana) ` M))"
     proof
       fix t assume "t \<in> (\<Union>((set \<circ> fst \<circ> Ana) ` M))"
       then obtain s where s: "s \<in> M" "t \<in> (set \<circ> fst \<circ> Ana) s" by blast
       obtain K R where KR: "Ana s = (K,R)" by (metis surj_pair)
       hence "t \<in> set K" using s(2) by simp
       thus "wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_keys_wf'[OF KR] wf_M s(1) by blast
     qed
   
     show ?case using Ana_subst'_or_Ana_keys_subterm
     proof
       assume "\<forall>t K T k. Ana t = (K, T) \<longrightarrow> k \<in> set K \<longrightarrow> k \<sqsubset> t"
       hence *: "k \<sqsubseteq> t" using Ana.hyps(2,3) by auto
       show ?thesis by (rule SMP_D_aux3[OF * wf_t Ana.prems Ana.IH[OF 1] M_SMP_repr])
     next
       assume Ana_subst':
           "\<forall>f T \<delta> K M. Ana (Fun f T) = (K, M) \<longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
   
       have "arity f > 0" using Ana_const[of f U] U Ana.hyps(2,3) by fastforce
       hence "U \<noteq> []" using wf_t U unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by force
       then obtain m \<delta> where m: "m \<in> M" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = m \<cdot> \<delta>" "is_Fun m"
         using Ana.IH[OF 1] U by auto
       hence "Ana (t \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,T \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)" using Ana_subst' U Ana.hyps(2) by auto
       obtain Km Tm where Ana_m: "Ana m = (Km,Tm)" by moura
       hence "Ana (m \<cdot> \<delta>) = (Km \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>,Tm \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>)"
         using Ana_subst' U m(4) is_FunE[OF m(5)] Ana.hyps(2)
         by metis
       then obtain km where km: "km \<in> set Km" "k = km \<cdot> \<delta>" using Ana.hyps(2,3) m(4) by auto
       then obtain \<theta> km' where \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           and km': "km' \<in> M" "km = km' \<cdot> \<theta>"
         using Ana_m m(1) has_all_wt_instances_ofD'[OF wf_M_keys wf_M closed(2), of km] by force
   
       have k\<theta>\<delta>: "k = km' \<cdot> \<theta> \<circ>\<^sub>s \<delta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<delta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
         using km(2) km' wt_subst_compose[OF \<theta>(1) m(2)] wf_trms_subst_compose[OF \<theta>(2) m(3)]
         by auto
   
       show ?case
       proof (cases "is_Fun km'")
         case True thus ?thesis using k\<theta>\<delta> km'(1) by blast
       next
         case False
         note F = False
         then obtain x where x: "km' = Var x" by auto
         hence 3: "x \<in> fv\<^sub>s\<^sub>e\<^sub>t M" using fv_subset[OF km'(1)] by auto
         obtain kf kT where kf: "k = Fun kf kT" using Ana.prems by auto
         show ?thesis
         proof (cases "kT = []")
           case True thus ?thesis using k\<theta>\<delta>(1) k\<theta>\<delta>(2) k\<theta>\<delta>(3) kf km'(1) by blast
         next
           case False
           hence 4: "arity kf > 0" using wf_k kf TAtom_term_cases const_type by fastforce
           then obtain kT' where kT': "\<Gamma> k = TComp kf kT'" by (simp add: fun_type kf) 
           then obtain V where V:
               "Fun kf V \<in> M" "\<Gamma> (Fun kf V) = \<Gamma> (Var x)" "\<forall>u \<in> set V. \<exists>v. u = Var v"
               "distinct V" "is_Fun (Fun kf V)"
             using is_TComp_var_instance_closedD[OF _ _ closed(3), of x]
                   x m(2) k\<theta>\<delta>(1) 3 wt_subst_trm''[OF k\<theta>\<delta>(2)]
             by (metis fun_type_id_eq term.disc(2) is_VarE)
           have 5: "kT' = map \<Gamma> V"
             using fun_type[OF 4] x kT' k\<theta>\<delta> m(2) V(2)
             by (metis term.inject(2) wt_subst_trm'')
           thus ?thesis
             using TComp_var_instance_wt_subst_exists wf_k kf 4 V(3,4) kT' V(1,5)
             by metis
         qed
       qed
     qed
   qed
 qed
 
 lemma SMP_D':
   fixes M
   defines "\<delta> \<equiv> var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))"
   assumes M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
     and s: "s \<in> SMP M" "is_Fun s" "\<nexists>f. s = Fun f []"
     and t: "t \<in> SMP M" "is_Fun t" "\<nexists>f. t = Fun f []"
   obtains \<sigma> s0 \<theta> t0
   where "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "s0 \<in> M" "is_Fun s0" "s = s0 \<cdot> \<sigma>" "\<Gamma> s = \<Gamma> s0"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "t0 \<in> M" "is_Fun t0" "t = t0 \<cdot> \<delta> \<cdot> \<theta>" "\<Gamma> t = \<Gamma> t0"
 proof -
   obtain \<sigma> s0 where
       s0: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)" "s0 \<in> M" "s = s0 \<cdot> \<sigma>" "is_Fun s0"
     using s(3) SMP_D[OF s(1,2) M_SMP_repr] unfolding \<delta>_def by metis
 
   obtain \<theta> t0 where t0:
       "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "t0 \<in> M" "t = t0 \<cdot> \<delta> \<cdot> \<theta>" "is_Fun t0"
     using t(3) SMP_D[OF t(1,2) M_SMP_repr] var_rename_wt'[of _ t]
           wf_trms_subst_compose_Var_range(1)[OF _ var_rename_is_renaming(2)]
     unfolding \<delta>_def by metis
 
   have "\<Gamma> s = \<Gamma> s0" "\<Gamma> t = \<Gamma> (t0 \<cdot> \<delta>)" "\<Gamma> (t0 \<cdot> \<delta>) = \<Gamma> t0"
     using s0 t0 wt_subst_trm'' by (metis, metis, metis \<delta>_def var_rename_wt(1))
   thus ?thesis using s0 t0 that by simp
 qed
 
 lemma SMP_D'':
   fixes t::"('fun, ('fun, 'atom) term \<times> nat) term"
   assumes t_SMP: "t \<in> SMP M"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "\<exists>m \<in> M. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> t = m \<cdot> \<delta>"
 proof (cases "(\<exists>x. t = Var x) \<or> (\<exists>c. t = Fun c [])")
   case True
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   have M_Ana_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union> ((set \<circ> fst \<circ> Ana) ` M))"
   proof
     fix k assume "k \<in> \<Union>((set \<circ> fst \<circ> Ana) ` M)"
     then obtain m where m: "m \<in> M" "k \<in> set (fst (Ana m))" by force
     thus "wf\<^sub>t\<^sub>r\<^sub>m k" using M_wf Ana_keys_wf'[of m "fst (Ana m)" _ k] surjective_pairing by blast
   qed
 
   show ?thesis using True
   proof
     assume "\<exists>x. t = Var x"
     then obtain x y where x: "t = Var x" and y: "y \<in> fv\<^sub>s\<^sub>e\<^sub>t M" "\<Gamma> (Var y) = \<Gamma> (Var x)"
       using SMP_D_aux1[OF t_SMP M_subterms_cl M_var_inst_cl M_wf] by fastforce
     then obtain m \<delta> where m: "m \<in> M" "m \<cdot> \<delta> = Var y" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
       using has_all_wt_instances_ofD'[OF wf_trms_subterms[OF M_wf] M_wf M_subterms_cl, of "Var y"]
             vars_iff_subtermeq_set[of y M]
       by fastforce
 
     obtain z where z: "m = Var z" using m(2) by (cases m) auto
 
     define \<theta> where "\<theta> \<equiv> Var(z := Var x)::('fun, ('fun, 'atom) term \<times> nat) subst"
 
     have "\<Gamma> (Var z) = \<Gamma> (Var x)" using y(2) m(2) z wt_subst_trm''[OF \<delta>, of m] by argo
     hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" unfolding \<theta>_def wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
     moreover have "t = m \<cdot> \<theta>" using x z unfolding \<theta>_def by simp
     ultimately show ?thesis using m(1) by blast
   qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast)
 qed (use SMP_D[OF t_SMP _ M_SMP_repr] in blast)
 end
 
 lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t:
   assumes "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t M"
 proof -
   let ?\<delta> = "var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t M))"
   have M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
     by (metis comp_tfr\<^sub>s\<^sub>e\<^sub>t_def assms)
 
   have M_finite: "finite M"
     using assms card_gt_0_iff unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def finite_SMP_representation_def by blast
 
   show ?thesis
   proof (unfold tfr\<^sub>s\<^sub>e\<^sub>t_def; intro ballI impI)
     fix s t assume "s \<in> SMP M - Var`\<V>" "t \<in> SMP M - Var`\<V>"
     hence st: "s \<in> SMP M" "is_Fun s" "t \<in> SMP M" "is_Fun t" by auto
     have "\<not>(\<exists>\<delta>. Unifier \<delta> s t)" when st_type_neq: "\<Gamma> s \<noteq> \<Gamma> t"
     proof (cases "\<exists>f. s = Fun f [] \<or> t = Fun f []")
       case False
       then obtain \<sigma> s0 \<theta> t0 where
             s0: "s0 \<in> M" "is_Fun s0" "s = s0 \<cdot> \<sigma>" "\<Gamma> s = \<Gamma> s0"
         and t0: "t0 \<in> M" "is_Fun t0" "t = t0 \<cdot> ?\<delta> \<cdot> \<theta>" "\<Gamma> t = \<Gamma> t0"
         using SMP_D'[OF M_SMP_repr st(1,2) _ st(3,4)] by metis
       hence "\<not>(\<exists>\<delta>. Unifier \<delta> s0 (t0 \<cdot> ?\<delta>))"
         using assms mgu_None_is_subst_neq st_type_neq wt_subst_trm''[OF var_rename_wt(1)]
         unfolding comp_tfr\<^sub>s\<^sub>e\<^sub>t_def Let_def by metis
       thus ?thesis
         using vars_term_disjoint_imp_unifier[OF var_rename_fv_set_disjoint[OF M_finite]] s0(1) t0(1)
         unfolding s0(3) t0(3) by (metis (no_types, opaque_lifting) subst_subst_compose)
     qed (use st_type_neq st(2,4) in auto)
     thus "\<Gamma> s = \<Gamma> t" when "\<exists>\<delta>. Unifier \<delta> s t" by (metis that)
   qed
 qed
 
 lemma tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t':
   assumes "let N = SMP0 Ana \<Gamma> M in set M \<subseteq> set N \<and> comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> (set N)"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (set M)"
 by (rule tfr_subset(2)[
           OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF conjunct2[OF assms[unfolded Let_def]]]
              conjunct1[OF assms[unfolded Let_def]]])
 
 lemma tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p: "tfr\<^sub>s\<^sub>t\<^sub>p a = comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma> a"
 proof (cases a)
   case (Equality ac t t')
   thus ?thesis
     using mgu_always_unifies[of t _ t'] mgu_gives_MGU[of t t']
     by auto
 next
   case (Inequality X F)
   thus ?thesis
     using tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of X F]
           comp_tfr\<^sub>s\<^sub>t\<^sub>p.simps(2)[of \<Gamma> X F]
           Fun_range_case(2)[of "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"] 
     unfolding is_Var_def
     by auto
 qed auto
 
 lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t:
   assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> M S"
   shows "tfr\<^sub>s\<^sub>t S"
 unfolding tfr\<^sub>s\<^sub>t_def
 proof
   have comp_tfr\<^sub>s\<^sub>e\<^sub>t_M: "comp_tfr\<^sub>s\<^sub>e\<^sub>t arity Ana \<Gamma> M"
     using assms unfolding comp_tfr\<^sub>s\<^sub>t_def by blast
   
   have wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M"
       and wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
       and S_trms_instance_M: "has_all_wt_instances_of \<Gamma> (trms\<^sub>s\<^sub>t S) M"
     using assms wf\<^sub>t\<^sub>r\<^sub>m_code wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_code trms_list\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>t
     unfolding comp_tfr\<^sub>s\<^sub>t_def comp_tfr\<^sub>s\<^sub>e\<^sub>t_def finite_SMP_representation_def list_all_iff
     by blast+
 
   show "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)"
     using tfr_subset(3)[OF tfr\<^sub>s\<^sub>e\<^sub>t_if_comp_tfr\<^sub>s\<^sub>e\<^sub>t[OF comp_tfr\<^sub>s\<^sub>e\<^sub>t_M] SMP_SMP_subset]
           SMP_I'[OF wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_S wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s_M S_trms_instance_M]
     by blast
 
   have "list_all (comp_tfr\<^sub>s\<^sub>t\<^sub>p \<Gamma>) S" by (metis assms comp_tfr\<^sub>s\<^sub>t_def)
   thus "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" by (induct S) (simp_all add: tfr\<^sub>s\<^sub>t\<^sub>p_is_comp_tfr\<^sub>s\<^sub>t\<^sub>p)
 qed
 
 lemma tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t':
   assumes "comp_tfr\<^sub>s\<^sub>t arity Ana \<Gamma> (set (SMP0 Ana \<Gamma> (trms_list\<^sub>s\<^sub>t S))) S"
   shows "tfr\<^sub>s\<^sub>t S"
 by (rule tfr\<^sub>s\<^sub>t_if_comp_tfr\<^sub>s\<^sub>t[OF assms])
 
 
 
 subsubsection \<open>Lemmata for Checking Ground SMP (GSMP) Disjointness\<close>
 context
 begin
 private lemma ground_SMP_disjointI_aux1:
   fixes M::"('fun, ('fun, 'atom) term \<times> nat) term set"
   assumes f_def: "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
     and g_def: "g \<equiv> \<lambda>M. {t \<in> M. fv t = {}}"
   shows "f (SMP M) = g (SMP M)"
 proof
   have "t \<in> f (SMP M)" when t: "t \<in> SMP M" "fv t = {}" for t
   proof -
     define \<delta> where "\<delta> \<equiv> Var::('fun, ('fun, 'atom) term \<times> nat) subst"
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "t = t \<cdot> \<delta>"
       using subst_apply_term_empty[of t] that(2) wt_subst_Var wf_trm_subst_range_Var
       unfolding \<delta>_def by auto
     thus ?thesis using SMP.Substitution[OF t(1), of \<delta>] t(2) unfolding f_def by fastforce
   qed
   thus "g (SMP M) \<subseteq> f (SMP M)" unfolding g_def by blast
 qed (use f_def g_def in blast)
 
 private lemma ground_SMP_disjointI_aux2:
   fixes M::"('fun, ('fun, 'atom) term \<times> nat) term set"
   assumes f_def: "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
     and M_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> M"
   shows "f M = f (SMP M)"
 proof
   have M_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s M" 
       and M_var_inst_cl: "is_TComp_var_instance_closed \<Gamma> M"
       and M_subterms_cl: "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t M) M"
       and M_Ana_cl: "has_all_wt_instances_of \<Gamma> (\<Union>((set \<circ> fst \<circ> Ana) ` M)) M"
     using finite_SMP_representationD[OF M_SMP_repr] by blast+
 
   show "f (SMP M) \<subseteq> f M"
   proof
     fix t assume "t \<in> f (SMP M)"
     then obtain s \<delta> where s: "t = s \<cdot> \<delta>" "s \<in> SMP M" "fv (s \<cdot> \<delta>) = {}"
         and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       unfolding f_def by blast
 
     have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t" using SMP_wf_trm[OF s(2) M_wf] s(1) wf_trm_subst[OF \<delta>(2)] by blast 
 
     obtain m \<theta> where m: "m \<in> M" "s = m \<cdot> \<theta>" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
       using SMP_D''[OF s(2) M_SMP_repr] by blast
 
     have "t = m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)" "fv (m \<cdot> (\<theta> \<circ>\<^sub>s \<delta>)) = {}" using s(1,3) m(2) by simp_all
     thus "t \<in> f M"
       using m(1) wt_subst_compose[OF \<theta>(1) \<delta>(1)] wf_trms_subst_compose[OF \<theta>(2) \<delta>(2)]
       unfolding f_def by blast
   qed
 qed (auto simp add: f_def)
 
 private lemma ground_SMP_disjointI_aux3:
   fixes A B C::"('fun, ('fun, 'atom) term \<times> nat) term set"
   defines "P \<equiv> \<lambda>t s. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> Unifier \<delta> t s"
   assumes f_def: "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
     and Q_def: "Q \<equiv> \<lambda>t. intruder_synth' public arity {} t"
     and R_def: "R \<equiv> \<lambda>t. \<exists>u \<in> C. is_wt_instance_of_cond \<Gamma> t u"
     and AB: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s A" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s B" "fv\<^sub>s\<^sub>e\<^sub>t A \<inter> fv\<^sub>s\<^sub>e\<^sub>t B = {}"
     and C: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C"
     and ABC: "\<forall>t \<in> A. \<forall>s \<in> B. P t s \<longrightarrow> Q t \<or> R t"
   shows "f A \<inter> f B \<subseteq> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
 proof
   fix t assume "t \<in> f A \<inter> f B"
   then obtain ta tb \<delta>a \<delta>b where
           ta: "t = ta \<cdot> \<delta>a" "ta \<in> A" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>a)" "fv (ta \<cdot> \<delta>a) = {}"
       and tb: "t = tb \<cdot> \<delta>b" "tb \<in> B" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>b" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>b)" "fv (tb \<cdot> \<delta>b) = {}"
     unfolding f_def by blast
 
   have ta_tb_wf: "wf\<^sub>t\<^sub>r\<^sub>m ta" "wf\<^sub>t\<^sub>r\<^sub>m tb" "fv ta \<inter> fv tb = {}" "\<Gamma> ta = \<Gamma> tb"
     using ta(1,2) tb(1,2) AB fv_subset_subterms
           wt_subst_trm''[OF ta(3), of ta] wt_subst_trm''[OF tb(3), of tb]
     by (fast, fast, blast, simp)
 
   obtain \<theta> where \<theta>: "Unifier \<theta> ta tb" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     using vars_term_disjoint_imp_unifier[OF ta_tb_wf(3), of \<delta>a \<delta>b]
           ta(1) tb(1) wt_Unifier_if_Unifier[OF ta_tb_wf(1,2,4)]
     by blast
   hence "Q ta \<or> R ta" using ABC ta(2) tb(2) unfolding P_def by blast+
   thus "t \<in> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
   proof
     show "Q ta \<Longrightarrow> ?thesis"
       using ta(1) pgwt_ground[of ta] pgwt_is_empty_synth[of ta] subst_ground_ident[of ta \<delta>a]
       unfolding Q_def f_def intruder_synth_code[symmetric] by simp
   next
     assume "R ta"
     then obtain ua \<sigma>a where ua: "ta = ua \<cdot> \<sigma>a" "ua \<in> C" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>a" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>a)"
       using \<theta> ABC ta_tb_wf(1,2) ta(2) tb(2) C is_wt_instance_of_condD'
       unfolding P_def R_def by metis
   
     have "t = ua \<cdot> (\<sigma>a \<circ>\<^sub>s \<delta>a)" "fv t = {}"
       using ua(1) ta(1,5) tb(1,5) by auto
     thus ?thesis
       using ua(2) wt_subst_compose[OF ua(3) ta(3)] wf_trms_subst_compose[OF ua(4) ta(4)]
       unfolding f_def by blast
   qed
 qed
 
 lemma ground_SMP_disjointI:
   fixes A B::"('fun, ('fun, 'atom) term \<times> nat) term set" and C
   defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
     and "g \<equiv> \<lambda>M. {t \<in> M. fv t = {}}"
     and "Q \<equiv> \<lambda>t. intruder_synth' public arity {} t"
     and "R \<equiv> \<lambda>t. \<exists>u \<in> C. is_wt_instance_of_cond \<Gamma> t u"
   assumes AB_fv_disj: "fv\<^sub>s\<^sub>e\<^sub>t A \<inter> fv\<^sub>s\<^sub>e\<^sub>t B = {}"
     and A_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> A"
     and B_SMP_repr: "finite_SMP_representation arity Ana \<Gamma> B"
     and C_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s C"
     and ABC: "\<forall>t \<in> A. \<forall>s \<in> B. \<Gamma> t = \<Gamma> s \<and> mgu t s \<noteq> None \<longrightarrow> Q t \<or> R t"
   shows "g (SMP A) \<inter> g (SMP B) \<subseteq> f C \<union> {m. {} \<turnstile>\<^sub>c m}"
 proof -
   have AB_wf: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s A" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s B"
     using A_SMP_repr B_SMP_repr finite_SMP_representationD(1)
     by (blast, blast)
 
   let ?P = "\<lambda>t s. \<exists>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> Unifier \<delta> t s"
   have ABC': "\<forall>t \<in> A. \<forall>s \<in> B. ?P t s \<longrightarrow> Q t \<or> R t"
     by (metis (no_types) ABC mgu_None_is_subst_neq wt_subst_trm'')
 
   show ?thesis
     using ground_SMP_disjointI_aux1[OF f_def g_def, of A]
           ground_SMP_disjointI_aux1[OF f_def g_def, of B]
           ground_SMP_disjointI_aux2[OF f_def A_SMP_repr]
           ground_SMP_disjointI_aux2[OF f_def B_SMP_repr]
           ground_SMP_disjointI_aux3[OF f_def Q_def R_def AB_wf AB_fv_disj C_wf ABC']
     by argo
 qed
 
 end
 
 end
 
 end