diff --git a/thys/Buchi_Complementation/Ranking.thy b/thys/Buchi_Complementation/Ranking.thy
--- a/thys/Buchi_Complementation/Ranking.thy
+++ b/thys/Buchi_Complementation/Ranking.thy
@@ -1,481 +1,481 @@
 section \<open>Rankings\<close>
 
 theory Ranking
 imports
   "Alternate"
   "Graph"
 begin
 
   subsection \<open>Rankings\<close>
 
   type_synonym 'state ranking = "'state node \<Rightarrow> nat"
 
   definition ranking :: "('label, 'state) nba \<Rightarrow> 'label stream \<Rightarrow> 'state ranking \<Rightarrow> bool" where
     "ranking A w f \<equiv>
       (\<forall> v \<in> gunodes A w. f v \<le> 2 * card (nodes A)) \<and>
       (\<forall> v \<in> gunodes A w. \<forall> u \<in> gusuccessors A w v. f u \<le> f v) \<and>
       (\<forall> v \<in> gunodes A w. gaccepting A v \<longrightarrow> even (f v)) \<and>
       (\<forall> v \<in> gunodes A w. \<forall> r k. gurun A w r v \<longrightarrow> smap f (gtrace r v) = sconst k \<longrightarrow> odd k)"
 
   subsection \<open>Ranking Implies Word not in Language\<close>
 
   lemma ranking_stuck:
     assumes "ranking A w f"
     assumes "v \<in> gunodes A w" "gurun A w r v"
     obtains n k
     where "smap f (gtrace (sdrop n r) (gtarget (stake n r) v)) = sconst k"
   proof -
     have 0: "f u \<le> f v" if "v \<in> gunodes A w" "u \<in> gusuccessors A w v" for v u
       using assms(1) that unfolding ranking_def by auto
     have 1: "shd (v ## gtrace r v) \<in> gunodes A w" using assms(2) by auto
     have 2: "sdescending (smap f (v ## gtrace r v))"
     using 1 assms(3)
     proof (coinduction arbitrary: r v rule: sdescending.coinduct)
       case sdescending
       obtain u s where 1: "r = u ## s" using stream.exhaust by blast
       have 2: "v \<in> gunodes A w" using sdescending(1) by simp
       have 3: "gurun A w (u ## s) v" using sdescending(2) 1 by auto
       have 4: "u \<in> gusuccessors A w v" using 3 by auto
       have 5: "u \<in> gureachable A w v" using graph.reachable_successors 4 by blast
       show ?case
       unfolding 1
       proof (intro exI conjI disjI1)
         show "f u \<le> f v" using 0 2 4 by this
         show "shd (u ## gtrace s u) \<in> gunodes A w" using 2 5 by auto
         show "gurun A w s u" using 3 by auto
       qed auto
     qed
     obtain n k where 3: "sdrop n (smap f (v ## gtrace r v)) = sconst k"
       using sdescending_stuck[OF 2] by metis
     have "gtrace (sdrop (Suc n) r) (gtarget (stake (Suc n) r) v) = sdrop (Suc n) (gtrace r v)"
       using sscan_sdrop by rule
     also have "smap f \<dots> = sdrop n (smap f (v ## gtrace r v))"
       by (auto, metis 3 id_apply sdrop_smap sdrop_stl siterate.simps(2)
         sscan_const stream.map stream.map_sel(2) stream.sel(2))
     also have "\<dots> = sconst k" using 3 by this
     finally show ?thesis using that by blast
   qed
 
   lemma ranking_stuck_odd:
     assumes "ranking A w f"
     assumes "v \<in> gunodes A w" "gurun A w r v"
     obtains n
     where "sset (smap f (gtrace (sdrop n r) (gtarget (stake n r) v))) \<subseteq> Collect odd"
   proof -
     obtain n k where 1: "smap f (gtrace (sdrop n r) (gtarget (stake n r) v)) = sconst k"
       using ranking_stuck assms by this
     have 2: "gtarget (stake n r) v \<in> gunodes A w"
       using assms(2, 3) by (simp add: graph.nodes_target graph.run_stake)
     have 3: "gurun A w (sdrop n r) (gtarget (stake n r) v)"
       using assms(2, 3) by (simp add: graph.run_sdrop)
     have 4: "odd k" using 1 2 3 assms(1) unfolding ranking_def by meson
     have "sset (smap f (gtrace (sdrop n r) (gtarget (stake n r) v))) = sset (sconst k)"
       unfolding 1 by rule
     also have "\<dots> \<subseteq> Collect odd" using 4 by simp
     finally show ?thesis using that by simp
   qed
 
   lemma ranking_language:
     assumes "ranking A w f"
     shows "w \<notin> language A"
   proof
     assume 1: "w \<in> language A"
     obtain r p where 2: "run A (w ||| r) p" "p \<in> initial A" "infs (accepting A) (trace (w ||| r) p)"
       using 1 by rule
     let ?r = "fromN 1 ||| r"
     let ?v = "(0, p)"
     have 3: "?v \<in> gunodes A w" "gurun A w ?r ?v" using 2(1, 2) by (auto intro: run_grun)
 
     obtain n where 4: "sset (smap f (gtrace (sdrop n ?r) (gtarget (stake n ?r) ?v))) \<subseteq> {a. odd a}"
       using ranking_stuck_odd assms 3 by this
     let ?s = "stake n ?r"
     let ?t = "sdrop n ?r"
     let ?u = "gtarget ?s ?v"
 
     have "sset (gtrace ?t ?u) \<subseteq> gureachable A w ?v"
     proof (intro graph.reachable_trace graph.reachable_target graph.reachable.reflexive)
       show "gupath A w ?s ?v" using graph.run_stake 3(2) by this
       show "gurun A w ?t ?u" using graph.run_sdrop 3(2) by this
     qed
     also have "\<dots> \<subseteq> gunodes A w" using 3(1) by blast
     finally have 7: "sset (gtrace ?t ?u) \<subseteq> gunodes A w" by this
     have 8: "\<And> p. p \<in> gunodes A w \<Longrightarrow> gaccepting A p \<Longrightarrow> even (f p)"
       using assms unfolding ranking_def by auto
     have 9: "\<And> p. p \<in> sset (gtrace ?t ?u) \<Longrightarrow> gaccepting A p \<Longrightarrow> even (f p)" using 7 8 by auto
 
     have 19: "infs (accepting A) (smap snd ?r)" using 2(3) unfolding trace_alt_def by simp
-    have 18: "infs (gaccepting A) ?r" using 19 by (force simp: comp_def)
+    have 18: "infs (gaccepting A) ?r" using 19 by simp
     have 17: "infs (gaccepting A) (gtrace ?r ?v)" using 18 unfolding gtrace_alt_def by this
     have 16: "infs (gaccepting A) (gtrace (?s @- ?t) ?v)" using 17 unfolding stake_sdrop by this
     have 15: "infs (gaccepting A) (gtrace ?t ?u)" using 16 by simp
     have 13: "infs (even \<circ> f) (gtrace ?t ?u)" using infs_mono[OF _ 15] 9 by simp
     have 12: "infs even (smap f (gtrace ?t ?u))" using 13 by (simp add: comp_def)
     have 11: "Bex (sset (smap f (gtrace ?t ?u))) even" using 12 infs_any by metis
 
     show False using 4 11 by auto
   qed
 
   subsection \<open>Word not in Language implies Ranking\<close>
 
   subsubsection \<open>Removal of Endangered Nodes\<close>
 
   definition clean :: "('label, 'state) nba \<Rightarrow> 'label stream \<Rightarrow> 'state node set \<Rightarrow> 'state node set" where
     "clean A w V \<equiv> {v \<in> V. infinite (greachable A w V v)}"
 
   lemma clean_decreasing: "clean A w V \<subseteq> V" unfolding clean_def by auto
   lemma clean_successors:
     assumes "v \<in> V" "u \<in> gusuccessors A w v"
     shows "u \<in> clean A w V \<Longrightarrow> v \<in> clean A w V"
   proof -
     assume 1: "u \<in> clean A w V"
     have 2: "u \<in> V" "infinite (greachable A w V u)" using 1 unfolding clean_def by auto
     have 3: "u \<in> greachable A w V v" using graph.reachable.execute assms(2) 2(1) by blast
     have 4: "greachable A w V u \<subseteq> greachable A w V v" using 3 by blast
     have 5: "infinite (greachable A w V v)" using 2(2) 4 by (simp add: infinite_super)
     show "v \<in> clean A w V" unfolding clean_def using assms(1) 5 by simp
   qed
 
   subsubsection \<open>Removal of Safe Nodes\<close>
 
   definition prune :: "('label, 'state) nba \<Rightarrow> 'label stream \<Rightarrow> 'state node set \<Rightarrow> 'state node set" where
     "prune A w V \<equiv> {v \<in> V. \<exists> u \<in> greachable A w V v. gaccepting A u}"
 
   lemma prune_decreasing: "prune A w V \<subseteq> V" unfolding prune_def by auto
   lemma prune_successors:
     assumes "v \<in> V" "u \<in> gusuccessors A w v"
     shows "u \<in> prune A w V \<Longrightarrow> v \<in> prune A w V"
   proof -
     assume 1: "u \<in> prune A w V"
     have 2: "u \<in> V" "\<exists> x \<in> greachable A w V u. gaccepting A x" using 1 unfolding prune_def by auto
     have 3: "u \<in> greachable A w V v" using graph.reachable.execute assms(2) 2(1) by blast
     have 4: "greachable A w V u \<subseteq> greachable A w V v" using 3 by blast
     show "v \<in> prune A w V" unfolding prune_def using assms(1) 2(2) 4 by auto
   qed
 
   subsubsection \<open>Run Graph Interation\<close>
 
   definition graph :: "('label, 'state) nba \<Rightarrow> 'label stream \<Rightarrow> nat \<Rightarrow> 'state node set" where
     "graph A w k \<equiv> alternate (clean A w) (prune A w) k (gunodes A w)"
 
   abbreviation "level A w k l \<equiv> {v \<in> graph A w k. fst v = l}"
 
   lemma graph_0[simp]: "graph A w 0 = gunodes A w" unfolding graph_def by simp
   lemma graph_Suc[simp]: "graph A w (Suc k) = (if even k then clean A w else prune A w) (graph A w k)"
     unfolding graph_def by simp
 
   lemma graph_antimono: "antimono (graph A w)"
     using alternate_antimono clean_decreasing prune_decreasing
     unfolding antimono_def le_fun_def graph_def
     by metis
   lemma graph_nodes: "graph A w k \<subseteq> gunodes A w" using graph_0 graph_antimono le0 antimonoD by metis
   lemma graph_successors:
     assumes "v \<in> gunodes A w" "u \<in> gusuccessors A w v"
     shows "u \<in> graph A w k \<Longrightarrow> v \<in> graph A w k"
   using assms
   proof (induct k arbitrary: u v)
     case 0
     show ?case using 0(2) by simp
   next
     case (Suc k)
     have 1: "v \<in> graph A w k" using Suc using antimono_iff_le_Suc graph_antimono rev_subsetD by blast
     show ?case using Suc(2) clean_successors[OF 1 Suc(4)] prune_successors[OF 1 Suc(4)] by auto
   qed
 
   lemma graph_level_finite:
     assumes "finite (nodes A)"
     shows "finite (level A w k l)"
   proof -
     have "level A w k l \<subseteq> {v \<in> gunodes A w. fst v = l}" by (simp add: graph_nodes subset_CollectI)
     also have "{v \<in> gunodes A w. fst v = l} \<subseteq> {l} \<times> nodes A" using gnodes_nodes by force
     also have "finite ({l} \<times> nodes A)" using assms(1) by simp
     finally show ?thesis by this
   qed
 
   lemma find_safe:
     assumes "w \<notin> language A"
     assumes "V \<noteq> {}" "V \<subseteq> gunodes A w"
     assumes "\<And> v. v \<in> V \<Longrightarrow> gsuccessors A w V v \<noteq> {}"
     obtains v
     where "v \<in> V" "\<forall> u \<in> greachable A w V v. \<not> gaccepting A u"
   proof (rule ccontr)
     assume 1: "\<not> thesis"
     have 2: "\<And> v. v \<in> V \<Longrightarrow> \<exists> u \<in> greachable A w V v. gaccepting A u" using that 1 by auto
     have 3: "\<And> r v. v \<in> initial A \<Longrightarrow> run A (w ||| r) v \<Longrightarrow> fins (accepting A) (trace (w ||| r) v)"
       using assms(1) by auto
     obtain v where 4: "v \<in> V" using assms(2) by force
     obtain x where 5: "x \<in> greachable A w V v" "gaccepting A x" using 2 4 by blast
     obtain y where 50: "gpath A w V y v" "x = gtarget y v" using 5(1) by rule
     obtain r where 6: "grun A w V r x" "infs (\<lambda> x. x \<in> V \<and> gaccepting A x) r"
     proof (rule graph.recurring_condition)
       show "x \<in> V \<and> gaccepting A x" using greachable_subset 4 5 by blast
     next
       fix v
       assume 1: "v \<in> V \<and> gaccepting A v"
       obtain v' where 20: "v' \<in> gsuccessors A w V v" using assms(4) 1 by (meson IntE equals0I)
       have 21: "v' \<in> V" using 20 by auto
       have 22: "\<exists> u \<in> greachable A w V v'. u \<in> V \<and> gaccepting A u"
         using greachable_subset 2 21 by blast
       obtain r where 30: "gpath A w V r v'" "gtarget r v' \<in> V \<and> gaccepting A (gtarget r v')"
         using 22 by blast
       show "\<exists> r. r \<noteq> [] \<and> gpath A w V r v \<and> gtarget r v \<in> V \<and> gaccepting A (gtarget r v)"
       proof (intro exI conjI)
         show "v' # r \<noteq> []" by simp
         show "gpath A w V (v' # r) v" using 20 30 by auto
         show "gtarget (v' # r) v \<in> V" using 30 by simp
         show "gaccepting A (gtarget (v' # r) v)" using 30 by simp
       qed
     qed auto
     obtain u where 100: "u \<in> ginitial A" "v \<in> gureachable A w u" using 4 assms(3) by blast
     have 101: "gupath A w y v" using gpath_subset 50(1) subset_UNIV by this
     have 102: "gurun A w r x" using grun_subset 6(1) subset_UNIV by this
     obtain t where 103: "gupath A w t u" "v = gtarget t u" using 100(2) by rule
     have 104: "gurun A w (t @- y @- r) u" using 101 102 103 50(2) by auto
     obtain s q where 7: "t @- y @- r = fromN (Suc 0) ||| s" "u = (0, q)"
       using grun_elim[OF 104] 100(1) by blast
     have 8: "run A (w ||| s) q" using grun_run[OF 104[unfolded 7]] by simp
     have 9: "q \<in> initial A" using 100(1) 7(2) by auto
     have 91: "sset (trace (w ||| s) q) \<subseteq> reachable A q"
       using nba.reachable_trace nba.reachable.reflexive 8 by this
     have 10: "fins (accepting A) (trace (w ||| s) q)" using 3 9 8 by this
     have 11: "fins (accepting A) s" using 10 unfolding trace_alt_def by simp
     have 12: "infs (gaccepting A) r" using infs_mono[OF _ 6(2)] by simp
     have "s = smap snd (t @- y @- r)" unfolding 7(1) by simp
     also have "infs (accepting A) \<dots>" using 12 by (simp add: comp_def)
     finally have 13: "infs (accepting A) s" by this
     show False using 11 13 by simp
   qed
 
   lemma remove_run:
     assumes "finite (nodes A)" "w \<notin> language A"
     assumes "V \<subseteq> gunodes A w" "clean A w V \<noteq> {}"
     obtains v r
     where
       "grun A w V r v"
       "sset (gtrace r v) \<subseteq> clean A w V"
       "sset (gtrace r v) \<subseteq> - prune A w (clean A w V)"
   proof -
     obtain u where 1: "u \<in> clean A w V" "\<forall> x \<in> greachable A w (clean A w V) u. \<not> gaccepting A x"
     proof (rule find_safe)
       show "w \<notin> language A" using assms(2) by this
       show "clean A w V \<noteq> {}" using assms(4) by this
       show "clean A w V \<subseteq> gunodes A w" using assms(3) by (meson clean_decreasing subset_iff)
     next
       fix v
       assume 1: "v \<in> clean A w V"
       have 2: "v \<in> V" using 1 clean_decreasing by blast
       have 3: "infinite (greachable A w V v)" using 1 clean_def by auto
       have "gsuccessors A w V v \<subseteq> gusuccessors A w v" by auto
       also have "finite \<dots>" using 2 assms(1, 3) finite_nodes_gsuccessors by blast
       finally have 4: "finite (gsuccessors A w V v)" by this
       have 5: "infinite (insert v (\<Union>((greachable A w V) ` (gsuccessors A w V v))))"
         using graph.reachable_step 3 by metis
       obtain u where 6: "u \<in> gsuccessors A w V v" "infinite (greachable A w V u)" using 4 5 by auto
       have 7: "u \<in> clean A w V" using 6 unfolding clean_def by auto
       show "gsuccessors A w (clean A w V) v \<noteq> {}" using 6(1) 7 by auto
     qed auto
     have 2: "u \<in> V" using 1(1) unfolding clean_def by auto
     have 3: "infinite (greachable A w V u)" using 1(1) unfolding clean_def by simp
     have 4: "finite (gsuccessors A w V v)" if "v \<in> greachable A w V u" for v
     proof -
       have 1: "v \<in> V" using that greachable_subset 2 by blast
       have "gsuccessors A w V v \<subseteq> gusuccessors A w v" by auto
       also have "finite \<dots>" using 1 assms(1, 3) finite_nodes_gsuccessors by blast
       finally show ?thesis by this
     qed
     obtain r where 5: "grun A w V r u" using graph.koenig[OF 3 4] by this
     have 6: "greachable A w V u \<subseteq> V" using 2 greachable_subset by blast
     have 7: "sset (gtrace r u) \<subseteq> V"
       using graph.reachable_trace[OF graph.reachable.reflexive 5(1)] 6 by blast
     have 8: "sset (gtrace r u) \<subseteq> clean A w V"
       unfolding clean_def using 7 infinite_greachable_gtrace[OF 5(1)] by auto
     have 9: "sset (gtrace r u) \<subseteq> greachable A w (clean A w V) u"
       using 5 8 by (metis graph.reachable.reflexive graph.reachable_trace grun_subset)
     show ?thesis
     proof
       show "grun A w V r u" using 5(1) by this
       show "sset (gtrace r u) \<subseteq> clean A w V" using 8 by this
       show "sset (gtrace r u) \<subseteq> - prune A w (clean A w V)"
       proof (intro subsetI ComplI)
         fix p
         assume 10: "p \<in> sset (gtrace r u)" "p \<in> prune A w (clean A w V)"
         have 20: "\<exists> x \<in> greachable A w (clean A w V) p. gaccepting A x"
           using 10(2) unfolding prune_def by auto
         have 30: "greachable A w (clean A w V) p \<subseteq> greachable A w (clean A w V) u"
           using 10(1) 9 by blast
         show "False" using 1(2) 20 30 by force
       qed
     qed
   qed
 
   lemma level_bounded:
     assumes "finite (nodes A)" "w \<notin> language A"
     obtains n
     where "\<And> l. l \<ge> n \<Longrightarrow> card (level A w (2 * k) l) \<le> card (nodes A) - k"
   proof (induct k arbitrary: thesis)
     case (0)
     show ?case
     proof (rule 0)
       fix l :: nat
       have "finite ({l} \<times> nodes A)" using assms(1) by simp
       also have "level A w 0 l \<subseteq> {l} \<times> nodes A" using gnodes_nodes by force
       also (card_mono) have "card \<dots> = card (nodes A)" using assms(1) by simp
       finally show "card (level A w (2 * 0) l) \<le> card (nodes A) - 0" by simp
     qed
   next
     case (Suc k)
     show ?case
     proof (cases "graph A w (Suc (2 * k)) = {}")
       case True
       have 3: "graph A w (2 * Suc k) = {}" using True prune_decreasing by simp blast
       show ?thesis using Suc(2) 3 by simp
     next
       case False
       obtain v r where 1:
         "grun A w (graph A w (2 * k)) r v"
         "sset (gtrace r v) \<subseteq> graph A w (Suc (2 * k))"
         "sset (gtrace r v) \<subseteq> - graph A w (Suc (Suc (2 * k)))"
       proof (rule remove_run)
         show "finite (nodes A)" "w \<notin> language A" using assms by this
         show "clean A w (graph A w (2 * k)) \<noteq> {}" using False by simp
         show "graph A w (2 * k) \<subseteq> gunodes A w" using graph_nodes by this
       qed auto
       obtain l q where 2: "v = (l, q)" by force
       obtain n where 90: "\<And> l. n \<le> l \<Longrightarrow> card (level A w (2 * k) l) \<le> card (nodes A) - k"
         using Suc(1) by blast
       show ?thesis
       proof (rule Suc(2))
         fix j
         assume 100: "n + Suc l \<le> j"
         have 6: "graph A w (Suc (Suc (2 * k))) \<subseteq> graph A w (Suc (2 * k))"
           using graph_antimono antimono_iff_le_Suc by blast
         have 101: "gtrace r v !! (j - Suc l) \<in> graph A w (Suc (2 * k))" using 1(2) snth_sset by auto
         have 102: "gtrace r v !! (j - Suc l) \<notin> graph A w (Suc (Suc (2 * k)))" using 1(3) snth_sset by blast
         have 103: "gtrace r v !! (j - Suc l) \<in> level A w (Suc (2 * k)) j"
           using 1(1) 100 101 2 by (auto elim: grun_elim)
         have 104: "gtrace r v !! (j - Suc l) \<notin> level A w (Suc (Suc (2 * k))) j" using 100 102 by simp
         have "level A w (2 * Suc k) j = level A w (Suc (Suc (2 * k))) j" by simp
         also have "\<dots> \<subset> level A w (Suc (2 * k)) j" using 103 104 6 by blast
         also have "\<dots> \<subseteq> level A w (2 * k) j" by (simp add: Collect_mono clean_def)
         finally have 105: "level A w (2 * Suc k) j \<subset> level A w (2 * k) j" by this
         have "card (level A w (2 * Suc k) j) < card (level A w (2 * k) j)"
           using assms(1) 105 by (simp add: graph_level_finite psubset_card_mono)
         also have "\<dots> \<le> card (nodes A) - k" using 90 100 by simp
         finally show "card (level A w (2 * Suc k) j) \<le> card (nodes A) - Suc k" by simp
       qed
     qed
   qed
   lemma graph_empty:
     assumes "finite (nodes A)" "w \<notin> language A"
     shows "graph A w (Suc (2 * card (nodes A))) = {}"
   proof -
     obtain n where 1: "\<And> l. l \<ge> n \<Longrightarrow> card (level A w (2 * card (nodes A)) l) = 0"
       using level_bounded[OF assms(1, 2), of "card (nodes A)"] by auto
     have "graph A w (2 * card (nodes A)) =
       (\<Union> l \<in> {..< n}. level A w (2 * card (nodes A)) l) \<union>
       (\<Union> l \<in> {n ..}. level A w (2 * card (nodes A)) l)"
       by auto
     also have "(\<Union> l \<in> {n ..}. level A w (2 * card (nodes A)) l) = {}"
       using graph_level_finite assms(1) 1 by fastforce
     also have "finite ((\<Union> l \<in> {..< n}. level A w (2 * card (nodes A)) l) \<union> {})"
       using graph_level_finite assms(1) by auto
     finally have 100: "finite (graph A w (2 * card (nodes A)))" by this
     have 101: "finite (greachable A w (graph A w (2 * card (nodes A))) v)" for v
       using 100 greachable_subset[of A w "graph A w (2 * card (nodes A))" v]
       using finite_insert infinite_super by auto
     show ?thesis using 101 by (simp add: clean_def)
   qed
   lemma graph_le:
     assumes "finite (nodes A)" "w \<notin> language A"
     assumes "v \<in> graph A w k"
     shows "k \<le> 2 * card (nodes A)"
     using graph_empty graph_antimono assms
     by (metis (no_types, lifting) Suc_leI antimono_def basic_trans_rules(30) empty_iff not_le_imp_less)
 
   subsection \<open>Node Ranks\<close>
 
   definition rank :: "('label, 'state) nba \<Rightarrow> 'label stream \<Rightarrow> 'state node \<Rightarrow> nat" where
     "rank A w v \<equiv> GREATEST k. v \<in> graph A w k"
 
   lemma rank_member:
     assumes "finite (nodes A)" "w \<notin> language A" "v \<in> gunodes A w"
     shows "v \<in> graph A w (rank A w v)"
   unfolding rank_def
   proof (rule GreatestI_nat)
     show "v \<in> graph A w 0" using assms(3) by simp
     show "\<forall> k. v \<in> graph A w k \<longrightarrow> k \<le> 2 * card (nodes A)" using graph_le assms(1, 2) by blast
   qed
   lemma rank_removed:
     assumes "finite (nodes A)" "w \<notin> language A"
     shows "v \<notin> graph A w (Suc (rank A w v))"
   proof
     assume "v \<in> graph A w (Suc (rank A w v))"
     then have 2: "Suc (rank A w v) \<le> rank A w v"
       unfolding rank_def using Greatest_le_nat graph_le assms by metis
     then show "False" by auto
   qed
   lemma rank_le:
     assumes "finite (nodes A)" "w \<notin> language A"
     assumes "v \<in> gunodes A w" "u \<in> gusuccessors A w v"
     shows "rank A w u \<le> rank A w v"
   unfolding rank_def
   proof (rule Greatest_le_nat)
     have 1: "u \<in> gureachable A w v" using graph.reachable_successors assms(4) by blast
     have 2: "u \<in> gunodes A w" using assms(3) 1 by auto
     show "v \<in> graph A w (GREATEST k. u \<in> graph A w k)"
     unfolding rank_def[symmetric]
     proof (rule graph_successors)
       show "v \<in> gunodes A w" using assms(3) by this
       show "u \<in> gusuccessors A w v" using assms(4) by this
       show "u \<in> graph A w (rank A w u)" using rank_member assms(1, 2) 2 by this
     qed
     show "\<forall> k. v \<in> graph A w k \<longrightarrow> k \<le> 2 * card (nodes A)" using graph_le assms(1, 2) by blast
   qed
 
   lemma language_ranking:
     assumes "finite (nodes A)" "w \<notin> language A"
     shows "ranking A w (rank A w)"
   unfolding ranking_def
   proof (intro conjI ballI allI impI)
     fix v
     assume 1: "v \<in> gunodes A w"
     have 2: "v \<in> graph A w (rank A w v)" using rank_member assms 1 by this
     show "rank A w v \<le> 2 * card (nodes A)" using graph_le assms 2 by this
   next
     fix v u
     assume 1: "v \<in> gunodes A w" "u \<in> gusuccessors A w v"
     show "rank A w u \<le> rank A w v" using rank_le assms 1 by this
   next
     fix v
     assume 1: "v \<in> gunodes A w" "gaccepting A v"
     have 2: "v \<in> graph A w (rank A w v)" using rank_member assms 1(1) by this
     have 3: "v \<notin> graph A w (Suc (rank A w v))" using rank_removed assms by this
     have 4: "v \<in> prune A w (graph A w (rank A w v))" using 2 1(2) unfolding prune_def by auto
     have 5: "graph A w (Suc (rank A w v)) \<noteq> prune A w (graph A w (rank A w v))" using 3 4 by blast
     show "even (rank A w v)" using 5 by auto
   next
     fix v r k
     assume 1: "v \<in> gunodes A w" "gurun A w r v" "smap (rank A w) (gtrace r v) = sconst k"
     have "sset (gtrace r v) \<subseteq> gureachable A w v"
       using 1(2) by (metis graph.reachable.reflexive graph.reachable_trace)
     then have 6: "sset (gtrace r v) \<subseteq> gunodes A w" using 1(1) by blast
     have 60: "rank A w ` sset (gtrace r v) \<subseteq> {k}"
       using 1(3) by (metis equalityD1 sset_sconst stream.set_map)
     have 50: "sset (gtrace r v) \<subseteq> graph A w k"
       using rank_member[OF assms] subsetD[OF 6] 60 unfolding image_subset_iff by auto
     have 70: "grun A w (graph A w k) r v" using grun_subset 1(2) 50 by this
     have 7: "sset (gtrace r v) \<subseteq> clean A w (graph A w k)"
       unfolding clean_def using 50 infinite_greachable_gtrace[OF 70] by auto
     have 8: "sset (gtrace r v) \<inter> graph A w (Suc k) = {}" using rank_removed[OF assms] 60 by blast
     have 9: "sset (gtrace r v) \<noteq> {}" using stream.set_sel(1) by auto
     have 10: "graph A w (Suc k) \<noteq> clean A w (graph A w k)" using 7 8 9 by blast
     show "odd k" using 10 unfolding graph_Suc by auto
   qed
 
   subsection \<open>Correctness Theorem\<close>
 
   theorem language_ranking_iff:
     assumes "finite (nodes A)"
     shows "w \<notin> language A \<longleftrightarrow> (\<exists> f. ranking A w f)"
     using ranking_language language_ranking assms by blast
 
 end
diff --git a/thys/LTL_Master_Theorem/Code_Export.thy b/thys/LTL_Master_Theorem/Code_Export.thy
--- a/thys/LTL_Master_Theorem/Code_Export.thy
+++ b/thys/LTL_Master_Theorem/Code_Export.thy
@@ -1,55 +1,55 @@
 (*
     Author:   Benedikt Seidl
     License:  BSD
 *)
 
 section \<open>Code export to Standard ML\<close>
 
 theory Code_Export
 imports
   "LTL_to_DRA/DRA_Implementation"
   LTL.Code_Equations
   "HOL-Library.Code_Target_Numeral"
 begin
 
 subsection \<open>LTL to DRA\<close>
 
 export_code ltlc_to_draei checking
 
 
 declare ltl_to_dra.af_letter\<^sub>F_lifted_semantics [code]
 declare ltl_to_dra.af_letter\<^sub>G_lifted_semantics [code]
 declare ltl_to_dra.af_letter\<^sub>\<nu>_lifted_semantics [code]
 
 definition atoms_ltlc_list_literals :: "String.literal ltlc \<Rightarrow> String.literal list"
 where
   "atoms_ltlc_list_literals = atoms_ltlc_list"
 
 definition ltlc_to_draei_literals :: "String.literal ltlc \<Rightarrow> (String.literal set, nat) draei"
 where
   "ltlc_to_draei_literals = ltlc_to_draei"
 
 definition sort_transitions :: "(nat \<times> String.literal set \<times> nat) list \<Rightarrow> (nat \<times> String.literal set \<times> nat) list"
 where
   "sort_transitions = sort_key fst"
 
 export_code True_ltlc Iff_ltlc ltlc_to_draei_literals
-  alphabetei initialei transitionei acceptingei
+  alphabetei initialei transitionei conditionei
   integer_of_nat atoms_ltlc_list_literals sort_transitions set
   in SML module_name LTL file_prefix LTL_to_DRA
 
 
 
 subsection \<open>LTL to NBA\<close>
 
 (* TODO *)
 
 
 
 subsection \<open>LTL to LDBA\<close>
 
 (* TODO *)
 
 
 
 end
diff --git a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Construction.thy b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Construction.thy
--- a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Construction.thy
+++ b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Construction.thy
@@ -1,443 +1,436 @@
 (*
     Author:   Benedikt Seidl
     License:  BSD
 *)
 
 section \<open>Constructing DRAs for LTL Formulas\<close>
 
 theory DRA_Construction
   imports
     Transition_Functions
 
     "../Quotient_Type"
     "../Omega_Words_Fun_Stream"
 
     "../Logical_Characterization/Master_Theorem"
 
     Transition_Systems_and_Automata.DBA_Combine
     Transition_Systems_and_Automata.DCA_Combine
     Transition_Systems_and_Automata.DRA_Combine
 begin
 
 \<comment> \<open>We use prefix and suffix on infinite words.\<close>
 hide_const Sublist.prefix Sublist.suffix
 
 locale dra_construction = transition_functions eq + quotient eq Rep Abs
   for
     eq :: "'a ltln \<Rightarrow> 'a ltln \<Rightarrow> bool" (infix "\<sim>" 75)
   and
     Rep :: "'ltlq \<Rightarrow> 'a ltln"
   and
     Abs :: "'a ltln \<Rightarrow> 'ltlq"
 begin
 
 subsection \<open>Lifting Setup\<close>
 
 abbreviation true\<^sub>n_lifted :: "'ltlq" ("\<up>true\<^sub>n") where
   "\<up>true\<^sub>n \<equiv> Abs true\<^sub>n"
 
 abbreviation false\<^sub>n_lifted :: "'ltlq" ("\<up>false\<^sub>n") where
   "\<up>false\<^sub>n \<equiv> Abs false\<^sub>n"
 
 abbreviation af_letter_lifted :: "'a set \<Rightarrow> 'ltlq \<Rightarrow> 'ltlq" ("\<up>afletter") where
   "\<up>afletter \<nu> \<phi> \<equiv> Abs (af_letter (Rep \<phi>) \<nu>)"
 
 abbreviation af_lifted :: "'ltlq \<Rightarrow> 'a set list \<Rightarrow> 'ltlq" ("\<up>af") where
   "\<up>af \<phi> w \<equiv> fold \<up>afletter w \<phi>"
 
 abbreviation GF_advice_lifted :: "'ltlq \<Rightarrow> 'a ltln set \<Rightarrow> 'ltlq" ("_\<up>[_]\<^sub>\<nu>" [90,60] 89) where
   "\<phi>\<up>[X]\<^sub>\<nu> \<equiv> Abs ((Rep \<phi>)[X]\<^sub>\<nu>)"
 
 
 lemma af_letter_lifted_semantics:
   "\<up>afletter \<nu> (Abs \<phi>) = Abs (af_letter \<phi> \<nu>)"
   by (metis Rep_Abs_eq af_letter_congruent Abs_eq)
 
 lemma af_lifted_semantics:
   "\<up>af (Abs \<phi>) w = Abs (af \<phi> w)"
   by (induction w rule: rev_induct) (auto simp: Abs_eq, insert Rep_Abs_eq af_letter_congruent eq_sym, blast)
 
 lemma af_lifted_range:
   "range (\<up>af (Abs \<phi>)) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>}"
   using af_lifted_semantics af_nested_prop_atoms by blast
 
 
 definition af_letter\<^sub>F_lifted :: "'a ltln \<Rightarrow> 'a set \<Rightarrow> 'ltlq \<Rightarrow> 'ltlq" ("\<up>afletter\<^sub>F")
 where
   "\<up>afletter\<^sub>F \<phi> \<nu> \<psi> \<equiv> Abs (af_letter\<^sub>F \<phi> (Rep \<psi>) \<nu>)"
 
 definition af_letter\<^sub>G_lifted :: "'a ltln \<Rightarrow> 'a set \<Rightarrow> 'ltlq \<Rightarrow> 'ltlq" ("\<up>afletter\<^sub>G")
 where
   "\<up>afletter\<^sub>G \<phi> \<nu> \<psi> \<equiv> Abs (af_letter\<^sub>G \<phi> (Rep \<psi>) \<nu>)"
 
 lemma af_letter\<^sub>F_lifted_semantics:
   "\<up>afletter\<^sub>F \<phi> \<nu> (Abs \<psi>) = Abs (af_letter\<^sub>F \<phi> \<psi> \<nu>)"
   by (metis af_letter\<^sub>F_lifted_def Rep_inverse af_letter\<^sub>F_def af_letter_congruent Abs_eq)
 
 lemma af_letter\<^sub>G_lifted_semantics:
   "\<up>afletter\<^sub>G \<phi> \<nu> (Abs \<psi>) = Abs (af_letter\<^sub>G \<phi> \<psi> \<nu>)"
   by (metis af_letter\<^sub>G_lifted_def Rep_inverse af_letter\<^sub>G_def af_letter_congruent Abs_eq)
 
 abbreviation af\<^sub>F_lifted :: "'a ltln \<Rightarrow> 'ltlq \<Rightarrow> 'a set list \<Rightarrow> 'ltlq" ("\<up>af\<^sub>F")
 where
   "\<up>af\<^sub>F \<phi> \<psi> w \<equiv> fold (\<up>afletter\<^sub>F \<phi>) w \<psi>"
 
 abbreviation af\<^sub>G_lifted :: "'a ltln \<Rightarrow> 'ltlq \<Rightarrow> 'a set list \<Rightarrow> 'ltlq" ("\<up>af\<^sub>G")
 where
   "\<up>af\<^sub>G \<phi> \<psi> w \<equiv> fold (\<up>afletter\<^sub>G \<phi>) w \<psi>"
 
 lemma af\<^sub>F_lifted_semantics:
   "\<up>af\<^sub>F \<phi> (Abs \<psi>) w = Abs (af\<^sub>F \<phi> \<psi> w)"
   by (induction w rule: rev_induct) (auto simp: af_letter\<^sub>F_lifted_semantics)
 
 lemma af\<^sub>G_lifted_semantics:
   "\<up>af\<^sub>G \<phi> (Abs \<psi>) w = Abs (af\<^sub>G \<phi> \<psi> w)"
   by (induction w rule: rev_induct) (auto simp: af_letter\<^sub>G_lifted_semantics)
 
 lemma af\<^sub>F_lifted_range:
   "nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (F\<^sub>n \<phi>) \<Longrightarrow> range (\<up>af\<^sub>F \<phi> (Abs \<psi>)) \<subseteq>  {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (F\<^sub>n \<phi>)}"
   using af\<^sub>F_lifted_semantics af\<^sub>F_nested_prop_atoms by blast
 
 lemma af\<^sub>G_lifted_range:
   "nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (G\<^sub>n \<phi>) \<Longrightarrow> range (\<up>af\<^sub>G \<phi> (Abs \<psi>)) \<subseteq>  {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (G\<^sub>n \<phi>)}"
   using af\<^sub>G_lifted_semantics af\<^sub>G_nested_prop_atoms by blast
 
 
 definition af_letter\<^sub>\<nu>_lifted :: "'a ltln set \<Rightarrow> 'a set \<Rightarrow> 'ltlq \<times> 'ltlq \<Rightarrow> 'ltlq \<times> 'ltlq" ("\<up>afletter\<^sub>\<nu>")
 where
   "\<up>afletter\<^sub>\<nu> X \<nu> p \<equiv>
     (Abs (fst (af_letter\<^sub>\<nu> X (Rep (fst p), Rep (snd p)) \<nu>)),
      Abs (snd (af_letter\<^sub>\<nu> X (Rep (fst p), Rep (snd p)) \<nu>)))"
 
 abbreviation af\<^sub>\<nu>_lifted :: "'a ltln set \<Rightarrow> 'ltlq \<times> 'ltlq \<Rightarrow> 'a set list \<Rightarrow> 'ltlq \<times> 'ltlq" ("\<up>af\<^sub>\<nu>")
 where
   "\<up>af\<^sub>\<nu> X p w \<equiv> fold (\<up>afletter\<^sub>\<nu> X) w p"
 
 lemma af_letter\<^sub>\<nu>_lifted_semantics:
   "\<up>afletter\<^sub>\<nu> X \<nu> (Abs x, Abs y) = (Abs (fst (af_letter\<^sub>\<nu> X (x, y) \<nu>)), Abs (snd (af_letter\<^sub>\<nu> X (x, y) \<nu>)))"
   by (simp add: af_letter\<^sub>\<nu>_def af_letter\<^sub>\<nu>_lifted_def) (insert GF_advice_congruent Rep_Abs_eq Rep_inverse af_letter_lifted_semantics eq_trans Abs_eq, blast)
 
 lemma af\<^sub>\<nu>_lifted_semantics:
   "\<up>af\<^sub>\<nu> X (Abs \<xi>, Abs \<zeta>) w = (Abs (fst (af\<^sub>\<nu> X (\<xi>, \<zeta>) w)), Abs (snd (af\<^sub>\<nu> X (\<xi>, \<zeta>) w)))"
   apply (induction w rule: rev_induct) 
    apply (auto simp: af_letter\<^sub>\<nu>_lifted_def af_letter\<^sub>\<nu>_lifted_semantics af_letter_lifted_semantics)
   by (metis (no_types, hide_lams) af_letter\<^sub>\<nu>_lifted_def af\<^sub>\<nu>_fst af_letter\<^sub>\<nu>_lifted_semantics eq_fst_iff prod.sel(2))
 
 
 
 subsection \<open>Büchi automata for basic languages\<close>
 
 definition \<AA>\<^sub>\<mu> :: "'a ltln \<Rightarrow> ('a set, 'ltlq) dba" where
   "\<AA>\<^sub>\<mu> \<phi> = dba UNIV (Abs \<phi>) \<up>afletter (\<lambda>\<psi>. \<psi> = \<up>true\<^sub>n)"
 
 definition \<AA>\<^sub>\<mu>_GF :: "'a ltln \<Rightarrow> ('a set, 'ltlq) dba" where
   "\<AA>\<^sub>\<mu>_GF \<phi> = dba UNIV (Abs (F\<^sub>n \<phi>)) (\<up>afletter\<^sub>F \<phi>) (\<lambda>\<psi>. \<psi> = \<up>true\<^sub>n)"
 
 definition \<AA>\<^sub>\<nu> :: "'a ltln \<Rightarrow> ('a set, 'ltlq) dca" where
   "\<AA>\<^sub>\<nu> \<phi> = dca UNIV (Abs \<phi>) \<up>afletter (\<lambda>\<psi>. \<psi> = \<up>false\<^sub>n)"
 
 definition \<AA>\<^sub>\<nu>_FG :: "'a ltln \<Rightarrow> ('a set, 'ltlq) dca" where
   "\<AA>\<^sub>\<nu>_FG \<phi> = dca UNIV (Abs (G\<^sub>n \<phi>)) (\<up>afletter\<^sub>G \<phi>) (\<lambda>\<psi>. \<psi> = \<up>false\<^sub>n)"
 
 
 lemma dba_run:
-  "DBA.run (dba UNIV p \<delta> \<alpha>) (to_stream w) p"
-  unfolding DBA.run_def by (rule transition_system.snth_run) fastforce
+  "DBA.run (dba UNIV p \<delta> \<alpha>) (to_stream w) p" unfolding dba.run_alt_def by simp
 
 lemma dca_run:
-  "DCA.run (dca UNIV p \<delta> \<alpha>) (to_stream w) p"
-  unfolding DCA.run_def by (rule transition_system.snth_run) fastforce
+  "DCA.run (dca UNIV p \<delta> \<alpha>) (to_stream w) p" unfolding dca.run_alt_def by simp
 
 
 lemma \<AA>\<^sub>\<mu>_language:
   "\<phi> \<in> \<mu>LTL \<Longrightarrow> to_stream w \<in> DBA.language (\<AA>\<^sub>\<mu> \<phi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
 proof -
   assume "\<phi> \<in> \<mu>LTL"
 
   then have "w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow> (\<forall>n. \<exists>k\<ge>n. af \<phi> (w[0 \<rightarrow> k]) \<sim> true\<^sub>n)"
     by (meson af_\<mu>LTL af_prefix_true le_cases)
 
   also have "\<dots> \<longleftrightarrow> (\<forall>n. \<exists>k\<ge>n. af \<phi> (w[0 \<rightarrow> Suc k]) \<sim> true\<^sub>n)"
     by (meson af_prefix_true le_SucI order_refl)
 
   also have "\<dots> \<longleftrightarrow> infs (\<lambda>\<psi>. \<psi> = \<up>true\<^sub>n) (DBA.trace (\<AA>\<^sub>\<mu> \<phi>) (to_stream w) (Abs \<phi>))"
     by (simp add: infs_snth \<AA>\<^sub>\<mu>_def DBA.transition_def af_lifted_semantics Abs_eq[symmetric] af_letter_lifted_semantics)
 
   also have "\<dots> \<longleftrightarrow> to_stream w \<in> DBA.language (\<AA>\<^sub>\<mu> \<phi>)"
-    unfolding \<AA>\<^sub>\<mu>_def dba.initial_def dba.accepting_def
-    by (metis dba_run DBA.language DBA.language_elim dba.sel(2) dba.sel(4))
+    unfolding \<AA>\<^sub>\<mu>_def dba.initial_def dba.accepting_def by (auto simp: dba_run)
 
   finally show ?thesis
     by simp
 qed
 
 lemma \<AA>\<^sub>\<mu>_GF_language:
   "\<phi> \<in> \<mu>LTL \<Longrightarrow> to_stream w \<in> DBA.language (\<AA>\<^sub>\<mu>_GF \<phi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<phi>)"
 proof -
   assume "\<phi> \<in> \<mu>LTL"
 
   then have "w \<Turnstile>\<^sub>n G\<^sub>n (F\<^sub>n \<phi>) \<longleftrightarrow> (\<forall>n. \<exists>k. af (F\<^sub>n \<phi>) (w[n \<rightarrow> k]) \<sim>\<^sub>L true\<^sub>n)"
     using ltl_lang_equivalence.af_\<mu>LTL_GF by blast
 
   also have "\<dots> \<longleftrightarrow> (\<forall>n. \<exists>k>n. af\<^sub>F \<phi> (F\<^sub>n \<phi>) (w[0 \<rightarrow> k]) \<sim> true\<^sub>n)"
     using af\<^sub>F_semantics_ltr af\<^sub>F_semantics_rtl
     using \<open>\<phi> \<in> \<mu>LTL\<close> af_\<mu>LTL_GF calculation by blast
 
   also have "\<dots> \<longleftrightarrow> (\<forall>n. \<exists>k\<ge>n. af\<^sub>F \<phi> (F\<^sub>n \<phi>) (w[0 \<rightarrow> Suc k]) \<sim> true\<^sub>n)"
     by (metis less_Suc_eq_le less_imp_Suc_add)
 
   also have "\<dots> \<longleftrightarrow> infs (\<lambda>\<psi>. \<psi> = \<up>true\<^sub>n) (DBA.trace (\<AA>\<^sub>\<mu>_GF \<phi>) (to_stream w) (Abs (F\<^sub>n \<phi>)))"
     by (simp add: infs_snth \<AA>\<^sub>\<mu>_GF_def DBA.transition_def af\<^sub>F_lifted_semantics Abs_eq[symmetric] af_letter\<^sub>F_lifted_semantics)
 
   also have "\<dots> \<longleftrightarrow> to_stream w \<in> DBA.language (\<AA>\<^sub>\<mu>_GF \<phi>)"
-    unfolding \<AA>\<^sub>\<mu>_GF_def dba.initial_def dba.accepting_def
-    by (metis dba_run DBA.language DBA.language_elim dba.sel(2) dba.sel(4))
+    unfolding \<AA>\<^sub>\<mu>_GF_def dba.initial_def dba.accepting_def by (auto simp: dba_run)
 
   finally show ?thesis
     by simp
 qed
 
 lemma \<AA>\<^sub>\<nu>_language:
   "\<phi> \<in> \<nu>LTL \<Longrightarrow> to_stream w \<in> DCA.language (\<AA>\<^sub>\<nu> \<phi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>"
 proof -
   assume "\<phi> \<in> \<nu>LTL"
 
   then have "w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow> (\<exists>n. \<forall>k\<ge>n. \<not> af \<phi> (w[0 \<rightarrow> k]) \<sim> false\<^sub>n)"
     by (meson af_\<nu>LTL af_prefix_false le_cases order_refl)
 
   also have "\<dots> \<longleftrightarrow> (\<exists>n. \<forall>k\<ge>n. \<not> af \<phi> (w[0 \<rightarrow> Suc k]) \<sim> false\<^sub>n)"
     by (meson af_prefix_false le_SucI order_refl)
 
   also have "\<dots> \<longleftrightarrow> fins (\<lambda>\<psi>. \<psi> = \<up>false\<^sub>n) (DCA.trace (\<AA>\<^sub>\<nu> \<phi>) (to_stream w) (Abs \<phi>))"
     by (simp add: infs_snth \<AA>\<^sub>\<nu>_def DBA.transition_def af_lifted_semantics Abs_eq[symmetric] af_letter_lifted_semantics)
 
   also have "\<dots> \<longleftrightarrow> to_stream w \<in> DCA.language (\<AA>\<^sub>\<nu> \<phi>)"
-    unfolding \<AA>\<^sub>\<nu>_def dca.initial_def dca.rejecting_def
-    by (metis dca_run DCA.language DCA.language_elim dca.sel(2) dca.sel(4))
+    unfolding \<AA>\<^sub>\<nu>_def dca.initial_def dca.rejecting_def by (auto simp: dca_run)
 
   finally show ?thesis
     by simp
 qed
 
 lemma \<AA>\<^sub>\<nu>_FG_language:
   "\<phi> \<in> \<nu>LTL \<Longrightarrow> to_stream w \<in> DCA.language (\<AA>\<^sub>\<nu>_FG \<phi>) \<longleftrightarrow> w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<phi>)"
 proof -
   assume "\<phi> \<in> \<nu>LTL"
 
   then have "w \<Turnstile>\<^sub>n F\<^sub>n (G\<^sub>n \<phi>) \<longleftrightarrow> (\<exists>k. \<forall>j. \<not> af (G\<^sub>n \<phi>) (w[k \<rightarrow> j]) \<sim>\<^sub>L false\<^sub>n)"
     using ltl_lang_equivalence.af_\<nu>LTL_FG by blast
 
   also have "\<dots> \<longleftrightarrow> (\<exists>n. \<forall>k>n. \<not> af\<^sub>G \<phi> (G\<^sub>n \<phi>) (w[0 \<rightarrow> k]) \<sim> false\<^sub>n)"
     using af\<^sub>G_semantics_ltr af\<^sub>G_semantics_rtl
     using \<open>\<phi> \<in> \<nu>LTL\<close> af_\<nu>LTL_FG calculation by blast
 
   also have "\<dots> \<longleftrightarrow> (\<exists>n. \<forall>k\<ge>n. \<not> af\<^sub>G \<phi> (G\<^sub>n \<phi>) (w[0 \<rightarrow> Suc k]) \<sim> false\<^sub>n)"
     by (metis less_Suc_eq_le less_imp_Suc_add)
 
   also have "\<dots> \<longleftrightarrow> fins (\<lambda>\<psi>. \<psi> = \<up>false\<^sub>n) (DCA.trace (\<AA>\<^sub>\<nu>_FG \<phi>) (to_stream w) (Abs (G\<^sub>n \<phi>)))"
     by (simp add: infs_snth \<AA>\<^sub>\<nu>_FG_def DBA.transition_def af\<^sub>G_lifted_semantics Abs_eq[symmetric] af_letter\<^sub>G_lifted_semantics)
 
   also have "\<dots> \<longleftrightarrow> to_stream w \<in> DCA.language (\<AA>\<^sub>\<nu>_FG \<phi>)"
-    unfolding \<AA>\<^sub>\<nu>_FG_def dca.initial_def dca.rejecting_def
-    by (metis dca_run DCA.language DCA.language_elim dca.sel(2) dca.sel(4))
+    unfolding \<AA>\<^sub>\<nu>_FG_def dca.initial_def dca.rejecting_def by (auto simp: dca_run)
 
   finally show ?thesis
     by simp
 qed
 
 
 lemma \<AA>\<^sub>\<mu>_nodes:
   "DBA.nodes (\<AA>\<^sub>\<mu> \<phi>) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>}"
-  unfolding \<AA>\<^sub>\<mu>_def transition_system_initial.nodes_alt_def
+  unfolding \<AA>\<^sub>\<mu>_def
   using af_lifted_semantics af_nested_prop_atoms by fastforce
 
 lemma \<AA>\<^sub>\<mu>_GF_nodes:
   "DBA.nodes (\<AA>\<^sub>\<mu>_GF \<phi>) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (F\<^sub>n \<phi>)}"
-  unfolding \<AA>\<^sub>\<mu>_GF_def DBA.nodes_def transition_system_initial.nodes_alt_def transition_system.reachable_alt_def
+  unfolding \<AA>\<^sub>\<mu>_GF_def dba.nodes_alt_def dba.reachable_alt_def
   using af\<^sub>F_nested_prop_atoms[of "F\<^sub>n \<phi>"] by (auto simp: af\<^sub>F_lifted_semantics)
 
 lemma \<AA>\<^sub>\<nu>_nodes:
   "DCA.nodes (\<AA>\<^sub>\<nu> \<phi>) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>}"
-  unfolding \<AA>\<^sub>\<nu>_def transition_system_initial.nodes_alt_def
+  unfolding \<AA>\<^sub>\<nu>_def
   using af_lifted_semantics af_nested_prop_atoms by fastforce
 
 lemma \<AA>\<^sub>\<nu>_FG_nodes:
   "DCA.nodes (\<AA>\<^sub>\<nu>_FG \<phi>) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms (G\<^sub>n \<phi>)}"
-  unfolding \<AA>\<^sub>\<nu>_FG_def DCA.nodes_def transition_system_initial.nodes_alt_def transition_system.reachable_alt_def
+  unfolding \<AA>\<^sub>\<nu>_FG_def dca.nodes_alt_def dca.reachable_alt_def
   using af\<^sub>G_nested_prop_atoms[of "G\<^sub>n \<phi>"] by (auto simp: af\<^sub>G_lifted_semantics)
 
 
 
 subsection \<open>A DCA checking the GF-advice Function\<close>
 
 definition \<CC> :: "'a ltln \<Rightarrow> 'a ltln set \<Rightarrow> ('a set, 'ltlq \<times> 'ltlq) dca" where
   "\<CC> \<phi> X = dca UNIV (Abs \<phi>, Abs (\<phi>[X]\<^sub>\<nu>)) (\<up>afletter\<^sub>\<nu> X) (\<lambda>p. snd p = \<up>false\<^sub>n)"
 
 lemma \<CC>_language:
   "to_stream w \<in> DCA.language (\<CC> \<phi> X) \<longleftrightarrow> (\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>)"
 proof -
 
   have "(\<exists>i. suffix i w \<Turnstile>\<^sub>n af \<phi> (prefix i w)[X]\<^sub>\<nu>)
         \<longleftrightarrow> (\<exists>m. \<forall>k\<ge>m. \<not> snd (af\<^sub>\<nu> X (\<phi>, \<phi>[X]\<^sub>\<nu>) (prefix (Suc k) w)) \<sim> false\<^sub>n)"
     using af\<^sub>\<nu>_semantics_ltr af\<^sub>\<nu>_semantics_rtl by blast
 
   also have "\<dots> \<longleftrightarrow> fins (\<lambda>p. snd p = \<up>false\<^sub>n) (DCA.trace (\<CC> \<phi> X) (to_stream w) (Abs \<phi>, Abs (\<phi>[X]\<^sub>\<nu>)))"
     by(simp add: infs_snth \<CC>_def DCA.transition_def af\<^sub>\<nu>_lifted_semantics af_letter\<^sub>\<nu>_lifted_semantics Abs_eq)
 
   also have "\<dots> \<longleftrightarrow> to_stream w \<in> DCA.language (\<CC> \<phi> X)"
-    by (simp add: \<CC>_def dca.initial_def dca.rejecting_def DCA.language_def dca_run)
+    by (simp add: \<CC>_def dca.initial_def dca.rejecting_def dca.language_def dca_run)
 
   finally show ?thesis
     by blast
 qed
 
 
 lemma \<CC>_nodes:
   "DCA.nodes (\<CC> \<phi> X) \<subseteq> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>} \<times> {Abs \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms\<^sub>\<nu> \<phi> X}"
-  unfolding \<CC>_def DCA.nodes_def transition_system_initial.nodes_alt_def transition_system.reachable_alt_def
+  unfolding \<CC>_def dca.nodes_alt_def dca.reachable_alt_def
   apply (auto simp add: af\<^sub>\<nu>_lifted_semantics af_letter\<^sub>\<nu>_lifted_semantics)
   using af\<^sub>\<nu>_fst_nested_prop_atoms apply force
   using GF_advice_nested_prop_atoms\<^sub>\<nu> af\<^sub>\<nu>_snd_nested_prop_atoms dra_construction_axioms by fastforce
 
 
 
 subsection \<open>A DRA for each combination of sets X and Y\<close>
 
 lemma dba_language:
   "(\<And>w. to_stream w \<in> DBA.language \<AA> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>) \<Longrightarrow> DBA.language \<AA> = {w. to_omega w \<Turnstile>\<^sub>n \<phi>}"
-  by (metis (mono_tags, lifting) Collect_cong DBA.language_def mem_Collect_eq to_stream_to_omega)
+  by (metis (mono_tags, lifting) Collect_cong dba.language_def mem_Collect_eq to_stream_to_omega)
 
 lemma dca_language:
   "(\<And>w. to_stream w \<in> DCA.language \<AA> \<longleftrightarrow> w \<Turnstile>\<^sub>n \<phi>) \<Longrightarrow> DCA.language \<AA> = {w. to_omega w \<Turnstile>\<^sub>n \<phi>}"
-  by (metis (mono_tags, lifting) Collect_cong DCA.language_def mem_Collect_eq to_stream_to_omega)
+  by (metis (mono_tags, lifting) Collect_cong dca.language_def mem_Collect_eq to_stream_to_omega)
 
 
 definition \<AA>\<^sub>1 :: "'a ltln \<Rightarrow> 'a ltln list \<Rightarrow> ('a set, 'ltlq \<times> 'ltlq) dca" where
   "\<AA>\<^sub>1 \<phi> xs = \<CC> \<phi> (set xs)"
 
 lemma \<AA>\<^sub>1_language:
   "to_omega ` DCA.language (\<AA>\<^sub>1 \<phi> xs) = L\<^sub>1 \<phi> (set xs)"
   by (simp add: \<AA>\<^sub>1_def L\<^sub>1_def set_eq_iff \<CC>_language)
 
 lemma \<AA>\<^sub>1_alphabet:
   "DCA.alphabet (\<AA>\<^sub>1 \<phi> xs) = UNIV"
   unfolding \<AA>\<^sub>1_def \<CC>_def by simp
 
 
 definition \<AA>\<^sub>2 :: "'a ltln list \<Rightarrow> 'a ltln list \<Rightarrow> ('a set, 'ltlq list degen) dba" where
-  "\<AA>\<^sub>2 xs ys = dbail (map (\<lambda>\<psi>. \<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>)) xs)"
+  "\<AA>\<^sub>2 xs ys = DBA_Combine.intersect_list (map (\<lambda>\<psi>. \<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>)) xs)"
 
 lemma \<AA>\<^sub>2_language:
   "to_omega ` DBA.language (\<AA>\<^sub>2 xs ys) = L\<^sub>2 (set xs) (set ys)"
   by (simp add: \<AA>\<^sub>2_def L\<^sub>2_def set_eq_iff dba_language[OF \<AA>\<^sub>\<mu>_GF_language[OF FG_advice_\<mu>LTL(1)]])
 
 lemma \<AA>\<^sub>2_alphabet:
   "DBA.alphabet (\<AA>\<^sub>2 xs ys) = UNIV"
-  by (simp add: \<AA>\<^sub>2_def \<AA>\<^sub>\<mu>_GF_def dbail_def dbgail_def)
+  by (simp add: \<AA>\<^sub>2_def \<AA>\<^sub>\<mu>_GF_def)
 
 
 definition \<AA>\<^sub>3 :: "'a ltln list \<Rightarrow> 'a ltln list \<Rightarrow> ('a set, 'ltlq list) dca" where
-  "\<AA>\<^sub>3 xs ys = dcail (map (\<lambda>\<psi>. \<AA>\<^sub>\<nu>_FG (\<psi>[set xs]\<^sub>\<nu>)) ys)"
+  "\<AA>\<^sub>3 xs ys = DCA_Combine.intersect_list (map (\<lambda>\<psi>. \<AA>\<^sub>\<nu>_FG (\<psi>[set xs]\<^sub>\<nu>)) ys)"
 
 lemma \<AA>\<^sub>3_language:
   "to_omega ` DCA.language (\<AA>\<^sub>3 xs ys) = L\<^sub>3 (set xs) (set ys)"
   by (simp add: \<AA>\<^sub>3_def L\<^sub>3_def set_eq_iff dca_language[OF \<AA>\<^sub>\<nu>_FG_language[OF GF_advice_\<nu>LTL(1)]])
 
 lemma \<AA>\<^sub>3_alphabet:
   "DCA.alphabet (\<AA>\<^sub>3 xs ys) = UNIV"
-  by (simp add: \<AA>\<^sub>3_def \<AA>\<^sub>\<nu>_FG_def dcail_def)
+  by (simp add: \<AA>\<^sub>3_def \<AA>\<^sub>\<nu>_FG_def)
 
 
-definition "\<AA>' \<phi> xs ys = dbcrai (\<AA>\<^sub>2 xs ys) (dcai (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys))"
+definition "\<AA>' \<phi> xs ys = intersect_bc (\<AA>\<^sub>2 xs ys) (DCA_Combine.intersect (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys))"
 
 lemma \<AA>'_language:
   "to_omega ` DRA.language (\<AA>' \<phi> xs ys) = (L\<^sub>1 \<phi> (set xs) \<inter> L\<^sub>2 (set xs) (set ys) \<inter> L\<^sub>3 (set xs) (set ys))"
   by (simp add: \<AA>'_def \<AA>\<^sub>1_language \<AA>\<^sub>2_language \<AA>\<^sub>3_language) fastforce
 
 lemma \<AA>'_alphabet:
   "DRA.alphabet (\<AA>' \<phi> xs ys) = UNIV"
-  by (simp add: \<AA>'_def dbcrai_def dcai_def \<AA>\<^sub>1_alphabet \<AA>\<^sub>2_alphabet \<AA>\<^sub>3_alphabet)
+  by (simp add: \<AA>'_def \<AA>\<^sub>1_alphabet \<AA>\<^sub>2_alphabet \<AA>\<^sub>3_alphabet)
 
 
 
 subsection \<open>A DRA for @{term "L(\<phi>)"}\<close>
 
-definition "ltl_to_dra \<phi> = draul (map (\<lambda>(xs, ys). \<AA>' \<phi> xs ys) (advice_sets \<phi>))"
+definition "ltl_to_dra \<phi> = DRA_Combine.union_list (map (\<lambda>(xs, ys). \<AA>' \<phi> xs ys) (advice_sets \<phi>))"
 
 lemma ltl_to_dra_language:
   "to_omega ` DRA.language (ltl_to_dra \<phi>) = language_ltln \<phi>"
 proof -
   have "(\<Inter>(a, b)\<in>set (advice_sets \<phi>). dra.alphabet (\<AA>' \<phi> a b)) =
     (\<Union>(a, b)\<in>set (advice_sets \<phi>). dra.alphabet (\<AA>' \<phi> a b))"
     using advice_sets_not_empty by (simp add: \<AA>'_alphabet)
-  then have *: "DRA.language (draul (map (\<lambda>(x, y). \<AA>' \<phi> x y) (advice_sets \<phi>))) =
+  then have *: "DRA.language (DRA_Combine.union_list (map (\<lambda>(x, y). \<AA>' \<phi> x y) (advice_sets \<phi>))) =
     \<Union> (DRA.language ` set (map (\<lambda>(x, y). \<AA>' \<phi> x y) (advice_sets \<phi>)))"
     by (simp add: split_def)
   have "language_ltln \<phi> = \<Union> {(L\<^sub>1 \<phi> X \<inter> L\<^sub>2 X Y \<inter> L\<^sub>3 X Y) | X Y. X \<subseteq> subformulas\<^sub>\<mu> \<phi> \<and> Y \<subseteq> subformulas\<^sub>\<nu> \<phi>}"
     unfolding master_theorem_language by auto
   also have "\<dots> = \<Union> {L\<^sub>1 \<phi> (set xs) \<inter> L\<^sub>2 (set xs) (set ys) \<inter> L\<^sub>3 (set xs) (set ys) | xs ys. (xs, ys) \<in> set (advice_sets \<phi>)}"
     unfolding advice_sets_subformulas by (metis (no_types, lifting))
   also have "\<dots> = \<Union> {to_omega ` DRA.language (\<AA>' \<phi> xs ys) | xs ys. (xs, ys) \<in> set (advice_sets \<phi>)}"
     by (simp add: \<AA>'_language)
   finally show ?thesis
     using * by (auto simp add: ltl_to_dra_def)
 qed
 
 lemma ltl_to_dra_alphabet:
   "alphabet (ltl_to_dra \<phi>) = UNIV"
-  by (auto simp: ltl_to_dra_def draul_def \<AA>'_alphabet split: prod.split)
-     (insert advice_sets_subformulas, blast)
+  by (auto simp: ltl_to_dra_def \<AA>'_alphabet)
 
 
 
 subsection \<open>Setting the Alphabet of a DRA\<close>
 
 definition dra_set_alphabet :: "('a set, 'b) dra \<Rightarrow> 'a set set \<Rightarrow> ('a set, 'b) dra"
 where
-  "dra_set_alphabet \<AA> \<Sigma> = dra \<Sigma> (initial \<AA>) (transition \<AA>) (accepting \<AA>)"
+  "dra_set_alphabet \<AA> \<Sigma> = dra \<Sigma> (initial \<AA>) (transition \<AA>) (condition \<AA>)"
 
 lemma dra_set_alphabet_language:
   "\<Sigma> \<subseteq> alphabet \<AA> \<Longrightarrow> language (dra_set_alphabet \<AA> \<Sigma>) = language \<AA> \<inter> {s. sset s \<subseteq> \<Sigma>}"
-  by (auto simp add: dra_set_alphabet_def language_def set_eq_iff DRA.run_alt_def)
+  by (auto simp add: dra_set_alphabet_def dra.language_def set_eq_iff dra.run_alt_def)
 
 lemma dra_set_alphabet_alphabet[simp]:
   "alphabet (dra_set_alphabet \<AA> \<Sigma>) = \<Sigma>"
   unfolding dra_set_alphabet_def by simp
 
 lemma dra_set_alphabet_nodes:
   "\<Sigma> \<subseteq> alphabet \<AA> \<Longrightarrow> DRA.nodes (dra_set_alphabet \<AA> \<Sigma>) \<subseteq> DRA.nodes \<AA>"
-  unfolding dra_set_alphabet_def DRA.nodes_def transition_system_initial.nodes_alt_def transition_system.reachable_alt_def
-  by auto (metis DRA.path_alt_def DRA.path_def dra.sel(1) dra.sel(3) subset_trans)
+  unfolding dra_set_alphabet_def dra.nodes_alt_def dra.reachable_alt_def dra.path_alt_def
+  by auto
 
 
 
 subsection \<open>A DRA for @{term "L(\<phi>)"} with a finite alphabet\<close>
 
 definition "ltl_to_dra_alphabet \<phi> Ap = dra_set_alphabet (ltl_to_dra \<phi>) (Pow Ap)"
 
 lemma ltl_to_dra_alphabet_language:
   assumes
     "atoms_ltln \<phi> \<subseteq> Ap"
   shows
     "to_omega ` language (ltl_to_dra_alphabet \<phi> Ap) = language_ltln \<phi> \<inter> {w. range w \<subseteq> Pow Ap}"
 proof -
   have 1: "Pow Ap \<subseteq> alphabet (ltl_to_dra \<phi>)"
     unfolding ltl_to_dra_alphabet by simp
 
   show ?thesis
     unfolding ltl_to_dra_alphabet_def dra_set_alphabet_language[OF 1]
     by (simp add: ltl_to_dra_language sset_range) force
 qed
 
 lemma ltl_to_dra_alphabet_alphabet[simp]:
   "alphabet (ltl_to_dra_alphabet \<phi> Ap) = Pow Ap"
   unfolding ltl_to_dra_alphabet_def by simp
 
 lemma ltl_to_dra_alphabet_nodes:
   "DRA.nodes (ltl_to_dra_alphabet \<phi> Ap) \<subseteq> DRA.nodes (ltl_to_dra \<phi>)"
   unfolding ltl_to_dra_alphabet_def
   by (rule dra_set_alphabet_nodes) (simp add: ltl_to_dra_alphabet)
 
 end
 
 end
diff --git a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Implementation.thy b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Implementation.thy
--- a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Implementation.thy
+++ b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Implementation.thy
@@ -1,132 +1,132 @@
 (*
     Author:   Benedikt Seidl
     License:  BSD
 *)
 
 section \<open>Implementation of the DRA Construction\<close>
 
 theory DRA_Implementation
 imports
   DRA_Instantiation
   LTL.Rewriting
   Transition_Systems_and_Automata.DRA_Translate
 begin
 
 text \<open>We convert the implicit automaton to its explicit representation
       and afterwards proof the final correctness theorem and the overall
       size bound.\<close>
 
 subsection \<open>Generating the Explicit Automaton\<close>
 
 definition dra_to_drai :: "('a, 'b) dra \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) drai"
 where
-  "dra_to_drai \<AA> \<Sigma> = drai \<Sigma> (initial \<AA>) (transition \<AA>) (accepting \<AA>)"
+  "dra_to_drai \<AA> \<Sigma> = drai \<Sigma> (initial \<AA>) (transition \<AA>) (condition \<AA>)"
 
 lemma dra_to_drai_language:
   "set \<Sigma> = alphabet \<AA> \<Longrightarrow> language (drai_dra (dra_to_drai \<AA> \<Sigma>)) = language \<AA>"
   by (simp add: dra_to_drai_def drai_dra_def)
 
 definition drai_to_draei :: "('a, 'b) drai \<Rightarrow> ('a, nat) draei"
 where
   "drai_to_draei = to_draei_impl (=) bot 2"
 
 fun atoms_ltlc_list :: "'a ltlc \<Rightarrow> 'a list"
 where
   "atoms_ltlc_list true\<^sub>c = []"
 | "atoms_ltlc_list false\<^sub>c = []"
 | "atoms_ltlc_list prop\<^sub>c(q) = [q]"
 | "atoms_ltlc_list (not\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
 | "atoms_ltlc_list (\<phi> and\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (\<phi> or\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (\<phi> implies\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (X\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
 | "atoms_ltlc_list (F\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
 | "atoms_ltlc_list (G\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
 | "atoms_ltlc_list (\<phi> U\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (\<phi> R\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (\<phi> W\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 | "atoms_ltlc_list (\<phi> M\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
 
 lemma atoms_ltlc_list_set:
   "set (atoms_ltlc_list \<phi>) = atoms_ltlc \<phi>"
   by (induction \<phi>) simp_all
 
 lemma atoms_ltlc_list_distinct:
   "distinct (atoms_ltlc_list \<phi>)"
   by (induction \<phi>) simp_all
 
 definition ltl_alphabet :: "'a ltlc \<Rightarrow> 'a set list"
 where
   "ltl_alphabet \<phi> = map set (subseqs (atoms_ltlc_list \<phi>))"
 
 definition ltlc_to_draei :: "'a ltlc \<Rightarrow> ('a set, nat) draei"
 where
   "ltlc_to_draei \<phi> = drai_to_draei (dra_to_drai (ltl_to_dra_alphabet (simplify Slow (ltlc_to_ltln \<phi>)) (atoms_ltlc \<phi>)) (ltl_alphabet \<phi>))"
 
 
 
 subsection \<open>Final Proof of Correctness\<close>
 
 lemma dra_to_drai_rel:
   assumes
     "(\<Sigma>, alphabet A) \<in> \<langle>Id\<rangle> list_set_rel"
   shows
     "(dra_to_drai A \<Sigma>, A) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
 proof -
   have "(A, A) \<in> \<langle>Id, Id\<rangle>dra_rel"
     by simp
 
-  then have "(dra_to_drai A \<Sigma>, dra (alphabet A) (initial A) (transition A) (accepting A)) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
+  then have "(dra_to_drai A \<Sigma>, dra (alphabet A) (initial A) (transition A) (condition A)) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
     unfolding dra_to_drai_def using assms by parametricity
 
   then show ?thesis
     by simp
 qed
 
 lemma draei_language:
   assumes 1:
     "(\<Sigma>, alphabet A) \<in> \<langle>Id\<rangle> list_set_rel"
   and
     "finite (DRA.nodes A)"
   shows
     "DRA.language (drae_dra (draei_drae (drai_to_draei (dra_to_drai A \<Sigma>)))) = DRA.language A"
 proof -
   have "(dra_to_drai A \<Sigma>, A) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
     using dra_to_drai_rel 1 by fast
 
   then have "(drai_to_draei (dra_to_drai A \<Sigma>), to_draei A) \<in> \<langle>Id_on (dra.alphabet A), rel (dra_to_drai A \<Sigma>) A (=) bot 2\<rangle> draei_dra_rel"
     unfolding drai_to_draei_def
     using to_draei_impl_refine[unfolded autoref_tag_defs]
     apply parametricity
     by (simp_all add: assms is_bounded_hashcode_def bot_nat_def is_valid_def_hm_size_def)
 
   then have "(DRA.language ((drae_dra \<circ> draei_drae) (drai_to_draei (dra_to_drai A \<Sigma>))), DRA.language (id (to_draei A))) \<in> \<langle>\<langle>Id_on (dra.alphabet A)\<rangle> stream_rel\<rangle> set_rel"
     by parametricity
 
   then show ?thesis
     by (simp add: to_draei_def)
 qed
 
 
 lemma ltl_to_dra_alphabet_rel:
   "(ltl_alphabet \<phi>, alphabet (ltl_to_dra_alphabet \<psi> (atoms_ltlc \<phi>))) \<in> \<langle>Id\<rangle> list_set_rel"
   unfolding ltl_to_dra.ltl_to_dra_alphabet_alphabet ltl_alphabet_def
   by (simp add: list_set_rel_def atoms_ltlc_list_set atoms_ltlc_list_distinct in_br_conv subseqs_powset distinct_set_subseqs)
 
 lemma ltl_to_dra_alphabet_nodes_finite:
   "finite (DRA.nodes (ltl_to_dra_alphabet \<phi> Ap))"
   using ltl_to_dra.ltl_to_dra_alphabet_nodes ltl_to_dra_nodes_finite finite_subset by fast
 
 lemma ltlc_to_ltln_simplify_atoms:
   "atoms_ltln (simplify Slow (ltlc_to_ltln \<phi>)) \<subseteq> atoms_ltlc \<phi>"
   using ltlc_to_ltln_atoms simplify_atoms by fast
 
 theorem final_correctness:
   "to_omega ` language (drae_dra (draei_drae (ltlc_to_draei \<phi>)))
     = language_ltlc \<phi> \<inter> {w. range w \<subseteq> Pow (atoms_ltlc \<phi>)}"
   unfolding ltlc_to_draei_def
   unfolding draei_language[OF ltl_to_dra_alphabet_rel ltl_to_dra_alphabet_nodes_finite]
   unfolding ltl_to_dra.ltl_to_dra_alphabet_language[OF ltlc_to_ltln_simplify_atoms]
   unfolding ltlc_to_ltln_atoms language_ltln_def language_ltlc_def ltlc_to_ltln_semantics simplify_correct ..
 
 end
diff --git a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Instantiation.thy b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Instantiation.thy
--- a/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Instantiation.thy
+++ b/thys/LTL_Master_Theorem/LTL_to_DRA/DRA_Instantiation.thy
@@ -1,419 +1,417 @@
 (*
     Author:   Benedikt Seidl
     License:  BSD
 *)
 
 section \<open>Instantiation of the LTL to DRA construction\<close>
 
 theory DRA_Instantiation
 imports
   DRA_Construction
   LTL.Equivalence_Relations
   "HOL-Library.Log_Nat"
 begin
 
 text \<open>We instantiate the construction locale with propositional equivalence
       and obtain a function converting a formula into an abstract automaton.\<close>
 
 global_interpretation ltl_to_dra: dra_construction "(\<sim>\<^sub>P)" rep_ltln\<^sub>P abs_ltln\<^sub>P
   defines ltl_to_dra = ltl_to_dra.ltl_to_dra
     and ltl_to_dra_alphabet = ltl_to_dra.ltl_to_dra_alphabet
     and \<AA>' = ltl_to_dra.\<AA>'
     and \<AA>\<^sub>1 = ltl_to_dra.\<AA>\<^sub>1
     and \<AA>\<^sub>2 = ltl_to_dra.\<AA>\<^sub>2
     and \<AA>\<^sub>3 = ltl_to_dra.\<AA>\<^sub>3
     and \<AA>\<^sub>\<nu>_FG = ltl_to_dra.\<AA>\<^sub>\<nu>_FG
     and \<AA>\<^sub>\<mu>_GF = ltl_to_dra.\<AA>\<^sub>\<mu>_GF
     and af_letter\<^sub>G = ltl_to_dra.af_letter\<^sub>G
     and af_letter\<^sub>F = ltl_to_dra.af_letter\<^sub>F
     and af_letter\<^sub>G_lifted = ltl_to_dra.af_letter\<^sub>G_lifted
     and af_letter\<^sub>F_lifted = ltl_to_dra.af_letter\<^sub>F_lifted
     and af_letter\<^sub>\<nu>_lifted = ltl_to_dra.af_letter\<^sub>\<nu>_lifted
     and \<CC> = ltl_to_dra.\<CC>
     and af_letter\<^sub>\<nu> = ltl_to_dra.af_letter\<^sub>\<nu>
   by unfold_locales (meson Quotient_abs_rep Quotient_ltln\<^sub>P, simp add: Quotient_abs_rep Quotient_ltln\<^sub>P ltln\<^sub>P.abs_eq_iff)
 
 text \<open>We obtain the following theorem:\<close>
 
 thm ltl_to_dra.ltl_to_dra_language
 
 
 text \<open>Furthermore, we verify the size bound of the automaton to be double-exponential.\<close>
 
 lemma prop_equiv_nested_prop_atoms_finite:
   "finite {abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>}"
   using prop_equiv_finite'[OF nested_prop_atoms_finite] .
 
 lemma prop_equiv_nested_prop_atoms_card:
   "card {abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>} \<le> 2 ^ 2 ^ card (nested_prop_atoms \<phi>)"
   using prop_equiv_card'[OF nested_prop_atoms_finite] .
 
 
 lemma prop_equiv_nested_prop_atoms\<^sub>\<nu>_finite:
   "finite {abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms\<^sub>\<nu> \<phi> X}"
   using prop_equiv_finite'[OF nested_prop_atoms\<^sub>\<nu>_finite] by fast
 
 lemma prop_equiv_nested_prop_atoms\<^sub>\<nu>_card:
   "card {abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms\<^sub>\<nu> \<phi> X} \<le> 2 ^ 2 ^ card (nested_prop_atoms \<phi>)" (is "?lhs \<le> ?rhs")
 proof -
   have "finite {abs_ltln\<^sub>P \<psi> | \<psi>. prop_atoms \<psi> \<subseteq> nested_prop_atoms\<^sub>\<nu> \<phi> X}"
     by (simp add: prop_equiv_nested_prop_atoms\<^sub>\<nu>_finite nested_prop_atoms\<^sub>\<nu>_finite prop_equiv_finite)
 
   then have "?lhs \<le> card {abs_ltln\<^sub>P \<psi> | \<psi>. prop_atoms \<psi> \<subseteq> (nested_prop_atoms\<^sub>\<nu> \<phi> X)}"
     using card_mono prop_equiv_subset by blast
 
   also have "\<dots> \<le> 2 ^ 2 ^ card (nested_prop_atoms\<^sub>\<nu> \<phi> X)"
     using prop_equiv_card[OF nested_prop_atoms\<^sub>\<nu>_finite] by fast
 
   also have "\<dots> \<le> ?rhs"
     using nested_prop_atoms\<^sub>\<nu>_card by auto
 
   finally show ?thesis .
 qed
 
 
 lemma \<AA>\<^sub>\<mu>_GF_nodes_finite:
   "finite (DBA.nodes (\<AA>\<^sub>\<mu>_GF \<phi>))"
   using finite_subset[OF ltl_to_dra.\<AA>\<^sub>\<mu>_GF_nodes prop_equiv_nested_prop_atoms_finite] .
 
 lemma \<AA>\<^sub>\<nu>_FG_nodes_finite:
   "finite (DCA.nodes (\<AA>\<^sub>\<nu>_FG \<phi>))"
   using finite_subset[OF ltl_to_dra.\<AA>\<^sub>\<nu>_FG_nodes prop_equiv_nested_prop_atoms_finite] .
 
 lemma \<AA>\<^sub>\<mu>_GF_nodes_card:
   "card (DBA.nodes (\<AA>\<^sub>\<mu>_GF \<phi>)) \<le> 2 ^ 2 ^ card (nested_prop_atoms (F\<^sub>n \<phi>))"
   using le_trans[OF card_mono[OF prop_equiv_nested_prop_atoms_finite ltl_to_dra.\<AA>\<^sub>\<mu>_GF_nodes] prop_equiv_nested_prop_atoms_card] .
 
 lemma \<AA>\<^sub>\<nu>_FG_nodes_card:
   "card (DCA.nodes (\<AA>\<^sub>\<nu>_FG \<phi>)) \<le> 2 ^ 2 ^ card (nested_prop_atoms (G\<^sub>n \<phi>))"
   using le_trans[OF card_mono[OF prop_equiv_nested_prop_atoms_finite ltl_to_dra.\<AA>\<^sub>\<nu>_FG_nodes] prop_equiv_nested_prop_atoms_card] .
 
 
 lemma \<AA>\<^sub>2_nodes_finite_helper:
   "list_all (finite \<circ> DBA.nodes) (map (\<lambda>\<psi>. \<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>)) xs)"
   by (auto simp: list.pred_map list_all_iff \<AA>\<^sub>\<mu>_GF_nodes_finite)
 
 lemma \<AA>\<^sub>2_nodes_finite:
   "finite (DBA.nodes (\<AA>\<^sub>2 xs ys))"
-  unfolding ltl_to_dra.\<AA>\<^sub>2_def using dbail_nodes_finite \<AA>\<^sub>2_nodes_finite_helper .
+  unfolding ltl_to_dra.\<AA>\<^sub>2_def using DBA_Combine.intersect_list_nodes_finite \<AA>\<^sub>2_nodes_finite_helper .
 
 lemma \<AA>\<^sub>3_nodes_finite_helper:
   "list_all (finite \<circ> DCA.nodes) (map (\<lambda>\<psi>. \<AA>\<^sub>\<nu>_FG (\<psi>[set xs]\<^sub>\<nu>)) ys)"
   by (auto simp: list.pred_map list_all_iff \<AA>\<^sub>\<nu>_FG_nodes_finite)
 
 lemma \<AA>\<^sub>3_nodes_finite:
   "finite (DCA.nodes (\<AA>\<^sub>3 xs ys))"
-  unfolding ltl_to_dra.\<AA>\<^sub>3_def using dcail_finite \<AA>\<^sub>3_nodes_finite_helper .
+  unfolding ltl_to_dra.\<AA>\<^sub>3_def using DCA_Combine.intersect_list_nodes_finite \<AA>\<^sub>3_nodes_finite_helper .
 
 (* TODO add to HOL/Groups_List.thy *)
 lemma list_prod_mono:
   "f \<le> g \<Longrightarrow> (\<Prod>x\<leftarrow>xs. f x) \<le> (\<Prod>x\<leftarrow>xs. g x)" for f g :: "'a \<Rightarrow> nat"
   by (induction xs) (auto simp: le_funD mult_le_mono)
 
 (* TODO add to HOL/Groups_List.thy *)
 lemma list_prod_const:
   "(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> c) \<Longrightarrow> (\<Prod>x\<leftarrow>xs. f x) \<le> c ^ length xs" for f :: "'a \<Rightarrow> nat"
   by (induction xs) (auto simp: mult_le_mono)
 
 (* TODO add to HOL/Finite_Set.thy *)
 lemma card_insert_Suc:
   "card (insert x S) \<le> Suc (card S)"
   by (metis Suc_n_not_le_n card.infinite card_insert_if finite_insert linear)
 
 (* TODO add to HOL/Power.thy *)
 lemma nat_power_le_imp_le:
   "0 < a \<Longrightarrow> a \<le> b \<Longrightarrow> x ^ a \<le> x ^ b" for x :: nat
   by (metis leD linorder_le_less_linear nat_power_less_imp_less neq0_conv power_eq_0_iff)
 
 (* TODO add to HOL/Power.thy *)
 lemma const_less_power:
   "n < x ^ n" if "x > 1"
   using that by (induction n) (auto simp: less_trans_Suc)
 
 (* TODO add to HOL-Library/Log_Nat.thy *)
 lemma floorlog_le_const:
   "floorlog x n \<le> n"
   by (induction n) (simp add: floorlog_eq_zero_iff, metis Suc_lessI floorlog_le_iff le_SucI power_inject_exp)
 
 lemma \<AA>\<^sub>2_nodes_card:
   assumes
     "length xs \<le> n"
   and
     "\<And>\<psi>. \<psi> \<in> set xs \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
   shows
     "card (DBA.nodes (\<AA>\<^sub>2 xs ys)) \<le> 2 ^ 2 ^ (n + floorlog 2 n + 2)"
 proof -
   have 1: "\<And>\<psi>. \<psi> \<in> set xs \<Longrightarrow> card (nested_prop_atoms (F\<^sub>n \<psi>[set ys]\<^sub>\<mu>)) \<le> Suc n"
   proof -
     fix \<psi>
     assume "\<psi> \<in> set xs"
 
     have "card (nested_prop_atoms (F\<^sub>n (\<psi>[set ys]\<^sub>\<mu>)))
           \<le> Suc (card (nested_prop_atoms (\<psi>[set ys]\<^sub>\<mu>)))"
       by (simp add: card_insert_Suc)
 
     also have "\<dots> \<le> Suc (card (nested_prop_atoms \<psi>))"
       by (simp add: FG_advice_nested_prop_atoms_card)
 
     also have "\<dots> \<le> Suc n"
       by (simp add: assms(2) \<open>\<psi> \<in> set xs\<close>)
 
     finally show "card (nested_prop_atoms (F\<^sub>n (\<psi>[set ys]\<^sub>\<mu>))) \<le> Suc n" .
   qed
 
   have "(\<Prod>\<psi>\<leftarrow>xs. card (DBA.nodes (\<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>))))
         \<le> (\<Prod>\<psi>\<leftarrow>xs. 2 ^ 2 ^ card (nested_prop_atoms (F\<^sub>n (\<psi>[set ys]\<^sub>\<mu>))))"
     by (rule list_prod_mono) (insert \<AA>\<^sub>\<mu>_GF_nodes_card le_fun_def, blast)
 
   also have "\<dots> \<le> (2 ^ 2 ^ Suc n) ^ length xs"
     by (rule list_prod_const) (metis 1 Suc_leI nat_power_le_imp_le nat_power_eq_Suc_0_iff neq0_conv pos2 zero_less_power)
 
   also have "\<dots> \<le> (2 ^ 2 ^ Suc n) ^ n"
     using assms(1) nat_power_le_imp_le by fastforce
 
   also have "\<dots> = 2 ^ (n * 2 ^ Suc n)"
     by (metis Groups.mult_ac(2) power_mult)
 
   also have "\<dots> \<le> 2 ^ (2 ^ floorlog 2 n * 2 ^ Suc n)"
     by (cases "n = 0") (auto simp: floorlog_bounds less_imp_le_nat)
 
   also have "\<dots> = 2 ^ 2 ^ (Suc n + floorlog 2 n)"
     by (simp add: power_add)
 
   finally have 2: "(\<Prod>\<psi>\<leftarrow>xs. card (DBA.nodes (\<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>)))) \<le> 2 ^ 2 ^ (Suc n + floorlog 2 n)" .
 
   have "card (DBA.nodes (\<AA>\<^sub>2 xs ys)) \<le> max 1 (length xs) * (\<Prod>\<psi>\<leftarrow>xs. card (DBA.nodes (\<AA>\<^sub>\<mu>_GF (\<psi>[set ys]\<^sub>\<mu>))))"
-    using dbail_nodes_card[OF \<AA>\<^sub>2_nodes_finite_helper]
+    using DBA_Combine.intersect_list_nodes_card[OF \<AA>\<^sub>2_nodes_finite_helper]
     by (auto simp: ltl_to_dra.\<AA>\<^sub>2_def comp_def)
 
   also have "\<dots> \<le> max 1 n * 2 ^ 2 ^ (Suc n + floorlog 2 n)"
     using assms(1) 2 by (simp add: mult_le_mono)
 
   also have "\<dots> \<le> 2 ^ (floorlog 2 n) * 2 ^ 2 ^ (Suc n + floorlog 2 n)"
     by (cases "n = 0") (auto simp: floorlog_bounds less_imp_le_nat)
 
   also have "\<dots> = 2 ^ (floorlog 2 n + 2 ^ (Suc n + floorlog 2 n))"
     by (simp add: power_add)
 
   also have "\<dots> \<le> 2 ^ (n + 2 ^ (Suc n + floorlog 2 n))"
     by (simp add: floorlog_le_const)
 
   also have "\<dots> \<le> 2 ^ 2 ^ (n + floorlog 2 n + 2)"
     by simp (metis const_less_power Suc_1 add_Suc_right add_leE lessI less_imp_le_nat power_Suc)
 
   finally show ?thesis .
 qed
 
 
 lemma \<AA>\<^sub>3_nodes_card:
   assumes
     "length ys \<le> n"
   and
     "\<And>\<psi>. \<psi> \<in> set ys \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
   shows
     "card (DCA.nodes (\<AA>\<^sub>3 xs ys)) \<le> 2 ^ 2 ^ (n + floorlog 2 n + 1)"
 proof -
   have 1: "\<And>\<psi>. \<psi> \<in> set ys \<Longrightarrow> card (DCA.nodes (\<AA>\<^sub>\<nu>_FG (\<psi>[set xs]\<^sub>\<nu>))) \<le> 2 ^ 2 ^ Suc n"
   proof -
     fix \<psi>
     assume "\<psi> \<in> set ys"
 
     have "card (nested_prop_atoms (G\<^sub>n \<psi>[set xs]\<^sub>\<nu>))
           \<le> Suc (card (nested_prop_atoms (\<psi>[set xs]\<^sub>\<nu>)))"
       by (simp add: card_insert_Suc)
 
     also have "\<dots> \<le> Suc (card (nested_prop_atoms \<psi>))"
       by (simp add: GF_advice_nested_prop_atoms_card)
 
     also have "\<dots> \<le> Suc n"
       by (simp add: assms(2) \<open>\<psi> \<in> set ys\<close>)
 
     finally have 2: "card (nested_prop_atoms (G\<^sub>n \<psi>[set xs]\<^sub>\<nu>)) \<le> Suc n" .
 
     then show "?thesis \<psi>"
       by (intro le_trans[OF \<AA>\<^sub>\<nu>_FG_nodes_card]) (meson one_le_numeral power_increasing)
   qed
 
 
   have "card (DCA.nodes (\<AA>\<^sub>3 xs ys)) \<le> (\<Prod>\<psi>\<leftarrow>ys. card (DCA.nodes (\<AA>\<^sub>\<nu>_FG (\<psi>[set xs]\<^sub>\<nu>))))"
-    unfolding ltl_to_dra.\<AA>\<^sub>3_def using dcail_nodes_card[OF \<AA>\<^sub>3_nodes_finite_helper]
+    unfolding ltl_to_dra.\<AA>\<^sub>3_def using DCA_Combine.intersect_list_nodes_card[OF \<AA>\<^sub>3_nodes_finite_helper]
     by (auto simp: comp_def)
 
   also have "\<dots> \<le> (2 ^ 2 ^ Suc n) ^ length ys"
     by (rule list_prod_const) (rule 1)
 
   also have "\<dots> \<le> (2 ^ 2 ^ Suc n) ^ n"
     by (simp add: assms(1) power_increasing)
 
   also have "\<dots> \<le> 2 ^ (n * 2 ^ Suc n)"
     by (metis le_refl mult.commute power_mult)
 
   also have "\<dots> \<le> 2 ^ (2 ^ floorlog 2 n * 2 ^ Suc n)"
     by (cases \<open>n > 0\<close>) (simp_all add: floorlog_bounds less_imp_le_nat)
 
   also have "\<dots> = 2 ^ 2 ^ (n + floorlog 2 n + 1)"
     by (simp add: power_add)
 
   finally show ?thesis .
 qed
 
 
 lemma \<AA>\<^sub>1_nodes_finite:
   "finite (DCA.nodes (\<AA>\<^sub>1 \<phi> xs))"
   unfolding ltl_to_dra.\<AA>\<^sub>1_def
   by (metis (no_types, lifting) finite_subset ltl_to_dra.\<CC>_nodes finite_SigmaI prop_equiv_nested_prop_atoms\<^sub>\<nu>_finite prop_equiv_nested_prop_atoms_finite)
 
 lemma \<AA>\<^sub>1_nodes_card:
   assumes
     "card (subfrmlsn \<phi>) \<le> n"
   shows
     "card (DCA.nodes (\<AA>\<^sub>1 \<phi> xs)) \<le> 2 ^ 2 ^ (n + 1)"
 proof -
   let ?fst = "{abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms \<phi>}"
   let ?snd = "{abs_ltln\<^sub>P \<psi> | \<psi>. nested_prop_atoms \<psi> \<subseteq> nested_prop_atoms\<^sub>\<nu> \<phi> (set xs)}"
 
   have 1: "card (nested_prop_atoms \<phi>) \<le> n"
     by (meson card_mono[OF subfrmlsn_finite nested_prop_atoms_subfrmlsn] assms le_trans)
 
 
   have "card (DCA.nodes (\<AA>\<^sub>1 \<phi> xs)) \<le> card (?fst \<times> ?snd)"
     unfolding ltl_to_dra.\<AA>\<^sub>1_def
     by (rule card_mono) (simp_all add: ltl_to_dra.\<CC>_nodes prop_equiv_nested_prop_atoms\<^sub>\<nu>_finite prop_equiv_nested_prop_atoms_finite)
 
   also have "\<dots> = card ?fst * card ?snd"
     using prop_equiv_nested_prop_atoms\<^sub>\<nu>_finite card_cartesian_product by blast
 
   also have "\<dots> \<le> 2 ^ 2 ^ card (nested_prop_atoms \<phi>) * 2 ^ 2 ^ card (nested_prop_atoms \<phi>)"
     using prop_equiv_nested_prop_atoms\<^sub>\<nu>_card prop_equiv_nested_prop_atoms_card mult_le_mono by blast
 
   also have "\<dots> = 2 ^ 2 ^ (card (nested_prop_atoms \<phi>) + 1)"
     by (simp add: semiring_normalization_rules(36))
 
   also have "\<dots> \<le> 2 ^ 2 ^ (n + 1)"
     using assms 1 by simp
 
   finally show ?thesis .
 qed
 
 
 lemma \<AA>'_nodes_finite:
   "finite (DRA.nodes (\<AA>' \<phi> xs ys))"
   unfolding ltl_to_dra.\<AA>'_def
-  using dcai_nodes_finite dbcrai_nodes_finite
+  using intersect_nodes_finite intersect_bc_nodes_finite
   using \<AA>\<^sub>1_nodes_finite \<AA>\<^sub>2_nodes_finite \<AA>\<^sub>3_nodes_finite
   by fast
 
 lemma \<AA>'_nodes_card:
   assumes
     "length xs \<le> n"
   and
     "\<And>\<psi>. \<psi> \<in> set xs \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
   and
     "length ys \<le> n"
   and
     "\<And>\<psi>. \<psi> \<in> set ys \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
   and
     "card (subfrmlsn \<phi>) \<le> n"
   shows
     "card (DRA.nodes (\<AA>' \<phi> xs ys)) \<le> 2 ^ 2 ^ (n + floorlog 2 n + 4)"
 proof -
   have "n + 1 \<le> n + floorlog 2 n + 2"
     by auto
 
   then have 1: "(2::nat) ^ (n + 1) \<le> 2 ^ (n + floorlog 2 n + 2)"
     using one_le_numeral power_increasing by blast
 
 
   have "card (DRA.nodes (\<AA>' \<phi> xs ys)) \<le> card (DCA.nodes (\<AA>\<^sub>1 \<phi> xs)) * card (DBA.nodes (\<AA>\<^sub>2 xs ys)) * card (DCA.nodes (\<AA>\<^sub>3 xs ys))" (is "?lhs \<le> ?rhs")
   proof (unfold ltl_to_dra.\<AA>'_def)
-    have "card (DBA.nodes (\<AA>\<^sub>2 xs ys)) * card (DCA.nodes (dcai (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys))) \<le> ?rhs"
-      by (simp add: dcai_nodes_card[OF \<AA>\<^sub>1_nodes_finite \<AA>\<^sub>3_nodes_finite])
-    then show "card (DRA.nodes (dbcrai (\<AA>\<^sub>2 xs ys) (dcai (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys)))) \<le> ?rhs"
-      by (meson dbcrai_nodes_card[OF \<AA>\<^sub>2_nodes_finite dcai_nodes_finite[OF \<AA>\<^sub>1_nodes_finite \<AA>\<^sub>3_nodes_finite]] basic_trans_rules(23))
+    have "card (DBA.nodes (\<AA>\<^sub>2 xs ys)) * card (DCA.nodes (DCA_Combine.intersect (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys))) \<le> ?rhs"
+      by (simp add: intersect_nodes_card[OF \<AA>\<^sub>1_nodes_finite \<AA>\<^sub>3_nodes_finite])
+    then show "card (DRA.nodes (intersect_bc (\<AA>\<^sub>2 xs ys) (DCA_Combine.intersect (\<AA>\<^sub>1 \<phi> xs) (\<AA>\<^sub>3 xs ys)))) \<le> ?rhs"
+      by (meson intersect_bc_nodes_card[OF \<AA>\<^sub>2_nodes_finite intersect_nodes_finite[OF \<AA>\<^sub>1_nodes_finite \<AA>\<^sub>3_nodes_finite]] basic_trans_rules(23))
   qed
 
   also have "\<dots> \<le> 2 ^ 2 ^ (n + 1) * 2 ^ 2 ^ (n + floorlog 2 n + 2) * 2 ^ 2 ^ (n + floorlog 2 n + 1)"
     using \<AA>\<^sub>1_nodes_card[OF assms(5)] \<AA>\<^sub>2_nodes_card[OF assms(1,2)] \<AA>\<^sub>3_nodes_card[OF assms(3,4)]
     by (metis mult_le_mono)
 
   also have "\<dots> = 2 ^ (2 ^ (n + 1) + 2 ^ (n + floorlog 2 n + 2) + 2 ^ (n + floorlog 2 n + 1))"
     by (metis power_add)
 
   also have "\<dots> \<le> 2 ^ (4 * 2 ^ (n + floorlog 2 n + 2))"
     using 1 by auto
 
   finally show ?thesis
     by (simp add: numeral.simps(2) power_add)
 qed
 
 lemma subformula_nested_prop_atoms_subfrmlsn:
   "\<psi> \<in> subfrmlsn \<phi> \<Longrightarrow> nested_prop_atoms \<psi> \<subseteq> subfrmlsn \<phi>"
   using nested_prop_atoms_subfrmlsn subfrmlsn_subset by blast
 
 
 lemma ltl_to_dra_nodes_finite:
   "finite (DRA.nodes (ltl_to_dra \<phi>))"
   unfolding ltl_to_dra.ltl_to_dra_def
-  apply (rule draul_nodes_finite)
+  apply (rule DRA_Combine.union_list_nodes_finite)
   apply (simp add: split_def ltl_to_dra.\<AA>'_alphabet advice_sets_not_empty)
   apply (simp add: list.pred_set split_def \<AA>'_nodes_finite)
   done
 
 lemma ltl_to_dra_nodes_card:
   assumes
     "card (subfrmlsn \<phi>) \<le> n"
   shows
     "card (DRA.nodes (ltl_to_dra \<phi>)) \<le> 2 ^ 2 ^ (2 * n + floorlog 2 n + 4)"
 proof -
   let ?map = "map (\<lambda>(x, y). \<AA>' \<phi> x y) (advice_sets \<phi>)"
 
   have 1: "\<And>x::nat. x > 0 \<Longrightarrow> x ^ length (advice_sets \<phi>) \<le> x ^ 2 ^ card (subfrmlsn \<phi>)"
     by (metis advice_sets_length linorder_not_less nat_power_less_imp_less)
 
   have "card (DRA.nodes (ltl_to_dra \<phi>)) \<le> prod_list (map (card \<circ> DRA.nodes) ?map)"
     unfolding ltl_to_dra.ltl_to_dra_def
-    apply (rule draul_nodes_card)
-    unfolding set_map image_image split_def ltl_to_dra.\<AA>'_alphabet
-    apply (simp add: advice_sets_not_empty)
-    unfolding split_def list.pred_set using \<AA>'_nodes_finite by auto
+    apply (rule DRA_Combine.union_list_nodes_card)
+    unfolding list.pred_set using \<AA>'_nodes_finite by auto
 
   also have "\<dots> = (\<Prod>(x, y)\<leftarrow>advice_sets \<phi>. card (DRA.nodes (\<AA>' \<phi> x y)))"
     by (induction "advice_sets \<phi>") (auto, metis (no_types, lifting) comp_apply split_def)
 
   also have "\<dots> \<le> (2 ^ 2 ^ (n + floorlog 2 n + 4)) ^ length (advice_sets \<phi>)"
   proof (rule list_prod_const, unfold split_def, rule \<AA>'_nodes_card)
     show "\<And>x. x \<in> set (advice_sets \<phi>) \<Longrightarrow> length (fst x) \<le> n"
       using advice_sets_element_length assms by fastforce
 
     show "\<And>x \<psi>. \<lbrakk>x \<in> set (advice_sets \<phi>); \<psi> \<in> set (fst x)\<rbrakk> \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
       using advice_sets_element_subfrmlsn(1) assms subformula_nested_prop_atoms_subfrmlsn subformulas\<^sub>\<mu>_subfrmlsn
       by (metis (no_types, lifting) card_mono subfrmlsn_finite subset_iff sup.absorb_iff2 sup.coboundedI1 surjective_pairing)
 
     show "\<And>x. x \<in> set (advice_sets \<phi>) \<Longrightarrow> length (snd x) \<le> n"
       using advice_sets_element_length assms by fastforce
 
     show "\<And>x \<psi>. \<lbrakk>x \<in> set (advice_sets \<phi>); \<psi> \<in> set (snd x)\<rbrakk> \<Longrightarrow> card (nested_prop_atoms \<psi>) \<le> n"
       using advice_sets_element_subfrmlsn(2) assms subformula_nested_prop_atoms_subfrmlsn subformulas\<^sub>\<nu>_subfrmlsn
       by (metis (no_types, lifting) card_mono subfrmlsn_finite subset_iff sup.absorb_iff2 sup.coboundedI1 surjective_pairing)
   qed (insert assms, blast)
 
   also have "\<dots> \<le> (2 ^ 2 ^ (n + floorlog 2 n + 4)) ^ (2 ^ card (subfrmlsn \<phi>))"
     by (simp add: 1)
 
   also have "\<dots> \<le> (2 ^ 2 ^ (n + floorlog 2 n + 4)) ^ (2 ^ n)"
     by (simp add: assms power_increasing)
 
   also have "\<dots> = 2 ^ (2 ^ n * 2 ^ (n + floorlog 2 n + 4))"
     by (simp add: ac_simps power_mult [symmetric])
 
   also have "\<dots> = 2 ^ 2 ^ (2 * n + floorlog 2 n + 4)"
     by (simp add: power_add) (simp add: mult_2 power_add)
 
   finally show ?thesis .
 qed
 
 theorem ltl_to_dra_size:
   "card (DRA.nodes (ltl_to_dra \<phi>)) \<le> 2 ^ 2 ^ (2 * size \<phi> + floorlog 2 (size \<phi>) + 4)"
   using ltl_to_dra_nodes_card subfrmlsn_card by blast
 
 end
diff --git a/thys/LTL_Master_Theorem/code/hoa.sml b/thys/LTL_Master_Theorem/code/hoa.sml
--- a/thys/LTL_Master_Theorem/code/hoa.sml
+++ b/thys/LTL_Master_Theorem/code/hoa.sml
@@ -1,136 +1,136 @@
 (*
     Serialization of DRAs in the HOA format.
 
     Benedikt Seidl
 *)
 
 open LTL
 
 structure HOA : sig
   val serialize : string ltlc -> (string set, nat) draei -> string
 end = struct
 
   (* Metadata *)
 
   val tool = "LTL to DRA translation based on the Master Theorem"
   val version = "0.1"
   val properties = ["transition-labels", "state-acc", "deterministic"]
   val acc_name = "Rabin"
 
   fun quote s = "\"" ^ s ^ "\""
 
   fun bracket true s = "(" ^ s ^ ")"
     | bracket false s = s
 
   fun nat_to_string n = IntInf.toString (integer_of_nat n)
 
   fun ltlc_to_string b True_ltlc = "true"
     | ltlc_to_string b False_ltlc = "false"
     | ltlc_to_string b (Prop_ltlc s) = s
     | ltlc_to_string b (Not_ltlc x) = "!" ^ ltlc_to_string true x
     | ltlc_to_string b (And_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " & " ^ ltlc_to_string true x2)
     | ltlc_to_string b (Or_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " | " ^ ltlc_to_string true x2)
     | ltlc_to_string b (Implies_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " -> " ^ ltlc_to_string true x2)
     | ltlc_to_string b (Next_ltlc x) = bracket b ("X " ^ ltlc_to_string true x)
     | ltlc_to_string b (Final_ltlc x) = bracket b ("F " ^ ltlc_to_string true x)
     | ltlc_to_string b (Global_ltlc x) = bracket b ("G " ^ ltlc_to_string true x)
     | ltlc_to_string b (Until_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " U " ^ ltlc_to_string true x2)
     | ltlc_to_string b (Release_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " R " ^ ltlc_to_string true x2)
     | ltlc_to_string b (WeakUntil_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " W " ^ ltlc_to_string true x2)
     | ltlc_to_string b (StrongRelease_ltlc (x1, x2)) = bracket b (ltlc_to_string true x1 ^ " M " ^ ltlc_to_string true x2)
 
   fun mapi f xs =
     let
       fun inner (x, (i, xs)) = (i + 1, f (i, x) :: xs)
     in
       List.rev (#2 (foldl inner (0, []) xs))
     end
 
   (* TODO formalize in Isabelle *)
   fun group_sorted f xs =
     let
       fun inner (t, ([], acc)) = ([t], acc)
         | inner (t, (x :: xs, acc)) = if f (t, x)
             then ([t], (x :: xs) :: acc)
             else (t :: x :: xs, acc)
       val (grp, acc) = foldl inner ([], []) xs
     in
       case grp of
            [] => acc
          | x :: xs => (x :: xs) :: acc
     end
 
   (* Header *)
 
   fun serialize_aps aps =
     Int.toString (List.length aps) ^ " " ^ String.concatWith " " (List.map quote aps)
 
   fun serialize_rabin_pair (i, _) =
     "Inf(" ^ Int.toString (2 * i) ^ ") & Fin(" ^ Int.toString (2 * i + 1) ^ ")"
 
   fun serialize_acceptance acc =
     Int.toString (2 * List.length acc) ^ " "
       ^ String.concatWith " | " (mapi serialize_rabin_pair acc)
 
   fun serialize_header phi aut states =
     "HOA: v1\n"
       ^ "tool: " ^ quote tool ^ " " ^ quote version ^ "\n"
       ^ "name: " ^ quote ("DRA for " ^ ltlc_to_string false phi) ^ "\n"
       ^ "properties: " ^ String.concatWith " " properties ^ "\n"
       ^ "States: " ^ Int.toString (List.length states) ^ "\n"
       ^ "Start: " ^ nat_to_string (initialei aut) ^ "\n"
       ^ "AP: " ^ serialize_aps (atoms_ltlc_list_literals phi) ^ "\n"
-      ^ "Acceptance: " ^ serialize_acceptance (acceptingei aut) ^ "\n"
+      ^ "Acceptance: " ^ serialize_acceptance (conditionei aut) ^ "\n"
       ^ "acc-name: " ^ acc_name ^ "\n"
 
   (* Body *)
 
   fun iterate_aps phi f =
     let
       fun inner (i, a) = if f a
         then Int.toString i
         else "!" ^ Int.toString i
     in
       case atoms_ltlc_list_literals phi of
         [] => "[t]"
       | xs => "[" ^ String.concatWith "&" (mapi inner xs) ^ "]"
     end
 
   fun serialize_label phi (Set xs) =
         iterate_aps phi (fn a => List.exists (fn b => a = b) xs)
     | serialize_label phi (Coset xs) =
         iterate_aps phi (fn a => List.all (fn b => a <> b) xs)
 
   fun serialize_transition phi (from, (label, to)) =
     serialize_label phi label ^ " " ^ nat_to_string to ^ "\n"
 
   fun serialize_state_labels acc state =
     let
       fun inner (i, (inf, fin)) =
         (if (List.exists (fn j => state = j) inf) then [Int.toString (2 * i)] else [])
           @ (if (List.exists (fn j => state = j) fin) then [Int.toString (2 * i + 1)] else [])
     in
       "{" ^ String.concatWith " " (List.concat (mapi inner acc)) ^ "}"
     end
 
   fun serialize_state phi aut state =
     "State: " ^ nat_to_string (#1 (List.hd state)) ^ " "
-      ^ serialize_state_labels (acceptingei aut) (#1 (List.hd state)) ^ "\n"
+      ^ serialize_state_labels (conditionei aut) (#1 (List.hd state)) ^ "\n"
       ^ String.concat (List.map (serialize_transition phi) state)
 
   fun serialize_body phi aut states =
     String.concatWith "\n" (List.map (serialize_state phi aut) states)
 
   (* Automaton *)
 
   fun serialize phi aut =
     let
       val states = group_sorted (fn (x, y) => integer_of_nat (#1 x) <
       integer_of_nat (#1 y)) (List.rev (sort_transitions (transitionei aut)))
     in
       serialize_header phi aut states
         ^ "\n--BODY--\n"
         ^ serialize_body phi aut states
         ^ "--END--"
     end
 end;
diff --git a/thys/Transition_Systems_and_Automata/Automata/DBA/DBA.thy b/thys/Transition_Systems_and_Automata/Automata/DBA/DBA.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DBA/DBA.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DBA/DBA.thy
@@ -1,62 +1,29 @@
 section \<open>Deterministic Büchi Automata\<close>
 
 theory DBA
-imports
-  "../../Basic/Sequence_Zip"
-  "../../Basic/Acceptance"
-  "../../Transition_Systems/Transition_System"
-  "../../Transition_Systems/Transition_System_Extra"
-  "../../Transition_Systems/Transition_System_Construction"
+imports "../Deterministic"
 begin
 
   datatype ('label, 'state) dba = dba
     (alphabet: "'label set")
     (initial: "'state")
     (transition: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
     (accepting: "'state pred")
 
-  global_interpretation dba: transition_system_initial
-    "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
-    for A
-    defines path = dba.path and run = dba.run and reachable = dba.reachable and nodes = dba.nodes and
-      enableds = dba.enableds and paths = dba.paths and runs = dba.runs
-    by this
+  (* TODO: if we interpret everything at once, some abbreviations don't get folded back
+    see DBA_Combine.intersection_list.combine_finite *)
+  global_interpretation dba: automaton dba alphabet initial transition accepting
+    defines path = dba.path and run = dba.run and reachable = dba.reachable and nodes = dba.nodes
+    by unfold_locales auto
+  global_interpretation dba: automaton_trace dba alphabet initial transition accepting infs
+    defines language = dba.language
+    by standard
 
   abbreviation target where "target \<equiv> dba.target"
   abbreviation states where "states \<equiv> dba.states"
   abbreviation trace where "trace \<equiv> dba.trace"
-
-  abbreviation successors :: "('label, 'state) dba \<Rightarrow> 'state \<Rightarrow> 'state set" where
-    "successors \<equiv> dba.successors TYPE('label)"
-
-  lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
-  unfolding lists_iff_set[symmetric]
-  proof
-    show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
-    show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
-  qed
-  lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
-  unfolding streams_iff_sset[symmetric]
-  proof
-    show "w \<in> streams (alphabet A)" if "run A w p"
-      using that by (coinduction arbitrary: w p) (force elim: dba.run.cases)
-    show "run A w p" if "w \<in> streams (alphabet A)"
-      using that by (coinduction arbitrary: w p) (force elim: streams.cases)
-  qed
-
-  definition language :: "('label, 'state) dba \<Rightarrow> 'label stream set" where
-    "language A \<equiv> {w. run A w (initial A) \<and> infs (accepting A) (trace A w (initial A))}"
-
-  lemma language[intro]:
-    assumes "run A w (initial A)" "infs (accepting A) (trace A w (initial A))"
-    shows "w \<in> language A"
-    using assms unfolding language_def by auto
-  lemma language_elim[elim]:
-    assumes "w \<in> language A"
-    obtains "run A w (initial A)" "infs (accepting A) (trace A w (initial A))"
-    using assms unfolding language_def by auto
-
-  lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
-    unfolding language_def run_alt_def using sset_streams by auto
+  (* TODO: why does this happen? if I can fix it here, why can't the interpretation do it?
+    same happens with reachable, requiring the use of defines directives *)
+  abbreviation successors where "successors \<equiv> dba.successors TYPE('label)"
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DBA/DBA_Combine.thy b/thys/Transition_Systems_and_Automata/Automata/DBA/DBA_Combine.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DBA/DBA_Combine.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DBA/DBA_Combine.thy
@@ -1,304 +1,107 @@
 section \<open>Deterministic Büchi Automata Combinations\<close>
 
 theory DBA_Combine
-imports "DBA" "DGBA"
+imports DBA DGBA
 begin
 
-  definition dbgail :: "('label, 'state) dba list \<Rightarrow> ('label, 'state list) dgba" where
-    "dbgail AA \<equiv> dgba
-      (\<Inter> (dba.alphabet ` set AA))
-      (map dba.initial AA)
-      (\<lambda> a pp. map2 (\<lambda> A p. dba.transition A a p) AA pp)
-      (map (\<lambda> k pp. dba.accepting (AA ! k) (pp ! k)) [0 ..< length AA])"
-
-  lemma dbgail_trace_smap:
-    assumes "length pp = length AA" "k < length AA"
-    shows "smap (\<lambda> pp. pp ! k) (dgba.trace (dbgail AA) w pp) = dba.trace (AA ! k) w (pp ! k)"
-    using assms unfolding dbgail_def by (coinduction arbitrary: w pp) (force)
-  lemma dbgail_nodes_length:
-    assumes "pp \<in> DGBA.nodes (dbgail AA)"
-    shows "length pp = length AA"
-    using assms unfolding dbgail_def by induct auto
-  lemma dbgail_nodes[intro]:
-    assumes "pp \<in> DGBA.nodes (dbgail AA)" "k < length pp"
-    shows "pp ! k \<in> DBA.nodes (AA ! k)"
-    using assms unfolding dbgail_def by induct auto
-
-  lemma dbgail_nodes_finite[intro]:
-    assumes "list_all (finite \<circ> DBA.nodes) AA"
-    shows "finite (DGBA.nodes (dbgail AA))"
-  proof (rule finite_subset)
-    show "DGBA.nodes (dbgail AA) \<subseteq> listset (map DBA.nodes AA)"
-      by (force simp: listset_member list_all2_conv_all_nth dbgail_nodes_length)
-    have "finite (listset (map DBA.nodes AA)) \<longleftrightarrow> list_all finite (map DBA.nodes AA)"
-      by (rule listset_finite) (auto simp: list_all_iff)
-    then show "finite (listset (map DBA.nodes AA))" using assms by (simp add: list.pred_map)
-  qed
-  lemma dbgail_nodes_card:
-    assumes "list_all (finite \<circ> DBA.nodes) AA"
-    shows "card (DGBA.nodes (dbgail AA)) \<le> prod_list (map (card \<circ> DBA.nodes) AA)"
-  proof -
-    have "card (DGBA.nodes (dbgail AA)) \<le> card (listset (map DBA.nodes AA))"
-    proof (rule card_mono)
-      have "finite (listset (map DBA.nodes AA)) \<longleftrightarrow> list_all finite (map DBA.nodes AA)"
-        by (rule listset_finite) (auto simp: list_all_iff)
-      then show "finite (listset (map DBA.nodes AA))" using assms by (simp add: list.pred_map)
-      show "DGBA.nodes (dbgail AA) \<subseteq> listset (map DBA.nodes AA)"
-        by (force simp: listset_member list_all2_conv_all_nth dbgail_nodes_length)
-    qed
-    also have "\<dots> = prod_list (map (card \<circ> DBA.nodes) AA)" by simp
-    finally show ?thesis by this
-  qed
+  global_interpretation degeneralization: automaton_degeneralization_trace
+    dgba dgba.alphabet dgba.initial dgba.transition dgba.accepting "gen infs"
+    dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    defines degeneralize = degeneralization.degeneralize
+    by unfold_locales auto
 
-  lemma dbgail_language[simp]: "DGBA.language (dbgail AA) = \<Inter> (DBA.language ` set AA)"
-  proof safe
-    fix w A
-    assume 1: "w \<in> DGBA.language (dbgail AA)" "A \<in> set AA"
-    obtain 2:
-      "dgba.run (dbgail AA) w (dgba.initial (dbgail AA))"
-      "gen infs (dgba.accepting (dbgail AA)) (dgba.trace (dbgail AA) w (dgba.initial (dbgail AA)))"
-      using 1(1) by rule
-    obtain k where 3: "A = AA ! k" "k < length AA" using 1(2) unfolding in_set_conv_nth by auto
-    have 4: "(\<lambda> pp. dba.accepting A (pp ! k)) \<in> set (dgba.accepting (dbgail AA))"
-      using 3 unfolding dbgail_def by auto
-    show "w \<in> DBA.language A"
-    proof
-      show "dba.run A w (dba.initial A)"
-        using 1(2) 2(1) unfolding DBA.run_alt_def DGBA.run_alt_def dbgail_def by auto
-      have "True \<longleftrightarrow> infs (\<lambda> pp. dba.accepting A (pp ! k)) (dgba.trace (dbgail AA) w (map dba.initial AA))"
-        using 2(2) 4 unfolding dbgail_def by auto
-      also have "\<dots> \<longleftrightarrow> infs (dba.accepting A) (smap (\<lambda> pp. pp ! k)
-        (dgba.trace (dbgail AA) w (map dba.initial AA)))" by (simp add: comp_def)
-      also have "smap (\<lambda> pp. pp ! k) (dgba.trace (dbgail AA) w (map dba.initial AA)) =
-        dba.trace (AA ! k) w (map dba.initial AA ! k)" using 3(2) by (fastforce intro: dbgail_trace_smap)
-      also have "\<dots> = dba.trace A w (dba.initial A)" using 3 by auto
-      finally show "infs (dba.accepting A) (dba.trace A w (dba.initial A))" by simp
-    qed
-  next
-    fix w
-    assume 1: "w \<in> \<Inter> (DBA.language ` set AA)"
-    have 2: "dba.run A w (dba.initial A)" "infs (dba.accepting A) (dba.trace A w (dba.initial A))"
-      if "A \<in> set AA" for A using 1 that by auto
-    show "w \<in> DGBA.language (dbgail AA)"
-    proof (intro DGBA.language ballI gen)
-      show "dgba.run (dbgail AA) w (dgba.initial (dbgail AA))"
-        using 2(1) unfolding DBA.run_alt_def DGBA.run_alt_def dbgail_def by auto
-    next
-      fix P
-      assume 3: "P \<in> set (dgba.accepting (dbgail AA))"
-      obtain k where 4: "P = (\<lambda> pp. dba.accepting (AA ! k) (pp ! k))" "k < length AA"
-        using 3 unfolding dbgail_def by auto
-      have "True \<longleftrightarrow> infs (dba.accepting (AA ! k)) (dba.trace (AA ! k) w (map dba.initial AA ! k))"
-        using 2(2) 4(2) by auto
-      also have "dba.trace (AA ! k) w (map dba.initial AA ! k) =
-        smap (\<lambda> pp. pp ! k) (dgba.trace (dbgail AA) w (map dba.initial AA))"
-        using 4(2) by (fastforce intro: dbgail_trace_smap[symmetric])
-      also have "infs (dba.accepting (AA ! k)) \<dots> \<longleftrightarrow> infs P (dgba.trace (dbgail AA) w (map dba.initial AA))"
-        unfolding 4(1) by (simp add: comp_def)
-      also have "map dba.initial AA = dgba.initial (dbgail AA)" unfolding dbgail_def by simp
-      finally show "infs P (dgba.trace (dbgail AA) w (dgba.initial (dbgail AA)))" by simp
-    qed
-  qed
+  lemmas degeneralize_language[simp] = degeneralization.degeneralize_language[folded DBA.language_def]
+  lemmas degeneralize_nodes_finite[iff] = degeneralization.degeneralize_nodes_finite[folded DBA.nodes_def]
+  lemmas degeneralize_nodes_card = degeneralization.degeneralize_nodes_card[folded DBA.nodes_def]
 
-  definition dbail :: "('label, 'state) dba list \<Rightarrow> ('label, 'state list degen) dba" where
-    "dbail = dgbad \<circ> dbgail"
+  global_interpretation intersection: automaton_intersection_trace
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dgba.dgba dgba.alphabet dgba.initial dgba.transition dgba.accepting "gen infs"
+    "\<lambda> c\<^sub>1 c\<^sub>2. [c\<^sub>1 \<circ> fst, c\<^sub>2 \<circ> snd]"
+    defines intersect' = intersection.combine
+    by unfold_locales auto
 
-  lemma dbail_nodes_finite[intro]:
-    assumes "list_all (finite \<circ> DBA.nodes) AA"
-    shows "finite (DBA.nodes (dbail AA))"
-    using dbgail_nodes_finite assms unfolding dbail_def by auto
-  lemma dbail_nodes_card:
-    assumes"list_all (finite \<circ> DBA.nodes) AA"
-    shows "card (DBA.nodes (dbail AA)) \<le> max 1 (length AA) * prod_list (map (card \<circ> DBA.nodes) AA)"
+  lemmas intersect'_language[simp] = intersection.combine_language[folded DGBA.language_def]
+  lemmas intersect'_nodes_finite = intersection.combine_nodes_finite[folded DGBA.nodes_def]
+  lemmas intersect'_nodes_card = intersection.combine_nodes_card[folded DGBA.nodes_def]
+
+  global_interpretation union: automaton_union_trace
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    "\<lambda> c\<^sub>1 c\<^sub>2 pq. (c\<^sub>1 \<circ> fst) pq \<or> (c\<^sub>2 \<circ> snd) pq"
+    defines union = union.combine
+    by (unfold_locales) (simp del: comp_apply)
+
+  lemmas union_language = union.combine_language
+  lemmas union_nodes_finite = union.combine_nodes_finite
+  lemmas union_nodes_card = union.combine_nodes_card
+
+  global_interpretation intersection_list: automaton_intersection_list_trace
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dgba.dgba dgba.alphabet dgba.initial dgba.transition dgba.accepting "gen infs"
+    "\<lambda> cs. map (\<lambda> k pp. (cs ! k) (pp ! k)) [0 ..< length cs]"
+    defines intersect_list' = intersection_list.combine
+    by (unfold_locales) (auto simp: gen_def comp_def)
+
+  lemmas intersect_list'_language[simp] = intersection_list.combine_language[folded DGBA.language_def]
+  lemmas intersect_list'_nodes_finite = intersection_list.combine_nodes_finite[folded DGBA.nodes_def]
+  lemmas intersect_list'_nodes_card = intersection_list.combine_nodes_card[folded DGBA.nodes_def]
+
+  global_interpretation union_list: automaton_union_list_trace
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    "\<lambda> cs pp. \<exists> k < length cs. (cs ! k) (pp ! k)"
+    defines union_list = union_list.combine
+    by (unfold_locales) (simp add: comp_def)
+
+  lemmas union_list_language = union_list.combine_language
+  lemmas union_list_nodes_finite = union_list.combine_nodes_finite
+  lemmas union_list_nodes_card = union_list.combine_nodes_card
+
+  (* TODO: these compound definitions are annoying, can we move those into Deterministic theory *)
+
+  abbreviation intersect where "intersect A B \<equiv> degeneralize (intersect' A B)"
+
+  lemma intersect_language[simp]: "DBA.language (intersect A B) = DBA.language A \<inter> DBA.language B"
+    by simp
+  lemma intersect_nodes_finite:
+    assumes "finite (DBA.nodes A)" "finite (DBA.nodes B)"
+    shows "finite (DBA.nodes (intersect A B))"
+    using intersect'_nodes_finite assms by simp
+  lemma intersect_nodes_card:
+    assumes "finite (DBA.nodes A)" "finite (DBA.nodes B)"
+    shows "card (DBA.nodes (intersect A B)) \<le> 2 * card (DBA.nodes A) * card (DBA.nodes B)"
   proof -
-    have "card (DBA.nodes (dbail AA)) \<le>
-      max 1 (length (dgba.accepting (dbgail AA))) * card (DGBA.nodes (dbgail AA))"
-      unfolding dbail_def using dgbad_nodes_card by simp
-    also have "length (dgba.accepting (dbgail AA)) = length AA" unfolding dbgail_def by simp
-    also have "card (DGBA.nodes (dbgail AA)) \<le> prod_list (map (card \<circ> DBA.nodes) AA)"
-      using dbgail_nodes_card assms by this
+    have "card (DBA.nodes (intersect A B)) \<le>
+      max 1 (length (dgba.accepting (intersect' A B))) * card (DGBA.nodes (intersect' A B))"
+      using degeneralize_nodes_card by this
+    also have "length (dgba.accepting (intersect' A B)) = 2" by simp
+    also have "card (DGBA.nodes (intersect' A B)) \<le> card (DBA.nodes A) * card (DBA.nodes B)"
+      using intersect'_nodes_card assms by this
     finally show ?thesis by simp
   qed
 
-  lemma dbail_language [simp]:
-    "DBA.language (dbail AA) = \<Inter> (DBA.language ` set AA)"
-    by (simp add: dbail_def)
-
-  definition dbau :: "('label, 'state\<^sub>1) dba \<Rightarrow> ('label, 'state\<^sub>2) dba \<Rightarrow>
-    ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) dba" where
-    "dbau A B \<equiv> dba
-      (dba.alphabet A \<union> dba.alphabet B)
-      (dba.initial A, dba.initial B)
-      (\<lambda> a (p, q). (dba.transition A a p, dba.transition B a q))
-      (\<lambda> (p, q). dba.accepting A p \<or> dba.accepting B q)"
-
-  (* TODO: can these be extracted as more general theorems about sscan? *)
-  lemma dbau_fst[iff]: "infs (P \<circ> fst) (dba.trace (dbau A B) w (p, q)) \<longleftrightarrow> infs P (dba.trace A w p)"
-  proof -
-    let ?t = "dba.trace (dbau A B) w (p, q)"
-    have "infs (P \<circ> fst) ?t \<longleftrightarrow> infs P (smap fst ?t)" by (simp add: comp_def)
-    also have "smap fst ?t = dba.trace A w p" unfolding dbau_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dbau_snd[iff]: "infs (P \<circ> snd) (dba.trace (dbau A B) w (p, q)) \<longleftrightarrow> infs P (dba.trace B w q)"
-  proof -
-    let ?t = "dba.trace (dbau A B) w (p, q)"
-    have "infs (P \<circ> snd) ?t \<longleftrightarrow> infs P (smap snd ?t)" by (simp add: comp_def)
-    also have "smap snd ?t = dba.trace B w q" unfolding dbau_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dbau_nodes_fst[intro]:
-    assumes "dba.alphabet A = dba.alphabet B"
-    shows "fst ` DBA.nodes (dbau A B) \<subseteq> DBA.nodes A"
-  proof (rule subsetI, erule imageE)
-    fix pq p
-    assume "pq \<in> DBA.nodes (dbau A B)" "p = fst pq"
-    then show "p \<in> DBA.nodes A" using assms unfolding dbau_def by (induct arbitrary: p) (auto)
-  qed
-  lemma dbau_nodes_snd[intro]:
-    assumes "dba.alphabet A = dba.alphabet B"
-    shows "snd ` DBA.nodes (dbau A B) \<subseteq> DBA.nodes B"
-  proof (rule subsetI, erule imageE)
-    fix pq q
-    assume "pq \<in> DBA.nodes (dbau A B)" "q = snd pq"
-    then show "q \<in> DBA.nodes B" using assms unfolding dbau_def by (induct arbitrary: q) (auto)
-  qed
-
-  lemma dbau_nodes_finite[intro]:
-    assumes "dba.alphabet A = dba.alphabet B"
-    assumes "finite (DBA.nodes A)" "finite (DBA.nodes B)"
-    shows "finite (DBA.nodes (dbau A B))"
-  proof (rule finite_subset)
-    show "DBA.nodes (dbau A B) \<subseteq> DBA.nodes A \<times> DBA.nodes B"
-      using dbau_nodes_fst[OF assms(1)] dbau_nodes_snd[OF assms(1)] unfolding image_subset_iff by force
-    show "finite (DBA.nodes A \<times> DBA.nodes B)" using assms(2, 3) by simp
-  qed
-  lemma dbau_nodes_card[intro]:
-    assumes "dba.alphabet A = dba.alphabet B"
-    assumes "finite (DBA.nodes A)" "finite (DBA.nodes B)"
-    shows "card (DBA.nodes (dbau A B)) \<le> card (DBA.nodes A) * card (DBA.nodes B)"
-  proof -
-    have "card (DBA.nodes (dbau A B)) \<le> card (DBA.nodes A \<times> DBA.nodes B)"
-    proof (rule card_mono)
-      show "finite (DBA.nodes A \<times> DBA.nodes B)" using assms(2, 3) by simp
-      show "DBA.nodes (dbau A B) \<subseteq> DBA.nodes A \<times> DBA.nodes B"
-        using dbau_nodes_fst[OF assms(1)] dbau_nodes_snd[OF assms(1)] unfolding image_subset_iff by force
-    qed
-    also have "\<dots> = card (DBA.nodes A) * card (DBA.nodes B)" using card_cartesian_product by this
-    finally show ?thesis by this
-  qed
-
-  lemma dbau_language[simp]:
-    assumes "dba.alphabet A = dba.alphabet B"
-    shows "DBA.language (dbau A B) = DBA.language A \<union> DBA.language B"
-  proof -
-    have 1: "dba.alphabet (dbau A B) = dba.alphabet A \<union> dba.alphabet B" unfolding dbau_def by simp
-    have 2: "dba.initial (dbau A B) = (dba.initial A, dba.initial B)" unfolding dbau_def by simp
-    have 3: "dba.accepting (dbau A B) = (\<lambda> pq. (dba.accepting A \<circ> fst) pq \<or> (dba.accepting B \<circ> snd) pq)"
-      unfolding dbau_def by auto
-    have 4: "infs (dba.accepting (dbau A B)) (DBA.trace (dbau A B) w (p, q)) \<longleftrightarrow>
-      infs (dba.accepting A) (DBA.trace A w p) \<or> infs (dba.accepting B) (DBA.trace B w q)" for w p q
-      unfolding 3 by blast
-    show ?thesis using assms unfolding DBA.language_def DBA.run_alt_def 1 2 4 by auto
-  qed
-
-  definition dbaul :: "('label, 'state) dba list \<Rightarrow> ('label, 'state list) dba" where
-    "dbaul AA \<equiv> dba
-      (\<Union> (dba.alphabet ` set AA))
-      (map dba.initial AA)
-      (\<lambda> a pp. map2 (\<lambda> A p. dba.transition A a p) AA pp)
-      (\<lambda> pp. \<exists> k < length AA. dba.accepting (AA ! k) (pp ! k))"
+  abbreviation intersect_list where "intersect_list AA \<equiv> degeneralize (intersect_list' AA)"
 
-  lemma dbaul_trace_smap:
-    assumes "length pp = length AA" "k < length AA"
-    shows "smap (\<lambda> pp. pp ! k) (dba.trace (dbaul AA) w pp) = dba.trace (AA ! k) w (pp ! k)"
-    using assms unfolding dbaul_def by (coinduction arbitrary: w pp) (force)
-  lemma dbaul_nodes_length:
-    assumes "pp \<in> DBA.nodes (dbaul AA)"
-    shows "length pp = length AA"
-    using assms unfolding dbaul_def by induct auto
-  lemma dbaul_nodes[intro]:
-    assumes "\<Inter> (dba.alphabet ` set AA) = \<Union> (dba.alphabet ` set AA)"
-    assumes "pp \<in> DBA.nodes (dbaul AA)" "k < length pp"
-    shows "pp ! k \<in> DBA.nodes (AA ! k)"
-    using assms(2, 3, 1) unfolding dbaul_def by induct force+
-
-  lemma dbaul_nodes_finite[intro]:
-    assumes "\<Inter> (dba.alphabet ` set AA) = \<Union> (dba.alphabet ` set AA)"
+  lemma intersect_list_language[simp]: "DBA.language (intersect_list AA) = \<Inter> (DBA.language ` set AA)"
+    by simp
+  lemma intersect_list_nodes_finite:
     assumes "list_all (finite \<circ> DBA.nodes) AA"
-    shows "finite (DBA.nodes (dbaul AA))"
-  proof (rule finite_subset)
-    show "DBA.nodes (dbaul AA) \<subseteq> listset (map DBA.nodes AA)"
-      using assms(1) by (force simp: listset_member list_all2_conv_all_nth dbaul_nodes_length)
-    have "finite (listset (map DBA.nodes AA)) \<longleftrightarrow> list_all finite (map DBA.nodes AA)"
-      by (rule listset_finite) (auto simp: list_all_iff)
-    then show "finite (listset (map DBA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-  qed
-  lemma dbaul_nodes_card:
-    assumes "\<Inter> (dba.alphabet ` set AA) = \<Union> (dba.alphabet ` set AA)"
+    shows "finite (DBA.nodes (intersect_list AA))"
+    using intersect_list'_nodes_finite assms by simp
+  lemma intersect_list_nodes_card:
     assumes "list_all (finite \<circ> DBA.nodes) AA"
-    shows "card (DBA.nodes (dbaul AA)) \<le> prod_list (map (card \<circ> DBA.nodes) AA)"
+    shows "card (DBA.nodes (intersect_list AA)) \<le> max 1 (length AA) * prod_list (map (card \<circ> DBA.nodes) AA)"
   proof -
-    have "card (DBA.nodes (dbaul AA)) \<le> card (listset (map DBA.nodes AA))"
-    proof (rule card_mono)
-      have "finite (listset (map DBA.nodes AA)) \<longleftrightarrow> list_all finite (map DBA.nodes AA)"
-        by (rule listset_finite) (auto simp: list_all_iff)
-      then show "finite (listset (map DBA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-      show "DBA.nodes (dbaul AA) \<subseteq> listset (map DBA.nodes AA)"
-        using assms(1) by (force simp: listset_member list_all2_conv_all_nth dbaul_nodes_length)
-    qed
-    also have "\<dots> = prod_list (map (card \<circ> DBA.nodes) AA)" by simp
-    finally show ?thesis by this
-  qed
-
-  lemma dbaul_language[simp]:
-    assumes "\<Inter> (dba.alphabet ` set AA) = \<Union> (dba.alphabet ` set AA)"
-    shows "DBA.language (dbaul AA) = \<Union> (DBA.language ` set AA)"
-  proof safe
-    fix w
-    assume 1: "w \<in> DBA.language (dbaul AA)"
-    obtain 2:
-      "dba.run (dbaul AA) w (dba.initial (dbaul AA))"
-      "infs (dba.accepting (dbaul AA)) (dba.trace (dbaul AA) w (dba.initial (dbaul AA)))"
-      using 1 by rule
-    obtain k where 3:
-      "k < length AA"
-      "infs (\<lambda> pp. dba.accepting (AA ! k) (pp ! k)) (dba.trace (dbaul AA) w (map dba.initial AA))"
-      using 2(2) unfolding dbaul_def by auto
-    show "w \<in> \<Union> (DBA.language ` set AA)"
-    proof (intro UN_I DBA.language)
-      show "AA ! k \<in> set AA" using 3(1) by simp
-      show "dba.run (AA ! k) w (dba.initial (AA ! k))"
-        using assms 2(1) 3(1) unfolding DBA.run_alt_def DGBA.run_alt_def dbaul_def by force
-      have "True \<longleftrightarrow> infs (\<lambda> pp. dba.accepting (AA ! k) (pp ! k))
-        (dba.trace (dbaul AA) w (map dba.initial AA))" using 3(2) by auto
-      also have "\<dots> \<longleftrightarrow> infs (dba.accepting (AA ! k))
-        (smap (\<lambda> pp. pp ! k) (dba.trace (dbaul AA) w (map dba.initial AA)))" by (simp add: comp_def)
-      also have "smap (\<lambda> pp. pp ! k) (dba.trace (dbaul AA) w (map dba.initial AA)) =
-        dba.trace (AA ! k) w (map dba.initial AA ! k)" using 3(1) by (fastforce intro: dbaul_trace_smap)
-      also have "\<dots> = dba.trace (AA ! k) w (dba.initial (AA ! k))" using 3 by auto
-      finally show "infs (dba.accepting (AA ! k)) (dba.trace (AA ! k) w (dba.initial (AA ! k)))" by simp
-    qed
-  next
-    fix A w
-    assume 1: "A \<in> set AA" "w \<in> DBA.language A"
-    obtain 2: "dba.run A w (dba.initial A)" "infs (dba.accepting A) (dba.trace A w (dba.initial A))"
-      using 1(2) by rule
-    obtain k where 3: "A = AA ! k" "k < length AA" using 1(1) unfolding in_set_conv_nth by auto
-    show "w \<in> DBA.language (dbaul AA)"
-    proof
-      show "dba.run (dbaul AA) w (dba.initial (dbaul AA))"
-        using 1(1) 2(1) unfolding DBA.run_alt_def DGBA.run_alt_def dbaul_def by auto
-      have "True \<longleftrightarrow> infs (dba.accepting (AA ! k)) (dba.trace (AA ! k) w (map dba.initial AA ! k))"
-        using 2(2) 3 by auto
-      also have "dba.trace (AA ! k) w (map dba.initial AA ! k) =
-        smap (\<lambda> pp. pp ! k) (dba.trace (dbaul AA) w (map dba.initial AA))"
-        using 3(2) by (fastforce intro: dbaul_trace_smap[symmetric])
-      also have "infs (dba.accepting (AA ! k)) \<dots> \<longleftrightarrow> infs (\<lambda> pp. dba.accepting (AA ! k) (pp ! k))
-        (dba.trace (dbaul AA) w (map dba.initial AA))" by (simp add: comp_def)
-      finally show "infs (dba.accepting (dbaul AA)) (dba.trace (dbaul AA) w (dba.initial (dbaul AA)))"
-        using 3(2) unfolding dbaul_def by auto
-    qed
+    have "card (DBA.nodes (intersect_list AA)) \<le>
+      max 1 (length (dgba.accepting (intersect_list' AA))) * card (DGBA.nodes (intersect_list' AA))"
+      using degeneralize_nodes_card by this
+    also have "length (dgba.accepting (intersect_list' AA)) = length AA" by simp
+    also have "card (DGBA.nodes (intersect_list' AA)) \<le> prod_list (map (card \<circ> DBA.nodes) AA)"
+      using intersect_list'_nodes_card assms by this
+    finally show ?thesis by simp
   qed
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DBA/DGBA.thy b/thys/Transition_Systems_and_Automata/Automata/DBA/DGBA.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DBA/DGBA.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DBA/DGBA.thy
@@ -1,146 +1,25 @@
 section \<open>Deterministic Generalized Büchi Automata\<close>
 
 theory DGBA
-imports
-  "DBA"
-  "../../Basic/Degeneralization"
+imports "../Deterministic"
 begin
 
   datatype ('label, 'state) dgba = dgba
     (alphabet: "'label set")
     (initial: "'state")
     (transition: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
     (accepting: "'state pred gen")
 
-  global_interpretation dgba: transition_system_initial
-    "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
-    for A
-    defines path = dgba.path and run = dgba.run and reachable = dgba.reachable and nodes = dgba.nodes and
-      enableds = dgba.enableds and paths = dgba.paths and runs = dgba.runs
-    by this
+  global_interpretation dgba: automaton dgba alphabet initial transition accepting
+    defines path = dgba.path and run = dgba.run and reachable = dgba.reachable and nodes = dgba.nodes
+    by unfold_locales auto
+  global_interpretation dgba: automaton_trace dgba alphabet initial transition accepting "gen infs"
+    defines language = dgba.language
+    by standard
 
   abbreviation target where "target \<equiv> dgba.target"
   abbreviation states where "states \<equiv> dgba.states"
   abbreviation trace where "trace \<equiv> dgba.trace"
-
-  abbreviation successors :: "('label, 'state) dgba \<Rightarrow> 'state \<Rightarrow> 'state set" where
-    "successors \<equiv> dgba.successors TYPE('label)"
-
-  lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
-  unfolding lists_iff_set[symmetric]
-  proof
-    show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
-    show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
-  qed
-  lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
-  unfolding streams_iff_sset[symmetric]
-  proof
-    show "w \<in> streams (alphabet A)" if "run A w p"
-      using that by (coinduction arbitrary: w p) (force elim: dgba.run.cases)
-    show "run A w p" if "w \<in> streams (alphabet A)"
-      using that by (coinduction arbitrary: w p) (force elim: streams.cases)
-  qed
-
-  definition language :: "('label, 'state) dgba \<Rightarrow> 'label stream set" where
-    "language A \<equiv> {w. run A w (initial A) \<and> gen infs (accepting A) (trace A w (initial A))}"
-
-  lemma language[intro]:
-    assumes "run A w (initial A)" "gen infs (accepting A) (trace A w (initial A))"
-    shows "w \<in> language A"
-    using assms unfolding language_def by auto
-  lemma language_elim[elim]:
-    assumes "w \<in> language A"
-    obtains "run A w (initial A)" "gen infs (accepting A) (trace A w (initial A))"
-    using assms unfolding language_def by auto
-
-  lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
-    unfolding language_def run_alt_def using sset_streams by auto
-
-  definition dgbad :: "('label, 'state) dgba \<Rightarrow> ('label, 'state degen) dba" where
-    "dgbad A \<equiv> dba
-      (alphabet A)
-      (initial A, 0)
-      (\<lambda> a (p, k). (transition A a p, count (accepting A) p k))
-      (degen (accepting A))"
-
-  lemma dgbad_simps[simp]:
-    "dba.alphabet (dgbad A) = alphabet A"
-    "dba.initial (dgbad A) = (initial A, 0)"
-    "dba.transition (dgbad A) a (p, k) = (transition A a p, count (accepting A) p k)"
-    "dba.accepting (dgbad A) = degen (accepting A)"
-    unfolding dgbad_def by auto
-
-  lemma dgbad_target[simp]: "dba.target (dgbad A) w (p, k) =
-    (dgba.target A w p, fold (count (accepting A)) (butlast (p # dgba.states A w p)) k)"
-    by (induct w arbitrary: p k) (auto)
-  lemma dgbad_states[simp]: "dba.states (dgbad A) w (p, k) =
-    dgba.states A w p || scan (count (accepting A)) (p # dgba.states A w p) k"
-    by (induct w arbitrary: p k) (auto)
-  lemma dgbad_trace[simp]: "dba.trace (dgbad A) w (p, k) =
-    dgba.trace A w p ||| sscan (count (accepting A)) (p ## dgba.trace A w p) k"
-    by (coinduction arbitrary: w p k) (auto)
-  lemma dgbad_path[iff]: "dba.path (dgbad A) w (p, k) \<longleftrightarrow> dgba.path A w p"
-    unfolding DBA.path_alt_def DGBA.path_alt_def by simp
-  lemma dgbad_run[iff]: "dba.run (dgbad A) w (p, k) \<longleftrightarrow> dgba.run A w p"
-    unfolding DBA.run_alt_def DGBA.run_alt_def by simp
-
-  (* TODO: revise *)
-  lemma dgbad_nodes_fst[simp]: "fst ` DBA.nodes (dgbad A) = DGBA.nodes A"
-    unfolding dba.nodes_alt_def dba.reachable_alt_def
-    unfolding dgba.nodes_alt_def dgba.reachable_alt_def
-    unfolding image_def by simp
-  lemma dgbad_nodes_snd_empty:
-    assumes "accepting A = []"
-    shows "snd ` DBA.nodes (dgbad A) \<subseteq> {0}"
-  proof -
-    have 2: "snd (dba.transition (dgbad A) a (p, k)) = 0" for a p k using assms by auto
-    show ?thesis using 2 by (auto elim: dba.nodes.cases)
-  qed
-  lemma dgbad_nodes_snd_nonempty:
-    assumes "accepting A \<noteq> []"
-    shows "snd ` DBA.nodes (dgbad A) \<subseteq> {0 ..< length (accepting A)}"
-  proof -
-    have 1: "snd (dba.initial (dgbad A)) < length (accepting A)"
-      using assms by simp
-    have 2: "snd (dba.transition (dgbad A) a (p, k)) < length (accepting A)" for a p k
-      using assms by auto
-    show ?thesis using 1 2 by (auto elim: dba.nodes.cases)
-  qed
-  lemma dgbad_nodes_empty:
-    assumes "accepting A = []"
-    shows "DBA.nodes (dgbad A) = DGBA.nodes A \<times> {0}"
-  proof -
-    have "(p, k) \<in> DBA.nodes (dgbad A) \<longleftrightarrow> p \<in> fst ` DBA.nodes (dgbad A) \<and> k = 0" for p k
-      using dgbad_nodes_snd_empty[OF assms] by (force simp del: dgbad_nodes_fst)
-    then show ?thesis by auto
-  qed
-  lemma dgbad_nodes_nonempty:
-    assumes "accepting A \<noteq> []"
-    shows "DBA.nodes (dgbad A) \<subseteq> DGBA.nodes A \<times> {0 ..< length (accepting A)}"
-    using subset_fst_snd dgbad_nodes_fst[of A] dgbad_nodes_snd_nonempty[OF assms] by blast
-  lemma dgbad_nodes: "DBA.nodes (dgbad A) \<subseteq> DGBA.nodes A \<times> {0 ..< max 1 (length (accepting A))}"
-    using dgbad_nodes_empty dgbad_nodes_nonempty by force
-
-  lemma dgbad_language[simp]: "DBA.language (dgbad A) = DGBA.language A" by force
-
-  lemma dgbad_nodes_finite[iff]: "finite (DBA.nodes (dgbad A)) \<longleftrightarrow> finite (DGBA.nodes A)"
-  proof
-    show "finite (DGBA.nodes A)" if "finite (DBA.nodes (dgbad A))"
-      using that by (auto simp flip: dgbad_nodes_fst)
-    show "finite (DBA.nodes (dgbad A))" if "finite (DGBA.nodes A)"
-      using dgbad_nodes that finite_subset by fastforce
-  qed
-  lemma dgbad_nodes_card: "card (DBA.nodes (dgbad A)) \<le> max 1 (length (accepting A)) * card (DGBA.nodes A)"
-  proof (cases "finite (DGBA.nodes A)")
-    case True
-    have "card (DBA.nodes (dgbad A)) \<le> card (DGBA.nodes A \<times> {0 ..< max 1 (length (accepting A))})"
-      using dgbad_nodes True by (blast intro: card_mono)
-    also have "\<dots> = max 1 (length (accepting A)) * card (DGBA.nodes A)" unfolding card_cartesian_product by simp
-    finally show ?thesis by this
-  next
-    case False
-    then have "card (DGBA.nodes A) = 0" "card (DBA.nodes (dgbad A)) = 0" by auto
-    then show ?thesis by simp
-  qed
+  abbreviation successors where "successors \<equiv> dgba.successors TYPE('label)"
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DCA/DCA.thy b/thys/Transition_Systems_and_Automata/Automata/DCA/DCA.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DCA/DCA.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DCA/DCA.thy
@@ -1,62 +1,25 @@
 section \<open>Deterministic Co-Büchi Automata\<close>
 
 theory DCA
-imports
-  "../../Basic/Sequence_Zip"
-  "../../Basic/Acceptance"
-  "../../Transition_Systems/Transition_System"
-  "../../Transition_Systems/Transition_System_Extra"
-  "../../Transition_Systems/Transition_System_Construction"
+imports "../Deterministic"
 begin
 
   datatype ('label, 'state) dca = dca
     (alphabet: "'label set")
     (initial: "'state")
     (transition: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
     (rejecting: "'state \<Rightarrow> bool")
 
-  global_interpretation dca: transition_system_initial
-    "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
-    for A
-    defines path = dca.path and run = dca.run and reachable = dca.reachable and nodes = dca.nodes and
-      enableds = dca.enableds and paths = dca.paths and runs = dca.runs
-    by this
+  global_interpretation dca: automaton dca alphabet initial transition rejecting
+    defines path = dca.path and run = dca.run and reachable = dca.reachable and nodes = dca.nodes
+    by unfold_locales auto
+  global_interpretation dca: automaton_trace dca alphabet initial transition rejecting fins
+    defines language = dca.language
+    by standard
 
   abbreviation target where "target \<equiv> dca.target"
   abbreviation states where "states \<equiv> dca.states"
   abbreviation trace where "trace \<equiv> dca.trace"
-
-  abbreviation successors :: "('label, 'state) dca \<Rightarrow> 'state \<Rightarrow> 'state set" where
-    "successors \<equiv> dca.successors TYPE('label)"
-
-  lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
-  unfolding lists_iff_set[symmetric]
-  proof
-    show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
-    show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
-  qed
-  lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
-  unfolding streams_iff_sset[symmetric]
-  proof
-    show "w \<in> streams (alphabet A)" if "run A w p"
-      using that by (coinduction arbitrary: w p) (force elim: dca.run.cases)
-    show "run A w p" if "w \<in> streams (alphabet A)"
-      using that by (coinduction arbitrary: w p) (force elim: streams.cases)
-  qed
-
-  definition language :: "('label, 'state) dca \<Rightarrow> 'label stream set" where
-    "language A \<equiv> {w. run A w (initial A) \<and> fins (rejecting A) (trace A w (initial A))}"
-
-  lemma language[intro]:
-    assumes "run A w (initial A)" "fins (rejecting A) (trace A w (initial A))"
-    shows "w \<in> language A"
-    using assms unfolding language_def by auto
-  lemma language_elim[elim]:
-    assumes "w \<in> language A"
-    obtains "run A w (initial A)" "fins (rejecting A) (trace A w (initial A))"
-    using assms unfolding language_def by auto
-
-  lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
-    unfolding language_def run_alt_def using sset_streams by auto
+  abbreviation successors where "successors \<equiv> dca.successors TYPE('label)"
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DCA/DCA_Combine.thy b/thys/Transition_Systems_and_Automata/Automata/DCA/DCA_Combine.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DCA/DCA_Combine.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DCA/DCA_Combine.thy
@@ -1,298 +1,109 @@
 section \<open>Deterministic Co-Büchi Automata Combinations\<close>
 
 theory DCA_Combine
-imports "DCA" "DGCA"
+imports DCA DGCA
 begin
 
-  definition dcai :: "('label, 'state\<^sub>1) dca \<Rightarrow> ('label, 'state\<^sub>2) dca \<Rightarrow>
-    ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) dca" where
-    "dcai A B \<equiv> dca
-      (dca.alphabet A \<inter> dca.alphabet B)
-      (dca.initial A, dca.initial B)
-      (\<lambda> a (p, q). (dca.transition A a p, dca.transition B a q))
-      (\<lambda> (p, q). dca.rejecting A p \<or> dca.rejecting B q)"
-
-  lemma dcai_fst[iff]: "infs (P \<circ> fst) (dca.trace (dcai A B) w (p, q)) \<longleftrightarrow> infs P (dca.trace A w p)"
-  proof -
-    let ?t = "dca.trace (dcai A B) w (p, q)"
-    have "infs (P \<circ> fst) ?t \<longleftrightarrow> infs P (smap fst ?t)" by (simp add: comp_def)
-    also have "smap fst ?t = dca.trace A w p" unfolding dcai_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dcai_snd[iff]: "infs (P \<circ> snd) (dca.trace (dcai A B) w (p, q)) \<longleftrightarrow> infs P (dca.trace B w q)"
-  proof -
-    let ?t = "dca.trace (dcai A B) w (p, q)"
-    have "infs (P \<circ> snd) ?t \<longleftrightarrow> infs P (smap snd ?t)" by (simp add: comp_def)
-    also have "smap snd ?t = dca.trace B w q" unfolding dcai_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dcai_nodes_fst[intro]: "fst ` DCA.nodes (dcai A B) \<subseteq> DCA.nodes A"
-  proof (rule subsetI, erule imageE)
-    fix pq p
-    assume "pq \<in> DCA.nodes (dcai A B)" "p = fst pq"
-    then show "p \<in> DCA.nodes A" unfolding dcai_def by (induct arbitrary: p) (auto)
-  qed
-  lemma dcai_nodes_snd[intro]: "snd ` DCA.nodes (dcai A B) \<subseteq> DCA.nodes B"
-  proof (rule subsetI, erule imageE)
-    fix pq q
-    assume "pq \<in> DCA.nodes (dcai A B)" "q = snd pq"
-    then show "q \<in> DCA.nodes B" unfolding dcai_def by (induct arbitrary: q) (auto)
-  qed
-
-  lemma dcai_nodes_finite[intro]:
-    assumes "finite (DCA.nodes A)" "finite (DCA.nodes B)"
-    shows "finite (DCA.nodes (dcai A B))"
-  proof (rule finite_subset)
-    show "DCA.nodes (dcai A B) \<subseteq> DCA.nodes A \<times> DCA.nodes B"
-      using dcai_nodes_fst dcai_nodes_snd unfolding image_subset_iff by force
-    show "finite (DCA.nodes A \<times> DCA.nodes B)" using assms by simp
-  qed
-  lemma dcai_nodes_card[intro]:
-    assumes "finite (DCA.nodes A)" "finite (DCA.nodes B)"
-    shows "card (DCA.nodes (dcai A B)) \<le> card (DCA.nodes A) * card (DCA.nodes B)"
-  proof -
-    have "card (DCA.nodes (dcai A B)) \<le> card (DCA.nodes A \<times> DCA.nodes B)"
-    proof (rule card_mono)
-      show "finite (DCA.nodes A \<times> DCA.nodes B)" using assms by simp
-      show "DCA.nodes (dcai A B) \<subseteq> DCA.nodes A \<times> DCA.nodes B"
-        using dcai_nodes_fst dcai_nodes_snd unfolding image_subset_iff by force
-    qed
-    also have "\<dots> = card (DCA.nodes A) * card (DCA.nodes B)" using card_cartesian_product by this
-    finally show ?thesis by this
-  qed
-
-  lemma dcai_language[simp]: "DCA.language (dcai A B) = DCA.language A \<inter> DCA.language B"
-  proof -
-    have 1: "dca.alphabet (dcai A B) = dca.alphabet A \<inter> dca.alphabet B" unfolding dcai_def by simp
-    have 2: "dca.initial (dcai A B) = (dca.initial A, dca.initial B)" unfolding dcai_def by simp
-    have 3: "dca.rejecting (dcai A B) = (\<lambda> pq. (dca.rejecting A \<circ> fst) pq \<or> (dca.rejecting B \<circ> snd) pq)"
-      unfolding dcai_def by auto
-    have 4: "infs (dca.rejecting (dcai A B)) (DCA.trace (dcai A B) w (p, q)) \<longleftrightarrow>
-      infs (dca.rejecting A) (DCA.trace A w p) \<or> infs (dca.rejecting B) (DCA.trace B w q)" for w p q
-      unfolding 3 by blast
-    show ?thesis unfolding DCA.language_def DCA.run_alt_def 1 2 4 by auto
-  qed
-
-  definition dcail :: "('label, 'state) dca list \<Rightarrow> ('label, 'state list) dca" where
-    "dcail AA \<equiv> dca
-      (\<Inter> (dca.alphabet ` set AA))
-      (map dca.initial AA)
-      (\<lambda> a pp. map2 (\<lambda> A p. dca.transition A a p) AA pp)
-      (\<lambda> pp. \<exists> k < length AA. dca.rejecting (AA ! k) (pp ! k))"
-
-  lemma dcail_trace_smap:
-    assumes "length pp = length AA" "k < length AA"
-    shows "smap (\<lambda> pp. pp ! k) (dca.trace (dcail AA) w pp) = dca.trace (AA ! k) w (pp ! k)"
-    using assms unfolding dcail_def by (coinduction arbitrary: w pp) (force)
-  lemma dcail_nodes_length:
-    assumes "pp \<in> DCA.nodes (dcail AA)"
-    shows "length pp = length AA"
-    using assms unfolding dcail_def by induct auto
-  lemma dcail_nodes[intro]:
-    assumes "pp \<in> DCA.nodes (dcail AA)" "k < length pp"
-    shows "pp ! k \<in> DCA.nodes (AA ! k)"
-    using assms unfolding dcail_def by induct auto
-
-  lemma dcail_finite[intro]:
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "finite (DCA.nodes (dcail AA))"
-  proof (rule finite_subset)
-    show "DCA.nodes (dcail AA) \<subseteq> listset (map DCA.nodes AA)"
-      by (force simp: listset_member list_all2_conv_all_nth dcail_nodes_length)
-    have "finite (listset (map DCA.nodes AA)) \<longleftrightarrow> list_all finite (map DCA.nodes AA)"
-      by (rule listset_finite) (auto simp: list_all_iff)
-    then show "finite (listset (map DCA.nodes AA))" using assms by (simp add: list.pred_map)
-  qed
-  lemma dcail_nodes_card:
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "card (DCA.nodes (dcail AA)) \<le> prod_list (map (card \<circ> DCA.nodes) AA)"
-  proof -
-    have "card (DCA.nodes (dcail AA)) \<le> card (listset (map DCA.nodes AA))"
-    proof (rule card_mono)
-      have "finite (listset (map DCA.nodes AA)) \<longleftrightarrow> list_all finite (map DCA.nodes AA)"
-        by (rule listset_finite) (auto simp: list_all_iff)
-      then show "finite (listset (map DCA.nodes AA))" using assms by (simp add: list.pred_map)
-      show "DCA.nodes (dcail AA) \<subseteq> listset (map DCA.nodes AA)"
-        by (force simp: listset_member list_all2_conv_all_nth dcail_nodes_length)
-    qed
-    also have "\<dots> = prod_list (map (card \<circ> DCA.nodes) AA)" by simp
-    finally show ?thesis by this
-  qed
+  global_interpretation degeneralization: automaton_degeneralization_trace
+    dgca dgca.alphabet dgca.initial dgca.transition dgca.rejecting "cogen fins"
+    dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    defines degeneralize = degeneralization.degeneralize
+    by unfold_locales auto
 
-  lemma dcail_language[simp]: "DCA.language (dcail AA) = \<Inter> (DCA.language ` set AA)"
-  proof safe
-    fix A w
-    assume 1: "w \<in> DCA.language (dcail AA)" "A \<in> set AA"
-    obtain 2:
-      "dca.run (dcail AA) w (dca.initial (dcail AA))"
-      "fins (dca.rejecting (dcail AA)) (dca.trace (dcail AA) w (dca.initial (dcail AA)))"
-      using 1(1) by rule
-    obtain k where 3: "A = AA ! k" "k < length AA" using 1(2) unfolding in_set_conv_nth by auto
-    have 4: "fins (\<lambda> pp. dca.rejecting A (pp ! k)) (dca.trace (dcail AA) w (map dca.initial AA))"
-      using 2(2) 3 unfolding dcail_def by auto
-    show "w \<in> DCA.language A"
-    proof
-      show "dca.run A w (dca.initial A)"
-        using 1(2) 2(1) unfolding DCA.run_alt_def dcail_def by auto
-      have "True \<longleftrightarrow> fins (\<lambda> pp. dca.rejecting A (pp ! k)) (dca.trace (dcail AA) w (map dca.initial AA))"
-        using 4 by simp
-      also have "\<dots> \<longleftrightarrow> fins (dca.rejecting A) (smap (\<lambda> pp. pp ! k)
-        (dca.trace (dcail AA) w (map dca.initial AA)))" by (simp add: comp_def)
-      also have "smap (\<lambda> pp. pp ! k) (dca.trace (dcail AA) w (map dca.initial AA)) =
-        dca.trace (AA ! k) w (map dca.initial AA ! k)" using 3(2) by (fastforce intro: dcail_trace_smap)
-      also have "\<dots> = dca.trace A w (dca.initial A)" using 3 by auto
-      finally show "fins (dca.rejecting A) (DCA.trace A w (dca.initial A))" by simp
-    qed
-  next
-    fix w
-    assume 1: "w \<in> \<Inter> (DCA.language `set AA)"
-    have 2: "dca.run A w (dca.initial A)" "fins (dca.rejecting A) (dca.trace A w (dca.initial A))"
-      if "A \<in> set AA" for A using 1 that by auto
-    have 3: "fins (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k)) (dca.trace (dcail AA) w (map dca.initial AA))"
-      if "k < length AA" for k
-    proof -
-      have "True \<longleftrightarrow> fins (dca.rejecting (AA ! k)) (dca.trace (AA ! k) w (map dca.initial AA ! k))"
-        using 2(2) that by auto
-      also have "dca.trace (AA ! k) w (map dca.initial AA ! k) =
-        smap (\<lambda> pp. pp ! k) (dca.trace (dcail AA) w (map dca.initial AA))"
-        using that by (fastforce intro: dcail_trace_smap[symmetric])
-      also have "infs (dca.rejecting (AA ! k)) \<dots> \<longleftrightarrow> infs (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k))
-        (dca.trace (dcail AA) w (map dca.initial AA))" by (simp add: comp_def)
-      finally show ?thesis by simp
-    qed
-    show "w \<in> DCA.language (dcail AA)"
-    proof
-      show "dca.run (dcail AA) w (dca.initial (dcail AA))"
-        using 2(1) unfolding DCA.run_alt_def dcail_def by auto
-      show "fins (dca.rejecting (dcail AA)) (dca.trace (dcail AA) w (dca.initial (dcail AA)))"
-        using 3 unfolding dcail_def by auto
-    qed
-  qed
-
-  definition dcgaul :: "('label, 'state) dca list \<Rightarrow> ('label, 'state list) dgca" where
-    "dcgaul AA \<equiv> dgca
-      (\<Union> (dca.alphabet ` set AA))
-      (map dca.initial AA)
-      (\<lambda> a pp. map2 (\<lambda> A p. dca.transition A a p) AA pp)
-      (map (\<lambda> k pp. dca.rejecting (AA ! k) (pp ! k)) [0 ..< length AA])"
-
-  lemma dcgaul_trace_smap:
-    assumes "length pp = length AA" "k < length AA"
-    shows "smap (\<lambda> pp. pp ! k) (dgca.trace (dcgaul AA) w pp) = dca.trace (AA ! k) w (pp ! k)"
-    using assms unfolding dcgaul_def by (coinduction arbitrary: w pp) (force)
-  lemma dcgaul_nodes_length:
-    assumes "pp \<in> DGCA.nodes (dcgaul AA)"
-    shows "length pp = length AA"
-    using assms unfolding dcgaul_def by induct auto
-  lemma dcgaul_nodes[intro]:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    assumes "pp \<in> DGCA.nodes (dcgaul AA)" "k < length pp"
-    shows "pp ! k \<in> DCA.nodes (AA ! k)"
-    using assms(2, 3, 1) unfolding dcgaul_def by induct force+
+  lemmas degeneralize_language[simp] = degeneralization.degeneralize_language[folded DCA.language_def]
+  lemmas degeneralize_nodes_finite[iff] = degeneralization.degeneralize_nodes_finite[folded DCA.nodes_def]
+  lemmas degeneralize_nodes_card = degeneralization.degeneralize_nodes_card[folded DCA.nodes_def]
 
-  lemma dcgaul_nodes_finite[intro]:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "finite (DGCA.nodes (dcgaul AA))"
-  proof (rule finite_subset)
-    show "DGCA.nodes (dcgaul AA) \<subseteq> listset (map DCA.nodes AA)"
-      using assms(1) by (force simp: listset_member list_all2_conv_all_nth dcgaul_nodes_length)
-    have "finite (listset (map DCA.nodes AA)) \<longleftrightarrow> list_all finite (map DCA.nodes AA)"
-      by (rule listset_finite) (auto simp: list_all_iff)
-    then show "finite (listset (map DCA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-  qed
-  lemma dcgaul_nodes_card:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "card (DGCA.nodes (dcgaul AA)) \<le> prod_list (map (card \<circ> DCA.nodes) AA)"
-  proof -
-    have "card (DGCA.nodes (dcgaul AA)) \<le> card (listset (map DCA.nodes AA))"
-    proof (rule card_mono)
-      have "finite (listset (map DCA.nodes AA)) \<longleftrightarrow> list_all finite (map DCA.nodes AA)"
-        by (rule listset_finite) (auto simp: list_all_iff)
-      then show "finite (listset (map DCA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-      show "DGCA.nodes (dcgaul AA) \<subseteq> listset (map DCA.nodes AA)"
-        using assms(1) by (force simp: listset_member list_all2_conv_all_nth dcgaul_nodes_length)
-    qed
-    also have "\<dots> = prod_list (map (card \<circ> DCA.nodes) AA)" by simp
-    finally show ?thesis by this
-  qed
+  global_interpretation intersection: automaton_intersection_trace
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    "\<lambda> c\<^sub>1 c\<^sub>2 pq. (c\<^sub>1 \<circ> fst) pq \<or> (c\<^sub>2 \<circ> snd) pq"
+    defines intersect = intersection.combine
+    by (unfold_locales) (simp del: comp_apply)
 
-  lemma dcgaul_language[simp]:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    shows "DGCA.language (dcgaul AA) = \<Union> (DCA.language ` set AA)"
-  proof safe
-    fix w
-    assume 1: "w \<in> DGCA.language (dcgaul AA)"
-    obtain k where 2:
-      "dgca.run (dcgaul AA) w (dgca.initial (dcgaul AA))"
-      "k < length AA"
-      "fins (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k)) (dgca.trace (dcgaul AA) w (dgca.initial (dcgaul AA)))"
-      using 1 unfolding dcgaul_def by force
-    show "w \<in> \<Union> (DCA.language ` set AA)"
-    proof (intro UN_I DCA.language)
-      show "AA ! k \<in> set AA" using 2(2) by simp
-      show "dca.run (AA ! k) w (dca.initial (AA ! k))"
-        using assms 2(1, 2) unfolding DCA.run_alt_def DGCA.run_alt_def dcgaul_def by force
-      have "True \<longleftrightarrow> fins (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k))
-        (dgca.trace (dcgaul AA) w (map dca.initial AA))" using 2(3) unfolding dcgaul_def by auto
-      also have "\<dots> \<longleftrightarrow> fins (dca.rejecting (AA ! k))
-        (smap (\<lambda> pp. pp ! k) (dgca.trace (dcgaul AA) w (map dca.initial AA)))" by (simp add: comp_def)
-      also have "smap (\<lambda> pp. pp ! k) (dgca.trace (dcgaul AA) w (map dca.initial AA)) =
-        dca.trace (AA ! k) w (map dca.initial AA ! k)" using 2(2) by (fastforce intro: dcgaul_trace_smap)
-      also have "\<dots> = dca.trace (AA ! k) w (dca.initial (AA ! k))" using 2(2) by auto
-      finally show "fins (dca.rejecting (AA ! k)) (dca.trace (AA ! k) w (dca.initial (AA ! k)))" by simp
-    qed
-  next
-    fix A w
-    assume 1: "A \<in> set AA" "w \<in> DCA.language A"
-    obtain 2: "dca.run A w (dca.initial A)" "fins (dca.rejecting A) (dca.trace A w (dca.initial A))"
-      using 1(2) by rule
-    obtain k where 3: "A = AA ! k" "k < length AA" using 1(1) unfolding in_set_conv_nth by auto
-    show "w \<in> DGCA.language (dcgaul AA)"
-    proof (intro DGCA.language bexI cogen)
-      show "dgca.run (dcgaul AA) w (dgca.initial (dcgaul AA))"
-        using 1(1) 2(1) unfolding DCA.run_alt_def DGCA.run_alt_def dcgaul_def by auto
-      have "True \<longleftrightarrow> fins (dca.rejecting (AA ! k)) (dca.trace (AA ! k) w (map dca.initial AA ! k))"
-        using 2(2) 3 by auto
-      also have "dca.trace (AA ! k) w (map dca.initial AA ! k) =
-        smap (\<lambda> pp. pp ! k) (dgca.trace (dcgaul AA) w (map dca.initial AA))"
-        using 3(2) by (fastforce intro: dcgaul_trace_smap[symmetric])
-      also have "fins (dca.rejecting (AA ! k)) \<dots> \<longleftrightarrow> fins (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k))
-        (dgca.trace (dcgaul AA) w (map dca.initial AA))" by (simp add: comp_def)
-      also have "map dca.initial AA = dgca.initial (dcgaul AA)" unfolding dcgaul_def by simp
-      finally show "fins (\<lambda> pp. dca.rejecting (AA ! k) (pp ! k)) (dgca.trace (dcgaul AA) w (dgca.initial (dcgaul AA)))"
-        by simp
-      show "(\<lambda> pp. dca.rejecting (AA ! k) (pp ! k)) \<in> set (dgca.rejecting (dcgaul AA))"
-        unfolding dcgaul_def using 3(2) by simp
-    qed
-  qed
+  lemmas intersect_language = intersection.combine_language
+  lemmas intersect_nodes_finite = intersection.combine_nodes_finite
+  lemmas intersect_nodes_card = intersection.combine_nodes_card
 
-  definition dcaul :: "('label, 'state) dca list \<Rightarrow> ('label, 'state list degen) dca" where
-    "dcaul = dgcad \<circ> dcgaul"
+  global_interpretation union: automaton_union_trace
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dgca.dgca dgca.alphabet dgca.initial dgca.transition dgca.rejecting "cogen fins"
+    "\<lambda> c\<^sub>1 c\<^sub>2. [c\<^sub>1 \<circ> fst, c\<^sub>2 \<circ> snd]"
+    defines union' = union.combine
+    by unfold_locales auto
 
-  lemma dcaul_nodes_finite[intro]:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "finite (DCA.nodes (dcaul AA))"
-    using dcgaul_nodes_finite assms unfolding dcaul_def by auto
-  lemma dcaul_nodes_card:
-    assumes "\<Inter> (dca.alphabet ` set AA)  = \<Union> (dca.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DCA.nodes) AA"
-    shows "card (DCA.nodes (dcaul AA)) \<le> max 1 (length AA) * prod_list (map (card \<circ> DCA.nodes) AA)"
+  lemmas union'_language[simp] = union.combine_language[folded DGCA.language_def]
+  lemmas union'_nodes_finite = union.combine_nodes_finite[folded DGCA.nodes_def]
+  lemmas union'_nodes_card = union.combine_nodes_card[folded DGCA.nodes_def]
+
+  global_interpretation intersection_list: automaton_intersection_list_trace
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    "\<lambda> cs pp. \<exists> k < length cs. (cs ! k) (pp ! k)"
+    defines intersect_list = intersection_list.combine
+    by (unfold_locales) (simp add: comp_def)
+
+  lemmas intersect_list_language = intersection_list.combine_language
+  lemmas intersect_list_nodes_finite = intersection_list.combine_nodes_finite
+  lemmas intersect_list_nodes_card = intersection_list.combine_nodes_card
+
+  global_interpretation union_list: automaton_union_list_trace
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dgca.dgca dgca.alphabet dgca.initial dgca.transition dgca.rejecting "cogen fins"
+    "\<lambda> cs. map (\<lambda> k pp. (cs ! k) (pp ! k)) [0 ..< length cs]"
+    defines union_list' = union_list.combine
+    by (unfold_locales) (auto simp: cogen_def comp_def)
+
+  lemmas union_list'_language[simp] = union_list.combine_language[folded DGCA.language_def]
+  lemmas union_list'_nodes_finite = union_list.combine_nodes_finite[folded DGCA.nodes_def]
+  lemmas union_list'_nodes_card = union_list.combine_nodes_card[folded DGCA.nodes_def]
+
+  abbreviation union where "union A B \<equiv> degeneralize (union' A B)"
+
+  lemma union_language[simp]:
+    assumes "dca.alphabet A = dca.alphabet B"
+    shows "DCA.language (union A B) = DCA.language A \<union> DCA.language B"
+    using assms by simp
+  lemma union_nodes_finite:
+    assumes "finite (DCA.nodes A)" "finite (DCA.nodes B)"
+    shows "finite (DCA.nodes (union A B))"
+    using union'_nodes_finite assms by simp
+  lemma union_nodes_card:
+    assumes "finite (DCA.nodes A)" "finite (DCA.nodes B)"
+    shows "card (DCA.nodes (union A B)) \<le> 2 * card (DCA.nodes A) * card (DCA.nodes B)"
   proof -
-    have "card (DCA.nodes (dcaul AA)) \<le>
-      max 1 (length (dgca.rejecting (dcgaul AA))) * card (DGCA.nodes (dcgaul AA))"
-      unfolding dcaul_def using dgcad_nodes_card by simp
-    also have "length (dgca.rejecting (dcgaul AA)) = length AA" unfolding dcgaul_def by simp
-    also have "card (DGCA.nodes (dcgaul AA)) \<le> prod_list (map (card \<circ> DCA.nodes) AA)"
-      using dcgaul_nodes_card assms by this
+    have "card (DCA.nodes (union A B)) \<le>
+      max 1 (length (dgca.rejecting (union' A B))) * card (DGCA.nodes (union' A B))"
+      using degeneralize_nodes_card by this
+    also have "length (dgca.rejecting (union' A B)) = 2" by simp
+    also have "card (DGCA.nodes (union' A B)) \<le> card (DCA.nodes A) * card (DCA.nodes B)"
+      using union'_nodes_card assms by this
     finally show ?thesis by simp
   qed
 
-  lemma dcaul_language[simp]:
+  abbreviation union_list where "union_list AA \<equiv> degeneralize (union_list' AA)"
+
+  lemma union_list_language[simp]:
     assumes "\<Inter> (dca.alphabet ` set AA) = \<Union> (dca.alphabet ` set AA)"
-    shows "DCA.language (dcaul AA) = \<Union> (DCA.language ` set AA)"
-    unfolding dcaul_def using dgcad_language dcgaul_language[OF assms] by auto
+    shows "DCA.language (union_list AA) = \<Union> (DCA.language ` set AA)"
+    using assms by simp
+  lemma union_list_nodes_finite:
+    assumes "list_all (finite \<circ> DCA.nodes) AA"
+    shows "finite (DCA.nodes (union_list AA))"
+    using union_list'_nodes_finite assms by simp
+  lemma union_list_nodes_card:
+    assumes "list_all (finite \<circ> DCA.nodes) AA"
+    shows "card (DCA.nodes (union_list AA)) \<le> max 1 (length AA) * prod_list (map (card \<circ> DCA.nodes) AA)"
+  proof -
+    have "card (DCA.nodes (union_list AA)) \<le>
+      max 1 (length (dgca.rejecting (union_list' AA))) * card (DGCA.nodes (union_list' AA))"
+      using degeneralize_nodes_card by this
+    also have "length (dgca.rejecting (union_list' AA)) = length AA" by simp
+    also have "card (DGCA.nodes (union_list' AA)) \<le> prod_list (map (card \<circ> DCA.nodes) AA)"
+      using union_list'_nodes_card assms by this
+    finally show ?thesis by simp
+  qed
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DCA/DGCA.thy b/thys/Transition_Systems_and_Automata/Automata/DCA/DGCA.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DCA/DGCA.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DCA/DGCA.thy
@@ -1,146 +1,25 @@
 section \<open>Deterministic Co-Generalized Co-Büchi Automata\<close>
 
 theory DGCA
-imports
-  "DCA"
-  "../../Basic/Degeneralization"
+imports "../Deterministic"
 begin
 
   datatype ('label, 'state) dgca = dgca
     (alphabet: "'label set")
     (initial: "'state")
     (transition: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
     (rejecting: "'state pred gen")
 
-  global_interpretation dgca: transition_system_initial
-    "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
-    for A
-    defines path = dgca.path and run = dgca.run and reachable = dgca.reachable and nodes = dgca.nodes and
-      enableds = dgca.enableds and paths = dgca.paths and runs = dgca.runs
-    by this
+  global_interpretation dgca: automaton dgca alphabet initial transition rejecting
+    defines path = dgca.path and run = dgca.run and reachable = dgca.reachable and nodes = dgca.nodes
+    by unfold_locales auto
+  global_interpretation dgca: automaton_trace dgca alphabet initial transition rejecting "cogen fins"
+    defines language = dgca.language
+    by standard
 
   abbreviation target where "target \<equiv> dgca.target"
   abbreviation states where "states \<equiv> dgca.states"
   abbreviation trace where "trace \<equiv> dgca.trace"
-
-  abbreviation successors :: "('label, 'state) dgca \<Rightarrow> 'state \<Rightarrow> 'state set" where
-    "successors \<equiv> dgca.successors TYPE('label)"
-
-  lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
-  unfolding lists_iff_set[symmetric]
-  proof
-    show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
-    show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
-  qed
-  lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
-  unfolding streams_iff_sset[symmetric]
-  proof
-    show "w \<in> streams (alphabet A)" if "run A w p"
-      using that by (coinduction arbitrary: w p) (force elim: dgca.run.cases)
-    show "run A w p" if "w \<in> streams (alphabet A)"
-      using that by (coinduction arbitrary: w p) (force elim: streams.cases)
-  qed
-
-  definition language :: "('label, 'state) dgca \<Rightarrow> 'label stream set" where
-    "language A \<equiv> {w. run A w (initial A) \<and> cogen fins (rejecting A) (trace A w (initial A))}"
-
-  lemma language[intro]:
-    assumes "run A w (initial A)" "cogen fins (rejecting A) (trace A w (initial A))"
-    shows "w \<in> language A"
-    using assms unfolding language_def by auto
-  lemma language_elim[elim]:
-    assumes "w \<in> language A"
-    obtains "run A w (initial A)" "cogen fins (rejecting A) (trace A w (initial A))"
-    using assms unfolding language_def by auto
-
-  lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
-    unfolding language_def run_alt_def using sset_streams by auto
-
-  definition dgcad :: "('label, 'state) dgca \<Rightarrow> ('label, 'state degen) dca" where
-    "dgcad A \<equiv> dca
-      (alphabet A)
-      (initial A, 0)
-      (\<lambda> a (p, k). (transition A a p, count (rejecting A) p k))
-      (degen (rejecting A))"
-
-  lemma dgcad_simps[simp]:
-    "dca.alphabet (dgcad A) = alphabet A"
-    "dca.initial (dgcad A) = (initial A, 0)"
-    "dca.transition (dgcad A) a (p, k) = (transition A a p, count (rejecting A) p k)"
-    "dca.rejecting (dgcad A) = degen (rejecting A)"
-    unfolding dgcad_def by auto
-
-  lemma dgcad_target[simp]: "dca.target (dgcad A) w (p, k) =
-    (dgca.target A w p, fold (count (rejecting A)) (butlast (p # dgca.states A w p)) k)"
-    by (induct w arbitrary: p k) (auto)
-  lemma dgcad_states[simp]: "dca.states (dgcad A) w (p, k) =
-    dgca.states A w p || scan (count (rejecting A)) (p # dgca.states A w p) k"
-    by (induct w arbitrary: p k) (auto)
-  lemma dgcad_trace[simp]: "dca.trace (dgcad A) w (p, k) =
-    dgca.trace A w p ||| sscan (count (rejecting A)) (p ## dgca.trace A w p) k"
-    by (coinduction arbitrary: w p k) (auto)
-  lemma dgcad_path[iff]: "dca.path (dgcad A) w (p, k) \<longleftrightarrow> dgca.path A w p"
-    unfolding DCA.path_alt_def DGCA.path_alt_def by simp
-  lemma dgcad_run[iff]: "dca.run (dgcad A) w (p, k) \<longleftrightarrow> dgca.run A w p"
-    unfolding DCA.run_alt_def DGCA.run_alt_def by simp
-
-  (* TODO: revise *)
-  lemma dgcad_nodes_fst[simp]: "fst ` DCA.nodes (dgcad A) = DGCA.nodes A"
-    unfolding dca.nodes_alt_def dca.reachable_alt_def
-    unfolding dgca.nodes_alt_def dgca.reachable_alt_def
-    unfolding image_def by simp
-  lemma dgcad_nodes_snd_empty:
-    assumes "rejecting A = []"
-    shows "snd ` DCA.nodes (dgcad A) \<subseteq> {0}"
-  proof -
-    have 2: "snd (dca.transition (dgcad A) a (p, k)) = 0" for a p k using assms by auto
-    show ?thesis using 2 by (auto elim: dca.nodes.cases)
-  qed
-  lemma dgcad_nodes_snd_nonempty:
-    assumes "rejecting A \<noteq> []"
-    shows "snd ` DCA.nodes (dgcad A) \<subseteq> {0 ..< length (rejecting A)}"
-  proof -
-    have 1: "snd (dca.initial (dgcad A)) < length (rejecting A)"
-      using assms by simp
-    have 2: "snd (dca.transition (dgcad A) a (p, k)) < length (rejecting A)" for a p k
-      using assms by auto
-    show ?thesis using 1 2 by (auto elim: dca.nodes.cases)
-  qed
-  lemma dgcad_nodes_empty:
-    assumes "rejecting A = []"
-    shows "DCA.nodes (dgcad A) = DGCA.nodes A \<times> {0}"
-  proof -
-    have "(p, k) \<in> DCA.nodes (dgcad A) \<longleftrightarrow> p \<in> fst ` DCA.nodes (dgcad A) \<and> k = 0" for p k
-      using dgcad_nodes_snd_empty[OF assms] by (force simp del: dgcad_nodes_fst)
-    then show ?thesis by auto
-  qed
-  lemma dgcad_nodes_nonempty:
-    assumes "rejecting A \<noteq> []"
-    shows "DCA.nodes (dgcad A) \<subseteq> DGCA.nodes A \<times> {0 ..< length (rejecting A)}"
-    using subset_fst_snd dgcad_nodes_fst[of A] dgcad_nodes_snd_nonempty[OF assms] by blast
-  lemma dgcad_nodes: "DCA.nodes (dgcad A) \<subseteq> DGCA.nodes A \<times> {0 ..< max 1 (length (rejecting A))}"
-    using dgcad_nodes_empty dgcad_nodes_nonempty by force
-
-  lemma dgcad_language[simp]: "DCA.language (dgcad A) = DGCA.language A" by force
-
-  lemma dgcad_nodes_finite[iff]: "finite (DCA.nodes (dgcad A)) \<longleftrightarrow> finite (DGCA.nodes A)"
-  proof
-    show "finite (DGCA.nodes A)" if "finite (DCA.nodes (dgcad A))"
-      using that by (auto simp flip: dgcad_nodes_fst)
-    show "finite (DCA.nodes (dgcad A))" if "finite (DGCA.nodes A)"
-      using dgcad_nodes that finite_subset by fastforce
-  qed
-  lemma dgcad_nodes_card: "card (DCA.nodes (dgcad A)) \<le> max 1 (length (rejecting A)) * card (DGCA.nodes A)"
-  proof (cases "finite (DGCA.nodes A)")
-    case True
-    have "card (DCA.nodes (dgcad A)) \<le> card (DGCA.nodes A \<times> {0 ..< max 1 (length (rejecting A))})"
-      using dgcad_nodes True by (blast intro: card_mono)
-    also have "\<dots> = max 1 (length (rejecting A)) * card (DGCA.nodes A)" unfolding card_cartesian_product by simp
-    finally show ?thesis by this
-  next
-    case False
-    then have "card (DGCA.nodes A) = 0" "card (DCA.nodes (dgcad A)) = 0" by auto
-    then show ?thesis by simp
-  qed
+  abbreviation successors where "successors \<equiv> dgca.successors TYPE('label)"
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA.thy
@@ -1,62 +1,25 @@
 section \<open>Deterministic Rabin Automata\<close>
 
 theory DRA
-imports
-  "../../Basic/Sequence_Zip"
-  "../../Basic/Acceptance"
-  "../../Transition_Systems/Transition_System"
-  "../../Transition_Systems/Transition_System_Extra"
-  "../../Transition_Systems/Transition_System_Construction"
+imports "../Deterministic"
 begin
 
   datatype ('label, 'state) dra = dra
     (alphabet: "'label set")
     (initial: "'state")
     (transition: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
-    (accepting: "'state rabin gen")
+    (condition: "'state rabin gen")
 
-  global_interpretation dra: transition_system_initial
-    "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
-    for A
-    defines path = dra.path and run = dra.run and reachable = dra.reachable and nodes = dra.nodes and
-      enableds = dra.enableds and paths = dra.paths and runs = dra.runs
-    by this
+  global_interpretation dra: automaton dra alphabet initial transition condition
+    defines path = dra.path and run = dra.run and reachable = dra.reachable and nodes = dra.nodes
+    by unfold_locales auto
+  global_interpretation dra: automaton_trace dra alphabet initial transition condition "cogen rabin"
+    defines language = dra.language
+    by standard
 
   abbreviation target where "target \<equiv> dra.target"
   abbreviation states where "states \<equiv> dra.states"
   abbreviation trace where "trace \<equiv> dra.trace"
-
-  abbreviation successors :: "('label, 'state) dra \<Rightarrow> 'state \<Rightarrow> 'state set" where
-    "successors \<equiv> dra.successors TYPE('label)"
-
-  lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
-  unfolding lists_iff_set[symmetric]
-  proof
-    show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
-    show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
-  qed
-  lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
-  unfolding streams_iff_sset[symmetric]
-  proof
-    show "w \<in> streams (alphabet A)" if "run A w p"
-      using that by (coinduction arbitrary: w p) (force elim: dra.run.cases)
-    show "run A w p" if "w \<in> streams (alphabet A)"
-      using that by (coinduction arbitrary: w p) (force elim: streams.cases)
-  qed
-
-  definition language :: "('label, 'state) dra \<Rightarrow> 'label stream set" where
-    "language A \<equiv> {w. run A w (initial A) \<and> cogen rabin (accepting A) (trace A w (initial A))}"
-
-  lemma language[intro]:
-    assumes "run A w (initial A)" "cogen rabin (accepting A) (trace A w (initial A))"
-    shows "w \<in> language A"
-    using assms unfolding language_def by auto
-  lemma language_elim[elim]:
-    assumes "w \<in> language A"
-    obtains "run A w (initial A)" "cogen rabin (accepting A) (trace A w (initial A))"
-    using assms unfolding language_def by auto
-
-  lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
-    unfolding language_def run_alt_def using sset_streams by auto
+  abbreviation successors where "successors \<equiv> dra.successors TYPE('label)"
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Combine.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Combine.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Combine.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Combine.thy
@@ -1,223 +1,33 @@
 section \<open>Deterministic Rabin Automata Combinations\<close>
 
 theory DRA_Combine
 imports "DRA" "../DBA/DBA" "../DCA/DCA"
 begin
 
-  definition from_dba :: "('label, 'state) dba \<Rightarrow> ('label, 'state) dra" where
-    "from_dba A \<equiv> dra (dba.alphabet A) (dba.initial A) (dba.transition A) [(dba.accepting A, bot)]"
-
-  lemma from_dba_language[simp]: "DRA.language (from_dba A) = DBA.language A"
-    unfolding DBA.language_def DRA.language_def from_dba_def DBA.run_def DRA.run_def by (auto 0 3)
-
-  definition from_dca :: "('label, 'state) dca \<Rightarrow> ('label, 'state) dra" where
-    "from_dca A \<equiv> dra (dca.alphabet A) (dca.initial A) (dca.transition A) [(top, dca.rejecting A)]"
-
-  lemma from_dca_language[simp]: "DRA.language (from_dca A) = DCA.language A"
-    unfolding DCA.language_def DRA.language_def from_dca_def DCA.run_def DRA.run_def by (auto 0 3)
-
-  definition dbcrai :: "('label, 'state\<^sub>1) dba \<Rightarrow> ('label, 'state\<^sub>2) dca \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) dra" where
-    "dbcrai A B \<equiv> dra
-      (dba.alphabet A \<inter> dca.alphabet B)
-      (dba.initial A, dca.initial B)
-      (\<lambda> a (p, q). (dba.transition A a p, dca.transition B a q))
-      [(dba.accepting A \<circ> fst, dca.rejecting B \<circ> snd)]"
-
-  lemma dbcrai_fst[iff]: "infs (P \<circ> fst) (dra.trace (dbcrai A B) w (p, q)) \<longleftrightarrow> infs P (dba.trace A w p)"
-  proof -
-    let ?t = "dra.trace (dbcrai A B) w (p, q)"
-    have "infs (P \<circ> fst) ?t \<longleftrightarrow> infs P (smap fst ?t)" by (simp add: comp_def)
-    also have "smap fst ?t = dba.trace A w p" unfolding dbcrai_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dbcrai_snd[iff]: "infs (P \<circ> snd) (dra.trace (dbcrai A B) w (p, q)) \<longleftrightarrow> infs P (dca.trace B w q)"
-  proof -
-    let ?t = "dra.trace (dbcrai A B) w (p, q)"
-    have "infs (P \<circ> snd) ?t \<longleftrightarrow> infs P (smap snd ?t)" by (simp add: comp_def)
-    also have "smap snd ?t = dca.trace B w q" unfolding dbcrai_def by (coinduction arbitrary: w p q) (auto)
-    finally show ?thesis by this
-  qed
-  lemma dbcrai_nodes_fst[intro]: "fst ` DRA.nodes (dbcrai A B) \<subseteq> DBA.nodes A"
-  proof (rule subsetI, erule imageE)
-    fix pq p
-    assume "pq \<in> DRA.nodes (dbcrai A B)" "p = fst pq"
-    then show "p \<in> DBA.nodes A" unfolding dbcrai_def by (induct arbitrary: p) (auto)
-  qed
-  lemma dbcrai_nodes_snd[intro]: "snd ` DRA.nodes (dbcrai A B) \<subseteq> DCA.nodes B"
-  proof (rule subsetI, erule imageE)
-    fix pq q
-    assume "pq \<in> DRA.nodes (dbcrai A B)" "q = snd pq"
-    then show "q \<in> DCA.nodes B" unfolding dbcrai_def by (induct arbitrary: q) (auto)
-  qed
-
-  lemma dbcrai_nodes_finite[intro]:
-    assumes "finite (DBA.nodes A)" "finite (DCA.nodes B)"
-    shows "finite (DRA.nodes (dbcrai A B))"
-  proof (rule finite_subset)
-    show "DRA.nodes (dbcrai A B) \<subseteq> DBA.nodes A \<times> DCA.nodes B"
-      using dbcrai_nodes_fst dbcrai_nodes_snd unfolding image_subset_iff by force
-    show "finite (DBA.nodes A \<times> DCA.nodes B)" using assms by simp
-  qed
-  lemma dbcrai_nodes_card[intro]:
-    assumes "finite (DBA.nodes A)" "finite (DCA.nodes B)"
-    shows "card (DRA.nodes (dbcrai A B)) \<le> card (DBA.nodes A) * card (DCA.nodes B)"
-  proof -
-    have "card (DRA.nodes (dbcrai A B)) \<le> card (DBA.nodes A \<times> DCA.nodes B)"
-    proof (rule card_mono)
-      show "finite (DBA.nodes A \<times> DCA.nodes B)" using assms by simp
-      show "DRA.nodes (dbcrai A B) \<subseteq> DBA.nodes A \<times> DCA.nodes B"
-        using dbcrai_nodes_fst dbcrai_nodes_snd unfolding image_subset_iff by force
-    qed
-    also have "\<dots> = card (DBA.nodes A) * card (DCA.nodes B)" using card_cartesian_product by this
-    finally show ?thesis by this
-  qed
-
-  lemma dbcrai_language[simp]: "DRA.language (dbcrai A B) = DBA.language A \<inter> DCA.language B"
-  proof -
-    have 1: "dra.alphabet (dbcrai A B) = dba.alphabet A \<inter> dca.alphabet B" unfolding dbcrai_def by simp
-    have 2: "dra.initial (dbcrai A B) = (dba.initial A, dca.initial B)" unfolding dbcrai_def by simp
-    have 3: "dra.accepting (dbcrai A B) = [(dba.accepting A \<circ> fst, dca.rejecting B \<circ> snd)]"
-      unfolding dbcrai_def by simp
-    have 4: "cogen rabin (dra.accepting (dbcrai A B)) (DRA.trace (dbcrai A B) w (p, q)) \<longleftrightarrow>
-      infs (dba.accepting A) (DBA.trace A w p) \<and> fins (rejecting B) (DCA.trace B w q)" for w p q
-      unfolding cogen_def rabin_def 3 by simp
-    show ?thesis
-      unfolding DRA.language_def DBA.language_def DCA.language_def
-      unfolding DRA.run_alt_def DBA.run_alt_def DCA.run_alt_def
-      unfolding 1 2 4 by auto
-  qed
-
-  abbreviation (input) "get k pp \<equiv> pp ! k"
-
-  definition draul :: "('label, 'state) dra list \<Rightarrow> ('label, 'state list) dra" where
-    "draul AA \<equiv> dra
-      (\<Union> (dra.alphabet ` set AA))
-      (map dra.initial AA)
-      (\<lambda> a pp. map2 (\<lambda> A p. dra.transition A a p) AA pp)
-      (do { k \<leftarrow> [0 ..< length AA]; (f, g) \<leftarrow> dra.accepting (AA ! k); [(f \<circ> get k, g \<circ> get k)] })"
+  global_interpretation intersection_bc: automaton_intersection_trace
+    dba.dba dba.alphabet dba.initial dba.transition dba.accepting infs
+    dca.dca dca.alphabet dca.initial dca.transition dca.rejecting fins
+    dra.dra dra.alphabet dra.initial dra.transition dra.condition "cogen rabin"
+    "\<lambda> c\<^sub>1 c\<^sub>2. [(c\<^sub>1 \<circ> fst, c\<^sub>2 \<circ> snd)]"
+    defines intersect_bc = intersection_bc.combine
+    by (unfold_locales) (simp add: cogen_def rabin_def)
 
-  lemma draul_get:
-    assumes "length pp = length AA" "k < length AA"
-    shows "infs (P \<circ> get k) (dra.trace (draul AA) w pp) \<longleftrightarrow>
-      infs P (dra.trace (AA ! k) w (pp ! k))"
-  proof -
-    have "infs (P \<circ> get k) (dra.trace (draul AA) w pp) \<longleftrightarrow>
-      infs P (smap (get k) (dra.trace (draul AA) w pp))" by (simp add: comp_def)
-    also have "smap (get k) (dra.trace (draul AA) w pp) = dra.trace (AA ! k) w (pp ! k)"
-      using assms unfolding draul_def by (coinduction arbitrary: w pp) (force)
-    finally show ?thesis by this
-  qed
-  lemma draul_nodes_length:
-    assumes "pp \<in> DRA.nodes (draul AA)"
-    shows "length pp = length AA"
-    using assms unfolding draul_def by induct auto
-  lemma draul_nodes[intro]:
-    assumes "\<Inter> (dra.alphabet ` set AA)  = \<Union> (dra.alphabet ` set AA)"
-    assumes "pp \<in> DRA.nodes (draul AA)" "k < length pp"
-    shows "pp ! k \<in> DRA.nodes (AA ! k)"
-    using assms(2, 3, 1) unfolding draul_def by induct force+
-
-  lemma draul_nodes_finite[intro]:
-    assumes "\<Inter> (dra.alphabet ` set AA)  = \<Union> (dra.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DRA.nodes) AA"
-    shows "finite (DRA.nodes (draul AA))"
-  proof (rule finite_subset)
-    show "DRA.nodes (draul AA) \<subseteq> listset (map DRA.nodes AA)"
-      using assms(1) by (force simp: listset_member list_all2_conv_all_nth draul_nodes_length)
-    have "finite (listset (map DRA.nodes AA)) \<longleftrightarrow> list_all finite (map DRA.nodes AA)"
-      by (rule listset_finite) (auto simp: list_all_iff)
-    then show "finite (listset (map DRA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-  qed
-  lemma draul_nodes_card:
-    assumes "\<Inter> (dra.alphabet ` set AA)  = \<Union> (dra.alphabet ` set AA)"
-    assumes "list_all (finite \<circ> DRA.nodes) AA"
-    shows "card (DRA.nodes (draul AA)) \<le> prod_list (map (card \<circ> DRA.nodes) AA)"
-  proof -
-    have "card (DRA.nodes (draul AA)) \<le> card (listset (map DRA.nodes AA))"
-    proof (rule card_mono)
-      have "finite (listset (map DRA.nodes AA)) \<longleftrightarrow> list_all finite (map DRA.nodes AA)"
-        by (rule listset_finite) (auto simp: list_all_iff)
-      then show "finite (listset (map DRA.nodes AA))" using assms(2) by (simp add: list.pred_map)
-      show "DRA.nodes (draul AA) \<subseteq> listset (map DRA.nodes AA)"
-        using assms(1) by (force simp: listset_member list_all2_conv_all_nth draul_nodes_length)
-    qed
-    also have "\<dots> = prod_list (map (card \<circ> DRA.nodes) AA)" by simp
-    finally show ?thesis by this
-  qed
+  (* TODO: why are only the constants of the first interpretation folded back correctly? *)
+  lemmas intersect_bc_language[simp] = intersection_bc.combine_language[folded DCA.language_def DRA.language_def]
+  lemmas intersect_bc_nodes_finite = intersection_bc.combine_nodes_finite[folded DCA.nodes_def DRA.nodes_def]
+  lemmas intersect_bc_nodes_card = intersection_bc.combine_nodes_card[folded DCA.nodes_def DRA.nodes_def]
 
-  lemma draul_language[simp]:
-    assumes "\<Inter> (dra.alphabet ` set AA)  = \<Union> (dra.alphabet ` set AA)"
-    shows "DRA.language (draul AA) = \<Union> (DRA.language ` set AA)"
-  proof safe
-    fix w
-    assume 1: "w \<in> DRA.language (draul AA)"
-    obtain 2:
-      "dra.run (draul AA) w (dra.initial (draul AA))"
-      "cogen rabin (dra.accepting (draul AA)) (dra.trace (draul AA) w (dra.initial (draul AA)))"
-      using 1 by rule
-    obtain I F where 3:
-      "(I, F) \<in> set (dra.accepting (draul AA))"
-      "infs I (dra.trace (draul AA) w (dra.initial (draul AA)))"
-      "fins F (dra.trace (draul AA) w (dra.initial (draul AA)))"
-      using 2(2) by blast
-    obtain k P Q where 4:
-      "k < length AA" "I = P \<circ> get k" "F = Q \<circ> get k" "(P, Q) \<in> set (dra.accepting (AA ! k))"
-      using 3(1) unfolding draul_def List.bind_def by (auto simp: comp_def)
-    show "w \<in> \<Union> (DRA.language ` set AA)"
-    proof (intro UN_I DRA.language cogen rabin)
-      show "AA ! k \<in> set AA" using 4(1) by auto
-      show "DRA.run (AA ! k) w (dra.initial (AA ! k))"
-        using assms 2(1) 4(1) unfolding DRA.run_alt_def draul_def by force
-      show "(P, Q) \<in> set (dra.accepting (AA ! k))" using 4(4) by this
-      show "(P, Q) = (P, Q)" by rule
-      have "True \<longleftrightarrow> infs (P \<circ> get k) (dra.trace (draul AA) w (map dra.initial AA))"
-        using 3(2) unfolding draul_def 4(2) by simp
-      also have "\<dots> \<longleftrightarrow> infs P (dra.trace (AA ! k) w (map dra.initial AA ! k))"
-        using 4(1) by (force intro!: draul_get)
-      also have "map dra.initial AA ! k = dra.initial (AA ! k)" using 4(1) by simp
-      finally show "infs P (dra.trace (AA ! k) w (dra.initial (AA ! k)))" by simp
-      have "False \<longleftrightarrow> infs (Q \<circ> get k) (dra.trace (draul AA) w (map dra.initial AA))"
-        using 3(3) unfolding draul_def 4(3) by simp
-      also have "\<dots> \<longleftrightarrow> infs Q (dra.trace (AA ! k) w (map dra.initial AA ! k))"
-        using 4(1) by (force intro!: draul_get)
-      also have "map dra.initial AA ! k = dra.initial (AA ! k)" using 4(1) by simp
-      finally show "fins Q (dra.trace (AA ! k) w (dra.initial (AA ! k)))" by simp
-    qed
-  next
-    fix A w
-    assume 1: "A \<in> set AA" "w \<in> DRA.language A"
-    obtain 2:
-      "dra.run A w (dra.initial A)"
-      "cogen rabin (dra.accepting A) (dra.trace A w (dra.initial A))"
-      using 1(2) by rule
-    obtain I F where 3:
-      "(I, F) \<in> set (dra.accepting A)"
-      "infs I (dra.trace A w (dra.initial A))"
-      "fins F (dra.trace A w (dra.initial A))"
-      using 2(2) by blast
-    obtain k where 4: "A = AA ! k" "k < length AA" using 1(1) unfolding in_set_conv_nth by auto
-    show "w \<in> DRA.language (draul AA)"
-    proof (intro DRA.language cogen rabin)
-      show "dra.run (draul AA) w (dra.initial (draul AA))"
-        using 1(1) 2(1) unfolding DRA.run_alt_def draul_def by auto
-      show "(I \<circ> get k, F \<circ> get k) \<in> set (dra.accepting (draul AA))"
-        unfolding draul_def List.bind_def using 3(1) 4 by (force simp: comp_def)
-      show "(I \<circ> get k, F \<circ> get k) = (I \<circ> get k, F \<circ> get k)" by rule
-      have "infs (I \<circ> get k) (dra.trace (draul AA) w (dra.initial (draul AA))) \<longleftrightarrow>
-        infs (I \<circ> get k) (dra.trace (draul AA) w (map dra.initial AA))"
-        unfolding draul_def by simp
-      also have "\<dots> \<longleftrightarrow> infs I (dra.trace (AA ! k) w (map dra.initial AA ! k))"
-        using 4(2) by (force intro!: draul_get)
-      also have "\<dots> \<longleftrightarrow> True" using 3(2) 4 by simp
-      finally show "infs (I \<circ> get k) (dra.trace (draul AA) w (dra.initial (draul AA)))" by simp
-      have "infs (F \<circ> get k) (dra.trace (draul AA) w (dra.initial (draul AA))) \<longleftrightarrow>
-        infs (F \<circ> get k) (dra.trace (draul AA) w (map dra.initial AA))"
-        unfolding draul_def by simp
-      also have "\<dots> \<longleftrightarrow> infs F (dra.trace (AA ! k) w (map dra.initial AA ! k))"
-        using 4(2) by (force intro!: draul_get)
-      also have "\<dots> \<longleftrightarrow> False" using 3(3) 4 by simp
-      finally show "fins (F \<circ> get k) (dra.trace (draul AA) w (dra.initial (draul AA)))" by simp
-    qed
-  qed
+  (* TODO: are there some statements about the rabin constant hidden in here?
+    same for gen/cogen, also in other combinations, shouldn't have to unfold those *)
+  global_interpretation union_list: automaton_union_list_trace
+    dra.dra dra.alphabet dra.initial dra.transition dra.condition "cogen rabin"
+    dra.dra dra.alphabet dra.initial dra.transition dra.condition "cogen rabin"
+    "\<lambda> cs. do { k \<leftarrow> [0 ..< length cs]; (f, g) \<leftarrow> cs ! k; [(\<lambda> pp. f (pp ! k), \<lambda> pp. g (pp ! k))] }"
+    defines union_list = union_list.combine
+    by (unfold_locales) (auto simp: cogen_def rabin_def comp_def split_beta)
+
+  lemmas union_list_language = union_list.combine_language
+  lemmas union_list_nodes_finite = union_list.combine_nodes_finite
+  lemmas union_list_nodes_card = union_list.combine_nodes_card
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Explicit.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Explicit.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Explicit.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Explicit.thy
@@ -1,208 +1,208 @@
 section \<open>Explicit Deterministic Rabin Automata\<close>
 
 theory DRA_Explicit
 imports DRA_Nodes
 begin
 
   datatype ('label, 'state) drae = drae
     (alphabete: "'label set")
     (initiale: "'state")
     (transitione: "('state \<times> 'label \<times> 'state) set")
-    (acceptinge: "('state set \<times> 'state set) list")
+    (conditione: "('state set \<times> 'state set) list")
 
   definition drae_rel where
     [to_relAPP]: "drae_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabete A\<^sub>1, alphabete A\<^sub>2) \<in> \<langle>L\<rangle> set_rel \<and>
       (initiale A\<^sub>1, initiale A\<^sub>2) \<in> S \<and>
       (transitione A\<^sub>1, transitione A\<^sub>2) \<in> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> set_rel \<and>
-      (acceptinge A\<^sub>1, acceptinge A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> set_rel \<times>\<^sub>r \<langle>S\<rangle> set_rel\<rangle> list_rel}"
+      (conditione A\<^sub>1, conditione A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> set_rel \<times>\<^sub>r \<langle>S\<rangle> set_rel\<rangle> list_rel}"
 
   lemma drae_param[param, autoref_rules]:
     "(drae, drae) \<in> \<langle>L\<rangle> set_rel \<rightarrow> S \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> set_rel \<rightarrow>
       \<langle>\<langle>S\<rangle> set_rel \<times>\<^sub>r \<langle>S\<rangle> set_rel\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> drae_rel"
     "(alphabete, alphabete) \<in> \<langle>L, S\<rangle> drae_rel \<rightarrow> \<langle>L\<rangle> set_rel"
     "(initiale, initiale) \<in> \<langle>L, S\<rangle> drae_rel \<rightarrow> S"
     "(transitione, transitione) \<in> \<langle>L, S\<rangle> drae_rel \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> set_rel"
-    "(acceptinge, acceptinge) \<in> \<langle>L, S\<rangle> drae_rel \<rightarrow> \<langle>\<langle>S\<rangle> set_rel \<times>\<^sub>r \<langle>S\<rangle> set_rel\<rangle> list_rel"
+    "(conditione, conditione) \<in> \<langle>L, S\<rangle> drae_rel \<rightarrow> \<langle>\<langle>S\<rangle> set_rel \<times>\<^sub>r \<langle>S\<rangle> set_rel\<rangle> list_rel"
     unfolding drae_rel_def by auto
 
   lemma drae_rel_id[simp]: "\<langle>Id, Id\<rangle> drae_rel = Id" unfolding drae_rel_def using drae.expand by auto
   lemma drae_rel_comp[simp]: "\<langle>L\<^sub>1 O L\<^sub>2, S\<^sub>1 O S\<^sub>2\<rangle> drae_rel = \<langle>L\<^sub>1, S\<^sub>1\<rangle> drae_rel O \<langle>L\<^sub>2, S\<^sub>2\<rangle> drae_rel"
   proof safe
     fix A B
     assume 1: "(A, B) \<in> \<langle>L\<^sub>1 O L\<^sub>2, S\<^sub>1 O S\<^sub>2\<rangle> drae_rel"
     obtain a b c d where 2:
       "(alphabete A, a) \<in> \<langle>L\<^sub>1\<rangle> set_rel" "(a, alphabete B) \<in> \<langle>L\<^sub>2\<rangle> set_rel"
       "(initiale A, b) \<in> S\<^sub>1" "(b, initiale B) \<in> S\<^sub>2"
       "(transitione A, c) \<in> \<langle>S\<^sub>1 \<times>\<^sub>r L\<^sub>1 \<times>\<^sub>r S\<^sub>1\<rangle> set_rel" "(c, transitione B) \<in> \<langle>S\<^sub>2 \<times>\<^sub>r L\<^sub>2 \<times>\<^sub>r S\<^sub>2\<rangle> set_rel"
-      "(acceptinge A, d) \<in> \<langle>\<langle>S\<^sub>1\<rangle> set_rel \<times>\<^sub>r \<langle>S\<^sub>1\<rangle> set_rel\<rangle> list_rel"
-      "(d, acceptinge B) \<in> \<langle>\<langle>S\<^sub>2\<rangle> set_rel \<times>\<^sub>r \<langle>S\<^sub>2\<rangle> set_rel\<rangle> list_rel"
+      "(conditione A, d) \<in> \<langle>\<langle>S\<^sub>1\<rangle> set_rel \<times>\<^sub>r \<langle>S\<^sub>1\<rangle> set_rel\<rangle> list_rel"
+      "(d, conditione B) \<in> \<langle>\<langle>S\<^sub>2\<rangle> set_rel \<times>\<^sub>r \<langle>S\<^sub>2\<rangle> set_rel\<rangle> list_rel"
       using 1 unfolding drae_rel_def prod_rel_compp set_rel_compp by auto
     show "(A, B) \<in> \<langle>L\<^sub>1, S\<^sub>1\<rangle> drae_rel O \<langle>L\<^sub>2, S\<^sub>2\<rangle> drae_rel"
     proof
       show "(A, drae a b c d) \<in> \<langle>L\<^sub>1, S\<^sub>1\<rangle> drae_rel" using 2 unfolding drae_rel_def by auto
       show "(drae a b c d, B) \<in> \<langle>L\<^sub>2, S\<^sub>2\<rangle> drae_rel" using 2 unfolding drae_rel_def by auto
     qed
   next
     show "(A, C) \<in> \<langle>L\<^sub>1 O L\<^sub>2, S\<^sub>1 O S\<^sub>2\<rangle> drae_rel"
       if "(A, B) \<in> \<langle>L\<^sub>1, S\<^sub>1\<rangle> drae_rel" "(B, C) \<in> \<langle>L\<^sub>2, S\<^sub>2\<rangle> drae_rel" for A B C
       using that unfolding drae_rel_def prod_rel_compp set_rel_compp by auto
   qed
 
   (* TODO: why do we need all this setup? can't i_of_rel do the trick? *)
   consts i_drae_scheme :: "interface \<Rightarrow> interface \<Rightarrow> interface"
 
   context
   begin
 
     interpretation autoref_syn by this
 
     lemma drae_scheme_itype[autoref_itype]:
       "drae ::\<^sub>i \<langle>L\<rangle>\<^sub>i i_set \<rightarrow>\<^sub>i S \<rightarrow>\<^sub>i \<langle>\<langle>S, \<langle>L, S\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_set \<rightarrow>\<^sub>i
         \<langle>\<langle>\<langle>S\<rangle>\<^sub>i i_set, \<langle>S\<rangle>\<^sub>i i_set\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_list \<rightarrow>\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme"
       "alphabete ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme \<rightarrow>\<^sub>i \<langle>L\<rangle>\<^sub>i i_set"
       "initiale ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme \<rightarrow>\<^sub>i S"
       "transitione ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme \<rightarrow>\<^sub>i \<langle>\<langle>S, \<langle>L, S\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_set"
-      "acceptinge ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme \<rightarrow>\<^sub>i \<langle>\<langle>\<langle>S\<rangle>\<^sub>i i_set, \<langle>S\<rangle>\<^sub>i i_set\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_list"
+      "conditione ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_drae_scheme \<rightarrow>\<^sub>i \<langle>\<langle>\<langle>S\<rangle>\<^sub>i i_set, \<langle>S\<rangle>\<^sub>i i_set\<rangle>\<^sub>i i_prod\<rangle>\<^sub>i i_list"
       by auto
 
   end
 
   datatype ('label, 'state) draei = draei
     (alphabetei: "'label list")
     (initialei: "'state")
     (transitionei: "('state \<times> 'label \<times> 'state) list")
-    (acceptingei: "('state list \<times> 'state list) list")
+    (conditionei: "('state list \<times> 'state list) list")
 
   definition draei_rel where
     [to_relAPP]: "draei_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabetei A\<^sub>1, alphabetei A\<^sub>2) \<in> \<langle>L\<rangle> list_rel \<and>
       (initialei A\<^sub>1, initialei A\<^sub>2) \<in> S \<and>
       (transitionei A\<^sub>1, transitionei A\<^sub>2) \<in> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_rel \<and>
-      (acceptingei A\<^sub>1, acceptingei A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> list_rel \<times>\<^sub>r \<langle>S\<rangle> list_rel\<rangle> list_rel}"
+      (conditionei A\<^sub>1, conditionei A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> list_rel \<times>\<^sub>r \<langle>S\<rangle> list_rel\<rangle> list_rel}"
 
   lemma draei_param[param, autoref_rules]:
     "(draei, draei) \<in> \<langle>L\<rangle> list_rel \<rightarrow> S \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_rel \<rightarrow>
       \<langle>\<langle>S\<rangle> list_rel \<times>\<^sub>r \<langle>S\<rangle> list_rel\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> draei_rel"
     "(alphabetei, alphabetei) \<in> \<langle>L, S\<rangle> draei_rel \<rightarrow> \<langle>L\<rangle> list_rel"
     "(initialei, initialei) \<in> \<langle>L, S\<rangle> draei_rel \<rightarrow> S"
     "(transitionei, transitionei) \<in> \<langle>L, S\<rangle> draei_rel \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_rel"
-    "(acceptingei, acceptingei) \<in> \<langle>L, S\<rangle> draei_rel \<rightarrow> \<langle>\<langle>S\<rangle> list_rel \<times>\<^sub>r \<langle>S\<rangle> list_rel\<rangle> list_rel"
+    "(conditionei, conditionei) \<in> \<langle>L, S\<rangle> draei_rel \<rightarrow> \<langle>\<langle>S\<rangle> list_rel \<times>\<^sub>r \<langle>S\<rangle> list_rel\<rangle> list_rel"
     unfolding draei_rel_def by auto
 
   definition draei_drae_rel where
     [to_relAPP]: "draei_drae_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabetei A\<^sub>1, alphabete A\<^sub>2) \<in> \<langle>L\<rangle> list_set_rel \<and>
       (initialei A\<^sub>1, initiale A\<^sub>2) \<in> S \<and>
       (transitionei A\<^sub>1, transitione A\<^sub>2) \<in> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_set_rel \<and>
-      (acceptingei A\<^sub>1, acceptinge A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> list_set_rel \<times>\<^sub>r \<langle>S\<rangle> list_set_rel\<rangle> list_rel}"
+      (conditionei A\<^sub>1, conditione A\<^sub>2) \<in> \<langle>\<langle>S\<rangle> list_set_rel \<times>\<^sub>r \<langle>S\<rangle> list_set_rel\<rangle> list_rel}"
 
   lemmas [autoref_rel_intf] = REL_INTFI[of draei_drae_rel i_drae_scheme]
 
   lemma draei_drae_param[param, autoref_rules]:
     "(draei, drae) \<in> \<langle>L\<rangle> list_set_rel \<rightarrow> S \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_set_rel \<rightarrow>
       \<langle>\<langle>S\<rangle> list_set_rel \<times>\<^sub>r \<langle>S\<rangle> list_set_rel\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> draei_drae_rel"
     "(alphabetei, alphabete) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> \<langle>L\<rangle> list_set_rel"
     "(initialei, initiale) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> S"
     "(transitionei, transitione) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> list_set_rel"
-    "(acceptingei, acceptinge) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> \<langle>\<langle>S\<rangle> list_set_rel \<times>\<^sub>r \<langle>S\<rangle> list_set_rel\<rangle> list_rel"
+    "(conditionei, conditione) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> \<langle>\<langle>S\<rangle> list_set_rel \<times>\<^sub>r \<langle>S\<rangle> list_set_rel\<rangle> list_rel"
     unfolding draei_drae_rel_def by auto
 
   definition draei_drae where
     "draei_drae A \<equiv> drae (set (alphabetei A)) (initialei A)
-      (set (transitionei A)) (map (map_prod set set) (acceptingei A))"
+      (set (transitionei A)) (map (map_prod set set) (conditionei A))"
 
   lemma draei_drae_id_param[param]: "(draei_drae, id) \<in> \<langle>L, S\<rangle> draei_drae_rel \<rightarrow> \<langle>L, S\<rangle> drae_rel"
   proof
     fix Ai A
     assume 1: "(Ai, A) \<in> \<langle>L, S\<rangle> draei_drae_rel"
     have 2: "draei_drae Ai = drae (set (alphabetei Ai)) (initialei Ai)
-      (set (transitionei Ai)) (map (map_prod set set) (acceptingei Ai))" unfolding draei_drae_def by rule
+      (set (transitionei Ai)) (map (map_prod set set) (conditionei Ai))" unfolding draei_drae_def by rule
     have 3: "id A = drae (id (alphabete A)) (initiale A)
-      (id (transitione A)) (map (map_prod id id) (acceptinge A))" by simp
+      (id (transitione A)) (map (map_prod id id) (conditione A))" by simp
     show "(draei_drae Ai, id A) \<in> \<langle>L, S\<rangle> drae_rel" unfolding 2 3 using 1 by parametricity
   qed
 
   abbreviation "transitions L S s \<equiv> \<Union> a \<in> L. \<Union> p \<in> S. {p} \<times> {a} \<times> {s a p}"
   abbreviation "succs T a p \<equiv> the_elem ((T `` {p}) `` {a})"
 
   definition wft :: "'label set \<Rightarrow> 'state set \<Rightarrow> ('state \<times> 'label \<times> 'state) set \<Rightarrow> bool" where
     "wft L S T \<equiv> \<forall> a \<in> L. \<forall> p \<in> S. is_singleton ((T `` {p}) `` {a})"
 
   lemma wft_param[param]:
     assumes "bijective S" "bijective L"
     shows "(wft, wft) \<in> \<langle>L\<rangle> set_rel \<rightarrow> \<langle>S\<rangle> set_rel \<rightarrow> \<langle>S \<times>\<^sub>r L \<times>\<^sub>r S\<rangle> set_rel \<rightarrow> bool_rel"
     using assms unfolding wft_def by parametricity
 
   lemma wft_transitions: "wft L S (transitions L S s)" unfolding wft_def is_singleton_def by auto
 
   definition dra_drae where "dra_drae A \<equiv> drae (alphabet A) (initial A) 
     (transitions (alphabet A) (nodes A) (transition A))
-    (map (\<lambda> (P, Q). (Set.filter P (nodes A), Set.filter Q (nodes A))) (accepting A))"
+    (map (\<lambda> (P, Q). (Set.filter P (nodes A), Set.filter Q (nodes A))) (condition A))"
   definition drae_dra where "drae_dra A \<equiv> dra (alphabete A) (initiale A)
-    (succs (transitione A)) (map (\<lambda> (I, F). (\<lambda> p. p \<in> I, \<lambda> p. p \<in> F)) (acceptinge A))"
+    (succs (transitione A)) (map (\<lambda> (I, F). (\<lambda> p. p \<in> I, \<lambda> p. p \<in> F)) (conditione A))"
 
   lemma set_rel_Domain_Range[intro!, simp]: "(Domain A, Range A) \<in> \<langle>A\<rangle> set_rel" unfolding set_rel_def by auto
 
   lemma dra_drae_param[param]: "(dra_drae, dra_drae) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>L, S\<rangle> drae_rel"
     unfolding dra_drae_def by parametricity
   lemma drae_dra_param[param]:
     assumes "bijective L" "bijective S"
     assumes "wft (Range L) (Range S) (transitione B)"
     assumes [param]: "(A, B) \<in> \<langle>L, S\<rangle> drae_rel"
     shows "(drae_dra A, drae_dra B) \<in> \<langle>L, S\<rangle> dra_rel"
   proof -
     have 1: "(wft (Domain L) (Domain S) (transitione A), wft (Range L) (Range S) (transitione B)) \<in> bool_rel"
       using assms(1, 2) by parametricity auto
     have 2: "wft (Domain L) (Domain S) (transitione A)" using assms(3) 1 by simp
     show ?thesis
       using assms(1 - 3) 2 assms(2)[unfolded bijective_alt]
       unfolding drae_dra_def wft_def
       by parametricity force+
   qed
 
   lemma succs_transitions_param[param]:
     "(succs \<circ> transitions L S, id) \<in> (Id_on L \<rightarrow> Id_on S \<rightarrow> Id_on S) \<rightarrow> (Id_on L \<rightarrow> Id_on S \<rightarrow> Id_on S)"
   proof
     fix f g
     assume 1[param]: "(f, g) \<in> Id_on L \<rightarrow> Id_on S \<rightarrow> Id_on S"
     show "((succs \<circ> transitions L S) f, id g) \<in> Id_on L \<rightarrow> Id_on S \<rightarrow> Id_on S"
     proof safe
       fix a p
       assume 2: "a \<in> L" "p \<in> S"
       have "(succs \<circ> transitions L S) f a p = succs (transitions L S f) a p" by simp
       also have "(transitions L S f `` {p}) `` {a} = {f a p}" using 2 by auto
       also have "the_elem \<dots> = f a p" by simp
       also have "(\<dots>, g a p) \<in> Id_on S" using 2 by parametricity auto
       finally show "(succs \<circ> transitions L S) f a p = id g a p" by simp
       show "id g a p \<in> S" using 1[param_fo] 2 by simp
     qed
   qed
   lemma drae_dra_dra_drae_param[param]:
     "((drae_dra \<circ> dra_drae) A, id A) \<in> \<langle>Id_on (alphabet A), Id_on (nodes A)\<rangle> dra_rel"
   proof -
     have [param]: "(\<lambda> (P, Q). (\<lambda> p. p \<in> Set.filter P (nodes A), \<lambda> p. p \<in> Set.filter Q (nodes A)), id) \<in>
       pred_rel (Id_on (nodes A)) \<times>\<^sub>r pred_rel (Id_on (nodes A)) \<rightarrow> rabin_rel (Id_on (nodes A))"
       unfolding fun_rel_def Id_on_def by auto
     have "(drae_dra \<circ> dra_drae) A = dra (alphabet A) (initial A)
       ((succs \<circ> transitions (alphabet A) (nodes A)) (transition A))
-      (map (\<lambda> (P, Q). (\<lambda> p. p \<in> Set.filter P (nodes A), \<lambda> p. p \<in> Set.filter Q (nodes A))) (accepting A))"
+      (map (\<lambda> (P, Q). (\<lambda> p. p \<in> Set.filter P (nodes A), \<lambda> p. p \<in> Set.filter Q (nodes A))) (condition A))"
       unfolding drae_dra_def dra_drae_def by auto
-    also have "(\<dots>, dra (alphabet A) (initial A) (id (transition A)) (map id (accepting A))) \<in>
+    also have "(\<dots>, dra (alphabet A) (initial A) (id (transition A)) (map id (condition A))) \<in>
       \<langle>Id_on (alphabet A), Id_on (nodes A)\<rangle> dra_rel" using dra_rel_eq by parametricity auto
-    also have "dra (alphabet A) (initial A) (id (transition A)) (map id (accepting A)) = id A" by simp
+    also have "dra (alphabet A) (initial A) (id (transition A)) (map id (condition A)) = id A" by simp
     finally show ?thesis by this
   qed
 
   definition draei_dra_rel where
     [to_relAPP]: "draei_dra_rel L S \<equiv> {(Ae, A). (drae_dra (draei_drae Ae), A) \<in> \<langle>L, S\<rangle> dra_rel}"
   lemma draei_dra_id[param]: "(drae_dra \<circ> draei_drae, id) \<in> \<langle>L, S\<rangle> draei_dra_rel \<rightarrow> \<langle>L, S\<rangle> dra_rel"
     unfolding draei_dra_rel_def by auto
 
 (*
   schematic_goal drae_dra_impl: "(?f, drae_dra) \<in> \<langle>Id, Id\<rangle> draei_drae_rel \<rightarrow> \<langle>Id, Id\<rangle> drai_dra_rel"
     unfolding drae_dra_def by (autoref (trace))
   concrete_definition drae_dra_impl uses drae_dra_impl
 *)
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Implement.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Implement.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Implement.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Implement.thy
@@ -1,81 +1,81 @@
 section \<open>Implementation of Deterministic Rabin Automata\<close>
 
 theory DRA_Implement
 imports
   "DRA_Refine"
   "../../Basic/Implement"
 begin
 
   datatype ('label, 'state) drai = drai
     (alphabeti: "'label list")
     (initiali: "'state")
     (transitioni: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
-    (acceptingi: "'state rabin gen")
+    (conditioni: "'state rabin gen")
 
   definition drai_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
     (('label\<^sub>1, 'state\<^sub>1) drai \<times> ('label\<^sub>2, 'state\<^sub>2) drai) set" where
     [to_relAPP]: "drai_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabeti A\<^sub>1, alphabeti A\<^sub>2) \<in> \<langle>L\<rangle> list_rel \<and>
       (initiali A\<^sub>1, initiali A\<^sub>2) \<in> S \<and>
       (transitioni A\<^sub>1, transitioni A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> S \<and>
-      (acceptingi A\<^sub>1, acceptingi A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
+      (conditioni A\<^sub>1, conditioni A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
 
   lemma drai_param[param]:
     "(drai, drai) \<in> \<langle>L\<rangle> list_rel \<rightarrow> S \<rightarrow> (L \<rightarrow> S \<rightarrow> S) \<rightarrow>
       \<langle>rabin_rel S\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> drai_rel"
     "(alphabeti, alphabeti) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> \<langle>L\<rangle> list_rel"
     "(initiali, initiali) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> S"
     "(transitioni, transitioni) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> L \<rightarrow> S \<rightarrow> S"
-    "(acceptingi, acceptingi) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
+    "(conditioni, conditioni) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
     unfolding drai_rel_def fun_rel_def by auto
 
   definition drai_dra_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
     (('label\<^sub>1, 'state\<^sub>1) drai \<times> ('label\<^sub>2, 'state\<^sub>2) dra) set" where
     [to_relAPP]: "drai_dra_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabeti A\<^sub>1, alphabet A\<^sub>2) \<in> \<langle>L\<rangle> list_set_rel \<and>
       (initiali A\<^sub>1, initial A\<^sub>2) \<in> S \<and>
       (transitioni A\<^sub>1, transition A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> S \<and>
-      (acceptingi A\<^sub>1, accepting A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
+      (conditioni A\<^sub>1, condition A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
 
   lemma drai_dra_param[param, autoref_rules]:
     "(drai, dra) \<in> \<langle>L\<rangle> list_set_rel \<rightarrow> S \<rightarrow> (L \<rightarrow> S \<rightarrow> S) \<rightarrow>
       \<langle>rabin_rel S\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> drai_dra_rel"
     "(alphabeti, alphabet) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>L\<rangle> list_set_rel"
     "(initiali, initial) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> S"
     "(transitioni, transition) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> L \<rightarrow> S \<rightarrow> S"
-    "(acceptingi, accepting) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
+    "(conditioni, condition) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
     unfolding drai_dra_rel_def fun_rel_def by auto
 
   definition drai_dra :: "('label, 'state) drai \<Rightarrow> ('label, 'state) dra" where
-    "drai_dra A \<equiv> dra (set (alphabeti A)) (initiali A) (transitioni A) (acceptingi A)"
+    "drai_dra A \<equiv> dra (set (alphabeti A)) (initiali A) (transitioni A) (conditioni A)"
   definition drai_invar :: "('label, 'state) drai \<Rightarrow> bool" where
     "drai_invar A \<equiv> distinct (alphabeti A)"
 
   lemma drai_dra_id_param[param]: "(drai_dra, id) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>L, S\<rangle> dra_rel"
   proof
     fix Ai A
     assume 1: "(Ai, A) \<in> \<langle>L, S\<rangle> drai_dra_rel"
-    have 2: "drai_dra Ai = dra (set (alphabeti Ai)) (initiali Ai) (transitioni Ai) (acceptingi Ai)"
+    have 2: "drai_dra Ai = dra (set (alphabeti Ai)) (initiali Ai) (transitioni Ai) (conditioni Ai)"
       unfolding drai_dra_def by rule
-    have 3: "id A = dra (id (alphabet A)) (initial A) (transition A) (accepting A)" by simp
+    have 3: "id A = dra (id (alphabet A)) (initial A) (transition A) (condition A)" by simp
     show "(drai_dra Ai, id A) \<in> \<langle>L, S\<rangle> dra_rel" unfolding 2 3 using 1 by parametricity
   qed
 
   lemma drai_dra_br: "\<langle>Id, Id\<rangle> drai_dra_rel = br drai_dra drai_invar"
   proof safe
     show "(A, B) \<in> \<langle>Id, Id\<rangle> drai_dra_rel" if "(A, B) \<in> br drai_dra drai_invar"
       for A and B :: "('a, 'b) dra"
       using that unfolding drai_dra_rel_def drai_dra_def drai_invar_def
       by (auto simp: in_br_conv list_set_rel_def)
     show "(A, B) \<in> br drai_dra drai_invar" if "(A, B) \<in> \<langle>Id, Id\<rangle> drai_dra_rel"
       for A and B :: "('a, 'b) dra"
     proof -
       have 1: "(drai_dra A, id B) \<in> \<langle>Id, Id\<rangle> dra_rel" using that by parametricity
       have 2: "drai_invar A"
         using drai_dra_param(2 - 5)[param_fo, OF that]
         by (auto simp: in_br_conv list_set_rel_def drai_invar_def)
       show ?thesis using 1 2 unfolding in_br_conv by auto
     qed
   qed
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Refine.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Refine.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Refine.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Refine.thy
@@ -1,88 +1,88 @@
 section \<open>Relations on Deterministic Rabin Automata\<close>
 
 theory DRA_Refine
 imports
   "DRA"
   "../../Basic/Acceptance_Refine"
   "../../Transition_Systems/Transition_System_Refine"
 begin
 
   definition dra_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
     (('label\<^sub>1, 'state\<^sub>1) dra \<times> ('label\<^sub>2, 'state\<^sub>2) dra) set" where
     [to_relAPP]: "dra_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
       (alphabet A\<^sub>1, alphabet A\<^sub>2) \<in> \<langle>L\<rangle> set_rel \<and>
       (initial A\<^sub>1, initial A\<^sub>2) \<in> S \<and>
       (transition A\<^sub>1, transition A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> S \<and>
-      (accepting A\<^sub>1, accepting A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
+      (condition A\<^sub>1, condition A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"
 
   lemma dra_param[param]:
     "(dra, dra) \<in> \<langle>L\<rangle> set_rel \<rightarrow> S \<rightarrow> (L \<rightarrow> S \<rightarrow> S) \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel \<rightarrow>
       \<langle>L, S\<rangle> dra_rel"
     "(alphabet, alphabet) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>L\<rangle> set_rel"
     "(initial, initial) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S"
     "(transition, transition) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> L \<rightarrow> S \<rightarrow> S"
-    "(accepting, accepting) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
+    "(condition, condition) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
     unfolding dra_rel_def fun_rel_def by auto
 
   lemma dra_rel_id[simp]: "\<langle>Id, Id\<rangle> dra_rel = Id" unfolding dra_rel_def using dra.expand by auto
   lemma dra_rel_comp[trans]:
     assumes [param]: "(A, B) \<in> \<langle>L\<^sub>1, S\<^sub>1\<rangle> dra_rel" "(B, C) \<in> \<langle>L\<^sub>2, S\<^sub>2\<rangle> dra_rel"
     shows "(A, C) \<in> \<langle>L\<^sub>1 O L\<^sub>2, S\<^sub>1 O S\<^sub>2\<rangle> dra_rel"
   proof -
-    have "(accepting A, accepting B) \<in> \<langle>rabin_rel S\<^sub>1\<rangle> list_rel" by parametricity
-    also have "(accepting B, accepting C) \<in> \<langle>rabin_rel S\<^sub>2\<rangle> list_rel" by parametricity
-    finally have 1: "(accepting A, accepting C) \<in> \<langle>rabin_rel S\<^sub>1 O rabin_rel S\<^sub>2\<rangle> list_rel" by simp
+    have "(condition A, condition B) \<in> \<langle>rabin_rel S\<^sub>1\<rangle> list_rel" by parametricity
+    also have "(condition B, condition C) \<in> \<langle>rabin_rel S\<^sub>2\<rangle> list_rel" by parametricity
+    finally have 1: "(condition A, condition C) \<in> \<langle>rabin_rel S\<^sub>1 O rabin_rel S\<^sub>2\<rangle> list_rel" by simp
     have 2: "rabin_rel S\<^sub>1 O rabin_rel S\<^sub>2 \<subseteq> rabin_rel (S\<^sub>1 O S\<^sub>2)" by (force simp: fun_rel_def)
-    have 3: "(accepting A, accepting C) \<in> \<langle>rabin_rel (S\<^sub>1 O S\<^sub>2)\<rangle> list_rel" using 1 2 list_rel_mono by blast
+    have 3: "(condition A, condition C) \<in> \<langle>rabin_rel (S\<^sub>1 O S\<^sub>2)\<rangle> list_rel" using 1 2 list_rel_mono by blast
     have "(transition A, transition B) \<in> L\<^sub>1 \<rightarrow> S\<^sub>1 \<rightarrow> S\<^sub>1" by parametricity
     also have "(transition B, transition C) \<in> L\<^sub>2 \<rightarrow> S\<^sub>2 \<rightarrow> S\<^sub>2" by parametricity
     finally have 4: "(transition A, transition C) \<in> L\<^sub>1 O L\<^sub>2 \<rightarrow> S\<^sub>1 O S\<^sub>2 \<rightarrow> S\<^sub>1 O S\<^sub>2" by this
     show ?thesis
       unfolding dra_rel_def mem_Collect_eq prod.case set_rel_compp
       using 3 4
       using dra_param(2 - 5)[THEN fun_relD, OF assms(1)]
       using dra_param(2 - 5)[THEN fun_relD, OF assms(2)]
       by auto
   qed
   lemma dra_rel_converse[simp]: "(\<langle>L, S\<rangle> dra_rel)\<inverse> = \<langle>L\<inverse>, S\<inverse>\<rangle> dra_rel"
   proof -
     have 1: "\<langle>L\<rangle> set_rel = (\<langle>L\<inverse>\<rangle> set_rel)\<inverse>" by simp
     have 2: "\<langle>S\<rangle> set_rel = (\<langle>S\<inverse>\<rangle> set_rel)\<inverse>" by simp
     have 3: "L \<rightarrow> S \<rightarrow> S = (L\<inverse> \<rightarrow> S\<inverse> \<rightarrow> S\<inverse>)\<inverse>" by simp
     have 4: "\<langle>rabin_rel S\<rangle> list_rel = (\<langle>rabin_rel (S\<inverse>)\<rangle> list_rel)\<inverse>" by simp
     show ?thesis unfolding dra_rel_def unfolding 3 unfolding 1 2 4 by fastforce
   qed
 
   lemma dra_rel_eq: "(A, A) \<in> \<langle>Id_on (alphabet A), Id_on (nodes A)\<rangle> dra_rel"
     unfolding dra_rel_def prod_rel_def using list_all2_same[to_set] by auto
 
-  lemma enableds_param[param]: "(enableds, enableds) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>L\<rangle> set_rel"
-    using dra_param(2, 4) unfolding dra.enableds_def fun_rel_def set_rel_def by fastforce
-  lemma paths_param[param]: "(paths, paths) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>\<langle>L\<rangle> list_rel\<rangle> set_rel"
-    unfolding paths_def by (intro fun_relI paths_param, fold enableds_def) (parametricity+)
-  lemma runs_param[param]: "(runs, runs) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>\<langle>L\<rangle> stream_rel\<rangle> set_rel"
-    unfolding runs_def by (intro fun_relI runs_param, fold enableds_def) (parametricity+)
+  lemma enableds_param[param]: "(dra.enableds, dra.enableds) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>L\<rangle> set_rel"
+    unfolding dra.enableds_def by simp parametricity
+  lemma paths_param[param]: "(dra.paths, dra.paths) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>\<langle>L\<rangle> list_rel\<rangle> set_rel"
+    using enableds_param[param_fo] by parametricity
+  lemma runs_param[param]: "(dra.runs, dra.runs) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>\<langle>L\<rangle> stream_rel\<rangle> set_rel"
+    using enableds_param[param_fo] by parametricity
 
   lemma reachable_param[param]: "(reachable, reachable) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> S \<rightarrow> \<langle>S\<rangle> set_rel"
   proof -
-    have 1: "reachable A p = (\<lambda> w. target A w p) ` paths A p" for A :: "('label, 'state) dra" and p
+    have 1: "reachable A p = (\<lambda> w. target A w p) ` dra.paths A p" for A :: "('label, 'state) dra" and p
       unfolding dra.reachable_alt_def dra.paths_def by auto
-    show ?thesis unfolding 1 by parametricity
+    show ?thesis unfolding 1 using enableds_param[param_fo] by parametricity
   qed
   lemma nodes_param[param]: "(nodes, nodes) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>S\<rangle> set_rel"
   proof -
     have 1: "nodes A = reachable A (initial A)" for A :: "('label, 'state) dra"
       unfolding dra.nodes_alt_def by simp
     show ?thesis unfolding 1 by parametricity
   qed
 
   lemma language_param[param]: "(language, language) \<in> \<langle>L, S\<rangle> dra_rel \<rightarrow> \<langle>\<langle>L\<rangle> stream_rel\<rangle> set_rel"
   proof -
-    have 1: "language A = (\<Union> w \<in> runs A (initial A).
-      if cogen rabin (accepting A) (trace A w (initial A)) then {w} else {})"
+    have 1: "language A = (\<Union> w \<in> dra.runs A (initial A).
+      if cogen rabin (condition A) (trace A w (initial A)) then {w} else {})"
       for A :: "('label, 'state) dra"
-      unfolding language_def dra.runs_def image_def by auto
-    show ?thesis unfolding 1 by parametricity
+      unfolding dra.language_def dra.runs_def by auto
+    show ?thesis unfolding 1 using enableds_param[param_fo] by parametricity
   qed
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Translate.thy b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Translate.thy
--- a/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Translate.thy
+++ b/thys/Transition_Systems_and_Automata/Automata/DRA/DRA_Translate.thy
@@ -1,249 +1,249 @@
 section \<open>Explore and Enumerate Nodes of Deterministic Rabin Automata\<close>
 
 theory DRA_Translate
 imports DRA_Explicit
 begin
 
   subsection \<open>Syntax\<close>
 
   (* TODO: this syntax has unnecessarily high inner binding strength, requiring extra parentheses
     the regular let syntax correctly uses inner binding strength 0: ("(2_ =/ _)" 10) *)
   no_syntax "_do_let" :: "[pttrn, 'a] \<Rightarrow> do_bind" ("(2let _ =/ _)" [1000, 13] 13)
   syntax "_do_let" :: "[pttrn, 'a] \<Rightarrow> do_bind" ("(2let _ =/ _)" 13)
 
   section \<open>Image on Explicit Automata\<close>
 
   definition drae_image where "drae_image f A \<equiv> drae (alphabete A) (f (initiale A))
-    ((\<lambda> (p, a, q). (f p, a, f q)) ` transitione A) (map (map_prod (image f) (image f)) (acceptinge A))"
+    ((\<lambda> (p, a, q). (f p, a, f q)) ` transitione A) (map (map_prod (image f) (image f)) (conditione A))"
 
   lemma drae_image_param[param]: "(drae_image, drae_image) \<in> (S \<rightarrow> T) \<rightarrow> \<langle>L, S\<rangle> drae_rel \<rightarrow> \<langle>L, T\<rangle> drae_rel"
     unfolding drae_image_def by parametricity
 
   lemma drae_image_id[simp]: "drae_image id = id" unfolding drae_image_def by auto
   lemma drae_image_dra_drae: "drae_image f (dra_drae A) = drae
     (alphabet A) (f (initial A))
     (\<Union> p \<in> nodes A. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p})
-    (map (\<lambda> (P, Q). (f ` {p \<in> nodes A. P p}, f ` {p \<in> nodes A. Q p})) (accepting A))"
+    (map (\<lambda> (P, Q). (f ` {p \<in> nodes A. P p}, f ` {p \<in> nodes A. Q p})) (condition A))"
     unfolding dra_drae_def drae_image_def drae.simps Set.filter_def by force
 
   section \<open>Exploration and Translation\<close>
 
   definition trans_spec where
     "trans_spec A f \<equiv> \<Union> p \<in> nodes A. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}"
 
   definition trans_algo where
     "trans_algo N L S f \<equiv>
       FOREACH N (\<lambda> p T. do {
         ASSERT (p \<in> N);
         FOREACH L (\<lambda> a T. do {
           ASSERT (a \<in> L);
           let q = S a p;
           ASSERT ((f p, a, f q) \<notin> T);
           RETURN (insert (f p, a, f q) T) }
         ) T }
       ) {}"
 
   lemma trans_algo_refine:
     assumes "finite (nodes A)" "finite (alphabet A)" "inj_on f (nodes A)"
     assumes "N = nodes A" "L = alphabet A" "S = transition A"
     shows "(trans_algo N L S f, SPEC (HOL.eq (trans_spec A f))) \<in> \<langle>Id\<rangle> nres_rel"
   unfolding trans_algo_def trans_spec_def assms(4-6)
   proof (refine_vcg FOREACH_rule_insert_eq)
     show "finite (nodes A)" using assms(1) by this
     show "(\<Union> p \<in> nodes A. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}) =
       (\<Union> p \<in> nodes A. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p})" by rule
     show "(\<Union> p \<in> {}. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}) = {}" by simp
     fix T x
     assume 1: "T \<subseteq> nodes A" "x \<in> nodes A" "x \<notin> T"
     show "finite (alphabet A)" using assms(2) by this
     show "(\<Union> a \<in> {}. f ` {x} \<times> {a} \<times> f ` {transition A a x}) \<union>
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}) =
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p})"
       "(\<Union> a \<in> alphabet A. f ` {x} \<times> {a} \<times> f ` {transition A a x}) \<union>
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}) =
       (\<Union> p \<in> insert x T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p})" by auto
     fix Ta xa
     assume 2: "Ta \<subseteq> alphabet A" "xa \<in> alphabet A" "xa \<notin> Ta"
     show "(f x, xa, f (transition A xa x)) \<notin> (\<Union> a \<in> Ta. f ` {x} \<times> {a} \<times> f ` {transition A a x}) \<union>
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p})"
       using 1 2(3) assms(3) by (auto dest: inj_onD)
     show "(\<Union> a \<in> insert xa Ta. f ` {x} \<times> {a} \<times> f ` {transition A a x}) \<union>
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}) =
       insert (f x, xa, f (transition A xa x)) ((\<Union> a \<in> Ta. f ` {x} \<times> {a} \<times> f ` {transition A a x}) \<union>
       (\<Union> p \<in> T. \<Union> a \<in> alphabet A. f ` {p} \<times> {a} \<times> f ` {transition A a p}))"
       by simp
   qed
 
   definition to_draei :: "('state, 'label) dra \<Rightarrow> ('state, 'label) dra"
     where "to_draei \<equiv> id"
 
   (* TODO: make separate implementations for "dra_drae" and "op_set_enumerate \<bind> drae_image" *)
   schematic_goal to_draei_impl:
     fixes S :: "('statei \<times> 'state) set"
     assumes [simp]: "finite (nodes A)"
     assumes [autoref_ga_rules]: "is_bounded_hashcode S seq bhc"
     assumes [autoref_ga_rules]: "is_valid_def_hm_size TYPE('statei) hms"
     assumes [autoref_rules]: "(seq, HOL.eq) \<in> S \<rightarrow> S \<rightarrow> bool_rel"
     assumes [autoref_rules]: "(Ai, A) \<in> \<langle>L, S\<rangle> drai_dra_rel"
     shows "(?f :: ?'a, do {
         let N = nodes A;
         f \<leftarrow> op_set_enumerate N;
         ASSERT (dom f = N);
         ASSERT (f (initial A) \<noteq> None);
         ASSERT (\<forall> a \<in> alphabet A. \<forall> p \<in> dom f. f (transition A a p) \<noteq> None);
         T \<leftarrow> trans_algo N (alphabet A) (transition A) (\<lambda> x. the (f x));
         RETURN (drae (alphabet A) ((\<lambda> x. the (f x)) (initial A)) T
-          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> N. P p}, (\<lambda> x. the (f x)) ` {p \<in> N. Q p})) (accepting A)))
+          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> N. P p}, (\<lambda> x. the (f x)) ` {p \<in> N. Q p})) (condition A)))
       }) \<in> ?R"
     unfolding trans_algo_def by (autoref_monadic (plain))
   concrete_definition to_draei_impl uses to_draei_impl
   lemma to_draei_impl_refine'':
     fixes S :: "('statei \<times> 'state) set"
     assumes "finite (nodes A)"
     assumes "is_bounded_hashcode S seq bhc"
     assumes "is_valid_def_hm_size TYPE('statei) hms"
     assumes "(seq, HOL.eq) \<in> S \<rightarrow> S \<rightarrow> bool_rel"
     assumes "(Ai, A) \<in> \<langle>L, S\<rangle> drai_dra_rel"
     shows "(RETURN (to_draei_impl seq bhc hms Ai), do {
         f \<leftarrow> op_set_enumerate (nodes A);
         RETURN (drae_image (the \<circ> f) (dra_drae A))
       }) \<in> \<langle>\<langle>L, nat_rel\<rangle> draei_drae_rel\<rangle> nres_rel"
   proof -
     have 1: "finite (alphabet A)"
       using drai_dra_param(2)[param_fo, OF assms(5)] list_set_rel_finite
       unfolding finite_set_rel_def by auto
     note to_draei_impl.refine[OF assms]
     also have "(do {
         let N = nodes A;
         f \<leftarrow> op_set_enumerate N;
         ASSERT (dom f = N);
         ASSERT (f (initial A) \<noteq> None);
         ASSERT (\<forall> a \<in> alphabet A. \<forall> p \<in> dom f. f (transition A a p) \<noteq> None);
         T \<leftarrow> trans_algo N (alphabet A) (transition A) (\<lambda> x. the (f x));
         RETURN (drae (alphabet A) ((\<lambda> x. the (f x)) (initial A)) T
-          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> N. P p}, (\<lambda> x. the (f x)) ` {p \<in> N. Q p})) (accepting A)))
+          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> N. P p}, (\<lambda> x. the (f x)) ` {p \<in> N. Q p})) (condition A)))
       }, do {
         f \<leftarrow> op_set_enumerate (nodes A);
         T \<leftarrow> SPEC (HOL.eq (trans_spec A (\<lambda> x. the (f x))));
         RETURN (drae (alphabet A) ((\<lambda> x. the (f x)) (initial A)) T
-          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> nodes A. P p}, (\<lambda> x. the (f x)) ` {p \<in> nodes A. Q p})) (accepting A)))
+          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> nodes A. P p}, (\<lambda> x. the (f x)) ` {p \<in> nodes A. Q p})) (condition A)))
       }) \<in> \<langle>Id\<rangle> nres_rel"
       unfolding Let_def comp_apply op_set_enumerate_def using assms(1) 1
       by (refine_vcg vcg0[OF trans_algo_refine]) (auto intro!: inj_on_map_the[unfolded comp_apply])
     also have "(do {
         f \<leftarrow> op_set_enumerate (nodes A);
         T \<leftarrow> SPEC (HOL.eq (trans_spec A (\<lambda> x. the (f x))));
         RETURN (drae (alphabet A) ((\<lambda> x. the (f x)) (initial A)) T
-          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> nodes A. P p}, (\<lambda> x. the (f x)) ` {p \<in> nodes A. Q p})) (accepting A)))
+          (map (\<lambda> (P, Q). ((\<lambda> x. the (f x)) ` {p \<in> nodes A. P p}, (\<lambda> x. the (f x)) ` {p \<in> nodes A. Q p})) (condition A)))
       },  do {
         f \<leftarrow> op_set_enumerate (nodes A);
         RETURN (drae_image (the \<circ> f) (dra_drae A))
       }) \<in> \<langle>Id\<rangle> nres_rel"
       unfolding trans_spec_def drae_image_dra_drae by refine_vcg force
     finally show ?thesis unfolding nres_rel_comp by simp
   qed
 
   (* TODO: generalize L *)
   context
     fixes Ai A
     fixes seq bhc hms
     fixes S :: "('statei \<times> 'state) set"
     assumes a: "finite (nodes A)"
     assumes b: "is_bounded_hashcode S seq bhc"
     assumes c: "is_valid_def_hm_size TYPE('statei) hms"
     assumes d: "(seq, HOL.eq) \<in> S \<rightarrow> S \<rightarrow> bool_rel"
     assumes e: "(Ai, A) \<in> \<langle>Id, S\<rangle> drai_dra_rel"
   begin
 
     definition f' where "f' \<equiv> SOME f'.
       (to_draei_impl seq bhc hms Ai, drae_image (the \<circ> f') (dra_drae A)) \<in> \<langle>Id, nat_rel\<rangle> draei_drae_rel \<and>
       dom f' = nodes A \<and> inj_on f' (nodes A)"
 
     lemma 1: "\<exists> f'. (to_draei_impl seq bhc hms Ai, drae_image (the \<circ> f') (dra_drae A)) \<in>
       \<langle>Id, nat_rel\<rangle> draei_drae_rel \<and> dom f' = nodes A \<and> inj_on f' (nodes A)"
       using to_draei_impl_refine''[
         OF a b c d e,
         unfolded op_set_enumerate_def bind_RES_RETURN_eq,
         THEN nres_relD,
         THEN RETURN_ref_SPECD]
       by force
 
     lemma f'_refine: "(to_draei_impl seq bhc hms Ai, drae_image (the \<circ> f') (dra_drae A)) \<in>
       \<langle>Id, nat_rel\<rangle> draei_drae_rel" using someI_ex[OF 1, folded f'_def] by auto
     lemma f'_dom: "dom f' = nodes A" using someI_ex[OF 1, folded f'_def] by auto
     lemma f'_inj: "inj_on f' (nodes A)" using someI_ex[OF 1, folded f'_def] by auto
 
     definition f where "f \<equiv> the \<circ> f'"
     definition g where "g = inv_into (nodes A) f"
     lemma inj_f[intro!, simp]: "inj_on f (nodes A)"
       using f'_inj f'_dom unfolding f_def by (simp add: inj_on_map_the)
     lemma inj_g[intro!, simp]: "inj_on g (f ` nodes A)"
       unfolding g_def by (simp add: inj_on_inv_into)
 
     definition rel where "rel \<equiv> {(f p, p) |p. p \<in> nodes A}"
     lemma rel_alt_def: "rel = (br f (\<lambda> p. p \<in> nodes A))\<inverse>"
       unfolding rel_def by (auto simp: in_br_conv)
     lemma rel_inv_def: "rel = br g (\<lambda> k. k \<in> f ` nodes A)"
       unfolding rel_alt_def g_def by (auto simp: in_br_conv)
     lemma rel_domain[simp]: "Domain rel = f ` nodes A" unfolding rel_def by force
     lemma rel_range[simp]: "Range rel = nodes A" unfolding rel_def by auto
     lemma [intro!, simp]: "bijective rel" unfolding rel_inv_def by (simp add: bijective_alt)
     lemma [simp]: "Id_on (f ` nodes A) O rel = rel" unfolding rel_def by auto
     lemma [simp]: "rel O Id_on (nodes A) = rel" unfolding rel_def by auto
 
     lemma [param]: "(f, f) \<in> Id_on (Range rel) \<rightarrow> Id_on (Domain rel)" unfolding rel_alt_def by auto
     lemma [param]: "(g, g) \<in> Id_on (Domain rel) \<rightarrow> Id_on (Range rel)" unfolding rel_inv_def by auto
     lemma [param]: "(id, f) \<in> rel \<rightarrow> Id_on (Domain rel)" unfolding rel_alt_def by (auto simp: in_br_conv)
     lemma [param]: "(f, id) \<in> Id_on (Range rel) \<rightarrow> rel" unfolding rel_alt_def by (auto simp: in_br_conv)
     lemma [param]: "(id, g) \<in> Id_on (Domain rel) \<rightarrow> rel" unfolding rel_inv_def by (auto simp: in_br_conv)
     lemma [param]: "(g, id) \<in> rel \<rightarrow> Id_on (Range rel)" unfolding rel_inv_def by (auto simp: in_br_conv)
 
     lemma to_draei_impl_refine':
       "(to_draei_impl seq bhc hms Ai, to_draei A) \<in> \<langle>Id_on (alphabet A), rel\<rangle> draei_dra_rel"
     proof -
       have 1: "(draei_drae (to_draei_impl seq bhc hms Ai), id (drae_image f (dra_drae A))) \<in>
         \<langle>Id, nat_rel\<rangle> drae_rel" using f'_refine[folded f_def] by parametricity
       have 2: "(draei_drae (to_draei_impl seq bhc hms Ai), id (drae_image f (dra_drae A))) \<in>
         \<langle>Id_on (alphabet A), Id_on (f ` nodes A)\<rangle> drae_rel"
         using 1 unfolding drae_rel_def dra_drae_def drae_image_def by auto
 
       have 3: "wft (alphabet A) (nodes A) (transitione (dra_drae A))"
         using wft_transitions unfolding dra_drae_def drae.sel by this
       have 4: "(wft (alphabet A) (f ` nodes A) (transitione (drae_image f (dra_drae A))),
         wft (alphabet A) (id ` nodes A) (transitione (drae_image id (dra_drae A)))) \<in> bool_rel"
         using dra_rel_eq by parametricity auto
       have 5: "wft (alphabet A) (f ` nodes A) (transitione (drae_image f (dra_drae A)))" using 3 4 by simp
 
       have "(drae_dra (draei_drae (to_draei_impl seq bhc hms Ai)), drae_dra (id (drae_image f (dra_drae A)))) \<in>
         \<langle>Id_on (alphabet A), Id_on (f ` nodes A)\<rangle> dra_rel" using 2 5 by parametricity auto
       also have "(drae_dra (id (drae_image f (dra_drae A))), drae_dra (id (drae_image id (dra_drae A)))) \<in>
         \<langle>Id_on (alphabet A), rel\<rangle> dra_rel" using dra_rel_eq 3 by parametricity auto
       also have "drae_dra (id (drae_image id (dra_drae A))) = (drae_dra \<circ> dra_drae) A" by simp
       also have "(\<dots>, id A) \<in> \<langle>Id_on (alphabet A), Id_on (nodes A)\<rangle> dra_rel" by parametricity
       also have "id A = to_draei A" unfolding to_draei_def by simp
       finally show ?thesis unfolding draei_dra_rel_def by simp
     qed
 
   end
 
   context
   begin
 
     interpretation autoref_syn by this
 
     lemma to_draei_impl_refine[autoref_rules]:
       fixes S :: "('statei \<times> 'state) set"
       assumes "SIDE_PRECOND (finite (nodes A))"
       assumes "SIDE_GEN_ALGO (is_bounded_hashcode S seq bhc)"
       assumes "SIDE_GEN_ALGO (is_valid_def_hm_size TYPE('statei) hms)"
       assumes "GEN_OP seq HOL.eq (S \<rightarrow> S \<rightarrow> bool_rel)"
       assumes "(Ai, A) \<in> \<langle>Id, S\<rangle> drai_dra_rel"
       shows "(to_draei_impl seq bhc hms Ai,
         (OP to_draei ::: \<langle>Id, S\<rangle> drai_dra_rel \<rightarrow>
         \<langle>Id_on (alphabet A), rel Ai A seq bhc hms\<rangle> draei_dra_rel) $ A) \<in>
         \<langle>Id_on (alphabet A), rel Ai A seq bhc hms\<rangle> draei_dra_rel"
       using to_draei_impl_refine' assms unfolding autoref_tag_defs by this
 
   end
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy b/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy
new file mode 100644
--- /dev/null
+++ b/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy
@@ -0,0 +1,559 @@
+theory Deterministic
+imports
+  "../Transition_Systems/Transition_System"
+  "../Transition_Systems/Transition_System_Extra"
+  "../Transition_Systems/Transition_System_Construction"
+  "../Basic/Degeneralization"
+begin
+
+  type_synonym ('label, 'state) trans = "'label \<Rightarrow> 'state \<Rightarrow> 'state"
+
+  (* TODO: is there a way to be less verbose in these locales? do we need to specify all the types? *)
+  locale automaton =
+    fixes automaton :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'condition \<Rightarrow> 'automaton"
+    fixes alphabet :: "'automaton \<Rightarrow> 'label set"
+    fixes initial :: "'automaton \<Rightarrow> 'state"
+    fixes transition :: "'automaton \<Rightarrow> ('label, 'state) trans"
+    fixes condition :: "'automaton \<Rightarrow> 'condition"
+    assumes automaton[simp]: "automaton (alphabet A) (initial A) (transition A) (condition A) = A"
+    assumes alphabet[simp]: "alphabet (automaton a i t c) = a"
+    assumes initial[simp]: "initial (automaton a i t c) = i"
+    assumes transition[simp]: "transition (automaton a i t c) = t"
+    assumes condition[simp]: "condition (automaton a i t c) = c"
+  begin
+
+    (* TODO: is there a way to use defines without renaming the constants? *)
+    sublocale transition_system_initial
+      "transition A" "\<lambda> a p. a \<in> alphabet A" "\<lambda> p. p = initial A"
+      for A
+      defines path' = path and run' = run and reachable' = reachable and nodes' = nodes
+      by this
+
+    lemma path_alt_def: "path A w p \<longleftrightarrow> set w \<subseteq> alphabet A"
+    unfolding lists_iff_set[symmetric]
+    proof
+      show "w \<in> lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto)
+      show "path A w p" if "w \<in> lists (alphabet A)" using that by (induct arbitrary: p) (auto)
+    qed
+    lemma run_alt_def: "run A w p \<longleftrightarrow> sset w \<subseteq> alphabet A"
+    unfolding streams_iff_sset[symmetric]
+    proof
+      show "w \<in> streams (alphabet A)" if "run A w p"
+        using that by (coinduction arbitrary: w p) (force elim: run.cases)
+      show "run A w p" if "w \<in> streams (alphabet A)"
+        using that by (coinduction arbitrary: w p) (force elim: streams.cases)
+    qed
+
+  end
+
+  (* TODO: create analogous locale for DFAs (automaton_target) *)
+  locale automaton_trace =
+    automaton automaton alphabet initial transition condition
+    for automaton :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'condition \<Rightarrow> 'automaton"
+    and alphabet :: "'automaton \<Rightarrow> 'label set"
+    and initial :: "'automaton \<Rightarrow> 'state"
+    and transition :: "'automaton \<Rightarrow> ('label, 'state) trans"
+    and condition :: "'automaton \<Rightarrow> 'condition"
+    +
+    fixes test :: "'condition \<Rightarrow> 'state stream \<Rightarrow> bool"
+  begin
+
+    definition language :: "'automaton \<Rightarrow> 'label stream set" where
+      "language A \<equiv> {w. run A w (initial A) \<and> test (condition A) (trace A w (initial A))}"
+  
+    lemma language[intro]:
+      assumes "run A w (initial A)" "test (condition A) (trace A w (initial A))"
+      shows "w \<in> language A"
+      using assms unfolding language_def by auto
+    lemma language_elim[elim]:
+      assumes "w \<in> language A"
+      obtains "run A w (initial A)" "test (condition A) (trace A w (initial A))"
+      using assms unfolding language_def by auto
+  
+    lemma language_alphabet: "language A \<subseteq> streams (alphabet A)"
+      unfolding language_def run_alt_def using sset_streams by auto
+
+  end
+
+  locale automaton_degeneralization =
+    a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 +
+    b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'state pred gen \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state pred gen"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state degen \<Rightarrow> ('label, 'state degen) trans \<Rightarrow> 'state degen pred \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state degen"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state degen) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state degen pred"
+  begin
+
+    definition degeneralize :: "'automaton\<^sub>1 \<Rightarrow> 'automaton\<^sub>2" where
+      "degeneralize A \<equiv> automaton\<^sub>2
+        (alphabet\<^sub>1 A)
+        (initial\<^sub>1 A, 0)
+        (\<lambda> a (p, k). (transition\<^sub>1 A a p, count (condition\<^sub>1 A) p k))
+        (degen (condition\<^sub>1 A))"
+
+    lemma degeneralize_simps[simp]:
+      "alphabet\<^sub>2 (degeneralize A) = alphabet\<^sub>1 A"
+      "initial\<^sub>2 (degeneralize A) = (initial\<^sub>1 A, 0)"
+      "transition\<^sub>2 (degeneralize A) a (p, k) = (transition\<^sub>1 A a p, count (condition\<^sub>1 A) p k)"
+      "condition\<^sub>2 (degeneralize A) = degen (condition\<^sub>1 A)"
+      unfolding degeneralize_def by auto
+
+    lemma degeneralize_target[simp]: "b.target (degeneralize A) w (p, k) =
+      (a.target A w p, fold (count (condition\<^sub>1 A)) (butlast (p # a.states A w p)) k)"
+      by (induct w arbitrary: p k) (auto)
+    lemma degeneralize_states[simp]: "b.states (degeneralize A) w (p, k) =
+      a.states A w p || scan (count (condition\<^sub>1 A)) (p # a.states A w p) k"
+      by (induct w arbitrary: p k) (auto)
+    lemma degeneralize_trace[simp]: "b.trace (degeneralize A) w (p, k) =
+      a.trace A w p ||| sscan (count (condition\<^sub>1 A)) (p ## a.trace A w p) k"
+      by (coinduction arbitrary: w p k) (auto)
+
+    lemma degeneralize_path[iff]: "b.path (degeneralize A) w (p, k) \<longleftrightarrow> a.path A w p"
+      unfolding a.path_alt_def b.path_alt_def by simp
+    lemma degeneralize_run[iff]: "b.run (degeneralize A) w (p, k) \<longleftrightarrow> a.run A w p"
+      unfolding a.run_alt_def b.run_alt_def by simp
+
+    lemma degeneralize_reachable_fst[simp]: "fst ` b.reachable (degeneralize A) (p, k) = a.reachable A p"
+      unfolding a.reachable_alt_def b.reachable_alt_def image_def by simp
+    lemma degeneralize_reachable_snd_empty[simp]:
+      assumes "condition\<^sub>1 A = []"
+      shows "snd ` b.reachable (degeneralize A) (p, k) = {k}"
+    proof -
+      have "snd ql = k" if "ql \<in> b.reachable (degeneralize A) (p, k)" for ql
+        using that assms by induct auto
+      then show ?thesis by auto
+    qed
+    lemma degeneralize_reachable_empty[simp]:
+      assumes "condition\<^sub>1 A = []"
+      shows "b.reachable (degeneralize A) (p, k) = a.reachable A p \<times> {k}"
+      using degeneralize_reachable_fst degeneralize_reachable_snd_empty assms
+      by (metis prod_singleton(2))
+    lemma degeneralize_reachable_snd:
+      "snd ` b.reachable (degeneralize A) (p, k) \<subseteq> insert k {0 ..< length (condition\<^sub>1 A)}"
+      by (cases "condition\<^sub>1 A = []") (auto)
+    lemma degeneralize_reachable:
+      "b.reachable (degeneralize A) (p, k) \<subseteq> a.reachable A p \<times> insert k {0 ..< length (condition\<^sub>1 A)}"
+      by (cases "condition\<^sub>1 A = []") (auto 0 3)
+
+    lemma degeneralize_nodes_fst[simp]: "fst ` b.nodes (degeneralize A) = a.nodes A"
+      unfolding a.nodes_alt_def b.nodes_alt_def by simp
+    lemma degeneralize_nodes_snd_empty:
+      assumes "condition\<^sub>1 A = []"
+      shows "snd ` b.nodes (degeneralize A) = {0}"
+      using assms unfolding b.nodes_alt_def by auto
+    lemma degeneralize_nodes_empty:
+      assumes "condition\<^sub>1 A = []"
+      shows "b.nodes (degeneralize A) = a.nodes A \<times> {0}"
+      using assms unfolding b.nodes_alt_def by auto
+    lemma degeneralize_nodes_snd:
+      "snd ` b.nodes (degeneralize A) \<subseteq> insert 0 {0 ..< length (condition\<^sub>1 A)}"
+      using degeneralize_reachable_snd unfolding b.nodes_alt_def by auto
+    lemma degeneralize_nodes:
+      "b.nodes (degeneralize A) \<subseteq> a.nodes A \<times> insert 0 {0 ..< length (condition\<^sub>1 A)}"
+      using degeneralize_reachable unfolding a.nodes_alt_def b.nodes_alt_def by simp
+  
+    lemma degeneralize_nodes_finite[iff]: "finite (b.nodes (degeneralize A)) \<longleftrightarrow> finite (a.nodes A)"
+    proof
+      show "finite (a.nodes A)" if "finite (b.nodes (degeneralize A))"
+        using that by (auto simp flip: degeneralize_nodes_fst)
+      show "finite (b.nodes (degeneralize A))" if "finite (a.nodes A)"
+        using degeneralize_nodes that finite_subset by fastforce
+    qed
+    lemma degeneralize_nodes_card: "card (b.nodes (degeneralize A)) \<le>
+      max 1 (length (condition\<^sub>1 A)) * card (a.nodes A)"
+    proof (cases "finite (a.nodes A)")
+      case True
+      have "card (b.nodes (degeneralize A)) \<le> card (a.nodes A \<times> insert 0 {0 ..< length (condition\<^sub>1 A)})"
+        using degeneralize_nodes True by (blast intro: card_mono)
+      also have "\<dots> = card (insert 0 {0 ..< length (condition\<^sub>1 A)}) * card (a.nodes A)"
+        unfolding card_cartesian_product by simp
+      also have "card (insert 0 {0 ..< length (condition\<^sub>1 A)}) = max 1 (length (condition\<^sub>1 A))"
+        by (simp add: card_insert_if Suc_leI max_absorb2)
+      finally show ?thesis by this
+    next
+      case False
+      then have "card (a.nodes A) = 0" "card (b.nodes (degeneralize A)) = 0" by auto
+      then show ?thesis by simp
+    qed
+
+  end
+
+  locale automaton_degeneralization_trace =
+    automaton_degeneralization
+      automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1
+      automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 +
+    a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 +
+    b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'state pred gen \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state pred gen"
+    and test\<^sub>1 :: "'state pred gen \<Rightarrow> 'state stream \<Rightarrow> bool"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state degen \<Rightarrow> ('label, 'state degen) trans \<Rightarrow> 'state degen pred \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state degen"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state degen) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state degen pred"
+    and test\<^sub>2 :: "'state degen pred \<Rightarrow> 'state degen stream \<Rightarrow> bool"
+    +
+    assumes test[iff]: "test\<^sub>2 (degen cs) (r ||| sscan (count cs) (p ## r) k) \<longleftrightarrow> test\<^sub>1 cs r"
+  begin
+
+    lemma degeneralize_language[simp]: "b.language (degeneralize A) = a.language A"
+      by (force simp del: sscan_scons)
+
+  end
+
+  locale automaton_combination =
+    a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 +
+    b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 +
+    c: automaton automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state\<^sub>1"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state\<^sub>2"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    and automaton\<^sub>3 :: "'label set \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans \<Rightarrow>
+      'condition\<^sub>3 \<Rightarrow> 'automaton\<^sub>3"
+    and alphabet\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'label set"
+    and initial\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2"
+    and transition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans"
+    and condition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'condition\<^sub>3"
+    +
+    fixes condition :: "'condition\<^sub>1 \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'condition\<^sub>3"
+  begin
+
+    definition combine :: "'automaton\<^sub>1 \<Rightarrow> 'automaton\<^sub>2 \<Rightarrow> 'automaton\<^sub>3" where
+      "combine A B \<equiv> automaton\<^sub>3
+        (alphabet\<^sub>1 A \<inter> alphabet\<^sub>2 B)
+        (initial\<^sub>1 A, initial\<^sub>2 B)
+        (\<lambda> a (p, q). (transition\<^sub>1 A a p, transition\<^sub>2 B a q))
+        (condition (condition\<^sub>1 A) (condition\<^sub>2 B))"
+
+    lemma combine_simps[simp]:
+      "alphabet\<^sub>3 (combine A B) = alphabet\<^sub>1 A \<inter> alphabet\<^sub>2 B"
+      "initial\<^sub>3 (combine A B) = (initial\<^sub>1 A, initial\<^sub>2 B)"
+      "transition\<^sub>3 (combine A B) a (p, q) = (transition\<^sub>1 A a p, transition\<^sub>2 B a q)"
+      "condition\<^sub>3 (combine A B) = condition (condition\<^sub>1 A) (condition\<^sub>2 B)"
+      unfolding combine_def by auto
+
+    lemma combine_target[simp]: "c.target (combine A B) w (p, q) = (a.target A w p, b.target B w q)"
+      by (induct w arbitrary: p q) (auto)
+    lemma combine_states[simp]: "c.states (combine A B) w (p, q) = a.states A w p || b.states B w q"
+      by (induct w arbitrary: p q) (auto)
+    lemma combine_trace[simp]: "c.trace (combine A B) w (p, q) = a.trace A w p ||| b.trace B w q"
+      by (coinduction arbitrary: w p q) (auto)
+
+    lemma combine_path[iff]: "c.path (combine A B) w (p, q) \<longleftrightarrow> a.path A w p \<and> b.path B w q"
+      unfolding a.path_alt_def b.path_alt_def c.path_alt_def by simp
+    lemma combine_run[iff]: "c.run (combine A B) w (p, q) \<longleftrightarrow> a.run A w p \<and> b.run B w q"
+      unfolding a.run_alt_def b.run_alt_def c.run_alt_def by simp
+
+    lemma combine_reachable[simp]: "c.reachable (combine A B) (p, q) \<subseteq> a.reachable A p \<times> b.reachable B q"
+      unfolding c.reachable_alt_def by auto
+    lemma combine_nodes[simp]: "c.nodes (combine A B) \<subseteq> a.nodes A \<times> b.nodes B"
+      unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def by auto
+    lemma combine_reachable_fst[simp]:
+      assumes "alphabet\<^sub>1 A \<subseteq> alphabet\<^sub>2 B"
+      shows "fst ` c.reachable (combine A B) (p, q) = a.reachable A p"
+      using assms
+      unfolding a.reachable_alt_def a.path_alt_def
+      unfolding b.reachable_alt_def b.path_alt_def
+      unfolding c.reachable_alt_def c.path_alt_def
+      by auto force
+    lemma combine_reachable_snd[simp]:
+      assumes "alphabet\<^sub>1 A \<supseteq> alphabet\<^sub>2 B"
+      shows "snd ` c.reachable (combine A B) (p, q) = b.reachable B q"
+      using assms
+      unfolding a.reachable_alt_def a.path_alt_def
+      unfolding b.reachable_alt_def b.path_alt_def
+      unfolding c.reachable_alt_def c.path_alt_def
+      by auto force
+    lemma combine_nodes_fst[simp]:
+      assumes "alphabet\<^sub>1 A \<subseteq> alphabet\<^sub>2 B"
+      shows "fst ` c.nodes (combine A B) = a.nodes A"
+      using assms combine_reachable_fst
+      unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def
+      by fastforce
+    lemma combine_nodes_snd[simp]:
+      assumes "alphabet\<^sub>1 A \<supseteq> alphabet\<^sub>2 B"
+      shows "snd ` c.nodes (combine A B) = b.nodes B"
+      using assms combine_reachable_snd
+      unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def
+      by fastforce
+
+    lemma combine_nodes_finite[intro]:
+      assumes "finite (a.nodes A)" "finite (b.nodes B)"
+      shows "finite (c.nodes (combine A B))"
+    proof (rule finite_subset)
+      show "c.nodes (combine A B) \<subseteq> a.nodes A \<times> b.nodes B" using combine_nodes by this
+      show "finite (a.nodes A \<times> b.nodes B)" using assms by simp
+    qed
+    lemma combine_nodes_finite_strong[iff]:
+      assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B"
+      shows "finite (c.nodes (combine A B)) \<longleftrightarrow> finite (a.nodes A) \<and> finite (b.nodes B)"
+    proof safe
+      show "finite (a.nodes A)" if "finite (c.nodes (combine A B))"
+        using combine_nodes_fst assms that by (metis finite_imageI equalityD1)
+      show "finite (b.nodes B)" if "finite (c.nodes (combine A B))"
+        using combine_nodes_snd assms that by (metis finite_imageI equalityD2)
+      show "finite (c.nodes (combine A B))" if "finite (a.nodes A)" "finite (b.nodes B)"
+        using that by rule
+    qed
+    lemma combine_nodes_card[intro]:
+      assumes "finite (a.nodes A)" "finite (b.nodes B)"
+      shows "card (c.nodes (combine A B)) \<le> card (a.nodes A) * card (b.nodes B)"
+    proof -
+      have "card (c.nodes (combine A B)) \<le> card (a.nodes A \<times> b.nodes B)"
+      proof (rule card_mono)
+        show "finite (a.nodes A \<times> b.nodes B)" using assms by simp
+        show "c.nodes (combine A B) \<subseteq> a.nodes A \<times> b.nodes B" using combine_nodes by this
+      qed
+      also have "\<dots> = card (a.nodes A) * card (b.nodes B)" using card_cartesian_product by this
+      finally show ?thesis by this
+    qed
+    lemma combine_nodes_card_strong[intro]:
+      assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B"
+      shows "card (c.nodes (combine A B)) \<le> card (a.nodes A) * card (b.nodes B)"
+    proof (cases "finite (a.nodes A) \<and> finite (b.nodes B)")
+      case True
+      show ?thesis using True by auto
+    next
+      case False
+      have 1: "card (c.nodes (combine A B)) = 0" using False assms by simp
+      have 2: "card (a.nodes A) * card (b.nodes B) = 0" using False by auto
+      show ?thesis using 1 2 by simp
+    qed
+
+  end
+
+  locale automaton_intersection_trace =
+    automaton_combination
+      automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1
+      automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2
+      automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition +
+    a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 +
+    b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 +
+    c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state\<^sub>1"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and test\<^sub>1 :: "'condition\<^sub>1 \<Rightarrow> 'state\<^sub>1 stream \<Rightarrow> bool"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state\<^sub>2"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    and test\<^sub>2 :: "'condition\<^sub>2 \<Rightarrow> 'state\<^sub>2 stream \<Rightarrow> bool"
+    and automaton\<^sub>3 :: "'label set \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans \<Rightarrow>
+      'condition\<^sub>3 \<Rightarrow> 'automaton\<^sub>3"
+    and alphabet\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'label set"
+    and initial\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2"
+    and transition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans"
+    and condition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'condition\<^sub>3"
+    and test\<^sub>3 :: "'condition\<^sub>3 \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) stream \<Rightarrow> bool"
+    and condition :: "'condition\<^sub>1 \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'condition\<^sub>3"
+    +
+    assumes test[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) (u ||| v) \<longleftrightarrow> test\<^sub>1 c\<^sub>1 u \<and> test\<^sub>2 c\<^sub>2 v"
+  begin
+
+    lemma combine_language[simp]: "c.language (combine A B) = a.language A \<inter> b.language B" by force
+
+  end
+
+  locale automaton_union_trace =
+    automaton_combination
+      automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1
+      automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2
+      automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition +
+    a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 +
+    b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 +
+    c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state\<^sub>1"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state\<^sub>1) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and test\<^sub>1 :: "'condition\<^sub>1 \<Rightarrow> 'state\<^sub>1 stream \<Rightarrow> bool"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state\<^sub>2"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>2) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    and test\<^sub>2 :: "'condition\<^sub>2 \<Rightarrow> 'state\<^sub>2 stream \<Rightarrow> bool"
+    and automaton\<^sub>3 :: "'label set \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans \<Rightarrow>
+      'condition\<^sub>3 \<Rightarrow> 'automaton\<^sub>3"
+    and alphabet\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'label set"
+    and initial\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'state\<^sub>1 \<times> 'state\<^sub>2"
+    and transition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> ('label, 'state\<^sub>1 \<times> 'state\<^sub>2) trans"
+    and condition\<^sub>3 :: "'automaton\<^sub>3 \<Rightarrow> 'condition\<^sub>3"
+    and test\<^sub>3 :: "'condition\<^sub>3 \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) stream \<Rightarrow> bool"
+    and condition :: "'condition\<^sub>1 \<Rightarrow> 'condition\<^sub>2 \<Rightarrow> 'condition\<^sub>3"
+    +
+    assumes test[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) (u ||| v) \<longleftrightarrow> test\<^sub>1 c\<^sub>1 u \<or> test\<^sub>2 c\<^sub>2 v"
+  begin
+
+    lemma combine_language[simp]:
+      assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B"
+      shows "c.language (combine A B) = a.language A \<union> b.language B"
+      using assms by (force simp: a.run_alt_def b.run_alt_def)
+
+  end
+
+  (* TODO: complete this in analogy to the pair case *)
+  locale automaton_combination_list =
+    a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 +
+    b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state list \<Rightarrow> ('label, 'state list) trans \<Rightarrow>
+      'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state list"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state list) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    +
+    fixes condition :: "'condition\<^sub>1 list \<Rightarrow> 'condition\<^sub>2"
+  begin
+
+    definition combine :: "'automaton\<^sub>1 list \<Rightarrow> 'automaton\<^sub>2" where
+      "combine AA \<equiv> automaton\<^sub>2
+        (\<Inter> (alphabet\<^sub>1 ` set AA))
+        (map initial\<^sub>1 AA)
+        (\<lambda> a pp. map2 (\<lambda> A p. transition\<^sub>1 A a p) AA pp)
+        (condition (map condition\<^sub>1 AA))"
+
+    lemma combine_simps[simp]:
+      "alphabet\<^sub>2 (combine AA) = \<Inter> (alphabet\<^sub>1 ` set AA)"
+      "initial\<^sub>2 (combine AA) = map initial\<^sub>1 AA"
+      "transition\<^sub>2 (combine AA) a pp = map2 (\<lambda> A p. transition\<^sub>1 A a p) AA pp"
+      "condition\<^sub>2 (combine AA) = condition (map condition\<^sub>1 AA)"
+      unfolding combine_def by auto
+
+    (* TODO: get rid of indices, express this using stranspose *)
+    lemma combine_trace_smap:
+      assumes "length pp = length AA" "k < length AA"
+      shows "smap (\<lambda> pp. pp ! k) (b.trace (combine AA) w pp) = a.trace (AA ! k) w (pp ! k)"
+      using assms by (coinduction arbitrary: w pp) (force)
+    lemma combine_nodes_length:
+      assumes "pp \<in> b.nodes (combine AA)"
+      shows "length pp = length AA"
+      using assms by induct auto
+    lemma combine_nodes[intro]:
+      assumes "pp \<in> b.nodes (combine AA)" "k < length pp"
+      shows "pp ! k \<in> a.nodes (AA ! k)"
+      using assms by induct auto
+
+    lemma combine_nodes_finite[intro]:
+      assumes "list_all (finite \<circ> a.nodes) AA"
+      shows "finite (b.nodes (combine AA))"
+    proof (rule finite_subset)
+      show "b.nodes (combine AA) \<subseteq> listset (map a.nodes AA)"
+        by (force simp: listset_member list_all2_conv_all_nth combine_nodes_length)
+      have "finite (listset (map a.nodes AA)) \<longleftrightarrow> list_all finite (map a.nodes AA)"
+        by (rule listset_finite) (auto simp: list_all_iff)
+      then show "finite (listset (map a.nodes AA))" using assms by (simp add: list.pred_map)
+    qed
+    lemma combine_nodes_card:
+      assumes "list_all (finite \<circ> a.nodes) AA"
+      shows "card (b.nodes (combine AA)) \<le> prod_list (map (card \<circ> a.nodes) AA)"
+    proof -
+      have "card (b.nodes (combine AA)) \<le> card (listset (map a.nodes AA))"
+      proof (rule card_mono)
+        have "finite (listset (map a.nodes AA)) \<longleftrightarrow> list_all finite (map a.nodes AA)"
+          by (rule listset_finite) (auto simp: list_all_iff)
+        then show "finite (listset (map a.nodes AA))" using assms by (simp add: list.pred_map)
+        show "b.nodes (combine AA) \<subseteq> listset (map a.nodes AA)"
+          by (force simp: listset_member list_all2_conv_all_nth combine_nodes_length)
+      qed
+      also have "\<dots> = prod_list (map (card \<circ> a.nodes) AA)" by simp
+      finally show ?thesis by this
+    qed
+
+  end
+
+  locale automaton_intersection_list_trace =
+    automaton_combination_list
+      automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1
+      automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition +
+    a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 +
+    b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and test\<^sub>1 :: "'condition\<^sub>1 \<Rightarrow> 'state stream \<Rightarrow> bool"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state list \<Rightarrow> ('label, 'state list) trans \<Rightarrow>
+      'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state list"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state list) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    and test\<^sub>2 :: "'condition\<^sub>2 \<Rightarrow> 'state list stream \<Rightarrow> bool"
+    and condition :: "'condition\<^sub>1 list \<Rightarrow> 'condition\<^sub>2"
+    +
+    assumes test[iff]: "test\<^sub>2 (condition cs) w \<longleftrightarrow>
+      (\<forall> k < length cs. test\<^sub>1 (cs ! k) (smap (\<lambda> pp. pp ! k) w))"
+  begin
+
+    lemma combine_language[simp]: "b.language (combine AA) = \<Inter> (a.language ` set AA)"
+      unfolding a.language_def b.language_def
+      unfolding a.run_alt_def b.run_alt_def
+      by (auto simp: combine_trace_smap iff: in_set_conv_nth)
+
+  end
+
+  locale automaton_union_list_trace =
+    automaton_combination_list
+      automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1
+      automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition +
+    a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 +
+    b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2
+    for automaton\<^sub>1 :: "'label set \<Rightarrow> 'state \<Rightarrow> ('label, 'state) trans \<Rightarrow> 'condition\<^sub>1 \<Rightarrow> 'automaton\<^sub>1"
+    and alphabet\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'label set"
+    and initial\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'state"
+    and transition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> ('label, 'state) trans"
+    and condition\<^sub>1 :: "'automaton\<^sub>1 \<Rightarrow> 'condition\<^sub>1"
+    and test\<^sub>1 :: "'condition\<^sub>1 \<Rightarrow> 'state stream \<Rightarrow> bool"
+    and automaton\<^sub>2 :: "'label set \<Rightarrow> 'state list \<Rightarrow> ('label, 'state list) trans \<Rightarrow>
+      'condition\<^sub>2 \<Rightarrow> 'automaton\<^sub>2"
+    and alphabet\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'label set"
+    and initial\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'state list"
+    and transition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> ('label, 'state list) trans"
+    and condition\<^sub>2 :: "'automaton\<^sub>2 \<Rightarrow> 'condition\<^sub>2"
+    and test\<^sub>2 :: "'condition\<^sub>2 \<Rightarrow> 'state list stream \<Rightarrow> bool"
+    and condition :: "'condition\<^sub>1 list \<Rightarrow> 'condition\<^sub>2"
+    +
+    assumes test[iff]: "test\<^sub>2 (condition cs) w \<longleftrightarrow>
+      (\<exists> k < length cs. test\<^sub>1 (cs ! k) (smap (\<lambda> pp. pp ! k) w))"
+  begin
+
+    lemma combine_language[simp]:
+      assumes "\<Inter> (alphabet\<^sub>1 ` set AA) = \<Union> (alphabet\<^sub>1 ` set AA)"
+      shows "b.language (combine AA) = \<Union> (a.language ` set AA)"
+      using assms
+      unfolding a.language_def b.language_def
+      unfolding a.run_alt_def b.run_alt_def
+      by (auto simp: combine_trace_smap iff: in_set_conv_nth) (metis INT_subset_iff in_set_conv_nth)
+
+  end
+
+end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Basic/Basic.thy b/thys/Transition_Systems_and_Automata/Basic/Basic.thy
--- a/thys/Transition_Systems_and_Automata/Basic/Basic.thy
+++ b/thys/Transition_Systems_and_Automata/Basic/Basic.thy
@@ -1,31 +1,35 @@
 section \<open>Basics\<close>
 
 theory Basic
 imports Main
 begin
 
   subsection \<open>Miscellaneous\<close>
 
   abbreviation (input) "const x \<equiv> \<lambda> _. x"
 
   lemmas [simp] = map_prod.id map_prod.comp[symmetric]
   lemma prod_UNIV[iff]: "A \<times> B = UNIV \<longleftrightarrow> A = UNIV \<and> B = UNIV" by auto
+  lemma prod_singleton:
+    "fst ` A = {x} \<Longrightarrow> A = fst ` A \<times> snd ` A"
+    "snd ` A = {y} \<Longrightarrow> A = fst ` A \<times> snd ` A"
+    by force+
 
   lemma infinite_subset[trans]: "infinite A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> infinite B" using infinite_super by this
   lemma finite_subset[trans]: "A \<subseteq> B \<Longrightarrow> finite B \<Longrightarrow> finite A" using finite_subset by this
 
   declare infinite_coinduct[case_names infinite, coinduct pred: infinite]
   lemma infinite_psubset_coinduct[case_names infinite, consumes 1]:
     assumes "R A"
     assumes "\<And> A. R A \<Longrightarrow> \<exists> B \<subset> A. R B"
     shows "infinite A"
   proof
     show "False" if "finite A" using that assms by (induct rule: finite_psubset_induct) (auto)
   qed
 
   (* TODO: why are there two copies of this theorem? *)
   thm inj_on_subset subset_inj_on
 
   lemma inj_inj_on[dest]: "inj f \<Longrightarrow> inj_on f S" using inj_on_subset by auto
 
 end
diff --git a/thys/Transition_Systems_and_Automata/Basic/Degeneralization.thy b/thys/Transition_Systems_and_Automata/Basic/Degeneralization.thy
--- a/thys/Transition_Systems_and_Automata/Basic/Degeneralization.thy
+++ b/thys/Transition_Systems_and_Automata/Basic/Degeneralization.thy
@@ -1,224 +1,230 @@
 theory Degeneralization
 imports
   Acceptance
   Sequence_Zip
 begin
 
   type_synonym 'a degen = "'a \<times> nat"
 
   definition degen :: "'a pred gen \<Rightarrow> 'a degen pred" where
     "degen cs \<equiv> \<lambda> (a, k). k \<ge> length cs \<or> (cs ! k) a"
 
   lemma degen_simps[iff]: "degen cs (a, k) \<longleftrightarrow> k \<ge> length cs \<or> (cs ! k) a" unfolding degen_def by simp
 
   definition count :: "'a pred gen \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> nat" where
-    "count cs a k \<equiv> if k < length cs then if (cs ! k) a then Suc k mod length cs else k else 0"
+    "count cs a k \<equiv>
+      if k < length cs
+      then if (cs ! k) a then Suc k mod length cs else k
+      else if cs = [] then k else 0"
 
-  lemma count_empty[simp]: "count [] a k = 0" unfolding count_def by simp
-  lemma count_nonempty[simp]:
-    assumes "cs \<noteq> []"
-    shows "count cs a k < length cs"
-    using assms unfolding count_def by simp
+  lemma count_empty[simp]: "count [] a k = k" unfolding count_def by simp
+  lemma count_nonempty[simp]: "cs \<noteq> [] \<Longrightarrow> count cs a k < length cs" unfolding count_def by simp
   lemma count_constant_1:
     assumes "k < length cs"
     assumes "\<And> a. a \<in> set w \<Longrightarrow> \<not> (cs ! k) a"
     shows "fold (count cs) w k = k"
     using assms unfolding count_def by (induct w) (auto)
   lemma count_constant_2:
     assumes "k < length cs"
     assumes "\<And> a. a \<in> set (w || k # scan (count cs) w k) \<Longrightarrow> \<not> degen cs a"
     shows "fold (count cs) w k = k"
     using assms unfolding count_def by (induct w) (auto)
+  lemma count_step:
+    assumes "k < length cs"
+    assumes "(cs ! k) a"
+    shows "count cs a k = Suc k mod length cs"
+    using assms unfolding count_def by simp
 
   lemma degen_skip_condition:
     assumes "k < length cs"
     assumes "infs (degen cs) (w ||| k ## sscan (count cs) w k)"
     obtains u a v
     where "w = u @- a ## v" "fold (count cs) u k = k" "(cs ! k) a"
   proof -
     have 1: "Collect (degen cs) \<inter> sset (w ||| k ## sscan (count cs) w k) \<noteq> {}"
       using infs_any assms(2) by auto
     obtain ys x zs where 2:
       "w ||| k ## sscan (count cs) w k = ys @- x ## zs"
       "Collect (degen cs) \<inter> set ys = {}"
       "x \<in> Collect (degen cs)"
       using split_stream_first 1 by this
     define u where "u \<equiv> stake (length ys) w"
     define a where "a \<equiv> w !! length ys"
     define v where "v \<equiv> sdrop (Suc (length ys)) w"
     have "ys = stake (length ys) (w ||| k ## sscan (count cs) w k)" using shift_eq 2(1) by auto
     also have "\<dots> = stake (length ys) w || stake (length ys) (k ## sscan (count cs) w k)" by simp
     also have "\<dots> = take (length ys) u || take (length ys) (k # scan (count cs) u k)"
       unfolding u_def
       using append_eq_conv_conj length_stake length_zip stream.sel
       using sscan_stake stake.simps(2) stake_Suc stake_szip take_stake
       by metis
     also have "\<dots> = take (length ys) (u || k # scan (count cs) u k)" using take_zip by rule
     also have "\<dots> = u || k # scan (count cs) u k" unfolding u_def by simp
     finally have 3: "ys = u || k # scan (count cs) u k" by this
     have "x = (w ||| k ## sscan (count cs) w k) !! length ys" unfolding 2(1) by simp
     also have "\<dots> = (w !! length ys, (k ## sscan (count cs) w k) !! length ys)" by simp
     also have "\<dots> = (a, fold (count cs) u k)" unfolding u_def a_def by simp
     finally have 4: "x = (a, fold (count cs) u k)" by this
     have 5: "fold (count cs) u k = k" using count_constant_2 assms(1) 2(2) unfolding 3 by blast
     show ?thesis
     proof
       show "w = u @- a ## v" unfolding u_def a_def v_def using id_stake_snth_sdrop by this
       show "fold (count cs) u k = k" using 5 by this
       show "(cs ! k) a" using assms(1) 2(3) unfolding 4 5 by simp
     qed
   qed
   lemma degen_skip_arbitrary:
     assumes "k < length cs" "l < length cs"
     assumes "infs (degen cs) (w ||| k ## sscan (count cs) w k)"
     obtains u v
     where "w = u @- v" "fold (count cs) u k = l"
   using assms
   proof (induct "nat ((int l - int k) mod length cs)" arbitrary: l thesis)
     case (0)
     have 1: "length cs > 0" using assms(1) by auto
     have 2: "(int l - int k) mod length cs = 0" using 0(1) 1 by (auto intro: antisym)
     have 3: "int l mod length cs = int k mod length cs" using mod_eq_dvd_iff 2 by force
     have 4: "k = l" using 0(3, 4) 3 by simp
     show ?case
     proof (rule 0(2))
       show "w = [] @- w" by simp
       show "fold (count cs) [] k = l" using 4 by simp
     qed
   next
     case (Suc n)
     have 1: "length cs > 0" using assms(1) by auto
     define l' where "l' = nat ((int l - 1) mod length cs)"
     obtain u v where 2: "w = u @- v" "fold (count cs) u k = l'"
     proof (rule Suc(1))
       have 2: "Suc n < length cs" using nat_less_iff Suc(2) 1 by simp
       have "n = nat (int n)" by simp
       also have "int n = (int (Suc n) - 1) mod length cs" using 2 by simp
       also have "\<dots> = (int l - int k - 1) mod length cs" using Suc(2) by (simp add: mod_simps)
       also have "\<dots> = (int l - 1 - int k) mod length cs" by (simp add: algebra_simps)
       also have "\<dots> = (int l' - int k) mod length cs" using l'_def 1 by (simp add: mod_simps)
       finally show "n = nat ((int l' - int k) mod length cs)" by this
       show "k < length cs" using Suc(4) by this
       show "l' < length cs" using nat_less_iff l'_def 1 by simp
       show "infs (degen cs) (w ||| k ## sscan (count cs) w k)" using Suc(6) by this
     qed
     have 3: "l' < length cs" using nat_less_iff l'_def 1 by simp
     have 4: "v ||| l' ## sscan (count cs) v l' = sdrop (length u) (w ||| k ## sscan (count cs) w k)"
       using 2 eq_scons eq_shift
       by (metis sdrop.simps(2) sdrop_simps sdrop_szip sscan_scons_snth sscan_sdrop stream.sel(2))
     have 5: "infs (degen cs) (v ||| l' ## sscan (count cs) v l')" using Suc(6) unfolding 4 by blast
     obtain vu a vv where 6: "v = vu @- a ## vv" "fold (count cs) vu l' = l'" "(cs ! l') a"
       using degen_skip_condition 3 5 by this
     have "l = nat (int l)" by simp
     also have "int l = int l mod length cs" using Suc(5) by simp
     also have "\<dots> = int (Suc l') mod length cs" using l'_def 1 by (simp add: mod_simps)
     finally have 7: "l = Suc l' mod length cs" using nat_mod_as_int by metis
     show ?case
     proof (rule Suc(3))
       show "w = (u @ vu @ [a]) @- vv" unfolding 2(1) 6(1) by simp
-      show "fold (count cs) (u @ vu @ [a]) k = l" using 2(2) 3 6(2, 3) 7 unfolding count_def by simp
+      show "fold (count cs) (u @ vu @ [a]) k = l" using 2(2) 3 6(2, 3) 7 count_step by simp
     qed
   qed
   lemma degen_skip_arbitrary_condition:
     assumes "l < length cs"
     assumes "infs (degen cs) (w ||| k ## sscan (count cs) w k)"
     obtains u a v
     where "w = u @- a ## v" "fold (count cs) u k = l" "(cs ! l) a"
   proof -
-    have 1: "count cs (shd w) k < length cs" using mod_Suc assms(1) unfolding count_def by auto
+    have 0: "cs \<noteq> []" using assms(1) by auto
+    have 1: "count cs (shd w) k < length cs" using 0 by simp
     have 2: "infs (degen cs) (stl w ||| count cs (shd w) k ## sscan (count cs) (stl w) (count cs (shd w) k))"
       using assms(2) by (metis alw.cases sscan.code stream.sel(2) szip.simps(2))
     obtain u v where 3: "stl w = u @- v" "fold (count cs) u (count cs (shd w) k) = l"
       using degen_skip_arbitrary 1 assms(1) 2 by this
     have 4: "v ||| l ## sscan (count cs) v l =
       sdrop (length u) (stl w ||| count cs (shd w) k ## sscan (count cs) (stl w) (count cs (shd w) k))"
       using 3 eq_scons eq_shift
       by (metis sdrop.simps(2) sdrop_simps sdrop_szip sscan_scons_snth sscan_sdrop stream.sel(2))
     have 5: "infs (degen cs) (v ||| l ## sscan (count cs) v l)" using 2 unfolding 4 by blast
     obtain vu a vv where 6: "v = vu @- a ## vv" "fold (count cs) vu l = l" "(cs ! l) a"
       using degen_skip_condition assms(1) 5 by this
     show ?thesis
     proof
       show "w = (shd w # u @ vu) @- a ## vv" using 3(1) 6(1) by (simp add: eq_scons)
       show "fold (count cs) (shd w # u @ vu) k = l" using 3(2) 6(2) by simp
       show "(cs ! l) a" using 6(3) by this
     qed
   qed
   lemma gen_degen_step:
     assumes "gen infs cs w"
     obtains u a v
     where "w = u @- a ## v" "degen cs (a, fold (count cs) u k)"
   proof (cases "k < length cs")
     case True
     have 1: "infs (cs ! k) w" using assms True by auto
     have 2: "{a. (cs ! k) a} \<inter> sset w \<noteq> {}" using infs_any 1 by auto
     obtain u a v where 3: "w = u @- a ## v" "{a. (cs ! k) a} \<inter> set u = {}" "a \<in> {a. (cs ! k) a}"
       using split_stream_first 2 by this
     have 4: "fold (count cs) u k = k" using count_constant_1 True 3(2) by auto
     show ?thesis using 3(1, 3) 4 that by simp
   next
     case False
     show ?thesis
     proof
       show "w = [] @- shd w ## stl w" by simp
       show "degen cs (shd w, fold (count cs) [] k)" using False by simp
     qed
   qed
 
   lemma degen_infs[iff]: "infs (degen cs) (w ||| k ## sscan (count cs) w k) \<longleftrightarrow> gen infs cs w"
   proof
     show "gen infs cs w" if "infs (degen cs) (w ||| k ## sscan (count cs) w k)"
     proof
       fix c
       assume 1: "c \<in> set cs"
       obtain l where 2: "c = cs ! l" "l < length cs" using in_set_conv_nth 1 by metis
       show "infs c w"
       using that unfolding 2(1)
       proof (coinduction arbitrary: w k rule: infs_set_coinduct)
         case (infs_set w k)
         obtain u a v where 3: "w = u @- a ## v" "(cs ! l) a"
           using degen_skip_arbitrary_condition 2(2) infs_set by this
         let ?k = "fold (count cs) u k"
         let ?l = "fold (count cs) (u @ [a]) k"
         have 4: "a ## v ||| ?k ## sscan (count cs) (a ## v) ?k =
           sdrop (length u) (w ||| k ## sscan (count cs) w k)"
           using 3(1) eq_shift scons_eq
           by (metis sdrop_simps(1) sdrop_stl sdrop_szip sscan_scons_snth sscan_sdrop stream.sel(2))
         have 5: "infs (degen cs) (a ## v ||| ?k ## sscan (count cs) (a ## v) ?k)"
           using infs_set unfolding 4 by blast
         show ?case
         proof (intro exI conjI bexI)
           show "w = (u @ [a]) @- v" "(cs ! l) a" "a \<in> set (u @ [a])" "v = v" using 3 by auto
           show "infs (degen cs) (v ||| ?l ## sscan (count cs) v ?l)" using 5 by simp
         qed
       qed
     qed
     show "infs (degen cs) (w ||| k ## sscan (count cs) w k)" if "gen infs cs w"
     using that
     proof (coinduction arbitrary: w k rule: infs_set_coinduct)
       case (infs_set w k)
       obtain u a v where 1: "w = u @- a ## v" "degen cs (a, fold (count cs) u k)"
         using gen_degen_step infs_set by this
       let ?u = "u @ [a] || k # scan (count cs) u k"
       let ?l = "fold (count cs) (u @ [a]) k"
       show ?case
       proof (intro exI conjI bexI)
         have "w ||| k ## sscan (count cs) w k =
           (u @ [a]) @- v ||| k ## scan (count cs) u k @- ?l ## sscan (count cs) v ?l"
           unfolding 1(1) by simp
         also have "\<dots> = ?u @- (v ||| ?l ## sscan (count cs) v ?l)"
           by (metis length_Cons length_append_singleton scan_length shift.simps(2) szip_shift)
         finally show "w ||| k ## sscan (count cs) w k = ?u @- (v ||| ?l ## sscan (count cs) v ?l)" by this
         show "degen cs (a, fold (count cs) u k)" using 1(2) by this
         have "(a, fold (count cs) u k) = (last (u @ [a]), last (k # scan (count cs) u k))"
           unfolding scan_last by simp
         also have "\<dots> = last ?u" by (simp add: zip_eq_Nil_iff)
         also have "\<dots> \<in> set ?u" by (fastforce intro: last_in_set simp: zip_eq_Nil_iff)
         finally show "(a, fold (count cs) u k) \<in> set ?u" by this
         show "v ||| ?l ## sscan (count cs) v ?l = v ||| ?l ## sscan (count cs) v ?l" by rule
         show "gen infs cs v" using infs_set unfolding 1(1) by auto
       qed
     qed
   qed
 
-end
\ No newline at end of file
+end
diff --git a/thys/Transition_Systems_and_Automata/Basic/Sequence.thy b/thys/Transition_Systems_and_Automata/Basic/Sequence.thy
--- a/thys/Transition_Systems_and_Automata/Basic/Sequence.thy
+++ b/thys/Transition_Systems_and_Automata/Basic/Sequence.thy
@@ -1,436 +1,441 @@
 section \<open>Finite and Infinite Sequences\<close>
 
 theory Sequence
 imports
   "Basic"
   "HOL-Library.Stream"
   "HOL-Library.Monad_Syntax"
 begin
 
   subsection \<open>List Basics\<close>
 
   declare upt_Suc[simp del]
   declare last.simps[simp del]
   declare butlast.simps[simp del]
   declare Cons_nth_drop_Suc[simp]
   declare list.pred_True[simp]
 
   lemma list_pred_cases:
     assumes "list_all P xs"
     obtains (nil) "xs = []" | (cons) y ys where "xs = y # ys" "P y" "list_all P ys"
     using assms by (cases xs) (auto)
 
   lemma lists_iff_set: "w \<in> lists A \<longleftrightarrow> set w \<subseteq> A" by auto
 
   lemma fold_const: "fold const xs a = last (a # xs)"
     by (induct xs arbitrary: a) (auto simp: last.simps)
 
   lemma take_Suc: "take (Suc n) xs = (if xs = [] then [] else hd xs # take n (tl xs))"
     by (simp add: take_Suc)
 
   lemma bind_map[simp]: "map f xs \<bind> g = xs \<bind> g \<circ> f" unfolding List.bind_def by simp
 
+  lemma ball_bind[iff]: "Ball (set (xs \<bind> f)) P \<longleftrightarrow> (\<forall> x \<in> set xs. \<forall> y \<in> set (f x). P y)"
+    unfolding set_list_bind by simp
+  lemma bex_bind[iff]: "Bex (set (xs \<bind> f)) P \<longleftrightarrow> (\<exists> x \<in> set xs. \<exists> y \<in> set (f x). P y)"
+    unfolding set_list_bind by simp
+
   lemma listset_member: "ys \<in> listset XS \<longleftrightarrow> list_all2 (\<in>) ys XS"
     by (induct XS arbitrary: ys) (auto simp: set_Cons_def list_all2_Cons2)
   lemma listset_empty[iff]: "listset XS = {} \<longleftrightarrow> \<not> list_all (\<lambda> A. A \<noteq> {}) XS"
     by (induct XS) (auto simp: set_Cons_def)
   lemma listset_finite[iff]:
     assumes "list_all (\<lambda> A. A \<noteq> {}) XS"
     shows "finite (listset XS) \<longleftrightarrow> list_all finite XS"
   using assms
   proof (induct XS)
     case Nil
     show ?case by simp
   next
     case (Cons A XS)
     note [simp] = finite_image_iff finite_cartesian_product_iff
     have "listset (A # XS) = case_prod Cons ` (A \<times> listset XS)" by (auto simp: set_Cons_def)
     also have "finite \<dots> \<longleftrightarrow> finite (A \<times> listset XS)" by (simp add: inj_on_def)
     also have "\<dots> \<longleftrightarrow> finite A \<and> finite (listset XS)" using Cons(2) by simp
     also have "finite (listset XS) \<longleftrightarrow> list_all finite XS" using Cons by simp
     also have "finite A \<and> \<dots> \<longleftrightarrow> list_all finite (A # XS)" by simp
     finally show ?case by this
   qed
   lemma listset_card[simp]: "card (listset XS) = prod_list (map card XS)"
   proof (induct XS)
     case Nil
     show ?case by simp
   next
     case (Cons A XS)
     have 1: "inj (case_prod Cons)" unfolding inj_def by simp
     have "listset (A # XS) = case_prod Cons ` (A \<times> listset XS)" by (auto simp: set_Cons_def)
     also have "card \<dots> = card (A \<times> listset XS)" using card_image 1 by auto
     also have "\<dots> = card A * card (listset XS)" using card_cartesian_product by this
     also have "card (listset XS) = prod_list (map card XS)" using Cons by this
     also have "card A * \<dots> = prod_list (map card (A # XS))" by simp
     finally show ?case by this
   qed
 
   subsection \<open>Stream Basics\<close>
 
   declare stream.map_id[simp]
   declare stream.set_map[simp]
   declare stream.set_sel(1)[intro!, simp]
   declare stream.pred_True[simp]
   declare stream.pred_map[iff]
   declare stream.rel_map[iff]
   declare shift_simps[simp del]
   declare stake_sdrop[simp]
   declare stake_siterate[simp del]
   declare sdrop_snth[simp]
 
   lemma stream_pred_cases:
     assumes "pred_stream P xs"
     obtains (scons) y ys where "xs = y ## ys" "P y" "pred_stream P ys"
     using assms by (cases xs) (auto)
 
   lemma stream_rel_coinduct[case_names stream_rel, coinduct pred: stream_all2]:
     assumes "R u v"
     assumes "\<And> a u b v. R (a ## u) (b ## v) \<Longrightarrow> P a b \<and> R u v"
     shows "stream_all2 P u v"
     using assms by (coinduct) (metis stream.collapse)
   lemma stream_rel_coinduct_shift[case_names stream_rel, consumes 1]:
     assumes "R u v"
     assumes "\<And> u v. R u v \<Longrightarrow>
       \<exists> u\<^sub>1 u\<^sub>2 v\<^sub>1 v\<^sub>2. u = u\<^sub>1 @- u\<^sub>2 \<and> v = v\<^sub>1 @- v\<^sub>2 \<and> u\<^sub>1 \<noteq> [] \<and> v\<^sub>1 \<noteq> [] \<and> list_all2 P u\<^sub>1 v\<^sub>1 \<and> R u\<^sub>2 v\<^sub>2"
     shows "stream_all2 P u v"
   proof -
     have "\<exists> u\<^sub>1 u\<^sub>2 v\<^sub>1 v\<^sub>2. u = u\<^sub>1 @- u\<^sub>2 \<and> v = v\<^sub>1 @- v\<^sub>2 \<and> list_all2 P u\<^sub>1 v\<^sub>1 \<and> R u\<^sub>2 v\<^sub>2"
       using assms(1) by force
     then show ?thesis using assms(2) by (coinduct) (force elim: list.rel_cases)
   qed
 
   lemma stream_pred_coinduct[case_names stream_pred, coinduct pred: pred_stream]:
     assumes "R w"
     assumes "\<And> a w. R (a ## w) \<Longrightarrow> P a \<and> R w"
     shows "pred_stream P w"
     using assms unfolding stream.pred_rel eq_onp_def by (coinduction arbitrary: w) (auto)
   lemma stream_pred_coinduct_shift[case_names stream_pred, consumes 1]:
     assumes "R w"
     assumes "\<And> w. R w \<Longrightarrow> \<exists> u v. w = u @- v \<and> u \<noteq> [] \<and> list_all P u \<and> R v"
     shows "pred_stream P w"
   proof -
     have "\<exists> u v. w = u @- v \<and> list_all P u \<and> R v"
       using assms(1) by (metis list_all_simps(2) shift.simps(1))
     then show ?thesis using assms(2) by (coinduct) (force elim: list_pred_cases)
   qed
   lemma stream_pred_flat_coinduct[case_names stream_pred, consumes 1]:
     assumes "R ws"
     assumes "\<And> w ws. R (w ## ws) \<Longrightarrow> w \<noteq> [] \<and> list_all P w \<and> R ws"
     shows "pred_stream P (flat ws)"
     using assms
     by (coinduction arbitrary: ws rule: stream_pred_coinduct_shift) (metis stream.exhaust flat_Stream)
 
   lemmas stream_eq_coinduct[case_names stream_eq, coinduct pred: HOL.eq] =
     stream_rel_coinduct[where ?P = HOL.eq, unfolded stream.rel_eq]
   lemmas stream_eq_coinduct_shift[case_names stream_eq, consumes 1] =
     stream_rel_coinduct_shift[where ?P = HOL.eq, unfolded stream.rel_eq list.rel_eq]
 
   lemma stream_pred_shift[iff]: "pred_stream P (u @- v) \<longleftrightarrow> list_all P u \<and> pred_stream P v"
     by (induct u) (auto)
   lemma stream_rel_shift[iff]:
     assumes "length u\<^sub>1 = length v\<^sub>1"
     shows "stream_all2 P (u\<^sub>1 @- u\<^sub>2) (v\<^sub>1 @- v\<^sub>2) \<longleftrightarrow> list_all2 P u\<^sub>1 v\<^sub>1 \<and> stream_all2 P u\<^sub>2 v\<^sub>2"
     using assms by (induct rule: list_induct2) (auto)
 
   lemma sset_subset_stream_pred: "sset w \<subseteq> A \<longleftrightarrow> pred_stream (\<lambda> a. a \<in> A) w"
     unfolding stream.pred_set by auto
 
   lemma eq_scons: "w = a ## v \<longleftrightarrow> a = shd w \<and> v = stl w" by auto
   lemma scons_eq: "a ## v = w \<longleftrightarrow> shd w = a \<and> stl w = v" by auto
   lemma eq_shift: "w = u @- v \<longleftrightarrow> stake (length u) w = u \<and> sdrop (length u) w = v"
     by (induct u arbitrary: w) (force+)
   lemma shift_eq: "u @- v = w \<longleftrightarrow> u = stake (length u) w \<and> v = sdrop (length u) w"
     by (induct u arbitrary: w) (force+)
   lemma scons_eq_shift: "a ## w = u @- v \<longleftrightarrow> ([] = u \<and> a ## w = v) \<or> (\<exists> u'. a # u' = u \<and> w = u' @- v)"
     by (cases u) (auto)
   lemma shift_eq_scons: "u @- v = a ## w \<longleftrightarrow> (u = [] \<and> v = a ## w) \<or> (\<exists> u'. u = a # u' \<and> u' @- v = w)"
     by (cases u) (auto)
 
   lemma stream_all2_sset1:
     assumes "stream_all2 P xs ys"
     shows "\<forall> x \<in> sset xs. \<exists> y \<in> sset ys. P x y"
   proof -
     have "pred_stream (\<lambda> x. \<exists> y \<in> S. P x y) xs" if "sset ys \<subseteq> S" for S
       using assms that by (coinduction arbitrary: xs ys) (force elim: stream.rel_cases)
     then show ?thesis unfolding stream.pred_set by auto
   qed
   lemma stream_all2_sset2:
     assumes "stream_all2 P xs ys"
     shows "\<forall> y \<in> sset ys. \<exists> x \<in> sset xs. P x y"
   proof -
     have "pred_stream (\<lambda> y. \<exists> x \<in> S. P x y) ys" if "sset xs \<subseteq> S" for S
       using assms that by (coinduction arbitrary: xs ys) (force elim: stream.rel_cases)
     then show ?thesis unfolding stream.pred_set by auto
   qed
 
   lemma smap_eq_scons[iff]: "smap f xs = y ## ys \<longleftrightarrow> f (shd xs) = y \<and> smap f (stl xs) = ys"
     using smap_ctr by metis
   lemma scons_eq_smap[iff]: "y ## ys = smap f xs \<longleftrightarrow> y = f (shd xs) \<and> ys = smap f (stl xs)"
     using smap_ctr by metis
   lemma smap_eq_shift[iff]:
     "smap f w = u @- v \<longleftrightarrow> (\<exists> w\<^sub>1 w\<^sub>2. w = w\<^sub>1 @- w\<^sub>2 \<and> map f w\<^sub>1 = u \<and> smap f w\<^sub>2 = v)"
     using sdrop_smap eq_shift stake_sdrop stake_smap by metis
   lemma shift_eq_smap[iff]:
     "u @- v = smap f w \<longleftrightarrow> (\<exists> w\<^sub>1 w\<^sub>2. w = w\<^sub>1 @- w\<^sub>2 \<and> u = map f w\<^sub>1 \<and> v = smap f w\<^sub>2)"
     using sdrop_smap eq_shift stake_sdrop stake_smap by metis
 
   lemma szip_eq_scons[iff]: "szip xs ys = z ## zs \<longleftrightarrow> (shd xs, shd ys) = z \<and> szip (stl xs) (stl ys) = zs"
     using szip.ctr stream.inject by metis
   lemma scons_eq_szip[iff]: "z ## zs = szip xs ys \<longleftrightarrow> z = (shd xs, shd ys) \<and> zs = szip (stl xs) (stl ys)"
     using szip.ctr stream.inject by metis
 
   lemma siterate_eq_scons[iff]: "siterate f s = a ## w \<longleftrightarrow> s = a \<and> siterate f (f s) = w"
     using siterate.ctr stream.inject by metis
   lemma scons_eq_siterate[iff]: "a ## w = siterate f s \<longleftrightarrow> a = s \<and> w = siterate f (f s)"
     using siterate.ctr stream.inject by metis
 
   lemma snth_0: "(a ## w) !! 0 = a" by simp
   lemma eqI_snth:
     assumes "\<And> i. u !! i = v !! i"
     shows "u = v"
     using assms by (coinduction arbitrary: u v) (metis stream.sel snth.simps)
 
   lemma stream_pred_snth: "pred_stream P w \<longleftrightarrow> (\<forall> i. P (w !! i))"
     unfolding stream.pred_set sset_range by simp
   lemma stream_rel_snth: "stream_all2 P u v \<longleftrightarrow> (\<forall> i. P (u !! i) (v !! i))"
   proof safe
     show "P (u !! i) (v !! i)" if "stream_all2 P u v" for i
       using that by (induct i arbitrary: u v) (auto elim: stream.rel_cases)
     show "stream_all2 P u v" if "\<forall> i. P (u !! i) (v !! i)"
       using that by (coinduct) (metis snth_0 snth_Stream)
   qed
 
   lemma stream_rel_pred_szip: "stream_all2 P u v \<longleftrightarrow> pred_stream (case_prod P) (szip u v)"
     unfolding stream_pred_snth stream_rel_snth by simp
 
   lemma sconst_eq[iff]: "sconst x = sconst y \<longleftrightarrow> x = y" by (auto) (metis siterate.simps(1))
   lemma stream_pred__sconst[iff]: "pred_stream P (sconst x) \<longleftrightarrow> P x"
     unfolding stream_pred_snth by simp
   lemma stream_rel_sconst[iff]: "stream_all2 P (sconst x) (sconst y) \<longleftrightarrow> P x y"
     unfolding stream_rel_snth by simp
 
   lemma set_sset_stake[intro!, simp]: "set (stake n xs) \<subseteq> sset xs"
     by (metis sset_shift stake_sdrop sup_ge1)
   lemma sset_sdrop[intro!, simp]: "sset (sdrop n xs) \<subseteq> sset xs"
     by (metis sset_shift stake_sdrop sup_ge2)
 
   lemma set_stake_snth: "x \<in> set (stake n xs) \<longleftrightarrow> (\<exists> i < n. xs !! i = x)"
     unfolding in_set_conv_nth by auto
 
   (* TODO: these should be generated by the transfer option on the primcorec definitions *)
   (* TODO: transfer_prover cannot handle corecursive definitions due to the \<lambda>(s1, s2). undefined
     abortion term that is never used *)
   lemma szip_transfer[transfer_rule]:
     includes lifting_syntax
     shows "(stream_all2 A ===> stream_all2 B ===> stream_all2 (rel_prod A B)) szip szip"
     by (intro rel_funI, coinduction) (force elim: stream.rel_cases)
   lemma siterate_transfer[transfer_rule]:
     includes lifting_syntax
     shows "((A ===> A) ===> A ===> stream_all2 A) siterate siterate"
     by (intro rel_funI, coinduction) (force dest: rel_funD)
 
   lemma split_stream_first:
     assumes "A \<inter> sset xs \<noteq> {}"
     obtains ys a zs
     where "xs = ys @- a ## zs" "A \<inter> set ys = {}" "a \<in> A"
   proof
     let ?n = "LEAST n. xs !! n \<in> A"
     have 1: "xs !! n \<notin> A" if "n < ?n" for n using that by (metis (full_types) not_less_Least)
     show "xs = stake ?n xs @- (xs !! ?n) ## sdrop (Suc ?n) xs" using id_stake_snth_sdrop by blast
     show "A \<inter> set (stake ?n xs) = {}" using 1 by (metis (no_types, lifting) disjoint_iff_not_equal set_stake_snth)
     show "xs !! ?n \<in> A" using assms unfolding sset_range by (auto intro: LeastI)
   qed
   lemma split_stream_first':
     assumes "x \<in> sset xs"
     obtains ys zs
     where "xs = ys @- x ## zs" "x \<notin> set ys"
   proof
     let ?n = "LEAST n. xs !! n = x"
     have 1: "xs !! ?n = x" using assms unfolding sset_range by (auto intro: LeastI)
     have 2: "xs !! n \<noteq> x" if "n < ?n" for n using that by (metis (full_types) not_less_Least)
     show "xs = stake ?n xs @- x ## sdrop (Suc ?n) xs" using 1 by (metis id_stake_snth_sdrop)
     show "x \<notin> set (stake ?n xs)" using 2 by (meson set_stake_snth)
   qed
 
   lemma streams_UNIV[iff]: "streams A = UNIV \<longleftrightarrow> A = UNIV"
   proof
     show "A = UNIV \<Longrightarrow> streams A = UNIV" by simp
   next
     assume "streams A = UNIV"
     then have "w \<in> streams A" for w by simp
     then have "sset w \<subseteq> A" for w unfolding streams_iff_sset by this
     then have "sset (sconst a) \<subseteq> A" for a by blast
     then have "a \<in> A" for a by simp
     then show "A = UNIV" by auto
   qed
 
   lemma pred_list_listsp[pred_set_conv]: "list_all = listsp"
     unfolding list.pred_set by auto
   lemma pred_stream_streamsp[pred_set_conv]: "pred_stream = streamsp"
     unfolding stream.pred_set streams_iff_sset[to_pred] by auto
 
   subsection \<open>The scan Function\<close>
 
   primrec (transfer) scan :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b list" where
     "scan f [] a = []" | "scan f (x # xs) a = f x a # scan f xs (f x a)"
 
   lemma scan_append[simp]: "scan f (xs @ ys) a = scan f xs a @ scan f ys (fold f xs a)"
     by (induct xs arbitrary: a) (auto)
 
   lemma scan_eq_nil[iff]: "scan f xs a = [] \<longleftrightarrow> xs = []" by (cases xs) (auto)
   lemma scan_eq_cons[iff]:
     "scan f xs a = b # w \<longleftrightarrow> (\<exists> y ys. xs = y # ys \<and> f y a = b \<and> scan f ys (f y a) = w)"
     by (cases xs) (auto)
   lemma scan_eq_append[iff]:
     "scan f xs a = u @ v \<longleftrightarrow> (\<exists> ys zs. xs = ys @ zs \<and> scan f ys a = u \<and> scan f zs (fold f ys a) = v)"
     by (induct u arbitrary: xs a) (auto, metis append_Cons fold_simps(2), blast)
 
   lemma scan_length[simp]: "length (scan f xs a) = length xs"
     by (induct xs arbitrary: a) (auto)
   (* TODO: figure out how this is used, should it be a simp rule? or flipped? also target_alt_def *)
   lemma scan_last: "last (a # scan f xs a) = fold f xs a"
     by (induct xs arbitrary: a) (auto simp: last.simps)
   lemma scan_butlast[simp]: "scan f (butlast xs) a = butlast (scan f xs a)"
     by (induct xs arbitrary: a) (auto simp: butlast.simps)
 
   lemma scan_const[simp]: "scan const xs a = xs"
     by (induct xs arbitrary: a) (auto)
   lemma scan_nth[simp]:
     assumes "i < length (scan f xs a)"
     shows "scan f xs a ! i = fold f (take (Suc i) xs) a"
     using assms by (cases xs, simp, induct i arbitrary: xs a, auto simp: take_Suc neq_Nil_conv)
   lemma scan_map[simp]: "scan f (map g xs) a = scan (f \<circ> g) xs a"
     by (induct xs arbitrary: a) (auto)
   lemma scan_take[simp]: "take k (scan f xs a) = scan f (take k xs) a"
     by (induct k arbitrary: xs a) (auto simp: take_Suc neq_Nil_conv)
   lemma scan_drop[simp]: "drop k (scan f xs a) = scan f (drop k xs) (fold f (take k xs) a)"
     by (induct k arbitrary: xs a) (auto simp: take_Suc neq_Nil_conv)
 
   primcorec (transfer) sscan :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a stream \<Rightarrow> 'b \<Rightarrow> 'b stream" where
     "sscan f xs a = f (shd xs) a ## sscan f (stl xs) (f (shd xs) a)"
 
   lemma sscan_scons[simp]: "sscan f (x ## xs) a = f x a ## sscan f xs (f x a)"
     by (simp add: stream.expand)
   lemma sscan_shift[simp]: "sscan f (xs @- ys) a = scan f xs a @- sscan f ys (fold f xs a)"
     by (induct xs arbitrary: a) (auto)
 
   lemma sscan_eq_scons[iff]:
     "sscan f xs a = b ## w \<longleftrightarrow> f (shd xs) a = b \<and> sscan f (stl xs) (f (shd xs) a) = w"
     using sscan.ctr stream.inject by metis
   lemma scons_eq_sscan[iff]:
     "b ## w = sscan f xs a \<longleftrightarrow> b = f (shd xs) a \<and> w = sscan f (stl xs) (f (shd xs) a)"
     using sscan.ctr stream.inject by metis
 
   lemma sscan_const[simp]: "sscan const xs a = xs"
     by (coinduction arbitrary: xs a) (auto)
   lemma sscan_snth[simp]: "sscan f xs a !! i = fold f (stake (Suc i) xs) a"
     by (induct i arbitrary: xs a) (auto)
   lemma sscan_scons_snth[simp]: "(a ## sscan f xs a) !! i = fold f (stake i xs) a"
     by (induct i arbitrary: xs a) (auto)
   lemma sscan_smap[simp]: "sscan f (smap g xs) a = sscan (f \<circ> g) xs a"
     by (coinduction arbitrary: xs a) (auto)
   lemma sscan_stake[simp]: "stake k (sscan f xs a) = scan f (stake k xs) a"
     by (induct k arbitrary: a xs) (auto)
   lemma sscan_sdrop[simp]: "sdrop k (sscan f xs a) = sscan f (sdrop k xs) (fold f (stake k xs) a)"
     by (induct k arbitrary: a xs) (auto)
 
   subsection \<open>Distinct Streams\<close>
 
   coinductive sdistinct :: "'a stream \<Rightarrow> bool" where
     scons[intro!]: "x \<notin> sset xs \<Longrightarrow> sdistinct xs \<Longrightarrow> sdistinct (x ## xs)"
 
   lemma sdistinct_scons_elim[elim!]:
     assumes "sdistinct (x ## xs)"
     obtains "x \<notin> sset xs" "sdistinct xs"
     using assms by (auto elim: sdistinct.cases)
 
   lemma sdistinct_coinduct[case_names sdistinct, coinduct pred: sdistinct]:
     assumes "P xs"
     assumes "\<And> x xs. P (x ## xs) \<Longrightarrow> x \<notin> sset xs \<and> P xs"
     shows "sdistinct xs"
     using stream.collapse sdistinct.coinduct assms by metis
 
   lemma sdistinct_shift[intro!]:
     assumes "distinct xs" "sdistinct ys" "set xs \<inter> sset ys = {}"
     shows "sdistinct (xs @- ys)"
     using assms by (induct xs) (auto)
   lemma sdistinct_shift_elim[elim!]:
     assumes "sdistinct (xs @- ys)"
     obtains "distinct xs" "sdistinct ys" "set xs \<inter> sset ys = {}"
     using assms by (induct xs) (auto)
 
   lemma sdistinct_infinite_sset:
     assumes "sdistinct w"
     shows "infinite (sset w)"
     using assms by (coinduction arbitrary: w) (force elim: sdistinct.cases)
 
   lemma not_sdistinct_decomp:
     assumes "\<not> sdistinct w"
     obtains u v a w'
     where "w = u @- a ## v @- a ## w'"
   proof (rule ccontr)
     assume 1: "\<not> thesis"
     assume 2: "w = u @- a ## v @- a ## w' \<Longrightarrow> thesis" for u a v w'
     have 3: "\<forall> u v a w'. w \<noteq> u @- a ## v @- a ## w'" using 1 2 by auto
     have 4: "sdistinct w" using 3 by (coinduct) (metis id_stake_snth_sdrop imageE shift.simps sset_range)
     show False using assms 4 by auto
   qed
 
   subsection \<open>Sorted Streams\<close>
 
   coinductive (in order) sascending :: "'a stream \<Rightarrow> bool" where
     "a \<le> b \<Longrightarrow> sascending (b ## w) \<Longrightarrow> sascending (a ## b ## w)"
 
   coinductive (in order) sdescending :: "'a stream \<Rightarrow> bool" where
     "a \<ge> b \<Longrightarrow> sdescending (b ## w) \<Longrightarrow> sdescending (a ## b ## w)"
 
   lemma sdescending_coinduct[case_names sdescending, coinduct pred: sdescending]:
     assumes "P w"
     assumes "\<And> a b w. P (a ## b ## w) \<Longrightarrow> a \<ge> b \<and> P (b ## w)"
     shows "sdescending w"
     using stream.collapse sdescending.coinduct assms by (metis (no_types))
 
   lemma sdescending_sdrop:
     assumes "sdescending w"
     shows "sdescending (sdrop k w)"
     using assms by (induct k) (auto, metis sdescending.cases sdrop_stl stream.sel(2))
 
   lemma sdescending_snth_antimono:
     assumes "sdescending w"
     shows "antimono (snth w)"
   unfolding antimono_iff_le_Suc
   proof
     fix k
     have "sdescending (sdrop k w)" using sdescending_sdrop assms by this
     then obtain a b v where 2: "sdrop k w = a ## b ## v" "a \<ge> b" by rule
     then show "w !! k \<ge> w !! Suc k" by (metis sdrop_simps stream.sel)
   qed
 
   lemma sdescending_stuck:
     fixes w :: "'a :: wellorder stream"
     assumes "sdescending w"
     obtains k
     where "sdrop k w = sconst (w !! k)"
   using assms
   proof (induct "w !! 0" arbitrary: w thesis rule: less_induct)
     case less
     show ?case
     proof (cases "w = sconst (w !! 0)")
       case True
       show ?thesis using less(2)[of 0] True by simp
     next
       case False
       obtain k where 1: "w !! k \<noteq> w !! 0"
         using False by (metis empty_iff eqI_snth insert_iff snth_sset sset_sconst)
       have 2: "antimono (snth w)" using sdescending_snth_antimono less(3) by this
       have 3: "w !! k \<le> w !! 0" using 1 2 by (blast dest: antimonoD)
       have 4: "sdrop k w !! 0 < w !! 0" using 1 3 by auto
       have 5: "sdescending (sdrop k w)" using sdescending_sdrop less(3) by this
       obtain l where 5: "sdrop l (sdrop k w) = sconst (sdrop k w !! l)"
         using less(1)[OF 4 _ 5] by this
       show ?thesis using less(2) 5 by simp
     qed
   qed
 
 end
diff --git a/thys/Transition_Systems_and_Automata/Basic/Sequence_LTL.thy b/thys/Transition_Systems_and_Automata/Basic/Sequence_LTL.thy
--- a/thys/Transition_Systems_and_Automata/Basic/Sequence_LTL.thy
+++ b/thys/Transition_Systems_and_Automata/Basic/Sequence_LTL.thy
@@ -1,114 +1,116 @@
 section \<open>Linear Temporal Logic on Streams\<close>
 
 theory Sequence_LTL
 imports
   "Sequence"
   "HOL-Library.Linear_Temporal_Logic_on_Streams"
 begin
 
   subsection \<open>Basics\<close>
 
   text \<open>Avoid destroying the constant @{const holds} prematurely.\<close>
   lemmas [simp del] = holds.simps holds_eq1 holds_eq2 not_holds_eq
 
+  (* TODO: these cannot be applied successively to simplify infs due to introduction of \<circ>
+    avoid or add extra simplification rules for infs *)
   lemma ev_smap[iff]: "ev P (smap f w) \<longleftrightarrow> ev (P \<circ> smap f) w" using ev_smap unfolding comp_apply by this
   lemma alw_smap[iff]: "alw P (smap f w) \<longleftrightarrow> alw (P \<circ> smap f) w" using alw_smap unfolding comp_apply by this
   lemma holds_smap[iff]: "holds P (smap f w) \<longleftrightarrow> holds (P \<circ> f) w" unfolding holds.simps by simp
 
   lemmas [iff] = ev_sconst alw_sconst hld_smap'
 
   lemmas [iff] = alw_ev_stl
   lemma alw_ev_sdrop[iff]: "alw (ev P) (sdrop n w) \<longleftrightarrow> alw (ev P) w"
     using alw_ev_sdrop alw_sdrop by blast
   lemma alw_ev_scons[iff]: "alw (ev P) (a ## w) \<longleftrightarrow> alw (ev P) w" by (metis alw_ev_stl stream.sel(2))
   lemma alw_ev_shift[iff]: "alw (ev P) (u @- v) \<longleftrightarrow> alw (ev P) v" by (induct u) (auto)
 
   lemmas [simp del, iff] = ev_alw_stl
   lemma ev_alw_sdrop[iff]: "ev (alw P) (sdrop n w) \<longleftrightarrow> ev (alw P) w"
     using alwD alw_alw alw_sdrop ev_alw_imp_alw_ev not_ev_iff by metis
   lemma ev_alw_scons[iff]: "ev (alw P) (a ## w) \<longleftrightarrow> ev (alw P) w" by (metis ev_alw_stl stream.sel(2))
   lemma ev_alw_shift[iff]: "ev (alw P) (u @- v) \<longleftrightarrow> ev (alw P) v" by (induct u) (auto)
 
   lemma holds_sconst[iff]: "holds P (sconst a) \<longleftrightarrow> P a" unfolding holds.simps by simp
   lemma HLD_sconst[iff]: "HLD A (sconst a) \<longleftrightarrow> a \<in> A" unfolding HLD_def holds.simps by simp
 
   lemma ev_alt_def: "ev \<phi> w \<longleftrightarrow> (\<exists> u v. w = u @- v \<and> \<phi> v)"
     using ev.base ev_shift ev_imp_shift by metis
   lemma ev_stl_alt_def: "ev \<phi> (stl w) \<longleftrightarrow> (\<exists> u v. w = u @- v \<and> u \<noteq> [] \<and> \<phi> v)"
     unfolding ev_alt_def by (cases w) (force simp: scons_eq)
 
   lemma ev_HLD_sset: "ev (HLD A) w \<longleftrightarrow> sset w \<inter> A \<noteq> {}" unfolding HLD_def ev_holds_sset by auto
 
   lemma alw_ev_coinduct[case_names alw_ev, consumes 1]:
     assumes "R w"
     assumes "\<And> w. R w \<Longrightarrow> ev \<phi> w \<and> ev R (stl w)"
     shows "alw (ev \<phi>) w"
   proof -
     have "ev R w" using assms(1) by rule
     then show ?thesis using assms(2) by (coinduct) (metis alw_sdrop not_ev_iff sdrop_stl sdrop_wait)
   qed
 
   subsection \<open>Infinite Occurrence\<close>
 
   abbreviation "infs P w \<equiv> alw (ev (holds P)) w"
   abbreviation "fins P w \<equiv> \<not> infs P w"
 
   lemma infs_suffix: "infs P w \<longleftrightarrow> (\<forall> u v. w = u @- v \<longrightarrow> Bex (sset v) P)"
     using alwD alw_iff_sdrop alw_shift ev_holds_sset stake_sdrop by (metis (mono_tags, hide_lams))
   lemma infs_snth: "infs P w \<longleftrightarrow> (\<forall> n. \<exists> k \<ge> n. P (w !! k))"
     by (auto simp: alw_iff_sdrop ev_iff_sdrop holds.simps intro: le_add1 dest: le_Suc_ex)
   lemma infs_infm: "infs P w \<longleftrightarrow> (\<exists>\<^sub>\<infinity> i. P (w !! i))"
     unfolding infs_snth INFM_nat_le by rule
 
   lemma infs_coinduct[case_names infs, coinduct pred: infs]:
     assumes "R w"
     assumes "\<And> w. R w \<Longrightarrow> Bex (sset w) P \<and> ev R (stl w)"
     shows "infs P w"
     using assms by (coinduct rule: alw_ev_coinduct) (auto simp: ev_holds_sset)
   lemma infs_set_coinduct[case_names infs_set, consumes 1]:
     assumes "R w"
     assumes "\<And> w. R w \<Longrightarrow> \<exists> u v. w = u @- v \<and> Bex (set u) P \<and> R v"
     shows "infs P w"
     using assms by (coinduct) (force simp: ev_stl_alt_def)
   lemma infs_flat_coinduct[case_names infs_flat, consumes 1]:
     assumes "R w"
     assumes "\<And> u v. R (u ## v) \<Longrightarrow> Bex (set u) P \<and> R v"
     shows "infs P (flat w)"
     using assms by (coinduction arbitrary: w rule: infs_set_coinduct)
       (metis empty_iff flat_Stream list.set(1) stream.exhaust)
 
   lemma infs_mono: "(\<And> a. a \<in> sset w \<Longrightarrow> P a \<Longrightarrow> Q a) \<Longrightarrow> infs P w \<Longrightarrow> infs Q w"
     unfolding infs_snth by force
   lemma infs_mono_strong: "stream_all2 (\<lambda> a b. P a \<longrightarrow> Q b) u v \<Longrightarrow> infs P u \<Longrightarrow> infs Q v"
     unfolding stream_rel_snth infs_snth by blast
 
   lemma infs_all: "Ball (sset w) P \<Longrightarrow> infs P w" unfolding infs_snth by auto
   lemma infs_any: "infs P w \<Longrightarrow> Bex (sset w) P" unfolding ev_holds_sset by auto
 
   lemma infs_bot[iff]: "infs bot w \<longleftrightarrow> False" using infs_any by auto
   lemma infs_top[iff]: "infs top w \<longleftrightarrow> True" by (simp add: infs_all)
   lemma infs_disj[iff]: "infs (\<lambda> a. P a \<or> Q a) w \<longleftrightarrow> infs P w \<or> infs Q w"
     unfolding infs_snth using le_trans le_cases by metis
   lemma infs_bex[iff]:
     assumes "finite S"
     shows "infs (\<lambda> a. \<exists> x \<in> S. P x a) w \<longleftrightarrow> (\<exists> x \<in> S. infs (P x) w)"
     using assms infs_any by induct auto
   lemma infs_bex_le_nat[iff]: "infs (\<lambda> a. \<exists> k < n :: nat. P k a) w \<longleftrightarrow> (\<exists> k < n. infs (P k) w)"
   proof -
     have "infs (\<lambda> a. \<exists> k < n. P k a) w \<longleftrightarrow> infs (\<lambda> a. \<exists> k \<in> {k. k < n}. P k a) w" by simp
     also have "\<dots> \<longleftrightarrow> (\<exists> k \<in> {k. k < n}. infs (P k) w)" by blast
     also have "\<dots> \<longleftrightarrow> (\<exists> k < n. infs (P k) w)" by simp
     finally show ?thesis by this
   qed
 
   lemma infs_cycle[iff]:
     assumes "w \<noteq> []"
     shows "infs P (cycle w) \<longleftrightarrow> Bex (set w) P"
   proof
     show "infs P (cycle w) \<Longrightarrow> Bex (set w) P"
       using assms by (auto simp: ev_holds_sset dest: alwD)
     show "Bex (set w) P \<Longrightarrow> infs P (cycle w)"
       using assms by (coinduction rule: infs_set_coinduct) (blast dest: cycle_decomp)
   qed
 
 end
\ No newline at end of file
diff --git a/thys/Transition_Systems_and_Automata/Basic/Sequence_Zip.thy b/thys/Transition_Systems_and_Automata/Basic/Sequence_Zip.thy
--- a/thys/Transition_Systems_and_Automata/Basic/Sequence_Zip.thy
+++ b/thys/Transition_Systems_and_Automata/Basic/Sequence_Zip.thy
@@ -1,128 +1,143 @@
 section \<open>Zipping Sequences\<close>
 
 theory Sequence_Zip
-imports "Sequence"
+imports "Sequence_LTL"
 begin
 
   subsection \<open>Zipping Lists\<close>
 
   notation zip (infixr "||" 51)
 
   lemmas [simp] = zip_map_fst_snd
 
   lemma split_zip[no_atp]: "(\<And> x. PROP P x) \<equiv> (\<And> y z. length y = length z \<Longrightarrow> PROP P (y || z))"
   proof
     fix y z
     assume 1: "\<And> x. PROP P x"
     show "PROP P (y || z)" using 1 by this
   next
     fix x :: "('a \<times> 'b) list"
     assume 1: "\<And> y z. length y = length z \<Longrightarrow> PROP P (y || z)"
     have 2: "length (map fst x) = length (map snd x)" by simp
     have 3: "PROP P (map fst x || map snd x)" using 1 2 by this
     show "PROP P x" using 3 by simp
   qed
   lemma split_zip_all[no_atp]: "(\<forall> x. P x) \<longleftrightarrow> (\<forall> y z. length y = length z \<longrightarrow> P (y || z))"
     by (fastforce iff: split_zip)
   lemma split_zip_ex[no_atp]: "(\<exists> x. P x) \<longleftrightarrow> (\<exists> y z. length y = length z \<and> P (y || z))"
     by (fastforce iff: split_zip)
 
   lemma zip_eq[iff]:
     assumes "length u = length v" "length r = length s"
     shows "u || v = r || s \<longleftrightarrow> u = r \<and> v = s"
     using assms zip_eq_conv by metis
 
   lemma list_rel_zip[iff]:
     assumes "length u = length v" "length r = length s"
     shows "list_all2 (rel_prod A B) (u || v) (r || s) \<longleftrightarrow> list_all2 A u r \<and> list_all2 B v s"
   proof safe
     assume [transfer_rule]: "list_all2 (rel_prod A B) (u || v) (r || s)"
     have "list_all2 A (map fst (u || v)) (map fst (r || s))" by transfer_prover
     then show "list_all2 A u r" using assms by simp
     have "list_all2 B (map snd (u || v)) (map snd (r || s))" by transfer_prover
     then show "list_all2 B v s" using assms by simp
   next
     assume [transfer_rule]: "list_all2 A u r" "list_all2 B v s"
     show "list_all2 (rel_prod A B) (u || v) (r || s)" by transfer_prover
   qed
 
   lemma zip_last[simp]:
     assumes "xs || ys \<noteq> []" "length xs = length ys"
     shows "last (xs || ys) = (last xs, last ys)"
   proof -
     have 1: "xs \<noteq> []" "ys \<noteq> []" using assms(1) by auto
     have "last (xs || ys) = (xs || ys) ! (length (xs || ys) - 1)" using last_conv_nth assms by blast
     also have "\<dots> = (xs ! (length (xs || ys) - 1), ys ! (length (xs || ys) - 1))" using assms 1 by simp
     also have "\<dots> = (xs ! (length xs - 1), ys ! (length ys - 1))" using assms(2) by simp
     also have "\<dots> = (last xs, last ys)" using last_conv_nth 1 by metis
     finally show ?thesis by this
   qed
 
   subsection \<open>Zipping Streams\<close>
 
   notation szip (infixr "|||" 51)
 
   lemmas [simp] = szip_unfold
 
   lemma szip_smap[simp]: "smap fst zs ||| smap snd zs = zs" by (coinduction arbitrary: zs) (auto)
   lemma szip_smap_fst[simp]: "smap fst (xs ||| ys) = xs" by (coinduction arbitrary: xs ys) (auto)
   lemma szip_smap_snd[simp]: "smap snd (xs ||| ys) = ys" by (coinduction arbitrary: xs ys) (auto)
 
   lemma split_szip[no_atp]: "(\<And> x. PROP P x) \<equiv> (\<And> y z. PROP P (y ||| z))"
   proof
     fix y z
     assume 1: "\<And> x. PROP P x"
     show "PROP P (y ||| z)" using 1 by this
   next
     fix x
     assume 1: "\<And> y z. PROP P (y ||| z)"
     have 2: "PROP P (smap fst x ||| smap snd x)" using 1 by this
     show "PROP P x" using 2 by simp
   qed
   lemma split_szip_all[no_atp]: "(\<forall> x. P x) \<longleftrightarrow> (\<forall> y z. P (y ||| z))" by (fastforce iff: split_szip)
   lemma split_szip_ex[no_atp]: "(\<exists> x. P x) \<longleftrightarrow> (\<exists> y z. P (y ||| z))" by (fastforce iff: split_szip)
 
   lemma szip_eq[iff]: "u ||| v = r ||| s \<longleftrightarrow> u = r \<and> v = s"
     using szip_smap_fst szip_smap_snd by metis
 
   lemma stream_rel_szip[iff]:
     "stream_all2 (rel_prod A B) (u ||| v) (r ||| s) \<longleftrightarrow> stream_all2 A u r \<and> stream_all2 B v s"
   proof safe
     assume [transfer_rule]: "stream_all2 (rel_prod A B) (u ||| v) (r ||| s)"
     have "stream_all2 A (smap fst (u ||| v)) (smap fst (r ||| s))" by transfer_prover
     then show "stream_all2 A u r" by simp
     have "stream_all2 B (smap snd (u ||| v)) (smap snd (r ||| s))" by transfer_prover
     then show "stream_all2 B v s" by simp
   next
     assume [transfer_rule]: "stream_all2 A u r" "stream_all2 B v s"
     show "stream_all2 (rel_prod A B) (u ||| v) (r ||| s)" by transfer_prover
   qed
 
   lemma szip_shift[simp]:
     assumes "length u = length s"
     shows "u @- v ||| s @- t = (u || s) @- (v ||| t)"
     using assms by (simp add: eq_shift stake_shift sdrop_shift)
 
   lemma szip_sset_fst[simp]: "fst ` sset (u ||| v) = sset u" by (metis stream.set_map szip_smap_fst)
   lemma szip_sset_snd[simp]: "snd ` sset (u ||| v) = sset v" by (metis stream.set_map szip_smap_snd)
   lemma szip_sset_elim[elim]:
     assumes "(a, b) \<in> sset (u ||| v)"
     obtains "a \<in> sset u" "b \<in> sset v"
     using assms by (metis image_eqI fst_conv snd_conv szip_sset_fst szip_sset_snd)
   lemma szip_sset[simp]: "sset (u ||| v) \<subseteq> sset u \<times> sset v" by auto
 
   lemma sset_szip_finite[iff]: "finite (sset (u ||| v)) \<longleftrightarrow> finite (sset u) \<and> finite (sset v)"
   proof safe
     assume 1: "finite (sset (u ||| v))"
     have 2: "finite (fst ` sset (u ||| v))" using 1 by blast
     have 3: "finite (snd ` sset (u ||| v))" using 1 by blast
     show "finite (sset u)" using 2 by simp
     show "finite (sset v)" using 3 by simp
   next
     assume 1: "finite (sset u)" "finite (sset v)"
     have "sset (u ||| v) \<subseteq> sset u \<times> sset v" by simp
     also have "finite \<dots>" using 1 by simp
     finally show "finite (sset (u ||| v))" by this
   qed
 
-end
+  lemma infs_szip_fst[iff]: "infs (P \<circ> fst) (u ||| v) \<longleftrightarrow> infs P u"
+  proof -
+    have "infs (P \<circ> fst) (u ||| v) \<longleftrightarrow> infs P (smap fst (u ||| v))"
+      by (simp add: comp_def del: szip_smap_fst)
+    also have "\<dots> \<longleftrightarrow> infs P u" by simp
+    finally show ?thesis by this
+  qed
+  lemma infs_szip_snd[iff]: "infs (P \<circ> snd) (u ||| v) \<longleftrightarrow> infs P v"
+  proof -
+    have "infs (P \<circ> snd) (u ||| v) \<longleftrightarrow> infs P (smap snd (u ||| v))"
+      by (simp add: comp_def del: szip_smap_snd)
+    also have "\<dots> \<longleftrightarrow> infs P v" by simp
+    finally show ?thesis by this
+  qed
+
+end
\ No newline at end of file