diff --git a/thys/Compiling-Exceptions-Correctly/Exceptions.thy b/thys/Compiling-Exceptions-Correctly/Exceptions.thy
--- a/thys/Compiling-Exceptions-Correctly/Exceptions.thy
+++ b/thys/Compiling-Exceptions-Correctly/Exceptions.thy
@@ -1,186 +1,191 @@
 (*  Author:     Tobias Nipkow
     Copyright   2004 TU Muenchen
 *)
 
 section \<open>Compiling exception handling\<close>
 
 theory Exceptions
 imports Main
 begin
 
 subsection\<open>The source language\<close>
 
 datatype expr = Val int | Add expr expr | Throw | Catch expr expr
 
 primrec eval :: "expr \<Rightarrow> int option"
 where
   "eval (Val i) = Some i"
 | "eval (Add x y) =
    (case eval x of None \<Rightarrow> None
     | Some i \<Rightarrow> (case eval y of None \<Rightarrow> None
                  | Some j \<Rightarrow> Some(i+j)))"
 | "eval Throw = None"
 | "eval (Catch x h) = (case eval x of None \<Rightarrow> eval h | Some i \<Rightarrow> Some i)"
 
 subsection\<open>The target language\<close>
 
 datatype instr =
   Push int | ADD | THROW | Mark nat | Unmark | Label nat | Jump nat
 
 datatype item = VAL int | HAN nat
 
 type_synonym code = "instr list"
 type_synonym stack = "item list"
 
 fun jump where
   "jump l [] = []"
 | "jump l (Label l' # cs) = (if l = l' then cs else jump l cs)"
 | "jump l (c # cs) = jump l cs"
 
 lemma size_jump1: "size (jump l cs) < Suc (size cs)"
 apply(induct cs)
  apply simp
 apply(case_tac a)
 apply auto
 done
 
 lemma size_jump2: "size (jump l cs) < size cs \<or> jump l cs = cs"
 apply(induct cs)
  apply simp
 apply(case_tac a)
 apply auto
-done
+  done
+
+lemma jump_neq [simp]: "jump l cs \<noteq> Jump l # cs"
+  using size_jump1 [of l cs] by auto
 
 function (sequential) exec2 :: "bool \<Rightarrow> code \<Rightarrow> stack \<Rightarrow> stack" where
   "exec2 True [] s = s"
 | "exec2 True (Push i#cs) s = exec2 True cs (VAL i # s)"
 | "exec2 True (ADD#cs) (VAL j # VAL i # s) = exec2 True cs (VAL(i+j) # s)"
 | "exec2 True (THROW#cs) s = exec2 False cs s"
 | "exec2 True (Mark l#cs) s = exec2 True cs (HAN l # s)"
 | "exec2 True (Unmark#cs) (v # HAN l # s) = exec2 True cs (v # s)"
 | "exec2 True (Label l#cs) s = exec2 True cs s"
 | "exec2 True (Jump l#cs) s = exec2 True (jump l cs) s"
 
 | "exec2 False cs [] = []"
 | "exec2 False cs (VAL i # s) = exec2 False cs s"
 | "exec2 False cs (HAN l # s) = exec2 True (jump l cs) s"
 by pat_completeness auto
 
-termination by (relation
+termination 
+  apply (relation
   "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(b,cs,s). (cs,s))")
-    (auto simp add: size_jump1 size_jump2)
+  using size_jump2 apply(force simp add: size_jump1)+
+  done
 
 abbreviation "exec \<equiv> exec2 True"
 abbreviation "unwind \<equiv> exec2 False"
 
 subsection\<open>The compiler\<close>
 
 primrec compile :: "nat \<Rightarrow> expr \<Rightarrow> code * nat"
 where
   "compile l (Val i) = ([Push i], l)"
 | "compile l (Add x y) = (let (xs,m) = compile l x; (ys,n) = compile m y
                        in (xs @ ys @ [ADD], n))"
 | "compile l Throw = ([THROW],l)"
 | "compile l (Catch x h) =
     (let (xs,m) = compile (l+2) x; (hs,n) = compile m h
      in (Mark l # xs @ [Unmark, Jump (l+1), Label l] @ hs @ [Label(l+1)], n))"
 
 abbreviation
   cmp :: "nat \<Rightarrow> expr \<Rightarrow> code" where
   "cmp l e == fst(compile l e)"
 
 primrec isFresh :: "nat \<Rightarrow> stack \<Rightarrow> bool"
 where
   "isFresh l [] = True"
 | "isFresh l (it#s) = (case it of VAL i \<Rightarrow> isFresh l s
                        | HAN l' \<Rightarrow> l' < l \<and> isFresh l s)"
 
 definition
   conv :: "code \<Rightarrow> stack \<Rightarrow> int option \<Rightarrow> stack" where
   "conv cs s io = (case io of None \<Rightarrow> unwind cs s
                   | Some i \<Rightarrow> exec cs (VAL i # s))"
 
 subsection\<open>The proofs\<close>
 
 text\<open>Lemma numbers are the same as in the paper.\<close>
 
 declare
   conv_def[simp] option.splits[split] Let_def[simp]
 
 lemma 3:
   "(\<And>l. c = Label l \<Longrightarrow> isFresh l s) \<Longrightarrow> unwind (c#cs) s = unwind cs s"
 apply(induct s)
  apply simp
 apply(auto)
 apply(case_tac a)
 apply auto
 apply(case_tac c)
 apply auto
 done
 
 corollary [simp]:
   "(!!l. c \<noteq> Label l) \<Longrightarrow> unwind (c#cs) s = unwind cs s"
 by(blast intro: 3)
 
 corollary [simp]:
   "isFresh l s \<Longrightarrow> unwind (Label l#cs) s = unwind cs s"
 by(blast intro: 3)
 
 
 lemma 5: "\<lbrakk> isFresh l s; l \<le> m \<rbrakk> \<Longrightarrow> isFresh m s"
 apply(induct s)
  apply simp
 apply(auto split:item.split)
 done
 
 corollary [simp]: "isFresh l s \<Longrightarrow> isFresh (Suc l) s"
 by(auto intro:5)
 
 
 lemma 6: "\<And>l. l \<le> snd(compile l e)"
 proof(induct e)
   case Val thus ?case by simp
 next
   case (Add x y)
   from \<open>l \<le> snd (compile l x)\<close>
    and \<open>snd (compile l x) \<le> snd (compile (snd (compile l x)) y)\<close>
   show ?case by(simp_all add:split_def)
 next
   case Throw thus ?case by simp
 next
   case (Catch x h)
   from \<open>l+2 \<le> snd (compile (l+2) x)\<close>
    and \<open>snd (compile (l+2) x) \<le> snd (compile (snd (compile (l+2) x)) h)\<close>
   show ?case by(simp_all add:split_def)
 qed
 
 corollary [simp]: "l < m \<Longrightarrow> l < snd(compile m e)"
 using 6[where l = m and e = e] by auto
 
 corollary [simp]: "isFresh l s \<Longrightarrow> isFresh (snd(compile l e)) s"
 using 5 6 by blast
 
 
 text\<open>Contrary to what the paper says, the proof of lemma 4 does not
 just need lemma 3 but also the above corollary of 5 and 6. Hence the
 strange order of the lemmas in our proof.\<close>
 
 lemma 4 [simp]: "\<And>l cs. isFresh l s \<Longrightarrow> unwind (cmp l e @ cs) s = unwind cs s"
 by (induct e) (auto simp add:split_def)
 
 
 lemma 7 [simp]: "l < m \<Longrightarrow> jump l (cmp m e @ cs) = jump l cs"
 by (induct e arbitrary: m cs) (simp_all add:split_def)
 
 text\<open>The compiler correctness theorem:\<close>
 
 theorem comp_corr:
   "\<And>l s cs. isFresh l s \<Longrightarrow> exec (cmp l e @ cs) s = conv cs s (eval e)"
 by(induct e)(auto simp add:split_def)
 
 text\<open>The specialized and more readable version (omitted in the paper):\<close>
 
 corollary "exec (cmp l e) [] = (case eval e of None \<Rightarrow> [] | Some n \<Rightarrow> [VAL n])"
 by (simp add: comp_corr[where cs = "[]", simplified])
 
 end
diff --git a/thys/Diophantine_Eqns_Lin_Hom/List_Vector.thy b/thys/Diophantine_Eqns_Lin_Hom/List_Vector.thy
--- a/thys/Diophantine_Eqns_Lin_Hom/List_Vector.thy
+++ b/thys/Diophantine_Eqns_Lin_Hom/List_Vector.thy
@@ -1,687 +1,662 @@
 (*
 Author:  Florian Messner <florian.g.messner@uibk.ac.at>
 Author:  Julian Parsert <julian.parsert@gmail.com>
 Author:  Jonas Schöpf <jonas.schoepf@uibk.ac.at>
 Author:  Christian Sternagel <c.sternagel@gmail.com>
 License: LGPL
 *)
 
 section \<open>Vectors as Lists of Naturals\<close>
 
 theory List_Vector
   imports Main
 begin
 
 (*TODO: move*)
 lemma lex_lengthD: "(x, y) \<in> lex P \<Longrightarrow> length x = length y"
   by (auto simp: lexord_lex)
 
 (*TODO: move*)
-lemma lexI:
-  assumes "length ys = length xs" and "i < length xs"
-    and "take i xs = take i ys" and "(xs ! i, ys ! i) \<in> r"
-  shows "(xs, ys) \<in> lex r"
-proof -
-  have "xs = take i xs @ xs ! i # drop (Suc i) xs"
-    and "ys = take i ys @ ys ! i # drop (Suc i) ys"
-    using assms by (metis id_take_nth_drop)+
-  then show ?thesis
-    using assms by (auto simp: lex_def lexn_conv)
-qed
-
-(*TODO: move*)
 lemma lex_take_index:
   assumes "(xs, ys) \<in> lex r"
   obtains i where "length ys = length xs"
     and "i < length xs" and "take i xs = take i ys"
     and "(xs ! i, ys ! i) \<in> r"
 proof -
   obtain n us x xs' y ys' where "(xs, ys) \<in> lexn r n" and "length xs = n" and "length ys = n"
     and "xs = us @ x # xs'" and "ys = us @ y # ys'" and "(x, y) \<in> r"
     using assms by (fastforce simp: lex_def lexn_conv)
   then show ?thesis by (intro that [of "length us"]) auto
 qed
 
 (*TODO: move*)
 lemma mods_with_nats:
   assumes "(v::nat) > w"
     and "(v * b) mod a = (w * b) mod a"
   shows "((v - w) * b) mod a = 0"
   by (metis add_diff_cancel_left' assms left_diff_distrib'
       less_imp_le mod_mult_self1_is_0 mult_le_mono1 nat_mod_eq_lemma)
 
 \<comment> \<open>The 0-vector of length \<open>n\<close>.\<close>
 abbreviation zeroes :: "nat \<Rightarrow> nat list"
   where
     "zeroes n \<equiv> replicate n 0"
 
 lemma rep_upd_unit:
   assumes "x = (zeroes n)[i := a]"
   shows "\<forall>j < length x. (j \<noteq> i \<longrightarrow> x ! j = 0) \<and> (j = i \<longrightarrow> x ! j = a)"
   using assms by simp
 
 definition nonzero_iff: "nonzero xs \<longleftrightarrow> (\<exists>x\<in>set xs. x \<noteq> 0)"
 
 lemma nonzero_append [simp]:
   "nonzero (xs @ ys) \<longleftrightarrow> nonzero xs \<or> nonzero ys" by (auto simp: nonzero_iff)
 
 
 subsection \<open>The Inner Product\<close>
 
 definition dotprod :: "nat list \<Rightarrow> nat list \<Rightarrow> nat" (infixl "\<bullet>" 70)
   where
     "xs \<bullet> ys = (\<Sum>i<min (length xs) (length ys). xs ! i * ys ! i)"
 
 lemma dotprod_code [code]:
   "xs \<bullet> ys = sum_list (map (\<lambda>(x, y). x * y) (zip xs ys))"
   by (auto simp: dotprod_def sum_list_sum_nth lessThan_atLeast0)
 
 lemma dotprod_commute:
   assumes "length xs = length ys"
   shows "xs \<bullet> ys = ys \<bullet> xs"
   using assms by (auto simp: dotprod_def mult.commute)
 
 lemma dotprod_Nil [simp]: "[] \<bullet> [] = 0"
   by (simp add: dotprod_def)
 
 lemma dotprod_Cons [simp]:
   "(x # xs) \<bullet> (y # ys) = x * y + xs \<bullet> ys"
   unfolding dotprod_def and length_Cons and min_Suc_Suc and sum.lessThan_Suc_shift by auto
 
 lemma dotprod_1_right [simp]:
   "xs \<bullet> replicate (length xs) 1 = sum_list xs"
   by (induct xs) (simp_all)
 
 lemma dotprod_0_right [simp]:
   "xs \<bullet> zeroes (length xs) = 0"
   by (induct xs) (simp_all)
 
 lemma dotprod_unit [simp]:
   assumes "length a = n"
     and "k < n"
   shows "a \<bullet> (zeroes n)[k := zk] = a ! k * zk"
   using assms by (induct a arbitrary: k n) (auto split: nat.splits)
 
 lemma dotprod_gt0:
   assumes "length x = length y" and "\<exists>i<length y. x ! i > 0 \<and> y ! i > 0"
   shows "x \<bullet> y > 0"
   using assms by (induct x y rule: list_induct2) (fastforce simp: nth_Cons split: nat.splits)+
 
 lemma dotprod_gt0D:
   assumes "length x = length y"
     and "x \<bullet> y > 0"
   shows "\<exists>i<length y. x ! i > 0 \<and> y ! i > 0"
   using assms by (induct x y rule: list_induct2) (auto simp: Ex_less_Suc2)
 
 lemma dotprod_gt0_iff [iff]:
   assumes "length x = length y"
   shows "x \<bullet> y > 0 \<longleftrightarrow> (\<exists>i<length y. x ! i > 0 \<and> y ! i > 0)"
   using assms and dotprod_gt0D and dotprod_gt0 by blast
 
 lemma dotprod_append:
   assumes "length a = length b"
   shows"(a @ x) \<bullet> (b @ y) = a \<bullet> b + x \<bullet> y"
   using assms by (induct a b rule: list_induct2) auto
 
 lemma dotprod_le_take:
   assumes "length a = length b"
     and "k \<le> length a"
   shows"take k a \<bullet> take k b \<le> a \<bullet> b"
   using assms and append_take_drop_id [of k a] and append_take_drop_id [of k b]
   by (metis add_right_cancel leI length_append length_drop not_add_less1 dotprod_append)
 
 lemma dotprod_le_drop:
   assumes "length a = length b"
     and "k \<le> length a"
   shows "drop k a \<bullet> drop k b \<le> a \<bullet> b"
   using assms and append_take_drop_id [of k a] and append_take_drop_id [of k b]
   by (metis dotprod_append length_take order_refl trans_le_add2)
 
 lemma dotprod_is_0 [simp]:
   assumes "length x = length y"
   shows "x \<bullet> y = 0 \<longleftrightarrow> (\<forall>i<length y. x ! i = 0 \<or> y ! i = 0)"
   using assms by (metis dotprod_gt0_iff neq0_conv)
 
 lemma dotprod_eq_0_iff:
   assumes "length x = length a"
     and "0 \<notin> set a"
   shows "x \<bullet> a = 0 \<longleftrightarrow> (\<forall>e \<in> set x. e = 0)"
   using assms by (fastforce simp: in_set_conv_nth)
 
 lemma dotprod_eq_nonzero_iff:
   assumes "a \<bullet> x = b \<bullet> y" and "length x = length a" and "length y = length b"
     and "0 \<notin> set a" and "0 \<notin> set b"
   shows "nonzero x \<longleftrightarrow> nonzero y"
   using assms by (auto simp: nonzero_iff) (metis dotprod_commute dotprod_eq_0_iff neq0_conv)+
 
 lemma eq_0_iff:
   "xs = zeroes n \<longleftrightarrow> length xs = n \<and> (\<forall>x\<in>set xs. x = 0)"
   using in_set_replicate [of _ n 0] and replicate_eqI [of xs n 0] by auto
 
 lemma not_nonzero_iff: "\<not> nonzero x \<longleftrightarrow> x = zeroes (length x)"
   by (auto simp: nonzero_iff replicate_length_same eq_0_iff)
 
 lemma neq_0_iff':
   "xs \<noteq> zeroes n \<longleftrightarrow> length xs \<noteq> n \<or> (\<exists>x\<in>set xs. x > 0)"
   by (auto simp: eq_0_iff)
 
 lemma dotprod_pointwise_le:
   assumes "length as = length xs"
     and "i < length as"
   shows "as ! i * xs ! i \<le> as \<bullet> xs"
 proof -
   have "as \<bullet> xs = (\<Sum>i<min (length as) (length xs). as ! i * xs ! i)"
     by (simp add: dotprod_def)
   then show ?thesis
     using assms by (auto intro: member_le_sum)
 qed
 
 lemma replicate_dotprod:
   assumes "length y = n"
   shows "replicate n x \<bullet> y = x * sum_list y"
 proof -
   have "x * (\<Sum>i<length y.  y ! i) = (\<Sum>i<length y. x * y ! i)"
     using sum_distrib_left by blast
   then show ?thesis
     using assms by (auto simp: dotprod_def sum_list_sum_nth atLeast0LessThan)
 qed
 
 
 subsection \<open>The Pointwise Order on Vectors\<close>
 
 definition  less_eq :: "nat list \<Rightarrow> nat list \<Rightarrow> bool" ("_/ \<le>\<^sub>v _" [51, 51] 50)
   where
     "xs \<le>\<^sub>v ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>i<length xs. xs ! i \<le> ys ! i)"
 
 definition less :: "nat list \<Rightarrow> nat list \<Rightarrow> bool" ("_/ <\<^sub>v _" [51, 51] 50)
   where
     "xs <\<^sub>v ys \<longleftrightarrow> xs \<le>\<^sub>v ys \<and> \<not> ys \<le>\<^sub>v xs"
 
 interpretation order_vec: order less_eq less
   by (standard, auto simp add: less_def less_eq_def dual_order.antisym nth_equalityI) (force)
 
 lemma less_eqI [intro?]: "length xs = length ys \<Longrightarrow> \<forall>i<length xs. xs ! i \<le> ys ! i \<Longrightarrow> xs \<le>\<^sub>v ys"
   by (auto simp: less_eq_def)
 
 lemma le0 [simp, intro]: "zeroes (length xs) \<le>\<^sub>v xs" by (simp add: less_eq_def)
 
 lemma le_list_update [simp]:
   assumes "xs \<le>\<^sub>v ys" and "i < length ys" and "z \<le> ys ! i"
   shows "xs[i := z] \<le>\<^sub>v ys"
   using assms by (auto simp: less_eq_def nth_list_update)
 
 lemma le_Cons: "x # xs \<le>\<^sub>v y # ys \<longleftrightarrow> x \<le> y \<and> xs \<le>\<^sub>v ys"
   by (auto simp add: less_eq_def nth_Cons split: nat.splits)
 
 lemma zero_less:
   assumes "nonzero x"
   shows "zeroes (length x) <\<^sub>v x"
   using assms and eq_0_iff order_vec.dual_order.strict_iff_order
   by (auto simp: nonzero_iff)
 
 lemma le_append:
   assumes "length xs = length vs"
   shows "xs @ ys \<le>\<^sub>v vs @ ws \<longleftrightarrow> xs \<le>\<^sub>v vs \<and> ys \<le>\<^sub>v ws"
   using assms
   by (auto simp: less_eq_def nth_append)
     (metis add.commute add_diff_cancel_left' nat_add_left_cancel_less not_add_less2)
 
 lemma less_Cons:
   "(x # xs) <\<^sub>v (y # ys) \<longleftrightarrow> length xs = length ys \<and> (x \<le> y \<and> xs <\<^sub>v ys \<or> x < y \<and> xs \<le>\<^sub>v ys)"
   by (simp add: less_def less_eq_def All_less_Suc2) (auto dest: leD)
 
 lemma le_length [dest]:
   assumes "xs \<le>\<^sub>v ys"
   shows "length xs = length ys"
   using assms by (simp add: less_eq_def)
 
 lemma less_length [dest]:
   assumes "x <\<^sub>v y"
   shows "length x = length y"
   using assms by (auto simp: less_def)
 
 lemma less_append:
   assumes "xs <\<^sub>v vs " and "ys \<le>\<^sub>v ws"
   shows "xs @ ys <\<^sub>v vs @ ws"
 proof -
   have "length xs  = length vs"
     using assms by blast
   then show ?thesis
     using assms by (induct xs vs rule: list_induct2) (auto simp: less_Cons le_append le_length)
 qed
 
 lemma less_appendD:
   assumes "xs @ ys <\<^sub>v vs @ ws"
     and "length xs = length vs"
   shows "xs <\<^sub>v vs \<or> ys <\<^sub>v ws"
   by (auto) (metis (no_types, lifting) assms le_append order_vec.order.strict_iff_order)
 
 lemma less_append_cases:
   assumes "xs @ ys <\<^sub>v vs @ ws" and "length xs = length vs"
   obtains "xs <\<^sub>v vs" and "ys \<le>\<^sub>v ws" | "xs \<le>\<^sub>v vs" and "ys <\<^sub>v ws"
   using assms and that
   by (metis le_append less_appendD order_vec.order.strict_implies_order)
 
 lemma less_append_swap:
   assumes "x @ y <\<^sub>v u @ v"
     and "length x = length u"
   shows "y @ x <\<^sub>v v @ u"
   using assms(2, 1)
   by (induct x u rule: list_induct2)
     (auto simp: order_vec.order.strict_iff_order le_Cons le_append le_length)
 
 lemma le_sum_list_less:
   assumes "xs \<le>\<^sub>v ys"
     and "sum_list xs < sum_list ys"
   shows "xs <\<^sub>v ys"
 proof -
   have "length xs = length ys" and "\<forall>i<length ys. xs ! i \<le> ys ! i"
     using assms by (auto simp: less_eq_def)
   then show ?thesis
     using \<open>sum_list xs < sum_list ys\<close>
     by (induct xs ys rule: list_induct2)
       (auto simp: less_Cons All_less_Suc2 less_eq_def)
 qed
 
 lemma dotprod_le_right:
   assumes "v \<le>\<^sub>v w"
     and "length b = length w"
   shows "b \<bullet> v \<le> b \<bullet> w"
   using assms by (auto simp: dotprod_def less_eq_def intro: sum_mono)
 
 lemma dotprod_pointwise_le_right:
   assumes "length z = length u"
     and "length u = length v"
     and "\<forall>i<length v. u ! i \<le> v ! i"
   shows "z \<bullet> u \<le> z \<bullet> v"
   using assms by (intro dotprod_le_right) (auto intro: less_eqI)
 
 lemma dotprod_le_left:
   assumes "v \<le>\<^sub>v w"
     and "length b = length w"
   shows "v \<bullet> b \<le> w \<bullet> b "
   using assms by (simp add: dotprod_le_right dotprod_commute le_length)
 
 lemma dotprod_le:
   assumes "x \<le>\<^sub>v u" and "y \<le>\<^sub>v v"
     and "length y = length x" and "length v = length u"
   shows "x \<bullet> y \<le> u \<bullet> v"
   using assms by (metis dotprod_le_left dotprod_le_right le_length le_trans)
 
 lemma dotprod_less_left:
   assumes "length b = length w"
     and "0 \<notin> set b"
     and "v <\<^sub>v w"
   shows "v \<bullet> b < w \<bullet> b"
 proof -
   have "length v = length w" using assms
     using less_eq_def order_vec.order.strict_implies_order by blast
   then show ?thesis
     using assms
   proof (induct v w arbitrary: b rule: list_induct2)
     case (Cons x xs y ys)
     then show ?case
       by (cases b) (auto simp: less_Cons add_mono_thms_linordered_field dotprod_le_left)
   qed simp
 qed
 
 lemma le_append_swap:
   assumes "length y = length v"
     and "x @ y \<le>\<^sub>v w @ v"
   shows "y @ x \<le>\<^sub>v v @ w"
 proof -
   have "length w = length x" using assms by auto
   with assms show ?thesis
     by (induct y v arbitrary: x w rule: list_induct2) (auto simp: le_Cons le_append)
 qed
 
 lemma le_append_swap_iff:
   assumes "length y = length v"
   shows "y @ x \<le>\<^sub>v v @ w  \<longleftrightarrow> x @ y \<le>\<^sub>v w @ v"
   using assms and le_append_swap
   by (auto) (metis (no_types, lifting) add_left_imp_eq le_length length_append)
 
 lemma unit_less:
   assumes "i < n"
     and "x <\<^sub>v (zeroes n)[i := b]"
   shows "x ! i < b \<and> (\<forall>j<n. j \<noteq> i \<longrightarrow> x ! j = 0)"
 proof
   show "x ! i < b"
     using assms less_def by fastforce
 next
   have "x \<le>\<^sub>v (zeroes n)[i := b]" by (simp add: assms order_vec.less_imp_le)
   then show "\<forall>j<n. j \<noteq> i \<longrightarrow> x ! j = 0" by (auto simp: less_eq_def)
 qed
 
 lemma le_sum_list_mono:
   assumes "xs \<le>\<^sub>v ys"
   shows "sum_list xs \<le> sum_list ys"
   using assms and sum_list_mono [of "[0..<length ys]" "(!) xs" "(!) ys"]
   by (auto simp: less_eq_def) (metis map_nth)
 
 lemma sum_list_less_diff_Ex:
   assumes "u \<le>\<^sub>v y"
     and "sum_list u < sum_list y"
   shows "\<exists>i<length y. u ! i < y ! i"
 proof -
   have "length u = length y" and "\<forall>i<length y. u ! i \<le> y ! i"
     using \<open>u \<le>\<^sub>v y\<close> by (auto simp: less_eq_def)
   then show ?thesis
     using \<open>sum_list u < sum_list y\<close>
     by (induct u y rule: list_induct2) (force simp: Ex_less_Suc2 All_less_Suc2)+
 qed
 
 lemma less_vec_sum_list_less:
   assumes "v <\<^sub>v w"
   shows "sum_list v < sum_list w"
   using assms
 proof -
   have "length v = length w"
     using assms less_eq_def less_imp_le by blast
   then show ?thesis
     using assms
   proof (induct v w rule: list_induct2)
     case (Cons x xs y ys)
     then show ?case
       using length_replicate less_Cons order_vec.order.strict_iff_order by force
   qed simp
 qed
 
 definition maxne0 :: "nat list \<Rightarrow> nat list \<Rightarrow> nat"
   where
     "maxne0 x a =
       (if length x = length a \<and> (\<exists>i<length a. x ! i \<noteq> 0)
       then Max {a ! i | i. i < length a \<and> x ! i \<noteq> 0}
       else 0)"
 
 lemma maxne0_le_Max:
   "maxne0 x a \<le> Max (set a)"
   by (auto simp: maxne0_def nonzero_iff in_set_conv_nth) simp
 
 lemma maxne0_Nil [simp]:
   "maxne0 [] as = 0"
   "maxne0 xs [] = 0"
   by (auto simp: maxne0_def)
 
 lemma maxne0_Cons [simp]:
   "maxne0 (x # xs) (a # as) =
     (if length xs = length as then
       (if x = 0 then maxne0 xs as else max a (maxne0 xs as))
     else 0)"
 proof -
   let ?a = "a # as" and ?x = "x # xs"
   have eq: "{?a ! i | i. i < length ?a \<and> ?x ! i \<noteq> 0} =
     (if x > 0 then {a} else {}) \<union> {as ! i | i. i < length as \<and> xs ! i \<noteq> 0}"
     by (auto simp: nth_Cons split: nat.splits) (metis Suc_pred)+
   show ?thesis
     unfolding maxne0_def and eq
     by (auto simp: less_Suc_eq_0_disj nth_Cons' intro: Max_insert2)
 qed
 
 lemma maxne0_times_sum_list_gt_dotprod:
   assumes "length b = length ys"
   shows "maxne0 ys b * sum_list ys \<ge> b \<bullet> ys"
   using assms
   apply (induct b ys rule: list_induct2)
    apply (auto  simp: max_def ring_distribs add_mono_thms_linordered_semiring(1))
   by (meson leI le_trans mult_less_cancel2 nat_less_le)
 
 lemma max_times_sum_list_gt_dotprod:
   assumes "length b = length ys"
   shows "Max (set b) * sum_list ys \<ge> b \<bullet> ys"
 proof -
   have "\<forall> e \<in> set b . Max (set b) \<ge> e" by simp
   then have "replicate (length ys) (Max (set b)) \<bullet> ys \<ge> b \<bullet> ys" (is "?rep \<ge> _")
     by (metis assms dotprod_pointwise_le_right dotprod_commute
         length_replicate nth_mem nth_replicate)
   moreover have "Max (set b) * sum_list ys = ?rep"
     using replicate_dotprod [of ys _ "Max (set b)"] by auto
   ultimately show ?thesis
     by (simp add: assms)
 qed
 
 lemma maxne0_mono:
   assumes "y \<le>\<^sub>v x"
   shows "maxne0 y a \<le> maxne0 x a"
 proof (cases "length y = length a")
   case True
   have "length y = length x" using assms by (auto)
   then show ?thesis
     using assms and True
   proof (induct y x arbitrary: a rule: list_induct2)
     case (Cons x xs y ys)
     then show ?case by (cases a) (force simp: less_eq_def All_less_Suc2 le_max_iff_disj)+
   qed simp
 next
   case False
   then show ?thesis
     using assms by (auto simp: maxne0_def)
 qed
 
 lemma all_leq_Max:
   assumes "x \<le>\<^sub>v y"
     and "x \<noteq> []"
   shows "\<forall>xi \<in> set x. xi \<le> Max (set y)"
   by (metis (no_types, lifting) List.finite_set Max_ge_iff
       assms in_set_conv_nth length_0_conv less_eq_def set_empty)
 
 lemma le_not_less_replicate:
   "\<forall>x\<in>set xs. x \<le> b \<Longrightarrow> \<not> xs <\<^sub>v replicate (length xs) b \<Longrightarrow> xs = replicate (length xs) b"
   by (induct xs) (auto simp: less_Cons)
 
 lemma le_replicateI: "\<forall>x\<in>set xs. x \<le> b \<Longrightarrow> xs \<le>\<^sub>v replicate (length xs) b"
   by (induct xs) (auto simp: le_Cons)
 
 lemma le_take:
   assumes "x \<le>\<^sub>v y" and "i \<le> length x" shows "take i x \<le>\<^sub>v take i y"
   using assms by (auto simp: less_eq_def)
 
 lemma wf_less:
   "wf {(x, y). x <\<^sub>v y}"
 proof -
   have "wf (measure sum_list)" ..
   moreover have "{(x, y). x <\<^sub>v y} \<subseteq> measure sum_list"
     by (auto simp: less_vec_sum_list_less)
   ultimately show "wf {(x, y). x <\<^sub>v y}"
     by (rule wf_subset)
 qed
 
 
 subsection \<open>Pointwise Subtraction\<close>
 
 definition vdiff :: "nat list \<Rightarrow> nat list \<Rightarrow> nat list" (infixl "-\<^sub>v" 65)
   where
     "w -\<^sub>v v = map (\<lambda>i. w ! i - v ! i) [0 ..< length w]"
 
 lemma vdiff_Nil [simp]: "[] -\<^sub>v [] = []" by (simp add: vdiff_def)
 
 lemma upt_Cons_conv:
   assumes "j < n"
   shows "[j..<n] = j # [j+1..<n]"
   by (simp add: assms upt_eq_Cons_conv)
 
 lemma map_upt_Suc: "map f [Suc m ..< Suc n] = map (f \<circ> Suc) [m ..< n]"
   by (fold list.map_comp [of f "Suc" "[m ..< n]"]) (simp add: map_Suc_upt)
 
 lemma vdiff_Cons [simp]:
   "(x # xs) -\<^sub>v (y # ys) = (x - y) # (xs -\<^sub>v ys)"
   by (simp add: vdiff_def upt_Cons_conv [OF zero_less_Suc] map_upt_Suc del: upt_Suc)
 
 lemma vdiff_alt_def:
   assumes "length w = length v"
   shows "w -\<^sub>v v = map (\<lambda>(x, y). x - y) (zip w v)"
   using assms by (induct rule: list_induct2) simp_all
 
 lemma vdiff_dotprod_distr:
   assumes "length b = length w"
     and "v \<le>\<^sub>v w"
   shows "(w -\<^sub>v v) \<bullet> b = w \<bullet> b - v \<bullet> b"
 proof -
   have "length v = length w" and "\<forall>i<length w. v ! i \<le> w ! i"
     using assms less_eq_def by auto
   then show ?thesis
     using \<open>length b = length w\<close>
   proof (induct v w arbitrary: b rule: list_induct2)
     case (Cons x xs y ys)
     then show ?case
       by (cases b) (auto simp: All_less_Suc2 diff_mult_distrib
           dotprod_commute dotprod_pointwise_le_right)
   qed simp
 qed
 
 lemma sum_list_vdiff_distr [simp]:
   assumes "v \<le>\<^sub>v u"
   shows "sum_list (u -\<^sub>v v) = sum_list u - sum_list v"
   by (metis (no_types, lifting) assms diff_zero dotprod_1_right
       length_map length_replicate length_upt
       less_eq_def vdiff_def vdiff_dotprod_distr)
 
 lemma vdiff_le:
   assumes "v \<le>\<^sub>v w"
     and "length v = length x"
   shows "v -\<^sub>v x \<le>\<^sub>v w"
   using assms by (auto simp add: less_eq_def vdiff_def)
 
 lemma mods_with_vec:
   assumes "v <\<^sub>v w"
     and "0 \<notin> set b"
     and "length b = length w"
     and "(v \<bullet> b) mod a = (w \<bullet> b) mod a"
   shows "((w -\<^sub>v v) \<bullet> b) mod a = 0"
 proof -
   have *: "v \<bullet> b < w \<bullet> b"
     using dotprod_less_left and assms by blast
   have "v \<le>\<^sub>v w"
     using assms by auto
   from vdiff_dotprod_distr [OF assms(3) this]
   have "((w -\<^sub>v v) \<bullet> b) mod a = (w \<bullet> b - v \<bullet> b) mod a "
     by simp
   also have "... = 0 mod a"
     using mods_with_nats [of "v \<bullet> b" "w \<bullet> b" "1" a, OF *] assms by auto
   finally show ?thesis by simp
 qed
 
 lemma mods_with_vec_2:
   assumes "v <\<^sub>v w"
     and "0 \<notin> set b"
     and "length b = length w"
     and "(b \<bullet> v) mod a = (b \<bullet> w) mod a"
   shows "(b \<bullet> (w -\<^sub>v v)) mod a = 0"
   by (metis (no_types, lifting) assms diff_zero dotprod_commute
       length_map length_upt less_eq_def order_vec.less_imp_le
       mods_with_vec vdiff_def)
 
 
 subsection \<open>The Lexicographic Order on Vectors\<close>
 
 abbreviation lex_less_than ("_/ <\<^sub>l\<^sub>e\<^sub>x _" [51, 51] 50)
   where
     "xs <\<^sub>l\<^sub>e\<^sub>x ys \<equiv> (xs, ys) \<in> lex less_than"
 
 definition rlex (infix "<\<^sub>r\<^sub>l\<^sub>e\<^sub>x" 50)
   where
     "xs <\<^sub>r\<^sub>l\<^sub>e\<^sub>x ys \<longleftrightarrow> rev xs <\<^sub>l\<^sub>e\<^sub>x rev ys"
 
 lemma rev_le [simp]:
   "rev xs \<le>\<^sub>v rev ys \<longleftrightarrow> xs \<le>\<^sub>v ys"
 proof -
   { fix i assume i: "i < length ys" and [simp]: "length xs = length ys"
       and "\<forall>i < length ys. rev xs ! i \<le> rev ys ! i"
     then have "rev xs ! (length ys - i - 1) \<le> rev ys ! (length ys - i - 1)" by auto
     then have "xs ! i \<le> ys ! i" using i by (auto simp: rev_nth) }
   then show ?thesis by (auto simp: less_eq_def rev_nth)
 qed
 
 lemma rev_less [simp]:
   "rev xs <\<^sub>v rev ys \<longleftrightarrow> xs <\<^sub>v ys"
   by (simp add: less_def)
 
 lemma less_imp_lex:
   assumes "xs <\<^sub>v ys" shows "xs <\<^sub>l\<^sub>e\<^sub>x ys"
 proof -
   have "length ys = length xs" using assms by auto
   then show ?thesis using assms
     by (induct rule: list_induct2) (auto simp: less_Cons)
 qed
 
 lemma less_imp_rlex:
   assumes "xs <\<^sub>v ys" shows "xs <\<^sub>r\<^sub>l\<^sub>e\<^sub>x ys"
   using assms and less_imp_lex [of "rev xs" "rev ys"]
   by (simp add: rlex_def)
 
 lemma lex_not_sym:
   assumes "xs <\<^sub>l\<^sub>e\<^sub>x ys"
   shows "\<not> ys <\<^sub>l\<^sub>e\<^sub>x xs"
 proof
   assume "ys <\<^sub>l\<^sub>e\<^sub>x xs"
   then obtain i where "i < length xs" and "take i xs = take i ys"
     and "ys ! i < xs ! i" by (elim lex_take_index) auto
   moreover obtain j where "j < length xs" and "length ys = length xs" and "take j xs = take j ys"
     and "xs ! j < ys ! j" using assms by (elim lex_take_index) auto
   ultimately show False by (metis le_antisym nat_less_le nat_neq_iff nth_take)
 qed
 
 lemma rlex_not_sym:
   assumes "xs <\<^sub>r\<^sub>l\<^sub>e\<^sub>x ys"
   shows "\<not> ys <\<^sub>r\<^sub>l\<^sub>e\<^sub>x xs"
 proof
   assume ass: "ys <\<^sub>r\<^sub>l\<^sub>e\<^sub>x xs"
   then obtain i where "i < length xs" and "take i xs = take i ys"
     and "ys ! i > xs ! i" using assms lex_not_sym rlex_def by blast
   moreover obtain j where "j < length xs" and "length ys = length xs" and "take j xs = take j ys"
     and "xs ! j > ys ! j" using assms rlex_def ass lex_not_sym by blast
   ultimately show False
     by (metis leD nat_less_le nat_neq_iff nth_take)
 qed
 
 lemma lex_trans:
   assumes "x <\<^sub>l\<^sub>e\<^sub>x y" and "y <\<^sub>l\<^sub>e\<^sub>x z"
   shows "x <\<^sub>l\<^sub>e\<^sub>x z"
-proof -
-  from assms obtain i and j where "length y = length x" and "length z = length x"
-     and "i < length x" and "j < length x"
-     and "take i x = take i y" and "take j y = take j z"
-     and "x ! i < y ! i" and "y ! j < z ! j" by (fastforce elim!: lex_take_index)
-  then show ?thesis
-    apply (intro lexI [where i = "min i j"])
-       apply (auto)
-     apply (metis min.commute take_take)
-    apply (auto simp: min_def)
-     apply (metis dual_order.order_iff_strict dual_order.trans not_le nth_take)
-    by (metis not_less nth_take)
-qed
+  using assms by (auto simp: antisym_def intro: transD [OF lex_transI])
 
 lemma rlex_trans:
   assumes "x <\<^sub>r\<^sub>l\<^sub>e\<^sub>x y" and "y <\<^sub>r\<^sub>l\<^sub>e\<^sub>x z"
   shows "x <\<^sub>r\<^sub>l\<^sub>e\<^sub>x z"
   using assms lex_trans rlex_def by blast
 
 lemma lex_append_rightD:
   assumes "xs @ us <\<^sub>l\<^sub>e\<^sub>x ys @ vs" and "length xs = length ys"
     and "\<not> xs <\<^sub>l\<^sub>e\<^sub>x ys"
   shows "ys = xs \<and> us <\<^sub>l\<^sub>e\<^sub>x vs"
   using assms(2,1,3)
-  by (induct xs ys rule: list_induct2) simp_all
+  by (induct xs ys rule: list_induct2) auto
 
 lemma rlex_Cons:
   "x # xs <\<^sub>r\<^sub>l\<^sub>e\<^sub>x y # ys \<longleftrightarrow> xs <\<^sub>r\<^sub>l\<^sub>e\<^sub>x ys \<or> ys = xs \<and> x < y" (is "?A = ?B")
   by (cases "length ys = length xs")
     (auto simp: rlex_def intro: lex_append_rightI lex_append_leftI dest: lex_append_rightD lex_lengthD)
 
 lemma rlex_irrefl:
   "\<not> x <\<^sub>r\<^sub>l\<^sub>e\<^sub>x x"
   by (induct x) (auto simp: rlex_def dest: lex_append_rightD)
 
 
 subsection \<open>Code Equations\<close>
 
 fun exists2
   where
     "exists2 d P [] [] \<longleftrightarrow> False"
   | "exists2 d P (x#xs) (y#ys) \<longleftrightarrow> P x y \<or> exists2 d P xs ys"
   | "exists2 d P _ _ \<longleftrightarrow> d"
 
 lemma not_le_code [code_unfold]: "\<not> xs \<le>\<^sub>v ys \<longleftrightarrow> exists2 True (>) xs ys"
   by (induct "True" "(>) :: nat \<Rightarrow> nat \<Rightarrow> bool" xs ys rule: exists2.induct) (auto simp: le_Cons)
 
 end
diff --git a/thys/LTL_to_GBA/LTL_to_GBA.thy b/thys/LTL_to_GBA/LTL_to_GBA.thy
--- a/thys/LTL_to_GBA/LTL_to_GBA.thy
+++ b/thys/LTL_to_GBA/LTL_to_GBA.thy
@@ -1,3224 +1,3233 @@
 section \<open>LTL to GBA translation\<close>
 (*
   Author: Alexander Schimpf
     Modified by Peter Lammich
 
 **)
 theory LTL_to_GBA
 imports
   CAVA_Base.CAVA_Base
   LTL.LTL
   CAVA_Automata.Automata
 begin
 
 subsection \<open>Statistics\<close>
 code_printing
   code_module Gerth_Statistics \<rightharpoonup> (SML) \<open>
     structure Gerth_Statistics = struct
       val active = Unsynchronized.ref false
       val data = Unsynchronized.ref (0,0,0)
 
       fun is_active () = !active
       fun set_data num_states num_init num_acc = (
         active := true;
         data := (num_states, num_init, num_acc)
       )
 
       fun to_string () = let
         val (num_states, num_init, num_acc) = !data
       in
           "Num states: " ^ IntInf.toString (num_states) ^ "\n"
         ^ "  Num initial: " ^ IntInf.toString num_init ^ "\n"
         ^ "  Num acc-classes: " ^ IntInf.toString num_acc ^ "\n"
       end
 
       val _ = Statistics.register_stat ("Gerth LTL_to_GBA",is_active,to_string)
     end
 \<close>
 code_reserved SML Gerth_Statistics
 
 consts
   stat_set_data_int :: "integer \<Rightarrow> integer \<Rightarrow> integer \<Rightarrow> unit"
 
 code_printing
   constant stat_set_data_int \<rightharpoonup> (SML) "Gerth'_Statistics.set'_data"
 
 definition "stat_set_data ns ni na
   \<equiv> stat_set_data_int (integer_of_nat ns) (integer_of_nat ni) (integer_of_nat na)"
 
 lemma [autoref_rules]:
   "(stat_set_data,stat_set_data) \<in> nat_rel \<rightarrow> nat_rel \<rightarrow> nat_rel \<rightarrow> unit_rel"
   by auto
 
 abbreviation "stat_set_data_nres ns ni na \<equiv> RETURN (stat_set_data ns ni na)"
 
 lemma discard_stat_refine[refine]:
   "m1\<le>m2 \<Longrightarrow> stat_set_data_nres ns ni na \<then> m1 \<le> m2" by simp_all
 
 
 subsection \<open>Preliminaries\<close>
 
 text \<open>Some very special lemmas for reasoning about the nres-monad\<close>
 
 lemma SPEC_rule_nested2:
   "\<lbrakk>m \<le> SPEC P; \<And>r1 r2. P (r1, r2) \<Longrightarrow> g (r1, r2) \<le> SPEC P\<rbrakk>
   \<Longrightarrow> m \<le> SPEC (\<lambda>r'. g r' \<le> SPEC P)"
   by (simp add: pw_le_iff) blast
 
 lemma SPEC_rule_param2:
   assumes "f x \<le> SPEC (P x)"
       and "\<And>r1 r2. (P x) (r1, r2) \<Longrightarrow> (P x') (r1, r2)"
     shows "f x \<le> SPEC (P x')"
   using assms
   by (simp add: pw_le_iff)
 
 lemma SPEC_rule_weak:
   assumes "f x \<le> SPEC (Q x)" and "f x \<le> SPEC (P x)"
       and "\<And>r1 r2. \<lbrakk>(Q x) (r1, r2); (P x) (r1, r2)\<rbrakk> \<Longrightarrow> (P x') (r1, r2)"
     shows "f x \<le> SPEC (P x')"
   using assms
   by (simp add: pw_le_iff)
 
 lemma SPEC_rule_weak_nested2: "\<lbrakk>f \<le> SPEC Q; f \<le> SPEC P;
   \<And>r1 r2. \<lbrakk>Q (r1, r2); P (r1, r2)\<rbrakk> \<Longrightarrow> g (r1, r2) \<le> SPEC P\<rbrakk>
   \<Longrightarrow> f \<le> SPEC (\<lambda>r'. g r' \<le> SPEC P)"
   by (simp add: pw_le_iff) blast
 
 
 subsection \<open>Creation of States\<close>
 text \<open>
   In this section, the first part of the algorithm, which creates the states of the
   automaton, is formalized.
 \<close>
 
 (* FIXME: Abstraktion über node_name *)
 
 type_synonym node_name = nat
 
 type_synonym 'a frml = "'a ltlr"
 
 type_synonym 'a interprt = "'a set word"
 
 record 'a node =
   name :: node_name
   incoming :: "node_name set"
   new :: "'a frml set"
   old :: "'a frml set"
   "next" :: "'a frml set"
 
 context
 begin
 
 fun new1 where
   "new1 (\<mu> and\<^sub>r \<psi>) = {\<mu>,\<psi>}"
 | "new1 (\<mu> U\<^sub>r \<psi>) = {\<mu>}"
 | "new1 (\<mu> R\<^sub>r \<psi>) = {\<psi>}"
 | "new1 (\<mu> or\<^sub>r \<psi>) = {\<mu>}"
 | "new1 _ = {}"
 
 fun next1 where
   "next1 (X\<^sub>r \<psi>) = {\<psi>}"
 | "next1 (\<mu> U\<^sub>r \<psi>) = {\<mu> U\<^sub>r \<psi>}"
 | "next1 (\<mu> R\<^sub>r \<psi>) = {\<mu> R\<^sub>r \<psi>}"
 | "next1 _ = {}"
 
 fun new2 where
   "new2 (\<mu> U\<^sub>r \<psi>) = {\<psi>}"
 | "new2 (\<mu> R\<^sub>r \<psi>) = {\<mu>, \<psi>}"
 | "new2 (\<mu> or\<^sub>r \<psi>) = {\<psi>}"
 | "new2 _ = {}"
 
 
 (* FIXME: Abstraction over concrete definition *)
 
 definition "expand_init \<equiv> 0"
 definition "expand_new_name \<equiv> Suc"
 
 lemma expand_new_name_expand_init: "expand_init < expand_new_name nm"
   by (auto simp add:expand_init_def expand_new_name_def)
 
 lemma expand_new_name_step[intro]:
   fixes n :: "'a node"
   shows "name n < expand_new_name (name n)"
   by (auto simp add:expand_new_name_def)
 
 lemma expand_new_name__less_zero[intro]: "0 < expand_new_name nm"
 proof -
   from expand_new_name_expand_init have "expand_init < expand_new_name nm"
     by auto
   then show ?thesis
     by (metis gr0I less_zeroE)
 qed
 
 abbreviation
   "upd_incoming_f n \<equiv> (\<lambda>n'.
     if (old n' = old n \<and> next n' = next n) then
       n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr>
     else n'
   )"
 
 definition
  "upd_incoming n ns \<equiv> ((upd_incoming_f n) ` ns)"
 
 lemma upd_incoming__elem:
   assumes "nd\<in>upd_incoming n ns"
   shows "nd\<in>ns
          \<or> (\<exists>nd'\<in>ns. nd = nd'\<lparr> incoming := incoming n \<union> incoming nd' \<rparr> \<and>
                             old nd' = old n \<and>
                             next nd' = next n)"
 proof -
   obtain nd' where "nd'\<in>ns" and nd_eq: "nd = upd_incoming_f n nd'"
     using assms unfolding upd_incoming_def by blast
   then show ?thesis by auto
 qed
 
 lemma upd_incoming__ident_node:
   assumes "nd\<in>upd_incoming n ns" and "nd\<in>ns"
     shows "incoming n \<subseteq> incoming nd \<or> \<not> (old nd = old n \<and> next nd = next n)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have nsubset: "\<not> (incoming n \<subseteq> incoming nd)" and
     old_next_eq: "old nd = old n \<and> next nd = next n"
     by auto
   moreover
   obtain nd' where "nd'\<in>ns" and nd_eq: "nd = upd_incoming_f n nd'"
     using assms unfolding upd_incoming_def by blast
   { assume "old nd' = old n \<and> next nd' = next n"
     with nd_eq have "nd = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>" by auto
     with nsubset have "False" by auto }
   moreover
   { assume "\<not> (old nd' = old n \<and> next nd' = next n)"
     with nd_eq old_next_eq have "False" by auto }
   ultimately show "False" by fast
 qed
 
 lemma upd_incoming__ident:
   assumes "\<forall>n\<in>ns. P n"
       and "\<And>n. \<lbrakk>n\<in>ns; P n\<rbrakk> \<Longrightarrow> (\<And>v. P (n\<lparr> incoming := v \<rparr>))"
     shows "\<forall>n\<in>upd_incoming n ns. P n"
 proof
   fix nd v
   let ?f = "\<lambda>n'.
     if (old n' = old n \<and> next n' = next n) then
       n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr>
     else n'"
   assume "nd\<in>upd_incoming n ns"
   then obtain nd' where "nd'\<in>ns" and nd_eq: "nd = ?f nd'"
     unfolding upd_incoming_def by blast
   { assume "old nd' = old n \<and> next nd' = next n"
     then obtain v where "nd = nd'\<lparr> incoming := v \<rparr>" using nd_eq by auto
     with assms \<open>nd'\<in>ns\<close> have "P nd" by auto }
   then show "P nd" using nd_eq \<open>nd'\<in>ns\<close> assms by auto
 qed
 
 
 lemma name_upd_incoming_f[simp]: "name (upd_incoming_f n x) = name x"
   by auto
 
 
 lemma name_upd_incoming[simp]:
   "name ` (upd_incoming n ns) = name ` ns" (is "?lhs = ?rhs")
   unfolding upd_incoming_def
 proof safe
   fix x
   assume "x\<in>ns"
   then have "upd_incoming_f n x \<in> (\<lambda>n'. local.upd_incoming_f n n') ` ns" by auto
   then have "name (upd_incoming_f n x) \<in> name ` (\<lambda>n'. local.upd_incoming_f n n') ` ns"
     by blast
   then show "name x \<in> name ` (\<lambda>n'. local.upd_incoming_f n n') ` ns" by simp
 qed auto
 
 
 abbreviation expand_body
 where
   "expand_body \<equiv> (\<lambda>expand (n,ns).
       if new n = {} then (
         if (\<exists>n'\<in>ns. old n' = old n \<and> next n' = next n) then
           RETURN (name n, upd_incoming n ns)
         else
           expand (
             \<lparr>
               name=expand_new_name (name n),
               incoming={name n},
               new=next n,
               old={},
               next={}
             \<rparr>,
             {n} \<union> ns)
       ) else do {
         \<phi> \<leftarrow> SPEC (\<lambda>x. x\<in>(new n));
         let n = n\<lparr> new := new n - {\<phi>} \<rparr>;
         if (\<exists>q. \<phi> = prop\<^sub>r(q) \<or> \<phi> = nprop\<^sub>r(q)) then
           (if (not\<^sub>r \<phi>) \<in> old n then RETURN (name n, ns)
            else expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns))
         else if \<phi> = true\<^sub>r then expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns)
         else if \<phi> = false\<^sub>r then RETURN (name n, ns)
         else if (\<exists>\<nu> \<mu>. (\<phi> = \<nu> and\<^sub>r \<mu>) \<or> (\<phi> = X\<^sub>r \<nu>)) then
           expand (
             n\<lparr>
               new := new1 \<phi> \<union> new n,
               old := {\<phi>} \<union> old n,
               next := next1 \<phi> \<union> next n
             \<rparr>,
             ns)
         else do {
           (nm, nds) \<leftarrow> expand (
             n\<lparr>
               new := new1 \<phi> \<union> new n,
               old := {\<phi>} \<union> old n,
               next := next1 \<phi> \<union> next n
             \<rparr>,
             ns);
           expand (n\<lparr> name := nm, new := new2 \<phi> \<union> new n, old := {\<phi>} \<union> old n \<rparr>, nds)
         }
       }
      )"
 
 lemma expand_body_mono: "trimono expand_body" by refine_mono
 
 definition expand :: "('a node \<times> ('a node set)) \<Rightarrow> (node_name \<times> 'a node set) nres"
   where "expand \<equiv> REC expand_body"
 
 lemma REC_rule_old: (* TODO: Adapt proofs below, have fun with subgoal 27 ...*)
   fixes x::"'x"
   assumes M: "trimono body"
   assumes I0: "\<Phi> x"
   assumes IS: "\<And>f x. \<lbrakk> \<And>x. \<Phi> x \<Longrightarrow> f x \<le> M x; \<Phi> x; f \<le> REC body \<rbrakk>
     \<Longrightarrow> body f x \<le> M x"
   shows "REC body x \<le> M x"
   by (rule REC_rule_arb[where pre="\<lambda>_. \<Phi>" and M="\<lambda>_. M", OF assms])
 
 lemma expand_rec_rule:
   assumes I0: "\<Phi> x"
   assumes IS: "\<And>f x. \<lbrakk> \<And>x. f x \<le> expand x; \<And>x. \<Phi> x \<Longrightarrow> f x \<le> M x; \<Phi> x \<rbrakk>
     \<Longrightarrow> expand_body f x \<le> M x"
   shows "expand x \<le> M x"
   unfolding expand_def
   apply (rule REC_rule_old[where \<Phi>="\<Phi>"])
   apply (rule expand_body_mono)
   apply (rule I0)
   apply (rule IS[unfolded expand_def])
   apply (blast dest: le_funD)
   apply blast
   apply blast
   done
 
 abbreviation
   "expand_assm_incoming n_ns
    \<equiv> (\<forall>nm\<in>incoming (fst n_ns). name (fst n_ns) > nm)
     \<and> 0 < name (fst n_ns)
     \<and> (\<forall>q\<in>snd n_ns.
         name (fst n_ns) > name q
       \<and> (\<forall>nm\<in>incoming q. name (fst n_ns) > nm))"
 
 abbreviation
   "expand_rslt_incoming nm_nds
    \<equiv> (\<forall>q\<in>snd nm_nds. (fst nm_nds > name q \<and> (\<forall>nm'\<in>incoming q. fst nm_nds > nm')))"
 
 abbreviation
   "expand_rslt_name n_ns nm_nds
    \<equiv> (name (fst n_ns) \<le> fst nm_nds \<and> name ` (snd n_ns) \<subseteq> name ` (snd nm_nds))
      \<and> name ` (snd nm_nds)
        = name ` (snd n_ns) \<union> name ` {nd\<in>snd nm_nds. name nd \<ge> name (fst n_ns)}"
 
 abbreviation
   "expand_name_ident nds
    \<equiv> (\<forall>q\<in>nds. \<exists>!q'\<in>nds. name q = name q')"
 
 abbreviation
   "expand_assm_exist \<xi> n_ns
    \<equiv> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old (fst n_ns) \<and> \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> new (fst n_ns) \<union> old (fst n_ns)
          \<and> (\<forall>\<psi>\<in>new (fst n_ns). \<xi> \<Turnstile>\<^sub>r \<psi>)
          \<and> (\<forall>\<psi>\<in>old (fst n_ns). \<xi> \<Turnstile>\<^sub>r \<psi>)
          \<and> (\<forall>\<psi>\<in>next (fst n_ns). \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)"
 
 abbreviation
   "expand_rslt_exist__node_prop \<xi> n nd
    \<equiv> incoming n \<subseteq> incoming nd
       \<and> (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
       \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old nd \<and> \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> old nd"
 
 abbreviation
   "expand_rslt_exist \<xi> n_ns nm_nds
   \<equiv> (\<exists>nd\<in>snd nm_nds. expand_rslt_exist__node_prop \<xi> (fst n_ns) nd)"
 
 abbreviation
   "expand_rslt_exist_eq__node n nd
    \<equiv> name n = name nd
     \<and> old n = old nd
     \<and> next n = next nd
     \<and> incoming n \<subseteq> incoming nd"
 
 abbreviation
   "expand_rslt_exist_eq n_ns nm_nds \<equiv>
     (\<forall>n\<in>snd n_ns. \<exists>nd\<in>snd nm_nds. expand_rslt_exist_eq__node n nd)"
 
 lemma expand_name_propag:
   assumes "expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
     shows "expand n_ns \<le> SPEC (\<lambda>r. expand_rslt_incoming r
                                     \<and> expand_rslt_name n_ns r
                                     \<and> expand_name_ident (snd r))"
       (is "expand _ \<le> SPEC (?P n_ns)")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case prems: (1 _ _ n ns)
   then have Q: "?Q (n, ns)" by fast
   let ?nds = "upd_incoming n ns"
 
   from prems have "\<forall>q\<in>?nds. name q < name n"
     by (rule_tac upd_incoming__ident) auto
   moreover
   have "\<forall>q\<in>?nds. \<forall>nm'\<in>incoming q. nm' < name n" (is "\<forall>q\<in>_. ?sg q")
   proof
     fix q
     assume q_in:"q\<in>?nds"
     show "?sg q"
     proof (cases "q\<in>ns")
       case True
       with prems show ?thesis by auto
     next
       case False
       with upd_incoming__elem[OF q_in]
       obtain nd' where
         nd'_def:"nd'\<in>ns \<and> q = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>"
       by blast
 
       { fix nm'
         assume "nm'\<in>incoming q"
         moreover
         { assume "nm'\<in>incoming n"
           with Q have "nm' < name n" by auto }
         moreover
         { assume "nm'\<in>incoming nd'"
           with Q nd'_def have "nm' < name n" by auto }
         ultimately have "nm' < name n" using nd'_def by auto }
 
       then show ?thesis by fast
     qed
   qed
   moreover
   have "expand_name_ident ?nds"
   proof (rule upd_incoming__ident, goal_cases)
     case 1
     show ?case
     proof
       fix q
       assume "q\<in>ns"
 
       with Q have "\<exists>!q'\<in>ns. name q = name q'" by auto
       then obtain q' where "q'\<in>ns" and "name q = name q'"
                        and q'_all: "\<forall>q''\<in>ns. name q' = name q'' \<longrightarrow> q' = q''"
         by auto
       let ?q' = "upd_incoming_f n q'"
       have P_a: "?q'\<in>?nds \<and> name q = name ?q'"
         using \<open>q'\<in>ns\<close> \<open>name q = name q'\<close> q'_all
         unfolding upd_incoming_def by auto
 
       have P_all: "\<forall>q''\<in>?nds. name ?q' = name q'' \<longrightarrow> ?q' = q''"
       proof(clarify)
         fix q''
         assume "q''\<in>?nds" and q''_name_eq: "name ?q' = name q''"
         { assume "q''\<notin>ns"
           with upd_incoming__elem[OF \<open>q''\<in>?nds\<close>]
           obtain nd'' where
             "nd''\<in>ns"
             and q''_is: "q'' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>
                           \<and> old nd'' = old n \<and> next nd'' = next n"
             by auto
           then have "name nd'' = name q'"
             using q''_name_eq
             by (cases "old q' = old n \<and> next q' = next n") auto
           with \<open>nd''\<in>ns\<close> q'_all have "nd'' = q'" by auto
           then have "?q' = q''" using q''_is by simp }
         moreover
         { assume "q''\<in>ns"
           moreover
           have "name q' = name q''"
             using q''_name_eq
             by (cases "old q' = old n \<and> next q' = next n") auto
           moreover
           then have "incoming n \<subseteq> incoming q''
             \<Longrightarrow> incoming q'' = incoming n \<union> incoming q''"
             by auto
           ultimately have "?q' = q''"
             using upd_incoming__ident_node[OF \<open>q''\<in>?nds\<close>] q'_all
             by auto
         }
         ultimately show "?q' = q''" by fast
       qed
 
       show "\<exists>!q'\<in>upd_incoming n ns. name q = name q'"
       proof(rule ex1I[of _ ?q'], goal_cases)
         case 1
         then show ?case using P_a by simp
       next
         case 2
         then show ?case
           using P_all unfolding P_a[THEN conjunct2, THEN sym]
           by blast
       qed
     qed
   qed simp
   ultimately show ?case using prems by auto
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems have Q: "?Q (n, ns)" by auto
 
   show ?case unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step, goal_cases)
     case 1
     with expand_new_name_step[of n] show ?case
       using Q
       by (auto elim: order_less_trans[rotated])
   next
     case prems': (2 _ nds)
     then have "name ` ns \<subseteq> name ` nds" by auto
     with expand_new_name_step[of n] show ?case
       using prems' by auto
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   with prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   from prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   from prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)" and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   show ?case
     using goal_assms Q
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_param2, rule_tac step) auto
   next
     case prems: (2 nm nds)
     then have P_x: "(name n \<le> nm \<and> name ` ns \<subseteq> name ` nds)
       \<and> name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
       (is "_ \<and> ?nodes_eq nds ns (name n)") by auto
     show ?case
     proof (rule_tac SPEC_rule_param2[where P = "?P"], goal_cases)
       case 1
       with prems show ?case by (rule_tac step) auto
     next
       case prems': (2 nm' nds')
       then have "\<forall>q\<in>nds'. name q < nm' \<and> (\<forall>nm''\<in>incoming q. nm'' < nm')" by auto
       moreover
       have "?nodes_eq nds ns (name n)" and "?nodes_eq nds' nds nm" and "name n \<le> nm"
         using prems' P_x by auto
       then have "?nodes_eq nds' ns (name n)" by auto
       then have "expand_rslt_name (n, ns) (nm', nds')"
         using prems' P_x subset_trans[of "name ` ns" "name ` nds"] by auto
       ultimately show ?case using prems' by auto
     qed
   qed
 qed
 
 lemmas expand_name_propag__incoming = SPEC_rule_conjunct1[OF expand_name_propag]
 lemmas expand_name_propag__name =
   SPEC_rule_conjunct1[OF SPEC_rule_conjunct2[OF expand_name_propag]]
 lemmas expand_name_propag__name_ident =
   SPEC_rule_conjunct2[OF SPEC_rule_conjunct2[OF expand_name_propag]]
 
 
 lemma expand_rslt_exist_eq:
   shows "expand n_ns \<le> SPEC (expand_rslt_exist_eq n_ns)"
     (is "_ \<le> SPEC (?P n_ns)")
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>_. True"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   let ?r = "(name n, upd_incoming n ns)"
   have "expand_rslt_exist_eq (n, ns) ?r"
     unfolding snd_conv
   proof
     fix n'
     assume "n'\<in>ns"
     { assume "old n' = old n \<and> next n' = next n"
       with \<open>n'\<in>ns\<close>
       have "n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr> \<in> upd_incoming n ns"
         unfolding upd_incoming_def by auto
     }
     moreover
     { assume "\<not> (old n' = old n \<and> next n' = next n)"
       with \<open>n'\<in>ns\<close> have "n' \<in> upd_incoming n ns"
         unfolding upd_incoming_def by auto
     }
     ultimately show "\<exists>nd\<in>upd_incoming n ns. expand_rslt_exist_eq__node n' nd"
       by force
   qed
   with prems show ?case by auto
 next
   case prems: (2 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6 then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
 
   show ?case
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     with prems show ?case
       by (rule_tac SPEC_rule_param2, rule_tac step) auto
   next
     case (2 nm nds)
     with prems have P_x: "?P (n, ns) (nm, nds)" by fast
     show ?case
       unfolding case_prod_unfold \<open>x = (n, ns)\<close>
     proof (rule_tac SPEC_rule_param2[where P = "?P"], goal_cases)
       case 1
       then show ?case by (rule_tac step)
     next
       case prems': (2 nm' nds')
       {
         fix n'
         assume "n'\<in>ns"
         with P_x obtain nd where "nd\<in>nds" and n'_split: "expand_rslt_exist_eq__node n' nd"
           by auto
         with prems' obtain nd' where "nd'\<in>nds'" and "expand_rslt_exist_eq__node nd nd'"
           by auto
         then have "\<exists>nd'\<in>nds'. expand_rslt_exist_eq__node n' nd'"
           using n'_split subset_trans[of "incoming n'"] by auto
       }
       then have "expand_rslt_exist_eq (n, ns) (nm', nds')" by auto
       with prems show ?case by auto
     qed
   qed
 qed
 
 lemma expand_prop_exist:
   "expand n_ns \<le> SPEC (\<lambda>r. expand_assm_exist \<xi> n_ns \<longrightarrow> expand_rslt_exist \<xi> n_ns r)"
   (is "_ \<le> SPEC (?P n_ns)")
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>_. True"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   let ?nds = "upd_incoming n ns"
   let ?r = "(name n, ?nds)"
   { assume Q: "expand_assm_exist \<xi> (n, ns)"
     note \<open>\<exists>n'\<in>ns. old n' = old n \<and> next n' = next n\<close>
     then obtain n' where "n'\<in>ns" and assm_eq: "old n' = old n \<and> next n' = next n"
       by auto
     let ?nd = "n'\<lparr> incoming := incoming n \<union> incoming n'\<rparr>"
     have "?nd \<in> ?nds" using \<open>n'\<in>ns\<close> assm_eq unfolding upd_incoming_def by auto
     moreover
     have "incoming n \<subseteq> incoming ?nd" by auto
     moreover
     have "expand_rslt_exist__node_prop \<xi> n ?nd" using Q assm_eq \<open>new n = {}\<close>
       by simp
     ultimately have "expand_rslt_exist \<xi> (n, ns) ?r"
       unfolding fst_conv snd_conv by blast
   }
   with prems show ?case
     by auto
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where Q = "expand_rslt_exist_eq"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_rslt_exist_eq)
   next
     case 2
     then show ?case by (rule_tac step)
   next
     case prems': (3 nm nds)
     then have "name ` ns \<subseteq> name ` nds" by auto
     moreover
     { assume assm_ex: "expand_assm_exist \<xi> (n, ns)"
       with prems' obtain nd where "nd\<in>nds" and "expand_rslt_exist_eq__node n nd"
         by force+
       then have "expand_rslt_exist__node_prop \<xi> n nd"
        using assm_ex \<open>new n = {}\<close> by auto
       then have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" using \<open>nd\<in>nds\<close> by auto }
     ultimately show ?case
       using expand_new_name_step[of n] prems' by auto
   qed
 next
   case prems: (3 f x n ns \<psi>)
   { assume "expand_assm_exist \<xi> (n, ns)"
     with prems have "\<xi> \<Turnstile>\<^sub>r \<psi>" and "\<xi> \<Turnstile>\<^sub>r not\<^sub>r \<psi>"  
       by (metis (no_types, lifting) fstI node.select_convs(4) node.surjective node.update_convs(3))+
     then have False by simp }
   with prems show ?case by auto
 next
   case prems: (4 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (5 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>r"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (6 f x n ns \<psi>)
   { assume "expand_assm_exist \<xi> (n, ns)"
     with prems have "\<xi> \<Turnstile>\<^sub>r false\<^sub>r" by auto }
   with prems show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have step: "\<And>x. f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x1 = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
                 old := {\<psi>} \<union> old n, next := next1 \<psi> \<union> next n\<rparr>, ns)"
 
   let ?new1_assm_sel = "\<lambda>\<psi>. (case \<psi> of \<mu> U\<^sub>r \<eta> => \<eta> | \<mu> R\<^sub>r \<eta> \<Rightarrow> \<mu> | \<mu> or\<^sub>r \<eta> \<Rightarrow> \<eta>)"
 
   { assume new1_assm: "\<not> (\<xi> \<Turnstile>\<^sub>r (?new1_assm_sel \<psi>))"
     then have ?case
       using goal_assms unfolding \<open>x = (n, ns)\<close>
     proof (rule_tac SPEC_rule_nested2, goal_cases)
       case prems': 1
       then show ?case
       proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
         case prems'': (1 nm nds)
         { assume "expand_assm_exist \<xi> (n, ns)"
           with prems'' have "expand_assm_exist \<xi> ?x1"
             unfolding fst_conv
           proof (cases \<psi>, goal_cases)
             case \<psi>: (8 \<mu> \<eta>)
             then have "\<xi> \<Turnstile>\<^sub>r \<mu> U\<^sub>r \<eta>" by fast
             then have "\<xi> \<Turnstile>\<^sub>r \<mu>" and "\<xi> \<Turnstile>\<^sub>r X\<^sub>r (\<mu> U\<^sub>r \<eta>)"
               using \<psi> ltlr_expand_Until[of \<xi> \<mu> \<eta>] by auto
             with \<psi> show ?case by auto
           next
             case \<psi>: (9 \<mu> \<eta>)
             then have *: "\<xi> \<Turnstile>\<^sub>r \<mu> R\<^sub>r \<eta>" by fast
             with \<psi> have "\<xi> \<Turnstile>\<^sub>r \<eta>" and "\<xi> \<Turnstile>\<^sub>r X\<^sub>r (\<mu> R\<^sub>r \<eta>)"
               using ltlr_expand_Release[of \<xi> \<mu> \<eta>] by auto
             with \<psi> * show ?case by auto
           qed auto
           with prems'' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by force }
         with prems'' show ?case by auto
       qed
     next
       case prems': (2 nm nds)
       then have P_x: "?P (n, ns) (nm, nds)" by fast
 
       show ?case
         unfolding case_prod_unfold
       proof (rule_tac SPEC_rule_weak[where P = "?P" and Q = "expand_rslt_exist_eq"], goal_cases)
         case 1
         then show ?case
           by (rule_tac order_trans,
             rule_tac f_sup,
             rule_tac expand_rslt_exist_eq)
       next
         case 2
         then show ?case by (rule_tac step)
       next
         case prems'': (3 nm' nds')
         { assume "expand_assm_exist \<xi> (n, ns)"
           with P_x have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by simp
           then obtain nd where nd: "nd\<in>nds" "expand_rslt_exist__node_prop \<xi> n nd"
             using goal_assms by auto
           with prems'' obtain nd' where
             "nd'\<in>nds'" and "expand_rslt_exist_eq__node nd nd'"
             by force
           with nd have "expand_rslt_exist__node_prop \<xi> n nd'"
             using subset_trans[of "incoming n" "incoming nd"] by auto
           then have "expand_rslt_exist \<xi> (n,ns) (nm', nds')"
             using \<open>nd'\<in>nds'\<close> goal_assms by auto }
         then show ?case by fast
       qed
     qed
   }
   moreover
   { assume new1_assm: "\<xi> \<Turnstile>\<^sub>r (?new1_assm_sel \<psi>)"
     let ?x2f = "\<lambda>(nm::node_name, nds::'a node set). (
         n\<lparr>new := new n - {\<psi>},
           name := nm,
           new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
           old := {\<psi>} \<union> old n\<rparr>,
         nds)"
     have P_x: "f ?x1 \<le> SPEC (?P ?x1)" by (rule step)
     moreover
     { fix r :: "node_name \<times> 'a node set"
       let ?x2 = "?x2f r"
 
       assume assm: "(?P ?x1) r"
       have "f ?x2 \<le> SPEC (?P (n, ns))"
         unfolding case_prod_unfold fst_conv
       proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
         case prems': (1 nm' nds')
         { assume "expand_assm_exist \<xi> (n, ns)"
           with new1_assm goal_assms have "expand_assm_exist \<xi> ?x2"
           proof (cases r, cases \<psi>, goal_cases)
             case prems'': (9 _ _ \<mu> \<eta>)
             then have *: "\<xi> \<Turnstile>\<^sub>r \<mu> R\<^sub>r \<eta>" unfolding fst_conv by fast
             with ltlr_expand_Release[of \<xi> \<mu> \<eta>] have "\<xi> \<Turnstile>\<^sub>r \<eta>" by auto
             with prems'' * show ?case by auto
           qed auto
           with prems' have "expand_rslt_exist \<xi> ?x2 (nm', nds')"
             unfolding case_prod_unfold fst_conv snd_conv by fast
           then have "expand_rslt_exist \<xi> (n, ns) (nm', nds')" by (cases r, auto) }
         then show ?case by simp
       qed
     }
     then have "SPEC (?P ?x1)
       \<le> SPEC (\<lambda>r. (case r of (nm, nds) =>
           f (?x2f (nm, nds))) \<le> SPEC (?P (n, ns)))"
       using goal_assms by (rule_tac SPEC_rule) force
     finally have ?case unfolding case_prod_unfold \<open>x = (n, ns)\<close> by simp
   }
   ultimately show ?case by fast
 qed
 
 
 text \<open>Termination proof\<close>
 
 definition expand\<^sub>T :: "('a node \<times> ('a node set)) \<Rightarrow> (node_name \<times> 'a node set) nres"
   where "expand\<^sub>T n_ns \<equiv> REC\<^sub>T expand_body n_ns"
 
 abbreviation "old_next_pair n \<equiv> (old n, next n)"
 
 abbreviation "old_next_limit \<phi> \<equiv> Pow (subfrmlsr \<phi>) \<times> Pow (subfrmlsr \<phi>)"
 
 lemma old_next_limit_finite: "finite (old_next_limit \<phi>)"
   using subfrmlsr_finite by auto
 
 definition
   "expand_ord \<phi> \<equiv>
      inv_image (finite_psupset (old_next_limit \<phi>) <*lex*> less_than)
                (\<lambda>(n, ns). (old_next_pair ` ns, size_set (new n)))"
 
 lemma expand_ord_wf[simp]: "wf (expand_ord \<phi>)"
   using finite_psupset_wf[OF old_next_limit_finite]
   unfolding expand_ord_def by auto
 
 abbreviation
   "expand_inv_node \<phi> n
   \<equiv> finite (new n) \<and> finite (old n) \<and> finite (next n)
   \<and> (new n) \<union> (old n) \<union> (next n) \<subseteq> subfrmlsr \<phi>"
 
 abbreviation
   "expand_inv_result \<phi> ns \<equiv> finite ns \<and> (\<forall>n'\<in>ns. (new n') \<union> (old n') \<union> (next n') \<subseteq> subfrmlsr \<phi>)"
 
 definition
   "expand_inv \<phi> n_ns \<equiv> (case n_ns of (n, ns) \<Rightarrow> expand_inv_node \<phi> n \<and> expand_inv_result \<phi> ns)"
 
 lemma new1_less_sum: 
   "size_set (new1 \<phi>) < size_set {\<phi>}"
 proof (cases \<phi>)
   case (And_ltlr \<nu> \<mu>)
     thus ?thesis
       by (cases "\<nu> = \<mu>"; simp)
 qed (simp_all)
 
 lemma new2_less_sum: 
   "size_set (new2 \<phi>) < size_set {\<phi>}"
 proof (cases \<phi>)
   case (Release_ltlr \<nu> \<mu>)
     thus ?thesis
       by (cases "\<nu> = \<mu>"; simp)
 qed (simp_all)
 
 lemma new1_finite[intro]: "finite (new1 \<psi>)"
   by (cases \<psi>) auto
 lemma new1_subset_frmls: "\<phi> \<in> new1 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsr \<psi>"
   by (cases \<psi>) auto
 
 lemma new2_finite[intro]: "finite (new2 \<psi>)"
   by (cases \<psi>) auto
 lemma new2_subset_frmls: "\<phi> \<in> new2 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsr \<psi>"
   by (cases \<psi>) auto
 
 lemma next1_finite[intro]: "finite (next1 \<psi>)"
   by (cases \<psi>) auto
 lemma next1_subset_frmls: "\<phi> \<in> next1 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsr \<psi>"
   by (cases \<psi>) auto
 
+text \<open>Expanding the new-style lexorder\<close>
+lemma expand_ord_iff: "((a,b),(c,d)) \<in> expand_ord \<phi> 
+       \<longleftrightarrow> ((old_next_pair ` b, old_next_pair ` d) \<in> finite_psupset (old_next_limit \<phi>) 
+         \<or> old_next_pair ` b = old_next_pair ` d \<and> (\<Sum>x\<in>new a. Suc (2 * size x)) < (\<Sum>x\<in>new c. Suc (2 * size x)))"
+apply (simp add: expand_ord_def)
+  apply (auto simp: finite_psupset_def)
+   apply (metis (mono_tags, lifting) image_iff)+
+  done
+
 lemma expand_inv_impl[intro!]:
   assumes "expand_inv \<phi> (n, ns)"
       and newn: "\<psi> \<in> new n"
       and "old_next_pair ` ns \<subseteq> old_next_pair ` ns'"
       and "expand_inv_result \<phi> ns'"
       and "(n' = n\<lparr> new := new n - {\<psi>}, 
                     old := {\<psi>} \<union> old n \<rparr>) \<or>
            (n' = n\<lparr> new := new1 \<psi> \<union> (new n - {\<psi>}),
                     old := {\<psi>} \<union> old n,
                     next := next1 \<psi> \<union> next n \<rparr>) \<or>
            (n' = n\<lparr> name := nm, 
                     new := new2 \<psi> \<union> (new n - {\<psi>}), 
                     old := {\<psi>} \<union> old n \<rparr>)"
           (is "?case1 \<or> ?case2 \<or> ?case3")
     shows "((n', ns'), (n, ns))\<in>expand_ord \<phi> \<and> expand_inv \<phi> (n', ns')"
           (is "?concl1 \<and> ?concl2")
 proof
   from assms consider ?case1 | ?case2 | ?case3 by blast
   then show ?concl1
   proof cases
     case n'def: 1
     with assms show ?thesis
-      unfolding expand_ord_def expand_inv_def finite_psupset_def 
+      unfolding expand_ord_iff expand_inv_def finite_psupset_def 
       apply (cases "old_next_pair ` ns \<subset> old_next_pair ` ns'") 
-      apply simp_all
-      apply auto [1]
-      apply (metis (no_types, lifting) add_Suc diff_Suc_less psubsetI sum.remove sum_diff1_nat zero_less_Suc)
+       apply (simp_all add: psubset_eq)
+       apply blast
+      apply (metis (no_types, lifting) add_Suc diff_Suc_less sum.remove sum_diff1_nat zero_less_Suc)
       done
   next
     case n'def: 2
     have \<psi>innew: "\<psi> \<in> new n" and fin_new: "finite (new n)"
       using assms unfolding expand_inv_def by auto
     then have "size_set (new n - {\<psi>}) = size_set (new n) - size_set {\<psi>}"
       using size_set_diff by fastforce
     moreover
     from fin_new sum_Un_nat[OF new1_finite _, of "new n - {\<psi>}" size \<psi>]
     have "size_set (new n') \<le> size_set (new1 \<psi>) + size_set (new n - {\<psi>})"
       unfolding n'def by (simp add: new1_finite sum_Un_nat) 
     moreover 
     have sum_leq: "size_set (new n) \<ge> size_set {\<psi>}"
       using \<psi>innew sum_mono2[OF fin_new, of "{\<psi>}"]
       by blast
     ultimately 
     have "size_set (new n') < size_set (new n)"
       using new1_less_sum[of \<psi>] by auto
     with assms show ?thesis 
-      unfolding expand_ord_def finite_psupset_def by auto
+      unfolding expand_ord_iff finite_psupset_def by auto 
   next
     case n'def: 3
     have \<psi>innew: "\<psi> \<in> new n" and fin_new: "finite (new n)"
       using assms unfolding expand_inv_def by auto
     from \<psi>innew sum_diff1_nat[of size "new n" \<psi>]
     have "size_set (new n - {\<psi>}) = size_set (new n) - size_set {\<psi>}"
       using size_set_diff[of "new n" "{\<psi>}"] by fastforce
     moreover
     from fin_new sum_Un_nat[OF new2_finite _, of "new n - {\<psi>}" size \<psi>]
     have "size_set (new n') \<le> size_set (new2 \<psi>) + size_set (new n - {\<psi>})"
       unfolding n'def by (simp add: new2_finite sum_Un_nat) 
     moreover 
     have sum_leq:"size_set (new n) \<ge>  size_set {\<psi>}"
       using \<psi>innew sum_mono2[OF fin_new, of "{\<psi>}"] by blast
     ultimately 
     have "size_set (new n') < size_set (new n)"
       using new2_less_sum[of \<psi>] sum_leq by auto
     with assms show ?thesis
-      unfolding expand_ord_def finite_psupset_def by auto
+      unfolding expand_ord_iff finite_psupset_def by auto 
   qed
 next
   have "new1 \<psi> \<subseteq> subfrmlsr \<phi>"
     and "new2 \<psi> \<subseteq> subfrmlsr \<phi>"
     and "next1 \<psi> \<subseteq> subfrmlsr \<phi>"
     using assms subfrmlsr_subset[OF new1_subset_frmls[of _ \<psi>]]
       subfrmlsr_subset[of \<psi> \<phi>, OF rev_subsetD[of _ "new n"]]
       subfrmlsr_subset[OF new2_subset_frmls[of _ \<psi>]]
       subfrmlsr_subset[OF next1_subset_frmls[of _ \<psi>]]
     unfolding expand_inv_def
     (* This proof is merely a speed optimization. A single force+ does the job,
        but takes very long *)
     apply -
     apply (clarsimp split: prod.splits)
     apply (metis in_mono new1_subset_frmls)
     apply (clarsimp split: prod.splits)
     apply (metis new2_subset_frmls rev_subsetD)
     apply (clarsimp split: prod.splits)
     apply (metis in_mono next1_subset_frmls)
     done
   with assms show ?concl2
     unfolding expand_inv_def
     by auto
 qed
 
 lemma expand_term_prop_help:
   assumes "((n', ns'), (n, ns))\<in>expand_ord \<phi> \<and> expand_inv \<phi> (n', ns')"
     and assm_rule: "\<lbrakk>expand_inv \<phi> (n', ns'); ((n', ns'), n, ns) \<in> expand_ord \<phi>\<rbrakk>
       \<Longrightarrow> f (n', ns') \<le> SPEC P"
   shows "f (n', ns') \<le> SPEC P"
   using assms by (rule_tac assm_rule) auto
 
 lemma expand_inv_upd_incoming:
   assumes "expand_inv \<phi> (n, ns)"
   shows "expand_inv_result \<phi> (upd_incoming n ns)"
   using assms unfolding expand_inv_def upd_incoming_def by force
 
 
 lemma upd_incoming_eq_old_next_pair: "old_next_pair ` ns = old_next_pair ` (upd_incoming n ns)"
   (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix x
     let ?f = "\<lambda>n'. n'\<lparr>incoming := incoming n \<union> incoming n'\<rparr>"
     assume "x \<in> ?A"
     then obtain n' where "n' \<in> ns" and xeq: "x = (old n', next n')"
       by auto
     have "x \<in> (old_next_pair ` (\<lambda>n'. n'\<lparr>incoming := incoming n \<union> incoming n'\<rparr>)
              ` (ns \<inter> {n' \<in> ns. old n' = old n \<and> next n' = next n}))
           \<union> (old_next_pair ` (ns \<inter> {n' \<in> ns. old n' \<noteq> old n \<or> next n' \<noteq> next n}))"
     proof (cases "old n' = old n \<and> next n' = next n")
       case True
       with \<open>n' \<in> ns\<close>
       have "?f n' \<in> ?f ` (ns \<inter> {n'\<in>ns. old n' = old n \<and> next n' = next n})"  (is "_ \<in> ?C")
         by auto
       then have "old_next_pair (?f n') \<in> old_next_pair ` ?C"
         by (rule_tac imageI) auto
       with xeq have "x\<in>old_next_pair ` ?C" by auto
       then show ?thesis by blast
     next
       case False
       with \<open>n' \<in> ns\<close> xeq
       have "x \<in> old_next_pair ` (ns \<inter> {n'\<in>ns. old n' \<noteq> old n \<or> next n' \<noteq> next n})"
         by auto
       then show ?thesis by blast
     qed
     then show "x \<in> ?B"
       using \<open>x \<in> ?A\<close> unfolding upd_incoming_def by auto
   qed
   show "?B \<subseteq> ?A"
     unfolding upd_incoming_def by (force intro:imageI)
 qed
 
 lemma expand_term_prop:
   "expand_inv \<phi> n_ns \<Longrightarrow>
     expand\<^sub>T n_ns \<le> SPEC (\<lambda>(_, nds). old_next_pair ` snd n_ns\<subseteq>old_next_pair `nds
     \<and> expand_inv_result \<phi> nds)"
   (is "_ \<Longrightarrow> _ \<le> SPEC (?P n_ns)")
   unfolding expand\<^sub>T_def
   apply (rule_tac RECT_rule[where pre="\<lambda>(n, ns). expand_inv \<phi> (n, ns)" and V="expand_ord \<phi>"])
   apply (refine_mono)
   apply simp
   apply simp
 proof (intro refine_vcg, goal_cases)
   case prems: (1 _ _ n ns)
   have "old_next_pair ` ns \<subseteq> old_next_pair ` (upd_incoming n ns)"
     by (rule equalityD1[OF upd_incoming_eq_old_next_pair])
   with prems show ?case
     using expand_inv_upd_incoming[of \<phi> n ns] by auto
 next
   case prems: (2 expand x n ns)
   let ?n' = "\<lparr>
     name = expand_new_name (name n),
     incoming = {name n},
     new = next n,
     old = {},
     next = {}\<rparr>"
   let ?ns' = "{n} \<union> ns"
   from prems have SPEC_sub:"SPEC (?P (?n', ?ns')) \<le> SPEC (?P x)"
     by (rule_tac SPEC_rule) auto
   from prems have "old_next_pair n \<notin> old_next_pair ` ns"
     by auto
   then have "old_next_pair ` ns \<subset> old_next_pair ` (insert n ns)"
     by auto
   moreover from prems have "expand_inv \<phi> (n, ns)"
     by simp
   ultimately have "((?n', ?ns'), (n, ns)) \<in> expand_ord \<phi>"
-    by (auto simp add: expand_ord_def finite_psupset_def expand_inv_def)
+    by (auto simp add: expand_ord_iff finite_psupset_def expand_inv_def)
   moreover from prems have "expand_inv \<phi> (?n', ?ns')"
     unfolding expand_inv_def by auto
   ultimately have "expand (?n', ?ns') \<le> SPEC (?P (?n', ?ns'))"
     using prems by fast
   with SPEC_sub show ?case
     by (rule_tac order_trans) fast+
 next
   case 3
   then show ?case by (auto simp add:expand_inv_def)
 next
   case 4
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case 5
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case 6
   then show ?case by (simp add: expand_inv_def)
 next
   case 7
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case prems: (8 f x a b xa)
   let ?n' = "a\<lparr>
     new := new1 xa \<union> (new a - {xa}),
     old := insert xa (old a),
     next := next1 xa \<union> next a\<rparr>"
   let ?n'' = "\<lambda>nm. a\<lparr>
     name := nm,
     new := new2 xa \<union> (new a - {xa}),
     old := insert xa (old a)\<rparr>"
   have step:"((?n', b), (a, b)) \<in> expand_ord \<phi> \<and> expand_inv \<phi> (?n', b)"
     using prems by (rule_tac expand_inv_impl) (auto simp add: expand_inv_def)
   with prems have assm1: "f (?n', b) \<le> SPEC (?P (a, b))"
     by auto
   moreover
   {
     fix nm::node_name and nds::"'a node set"
     assume assm1: "old_next_pair ` b \<subseteq> old_next_pair ` nds"
       and assm2: "expand_inv_result \<phi> nds"
     with prems step have "((?n'' nm, nds), (a, b)) \<in> expand_ord \<phi> \<and> expand_inv \<phi> (?n'' nm, nds)"
       by (rule_tac expand_inv_impl) auto
     with prems have "f (?n'' nm, nds) \<le> SPEC (?P (?n'' nm, nds))"
       by auto
     moreover
     have "SPEC (?P (?n'' nm, nds)) \<le> SPEC (?P (a, b))"
       using assm2 subset_trans[OF assm1] by auto
     ultimately have "f (?n'' nm, nds) \<le> SPEC (?P (a, b))"
       by (rule order_trans)
   }
   then have assm2: "SPEC (?P (a, b))
     \<le> SPEC (\<lambda>r. (case r of (nm, nds) \<Rightarrow> f (?n'' nm, nds)) \<le> SPEC (?P (a, b)))"
     by (rule_tac SPEC_rule) auto
   from prems order_trans[OF assm1 assm2] show ?case
     by auto
 qed
 
 lemma expand_eq_expand\<^sub>T:
   assumes inv: "expand_inv \<phi> n_ns"
   shows "expand\<^sub>T n_ns = expand n_ns"
   unfolding expand\<^sub>T_def expand_def
   apply (rule RECT_eq_REC)
   unfolding expand\<^sub>T_def[symmetric]
   using expand_term_prop[OF inv] apply auto
   done
 
 lemma expand_nofail:
   assumes inv: "expand_inv \<phi> n_ns"
   shows "nofail (expand\<^sub>T n_ns)"
   using expand_term_prop[OF inv] by (simp add: pw_le_iff)
 
 lemma [intro!]: "expand_inv \<phi> (
   \<lparr>
     name = expand_new_name expand_init,
     incoming = {expand_init},
     new = {\<phi>},
     old = {},
     next = {} \<rparr>,
   {})"
   by (auto simp add: expand_inv_def)
 
 definition create_graph :: "'a frml \<Rightarrow> 'a node set nres"
 where
   "create_graph \<phi> \<equiv>
     do {
       (_, nds) \<leftarrow> expand (
         \<lparr>
           name = expand_new_name expand_init,
           incoming = {expand_init},
           new = {\<phi>},
           old = {},
           next = {}
         \<rparr>::'a node,
         {}::'a node set);
       RETURN nds
     }"
 
 (* "expand_eq_expand\<^sub>T" *)
 
 definition create_graph\<^sub>T :: "'a frml \<Rightarrow> 'a node set nres"
 where
   "create_graph\<^sub>T \<phi> \<equiv> do {
     (_, nds) \<leftarrow> expand\<^sub>T (
       \<lparr>
         name = expand_new_name expand_init,
         incoming = {expand_init},
         new = {\<phi>},
         old = {},
         next = {}
       \<rparr>::'a node,
     {}::'a node set);
     RETURN nds
   }"
 
 lemma create_graph_eq_create_graph\<^sub>T: "create_graph \<phi> = create_graph\<^sub>T \<phi>"
   unfolding create_graph\<^sub>T_def create_graph_def
   unfolding eq_iff
 proof (standard, goal_cases)
   case 1
   then show ?case
     by refine_mono (unfold expand_def expand\<^sub>T_def, rule REC_le_RECT)
 next
   case 2
   then show ?case
     by (refine_mono, rule expand_eq_expand\<^sub>T[unfolded eq_iff, THEN conjunct1]) auto
 qed
 
 lemma create_graph_finite: "create_graph \<phi> \<le> SPEC finite"
   unfolding create_graph_def expand_def
   apply (intro refine_vcg)
   apply (rule_tac order_trans)
   apply (rule_tac REC_le_RECT)
   apply (fold expand\<^sub>T_def)
   apply (rule_tac order_trans[OF expand_term_prop])
   apply auto[1]
   apply (rule_tac SPEC_rule)
   apply auto
   done
 
 lemma create_graph_nofail: "nofail (create_graph \<phi>)"
   by (rule_tac pwD1[OF create_graph_finite]) auto
 
 
 abbreviation
   "create_graph_rslt_exist \<xi> nds
    \<equiv> \<exists>nd\<in>nds.
         expand_init\<in>incoming nd
       \<and> (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
       \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old nd \<and> \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> old nd"
 
 lemma L4_7:
   assumes "\<xi> \<Turnstile>\<^sub>r \<phi>"
   shows "create_graph \<phi> \<le> SPEC (create_graph_rslt_exist \<xi>)"
   using assms unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_prop_exist) (
     auto simp add:expand_new_name_expand_init)
 
 
 lemma expand_incoming_name_exist:
   assumes "name (fst n_ns) > expand_init
     \<and> (\<forall>nm\<in>incoming (fst n_ns). nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` (snd n_ns))
     \<and> expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   and "\<forall>nd\<in>snd n_ns.
     name nd > expand_init
     \<and> (\<forall>nm\<in>incoming nd. nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` (snd n_ns))"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
   apply (rule_tac expand_rec_rule[where \<Phi>="\<lambda>n_ns. ?Q n_ns \<and> ?P (snd n_ns)"])
   apply simp
   apply (intro refine_vcg)
 proof goal_cases
   case (1 f x n ns)
   then show ?case
   proof (simp, clarify, goal_cases)
     case prems: (1 _ _ nd)
     { assume "nd\<in>ns"
       with prems have ?case by auto }
     moreover
     { assume "nd\<notin>ns"
       with upd_incoming__elem[OF \<open>nd\<in>upd_incoming n ns\<close>]
       obtain nd' where "nd'\<in>ns" and "nd = nd'\<lparr>incoming :=
         incoming n \<union> incoming nd'\<rparr> \<and>
         old nd' = old n \<and>
         next nd' = next n" by auto
       with prems have ?case by auto }
     ultimately show ?case by fast
   qed
 next
   case (2 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x. ?P (snd x))"
     and QP: "?Q (n, ns) \<and> ?P ns"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
     using QP expand_new_name_expand_init
   proof (rule_tac step, goal_cases)
     case prems: 1
     then have name_less: "name n < expand_new_name (name n)"
       by auto
     moreover
     from prems name_less have "\<forall>nm\<in>incoming n. nm < expand_new_name (name n)"
       by auto
     moreover
     from prems name_less have **: "\<forall>q\<in>ns. name q < expand_new_name (name n) \<and>
       (\<forall>nm\<in>incoming q. nm < expand_new_name (name n))"
       by force
     moreover
     from QP have "\<exists>!q'. (q' = n \<or> q' \<in> ns) \<and> name n = name q'"
       by force
     moreover
     have "\<forall>q\<in>ns. \<exists>!q'.
       (q' = n \<or> q' \<in> ns) \<and>
       name q = name q' " using QP by auto
     ultimately show ?case using prems by simp
   qed
 next
   case 3
   then show ?case by simp
 next
   case 4
   then show ?case by simp
 next
   case 5
   then show ?case by simp
 next
   case 6
   then show ?case by simp
 next
   case 7
   then show ?case by simp
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   with prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
         next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_incoming r
     \<and> expand_rslt_name x r
     \<and> expand_name_ident (snd r)"
 
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_name_propag) simp
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>x r. ?P (snd r)"], rule_tac step)
         auto
   next
     case (3 nm nds)
     then show ?case
     proof (rule_tac SPEC_rule_weak[where P = "\<lambda>x r. ?P (snd r)"
         and Q = "\<lambda>x r. expand_rslt_exist_eq x r \<and> ?props x r"], goal_cases)
       case 1
       then show ?case
         by (rule_tac SPEC_rule_conjI,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_rslt_exist_eq,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_name_propag) force
     next
       case 2
       then show ?case
         by (rule_tac SPEC_rule_param2[where P = "\<lambda>x r. ?P (snd r)"],
           rule_tac step) force
     next
       case (3 nm' nds')
       then show ?case
         by simp
     qed
   qed
 qed
 
 lemma create_graph__incoming_name_exist:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. expand_init < name nd \<and> (\<forall>nm\<in>incoming nd. nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` nds))"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_incoming_name_exist) (
     auto simp add:expand_new_name_expand_init)
 
 
 abbreviation
   "expand_rslt_all__ex_equiv \<xi> nd nds \<equiv>
    (\<exists>nd'\<in>nds.
     name nd \<in> incoming nd'
     \<and> (\<forall>\<psi>\<in>old nd'. suffix 1 \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next nd'. suffix 1 \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
     \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old nd' \<and> suffix 1 \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> old nd')"
 
 abbreviation
   "expand_rslt_all \<xi> n_ns nm_nds \<equiv>
    (\<forall>nd\<in>snd nm_nds. name nd \<notin> name ` (snd n_ns) \<and>
         (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
         \<longrightarrow> expand_rslt_all__ex_equiv \<xi> nd (snd nm_nds))"
 
 lemma expand_prop_all:
   assumes "expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (expand_rslt_all \<xi> n_ns)"
     (is "_ \<le> SPEC (?P n_ns)")
   using assms
   apply (rule_tac expand_rec_rule[where \<Phi>="?Q"])
   apply simp
   apply (intro refine_vcg)
 proof goal_cases
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) simp_all
 next
   case (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     and Q: "?Q (n, ns)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(\<lparr>name = expand_new_name (name n),
     incoming = {name n}, new = next n, old = {}, next = {}\<rparr>, {n} \<union> ns)"
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>p r.
       (expand_assm_exist (suffix 1 \<xi>) ?x \<longrightarrow> expand_rslt_exist (suffix 1 \<xi>) ?x r)
       \<and> expand_rslt_exist_eq p r \<and> (expand_name_ident (snd r))"], goal_cases)
     case 1
     then show ?case
     proof (rule_tac SPEC_rule_conjI,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_prop_exist,
            rule_tac SPEC_rule_conjI,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_rslt_exist_eq,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_name_propag__name_ident,
            goal_cases)
       case 1
       then show ?case using Q name_le by force
     qed
   next
     case 2
     then show ?case using Q name_le by (rule_tac step) force
   next
     case prems: (3 nm nds)
     then obtain n' where "n'\<in>nds"
       and eq_node: "expand_rslt_exist_eq__node n n'" by auto
     with prems have ex1_name: "\<exists>!q\<in>nds. name n = name q" by auto
     then have nds_eq: "nds = {n'} \<union> {x \<in> nds. name n \<noteq> name x}"
       using eq_node \<open>n'\<in>nds\<close> by blast
     have name_notin: "name n \<notin> name ` ns" using Q by auto
     from prems have P_x: "expand_rslt_all \<xi> ?x (nm, nds)" by fast
     show ?case
       unfolding snd_conv
     proof clarify
       fix nd
       assume "nd \<in> nds" and name_img: "name nd \<notin> name ` ns"
         and nd_old_equiv: "\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>r \<psi>"
         and nd_next_equiv: "\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>"
       show "expand_rslt_all__ex_equiv \<xi> nd nds"
       proof (cases "name nd = name n")
         case True
         with nds_eq eq_node \<open>nd\<in>nds\<close> have "nd = n'" by auto
         with prems(1)[THEN conjunct1, simplified]
           nd_old_equiv nd_next_equiv eq_node
         show ?thesis by simp
       next
         case False
         with name_img \<open>nd \<in> nds\<close> nd_old_equiv nd_next_equiv P_x
         show ?thesis by simp
       qed
     qed
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
           old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
         \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_incoming r
     \<and> expand_rslt_name x r
     \<and> expand_name_ident (snd r)"
   show ?case
     using goal_assms Q
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_name_propag) simp
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step) auto
   next
     case prems: (3 nm nds)
     then show ?case
     proof (rule_tac SPEC_rule_weak[where
         P = "?P" and
         Q = "\<lambda>x r. expand_rslt_exist_eq x r \<and> ?props x r"], goal_cases)
       case 1
       then show ?case
         by (rule_tac SPEC_rule_conjI,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_rslt_exist_eq,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_name_propag) auto
     next
       case 2
       then show ?case
         by (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step) auto
     next
       case prems': (3 nm' nds')
       then have P_x: "?P (n, ns) (nm, nds)"
         and P_x': "?P (n, nds) (nm', nds')" by simp_all
       show ?case
         unfolding snd_conv
       proof clarify
         fix nd
         assume "nd\<in>nds'"
           and name_nd_notin: "name nd \<notin> name ` ns"
           and old_equiv: "\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>r \<psi>"
           and next_equiv: "\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>"
         show "expand_rslt_all__ex_equiv \<xi> nd nds'"
         proof (cases "name nd \<in> name ` nds")
           case True
           then obtain n' where "n' \<in> nds" and "name nd = name n'" by auto
           with prems' obtain nd' where "nd'\<in>nds'"
             and nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           moreover from prems' have "\<forall>q\<in>nds'. \<exists>!q'\<in>nds'. name q = name q'"
             by simp
           ultimately have "nd' = nd"
             using \<open>name nd = name n'\<close> \<open>nd \<in> nds'\<close> by auto
           with nd'_eq have n'_eq: "expand_rslt_exist_eq__node n' nd"
             by simp
           then have "name n'\<notin>name ` ns" and "\<forall>\<psi>\<in>old n'. \<xi> \<Turnstile>\<^sub>r \<psi>" and "\<forall>\<psi>\<in>next n'. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>"
             using name_nd_notin old_equiv next_equiv \<open>n' \<in> nds\<close>
             by auto
           then have "expand_rslt_all__ex_equiv \<xi> n' nds"  (is "\<exists>nd'\<in>nds. ?sthm n' nd'")
             using P_x \<open>n' \<in> nds\<close> unfolding snd_conv by blast
           then obtain sucnd where sucnd: "sucnd\<in>nds" and sthm: "?sthm n' sucnd"
             by blast
           moreover
           from prems' sucnd sthm obtain sucnd' where "sucnd'\<in>nds'"
               and sucnd'_eq: "expand_rslt_exist_eq__node sucnd sucnd'"
             by auto
           ultimately have "?sthm n' sucnd'" by auto
           then show ?thesis
             using \<open>sucnd' \<in> nds'\<close>
             unfolding \<open>name nd = name n'\<close> by blast
         next
           case False
           with \<open>nd \<in> nds'\<close> P_x' old_equiv next_equiv
           show ?thesis unfolding snd_conv by blast
         qed
       qed
     qed
   qed
 qed
 
 abbreviation
   "create_graph_rslt_all \<xi> nds
    \<equiv> \<forall>q\<in>nds. (\<forall>\<psi>\<in>old q. \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next q. \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
     \<longrightarrow> (\<exists>q'\<in>nds. name q \<in> incoming q'
          \<and> (\<forall>\<psi>\<in>old q'. suffix 1 \<xi> \<Turnstile>\<^sub>r \<psi>)
          \<and> (\<forall>\<psi>\<in>next q'. suffix 1 \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>)
          \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old q' \<and> suffix 1 \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> old q')"
 
 lemma L4_5: "create_graph \<phi> \<le> SPEC (create_graph_rslt_all \<xi>)"
   unfolding create_graph_def
   apply (refine_vcg expand_prop_all)
   apply (auto simp add:expand_new_name_expand_init)  
   done  
 
 subsection \<open>Creation of GBA\<close>
 
 text \<open>This section formalizes the second part of the algorithm, that creates
   the actual generalized B\"uchi automata from the set of nodes.\<close>
 
 definition create_gba_from_nodes :: "'a frml \<Rightarrow> 'a node set \<Rightarrow> ('a node, 'a set) gba_rec"
 where "create_gba_from_nodes \<phi> qs \<equiv> \<lparr>
   g_V = qs,
   g_E = {(q, q'). q\<in>qs \<and> q'\<in>qs \<and> name q\<in>incoming q'},
   g_V0 = {q\<in>qs. expand_init\<in>incoming q},
   gbg_F = {{q\<in>qs. \<mu> U\<^sub>r \<eta>\<in>old q \<longrightarrow> \<eta>\<in>old q}|\<mu> \<eta>. \<mu> U\<^sub>r \<eta> \<in> subfrmlsr \<phi>},
   gba_L = \<lambda>q l. q\<in>qs \<and> {p. prop\<^sub>r(p)\<in>old q}\<subseteq>l \<and> {p. nprop\<^sub>r(p)\<in>old q} \<inter> l = {}
 \<rparr>"
 
 end
 
 locale create_gba_from_nodes_precond =
   fixes \<phi> :: "'a ltlr"
   fixes qs :: "'a node set"
   assumes res: "inres (create_graph \<phi>) qs"
 begin
 
 lemma finite_qs[simp, intro!]: "finite qs"
   using res create_graph_finite by (auto simp add: pw_le_iff)
 
 lemma create_gba_from_nodes__invar: "gba (create_gba_from_nodes \<phi> qs)"
   using [[simproc finite_Collect]]
   apply unfold_locales
   apply (auto
     intro!: finite_vimageI subfrmlsr_finite injI
     simp: create_gba_from_nodes_def)
   done
 
 sublocale gba: gba "create_gba_from_nodes \<phi> qs"
   by (rule create_gba_from_nodes__invar)
 
 lemma create_gba_from_nodes__fin: "finite (g_V (create_gba_from_nodes \<phi> qs))"
   unfolding create_gba_from_nodes_def by auto
 
 lemma create_gba_from_nodes__ipath:
   "ipath gba.E r \<longleftrightarrow> (\<forall>i. r i \<in>qs \<and> name (r i)\<in>incoming (r (Suc i)))"
   unfolding create_gba_from_nodes_def ipath_def
   by auto
 
 lemma create_gba_from_nodes__is_run:
   "gba.is_run r \<longleftrightarrow> expand_init \<in> incoming (r 0)
     \<and> (\<forall>i. r i\<in>qs \<and> name (r i)\<in>incoming (r (Suc i)))"
   unfolding gba.is_run_def
   apply (simp add: create_gba_from_nodes__ipath)
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 
 context
 begin
 
 abbreviation
   "auto_run_j j \<xi> q \<equiv>
         (\<forall>\<psi>\<in>old q. suffix j \<xi> \<Turnstile>\<^sub>r \<psi>) \<and> (\<forall>\<psi>\<in>next q. suffix j \<xi> \<Turnstile>\<^sub>r X\<^sub>r \<psi>) \<and>
         {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>r \<eta> \<in> old q \<and> suffix j \<xi> \<Turnstile>\<^sub>r \<eta>} \<subseteq> old q"
 
 fun auto_run :: "['a interprt, 'a node set] \<Rightarrow> 'a node word"
 where
   "auto_run \<xi> nds 0
    = (SOME q. q\<in>nds \<and> expand_init \<in> incoming q \<and> auto_run_j 0 \<xi> q)"
 | "auto_run \<xi> nds (Suc k)
    = (SOME q'. q'\<in>nds \<and> name (auto_run \<xi> nds k) \<in> incoming q'
         \<and> auto_run_j (Suc k) \<xi> q')"
 
 
 (* TODO: Remove. Only special instance of more generic principle
 lemma create_graph_comb:
   assumes "\<And>x. inres (create_graph \<phi>) x \<Longrightarrow> P x"
     shows "create_graph \<phi>\<le>SPEC P"
   using create_graph_nofail assms
   by (auto simp add: pw_le_iff refine_pw_simps)
 *)
 
 lemma run_propag_on_create_graph:
   assumes "ipath gba.E \<sigma>"
   shows "\<sigma> k\<in>qs \<and> name (\<sigma> k)\<in>incoming (\<sigma> (k+1))"
   using assms
   by (auto simp: create_gba_from_nodes__ipath)
 
 lemma expand_false_propag:
   assumes "false\<^sub>r \<notin> old (fst n_ns) \<and> (\<forall>nd\<in>snd n_ns. false\<^sub>r \<notin> old nd)"
     (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. \<forall>nd\<in>snd nm_nds. false\<^sub>r \<notin> old nd)"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case 8
   then show ?case by (rule_tac SPEC_rule_nested2) auto
 qed auto
 
 lemma false_propag_on_create_graph: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. false\<^sub>r \<notin> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_false_propag) auto
 
 
 lemma expand_and_propag:
   assumes "\<mu> and\<^sub>r \<eta> \<in> old (fst n_ns)
     \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old (fst n_ns) \<union> new (fst n_ns)" (is "?Q n_ns")
     and "\<forall>nd\<in>snd n_ns. \<mu> and\<^sub>r \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd" (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case (6 f x n ns)
   then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))
     \<and> \<psi> \<noteq> true\<^sub>r \<and> \<psi> \<noteq> false\<^sub>r
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     by simp_all
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed auto
 
 lemma and_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. \<mu> and\<^sub>r \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_and_propag) auto
 
 lemma expand_or_propag:
   assumes "\<mu> or\<^sub>r \<eta> \<in> old (fst n_ns)
     \<longrightarrow> {\<mu>, \<eta>} \<inter> (old (fst n_ns) \<union> new (fst n_ns)) \<noteq> {}" (is "?Q n_ns")
     and "\<forall>nd\<in>snd n_ns. \<mu> or\<^sub>r \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<inter> old nd \<noteq> {}"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case (6 f x n ns)
   then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))
     \<and> \<psi> \<noteq> true\<^sub>r \<and> \<psi> \<noteq> false\<^sub>r
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     by simp_all
   show ?case
     using goal_assms QP
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed auto
 
 lemma or_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. \<mu> or\<^sub>r \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<inter> old nd \<noteq> {})"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_or_propag) auto
 
 
 abbreviation
   "next_propag__assm \<mu> n_ns \<equiv>
      (X\<^sub>r \<mu> \<in> old (fst n_ns) \<longrightarrow> \<mu> \<in> next (fst n_ns))
      \<and> (\<forall>nd\<in>snd n_ns. X\<^sub>r \<mu> \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
         \<longrightarrow> \<mu> \<in> old (fst n_ns) \<union> new (fst n_ns))"
 
 abbreviation
   "next_propag__rslt \<mu> ns \<equiv>
      \<forall>nd\<in>ns. \<forall>nd'\<in>ns. X\<^sub>r \<mu> \<in> old nd \<and> name nd \<in> incoming nd' \<longrightarrow> \<mu> \<in> old nd'"
 
 lemma expand_next_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "next_propag__assm \<mu> n_ns
            \<and> next_propag__rslt \<mu> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. next_propag__rslt \<mu> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems: 1
     {
       fix nd :: "'a node" and nd' :: "'a node"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       have "\<mu> \<in> old nd'" if *: "X\<^sub>r \<mu> \<in> old nd" and **: "name nd \<in> incoming nd'"
       proof (cases "nd'\<in>ns")
         case True
         with prems * ** show ?thesis using \<open>nd\<in>ns\<close> by auto
       next
         case False
         with upd_incoming__elem[of nd' n ns] nd'_elem * **
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n" by auto
         have "\<mu> \<in> old nd'"
         proof (cases "name nd \<in> incoming n")
           case True
           with prems * \<open>nd\<in>ns\<close> have "\<mu> \<in> old n" by auto
           then show ?thesis using nd'_eq old_eq by simp
         next
           case False
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then show ?thesis
             unfolding nd'_eq using \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> * prems by auto
         qed
         then show ?thesis by auto
       qed
     }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
     using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "next_propag__assm \<mu> ?x' \<and> next_propag__rslt \<mu> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
   show ?case
     using \<open>new n = {}\<close>
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case
     using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case
       using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
       and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
       and f_sup: "\<And>x. f x \<le> expand x"
     by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
         \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1 then
     show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems': (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems' show ?case
     proof (rule_tac step, goal_cases)
       case prems'': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems'' have nds_ident: "expand_name_ident (snd ?x')" by simp
       moreover
       have "X\<^sub>r \<mu> \<in> old (fst ?x') \<longrightarrow> \<mu>\<in>next (fst ?x')"
       using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems'' have "next_propag__rslt \<mu> (snd ?x')" by simp
       moreover
       from prems'' have name_nds_eq: "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (X\<^sub>r \<mu> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
                        \<longrightarrow> \<mu>\<in>old (fst ?x')\<union>new (fst ?x')"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           moreover
           from prems'' n' obtain nd' where "nd'\<in>nds"
               and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           ultimately have "nd = nd'"
             using nds_ident \<open>nd\<in>nds\<close> loc_assm by auto
           moreover from prems'' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems'' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma next_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. X\<^sub>r \<mu>\<in>old n \<and> name n\<in>incoming n' \<longrightarrow> \<mu>\<in>old n')"
   unfolding create_graph_def
   apply (refine_vcg expand_next_propag)  
   apply (auto simp add:expand_new_name_expand_init)
   done
     
 
 abbreviation
   "release_propag__assm \<mu> \<eta> n_ns \<equiv>
      (\<mu> R\<^sub>r \<eta> \<in> old (fst n_ns)
       \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old (fst n_ns)\<union>new (fst n_ns) \<or>
          (\<eta>\<in>old (fst n_ns)\<union>new (fst n_ns)) \<and> \<mu> R\<^sub>r \<eta> \<in> next (fst n_ns))
      \<and> (\<forall>nd\<in>snd n_ns.
          \<mu> R\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
          \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old nd \<or>
             (\<eta>\<in>old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old (fst n_ns)\<union>new (fst n_ns)))"
 
 abbreviation
   "release_propag__rslt \<mu> \<eta> ns \<equiv>
      \<forall>nd\<in>ns.
        \<forall>nd'\<in>ns.
          \<mu> R\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
          \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old nd \<or>
             (\<eta>\<in>old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old nd')"
 
 lemma expand_release_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "release_propag__assm \<mu> \<eta> n_ns
            \<and> release_propag__rslt \<mu> \<eta> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. release_propag__rslt \<mu> \<eta> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems: 1
     { fix nd :: "'a node" and nd' :: "'a node"
       let ?V_prop = "\<mu> R\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
         \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old nd'"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       { assume "nd'\<in>ns"
         with prems have ?V_prop using \<open>nd\<in>ns\<close> by auto }
       moreover
       { assume "nd'\<notin>ns"
           and V_in_nd: "\<mu> R\<^sub>r \<eta> \<in> old nd" and "name nd \<in>incoming nd'"
         with upd_incoming__elem[of nd' n ns] nd'_elem
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n"
           by auto
         { assume "name nd \<in> incoming n"
           with prems V_in_nd \<open>nd\<in>ns\<close>
           have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old n"
             by auto
           then have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old nd'"
             using nd'_eq old_eq by simp }
         moreover
         { assume "name nd \<notin> incoming n"
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old nd'"
             unfolding nd'_eq
             using prems \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> V_in_nd by auto }
         ultimately have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> R\<^sub>r \<eta> \<in> old nd'"
           by fast
       }
       ultimately have ?V_prop by auto
     }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
   using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "release_propag__assm \<mu> \<eta> ?x' \<and> release_propag__rslt \<mu> \<eta> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
 
   show ?case using \<open>new n = {}\<close> unfolding \<open>x = (n, ns)\<close>
 
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case
     using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>r" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
       \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
 
   show ?case using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
 
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems': (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems' show ?case
     proof (rule_tac step, goal_cases)
       case prems'': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems'' have nds_ident: "expand_name_ident (snd ?x')" by simp
       moreover
       have "(\<mu> R\<^sub>r \<eta> \<in> old (fst ?x')
              \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old (fst ?x') \<union> new (fst ?x')
                   \<or> (\<eta>\<in>old (fst ?x')\<union>new (fst ?x')
                      \<and> \<mu> R\<^sub>r \<eta> \<in> next (fst ?x'))))"
         using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems'' have "release_propag__rslt \<mu> \<eta> (snd ?x')" by simp
       moreover
       from prems'' have name_nds_eq: "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (\<mu> R\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
                  \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old nd
                       \<or> (\<eta>\<in>old nd \<and> \<mu> R\<^sub>r \<eta> \<in>old (fst ?x')\<union>new (fst ?x')))"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           with prems'' obtain nd' where "nd'\<in>nds"
             and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           with n' have "nd = nd'" using nds_ident \<open>nd\<in>nds\<close> loc_assm
             by auto
           moreover from prems'' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems'' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma release_propag_on_create_graph:
   "create_graph \<phi>
      \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. \<mu> R\<^sub>r \<eta>\<in>old n \<and> name n\<in>incoming n'
                                       \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old n \<or> \<eta>\<in>old n \<and> \<mu> R\<^sub>r \<eta>\<in>old n'))"
   unfolding create_graph_def
   apply (refine_vcg expand_release_propag)  
   by (auto simp add:expand_new_name_expand_init)
 
 
 abbreviation
   "until_propag__assm f g n_ns \<equiv>
      (f U\<^sub>r g \<in> old (fst n_ns)
       \<longrightarrow> (g\<in>old (fst n_ns)\<union>new (fst n_ns)
             \<or> (f\<in>old (fst n_ns)\<union>new (fst n_ns) \<and> f U\<^sub>r g \<in> next (fst n_ns))))
      \<and> (\<forall>nd\<in>snd n_ns. f U\<^sub>r g \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
         \<longrightarrow> (g\<in>old nd \<or> (f\<in>old nd \<and> f U\<^sub>r g \<in>old (fst n_ns)\<union>new (fst n_ns))))"
 
 abbreviation
   "until_propag__rslt f g ns \<equiv>
      \<forall>n\<in>ns. \<forall>nd\<in>ns. f U\<^sub>r g \<in> old n \<and> name n \<in> incoming nd
                                   \<longrightarrow> (g \<in> old n \<or> (f\<in>old n \<and> f U\<^sub>r g \<in> old nd))"
 
 lemma expand_until_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "until_propag__assm \<mu> \<eta> n_ns
            \<and> until_propag__rslt \<mu> \<eta> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. until_propag__rslt \<mu> \<eta> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems': 1
     { fix nd :: "'a node" and nd' :: "'a node"
       let ?U_prop = "\<mu> U\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
                            \<longrightarrow> \<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>r \<eta> \<in> old nd'"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       { assume "nd'\<in>ns"
         with prems' have ?U_prop using \<open>nd\<in>ns\<close> by auto }
       moreover
       { assume "nd'\<notin>ns" and
         U_in_nd: "\<mu> U\<^sub>r \<eta> \<in> old nd" and "name nd \<in>incoming nd'"
         with upd_incoming__elem[of nd' n ns] nd'_elem
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n" by auto
         { assume "name nd \<in> incoming n"
           with prems' U_in_nd \<open>nd\<in>ns\<close>
           have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>r \<eta> \<in> old n" by auto
           then have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>r \<eta> \<in> old nd'"
             using nd'_eq old_eq by simp }
         moreover
         { assume "name nd \<notin> incoming n"
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>r \<eta> \<in> old nd'"
             unfolding nd'_eq
             using prems' \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> U_in_nd by auto }
         ultimately have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>r \<eta> \<in> old nd'" by fast }
       ultimately have ?U_prop by auto }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and f_sup: "\<And>x. f x \<le> expand x"
     by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
     using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "until_propag__assm \<mu> \<eta> ?x' \<and> until_propag__rslt \<mu> \<eta> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
 
   show ?case
     using \<open>new n = {}\<close> unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
        \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
 
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems: (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems show ?case
     proof (rule_tac step, goal_cases)
       case prems': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems' have nds_ident: "expand_name_ident (snd ?x')"
         by simp
       moreover
       have "(\<mu> U\<^sub>r \<eta> \<in> old (fst ?x')
              \<longrightarrow> (\<eta>\<in>old (fst ?x')\<union>new (fst ?x')
                   \<or> (\<mu>\<in>old (fst ?x')\<union>new (fst ?x')
                      \<and> \<mu> U\<^sub>r \<eta> \<in> next (fst ?x'))))"
         using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems' have "until_propag__rslt \<mu> \<eta> (snd ?x')"
         by simp
       moreover
       from prems' have name_nds_eq:
         "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (\<mu> U\<^sub>r \<eta> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
         \<longrightarrow> (\<eta>\<in>old nd \<or> (\<mu>\<in>old nd \<and> \<mu> U\<^sub>r \<eta> \<in>old (fst ?x')\<union>new (fst ?x')))"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           moreover
           from prems' n' obtain nd' where "nd'\<in>nds"
             and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           ultimately have "nd = nd'"
             using nds_ident \<open>nd\<in>nds\<close> loc_assm by auto
           moreover from prems' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma until_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. \<mu> U\<^sub>r \<eta>\<in>old n \<and> name n\<in>incoming n'
     \<longrightarrow> (\<eta>\<in>old n \<or> \<mu>\<in>old n \<and> \<mu> U\<^sub>r \<eta>\<in>old n'))"
   unfolding create_graph_def
   apply (refine_vcg expand_until_propag)  
   by (auto simp add:expand_new_name_expand_init)
 
 definition all_subfrmls :: "'a node \<Rightarrow> 'a frml set"
   where "all_subfrmls n \<equiv> \<Union>(subfrmlsr ` (new n \<union> old n \<union> next n))"
 
 lemma all_subfrmls__UnionD:
   assumes "(\<Union>x\<in>A. subfrmlsr x) \<subseteq> B"
     and "x\<in>A"
     and "y\<in>subfrmlsr x"
   shows "y\<in>B"
 proof -
   note subfrmlsr_id[of x]
   also have "subfrmlsr x \<subseteq> (\<Union>x\<in>A. subfrmlsr x)"
     using assms by auto
   finally show ?thesis using assms by auto
 qed
 
 
 lemma expand_all_subfrmls_propag:
   assumes "all_subfrmls (fst n_ns) \<subseteq> B \<and> (\<forall>nd\<in>snd n_ns. all_subfrmls nd \<subseteq> B)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. \<forall>nd\<in>snd r. all_subfrmls nd \<subseteq> B)"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case 1
     then show ?case by auto
   next
     case 2
     then show ?case by (simp add: all_subfrmls_def)
   qed
 next
   case 2
   then show ?case by (auto simp add: all_subfrmls_def)
 next
   case 3
   then show ?case by (auto simp add: all_subfrmls_def)
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac step) (auto simp add: all_subfrmls_def)
 next
   case prems: (5 f _ n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>r" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms
     by (rule_tac step) (auto dest: all_subfrmls__UnionD simp add: all_subfrmls_def)
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case
     using Q goal_assms
     by (rule_tac step) (auto dest: all_subfrmls__UnionD simp add: all_subfrmls_def)
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))
     \<and> \<psi> \<noteq> true\<^sub>r \<and> \<psi> \<noteq> false\<^sub>r
     \<and>  \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)" and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     by simp_all
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case
       by (rule_tac step) (auto dest: all_subfrmls__UnionD simp: all_subfrmls_def)
   next
     case 2
     then show ?case
       by (rule_tac step) (auto dest: all_subfrmls__UnionD simp: all_subfrmls_def)
   qed
 qed
 
 lemma old_propag_on_create_graph: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. old n \<subseteq> subfrmlsr \<phi>)"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_all_subfrmls_propag[where B = "subfrmlsr \<phi>"])
    (force simp add:all_subfrmls_def expand_new_name_expand_init)+
 
 lemma L4_2__aux:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> 0)"
     and "\<forall>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)) \<longrightarrow> \<eta> \<notin> old (\<sigma> j)"
   shows "\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i) \<and> \<eta> \<notin> old (\<sigma> i)"
 proof -
   have "\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)" (is "?sbthm j") for j
   proof (induct j)
     show "?sbthm 0" by auto
   next
     fix k
     assume step: "?sbthm k"
     then have \<sigma>_k_prop: "\<eta> \<notin> old (\<sigma> k)
       \<and> \<sigma> k\<in>qs \<and> \<sigma> (Suc k)\<in>qs
       \<and> name (\<sigma> k) \<in> incoming (\<sigma> (Suc k))"
     using assms run_propag_on_create_graph[OF run] by auto
     with inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
     have "{\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> k)" (is "?subsetthm")
     proof (cases k)
       assume "k = 0"
       with assms \<sigma>_k_prop
         inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       show ?subsetthm by auto
     next
       fix l
       assume "k = Suc l"
       then have "{\<mu>, \<mu> U\<^sub>r \<eta>}\<subseteq>old (\<sigma> l) \<and> \<eta>\<notin>old (\<sigma> l)
         \<and> \<sigma> l\<in>qs \<and> \<sigma> k\<in>qs
         \<and> name (\<sigma> l)\<in>incoming (\<sigma> k)"
       using step assms run_propag_on_create_graph[OF run] by auto
       with inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       have "\<mu> U\<^sub>r \<eta>\<in>old (\<sigma> k)" by auto
       with \<sigma>_k_prop
         inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       show ?subsetthm by auto
     qed
     with step show "?sbthm (Suc k)" by (metis less_SucE)
   qed
   with assms show ?thesis by auto
 qed
 
 lemma L4_2a:
   assumes "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> 0)"
   shows "(\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i) \<and> \<eta> \<notin> old (\<sigma> i))
          \<or> (\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j))"
     (is "?A \<or> ?B")
 proof (rule disjCI)
   assume "\<not> ?B"
   then show ?A
     using assms by (rule_tac L4_2__aux) blast+
 qed
 
 lemma L4_2b:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> 0)"
     and ACC: "gba.is_acc \<sigma>"
   shows "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have contr: "\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>}\<subseteq>old(\<sigma> i) \<and> \<eta>\<notin>old(\<sigma> i)"
     using assms L4_2a[of \<sigma> \<mu> \<eta>] by blast
 
   define S where "S = {q \<in> qs. \<mu> U\<^sub>r \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}"
 
   from assms inres_SPEC[OF res old_propag_on_create_graph] create_gba_from_nodes__ipath
   have "\<mu> U\<^sub>r \<eta> \<in> subfrmlsr \<phi>"
     by (metis assms(2) subsetD)
   then have "S\<in>gbg_F(create_gba_from_nodes \<phi> qs)"
     unfolding S_def create_gba_from_nodes_def by auto
   with ACC have 1: "\<exists>\<^sub>\<infinity>i. \<sigma> i \<in> S"
     unfolding gba.is_acc_def by blast
 
   from INFM_EX[OF 1] obtain k where "\<sigma> k \<in> qs" and "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> k) \<longrightarrow> \<eta> \<in> old (\<sigma> k)"
     unfolding S_def by auto
   moreover have "{\<mu>, \<mu> U\<^sub>r \<eta>}\<subseteq>old(\<sigma> k) \<and> \<eta>\<notin>old(\<sigma> k)"
     using contr by auto
   ultimately show False by auto
 qed
 
 lemma L4_2c:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> R\<^sub>r \<eta> \<in> old (\<sigma> 0)"
   shows "\<forall>i. \<eta> \<in> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))"
 proof -
   have "{\<eta>, \<mu> R\<^sub>r \<eta>} \<subseteq> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))" (is "?thm i") for i
   proof (induct i)
     case 0
     have "\<sigma> 0\<in>qs \<and> \<sigma> 1\<in>qs \<and> name (\<sigma> 0) \<in> incoming (\<sigma> 1)"
     using create_gba_from_nodes__ipath assms by auto
     then show ?case
       using assms inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
       by auto
   next
     case (Suc k)
     note \<open>?thm k\<close>
     moreover
     { assume "{\<eta>, \<mu> R\<^sub>r \<eta>} \<subseteq> old (\<sigma> k)"
       moreover
       have "\<sigma> k\<in>qs \<and> \<sigma> (Suc k)\<in>qs \<and> name (\<sigma> k) \<in> incoming (\<sigma> (Suc k))"
       using create_gba_from_nodes__ipath assms by auto
       ultimately have "\<mu> \<in> old (\<sigma> k) \<or> \<mu> R\<^sub>r \<eta> \<in> old (\<sigma> (Suc k))"
         using assms inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
         by auto
       moreover
       { assume "\<mu> \<in> old (\<sigma> k)"
         then have ?case by blast }
       moreover
       { assume "\<mu> R\<^sub>r \<eta> \<in> old (\<sigma> (Suc k))"
         moreover
         have "\<sigma> (Suc k)\<in>qs \<and> \<sigma> (Suc (Suc k))\<in>qs
           \<and> name (\<sigma> (Suc k)) \<in> incoming (\<sigma> (Suc (Suc k)))"
         using create_gba_from_nodes__ipath assms by auto
         ultimately have ?case
           using assms
             inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
           by auto }
       ultimately have ?case by fast }
     moreover
     { assume "\<exists>j<k. \<mu> \<in> old (\<sigma> j)"
       then have ?case by auto }
     ultimately show ?case by auto
   qed
   then show ?thesis by auto
 qed
 
 lemma L4_8':
   assumes "ipath gba.E \<sigma>" (is "?inf_run \<sigma>")
     and "gba.is_acc \<sigma>" (is "?gbarel_accept \<sigma>")
     and "\<forall>i. gba.L (\<sigma> i) (\<xi> i)" (is "?lgbarel_accept \<xi> \<sigma>")
     and "\<psi> \<in> old (\<sigma> 0)"
   shows "\<xi> \<Turnstile>\<^sub>r \<psi>"
   using assms
 proof (induct \<psi> arbitrary: \<sigma> \<xi>)
   case True_ltlr
   show ?case by auto
 next
   case False_ltlr
   then show ?case
     using inres_SPEC[OF res false_propag_on_create_graph]
       create_gba_from_nodes__ipath
     by (metis)
 next
   case (Prop_ltlr p)
   then show ?case
     unfolding create_gba_from_nodes_def by auto
 next
   case (Nprop_ltlr p)
   then show ?case
     unfolding create_gba_from_nodes_def by auto
 next
   case (And_ltlr \<mu> \<eta>)
   then show ?case
     using inres_SPEC[OF res and_propag_on_create_graph, of \<mu> \<eta>]
       create_gba_from_nodes__ipath
       by (metis insert_subset semantics_ltlr.simps(5))
 next
   case (Or_ltlr \<mu> \<eta>)
   then have "\<mu> \<in> old (\<sigma> 0) \<or> \<eta> \<in> old (\<sigma> 0)"
     using inres_SPEC[OF res or_propag_on_create_graph, of \<mu> \<eta>]
     create_gba_from_nodes__ipath
     by (metis (full_types) Int_empty_left Int_insert_left_if0)
   moreover have "\<xi> \<Turnstile>\<^sub>r \<mu>" if "\<mu> \<in> old (\<sigma> 0)"
     using Or_ltlr that by auto
   moreover have "\<xi> \<Turnstile>\<^sub>r \<eta>" if "\<eta> \<in> old (\<sigma> 0)"
     using Or_ltlr that by auto
   ultimately show ?case by auto
 next
   case (Next_ltlr \<mu>)
   with create_gba_from_nodes__ipath[of \<sigma>]
   have "\<sigma> 0 \<in> qs \<and> \<sigma> 1 \<in> qs \<and> name (\<sigma> 0) \<in> incoming (\<sigma> 1)"
     by auto
   with inres_SPEC[OF res next_propag_on_create_graph, of \<mu>] have "\<mu>\<in>old (suffix 1 \<sigma> 0)"
     using Next_ltlr by auto
   moreover
   have "?inf_run (suffix 1 \<sigma>)"
     and "?gbarel_accept (suffix 1 \<sigma>)"
     and "?lgbarel_accept (suffix 1 \<xi>) (suffix 1 \<sigma> )"
     using Next_ltlr create_gba_from_nodes__ipath
     apply -
     apply (metis ipath_suffix)
     apply (auto simp del: suffix_nth) [] (* FIXME:
       "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
     apply auto
     done
   ultimately show ?case using Next_ltlr by simp
 next
   case (Until_ltlr \<mu> \<eta>)
   then have "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j)"
     using L4_2b by auto
   then obtain j where \<sigma>_pre: "\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> i)" and "\<eta> \<in> old (suffix j \<sigma> 0)"
     by auto
   moreover
   have "?inf_run (suffix j \<sigma>)"
     and "?gbarel_accept (suffix j \<sigma>)"
     and "?lgbarel_accept (suffix j \<xi>) (suffix j \<sigma>)"
     unfolding limit_suffix
     using Until_ltlr create_gba_from_nodes__ipath
     apply -
     apply (metis ipath_suffix)
     apply (auto simp del: suffix_nth) [] (* FIXME:
       "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
     apply auto
     done
   ultimately have "suffix j \<xi> \<Turnstile>\<^sub>r \<eta>"
     using Until_ltlr by simp
   moreover {
     fix i
     assume "i < j"
     have "?inf_run (suffix i \<sigma>)"
       and "?gbarel_accept (suffix i \<sigma>)"
       and "?lgbarel_accept (suffix i \<xi>) (suffix i \<sigma> )"
       unfolding limit_suffix
       using Until_ltlr create_gba_from_nodes__ipath
       apply -
       apply (metis ipath_suffix)
       apply (auto simp del: suffix_nth) [] (* FIXME:
         "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
       apply auto
       done
     moreover have "\<mu>\<in>old (suffix i \<sigma> 0)"
       using \<sigma>_pre \<open>i<j\<close> by auto
     ultimately have "suffix i \<xi> \<Turnstile>\<^sub>r \<mu>" using Until_ltlr by simp
   }
   ultimately show ?case by auto
 next
   case (Release_ltlr \<mu> \<eta>)
   { fix i
     assume "\<eta> \<in> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))"
     moreover
     {
       assume *: "\<eta> \<in> old (\<sigma> i)"
       have "?inf_run (suffix i \<sigma>)"
         and "?gbarel_accept (suffix i \<sigma>)"
         and "?lgbarel_accept (suffix i \<xi>) (suffix i \<sigma> )"
         unfolding limit_suffix
         using Release_ltlr create_gba_from_nodes__ipath
         apply -
         apply (metis ipath_suffix)
         apply (auto simp del: suffix_nth) [] (* FIXME:
           "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
         apply auto
         done
       with * have "suffix i \<xi> \<Turnstile>\<^sub>r \<eta>"
         using Release_ltlr by auto
     }
     moreover
     {
       assume "\<exists>j<i. \<mu> \<in> old (\<sigma> j)"
       then obtain j where "j<i" and "\<mu> \<in> old (\<sigma> j)" by auto
       moreover
       have "?inf_run (suffix j \<sigma>)"
         and "?gbarel_accept (suffix j \<sigma>)"
         and "?lgbarel_accept (suffix j \<xi>) (suffix j \<sigma> )" unfolding limit_suffix
         using Release_ltlr create_gba_from_nodes__ipath
         apply -
         apply (metis ipath_suffix)
         apply (auto simp del: suffix_nth) [] (* FIXME:
           "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
         apply auto
         done
       ultimately have "suffix j \<xi> \<Turnstile>\<^sub>r \<mu>"
         using Release_ltlr by auto
       then have "\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>r \<mu>"
         using \<open>j<i\<close> by auto
     }
     ultimately have "suffix i \<xi> \<Turnstile>\<^sub>r \<eta> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>r \<mu>)" by auto
   }
   then show ?case using Release_ltlr L4_2c by auto
 qed
 
 
 lemma L4_8:
   assumes "gba.is_acc_run \<sigma>"
     and "\<forall>i. gba.L (\<sigma> i) (\<xi> i)"
     and "\<psi> \<in> old (\<sigma> 0)"
   shows "\<xi> \<Turnstile>\<^sub>r \<psi>"
   using assms
   unfolding gba.is_acc_run_def gba.is_run_def
   using L4_8' by blast
 
 lemma expand_expand_init_propag:
   assumes "(\<forall>nm\<in>incoming n'. nm < name n')
            \<and> name n' \<le> name (fst n_ns)
            \<and> (incoming n' \<inter> incoming (fst n_ns) \<noteq> {}
               \<longrightarrow> new n' \<subseteq> old (fst n_ns) \<union> new (fst n_ns))
            " (is "?Q n_ns")
   and "\<forall>nd\<in>snd n_ns. \<forall>nm\<in>incoming n'. nm\<in>incoming nd \<longrightarrow> new n' \<subseteq> old nd"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>r. name n'\<le>fst r \<and> ?P (snd r))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp,
     intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   then have goal_assms: "new n = {} \<and> ?Q (n, ns) \<and> ?P ns" by simp
   { fix nd nm
     assume "nd\<in>upd_incoming n ns" and "nm\<in>incoming n'" and "nm\<in>incoming nd"
     { assume "nd\<in>ns"
       with goal_assms \<open>nm\<in>incoming n'\<close> \<open>nm\<in>incoming nd\<close> have "new n' \<subseteq> old nd"
         by auto }
     moreover
     { assume "nd\<notin>ns"
       with upd_incoming__elem[OF \<open>nd\<in>upd_incoming n ns\<close>]
       obtain nd' where "nd'\<in>ns"
                    and nd_eq: "nd = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>"
                    and old_next_eq: "old nd' = old n \<and> next nd' = next n" by auto
       { assume "nm\<in>incoming nd'"
         with goal_assms \<open>nm\<in>incoming n'\<close> \<open>nd'\<in>ns\<close> have "new n' \<subseteq> old nd"
           unfolding nd_eq by auto }
       moreover
       { assume "nm\<in>incoming n"
         with nd_eq old_next_eq goal_assms \<open>nm\<in>incoming n'\<close>
         have "new n' \<subseteq> old nd"
           by auto }
       ultimately have "new n' \<subseteq> old nd" using \<open>nm\<in>incoming nd\<close> nd_eq by auto }
     ultimately have "new n' \<subseteq> old nd" by fast }
   with prems show ?case by auto
 next
   case prems: (2 f x n ns)
   then have goal_assms: "new n = {} \<and> ?Q (n, ns) \<and> ?P ns" and step: "\<And>x. ?Q x \<and> ?P (snd x)
       \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp_all
   then show ?case
   proof (rule_tac step, goal_cases)
     case prems': 1
     have expand_new_name_less: "name n < expand_new_name (name n)"
       by auto
     moreover have "name n \<notin> incoming n'"
       using goal_assms by auto
     ultimately show ?case using prems' by auto
   qed
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case 6 then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>r(q) \<or> \<psi> = nprop\<^sub>r(q))
     \<and> \<psi> \<noteq> true\<^sub>r \<and> \<psi> \<noteq> false\<^sub>r
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>r \<mu> \<or> \<psi> = X\<^sub>r \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>r \<mu> \<or> \<psi> = \<nu> U\<^sub>r \<mu> \<or> \<psi> = \<nu> R\<^sub>r \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns" and
     step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp_all
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed
 
 lemma expand_init_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC(\<lambda>nds. \<forall>nd\<in>nds. expand_init\<in>incoming nd \<longrightarrow> \<phi> \<in> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans,
       rule_tac expand_expand_init_propag[where
           n' = "\<lparr> name = expand_new_name expand_init,
           incoming = {expand_init},
           new = {\<phi>},
           old = {},
           next = {} \<rparr>"]) (auto simp add:expand_new_name_expand_init)
 
 lemma L4_6:
   assumes "q\<in>gba.V0"
   shows "\<phi>\<in>old q"
   using assms inres_SPEC[OF res expand_init_propag_on_create_graph]
   unfolding create_gba_from_nodes_def by auto
 
 lemma L4_9:
   assumes acc: "gba.accept \<xi>"
   shows "\<xi> \<Turnstile>\<^sub>r \<phi>"
 proof -
   from acc obtain \<sigma> where accept: "gba.is_acc_run \<sigma> \<and> (\<forall>i. gba.L (\<sigma> i) (\<xi> i))"
     unfolding gba.accept_def by auto
   then have "\<sigma> 0\<in>gba.V0"
     unfolding gba.is_acc_run_def gba.is_run_def by simp
   with L4_6 have "\<phi>\<in>old (\<sigma> 0)" by auto
   with L4_8 accept show ?thesis by auto
 qed
 
 lemma L4_10:
   assumes "\<xi> \<Turnstile>\<^sub>r \<phi>"
   shows "gba.accept \<xi>"
 proof -
   define \<sigma> where "\<sigma> = auto_run \<xi> qs"
   let ?G = "create_graph \<phi>"
 
   have \<sigma>_prop_0: "(\<sigma> 0)\<in>qs \<and> expand_init\<in>incoming(\<sigma> 0) \<and> auto_run_j 0 \<xi> (\<sigma> 0)"
     (is "?sbthm")
   using inres_SPEC[OF res L4_7[OF \<open>\<xi> \<Turnstile>\<^sub>r \<phi>\<close>]]
   unfolding \<sigma>_def auto_run.simps by (rule_tac someI_ex, simp) blast
 
   have \<sigma>_valid: "\<forall>j. \<sigma> j \<in> qs \<and> auto_run_j j \<xi> (\<sigma> j)" (is "\<forall>j. ?\<sigma>_valid j")
   proof
     fix j
     show "?\<sigma>_valid j"
     proof(induct j)
       from \<sigma>_prop_0 show "?\<sigma>_valid 0" by fast
     next
       fix k
       assume goal_assms: "\<sigma> k \<in> qs \<and> auto_run_j k \<xi> (\<sigma> k)"
       with inres_SPEC[OF res L4_5, of "suffix k \<xi>"]
       have sbthm: "\<exists>q'. q'\<in>qs \<and> name (\<sigma> k)\<in>incoming q' \<and> auto_run_j (Suc k) \<xi> q'"
         (is "\<exists>q'. ?sbthm q'")
         by auto
       have "?sbthm (\<sigma> (Suc k))" using someI_ex[OF sbthm]
       unfolding \<sigma>_def auto_run.simps by blast
       then show "?\<sigma>_valid (Suc k)" by fast
     qed
   qed
 
   have \<sigma>_prop_Suc: "\<And>k. \<sigma> k\<in> qs \<and> \<sigma> (Suc k)\<in>qs
     \<and> name (\<sigma> k)\<in>incoming (\<sigma> (Suc k))
     \<and> auto_run_j (Suc k) \<xi> (\<sigma> (Suc k))"
   proof -
     fix k
     from \<sigma>_valid have "\<sigma> k \<in> qs" and "auto_run_j k \<xi> (\<sigma> k)" by blast+
     with inres_SPEC[OF res L4_5, of "suffix k \<xi>"]
     have sbthm: "\<exists>q'. q'\<in>qs \<and> name (\<sigma> k)\<in>incoming q'
       \<and> auto_run_j (Suc k) \<xi> q'" (is "\<exists>q'. ?sbthm q'")
       by auto
     show "\<sigma> k\<in> qs \<and> ?sbthm (\<sigma> (Suc k))" using \<open>\<sigma> k\<in>qs\<close> someI_ex[OF sbthm]
       unfolding \<sigma>_def auto_run.simps by blast
   qed
 
   have \<sigma>_vnaccpt:
     "\<forall>k \<mu> \<eta>. \<mu> U\<^sub>r \<eta> \<in> old (\<sigma> k) \<longrightarrow> \<not> (\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i)))"
   proof clarify
     fix k \<mu> \<eta>
     assume U_in: "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> k)"
       and cntr_prm: "\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i))"
     have "suffix k \<xi> \<Turnstile>\<^sub>r \<mu> U\<^sub>r \<eta>"
       using U_in \<sigma>_valid by force
     then obtain i where "suffix (k+i) \<xi> \<Turnstile>\<^sub>r \<eta>" and "\<forall>j<i. suffix (k+j) \<xi> \<Turnstile>\<^sub>r \<mu>"
       by auto
     moreover have "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i))"
       using cntr_prm by auto
     ultimately show False
       using \<sigma>_valid by force
   qed
 
   have \<sigma>_exec: "gba.is_run \<sigma>"
     using \<sigma>_prop_0 \<sigma>_prop_Suc \<sigma>_valid
     unfolding gba.is_run_def ipath_def
     unfolding create_gba_from_nodes_def
     by auto
   moreover
   have \<sigma>_vaccpt:
     "\<forall>k \<mu> \<eta>. \<mu> U\<^sub>r \<eta> \<in> old (\<sigma> k) \<longrightarrow>
       (\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> (k+i))) \<and> \<eta> \<in> old (\<sigma> (k+j)))"
   proof(clarify)
     fix k \<mu> \<eta>
     assume U_in: "\<mu> U\<^sub>r \<eta> \<in> old (\<sigma> k)"
     then have "\<not> (\<forall>i. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (suffix k \<sigma> i) \<and> \<eta> \<notin> old (suffix k \<sigma> i))"
       using \<sigma>_vnaccpt[THEN allE, of k] by auto
     moreover have "suffix k \<sigma> 0 \<in> qs" using \<sigma>_valid by auto
     ultimately show "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>r \<eta>} \<subseteq> old (\<sigma> (k+i))) \<and> \<eta> \<in> old (\<sigma> (k+j))"
       apply -
       apply (rule make_pos_rule'[OF L4_2a])
       apply (fold suffix_def)
       apply (rule ipath_suffix)
       using \<sigma>_exec[unfolded gba.is_run_def]
       apply simp
       using U_in apply simp
       apply simp
       done
   qed
 
   have "gba.is_acc \<sigma>"
     unfolding gba.is_acc_def
   proof
     fix S
     assume "S\<in>gba.F"
     then obtain \<mu> \<eta> where S_eq: "S = {q \<in> qs. \<mu> U\<^sub>r \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}"
       and "\<mu> U\<^sub>r \<eta> \<in> subfrmlsr \<phi>"
       by (auto simp add: create_gba_from_nodes_def)
     have range_subset: "range \<sigma> \<subseteq> qs"
     proof
       fix q
       assume "q\<in>range \<sigma>"
       with full_SetCompr_eq[of \<sigma>] obtain k where "q = \<sigma> k" by auto
       then show "q \<in> qs" using \<sigma>_valid by auto
     qed
     with limit_nonempty[of \<sigma>]
          limit_in_range[of \<sigma>]
          finite_subset[OF range_subset]
          inres_SPEC[OF res create_graph_finite]
     obtain q where q_in_limit: "q \<in> limit \<sigma>" and q_is_node: "q\<in>qs"
       by auto
     show "\<exists>\<^sub>\<infinity>i. \<sigma> i \<in> S"
     proof (cases "\<mu> U\<^sub>r \<eta> \<in> old q")
       case False
       with S_eq q_in_limit q_is_node
       show ?thesis
         by (auto simp: limit_iff_frequent intro: INFM_mono)
     next
       case True
       obtain k where q_eq: "q = \<sigma> k" using q_in_limit
         unfolding limit_iff_frequent by (metis (lifting, full_types) INFM_nat_le)
       have "\<exists>\<^sub>\<infinity> k. \<eta> \<in> old (\<sigma> k)"
         unfolding INFM_nat
       proof (rule ccontr)
         assume "\<not> (\<forall>m. \<exists>n>m. \<eta> \<in> old (\<sigma> n))"
         then obtain m where "\<forall>n>m. \<eta> \<notin> old (\<sigma> n)" by auto
         moreover
         from q_eq q_in_limit limit_iff_frequent[of q \<sigma>] INFM_nat[of "\<lambda>n. \<sigma> n = q"]
         obtain n where "m<n" and \<sigma>n_eq: "\<sigma> n = \<sigma> k" by auto
         moreover
         obtain j where "\<eta> \<in> old (\<sigma> (n+j))"
           using \<sigma>_vaccpt \<open>\<mu> U\<^sub>r \<eta> \<in> old q\<close> unfolding q_eq by (fold \<sigma>n_eq) force
         ultimately show False by auto
       qed
       then have "\<exists>\<^sub>\<infinity> k. \<sigma> k \<in> qs \<and> \<eta> \<in> old (\<sigma> k)"
         using \<sigma>_valid by (auto intro: INF_mono)
       then show "\<exists>\<^sub>\<infinity> k. \<sigma> k \<in> S"
         unfolding S_eq by (rule INFM_mono) simp
     qed
   qed
   moreover have "gba.L (\<sigma> i) (\<xi> i)" for i
   proof -
     from \<sigma>_valid have [simp]: "\<sigma> i \<in> qs" by auto
     have "\<forall>\<psi>\<in>old (\<sigma> i). suffix i \<xi> \<Turnstile>\<^sub>r \<psi>"
       using \<sigma>_valid by auto
     then show ?thesis
       unfolding create_gba_from_nodes_def by auto
   qed
   ultimately show ?thesis
     unfolding gba.accept_def gba.is_acc_run_def by blast
 qed
 
 end
 end
 
 lemma create_graph__name_ident: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>q\<in>nds. \<exists>!q'\<in>nds. name q = name q')"
   unfolding create_graph_def
   apply (refine_vcg expand_name_propag__name_ident)  
   by (auto simp add:expand_new_name_expand_init)
 
 corollary create_graph__name_inj: "create_graph \<phi> \<le> SPEC (\<lambda>nds. inj_on name nds)"
   by (rule order_trans[OF create_graph__name_ident]) (auto intro: inj_onI)
 
 
 definition
   "create_gba \<phi>
    \<equiv> do { nds \<leftarrow> create_graph\<^sub>T \<phi>;
           RETURN (create_gba_from_nodes \<phi> nds) }"
 
 lemma create_graph_precond: "create_graph \<phi>
   \<le> SPEC (create_gba_from_nodes_precond \<phi>)"
   apply (clarsimp simp: pw_le_iff create_graph_nofail)
   apply unfold_locales
   apply simp
   done
 
 lemma create_gba__invar: "create_gba \<phi> \<le> SPEC gba"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_precond])
   by (rule create_gba_from_nodes_precond.create_gba_from_nodes__invar)
 
 lemma create_gba_acc:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. \<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>r \<phi>)"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_precond])
   using create_gba_from_nodes_precond.L4_9
   using create_gba_from_nodes_precond.L4_10
   by blast
 
 lemma create_gba__name_inj:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. (inj_on name (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__name_inj])
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 lemma create_gba__fin:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. (finite (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_finite])
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 lemma create_graph_old_finite:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. finite (old nd))"
 proof -
   show ?thesis
     unfolding create_graph_def create_graph_eq_create_graph\<^sub>T[symmetric]
     unfolding expand_def
     apply (intro refine_vcg)
     apply (rule_tac order_trans)
     apply (rule_tac REC_le_RECT)
     apply (fold expand\<^sub>T_def)
     apply (rule_tac order_trans[OF expand_term_prop])
     apply auto[1]
     apply (rule_tac SPEC_rule)
     apply auto
     by (metis infinite_super subfrmlsr_finite)
 qed
 
 lemma create_gba__old_fin:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. \<forall>nd\<in>g_V \<A>. finite (old nd))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_old_finite])
   apply (simp add: create_gba_from_nodes_def)
   done
 
 lemma create_gba__incoming_exists:
   shows "create_gba \<phi>
   \<le> SPEC(\<lambda>\<A>. \<forall>nd\<in>g_V \<A>. incoming nd \<subseteq> insert expand_init (name ` (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__incoming_name_exist])
   apply (auto simp add: create_gba_from_nodes_def)
   done
 
 lemma create_gba__no_init:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. expand_init \<notin> name ` (g_V \<A>))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__incoming_name_exist])
   apply (auto simp add: create_gba_from_nodes_def)
   done
 
 definition "nds_invars nds \<equiv>
   inj_on name nds
   \<and> finite nds
   \<and> expand_init \<notin> name`nds
   \<and> (\<forall>nd\<in>nds.
     finite (old nd)
     \<and> incoming nd \<subseteq> insert expand_init (name ` nds))"
 
 lemma create_gba_nds_invars: "create_gba \<phi> \<le> SPEC (\<lambda>\<A>. nds_invars (g_V \<A>))"
   using create_gba__name_inj[of \<phi>] create_gba__fin[of \<phi>]
     create_gba__old_fin[of \<phi>] create_gba__incoming_exists[of \<phi>]
     create_gba__no_init[of \<phi>]
   unfolding nds_invars_def
   by (simp add: pw_le_iff)
 
 theorem T4_1:
   "create_gba \<phi> \<le> SPEC(
     \<lambda>\<A>. gba \<A>
     \<and> finite (g_V \<A>)
     \<and> (\<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>r \<phi>)
     \<and> (nds_invars (g_V \<A>)))"
   using create_gba__invar create_gba__fin create_gba_acc create_gba_nds_invars
   apply (simp add: pw_le_iff)
   apply blast
   done
 
 definition "create_name_gba \<phi> \<equiv> do {
   G \<leftarrow> create_gba \<phi>;
   ASSERT (nds_invars (g_V G));
   RETURN (gba_rename name G)
 }"
 
 
 theorem create_name_gba_correct:
   "create_name_gba \<phi> \<le> SPEC(\<lambda>\<A>. gba \<A> \<and> finite (g_V \<A>) \<and> (\<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>r \<phi>))"
   unfolding create_name_gba_def
   apply (refine_rcg refine_vcg order_trans[OF T4_1])
   apply (simp_all add: nds_invars_def gba_rename_correct)
   done
 
 definition create_name_igba :: "'a::linorder ltlr \<Rightarrow> _" where
 "create_name_igba \<phi> \<equiv> do {
   A \<leftarrow> create_name_gba \<phi>;
   A' \<leftarrow> gba_to_idx A;
   stat_set_data_nres (card (g_V A)) (card (g_V0 A')) (igbg_num_acc A');
   RETURN A'
 }"
 
 lemma create_name_igba_correct: "create_name_igba \<phi> \<le> SPEC (\<lambda>G.
   igba G \<and> finite (g_V G) \<and> (\<forall>\<xi>. igba.accept G \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>r \<phi>))"
   unfolding create_name_igba_def
   apply (refine_rcg
     order_trans[OF create_name_gba_correct]
     order_trans[OF gba.gba_to_idx_ext_correct]
     refine_vcg)
   apply clarsimp_all
 proof -
   fix G :: "(nat, 'a set) gba_rec"
   fix A :: "nat set"
   assume 1: "gba G"
   assume 2: "finite (g_V G)" "A \<in> gbg_F G"
   interpret gba G using 1 .
   show "finite A" using finite_V_Fe 2 .
 qed
 
 (* For presentation in paper*)
 context
   notes [refine_vcg] = order_trans[OF create_name_gba_correct]
 begin
 
 lemma "create_name_igba \<phi> \<le> SPEC (\<lambda>G. igba G \<and> (\<forall>\<xi>. igba.accept G \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>r \<phi>))"
   unfolding create_name_igba_def
 proof (refine_rcg refine_vcg, clarsimp_all)
   fix G :: "(nat, 'a set) gba_rec"
   assume "gba G"
   then interpret gba G .
   note [refine_vcg] = order_trans[OF gba_to_idx_ext_correct]
 
   assume "\<forall>\<xi>. gba.accept G \<xi> = \<xi> \<Turnstile>\<^sub>r \<phi>" "finite (g_V G)"
   then show "gba_to_idx G \<le> SPEC (\<lambda>G'. igba G' \<and> (\<forall>\<xi>. igba.accept G' \<xi> = \<xi> \<Turnstile>\<^sub>r \<phi>))"
     by (refine_rcg refine_vcg) (auto intro: finite_V_Fe)
 qed
 
 end
 
 end
diff --git a/thys/Nested_Multisets_Ordinals/Nested_Multiset.thy b/thys/Nested_Multisets_Ordinals/Nested_Multiset.thy
--- a/thys/Nested_Multisets_Ordinals/Nested_Multiset.thy
+++ b/thys/Nested_Multisets_Ordinals/Nested_Multiset.thy
@@ -1,408 +1,411 @@
 (*  Title:       Nested Multisets
     Author:      Dmitriy Traytel <traytel at inf.ethz.ch>, 2016
     Author:      Jasmin Blanchette <jasmin.blanchette at inria.fr>, 2016
     Maintainer:  Dmitriy Traytel <traytel at inf.ethz.ch>
 *)
 
 section \<open>Nested Multisets\<close>
 
 theory Nested_Multiset
 imports "HOL-Library.Multiset_Order"
 begin
 
 declare multiset.map_comp [simp]
 declare multiset.map_cong [cong]
 
 
 subsection \<open>Type Definition\<close>
 
 datatype 'a nmultiset =
   Elem 'a
 | MSet "'a nmultiset multiset"
 
 inductive no_elem :: "'a nmultiset \<Rightarrow> bool" where
   "(\<And>X. X \<in># M \<Longrightarrow> no_elem X) \<Longrightarrow> no_elem (MSet M)"
 
 inductive_set sub_nmset :: "('a nmultiset \<times> 'a nmultiset) set" where
   "X \<in># M \<Longrightarrow> (X, MSet M) \<in> sub_nmset"
 
 lemma wf_sub_nmset[simp]: "wf sub_nmset"
 proof (rule wfUNIVI)
   fix P :: "'a nmultiset \<Rightarrow> bool" and M :: "'a nmultiset"
   assume IH: "\<forall>M. (\<forall>N. (N, M) \<in> sub_nmset \<longrightarrow> P N) \<longrightarrow> P M"
   show "P M"
     by (induct M; rule IH[rule_format]) (auto simp: sub_nmset.simps)
 qed
 
 primrec depth_nmset :: "'a nmultiset \<Rightarrow> nat" ("|_|") where
   "|Elem a| = 0"
 | "|MSet M| = (let X = set_mset (image_mset depth_nmset M) in if X = {} then 0 else Suc (Max X))"
 
 lemma depth_nmset_MSet: "x \<in># M \<Longrightarrow> |x| < |MSet M|"
   by (auto simp: less_Suc_eq_le)
 
 declare depth_nmset.simps(2)[simp del]
 
 
 subsection \<open>Dershowitz and Manna's Nested Multiset Order\<close>
 
 text \<open>The Dershowitz--Manna extension:\<close>
 
 definition less_multiset_ext\<^sub>D\<^sub>M :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where
   "less_multiset_ext\<^sub>D\<^sub>M R M N \<longleftrightarrow>
    (\<exists>X Y. X \<noteq> {#} \<and> X \<subseteq># N \<and> M = (N - X) + Y \<and> (\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> R k a)))"
 
 lemma less_multiset_ext\<^sub>D\<^sub>M_imp_mult:
   assumes
     N_A: "set_mset N \<subseteq> A" and M_A: "set_mset M \<subseteq> A" and less: "less_multiset_ext\<^sub>D\<^sub>M R M N"
   shows "(M, N) \<in> mult {(x, y). x \<in> A \<and> y \<in> A \<and> R x y}"
 proof -
   from less obtain X Y where
     "X \<noteq> {#}" and "X \<subseteq># N" and "M = N - X + Y" and "\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> R k a)"
     unfolding less_multiset_ext\<^sub>D\<^sub>M_def by blast
   with N_A M_A have "(N - X + Y, N - X + X) \<in> mult {(x, y). x \<in> A \<and> y \<in> A \<and> R x y}"
     by (intro one_step_implies_mult, blast,
       metis (mono_tags, lifting) case_prodI mem_Collect_eq mset_subset_eqD mset_subset_eq_add_right
         subsetCE)
   with \<open>M = N - X + Y\<close> \<open>X \<subseteq># N\<close> show "(M, N) \<in> mult {(x, y). x \<in> A \<and> y \<in> A \<and> R x y}"
     by (simp add: subset_mset.diff_add)
 qed
 
 lemma mult_imp_less_multiset_ext\<^sub>D\<^sub>M:
   assumes
     N_A: "set_mset N \<subseteq> A" and M_A: "set_mset M \<subseteq> A" and
     trans: "\<forall>x \<in> A. \<forall>y \<in> A. \<forall>z \<in> A. R x y \<longrightarrow> R y z \<longrightarrow> R x z" and
     in_mult: "(M, N) \<in> mult {(x, y). x \<in> A \<and> y \<in> A \<and> R x y}"
   shows "less_multiset_ext\<^sub>D\<^sub>M R M N"
   using in_mult N_A M_A unfolding mult_def less_multiset_ext\<^sub>D\<^sub>M_def
 proof induct
   case (base N)
   then obtain y M0 X where "N = add_mset y M0" and "M = M0 + X" and "\<forall>a. a \<in># X \<longrightarrow> R a y"
     unfolding mult1_def by auto
   thus ?case
     by (auto intro: exI[of _ "{#y#}"])
 next
   case (step N N')
   note N_N'_in_mult1 = this(2) and ih = this(3) and N'_A = this(4) and M_A = this(5)
 
   have N_A: "set_mset N \<subseteq> A"
     using N_N'_in_mult1 N'_A unfolding mult1_def by auto
 
   obtain Y X where y_nemp: "Y \<noteq> {#}" and y_sub_N: "Y \<subseteq># N" and M_eq: "M = N - Y + X" and
     ex_y: "\<forall>x. x \<in># X \<longrightarrow> (\<exists>y. y \<in># Y \<and> R x y)"
     using ih[OF N_A M_A] by blast
 
   obtain z M0 Ya where N'_eq: "N' = M0 + {#z#}" and N_eq: "N = M0 + Ya" and
     z_gt: "\<forall>y. y \<in># Ya \<longrightarrow> y \<in> A \<and> z \<in> A \<and> R y z"
     using N_N'_in_mult1[unfolded mult1_def] by auto
 
   let ?Za = "Y - Ya + {#z#}"
   let ?Xa = "X + Ya + (Y - Ya) - Y"
 
   have xa_sub_x_ya: "set_mset ?Xa \<subseteq> set_mset (X + Ya)"
     by (metis diff_subset_eq_self in_diffD subsetI subset_mset.diff_diff_right)
 
   have x_A: "set_mset X \<subseteq> A"
     using M_A M_eq by auto
   have ya_A: "set_mset Ya \<subseteq> A"
     by (simp add: subsetI z_gt)
 
   have ex_y': "\<exists>y. y \<in># Y - Ya + {#z#} \<and> R x y" if x_in: "x \<in># X + Ya" for x
   proof (cases "x \<in># X")
     case True
     then obtain y where y_in: "y \<in># Y" and y_gt_x: "R x y"
       using ex_y by blast
     show ?thesis
     proof (cases "y \<in># Ya")
       case False
       hence "y \<in># Y - Ya + {#z#}"
         using y_in count_greater_zero_iff in_diff_count by fastforce
       thus ?thesis
         using y_gt_x by blast
     next
       case True
       hence "y \<in> A" and "z \<in> A" and "R y z"
         using z_gt by blast+
       hence "R x z"
         using trans y_gt_x x_A ya_A x_in by (meson subsetCE union_iff)
       thus ?thesis
         by auto
     qed
   next
     case False
     hence "x \<in># Ya"
       using x_in by auto
     hence "x \<in> A" and "z \<in> A" and "R x z"
       using z_gt by blast+
     thus ?thesis
       by auto
   qed
 
   show ?case
   proof (rule exI[of _ ?Za], rule exI[of _ ?Xa], intro conjI)
     show "Y - Ya + {#z#} \<subseteq># N'"
       using mset_subset_eq_mono_add subset_eq_diff_conv y_sub_N N_eq N'_eq
       by (simp add: subset_eq_diff_conv)
   next
     show "M = N' - (Y - Ya + {#z#}) + (X + Ya + (Y - Ya) - Y)"
       unfolding M_eq N_eq N'_eq by (auto simp: multiset_eq_iff)
   next
     show "\<forall>x. x \<in># X + Ya + (Y - Ya) - Y \<longrightarrow> (\<exists>y. y \<in># Y - Ya + {#z#} \<and> R x y)"
       using ex_y' xa_sub_x_ya by blast
   qed auto
 qed
 
 lemma less_multiset_ext\<^sub>D\<^sub>M_iff_mult:
   assumes
     N_A: "set_mset N \<subseteq> A" and M_A: "set_mset M \<subseteq> A" and
     trans: "\<forall>x \<in> A. \<forall>y \<in> A. \<forall>z \<in> A. R x y \<longrightarrow> R y z \<longrightarrow> R x z"
   shows "less_multiset_ext\<^sub>D\<^sub>M R M N \<longleftrightarrow> (M, N) \<in> mult {(x, y). x \<in> A \<and> y \<in> A \<and> R x y}"
   using mult_imp_less_multiset_ext\<^sub>D\<^sub>M[OF assms] less_multiset_ext\<^sub>D\<^sub>M_imp_mult[OF N_A M_A] by blast
 
+lemma sub_nmset_lex: "((a,b),(c,d)) \<in> sub_nmset <*lex*> sub_nmset \<longleftrightarrow> (a,c) \<in> sub_nmset \<or> a=c \<and> (b,d) \<in> sub_nmset"
+  by auto
+
 instantiation nmultiset :: (preorder) preorder
 begin
 
 lemma less_multiset_ext\<^sub>D\<^sub>M_cong[fundef_cong]:
   "(\<And>X Y k a. X \<noteq> {#} \<Longrightarrow> X \<subseteq># N \<Longrightarrow> M = (N - X) + Y \<Longrightarrow> k \<in># Y \<Longrightarrow> R k a = S k a) \<Longrightarrow>
   less_multiset_ext\<^sub>D\<^sub>M R M N = less_multiset_ext\<^sub>D\<^sub>M S M N"
   unfolding less_multiset_ext\<^sub>D\<^sub>M_def by metis
 
 function less_nmultiset :: "'a nmultiset \<Rightarrow> 'a nmultiset \<Rightarrow> bool" where
   "less_nmultiset (Elem a) (Elem b) \<longleftrightarrow> a < b"
 | "less_nmultiset (Elem a) (MSet M) \<longleftrightarrow> True"
 | "less_nmultiset (MSet M) (Elem a) \<longleftrightarrow> False"
 | "less_nmultiset (MSet M) (MSet N) \<longleftrightarrow> less_multiset_ext\<^sub>D\<^sub>M less_nmultiset M N"
   by pat_completeness auto
 termination
-  by (relation "sub_nmset <*lex*> sub_nmset", fastforce,
-    metis sub_nmset.simps in_lex_prod mset_subset_eqD mset_subset_eq_add_right)
+  apply(relation "sub_nmset <*lex*> sub_nmset", force)
+  by (meson sub_nmset_lex sub_nmset.intros union_iff)
 
 lemmas less_nmultiset_induct =
   less_nmultiset.induct[case_names Elem_Elem Elem_MSet MSet_Elem MSet_MSet]
 
 lemmas less_nmultiset_cases =
   less_nmultiset.cases[case_names Elem_Elem Elem_MSet MSet_Elem MSet_MSet]
 
 lemma trans_less_nmultiset: "X < Y \<Longrightarrow> Y < Z \<Longrightarrow> X < Z" for X Y Z :: "'a nmultiset"
 proof (induct "Max {|X|, |Y|, |Z|}" arbitrary: X Y Z
     rule: less_induct)
   case less
   from less(2,3) show ?case
   proof (cases X; cases Y; cases Z)
     fix M N N' :: "'a nmultiset multiset"
     define A where "A = set_mset M \<union> set_mset N \<union> set_mset N'"
     assume XYZ: "X = MSet M" "Y = MSet N" "Z = MSet N'"
     then have trans: "\<forall>x \<in> A. \<forall>y \<in> A. \<forall>z \<in> A. x < y \<longrightarrow> y < z \<longrightarrow> x < z"
       by (auto elim!: less(1)[rotated -1] dest!: depth_nmset_MSet simp add: A_def)
     have "set_mset M \<subseteq> A" "set_mset N \<subseteq> A" "set_mset N' \<subseteq> A"
       unfolding A_def by auto
     with less(2,3) XYZ show "X < Z"
       by (auto simp: less_multiset_ext\<^sub>D\<^sub>M_iff_mult[OF _ _ trans] mult_def)
   qed (auto elim: less_trans)
 qed
 
 lemma irrefl_less_nmultiset:
   fixes X :: "'a nmultiset"
   shows "X < X \<Longrightarrow> False"
 proof (induct X)
   case (MSet M)
   from MSet(2) show ?case
   unfolding less_nmultiset.simps less_multiset_ext\<^sub>D\<^sub>M_def
   proof safe
     fix X Y :: "'a nmultiset multiset"
     define XY where "XY = {(x, y). x \<in># X \<and> y \<in># Y \<and> y < x}"
     then have fin: "finite XY" and trans: "trans XY"
       by (auto simp: trans_def intro: trans_less_nmultiset
         finite_subset[OF _ finite_cartesian_product])
     assume "X \<noteq> {#}" "X \<subseteq># M" "M = M - X + Y"
     then have "X = Y"
       by (auto simp: mset_subset_eq_exists_conv)
     with MSet(1) \<open>X \<subseteq># M\<close> have "irrefl XY"
       unfolding XY_def by (force dest: mset_subset_eqD simp: irrefl_def)
     with trans have "acyclic XY"
       by (simp add: acyclic_irrefl)
     moreover
     assume "\<forall>k. k \<in># Y \<longrightarrow> (\<exists>a. a \<in># X \<and> k < a)"
     with \<open>X = Y\<close> \<open>X \<noteq> {#}\<close> have "\<not> acyclic XY"
       by (intro notI, elim finite_acyclic_wf[OF fin, elim_format])
         (auto dest!: spec[of _ "set_mset Y"] simp: wf_eq_minimal XY_def)
     ultimately show False by blast
   qed
 qed simp
 
 lemma antisym_less_nmultiset:
   fixes X Y :: "'a nmultiset"
   shows "X < Y \<Longrightarrow> Y < X \<Longrightarrow> False"
   using trans_less_nmultiset irrefl_less_nmultiset by blast
 
 definition less_eq_nmultiset :: "'a nmultiset \<Rightarrow> 'a nmultiset \<Rightarrow> bool" where
   "less_eq_nmultiset X Y = (X < Y \<or> X = Y)"
 
 instance
 proof (intro_classes, goal_cases less_def refl trans)
   case (less_def x y)
   then show ?case
     unfolding less_eq_nmultiset_def by (metis irrefl_less_nmultiset antisym_less_nmultiset)
 next
   case (refl x)
   then show ?case
     unfolding less_eq_nmultiset_def by blast
 next
   case (trans x y z)
   then show ?case
     unfolding less_eq_nmultiset_def by (metis trans_less_nmultiset)
 qed
 
 lemma less_multiset_ext\<^sub>D\<^sub>M_less: "less_multiset_ext\<^sub>D\<^sub>M (<) = (<)"
   unfolding fun_eq_iff less_multiset_ext\<^sub>D\<^sub>M_def less_multiset\<^sub>D\<^sub>M by blast
 
 end
 
 instantiation nmultiset :: (order) order
 begin
 
 instance
 proof (intro_classes, goal_cases antisym)
   case (antisym x y)
   then show ?case
     unfolding less_eq_nmultiset_def by (metis trans_less_nmultiset irrefl_less_nmultiset)
 qed
 
 end
 
 instantiation nmultiset :: (linorder) linorder
 begin
 
 lemma total_less_nmultiset:
   fixes X Y :: "'a nmultiset"
   shows "\<not> X < Y \<Longrightarrow> Y \<noteq> X \<Longrightarrow> Y < X"
 proof (induct X Y rule: less_nmultiset_induct)
   case (MSet_MSet M N)
   then show ?case
     unfolding nmultiset.inject less_nmultiset.simps less_multiset_ext\<^sub>D\<^sub>M_less less_multiset\<^sub>H\<^sub>O
     by (metis add_diff_cancel_left' count_inI diff_add_zero in_diff_count less_imp_not_less
       mset_subset_eq_multiset_union_diff_commute subset_mset.order.refl)
 qed auto
 
 instance
 proof (intro_classes, goal_cases total)
   case (total x y)
   then show ?case
     unfolding less_eq_nmultiset_def by (metis total_less_nmultiset)
 qed
 
 end
 
 lemma less_depth_nmset_imp_less_nmultiset: "|X| < |Y| \<Longrightarrow> X < Y"
 proof (induct X Y rule: less_nmultiset_induct)
   case (MSet_MSet M N)
   then show ?case
   proof (cases "M = {#}")
     case False
     with MSet_MSet show ?thesis
       by (auto 0 4 simp: depth_nmset.simps(2) less_multiset_ext\<^sub>D\<^sub>M_def not_le Max_gr_iff
         intro: exI[of _ N] split: if_splits)
   qed (auto simp: depth_nmset.simps(2) less_multiset_ext\<^sub>D\<^sub>M_less split: if_splits)
 qed simp_all
 
 lemma less_nmultiset_imp_le_depth_nmset: "X < Y \<Longrightarrow> |X| \<le> |Y|"
 proof (induct X Y rule: less_nmultiset_induct)
   case (MSet_MSet M N)
   then have "M < N" by (simp add: less_multiset_ext\<^sub>D\<^sub>M_less)
   then show ?case
   proof (cases "M = {#}" "N = {#}" rule: bool.exhaust[case_product bool.exhaust])
     case [simp]: False_False
     show ?thesis
     unfolding depth_nmset.simps(2) Let_def False_False Suc_le_mono set_image_mset image_is_empty
       set_mset_eq_empty_iff if_False
     proof (intro iffD2[OF Max_le_iff] ballI iffD2[OF Max_ge_iff]; (elim imageE)?; simp)
       fix X
       assume [simp]: "X \<in># M"
       with MSet_MSet(1)[of N M X, simplified] \<open>M < N\<close> show "\<exists>Y\<in>#N. |X| \<le> |Y|"
         by (meson ex_gt_imp_less_multiset less_asym' less_depth_nmset_imp_less_nmultiset
           not_le_imp_less)
     qed
   qed (auto simp: depth_nmset.simps(2))
 qed simp_all
 
 lemma eq_mlex_I:
   fixes f :: "'a \<Rightarrow> nat" and R :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
   assumes "\<And>X Y. f X < f Y \<Longrightarrow> R X Y" and "antisymp R"
   shows "{(X, Y). R X Y} = f <*mlex*> {(X, Y). f X = f Y \<and> R X Y}"
 proof safe
   fix X Y
   assume "R X Y"
   show "(X, Y) \<in> f <*mlex*> {(X, Y). f X = f Y \<and> R X Y}"
   proof (cases "f X" "f Y" rule: linorder_cases)
     case less
     with \<open>R X Y\<close> show ?thesis
       by (elim mlex_less)
   next
     case equal
     with \<open>R X Y\<close> show ?thesis
       by (intro mlex_leq) auto
   next
     case greater
     from \<open>R X Y\<close> assms(1)[OF greater] \<open>antisymp R\<close> greater show ?thesis
       unfolding antisymp_def by auto
   qed
 next
   fix X Y
   assume "(X, Y) \<in> f <*mlex*> {(X, Y). f X = f Y \<and> R X Y}"
   then show "R X Y"
     unfolding mlex_prod_def by (auto simp: assms(1))
 qed
 
 instantiation nmultiset :: (wellorder) wellorder
 begin
 
 lemma depth_nmset_eq_0[simp]: "|X| = 0 \<longleftrightarrow> (X = MSet {#} \<or> (\<exists>x. X = Elem x))"
   by (cases X; simp add: depth_nmset.simps(2))
 
 lemma depth_nmset_eq_Suc[simp]: "|X| = Suc n \<longleftrightarrow>
   (\<exists>N. X = MSet N \<and> (\<exists>Y \<in># N. |Y| = n) \<and> (\<forall>Y \<in># N. |Y| \<le> n))"
   by (cases X; auto simp add: depth_nmset.simps(2) intro!: Max_eqI)
     (metis (no_types, lifting) Max_in finite_imageI finite_set_mset imageE image_is_empty
       set_mset_eq_empty_iff)
 
 lemma wf_less_nmultiset_depth:
   "wf {(X :: 'a nmultiset, Y). |X| = i \<and> |Y| = i \<and> X < Y}"
 proof (induct i rule: less_induct)
   case (less i)
   define A :: "'a nmultiset set" where "A = {X. |X| < i}"
   from less have "wf ((depth_nmset :: 'a nmultiset \<Rightarrow> nat) <*mlex*>
       (\<Union>j < i. {(X, Y). |X| = j \<and> |Y| = j \<and> X < Y}))"
     by (intro wf_UN wf_mlex) auto
   then have *: "wf (mult {(X :: 'a nmultiset, Y). X \<in> A \<and> Y \<in> A \<and> X < Y})"
     by (intro wf_mult, elim wf_subset) (force simp: A_def mlex_prod_def not_less_iff_gr_or_eq
       dest!: less_depth_nmset_imp_less_nmultiset)
   show ?case
   proof (cases i)
     case 0
     then show ?thesis
       by (auto simp: inj_on_def intro!: wf_subset[OF
         wf_Un[OF wf_map_prod_image[OF wf, of Elem] wf_UN[of "Elem ` UNIV" "\<lambda>x. {(x, MSet {#})}"]]])
   next
     case (Suc n)
     then show ?thesis
       by (intro wf_subset[OF wf_map_prod_image[OF *, of MSet]])
         (auto 0 4 simp: map_prod_def image_iff inj_on_def A_def
           dest!: less_multiset_ext\<^sub>D\<^sub>M_imp_mult[of _ A, rotated -1] split: prod.splits)
   qed
 qed
 
 lemma wf_less_nmultiset: "wf {(X :: 'a nmultiset, Y :: 'a nmultiset). X < Y}" (is "wf ?R")
 proof -
   have "?R = depth_nmset <*mlex*> {(X, Y). |X| = |Y| \<and> X < Y}"
     by (rule eq_mlex_I) (auto simp: antisymp_def less_depth_nmset_imp_less_nmultiset)
   also have "{(X, Y). |X| = |Y| \<and> X < Y} = (\<Union>i. {(X, Y). |X| = i \<and> |Y| = i \<and> X < Y})"
     by auto
   finally show ?thesis
     by (fastforce intro: wf_mlex wf_Union wf_less_nmultiset_depth)
 qed
 
 instance using wf_less_nmultiset unfolding wf_def mem_Collect_eq prod.case by intro_classes metis
 
 end
 
 end
diff --git a/thys/UTP/toolkit/List_Extra.thy b/thys/UTP/toolkit/List_Extra.thy
--- a/thys/UTP/toolkit/List_Extra.thy
+++ b/thys/UTP/toolkit/List_Extra.thy
@@ -1,890 +1,869 @@
 (******************************************************************************)
 (* Project: Isabelle/UTP Toolkit                                              *)
 (* File: List_Extra.thy                                                       *)
 (* Authors: Simon Foster and Frank Zeyda                                      *)
 (* Emails: simon.foster@york.ac.uk and frank.zeyda@york.ac.uk                 *)
 (******************************************************************************)
 
 section \<open> Lists: extra functions and properties \<close>
 
 theory List_Extra
   imports
   "HOL-Library.Sublist"
   "HOL-Library.Monad_Syntax"
   "HOL-Library.Prefix_Order"
   "Optics.Lens_Instances"
 begin
 
 subsection \<open> Useful Abbreviations \<close>
 
 abbreviation "list_sum xs \<equiv> foldr (+) xs 0"
 
 subsection \<open> Folds \<close>
 
 context abel_semigroup
 begin
 
   lemma foldr_snoc: "foldr (\<^bold>*) (xs @ [x]) k = (foldr (\<^bold>*) xs k) \<^bold>* x"
     by (induct xs, simp_all add: commute left_commute)
   
 end
 
 subsection \<open> List Lookup \<close>
 
 text \<open>
   The following variant of the standard \<open>nth\<close> function returns \<open>\<bottom>\<close> if the index is 
   out of range.
 \<close>
 
 primrec
   nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" ("_\<langle>_\<rangle>\<^sub>l" [90, 0] 91)
 where
   "[]\<langle>i\<rangle>\<^sub>l = None"
 | "(x # xs)\<langle>i\<rangle>\<^sub>l = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>\<^sub>l)"
 
 lemma nth_el_appendl[simp]: "i < length xs \<Longrightarrow> (xs @ ys)\<langle>i\<rangle>\<^sub>l = xs\<langle>i\<rangle>\<^sub>l"
   apply (induct xs arbitrary: i)
    apply simp
   apply (case_tac i)
    apply simp_all
   done
 
 lemma nth_el_appendr[simp]: "length xs \<le> i \<Longrightarrow> (xs @ ys)\<langle>i\<rangle>\<^sub>l = ys\<langle>i - length xs\<rangle>\<^sub>l"
   apply (induct xs arbitrary: i)
    apply simp
   apply (case_tac i)
    apply simp_all
   done
 
 subsection \<open> Extra List Theorems \<close>
 
 subsubsection \<open> Map \<close>
 
 lemma map_nth_Cons_atLeastLessThan:
   "map (nth (x # xs)) [Suc m..<n] = map (nth xs) [m..<n - 1]"
 proof -
   have "nth xs = nth (x # xs) \<circ> Suc"
     by auto
   hence "map (nth xs) [m..<n - 1] = map (nth (x # xs) \<circ> Suc) [m..<n - 1]"
     by simp
   also have "... = map (nth (x # xs)) (map Suc [m..<n - 1])"
     by simp
   also have "... = map (nth (x # xs)) [Suc m..<n]"
     by (metis Suc_diff_1 le_0_eq length_upt list.simps(8) list.size(3) map_Suc_upt not_less upt_0)
   finally show ?thesis ..
 qed
 
 subsubsection \<open> Sorted Lists \<close>
 
 lemma sorted_last [simp]: "\<lbrakk> x \<in> set xs; sorted xs \<rbrakk> \<Longrightarrow> x \<le> last xs"
   by (induct xs, auto)
 
 lemma sorted_prefix:
   assumes "xs \<le> ys" "sorted ys"
   shows "sorted xs"
 proof -
   obtain zs where "ys = xs @ zs"
     using Prefix_Order.prefixE assms(1) by auto
   thus ?thesis
     using assms(2) sorted_append by blast
 qed
 
 lemma sorted_map: "\<lbrakk> sorted xs; mono f \<rbrakk> \<Longrightarrow> sorted (map f xs)"
   by (simp add: monoD sorted_iff_nth_mono)
 
 lemma sorted_distinct [intro]: "\<lbrakk> sorted (xs); distinct(xs) \<rbrakk> \<Longrightarrow> (\<forall> i<length xs - 1. xs!i < xs!(i + 1))"
   apply (induct xs)
    apply (auto)
   apply (metis (no_types, hide_lams) Suc_leI Suc_less_eq Suc_pred gr0_conv_Suc not_le not_less_iff_gr_or_eq nth_Cons_Suc nth_mem nth_non_equal_first_eq)
   done
 
 text \<open> Is the given list a permutation of the given set? \<close>
 
 definition is_sorted_list_of_set :: "('a::ord) set \<Rightarrow> 'a list \<Rightarrow> bool" where
 "is_sorted_list_of_set A xs = ((\<forall> i<length(xs) - 1. xs!i < xs!(i + 1)) \<and> set(xs) = A)"
 
 lemma sorted_is_sorted_list_of_set:
   assumes "is_sorted_list_of_set A xs"
   shows "sorted(xs)" and "distinct(xs)"
 using assms proof (induct xs arbitrary: A)
   show "sorted []"
     by auto
 next
   show "distinct []"
     by auto
 next
   fix A :: "'a set"
   case (Cons x xs) note hyps = this
   assume isl: "is_sorted_list_of_set A (x # xs)"
   hence srt: "(\<forall>i<length xs - Suc 0. xs ! i < xs ! Suc i)"
     using less_diff_conv by (auto simp add: is_sorted_list_of_set_def)
   with hyps(1) have srtd: "sorted xs"
     by (simp add: is_sorted_list_of_set_def)
   with isl show "sorted (x # xs)"
     apply (auto simp add: is_sorted_list_of_set_def)
     apply (metis (mono_tags, lifting) all_nth_imp_all_set less_le_trans linorder_not_less not_less_iff_gr_or_eq nth_Cons_0 sorted_iff_nth_mono zero_order(3))
     done
   from srt hyps(2) have "distinct xs"
     by (simp add: is_sorted_list_of_set_def)
   with isl show "distinct (x # xs)"
   proof -
     have "(\<forall>n. \<not> n < length (x # xs) - 1 \<or> (x # xs) ! n < (x # xs) ! (n + 1)) \<and> set (x # xs) = A"
       by (meson \<open>is_sorted_list_of_set A (x # xs)\<close> is_sorted_list_of_set_def)
   then show ?thesis
     by (metis \<open>distinct xs\<close> add.commute add_diff_cancel_left' distinct.simps(2) leD length_Cons length_greater_0_conv length_pos_if_in_set less_le nth_Cons_0 nth_Cons_Suc plus_1_eq_Suc set_ConsD sorted.elims(2) srtd)    
   qed
 qed
 
 lemma is_sorted_list_of_set_alt_def:
   "is_sorted_list_of_set A xs \<longleftrightarrow> sorted (xs) \<and> distinct (xs) \<and> set(xs) = A"
   apply (auto intro: sorted_is_sorted_list_of_set)
     apply (auto simp add: is_sorted_list_of_set_def)
   apply (metis Nat.add_0_right One_nat_def add_Suc_right sorted_distinct)
   done
 
 definition sorted_list_of_set_alt :: "('a::ord) set \<Rightarrow> 'a list" where
 "sorted_list_of_set_alt A =
   (if (A = {}) then [] else (THE xs. is_sorted_list_of_set A xs))"
 
 lemma is_sorted_list_of_set:
   "finite A \<Longrightarrow> is_sorted_list_of_set A (sorted_list_of_set A)"
   by (simp add: is_sorted_list_of_set_alt_def)
 
 lemma sorted_list_of_set_other_def:
   "finite A \<Longrightarrow> sorted_list_of_set(A) = (THE xs. sorted(xs) \<and> distinct(xs) \<and> set xs = A)"
   apply (rule sym)
   apply (rule the_equality)
    apply (auto)
   apply (simp add: sorted_distinct_set_unique)
   done
 
 lemma sorted_list_of_set_alt [simp]:
   "finite A \<Longrightarrow> sorted_list_of_set_alt(A) = sorted_list_of_set(A)"
   apply (rule sym)
   apply (auto simp add: sorted_list_of_set_alt_def is_sorted_list_of_set_alt_def sorted_list_of_set_other_def)
   done
 
 text \<open> Sorting lists according to a relation \<close>
 
 definition is_sorted_list_of_set_by :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a list \<Rightarrow> bool" where
 "is_sorted_list_of_set_by R A xs = ((\<forall> i<length(xs) - 1. (xs!i, xs!(i + 1)) \<in> R) \<and> set(xs) = A)"
 
 definition sorted_list_of_set_by :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a list" where
 "sorted_list_of_set_by R A = (THE xs. is_sorted_list_of_set_by R A xs)"
 
 definition fin_set_lexord :: "'a rel \<Rightarrow> 'a set rel" where
 "fin_set_lexord R = {(A, B). finite A \<and> finite B \<and>
                              (\<exists> xs ys. is_sorted_list_of_set_by R A xs \<and> is_sorted_list_of_set_by R B ys
                               \<and> (xs, ys) \<in> lexord R)}"
 
 lemma is_sorted_list_of_set_by_mono:
   "\<lbrakk> R \<subseteq> S; is_sorted_list_of_set_by R A xs \<rbrakk> \<Longrightarrow> is_sorted_list_of_set_by S A xs"
   by (auto simp add: is_sorted_list_of_set_by_def)
 
 lemma lexord_mono':
   "\<lbrakk> (\<And> x y. f x y \<longrightarrow> g x y); (xs, ys) \<in> lexord {(x, y). f x y} \<rbrakk> \<Longrightarrow> (xs, ys) \<in> lexord {(x, y). g x y}"
   by (metis case_prodD case_prodI lexord_take_index_conv mem_Collect_eq)
 
 lemma fin_set_lexord_mono [mono]:
   "(\<And> x y. f x y \<longrightarrow> g x y) \<Longrightarrow> (xs, ys) \<in> fin_set_lexord {(x, y). f x y} \<longrightarrow> (xs, ys) \<in> fin_set_lexord {(x, y). g x y}"
 proof
   assume
     fin: "(xs, ys) \<in> fin_set_lexord {(x, y). f x y}" and
     hyp: "(\<And> x y. f x y \<longrightarrow> g x y)"
 
   from fin have "finite xs" "finite ys"
     using fin_set_lexord_def by fastforce+
 
   with fin hyp show "(xs, ys) \<in> fin_set_lexord {(x, y). g x y}"
     apply (auto simp add: fin_set_lexord_def)
     apply (rename_tac xs' ys')
     apply (rule_tac x="xs'" in exI)
     apply (auto)
      apply (metis case_prodD case_prodI is_sorted_list_of_set_by_def mem_Collect_eq)
     apply (metis case_prodD case_prodI is_sorted_list_of_set_by_def lexord_mono' mem_Collect_eq)
     done
 qed
 
 definition distincts :: "'a set \<Rightarrow> 'a list set" where
 "distincts A = {xs \<in> lists A. distinct(xs)}"
 
 lemma tl_element:
   "\<lbrakk> x \<in> set xs; x \<noteq> hd(xs) \<rbrakk> \<Longrightarrow> x \<in> set(tl(xs))"
   by (metis in_set_insert insert_Nil list.collapse list.distinct(2) set_ConsD)
 
 subsubsection \<open> List Update \<close>
 
 lemma listsum_update:
   fixes xs :: "'a::ring list"
   assumes "i < length xs"
   shows "list_sum (xs[i := v]) = list_sum xs - xs ! i + v"
 using assms proof (induct xs arbitrary: i)
   case Nil
   then show ?case by (simp)
 next
   case (Cons a xs)
   then show ?case
   proof (cases i)
     case 0
     thus ?thesis
       by (simp add: add.commute) 
   next
     case (Suc i')
     with Cons show ?thesis
       by (auto)
   qed
 qed
 
 subsubsection \<open> Drop While and Take While \<close>
 
 
 lemma dropWhile_sorted_le_above:
   "\<lbrakk> sorted xs; x \<in> set (dropWhile (\<lambda> x. x \<le> n) xs) \<rbrakk> \<Longrightarrow> x > n"
   apply (induct xs)
    apply (auto)
   apply (rename_tac a xs)
   apply (case_tac "a \<le> n")
    apply (auto)
 done
 
 lemma set_dropWhile_le:
   "sorted xs \<Longrightarrow> set (dropWhile (\<lambda> x. x \<le> n) xs) = {x\<in>set xs. x > n}"
   apply (induct xs)
    apply (simp)
   apply (rename_tac x xs)
   apply (subgoal_tac "sorted xs")
    apply (simp)
    apply (safe)
      apply (auto)
 done
 
 lemma set_takeWhile_less_sorted:
   "\<lbrakk> sorted I; x \<in> set I; x < n \<rbrakk> \<Longrightarrow> x \<in> set (takeWhile (\<lambda>x. x < n) I)"
 proof (induct I arbitrary: x)
   case Nil thus ?case
     by (simp)
 next
   case (Cons a I) thus ?case
     by auto
 qed
 
 lemma nth_le_takeWhile_ord: "\<lbrakk> sorted xs; i \<ge> length (takeWhile (\<lambda> x. x \<le> n) xs); i < length xs \<rbrakk> \<Longrightarrow> n \<le> xs ! i"
   apply (induct xs arbitrary: i, auto)
   apply (rename_tac x xs i)
   apply (case_tac "x \<le> n")
    apply (auto)
   apply (metis One_nat_def Suc_eq_plus1 le_less_linear le_less_trans less_imp_le list.size(4) nth_mem set_ConsD)
   done
 
 lemma length_takeWhile_less:
   "\<lbrakk> a \<in> set xs; \<not> P a \<rbrakk> \<Longrightarrow> length (takeWhile P xs) < length xs"
   by (metis in_set_conv_nth length_takeWhile_le nat_neq_iff not_less set_takeWhileD takeWhile_nth)
 
 lemma nth_length_takeWhile_less:
   "\<lbrakk> sorted xs; distinct xs; (\<exists> a \<in> set xs. a \<ge> n) \<rbrakk> \<Longrightarrow> xs ! length (takeWhile (\<lambda>x. x < n) xs) \<ge> n"
   by (induct xs, auto)
 
 subsubsection \<open> Last and But Last \<close>
 
 lemma length_gt_zero_butlast_concat:
   assumes "length ys > 0"
   shows "butlast (xs @ ys) = xs @ (butlast ys)"
   using assms by (metis butlast_append length_greater_0_conv)
 
 lemma length_eq_zero_butlast_concat:
   assumes "length ys = 0"
   shows "butlast (xs @ ys) = butlast xs"
   using assms by (metis append_Nil2 length_0_conv)
 
 lemma butlast_single_element:
   shows "butlast [e] = []"
   by (metis butlast.simps(2))
 
 lemma last_single_element:
   shows "last [e] = e"
   by (metis last.simps)
 
 lemma length_zero_last_concat:
   assumes "length t = 0"
   shows "last (s @ t) = last s"
   by (metis append_Nil2 assms length_0_conv)
 
 lemma length_gt_zero_last_concat:
   assumes "length t > 0"
   shows "last (s @ t) = last t"
   by (metis assms last_append length_greater_0_conv)
 
 subsubsection \<open> Prefixes and Strict Prefixes \<close>
 
 lemma prefix_length_eq:
   "\<lbrakk> length xs = length ys; prefix xs ys \<rbrakk> \<Longrightarrow> xs = ys"
   by (metis not_equal_is_parallel parallel_def)
 
 lemma prefix_Cons_elim [elim]:
   assumes "prefix (x # xs) ys"
   obtains ys' where "ys = x # ys'" "prefix xs ys'"
   using assms
   by (metis append_Cons prefix_def)
 
 lemma prefix_map_inj:
   "\<lbrakk> inj_on f (set xs \<union> set ys); prefix (map f xs) (map f ys) \<rbrakk> \<Longrightarrow>
    prefix xs ys"
   apply (induct xs arbitrary:ys)
    apply (simp_all)
   apply (erule prefix_Cons_elim)
   apply (auto)
   apply (metis image_insert insertI1 insert_Diff_if singletonE)
   done
 
 lemma prefix_map_inj_eq [simp]:
   "inj_on f (set xs \<union> set ys) \<Longrightarrow>
    prefix (map f xs) (map f ys) \<longleftrightarrow> prefix xs ys"
   using map_mono_prefix prefix_map_inj by blast
 
 lemma strict_prefix_Cons_elim [elim]:
   assumes "strict_prefix (x # xs) ys"
   obtains ys' where "ys = x # ys'" "strict_prefix xs ys'"
   using assms
   by (metis Sublist.strict_prefixE' Sublist.strict_prefixI' append_Cons)
 
 lemma strict_prefix_map_inj:
   "\<lbrakk> inj_on f (set xs \<union> set ys); strict_prefix (map f xs) (map f ys) \<rbrakk> \<Longrightarrow>
    strict_prefix xs ys"
   apply (induct xs arbitrary:ys)
    apply (auto)
   using prefix_bot.bot.not_eq_extremum apply fastforce
   apply (erule strict_prefix_Cons_elim)
   apply (auto)
   apply (metis (hide_lams, full_types) image_insert insertI1 insert_Diff_if singletonE)
   done
 
 lemma strict_prefix_map_inj_eq [simp]:
   "inj_on f (set xs \<union> set ys) \<Longrightarrow>
    strict_prefix (map f xs) (map f ys) \<longleftrightarrow> strict_prefix xs ys"
   by (simp add: inj_on_map_eq_map strict_prefix_def)
 
 lemma prefix_drop:
   "\<lbrakk> drop (length xs) ys = zs; prefix xs ys \<rbrakk>
    \<Longrightarrow> ys = xs @ zs"
   by (metis append_eq_conv_conj prefix_def)
 
 lemma list_append_prefixD [dest]: "x @ y \<le> z \<Longrightarrow> x \<le> z"
   using append_prefixD less_eq_list_def by blast
 
 lemma prefix_not_empty:
   assumes "strict_prefix xs ys" and "xs \<noteq> []"
   shows "ys \<noteq> []"
   using Sublist.strict_prefix_simps(1) assms(1) by blast
 
 lemma prefix_not_empty_length_gt_zero:
   assumes "strict_prefix xs ys" and "xs \<noteq> []"
   shows "length ys > 0"
   using assms prefix_not_empty by auto
 
 lemma butlast_prefix_suffix_not_empty:
   assumes "strict_prefix (butlast xs) ys"
   shows "ys \<noteq> []"
   using assms prefix_not_empty_length_gt_zero by fastforce
 
 lemma prefix_and_concat_prefix_is_concat_prefix:
   assumes "prefix s t" "prefix (e @ t) u"
   shows "prefix (e @ s) u"
   using Sublist.same_prefix_prefix assms(1) assms(2) prefix_order.dual_order.trans by blast
 
 lemma prefix_eq_exists:
   "prefix s t \<longleftrightarrow> (\<exists>xs . s @ xs = t)"
   using prefix_def by auto
 
 lemma strict_prefix_eq_exists:
   "strict_prefix s t \<longleftrightarrow> (\<exists>xs . s @ xs = t \<and> (length xs) > 0)"
   using prefix_def strict_prefix_def by auto
 
 lemma butlast_strict_prefix_eq_butlast:
   assumes "length s = length t" and "strict_prefix (butlast s) t"
   shows "strict_prefix (butlast s) t \<longleftrightarrow> (butlast s) = (butlast t)"
   by (metis append_butlast_last_id append_eq_append_conv assms(1) assms(2) length_0_conv length_butlast strict_prefix_eq_exists)
 
 lemma butlast_eq_if_eq_length_and_prefix:
   assumes "length s > 0" "length z > 0"
           "length s = length z" "strict_prefix (butlast s) t" "strict_prefix (butlast z) t"
   shows   "(butlast s) = (butlast z)"
   using assms by (auto simp add:strict_prefix_eq_exists)
 
-lemma prefix_imp_length_lteq:
-  assumes "prefix s t"
-  shows "length s \<le> length t"
-  using assms by (simp add: Sublist.prefix_length_le)
-
-lemma prefix_imp_length_not_gt:
-  assumes "prefix s t"
-  shows "\<not> length t < length s"
-  using assms by (simp add: Sublist.prefix_length_le leD)
-
-lemma prefix_and_eq_length_imp_eq_list:
-  assumes "prefix s t" and "length t = length s"
-  shows "s=t"
-  using assms by (simp add: prefix_length_eq)
-
 lemma butlast_prefix_imp_length_not_gt:
   assumes "length s > 0" "strict_prefix (butlast s) t"
   shows "\<not> (length t < length s)"
   using assms prefix_length_less by fastforce
 
 lemma length_not_gt_iff_eq_length:
   assumes "length s > 0" and "strict_prefix (butlast s) t"
   shows "(\<not> (length s < length t)) = (length s = length t)"
 proof -
   have "(\<not> (length s < length t)) = ((length t < length s) \<or> (length s = length t))"
       by (metis not_less_iff_gr_or_eq)
   also have "... = (length s = length t)"
       using assms
       by (simp add:butlast_prefix_imp_length_not_gt)
 
   finally show ?thesis .
 qed
 
 text \<open> Greatest common prefix \<close>
 
 fun gcp :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
 "gcp [] ys = []" |
 "gcp (x # xs) (y # ys) = (if (x = y) then x # gcp xs ys else [])" |
 "gcp _ _ = []"
 
 lemma gcp_right [simp]: "gcp xs [] = []"
   by (induct xs, auto)
 
 lemma gcp_append [simp]: "gcp (xs @ ys) (xs @ zs) = xs @ gcp ys zs"
   by (induct xs, auto)
 
 lemma gcp_lb1: "prefix (gcp xs ys) xs"
   apply (induct xs arbitrary: ys, auto)
   apply (case_tac ys, auto)
   done
 
 lemma gcp_lb2: "prefix (gcp xs ys) ys"
   apply (induct ys arbitrary: xs, auto)
   apply (case_tac xs, auto)
   done
 
 interpretation prefix_semilattice: semilattice_inf gcp prefix strict_prefix
 proof
   fix xs ys :: "'a list"
   show "prefix (gcp xs ys) xs"
     by (induct xs arbitrary: ys, auto, case_tac ys, auto)
   show "prefix (gcp xs ys) ys"
     by (induct ys arbitrary: xs, auto, case_tac xs, auto)
 next
   fix xs ys zs :: "'a list"
   assume "prefix xs ys" "prefix xs zs"
   thus "prefix xs (gcp ys zs)"
     by (simp add: prefix_def, auto)
 qed
 
 subsubsection \<open> Lexicographic Order \<close>
 
 lemma lexord_append:
   assumes "(xs\<^sub>1 @ ys\<^sub>1, xs\<^sub>2 @ ys\<^sub>2) \<in> lexord R" "length(xs\<^sub>1) = length(xs\<^sub>2)"
   shows "(xs\<^sub>1, xs\<^sub>2) \<in> lexord R \<or> (xs\<^sub>1 = xs\<^sub>2 \<and> (ys\<^sub>1, ys\<^sub>2) \<in> lexord R)"
 using assms
 proof (induct xs\<^sub>2 arbitrary: xs\<^sub>1)
   case (Cons x\<^sub>2 xs\<^sub>2') note hyps = this
   from hyps(3) obtain x\<^sub>1 xs\<^sub>1' where xs\<^sub>1: "xs\<^sub>1 = x\<^sub>1 # xs\<^sub>1'" "length(xs\<^sub>1') = length(xs\<^sub>2')"
     by (auto, metis Suc_length_conv)
   with hyps(2) have xcases: "(x\<^sub>1, x\<^sub>2) \<in> R \<or> (xs\<^sub>1' @ ys\<^sub>1, xs\<^sub>2' @ ys\<^sub>2) \<in> lexord R"
-    by (auto)
+    by (auto split: if_split_asm)
   show ?case
   proof (cases "(x\<^sub>1, x\<^sub>2) \<in> R")
     case True with xs\<^sub>1 show ?thesis
-      by (auto)
+      using Cons.hyps hyps(2) by auto
   next
     case False
     with xcases have "(xs\<^sub>1' @ ys\<^sub>1, xs\<^sub>2' @ ys\<^sub>2) \<in> lexord R"
       by (auto)
     with hyps(1) xs\<^sub>1 have dichot: "(xs\<^sub>1', xs\<^sub>2') \<in> lexord R \<or> (xs\<^sub>1' = xs\<^sub>2' \<and> (ys\<^sub>1, ys\<^sub>2) \<in> lexord R)"
       by (auto)
     have "x\<^sub>1 = x\<^sub>2"
-      using False hyps(2) xs\<^sub>1(1) by auto
+      using False hyps(2) xs\<^sub>1(1) by (auto split: if_split_asm)
     with dichot xs\<^sub>1 show ?thesis
       by (simp)
   qed
 next
   case Nil thus ?case
     by auto
 qed
 
-lemma strict_prefix_lexord_rel:
-  "strict_prefix xs ys \<Longrightarrow> (xs, ys) \<in> lexord R"
-  by (metis Sublist.strict_prefixE' lexord_append_rightI)
-
-lemma strict_prefix_lexord_left:
-  assumes "trans R" "(xs, ys) \<in> lexord R" "strict_prefix xs' xs"
+lemma prefix_lexord_left:
+  assumes "(xs, ys) \<in> lexord R" "prefix xs' xs"
   shows "(xs', ys) \<in> lexord R"
-  by (metis assms lexord_trans strict_prefix_lexord_rel)
+  using assms
+  apply (auto simp: lexord_def prefix_def)
+   apply (metis Nil_is_append_conv list.exhaust)
+  apply (simp add: append_eq_append_conv2)
+  apply (drule_tac x="u" in spec)
+  apply (drule_tac x="a" in spec)
+  apply (drule_tac x="b" in spec)
+  apply (auto simp: )
+   apply (metis hd_Cons_tl hd_append list.sel(1) self_append_conv2)
+  apply (metis Nil_is_append_conv hd_Cons_tl)
+  done
 
 lemma prefix_lexord_right:
-  assumes "trans R" "(xs, ys) \<in> lexord R" "strict_prefix ys ys'"
+  assumes "(xs, ys) \<in> lexord R" "prefix ys ys'"
   shows "(xs, ys') \<in> lexord R"
-  by (metis assms lexord_trans strict_prefix_lexord_rel)
+  using assms by (fastforce simp: lexord_def prefix_def)
+
 
 lemma lexord_eq_length:
   assumes "(xs, ys) \<in> lexord R" "length xs = length ys"
-  shows "\<exists> i. (xs!i, ys!i) \<in> R \<and> i < length xs \<and> (\<forall> j<i. xs!j = ys!j)"
+  shows "\<exists>i. (xs!i, ys!i) \<in> R \<and> xs!i\<noteq>ys!i \<and> i < length xs \<and> (\<forall> j<i. xs!j = ys!j)"
 using assms proof (induct xs arbitrary: ys)
   case (Cons x xs) note hyps = this
   then obtain y ys' where ys: "ys = y # ys'" "length ys' = length xs"
     by (metis Suc_length_conv)
   show ?case
-  proof (cases "(x, y) \<in> R")
-    case True with ys show ?thesis
+  proof (cases "(x,y) \<in> R \<and> x\<noteq>y")
+    case True with ys Cons show ?thesis
       by (rule_tac x="0" in exI, simp)
   next
     case False
     with ys hyps(2) have xy: "x = y" "(xs, ys') \<in> lexord R"
-      by auto
-    with hyps(1,3) ys obtain i where "(xs!i, ys'!i) \<in> R" "i < length xs" "(\<forall> j<i. xs!j = ys'!j)"
+      by (auto split: if_split_asm)
+    with hyps(1,3) ys obtain i where "(xs!i, ys'!i) \<in> R" "xs!i\<noteq>ys'!i" "i < length xs" "(\<forall> j<i. xs!j = ys'!j)"
       by force
     with xy ys show ?thesis
-      apply (rule_tac x="Suc i" in exI)
-      apply (auto simp add: less_Suc_eq_0_disj)
-    done
+      by (rule_tac x="Suc i" in exI) (auto simp add: less_Suc_eq_0_disj)
   qed
 next
   case Nil thus ?case by (auto)
 qed
 
 lemma lexord_intro_elems:
-  assumes "length xs > i" "length ys > i" "(xs!i, ys!i) \<in> R" "\<forall> j<i. xs!j = ys!j"
+  assumes "length xs > i" "length ys > i" "(xs!i, ys!i) \<in> R" "xs!i \<noteq> ys!i" "\<forall>j<i. xs!j = ys!j" 
   shows "(xs, ys) \<in> lexord R"
 using assms proof (induct i arbitrary: xs ys)
   case 0 thus ?case
     by (auto, metis lexord_cons_cons list.exhaust nth_Cons_0)
 next
   case (Suc i) note hyps = this
   then obtain x' y' xs' ys' where "xs = x' # xs'" "ys = y' # ys'"
     by (metis Suc_length_conv Suc_lessE)
-  moreover with hyps(5) have "\<forall>j<i. xs' ! j = ys' ! j"
-    by (auto)
+  moreover with hyps(5,6) have "\<forall>j<i. xs' ! j = ys' ! j"
+    using hyps(6) by auto
   ultimately show ?case using hyps
     by (auto)
 qed
 
 subsection \<open> Distributed Concatenation \<close>
 
 definition uncurry :: "('a \<Rightarrow> 'b \<Rightarrow>  'c) \<Rightarrow> ('a \<times> 'b \<Rightarrow> 'c)" where
 [simp]: "uncurry f = (\<lambda>(x, y). f x y)"
 
 definition dist_concat ::
   "'a list set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" (infixr "\<^sup>\<frown>" 100) where
 "dist_concat ls1 ls2 = (uncurry (@) ` (ls1 \<times> ls2))"
 
 lemma dist_concat_left_empty [simp]:
   "{} \<^sup>\<frown> ys = {}"
   by (simp add: dist_concat_def)
 
 lemma dist_concat_right_empty [simp]:
   "xs \<^sup>\<frown> {} = {}"
   by (simp add: dist_concat_def)
 
 lemma dist_concat_insert [simp]:
 "insert l ls1 \<^sup>\<frown> ls2 = ((@) l ` ( ls2)) \<union> (ls1 \<^sup>\<frown> ls2)"
   by (auto simp add: dist_concat_def)
 
 subsection \<open> List Domain and Range \<close>
 
 abbreviation seq_dom :: "'a list \<Rightarrow> nat set" ("dom\<^sub>l") where
 "seq_dom xs \<equiv> {0..<length xs}"
 
 abbreviation seq_ran :: "'a list \<Rightarrow> 'a set" ("ran\<^sub>l") where
 "seq_ran xs \<equiv> set xs"
 
 subsection \<open> Extracting List Elements \<close>
 
 definition seq_extract :: "nat set \<Rightarrow> 'a list \<Rightarrow> 'a list" (infix "\<upharpoonleft>\<^sub>l" 80) where
 "seq_extract A xs = nths xs A"
 
 lemma seq_extract_Nil [simp]: "A \<upharpoonleft>\<^sub>l [] = []"
   by (simp add: seq_extract_def)
 
 lemma seq_extract_Cons:
   "A \<upharpoonleft>\<^sub>l (x # xs) = (if 0 \<in> A then [x] else []) @ {j. Suc j \<in> A} \<upharpoonleft>\<^sub>l xs"
   by (simp add: seq_extract_def nths_Cons)
 
 lemma seq_extract_empty [simp]: "{} \<upharpoonleft>\<^sub>l xs = []"
   by (simp add: seq_extract_def)
 
 lemma seq_extract_ident [simp]: "{0..<length xs} \<upharpoonleft>\<^sub>l xs = xs"
   unfolding list_eq_iff_nth_eq
   by (auto simp add: seq_extract_def length_nths atLeast0LessThan)
 
 lemma seq_extract_split:
   assumes "i \<le> length xs"
   shows "{0..<i} \<upharpoonleft>\<^sub>l xs @ {i..<length xs} \<upharpoonleft>\<^sub>l xs = xs"
 using assms
 proof (induct xs arbitrary: i)
   case Nil thus ?case by (simp add: seq_extract_def)
 next
   case (Cons x xs) note hyp = this
   have "{j. Suc j < i} = {0..<i - 1}"
     by (auto)
   moreover have "{j. i \<le> Suc j \<and> j < length xs} = {i - 1..<length xs}"
     by (auto)
   ultimately show ?case
     using hyp by (force simp add: seq_extract_def nths_Cons)
 qed
 
 lemma seq_extract_append:
   "A \<upharpoonleft>\<^sub>l (xs @ ys) = (A \<upharpoonleft>\<^sub>l xs) @ ({j. j + length xs \<in> A} \<upharpoonleft>\<^sub>l ys)"
   by (simp add: seq_extract_def nths_append)
 
 lemma seq_extract_range: "A \<upharpoonleft>\<^sub>l xs = (A \<inter> dom\<^sub>l(xs)) \<upharpoonleft>\<^sub>l xs"
   apply (auto simp add: seq_extract_def nths_def)
   apply (metis (no_types, lifting) atLeastLessThan_iff filter_cong in_set_zip nth_mem set_upt)
 done
 
 lemma seq_extract_out_of_range:
   "A \<inter> dom\<^sub>l(xs) = {} \<Longrightarrow> A \<upharpoonleft>\<^sub>l xs = []"
   by (metis seq_extract_def seq_extract_range nths_empty)
 
 lemma seq_extract_length [simp]:
   "length (A \<upharpoonleft>\<^sub>l xs) = card (A \<inter> dom\<^sub>l(xs))"
 proof -
   have "{i. i < length(xs) \<and> i \<in> A} = (A \<inter> {0..<length(xs)})"
     by (auto)
   thus ?thesis
     by (simp add: seq_extract_def length_nths)
 qed
 
 lemma seq_extract_Cons_atLeastLessThan:
   assumes "m < n"
   shows "{m..<n} \<upharpoonleft>\<^sub>l (x # xs) = (if (m = 0) then x # ({0..<n-1} \<upharpoonleft>\<^sub>l xs) else {m-1..<n-1} \<upharpoonleft>\<^sub>l xs)"
 proof -
   have "{j. Suc j < n} = {0..<n - Suc 0}"
     by (auto)
   moreover have "{j. m \<le> Suc j \<and> Suc j < n} = {m - Suc 0..<n - Suc 0}"
     by (auto)
 
   ultimately show ?thesis using assms
     by (auto simp add: seq_extract_Cons)
 qed
 
 lemma seq_extract_singleton:
   assumes "i < length xs"
   shows "{i} \<upharpoonleft>\<^sub>l xs = [xs ! i]"
   using assms
   apply (induct xs arbitrary: i)
   apply (auto simp add: seq_extract_Cons)
   apply (rename_tac xs i)
   apply (subgoal_tac "{j. Suc j = i} = {i - 1}")
   apply (auto)
 done
 
 lemma seq_extract_as_map:
   assumes "m < n" "n \<le> length xs"
   shows "{m..<n} \<upharpoonleft>\<^sub>l xs = map (nth xs) [m..<n]"
 using assms proof (induct xs arbitrary: m n)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   have "[m..<n] = m # [m+1..<n]"
     using Cons.prems(1) upt_eq_Cons_conv by blast
   moreover have "map (nth (x # xs)) [Suc m..<n] = map (nth xs) [m..<n-1]"
     by (simp add: map_nth_Cons_atLeastLessThan)
   ultimately show ?case
     using Cons upt_rec
     by (auto simp add: seq_extract_Cons_atLeastLessThan)
 qed
 
 lemma seq_append_as_extract:
   "xs = ys @ zs \<longleftrightarrow> (\<exists> i\<le>length(xs). ys = {0..<i} \<upharpoonleft>\<^sub>l xs \<and> zs = {i..<length(xs)} \<upharpoonleft>\<^sub>l xs)"
 proof
   assume xs: "xs = ys @ zs"
   moreover have "ys = {0..<length ys} \<upharpoonleft>\<^sub>l (ys @ zs)"
     by (simp add: seq_extract_append)
   moreover have "zs = {length ys..<length ys + length zs} \<upharpoonleft>\<^sub>l (ys @ zs)"
   proof -
     have "{length ys..<length ys + length zs} \<inter> {0..<length ys} = {}"
       by auto
     moreover have s1: "{j. j < length zs} = {0..<length zs}"
       by auto
     ultimately show ?thesis
       by (simp add: seq_extract_append seq_extract_out_of_range)
   qed
   ultimately show "(\<exists> i\<le>length(xs). ys = {0..<i} \<upharpoonleft>\<^sub>l xs \<and> zs = {i..<length(xs)} \<upharpoonleft>\<^sub>l xs)"
     by (rule_tac x="length ys" in exI, auto)
 next
   assume "\<exists>i\<le>length xs. ys = {0..<i} \<upharpoonleft>\<^sub>l xs \<and> zs = {i..<length xs} \<upharpoonleft>\<^sub>l xs"
   thus "xs = ys @ zs"
     by (auto simp add: seq_extract_split)
 qed
 
 subsection \<open> Filtering a list according to a set \<close>
 
 definition seq_filter :: "'a list \<Rightarrow> 'a set \<Rightarrow> 'a list" (infix "\<restriction>\<^sub>l" 80) where
 "seq_filter xs A = filter (\<lambda> x. x \<in> A) xs"
 
 lemma seq_filter_Cons_in [simp]: 
   "x \<in> cs \<Longrightarrow> (x # xs) \<restriction>\<^sub>l cs = x # (xs \<restriction>\<^sub>l cs)"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_Cons_out [simp]: 
   "x \<notin> cs \<Longrightarrow> (x # xs) \<restriction>\<^sub>l cs = (xs \<restriction>\<^sub>l cs)"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_Nil [simp]: "[] \<restriction>\<^sub>l A = []"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_empty [simp]: "xs \<restriction>\<^sub>l {} = []"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_append: "(xs @ ys) \<restriction>\<^sub>l A = (xs \<restriction>\<^sub>l A) @ (ys \<restriction>\<^sub>l A)"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_UNIV [simp]: "xs \<restriction>\<^sub>l UNIV = xs"
   by (simp add: seq_filter_def)
 
 lemma seq_filter_twice [simp]: "(xs \<restriction>\<^sub>l A) \<restriction>\<^sub>l B = xs \<restriction>\<^sub>l (A \<inter> B)"
   by (simp add: seq_filter_def)
 
 subsection \<open> Minus on lists \<close>
 
 instantiation list :: (type) minus
 begin
 
 text \<open> We define list minus so that if the second list is not a prefix of the first, then an arbitrary
         list longer than the combined length is produced. Thus we can always determined from the output
         whether the minus is defined or not. \<close>
 
 definition "xs - ys = (if (prefix ys xs) then drop (length ys) xs else [])"
 
 instance ..
 end
 
 lemma minus_cancel [simp]: "xs - xs = []"
   by (simp add: minus_list_def)
 
 lemma append_minus [simp]: "(xs @ ys) - xs = ys"
   by (simp add: minus_list_def)
 
 lemma minus_right_nil [simp]: "xs - [] = xs"
   by (simp add: minus_list_def)
 
 lemma list_concat_minus_list_concat: "(s @ t) - (s @ z) = t - z"
   by (simp add: minus_list_def)
 
 lemma length_minus_list: "y \<le> x \<Longrightarrow> length(x - y) = length(x) - length(y)"
   by (simp add: less_eq_list_def minus_list_def)
 
 lemma map_list_minus:
   "xs \<le> ys \<Longrightarrow> map f (ys - xs) = map f ys - map f xs"
   by (simp add: drop_map less_eq_list_def map_mono_prefix minus_list_def)
 
 lemma list_minus_first_tl [simp]: 
   "[x] \<le> xs \<Longrightarrow> (xs - [x]) = tl xs"
   by (metis Prefix_Order.prefixE append.left_neutral append_minus list.sel(3) not_Cons_self2 tl_append2)
 
 text \<open> Extra lemmas about @{term prefix} and @{term strict_prefix} \<close>
 
 lemma prefix_concat_minus:
   assumes "prefix xs ys"
   shows "xs @ (ys - xs) = ys"
   using assms by (metis minus_list_def prefix_drop)
 
 lemma prefix_minus_concat:
   assumes "prefix s t"
   shows "(t - s) @ z = (t @ z) - s"
   using assms by (simp add: Sublist.prefix_length_le minus_list_def)
 
 lemma strict_prefix_minus_not_empty:
   assumes "strict_prefix xs ys"
   shows "ys - xs \<noteq> []"
   using assms by (metis append_Nil2 prefix_concat_minus strict_prefix_def)
 
 lemma strict_prefix_diff_minus:
   assumes "prefix xs ys" and "xs \<noteq> ys"
   shows "(ys - xs) \<noteq> []"
   using assms by (simp add: strict_prefix_minus_not_empty)
 
 lemma length_tl_list_minus_butlast_gt_zero:
   assumes "length s < length t" and "strict_prefix (butlast s) t" and "length s > 0"
   shows "length (tl (t - (butlast s))) > 0"
   using assms
   by (metis Nitpick.size_list_simp(2) butlast_snoc hd_Cons_tl length_butlast length_greater_0_conv length_tl less_trans nat_neq_iff strict_prefix_minus_not_empty prefix_order.dual_order.strict_implies_order prefix_concat_minus)
 
 lemma list_minus_butlast_eq_butlast_list:
   assumes "length t = length s" and "strict_prefix (butlast s) t"
   shows "t - (butlast s) = [last t]"
   using assms
   by (metis append_butlast_last_id append_eq_append_conv butlast.simps(1) length_butlast less_numeral_extra(3) list.size(3) prefix_order.dual_order.strict_implies_order prefix_concat_minus prefix_length_less)
 
 lemma butlast_strict_prefix_length_lt_imp_last_tl_minus_butlast_eq_last:
   assumes "length s > 0" "strict_prefix (butlast s) t" "length s < length t"
   shows "last (tl (t - (butlast s))) = (last t)"
   using assms by (metis last_append last_tl length_tl_list_minus_butlast_gt_zero less_numeral_extra(3) list.size(3) append_minus strict_prefix_eq_exists)
 
 lemma tl_list_minus_butlast_not_empty:
   assumes "strict_prefix (butlast s) t" and "length s > 0" and "length t > length s"
   shows "tl (t - (butlast s)) \<noteq> []"
   using assms length_tl_list_minus_butlast_gt_zero by fastforce
 
 lemma tl_list_minus_butlast_empty:
   assumes "strict_prefix (butlast s) t" and "length s > 0" and "length t = length s"
   shows "tl (t - (butlast s)) = []"
   using assms by (simp add: list_minus_butlast_eq_butlast_list)
 
-lemma concat_minus_list_concat_butlast_eq_list_minus_butlast:
-  assumes "prefix (butlast u) s"
-  shows "(t @ s) - (t @ (butlast u)) = s - (butlast u)"
-  using assms by (metis append_assoc prefix_concat_minus append_minus)
-
 lemma tl_list_minus_butlast_eq_empty:
   assumes "strict_prefix (butlast s) t" and "length s = length t"
   shows "tl (t - (butlast s)) = []"
   using assms by (metis list.sel(3) list_minus_butlast_eq_butlast_list)
 
-(* this can be shown using length_tl, but care is needed when list is empty? *)
-lemma prefix_length_tl_minus:
-  assumes "strict_prefix s t"
-  shows "length (tl (t-s)) = (length (t-s)) - 1"
-  by (auto)
-
 lemma length_list_minus:
   assumes "strict_prefix s t"
   shows "length(t - s) = length(t) - length(s)"
   using assms by (simp add: minus_list_def prefix_order.dual_order.strict_implies_order)
 
 subsection \<open> Laws on @{term take}, @{term drop}, and @{term nths} \<close>
 
 lemma take_prefix: "m \<le> n \<Longrightarrow> take m xs \<le> take n xs"
   by (metis Prefix_Order.prefixI append_take_drop_id min_absorb2 take_append take_take)
 
 lemma nths_atLeastAtMost_0_take: "nths xs {0..m} = take (Suc m) xs"
   by (metis atLeast0AtMost lessThan_Suc_atMost nths_upt_eq_take)
 
 lemma nths_atLeastLessThan_0_take: "nths xs {0..<m} = take m xs"
   by (simp add: atLeast0LessThan)
 
 lemma nths_atLeastAtMost_prefix: "m \<le> n \<Longrightarrow> nths xs {0..m} \<le> nths xs {0..n}"
   by (simp add: nths_atLeastAtMost_0_take take_prefix)
 
 lemma sorted_nths_atLeastAtMost_0: "\<lbrakk> m \<le> n; sorted (nths xs {0..n}) \<rbrakk> \<Longrightarrow> sorted (nths xs {0..m})"
   using nths_atLeastAtMost_prefix sorted_prefix by blast
 
 lemma sorted_nths_atLeastLessThan_0: "\<lbrakk> m \<le> n; sorted (nths xs {0..<n}) \<rbrakk> \<Longrightarrow> sorted (nths xs {0..<m})"
   by (metis atLeast0LessThan nths_upt_eq_take sorted_prefix take_prefix)
 
 lemma list_augment_as_update: 
   "k < length xs \<Longrightarrow> list_augment xs k x = list_update xs k x"
   by (metis list_augment_def list_augment_idem list_update_overwrite)
 
 lemma nths_list_update_out: "k \<notin> A \<Longrightarrow> nths (list_update xs k x) A = nths xs A"
   apply (induct xs arbitrary: k x A)
    apply (auto)
   apply (rename_tac a xs k x A)
   apply (case_tac k)
    apply (auto simp add: nths_Cons)
   done
 
 lemma nths_list_augment_out: "\<lbrakk> k < length xs; k \<notin> A \<rbrakk> \<Longrightarrow> nths (list_augment xs k x) A = nths xs A"
   by (simp add: list_augment_as_update nths_list_update_out)
 
 end
\ No newline at end of file
diff --git a/thys/UTP/toolkit/Sequence.thy b/thys/UTP/toolkit/Sequence.thy
--- a/thys/UTP/toolkit/Sequence.thy
+++ b/thys/UTP/toolkit/Sequence.thy
@@ -1,294 +1,279 @@
 (******************************************************************************)
 (* Project: Isabelle/UTP Toolkit                                              *)
 (* File: Sequence.thy                                                         *)
 (* Authors: Simon Foster and Frank Zeyda                                      *)
 (* Emails: simon.foster@york.ac.uk and frank.zeyda@york.ac.uk                 *)
 (******************************************************************************)
 
 section \<open> Infinite Sequences \<close>
 
 theory Sequence
 imports
   HOL.Real
   List_Extra
   "HOL-Library.Sublist"
   "HOL-Library.Nat_Bijection"
 begin
 
 typedef 'a seq = "UNIV :: (nat \<Rightarrow> 'a) set"
   by (auto)
 
 setup_lifting type_definition_seq
 
 definition ssubstr :: "nat \<Rightarrow> nat \<Rightarrow> 'a seq \<Rightarrow> 'a list" where
 "ssubstr i j xs = map (Rep_seq xs) [i ..< j]"
 
 lift_definition nth_seq :: "'a seq \<Rightarrow> nat \<Rightarrow> 'a" (infixl "!\<^sub>s" 100)
 is "\<lambda> f i. f i" .
 
 abbreviation sinit :: "nat \<Rightarrow> 'a seq \<Rightarrow> 'a list" where
 "sinit i xs \<equiv> ssubstr 0 i xs"
 
 lemma sinit_len [simp]:
   "length (sinit i xs) = i"
   by (simp add: ssubstr_def)
 
 lemma sinit_0 [simp]: "sinit 0 xs = []"
   by (simp add: ssubstr_def)
 
 lemma prefix_upt_0 [intro]:
   "i \<le> j \<Longrightarrow> prefix [0..<i] [0..<j]"
   by (induct i, auto, metis append_prefixD le0 prefix_order.lift_Suc_mono_le prefix_order.order_refl upt_Suc)
 
 lemma sinit_prefix:
   "i \<le> j \<Longrightarrow> prefix (sinit i xs) (sinit j xs)"
   by (simp add: map_mono_prefix prefix_upt_0 ssubstr_def)
 
 lemma sinit_strict_prefix:
   "i < j \<Longrightarrow> strict_prefix (sinit i xs) (sinit j xs)"
   by (metis sinit_len sinit_prefix le_less nat_neq_iff prefix_order.dual_order.strict_iff_order)
 
 lemma nth_sinit:
   "i < n \<Longrightarrow> sinit n xs ! i = xs !\<^sub>s i"
   apply (auto simp add: ssubstr_def)
   apply (transfer, auto)
   done
 
 lemma sinit_append_split:
   assumes "i < j"
   shows "sinit j xs = sinit i xs @ ssubstr i j xs"
 proof -
   have "[0..<i] @ [i..<j] = [0..<j]"
     by (metis assms le0 le_add_diff_inverse le_less upt_add_eq_append)
   thus ?thesis
     by (auto simp add: ssubstr_def, transfer, simp add: map_append[THEN sym])
 qed
 
 lemma sinit_linear_asym_lemma1:
   assumes "asym R" "i < j" "(sinit i xs, sinit i ys) \<in> lexord R" "(sinit j ys, sinit j xs) \<in> lexord R"
   shows False
 proof -
   have sinit_xs: "sinit j xs = sinit i xs @ ssubstr i j xs"
     by (metis assms(2) sinit_append_split)
   have sinit_ys: "sinit j ys = sinit i ys @ ssubstr i j ys"
     by (metis assms(2) sinit_append_split)
   from sinit_xs sinit_ys assms(4)
   have "(sinit i ys, sinit i xs) \<in> lexord R \<or> (sinit i ys = sinit i xs \<and> (ssubstr i j ys, ssubstr i j xs) \<in> lexord R)"
     by (auto dest: lexord_append)
   with assms lexord_asymmetric show False
     by (force)
 qed
 
 lemma sinit_linear_asym_lemma2:
   assumes "asym R" "(sinit i xs, sinit i ys) \<in> lexord R" "(sinit j ys, sinit j xs) \<in> lexord R"
   shows False
 proof (cases i j rule: linorder_cases)
   case less with assms show ?thesis
     by (auto dest: sinit_linear_asym_lemma1)
 next
   case equal with assms show ?thesis
     by (simp add: lexord_asymmetric)
 next
   case greater with assms show ?thesis
     by (auto dest: sinit_linear_asym_lemma1)
 qed
 
 lemma range_ext:
   assumes "\<forall>i :: nat. \<forall>x\<in>{0..<i}. f(x) = g(x)"
   shows "f = g"
 proof (rule ext)
   fix x :: nat
   obtain i :: nat where "i > x"
     by (metis lessI)
   with assms show "f(x) = g(x)"
     by (auto)
 qed
 
 lemma sinit_ext:
   "(\<forall> i. sinit i xs = sinit i ys) \<Longrightarrow> xs = ys"
   by (simp add: ssubstr_def, transfer, auto intro: range_ext)
 
 definition seq_lexord :: "'a rel \<Rightarrow> ('a seq) rel" where
 "seq_lexord R = {(xs, ys). (\<exists> i. (sinit i xs, sinit i ys) \<in> lexord R)}"
 
 lemma seq_lexord_irreflexive:
   "\<forall>x. (x, x) \<notin> R \<Longrightarrow> (xs, xs) \<notin> seq_lexord R"
   by (auto dest: lexord_irreflexive simp add: irrefl_def seq_lexord_def)
 
 lemma seq_lexord_irrefl:
   "irrefl R \<Longrightarrow> irrefl (seq_lexord R)"
   by (simp add: irrefl_def seq_lexord_irreflexive)
 
 lemma seq_lexord_transitive:
-  assumes "trans R"
+  assumes "trans R" "antisym R" 
   shows "trans (seq_lexord R)"
-unfolding seq_lexord_def
+  unfolding seq_lexord_def
 proof (rule transI, clarify)
   fix xs ys zs :: "'a seq" and m n :: nat
   assume las: "(sinit m xs, sinit m ys) \<in> lexord R" "(sinit n ys, sinit n zs) \<in> lexord R"
   hence inz: "m > 0"
     using gr0I by force
-  from las(1) obtain i where sinitm: "(sinit m xs!i, sinit m ys!i) \<in> R" "i < m" "\<forall> j<i. sinit m xs!j = sinit m ys!j"
+  from las(1) obtain i where sinitm: "(sinit m xs!i, sinit m ys!i) \<in> R" "sinit m xs!i \<noteq> sinit m ys!i"
+                                     "i < m" "\<forall> j<i. sinit m xs!j = sinit m ys!j"
     using lexord_eq_length by force
-  from las(2) obtain j where sinitn: "(sinit n ys!j, sinit n zs!j) \<in> R" "j < n" "\<forall> k<j. sinit n ys!k = sinit n zs!k"
+  from las(2) obtain j where sinitn: "(sinit n ys!j, sinit n zs!j) \<in> R" "sinit n ys!j \<noteq> sinit n zs!j"
+                                     "j < n" "\<forall> k<j. sinit n ys!k = sinit n zs!k"
     using lexord_eq_length by force
   show "\<exists>i. (sinit i xs, sinit i zs) \<in> lexord R"
   proof (cases "i \<le> j")
     case True note lt = this
     with sinitm sinitn have "(sinit n xs!i, sinit n zs!i) \<in> R"
       by (metis assms le_eq_less_or_eq le_less_trans nth_sinit transD)
+    moreover have "sinit n xs!i \<noteq> sinit n zs!i"
+      by (metis antisymD assms(2) dual_order.strict_trans2 le_eq_less_or_eq lt nth_sinit sinitm(1) sinitm(2) sinitm(3) sinitn(1) sinitn(3) sinitn(4))
     moreover from lt sinitm sinitn have "\<forall> j<i. sinit m xs!j = sinit m zs!j"
       by (metis less_le_trans less_trans nth_sinit)
+    moreover have "i<n"
+      using le_less_trans lt sinitn(3) by blast
     ultimately have "(sinit n xs, sinit n zs) \<in> lexord R" using sinitm(2) sinitn(2) lt
       apply (rule_tac lexord_intro_elems)
-         apply (auto)
-      apply (metis less_le_trans less_trans nth_sinit)
-      done
+          apply (auto)
+      by (metis less_trans nth_sinit sinitm(3))
     thus ?thesis by auto
   next
     case False
     then have ge: "i > j" by auto
     with assms sinitm sinitn have "(sinit n xs!j, sinit n zs!j) \<in> R"
       by (metis less_trans nth_sinit)
+    moreover have "sinit n xs!j \<noteq> sinit n zs!j"
+      by (metis ge less_trans nth_sinit sinitm(3) sinitm(4) sinitn(2) sinitn(3))
     moreover from ge sinitm sinitn have "\<forall> k<j. sinit m xs!k = sinit m zs!k"
       by (metis dual_order.strict_trans nth_sinit)
+    moreover have "j<n"
+      by (simp add: sinitn(3))
     ultimately have "(sinit n xs, sinit n zs) \<in> lexord R" using sinitm(2) sinitn(2) ge
       apply (rule_tac lexord_intro_elems)
-         apply (auto)
-      apply (metis less_trans nth_sinit)
-      done
+          apply (auto)
+      by (metis less_trans nth_sinit sinitm(3))
     thus ?thesis by auto
   qed
 qed
 
 lemma seq_lexord_trans:
-  "\<lbrakk> (xs, ys) \<in> seq_lexord R; (ys, zs) \<in> seq_lexord R; trans R \<rbrakk> \<Longrightarrow> (xs, zs) \<in> seq_lexord R"
+  "\<lbrakk> (xs, ys) \<in> seq_lexord R; (ys, zs) \<in> seq_lexord R; trans R; antisym R \<rbrakk> \<Longrightarrow> (xs, zs) \<in> seq_lexord R"
   by (meson seq_lexord_transitive transE)
 
 lemma seq_lexord_antisym:
   "\<lbrakk> asym R; (a, b) \<in> seq_lexord R \<rbrakk> \<Longrightarrow> (b, a) \<notin> seq_lexord R"
   by (auto dest: sinit_linear_asym_lemma2 simp add: seq_lexord_def)
 
 lemma seq_lexord_asym:
   assumes "asym R"
   shows "asym (seq_lexord R)"
   by (meson assms asym.simps seq_lexord_antisym seq_lexord_irrefl)
 
 lemma seq_lexord_total:
   assumes "total R"
   shows "total (seq_lexord R)"
   using assms by (auto simp add: total_on_def seq_lexord_def, meson lexord_linear sinit_ext)
 
-lemma seq_lexord_strict_linear_order:
-  assumes "strict_linear_order R"
-  shows "strict_linear_order (seq_lexord R)"
-  using assms
-  by (auto simp add: strict_linear_order_on_def partial_order_on_def preorder_on_def
-           intro: seq_lexord_transitive seq_lexord_irrefl seq_lexord_total)
-
 lemma seq_lexord_linear:
   assumes "(\<forall> a b. (a,b)\<in> R \<or> a = b \<or> (b,a) \<in> R)"
   shows "(x,y) \<in> seq_lexord R \<or> x = y \<or> (y,x) \<in> seq_lexord R"
 proof -
   have "total R"
     using assms total_on_def by blast
   hence "total (seq_lexord R)"
     using seq_lexord_total by blast
   thus ?thesis
     by (auto simp add: total_on_def)
 qed
 
 instantiation seq :: (ord) ord
 begin
 
 definition less_seq :: "'a seq \<Rightarrow> 'a seq \<Rightarrow> bool" where
 "less_seq xs ys \<longleftrightarrow> (xs, ys) \<in> seq_lexord {(xs, ys). xs < ys}"
 
 definition less_eq_seq :: "'a seq \<Rightarrow> 'a seq \<Rightarrow> bool" where
 "less_eq_seq xs ys = (xs = ys \<or> xs < ys)"
 
 instance ..
 
 end
 
 instance seq :: (order) order
 proof
-  fix xs :: "'a seq"
-  show "xs \<le> xs" by (simp add: less_eq_seq_def)
-next
-  fix xs ys zs :: "'a seq"
-  assume "xs \<le> ys" and "ys \<le> zs"
-  then show "xs \<le> zs"
-    by (force dest: seq_lexord_trans simp add: less_eq_seq_def less_seq_def trans_def)
-next
-  fix xs ys :: "'a seq"
-  assume "xs \<le> ys" and "ys \<le> xs"
-  then show "xs = ys"
+  have \<section>: "antisym {(xs, ys::'a). xs < ys}" "trans {(xs, ys::'a). xs < ys}"
+    using antisym_def trans_def by fastforce+
+  show "xs \<le> xs" for xs :: "'a seq"
+    by (simp add: less_eq_seq_def)
+  show "xs \<le> zs" if "xs \<le> ys" and "ys \<le> zs" for xs ys zs :: "'a seq"
+    using that
+    by (auto intro: \<section> seq_lexord_trans simp: less_eq_seq_def less_seq_def)
+  show "xs = ys" if "xs \<le> ys" and "ys \<le> xs" for xs ys :: "'a seq"
+    using that
     apply (auto simp add: less_eq_seq_def less_seq_def)
-    apply (rule seq_lexord_irreflexive [THEN notE])
-     defer
-     apply (rule seq_lexord_trans)
-       apply (auto intro: transI)
-    done
-next
-  fix xs ys :: "'a seq"
-  show "xs < ys \<longleftrightarrow> xs \<le> ys \<and> \<not> ys \<le> xs"
-    apply (auto simp add: less_seq_def less_eq_seq_def)
-     defer
-     apply (rule seq_lexord_irreflexive [THEN notE])
-      apply auto
-     apply (rule seq_lexord_irreflexive [THEN notE])
-      defer
-      apply (rule seq_lexord_trans)
-        apply (auto intro: transI)
-    apply (simp add: seq_lexord_irreflexive)
-    done
+    by (metis \<section> case_prodD less_irrefl mem_Collect_eq seq_lexord_irreflexive seq_lexord_trans)
+  show "xs < ys \<longleftrightarrow> xs \<le> ys \<and> \<not> ys \<le> xs" for xs ys :: "'a seq"
+    apply (auto simp add: less_seq_def less_eq_seq_def seq_lexord_irreflexive)
+    by (metis \<section> case_prodD less_irrefl mem_Collect_eq seq_lexord_irreflexive seq_lexord_trans)
 qed
 
 instance seq :: (linorder) linorder
 proof
   fix xs ys :: "'a seq"
   have "(xs, ys) \<in> seq_lexord {(u, v). u < v} \<or> xs = ys \<or> (ys, xs) \<in> seq_lexord {(u, v). u < v}"
     by (rule seq_lexord_linear) auto
   then show "xs \<le> ys \<or> ys \<le> xs"
     by (auto simp add: less_eq_seq_def less_seq_def)
 qed
 
 lemma seq_lexord_mono [mono]:
   "(\<And> x y. f x y \<longrightarrow> g x y) \<Longrightarrow> (xs, ys) \<in> seq_lexord {(x, y). f x y} \<longrightarrow> (xs, ys) \<in> seq_lexord {(x, y). g x y}"
   apply (auto simp add: seq_lexord_def)
   apply (metis case_prodD case_prodI lexord_take_index_conv mem_Collect_eq)
 done
 
 fun insort_rel :: "'a rel \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
 "insort_rel R x [] = [x]" |
 "insort_rel R x (y # ys) = (if (x = y \<or> (x,y) \<in> R) then x # y # ys else y # insort_rel R x ys)"
 
 inductive sorted_rel :: "'a rel \<Rightarrow> 'a list \<Rightarrow> bool" where
 Nil_rel [iff]: "sorted_rel R []" |
 Cons_rel: "\<forall> y \<in> set xs. (x = y \<or> (x, y) \<in> R) \<Longrightarrow> sorted_rel R xs \<Longrightarrow> sorted_rel R (x # xs)"
 
 definition list_of_set :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a list" where
 "list_of_set R = folding.F (insort_rel R) []"
 
 lift_definition seq_inj :: "'a seq seq \<Rightarrow> 'a seq" is
 "\<lambda> f i. f (fst (prod_decode i)) (snd (prod_decode i))" .
 
 lift_definition seq_proj :: "'a seq \<Rightarrow> 'a seq seq" is
 "\<lambda> f i j. f (prod_encode (i, j))" .
 
 lemma seq_inj_inverse: "seq_proj (seq_inj x) = x"
   by (transfer, simp)
 
 lemma seq_proj_inverse: "seq_inj (seq_proj x) = x"
   by (transfer, simp)
 
 lemma seq_inj: "inj seq_inj"
   by (metis injI seq_inj_inverse)
 
 lemma seq_inj_surj: "bij seq_inj"
   apply (rule bijI)
    apply (auto simp add: seq_inj)
   apply (metis rangeI seq_proj_inverse)
   done
 end
\ No newline at end of file