diff --git a/thys/CAVA_LTL_Modelchecker/BoolProgs/BoolProgs_LTL_Conv.thy b/thys/CAVA_LTL_Modelchecker/BoolProgs/BoolProgs_LTL_Conv.thy
--- a/thys/CAVA_LTL_Modelchecker/BoolProgs/BoolProgs_LTL_Conv.thy
+++ b/thys/CAVA_LTL_Modelchecker/BoolProgs/BoolProgs_LTL_Conv.thy
@@ -1,59 +1,49 @@
 theory BoolProgs_LTL_Conv
 imports
   "BoolProgs_Extras"
   "~~/src/HOL/Library/Mapping"
   "../../LTL_to_GBA/LTL"
 begin
 
-context begin interpretation LTL_Syntax .
-
 fun b2l :: "bexp \<Rightarrow> nat ltlc" where
   "b2l TT = true\<^sub>c"
 | "b2l FF = false\<^sub>c"
 | "b2l (bexp.V v) = prop\<^sub>c(v)"
 | "b2l (bexp.Not e) = not\<^sub>c (b2l e)"
 | "b2l (And e1 e2) = b2l e1 and\<^sub>c b2l e2"
 | "b2l (Or e1 e2) = b2l e1 or\<^sub>c b2l e2"
 
-end
-
 datatype
   propc = CProp String.literal | FProp "String.literal * integer"
 
-context begin interpretation LTL_Syntax .
-
 fun ltl_conv :: "const_map \<Rightarrow> fun_map \<Rightarrow> propc ltlc \<Rightarrow> (nat ltlc + String.literal)"
 where
   "ltl_conv _ _ LTLcTrue = Inl LTLcTrue"
 | "ltl_conv _ _ LTLcFalse = Inl LTLcFalse"
 | "ltl_conv C _ (LTLcProp (CProp s)) = (case Mapping.lookup C s of
                                               Some c \<Rightarrow> Inl (b2l c)
                                              | None \<Rightarrow> Inr (STR ''Unknown constant: '' @@ s))"
 | "ltl_conv _ M (LTLcProp (FProp (s, arg))) = (case Mapping.lookup M s of
                                                     Some f \<Rightarrow> (Inl \<circ> b2l \<circ> f \<circ> nat_of_integer) arg
                                                   | None \<Rightarrow> Inr (STR ''Unknown function: '' @@ s))"
 | "ltl_conv C M (LTLcNeg x) = (case ltl_conv C M x of Inl l \<Rightarrow> Inl (LTLcNeg l) | Inr s \<Rightarrow> Inr s)"
 | "ltl_conv C M (LTLcNext x) = (case ltl_conv C M x of Inl l \<Rightarrow> Inl (LTLcNext l) | Inr s \<Rightarrow> Inr s)"
 | "ltl_conv C M (LTLcFinal x) = (case ltl_conv C M x of Inl l \<Rightarrow> Inl (LTLcFinal l) | Inr s \<Rightarrow> Inr s)"
 | "ltl_conv C M (LTLcGlobal x) = (case ltl_conv C M x of Inl l \<Rightarrow> Inl (LTLcGlobal l) | Inr s \<Rightarrow> Inr s)"
 | "ltl_conv C M (LTLcAnd x y) = (case ltl_conv C M x of 
                                     Inr s \<Rightarrow> Inr s
                                   | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcAnd l r) | Inr s \<Rightarrow> Inr s))"
 | "ltl_conv C M (LTLcOr x y) = (case ltl_conv C M x of 
                                     Inr s \<Rightarrow> Inr s
                                   | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcOr l r) | Inr s \<Rightarrow> Inr s))"
 | "ltl_conv C M (LTLcImplies x y) = (case ltl_conv C M x of 
                                     Inr s \<Rightarrow> Inr s
                                   | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcImplies l r) | Inr s \<Rightarrow> Inr s))"
-| "ltl_conv C M (LTLcIff x y) = (case ltl_conv C M x of 
-                                    Inr s \<Rightarrow> Inr s
-                                  | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcIff l r) | Inr s \<Rightarrow> Inr s))"
 | "ltl_conv C M (LTLcUntil x y) = (case ltl_conv C M x of 
                                     Inr s \<Rightarrow> Inr s
                                   | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcUntil l r) | Inr s \<Rightarrow> Inr s))"
 | "ltl_conv C M (LTLcRelease x y) = (case ltl_conv C M x of 
                                     Inr s \<Rightarrow> Inr s
                                   | Inl l \<Rightarrow> (case ltl_conv C M y of Inl r \<Rightarrow> Inl (LTLcRelease l r) | Inr s \<Rightarrow> Inr s))"
 
 end
-end
diff --git a/thys/CAVA_LTL_Modelchecker/CAVA_Impl.thy b/thys/CAVA_LTL_Modelchecker/CAVA_Impl.thy
--- a/thys/CAVA_LTL_Modelchecker/CAVA_Impl.thy
+++ b/thys/CAVA_LTL_Modelchecker/CAVA_Impl.thy
@@ -1,875 +1,874 @@
 section {* Actual Implementation of the CAVA Model Checker *}
 theory CAVA_Impl
 imports
   "CAVA_Abstract"
   "../CAVA_Automata/Automata_Impl"
   
   "../LTL_to_GBA/LTL_to_GBA_impl" (* LTL to BA *)
 
   "../Gabow_SCC/Gabow_GBG_Code" (* Gabow's Algorithm *)
   "Nested_DFS/NDFS_SI" (* Nested-DFS, standard-invars formalization *)
 
   "BoolProgs/BoolProgs"                   (* Boolean Programs *)
   "BoolProgs/Programs/BoolProgs_Programs" (* the actual programs *)
   "BoolProgs/BoolProgs_LTL_Conv"          (* LTL parsing setup *)
 
   "../Promela/PromelaLTL"     (* Promela *)
   "../Promela/PromelaLTLConv" (* LTL parsing setup *)
 
   "~~/src/HOL/Library/AList_Mapping"
   "../CAVA_Automata/CAVA_Base/CAVA_Code_Target"
 begin
 
 (*<*)
 subsection {* Exporting Graphs *}
 
 (* TODO: frv_export is going to be replaced by more explicit implementation 
   of graphs.
   For the moment, we just keep it here.
 *)
 definition "frv_edge_set G \<equiv> g_E G \<inter> (g_V G \<times> UNIV)"
 
 definition "frv_edge_set_aimpl G \<equiv> FOREACHi (\<lambda>it r. r = g_E G \<inter> ((g_V G - it) \<times> UNIV))
   (g_V G) 
   (\<lambda>u r. do {
     let E = (\<lambda>v. (u,v))`(succ_of_E (g_E G) u);
     ASSERT (E \<inter> r = {});
     RETURN (E \<union> r)
   }) 
   {}"
 
 lemma frv_edge_set_aimpl_correct: 
   "finite (g_V G) \<Longrightarrow> frv_edge_set_aimpl G \<le> SPEC (\<lambda>r. r = frv_edge_set G)"
   unfolding frv_edge_set_aimpl_def frv_edge_set_def
   apply (refine_rcg refine_vcg)
   apply auto []
   apply auto []
   apply (auto simp: succ_of_E_def) []
   apply auto []
   done
 
 schematic_goal frv_edge_set_impl_aux:
   assumes [autoref_rules]: "(eq,op =)\<in>R \<rightarrow> R \<rightarrow> bool_rel"
   assumes [relator_props]: "single_valued R"
   shows "(?c, frv_edge_set_aimpl) \<in> \<langle>Re,R\<rangle>frgv_impl_rel_ext \<rightarrow> \<langle>\<langle>R \<times>\<^sub>r R\<rangle>list_set_rel\<rangle>nres_rel"
   unfolding frv_edge_set_aimpl_def[abs_def]
   apply (autoref (trace,keep_goal))
   done
 concrete_definition frv_edge_set_impl uses frv_edge_set_impl_aux
 lemmas [autoref_rules] = frv_edge_set_impl.refine[OF GEN_OP_D PREFER_sv_D]
 
 schematic_goal frv_edge_set_code_aux: "RETURN ?c \<le> frv_edge_set_impl eq G"
   unfolding frv_edge_set_impl_def by (refine_transfer (post))
 concrete_definition frv_edge_set_code for eq G uses frv_edge_set_code_aux
 lemmas [refine_transfer] = frv_edge_set_code.refine
 
 lemma frv_edge_set_autoref[autoref_rules]:
   assumes EQ[unfolded autoref_tag_defs]: "GEN_OP eq op = (R \<rightarrow> R \<rightarrow> bool_rel)"
   assumes SV[unfolded autoref_tag_defs]: "PREFER single_valued R"
   shows "(frv_edge_set_code eq,frv_edge_set) \<in> \<langle>Re,R\<rangle>frgv_impl_rel_ext \<rightarrow> \<langle>R \<times>\<^sub>r R\<rangle>list_set_rel"
 proof (intro fun_relI)
   fix Gi G
   assume Gr: "(Gi, G) \<in> \<langle>Re, R\<rangle>frgv_impl_rel_ext" 
   hence [simp]: "finite (g_V G)"
     unfolding frgv_impl_rel_ext_def g_impl_rel_ext_def
       gen_g_impl_rel_ext_def
     apply (simp add: list_set_rel_def br_def)
     apply fastforce
     done
 
   note frv_edge_set_code.refine
   also note frv_edge_set_impl.refine[OF EQ SV, THEN fun_relD, OF Gr, THEN nres_relD]
   also note frv_edge_set_aimpl_correct
   finally show "(frv_edge_set_code eq Gi, frv_edge_set G) \<in> \<langle>R \<times>\<^sub>r R\<rangle>list_set_rel" 
     by (rule RETURN_ref_SPECD) simp_all
 qed
 
 definition "frv_export G \<equiv> do {
   nodes \<leftarrow> SPEC (\<lambda>l. set l = g_V G \<and> distinct l);
   V0 \<leftarrow> SPEC (\<lambda>l. set l = g_V0 G \<and> distinct l);
   E \<leftarrow> SPEC (\<lambda>l. set l = frv_edge_set G \<and> distinct l);
   RETURN (nodes,V0,E)
   }"
 
 schematic_goal frv_export_impl_aux:
   fixes R :: "('vi \<times> 'v) set"
   notes [autoref_tyrel] = TYRELI[where R = "\<langle>R \<times>\<^sub>r R\<rangle>list_set_rel"]
   assumes EQ[autoref_rules]: "(eq,op =)\<in>R \<rightarrow> R \<rightarrow> bool_rel"
   assumes SVR[relator_props]: "single_valued R"
   shows "(?c, frv_export) 
   \<in> \<langle>Re,R\<rangle>frgv_impl_rel_ext 
   \<rightarrow> \<langle>\<langle>R\<rangle>list_rel \<times>\<^sub>r \<langle>R\<rangle>list_rel \<times>\<^sub>r \<langle>R \<times>\<^sub>r R\<rangle>list_rel\<rangle>nres_rel"
   unfolding frv_export_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 
 concrete_definition frv_export_impl for eq uses frv_export_impl_aux
 lemmas [autoref_rules] = frv_export_impl.refine[OF GEN_OP_D PREFER_sv_D]
 
 schematic_goal frv_export_code_aux: "RETURN ?c \<le> frv_export_impl eq G"
   unfolding frv_export_impl_def
   apply (refine_transfer (post))
   done
 concrete_definition frv_export_code for eq G uses frv_export_code_aux
 lemmas [refine_transfer] = frv_export_code.refine
 
 (*>*)
 
 subsection {* Setup *}
 
 subsubsection {* LTL to GBA conversion *}
 
 text {* In the following, we set up the algorithms for LTL to GBA conversion. *}
 
 definition is_ltl_to_gba_algo 
   :: "('a ltlc \<Rightarrow> (nat, 'a \<Rightarrow> bool, unit) igbav_impl_scheme) \<Rightarrow> bool"
   -- "Predicate that must be satisfied by an LTL to GBA conversion"
   where 
   "is_ltl_to_gba_algo algo \<equiv> (algo, ltl_to_gba_spec) 
     \<in> ltl_rel 
     \<rightarrow> \<langle>igbav_impl_rel_ext unit_rel nat_rel (\<langle>Id\<rangle>fun_set_rel)\<rangle>plain_nres_rel"
 
 definition gerth_ltl_to_gba 
   -- "Conversion based on Gerth's Algorithm"
   where "gerth_ltl_to_gba \<phi> 
-  \<equiv> create_name_igba (ltln_rewrite (ltl_to_ltln (ltl_pushneg (ltlc_to_ltl \<phi>))))"
+  \<equiv> create_name_igba (rewrite_iter_fast (ltlc_to_ltln \<phi>))"
 
 lemma gerth_ltl_to_gba_refine:
   "gerth_ltl_to_gba \<phi> \<le> \<Down>Id (ltl_to_gba_spec \<phi>)"
 apply simp
 unfolding ltl_to_gba_spec_def gerth_ltl_to_gba_def
 apply (rule order_trans[OF create_name_igba_correct])
 apply (rule SPEC_rule)
 proof (safe del: equalityI)
   fix G :: "(nat, 'a set) igba_rec"
   assume "igba G"
   interpret igba G by fact
   assume 1: "finite (g_V G)"
-  assume 2: "\<forall> \<xi>. accept \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n ltln_rewrite (ltl_to_ltln (ltl_pushneg (ltlc_to_ltl \<phi>)))"
+  assume 2: "\<forall> \<xi>. accept \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n rewrite_iter_fast (ltlc_to_ltln \<phi>)"
   show "lang = ltlc_language \<phi>"
     unfolding lang_def ltlc_language_def using 2
-    by (auto simp: ltln_rewrite__equiv ltlc_to_ltl_equiv)
+    using rewrite_iter_fast_sound ltlc_to_ltln_semantics by auto
   show "finite ((g_E G)\<^sup>* `` g_V0 G)" using 1 reachable_V 
     by (auto intro: finite_subset)
 qed
 
-definition "gerth_ltl_to_gba_code \<phi> 
-  \<equiv> create_name_igba_code 
-      (ltln_rewrite (ltl_to_ltln (ltl_pushneg (ltlc_to_ltl \<phi>))))"  
+definition
+  "gerth_ltl_to_gba_code \<phi> \<equiv> create_name_igba_code (rewrite_iter_fast (ltlc_to_ltln \<phi>))"  
   
 lemma gerth_ltl_to_gba_code_refine:
   "is_ltl_to_gba_algo gerth_ltl_to_gba_code"
 proof -
   have "\<And>\<phi>. RETURN (gerth_ltl_to_gba_code \<phi>) 
     \<le> \<Down>(igbav_impl_rel_ext unit_rel nat_rel (\<langle>Id\<rangle>fun_set_rel)) 
       (gerth_ltl_to_gba \<phi>)"
     using assms 
     unfolding gerth_ltl_to_gba_def[abs_def] gerth_ltl_to_gba_code_def[abs_def]
     apply (rule order_trans[OF create_name_igba_code.refine])
     apply (rule create_name_igba_impl.refine[THEN fun_relD, THEN nres_relD])
     apply simp
     apply simp
     done
   also note gerth_ltl_to_gba_refine
   finally show ?thesis 
     unfolding is_ltl_to_gba_algo_def 
     by (blast intro: plain_nres_relI)
 qed
 
 
 text {* We define a function that chooses between the possible conversion 
   algorithms. (Currently there is only one) *}
 datatype config_l2b = CFG_L2B_GERTHS
 
 definition "ltl_to_gba_code cfg 
   \<equiv> case cfg of CFG_L2B_GERTHS \<Rightarrow> gerth_ltl_to_gba_code"
 
 lemma ltl_to_gba_code_refine:
   "is_ltl_to_gba_algo (ltl_to_gba_code cfg)"
   apply (cases cfg)
   unfolding ltl_to_gba_code_def
 
   using gerth_ltl_to_gba_code_refine
   apply simp
   done
 
 subsubsection {* Counterexample Search *}
 definition is_find_ce_algo 
   :: "(('a, unit)igbg_impl_scheme \<Rightarrow> 'a lasso option option) \<Rightarrow> bool" 
   -- "Predicate that must be satisfied by counterexample search algorithm"
   where
   "is_find_ce_algo algo \<equiv> (algo, find_ce_spec) 
     \<in> igbg_impl_rel_ext unit_rel Id 
   \<rightarrow> \<langle>\<langle>\<langle>\<langle>Id\<rangle>lasso_run_rel\<rangle>Relators.option_rel\<rangle>Relators.option_rel\<rangle>plain_nres_rel"
 
 definition gabow_find_ce_code 
   -- "Emptiness check based on Gabow's SCC Algorithm"
   where "gabow_find_ce_code
   \<equiv> map_option (Some o lasso_of_prpl) o Gabow_GBG_Code.find_lasso_tr"
 
 lemma gabow_find_ce_code_refine: "is_find_ce_algo 
   (gabow_find_ce_code 
     :: ('a::hashable, unit) igbg_impl_scheme \<Rightarrow> 'a lasso option option)"
 proof -
   have AUX_EQ: 
     "\<And>gbgi::('a, unit) igbg_impl_scheme. RETURN (gabow_find_ce_code gbgi)
     = (do {
       l \<leftarrow> RETURN (find_lasso_tr gbgi);
       RETURN (map_option (Some \<circ> lasso_of_prpl) l)
     })" by (auto simp: gabow_find_ce_code_def)
 
   show ?thesis
     (* TODO: Clean up this proof! *)
     unfolding is_find_ce_algo_def 
     apply (intro fun_relI plain_nres_relI)
     unfolding find_ce_spec_def AUX_EQ
     apply (refine_rcg)
     apply (rule order_trans[
       OF bind_mono(1)[OF Gabow_GBG_Code.find_lasso_tr_correct order_refl]])
     apply assumption
     apply (rule igb_fr_graphI)
     apply assumption
     apply assumption
     unfolding igb_graph.find_lasso_spec_def
     apply (simp add: pw_le_iff refine_pw_simps)
     apply (clarsimp simp: lasso_run_rel_sv option_rel_sv split: option.split_asm)
     apply (metis igb_graph.is_lasso_prpl_of_lasso igb_graph.accepted_lasso 
       prod.exhaust)
     apply (simp add: option_rel_def lasso_run_rel_def br_def)
     by (metis igb_graph.is_lasso_prpl_conv igb_graph.lasso_accepted)
 qed
 
 definition ndfs_find_ce 
   :: "('q::hashable,_) igb_graph_rec_scheme \<Rightarrow> 'q lasso option option nres" 
   -- "Emptiness check based on nested DFS"
   where 
   "ndfs_find_ce G \<equiv> do {
     ASSERT (igb_graph G);
     let G = igb_graph.degeneralize G;
     l \<leftarrow> blue_dfs G;
     case l of
       None \<Rightarrow> RETURN None
     | Some l \<Rightarrow> do { 
         ASSERT (snd l \<noteq> []); 
         RETURN (Some (Some (map_lasso fst (lasso_of_prpl l)))) 
       }
   }"
 
 lemma ndfs_find_ce_refine: "(G',G)\<in>Id \<Longrightarrow> 
   ndfs_find_ce G' \<le> \<Down>(\<langle>\<langle>\<langle>Id\<rangle>lasso_run_rel\<rangle>option_rel\<rangle>option_rel) (find_ce_spec G)"
   apply simp
   unfolding find_ce_spec_def
 proof (refine_rcg SPEC_refine refine_vcg)
   assume [simp]: "igb_graph G"
   then interpret igb_graph G .
 
   assume fr: "finite ((g_E G)\<^sup>* `` g_V0 G)"
 
   have [simp]: "b_graph degeneralize" by (simp add: degen_invar)
   (*then interpret bg: b_graph degeneralize .*)
 
   show "ndfs_find_ce G
     \<le>
     (SPEC (\<lambda>res. \<exists>res'. 
          (res,res')\<in>(\<langle>\<langle>\<langle>Id\<rangle>lasso_run_rel\<rangle>Relators.option_rel\<rangle>Relators.option_rel)
        \<and> (case res' of None \<Rightarrow> \<forall>r. \<not> is_acc_run r
          | Some None \<Rightarrow> Ex is_acc_run 
          | Some (Some x) \<Rightarrow> is_acc_run x)))"
     unfolding ndfs_find_ce_def find_lasso_spec_def ce_correct_def
     apply (refine_rcg refine_vcg order_trans[OF blue_dfs_correct])
     apply (clarsimp_all)
 
     apply (auto intro: degen_finite_reachable fr) []
 
     apply (auto
       elim!: degen_acc_run_complete[where m="\<lambda>_. ()"]
       dest!: degen.accepted_lasso[OF degen_finite_reachable[OF fr]]
       simp: degen.is_lasso_prpl_of_lasso[symmetric] prpl_of_lasso_def
       simp del: degen.is_lasso_prpl_of_lasso) []
 
     apply (auto 
       simp: b_graph.is_lasso_prpl_def graph.is_lasso_prpl_pre_def) []
 
     apply (auto split: option.split
       simp: degen.is_lasso_prpl_conv lasso_run_rel_def br_def
       dest: degen.lasso_accepted degen_acc_run_sound
     ) []
     done
 qed
 
 
 schematic_goal ndfs_find_ce_impl_aux: "(?c, ndfs_find_ce) 
   \<in> igbg_impl_rel_ext Rm Id 
   \<rightarrow> \<langle>
     \<langle>\<langle>\<langle>unit_rel,Id::('a::hashable\<times>_) set\<rangle>lasso_rel_ext\<rangle>option_rel\<rangle>option_rel
   \<rangle> nres_rel"
   unfolding ndfs_find_ce_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (trace, keep_goal))
   done
 concrete_definition ndfs_find_ce_impl uses ndfs_find_ce_impl_aux
 
 schematic_goal ndfs_find_ce_code_aux: "RETURN ?c \<le> ndfs_find_ce_impl G"
   unfolding ndfs_find_ce_impl_def
   by (refine_transfer (post))
 concrete_definition ndfs_find_ce_code uses ndfs_find_ce_code_aux
 
 
 lemma ndfs_find_ce_code_refine: "is_find_ce_algo ndfs_find_ce_code"
   unfolding is_find_ce_algo_def
 proof (intro fun_relI plain_nres_relI)
   fix gbgi :: "('a,unit) igbg_impl_scheme" and gbg :: "'a igb_graph_rec"
   assume R: "(gbgi, gbg) \<in> igbg_impl_rel_ext unit_rel Id"
   note ndfs_find_ce_code.refine
   also note ndfs_find_ce_impl.refine[param_fo, THEN nres_relD, OF R]
   also note ndfs_find_ce_refine[OF IdI]
   finally show "RETURN (ndfs_find_ce_code gbgi)
     \<le> \<Down> (\<langle>\<langle>\<langle>Id\<rangle>lasso_run_rel\<rangle>Relators.option_rel\<rangle>Relators.option_rel) 
       (find_ce_spec gbg)"
     by (simp add: lasso_rel_ext_id)
 qed
 
 text {* We define a function that chooses between the emptiness check 
   algorithms *}
 
 datatype config_ce = CFG_CE_SCC_GABOW | CFG_CE_NDFS
 
 definition find_ce_code where "find_ce_code cfg \<equiv> case cfg of 
   CFG_CE_SCC_GABOW \<Rightarrow> gabow_find_ce_code
 | CFG_CE_NDFS \<Rightarrow> ndfs_find_ce_code"
 
 lemma find_ce_code_refine: "is_find_ce_algo (find_ce_code cfg)"
   apply (cases cfg)
   unfolding find_ce_code_def
   using gabow_find_ce_code_refine ndfs_find_ce_code_refine
   apply (auto split: config_ce.split)
   done
   
 subsection {* System-Agnostic Model-Checker *}
 text {*
   In this section, we implement the part of the model-checker that does not 
   depend on the language used to describe the system to be checked. 
 *}
 
 subsubsection {* Default Implementation of Lazy Intersection *}
 
 locale cava_inter_impl_loc =
   igba_sys_prod_precond G S
   for S :: "('s, 'l set) sa_rec"
   and G :: "('q,'l set) igba_rec" +
   fixes Gi Si Rq Rs Rl eqq
   assumes [autoref_rules]: "(eqq,op =) \<in> Rq \<rightarrow> Rq \<rightarrow> bool_rel"
   assumes [autoref_rules]: "(Gi,G) \<in> igbav_impl_rel_ext unit_rel Rq Rl"
   assumes [autoref_rules]: "(Si,S) \<in> sa_impl_rel_ext unit_rel Rs Rl"
 begin
 
   lemma cava_inter_impl_loc_this: "cava_inter_impl_loc S G Gi Si Rq Rs Rl eqq"
     by unfold_locales
 
   (*<*)
   text {* TODO/FIXME:
     Some black-magic is going on here: The performance of the mc seems to depend on the ordering of states,
     so we do some adjustments of the ordering here.
   *}
   lemma prod_impl_aux_alt_cava_reorder:
     "prod = (\<lparr>
       g_V = Collect (\<lambda>(q,s). q \<in> igba.V \<and> s \<in> sa.V),
       g_E = E_of_succ (\<lambda>(q,s). 
         if igba.L q (sa.L s) then     
           (\<lambda>(s,q). (q,s))`(LIST_SET_REV_TAG (succ_of_E (sa.E) s) 
            \<times> (succ_of_E (igba.E) q))
         else
           {}
       ),
       g_V0 = igba.V0 \<times> sa.V0,
       igbg_num_acc = igba.num_acc,
       igbg_acc = \<lambda>(q,s). if s\<in>sa.V then igba.acc q else {}
     \<rparr>)"
     unfolding prod_def
     apply (auto simp: succ_of_E_def E_of_succ_def split: if_split_asm)
     done
 
   schematic_goal vf_prod_impl_aux_cava_reorder:
     shows "(?c, prod) \<in> igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs)"
     unfolding prod_impl_aux_alt_cava_reorder[abs_def]
     using [[autoref_trace_failed_id]]
     apply (autoref (trace, keep_goal))
     done
 
   lemma (in -) map_concat_map_map_opt: 
     "map f (concat (map (\<lambda>xa. map (f' xa) (l1 xa)) l2)) 
       = List.maps (\<lambda>xa. map (f o f' xa) (l1 xa)) l2"
     "((\<lambda>(xd, xe). (xe, xd)) \<circ> Pair xa) = (\<lambda>x. (x,xa))"
     -- "Very specific optimization used in the next refinement"
     apply -
     apply (induction l2) 
     apply (auto simp: List.maps_def) [2]
 
     apply auto []
     done
 
   concrete_definition (in -) gbav_sys_prod_impl_cava_reorder 
     for eqq Gi Si
     uses cava_inter_impl_loc.vf_prod_impl_aux_cava_reorder[
     param_fo, unfolded map_concat_map_map_opt]
 
   lemmas [autoref_rules] = 
     gbav_sys_prod_impl_cava_reorder.refine[OF cava_inter_impl_loc_this]
   
   context begin interpretation autoref_syn .
     (* HACK: Overwrite pattern that rewrites outer-level prod, such that
       local rules apply here. *)
     lemma [autoref_op_pat]: "prod \<equiv> OP prod" by simp
   end
 
   (*>*)
 
   definition dflt_inter :: "('q \<times> 's) igb_graph_rec \<times> ('q \<times> 's \<Rightarrow> 's)" 
     where "dflt_inter \<equiv> (prod, snd)"
 
   lemma dflt_inter_refine: 
     shows "RETURN dflt_inter \<le> inter_spec S G"
     unfolding inter_spec_def dflt_inter_def
     apply (refine_rcg le_ASSERTI refine_vcg)
   proof clarsimp_all
     show "igb_graph prod" by (rule prod_invar)
 
     fix r
 
     assume "finite (igba.E\<^sup>* `` igba.V0)" "finite ((g_E S)\<^sup>* `` g_V0 S)"
     thus "finite ((g_E prod)\<^sup>* `` g_V0 prod)" using prod_finite_reachable by auto
 
     show "(\<exists>r'. prod.is_acc_run r' \<and> r = snd \<circ> r') \<longleftrightarrow>
           (sa.is_run r \<and> sa.L \<circ> r \<in> igba.lang)"
       using gsp_correct1 gsp_correct2 
       apply (auto simp: comp_assoc)
       done
   qed
 
   schematic_goal dflt_inter_impl_aux: 
     shows "(?c, dflt_inter) 
     \<in> igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs) \<times>\<^sub>r (Rq \<times>\<^sub>r Rs \<rightarrow> Rs)"
     unfolding dflt_inter_def[abs_def]
     using [[autoref_trace_failed_id]]
     apply (autoref (keep_goal))
     done
   
   concrete_definition (in -) dflt_inter_impl
     for eqq Si Gi
     uses cava_inter_impl_loc.dflt_inter_impl_aux
 
   lemmas [autoref_rules] = dflt_inter_impl.refine[OF cava_inter_impl_loc_this]
 end
 
 definition [simp]: "op_dflt_inter \<equiv> cava_inter_impl_loc.dflt_inter"
 lemma [autoref_op_pat]: "cava_inter_impl_loc.dflt_inter \<equiv> op_dflt_inter"
   by simp
 
 
 context begin interpretation autoref_syn .
 lemma dflt_inter_autoref[autoref_rules]:
   fixes G :: "('q,'l set) igba_rec"
   fixes S :: "('s, 'l set) sa_rec"
   fixes Gi Si Rq Rs Rl eqq
   assumes "SIDE_PRECOND (igba G)"
   assumes "SIDE_PRECOND (sa S)"
   assumes "GEN_OP eqq op = (Rq \<rightarrow> Rq \<rightarrow> bool_rel)"
   assumes "(Gi,G) \<in> igbav_impl_rel_ext unit_rel Rq Rl"
   assumes "(Si,S) \<in> sa_impl_rel_ext unit_rel Rs Rl"
   shows "(dflt_inter_impl eqq Si Gi,
     (OP op_dflt_inter 
      ::: sa_impl_rel_ext unit_rel Rs Rl
       \<rightarrow> igbav_impl_rel_ext unit_rel Rq Rl 
       \<rightarrow> igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs) \<times>\<^sub>r (Rq \<times>\<^sub>r Rs \<rightarrow> Rs))$S$G
   ) \<in> igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs) \<times>\<^sub>r (Rq \<times>\<^sub>r Rs \<rightarrow> Rs)"
 proof -
   from assms interpret igba: igba G by simp
   from assms interpret sa: sa S by simp
   from assms interpret cava_inter_impl_loc S G Gi Si Rq Rs Rl eqq
     by unfold_locales simp_all
 
   show ?thesis
     apply simp
     apply (rule dflt_inter_impl.refine)
     apply unfold_locales
     done
 qed
 
 end
 
 lemma inter_spec_refineI: 
   assumes "\<lbrakk> sa S; igba G \<rbrakk> \<Longrightarrow> m \<le> \<Down>R (inter_spec S G)"
   shows "m \<le> \<Down>R (inter_spec S G)"
   using assms
   unfolding inter_spec_def
   apply refine_rcg
   apply simp
   done
   
 lemma dflt_inter_impl_refine: 
   fixes Rs :: "('si \<times> 's) set"
   fixes Rq :: "('qi \<times> 'q) set"
   fixes Rprop :: "('pi \<times> 'p) set"
   assumes [relator_props]: "single_valued Rs" "Range Rs = UNIV" 
     "single_valued Rq" "Range Rq = UNIV"
 
   assumes EQ: "(eqq,op=) \<in> Rq \<rightarrow> Rq \<rightarrow> bool_rel"
 
   shows "(dflt_inter_impl eqq, inter_spec)
   \<in> sa_impl_rel_ext unit_rel Rs (\<langle>Rprop\<rangle>fun_set_rel) \<rightarrow>
     igbav_impl_rel_ext unit_rel Rq (\<langle>Rprop\<rangle>fun_set_rel) \<rightarrow>
     \<langle>igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs) \<times>\<^sub>r ((Rq \<times>\<^sub>r Rs) \<rightarrow> Rs)\<rangle>plain_nres_rel"
   apply (intro fun_relI plain_nres_relI)
   apply (rule inter_spec_refineI)
 proof -
   fix Si S Gi G
 
   assume R:"(Si,S) \<in> sa_impl_rel_ext unit_rel Rs (\<langle>Rprop\<rangle>fun_set_rel)"
     "(Gi, G) \<in> igbav_impl_rel_ext unit_rel Rq (\<langle>Rprop\<rangle>fun_set_rel)"
 
   assume "sa S" and "igba G"
   then interpret sa: sa S + igba: igba G .
   interpret cava_inter_impl_loc S G Gi Si Rq Rs "\<langle>Rprop\<rangle>fun_set_rel" eqq
     apply unfold_locales
     using EQ R by simp_all
 
   note RETURN_refine[OF dflt_inter_impl.refine[OF cava_inter_impl_loc_this]]
   also note dflt_inter_refine
   finally show "RETURN (dflt_inter_impl eqq Si Gi)
   \<le> \<Down> (igbg_impl_rel_ext unit_rel (Rq \<times>\<^sub>r Rs) \<times>\<^sub>r (Rq \<times>\<^sub>r Rs \<rightarrow> Rs))
      (inter_spec S G)" .
 qed
 
 subsubsection {* Definition of Model-Checker *}
 text {* In this section, we instantiate the parametrized model checker
   with the actual implementations. *}
 
 setup Locale_Code.open_block
 interpretation cava_sys_agn: impl_model_checker 
   "sa_impl_rel_ext unit_rel Id (\<langle>Id\<rangle>fun_set_rel)" 
   "igbav_impl_rel_ext unit_rel Id (\<langle>Id\<rangle>fun_set_rel)"
   "igbg_impl_rel_ext unit_rel (Id \<times>\<^sub>r Id)"
   "\<langle>Id \<times>\<^sub>r Id\<rangle>lasso_run_rel" "\<langle>Id\<rangle>lasso_run_rel"
 
   "ltl_to_gba_code"
   "\<lambda>_::unit. dflt_inter_impl op ="
   "find_ce_code"
   "map_lasso"
   apply unfold_locales
   apply tagged_solver
 
   apply (rule ltl_to_gba_code_refine[unfolded is_ltl_to_gba_algo_def])
   
   using dflt_inter_impl_refine[of Id Id "op =" Id] apply simp
 
   using find_ce_code_refine[unfolded is_find_ce_algo_def] 
   apply simp apply assumption
 
   using map_lasso_run_refine[of Id Id] apply simp
   done
 setup Locale_Code.close_block
 
 definition "cava_sys_agn \<equiv> cava_sys_agn.impl_model_check"
 
 text {* The correctness theorem states correctness of the model checker wrt.\ 
   a model given as system automata. In the following sections, we will then 
   refine the model description to Boolean programs and Promela. *}
 theorem cava_sys_agn_correct:
   fixes sysi :: "('s::hashable, 'p::linorder \<Rightarrow> bool, unit) sa_impl_scheme" 
     and sys :: "('s, 'p set) sa_rec" 
     and \<phi> :: "'p ltlc" 
     and cfg :: "config_l2b \<times> unit \<times> config_ce" 
   assumes "(sysi, sys) \<in> sa_impl_rel_ext unit_rel Id (\<langle>Id\<rangle>fun_set_rel)"
     and "sa sys" "finite ((g_E sys)\<^sup>* `` g_V0 sys)"
   shows "case cava_sys_agn cfg sysi \<phi> of
          None \<Rightarrow> sa.lang sys \<subseteq> ltlc_language \<phi> 
          | Some None \<Rightarrow> \<not> sa.lang sys \<subseteq> ltlc_language \<phi>
          | Some (Some L) \<Rightarrow> 
              graph_defs.is_run sys (run_of_lasso L) 
            \<and> sa_L sys \<circ> (run_of_lasso L) \<notin> ltlc_language \<phi>"
   using cava_sys_agn.impl_model_check_correct[OF assms, of \<phi> cfg]
   unfolding cava_sys_agn_def
   by (auto split: option.splits simp: lasso_run_rel_def br_def)
 
 
 subsection {* Model Checker for Boolean Programs *}
 
 definition bpc_to_sa 
   :: "bprog \<times> BoolProgs.config \<Rightarrow> (BoolProgs.config,nat set) sa_rec" 
   -- "Conversion of a Boolean program to a system automata."
   where 
   "bpc_to_sa bpc \<equiv> let (bp,c0)=bpc in
   \<lparr>
     g_V = UNIV,
     g_E = E_of_succ (set o BoolProgs.nexts bp),
     g_V0 = {c0},
     sa_L = \<lambda>c. bs_\<alpha> (snd c)
   \<rparr>"
 
 definition bpc_to_sa_impl 
   :: "bprog \<times> BoolProgs.config 
   \<Rightarrow> (BoolProgs.config,nat \<Rightarrow> bool,unit) sa_impl_scheme" 
   where 
   "bpc_to_sa_impl bpc \<equiv> let (bp,c0)=bpc in
   \<lparr> gi_V = \<lambda>_. True,
     gi_E = remdups o BoolProgs.nexts bp,
     gi_V0 = [c0],
     sai_L = \<lambda>c i. bs_mem i (snd c)
   \<rparr>"
 
 lemma bpc_to_sa_impl_refine: "(bpc_to_sa_impl bpc, bpc_to_sa bpc) 
   \<in> sa_impl_rel_ext unit_rel Id (\<langle>nat_rel\<rangle>fun_set_rel)"
   unfolding bpc_to_sa_impl_def bpc_to_sa_def 
   unfolding sa_impl_rel_eext_def g_impl_rel_ext_def
   unfolding gen_sa_impl_rel_eext_def gen_g_impl_rel_ext_def
   apply (clarsimp split: prod.split)
   apply (intro conjI)
   apply (auto simp: fun_set_rel_def br_def) []
 
   apply (rule E_of_succ_refine[param_fo])
   apply (auto simp: list_set_rel_def br_def) []
 
   apply (auto simp: list_set_rel_def br_def) []
 
   apply (auto simp: fun_set_rel_def br_def) []
   done
 
 
 lemma
   shows bpc_to_sa_invar: "sa (bpc_to_sa bpc)"
   and bpc_to_sa_fr: "finite ((g_E (bpc_to_sa bpc))\<^sup>* `` g_V0 (bpc_to_sa bpc))"
 proof -
   obtain bp c where [simp]: "bpc = (bp,c)" by (cases bpc)
   show "sa (bpc_to_sa bpc)"
     apply unfold_locales
 
     apply (simp add: bpc_to_sa_def)
     apply (simp add: bpc_to_sa_def)
     done
   show "finite ((g_E (bpc_to_sa bpc))\<^sup>* `` g_V0 (bpc_to_sa bpc))"
     apply (simp add: bpc_to_sa_def)
     apply (rule finite_subset[OF _ BoolProgs.reachable_configs_finite[of bp c]])
     apply (rule rtrancl_reachable_induct)
     apply (auto 
       intro: BoolProgs.reachable_configs.intros 
       simp: E_of_succ_def)
     done
 qed
 
 interpretation bpc_to_sa: sa "bpc_to_sa bpc"
   using bpc_to_sa_invar .
 
 lemma bpc_to_sa_run_conv[simp]: 
   "graph_defs.is_run (bpc_to_sa bpc) = bpc_is_run bpc"
   apply (rule ext)
   unfolding graph_defs.is_run_def
   unfolding bpc_to_sa_def bpc_is_run_def 
     ipath_def E_of_succ_def
   by auto
 
 lemma bpc_to_sa_L_conv[simp]: "sa_L (bpc_to_sa bpc) = bpc_props"
   apply (rule ext)
   unfolding bpc_to_sa_def bpc_props_def
   apply (auto simp: E_of_succ_def split: prod.split)
   done
 
 lemma bpc_to_sa_lang_conv[simp]: "sa.lang (bpc_to_sa bpc) = bpc_lang bpc"
   unfolding bpc_to_sa.lang_def bpc_to_sa.accept_def[abs_def] bpc_lang_def
   by auto
 
 definition "cava_bpc cfg bpc \<phi> \<equiv> cava_sys_agn cfg (bpc_to_sa_impl bpc) \<phi>"
 
 text {*
   Correctness theorem for the model checker on boolean programs.
   Note that the semantics of Boolean programs is given 
   by @{const "bpc_lang"}.
 *}
 theorem cava_bpc_correct:
   "case cava_bpc cfg bpc \<phi> of 
     None \<Rightarrow> bpc_lang bpc \<subseteq> ltlc_language \<phi>
   | Some None \<Rightarrow> (\<not>(bpc_lang bpc \<subseteq> ltlc_language \<phi>))
   | Some (Some ce) \<Rightarrow> 
       bpc_is_run bpc (run_of_lasso ce) 
     \<and> bpc_props o run_of_lasso ce \<notin> ltlc_language \<phi>"
   using cava_sys_agn_correct[OF bpc_to_sa_impl_refine bpc_to_sa_invar bpc_to_sa_fr, 
     of bpc \<phi> cfg]
   unfolding cava_bpc_def
   by (auto split: option.split simp: lasso_run_rel_def br_def)
 
 export_code cava_bpc checking SML
 
 subsection {* Model Checker for Promela Programs *}
 
 definition promela_to_sa 
   :: "PromelaDatastructures.program \<times> APs \<times> gState \<Rightarrow> (gState, nat set) sa_rec" 
   -- "Conversion of a Promela model to a system automata."
   where "promela_to_sa promg \<equiv> let (prog,APs,g\<^sub>0)=promg in
   \<lparr>
     g_V = UNIV,
     g_E = E_of_succ (ls.\<alpha> o Promela.nexts_code prog),
     g_V0 = {g\<^sub>0},
     sa_L = promela_props_ltl APs
   \<rparr>"
 
 definition promela_to_sa_impl 
   :: "PromelaDatastructures.program \<times> APs \<times> gState
   \<Rightarrow> (gState, nat \<Rightarrow> bool, unit) sa_impl_scheme" where 
   "promela_to_sa_impl promg \<equiv> let (prog,APs,g\<^sub>0)=promg in
   \<lparr> gi_V = \<lambda>_. True,
     gi_E = ls.to_list o Promela.nexts_code prog,
     gi_V0 = [g\<^sub>0],
     sai_L = propValid APs
   \<rparr>"
 
 lemma promela_to_sa_impl_refine:
   shows "(promela_to_sa_impl promg, promela_to_sa promg) 
   \<in> sa_impl_rel_ext unit_rel Id (\<langle>nat_rel\<rangle>fun_set_rel)"
   unfolding promela_to_sa_impl_def promela_to_sa_def 
   unfolding sa_impl_rel_eext_def g_impl_rel_ext_def
   unfolding gen_sa_impl_rel_eext_def gen_g_impl_rel_ext_def
 
   apply (clarsimp split: prod.split)
   apply (intro conjI)
 
   apply (auto simp: fun_set_rel_def br_def) []
 
   apply (rule E_of_succ_refine[param_fo])
   apply (auto simp: list_set_rel_def br_def ls.correct) []
 
   apply (auto simp: list_set_rel_def br_def) []
   apply (auto simp: fun_set_rel_def br_def in_set_member promela_props_ltl_def) []
   done
 
 definition "cava_promela cfg ast \<phi> \<equiv> 
   let 
       (promg,\<phi>\<^sub>i) = PromelaLTL.prepare cfg ast \<phi>
   in
      cava_sys_agn (fst cfg) (promela_to_sa_impl promg) \<phi>\<^sub>i"
 
 text {*
   The next theorem states correctness of the Promela model checker.
 
   The correctness is specified for some AST.
 *}
 lemma cava_promela_correct:
   shows 
   "case cava_promela cfg ast \<phi> of 
     None \<Rightarrow> promela_language ast \<subseteq> ltlc_language \<phi>
   | Some None \<Rightarrow> (\<not>(promela_language ast \<subseteq> ltlc_language \<phi>))
   | Some (Some ce) \<Rightarrow> promela_is_run ast (run_of_lasso ce) 
     \<and> promela_props o run_of_lasso ce \<notin> ltlc_language \<phi>"
 proof -
   obtain APs \<phi>\<^sub>i where conv: "PromelaLTL.ltl_convert \<phi> = (APs,\<phi>\<^sub>i)" 
     by (metis prod.exhaust)
   obtain prog g\<^sub>0 where ast: "Promela.setUp ast = (prog,g\<^sub>0)" 
     by (metis prod.exhaust)
 
   let ?promg = "(prog,APs,g\<^sub>0)"
 
   have promela_to_sa_invar: "sa (promela_to_sa ?promg)"
     apply unfold_locales
     apply (simp add: promela_to_sa_def)
     apply (simp add: promela_to_sa_def)
     done
 
   have promela_to_sa_fr: "finite ((g_E (promela_to_sa ?promg))\<^sup>* `` g_V0 (promela_to_sa ?promg))"
     apply (simp add: promela_to_sa_def)
     apply (rule 
       finite_subset[OF _ Promela.reachable_states_finite[of prog g\<^sub>0]])
     apply (rule rtrancl_reachable_induct)
     apply (auto 
       intro: Promela.reachable_states.intros 
       simp: E_of_succ_def) [2]
     apply (fact setUp_program_inv[OF ast])
     apply (fact setUp_gState_inv[OF ast])
     done
 
   interpret promela_to_sa: sa "promela_to_sa ?promg"
     using promela_to_sa_invar .
 
   have promela_to_sa_run_conv[simp]: 
     "graph_defs.is_run (promela_to_sa ?promg) = promela_is_run_ltl ?promg"
     apply (rule ext)
     unfolding graph_defs.is_run_def
     unfolding promela_to_sa_def promela_is_run_ltl_def promela_is_run'_def ipath_def E_of_succ_def
     by auto
 
   have promela_to_sa_L_conv[simp]: 
     "sa_L (promela_to_sa ?promg) = promela_props_ltl APs"
     apply (rule ext)
     unfolding promela_to_sa_def promela_props_ltl_def[abs_def]
     by (auto simp: E_of_succ_def)
 
   have promela_to_sa_lang_conv[simp]: 
     "sa.lang (promela_to_sa ?promg) = promela_language_ltl ?promg"
     unfolding promela_to_sa.lang_def promela_to_sa.accept_def[abs_def]
       promela_language_ltl_def
     by auto
   
   show ?thesis
     using cava_sys_agn_correct[OF 
       promela_to_sa_impl_refine promela_to_sa_invar promela_to_sa_fr, of \<phi>\<^sub>i "fst cfg"]
     using promela_language_sub_iff[OF conv ast] promela_run_in_language_iff[OF conv]
     unfolding cava_promela_def PromelaLTL.prepare_def
     by (auto split: option.split prod.splits simp: lasso_run_rel_def br_def conv ast promela_is_run_ltl_def)
 qed
 
 export_code cava_promela checking SML
 
 subsection {* Extraction of SML Code *}
 
 definition "dflt_cfg \<equiv> (CFG_L2B_GERTHS,(),CFG_CE_SCC_GABOW)"
 
 export_code (* Cava MC *)
             cava_bpc cava_promela dflt_cfg CAVA_Impl.CFG_CE_NDFS
             
             (* BP *)
             BoolProgs.print_config chose_prog list_progs
             BoolProgs_LTL_Conv.ltl_conv BoolProgs_LTL_Conv.CProp 
             BoolProgs_Programs.default_prog 
             BoolProgs_Programs.keys_of_map
             BoolProgs_Programs.default_prog BoolProgs_Programs.keys_of_map
             
             (* Promela *)
             printProcesses Promela.printConfigFromAST lookupLTL
             PromelaLTLConv.ltl_conv
 
             (* stat printing *)
             frv_export_code LTL_to_GBA_impl.create_name_gba_code
 
             (* Lasso *)
             lasso_v0 lasso_va lasso_reach lasso_cycle
             
             (* Arith *)
             nat_of_integer int_of_integer
             integer_of_nat integer_of_int
   checking SML 
 
 export_code (* Cava MC *)
             cava_bpc cava_promela dflt_cfg CAVA_Impl.CFG_CE_NDFS
             
             (* BP *)
             BoolProgs.print_config chose_prog list_progs
             BoolProgs_LTL_Conv.ltl_conv BoolProgs_LTL_Conv.CProp 
             BoolProgs_Programs.default_prog 
             BoolProgs_Programs.keys_of_map
             BoolProgs_Programs.default_prog BoolProgs_Programs.keys_of_map
             
             (* Promela *)
             printProcesses Promela.printConfigFromAST lookupLTL
             PromelaLTLConv.ltl_conv PromelaLTLConv.CProp PromelaLTLConv.Eq PromelaLTLConv.Ident
 
             (* stat printing *)
             frv_export_code LTL_to_GBA_impl.create_name_gba_code
 
             (* Lasso *)
             lasso_v0 lasso_va lasso_reach lasso_cycle
             
             (* Arith *)
             nat_of_integer int_of_integer
             integer_of_nat integer_of_int
   in SML 
   file "code/CAVA_Export.sml"
 
 end
diff --git a/thys/LTL_to_DRA/Impl/LTL_CAVA_Compat.thy b/thys/LTL_to_DRA/Impl/LTL_CAVA_Compat.thy
--- a/thys/LTL_to_DRA/Impl/LTL_CAVA_Compat.thy
+++ b/thys/LTL_to_DRA/Impl/LTL_CAVA_Compat.thy
@@ -1,140 +1,37 @@
 (*  
     Author:      Salomon Sickert
+    Author:      _
+    Author:      _
+    Author:      _
     License:     BSD
 *)
 
-section \<open>CAVA LTL Compatibility Layer\<close>
+section \<open>LTL with syntactic sugar\<close>
 
 theory LTL_CAVA_Compat
-  imports Main "../LTL"
+  imports Main "~~/src/HOL/Library/Omega_Words_Fun" "../../../../afp/LTL/LTL" "../LTL_FGXU"
 begin
 
-subsection \<open>Original CAVA LTL Definitions\<close>
-
--- \<open>The following definitions are adapted from the CAVA formalisation. The aim is to reuse the parsing infrastructure of CAVA\<close>
-
-datatype (ltlc_aprops: 'a)
-  ltlc = LTLcTrue 
-   | LTLcFalse
-   | LTLcProp 'a  
-   | LTLcNeg "'a ltlc"    
-   | LTLcAnd "'a ltlc" "'a ltlc"  
-   | LTLcOr "'a ltlc" "'a ltlc"   
-   | LTLcImplies "'a ltlc" "'a ltlc"  
-   | LTLcIff "'a ltlc" "'a ltlc"  
-   | LTLcNext "'a ltlc"      
-   | LTLcFinal "'a ltlc"     
-   | LTLcGlobal "'a ltlc"    
-   | LTLcUntil "'a ltlc" "'a ltlc"
-   | LTLcRelease "'a ltlc" "'a ltlc"
-
-notation
-      LTLcTrue     ("true\<^sub>c")
-  and LTLcFalse    ("false\<^sub>c")
-  and LTLcProp     ("prop\<^sub>c'(_')")
-  and LTLcNeg      ("not\<^sub>c _" [85] 85)
-  and LTLcAnd      ("_ and\<^sub>c _" [82,82] 81)
-  and LTLcOr       ("_ or\<^sub>c _" [81,81] 80)
-  and LTLcImplies  ("_ implies\<^sub>c _" [81,81] 80)
-  and LTLcIff      ("_ iff\<^sub>c _" [81,81] 80)
-  and LTLcNext     ("X\<^sub>c _" [88] 87)
-  and LTLcFinal    ("F\<^sub>c _" [88] 87)
-  and LTLcGlobal   ("G\<^sub>c _" [88] 87)
-  and LTLcUntil    ("_ U\<^sub>c _" [84,84] 83)
-  and LTLcRelease  ("_ V\<^sub>c _" [83,83] 82)
-
-fun ltlc_semantics 
-  :: "['a set word, 'a ltlc] \<Rightarrow> bool" ("_ \<Turnstile>\<^sub>c _" [80,80] 80)
-where
-    "\<xi> \<Turnstile>\<^sub>c true\<^sub>c = True"
-  | "\<xi> \<Turnstile>\<^sub>c false\<^sub>c = False"
-  | "\<xi> \<Turnstile>\<^sub>c prop\<^sub>c(q) = (q\<in>\<xi> 0)"
-  | "\<xi> \<Turnstile>\<^sub>c not\<^sub>c \<phi> = (\<not> \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> and\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<and> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> or\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<or> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> implies\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> iff\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c X\<^sub>c \<phi> = (suffix 1 \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c F\<^sub>c \<phi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c G\<^sub>c \<phi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> U\<^sub>c \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> V\<^sub>c \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"
-
 subsection \<open>Translation\<close>
 
---\<open>The following infrastructure translates the CAVA LTL datatype to the LTL datatype used in this project\<close>
+--\<open>The following infrastructure translates the arbitrary LTL datatype to the LTL datatype used in this project\<close>
 
-fun ltlc_to_ltl :: "bool \<Rightarrow> 'a ltlc \<Rightarrow> 'a ltl"
+fun ltlc_to_ltl :: "'a ltln \<Rightarrow> 'a ltl"
 where
-  "ltlc_to_ltl False true\<^sub>c  = true"
-| "ltlc_to_ltl False false\<^sub>c = false"
-| "ltlc_to_ltl False prop\<^sub>c(q) = p(q)"
-| "ltlc_to_ltl False (not\<^sub>c \<phi>) = ltlc_to_ltl True \<phi>"
-| "ltlc_to_ltl False (\<phi> and\<^sub>c \<psi>) = ltlc_to_ltl False \<phi> and ltlc_to_ltl False \<psi>"
-| "ltlc_to_ltl False (\<phi> or\<^sub>c \<psi>) = ltlc_to_ltl False \<phi> or ltlc_to_ltl False \<psi>"
-| "ltlc_to_ltl False (\<phi> implies\<^sub>c \<psi>) = ltlc_to_ltl True \<phi> or ltlc_to_ltl False \<psi>"
-| "ltlc_to_ltl False (\<phi> iff\<^sub>c \<psi>) = (ltlc_to_ltl True \<phi> or ltlc_to_ltl False \<psi>) and (ltlc_to_ltl False \<phi> or ltlc_to_ltl True \<psi>)"
-| "ltlc_to_ltl False (F\<^sub>c \<phi>) = F (ltlc_to_ltl False \<phi>)"
-| "ltlc_to_ltl False (G\<^sub>c \<phi>) = G (ltlc_to_ltl False \<phi>)"
-| "ltlc_to_ltl False (\<phi> U\<^sub>c \<psi>) = ltlc_to_ltl False \<phi> U ltlc_to_ltl False \<psi>"
-| "ltlc_to_ltl False (\<phi> V\<^sub>c \<psi>) = G (ltlc_to_ltl False \<psi>) or (ltlc_to_ltl False \<psi> U (ltlc_to_ltl False \<phi> and ltlc_to_ltl False \<psi>))"
-| "ltlc_to_ltl True  true\<^sub>c  = false"
-| "ltlc_to_ltl True  false\<^sub>c = true"
-| "ltlc_to_ltl True  prop\<^sub>c(q) = np(q)"
-| "ltlc_to_ltl True  (not\<^sub>c \<phi>) = ltlc_to_ltl False \<phi>"
-| "ltlc_to_ltl True  (\<phi> and\<^sub>c \<psi>) = ltlc_to_ltl True \<phi> or ltlc_to_ltl True \<psi>"
-| "ltlc_to_ltl True  (\<phi> or\<^sub>c \<psi>) = ltlc_to_ltl True \<phi> and ltlc_to_ltl True \<psi>"
-| "ltlc_to_ltl True  (\<phi> implies\<^sub>c \<psi>) = ltlc_to_ltl False \<phi> and ltlc_to_ltl True \<psi>"
-| "ltlc_to_ltl True  (\<phi> iff\<^sub>c \<psi>) = (ltlc_to_ltl True \<phi> and ltlc_to_ltl False \<psi>) or (ltlc_to_ltl False \<phi> and ltlc_to_ltl True \<psi>)"
-| "ltlc_to_ltl True  (F\<^sub>c \<phi>) = G (ltlc_to_ltl True \<phi>)"
-| "ltlc_to_ltl True  (G\<^sub>c \<phi>) = F (ltlc_to_ltl True \<phi>)"
-| "ltlc_to_ltl True  (\<phi> U\<^sub>c \<psi>) = G (ltlc_to_ltl True \<psi>) or (ltlc_to_ltl True \<psi> U (ltlc_to_ltl True \<phi> and ltlc_to_ltl True \<psi>))"
-| "ltlc_to_ltl True  (\<phi> V\<^sub>c \<psi>) = ltlc_to_ltl True \<phi> U ltlc_to_ltl True \<psi>"
-| "ltlc_to_ltl b     (X\<^sub>c \<phi>) = X (ltlc_to_ltl b \<phi>)"
-
-lemma V_equiv:
-  "w \<Turnstile>\<^sub>c \<phi> V\<^sub>c \<psi> \<longleftrightarrow> w \<Turnstile>\<^sub>c (\<psi> U\<^sub>c (\<psi> and\<^sub>c \<phi>)) or\<^sub>c G\<^sub>c \<psi>"
-proof (cases "\<exists>i. \<not>suffix i w \<Turnstile>\<^sub>c \<psi>")
-  case True
-    def i \<equiv> "Least (\<lambda>i. \<not>suffix i w \<Turnstile>\<^sub>c \<psi>)"
-    have "\<And>j. j < i \<Longrightarrow> suffix j w \<Turnstile>\<^sub>c \<psi>" and "\<not> suffix i w \<Turnstile>\<^sub>c \<psi>"
-      using True LeastI not_less_Least unfolding i_def by metis+ (* Slow *)
-    hence "(\<forall>i. suffix i w \<Turnstile>\<^sub>c \<psi> \<or> (\<exists>j<i. suffix j w \<Turnstile>\<^sub>c \<phi>)) \<Longrightarrow> (\<exists>i. (suffix i w \<Turnstile>\<^sub>c \<psi> \<and> suffix i w \<Turnstile>\<^sub>c \<phi>) \<and> (\<forall>j<i. suffix j w \<Turnstile>\<^sub>c \<psi>))"
-      by fastforce  
-      moreover
-     hence "(\<exists>i. (suffix i w \<Turnstile>\<^sub>c \<psi> \<and> suffix i w \<Turnstile>\<^sub>c \<phi>) \<and> (\<forall>j<i. suffix j w \<Turnstile>\<^sub>c \<psi>)) \<Longrightarrow> (\<forall>i. suffix i w \<Turnstile>\<^sub>c \<psi> \<or> (\<exists>j<i. suffix j w \<Turnstile>\<^sub>c \<phi>))"
-        using linorder_cases by blast
-      ultimately
-    show ?thesis
-      using True by auto
-qed auto
-
-lemma push_neg_U:
-  "w \<Turnstile>\<^sub>c (not\<^sub>c (\<phi> U\<^sub>c \<psi>)) \<longleftrightarrow> w \<Turnstile>\<^sub>c not\<^sub>c \<psi> U\<^sub>c (not\<^sub>c \<psi> and\<^sub>c not\<^sub>c \<phi>) or\<^sub>c G\<^sub>c (not\<^sub>c \<psi>)"
-proof -
-  have "w \<Turnstile>\<^sub>c (not\<^sub>c (\<phi> U\<^sub>c \<psi>)) \<longleftrightarrow> w \<Turnstile>\<^sub>c (not\<^sub>c \<phi>) V\<^sub>c (not\<^sub>c \<psi>)"
-    by simp
-  also
-  have "\<dots> \<longleftrightarrow> w \<Turnstile>\<^sub>c not\<^sub>c \<psi> U\<^sub>c (not\<^sub>c \<psi> and\<^sub>c not\<^sub>c \<phi>) or\<^sub>c G\<^sub>c (not\<^sub>c \<psi>)"
-    unfolding V_equiv by simp
-  finally
-  show ?thesis
-    by blast
-qed
+  "ltlc_to_ltl true\<^sub>n  = true"
+| "ltlc_to_ltl false\<^sub>n = false"
+| "ltlc_to_ltl prop\<^sub>n(q) = p(q)"
+| "ltlc_to_ltl nprop\<^sub>n(q) = np(q)"
+| "ltlc_to_ltl (\<phi> and\<^sub>n \<psi>) = ltlc_to_ltl \<phi> and ltlc_to_ltl \<psi>"
+| "ltlc_to_ltl (\<phi> or\<^sub>n \<psi>) = ltlc_to_ltl \<phi> or ltlc_to_ltl \<psi>"
+| "ltlc_to_ltl (\<phi> U\<^sub>n \<psi>) = (if \<phi> = true\<^sub>n then F (ltlc_to_ltl \<psi>) else ltlc_to_ltl \<phi> U ltlc_to_ltl \<psi>)"
+| "ltlc_to_ltl (\<phi> V\<^sub>n \<psi>) = (if \<phi> = false\<^sub>n then G (ltlc_to_ltl \<psi>) else G (ltlc_to_ltl \<psi>) or (ltlc_to_ltl \<psi> U (ltlc_to_ltl \<phi> and ltlc_to_ltl \<psi>)))"
+| "ltlc_to_ltl (X\<^sub>n \<phi>) = X (ltlc_to_ltl \<phi>)"
 
 lemma translation_correct:
-  "w \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> w \<Turnstile> ltlc_to_ltl False \<phi>"
-  "\<not> w \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> w \<Turnstile> ltlc_to_ltl True \<phi>"
-proof (induction \<phi> arbitrary: w)
-  case (LTLcUntil \<phi> \<psi>)
-    case 2
-      thus ?case
-        by (unfold ltlc_to_ltl.simps ltl_semantics.simps LTLcUntil[symmetric] ltlc_semantics.simps(4)[symmetric] push_neg_U) auto
-next
-  case (LTLcRelease \<phi> \<psi>)
-    case 1
-      thus ?case
-        by (unfold ltlc_to_ltl.simps ltl_semantics.simps LTLcRelease[symmetric] V_equiv) auto  
-qed auto
+  "w \<Turnstile>\<^sub>n \<phi> \<longleftrightarrow> w \<Turnstile> ltlc_to_ltl \<phi>"
+  apply (induction \<phi> arbitrary: w)
+  apply (simp_all add:  del: ltln_semantics.simps(9))
+  unfolding ltln_Release_alterdef by auto
 
-end
+end
\ No newline at end of file
diff --git a/thys/LTL_to_DRA/LTL.thy b/thys/LTL_to_DRA/LTL.thy
deleted file mode 100755
--- a/thys/LTL_to_DRA/LTL.thy
+++ /dev/null
@@ -1,851 +0,0 @@
-(*
-    Author:      Salomon Sickert
-    License:     BSD
-*)
-
-section \<open>LTL (in Negation-Normal-Form)\<close>
-
-theory LTL
-  imports Main "Aux/Words2"
-begin
-
-text \<open>Inspired/Based on schimpf/LTL\<close>
-
-subsection \<open>Syntax\<close>
-
-datatype (vars: 'a) ltl  =
-    LTLTrue
-  | LTLFalse
-  | LTLProp 'a
-  | LTLPropNeg 'a
-  | LTLAnd "'a ltl" "'a ltl"
-  | LTLOr "'a ltl" "'a ltl"
-  | LTLNext "'a ltl"
-  | LTLGlobal (theG: "'a ltl")
-  | LTLFinal "'a ltl"
-  | LTLUntil "'a ltl" "'a ltl"
-
-notation
-      LTLTrue     ("true")
-  and LTLFalse    ("false")
-  and LTLProp     ("p'(_')")
-  and LTLPropNeg  ("np'(_')" [86] 85)
-  and LTLAnd      ("_ and _" [83,83] 82)
-  and LTLOr       ("_ or _" [82,82] 81)
-  and LTLNext     ("X _" [88] 87)
-  and LTLGlobal   ("G _" [85] 84)
-  and LTLFinal    ("F _" [84] 83)
-  and LTLUntil    ("_ U _" [87,87] 86)
-
-subsection \<open>Semantics\<close>
-
-fun ltl_semantics :: "['a set word, 'a ltl] \<Rightarrow> bool" (infix "\<Turnstile>" 80)
-where
-  "w \<Turnstile> true = True"
-| "w \<Turnstile> false = False"
-| "w \<Turnstile> p(q) = (q \<in> w 0)"
-| "w \<Turnstile> np(q) = (q \<notin> w 0)"
-| "w \<Turnstile> \<phi> and \<psi> = (w \<Turnstile> \<phi> \<and> w \<Turnstile> \<psi>)"
-| "w \<Turnstile> \<phi> or \<psi> = (w \<Turnstile> \<phi> \<or> w \<Turnstile> \<psi>)"
-| "w \<Turnstile> X \<phi> = (suffix 1 w \<Turnstile> \<phi>)"
-| "w \<Turnstile> G \<phi> = (\<forall>k. suffix k w \<Turnstile> \<phi>)"
-| "w \<Turnstile> F \<phi> = (\<exists>k. suffix k w \<Turnstile> \<phi>)"
-| "w \<Turnstile> \<phi> U \<psi> = (\<exists>k. suffix k w \<Turnstile> \<psi> \<and> (\<forall>j < k. suffix j w \<Turnstile> \<phi>))"
-
-fun ltl_prop_entailment :: "['a ltl set, 'a ltl] \<Rightarrow> bool" (infix "\<Turnstile>\<^sub>P" 80)
-where
-  "\<A> \<Turnstile>\<^sub>P true = True"
-| "\<A> \<Turnstile>\<^sub>P false = False"
-| "\<A> \<Turnstile>\<^sub>P \<phi> and \<psi> = (\<A> \<Turnstile>\<^sub>P \<phi> \<and> \<A> \<Turnstile>\<^sub>P \<psi>)"
-| "\<A> \<Turnstile>\<^sub>P \<phi> or \<psi> = (\<A> \<Turnstile>\<^sub>P \<phi> \<or> \<A> \<Turnstile>\<^sub>P \<psi>)"
-| "\<A> \<Turnstile>\<^sub>P \<phi> = (\<phi> \<in> \<A>)"
-
-subsubsection \<open>Properties\<close>
-
-lemma LTL_G_one_step_unfolding:
-  "w \<Turnstile> G \<phi> \<longleftrightarrow> (w \<Turnstile> \<phi> \<and> w \<Turnstile> X (G \<phi>))"
-  (is "?lhs \<longleftrightarrow> ?rhs")
-proof
-  assume ?lhs
-  hence "w \<Turnstile> \<phi>"
-    using suffix_0[of w] ltl_semantics.simps(8)[of w \<phi>] by metis
-  moreover
-  from `?lhs` have "w \<Turnstile> X (G \<phi>)"
-    by simp
-  ultimately
-  show ?rhs by simp
-next
-  assume ?rhs
-  hence "w \<Turnstile> X (G \<phi>)" by simp
-  hence "\<forall>k. suffix (k + 1) w \<Turnstile> \<phi>" by force
-  hence "\<forall>k > 0. suffix k w \<Turnstile> \<phi>"
-    by (metis Suc_eq_plus1 gr0_implies_Suc)
-  moreover
-  from `?rhs` have "(suffix 0 w) \<Turnstile> \<phi>" by simp
-  ultimately
-  show ?lhs
-    using neq0_conv ltl_semantics.simps(8)[of w \<phi>] by blast
-qed
-
-lemma LTL_F_one_step_unfolding:
-  "w \<Turnstile> F \<phi> \<longleftrightarrow> (w \<Turnstile> \<phi> \<or> w \<Turnstile> X (F \<phi>))"
-  (is "?lhs \<longleftrightarrow> ?rhs")
-proof
-  assume ?lhs
-  then obtain k where "suffix k w \<Turnstile> \<phi>" by fastforce
-  thus ?rhs by (cases k) auto
-next
-  assume ?rhs
-  thus ?lhs
-    using suffix_0[of w] suffix_suffix[of _ 1 w] by (metis ltl_semantics.simps(7) ltl_semantics.simps(9))
-qed
-
-lemma LTL_U_one_step_unfolding:
-  "w \<Turnstile> \<phi> U \<psi> \<longleftrightarrow> (w \<Turnstile> \<psi> \<or> (w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)))"
-  (is "?lhs \<longleftrightarrow> ?rhs")
-proof
-  assume ?lhs
-  then obtain k where "suffix k w \<Turnstile> \<psi>" and "\<forall>j<k. suffix j w \<Turnstile> \<phi>"
-    by force
-  thus ?rhs
-    by (cases k) auto
-next
-  assume ?rhs
-  thus ?lhs
-  proof (cases "w \<Turnstile> \<psi>")
-    case False
-      hence "w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)"
-        using `?rhs` by blast
-      obtain k where "suffix k (suffix 1 w) \<Turnstile> \<psi>" and "\<forall>j<k. suffix j (suffix 1 w) \<Turnstile> \<phi>"
-        using False `?rhs` by force
-      moreover
-      {
-        fix j assume "j < 1 + k"
-        hence "suffix j w \<Turnstile> \<phi>"
-          using `w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)` `\<forall>j<k. suffix j (suffix 1 w) \<Turnstile> \<phi>`[unfolded suffix_suffix]
-          by (cases j) simp+
-      }
-      ultimately
-      show ?thesis
-        by auto
-  qed force
-qed
-
-lemma LTL_GF_infinitely_many_suffixes:
-  "w \<Turnstile> G (F \<phi>) = (\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile> \<phi>)"
-  (is "?lhs = ?rhs")
-proof
-  let ?S = "{i | i j. suffix (i + j) w \<Turnstile> \<phi>}"
-  let ?S' = "{i + j | i j. suffix (i + j) w \<Turnstile> \<phi>}"
-
-  assume ?lhs
-  hence "infinite ?S"
-    by auto
-  moreover
-  have "\<forall>s \<in> ?S. \<exists>s' \<in> ?S'. s \<le> s'"
-    by fastforce
-  ultimately
-  have "infinite ?S'"
-    using infinite_nat_iff_unbounded_le le_trans by meson
-  moreover
-  have "?S' = {k | k. suffix k w \<Turnstile> \<phi>}"
-    using monoid_add_class.add.left_neutral by metis
-  ultimately
-  have "infinite {k | k. suffix k w \<Turnstile> \<phi>}"
-    by metis
-  thus ?rhs unfolding Inf_many_def by force
-next
-  assume ?rhs
-  {
-    fix i
-    from `?rhs` obtain k where "i \<le> k" and "suffix k w \<Turnstile> \<phi>"
-      using INFM_nat_le[of "\<lambda>n. suffix n w \<Turnstile> \<phi>"] by blast
-    then obtain j where "k = i + j"
-      using le_iff_add[of i k] by fast
-    hence "suffix j (suffix i w) \<Turnstile> \<phi>"
-      using `suffix k w \<Turnstile> \<phi>` suffix_suffix by fastforce
-    hence "suffix i w \<Turnstile> F \<phi>" by auto
-  }
-  thus ?lhs by auto
-qed
-
-lemma LTL_FG_almost_all_suffixes:
-  "w \<Turnstile> F G \<phi> = (\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile> \<phi>)"
-  (is "?lhs = ?rhs")
-proof
-  let ?S = "{k. \<not> suffix k w \<Turnstile> \<phi>}"
-
-  assume ?lhs
-  then obtain i where "suffix i w \<Turnstile> G \<phi>"
-    by fastforce
-  hence "\<And>j. j \<ge> i \<Longrightarrow> (suffix j w \<Turnstile> \<phi>)"
-    using le_iff_add[of i] by auto
-  hence "\<And>j. \<not>suffix j w \<Turnstile> \<phi> \<Longrightarrow> j < i"
-    using le_less_linear by blast
-  hence "?S \<subseteq> {k. k < i}"
-    by blast
-  hence "finite ?S"
-    using finite_subset by fast
-  thus ?rhs
-    unfolding Alm_all_def Inf_many_def by presburger
-next
-  assume ?rhs
-  obtain S where S_def: "S = {k. \<not> suffix k w \<Turnstile> \<phi>}" by blast
-  hence "finite S"
-    using `?rhs` unfolding Alm_all_def Inf_many_def by fast
-  then obtain i where "i = Max S" by blast
-  {
-    fix j
-    assume "i < j"
-    hence "j \<notin> S"
-      using `i = Max S` Max.coboundedI[OF `finite S`] less_le_not_le by blast
-    hence "suffix j w \<Turnstile> \<phi>" using S_def by fast
-  }
-  hence "\<forall>j > i. (suffix j w \<Turnstile> \<phi>)" by simp
-  hence "suffix (Suc i) w \<Turnstile> G \<phi>" by auto
-  thus ?lhs
-    using ltl_semantics.simps(9)[of w "G \<phi>"] by blast
-qed
-
-lemma LTL_FG_suffix:
-  "(suffix i w) \<Turnstile> F (G \<phi>) = w \<Turnstile> F (G \<phi>)"
-proof -
-  have "(\<exists>m. \<forall>n\<ge>m. suffix n w \<Turnstile> \<phi>) = (\<exists>m. \<forall>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>)" (is "?l = ?r")
-  proof
-    assume ?r
-    then obtain m where "\<forall>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>"
-      by blast
-    hence "\<forall>n\<ge>i+m. suffix n w \<Turnstile> \<phi>"
-      unfolding suffix_suffix by (metis le_iff_add add_leE add_le_cancel_left)
-    thus ?l
-      by auto
-  qed (metis suffix_suffix trans_le_add2)
-  thus ?thesis
-    unfolding LTL_FG_almost_all_suffixes MOST_nat_le ..
-qed
-
-lemma LTL_GF_suffix:
-  "(suffix i w) \<Turnstile> G (F \<phi>) = w \<Turnstile> G (F \<phi>)"
-proof -
-  have "(\<forall>m. \<exists>n\<ge>m. suffix n w \<Turnstile> \<phi>) = (\<forall>m. \<exists>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>)" (is "?l = ?r")
-  proof
-    assume ?l
-    thus ?r
-      by (metis suffix_suffix add_leE add_le_cancel_left le_Suc_ex)
-  qed (metis suffix_suffix trans_le_add2)
-  thus ?thesis
-    unfolding LTL_GF_infinitely_many_suffixes INFM_nat_le ..
-qed
-
-lemma LTL_suffix_G:
-  "w \<Turnstile> G \<phi> \<Longrightarrow> suffix i w \<Turnstile> G \<phi>"
-  using suffix_0 suffix_suffix by (induction i) simp_all
-
-lemma LTL_prop_entailment_monotonI[intro]:
-  "S \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> S' \<Turnstile>\<^sub>P \<phi>"
-  by (induction rule: ltl_prop_entailment.induct) auto
-
-lemma ltl_models_equiv_prop_entailment:
-  "w \<Turnstile> \<phi> = {\<chi>. w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P \<phi>"
-  by (induction \<phi>) auto
-
-subsubsection \<open>Limit Behaviour of the G-operator\<close>
-
-abbreviation Only_G
-where
-  "Only_G S \<equiv> \<forall>x \<in> S. \<exists>y. x = G y"
-
-lemma ltl_G_stabilize:
-  assumes "finite \<G>"
-  assumes "Only_G \<G>"
-  obtains i where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
-proof -
-  have "finite \<G> \<Longrightarrow> Only_G \<G> \<Longrightarrow> \<exists>i. \<forall>\<chi> \<in> \<G>. \<forall>j. suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
-  proof (induction rule: finite_induct)
-    case (insert \<chi> \<G>)
-      then obtain i\<^sub>1  where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i\<^sub>1 w \<Turnstile> \<chi> = suffix (i\<^sub>1 + j) w \<Turnstile> \<chi>"
-        by blast
-      moreover
-      from insert obtain \<psi> where "\<chi> = G \<psi>"
-        by blast
-      have "\<exists>i. \<forall>j. suffix i w \<Turnstile> G \<psi> = suffix (i + j) w \<Turnstile> G \<psi>"
-        by (metis LTL_suffix_G plus_nat.add_0 suffix_0 suffix_suffix)
-      then obtain i\<^sub>2 where "\<And>j. suffix i\<^sub>2 w \<Turnstile> \<chi> = suffix (i\<^sub>2 + j) w \<Turnstile> \<chi>"
-        unfolding `\<chi> = G \<psi>` by blast
-      ultimately
-      have "\<And>\<chi>' j. \<chi>' \<in> \<G> \<union> {\<chi>} \<Longrightarrow> suffix (i\<^sub>1 + i\<^sub>2) w \<Turnstile> \<chi>' = suffix (i\<^sub>1 + i\<^sub>2 + j) w \<Turnstile> \<chi>'"
-        unfolding Un_iff singleton_iff by (metis add.commute add.left_commute)
-      thus ?case
-        by blast
-  qed simp
-  with assms obtain i where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
-    by blast
-  thus ?thesis
-    using that by blast
-qed
-
-lemma ltl_G_stabilize_property:
-  assumes "finite \<G>"
-  assumes "Only_G \<G>"
-  assumes "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
-  assumes "G \<psi> \<in> \<G> \<inter> {\<chi>. w \<Turnstile> F \<chi>}"
-  shows "suffix i w \<Turnstile> G \<psi>"
-proof -
-  obtain j where "suffix j w \<Turnstile> G \<psi>"
-    using assms by fastforce
-  thus "suffix i w \<Turnstile> G \<psi>"
-    by (cases "i \<le> j", insert assms, unfold le_iff_add, blast,
-        metis (erased, lifting) LTL_suffix_G `suffix j w \<Turnstile> G \<psi>` le_add_diff_inverse nat_le_linear suffix_suffix)
-qed
-
-subsection \<open>Subformulae\<close>
-
-subsubsection \<open>Propositions\<close>
-
-fun propos :: "'a ltl \<Rightarrow>'a ltl set"
-where
-  "propos true = {}"
-| "propos false = {}"
-| "propos (\<phi> and \<psi>) = propos \<phi> \<union> propos \<psi>"
-| "propos (\<phi> or \<psi>) = propos \<phi> \<union> propos \<psi>"
-| "propos \<phi> = {\<phi>}"
-
-fun nested_propos :: "'a ltl \<Rightarrow>'a ltl set"
-where
-  "nested_propos true = {}"
-| "nested_propos false = {}"
-| "nested_propos (\<phi> and \<psi>) = nested_propos \<phi> \<union> nested_propos \<psi>"
-| "nested_propos (\<phi> or \<psi>) = nested_propos \<phi> \<union> nested_propos \<psi>"
-| "nested_propos (F \<phi>) = {F \<phi>} \<union> nested_propos \<phi>"
-| "nested_propos (G \<phi>) = {G \<phi>} \<union> nested_propos \<phi>"
-| "nested_propos (X \<phi>) = {X \<phi>} \<union> nested_propos \<phi>"
-| "nested_propos (\<phi> U \<psi>) = {\<phi> U \<psi>} \<union> nested_propos \<phi> \<union> nested_propos \<psi>"
-| "nested_propos \<phi> = {\<phi>}"
-
-lemma finite_propos:
-  "finite (propos \<phi>)" "finite (nested_propos \<phi>)"
-  by (induction \<phi>) simp+
-
-lemma propos_subset:
-  "propos \<phi> \<subseteq> nested_propos \<phi>"
-  by (induction \<phi>) auto
-
-lemma LTL_prop_entailment_restrict_to_propos:
-  "S \<Turnstile>\<^sub>P \<phi> = (S \<inter> propos \<phi>) \<Turnstile>\<^sub>P \<phi>"
-  by (induction \<phi>) auto
-
-lemma propos_foldl:
-  assumes "\<And>x y. propos (f x y) = propos x \<union> propos y"
-  shows "\<Union>{propos y |y. y = i \<or> y \<in> set xs} = propos (foldl f i xs)"
-proof (induction xs rule: rev_induct)
-  case (snoc x xs)
-    have "\<Union>{propos y |y. y = i \<or> y \<in> set (xs@[x])} = \<Union>{propos y |y. y = i \<or> y \<in> set xs} \<union> propos x"
-      by auto
-    also
-    have "\<dots> = propos (foldl f i xs) \<union> propos x"
-      using snoc by auto
-    also
-    have "\<dots> = propos (foldl f i (xs@[x]))"
-      using assms by simp
-    finally
-    show ?case .
-qed simp
-
-subsubsection \<open>G-Subformulae\<close>
-
-text \<open>Notation for paper: mathds{G}\<close>
-
-fun G_nested_propos :: "'a ltl \<Rightarrow>'a ltl set" ("\<^bold>G")
-where
-  "\<^bold>G (\<phi> and \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
-| "\<^bold>G (\<phi> or \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
-| "\<^bold>G (F \<phi>) = \<^bold>G \<phi>"
-| "\<^bold>G (G \<phi>) = \<^bold>G \<phi> \<union> {G \<phi>}"
-| "\<^bold>G (X \<phi>) = \<^bold>G \<phi>"
-| "\<^bold>G (\<phi> U \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
-| "\<^bold>G \<phi> = {}"
-
-lemma G_nested_finite:
-  "finite (\<^bold>G \<phi>)"
-  by (induction \<phi>) auto
-
-lemma G_nested_propos_alt_def:
-  "\<^bold>G \<phi> = nested_propos \<phi> \<inter> {\<psi>. (\<exists>x. \<psi> = G x)}"
-  by (induction \<phi>) auto
-
-lemma G_nested_propos_Only_G:
-  "Only_G (\<^bold>G \<phi>)"
-  unfolding G_nested_propos_alt_def by blast
-
-lemma G_not_in_G:
-  "G \<phi> \<notin> \<^bold>G \<phi>"
-proof -
-  have "\<And>\<chi>. \<chi> \<in> \<^bold>G \<phi> \<Longrightarrow> size \<phi> \<ge> size \<chi>"
-    by (induction \<phi>) fastforce+
-  thus ?thesis
-    by fastforce
-qed
-
-lemma G_subset_G:
-  "\<psi> \<in> \<^bold>G \<phi> \<Longrightarrow> \<^bold>G \<psi> \<subseteq> \<^bold>G \<phi>"
-  "G \<psi> \<in> \<^bold>G \<phi> \<Longrightarrow> \<^bold>G \<psi> \<subseteq> \<^bold>G \<phi>"
-  by (induction \<phi>) auto
-
-lemma \<G>_properties:
-  assumes "\<G> \<subseteq> \<^bold>G \<phi>"
-  shows \<G>_finite: "finite \<G>" and \<G>_elements: "Only_G \<G>"
-  using assms G_nested_finite G_nested_propos_alt_def by (blast dest: finite_subset)+
-
-subsection \<open>Propositional Implication and Equivalence\<close>
-
-definition ltl_prop_implies :: "['a ltl, 'a ltl] \<Rightarrow> bool" (infix "\<longrightarrow>\<^sub>P" 75)
-where
-  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<equiv> \<forall>\<A>. \<A> \<Turnstile>\<^sub>P \<phi> \<longrightarrow> \<A> \<Turnstile>\<^sub>P \<psi>"
-
-definition ltl_prop_equiv :: "['a ltl, 'a ltl] \<Rightarrow> bool" (infix "\<equiv>\<^sub>P" 75)
-where
-  "\<phi> \<equiv>\<^sub>P \<psi> \<equiv> \<forall>\<A>. \<A> \<Turnstile>\<^sub>P \<phi> \<longleftrightarrow> \<A> \<Turnstile>\<^sub>P \<psi>"
-
-lemma ltl_prop_implies_equiv:
-  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<and> \<psi> \<longrightarrow>\<^sub>P \<phi> \<longleftrightarrow> \<phi> \<equiv>\<^sub>P \<psi>"
-  unfolding ltl_prop_implies_def ltl_prop_equiv_def by meson
-
-lemma ltl_prop_equiv_equivp:
-  "equivp (op \<equiv>\<^sub>P)"
-  by (blast intro: equivpI[of "op \<equiv>\<^sub>P", unfolded transp_def symp_def reflp_def ltl_prop_equiv_def])
-
-lemma [trans]:
-  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> \<psi> \<equiv>\<^sub>P \<chi> \<Longrightarrow> \<phi> \<equiv>\<^sub>P \<chi>"
-  using ltl_prop_equiv_equivp[THEN equivp_transp] .
-
-subsubsection \<open>Quotient Type for Propositional Equivalence\<close>
-
-quotient_type 'a ltl_prop_equiv_quotient = "'a ltl" / "op \<equiv>\<^sub>P"
-  morphisms Rep Abs
-  by (simp add: ltl_prop_equiv_equivp)
-
-type_synonym 'a ltl\<^sub>P = "'a ltl_prop_equiv_quotient"
-
-instantiation ltl_prop_equiv_quotient :: (type) equal begin
-
-lift_definition ltl_prop_equiv_quotient_eq_test :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" is "\<lambda>x y. x \<equiv>\<^sub>P y"
-  by (metis ltl_prop_equiv_quotient.abs_eq_iff)
-
-definition
-  eq: "equal_class.equal \<equiv> ltl_prop_equiv_quotient_eq_test"
-
-instance
-  by (standard; simp add: eq ltl_prop_equiv_quotient_eq_test.rep_eq, metis Quotient_ltl_prop_equiv_quotient Quotient_rel_rep)
-
-end
-
-lemma ltl\<^sub>P_abs_rep: "Abs (Rep \<phi>) = \<phi>"
-  by (meson Quotient3_abs_rep Quotient3_ltl_prop_equiv_quotient)
-
-lift_definition ltl_prop_entails_abs :: "'a ltl set \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" ("_ \<up>\<Turnstile>\<^sub>P _") is "op \<Turnstile>\<^sub>P"
-  by (simp add: ltl_prop_equiv_def)
-
-lift_definition ltl_prop_implies_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" ("_ \<up>\<longrightarrow>\<^sub>P _") is "op \<longrightarrow>\<^sub>P"
-  by (simp add: ltl_prop_equiv_def ltl_prop_implies_def)
-
-subsubsection \<open>Propositional Equivalence implies LTL Equivalence\<close>
-
-lemma ltl_prop_implication_implies_ltl_implication:
-  "w \<Turnstile> \<phi> \<Longrightarrow> \<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> w \<Turnstile> \<psi>"
-  unfolding ltl_prop_implies_def ltl_models_equiv_prop_entailment by simp
-
-lemma ltl_prop_equiv_implies_ltl_equiv:
-  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> w \<Turnstile> \<phi> = w \<Turnstile> \<psi>"
-  using ltl_prop_implication_implies_ltl_implication ltl_prop_implies_equiv by blast
-
-subsection \<open>Substitution\<close>
-
-fun subst :: "'a ltl \<Rightarrow> ('a ltl \<rightharpoonup> 'a ltl) \<Rightarrow> 'a ltl"
-where
-  "subst true m = true"
-| "subst false m = false"
-| "subst (\<phi> and \<psi>) m = subst \<phi> m and subst \<psi> m"
-| "subst (\<phi> or \<psi>) m = subst \<phi> m or subst \<psi> m"
-| "subst \<phi> m = (case m \<phi> of Some \<phi>' \<Rightarrow> \<phi>' | None \<Rightarrow> \<phi>)"
-
-text \<open>Based on Uwe Schoening's Translation Lemma (Logic for CS, p. 54)\<close>
-
-lemma ltl_prop_equiv_subst_S:
-  "S \<Turnstile>\<^sub>P subst \<phi> m = ((S - dom m) \<union> {\<chi> | \<chi> \<chi>'. \<chi> \<in> dom m \<and> m \<chi> = Some \<chi>' \<and> S \<Turnstile>\<^sub>P \<chi>'}) \<Turnstile>\<^sub>P \<phi>"
-  by (induction \<phi>) (auto split: option.split)
-
-lemma subst_respects_ltl_prop_entailment:
-  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> subst \<phi> m \<longrightarrow>\<^sub>P subst \<psi> m"
-  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> subst \<phi> m \<equiv>\<^sub>P subst \<psi> m"
-  unfolding ltl_prop_equiv_def ltl_prop_implies_def ltl_prop_equiv_subst_S by blast+
-
-lemma subst_respects_ltl_prop_entailment_generalized:
-  "(\<And>\<A>. (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P y) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P subst x m) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P subst y m"
-  unfolding ltl_prop_equiv_subst_S by simp
-
-lemma decomposable_function_subst:
-  "\<lbrakk>f true = true; f false = false; \<And>\<phi> \<psi>. f (\<phi> and \<psi>) = f \<phi> and f \<psi>; \<And>\<phi> \<psi>. f (\<phi> or \<psi>) = f \<phi> or f \<psi>\<rbrakk> \<Longrightarrow> f \<phi> = subst \<phi> (\<lambda>\<chi>. Some (f \<chi>))"
-  by (induction \<phi>) auto
-
-subsection \<open>Additional Operators\<close>
-
-subsubsection \<open>And\<close>
-
-lemma foldl_LTLAnd_prop_entailment:
-  "S \<Turnstile>\<^sub>P foldl LTLAnd i xs = (S \<Turnstile>\<^sub>P i \<and> (\<forall>y \<in> set xs. S \<Turnstile>\<^sub>P y))"
-  by (induction xs arbitrary: i) auto
-
-fun And :: "'a ltl list \<Rightarrow> 'a ltl"
-where
-  "And [] = true"
-| "And (x#xs) = foldl LTLAnd x xs"
-
-lemma And_prop_entailment:
-  "S \<Turnstile>\<^sub>P And xs = (\<forall>x \<in> set xs. S \<Turnstile>\<^sub>P x)"
-  using foldl_LTLAnd_prop_entailment by (cases xs) auto
-
-lemma And_propos:
-  "propos (And xs) = \<Union>{propos x| x. x \<in> set xs}"
-proof (cases xs)
-  case Nil
-    thus ?thesis by simp
-next
-  case (Cons x xs)
-    thus ?thesis
-      using propos_foldl[of LTLAnd x] by auto
-qed
-
-lemma And_semantics:
-  "w \<Turnstile> And xs = (\<forall>x \<in> set xs. w \<Turnstile> x)"
-proof -
-  have And_propos': "\<And>x. x \<in> set xs \<Longrightarrow> propos x \<subseteq> propos (And xs)"
-    using And_propos by blast
-
-  have "w \<Turnstile> And xs = {\<chi>. \<chi> \<in> propos (And xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P (And xs)"
-    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
-  also
-  have "\<dots> = (\<forall>x \<in> set xs. {\<chi>. \<chi> \<in> propos (And xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
-    using And_prop_entailment by auto
-  also
-  have "\<dots> = (\<forall>x \<in> set xs. {\<chi>. \<chi> \<in> propos x \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
-    using LTL_prop_entailment_restrict_to_propos And_propos' by blast
-  also
-  have "\<dots> = (\<forall>x \<in> set xs. w \<Turnstile> x)"
-    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
-  finally
-  show ?thesis .
-qed
-
-lemma And_append_syntactic:
-  "xs \<noteq> [] \<Longrightarrow> And (xs @ ys) = And ((And xs)#ys)"
-  by (induction xs rule: list_nonempty_induct) simp+
-
-lemma And_append_S:
-  "S \<Turnstile>\<^sub>P And (xs @ ys) = S \<Turnstile>\<^sub>P And xs and And ys"
-  using And_prop_entailment[of S] by auto
-
-lemma And_append:
-  "And (xs @ ys) \<equiv>\<^sub>P And xs and And ys"
-  unfolding ltl_prop_equiv_def using And_append_S by blast
-
-subsubsection \<open>Lifted Variant\<close>
-
-lift_definition and_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("_ \<up>and _") is "\<lambda>x y. x and y"
-  unfolding ltl_prop_equiv_def by simp
-
-fun And_abs :: "'a ltl\<^sub>P list \<Rightarrow> 'a ltl\<^sub>P" ("\<up>And")
-where
-  "\<up>And xs = foldl and_abs (Abs true) xs"
-
-lemma foldl_LTLAnd_prop_entailment_abs:
-  "S \<up>\<Turnstile>\<^sub>P foldl and_abs i xs = (S \<up>\<Turnstile>\<^sub>P i \<and> (\<forall>y\<in>set xs. S \<up>\<Turnstile>\<^sub>P y))"
-  by (induction xs arbitrary: i)
-     (simp_all add: and_abs_def ltl_prop_entails_abs.abs_eq, metis ltl_prop_entails_abs.rep_eq)
-
-lemma And_prop_entailment_abs:
-  "S \<up>\<Turnstile>\<^sub>P \<up>And xs = (\<forall>x \<in> set xs. S \<up>\<Turnstile>\<^sub>P x)"
-  by (simp add: foldl_LTLAnd_prop_entailment_abs ltl_prop_entails_abs.abs_eq)
-
-lemma and_abs_conjunction:
-  "S \<up>\<Turnstile>\<^sub>P \<phi> \<up>and \<psi> \<longleftrightarrow> S \<up>\<Turnstile>\<^sub>P \<phi> \<and> S \<up>\<Turnstile>\<^sub>P \<psi>"
-  by (metis and_abs.abs_eq ltl\<^sub>P_abs_rep ltl_prop_entailment.simps(3) ltl_prop_entails_abs.abs_eq)
-
-subsubsection \<open>Or\<close>
-
-lemma foldl_LTLOr_prop_entailment:
-  "S \<Turnstile>\<^sub>P foldl LTLOr i xs = (S \<Turnstile>\<^sub>P i \<or> (\<exists>y \<in> set xs. S \<Turnstile>\<^sub>P y))"
-  by (induction xs arbitrary: i) auto
-
-fun Or :: "'a ltl list \<Rightarrow> 'a ltl"
-where
-  "Or [] = false"
-| "Or (x#xs) = foldl LTLOr x xs"
-
-lemma Or_prop_entailment:
-  "S \<Turnstile>\<^sub>P Or xs = (\<exists>x \<in> set xs. S \<Turnstile>\<^sub>P x)"
-  using foldl_LTLOr_prop_entailment by (cases xs) auto
-
-lemma Or_propos:
-  "propos (Or xs) = \<Union>{propos x| x. x \<in> set xs}"
-proof (cases xs)
-  case Nil
-    thus ?thesis by simp
-next
-  case (Cons x xs)
-    thus ?thesis
-      using propos_foldl[of LTLOr x] by auto
-qed
-
-lemma Or_semantics:
-  "w \<Turnstile> Or xs = (\<exists>x \<in> set xs. w \<Turnstile> x)"
-proof -
-  have Or_propos': "\<And>x. x \<in> set xs \<Longrightarrow> propos x \<subseteq> propos (Or xs)"
-    using Or_propos by blast
-
-  have "w \<Turnstile> Or xs = {\<chi>. \<chi> \<in> propos (Or xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P (Or xs)"
-    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
-  also
-  have "\<dots> = (\<exists>x \<in> set xs. {\<chi>. \<chi> \<in> propos (Or xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
-    using Or_prop_entailment by auto
-  also
-  have "\<dots> = (\<exists>x \<in> set xs. {\<chi>. \<chi> \<in> propos x \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
-    using LTL_prop_entailment_restrict_to_propos Or_propos' by blast
-  also
-  have "\<dots> = (\<exists>x \<in> set xs. w \<Turnstile> x)"
-    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
-  finally
-  show ?thesis .
-qed
-
-lemma Or_append_syntactic:
-  "xs \<noteq> [] \<Longrightarrow> Or (xs @ ys) = Or ((Or xs)#ys)"
-  by (induction xs rule: list_nonempty_induct) simp+
-
-lemma Or_append_S:
-  "S \<Turnstile>\<^sub>P Or (xs @ ys) = S \<Turnstile>\<^sub>P Or xs or Or ys"
-  using Or_prop_entailment[of S] by auto
-
-lemma Or_append:
-  "Or (xs @ ys) \<equiv>\<^sub>P Or xs or Or ys"
-  unfolding ltl_prop_equiv_def using Or_append_S by blast
-
-subsubsection \<open>$eval_G$\<close>
-
--- \<open>Partly evaluate a formula by only considering G-subformulae\<close>
-
-fun eval\<^sub>G
-where
-  "eval\<^sub>G S (\<phi> and \<psi>) = eval\<^sub>G S \<phi> and eval\<^sub>G S \<psi>"
-| "eval\<^sub>G S (\<phi> or \<psi>) = eval\<^sub>G S \<phi> or eval\<^sub>G S \<psi>"
-| "eval\<^sub>G S (G \<phi>) = (if G \<phi> \<in> S then true else false)"
-| "eval\<^sub>G S \<phi> = \<phi>"
-
--- \<open>Syntactic Properties\<close>
-
-lemma eval\<^sub>G_And_map:
-  "eval\<^sub>G S (And xs) = And (map (eval\<^sub>G S) xs)"
-proof (induction xs rule: rev_induct)
-  case (snoc x xs)
-    thus ?case
-      by (cases xs) simp+
-qed simp
-
-lemma eval\<^sub>G_Or_map:
-  "eval\<^sub>G S (Or xs) = Or (map (eval\<^sub>G S) xs)"
-proof (induction xs rule: rev_induct)
-  case (snoc x xs)
-    thus ?case
-      by (cases xs) simp+
-qed simp
-
-lemma eval\<^sub>G_G_nested:
-  "\<^bold>G (eval\<^sub>G \<G> \<phi>) \<subseteq> \<^bold>G \<phi>"
-  by (induction \<phi>) (simp_all, blast+)
-
-lemma eval\<^sub>G_subst:
-  "eval\<^sub>G S \<phi> = subst \<phi> (\<lambda>\<chi>. Some (eval\<^sub>G S \<chi>))"
-  by (induction \<phi>) simp_all
-
--- \<open>Semantic Properties\<close>
-
-lemma eval\<^sub>G_prop_entailment:
-  "S \<Turnstile>\<^sub>P eval\<^sub>G S \<phi> \<longleftrightarrow> S \<Turnstile>\<^sub>P \<phi>"
-  by (induction \<phi>, auto)
-
-lemma eval\<^sub>G_respectfulness:
-  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> eval\<^sub>G S \<phi> \<longrightarrow>\<^sub>P eval\<^sub>G S \<psi>"
-  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> eval\<^sub>G S \<phi> \<equiv>\<^sub>P eval\<^sub>G S \<psi>"
-  using subst_respects_ltl_prop_entailment eval\<^sub>G_subst by metis+
-
-lemma eval\<^sub>G_respectfulness_generalized:
-  "(\<And>\<A>. (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P y) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P eval\<^sub>G P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P eval\<^sub>G P y"
-  using subst_respects_ltl_prop_entailment_generalized[of S y \<A>] eval\<^sub>G_subst[of P] by metis
-
-lift_definition eval\<^sub>G_abs :: "'a ltl set \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("\<up>eval\<^sub>G") is eval\<^sub>G
-  by (insert eval\<^sub>G_respectfulness(2))
-
-subsection \<open>Finite Quotient Set\<close>
-
-text \<open>If we restrict formulas to a finite set of propositions, the set of quotients of these is finite\<close>
-
-lemma Rep_Abs_prop_entailment[simp]:
-  "A \<Turnstile>\<^sub>P Rep (Abs \<phi>) = A \<Turnstile>\<^sub>P \<phi>"
-  using Quotient3_ltl_prop_equiv_quotient[THEN rep_abs_rsp]
-  by (auto simp add: ltl_prop_equiv_def)
-
-fun sat_models :: "'a ltl_prop_equiv_quotient \<Rightarrow> 'a ltl set set"
-where
-  "sat_models a = {A. A \<Turnstile>\<^sub>P Rep(a)}"
-
-lemma sat_models_invariant:
-  "A \<in> sat_models (Abs \<phi>) = A \<Turnstile>\<^sub>P \<phi>"
-  using Rep_Abs_prop_entailment by auto
-
-lemma sat_models_inj:
-  "inj sat_models"
-  using Quotient3_ltl_prop_equiv_quotient[THEN Quotient3_rel_rep]
-  by (auto simp add: ltl_prop_equiv_def inj_on_def)
-
-lemma sat_models_finite_image:
-  assumes "finite P"
-  shows "finite (sat_models ` {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P})"
-proof -
-  have "sat_models (Abs \<phi>) = {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}" (is "?lhs = ?rhs")
-    if "nested_propos \<phi> \<subseteq> P" for \<phi>
-  proof
-    have "\<And>A B. A \<in> sat_models (Abs \<phi>) \<Longrightarrow> A \<union> B \<in> sat_models (Abs \<phi>)"
-      unfolding sat_models_invariant by blast
-    moreover
-    have "{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} \<subseteq> sat_models (Abs \<phi>)"
-      using sat_models_invariant by fast
-    ultimately
-    show "?rhs \<subseteq> ?lhs"
-      by blast
-  next
-    have "propos \<phi> \<subseteq> P"
-      using that propos_subset by blast
-    have "A \<in> {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
-      if "A \<in> sat_models (Abs \<phi>)" for A
-    proof (standard, goal_cases prems)
-      case prems
-        then have "A \<Turnstile>\<^sub>P \<phi>"
-          using that sat_models_invariant by blast
-        then obtain C D where "C = (A \<inter> P)" and "D = A - P" and "A = C \<union> D"
-          by blast
-        then have "C \<Turnstile>\<^sub>P \<phi>" and "C \<subseteq> P" and "D \<subseteq> UNIV - P"
-          using `A \<Turnstile>\<^sub>P \<phi>` LTL_prop_entailment_restrict_to_propos `propos \<phi> \<subseteq> P` by blast+
-        then have "C \<union> D \<in> {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
-          by blast
-        thus ?case
-          using `A = C \<union> D` by simp
-    qed
-    thus "?lhs \<subseteq> ?rhs"
-      by blast
-  qed
-  hence Equal: "{sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P} = {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
-    by (metis (lifting, no_types))
-
-  have Finite: "finite {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
-  proof -
-    let ?map = "\<lambda>P S. {A \<union> B | A B. A \<in> S \<and> B \<subseteq> UNIV - P}"
-    obtain S' where S'_def: "S' = {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
-      by blast
-    obtain S where S_def: "S = {{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} | \<phi>. nested_propos \<phi> \<subseteq> P}"
-      by blast
-
-    -- \<open>Prove S and ?map applied to it is finite\<close>
-    hence "S \<subseteq> Pow (Pow P)"
-      by blast
-    hence "finite S"
-      using `finite P` finite_Pow_iff infinite_super by fast
-    hence "finite {?map P A | A. A \<in> S}"
-      by fastforce
-
-    -- \<open>Prove that S' can be embedded into S using ?map\<close>
-
-    have "S' \<subseteq> {?map P A | A. A \<in> S}"
-    proof
-      fix A
-      assume "A \<in> S'"
-      then obtain \<phi> where "nested_propos \<phi> \<subseteq> P"
-        and "A = {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
-        using S'_def by blast
-      then have "?map P {A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} = A"
-        by simp
-      moreover
-      have "{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} \<in> S"
-        using `nested_propos \<phi> \<subseteq> P` S_def by auto
-      ultimately
-      show "A \<in> {?map P A | A. A \<in> S}"
-        by blast
-    qed
-
-    show ?thesis
-      using rev_finite_subset[OF `finite {?map P A | A. A \<in> S}` `S' \<subseteq> {?map P A | A. A \<in> S}`]
-      unfolding S'_def .
-  qed
-
-  have Finite2: "finite {sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P}"
-    unfolding Equal using Finite by blast
-  have Equal2: "sat_models ` {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P} = {sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P}"
-    by blast
-
-  show ?thesis
-    unfolding Equal2 using Finite2 by blast
-qed
-
-lemma ltl_prop_equiv_quotient_restricted_to_P_finite:
-  assumes "finite P"
-  shows "finite {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P}"
-proof -
-  have "inj_on sat_models {Abs \<phi> |\<phi>. nested_propos \<phi> \<subseteq> P}"
-    using sat_models_inj subset_inj_on by auto
-  thus ?thesis
-    using finite_imageD[OF sat_models_finite_image[OF assms]] by fast
-qed
-
-locale lift_ltl_transformer =
-  fixes
-    f :: "'a ltl \<Rightarrow> 'b \<Rightarrow> 'a ltl"
-  assumes
-    respectfulness: "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> f \<phi> \<nu> \<equiv>\<^sub>P f \<psi> \<nu>"
-  assumes
-    nested_propos_bounded: "nested_propos (f \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
-begin
-
-lift_definition f_abs :: "'a ltl\<^sub>P \<Rightarrow> 'b \<Rightarrow> 'a ltl\<^sub>P" is f
-  using respectfulness .
-
-lift_definition f_foldl_abs :: "'a ltl\<^sub>P \<Rightarrow> 'b list \<Rightarrow> 'a ltl\<^sub>P" is "foldl f"
-proof -
-  fix \<phi> \<psi> :: "'a ltl" fix w :: "'b list" assume "\<phi> \<equiv>\<^sub>P \<psi>"
-  thus "foldl f \<phi> w \<equiv>\<^sub>P foldl f \<psi> w"
-    using respectfulness by (induction w arbitrary: \<phi> \<psi>) simp+
-qed
-
-lemma f_foldl_abs_alt_def:
-  "f_foldl_abs (Abs \<phi>) w = foldl f_abs (Abs \<phi>) w"
-  by (induction w rule: rev_induct) (unfold f_foldl_abs.abs_eq foldl.simps foldl_append, (metis f_abs.abs_eq)+)
-
-definition abs_reach :: "'a ltl_prop_equiv_quotient \<Rightarrow> 'a ltl_prop_equiv_quotient set"
-where
-  "abs_reach \<Phi> = {foldl f_abs \<Phi> w |w. True}"
-
-lemma finite_abs_reach:
-  "finite (abs_reach (Abs \<phi>))"
-proof -
-  {
-    fix w
-    have "nested_propos (foldl f \<phi> w) \<subseteq> nested_propos \<phi>"
-      by (induction w arbitrary: \<phi>) (simp, metis foldl_Cons nested_propos_bounded subset_trans)
-  }
-  hence "abs_reach (Abs \<phi>) \<subseteq> {Abs \<chi> | \<chi>. nested_propos \<chi> \<subseteq> nested_propos \<phi>}"
-    unfolding abs_reach_def f_foldl_abs_alt_def[symmetric] f_foldl_abs.abs_eq by blast
-  thus ?thesis
-    using ltl_prop_equiv_quotient_restricted_to_P_finite finite_propos
-    by (blast dest: finite_subset)
-qed
-
-end
-
-end
diff --git a/thys/LTL_to_DRA/LTL_FGXU.thy b/thys/LTL_to_DRA/LTL_FGXU.thy
new file mode 100755
--- /dev/null
+++ b/thys/LTL_to_DRA/LTL_FGXU.thy
@@ -0,0 +1,851 @@
+(*
+    Author:      Salomon Sickert
+    License:     BSD
+*)
+
+section \<open>LTL (in Negation-Normal-Form)\<close>
+
+theory LTL_FGXU
+  imports Main "Aux/Words2"
+begin
+
+text \<open>Inspired/Based on schimpf/LTL\<close>
+
+subsection \<open>Syntax\<close>
+
+datatype (vars: 'a) ltl  =
+    LTLTrue
+  | LTLFalse
+  | LTLProp 'a
+  | LTLPropNeg 'a
+  | LTLAnd "'a ltl" "'a ltl"
+  | LTLOr "'a ltl" "'a ltl"
+  | LTLNext "'a ltl"
+  | LTLGlobal (theG: "'a ltl")
+  | LTLFinal "'a ltl"
+  | LTLUntil "'a ltl" "'a ltl"
+
+notation
+      LTLTrue     ("true")
+  and LTLFalse    ("false")
+  and LTLProp     ("p'(_')")
+  and LTLPropNeg  ("np'(_')" [86] 85)
+  and LTLAnd      ("_ and _" [83,83] 82)
+  and LTLOr       ("_ or _" [82,82] 81)
+  and LTLNext     ("X _" [88] 87)
+  and LTLGlobal   ("G _" [85] 84)
+  and LTLFinal    ("F _" [84] 83)
+  and LTLUntil    ("_ U _" [87,87] 86)
+
+subsection \<open>Semantics\<close>
+
+fun ltl_semantics :: "['a set word, 'a ltl] \<Rightarrow> bool" (infix "\<Turnstile>" 80)
+where
+  "w \<Turnstile> true = True"
+| "w \<Turnstile> false = False"
+| "w \<Turnstile> p(q) = (q \<in> w 0)"
+| "w \<Turnstile> np(q) = (q \<notin> w 0)"
+| "w \<Turnstile> \<phi> and \<psi> = (w \<Turnstile> \<phi> \<and> w \<Turnstile> \<psi>)"
+| "w \<Turnstile> \<phi> or \<psi> = (w \<Turnstile> \<phi> \<or> w \<Turnstile> \<psi>)"
+| "w \<Turnstile> X \<phi> = (suffix 1 w \<Turnstile> \<phi>)"
+| "w \<Turnstile> G \<phi> = (\<forall>k. suffix k w \<Turnstile> \<phi>)"
+| "w \<Turnstile> F \<phi> = (\<exists>k. suffix k w \<Turnstile> \<phi>)"
+| "w \<Turnstile> \<phi> U \<psi> = (\<exists>k. suffix k w \<Turnstile> \<psi> \<and> (\<forall>j < k. suffix j w \<Turnstile> \<phi>))"
+
+fun ltl_prop_entailment :: "['a ltl set, 'a ltl] \<Rightarrow> bool" (infix "\<Turnstile>\<^sub>P" 80)
+where
+  "\<A> \<Turnstile>\<^sub>P true = True"
+| "\<A> \<Turnstile>\<^sub>P false = False"
+| "\<A> \<Turnstile>\<^sub>P \<phi> and \<psi> = (\<A> \<Turnstile>\<^sub>P \<phi> \<and> \<A> \<Turnstile>\<^sub>P \<psi>)"
+| "\<A> \<Turnstile>\<^sub>P \<phi> or \<psi> = (\<A> \<Turnstile>\<^sub>P \<phi> \<or> \<A> \<Turnstile>\<^sub>P \<psi>)"
+| "\<A> \<Turnstile>\<^sub>P \<phi> = (\<phi> \<in> \<A>)"
+
+subsubsection \<open>Properties\<close>
+
+lemma LTL_G_one_step_unfolding:
+  "w \<Turnstile> G \<phi> \<longleftrightarrow> (w \<Turnstile> \<phi> \<and> w \<Turnstile> X (G \<phi>))"
+  (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs
+  hence "w \<Turnstile> \<phi>"
+    using suffix_0[of w] ltl_semantics.simps(8)[of w \<phi>] by metis
+  moreover
+  from `?lhs` have "w \<Turnstile> X (G \<phi>)"
+    by simp
+  ultimately
+  show ?rhs by simp
+next
+  assume ?rhs
+  hence "w \<Turnstile> X (G \<phi>)" by simp
+  hence "\<forall>k. suffix (k + 1) w \<Turnstile> \<phi>" by force
+  hence "\<forall>k > 0. suffix k w \<Turnstile> \<phi>"
+    by (metis Suc_eq_plus1 gr0_implies_Suc)
+  moreover
+  from `?rhs` have "(suffix 0 w) \<Turnstile> \<phi>" by simp
+  ultimately
+  show ?lhs
+    using neq0_conv ltl_semantics.simps(8)[of w \<phi>] by blast
+qed
+
+lemma LTL_F_one_step_unfolding:
+  "w \<Turnstile> F \<phi> \<longleftrightarrow> (w \<Turnstile> \<phi> \<or> w \<Turnstile> X (F \<phi>))"
+  (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs
+  then obtain k where "suffix k w \<Turnstile> \<phi>" by fastforce
+  thus ?rhs by (cases k) auto
+next
+  assume ?rhs
+  thus ?lhs
+    using suffix_0[of w] suffix_suffix[of _ 1 w] by (metis ltl_semantics.simps(7) ltl_semantics.simps(9))
+qed
+
+lemma LTL_U_one_step_unfolding:
+  "w \<Turnstile> \<phi> U \<psi> \<longleftrightarrow> (w \<Turnstile> \<psi> \<or> (w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)))"
+  (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  assume ?lhs
+  then obtain k where "suffix k w \<Turnstile> \<psi>" and "\<forall>j<k. suffix j w \<Turnstile> \<phi>"
+    by force
+  thus ?rhs
+    by (cases k) auto
+next
+  assume ?rhs
+  thus ?lhs
+  proof (cases "w \<Turnstile> \<psi>")
+    case False
+      hence "w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)"
+        using `?rhs` by blast
+      obtain k where "suffix k (suffix 1 w) \<Turnstile> \<psi>" and "\<forall>j<k. suffix j (suffix 1 w) \<Turnstile> \<phi>"
+        using False `?rhs` by force
+      moreover
+      {
+        fix j assume "j < 1 + k"
+        hence "suffix j w \<Turnstile> \<phi>"
+          using `w \<Turnstile> \<phi> \<and> w \<Turnstile> X (\<phi> U \<psi>)` `\<forall>j<k. suffix j (suffix 1 w) \<Turnstile> \<phi>`[unfolded suffix_suffix]
+          by (cases j) simp+
+      }
+      ultimately
+      show ?thesis
+        by auto
+  qed force
+qed
+
+lemma LTL_GF_infinitely_many_suffixes:
+  "w \<Turnstile> G (F \<phi>) = (\<exists>\<^sub>\<infinity>i. suffix i w \<Turnstile> \<phi>)"
+  (is "?lhs = ?rhs")
+proof
+  let ?S = "{i | i j. suffix (i + j) w \<Turnstile> \<phi>}"
+  let ?S' = "{i + j | i j. suffix (i + j) w \<Turnstile> \<phi>}"
+
+  assume ?lhs
+  hence "infinite ?S"
+    by auto
+  moreover
+  have "\<forall>s \<in> ?S. \<exists>s' \<in> ?S'. s \<le> s'"
+    by fastforce
+  ultimately
+  have "infinite ?S'"
+    using infinite_nat_iff_unbounded_le le_trans by meson
+  moreover
+  have "?S' = {k | k. suffix k w \<Turnstile> \<phi>}"
+    using monoid_add_class.add.left_neutral by metis
+  ultimately
+  have "infinite {k | k. suffix k w \<Turnstile> \<phi>}"
+    by metis
+  thus ?rhs unfolding Inf_many_def by force
+next
+  assume ?rhs
+  {
+    fix i
+    from `?rhs` obtain k where "i \<le> k" and "suffix k w \<Turnstile> \<phi>"
+      using INFM_nat_le[of "\<lambda>n. suffix n w \<Turnstile> \<phi>"] by blast
+    then obtain j where "k = i + j"
+      using le_iff_add[of i k] by fast
+    hence "suffix j (suffix i w) \<Turnstile> \<phi>"
+      using `suffix k w \<Turnstile> \<phi>` suffix_suffix by fastforce
+    hence "suffix i w \<Turnstile> F \<phi>" by auto
+  }
+  thus ?lhs by auto
+qed
+
+lemma LTL_FG_almost_all_suffixes:
+  "w \<Turnstile> F G \<phi> = (\<forall>\<^sub>\<infinity>i. suffix i w \<Turnstile> \<phi>)"
+  (is "?lhs = ?rhs")
+proof
+  let ?S = "{k. \<not> suffix k w \<Turnstile> \<phi>}"
+
+  assume ?lhs
+  then obtain i where "suffix i w \<Turnstile> G \<phi>"
+    by fastforce
+  hence "\<And>j. j \<ge> i \<Longrightarrow> (suffix j w \<Turnstile> \<phi>)"
+    using le_iff_add[of i] by auto
+  hence "\<And>j. \<not>suffix j w \<Turnstile> \<phi> \<Longrightarrow> j < i"
+    using le_less_linear by blast
+  hence "?S \<subseteq> {k. k < i}"
+    by blast
+  hence "finite ?S"
+    using finite_subset by fast
+  thus ?rhs
+    unfolding Alm_all_def Inf_many_def by presburger
+next
+  assume ?rhs
+  obtain S where S_def: "S = {k. \<not> suffix k w \<Turnstile> \<phi>}" by blast
+  hence "finite S"
+    using `?rhs` unfolding Alm_all_def Inf_many_def by fast
+  then obtain i where "i = Max S" by blast
+  {
+    fix j
+    assume "i < j"
+    hence "j \<notin> S"
+      using `i = Max S` Max.coboundedI[OF `finite S`] less_le_not_le by blast
+    hence "suffix j w \<Turnstile> \<phi>" using S_def by fast
+  }
+  hence "\<forall>j > i. (suffix j w \<Turnstile> \<phi>)" by simp
+  hence "suffix (Suc i) w \<Turnstile> G \<phi>" by auto
+  thus ?lhs
+    using ltl_semantics.simps(9)[of w "G \<phi>"] by blast
+qed
+
+lemma LTL_FG_suffix:
+  "(suffix i w) \<Turnstile> F (G \<phi>) = w \<Turnstile> F (G \<phi>)"
+proof -
+  have "(\<exists>m. \<forall>n\<ge>m. suffix n w \<Turnstile> \<phi>) = (\<exists>m. \<forall>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>)" (is "?l = ?r")
+  proof
+    assume ?r
+    then obtain m where "\<forall>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>"
+      by blast
+    hence "\<forall>n\<ge>i+m. suffix n w \<Turnstile> \<phi>"
+      unfolding suffix_suffix by (metis le_iff_add add_leE add_le_cancel_left)
+    thus ?l
+      by auto
+  qed (metis suffix_suffix trans_le_add2)
+  thus ?thesis
+    unfolding LTL_FG_almost_all_suffixes MOST_nat_le ..
+qed
+
+lemma LTL_GF_suffix:
+  "(suffix i w) \<Turnstile> G (F \<phi>) = w \<Turnstile> G (F \<phi>)"
+proof -
+  have "(\<forall>m. \<exists>n\<ge>m. suffix n w \<Turnstile> \<phi>) = (\<forall>m. \<exists>n\<ge>m. suffix n (suffix i w) \<Turnstile> \<phi>)" (is "?l = ?r")
+  proof
+    assume ?l
+    thus ?r
+      by (metis suffix_suffix add_leE add_le_cancel_left le_Suc_ex)
+  qed (metis suffix_suffix trans_le_add2)
+  thus ?thesis
+    unfolding LTL_GF_infinitely_many_suffixes INFM_nat_le ..
+qed
+
+lemma LTL_suffix_G:
+  "w \<Turnstile> G \<phi> \<Longrightarrow> suffix i w \<Turnstile> G \<phi>"
+  using suffix_0 suffix_suffix by (induction i) simp_all
+
+lemma LTL_prop_entailment_monotonI[intro]:
+  "S \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> S' \<Turnstile>\<^sub>P \<phi>"
+  by (induction rule: ltl_prop_entailment.induct) auto
+
+lemma ltl_models_equiv_prop_entailment:
+  "w \<Turnstile> \<phi> = {\<chi>. w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P \<phi>"
+  by (induction \<phi>) auto
+
+subsubsection \<open>Limit Behaviour of the G-operator\<close>
+
+abbreviation Only_G
+where
+  "Only_G S \<equiv> \<forall>x \<in> S. \<exists>y. x = G y"
+
+lemma ltl_G_stabilize:
+  assumes "finite \<G>"
+  assumes "Only_G \<G>"
+  obtains i where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
+proof -
+  have "finite \<G> \<Longrightarrow> Only_G \<G> \<Longrightarrow> \<exists>i. \<forall>\<chi> \<in> \<G>. \<forall>j. suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
+  proof (induction rule: finite_induct)
+    case (insert \<chi> \<G>)
+      then obtain i\<^sub>1  where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i\<^sub>1 w \<Turnstile> \<chi> = suffix (i\<^sub>1 + j) w \<Turnstile> \<chi>"
+        by blast
+      moreover
+      from insert obtain \<psi> where "\<chi> = G \<psi>"
+        by blast
+      have "\<exists>i. \<forall>j. suffix i w \<Turnstile> G \<psi> = suffix (i + j) w \<Turnstile> G \<psi>"
+        by (metis LTL_suffix_G plus_nat.add_0 suffix_0 suffix_suffix)
+      then obtain i\<^sub>2 where "\<And>j. suffix i\<^sub>2 w \<Turnstile> \<chi> = suffix (i\<^sub>2 + j) w \<Turnstile> \<chi>"
+        unfolding `\<chi> = G \<psi>` by blast
+      ultimately
+      have "\<And>\<chi>' j. \<chi>' \<in> \<G> \<union> {\<chi>} \<Longrightarrow> suffix (i\<^sub>1 + i\<^sub>2) w \<Turnstile> \<chi>' = suffix (i\<^sub>1 + i\<^sub>2 + j) w \<Turnstile> \<chi>'"
+        unfolding Un_iff singleton_iff by (metis add.commute add.left_commute)
+      thus ?case
+        by blast
+  qed simp
+  with assms obtain i where "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
+    by blast
+  thus ?thesis
+    using that by blast
+qed
+
+lemma ltl_G_stabilize_property:
+  assumes "finite \<G>"
+  assumes "Only_G \<G>"
+  assumes "\<And>\<chi> j. \<chi> \<in> \<G> \<Longrightarrow> suffix i w \<Turnstile> \<chi> = suffix (i + j) w \<Turnstile> \<chi>"
+  assumes "G \<psi> \<in> \<G> \<inter> {\<chi>. w \<Turnstile> F \<chi>}"
+  shows "suffix i w \<Turnstile> G \<psi>"
+proof -
+  obtain j where "suffix j w \<Turnstile> G \<psi>"
+    using assms by fastforce
+  thus "suffix i w \<Turnstile> G \<psi>"
+    by (cases "i \<le> j", insert assms, unfold le_iff_add, blast,
+        metis (erased, lifting) LTL_suffix_G `suffix j w \<Turnstile> G \<psi>` le_add_diff_inverse nat_le_linear suffix_suffix)
+qed
+
+subsection \<open>Subformulae\<close>
+
+subsubsection \<open>Propositions\<close>
+
+fun propos :: "'a ltl \<Rightarrow>'a ltl set"
+where
+  "propos true = {}"
+| "propos false = {}"
+| "propos (\<phi> and \<psi>) = propos \<phi> \<union> propos \<psi>"
+| "propos (\<phi> or \<psi>) = propos \<phi> \<union> propos \<psi>"
+| "propos \<phi> = {\<phi>}"
+
+fun nested_propos :: "'a ltl \<Rightarrow>'a ltl set"
+where
+  "nested_propos true = {}"
+| "nested_propos false = {}"
+| "nested_propos (\<phi> and \<psi>) = nested_propos \<phi> \<union> nested_propos \<psi>"
+| "nested_propos (\<phi> or \<psi>) = nested_propos \<phi> \<union> nested_propos \<psi>"
+| "nested_propos (F \<phi>) = {F \<phi>} \<union> nested_propos \<phi>"
+| "nested_propos (G \<phi>) = {G \<phi>} \<union> nested_propos \<phi>"
+| "nested_propos (X \<phi>) = {X \<phi>} \<union> nested_propos \<phi>"
+| "nested_propos (\<phi> U \<psi>) = {\<phi> U \<psi>} \<union> nested_propos \<phi> \<union> nested_propos \<psi>"
+| "nested_propos \<phi> = {\<phi>}"
+
+lemma finite_propos:
+  "finite (propos \<phi>)" "finite (nested_propos \<phi>)"
+  by (induction \<phi>) simp+
+
+lemma propos_subset:
+  "propos \<phi> \<subseteq> nested_propos \<phi>"
+  by (induction \<phi>) auto
+
+lemma LTL_prop_entailment_restrict_to_propos:
+  "S \<Turnstile>\<^sub>P \<phi> = (S \<inter> propos \<phi>) \<Turnstile>\<^sub>P \<phi>"
+  by (induction \<phi>) auto
+
+lemma propos_foldl:
+  assumes "\<And>x y. propos (f x y) = propos x \<union> propos y"
+  shows "\<Union>{propos y |y. y = i \<or> y \<in> set xs} = propos (foldl f i xs)"
+proof (induction xs rule: rev_induct)
+  case (snoc x xs)
+    have "\<Union>{propos y |y. y = i \<or> y \<in> set (xs@[x])} = \<Union>{propos y |y. y = i \<or> y \<in> set xs} \<union> propos x"
+      by auto
+    also
+    have "\<dots> = propos (foldl f i xs) \<union> propos x"
+      using snoc by auto
+    also
+    have "\<dots> = propos (foldl f i (xs@[x]))"
+      using assms by simp
+    finally
+    show ?case .
+qed simp
+
+subsubsection \<open>G-Subformulae\<close>
+
+text \<open>Notation for paper: mathds{G}\<close>
+
+fun G_nested_propos :: "'a ltl \<Rightarrow>'a ltl set" ("\<^bold>G")
+where
+  "\<^bold>G (\<phi> and \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
+| "\<^bold>G (\<phi> or \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
+| "\<^bold>G (F \<phi>) = \<^bold>G \<phi>"
+| "\<^bold>G (G \<phi>) = \<^bold>G \<phi> \<union> {G \<phi>}"
+| "\<^bold>G (X \<phi>) = \<^bold>G \<phi>"
+| "\<^bold>G (\<phi> U \<psi>) = \<^bold>G \<phi> \<union> \<^bold>G \<psi>"
+| "\<^bold>G \<phi> = {}"
+
+lemma G_nested_finite:
+  "finite (\<^bold>G \<phi>)"
+  by (induction \<phi>) auto
+
+lemma G_nested_propos_alt_def:
+  "\<^bold>G \<phi> = nested_propos \<phi> \<inter> {\<psi>. (\<exists>x. \<psi> = G x)}"
+  by (induction \<phi>) auto
+
+lemma G_nested_propos_Only_G:
+  "Only_G (\<^bold>G \<phi>)"
+  unfolding G_nested_propos_alt_def by blast
+
+lemma G_not_in_G:
+  "G \<phi> \<notin> \<^bold>G \<phi>"
+proof -
+  have "\<And>\<chi>. \<chi> \<in> \<^bold>G \<phi> \<Longrightarrow> size \<phi> \<ge> size \<chi>"
+    by (induction \<phi>) fastforce+
+  thus ?thesis
+    by fastforce
+qed
+
+lemma G_subset_G:
+  "\<psi> \<in> \<^bold>G \<phi> \<Longrightarrow> \<^bold>G \<psi> \<subseteq> \<^bold>G \<phi>"
+  "G \<psi> \<in> \<^bold>G \<phi> \<Longrightarrow> \<^bold>G \<psi> \<subseteq> \<^bold>G \<phi>"
+  by (induction \<phi>) auto
+
+lemma \<G>_properties:
+  assumes "\<G> \<subseteq> \<^bold>G \<phi>"
+  shows \<G>_finite: "finite \<G>" and \<G>_elements: "Only_G \<G>"
+  using assms G_nested_finite G_nested_propos_alt_def by (blast dest: finite_subset)+
+
+subsection \<open>Propositional Implication and Equivalence\<close>
+
+definition ltl_prop_implies :: "['a ltl, 'a ltl] \<Rightarrow> bool" (infix "\<longrightarrow>\<^sub>P" 75)
+where
+  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<equiv> \<forall>\<A>. \<A> \<Turnstile>\<^sub>P \<phi> \<longrightarrow> \<A> \<Turnstile>\<^sub>P \<psi>"
+
+definition ltl_prop_equiv :: "['a ltl, 'a ltl] \<Rightarrow> bool" (infix "\<equiv>\<^sub>P" 75)
+where
+  "\<phi> \<equiv>\<^sub>P \<psi> \<equiv> \<forall>\<A>. \<A> \<Turnstile>\<^sub>P \<phi> \<longleftrightarrow> \<A> \<Turnstile>\<^sub>P \<psi>"
+
+lemma ltl_prop_implies_equiv:
+  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<and> \<psi> \<longrightarrow>\<^sub>P \<phi> \<longleftrightarrow> \<phi> \<equiv>\<^sub>P \<psi>"
+  unfolding ltl_prop_implies_def ltl_prop_equiv_def by meson
+
+lemma ltl_prop_equiv_equivp:
+  "equivp (op \<equiv>\<^sub>P)"
+  by (blast intro: equivpI[of "op \<equiv>\<^sub>P", unfolded transp_def symp_def reflp_def ltl_prop_equiv_def])
+
+lemma [trans]:
+  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> \<psi> \<equiv>\<^sub>P \<chi> \<Longrightarrow> \<phi> \<equiv>\<^sub>P \<chi>"
+  using ltl_prop_equiv_equivp[THEN equivp_transp] .
+
+subsubsection \<open>Quotient Type for Propositional Equivalence\<close>
+
+quotient_type 'a ltl_prop_equiv_quotient = "'a ltl" / "op \<equiv>\<^sub>P"
+  morphisms Rep Abs
+  by (simp add: ltl_prop_equiv_equivp)
+
+type_synonym 'a ltl\<^sub>P = "'a ltl_prop_equiv_quotient"
+
+instantiation ltl_prop_equiv_quotient :: (type) equal begin
+
+lift_definition ltl_prop_equiv_quotient_eq_test :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" is "\<lambda>x y. x \<equiv>\<^sub>P y"
+  by (metis ltl_prop_equiv_quotient.abs_eq_iff)
+
+definition
+  eq: "equal_class.equal \<equiv> ltl_prop_equiv_quotient_eq_test"
+
+instance
+  by (standard; simp add: eq ltl_prop_equiv_quotient_eq_test.rep_eq, metis Quotient_ltl_prop_equiv_quotient Quotient_rel_rep)
+
+end
+
+lemma ltl\<^sub>P_abs_rep: "Abs (Rep \<phi>) = \<phi>"
+  by (meson Quotient3_abs_rep Quotient3_ltl_prop_equiv_quotient)
+
+lift_definition ltl_prop_entails_abs :: "'a ltl set \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" ("_ \<up>\<Turnstile>\<^sub>P _") is "op \<Turnstile>\<^sub>P"
+  by (simp add: ltl_prop_equiv_def)
+
+lift_definition ltl_prop_implies_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> bool" ("_ \<up>\<longrightarrow>\<^sub>P _") is "op \<longrightarrow>\<^sub>P"
+  by (simp add: ltl_prop_equiv_def ltl_prop_implies_def)
+
+subsubsection \<open>Propositional Equivalence implies LTL Equivalence\<close>
+
+lemma ltl_prop_implication_implies_ltl_implication:
+  "w \<Turnstile> \<phi> \<Longrightarrow> \<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> w \<Turnstile> \<psi>"
+  unfolding ltl_prop_implies_def ltl_models_equiv_prop_entailment by simp
+
+lemma ltl_prop_equiv_implies_ltl_equiv:
+  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> w \<Turnstile> \<phi> = w \<Turnstile> \<psi>"
+  using ltl_prop_implication_implies_ltl_implication ltl_prop_implies_equiv by blast
+
+subsection \<open>Substitution\<close>
+
+fun subst :: "'a ltl \<Rightarrow> ('a ltl \<rightharpoonup> 'a ltl) \<Rightarrow> 'a ltl"
+where
+  "subst true m = true"
+| "subst false m = false"
+| "subst (\<phi> and \<psi>) m = subst \<phi> m and subst \<psi> m"
+| "subst (\<phi> or \<psi>) m = subst \<phi> m or subst \<psi> m"
+| "subst \<phi> m = (case m \<phi> of Some \<phi>' \<Rightarrow> \<phi>' | None \<Rightarrow> \<phi>)"
+
+text \<open>Based on Uwe Schoening's Translation Lemma (Logic for CS, p. 54)\<close>
+
+lemma ltl_prop_equiv_subst_S:
+  "S \<Turnstile>\<^sub>P subst \<phi> m = ((S - dom m) \<union> {\<chi> | \<chi> \<chi>'. \<chi> \<in> dom m \<and> m \<chi> = Some \<chi>' \<and> S \<Turnstile>\<^sub>P \<chi>'}) \<Turnstile>\<^sub>P \<phi>"
+  by (induction \<phi>) (auto split: option.split)
+
+lemma subst_respects_ltl_prop_entailment:
+  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> subst \<phi> m \<longrightarrow>\<^sub>P subst \<psi> m"
+  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> subst \<phi> m \<equiv>\<^sub>P subst \<psi> m"
+  unfolding ltl_prop_equiv_def ltl_prop_implies_def ltl_prop_equiv_subst_S by blast+
+
+lemma subst_respects_ltl_prop_entailment_generalized:
+  "(\<And>\<A>. (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P y) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P subst x m) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P subst y m"
+  unfolding ltl_prop_equiv_subst_S by simp
+
+lemma decomposable_function_subst:
+  "\<lbrakk>f true = true; f false = false; \<And>\<phi> \<psi>. f (\<phi> and \<psi>) = f \<phi> and f \<psi>; \<And>\<phi> \<psi>. f (\<phi> or \<psi>) = f \<phi> or f \<psi>\<rbrakk> \<Longrightarrow> f \<phi> = subst \<phi> (\<lambda>\<chi>. Some (f \<chi>))"
+  by (induction \<phi>) auto
+
+subsection \<open>Additional Operators\<close>
+
+subsubsection \<open>And\<close>
+
+lemma foldl_LTLAnd_prop_entailment:
+  "S \<Turnstile>\<^sub>P foldl LTLAnd i xs = (S \<Turnstile>\<^sub>P i \<and> (\<forall>y \<in> set xs. S \<Turnstile>\<^sub>P y))"
+  by (induction xs arbitrary: i) auto
+
+fun And :: "'a ltl list \<Rightarrow> 'a ltl"
+where
+  "And [] = true"
+| "And (x#xs) = foldl LTLAnd x xs"
+
+lemma And_prop_entailment:
+  "S \<Turnstile>\<^sub>P And xs = (\<forall>x \<in> set xs. S \<Turnstile>\<^sub>P x)"
+  using foldl_LTLAnd_prop_entailment by (cases xs) auto
+
+lemma And_propos:
+  "propos (And xs) = \<Union>{propos x| x. x \<in> set xs}"
+proof (cases xs)
+  case Nil
+    thus ?thesis by simp
+next
+  case (Cons x xs)
+    thus ?thesis
+      using propos_foldl[of LTLAnd x] by auto
+qed
+
+lemma And_semantics:
+  "w \<Turnstile> And xs = (\<forall>x \<in> set xs. w \<Turnstile> x)"
+proof -
+  have And_propos': "\<And>x. x \<in> set xs \<Longrightarrow> propos x \<subseteq> propos (And xs)"
+    using And_propos by blast
+
+  have "w \<Turnstile> And xs = {\<chi>. \<chi> \<in> propos (And xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P (And xs)"
+    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
+  also
+  have "\<dots> = (\<forall>x \<in> set xs. {\<chi>. \<chi> \<in> propos (And xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
+    using And_prop_entailment by auto
+  also
+  have "\<dots> = (\<forall>x \<in> set xs. {\<chi>. \<chi> \<in> propos x \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
+    using LTL_prop_entailment_restrict_to_propos And_propos' by blast
+  also
+  have "\<dots> = (\<forall>x \<in> set xs. w \<Turnstile> x)"
+    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
+  finally
+  show ?thesis .
+qed
+
+lemma And_append_syntactic:
+  "xs \<noteq> [] \<Longrightarrow> And (xs @ ys) = And ((And xs)#ys)"
+  by (induction xs rule: list_nonempty_induct) simp+
+
+lemma And_append_S:
+  "S \<Turnstile>\<^sub>P And (xs @ ys) = S \<Turnstile>\<^sub>P And xs and And ys"
+  using And_prop_entailment[of S] by auto
+
+lemma And_append:
+  "And (xs @ ys) \<equiv>\<^sub>P And xs and And ys"
+  unfolding ltl_prop_equiv_def using And_append_S by blast
+
+subsubsection \<open>Lifted Variant\<close>
+
+lift_definition and_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("_ \<up>and _") is "\<lambda>x y. x and y"
+  unfolding ltl_prop_equiv_def by simp
+
+fun And_abs :: "'a ltl\<^sub>P list \<Rightarrow> 'a ltl\<^sub>P" ("\<up>And")
+where
+  "\<up>And xs = foldl and_abs (Abs true) xs"
+
+lemma foldl_LTLAnd_prop_entailment_abs:
+  "S \<up>\<Turnstile>\<^sub>P foldl and_abs i xs = (S \<up>\<Turnstile>\<^sub>P i \<and> (\<forall>y\<in>set xs. S \<up>\<Turnstile>\<^sub>P y))"
+  by (induction xs arbitrary: i)
+     (simp_all add: and_abs_def ltl_prop_entails_abs.abs_eq, metis ltl_prop_entails_abs.rep_eq)
+
+lemma And_prop_entailment_abs:
+  "S \<up>\<Turnstile>\<^sub>P \<up>And xs = (\<forall>x \<in> set xs. S \<up>\<Turnstile>\<^sub>P x)"
+  by (simp add: foldl_LTLAnd_prop_entailment_abs ltl_prop_entails_abs.abs_eq)
+
+lemma and_abs_conjunction:
+  "S \<up>\<Turnstile>\<^sub>P \<phi> \<up>and \<psi> \<longleftrightarrow> S \<up>\<Turnstile>\<^sub>P \<phi> \<and> S \<up>\<Turnstile>\<^sub>P \<psi>"
+  by (metis and_abs.abs_eq ltl\<^sub>P_abs_rep ltl_prop_entailment.simps(3) ltl_prop_entails_abs.abs_eq)
+
+subsubsection \<open>Or\<close>
+
+lemma foldl_LTLOr_prop_entailment:
+  "S \<Turnstile>\<^sub>P foldl LTLOr i xs = (S \<Turnstile>\<^sub>P i \<or> (\<exists>y \<in> set xs. S \<Turnstile>\<^sub>P y))"
+  by (induction xs arbitrary: i) auto
+
+fun Or :: "'a ltl list \<Rightarrow> 'a ltl"
+where
+  "Or [] = false"
+| "Or (x#xs) = foldl LTLOr x xs"
+
+lemma Or_prop_entailment:
+  "S \<Turnstile>\<^sub>P Or xs = (\<exists>x \<in> set xs. S \<Turnstile>\<^sub>P x)"
+  using foldl_LTLOr_prop_entailment by (cases xs) auto
+
+lemma Or_propos:
+  "propos (Or xs) = \<Union>{propos x| x. x \<in> set xs}"
+proof (cases xs)
+  case Nil
+    thus ?thesis by simp
+next
+  case (Cons x xs)
+    thus ?thesis
+      using propos_foldl[of LTLOr x] by auto
+qed
+
+lemma Or_semantics:
+  "w \<Turnstile> Or xs = (\<exists>x \<in> set xs. w \<Turnstile> x)"
+proof -
+  have Or_propos': "\<And>x. x \<in> set xs \<Longrightarrow> propos x \<subseteq> propos (Or xs)"
+    using Or_propos by blast
+
+  have "w \<Turnstile> Or xs = {\<chi>. \<chi> \<in> propos (Or xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P (Or xs)"
+    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
+  also
+  have "\<dots> = (\<exists>x \<in> set xs. {\<chi>. \<chi> \<in> propos (Or xs) \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
+    using Or_prop_entailment by auto
+  also
+  have "\<dots> = (\<exists>x \<in> set xs. {\<chi>. \<chi> \<in> propos x \<and> w \<Turnstile> \<chi>} \<Turnstile>\<^sub>P x)"
+    using LTL_prop_entailment_restrict_to_propos Or_propos' by blast
+  also
+  have "\<dots> = (\<exists>x \<in> set xs. w \<Turnstile> x)"
+    using ltl_models_equiv_prop_entailment LTL_prop_entailment_restrict_to_propos by blast
+  finally
+  show ?thesis .
+qed
+
+lemma Or_append_syntactic:
+  "xs \<noteq> [] \<Longrightarrow> Or (xs @ ys) = Or ((Or xs)#ys)"
+  by (induction xs rule: list_nonempty_induct) simp+
+
+lemma Or_append_S:
+  "S \<Turnstile>\<^sub>P Or (xs @ ys) = S \<Turnstile>\<^sub>P Or xs or Or ys"
+  using Or_prop_entailment[of S] by auto
+
+lemma Or_append:
+  "Or (xs @ ys) \<equiv>\<^sub>P Or xs or Or ys"
+  unfolding ltl_prop_equiv_def using Or_append_S by blast
+
+subsubsection \<open>$eval_G$\<close>
+
+-- \<open>Partly evaluate a formula by only considering G-subformulae\<close>
+
+fun eval\<^sub>G
+where
+  "eval\<^sub>G S (\<phi> and \<psi>) = eval\<^sub>G S \<phi> and eval\<^sub>G S \<psi>"
+| "eval\<^sub>G S (\<phi> or \<psi>) = eval\<^sub>G S \<phi> or eval\<^sub>G S \<psi>"
+| "eval\<^sub>G S (G \<phi>) = (if G \<phi> \<in> S then true else false)"
+| "eval\<^sub>G S \<phi> = \<phi>"
+
+-- \<open>Syntactic Properties\<close>
+
+lemma eval\<^sub>G_And_map:
+  "eval\<^sub>G S (And xs) = And (map (eval\<^sub>G S) xs)"
+proof (induction xs rule: rev_induct)
+  case (snoc x xs)
+    thus ?case
+      by (cases xs) simp+
+qed simp
+
+lemma eval\<^sub>G_Or_map:
+  "eval\<^sub>G S (Or xs) = Or (map (eval\<^sub>G S) xs)"
+proof (induction xs rule: rev_induct)
+  case (snoc x xs)
+    thus ?case
+      by (cases xs) simp+
+qed simp
+
+lemma eval\<^sub>G_G_nested:
+  "\<^bold>G (eval\<^sub>G \<G> \<phi>) \<subseteq> \<^bold>G \<phi>"
+  by (induction \<phi>) (simp_all, blast+)
+
+lemma eval\<^sub>G_subst:
+  "eval\<^sub>G S \<phi> = subst \<phi> (\<lambda>\<chi>. Some (eval\<^sub>G S \<chi>))"
+  by (induction \<phi>) simp_all
+
+-- \<open>Semantic Properties\<close>
+
+lemma eval\<^sub>G_prop_entailment:
+  "S \<Turnstile>\<^sub>P eval\<^sub>G S \<phi> \<longleftrightarrow> S \<Turnstile>\<^sub>P \<phi>"
+  by (induction \<phi>, auto)
+
+lemma eval\<^sub>G_respectfulness:
+  "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> eval\<^sub>G S \<phi> \<longrightarrow>\<^sub>P eval\<^sub>G S \<psi>"
+  "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> eval\<^sub>G S \<phi> \<equiv>\<^sub>P eval\<^sub>G S \<psi>"
+  using subst_respects_ltl_prop_entailment eval\<^sub>G_subst by metis+
+
+lemma eval\<^sub>G_respectfulness_generalized:
+  "(\<And>\<A>. (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P y) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> \<A> \<Turnstile>\<^sub>P eval\<^sub>G P x) \<Longrightarrow> \<A> \<Turnstile>\<^sub>P eval\<^sub>G P y"
+  using subst_respects_ltl_prop_entailment_generalized[of S y \<A>] eval\<^sub>G_subst[of P] by metis
+
+lift_definition eval\<^sub>G_abs :: "'a ltl set \<Rightarrow> 'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("\<up>eval\<^sub>G") is eval\<^sub>G
+  by (insert eval\<^sub>G_respectfulness(2))
+
+subsection \<open>Finite Quotient Set\<close>
+
+text \<open>If we restrict formulas to a finite set of propositions, the set of quotients of these is finite\<close>
+
+lemma Rep_Abs_prop_entailment[simp]:
+  "A \<Turnstile>\<^sub>P Rep (Abs \<phi>) = A \<Turnstile>\<^sub>P \<phi>"
+  using Quotient3_ltl_prop_equiv_quotient[THEN rep_abs_rsp]
+  by (auto simp add: ltl_prop_equiv_def)
+
+fun sat_models :: "'a ltl_prop_equiv_quotient \<Rightarrow> 'a ltl set set"
+where
+  "sat_models a = {A. A \<Turnstile>\<^sub>P Rep(a)}"
+
+lemma sat_models_invariant:
+  "A \<in> sat_models (Abs \<phi>) = A \<Turnstile>\<^sub>P \<phi>"
+  using Rep_Abs_prop_entailment by auto
+
+lemma sat_models_inj:
+  "inj sat_models"
+  using Quotient3_ltl_prop_equiv_quotient[THEN Quotient3_rel_rep]
+  by (auto simp add: ltl_prop_equiv_def inj_on_def)
+
+lemma sat_models_finite_image:
+  assumes "finite P"
+  shows "finite (sat_models ` {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P})"
+proof -
+  have "sat_models (Abs \<phi>) = {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}" (is "?lhs = ?rhs")
+    if "nested_propos \<phi> \<subseteq> P" for \<phi>
+  proof
+    have "\<And>A B. A \<in> sat_models (Abs \<phi>) \<Longrightarrow> A \<union> B \<in> sat_models (Abs \<phi>)"
+      unfolding sat_models_invariant by blast
+    moreover
+    have "{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} \<subseteq> sat_models (Abs \<phi>)"
+      using sat_models_invariant by fast
+    ultimately
+    show "?rhs \<subseteq> ?lhs"
+      by blast
+  next
+    have "propos \<phi> \<subseteq> P"
+      using that propos_subset by blast
+    have "A \<in> {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
+      if "A \<in> sat_models (Abs \<phi>)" for A
+    proof (standard, goal_cases prems)
+      case prems
+        then have "A \<Turnstile>\<^sub>P \<phi>"
+          using that sat_models_invariant by blast
+        then obtain C D where "C = (A \<inter> P)" and "D = A - P" and "A = C \<union> D"
+          by blast
+        then have "C \<Turnstile>\<^sub>P \<phi>" and "C \<subseteq> P" and "D \<subseteq> UNIV - P"
+          using `A \<Turnstile>\<^sub>P \<phi>` LTL_prop_entailment_restrict_to_propos `propos \<phi> \<subseteq> P` by blast+
+        then have "C \<union> D \<in> {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
+          by blast
+        thus ?case
+          using `A = C \<union> D` by simp
+    qed
+    thus "?lhs \<subseteq> ?rhs"
+      by blast
+  qed
+  hence Equal: "{sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P} = {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
+    by (metis (lifting, no_types))
+
+  have Finite: "finite {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
+  proof -
+    let ?map = "\<lambda>P S. {A \<union> B | A B. A \<in> S \<and> B \<subseteq> UNIV - P}"
+    obtain S' where S'_def: "S' = {{A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P} | \<phi>. nested_propos \<phi> \<subseteq> P}"
+      by blast
+    obtain S where S_def: "S = {{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} | \<phi>. nested_propos \<phi> \<subseteq> P}"
+      by blast
+
+    -- \<open>Prove S and ?map applied to it is finite\<close>
+    hence "S \<subseteq> Pow (Pow P)"
+      by blast
+    hence "finite S"
+      using `finite P` finite_Pow_iff infinite_super by fast
+    hence "finite {?map P A | A. A \<in> S}"
+      by fastforce
+
+    -- \<open>Prove that S' can be embedded into S using ?map\<close>
+
+    have "S' \<subseteq> {?map P A | A. A \<in> S}"
+    proof
+      fix A
+      assume "A \<in> S'"
+      then obtain \<phi> where "nested_propos \<phi> \<subseteq> P"
+        and "A = {A \<union> B | A B. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi> \<and> B \<subseteq> UNIV - P}"
+        using S'_def by blast
+      then have "?map P {A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} = A"
+        by simp
+      moreover
+      have "{A | A. A \<subseteq> P \<and> A \<Turnstile>\<^sub>P \<phi>} \<in> S"
+        using `nested_propos \<phi> \<subseteq> P` S_def by auto
+      ultimately
+      show "A \<in> {?map P A | A. A \<in> S}"
+        by blast
+    qed
+
+    show ?thesis
+      using rev_finite_subset[OF `finite {?map P A | A. A \<in> S}` `S' \<subseteq> {?map P A | A. A \<in> S}`]
+      unfolding S'_def .
+  qed
+
+  have Finite2: "finite {sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P}"
+    unfolding Equal using Finite by blast
+  have Equal2: "sat_models ` {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P} = {sat_models (Abs \<phi>) | \<phi>. nested_propos \<phi> \<subseteq> P}"
+    by blast
+
+  show ?thesis
+    unfolding Equal2 using Finite2 by blast
+qed
+
+lemma ltl_prop_equiv_quotient_restricted_to_P_finite:
+  assumes "finite P"
+  shows "finite {Abs \<phi> | \<phi>. nested_propos \<phi> \<subseteq> P}"
+proof -
+  have "inj_on sat_models {Abs \<phi> |\<phi>. nested_propos \<phi> \<subseteq> P}"
+    using sat_models_inj subset_inj_on by auto
+  thus ?thesis
+    using finite_imageD[OF sat_models_finite_image[OF assms]] by fast
+qed
+
+locale lift_ltl_transformer =
+  fixes
+    f :: "'a ltl \<Rightarrow> 'b \<Rightarrow> 'a ltl"
+  assumes
+    respectfulness: "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> f \<phi> \<nu> \<equiv>\<^sub>P f \<psi> \<nu>"
+  assumes
+    nested_propos_bounded: "nested_propos (f \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
+begin
+
+lift_definition f_abs :: "'a ltl\<^sub>P \<Rightarrow> 'b \<Rightarrow> 'a ltl\<^sub>P" is f
+  using respectfulness .
+
+lift_definition f_foldl_abs :: "'a ltl\<^sub>P \<Rightarrow> 'b list \<Rightarrow> 'a ltl\<^sub>P" is "foldl f"
+proof -
+  fix \<phi> \<psi> :: "'a ltl" fix w :: "'b list" assume "\<phi> \<equiv>\<^sub>P \<psi>"
+  thus "foldl f \<phi> w \<equiv>\<^sub>P foldl f \<psi> w"
+    using respectfulness by (induction w arbitrary: \<phi> \<psi>) simp+
+qed
+
+lemma f_foldl_abs_alt_def:
+  "f_foldl_abs (Abs \<phi>) w = foldl f_abs (Abs \<phi>) w"
+  by (induction w rule: rev_induct) (unfold f_foldl_abs.abs_eq foldl.simps foldl_append, (metis f_abs.abs_eq)+)
+
+definition abs_reach :: "'a ltl_prop_equiv_quotient \<Rightarrow> 'a ltl_prop_equiv_quotient set"
+where
+  "abs_reach \<Phi> = {foldl f_abs \<Phi> w |w. True}"
+
+lemma finite_abs_reach:
+  "finite (abs_reach (Abs \<phi>))"
+proof -
+  {
+    fix w
+    have "nested_propos (foldl f \<phi> w) \<subseteq> nested_propos \<phi>"
+      by (induction w arbitrary: \<phi>) (simp, metis foldl_Cons nested_propos_bounded subset_trans)
+  }
+  hence "abs_reach (Abs \<phi>) \<subseteq> {Abs \<chi> | \<chi>. nested_propos \<chi> \<subseteq> nested_propos \<phi>}"
+    unfolding abs_reach_def f_foldl_abs_alt_def[symmetric] f_foldl_abs.abs_eq by blast
+  thus ?thesis
+    using ltl_prop_equiv_quotient_restricted_to_P_finite finite_propos
+    by (blast dest: finite_subset)
+qed
+
+end
+
+end
diff --git a/thys/LTL_to_DRA/af.thy b/thys/LTL_to_DRA/af.thy
--- a/thys/LTL_to_DRA/af.thy
+++ b/thys/LTL_to_DRA/af.thy
@@ -1,655 +1,655 @@
 (*  
     Author:      Salomon Sickert
     License:     BSD
 *)
 
 section \<open>af - Unfolding Functions\<close>
 
 theory af
-  imports Main "Aux/Words2" LTL
+  imports Main "Aux/Words2" LTL_FGXU
 begin
 
 subsection \<open>af\<close>
 
 fun af_letter :: "'a ltl \<Rightarrow> 'a set \<Rightarrow> 'a ltl"
 where
   "af_letter true \<nu> = true"
 | "af_letter false \<nu> = false"
 | "af_letter p(a) \<nu> = (if a \<in> \<nu> then true else false)"
 | "af_letter (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
 | "af_letter (\<phi> and \<psi>) \<nu> = (af_letter \<phi> \<nu>) and (af_letter \<psi> \<nu>)"
 | "af_letter (\<phi> or \<psi>) \<nu> = (af_letter \<phi> \<nu>) or (af_letter \<psi> \<nu>)"
 | "af_letter (X \<phi>) \<nu> = \<phi>"
 | "af_letter (G \<phi>) \<nu> = (G \<phi>) and (af_letter \<phi> \<nu>)"
 | "af_letter (F \<phi>) \<nu> = (F \<phi>) or (af_letter \<phi> \<nu>)"
 | "af_letter (\<phi> U \<psi>) \<nu> = (\<phi> U \<psi> and (af_letter \<phi> \<nu>)) or (af_letter \<psi> \<nu>)"
 
 abbreviation af :: "'a ltl \<Rightarrow> 'a set list \<Rightarrow> 'a ltl" ("af")
 where
   "af \<phi> w \<equiv> foldl af_letter \<phi> w"
 
 lemma af_decompose:
   "af (\<phi> and \<psi>) w = (af \<phi> w) and (af \<psi> w)"
   "af (\<phi> or \<psi>) w = (af \<phi> w) or (af \<psi> w)"
   by (induction w rule: rev_induct) simp_all
 
 lemma af_simps[simp]:
   "af true w = true"
   "af false w = false"
   "af (X \<phi>) (x#xs) = af \<phi> (xs)"
   by (induction w) simp_all
 
 lemma af_F:
   "af (F \<phi>) w = Or (F \<phi> # map (af \<phi>) (suffixes w))"
 proof (induction w)
   case (Cons x xs)
     have "af (F \<phi>) (x # xs) = af (af_letter (F \<phi>) x) xs"
       by simp
     also
     have "\<dots> = (af (F \<phi>) xs) or (af (af_letter (\<phi>) x) xs)"
       unfolding af_decompose[symmetric] by simp
     finally
     show ?case using Cons Or_append_syntactic by force
 qed simp
 
 lemma af_G:
   "af (G \<phi>) w = And (G \<phi> # map (af \<phi>) (suffixes w))"
 proof (induction w)
   case (Cons x xs)
     have "af (G \<phi>) (x # xs) = af (af_letter (G \<phi>) x) xs"
       by simp
     also
     have "\<dots> = (af (G \<phi>) xs) and (af (af_letter (\<phi>) x) xs)"
       unfolding af_decompose[symmetric] by simp
     finally
     show ?case using Cons Or_append_syntactic by force
 qed simp
 
 lemma af_U:
   "af (\<phi> U \<psi>) (x#xs) = (af (\<phi> U \<psi>) xs and af \<phi> (x#xs)) or af \<psi> (x#xs)"
   by (induction xs) (simp add: af_decompose)+
 
 lemma af_respectfulness:
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_letter \<phi> \<nu> \<longrightarrow>\<^sub>P af_letter \<psi> \<nu>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_letter \<phi> \<nu> \<equiv>\<^sub>P af_letter \<psi> \<nu>"
 proof -
   { 
     fix \<phi> 
     have "af_letter \<phi> \<nu> = subst \<phi> (\<lambda>\<chi>. Some (af_letter \<chi> \<nu>))" 
       by (induction \<phi>) auto 
   }
   thus "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_letter \<phi> \<nu> \<longrightarrow>\<^sub>P af_letter \<psi> \<nu>"
     and "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_letter \<phi> \<nu> \<equiv>\<^sub>P af_letter \<psi> \<nu>"
     using subst_respects_ltl_prop_entailment by metis+
 qed
 
 lemma af_respectfulness':
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af \<phi> w \<longrightarrow>\<^sub>P af \<psi> w"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af \<phi> w \<equiv>\<^sub>P af \<psi> w"
   by (induction w arbitrary: \<phi> \<psi>) (insert af_respectfulness, fastforce+)
 
 lemma af_nested_propos:
   "nested_propos (af_letter \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
   by (induction \<phi>) auto
 
 subsection \<open>@{term af\<^sub>G}\<close>
 
 fun af_G_letter :: "'a ltl \<Rightarrow> 'a set \<Rightarrow> 'a ltl"
 where
   "af_G_letter true \<nu> = true"
 | "af_G_letter false \<nu> = false"
 | "af_G_letter p(a) \<nu> = (if a \<in> \<nu> then true else false)"
 | "af_G_letter (np(a)) \<nu>  = (if a \<notin> \<nu> then true else false)"
 | "af_G_letter (\<phi> and \<psi>) \<nu> = (af_G_letter \<phi> \<nu>) and (af_G_letter \<psi> \<nu>)"
 | "af_G_letter (\<phi> or \<psi>) \<nu> = (af_G_letter \<phi> \<nu>) or (af_G_letter \<psi> \<nu>)"
 | "af_G_letter (X \<phi>) \<nu> = \<phi>"
 | "af_G_letter (G \<phi>) \<nu> = (G \<phi>)"
 | "af_G_letter (F \<phi>) \<nu> = (F \<phi>) or (af_G_letter \<phi> \<nu>)"
 | "af_G_letter (\<phi> U \<psi>) \<nu> = (\<phi> U \<psi> and (af_G_letter \<phi> \<nu>)) or (af_G_letter \<psi> \<nu>)"
 
 abbreviation af\<^sub>G :: "'a ltl \<Rightarrow> 'a set list \<Rightarrow> 'a ltl"
 where
   "af\<^sub>G \<phi> w \<equiv> (foldl af_G_letter \<phi> w)"
 
 lemma af\<^sub>G_decompose:
   "af\<^sub>G (\<phi> and \<psi>) w = (af\<^sub>G \<phi> w) and (af\<^sub>G \<psi> w)"
   "af\<^sub>G (\<phi> or \<psi>) w = (af\<^sub>G \<phi> w) or (af\<^sub>G \<psi> w)"
   by (induction w rule: rev_induct) simp_all
 
 lemma af\<^sub>G_simps[simp]:
   "af\<^sub>G true w = true"
   "af\<^sub>G false w = false"
   "af\<^sub>G (G \<phi>) w = G \<phi>"
   "af\<^sub>G (X \<phi>) (x#xs) = af\<^sub>G \<phi> (xs)"
   by (induction w) simp_all
 
 lemma af\<^sub>G_F:
   "af\<^sub>G (F \<phi>) w = Or (F \<phi> # map (af\<^sub>G \<phi>) (suffixes w))"
 proof (induction w)
   case (Cons x xs)
     have "af\<^sub>G (F \<phi>) (x # xs) = af\<^sub>G (af_G_letter (F \<phi>) x) xs"
       by simp
     also
     have "\<dots> = (af\<^sub>G (F \<phi>) xs) or (af\<^sub>G (af_G_letter (\<phi>) x) xs)"
       unfolding af\<^sub>G_decompose[symmetric] by simp
     finally
     show ?case using Cons Or_append_syntactic by force
 qed simp
 
 lemma af\<^sub>G_U:
   "af\<^sub>G (\<phi> U \<psi>) (x#xs) = (af\<^sub>G (\<phi> U \<psi>) xs and af\<^sub>G \<phi> (x#xs)) or af\<^sub>G \<psi> (x#xs)"
   by (simp add: af\<^sub>G_decompose)
 
 lemma af\<^sub>G_subsequence_U:
   "af\<^sub>G (\<phi> U \<psi>) (w [0 \<rightarrow> Suc n]) = (af\<^sub>G (\<phi> U \<psi>) (w [1 \<rightarrow> Suc n]) and af\<^sub>G \<phi> (w [0 \<rightarrow> Suc n])) or af\<^sub>G \<psi> (w [0 \<rightarrow> Suc n])"
 proof -
   have "\<And>n. w [0 \<rightarrow> Suc n] = w 0 # w [1 \<rightarrow> Suc n]"
     using subsequence_append[of w 1] by (simp add: subsequence_def upt_conv_Cons) 
   thus ?thesis
     using af\<^sub>G_U by metis
 qed
 
 lemma af_G_respectfulness:
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_G_letter \<phi> \<nu> \<longrightarrow>\<^sub>P af_G_letter \<psi> \<nu>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_G_letter \<phi> \<nu> \<equiv>\<^sub>P af_G_letter \<psi> \<nu>"
 proof -
   { 
     fix \<phi> 
     have "af_G_letter \<phi> \<nu> = subst \<phi> (\<lambda>\<chi>. Some (af_G_letter \<chi> \<nu>))" 
       by (induction \<phi>) auto 
   }
   thus "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_G_letter \<phi> \<nu> \<longrightarrow>\<^sub>P af_G_letter \<psi> \<nu>"
     and "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_G_letter \<phi> \<nu> \<equiv>\<^sub>P af_G_letter \<psi> \<nu>"
     using subst_respects_ltl_prop_entailment by metis+
 qed
 
 lemma af_G_respectfulness':
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af\<^sub>G \<phi> w \<longrightarrow>\<^sub>P af\<^sub>G \<psi> w"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af\<^sub>G \<phi> w \<equiv>\<^sub>P af\<^sub>G \<psi> w"
   by (induction w arbitrary: \<phi> \<psi>) (insert af_G_respectfulness, fastforce+) 
 
 lemma af_G_nested_propos:
   "nested_propos (af_G_letter \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
   by (induction \<phi>) auto
 
 lemma af_G_letter_sat_core:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af_G_letter \<phi> \<nu>"
   by (induction \<phi>) (simp_all, blast+)
 
 lemma af\<^sub>G_sat_core:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af\<^sub>G \<phi> w"
   using af_G_letter_sat_core by (induction w rule: rev_induct) (simp_all, blast)
 
 lemma af\<^sub>G_sat_core_generalized:
   "Only_G \<G> \<Longrightarrow> i \<le> j \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af\<^sub>G \<phi> (w [0 \<rightarrow> i]) \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af\<^sub>G \<phi> (w [0 \<rightarrow> j])"
   by (metis af\<^sub>G_sat_core foldl_append subsequence_append le_add_diff_inverse)
 
 lemma af\<^sub>G_eval\<^sub>G:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af\<^sub>G (eval\<^sub>G \<G> \<phi>) w \<longleftrightarrow> \<G> \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w)" 
   by (induction \<phi>) (simp_all add: eval\<^sub>G_prop_entailment af\<^sub>G_decompose)
 
 lemma af\<^sub>G_keeps_F_and_S:
   assumes "ys \<noteq> []"
   assumes "S \<Turnstile>\<^sub>P af\<^sub>G \<phi> ys"
   shows "S \<Turnstile>\<^sub>P af\<^sub>G (F \<phi>) (xs @ ys)"
 proof -
   have "af\<^sub>G \<phi> ys \<in> set (map (af\<^sub>G \<phi>) (suffixes (xs @ ys)))"
     using assms(1) unfolding suffixes_append map_append
     by (induction ys rule: List.list_nonempty_induct) auto
   thus ?thesis
     unfolding af\<^sub>G_F Or_prop_entailment using assms(2) by force
 qed
 
 subsection \<open>G-Subformulae Simplification\<close>
 
 lemma G_af_simp[simp]:
   "\<^bold>G (af \<phi> w) = \<^bold>G \<phi>"
 proof -
   { fix \<phi> \<nu> have "\<^bold>G (af_letter \<phi> \<nu>) = \<^bold>G \<phi>" by (induction \<phi>) auto }
   thus ?thesis
     by (induction w arbitrary: \<phi> rule: rev_induct) fastforce+
 qed
 
 lemma G_af\<^sub>G_simp[simp]:
   "\<^bold>G (af\<^sub>G \<phi> w) = \<^bold>G \<phi>"
 proof -
   { fix \<phi> \<nu> have "\<^bold>G (af_G_letter \<phi> \<nu>) = \<^bold>G \<phi>" by (induction \<phi>) auto }
   thus ?thesis
     by (induction w arbitrary: \<phi> rule: rev_induct) fastforce+
 qed
 
 subsection \<open>Relation between af and $af_G$\<close>
 
 lemma af_G_letter_free_F:
   "\<^bold>G \<phi> = {} \<Longrightarrow> \<^bold>G (af_letter \<phi> \<nu>) = {}"
   "\<^bold>G \<phi> = {} \<Longrightarrow> \<^bold>G (af_G_letter \<phi> \<nu>) = {}"
   by (induction \<phi>) auto
 
 lemma af_G_free:
   assumes "\<^bold>G \<phi> = {}"
   shows "af \<phi> w = af\<^sub>G \<phi> w"
   using assms
 proof (induction w arbitrary: \<phi>)
   case (Cons x xs)
     hence "af (af_letter \<phi> x) xs = af\<^sub>G (af_letter \<phi> x) xs"
       using af_G_letter_free_F[OF Cons.prems, THEN Cons.IH] by blast
     moreover
     have "af_letter \<phi> x = af_G_letter \<phi> x"
       using Cons.prems by (induction \<phi>) auto
     ultimately
     show ?case 
       by simp
 qed simp
 
 lemma af_equals_af\<^sub>G_base_cases:
   "af true w = af\<^sub>G true w"
   "af false w = af\<^sub>G false w"
   "af p(a) w = af\<^sub>G p(a) w"
   "af (np(a)) w = af\<^sub>G (np(a)) w"
   by (auto intro: af_G_free)
 
 lemma af_implies_af\<^sub>G:
   "S \<Turnstile>\<^sub>P af \<phi> w \<Longrightarrow> S \<Turnstile>\<^sub>P af\<^sub>G \<phi> w"
 proof (induction w arbitrary: S rule: rev_induct)
   case (snoc x xs)
     hence "S \<Turnstile>\<^sub>P af_letter (af \<phi> xs) x"
       by simp
     hence "S \<Turnstile>\<^sub>P af_letter (af\<^sub>G \<phi> xs) x"
       using af_respectfulness(1) snoc.IH unfolding ltl_prop_implies_def by blast
     moreover
     {
       fix \<phi> 
       have "\<And>\<nu>. S \<Turnstile>\<^sub>P af_letter \<phi> \<nu> \<Longrightarrow> S \<Turnstile>\<^sub>P af_G_letter \<phi> \<nu>"
         by (induction \<phi>) auto
     }
     ultimately
     show ?case
       using snoc.prems foldl_append by simp
 qed simp
 
 lemma af_implies_af\<^sub>G_2:
   "w \<Turnstile> af \<phi> xs \<Longrightarrow> w \<Turnstile> af\<^sub>G \<phi> xs"
   by (metis ltl_prop_implication_implies_ltl_implication af_implies_af\<^sub>G ltl_prop_implies_def)
 
 lemma af\<^sub>G_implies_af_eval\<^sub>G':
   assumes "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w)"
   assumes "\<And>\<psi>. G \<psi> \<in> \<G> \<Longrightarrow> S \<Turnstile>\<^sub>P G \<psi>"
   assumes "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i < length w \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i w))" 
   shows   "S \<Turnstile>\<^sub>P af \<phi> w"
   using assms
 proof (induction \<phi> arbitrary: w)
   case (LTLGlobal \<phi>)
     hence "G \<phi> \<in> \<G>"
       unfolding af\<^sub>G_simps eval\<^sub>G.simps by (cases "G \<phi> \<in> \<G>") simp+
     hence "S \<Turnstile>\<^sub>P G \<phi>"
       using LTLGlobal by simp
     moreover
     {
       fix x
       assume "x \<in> set (map (af \<phi>) (suffixes w))"
       then obtain w' where "x = af \<phi> w'" and "w' \<in> set (suffixes w)"
         by auto
       then obtain i where "w' = drop i w" and "i < length w"
         by (auto simp add: suffixes_alt_def subsequence_def)
       hence "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w')"
         using LTLGlobal.prems `G \<phi> \<in> \<G>` by simp
       hence "S \<Turnstile>\<^sub>P x"
         using LTLGlobal(1)[OF `S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w')`] LTLGlobal(3-4) drop_drop
         unfolding `x = af \<phi> w'` `w' = drop i w` by simp
     }
     ultimately
     show ?case
       unfolding af_G eval\<^sub>G_And_map And_prop_entailment by simp
 next
   case (LTLFinal \<phi>)
     then obtain x where x_def: "x \<in> set (F \<phi> # map (eval\<^sub>G \<G> o af\<^sub>G \<phi>) (suffixes w))" 
       and "S \<Turnstile>\<^sub>P x"
       unfolding Or_prop_entailment af\<^sub>G_F eval\<^sub>G_Or_map by force
     hence "\<exists>y \<in> set (F \<phi> # map (af \<phi>) (suffixes w)). S \<Turnstile>\<^sub>P y"
     proof (cases "x \<noteq> F \<phi>")
       case True
         then obtain w' where "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w')" and "w' \<in> set (suffixes w)"
           using x_def `S \<Turnstile>\<^sub>P x` by auto
         hence "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i < length w' \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i w'))"
           using LTLFinal.prems by (auto simp add: suffixes_alt_def subsequence_def)
         moreover
         have "\<And>\<psi>. G \<psi> \<in> \<G> \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (G \<psi>)"
           using LTLFinal by simp
         ultimately
         have "S \<Turnstile>\<^sub>P af \<phi> w'"
           using LTLFinal.IH[OF `S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> w')`] using assms(2) by blast 
         thus ?thesis
           using `w' \<in> set (suffixes w)` by auto
     qed simp
     thus ?case
       unfolding af_F Or_prop_entailment eval\<^sub>G_Or_map by simp
 next
   case (LTLNext \<phi>)
     thus ?case
     proof (cases w)
       case (Cons x xs)
         {
           fix \<psi> i
           assume "G \<psi> \<in> \<G>" and "Suc i < length (x#xs)"
           hence "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop (Suc i) (x#xs)))"
             using LTLNext.prems unfolding Cons by blast
           hence "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i xs))"
             by simp
         }
         hence "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i < length xs \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i xs))"
           by simp
         thus ?thesis
           using LTLNext Cons by simp
     qed simp
 next
   case (LTLUntil \<phi> \<psi>)
     thus ?case
     proof (induction w)
       case (Cons x xs)
         {
           assume "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (x # xs))"
           moreover
           have "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i < length (x#xs) \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i (x#xs)))"
             using Cons by simp
           ultimately
           have "S \<Turnstile>\<^sub>P af \<psi> (x # xs)"
             using Cons.prems by blast
           hence ?case
             unfolding af_U by simp
         }
         moreover
         {
           assume "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G (\<phi> U \<psi>) xs)" and "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> (x # xs))"
           moreover
           have "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i < length (x#xs) \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (drop i (x#xs)))"
             using Cons by simp
           ultimately
           have "S \<Turnstile>\<^sub>P af \<phi> (x # xs)" and "S \<Turnstile>\<^sub>P af (\<phi> U \<psi>) xs"  
             using Cons by (blast, force) 
           hence ?case
             unfolding af_U by simp
         }
         ultimately
         show ?case
           using Cons(4) unfolding af\<^sub>G_U by auto
     qed simp
 next
   case (LTLProp a)
     thus ?case
     proof (cases w)
       case (Cons x xs)
         thus ?thesis
           using LTLProp by (cases "a \<in> x") simp+
     qed simp
 next
   case (LTLPropNeg a)
     thus ?case
     proof (cases w)
       case (Cons x xs)
         thus ?thesis
           using LTLPropNeg by (cases "a \<in> x") simp+
     qed simp
 qed (unfold af_equals_af\<^sub>G_base_cases af\<^sub>G_decompose af_decompose, auto)
 
 lemma af\<^sub>G_implies_af_eval\<^sub>G:
   assumes "S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<phi> (w [0\<rightarrow>j]))"
   assumes "\<And>\<psi>. G \<psi> \<in> \<G> \<Longrightarrow> S \<Turnstile>\<^sub>P G \<psi>"
   assumes "\<And>\<psi> i. G \<psi> \<in> \<G> \<Longrightarrow> i \<le> j \<Longrightarrow> S \<Turnstile>\<^sub>P eval\<^sub>G \<G> (af\<^sub>G \<psi> (w [i \<rightarrow> j]))" 
   shows "S \<Turnstile>\<^sub>P af \<phi> (w [0\<rightarrow>j])"
   using af\<^sub>G_implies_af_eval\<^sub>G'[OF assms(1-2), unfolded subsequence_length subsequence_drop] assms(3) by force 
 
 subsection \<open>Continuation\<close>
 
 -- \<open>af fulfills the infinite continuation w' of a word after skipping some finite prefix w.
     Corresponds to Lemma 7 in arXiv: 1402.3388v2\<close>
 
 lemma af_ltl_continuation:
   "(w \<frown> w') \<Turnstile> \<phi> \<longleftrightarrow> w' \<Turnstile> af \<phi> w"
 proof (induction w arbitrary: \<phi> w')
   case (Cons x xs)
     have "((x # xs) \<frown> w') 0 = x"
       unfolding conc_def nth_Cons_0 by simp
     moreover
     have "suffix 1 ((x # xs) \<frown> w') = xs \<frown> w'"
       unfolding suffix_def conc_def by fastforce
     moreover
     {
       fix \<phi> :: "'a ltl"
       have "\<And>w. w \<Turnstile> \<phi> \<longleftrightarrow> suffix 1 w \<Turnstile> af_letter \<phi> (w 0)"
         by (induction \<phi>) ((unfold LTL_F_one_step_unfolding LTL_G_one_step_unfolding LTL_U_one_step_unfolding)?, auto)
     }
     ultimately
     have "((x # xs) \<frown> w') \<Turnstile> \<phi> \<longleftrightarrow> (xs \<frown> w') \<Turnstile> af_letter \<phi> x"
       by metis
     also
     have "\<dots> \<longleftrightarrow> w' \<Turnstile> af \<phi> (x#xs)"
       using Cons.IH by simp
     finally
     show ?case .
 qed simp
 
 lemma af_ltl_continuation_suffix:
   "w \<Turnstile> \<phi> \<longleftrightarrow> suffix i w \<Turnstile> af \<phi> (w[0 \<rightarrow> i])"
   using af_ltl_continuation prefix_suffix subsequence_def by metis
 
 lemma af_G_ltl_continuation:
   "\<forall>\<psi> \<in> \<^bold>G \<phi>. w' \<Turnstile> \<psi> = (w \<frown> w') \<Turnstile> \<psi> \<Longrightarrow> (w \<frown> w') \<Turnstile> \<phi> \<longleftrightarrow> w' \<Turnstile> af\<^sub>G \<phi> w"
 proof (induction w arbitrary: w' \<phi>)
   case (Cons x xs)
     {
       fix \<psi> :: "'a ltl" fix  w w' w'' 
       assume "w'' \<Turnstile> G \<psi> = ((w @ w') \<frown> w'') \<Turnstile> G \<psi>"
       hence "w'' \<Turnstile> G \<psi> = (w' \<frown>  w'') \<Turnstile> G \<psi>" and "(w' \<frown> w'') \<Turnstile> G \<psi> = ((w @ w') \<frown> w'') \<Turnstile> G \<psi>"
         by (induction w' arbitrary: w) (metis LTL_suffix_G suffix_conc_length conc_conc)+
     }
     note G_stable = this
     have A: "\<forall>\<psi>\<in>\<^bold>G (af\<^sub>G \<phi> [x]). w' \<Turnstile> \<psi> = (xs \<frown> w') \<Turnstile> \<psi>"
       using G_stable(1)[of w' _ "[x]"] Cons.prems unfolding G_af\<^sub>G_simp conc_conc append.simps unfolding G_nested_propos_alt_def by blast
     have B: "\<forall>\<psi>\<in>\<^bold>G \<phi>. ([x] \<frown> xs \<frown> w') \<Turnstile> \<psi> = (xs \<frown> w') \<Turnstile> \<psi>"
       using G_stable(2)[of w' _ "[x]"] Cons.prems unfolding conc_conc append.simps unfolding G_nested_propos_alt_def by blast 
     hence "([x] \<frown> xs \<frown> w') \<Turnstile> \<phi> = (xs \<frown> w') \<Turnstile> af\<^sub>G \<phi> [x]"
     proof (induction \<phi>)
       case (LTLFinal \<phi>)
         thus ?case
           unfolding LTL_F_one_step_unfolding
           by (auto simp add: suffix_conc_length[of "[x]", simplified])
     next
       case (LTLUntil \<phi> \<psi>)
         thus ?case
           unfolding LTL_U_one_step_unfolding
           by (auto simp add: suffix_conc_length[of "[x]", simplified])
     qed (auto simp add: conc_fst[of 0 "[x]"] suffix_conc_length[of "[x]", simplified])
     also
     have "... = w' \<Turnstile> af\<^sub>G \<phi> (x # xs)"
       using Cons.IH[of "af\<^sub>G \<phi> [x]" w'] A by simp
     finally
     show ?case unfolding conc_conc 
       by simp
 qed simp
 
 lemma af\<^sub>G_ltl_continuation_suffix:
   "\<forall>\<psi> \<in> \<^bold>G \<phi>. w \<Turnstile> \<psi> = (suffix i w) \<Turnstile> \<psi> \<Longrightarrow> w \<Turnstile> \<phi> \<longleftrightarrow> suffix i w \<Turnstile> af\<^sub>G \<phi> (w [0 \<rightarrow> i])"  
   by (metis af_G_ltl_continuation[of \<phi> "suffix i w"] prefix_suffix subsequence_def)
 
 subsection \<open>Eager Unfolding @{term af} and @{term af\<^sub>G}\<close> 
 
 fun Unf :: "'a ltl \<Rightarrow> 'a ltl"
 where
   "Unf (F \<phi>) = F \<phi> or Unf \<phi>"
 | "Unf (G \<phi>) = G \<phi> and Unf \<phi>" 
 | "Unf (\<phi> U \<psi>) = (\<phi> U \<psi> and Unf \<phi>) or Unf \<psi>"
 | "Unf (\<phi> and \<psi>) = Unf \<phi> and Unf \<psi>"
 | "Unf (\<phi> or \<psi>) = Unf \<phi> or Unf \<psi>"
 | "Unf \<phi> = \<phi>"
 
 fun Unf\<^sub>G :: "'a ltl \<Rightarrow> 'a ltl"
 where
   "Unf\<^sub>G (F \<phi>) = F \<phi> or Unf\<^sub>G \<phi>"
 | "Unf\<^sub>G (G \<phi>) = G \<phi>" 
 | "Unf\<^sub>G (\<phi> U \<psi>) = (\<phi> U \<psi> and Unf\<^sub>G \<phi>) or Unf\<^sub>G \<psi>"
 | "Unf\<^sub>G (\<phi> and \<psi>) = Unf\<^sub>G \<phi> and Unf\<^sub>G \<psi>"
 | "Unf\<^sub>G (\<phi> or \<psi>) = Unf\<^sub>G \<phi> or Unf\<^sub>G \<psi>"
 | "Unf\<^sub>G \<phi> = \<phi>"
 
 fun step :: "'a ltl \<Rightarrow> 'a set \<Rightarrow> 'a ltl"
 where
   "step p(a) \<nu> = (if a \<in> \<nu> then true else false)"
 | "step (np(a)) \<nu> = (if a \<notin> \<nu> then true else false)"
 | "step (X \<phi>) \<nu> = \<phi>"
 | "step (\<phi> and \<psi>) \<nu> = step \<phi> \<nu> and step \<psi> \<nu>"
 | "step (\<phi> or \<psi>) \<nu> = step \<phi> \<nu> or step \<psi> \<nu>"
 | "step \<phi> \<nu> = \<phi>"
 
 fun af_letter_opt
 where
   "af_letter_opt \<phi> \<nu> = Unf (step \<phi> \<nu>)"
 
 fun af_G_letter_opt
 where
   "af_G_letter_opt \<phi> \<nu> = Unf\<^sub>G (step \<phi> \<nu>)"
 
 abbreviation af_opt :: "'a ltl \<Rightarrow> 'a set list \<Rightarrow> 'a ltl" ("af\<^sub>\<UU>")
 where
   "af\<^sub>\<UU> \<phi> w \<equiv> (foldl af_letter_opt \<phi> w)"
 
 abbreviation af_G_opt :: "'a ltl \<Rightarrow> 'a set list \<Rightarrow> 'a ltl" ("af\<^sub>G\<^sub>\<UU>")
 where
   "af\<^sub>G\<^sub>\<UU> \<phi> w \<equiv> (foldl af_G_letter_opt \<phi> w)"
 
 lemma af_letter_alt_def:
   "af_letter \<phi> \<nu> = step (Unf \<phi>) \<nu>"
   "af_G_letter \<phi> \<nu> = step (Unf\<^sub>G \<phi>) \<nu>"
   by (induction \<phi>) simp_all
 
 lemma af_to_af_opt:
   "Unf (af \<phi> w) = af\<^sub>\<UU> (Unf \<phi>) w"
   "Unf\<^sub>G (af\<^sub>G \<phi> w) = af\<^sub>G\<^sub>\<UU> (Unf\<^sub>G \<phi>) w"
   by (induction w arbitrary: \<phi>)
      (simp_all add: af_letter_alt_def)
 
 lemma af_equiv:
   "af \<phi> (w @ [\<nu>]) = step (af\<^sub>\<UU> (Unf \<phi>) w) \<nu>"
   using af_to_af_opt(1) by (metis af_letter_alt_def(1) foldl_Cons foldl_Nil foldl_append)
 
 lemma af_equiv':
   "af \<phi> (w [0 \<rightarrow> Suc i]) = step (af\<^sub>\<UU> (Unf \<phi>) (w [0 \<rightarrow> i])) (w i)"
   using af_equiv unfolding subsequence_def by auto
 
 subsection \<open>Lifted Functions\<close>
 
 lemma respectfulness:
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_letter_opt \<phi> \<nu> \<longrightarrow>\<^sub>P af_letter_opt \<psi> \<nu>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_letter_opt \<phi> \<nu> \<equiv>\<^sub>P af_letter_opt \<psi> \<nu>"
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> af_G_letter_opt \<phi> \<nu> \<longrightarrow>\<^sub>P af_G_letter_opt \<psi> \<nu>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> af_G_letter_opt \<phi> \<nu> \<equiv>\<^sub>P af_G_letter_opt \<psi> \<nu>"
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> step \<phi> \<nu> \<longrightarrow>\<^sub>P step \<psi> \<nu>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> step \<phi> \<nu> \<equiv>\<^sub>P step \<psi> \<nu>"
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> Unf \<phi> \<longrightarrow>\<^sub>P Unf \<psi>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> Unf \<phi> \<equiv>\<^sub>P Unf \<psi>"
   "\<phi> \<longrightarrow>\<^sub>P \<psi> \<Longrightarrow> Unf\<^sub>G \<phi> \<longrightarrow>\<^sub>P Unf\<^sub>G \<psi>"
   "\<phi> \<equiv>\<^sub>P \<psi> \<Longrightarrow> Unf\<^sub>G \<phi> \<equiv>\<^sub>P Unf\<^sub>G \<psi>"
   using decomposable_function_subst[of "\<lambda>\<chi>. af_letter_opt \<chi> \<nu>", simplified] af_letter_opt.simps
   using decomposable_function_subst[of "\<lambda>\<chi>. af_G_letter_opt \<chi> \<nu>", simplified] af_G_letter_opt.simps
   using decomposable_function_subst[of "\<lambda>\<chi>. step \<chi> \<nu>", simplified]
   using decomposable_function_subst[of Unf, simplified] 
   using decomposable_function_subst[of Unf\<^sub>G, simplified]
   using subst_respects_ltl_prop_entailment by metis+
 
 lemma nested_propos:
   "nested_propos (step \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
   "nested_propos (Unf \<phi>) \<subseteq> nested_propos \<phi>"
   "nested_propos (Unf\<^sub>G \<phi>) \<subseteq> nested_propos \<phi>"
   "nested_propos (af_letter_opt \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
   "nested_propos (af_G_letter_opt \<phi> \<nu>) \<subseteq> nested_propos \<phi>"
   by (induction \<phi>) auto
 
 text \<open>Lift functions and bind to new names\<close>
 
 interpretation af_abs: lift_ltl_transformer af_letter
   using lift_ltl_transformer_def af_respectfulness af_nested_propos by blast
 
 definition af_letter_abs ("\<up>af")
 where
   "\<up>af \<equiv> af_abs.f_abs"
 
 interpretation af_G_abs: lift_ltl_transformer af_G_letter
   using lift_ltl_transformer_def af_G_respectfulness af_G_nested_propos by blast
 
 definition af_G_letter_abs ("\<up>af\<^sub>G")
 where
   "\<up>af\<^sub>G \<equiv> af_G_abs.f_abs"
 
 interpretation af_abs_opt: lift_ltl_transformer af_letter_opt
   using lift_ltl_transformer_def respectfulness nested_propos by blast
 
 definition af_letter_abs_opt ("\<up>af\<^sub>\<UU>")
 where
   "\<up>af\<^sub>\<UU> \<equiv> af_abs_opt.f_abs"
 
 interpretation af_G_abs_opt: lift_ltl_transformer af_G_letter_opt
   using lift_ltl_transformer_def respectfulness nested_propos by blast
 
 definition af_G_letter_abs_opt ("\<up>af\<^sub>G\<^sub>\<UU>")
 where
   "\<up>af\<^sub>G\<^sub>\<UU> \<equiv> af_G_abs_opt.f_abs"
 
 lift_definition step_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a set \<Rightarrow> 'a ltl\<^sub>P" ("\<up>step") is step
   by (insert respectfulness)
 
 lift_definition Unf_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("\<up>Unf") is Unf
   by (insert respectfulness)
 
 lift_definition Unf\<^sub>G_abs :: "'a ltl\<^sub>P \<Rightarrow> 'a ltl\<^sub>P" ("\<up>Unf\<^sub>G") is Unf\<^sub>G
   by (insert respectfulness)
 
 subsubsection \<open>Properties\<close>
 
 lemma af_G_letter_opt_sat_core:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P af_G_letter_opt \<phi> \<nu>"
   by (induction \<phi>) auto 
 
 lemma af_G_letter_sat_core_lifted:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P Rep \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P Rep (af_G_letter_abs \<phi> \<nu>)"
   by (metis af_G_letter_sat_core Quotient_ltl_prop_equiv_quotient[THEN Quotient_rep_abs] Quotient3_ltl_prop_equiv_quotient[THEN Quotient3_abs_rep] af_G_abs.f_abs.abs_eq ltl_prop_equiv_def af_G_letter_abs_def) 
 
 lemma af_G_letter_opt_sat_core_lifted:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P Rep \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P Rep (\<up>af\<^sub>G\<^sub>\<UU> \<phi> \<nu>)"
   unfolding af_G_letter_abs_opt_def
   by (metis af_G_letter_opt_sat_core Quotient_ltl_prop_equiv_quotient[THEN Quotient_rep_abs] Quotient3_ltl_prop_equiv_quotient[THEN Quotient3_abs_rep] af_G_abs_opt.f_abs.abs_eq ltl_prop_equiv_def) 
 
 lemma af_G_letter_abs_opt_split:
   "\<up>Unf\<^sub>G (\<up>step \<Phi> \<nu>) = \<up>af\<^sub>G\<^sub>\<UU> \<Phi> \<nu>"
   unfolding af_G_letter_abs_opt_def step_abs_def comp_def af_G_abs_opt.f_abs_def 
   using map_fun_apply Unf\<^sub>G_abs.abs_eq af_G_letter_opt.simps by auto
 
 lemma af_unfold: 
   "\<up>af = (\<lambda>\<phi> \<nu>. \<up>step (\<up>Unf \<phi>) \<nu>)" 
   by (metis Unf_abs_def af_abs.f_abs.abs_eq af_letter_abs_def af_letter_alt_def(1) ltl\<^sub>P_abs_rep map_fun_apply step_abs.abs_eq)
  
 lemma af_opt_unfold: 
   "\<up>af\<^sub>\<UU> = (\<lambda>\<phi> \<nu>. \<up>Unf (\<up>step \<phi> \<nu>))"
   by (metis (no_types, lifting) Quotient3_abs_rep Quotient3_ltl_prop_equiv_quotient Unf_abs.abs_eq af_abs_opt.f_abs.abs_eq af_letter_abs_opt_def af_letter_opt.elims id_apply map_fun_apply  step_abs_def)
 
 lemma af_abs_equiv:
   "foldl \<up>af \<psi> (xs @ [x]) = \<up>step (foldl \<up>af\<^sub>\<UU> (\<up>Unf \<psi>) xs) x" 
   unfolding af_unfold af_opt_unfold by (induction xs arbitrary: x \<psi> rule: rev_induct) simp+
 
 lemma Rep_Abs_equiv: 
   "Rep (Abs \<phi>) \<equiv>\<^sub>P \<phi>"
   using Rep_Abs_prop_entailment unfolding ltl_prop_equiv_def by auto
 
 lemma Rep_step: 
   "Rep (\<up>step \<Phi> \<nu>) \<equiv>\<^sub>P step (Rep \<Phi>) \<nu>"
   by (metis Quotient3_abs_rep Quotient3_ltl_prop_equiv_quotient ltl_prop_equiv_quotient.abs_eq_iff step_abs.abs_eq)
 
 lemma step_\<G>:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P step \<phi> \<nu>"
   by (induction \<phi>) auto
 
 lemma Unf\<^sub>G_\<G>:
   "Only_G \<G> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P \<phi> \<Longrightarrow> \<G> \<Turnstile>\<^sub>P Unf\<^sub>G \<phi>"
   by (induction \<phi>) auto
 
 hide_fact (open) respectfulness nested_propos
 
 end
diff --git a/thys/LTL_to_GBA/All_Of_LTL_to_GBA.thy b/thys/LTL_to_GBA/All_Of_LTL_to_GBA.thy
--- a/thys/LTL_to_GBA/All_Of_LTL_to_GBA.thy
+++ b/thys/LTL_to_GBA/All_Of_LTL_to_GBA.thy
@@ -1,6 +1,6 @@
 (*<*)
 theory All_Of_LTL_to_GBA
-imports LTL LTL_Rewrite LTL_Stutter LTL_to_GBA LTL_to_GBA_impl
+imports LTL_Stutter LTL_to_GBA LTL_to_GBA_impl
 begin
 end
 (*>*)
diff --git a/thys/LTL_to_GBA/LTL.thy b/thys/LTL_to_GBA/LTL.thy
deleted file mode 100644
--- a/thys/LTL_to_GBA/LTL.thy
+++ /dev/null
@@ -1,1335 +0,0 @@
-section \<open>Linear Temporal Logic\<close>
-(* Author: Alexander Schimpf *)
-theory LTL
-imports
-  "~~/src/HOL/Library/Omega_Words_Fun" "../Automatic_Refinement/Lib/Refine_Util"
-begin
-
-subsection "LTL formulas"
-
-subsubsection \<open>Syntax\<close>
-
-datatype (plugins del: size)
- 'a ltl = LTLTrue
-       | LTLFalse
-       | LTLProp 'a
-       | LTLNeg "'a ltl"
-       | LTLAnd "'a ltl" "'a ltl"
-       | LTLOr "'a ltl" "'a ltl"
-       | LTLNext "'a ltl"
-       | LTLUntil "'a ltl" "'a ltl"
-       | LTLRelease "'a ltl" "'a ltl"
-
-instantiation ltl :: (type) size
-begin
-
-text \<open>The new datatype package would give a size of 1 to
-  @{const LTLProp}, which breaks some of the proofs below.\<close>
-primrec size_ltl :: "'a ltl \<Rightarrow> nat" where
-    "size LTLTrue = 0"
-  | "size LTLFalse = 0"
-  | "size (LTLProp _) = 0"
-  | "size (LTLNeg \<phi>) = size \<phi> + 1"
-  | "size (LTLAnd \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
-  | "size (LTLOr \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
-  | "size (LTLNext \<phi>) = size \<phi> + 1"
-  | "size (LTLUntil \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
-  | "size (LTLRelease \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
-
-instance ..
-
-end
-
-text \<open>The following locale defines syntactic sugar for
-  parsing and printing LTL formulas in Isabelle\<close>
-locale LTL_Syntax begin
-notation
-           LTLTrue     ("true")
-       and LTLFalse    ("false")
-       and LTLProp     ("prop'(_')")
-       and LTLNeg      ("not _" [85] 85)
-       and LTLAnd      ("_ and _" [82,82] 81)
-       and LTLOr       ("_ or _" [81,81] 80)
-       and LTLNext     ("X _" [88] 87)
-       and LTLUntil    ("_ U _" [84,84] 83)
-       and LTLRelease  ("_ V _" [83,83] 82)
-end
-
-subsubsection \<open>Semantics\<close>
-text \<open>We first provide an abstract semantics, that is parameterized with
-  the semantics of atomic propositions\<close>
-
-context begin interpretation LTL_Syntax .
-
-primrec ltl_semantics :: "'ap set word \<Rightarrow> 'ap ltl \<Rightarrow> bool"
-  ("_ \<Turnstile> _" [80,80] 80)
-  where
-    "\<xi> \<Turnstile> true = True"
-  | "\<xi> \<Turnstile> false = False"
-  | "\<xi> \<Turnstile> prop(q) = (q \<in> (\<xi> 0))"
-  | "\<xi> \<Turnstile> not \<phi> = (\<not> \<xi> \<Turnstile> \<phi>)"
-  | "\<xi> \<Turnstile> \<phi> and \<psi> = (\<xi> \<Turnstile> \<phi> \<and> \<xi> \<Turnstile> \<psi>)"
-  | "\<xi> \<Turnstile> \<phi> or \<psi> = (\<xi> \<Turnstile> \<phi> \<or> \<xi> \<Turnstile> \<psi>)"
-  | "\<xi> \<Turnstile> X \<phi> = (suffix 1 \<xi> \<Turnstile> \<phi>)"
-  | "\<xi> \<Turnstile> \<phi> U \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile> \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>))"
-  | "\<xi> \<Turnstile> \<phi> V \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile> \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile> \<phi>))"
-
-definition "ltl_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile> \<phi>}"
-end
-
-subsubsection \<open>Explicit Syntactic Sugar\<close>
-text \<open>In this section, we provide a formulation of LTL with
-  explicit syntactic sugar deeply embedded. This formalization
-  serves as a reference semantics.
-\<close>
-datatype (ltlc_aprops: 'a)
-    ltlc = LTLcTrue
-         | LTLcFalse
-         | LTLcProp 'a
-         | LTLcNeg "'a ltlc"
-         | LTLcAnd "'a ltlc" "'a ltlc"
-         | LTLcOr "'a ltlc" "'a ltlc"
-         | LTLcImplies "'a ltlc" "'a ltlc"
-         | LTLcIff "'a ltlc" "'a ltlc"
-         | LTLcNext "'a ltlc"
-         | LTLcFinal "'a ltlc"
-         | LTLcGlobal "'a ltlc"
-         | LTLcUntil "'a ltlc" "'a ltlc"
-         | LTLcRelease "'a ltlc" "'a ltlc"
-
-context LTL_Syntax begin
-  notation
-        LTLcTrue     ("true\<^sub>c")
-    and LTLcFalse    ("false\<^sub>c")
-    and LTLcProp     ("prop\<^sub>c'(_')")
-    and LTLcNeg      ("not\<^sub>c _" [85] 85)
-    and LTLcAnd      ("_ and\<^sub>c _" [82,82] 81)
-    and LTLcOr       ("_ or\<^sub>c _" [81,81] 80)
-    and LTLcImplies  ("_ implies\<^sub>c _" [81,81] 80)
-    and LTLcIff      (" _ iff\<^sub>c _" [81,81] 80)
-    and LTLcNext     ("X\<^sub>c _" [88] 87)
-    and LTLcFinal    ("F\<^sub>c _" [88] 87)
-    and LTLcGlobal   ("G\<^sub>c _" [88] 87)
-    and LTLcUntil    ("_ U\<^sub>c _" [84,84] 83)
-    and LTLcRelease  ("_ V\<^sub>c _" [83,83] 82)
-end
-
-context begin interpretation LTL_Syntax .
-
-primrec ltlc_semantics
-  :: "['a set word, 'a ltlc] \<Rightarrow> bool" ("_ \<Turnstile>\<^sub>c _" [80,80] 80)
-where
-    "\<xi> \<Turnstile>\<^sub>c true\<^sub>c = True"
-  | "\<xi> \<Turnstile>\<^sub>c false\<^sub>c = False"
-  | "\<xi> \<Turnstile>\<^sub>c prop\<^sub>c(q) = (q\<in>\<xi> 0)"
-  | "\<xi> \<Turnstile>\<^sub>c not\<^sub>c \<phi> = (\<not> \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> and\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<and> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> or\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<or> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> implies\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> iff\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>c X\<^sub>c \<phi> = (suffix 1 \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c F\<^sub>c \<phi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c G\<^sub>c \<phi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> U\<^sub>c \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"
-  | "\<xi> \<Turnstile>\<^sub>c \<phi> V\<^sub>c \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"
-
-definition "ltlc_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile>\<^sub>c \<phi>}"
-
-lemma ltlc_language_negate[simp]:
-  "ltlc_language (not\<^sub>c \<phi>) = - ltlc_language \<phi>"
-unfolding ltlc_language_def
-by auto
-
-lemma ltlc_semantics_sugar:
-  "\<xi> \<Turnstile>\<^sub>c \<phi> implies\<^sub>c \<psi> = \<xi> \<Turnstile>\<^sub>c (not\<^sub>c \<phi> or\<^sub>c \<psi>)"
-  "\<xi> \<Turnstile>\<^sub>c \<phi> iff\<^sub>c \<psi> = \<xi> \<Turnstile>\<^sub>c ((not\<^sub>c \<phi> or\<^sub>c \<psi>) and\<^sub>c (not\<^sub>c \<psi> or\<^sub>c \<phi>))"
-  "\<xi> \<Turnstile>\<^sub>c F\<^sub>c \<phi> = \<xi> \<Turnstile>\<^sub>c (true\<^sub>c U\<^sub>c \<phi>)"
-  "\<xi> \<Turnstile>\<^sub>c G\<^sub>c \<phi> = \<xi> \<Turnstile>\<^sub>c (false\<^sub>c V\<^sub>c \<phi>)"
-by auto
-
-definition "pw_eq_on S w w' \<equiv> \<forall>i. w i \<inter> S = w' i \<inter> S"
-
-lemma
-      pw_eq_on_refl[simp]: "pw_eq_on S w w"
-  and pw_eq_on_sym: "pw_eq_on S w w' \<Longrightarrow> pw_eq_on S w' w"
-  and pw_eq_on_trans[trans]:
-    "\<lbrakk>pw_eq_on S w w'; pw_eq_on S w' w''\<rbrakk> \<Longrightarrow> pw_eq_on S w w''"
-  unfolding pw_eq_on_def by auto
-
-lemma ltlc_eq_on: "pw_eq_on (ltlc_aprops \<phi>) w w' \<Longrightarrow> w \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> w' \<Turnstile>\<^sub>c \<phi>"
-  unfolding pw_eq_on_def
-  apply (induction \<phi> arbitrary: w w')
-  apply (simp_all add: suffix_def)
-  apply (auto) []
-  apply ((rprems, (auto) []) | fo_rule arg_cong2 arg_cong | intro ext | simp)+
-  done
-
-lemma map_ltlc_semantics_aux:
-  assumes "inj_on f APs"
-  assumes "\<Union>(range \<xi>) \<subseteq> APs"
-  assumes "ltlc_aprops \<phi> \<subseteq> APs"
-  shows "\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> (\<lambda>i. f ` \<xi> i) \<Turnstile>\<^sub>c map_ltlc f \<phi>"
-  using assms(2,3)
-  apply (induct \<phi> arbitrary: \<xi>)
-  using assms(1)
-  apply (simp_all add: suffix_def inj_on_Un)
-  apply (auto dest: inj_onD) []
-  apply ((rprems, (auto) []) | fo_rule arg_cong2 arg_cong | intro ext | simp)+
-  done
-
-
-definition "map_aprops f APs \<equiv> { i. \<exists>p\<in>APs. f p = Some i }"
-
-lemma map_ltlc_semantics:
-  assumes INJ: "inj_on f (dom f)" and DOM: "ltlc_aprops \<phi> \<subseteq> dom f"
-  shows "\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> (map_aprops f o \<xi>) \<Turnstile>\<^sub>c map_ltlc (the o f) \<phi>"
-proof -
-  let ?\<xi>r = "\<lambda>i. \<xi> i \<inter> ltlc_aprops \<phi>"
-  let ?\<xi>r' = "\<lambda>i. \<xi> i \<inter> dom f"
-
-  have 1: "\<Union>range ?\<xi>r \<subseteq> ltlc_aprops \<phi>" by auto
-
-  have INJ_the_dom: "inj_on (the o f) (dom f)"
-    using assms
-    by (auto simp: inj_on_def domIff)
-  note 2 = subset_inj_on[OF this DOM]
-
-  have 3: "(\<lambda>i. (the o f) ` ?\<xi>r' i) = map_aprops f o \<xi>" using DOM INJ
-    apply (auto intro!: ext simp: map_aprops_def domIff image_iff)
-    by (metis Int_iff domI option.sel)
-
-  have "\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> ?\<xi>r \<Turnstile>\<^sub>c \<phi>"
-    apply (rule ltlc_eq_on)
-    apply (auto simp: pw_eq_on_def)
-    done
-  also from map_ltlc_semantics_aux[OF 2 1 subset_refl]
-  have "\<dots> \<longleftrightarrow> (\<lambda>i. (the o f) ` ?\<xi>r i) \<Turnstile>\<^sub>c map_ltlc (the o f) \<phi>" .
-  also have "\<dots> \<longleftrightarrow> (\<lambda>i. (the o f) ` ?\<xi>r' i) \<Turnstile>\<^sub>c map_ltlc (the o f) \<phi>"
-    apply (rule ltlc_eq_on) using DOM INJ
-    apply (auto simp: pw_eq_on_def ltlc.set_map domIff image_iff)
-    by (metis Int_iff contra_subsetD domD domI inj_on_eq_iff option.sel)
-  also note 3
-  finally show ?thesis .
-qed
-
-lemma map_ltlc_semantics_inv:
-  assumes INJ: "inj_on f (dom f)" and DOM: "ltlc_aprops \<phi> \<subseteq> dom f"
-  shows "\<xi> \<Turnstile>\<^sub>c map_ltlc (the o f) \<phi> \<longleftrightarrow> (\<lambda>i. (the o f) -` \<xi> i) \<Turnstile>\<^sub>c \<phi>"
-  using map_ltlc_semantics[OF assms]
-  apply simp
-  apply (intro ltlc_eq_on)
-  apply (auto simp add: pw_eq_on_def ltlc.set_map map_aprops_def)
-  by (metis DOM comp_apply contra_subsetD domD option.sel vimage_eq)
-
-text \<open>Conversion from LTL with common syntax to LTL\<close>
-
-fun ltlc_to_ltl :: "'a ltlc \<Rightarrow> 'a ltl"
-where
-  "ltlc_to_ltl true\<^sub>c = true"
-| "ltlc_to_ltl false\<^sub>c = false"
-| "ltlc_to_ltl prop\<^sub>c(q) = prop(q)"
-| "ltlc_to_ltl (not\<^sub>c \<phi>) = not (ltlc_to_ltl \<phi>)"
-| "ltlc_to_ltl (\<phi> and\<^sub>c \<psi>) = ltlc_to_ltl \<phi> and ltlc_to_ltl \<psi>"
-| "ltlc_to_ltl (\<phi> or\<^sub>c \<psi>) = ltlc_to_ltl \<phi> or ltlc_to_ltl \<psi>"
-| "ltlc_to_ltl (\<phi> implies\<^sub>c \<psi>) = (not (ltlc_to_ltl \<phi>)) or (ltlc_to_ltl \<psi>)"
-| "ltlc_to_ltl (\<phi> iff\<^sub>c \<psi>) = (let \<phi>' = ltlc_to_ltl \<phi> in
-                             let \<psi>' = ltlc_to_ltl \<psi> in
-                             (not \<phi>' or \<psi>') and (not \<psi>' or \<phi>'))"
-| "ltlc_to_ltl (X\<^sub>c \<phi>) = X (ltlc_to_ltl \<phi>)"
-| "ltlc_to_ltl (F\<^sub>c \<phi>) = true U ltlc_to_ltl \<phi>"
-| "ltlc_to_ltl (G\<^sub>c \<phi>) = false V ltlc_to_ltl \<phi>"
-| "ltlc_to_ltl (\<phi> U\<^sub>c \<psi>) = ltlc_to_ltl \<phi> U ltlc_to_ltl \<psi>"
-| "ltlc_to_ltl (\<phi> V\<^sub>c \<psi>) = ltlc_to_ltl \<phi> V ltlc_to_ltl \<psi>"
-
-lemma ltlc_to_ltl_equiv:
-  "\<xi> \<Turnstile> (ltlc_to_ltl \<phi>) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>c \<phi>"
-  apply (induct \<phi> arbitrary:\<xi>)
-  apply (auto simp: Let_def)
-  done
-
-end
-
-subsection \<open>Semantic Preserving Syntax Transformations\<close>
-
-context begin interpretation LTL_Syntax .
-
-lemma ltl_true_or_con[simp]:
-  "\<xi> \<Turnstile> prop(p) or (not prop(p)) \<longleftrightarrow> \<xi> \<Turnstile> true"
-  by auto
-
-lemma ltl_false_true_con[simp]:
-  "\<xi> \<Turnstile> not true \<longleftrightarrow> \<xi> \<Turnstile> false"
-  by auto
-
-text\<open>
-  The negation symbol can be passed through the next operator.
-\<close>
-lemma ltl_Next_Neg_con[simp]:
-  "\<xi> \<Turnstile> X (not \<phi>) \<longleftrightarrow> \<xi> \<Turnstile> not X \<phi>"
-  by auto
-
-text\<open>
-  The connection between Until and Release
-\<close>
-lemma ltl_Release_Until_con:
- "\<xi> \<Turnstile> \<phi> V \<psi> \<longleftrightarrow> (\<not> \<xi> \<Turnstile> (not \<phi>) U (not \<psi>))"
-  by auto
-
-
-text\<open>Expand strategy\<close>
-
-lemma ltl_expand_Until:
-  "\<xi> \<Turnstile> \<phi> U \<psi> \<longleftrightarrow> (\<xi> \<Turnstile> \<psi> or (\<phi> and (X (\<phi> U \<psi>))))" (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  then obtain i
-        where psi_is: "suffix i \<xi> \<Turnstile> \<psi>"
-          and phi_is: "\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>" by auto
-  show ?rhs
-  proof(cases i)
-    case 0
-    then show ?rhs using psi_is by auto
-  next
-    case (Suc k)
-    with phi_is have "\<xi> \<Turnstile> \<phi>" by auto
-    moreover
-    have "\<xi> \<Turnstile> X (\<phi> U \<psi>)"
-    using psi_is phi_is Suc by auto
-    ultimately show ?rhs by auto
-  qed
-next
-  assume rhs: ?rhs
-  show ?lhs
-  proof(cases "\<xi> \<Turnstile> \<psi>")
-    case True
-    then have "suffix 0 \<xi> \<Turnstile> \<psi>" by auto
-    moreover
-    have "\<forall>j<0. suffix j \<xi> \<Turnstile> \<phi>" by auto
-    ultimately
-    have "\<exists>i. suffix i \<xi> \<Turnstile> \<psi>
-              \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>)" by blast
-    then show ?lhs by auto
-  next
-    case False
-    then have phi_is: "\<xi> \<Turnstile> \<phi>"
-      and "\<xi> \<Turnstile> X (\<phi> U \<psi>)" using rhs by auto
-    then obtain i
-          where psi_suc_is: "suffix (Suc i) \<xi> \<Turnstile> \<psi>"
-            and phi_suc_is: "\<forall>j<i. suffix (Suc j) \<xi> \<Turnstile> \<phi>" by auto
-    have sbgoal: "\<forall>j<(Suc i). suffix j \<xi> \<Turnstile> \<phi>"
-    proof(clarify)
-      fix j
-      assume j_less: "j<Suc i"
-      show "suffix j \<xi> \<Turnstile> \<phi>"
-      proof (cases j)
-        assume "j=0"
-        then show ?thesis using phi_is by auto
-      next
-        fix k
-        assume "j=Suc k"
-        then show ?thesis using j_less phi_suc_is by auto
-      qed
-    qed
-    then show ?lhs using psi_suc_is phi_is by auto
-  qed
-qed
-
-lemma ltl_expand_Release:
-  "\<xi> \<Turnstile> \<phi> V \<psi> \<longleftrightarrow> (\<xi> \<Turnstile> \<psi> and (\<phi> or (X (\<phi> V \<psi>))))"
-proof -
-  from ltl_expand_Until[of \<xi> "not \<phi>" "not \<psi>"]
-  show ?thesis by auto
-qed
-
-text\<open>Double negation structure of an LTL formula\<close>
-
-lemma [simp]:
-  "not ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) (not \<phi>)"
-  by (induct n) auto
-
-lemma ltl_double_neg_struct:
-  shows "\<exists>n \<psi>. \<phi> = ((\<lambda>\<xi>. not not \<xi>) ^^ n) \<psi> \<and> (\<forall>\<nu>. \<psi> \<noteq> not not \<nu>)"
-  (is "\<exists>n \<psi>. ?Q \<phi> n \<psi>")
-proof(cases "\<forall>\<nu>. \<phi> \<noteq> not \<nu>")
-  case True
-    then have "?Q \<phi> 0 \<phi>" by auto
-    then show ?thesis by blast
-next
-  case False
-    then show ?thesis
-    proof(induct \<phi>)
-      case (LTLNeg \<phi>')
-        show ?case
-        proof(cases "\<forall>\<nu>. \<phi>' \<noteq> not \<nu>")
-          case True
-            with LTLNeg have "?Q (not \<phi>') 0 (not \<phi>')" by auto
-            then show ?thesis by blast
-        next
-          case False
-            with LTLNeg obtain n' \<psi>' where Q: "?Q \<phi>' n' \<psi>'" by auto
-            show ?thesis
-            proof(cases "\<exists>\<psi>''. \<psi>' = not \<psi>''")
-              case True
-                then obtain \<psi>''
-                      where "\<psi>' = not \<psi>''" by auto
-                with Q have "?Q (not \<phi>') (n'+1) \<psi>''" by auto
-                then show ?thesis by blast
-            next
-              case False
-                with Q have "?Q (not \<phi>') n' (not \<psi>')" by auto
-                then show ?thesis by blast
-            qed
-        qed
-    qed auto
-qed
-
-lemma ltl_size_double_neg:
-  assumes "\<psi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>"
-    shows "size \<phi> \<le> size \<psi>"
-using assms proof (induct n arbitrary:\<phi> \<psi>)
-  case (Suc k)
-    obtain \<mu> where \<mu>_eq: "\<mu> = ((\<lambda>\<mu>. not not \<mu>) ^^ k) \<phi>" by auto
-    then have "\<psi> = not not \<mu>" using Suc by auto
-    moreover have "size \<phi> \<le> size \<mu>" using Suc \<mu>_eq by auto
-    ultimately show ?case by auto
-qed auto
-
-
-text\<open>Pushing negation to the top of a proposition\<close>
-
-fun
-  ltl_pushneg :: "'a ltl \<Rightarrow> 'a ltl"
-  where
-    "ltl_pushneg true = true"
-  | "ltl_pushneg false = false"
-  | "ltl_pushneg prop(q) = prop(q)"
-  | "ltl_pushneg (not true) = false"
-  | "ltl_pushneg (not false) = true"
-  | "ltl_pushneg (not prop(q)) = not prop(q)"
-  | "ltl_pushneg (not (not \<psi>)) = ltl_pushneg \<psi>"
-  | "ltl_pushneg (not (\<nu> and \<mu>)) = ltl_pushneg (not \<nu>) or ltl_pushneg (not \<mu>)"
-  | "ltl_pushneg (not (\<nu> or \<mu>)) = ltl_pushneg (not \<nu>) and ltl_pushneg (not \<mu>)"
-  | "ltl_pushneg (not (X \<psi>)) = X ltl_pushneg (not \<psi>)"
-  | "ltl_pushneg (not (\<nu> U \<mu>)) = ltl_pushneg (not \<nu>) V ltl_pushneg (not \<mu>)"
-  | "ltl_pushneg (not (\<nu> V \<mu>)) = ltl_pushneg (not \<nu>) U ltl_pushneg (not \<mu>)"
-  | "ltl_pushneg (\<phi> and \<psi>) = (ltl_pushneg \<phi>) and (ltl_pushneg \<psi>)"
-  | "ltl_pushneg (\<phi> or \<psi>) = (ltl_pushneg \<phi>) or (ltl_pushneg \<psi>)"
-  | "ltl_pushneg (X \<phi>) = X (ltl_pushneg \<phi>)"
-  | "ltl_pushneg (\<phi> U \<psi>) = (ltl_pushneg \<phi>) U (ltl_pushneg \<psi>)"
-  | "ltl_pushneg (\<phi> V \<psi>) = (ltl_pushneg \<phi>) V (ltl_pushneg \<psi>)"
-
-
-text\<open>
-  In fact, the @{text ltl_pushneg} function does not change the
-  semantics of the input formula.
-\<close>
-
-lemma ltl_pushneg_neg:
-  shows "\<xi> \<Turnstile> ltl_pushneg (not \<phi>) \<longleftrightarrow> \<xi> \<Turnstile> not ltl_pushneg \<phi>"
-  by (induct \<phi> arbitrary: \<xi>) auto
-
-theorem ltl_pushneg_equiv[simp]:
-  "\<xi> \<Turnstile> ltl_pushneg \<phi> \<longleftrightarrow> \<xi> \<Turnstile> \<phi>"
-proof (induct \<phi> arbitrary: \<xi>)
-  case (LTLNeg \<psi>)
-  with ltl_pushneg_neg show ?case by auto
-qed auto
-
-
-text\<open>
-  We can now show that @{text ltl_pushneg} does what it should do.
-  Actually the negation occurs after the transformation
-  only on top of a proposition.
-\<close> (* TODO (Alex): Formulation! Describe the 'what' in one or two sentences! *)
-
-lemma ltl_pushneg_double_neg:
-  shows "ltl_pushneg (((\<lambda>\<phi>. not not \<phi>) ^^ n) \<phi>) = ltl_pushneg \<phi>"
-by (induct n arbitrary:\<phi>) auto
-
-lemma ltl_pushneg_neg_struct:
-  assumes "ltl_pushneg \<phi> = not \<psi>"
-    shows "\<exists>q. \<psi> = prop(q)"
-proof -
-  from ltl_double_neg_struct
-  obtain n \<mu> where \<phi>_eq: "\<phi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<mu>"
-               and \<mu>_neq: "(\<forall>\<nu>. \<mu> \<noteq> not not \<nu>)" by blast
-  with ltl_pushneg_double_neg have "ltl_pushneg \<phi> = ltl_pushneg \<mu>" by auto
-  then show ?thesis using \<phi>_eq assms \<mu>_neq
-  proof(induct \<mu>)
-    case (LTLNeg f) then show ?case by (cases f) auto
-  qed auto
-qed
-
-inductive subfrml
-where
-  "subfrml \<phi> (not \<phi>)"
-| "subfrml \<phi> (\<phi> and \<psi>)"
-| "subfrml \<psi> (\<phi> and \<psi>)"
-| "subfrml \<phi> (\<phi> or \<psi>)"
-| "subfrml \<psi> (\<phi> or \<psi>)"
-| "subfrml \<phi> (X \<phi>)"
-| "subfrml \<phi> (\<phi> U \<psi>)"
-| "subfrml \<psi> (\<phi> U \<psi>)"
-| "subfrml \<phi> (\<phi> V \<psi>)"
-| "subfrml \<psi> (\<phi> V \<psi>)"
-
-abbreviation is_subfrml ("_ is'_subformula'_of _")
-where
-  "is_subfrml \<psi> \<phi> \<equiv> subfrml\<^sup>*\<^sup>* \<psi> \<phi>"
-
-lemma subfrml_size:
-  assumes "subfrml \<psi> \<phi>"
-    shows "size \<psi> < size \<phi>"
-using assms by (induct \<phi>) auto
-
-lemma subformula_size:
-  assumes "\<psi> is_subformula_of \<phi>"
-    shows "size \<psi> < size \<phi> \<or> \<psi> = \<phi>"
-using assms proof(induct \<phi>)
-  case base then show ?case by auto
-next
-  case (step \<nu> \<mu>)
-    then have "size \<nu> < size \<mu>" by (rule_tac subfrml_size)
-    then show ?case using step by auto
-qed
-
-
-lemma subformula_on_ltl_pushneg:
-  assumes "\<psi> is_subformula_of (ltl_pushneg \<phi>)"
-    shows "\<exists>\<mu>. \<psi> = ltl_pushneg \<mu>"
-proof(cases "\<psi> = ltl_pushneg \<phi>")
-  case True then show ?thesis by blast
-next
-  case False then show ?thesis using assms
-  proof(induct \<phi> rule:ltl_pushneg.induct)
-    case 1 then show ?case using subformula_size by force
-  next
-    case 2 then show ?case using subformula_size by force
-  next
-    case 3 then show ?case using subformula_size by force
-  next
-    case 4 then show ?case using subformula_size by force
-  next
-    case 5 then show ?case using subformula_size by force
-  next
-    case (6 q)
-      let ?frml = "not prop(q)"
-      from rtrancl_eq_or_trancl[to_pred, of subfrml]
-      have t_prm: "subfrml\<^sup>+\<^sup>+ \<psi> ?frml"
-      using 6 by auto
-      obtain \<mu>
-       where sf_prm: "subfrml \<psi>  \<mu>"
-         and rt_prm: "\<mu> is_subformula_of ?frml"
-      using tranclpD[OF t_prm] by blast
-      show ?case
-      proof(cases "\<mu> = ?frml")
-        assume "\<mu> = ?frml"
-        with sf_prm have "\<psi> = ltl_pushneg prop(q)"
-        by (cases \<psi>) auto
-        then show ?thesis by blast
-      next
-        assume "\<mu> \<noteq> ?frml"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp[of subfrml]
-             subformula_size[of \<mu> ?frml]
-        have "size \<mu> = 0" by auto
-        with subfrml_size[OF sf_prm]
-        show ?thesis by auto
-      qed
-  next
-    case 7 then show ?case by auto
-  next
-    case (8 \<nu> \<mu>)
-      let ?frml = "not (\<nu> and \<mu>)"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 8 by auto
-      then have z_is:
-            "z = ltl_pushneg (not \<nu>) \<or>
-             z = ltl_pushneg (not \<mu>)" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 8 z_is by auto
-      qed
-  next
-    case (9 \<nu> \<mu>)
-      let ?frml = "not (\<nu> or \<mu>)"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 9 by auto
-      then have z_is:
-            "z = ltl_pushneg (not \<nu>) \<or>
-             z = ltl_pushneg (not \<mu>)" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 9 z_is by auto
-      qed
-  next
-    case (10 \<mu>)
-      let ?frml = "not (X \<mu>)"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 10 by auto
-      then have z_is: "z = ltl_pushneg (not \<mu>)"
-      by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 10 z_is by auto
-      qed
-  next
-    case (11 \<nu> \<mu>)
-      let ?frml = "not (\<nu> U \<mu>)"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 11 by auto
-      then have z_is:
-            "z = ltl_pushneg (not \<nu>) \<or>
-             z = ltl_pushneg (not \<mu>)" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 11 z_is by auto
-      qed
-  next
-    case (12 \<nu> \<mu>)
-      let ?frml = "not (\<nu> V \<mu>)"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 12 by auto
-      then have z_is:
-            "z = ltl_pushneg (not \<nu>) \<or>
-             z = ltl_pushneg (not \<mu>)" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 12 z_is by auto
-      qed
-  next
-    case (13 \<nu> \<mu>)
-      let ?frml = "\<nu> and \<mu>"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 13 by auto
-      then have z_is:
-            "z = ltl_pushneg \<nu> \<or>
-             z = ltl_pushneg \<mu>" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 13 z_is by auto
-      qed
-  next
-    case (14 \<nu> \<mu>)
-      let ?frml = "\<nu> or \<mu>"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 14 by auto
-      then have z_is:
-            "z = ltl_pushneg \<nu> \<or>
-             z = ltl_pushneg \<mu>" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 14 z_is by auto
-      qed
-  next
-    case (15 \<mu>)
-      let ?frml = "X \<mu>"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 15 by auto
-      then have z_is: "z = ltl_pushneg \<mu>" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 15 z_is by auto
-      qed
-  next
-    case (16 \<nu> \<mu>)
-      let ?frml = "\<nu> U \<mu>"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 16 by auto
-      then have z_is:
-            "z = ltl_pushneg \<nu> \<or>
-             z = ltl_pushneg \<mu>" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 16 z_is by auto
-      qed
-  next
-    case (17 \<nu> \<mu>)
-      let ?frml = "\<nu> V \<mu>"
-      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
-           rtrancl_eq_or_trancl[to_pred, of subfrml]
-      obtain z
-       where "subfrml z (ltl_pushneg ?frml)"
-         and rt_prm: "\<psi> is_subformula_of z"
-       using 17 by auto
-      then have z_is:
-            "z = ltl_pushneg \<nu> \<or>
-             z = ltl_pushneg \<mu>" by (cases z) auto
-      show ?case
-      proof(cases "\<psi> = z")
-        assume "\<psi> = z"
-        with z_is show ?thesis by auto
-      next
-        assume "\<psi> \<noteq> z"
-        with rtranclpD[OF rt_prm]
-             tranclp_into_rtranclp
-        have "\<psi> is_subformula_of z" by auto
-        then show ?thesis using 17 z_is by auto
-      qed
-  qed
-qed
-
-
-text\<open>
-  The fact that after pushing the negation the structure of a
-  formula changes, is shown by the following theorem.
-  Indeed, after pushing the negation symbol inside a
-  formula, it occurs at most on top of a proposition.
-\<close>
-
-theorem ltl_pushneg_struct:
-  assumes "(not \<psi>) is_subformula_of (ltl_pushneg \<phi>)"
-    shows "\<exists>q. \<psi> = prop(q)"
-proof -
-  from assms subformula_on_ltl_pushneg
-  obtain \<mu>
-   where prm:"not \<psi> = ltl_pushneg \<mu>" by blast
-  from ltl_pushneg_neg_struct[OF sym[OF prm]]
-  show ?thesis by auto
-qed
-
-
-text\<open>
-  Now we want to show that the size of the formula,
-  which is transformed by @{text ltl_pushneg}, does not increase
-  'too much', i.e. there is no exponential blowup
-  produced by the transformation.
-  For that purpose we need an additional function,
-  which counts the literals of the derivation tree
-  of a formula.
-  The idea is, that, assuming the worst case, the
-  pushing of negation can only increase the size of a
-  formula by putting the negation symbol on top of every
-  proposition inside the formula.
-\<close>
-
-fun leafcnt :: "'a ltl \<Rightarrow> nat"
-where
-  "leafcnt true = 1"
-| "leafcnt false = 1"
-| "leafcnt prop(q) = 1"
-| "leafcnt (not \<phi>) = leafcnt \<phi>"
-| "leafcnt (\<phi> and \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
-| "leafcnt (\<phi> or \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
-| "leafcnt (X \<phi>) = leafcnt \<phi>"
-| "leafcnt (\<phi> U \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
-| "leafcnt (\<phi> V \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
-
-
-lemma leafcnt_double_neg_ident:
-  "leafcnt (((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>) = leafcnt \<phi>"
-by (induct n arbitrary:\<phi>) auto
-
-lemma ltl_pushneg_help:
-  "\<exists>\<phi>. ltl_pushneg \<psi> = ltl_pushneg \<phi>
-       \<and> ((\<exists>\<nu>. \<phi> = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi> \<noteq> not \<mu>))
-       \<and> size \<phi> \<le> size \<psi>
-       \<and> leafcnt \<phi> = leafcnt \<psi>"
-  (is "\<exists>\<phi>. ?P \<psi> \<phi> \<and> ?Q \<phi> \<and> ?R \<phi>")
-proof -
-  from ltl_double_neg_struct
-  obtain n \<phi> where dblneg: "\<psi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>"
-               and \<phi>_neq: "(\<forall>\<nu>. \<phi> \<noteq> not not \<nu>)"
-                by blast
-  have "?Q \<phi>"
-  proof(rule ccontr)
-    assume *: "\<not> ?Q \<phi>"
-    show "False"
-    proof(cases "\<exists>\<mu>. \<phi> = not \<mu>")
-      case True
-        then obtain \<mu> where "\<phi> = not \<mu>" by blast
-        with * dblneg \<phi>_neq show ?thesis by auto
-    next
-      case False
-        with * show ?thesis by auto
-    qed
-  qed
-  with dblneg \<phi>_neq
-       ltl_pushneg_double_neg[of n \<phi>]
-       leafcnt_double_neg_ident[of n \<phi>]
-       ltl_size_double_neg[OF dblneg] show ?thesis by auto
-qed
-
-
-lemma ltl_pushneg_size_lin_help:
-  assumes "\<psi> = ltl_pushneg \<phi>"
-    shows "size \<psi> + 1 \<le> size \<phi> + leafcnt \<phi>"
-  using assms
-proof (induct \<psi> arbitrary: \<phi>)
-  case LTLTrue show ?case by (cases \<phi>) auto
-next
-  case LTLFalse show ?case by (cases \<phi>) auto
-next
-  case LTLProp show ?case by (cases \<phi>) auto
-next
-  case (LTLNeg \<psi>')
-    with ltl_pushneg_neg_struct[of \<phi> \<psi>'] obtain q where q: "\<psi>' = prop(q)" by auto
-    with ltl_pushneg_help[of \<phi>] obtain \<phi>' where \<phi>':
-        "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-        "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-        "size \<phi>' \<le> size \<phi>"
-        "leafcnt \<phi>' = leafcnt \<phi>"
-      by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with q \<phi>' show ?thesis using LTLNeg by (cases \<nu>) auto
-    next
-      case False
-      with \<phi>' LTLNeg show ?thesis by (cases \<phi>') force+
-    qed
-next
-  case (LTLAnd f g)
-    with ltl_pushneg_help[of \<phi>]
-    obtain \<phi>' where \<phi>':
-        "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-        "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-        "size \<phi>' \<le> size \<phi>"
-        "leafcnt \<phi>' = leafcnt \<phi>"
-      by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is: "\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with LTLAnd \<phi>' have "size (f and g) \<le> size \<nu> + leafcnt \<nu>" by (cases \<nu>) force+
-        with \<phi>' \<phi>'is show ?thesis by auto
-    next
-      case False
-        with LTLAnd \<phi>' show ?thesis by (cases \<phi>') force+
-    qed
-next
-  case (LTLOr f g)
-    with ltl_pushneg_help[of \<phi>]
-    obtain \<phi>' where \<phi>':
-      "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-      "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-      "size \<phi>' \<le> size \<phi>"
-      "leafcnt \<phi>' = leafcnt \<phi>" by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is: "\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with LTLOr \<phi>' have "size (f or g) \<le> size \<nu> + leafcnt \<nu>" by (cases \<nu>) force+
-        with \<phi>' \<phi>'is show ?thesis by auto
-    next
-      case False
-      with LTLOr \<phi>' show ?thesis by (cases \<phi>') force+
-    qed
-next
-  case (LTLNext f)
-    with ltl_pushneg_help[of \<phi>]
-    obtain \<phi>' where \<phi>':
-      "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-      "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-      "size \<phi>' \<le> size \<phi>"
-      "leafcnt \<phi>' = leafcnt \<phi>" by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is: "\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with LTLNext \<phi>' show ?thesis by (cases \<nu>) force+
-    next
-      case False
-        with LTLNext \<phi>' show ?thesis by (cases \<phi>') force+
-    qed
-next
-  case (LTLUntil f g)
-    with ltl_pushneg_help[of \<phi>]
-    obtain \<phi>' where \<phi>':
-      "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-     "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-     "size \<phi>' \<le> size \<phi>"
-     "leafcnt \<phi>' = leafcnt \<phi>" by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is: "\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with LTLUntil \<phi>' have "size (f U g) \<le> size \<nu> + leafcnt \<nu>" by (cases \<nu>) force+
-        with LTLUntil \<phi>' \<phi>'is show ?thesis by auto
-    next
-      case False
-        with LTLUntil \<phi>' show ?thesis by (cases \<phi>') force+
-    qed
-next
-  case (LTLRelease f g)
-    with ltl_pushneg_help[of \<phi>]
-    obtain \<phi>' where \<phi>':
-      "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
-      "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
-      "size \<phi>' \<le> size \<phi>"
-      "leafcnt \<phi>' = leafcnt \<phi>" by auto
-    show ?case
-    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
-      case True
-        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
-        with LTLRelease \<phi>' have "size (f V g) \<le> size \<nu> + leafcnt \<nu>" by (cases \<nu>) force+
-        with LTLRelease \<phi>' \<phi>'is show ?thesis by auto
-    next
-      case False
-        with LTLRelease \<phi>' show ?thesis by (cases \<phi>') force+
-    qed
-qed
-
-theorem ltl_pushneg_size_lin:
-  "size (ltl_pushneg \<phi>) \<le> 2 * size \<phi>"
-proof -
-  have "leafcnt \<phi> \<le> size \<phi> + 1" by (induct \<phi>) auto
-  with ltl_pushneg_size_lin_help[of _ \<phi>]
-  have "size (ltl_pushneg \<phi>) + 1 \<le> size \<phi> + size \<phi> + 1" by force
-  then show ?thesis by auto
-qed
-
-end
-
-subsection \<open>LTL formula in negation normal form (NNF)\<close>
-text\<open>
-  We define a type of LTL formula in negation normal form (NNF)
-\<close>
-
-
-datatype
-  'a ltln = LTLnTrue
-       | LTLnFalse
-       | LTLnProp 'a
-       | LTLnNProp 'a
-       | LTLnAnd "'a ltln" "'a ltln"
-       | LTLnOr "'a ltln" "'a ltln"
-       | LTLnNext "'a ltln"
-       | LTLnUntil "'a ltln" "'a ltln"
-       | LTLnRelease "'a ltln" "'a ltln"
-
-context LTL_Syntax begin
-  notation
-        LTLnTrue      ("true\<^sub>n")
-    and LTLnFalse     ("false\<^sub>n")
-    and LTLnProp      ("prop\<^sub>n'(_')")
-    and LTLnNProp     ("nprop\<^sub>n'(_')")
-    and LTLnAnd       ("_ and\<^sub>n _" [82,82] 81)
-    and LTLnOr        ("_ or\<^sub>n _" [84,84] 83)
-    and LTLnNext      ("X\<^sub>n _" [88] 87)
-    and LTLnUntil     ("_ U\<^sub>n _" [84,84] 83)
-    and LTLnRelease   ("_ V\<^sub>n _" [84,84] 83)
-
-  abbreviation ltln_eventuality :: "'a ltln \<Rightarrow> 'a ltln" ("\<diamond>\<^sub>n _" [88] 87)
-    where "ltln_eventuality \<phi> \<equiv> true\<^sub>n U\<^sub>n \<phi>"
-
-  abbreviation ltln_universality :: "'a ltln \<Rightarrow> 'a ltln" ("\<box>\<^sub>n _" [88] 87)
-    where "ltln_universality \<phi> \<equiv> false\<^sub>n V\<^sub>n \<phi>"
-
-end
-
-context begin interpretation LTL_Syntax .
-
-primrec ltln_semantics :: "['a set word, 'a ltln] \<Rightarrow> bool"
-("_ \<Turnstile>\<^sub>n _" [80,80] 80)
-  where
-    "\<xi> \<Turnstile>\<^sub>n true\<^sub>n = True"
-  | "\<xi> \<Turnstile>\<^sub>n false\<^sub>n = False"
-  | "\<xi> \<Turnstile>\<^sub>n prop\<^sub>n(q) = (q\<in>\<xi> 0)"
-  | "\<xi> \<Turnstile>\<^sub>n nprop\<^sub>n(q) = (q\<notin>\<xi> 0)"
-  | "\<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<phi> \<and> \<xi> \<Turnstile>\<^sub>n \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<phi> \<or> \<xi> \<Turnstile>\<^sub>n \<psi>)"
-  | "\<xi> \<Turnstile>\<^sub>n X\<^sub>n \<phi> = (suffix 1 \<xi> \<Turnstile>\<^sub>n \<phi>)"
-  | "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>))"
-  | "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>))"
-
-definition "ltln_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile>\<^sub>n \<phi>}"
-
-text\<open>
-  Conversion from LTL to LTL in NNF
-\<close>
-
-fun ltl_to_ltln :: "'a ltl \<Rightarrow> 'a ltln"
-where
-  "ltl_to_ltln true = true\<^sub>n"
-| "ltl_to_ltln false = false\<^sub>n"
-| "ltl_to_ltln prop(q) = prop\<^sub>n(q)"
-| "ltl_to_ltln (not prop(q)) = nprop\<^sub>n(q)"
-| "ltl_to_ltln (\<phi> and \<psi>) = ltl_to_ltln \<phi> and\<^sub>n ltl_to_ltln \<psi>"
-| "ltl_to_ltln (\<phi> or \<psi>) = ltl_to_ltln \<phi> or\<^sub>n ltl_to_ltln \<psi>"
-| "ltl_to_ltln (X \<phi>) = X\<^sub>n (ltl_to_ltln \<phi>)"
-| "ltl_to_ltln (\<phi> U \<psi>) = ltl_to_ltln \<phi> U\<^sub>n ltl_to_ltln \<psi>"
-| "ltl_to_ltln (\<phi> V \<psi>) = ltl_to_ltln \<phi> V\<^sub>n ltl_to_ltln \<psi>"
-
-
-lemma ltl_to_ltln_on_ltl_pushneg_equiv:
-  assumes "\<phi> = ltl_pushneg \<psi>"
-  shows "\<xi> \<Turnstile> \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n ltl_to_ltln \<phi>"
-  using assms
-proof(induct \<phi> arbitrary: \<xi> \<psi>)
-  case LTLTrue show ?case by auto
-next
-  case LTLFalse show ?case by auto
-next
-  case LTLProp show ?case by auto
-next
-  case (LTLNeg \<phi>)
-    with ltl_pushneg_neg_struct[of \<psi> \<phi>]
-    obtain q
-     where "\<phi> = prop(q)"
-        by auto
-    then show ?case by auto
-next
-  case (LTLAnd f g \<xi> \<psi>)
-    then have frml_eq: "ltl_pushneg \<psi> = f and g" by auto
-    with subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<mu>
-     where "f = ltl_pushneg \<mu>"
-        by (auto intro: subfrml.intros)
-    moreover
-    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<nu>
-     where "g = ltl_pushneg \<nu>"
-        by (auto intro: subfrml.intros)
-    ultimately
-    have "\<xi> \<Turnstile> f = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
-     and "\<xi> \<Turnstile> g = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
-    using LTLAnd by auto
-    then show ?case by auto
-next
-  case (LTLOr f g \<xi> \<psi>)
-    then have frml_eq: "ltl_pushneg \<psi> = f or g" by auto
-    with subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<mu>
-     where "f = ltl_pushneg \<mu>"
-        by (auto intro: subfrml.intros)
-    moreover
-    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<nu>
-     where "g = ltl_pushneg \<nu>"
-        by (auto intro: subfrml.intros)
-    ultimately
-    have "\<xi> \<Turnstile> f = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
-     and "\<xi> \<Turnstile> g = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
-    using LTLOr by auto
-    then show ?case by auto
-next
-  case (LTLNext \<phi> \<xi> \<psi>)
-    then have "ltl_pushneg \<psi> = X \<phi>" by auto
-    with subformula_on_ltl_pushneg[of \<phi> \<psi>]
-    obtain \<mu>
-     where "\<phi> = ltl_pushneg \<mu>"
-        by (auto intro: subfrml.intros)
-    with LTLNext(1) have "suffix 1 \<xi> \<Turnstile> \<phi> = suffix 1 \<xi> \<Turnstile>\<^sub>n ltl_to_ltln \<phi>" .
-    then show ?case by auto
-next
-  case (LTLUntil f g \<xi> \<psi>)
-    then have frml_eq: "ltl_pushneg \<psi> = f U g" by auto
-    with subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<mu>
-     where "f = ltl_pushneg \<mu>"
-        by (auto intro: subfrml.intros)
-    moreover
-    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<nu>
-     where "g = ltl_pushneg \<nu>"
-        by (auto intro: subfrml.intros)
-    ultimately
-    have "\<forall>i. suffix i \<xi> \<Turnstile> f = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
-     and "\<forall>i. suffix i \<xi> \<Turnstile> g = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
-    using LTLUntil(1,2) by blast+
-    then show ?case by auto
-next
-  case (LTLRelease f g \<xi> \<psi>)
-    then have frml_eq: "ltl_pushneg \<psi> = f V g" by auto
-    with subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<mu>
-     where "f = ltl_pushneg \<mu>"
-        by (auto intro: subfrml.intros)
-    moreover
-    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
-    obtain \<nu>
-     where "g = ltl_pushneg \<nu>"
-        by (auto intro: subfrml.intros)
-    ultimately
-    have "\<forall>i. suffix i \<xi> \<Turnstile> f = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
-     and "\<forall>i. suffix i \<xi> \<Turnstile> g = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
-    using LTLRelease(1,2) by blast+
-    then show ?case by auto
-qed
-
-
-lemma ltl_nnf_equiv[simp]:
-  "\<xi> \<Turnstile>\<^sub>n ltl_to_ltln (ltl_pushneg \<psi>) \<longleftrightarrow> \<xi> \<Turnstile> \<psi>"
-  using sym[OF ltl_pushneg_equiv] ltl_to_ltln_on_ltl_pushneg_equiv by blast
-
-
-fun subfrmlsn :: "'a ltln \<Rightarrow> 'a ltln set"
-where
-  "subfrmlsn (\<mu> and\<^sub>n \<psi>) = {\<mu> and\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
-| "subfrmlsn (X\<^sub>n \<mu>) = {X\<^sub>n \<mu>} \<union> subfrmlsn \<mu>"
-| "subfrmlsn (\<mu> U\<^sub>n \<psi>) = {\<mu> U\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
-| "subfrmlsn (\<mu> V\<^sub>n \<psi>) = {\<mu> V\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
-| "subfrmlsn (\<mu> or\<^sub>n \<psi>) = {\<mu> or\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
-| "subfrmlsn x = {x}"
-
-lemma subfrmlsn_id[simp]: "\<phi> \<in> subfrmlsn \<phi>" by (induct \<phi>) auto
-lemma subfrmlsn_finite: "finite (subfrmlsn \<phi>)" by (induct \<phi>) auto
-lemma subfrmlsn_subset:"\<psi> \<in> subfrmlsn \<phi> \<Longrightarrow> subfrmlsn \<psi> \<subseteq> subfrmlsn \<phi>"
-by (induct \<phi> arbitrary:\<psi>) auto
-
-fun size_frmln :: "'a ltln \<Rightarrow> nat"
-where
-  "size_frmln (\<phi> and\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
-| "size_frmln (X\<^sub>n \<phi>) = size_frmln \<phi> + 1"
-| "size_frmln (\<phi> U\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
-| "size_frmln (\<phi> V\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
-| "size_frmln (\<phi> or\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
-| "size_frmln _ = 1"
-
-lemma size_frmln_gt_zero[simp]: "size_frmln \<phi> > 0" by (induct \<phi>) auto
-
-abbreviation
-  "frmlset_sumn \<Phi> \<equiv> setsum size_frmln \<Phi>" -- "FIXME: lemmas about this?"
-
-lemma frmlset_sumn_diff_less[intro!]:
-  assumes finS:"finite S"
-      and "A\<noteq>{}"
-      and subset:"A\<subseteq>S"
-    shows "frmlset_sumn (S - A) < frmlset_sumn S"
-proof -
-  have finA: "finite A" using assms by (rule_tac finite_subset)
-  then have "frmlset_sumn A > 0" using assms size_frmln_gt_zero by (induct rule:finite_induct) auto
-  moreover
-  have "frmlset_sumn A \<le> frmlset_sumn S" using assms size_frmln_gt_zero by (rule_tac setsum_mono2) auto
-  ultimately show ?thesis using setsum_diff_nat[OF finA, of S size_frmln] assms by auto
-qed
-
-definition
-  "frmln_props \<phi> \<equiv> {p. prop\<^sub>n(p) \<in> subfrmlsn \<phi> \<or> nprop\<^sub>n(p) \<in> subfrmlsn \<phi>}"
-
-lemma ltln_expand_Until:
-  "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<psi> or\<^sub>n (\<phi> and\<^sub>n (X\<^sub>n (\<phi> U\<^sub>n \<psi>))))" (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  then obtain i
-        where psi_is: "suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
-          and phi_is: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
-  show ?rhs
-  proof(cases i)
-    assume "i=0"
-    then show ?rhs using psi_is by auto
-  next
-    fix k
-    assume i_eq: "i = Suc k"
-    with phi_is have "\<xi> \<Turnstile>\<^sub>n \<phi>" by auto
-    moreover
-    have "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<phi> U\<^sub>n \<psi>)"
-    using psi_is phi_is i_eq by auto
-    ultimately show ?rhs by auto
-  qed
-next
-  assume rhs: ?rhs
-  show ?lhs
-  proof(cases "\<xi> \<Turnstile>\<^sub>n \<psi>")
-    assume "\<xi> \<Turnstile>\<^sub>n \<psi>"
-    then have "suffix 0 \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
-    moreover
-    have "\<forall>j<0. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
-    ultimately
-    have "\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi>
-              \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)" by blast
-    then show ?lhs by auto
-  next
-    assume "\<not> \<xi> \<Turnstile>\<^sub>n \<psi>"
-    then have phi_is: "\<xi> \<Turnstile>\<^sub>n \<phi>"
-      and "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<phi> U\<^sub>n \<psi>)" using rhs by auto
-    then obtain i
-          where psi_suc_is: "suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>"
-            and phi_suc_is: "\<forall>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
-    have sbgoal: "\<forall>j<(Suc i). suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-    proof(clarify)
-      fix j
-      assume j_less: "j<Suc i"
-      show "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-      proof (cases j)
-        assume "j=0"
-        then show ?thesis using phi_is by auto
-      next
-        fix k
-        assume "j=Suc k"
-        then show ?thesis using j_less phi_suc_is by auto
-      qed
-    qed
-    then show ?lhs using psi_suc_is phi_is by auto
-  qed
-qed
-
-lemma ltln_expand_Release:
-  "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<psi> and\<^sub>n (\<phi> or\<^sub>n (X\<^sub>n (\<phi> V\<^sub>n \<psi>))))" (is "?lhs = ?rhs")
-proof
-  assume lhs: ?lhs
-  then have psi_is: "\<xi> \<Turnstile>\<^sub>n \<psi>" by force
-
-  have "\<And>i. \<lbrakk>\<not> \<xi> \<Turnstile>\<^sub>n \<phi>; \<not> suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>\<rbrakk>
-            \<Longrightarrow> (\<exists>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>)"
-  proof -
-    fix i
-    assume phi_nis: "\<not> \<xi> \<Turnstile>\<^sub>n \<phi>"
-       and "\<not> suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>"
-    then obtain j
-          where "j<Suc i"
-            and "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" using lhs by auto
-    then have "j - 1 < i \<and> suffix (Suc (j - 1)) \<xi> \<Turnstile>\<^sub>n \<phi>"
-    using phi_nis by (cases j) auto
-    then show "\<exists>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
-  qed
-  then show ?rhs using psi_is by auto
-next
-  assume rhs: ?rhs
-  then have psi_is: "\<xi> \<Turnstile>\<^sub>n \<psi>" by auto
-
-  show ?lhs
-  proof(cases "\<xi> \<Turnstile>\<^sub>n \<phi>")
-    assume "\<xi> \<Turnstile>\<^sub>n \<phi>"
-    then show ?thesis using psi_is by force
-  next
-    assume phi_nis: "\<not> \<xi> \<Turnstile>\<^sub>n \<phi>"
-
-    then have "\<forall>i. suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>
-               \<or> (\<exists>j<Suc i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
-    using rhs by auto
-
-    have "\<And>i. \<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>
-              \<Longrightarrow> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
-    proof -
-      fix i
-      assume psi_suf_nis: "\<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
-      show "\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-      proof(cases "i")
-        assume "i=0"
-        with psi_suf_nis psi_is show ?thesis by auto
-      next
-        fix k
-        assume i_eq: "i=Suc k"
-        with psi_suf_nis rhs show ?thesis by force
-      qed
-    qed
-    then show ?thesis by auto
-  qed
-qed
-
-lemma ltln_Release_alterdef:
-  "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n (\<box>\<^sub>n \<psi>) or\<^sub>n (\<psi> U\<^sub>n (\<phi> and\<^sub>n \<psi>))" (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  { assume "\<not> (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi>)"
-    then obtain i where \<psi>_neq: "\<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
-    let ?k = "LEAST i. \<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
-    from \<psi>_neq \<open>?lhs\<close> have "\<forall>j<?k. suffix j \<xi> \<Turnstile>\<^sub>n \<psi>" by (metis not_less_Least)
-    moreover
-    have "\<not> suffix ?k \<xi> \<Turnstile>\<^sub>n \<psi>" by (rule LeastI, rule \<psi>_neq)
-    moreover then obtain j where "j<?k" and "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" using \<open>?lhs\<close> by auto
-    ultimately have "\<xi> \<Turnstile>\<^sub>n \<psi> U\<^sub>n (\<phi> and\<^sub>n \<psi>)" by auto }
-  with \<open>?lhs\<close> show ?rhs by auto
-next
-  assume ?rhs
-  { assume "\<not> \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<psi>"
-    with \<open>?rhs\<close> obtain i where "suffix i \<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
-    then have ?lhs by (auto, metis nat_neq_iff) }
-  then show ?lhs using \<open>?rhs\<close> by auto
-qed
-
-
-end
-end
diff --git a/thys/LTL_to_GBA/LTL_Rewrite.thy b/thys/LTL_to_GBA/LTL_Rewrite.thy
deleted file mode 100644
--- a/thys/LTL_to_GBA/LTL_Rewrite.thy
+++ /dev/null
@@ -1,666 +0,0 @@
-section \<open>Rewriting LTL formulas\<close>
-(* Author: Alexander Schimpf *)
-theory LTL_Rewrite
-imports
-  LTL
-begin
-
-context begin interpretation LTL_Syntax .
-
-inductive_set ltln_pure_eventual_frmls :: "'a ltln set"
-where
-  "\<diamond>\<^sub>n \<phi> \<in> ltln_pure_eventual_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_eventual_frmls; \<mu> \<in> ltln_pure_eventual_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> and\<^sub>n \<mu> \<in> ltln_pure_eventual_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_eventual_frmls; \<mu> \<in> ltln_pure_eventual_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> or\<^sub>n \<mu> \<in> ltln_pure_eventual_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_eventual_frmls; \<mu> \<in> ltln_pure_eventual_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> U\<^sub>n \<mu> \<in> ltln_pure_eventual_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_eventual_frmls; \<mu> \<in> ltln_pure_eventual_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> V\<^sub>n \<mu> \<in> ltln_pure_eventual_frmls"
-
-theorem ltln_pure_eventual_frmls_equiv:
-  assumes "\<psi> \<in> ltln_pure_eventual_frmls"
-  shows "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-  using assms
-proof (induct \<psi> arbitrary:\<xi> \<phi>)
-  case 1
-  then show ?case
-    by force
-next
-  case prems: 2 show ?case using prems(2)[of \<xi> \<phi>] prems(4)[of \<xi> \<phi>]
-    by (auto, metis less_nat_zero_code suffix_0)
-next
-  case prems: 3 show ?case
-    using prems(2)[of \<xi> \<phi>] prems(4)[of \<xi> \<phi>] by auto
-next
-  case prems: (4 \<nu> \<mu>)
-    let ?\<psi> = "\<nu> U\<^sub>n \<mu>"
-    { assume "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n ?\<psi>"
-      then obtain i where "suffix i \<xi> \<Turnstile>\<^sub>n ?\<psi>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-        by auto
-      moreover with prems(4)[of "suffix i \<xi>" \<nu>] have "suffix i \<xi> \<Turnstile>\<^sub>n \<mu>"
-        by blast
-      ultimately have "\<xi> \<Turnstile>\<^sub>n ?\<psi>" using prems(4)[of \<xi> \<phi>] prems(4)[of \<xi> \<nu>]
-        by auto }
-    moreover
-    { assume "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-      with prems have "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<mu>" by auto
-      then obtain i where "suffix i \<xi> \<Turnstile>\<^sub>n \<mu>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-        by auto
-      moreover with prems(4)[of "suffix i \<xi>" \<nu>] have "suffix i \<xi> \<Turnstile>\<^sub>n \<nu> U\<^sub>n \<mu>"
-        by blast
-      ultimately have "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n ?\<psi>" by auto }
-    ultimately show ?case by fast
-next
-  case prems: (5 \<nu> \<mu>)
-    let ?\<psi> = "\<nu> V\<^sub>n \<mu>"
-    { assume "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n ?\<psi>"
-      then obtain i where
-        V_suf_i: "suffix i \<xi> \<Turnstile>\<^sub>n \<nu> V\<^sub>n \<mu>"
-        and phi_all_less_i: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
-        unfolding ltln_Release_alterdef[symmetric] by auto
-      then have \<mu>_suf_i: "suffix i \<xi> \<Turnstile>\<^sub>n \<mu>"
-        by (metis ltln_expand_Release ltln_semantics.simps(5))
-      have \<mu>_less_i: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<mu>"
-      proof(clarify)
-        fix k
-        assume "k<i"
-        then have "suffix (i-k) (suffix k \<xi>) \<Turnstile>\<^sub>n \<mu>"
-          and "\<forall>j<i-k. suffix j (suffix k \<xi>) \<Turnstile>\<^sub>n \<phi>"
-        using V_suf_i phi_all_less_i \<mu>_suf_i by auto
-        then show "suffix k \<xi> \<Turnstile>\<^sub>n \<mu>" using prems(4)[of "suffix k \<xi>" \<phi>]
-          using ltln_semantics.simps(8) by blast
-      qed
-      have "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-      proof -
-        { fix i'
-          { assume "i' < i"
-            then have "suffix i' \<xi> \<Turnstile>\<^sub>n \<mu>" using \<mu>_less_i by auto }
-          moreover
-          { assume "i' \<ge> i"
-            then obtain i'' where i'_eq: "i' = i + i''" and "i'\<ge>i''"
-              by (metis Nat.diff_le_self le_add_diff_inverse2 add.commute)
-            then have "suffix i' \<xi> \<Turnstile>\<^sub>n \<mu> \<or> (\<exists>j<i'. suffix j \<xi> \<Turnstile>\<^sub>n \<nu>)"
-              using V_suf_i by auto }
-          ultimately have "suffix i' \<xi> \<Turnstile>\<^sub>n \<mu> \<or> (\<exists>j<i'. suffix j \<xi> \<Turnstile>\<^sub>n \<nu>)"
-            by (metis linorder_not_less) }
-        then show ?thesis by auto
-      qed }
-    moreover
-    { assume "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-      then have "suffix 0 \<xi> \<Turnstile>\<^sub>n ?\<psi> \<and> (\<forall>j<0. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)" by auto
-      then have "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n ?\<psi>" unfolding ltln_semantics.simps by blast }
-    ultimately show ?case by fast
-qed
-
-corollary ltln_pure_eventual_frmls_equiv_diamond:
-  assumes "\<psi> \<in> ltln_pure_eventual_frmls"
-  shows "\<xi> \<Turnstile>\<^sub>n \<diamond>\<^sub>n \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-by (rule ltln_pure_eventual_frmls_equiv[OF assms])
-
-
-inductive_set ltln_pure_universal_frmls :: "'a ltln set"
-where
-  "\<box>\<^sub>n \<phi> \<in> ltln_pure_universal_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_universal_frmls; \<mu> \<in> ltln_pure_universal_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> and\<^sub>n \<mu> \<in> ltln_pure_universal_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_universal_frmls; \<mu> \<in> ltln_pure_universal_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> or\<^sub>n \<mu> \<in> ltln_pure_universal_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_universal_frmls; \<mu> \<in> ltln_pure_universal_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> U\<^sub>n \<mu> \<in> ltln_pure_universal_frmls"
-| "\<lbrakk> \<nu> \<in> ltln_pure_universal_frmls; \<mu> \<in> ltln_pure_universal_frmls \<rbrakk>
-      \<Longrightarrow> \<nu> V\<^sub>n \<mu> \<in> ltln_pure_universal_frmls"
-
-theorem ltln_pure_universal_frmls_equiv:
-  assumes "\<psi> \<in> ltln_pure_universal_frmls"
-  shows "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-  using assms
-proof (induct \<psi> arbitrary:\<xi> \<phi>)
-  case 1
-  then show ?case by force
-next
-  case prems: 2
-  show ?case
-    using prems(2)[of \<xi> \<phi>] prems(4)[of \<xi> \<phi>] by auto
-next
-  case prems: 3 show ?case
-    using prems(2)[of \<xi> \<phi>] prems(4)[of \<xi> \<phi>]
-    by (auto, metis less_nat_zero_code suffix_0)
-next
-  case prems: (4 \<nu> \<mu>)
-    let ?\<psi> = "\<nu> U\<^sub>n \<mu>"
-    { assume assm: "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>"
-      { assume "\<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n ?\<psi>"
-        then have "suffix 0 \<xi> \<Turnstile>\<^sub>n ?\<psi>"
-          by (metis ltln_semantics.simps(9) ltln_semantics.simps(2))
-        then have "\<xi> \<Turnstile>\<^sub>n ?\<psi>" by auto }
-      moreover
-      { assume "\<not> \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n ?\<psi>"
-        then have  "\<xi> \<Turnstile>\<^sub>n ?\<psi> U\<^sub>n (\<phi> and\<^sub>n ?\<psi>)"
-          using assm ltln_Release_alterdef[of \<xi> \<phi> ?\<psi>]
-          by (metis ltln_semantics.simps(6))
-        then obtain i
-          where "suffix i \<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n ?\<psi>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n ?\<psi>"
-          by auto
-        then have "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-          by (cases "i=0") (metis suffix_0 ltln_semantics.simps(5)
-            neq0_conv suffix_0)+ }
-      ultimately have "\<xi> \<Turnstile>\<^sub>n ?\<psi>" by fast }
-    moreover
-    { assume "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-      then obtain i where
-        \<mu>_suf_i: "suffix i \<xi> \<Turnstile>\<^sub>n \<mu>"
-        and \<nu>_less_i: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<nu>"
-        by auto
-      with prems(4)[of "suffix i \<xi>"] \<mu>_suf_i
-      have "suffix i \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<mu> or\<^sub>n (\<mu> U\<^sub>n (\<phi> and\<^sub>n \<mu>))"
-        using ltln_Release_alterdef[of "suffix i \<xi>" \<phi> \<mu>] by blast
-      moreover
-      { assume "suffix i \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<mu>"
-        then have \<psi>_suf_i: "suffix i \<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>"
-          by auto (metis ac_simps ltln_expand_Until ltln_semantics.simps)
-        from \<nu>_less_i have \<psi>_less_i: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n ?\<psi>"
-        proof(clarify, goal_cases)
-          case (1 j)
-            then obtain j' where "i = j + j'" by (metis less_imp_add_positive)
-            then have "suffix j' (suffix j \<xi>) \<Turnstile>\<^sub>n \<mu>"
-              and "\<forall>k<j'. suffix k (suffix j \<xi>) \<Turnstile>\<^sub>n \<nu>"
-            using \<mu>_suf_i by auto (metis \<nu>_less_i \<open>i = j + j'\<close>
-              add_less_cancel_right add.commute)
-            then show ?case by auto
-        qed
-        have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>"
-        proof -
-          { fix k
-            { assume "k < i"
-              with \<psi>_less_i have "suffix k \<xi> \<Turnstile>\<^sub>n ?\<psi>" by auto }
-            moreover
-            { assume "k \<ge> i"
-              then obtain i' where "k = i + i'" by (metis le_iff_add)
-              with \<psi>_suf_i have "suffix k \<xi> \<Turnstile>\<^sub>n ?\<psi> \<or> (\<exists>j<k. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
-                by auto }
-            ultimately have "suffix k \<xi> \<Turnstile>\<^sub>n ?\<psi> \<or> (\<exists>j<k. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
-              by (metis linorder_not_less) }
-          then show ?thesis by auto
-        qed }
-      moreover
-      { assume "suffix i \<xi> \<Turnstile>\<^sub>n \<mu> U\<^sub>n (\<phi> and\<^sub>n \<mu>)"
-        then obtain k where "suffix (i+k) \<xi> \<Turnstile>\<^sub>n \<phi>"
-                        and "suffix (i+k) \<xi> \<Turnstile>\<^sub>n \<mu>"
-                        and "\<forall>j<k. suffix j (suffix i \<xi>) \<Turnstile>\<^sub>n \<mu>" by auto
-        then have "\<forall>j\<le>i+k. suffix j \<xi> \<Turnstile>\<^sub>n ?\<psi>"
-        proof(clarify, goal_cases)
-          case prems: (1 j)
-            { assume "j < i"
-              then obtain j' where "i = j + j'" by (metis less_imp_add_positive)
-              with \<mu>_suf_i \<nu>_less_i have ?case by auto }
-            moreover
-            { assume "j \<ge> i"
-              then obtain i' where "j = i + i'" by (metis le_iff_add)
-              with prems have ?case
-                by (auto, metis (full_types) add.comm_neutral add_Suc_right
-                  le_neq_implies_less less_nat_zero_code) }
-            ultimately show ?case by (metis less_or_eq_imp_le linorder_neqE_nat)
-        qed
-        with \<open>suffix (i+k) \<xi> \<Turnstile>\<^sub>n \<phi>\<close> have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>"
-          by (auto, metis linorder_not_less) }
-      ultimately have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>" by auto }
-    ultimately show ?case by fast
-next
-  case prems: (5 \<nu> \<mu>)
-    let ?\<psi> = "\<nu> V\<^sub>n \<mu>"
-    { assume "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>"
-      moreover
-      { assume "\<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n ?\<psi>"
-        then have "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-          by (metis prems(4) ltln_semantics.simps(2) ltln_semantics.simps(9)) }
-      moreover
-      { assume "\<xi> \<Turnstile>\<^sub>n ?\<psi> U\<^sub>n (\<phi> and\<^sub>n ?\<psi>)"
-        then obtain i where "suffix i \<xi> \<Turnstile>\<^sub>n ?\<psi>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n ?\<psi>"
-          by auto
-        then have "\<xi> \<Turnstile>\<^sub>n ?\<psi>" by (cases "i=0") (auto, metis suffix_0 suffix_suffix) }
-      ultimately have "\<xi> \<Turnstile>\<^sub>n ?\<psi>" using ltln_Release_alterdef[of \<xi> \<phi> ?\<psi>] by auto }
-    moreover
-    { assume "\<xi> \<Turnstile>\<^sub>n ?\<psi>"
-      { assume "\<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<mu>"
-        then have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>" by auto }
-      moreover
-      { assume assm: "\<not> \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<mu>"
-        then have "\<xi> \<Turnstile>\<^sub>n \<mu> U\<^sub>n (\<nu> and\<^sub>n \<mu>)"
-          using ltln_Release_alterdef[of \<xi> \<nu> \<mu>] \<open>\<xi> \<Turnstile>\<^sub>n ?\<psi>\<close> by auto
-        then have "\<xi> \<Turnstile>\<^sub>n \<mu>" using \<open>\<xi> \<Turnstile>\<^sub>n ?\<psi>\<close>  by (auto, metis calculation(1) prems(4))
-        with prems(4)[of \<xi> \<phi>] have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<mu>" by auto
-        then have "\<xi> \<Turnstile>\<^sub>n \<mu> U\<^sub>n (\<phi> and\<^sub>n \<mu>)"
-          using assm ltln_Release_alterdef[of \<xi> \<phi> \<mu>] by auto
-        then obtain i
-          where "suffix i \<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<mu>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<mu>"
-          by auto
-        moreover then have "\<forall>j\<le>i. suffix j \<xi> \<Turnstile>\<^sub>n \<nu> V\<^sub>n \<mu>"
-          by (metis \<open>\<xi> \<Turnstile>\<^sub>n \<mu>\<close> assm prems(4))
-        ultimately have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>" by (auto, metis linorder_not_le) }
-      ultimately have "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n ?\<psi>" by fast }
-    ultimately show ?case by fast
-qed
-
-
-text\<open>Some simple rewrite rules\<close>
-
-fun ltln_rewrite_step :: "'a ltln \<Rightarrow> 'a ltln"
-where
-  "ltln_rewrite_step (_ U\<^sub>n true\<^sub>n) = true\<^sub>n"
-| "ltln_rewrite_step (_ V\<^sub>n false\<^sub>n) = false\<^sub>n"
-| "ltln_rewrite_step (true\<^sub>n U\<^sub>n (_ U\<^sub>n \<mu>)) = true\<^sub>n U\<^sub>n \<mu>"
-| "ltln_rewrite_step (false\<^sub>n V\<^sub>n (_ V\<^sub>n \<mu>)) = false\<^sub>n V\<^sub>n \<mu>"
-| "ltln_rewrite_step \<psi> = (case \<psi> of
-    \<phi> U\<^sub>n \<phi>' \<Rightarrow>
-      if \<phi> = \<phi>' then \<phi>
-      else if \<phi>' \<in> ltln_pure_eventual_frmls then \<phi>'
-      else \<psi>
-  | \<phi> V\<^sub>n \<phi>' \<Rightarrow>
-      if \<phi> = \<phi>' then \<phi>
-      else if \<phi>' \<in> ltln_pure_universal_frmls then \<phi>'
-      else \<psi>
-  | (\<phi> U\<^sub>n \<mu>) and\<^sub>n (\<nu> U\<^sub>n \<mu>') \<Rightarrow> if \<mu> = \<mu>' then (\<phi> and\<^sub>n \<nu>) U\<^sub>n \<mu> else \<psi>
-  | (\<phi> U\<^sub>n \<nu>) or\<^sub>n (\<phi>' U\<^sub>n \<mu>) \<Rightarrow> if \<phi> = \<phi>' then \<phi> U\<^sub>n (\<nu> or\<^sub>n \<mu>) else \<psi>
-  | (\<phi> V\<^sub>n \<nu>) and\<^sub>n (\<phi>' V\<^sub>n \<mu>) \<Rightarrow> if \<phi> = \<phi>' then \<phi> V\<^sub>n (\<nu> and\<^sub>n \<mu>) else \<psi>
-  | (\<phi> V\<^sub>n \<mu>) or\<^sub>n (\<nu> V\<^sub>n \<mu>') \<Rightarrow> if \<mu> = \<mu>' then (\<phi> or\<^sub>n \<nu>) V\<^sub>n \<mu> else \<psi>
-  | _ \<Rightarrow> \<psi>) "
-
-lemma ltln_rewrite_step__size_less:
-  assumes "ltln_rewrite_step \<psi> \<noteq> \<psi>"
-  shows "size (ltln_rewrite_step \<psi>) < size \<psi>"
-proof (cases \<psi>)
-  case (LTLnUntil \<nu> \<mu>)
-  with assms show ?thesis
-    by (cases \<mu>, cases \<nu>) (auto split:ltln.split,
-      metis+, cases \<nu>, auto split:ltln.split, metis+)
-next
-  case (LTLnRelease \<nu> \<mu>)
-  with assms show ?thesis
-    by (cases \<mu>, cases \<nu>) (auto split:ltln.split,
-      metis+, cases \<nu>, auto split:ltln.split, metis+)
-qed (insert assms, auto split:ltln.split)
-
-lemma ltln_rewrite_step__size_leq:
-  "size (ltln_rewrite_step \<psi>) \<le> size \<psi>"
-  using ltln_rewrite_step__size_less[of \<psi>]
-  by (cases "ltln_rewrite_step \<psi> = \<psi>") auto
-
-
-theorem ltln_rewrite_step__equiv:
-  "\<xi> \<Turnstile>\<^sub>n ltln_rewrite_step \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-proof (cases \<psi>)
-  case \<psi>: (LTLnAnd \<nu> \<mu>)
-  show ?thesis
-  proof (cases \<nu>)
-    case \<nu>: LTLnUntil
-    show ?thesis
-    proof (cases \<mu>)
-      case \<mu>: LTLnUntil
-      with \<psi> \<nu> \<mu> show ?thesis by (auto, metis nat_neq_iff order_less_trans)
-    qed (insert \<psi> \<nu>, auto)
-  qed (insert \<psi>, auto split:ltln.split)
-next
-  case \<psi>: (LTLnOr \<nu> \<mu>)
-  show ?thesis
-  proof (cases \<nu>)
-    case \<nu>: LTLnRelease
-    show ?thesis
-    proof (cases \<mu>)
-      case LTLnRelease
-      with \<psi> \<nu> show ?thesis by (auto, metis nat_neq_iff order_less_trans)
-    qed (insert \<psi> \<nu>, auto)
-  qed (insert \<psi>, auto split:ltln.split)
-next
-  case \<psi>: (LTLnUntil \<nu> \<mu>)
-  show ?thesis
-  proof(cases "\<mu> \<noteq> true\<^sub>n \<and> \<not> (\<nu> = true\<^sub>n \<and> (\<exists>\<nu>' \<mu>'. \<mu> = \<nu>' U\<^sub>n \<mu>')) \<and> \<nu> \<noteq> \<mu>")
-    case True
-      with \<psi> have "\<xi> \<Turnstile>\<^sub>n (if \<mu> \<in> ltln_pure_eventual_frmls then \<mu> else \<psi>) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-      using ltln_pure_eventual_frmls_equiv by auto
-      with \<psi> True show ?thesis by (cases \<mu>) (cases \<nu>, auto split:ltln.split)+
-  next
-    case False
-    with \<psi> show ?thesis
-      by (cases \<mu>, auto split:ltln.split) (metis less_nat_zero_code neq0_conv
-        suffix_0 add.comm_neutral add_0)+
-  qed
-next
-  case \<psi>: (LTLnRelease \<nu> \<mu>)
-  show ?thesis
-  proof(cases "\<mu> \<noteq> false\<^sub>n \<and> \<not> (\<nu> = false\<^sub>n \<and> (\<exists>\<nu>' \<mu>'. \<mu> = \<nu>' V\<^sub>n \<mu>')) \<and> \<nu> \<noteq> \<mu>")
-    case True
-      with \<psi> have "\<xi> \<Turnstile>\<^sub>n (if \<mu> \<in> ltln_pure_universal_frmls then \<mu> else \<psi>) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-      using ltln_pure_universal_frmls_equiv by auto
-      with \<psi> True show ?thesis by (cases \<mu>) (cases \<nu>, auto split:ltln.split)+
-  next
-    case False
-    with \<psi> show ?thesis
-      by (cases \<mu>, auto split:ltln.split) (metis less_nat_zero_code neq0_conv
-        suffix_0 add.comm_neutral add_0)+
-  qed
-qed (auto split:ltln.split)
-
-function ltln_rewrite_rec
-where
-  "ltln_rewrite_rec \<psi> = (case ltln_rewrite_step \<psi> of
-    \<nu> and\<^sub>n \<mu> \<Rightarrow> (ltln_rewrite_rec \<nu>) and\<^sub>n (ltln_rewrite_rec \<mu>)
-  | \<nu> or\<^sub>n \<mu> \<Rightarrow> (ltln_rewrite_rec \<nu>) or\<^sub>n (ltln_rewrite_rec \<mu>)
-  | X\<^sub>n \<nu> \<Rightarrow> X\<^sub>n (ltln_rewrite_rec \<nu>)
-  | \<nu> U\<^sub>n \<mu> \<Rightarrow> (ltln_rewrite_rec \<nu>) U\<^sub>n (ltln_rewrite_rec \<mu>)
-  | \<nu> V\<^sub>n \<mu> \<Rightarrow> (ltln_rewrite_rec \<nu>) V\<^sub>n (ltln_rewrite_rec \<mu>)
-  | \<phi> \<Rightarrow> \<phi>)"
-by pat_completeness auto
-termination proof -
-  {
-    fix \<psi> \<phi> :: "'a ltln" and thesis
-    assume "ltln_rewrite_step \<psi> = \<phi>"
-    thm ltln_rewrite_step__size_leq
-    moreover assume "\<lbrakk>ltln_rewrite_step \<psi> = \<phi>;
-      size (local.ltln_rewrite_step \<psi>) \<le> size \<psi>\<rbrakk> \<Longrightarrow> thesis"
-    ultimately have thesis using ltln_rewrite_step__size_leq[of \<psi>]
-      by blast
-  } note AUX=this
-  show ?thesis
-    apply (relation "inv_image less_than size")
-    apply simp_all
-    apply (erule AUX, simp)+
-    done
-qed
-
-declare ltln_rewrite_rec.simps [simp del]
-
-lemma ltln_rewrite_rec__size_less:
-  assumes "ltln_rewrite_rec \<psi> \<noteq> \<psi>"
-  shows "size (ltln_rewrite_rec \<psi>) < size \<psi>"
-  using assms
-proof (induct "ltln_rewrite_rec \<psi>" arbitrary: \<psi>)
-  case LTLnTrue
-  then show ?case
-    using ltln_rewrite_step__size_less[of \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnFalse
-  then show ?case
-    using ltln_rewrite_step__size_less[of \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnProp
-  then show ?case
-    using ltln_rewrite_step__size_less[of \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnNProp
-  then show ?case
-    using ltln_rewrite_step__size_less[of \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case (LTLnAnd \<nu> \<mu>)
-  show ?case
-  proof (cases "ltln_rewrite_step \<psi>")
-    case \<psi>: (LTLnAnd \<nu>' \<mu>')
-    show ?thesis
-      using LTLnAnd ltln_rewrite_step__size_less[of \<psi>]
-      unfolding \<psi> ltln_rewrite_rec.simps[of \<psi>]
-      by (cases "\<nu>' and\<^sub>n \<mu>' = \<psi>") fastforce+
-  qed (insert LTLnAnd, auto simp add: ltln_rewrite_rec.simps[of \<psi>])
-next
-  case (LTLnOr \<nu> \<mu>)
-  show ?case
-  proof (cases "ltln_rewrite_step \<psi>")
-    case \<psi>: (LTLnOr \<nu>' \<mu>')
-    show ?thesis
-      using LTLnOr ltln_rewrite_step__size_less[of \<psi>]
-      unfolding \<psi> ltln_rewrite_rec.simps[of \<psi>]
-      by (cases "\<nu>' or\<^sub>n \<mu>' = \<psi>") fastforce+
-  qed (insert LTLnOr, auto simp add: ltln_rewrite_rec.simps[of \<psi>])
-next
-  case (LTLnNext \<nu>)
-  show ?case
-  proof (cases "ltln_rewrite_step \<psi>")
-    case \<psi>: (LTLnNext \<nu>')
-    show ?thesis
-      using LTLnNext ltln_rewrite_step__size_less[of \<psi>]
-      unfolding \<psi> ltln_rewrite_rec.simps[of \<psi>]
-      by (cases "X\<^sub>n \<nu>' = \<psi>") fastforce+
-  qed (insert LTLnNext, auto simp add: ltln_rewrite_rec.simps[of \<psi>])
-next
-  case (LTLnUntil \<nu> \<mu>)
-  show ?case
-  proof (cases "ltln_rewrite_step \<psi>")
-    case \<psi>: (LTLnUntil \<nu>' \<mu>')
-    show ?thesis
-      using LTLnUntil ltln_rewrite_step__size_less[of \<psi>]
-      unfolding \<psi> ltln_rewrite_rec.simps[of \<psi>]
-      by (cases "\<nu>' U\<^sub>n \<mu>' = \<psi>") fastforce+
-  qed (insert LTLnUntil, auto simp add: ltln_rewrite_rec.simps[of \<psi>])
-next
-  case (LTLnRelease \<nu> \<mu>)
-  show ?case
-  proof (cases "ltln_rewrite_step \<psi>")
-    case \<psi>: (LTLnRelease \<nu>' \<mu>')
-    show ?thesis
-      using LTLnRelease ltln_rewrite_step__size_less[of \<psi>]
-      unfolding \<psi> ltln_rewrite_rec.simps[of \<psi>]
-      by (cases "\<nu>' V\<^sub>n \<mu>' = \<psi>") fastforce+
-  qed (insert LTLnRelease, auto simp add: ltln_rewrite_rec.simps[of \<psi>])
-qed
-
-lemma ltln_rewrite_rec__size_leq:
-  "size (ltln_rewrite_rec \<psi>) \<le> size \<psi>"
-using ltln_rewrite_rec__size_less[of \<psi>] by (cases "ltln_rewrite_rec \<psi> = \<psi>") auto
-
-
-theorem ltln_rewrite_rec__equiv: "\<xi> \<Turnstile>\<^sub>n ltln_rewrite_rec \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-proof (induct "ltln_rewrite_rec \<psi>" arbitrary: \<xi> \<psi>)
-  case LTLnTrue
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnFalse
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnProp
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnNProp
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnAnd
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnOr
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnNext
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnUntil
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-next
-  case LTLnRelease
-  then show ?case
-    using ltln_rewrite_step__equiv[of _ \<psi>] ltln_rewrite_rec.simps[of \<psi>]
-    by (cases "ltln_rewrite_step \<psi>") auto
-qed
-
-
-function ltln_rewrite
-where
-  "ltln_rewrite \<psi> =
-    (let \<phi> = ltln_rewrite_rec \<psi>
-     in if \<phi> \<noteq> \<psi> then ltln_rewrite \<phi> else \<psi>)"
-by pat_completeness auto
-
-termination
-proof (relation "inv_image less_than size", goal_cases)
-  case 1
-  show ?case by auto
-next
-  case (2 \<psi>)
-  then show ?case
-    using ltln_rewrite_rec__size_less[of \<psi>] by auto
-qed
-
-declare ltln_rewrite.simps [simp del]
-
-
-lemma ltln_rewrite__size_less:
-  assumes "ltln_rewrite \<psi> \<noteq> \<psi>"
-  shows "size (ltln_rewrite \<psi>) < size \<psi>"
-  using assms
-proof (induct \<psi> rule: ltln_rewrite.induct)
-  case prems: (1 \<psi>)
-  show ?case
-  proof (cases "ltln_rewrite_rec \<psi> = \<psi>")
-    case True
-    then show ?thesis
-      using prems(2) unfolding ltln_rewrite.simps[of \<psi>] by auto
-  next
-    case False
-    then have rw_\<psi>_eq: "ltln_rewrite \<psi> = ltln_rewrite (ltln_rewrite_rec \<psi>)"
-      unfolding ltln_rewrite.simps[of \<psi>] by auto
-    from prems(1)[OF refl False, folded rw_\<psi>_eq]
-      and ltln_rewrite_rec__size_less[OF False]
-    show ?thesis
-      by (cases "ltln_rewrite \<psi> = ltln_rewrite_rec \<psi>") auto
-  qed
-qed
-
-lemma ltln_rewrite__size_leq: "size (ltln_rewrite \<psi>) \<le> size \<psi>"
-  using ltln_rewrite__size_less[of \<psi>] by (cases "ltln_rewrite \<psi> = \<psi>") auto
-
-
-lemma ltln_rewrite__equiv: "\<xi> \<Turnstile>\<^sub>n ltln_rewrite \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<psi>"
-proof (induct \<psi> rule: ltln_rewrite.induct)
-  case prems: (1 \<psi>)
-    show ?case
-      using prems[OF refl] ltln_rewrite_rec__equiv[of \<xi> \<psi>]
-      unfolding ltln_rewrite.simps[of \<psi>]
-      by (cases "ltln_rewrite_rec \<psi> = \<psi>") auto
-qed
-
-
-fun ltln_pure_eventual_frmls_impl
-where
-  "ltln_pure_eventual_frmls_impl (\<diamond>\<^sub>n \<phi>) = True"
-| "ltln_pure_eventual_frmls_impl (\<nu> and\<^sub>n \<mu>)
-  = (ltln_pure_eventual_frmls_impl \<nu> \<and> ltln_pure_eventual_frmls_impl \<mu>)"
-| "ltln_pure_eventual_frmls_impl (\<nu> or\<^sub>n \<mu>)
-  = (ltln_pure_eventual_frmls_impl \<nu> \<and> ltln_pure_eventual_frmls_impl \<mu>)"
-| "ltln_pure_eventual_frmls_impl (\<nu> U\<^sub>n \<mu>)
-  = (ltln_pure_eventual_frmls_impl \<nu> \<and> ltln_pure_eventual_frmls_impl \<mu>)"
-| "ltln_pure_eventual_frmls_impl (\<nu> V\<^sub>n \<mu>)
-  = (ltln_pure_eventual_frmls_impl \<nu> \<and> ltln_pure_eventual_frmls_impl \<mu>)"
-| "ltln_pure_eventual_frmls_impl _ = False"
-
-lemma ltln_pure_eventual_frmls_unfold[code_unfold]:
-  "\<phi> \<in> ltln_pure_eventual_frmls \<longleftrightarrow> ltln_pure_eventual_frmls_impl \<phi>"
-  (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  then show ?rhs
-  proof (induct rule: ltln_pure_eventual_frmls.induct)
-    case (4 \<nu>)
-    then show ?case by (cases "\<nu> = true\<^sub>n") (cases \<nu>, auto)+
-  qed auto
-next
-  assume ?rhs
-  then show ?lhs
-  proof (induct \<phi>)
-    case (LTLnUntil \<nu> \<mu>)
-    then show ?case
-      by (cases "\<nu> = true\<^sub>n") (cases \<nu>,
-        auto intro: ltln_pure_eventual_frmls.intros)+
-  qed (auto intro: ltln_pure_eventual_frmls.intros)
-qed
-
-fun ltln_pure_universal_frmls_impl
-where
-  "ltln_pure_universal_frmls_impl (\<box>\<^sub>n \<phi>) = True"
-| "ltln_pure_universal_frmls_impl (\<nu> and\<^sub>n \<mu>)
-  = (ltln_pure_universal_frmls_impl \<nu> \<and> ltln_pure_universal_frmls_impl \<mu>)"
-| "ltln_pure_universal_frmls_impl (\<nu> or\<^sub>n \<mu>)
-  = (ltln_pure_universal_frmls_impl \<nu> \<and> ltln_pure_universal_frmls_impl \<mu>)"
-| "ltln_pure_universal_frmls_impl (\<nu> U\<^sub>n \<mu>)
-  = (ltln_pure_universal_frmls_impl \<nu> \<and> ltln_pure_universal_frmls_impl \<mu>)"
-| "ltln_pure_universal_frmls_impl (\<nu> V\<^sub>n \<mu>)
-  = (ltln_pure_universal_frmls_impl \<nu> \<and> ltln_pure_universal_frmls_impl \<mu>)"
-| "ltln_pure_universal_frmls_impl _ = False"
-
-lemma ltln_pure_universal_frmls_unfold[code_unfold]:
-  "\<phi> \<in> ltln_pure_universal_frmls \<longleftrightarrow> ltln_pure_universal_frmls_impl \<phi>"
-  (is "?lhs = ?rhs")
-proof
-  assume ?lhs
-  then show ?rhs
-  proof (induct rule: ltln_pure_universal_frmls.induct)
-    case (5 \<nu>)
-    then show ?case by (cases "\<nu> = false\<^sub>n") (cases \<nu>, auto)+
-  qed auto
-next
-  assume ?rhs
-  then show ?lhs
-  proof (induct \<phi>)
-    case (LTLnRelease \<nu> \<mu>)
-    then show ?case
-      by (cases "\<nu> = false\<^sub>n") (cases \<nu>, auto intro: ltln_pure_universal_frmls.intros)+
-  qed (auto intro: ltln_pure_universal_frmls.intros)
-qed
-
-definition
-  "ltln_rewrite_step_impl \<psi> \<equiv> case \<psi> of
-    \<nu> U\<^sub>n \<mu> \<Rightarrow> if \<mu> = true\<^sub>n then true\<^sub>n
-              else (
-                case (\<nu>, \<mu>) of
-                  (true\<^sub>n, _ U\<^sub>n \<mu>') \<Rightarrow> true\<^sub>n U\<^sub>n \<mu>'
-                | _ \<Rightarrow> if \<nu> = \<mu> then \<nu>
-                       else if \<mu>\<in>ltln_pure_eventual_frmls then \<mu>
-                       else \<psi>)
-  | \<nu> V\<^sub>n \<mu> \<Rightarrow> if \<mu> = false\<^sub>n then false\<^sub>n
-              else (
-                case (\<nu>, \<mu>) of
-                  (false\<^sub>n, _ V\<^sub>n \<mu>') \<Rightarrow> false\<^sub>n V\<^sub>n \<mu>'
-                | _ \<Rightarrow> if \<nu> = \<mu> then \<nu>
-                       else if \<mu>\<in>ltln_pure_universal_frmls then \<mu>
-                       else \<psi>)
-  | \<psi>1 and\<^sub>n \<psi>2 \<Rightarrow> (
-      case (\<psi>1, \<psi>2) of
-        (\<phi> U\<^sub>n \<mu>, \<nu> U\<^sub>n \<mu>') \<Rightarrow> if \<mu> = \<mu>' then (\<phi> and\<^sub>n \<nu>) U\<^sub>n \<mu> else \<psi>
-      | (\<phi> V\<^sub>n \<nu>, \<phi>' V\<^sub>n \<mu>) \<Rightarrow> if \<phi> = \<phi>' then \<phi> V\<^sub>n (\<nu> and\<^sub>n \<mu>) else \<psi>
-      | _ \<Rightarrow> \<psi>)
-  | \<psi>1 or\<^sub>n \<psi>2 \<Rightarrow> (
-      case (\<psi>1, \<psi>2) of
-        (\<phi> U\<^sub>n \<nu>, \<phi>' U\<^sub>n \<mu>) \<Rightarrow> if \<phi> = \<phi>' then \<phi> U\<^sub>n (\<nu> or\<^sub>n \<mu>) else \<psi>
-      | (\<phi> V\<^sub>n \<mu>, \<nu> V\<^sub>n \<mu>') \<Rightarrow> if \<mu> = \<mu>' then (\<phi> or\<^sub>n \<nu>) V\<^sub>n \<mu> else \<psi>
-      | _ \<Rightarrow> \<psi>)
-  | _ \<Rightarrow> \<psi>"
-
-lemma ltln_rewrite_step_unfold[code_unfold]:
-  "ltln_rewrite_step = ltln_rewrite_step_impl"
-proof -
-  { fix \<psi> :: "'a ltln"
-    have "ltln_rewrite_step \<psi> = ltln_rewrite_step_impl \<psi>"
-    unfolding ltln_rewrite_step_impl_def by (cases \<psi>) (auto split:ltln.split) }
-  then show ?thesis by auto
-qed
-
-end
-
-end
diff --git a/thys/LTL_to_GBA/LTL_Stutter.thy b/thys/LTL_to_GBA/LTL_Stutter.thy
--- a/thys/LTL_to_GBA/LTL_Stutter.thy
+++ b/thys/LTL_to_GBA/LTL_Stutter.thy
@@ -1,114 +1,53 @@
 section \<open>Stutter Invariance of next-free LTL Formula\<close>
-theory LTL_Stutter
-imports LTL "../Stuttering_Equivalence/PLTL"
-begin
-  text \<open>This theory builds on the AFP-entry by Stephan Merz\<close>
-
-  text \<open>Get rid of overlapping notation\<close>
-  no_notation PLTL.holds_of ("_ \<Turnstile> _" [70,70] 40)
-
-  hide_const (open) PLTL.false PLTL.atom PLTL.implies PLTL.next PLTL.until
-  hide_const (open) PLTL.not PLTL.true PLTL.or PLTL.and 
-  hide_const (open) PLTL.eventually PLTL.always
-
-  no_notation Samplers.suffix ("_[_ ..]" [80, 15] 80)
-  hide_const (open) Samplers.suffix
-  hide_fact (open) Samplers.suffix_def
-
-  lemma PLTL_suffix_cnv[simp]: "Samplers.suffix = (\<lambda>w i. suffix i w)"
-    apply (intro ext)
-    unfolding Samplers.suffix_def Omega_Words_Fun.suffix_def ..
-
-  hide_const (open) PLTL.next_free
-
-  primrec ltl_next_free :: "'a ltl \<Rightarrow> bool" where
-    "ltl_next_free LTLTrue \<longleftrightarrow> True"
-  | "ltl_next_free LTLFalse \<longleftrightarrow> True"
-  | "ltl_next_free (LTLProp _) \<longleftrightarrow> True"
-  | "ltl_next_free (LTLNeg \<phi>) \<longleftrightarrow> ltl_next_free \<phi>"
-  | "ltl_next_free (LTLAnd \<phi> \<psi>) \<longleftrightarrow> ltl_next_free \<phi> \<and> ltl_next_free \<psi>"
-  | "ltl_next_free (LTLOr \<phi> \<psi>) \<longleftrightarrow> ltl_next_free \<phi> \<and> ltl_next_free \<psi>"
-  | "ltl_next_free (LTLNext _) \<longleftrightarrow> False"
-  | "ltl_next_free (LTLUntil \<phi> \<psi>) \<longleftrightarrow> ltl_next_free \<phi> \<and> ltl_next_free \<psi>"
-  | "ltl_next_free (LTLRelease \<phi> \<psi>) \<longleftrightarrow> ltl_next_free \<phi> \<and> ltl_next_free \<psi>"
-
-  text \<open>Conversion between the two LTL formalizations\<close>
-
-  primrec cnv :: "'a LTL.ltl \<Rightarrow> 'a set PLTL.pltl" where
-    "cnv LTLTrue = PLTL.true"
-  | "cnv LTLFalse = PLTL.false"
-  | "cnv (LTLProp a) = PLTL.atom (op \<in> a)"
-  | "cnv (LTLNeg \<phi>) = PLTL.not (cnv \<phi>)"
-  | "cnv (LTLAnd \<phi> \<psi>) = PLTL.and (cnv \<phi>) (cnv \<psi>)"
-  | "cnv (LTLOr \<phi> \<psi>) = PLTL.or (cnv \<phi>) (cnv \<psi>)"
-  | "cnv (LTLNext \<phi>) = PLTL.next (cnv \<phi>)"
-  | "cnv (LTLUntil \<phi> \<psi>) = PLTL.until (cnv \<phi>) (cnv \<psi>)"
-  | "cnv (LTLRelease \<phi> \<psi>) 
-    = PLTL.not (PLTL.until (PLTL.not (cnv \<phi>)) (PLTL.not (cnv \<psi>)))"
-
-  lemma PLTL_holds_of_cnv[simp]: "PLTL.holds_of r (cnv \<phi>) \<longleftrightarrow> ltl_semantics r \<phi>"
-    by (induction \<phi> arbitrary: r) simp_all
-
-  lemma PLTL_next_free_cnv[simp]: "PLTL.next_free (cnv \<phi>) \<longleftrightarrow> ltl_next_free \<phi>"
-    by (induction \<phi>) auto
-
 
-  theorem next_free_stutter_invariant: 
-    assumes next_free: "ltl_next_free \<phi>"
-    assumes eq: "r \<approx> r'"
-    shows "r \<Turnstile> \<phi> \<longleftrightarrow> r' \<Turnstile> \<phi>"
-    -- \<open>A next free formula cannot distinguish between 
-      stutter-equivalent runs.\<close>
-  proof -
-    {
-      fix r r'
-      assume eq: "r \<approx> r'" and holds: "r \<Turnstile> \<phi>"
-      then have "holds_of r (cnv \<phi>)" by simp
-      
-      from next_free_stutter_invariant[of "cnv \<phi>"] next_free 
-      have "PLTL.stutter_invariant (cnv \<phi>)" by simp
-      from stutter_invariantD[OF this eq] holds have "r' \<Turnstile> \<phi>" by simp
-    } note aux=this
-    
-    from aux[of r r'] aux[of r' r] eq stutter_equiv_sym[OF eq] show ?thesis
-      by blast
-  qed
-
+theory LTL_Stutter
+  imports "../../../afp/LTL/LTL" "../Stuttering_Equivalence/PLTL"
+begin
 
-  context begin interpretation LTL_Syntax .
-    primrec ltlc_next_free :: "'a ltlc \<Rightarrow> bool"
-    where
-      "ltlc_next_free true\<^sub>c = True"
-    | "ltlc_next_free false\<^sub>c = True"
-    | "ltlc_next_free (prop\<^sub>c(q)) = True"
-    | "ltlc_next_free (not\<^sub>c \<phi>) = ltlc_next_free \<phi>"
-    | "ltlc_next_free (\<phi> and\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-    | "ltlc_next_free (\<phi> or\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-    | "ltlc_next_free (\<phi> implies\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-    | "ltlc_next_free (\<phi> iff\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-    | "ltlc_next_free (X\<^sub>c \<phi>) = False"
-    | "ltlc_next_free (F\<^sub>c \<phi>) = ltlc_next_free \<phi>"
-    | "ltlc_next_free (G\<^sub>c \<phi>) = ltlc_next_free \<phi>"
-    | "ltlc_next_free (\<phi> U\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-    | "ltlc_next_free (\<phi> V\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
-  end
+text \<open>This theory builds on the AFP-entry by Stephan Merz\<close>
 
-  lemma ltlc_to_ltl_next_free_iff: 
-    "ltl_next_free (ltlc_to_ltl \<phi>) \<longleftrightarrow> ltlc_next_free \<phi>"
-    by (induction \<phi>) (auto simp: Let_def)
-
+text \<open>Get rid of overlapping notation\<close>
 
-  theorem ltlc_next_free_stutter_invariant: 
-    assumes next_free: "ltlc_next_free \<phi>"
-    assumes eq: "r \<approx> r'"
-    shows "r \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> r' \<Turnstile>\<^sub>c \<phi>"
-    -- \<open>A next free formula cannot distinguish between 
-      stutter-equivalent runs.\<close>
-  proof -
-    note NF' = next_free[folded ltlc_to_ltl_next_free_iff]
-    from next_free_stutter_invariant[OF NF' eq] show ?thesis
-      by (auto simp: ltlc_to_ltl_equiv)
-  qed
+primrec ltlc_next_free :: "'a ltlc \<Rightarrow> bool"
+  where
+    "ltlc_next_free true\<^sub>c = True"
+  | "ltlc_next_free false\<^sub>c = True"
+  | "ltlc_next_free (prop\<^sub>c(q)) = True"
+  | "ltlc_next_free (not\<^sub>c \<phi>) = ltlc_next_free \<phi>"
+  | "ltlc_next_free (\<phi> and\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
+  | "ltlc_next_free (\<phi> or\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
+  | "ltlc_next_free (\<phi> implies\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
+  | "ltlc_next_free (X\<^sub>c \<phi>) = False"
+  | "ltlc_next_free (F\<^sub>c \<phi>) = ltlc_next_free \<phi>"
+  | "ltlc_next_free (G\<^sub>c \<phi>) = ltlc_next_free \<phi>"
+  | "ltlc_next_free (\<phi> U\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
+  | "ltlc_next_free (\<phi> V\<^sub>c \<psi>) = (ltlc_next_free \<phi> \<and> ltlc_next_free \<psi>)"
+
+text \<open>Conversion between the two LTL formalizations\<close>
+
+lemma PLTL_next_free_cnv[simp]: "PLTL.next_free (ltlc_to_pltl \<phi>) \<longleftrightarrow> ltlc_next_free \<phi>"
+  by (induction \<phi>) auto
+
+theorem next_free_stutter_invariant: 
+  assumes next_free: "ltlc_next_free \<phi>"
+  assumes eq: "r \<approx> r'"
+  shows "r \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> r' \<Turnstile>\<^sub>c \<phi>"
+  -- \<open>A next free formula cannot distinguish between 
+    stutter-equivalent runs.\<close>
+proof -
+  {
+    fix r r'
+    assume eq: "r \<approx> r'" and holds: "r \<Turnstile>\<^sub>c \<phi>"
+    then have "r \<Turnstile>\<^sub>p (ltlc_to_pltl \<phi>)"by simp
+    
+    from next_free_stutter_invariant[of "ltlc_to_pltl \<phi>"] next_free 
+    have "PLTL.stutter_invariant (ltlc_to_pltl \<phi>)" by simp
+    from stutter_invariantD[OF this eq] holds have "r' \<Turnstile>\<^sub>c \<phi>" by simp
+  } note aux=this
+  
+  from aux[of r r'] aux[of r' r] eq stutter_equiv_sym[OF eq] show ?thesis
+    by blast
+qed
 
 end
 
diff --git a/thys/LTL_to_GBA/LTL_to_GBA.thy b/thys/LTL_to_GBA/LTL_to_GBA.thy
--- a/thys/LTL_to_GBA/LTL_to_GBA.thy
+++ b/thys/LTL_to_GBA/LTL_to_GBA.thy
@@ -1,3235 +1,3231 @@
 section \<open>LTL to GBA translation\<close>
 (*
   Author: Alexander Schimpf
     Modified by Peter Lammich
 
 **)
 theory LTL_to_GBA
 imports
   "../CAVA_Automata/CAVA_Base/CAVA_Base"
-  LTL LTL_Rewrite
+  "../../../afp/LTL/LTL" "../../../afp/LTL/LTL_Rewrite"
   "../CAVA_Automata/Automata"
 begin
 
 subsection \<open>Statistics\<close>
 code_printing
   code_module Gerth_Statistics \<rightharpoonup> (SML) \<open>
     structure Gerth_Statistics = struct
       val active = Unsynchronized.ref false
       val data = Unsynchronized.ref (0,0,0)
 
       fun is_active () = !active
       fun set_data num_states num_init num_acc = (
         active := true;
         data := (num_states, num_init, num_acc)
       )
 
       fun to_string () = let
         val (num_states, num_init, num_acc) = !data
       in
           "Num states: " ^ IntInf.toString (num_states) ^ "\n"
         ^ "  Num initial: " ^ IntInf.toString num_init ^ "\n"
         ^ "  Num acc-classes: " ^ IntInf.toString num_acc ^ "\n"
       end
 
       val _ = Statistics.register_stat ("Gerth LTL_to_GBA",is_active,to_string)
     end
 \<close>
 code_reserved SML Gerth_Statistics
 
 consts
   stat_set_data_int :: "integer \<Rightarrow> integer \<Rightarrow> integer \<Rightarrow> unit"
 
 code_printing
   constant stat_set_data_int \<rightharpoonup> (SML) "Gerth'_Statistics.set'_data"
 
 definition "stat_set_data ns ni na
   \<equiv> stat_set_data_int (integer_of_nat ns) (integer_of_nat ni) (integer_of_nat na)"
 
 lemma [autoref_rules]:
   "(stat_set_data,stat_set_data) \<in> nat_rel \<rightarrow> nat_rel \<rightarrow> nat_rel \<rightarrow> unit_rel"
   by auto
 
 abbreviation "stat_set_data_nres ns ni na \<equiv> RETURN (stat_set_data ns ni na)"
 
 lemma discard_stat_refine[refine]:
   "m1\<le>m2 \<Longrightarrow> stat_set_data_nres ns ni na \<then> m1 \<le> m2" by simp_all
 
 
 subsection \<open>Preliminaries\<close>
 
 text \<open>Some very special lemmas for reasoning about the nres-monad\<close>
 
 lemma SPEC_rule_nested2:
   "\<lbrakk>m \<le> SPEC P; \<And>r1 r2. P (r1, r2) \<Longrightarrow> g (r1, r2) \<le> SPEC P\<rbrakk>
   \<Longrightarrow> m \<le> SPEC (\<lambda>r'. g r' \<le> SPEC P)"
   by (simp add: pw_le_iff) blast
 
 lemma SPEC_rule_param2:
   assumes "f x \<le> SPEC (P x)"
       and "\<And>r1 r2. (P x) (r1, r2) \<Longrightarrow> (P x') (r1, r2)"
     shows "f x \<le> SPEC (P x')"
   using assms
   by (simp add: pw_le_iff)
 
 lemma SPEC_rule_weak:
   assumes "f x \<le> SPEC (Q x)" and "f x \<le> SPEC (P x)"
       and "\<And>r1 r2. \<lbrakk>(Q x) (r1, r2); (P x) (r1, r2)\<rbrakk> \<Longrightarrow> (P x') (r1, r2)"
     shows "f x \<le> SPEC (P x')"
   using assms
   by (simp add: pw_le_iff)
 
 lemma SPEC_rule_weak_nested2: "\<lbrakk>f \<le> SPEC Q; f \<le> SPEC P;
   \<And>r1 r2. \<lbrakk>Q (r1, r2); P (r1, r2)\<rbrakk> \<Longrightarrow> g (r1, r2) \<le> SPEC P\<rbrakk>
   \<Longrightarrow> f \<le> SPEC (\<lambda>r'. g r' \<le> SPEC P)"
   by (simp add: pw_le_iff) blast
 
 
 subsection \<open>Creation of States\<close>
 text \<open>
   In this section, the first part of the algorithm, which creates the states of the
   automaton, is formalized.
 \<close>
 
 (* FIXME: Abstraktion über node_name *)
 
 type_synonym node_name = nat
 
 type_synonym 'a frml = "'a ltln"
 
 type_synonym 'a interprt = "'a set word"
 
 record 'a node =
   name :: node_name
   incoming :: "node_name set"
   new :: "'a frml set"
   old :: "'a frml set"
   "next" :: "'a frml set"
 
 context
 begin
 
-interpretation LTL_Syntax .
-
 fun frml_neg
 where
   "frml_neg true\<^sub>n = false\<^sub>n"
 | "frml_neg false\<^sub>n = true\<^sub>n"
 | "frml_neg prop\<^sub>n(q) = nprop\<^sub>n(q)"
 | "frml_neg nprop\<^sub>n(q) = prop\<^sub>n(q)"
 
 fun new1 where
   "new1 (\<mu> and\<^sub>n \<psi>) = {\<mu>,\<psi>}"
 | "new1 (\<mu> U\<^sub>n \<psi>) = {\<mu>}"
 | "new1 (\<mu> V\<^sub>n \<psi>) = {\<psi>}"
 | "new1 (\<mu> or\<^sub>n \<psi>) = {\<mu>}"
 | "new1 _ = {}"
 
 fun next1 where
   "next1 (X\<^sub>n \<psi>) = {\<psi>}"
 | "next1 (\<mu> U\<^sub>n \<psi>) = {\<mu> U\<^sub>n \<psi>}"
 | "next1 (\<mu> V\<^sub>n \<psi>) = {\<mu> V\<^sub>n \<psi>}"
 | "next1 _ = {}"
 
 fun new2 where
   "new2 (\<mu> U\<^sub>n \<psi>) = {\<psi>}"
 | "new2 (\<mu> V\<^sub>n \<psi>) = {\<mu>, \<psi>}"
 | "new2 (\<mu> or\<^sub>n \<psi>) = {\<psi>}"
 | "new2 _ = {}"
 
 
 (* FIXME: Abstraction over concrete definition *)
 
 definition "expand_init \<equiv> 0"
 definition "expand_new_name \<equiv> Suc"
 
 lemma expand_new_name_expand_init: "expand_init < expand_new_name nm"
   by (auto simp add:expand_init_def expand_new_name_def)
 
 lemma expand_new_name_step[intro]:
   fixes n :: "'a node"
   shows "name n < expand_new_name (name n)"
   by (auto simp add:expand_new_name_def)
 
 lemma expand_new_name__less_zero[intro]: "0 < expand_new_name nm"
 proof -
   from expand_new_name_expand_init have "expand_init < expand_new_name nm"
     by auto
   then show ?thesis
     by (metis gr0I less_zeroE)
 qed
 
 abbreviation
   "upd_incoming_f n \<equiv> (\<lambda>n'.
     if (old n' = old n \<and> next n' = next n) then
       n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr>
     else n'
   )"
 
 definition
  "upd_incoming n ns \<equiv> ((upd_incoming_f n) ` ns)"
 
 lemma upd_incoming__elem:
   assumes "nd\<in>upd_incoming n ns"
   shows "nd\<in>ns
          \<or> (\<exists>nd'\<in>ns. nd = nd'\<lparr> incoming := incoming n \<union> incoming nd' \<rparr> \<and>
                             old nd' = old n \<and>
                             next nd' = next n)"
 proof -
   obtain nd' where "nd'\<in>ns" and nd_eq: "nd = upd_incoming_f n nd'"
     using assms unfolding upd_incoming_def by blast
   then show ?thesis by auto
 qed
 
 lemma upd_incoming__ident_node:
   assumes "nd\<in>upd_incoming n ns" and "nd\<in>ns"
     shows "incoming n \<subseteq> incoming nd \<or> \<not> (old nd = old n \<and> next nd = next n)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have nsubset: "\<not> (incoming n \<subseteq> incoming nd)" and
     old_next_eq: "old nd = old n \<and> next nd = next n"
     by auto
   moreover
   obtain nd' where "nd'\<in>ns" and nd_eq: "nd = upd_incoming_f n nd'"
     using assms unfolding upd_incoming_def by blast
   { assume "old nd' = old n \<and> next nd' = next n"
     with nd_eq have "nd = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>" by auto
     with nsubset have "False" by auto }
   moreover
   { assume "\<not> (old nd' = old n \<and> next nd' = next n)"
     with nd_eq old_next_eq have "False" by auto }
   ultimately show "False" by fast
 qed
 
 lemma upd_incoming__ident:
   assumes "\<forall>n\<in>ns. P n"
       and "\<And>n. \<lbrakk>n\<in>ns; P n\<rbrakk> \<Longrightarrow> (\<And>v. P (n\<lparr> incoming := v \<rparr>))"
     shows "\<forall>n\<in>upd_incoming n ns. P n"
 proof
   fix nd v
   let ?f = "\<lambda>n'.
     if (old n' = old n \<and> next n' = next n) then
       n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr>
     else n'"
   assume "nd\<in>upd_incoming n ns"
   then obtain nd' where "nd'\<in>ns" and nd_eq: "nd = ?f nd'"
     unfolding upd_incoming_def by blast
   { assume "old nd' = old n \<and> next nd' = next n"
     then obtain v where "nd = nd'\<lparr> incoming := v \<rparr>" using nd_eq by auto
     with assms \<open>nd'\<in>ns\<close> have "P nd" by auto }
   then show "P nd" using nd_eq \<open>nd'\<in>ns\<close> assms by auto
 qed
 
 
 lemma name_upd_incoming_f[simp]: "name (upd_incoming_f n x) = name x"
   by auto
 
 
 lemma name_upd_incoming[simp]:
   "name ` (upd_incoming n ns) = name ` ns" (is "?lhs = ?rhs")
   unfolding upd_incoming_def
 proof safe
   fix x
   assume "x\<in>ns"
   then have "upd_incoming_f n x \<in> (\<lambda>n'. local.upd_incoming_f n n') ` ns" by auto
   then have "name (upd_incoming_f n x) \<in> name ` (\<lambda>n'. local.upd_incoming_f n n') ` ns"
     by blast
   then show "name x \<in> name ` (\<lambda>n'. local.upd_incoming_f n n') ` ns" by simp
 qed auto
 
 
 abbreviation expand_body
 where
   "expand_body \<equiv> (\<lambda>expand (n,ns).
       if new n = {} then (
         if (\<exists>n'\<in>ns. old n' = old n \<and> next n' = next n) then
           RETURN (name n, upd_incoming n ns)
         else
           expand (
             \<lparr>
               name=expand_new_name (name n),
               incoming={name n},
               new=next n,
               old={},
               next={}
             \<rparr>,
             {n} \<union> ns)
       ) else do {
         \<phi> \<leftarrow> SPEC (\<lambda>x. x\<in>(new n));
         let n = n\<lparr> new := new n - {\<phi>} \<rparr>;
         if (\<exists>q. \<phi> = prop\<^sub>n(q) \<or> \<phi> = nprop\<^sub>n(q)) then
           (if (frml_neg \<phi>)\<in>old n then RETURN (name n, ns)
            else expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns))
         else if \<phi> = true\<^sub>n then expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns)
         else if \<phi> = false\<^sub>n then RETURN (name n, ns)
         else if (\<exists>\<nu> \<mu>. (\<phi> = \<nu> and\<^sub>n \<mu>) \<or> (\<phi> = X\<^sub>n \<nu>)) then
           expand (
             n\<lparr>
               new := new1 \<phi> \<union> new n,
               old := {\<phi>} \<union> old n,
               next := next1 \<phi> \<union> next n
             \<rparr>,
             ns)
         else do {
           (nm, nds) \<leftarrow> expand (
             n\<lparr>
               new := new1 \<phi> \<union> new n,
               old := {\<phi>} \<union> old n,
               next := next1 \<phi> \<union> next n
             \<rparr>,
             ns);
           expand (n\<lparr> name := nm, new := new2 \<phi> \<union> new n, old := {\<phi>} \<union> old n \<rparr>, nds)
         }
       }
      )"
 
 lemma expand_body_mono: "trimono expand_body" by refine_mono
 
 definition expand :: "('a node \<times> ('a node set)) \<Rightarrow> (node_name \<times> 'a node set) nres"
   where "expand \<equiv> REC expand_body"
 
 lemma REC_rule_old: (* TODO: Adapt proofs below, have fun with subgoal 27 ...*)
   fixes x::"'x"
   assumes M: "trimono body"
   assumes I0: "\<Phi> x"
   assumes IS: "\<And>f x. \<lbrakk> \<And>x. \<Phi> x \<Longrightarrow> f x \<le> M x; \<Phi> x; f \<le> REC body \<rbrakk>
     \<Longrightarrow> body f x \<le> M x"
   shows "REC body x \<le> M x"
   by (rule REC_rule_arb[where pre="\<lambda>_. \<Phi>" and M="\<lambda>_. M", OF assms])
 
 lemma expand_rec_rule:
   assumes I0: "\<Phi> x"
   assumes IS: "\<And>f x. \<lbrakk> \<And>x. f x \<le> expand x; \<And>x. \<Phi> x \<Longrightarrow> f x \<le> M x; \<Phi> x \<rbrakk>
     \<Longrightarrow> expand_body f x \<le> M x"
   shows "expand x \<le> M x"
   unfolding expand_def
   apply (rule REC_rule_old[where \<Phi>="\<Phi>"])
   apply (rule expand_body_mono)
   apply (rule I0)
   apply (rule IS[unfolded expand_def])
   apply (blast dest: le_funD)
   apply blast
   apply blast
   done
 
 abbreviation
   "expand_assm_incoming n_ns
    \<equiv> (\<forall>nm\<in>incoming (fst n_ns). name (fst n_ns) > nm)
     \<and> 0 < name (fst n_ns)
     \<and> (\<forall>q\<in>snd n_ns.
         name (fst n_ns) > name q
       \<and> (\<forall>nm\<in>incoming q. name (fst n_ns) > nm))"
 
 abbreviation
   "expand_rslt_incoming nm_nds
    \<equiv> (\<forall>q\<in>snd nm_nds. (fst nm_nds > name q \<and> (\<forall>nm'\<in>incoming q. fst nm_nds > nm')))"
 
 abbreviation
   "expand_rslt_name n_ns nm_nds
    \<equiv> (name (fst n_ns) \<le> fst nm_nds \<and> name ` (snd n_ns) \<subseteq> name ` (snd nm_nds))
      \<and> name ` (snd nm_nds)
        = name ` (snd n_ns) \<union> name ` {nd\<in>snd nm_nds. name nd \<ge> name (fst n_ns)}"
 
 abbreviation
   "expand_name_ident nds
    \<equiv> (\<forall>q\<in>nds. \<exists>!q'\<in>nds. name q = name q')"
 
 abbreviation
   "expand_assm_exist \<xi> n_ns
    \<equiv> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old (fst n_ns) \<and> \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> new (fst n_ns) \<union> old (fst n_ns)
          \<and> (\<forall>\<psi>\<in>new (fst n_ns). \<xi> \<Turnstile>\<^sub>n \<psi>)
          \<and> (\<forall>\<psi>\<in>old (fst n_ns). \<xi> \<Turnstile>\<^sub>n \<psi>)
          \<and> (\<forall>\<psi>\<in>next (fst n_ns). \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)"
 
 abbreviation
   "expand_rslt_exist__node_prop \<xi> n nd
    \<equiv> incoming n \<subseteq> incoming nd
       \<and> (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
       \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old nd \<and> \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> old nd"
 
 abbreviation
   "expand_rslt_exist \<xi> n_ns nm_nds
   \<equiv> (\<exists>nd\<in>snd nm_nds. expand_rslt_exist__node_prop \<xi> (fst n_ns) nd)"
 
 abbreviation
   "expand_rslt_exist_eq__node n nd
    \<equiv> name n = name nd
     \<and> old n = old nd
     \<and> next n = next nd
     \<and> incoming n \<subseteq> incoming nd"
 
 abbreviation
   "expand_rslt_exist_eq n_ns nm_nds \<equiv>
     (\<forall>n\<in>snd n_ns. \<exists>nd\<in>snd nm_nds. expand_rslt_exist_eq__node n nd)"
 
 lemma expand_name_propag:
   assumes "expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
     shows "expand n_ns \<le> SPEC (\<lambda>r. expand_rslt_incoming r
                                     \<and> expand_rslt_name n_ns r
                                     \<and> expand_name_ident (snd r))"
       (is "expand _ \<le> SPEC (?P n_ns)")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case prems: (1 _ _ n ns)
   then have Q: "?Q (n, ns)" by fast
   let ?nds = "upd_incoming n ns"
 
   from prems have "\<forall>q\<in>?nds. name q < name n"
     by (rule_tac upd_incoming__ident) auto
   moreover
   have "\<forall>q\<in>?nds. \<forall>nm'\<in>incoming q. nm' < name n" (is "\<forall>q\<in>_. ?sg q")
   proof
     fix q
     assume q_in:"q\<in>?nds"
     show "?sg q"
     proof (cases "q\<in>ns")
       case True
       with prems show ?thesis by auto
     next
       case False
       with upd_incoming__elem[OF q_in]
       obtain nd' where
         nd'_def:"nd'\<in>ns \<and> q = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>"
       by blast
 
       { fix nm'
         assume "nm'\<in>incoming q"
         moreover
         { assume "nm'\<in>incoming n"
           with Q have "nm' < name n" by auto }
         moreover
         { assume "nm'\<in>incoming nd'"
           with Q nd'_def have "nm' < name n" by auto }
         ultimately have "nm' < name n" using nd'_def by auto }
 
       then show ?thesis by fast
     qed
   qed
   moreover
   have "expand_name_ident ?nds"
   proof (rule upd_incoming__ident, goal_cases)
     case 1
     show ?case
     proof
       fix q
       assume "q\<in>ns"
 
       with Q have "\<exists>!q'\<in>ns. name q = name q'" by auto
       then obtain q' where "q'\<in>ns" and "name q = name q'"
                        and q'_all: "\<forall>q''\<in>ns. name q' = name q'' \<longrightarrow> q' = q''"
         by auto
       let ?q' = "upd_incoming_f n q'"
       have P_a: "?q'\<in>?nds \<and> name q = name ?q'"
         using \<open>q'\<in>ns\<close> \<open>name q = name q'\<close> q'_all
         unfolding upd_incoming_def by auto
 
       have P_all: "\<forall>q''\<in>?nds. name ?q' = name q'' \<longrightarrow> ?q' = q''"
       proof(clarify)
         fix q''
         assume "q''\<in>?nds" and q''_name_eq: "name ?q' = name q''"
         { assume "q''\<notin>ns"
           with upd_incoming__elem[OF \<open>q''\<in>?nds\<close>]
           obtain nd'' where
             "nd''\<in>ns"
             and q''_is: "q'' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>
                           \<and> old nd'' = old n \<and> next nd'' = next n"
             by auto
           then have "name nd'' = name q'"
             using q''_name_eq
             by (cases "old q' = old n \<and> next q' = next n") auto
           with \<open>nd''\<in>ns\<close> q'_all have "nd'' = q'" by auto
           then have "?q' = q''" using q''_is by simp }
         moreover
         { assume "q''\<in>ns"
           moreover
           have "name q' = name q''"
             using q''_name_eq
             by (cases "old q' = old n \<and> next q' = next n") auto
           moreover
           then have "incoming n \<subseteq> incoming q''
             \<Longrightarrow> incoming q'' = incoming n \<union> incoming q''"
             by auto
           ultimately have "?q' = q''"
             using upd_incoming__ident_node[OF \<open>q''\<in>?nds\<close>] q'_all
             by auto
         }
         ultimately show "?q' = q''" by fast
       qed
 
       show "\<exists>!q'\<in>upd_incoming n ns. name q = name q'"
       proof(rule ex1I[of _ ?q'], goal_cases)
         case 1
         then show ?case using P_a by simp
       next
         case 2
         then show ?case
           using P_all unfolding P_a[THEN conjunct2, THEN sym]
           by blast
       qed
     qed
   qed simp
   ultimately show ?case using prems by auto
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems have Q: "?Q (n, ns)" by auto
 
   show ?case unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step, goal_cases)
     case 1
     with expand_new_name_step[of n] show ?case
       using Q
       by (auto elim: order_less_trans[rotated])
   next
     case prems': (2 _ nds)
     then have "name ` ns \<subseteq> name ` nds" by auto
     with expand_new_name_step[of n] show ?case
       using prems' by auto
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   with prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   from prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   from prems show ?case
     by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)" and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     by simp_all
   show ?case
     using goal_assms Q
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_param2, rule_tac step) auto
   next
     case prems: (2 nm nds)
     then have P_x: "(name n \<le> nm \<and> name ` ns \<subseteq> name ` nds)
       \<and> name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
       (is "_ \<and> ?nodes_eq nds ns (name n)") by auto
     show ?case
     proof (rule_tac SPEC_rule_param2[where P = "?P"], goal_cases)
       case 1
       with prems show ?case by (rule_tac step) auto
     next
       case prems': (2 nm' nds')
       then have "\<forall>q\<in>nds'. name q < nm' \<and> (\<forall>nm''\<in>incoming q. nm'' < nm')" by auto
       moreover
       have "?nodes_eq nds ns (name n)" and "?nodes_eq nds' nds nm" and "name n \<le> nm"
         using prems' P_x by auto
       then have "?nodes_eq nds' ns (name n)" by auto
       then have "expand_rslt_name (n, ns) (nm', nds')"
         using prems' P_x subset_trans[of "name ` ns" "name ` nds"] by auto
       ultimately show ?case using prems' by auto
     qed
   qed
 qed
 
 lemmas expand_name_propag__incoming = SPEC_rule_conjunct1[OF expand_name_propag]
 lemmas expand_name_propag__name =
   SPEC_rule_conjunct1[OF SPEC_rule_conjunct2[OF expand_name_propag]]
 lemmas expand_name_propag__name_ident =
   SPEC_rule_conjunct2[OF SPEC_rule_conjunct2[OF expand_name_propag]]
 
 
 lemma expand_rslt_exist_eq:
   shows "expand n_ns \<le> SPEC (expand_rslt_exist_eq n_ns)"
     (is "_ \<le> SPEC (?P n_ns)")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>_. True"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   let ?r = "(name n, upd_incoming n ns)"
   have "expand_rslt_exist_eq (n, ns) ?r"
     unfolding snd_conv
   proof
     fix n'
     assume "n'\<in>ns"
     { assume "old n' = old n \<and> next n' = next n"
       with \<open>n'\<in>ns\<close>
       have "n'\<lparr> incoming := incoming n \<union> incoming n' \<rparr> \<in> upd_incoming n ns"
         unfolding upd_incoming_def by auto
     }
     moreover
     { assume "\<not> (old n' = old n \<and> next n' = next n)"
       with \<open>n'\<in>ns\<close> have "n' \<in> upd_incoming n ns"
         unfolding upd_incoming_def by auto
     }
     ultimately show "\<exists>nd\<in>upd_incoming n ns. expand_rslt_exist_eq__node n' nd"
       by force
   qed
   with prems show ?case by auto
 next
   case prems: (2 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6 then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
   with prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns)
   then have step: "\<And>x. f x \<le> SPEC (?P x)" by simp
 
   show ?case
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     with prems show ?case
       by (rule_tac SPEC_rule_param2, rule_tac step) auto
   next
     case (2 nm nds)
     with prems have P_x: "?P (n, ns) (nm, nds)" by fast
     show ?case
       unfolding case_prod_unfold \<open>x = (n, ns)\<close>
     proof (rule_tac SPEC_rule_param2[where P = "?P"], goal_cases)
       case 1
       then show ?case by (rule_tac step)
     next
       case prems': (2 nm' nds')
       {
         fix n'
         assume "n'\<in>ns"
         with P_x obtain nd where "nd\<in>nds" and n'_split: "expand_rslt_exist_eq__node n' nd"
           by auto
         with prems' obtain nd' where "nd'\<in>nds'" and "expand_rslt_exist_eq__node nd nd'"
           by auto
         then have "\<exists>nd'\<in>nds'. expand_rslt_exist_eq__node n' nd'"
           using n'_split subset_trans[of "incoming n'"] by auto
       }
       then have "expand_rslt_exist_eq (n, ns) (nm', nds')" by auto
       with prems show ?case by auto
     qed
   qed
 qed
 
 lemma expand_prop_exist:
   "expand n_ns \<le> SPEC (\<lambda>r. expand_assm_exist \<xi> n_ns \<longrightarrow> expand_rslt_exist \<xi> n_ns r)"
   (is "_ \<le> SPEC (?P n_ns)")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>_. True"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   let ?nds = "upd_incoming n ns"
   let ?r = "(name n, ?nds)"
   { assume Q: "expand_assm_exist \<xi> (n, ns)"
     note \<open>\<exists>n'\<in>ns. old n' = old n \<and> next n' = next n\<close>
     then obtain n' where "n'\<in>ns" and assm_eq: "old n' = old n \<and> next n' = next n"
       by auto
     let ?nd = "n'\<lparr> incoming := incoming n \<union> incoming n'\<rparr>"
     have "?nd \<in> ?nds" using \<open>n'\<in>ns\<close> assm_eq unfolding upd_incoming_def by auto
     moreover
     have "incoming n \<subseteq> incoming ?nd" by auto
     moreover
     have "expand_rslt_exist__node_prop \<xi> n ?nd" using Q assm_eq \<open>new n = {}\<close>
       by simp
     ultimately have "expand_rslt_exist \<xi> (n, ns) ?r"
       unfolding fst_conv snd_conv by blast
   }
   with prems show ?case
     by auto
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where Q = "expand_rslt_exist_eq"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_rslt_exist_eq)
   next
     case 2
     then show ?case by (rule_tac step)
   next
     case prems': (3 nm nds)
     then have "name ` ns \<subseteq> name ` nds" by auto
     moreover
     { assume assm_ex: "expand_assm_exist \<xi> (n, ns)"
       with prems' obtain nd where "nd\<in>nds" and "expand_rslt_exist_eq__node n nd"
         by force+
       then have "expand_rslt_exist__node_prop \<xi> n nd"
        using assm_ex \<open>new n = {}\<close> by auto
       then have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" using \<open>nd\<in>nds\<close> by auto }
     ultimately show ?case
       using expand_new_name_step[of n] prems' by auto
   qed
 next
   case prems: (3 f x n ns \<psi>)
   { assume "expand_assm_exist \<xi> (n, ns)"
     with prems have "\<xi> \<Turnstile>\<^sub>n \<psi>" and "\<xi> \<Turnstile>\<^sub>n frml_neg \<psi>" by auto
     with prems have False by auto }
   with prems show ?case by auto
 next
   case prems: (4 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (5 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>n"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (6 f x n ns \<psi>)
   { assume "expand_assm_exist \<xi> (n, ns)"
     with prems have "\<xi> \<Turnstile>\<^sub>n false\<^sub>n" by auto }
   with prems show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)"
     and step: "\<And>x. f x \<le> SPEC (?P x)" by simp_all
   show ?case
     using goal_assms unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
     case prems': (1 nm nds)
     { assume "expand_assm_exist \<xi> (n, ns)"
       with prems' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by auto }
     then show ?case by auto
   qed
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have step: "\<And>x. f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x1 = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
                 old := {\<psi>} \<union> old n, next := next1 \<psi> \<union> next n\<rparr>, ns)"
 
   let ?new1_assm_sel = "\<lambda>\<psi>. (case \<psi> of \<mu> U\<^sub>n \<eta> => \<eta> | \<mu> V\<^sub>n \<eta> \<Rightarrow> \<mu> | \<mu> or\<^sub>n \<eta> \<Rightarrow> \<eta>)"
 
   { assume new1_assm: "\<not> (\<xi> \<Turnstile>\<^sub>n (?new1_assm_sel \<psi>))"
     then have ?case
       using goal_assms unfolding \<open>x = (n, ns)\<close>
     proof (rule_tac SPEC_rule_nested2, goal_cases)
       case prems': 1
       then show ?case
       proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
         case prems'': (1 nm nds)
         { assume "expand_assm_exist \<xi> (n, ns)"
           with prems'' have "expand_assm_exist \<xi> ?x1"
             unfolding fst_conv
           proof (cases \<psi>, goal_cases)
             case \<psi>: (8 \<mu> \<eta>)
             then have "\<xi> \<Turnstile>\<^sub>n \<mu> U\<^sub>n \<eta>" by fast
             then have "\<xi> \<Turnstile>\<^sub>n \<mu>" and "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<mu> U\<^sub>n \<eta>)"
               using \<psi> ltln_expand_Until[of \<xi> \<mu> \<eta>] by auto
             with \<psi> show ?case by auto
           next
             case \<psi>: (9 \<mu> \<eta>)
             then have *: "\<xi> \<Turnstile>\<^sub>n \<mu> V\<^sub>n \<eta>" by fast
             with \<psi> have "\<xi> \<Turnstile>\<^sub>n \<eta>" and "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<mu> V\<^sub>n \<eta>)"
               using ltln_expand_Release[of \<xi> \<mu> \<eta>] by auto
             with \<psi> * show ?case by auto
           qed auto
           with prems'' have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by force }
         with prems'' show ?case by auto
       qed
     next
       case prems': (2 nm nds)
       then have P_x: "?P (n, ns) (nm, nds)" by fast
 
       show ?case
         unfolding case_prod_unfold
       proof (rule_tac SPEC_rule_weak[where P = "?P" and Q = "expand_rslt_exist_eq"], goal_cases)
         case 1
         then show ?case
           by (rule_tac order_trans,
             rule_tac f_sup,
             rule_tac expand_rslt_exist_eq)
       next
         case 2
         then show ?case by (rule_tac step)
       next
         case prems'': (3 nm' nds')
         { assume "expand_assm_exist \<xi> (n, ns)"
           with P_x have "expand_rslt_exist \<xi> (n, ns) (nm, nds)" by simp
           then obtain nd where nd: "nd\<in>nds" "expand_rslt_exist__node_prop \<xi> n nd"
             using goal_assms by auto
           with prems'' obtain nd' where
             "nd'\<in>nds'" and "expand_rslt_exist_eq__node nd nd'"
             by force
           with nd have "expand_rslt_exist__node_prop \<xi> n nd'"
             using subset_trans[of "incoming n" "incoming nd"] by auto
           then have "expand_rslt_exist \<xi> (n,ns) (nm', nds')"
             using \<open>nd'\<in>nds'\<close> goal_assms by auto }
         then show ?case by fast
       qed
     qed
   }
   moreover
   { assume new1_assm: "\<xi> \<Turnstile>\<^sub>n (?new1_assm_sel \<psi>)"
     let ?x2f = "\<lambda>(nm::node_name, nds::'a node set). (
         n\<lparr>new := new n - {\<psi>},
           name := nm,
           new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
           old := {\<psi>} \<union> old n\<rparr>,
         nds)"
     have P_x: "f ?x1 \<le> SPEC (?P ?x1)" by (rule step)
     moreover
     { fix r :: "node_name \<times> 'a node set"
       let ?x2 = "?x2f r"
 
       assume assm: "(?P ?x1) r"
       have "f ?x2 \<le> SPEC (?P (n, ns))"
         unfolding case_prod_unfold fst_conv
       proof (rule_tac SPEC_rule_param2, rule_tac step, goal_cases)
         case prems': (1 nm' nds')
         { assume "expand_assm_exist \<xi> (n, ns)"
           with new1_assm goal_assms have "expand_assm_exist \<xi> ?x2"
           proof (cases r, cases \<psi>, goal_cases)
             case prems'': (9 _ _ \<mu> \<eta>)
             then have *: "\<xi> \<Turnstile>\<^sub>n \<mu> V\<^sub>n \<eta>" unfolding fst_conv by fast
             with ltln_expand_Release[of \<xi> \<mu> \<eta>] have "\<xi> \<Turnstile>\<^sub>n \<eta>" by auto
             with prems'' * show ?case by auto
           qed auto
           with prems' have "expand_rslt_exist \<xi> ?x2 (nm', nds')"
             unfolding case_prod_unfold fst_conv snd_conv by fast
           then have "expand_rslt_exist \<xi> (n, ns) (nm', nds')" by (cases r, auto) }
         then show ?case by simp
       qed
     }
     then have "SPEC (?P ?x1)
       \<le> SPEC (\<lambda>r. (case r of (nm, nds) =>
           f (?x2f (nm, nds))) \<le> SPEC (?P (n, ns)))"
       using goal_assms by (rule_tac SPEC_rule) force
     finally have ?case unfolding case_prod_unfold \<open>x = (n, ns)\<close> by simp
   }
   ultimately show ?case by fast
 qed
 
 
 text \<open>Termination proof\<close>
 
 definition expand\<^sub>T :: "('a node \<times> ('a node set)) \<Rightarrow> (node_name \<times> 'a node set) nres"
   where "expand\<^sub>T n_ns \<equiv> REC\<^sub>T expand_body n_ns"
 
 abbreviation "old_next_pair n \<equiv> (old n, next n)"
 
 abbreviation "old_next_limit \<phi> \<equiv> Pow (subfrmlsn \<phi>) \<times> Pow (subfrmlsn \<phi>)"
 
 lemma old_next_limit_finite: "finite (old_next_limit \<phi>)"
   using subfrmlsn_finite by auto
 
 definition
   "expand_ord \<phi> \<equiv>
      inv_image (finite_psupset (old_next_limit \<phi>) <*lex*> less_than)
                (\<lambda>(n, ns). (old_next_pair ` ns, frmlset_sumn (new n)))"
 
 lemma expand_ord_wf[simp]: "wf (expand_ord \<phi>)"
   using finite_psupset_wf[OF old_next_limit_finite]
   unfolding expand_ord_def by auto
 
 abbreviation
   "expand_inv_node \<phi> n
   \<equiv> finite (new n) \<and> finite (old n) \<and> finite (next n)
   \<and> (new n) \<union> (old n) \<union> (next n) \<subseteq> subfrmlsn \<phi>"
 
 abbreviation
   "expand_inv_result \<phi> ns \<equiv> finite ns \<and> (\<forall>n'\<in>ns. (new n') \<union> (old n') \<union> (next n') \<subseteq> subfrmlsn \<phi>)"
 
 definition
   "expand_inv \<phi> n_ns \<equiv> (case n_ns of (n, ns) \<Rightarrow> expand_inv_node \<phi> n \<and> expand_inv_result \<phi> ns)"
 
 lemma new1_less_setsum: "frmlset_sumn (new1 \<phi>) < frmlset_sumn {\<phi>}"
 proof -
   have "frmlset_sumn {\<nu>,\<mu>} < Suc (size_frmln \<nu> + size_frmln \<mu>)" for \<nu> \<mu>
     by (cases "\<nu> = \<mu>") auto
   then show ?thesis
     by (cases \<phi>) auto
 qed
 
 lemma new2_less_setsum: "frmlset_sumn (new2 \<phi>) < frmlset_sumn {\<phi>}"
 proof -
   have "frmlset_sumn {\<nu>,\<mu>} < Suc (size_frmln \<nu> + size_frmln \<mu>)" for \<nu> \<mu>
     by (cases "\<nu> = \<mu>") auto
   then show ?thesis
     by (cases \<phi>) auto
 qed
 
 lemma new1_finite[intro]: "finite (new1 \<psi>)"
   by (cases \<psi>) auto
 lemma new1_subset_frmls: "\<phi> \<in> new1 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsn \<psi>"
   by (cases \<psi>) auto
 
 lemma new2_finite[intro]: "finite (new2 \<psi>)"
   by (cases \<psi>) auto
 lemma new2_subset_frmls: "\<phi> \<in> new2 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsn \<psi>"
   by (cases \<psi>) auto
 
 lemma next1_finite[intro]: "finite (next1 \<psi>)"
   by (cases \<psi>) auto
 lemma next1_subset_frmls: "\<phi> \<in> next1 \<psi> \<Longrightarrow> \<phi> \<in> subfrmlsn \<psi>"
   by (cases \<psi>) auto
 
 lemma expand_inv_impl[intro!]:
   assumes "expand_inv \<phi> (n, ns)"
       and newn: "\<psi> \<in> new n"
       and "old_next_pair ` ns \<subseteq> old_next_pair ` ns'"
       and "expand_inv_result \<phi> ns'"
       and "(n' = n\<lparr> new := new n - {\<psi>}, old := {\<psi>} \<union> old n \<rparr>) \<or>
            (n' = n\<lparr> new := new1 \<psi> \<union> (new n - {\<psi>}),
                     old := {\<psi>} \<union> old n,
                     next := next1 \<psi> \<union> next n \<rparr>) \<or>
            (n' = n\<lparr> name := nm,
                     new := new2 \<psi> \<union> (new n - {\<psi>}), old := {\<psi>} \<union> old n \<rparr>)"
           (is "?case1 \<or> ?case2 \<or> ?case3")
     shows "((n', ns'), (n, ns))\<in>expand_ord \<phi> \<and> expand_inv \<phi> (n', ns')"
           (is "?concl1 \<and> ?concl2")
 proof
   from assms consider ?case1 | ?case2 | ?case3 by blast
   then show ?concl1
   proof cases
     case n'def: 1
     with assms show ?thesis
       unfolding expand_inv_def expand_ord_def finite_psupset_def by auto
   next
     case n'def: 2
     have \<psi>innew: "\<psi>\<in> new n" and fin_new: "finite (new n)"
       using assms unfolding expand_inv_def by auto
     from \<psi>innew setsum_diff1_nat[of size_frmln "new n" \<psi>]
     have "frmlset_sumn (new n - {\<psi>}) = frmlset_sumn (new n) - size_frmln \<psi>"
       by simp
     moreover
     from fin_new setsum_Un_nat[OF new1_finite _, of "new n - {\<psi>}" size_frmln \<psi>]
     have "frmlset_sumn (new n') \<le> frmlset_sumn (new1 \<psi>) + frmlset_sumn (new n - {\<psi>})"
       unfolding n'def by auto
     moreover have sum_leq:"frmlset_sumn (new n) \<ge>  frmlset_sumn {\<psi>}"
       using \<psi>innew setsum_mono2[OF fin_new, of "{\<psi>}" size_frmln]
         size_frmln_gt_zero
       by simp
     ultimately have "frmlset_sumn (new n') < frmlset_sumn (new n)"
       using new1_less_setsum[of \<psi>] sum_leq by auto
     with assms show ?thesis unfolding expand_ord_def finite_psupset_def by auto
   next
     case n'def: 3
     have \<psi>innew: "\<psi>\<in> new n" and fin_new: "finite (new n)"
       using assms unfolding expand_inv_def by auto
     from \<psi>innew setsum_diff1_nat[of size_frmln "new n" \<psi>]
     have "frmlset_sumn (new n - {\<psi>}) = frmlset_sumn (new n) - size_frmln \<psi>"
       by simp
     moreover
     from fin_new setsum_Un_nat[OF new2_finite _, of "new n - {\<psi>}" size_frmln \<psi>]
     have "frmlset_sumn (new n') \<le> frmlset_sumn (new2 \<psi>) + frmlset_sumn (new n - {\<psi>})"
       unfolding n'def by auto
     moreover have sum_leq:"frmlset_sumn (new n) \<ge>  frmlset_sumn {\<psi>}"
       using \<psi>innew setsum_mono2[OF fin_new, of "{\<psi>}" size_frmln]
         size_frmln_gt_zero
       by simp
     ultimately have "frmlset_sumn (new n') < frmlset_sumn (new n)"
       using new2_less_setsum[of \<psi>] sum_leq by auto
     with assms show ?thesis
       unfolding expand_ord_def finite_psupset_def by auto
   qed
 next
   have "new1 \<psi> \<subseteq> subfrmlsn \<phi>"
     and "new2 \<psi> \<subseteq> subfrmlsn \<phi>"
     and "next1 \<psi> \<subseteq> subfrmlsn \<phi>"
     using assms subfrmlsn_subset[OF new1_subset_frmls[of _ \<psi>]]
       subfrmlsn_subset[of \<psi> \<phi>, OF set_rev_mp[of _ "new n"]]
       subfrmlsn_subset[OF new2_subset_frmls[of _ \<psi>]]
       subfrmlsn_subset[OF next1_subset_frmls[of _ \<psi>]]
     unfolding expand_inv_def
     (* This proof is merely a speed optimization. A single force+ does the job,
        but takes very long *)
     apply -
     apply (clarsimp split: prod.splits)
     apply (metis in_mono new1_subset_frmls)
     apply (clarsimp split: prod.splits)
     apply (metis new2_subset_frmls set_rev_mp)
     apply (clarsimp split: prod.splits)
     apply (metis in_mono next1_subset_frmls)
     done
   with assms show ?concl2
     unfolding expand_inv_def
     by auto
 qed
 
 lemma expand_term_prop_help:
   assumes "((n', ns'), (n, ns))\<in>expand_ord \<phi> \<and> expand_inv \<phi> (n', ns')"
     and assm_rule: "\<lbrakk>expand_inv \<phi> (n', ns'); ((n', ns'), n, ns) \<in> expand_ord \<phi>\<rbrakk>
       \<Longrightarrow> f (n', ns') \<le> SPEC P"
   shows "f (n', ns') \<le> SPEC P"
   using assms by (rule_tac assm_rule) auto
 
 lemma expand_inv_upd_incoming:
   assumes "expand_inv \<phi> (n, ns)"
   shows "expand_inv_result \<phi> (upd_incoming n ns)"
   using assms unfolding expand_inv_def upd_incoming_def by force
 
 
 lemma upd_incoming_eq_old_next_pair: "old_next_pair ` ns = old_next_pair ` (upd_incoming n ns)"
   (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix x
     let ?f = "\<lambda>n'. n'\<lparr>incoming := incoming n \<union> incoming n'\<rparr>"
     assume "x \<in> ?A"
     then obtain n' where "n' \<in> ns" and xeq: "x = (old n', next n')"
       by auto
     have "x \<in> (old_next_pair ` (\<lambda>n'. n'\<lparr>incoming := incoming n \<union> incoming n'\<rparr>)
              ` (ns \<inter> {n' \<in> ns. old n' = old n \<and> next n' = next n}))
           \<union> (old_next_pair ` (ns \<inter> {n' \<in> ns. old n' \<noteq> old n \<or> next n' \<noteq> next n}))"
     proof (cases "old n' = old n \<and> next n' = next n")
       case True
       with \<open>n' \<in> ns\<close>
       have "?f n' \<in> ?f ` (ns \<inter> {n'\<in>ns. old n' = old n \<and> next n' = next n})"  (is "_ \<in> ?C")
         by auto
       then have "old_next_pair (?f n') \<in> old_next_pair ` ?C"
         by (rule_tac imageI) auto
       with xeq have "x\<in>old_next_pair ` ?C" by auto
       then show ?thesis by blast
     next
       case False
       with \<open>n' \<in> ns\<close> xeq
       have "x \<in> old_next_pair ` (ns \<inter> {n'\<in>ns. old n' \<noteq> old n \<or> next n' \<noteq> next n})"
         by auto
       then show ?thesis by blast
     qed
     then show "x \<in> ?B"
       using \<open>x \<in> ?A\<close> unfolding upd_incoming_def by auto
   qed
   show "?B \<subseteq> ?A"
     unfolding upd_incoming_def by (force intro:imageI)
 qed
 
 lemma expand_term_prop:
   "expand_inv \<phi> n_ns \<Longrightarrow>
     expand\<^sub>T n_ns \<le> SPEC (\<lambda>(_, nds). old_next_pair ` snd n_ns\<subseteq>old_next_pair `nds
     \<and> expand_inv_result \<phi> nds)"
   (is "_ \<Longrightarrow> _ \<le> SPEC (?P n_ns)")
   unfolding expand\<^sub>T_def
   apply (rule_tac RECT_rule[where pre="\<lambda>(n, ns). expand_inv \<phi> (n, ns)" and V="expand_ord \<phi>"])
   apply (refine_mono)
   apply simp
   apply simp
 proof (intro refine_vcg, goal_cases)
   case prems: (1 _ _ n ns)
   have "old_next_pair ` ns \<subseteq> old_next_pair ` (upd_incoming n ns)"
     by (rule equalityD1[OF upd_incoming_eq_old_next_pair])
   with prems show ?case
     using expand_inv_upd_incoming[of \<phi> n ns] by auto
 next
   case prems: (2 expand x n ns)
   let ?n' = "\<lparr>
     name = expand_new_name (name n),
     incoming = {name n},
     new = next n,
     old = {},
     next = {}\<rparr>"
   let ?ns' = "{n} \<union> ns"
   from prems have SPEC_sub:"SPEC (?P (?n', ?ns')) \<le> SPEC (?P x)"
     by (rule_tac SPEC_rule) auto
   from prems have *: "old_next_pair n\<notin>old_next_pair ` ns"
     by auto
   then have subset_next_pair:
     "old_next_pair ` ns \<subset> old_next_pair ` (insert n ns)"
     by auto
   with prems * have "((?n', ?ns'), (n, ns))\<in>expand_ord \<phi>"
     by (auto simp add: expand_ord_def expand_inv_def finite_psupset_def)
   moreover from prems have "expand_inv \<phi> (?n', ?ns')"
     unfolding expand_inv_def by auto
   ultimately have "expand (?n', ?ns') \<le> SPEC (?P (?n', ?ns'))"
     using prems by fast
   with SPEC_sub show ?case
     by (rule_tac order_trans) fast+
 next
   case 3
   then show ?case by (auto simp add:expand_inv_def)
 next
   case 4
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case 5
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case 6
   then show ?case by (simp add: expand_inv_def)
 next
   case 7
   then show ?case
     apply (rule_tac expand_term_prop_help[OF expand_inv_impl])
     apply (simp add: expand_inv_def)+
     apply force
     done
 next
   case prems: (8 f x a b xa)
   let ?n' = "a\<lparr>
     new := new1 xa \<union> (new a - {xa}),
     old := insert xa (old a),
     next := next1 xa \<union> next a\<rparr>"
   let ?n'' = "\<lambda>nm. a\<lparr>
     name := nm,
     new := new2 xa \<union> (new a - {xa}),
     old := insert xa (old a)\<rparr>"
   have step:"((?n', b), (a, b)) \<in> expand_ord \<phi> \<and> expand_inv \<phi> (?n', b)"
     using prems by (rule_tac expand_inv_impl) (auto simp add: expand_inv_def)
   with prems have assm1: "f (?n', b) \<le> SPEC (?P (a, b))"
     by auto
   moreover
   {
     fix nm::node_name and nds::"'a node set"
     assume assm1: "old_next_pair ` b \<subseteq> old_next_pair ` nds"
       and assm2: "expand_inv_result \<phi> nds"
     with prems step have "((?n'' nm, nds), (a, b)) \<in> expand_ord \<phi> \<and> expand_inv \<phi> (?n'' nm, nds)"
       by (rule_tac expand_inv_impl) auto
     with prems have "f (?n'' nm, nds) \<le> SPEC (?P (?n'' nm, nds))"
       by auto
     moreover
     have "SPEC (?P (?n'' nm, nds)) \<le> SPEC (?P (a, b))"
       using assm2 subset_trans[OF assm1] by auto
     ultimately have "f (?n'' nm, nds) \<le> SPEC (?P (a, b))"
       by (rule order_trans)
   }
   then have assm2: "SPEC (?P (a, b))
     \<le> SPEC (\<lambda>r. (case r of (nm, nds) \<Rightarrow> f (?n'' nm, nds)) \<le> SPEC (?P (a, b)))"
     by (rule_tac SPEC_rule) auto
   from prems order_trans[OF assm1 assm2] show ?case
     by auto
 qed
 
 lemma expand_eq_expand\<^sub>T:
   assumes inv: "expand_inv \<phi> n_ns"
   shows "expand\<^sub>T n_ns = expand n_ns"
   unfolding expand\<^sub>T_def expand_def
   apply (rule RECT_eq_REC)
   apply refine_mono
   unfolding expand\<^sub>T_def[symmetric]
   using expand_term_prop[OF inv] apply auto
   done
 
 lemma expand_nofail:
   assumes inv: "expand_inv \<phi> n_ns"
   shows "nofail (expand\<^sub>T n_ns)"
   using expand_term_prop[OF inv] by (simp add: pw_le_iff)
 
 lemma [intro!]: "expand_inv \<phi> (
   \<lparr>
     name = expand_new_name expand_init,
     incoming = {expand_init},
     new = {\<phi>},
     old = {},
     next = {} \<rparr>,
   {})"
   by (auto simp add: expand_inv_def)
 
 definition create_graph :: "'a frml \<Rightarrow> 'a node set nres"
 where
   "create_graph \<phi> \<equiv>
     do {
       (_, nds) \<leftarrow> expand (
         \<lparr>
           name = expand_new_name expand_init,
           incoming = {expand_init},
           new = {\<phi>},
           old = {},
           next = {}
         \<rparr>::'a node,
         {}::'a node set);
       RETURN nds
     }"
 
 (* "expand_eq_expand\<^sub>T" *)
 
 definition create_graph\<^sub>T :: "'a frml \<Rightarrow> 'a node set nres"
 where
   "create_graph\<^sub>T \<phi> \<equiv> do {
     (_, nds) \<leftarrow> expand\<^sub>T (
       \<lparr>
         name = expand_new_name expand_init,
         incoming = {expand_init},
         new = {\<phi>},
         old = {},
         next = {}
       \<rparr>::'a node,
     {}::'a node set);
     RETURN nds
   }"
 
 lemma create_graph_eq_create_graph\<^sub>T: "create_graph \<phi> = create_graph\<^sub>T \<phi>"
   unfolding create_graph\<^sub>T_def create_graph_def
   unfolding eq_iff
 proof (standard, goal_cases)
   case 1
   then show ?case
     by refine_mono (unfold expand_def expand\<^sub>T_def, rule REC_le_RECT)
 next
   case 2
   then show ?case
     by (refine_mono, rule expand_eq_expand\<^sub>T[unfolded eq_iff, THEN conjunct1]) auto
 qed
 
 lemma create_graph_finite: "create_graph \<phi> \<le> SPEC finite"
   unfolding create_graph_def expand_def
   apply (intro refine_vcg)
   apply (rule_tac order_trans)
   apply (rule_tac REC_le_RECT)
   apply (fold expand\<^sub>T_def)
   apply (rule_tac order_trans[OF expand_term_prop])
   apply auto[1]
   apply (rule_tac SPEC_rule)
   apply auto
   done
 
 lemma create_graph_nofail: "nofail (create_graph \<phi>)"
   by (rule_tac pwD1[OF create_graph_finite]) auto
 
 
 abbreviation
   "create_graph_rslt_exist \<xi> nds
    \<equiv> \<exists>nd\<in>nds.
         expand_init\<in>incoming nd
       \<and> (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
       \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old nd \<and> \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> old nd"
 
 lemma L4_7:
   assumes "\<xi> \<Turnstile>\<^sub>n \<phi>"
   shows "create_graph \<phi> \<le> SPEC (create_graph_rslt_exist \<xi>)"
   using assms unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_prop_exist) (
     auto simp add:expand_new_name_expand_init)
 
 
 lemma expand_incoming_name_exist:
   assumes "name (fst n_ns) > expand_init
     \<and> (\<forall>nm\<in>incoming (fst n_ns). nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` (snd n_ns))
     \<and> expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   and "\<forall>nd\<in>snd n_ns.
     name nd > expand_init
     \<and> (\<forall>nm\<in>incoming nd. nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` (snd n_ns))"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
   apply (rule_tac expand_rec_rule[where \<Phi>="\<lambda>n_ns. ?Q n_ns \<and> ?P (snd n_ns)"])
   apply simp
   apply (intro refine_vcg)
 proof goal_cases
   case (1 f x n ns)
   then show ?case
   proof (simp, clarify, goal_cases)
     case prems: (1 _ _ nd)
     { assume "nd\<in>ns"
       with prems have ?case by auto }
     moreover
     { assume "nd\<notin>ns"
       with upd_incoming__elem[OF \<open>nd\<in>upd_incoming n ns\<close>]
       obtain nd' where "nd'\<in>ns" and "nd = nd'\<lparr>incoming :=
         incoming n \<union> incoming nd'\<rparr> \<and>
         old nd' = old n \<and>
         next nd' = next n" by auto
       with prems have ?case by auto }
     ultimately show ?case by fast
   qed
 next
   case (2 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x. ?P (snd x))"
     and QP: "?Q (n, ns) \<and> ?P ns"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
     using QP expand_new_name_expand_init
   proof (rule_tac step, goal_cases)
     case prems: 1
     then have name_less: "name n < expand_new_name (name n)"
       by auto
     moreover
     from prems name_less have "\<forall>nm\<in>incoming n. nm < expand_new_name (name n)"
       by auto
     moreover
     from prems name_less have **: "\<forall>q\<in>ns. name q < expand_new_name (name n) \<and>
       (\<forall>nm\<in>incoming q. nm < expand_new_name (name n))"
       by force
     moreover
     from QP have "\<exists>!q'. (q' = n \<or> q' \<in> ns) \<and> name n = name q'"
       by force
     moreover
     have "\<forall>q\<in>ns. \<exists>!q'.
       (q' = n \<or> q' \<in> ns) \<and>
       name q = name q' " using QP by auto
     ultimately show ?case using prems by simp
   qed
 next
   case 3
   then show ?case by simp
 next
   case 4
   then show ?case by simp
 next
   case 5
   then show ?case by simp
 next
   case 6
   then show ?case by simp
 next
   case 7
   then show ?case by simp
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   with prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
         next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_incoming r
     \<and> expand_rslt_name x r
     \<and> expand_name_ident (snd r)"
 
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_name_propag) simp
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>x r. ?P (snd r)"], rule_tac step)
         auto
   next
     case (3 nm nds)
     then show ?case
     proof (rule_tac SPEC_rule_weak[where P = "\<lambda>x r. ?P (snd r)"
         and Q = "\<lambda>x r. expand_rslt_exist_eq x r \<and> ?props x r"], goal_cases)
       case 1
       then show ?case
         by (rule_tac SPEC_rule_conjI,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_rslt_exist_eq,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_name_propag) force
     next
       case 2
       then show ?case
         by (rule_tac SPEC_rule_param2[where P = "\<lambda>x r. ?P (snd r)"],
           rule_tac step) force
     next
       case (3 nm' nds')
       then show ?case
         by simp
     qed
   qed
 qed
 
 lemma create_graph__incoming_name_exist:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. expand_init < name nd \<and> (\<forall>nm\<in>incoming nd. nm \<noteq> expand_init \<longrightarrow> nm\<in>name ` nds))"
   using assms
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_incoming_name_exist) (
     auto simp add:expand_new_name_expand_init)
 
 
 abbreviation
   "expand_rslt_all__ex_equiv \<xi> nd nds \<equiv>
    (\<exists>nd'\<in>nds.
     name nd \<in> incoming nd'
     \<and> (\<forall>\<psi>\<in>old nd'. suffix 1 \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next nd'. suffix 1 \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
     \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old nd' \<and> suffix 1 \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> old nd')"
 
 abbreviation
   "expand_rslt_all \<xi> n_ns nm_nds \<equiv>
    (\<forall>nd\<in>snd nm_nds. name nd \<notin> name ` (snd n_ns) \<and>
         (\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
         \<longrightarrow> expand_rslt_all__ex_equiv \<xi> nd (snd nm_nds))"
 
 lemma expand_prop_all:
   assumes "expand_assm_incoming n_ns \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (expand_rslt_all \<xi> n_ns)"
     (is "_ \<le> SPEC (?P n_ns)")
   using assms
   apply (rule_tac expand_rec_rule[where \<Phi>="?Q"])
   apply simp
   apply (intro refine_vcg)
 proof goal_cases
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) simp_all
 next
   case (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     and Q: "?Q (n, ns)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(\<lparr>name = expand_new_name (name n),
     incoming = {name n}, new = next n, old = {}, next = {}\<rparr>, {n} \<union> ns)"
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   show ?case
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>p r.
       (expand_assm_exist (suffix 1 \<xi>) ?x \<longrightarrow> expand_rslt_exist (suffix 1 \<xi>) ?x r)
       \<and> expand_rslt_exist_eq p r \<and> (expand_name_ident (snd r))"], goal_cases)
     case 1
     then show ?case
     proof (rule_tac SPEC_rule_conjI,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_prop_exist,
            rule_tac SPEC_rule_conjI,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_rslt_exist_eq,
            rule_tac order_trans,
            rule_tac f_sup,
            rule_tac expand_name_propag__name_ident,
            goal_cases)
       case 1
       then show ?case using Q name_le by force
     qed
   next
     case 2
     then show ?case using Q name_le by (rule_tac step) force
   next
     case prems: (3 nm nds)
     then obtain n' where "n'\<in>nds"
       and eq_node: "expand_rslt_exist_eq__node n n'" by auto
     with prems have ex1_name: "\<exists>!q\<in>nds. name n = name q" by auto
     then have nds_eq: "nds = {n'} \<union> {x \<in> nds. name n \<noteq> name x}"
       using eq_node \<open>n'\<in>nds\<close> by blast
     have name_notin: "name n \<notin> name ` ns" using Q by auto
     from prems have P_x: "expand_rslt_all \<xi> ?x (nm, nds)" by fast
     show ?case
       unfolding snd_conv
     proof clarify
       fix nd
       assume "nd \<in> nds" and name_img: "name nd \<notin> name ` ns"
         and nd_old_equiv: "\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>n \<psi>"
         and nd_next_equiv: "\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>"
       show "expand_rslt_all__ex_equiv \<xi> nd nds"
       proof (cases "name nd = name n")
         case True
         with nds_eq eq_node \<open>nd\<in>nds\<close> have "nd = n'" by auto
         with prems(1)[THEN conjunct1, simplified]
           nd_old_equiv nd_next_equiv eq_node
         show ?thesis by simp
       next
         case False
         with name_img \<open>nd \<in> nds\<close> nd_old_equiv nd_next_equiv P_x
         show ?thesis by simp
       qed
     qed
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC (?P x)"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
           old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
         \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_incoming r
     \<and> expand_rslt_name x r
     \<and> expand_name_ident (snd r)"
   show ?case
     using goal_assms Q
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac order_trans, rule_tac f_sup, rule_tac expand_name_propag) simp
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step) auto
   next
     case prems: (3 nm nds)
     then show ?case
     proof (rule_tac SPEC_rule_weak[where
         P = "?P" and
         Q = "\<lambda>x r. expand_rslt_exist_eq x r \<and> ?props x r"], goal_cases)
       case 1
       then show ?case
         by (rule_tac SPEC_rule_conjI,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_rslt_exist_eq,
                rule_tac order_trans,
                rule_tac f_sup,
                rule_tac expand_name_propag) auto
     next
       case 2
       then show ?case
         by (rule_tac SPEC_rule_param2[where P = "?P"], rule_tac step) auto
     next
       case prems': (3 nm' nds')
       then have P_x: "?P (n, ns) (nm, nds)"
         and P_x': "?P (n, nds) (nm', nds')" by simp_all
       show ?case
         unfolding snd_conv
       proof clarify
         fix nd
         assume "nd\<in>nds'"
           and name_nd_notin: "name nd \<notin> name ` ns"
           and old_equiv: "\<forall>\<psi>\<in>old nd. \<xi> \<Turnstile>\<^sub>n \<psi>"
           and next_equiv: "\<forall>\<psi>\<in>next nd. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>"
         show "expand_rslt_all__ex_equiv \<xi> nd nds'"
         proof (cases "name nd \<in> name ` nds")
           case True
           then obtain n' where "n' \<in> nds" and "name nd = name n'" by auto
           with prems' obtain nd' where "nd'\<in>nds'"
             and nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           moreover from prems' have "\<forall>q\<in>nds'. \<exists>!q'\<in>nds'. name q = name q'"
             by simp
           ultimately have "nd' = nd"
             using \<open>name nd = name n'\<close> \<open>nd \<in> nds'\<close> by auto
           with nd'_eq have n'_eq: "expand_rslt_exist_eq__node n' nd"
             by simp
           then have "name n'\<notin>name ` ns" and "\<forall>\<psi>\<in>old n'. \<xi> \<Turnstile>\<^sub>n \<psi>" and "\<forall>\<psi>\<in>next n'. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>"
             using name_nd_notin old_equiv next_equiv \<open>n' \<in> nds\<close>
             by auto
           then have "expand_rslt_all__ex_equiv \<xi> n' nds"  (is "\<exists>nd'\<in>nds. ?sthm n' nd'")
             using P_x \<open>n' \<in> nds\<close> unfolding snd_conv by blast
           then obtain sucnd where sucnd: "sucnd\<in>nds" and sthm: "?sthm n' sucnd"
             by blast
           moreover
           from prems' sucnd sthm obtain sucnd' where "sucnd'\<in>nds'"
               and sucnd'_eq: "expand_rslt_exist_eq__node sucnd sucnd'"
             by auto
           ultimately have "?sthm n' sucnd'" by auto
           then show ?thesis
             using \<open>sucnd' \<in> nds'\<close>
             unfolding \<open>name nd = name n'\<close> by blast
         next
           case False
           with \<open>nd \<in> nds'\<close> P_x' old_equiv next_equiv
           show ?thesis unfolding snd_conv by blast
         qed
       qed
     qed
   qed
 qed
 
 abbreviation
   "create_graph_rslt_all \<xi> nds
    \<equiv> \<forall>q\<in>nds. (\<forall>\<psi>\<in>old q. \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next q. \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
     \<longrightarrow> (\<exists>q'\<in>nds. name q \<in> incoming q'
          \<and> (\<forall>\<psi>\<in>old q'. suffix 1 \<xi> \<Turnstile>\<^sub>n \<psi>)
          \<and> (\<forall>\<psi>\<in>next q'. suffix 1 \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>)
          \<and> {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old q' \<and> suffix 1 \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> old q')"
 
 lemma L4_5: "create_graph \<phi> \<le> SPEC (create_graph_rslt_all \<xi>)"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_prop_all) (auto simp add:expand_new_name_expand_init)
 
 
 subsection \<open>Creation of GBA\<close>
 
 text \<open>This section formalizes the second part of the algorithm, that creates
   the actual generalized B\"uchi automata from the set of nodes.\<close>
 
 definition create_gba_from_nodes :: "'a frml \<Rightarrow> 'a node set \<Rightarrow> ('a node, 'a set) gba_rec"
 where "create_gba_from_nodes \<phi> qs \<equiv> \<lparr>
   g_V = qs,
   g_E = {(q, q'). q\<in>qs \<and> q'\<in>qs \<and> name q\<in>incoming q'},
   g_V0 = {q\<in>qs. expand_init\<in>incoming q},
   gbg_F = {{q\<in>qs. \<mu> U\<^sub>n \<eta>\<in>old q \<longrightarrow> \<eta>\<in>old q}|\<mu> \<eta>. \<mu> U\<^sub>n \<eta> \<in> subfrmlsn \<phi>},
   gba_L = \<lambda>q l. q\<in>qs \<and> {p. prop\<^sub>n(p)\<in>old q}\<subseteq>l \<and> {p. nprop\<^sub>n(p)\<in>old q} \<inter> l = {}
 \<rparr>"
 
 end
 
 locale create_gba_from_nodes_precond =
   fixes \<phi> :: "'a ltln"
   fixes qs :: "'a node set"
   assumes res: "inres (create_graph \<phi>) qs"
 begin
 
 lemma finite_qs[simp, intro!]: "finite qs"
   using res create_graph_finite by (auto simp add: pw_le_iff)
 
 lemma create_gba_from_nodes__invar: "gba (create_gba_from_nodes \<phi> qs)"
   using [[simproc finite_Collect]]
   apply unfold_locales
   apply (auto
     intro!: finite_vimageI subfrmlsn_finite injI
     simp: create_gba_from_nodes_def)
   done
 
 sublocale gba: gba "create_gba_from_nodes \<phi> qs"
   by (rule create_gba_from_nodes__invar)
 
 lemma create_gba_from_nodes__fin: "finite (g_V (create_gba_from_nodes \<phi> qs))"
   unfolding create_gba_from_nodes_def by auto
 
 lemma create_gba_from_nodes__ipath:
   "ipath gba.E r \<longleftrightarrow> (\<forall>i. r i \<in>qs \<and> name (r i)\<in>incoming (r (Suc i)))"
   unfolding create_gba_from_nodes_def ipath_def
   by auto
 
 lemma create_gba_from_nodes__is_run:
   "gba.is_run r \<longleftrightarrow> expand_init \<in> incoming (r 0)
     \<and> (\<forall>i. r i\<in>qs \<and> name (r i)\<in>incoming (r (Suc i)))"
   unfolding gba.is_run_def
   apply (simp add: create_gba_from_nodes__ipath)
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 
 context
 begin
 
-interpretation LTL_Syntax .
-
 abbreviation
   "auto_run_j j \<xi> q \<equiv>
         (\<forall>\<psi>\<in>old q. suffix j \<xi> \<Turnstile>\<^sub>n \<psi>) \<and> (\<forall>\<psi>\<in>next q. suffix j \<xi> \<Turnstile>\<^sub>n X\<^sub>n \<psi>) \<and>
         {\<eta>. \<exists>\<mu>. \<mu> U\<^sub>n \<eta> \<in> old q \<and> suffix j \<xi> \<Turnstile>\<^sub>n \<eta>} \<subseteq> old q"
 
 fun auto_run :: "['a interprt, 'a node set] \<Rightarrow> 'a node word"
 where
   "auto_run \<xi> nds 0
    = (SOME q. q\<in>nds \<and> expand_init \<in> incoming q \<and> auto_run_j 0 \<xi> q)"
 | "auto_run \<xi> nds (Suc k)
    = (SOME q'. q'\<in>nds \<and> name (auto_run \<xi> nds k) \<in> incoming q'
         \<and> auto_run_j (Suc k) \<xi> q')"
 
 
 (* TODO: Remove. Only special instance of more generic principle
 lemma create_graph_comb:
   assumes "\<And>x. inres (create_graph \<phi>) x \<Longrightarrow> P x"
     shows "create_graph \<phi>\<le>SPEC P"
   using create_graph_nofail assms
   by (auto simp add: pw_le_iff refine_pw_simps)
 *)
 
 lemma run_propag_on_create_graph:
   assumes "ipath gba.E \<sigma>"
   shows "\<sigma> k\<in>qs \<and> name (\<sigma> k)\<in>incoming (\<sigma> (k+1))"
   using assms
   by (auto simp: create_gba_from_nodes__ipath)
 
 lemma expand_false_propag:
   assumes "false\<^sub>n \<notin> old (fst n_ns) \<and> (\<forall>nd\<in>snd n_ns. false\<^sub>n \<notin> old nd)"
     (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. \<forall>nd\<in>snd nm_nds. false\<^sub>n \<notin> old nd)"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case 8
   then show ?case by (rule_tac SPEC_rule_nested2) auto
 qed auto
 
 lemma false_propag_on_create_graph: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. false\<^sub>n \<notin> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_false_propag) auto
 
 
 lemma expand_and_propag:
   assumes "\<mu> and\<^sub>n \<eta> \<in> old (fst n_ns)
     \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old (fst n_ns) \<union> new (fst n_ns)" (is "?Q n_ns")
     and "\<forall>nd\<in>snd n_ns. \<mu> and\<^sub>n \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd" (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case (6 f x n ns)
   then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))
     \<and> \<psi> \<noteq> true\<^sub>n \<and> \<psi> \<noteq> false\<^sub>n
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     by simp_all
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed auto
 
 lemma and_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. \<mu> and\<^sub>n \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_and_propag) auto
 
 lemma expand_or_propag:
   assumes "\<mu> or\<^sub>n \<eta> \<in> old (fst n_ns)
     \<longrightarrow> {\<mu>, \<eta>} \<inter> (old (fst n_ns) \<union> new (fst n_ns)) \<noteq> {}" (is "?Q n_ns")
     and "\<forall>nd\<in>snd n_ns. \<mu> or\<^sub>n \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<inter> old nd \<noteq> {}"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>nm_nds. ?P (snd nm_nds))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case by (simp, rule_tac upd_incoming__ident) auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case (6 f x n ns)
   then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))" by simp
   with prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))
     \<and> \<psi> \<noteq> true\<^sub>n \<and> \<psi> \<noteq> false\<^sub>n
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns"
     and step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>x'. ?P (snd x'))"
     by simp_all
   show ?case
     using goal_assms QP
     unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed auto
 
 lemma or_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. \<mu> or\<^sub>n \<eta> \<in> old nd \<longrightarrow> {\<mu>, \<eta>} \<inter> old nd \<noteq> {})"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans, rule_tac expand_or_propag) auto
 
 
 abbreviation
   "next_propag__assm \<mu> n_ns \<equiv>
      (X\<^sub>n \<mu> \<in> old (fst n_ns) \<longrightarrow> \<mu> \<in> next (fst n_ns))
      \<and> (\<forall>nd\<in>snd n_ns. X\<^sub>n \<mu> \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
         \<longrightarrow> \<mu> \<in> old (fst n_ns) \<union> new (fst n_ns))"
 
 abbreviation
   "next_propag__rslt \<mu> ns \<equiv>
      \<forall>nd\<in>ns. \<forall>nd'\<in>ns. X\<^sub>n \<mu> \<in> old nd \<and> name nd \<in> incoming nd' \<longrightarrow> \<mu> \<in> old nd'"
 
 lemma expand_next_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "next_propag__assm \<mu> n_ns
            \<and> next_propag__rslt \<mu> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. next_propag__rslt \<mu> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems: 1
     {
       fix nd :: "'a node" and nd' :: "'a node"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       have "\<mu> \<in> old nd'" if *: "X\<^sub>n \<mu> \<in> old nd" and **: "name nd \<in> incoming nd'"
       proof (cases "nd'\<in>ns")
         case True
         with prems * ** show ?thesis using \<open>nd\<in>ns\<close> by auto
       next
         case False
         with upd_incoming__elem[of nd' n ns] nd'_elem * **
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n" by auto
         have "\<mu> \<in> old nd'"
         proof (cases "name nd \<in> incoming n")
           case True
           with prems * \<open>nd\<in>ns\<close> have "\<mu> \<in> old n" by auto
           then show ?thesis using nd'_eq old_eq by simp
         next
           case False
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then show ?thesis
             unfolding nd'_eq using \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> * prems by auto
         qed
         then show ?thesis by auto
       qed
     }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
     using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "next_propag__assm \<mu> ?x' \<and> next_propag__rslt \<mu> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
   show ?case
     using \<open>new n = {}\<close>
     unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case
     using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case
       using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
       and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
       and f_sup: "\<And>x. f x \<le> expand x"
     by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
         \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1 then
     show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems': (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems' show ?case
     proof (rule_tac step, goal_cases)
       case prems'': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems'' have nds_ident: "expand_name_ident (snd ?x')" by simp
       moreover
       have "X\<^sub>n \<mu> \<in> old (fst ?x') \<longrightarrow> \<mu>\<in>next (fst ?x')"
       using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems'' have "next_propag__rslt \<mu> (snd ?x')" by simp
       moreover
       from prems'' have name_nds_eq: "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (X\<^sub>n \<mu> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
                        \<longrightarrow> \<mu>\<in>old (fst ?x')\<union>new (fst ?x')"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           moreover
           from prems'' n' obtain nd' where "nd'\<in>nds"
               and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           ultimately have "nd = nd'"
             using nds_ident \<open>nd\<in>nds\<close> loc_assm by auto
           moreover from prems'' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems'' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma next_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. X\<^sub>n \<mu>\<in>old n \<and> name n\<in>incoming n' \<longrightarrow> \<mu>\<in>old n')"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_next_propag) (auto simp add:expand_new_name_expand_init)
 
 
 abbreviation
   "release_propag__assm \<mu> \<eta> n_ns \<equiv>
      (\<mu> V\<^sub>n \<eta> \<in> old (fst n_ns)
       \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old (fst n_ns)\<union>new (fst n_ns) \<or>
          (\<eta>\<in>old (fst n_ns)\<union>new (fst n_ns)) \<and> \<mu> V\<^sub>n \<eta> \<in> next (fst n_ns))
      \<and> (\<forall>nd\<in>snd n_ns.
          \<mu> V\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
          \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old nd \<or>
             (\<eta>\<in>old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old (fst n_ns)\<union>new (fst n_ns)))"
 
 abbreviation
   "release_propag__rslt \<mu> \<eta> ns \<equiv>
      \<forall>nd\<in>ns.
        \<forall>nd'\<in>ns.
          \<mu> V\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
          \<longrightarrow> {\<mu>, \<eta>}\<subseteq>old nd \<or>
             (\<eta>\<in>old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old nd')"
 
 lemma expand_release_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "release_propag__assm \<mu> \<eta> n_ns
            \<and> release_propag__rslt \<mu> \<eta> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. release_propag__rslt \<mu> \<eta> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems: 1
     { fix nd :: "'a node" and nd' :: "'a node"
       let ?V_prop = "\<mu> V\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
         \<longrightarrow> {\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old nd'"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       { assume "nd'\<in>ns"
         with prems have ?V_prop using \<open>nd\<in>ns\<close> by auto }
       moreover
       { assume "nd'\<notin>ns"
           and V_in_nd: "\<mu> V\<^sub>n \<eta> \<in> old nd" and "name nd \<in>incoming nd'"
         with upd_incoming__elem[of nd' n ns] nd'_elem
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n"
           by auto
         { assume "name nd \<in> incoming n"
           with prems V_in_nd \<open>nd\<in>ns\<close>
           have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old n"
             by auto
           then have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old nd'"
             using nd'_eq old_eq by simp }
         moreover
         { assume "name nd \<notin> incoming n"
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old nd'"
             unfolding nd'_eq
             using prems \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> V_in_nd by auto }
         ultimately have "{\<mu>, \<eta>} \<subseteq> old nd \<or> \<eta> \<in> old nd \<and> \<mu> V\<^sub>n \<eta> \<in> old nd'"
           by fast
       }
       ultimately have ?V_prop by auto
     }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
   using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "release_propag__assm \<mu> \<eta> ?x' \<and> release_propag__rslt \<mu> \<eta> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
 
   show ?case using \<open>new n = {}\<close> unfolding \<open>x = (n, ns)\<close>
 
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case
     using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>n" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
       \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
 
   show ?case using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
 
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems': (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems' show ?case
     proof (rule_tac step, goal_cases)
       case prems'': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems'' have nds_ident: "expand_name_ident (snd ?x')" by simp
       moreover
       have "(\<mu> V\<^sub>n \<eta> \<in> old (fst ?x')
              \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old (fst ?x') \<union> new (fst ?x')
                   \<or> (\<eta>\<in>old (fst ?x')\<union>new (fst ?x')
                      \<and> \<mu> V\<^sub>n \<eta> \<in> next (fst ?x'))))"
         using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems'' have "release_propag__rslt \<mu> \<eta> (snd ?x')" by simp
       moreover
       from prems'' have name_nds_eq: "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (\<mu> V\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
                  \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old nd
                       \<or> (\<eta>\<in>old nd \<and> \<mu> V\<^sub>n \<eta> \<in>old (fst ?x')\<union>new (fst ?x')))"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           with prems'' obtain nd' where "nd'\<in>nds"
             and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           with n' have "nd = nd'" using nds_ident \<open>nd\<in>nds\<close> loc_assm
             by auto
           moreover from prems'' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems'' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma release_propag_on_create_graph:
   "create_graph \<phi>
      \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. \<mu> V\<^sub>n \<eta>\<in>old n \<and> name n\<in>incoming n'
                                       \<longrightarrow> ({\<mu>, \<eta>}\<subseteq>old n \<or> \<eta>\<in>old n \<and> \<mu> V\<^sub>n \<eta>\<in>old n'))"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_release_propag) (auto simp add:expand_new_name_expand_init)
 
 
 abbreviation
   "until_propag__assm f g n_ns \<equiv>
      (f U\<^sub>n g \<in> old (fst n_ns)
       \<longrightarrow> (g\<in>old (fst n_ns)\<union>new (fst n_ns)
             \<or> (f\<in>old (fst n_ns)\<union>new (fst n_ns) \<and> f U\<^sub>n g \<in> next (fst n_ns))))
      \<and> (\<forall>nd\<in>snd n_ns. f U\<^sub>n g \<in> old nd \<and> name nd \<in> incoming (fst n_ns)
         \<longrightarrow> (g\<in>old nd \<or> (f\<in>old nd \<and> f U\<^sub>n g \<in>old (fst n_ns)\<union>new (fst n_ns))))"
 
 abbreviation
   "until_propag__rslt f g ns \<equiv>
      \<forall>n\<in>ns. \<forall>nd\<in>ns. f U\<^sub>n g \<in> old n \<and> name n \<in> incoming nd
                                   \<longrightarrow> (g \<in> old n \<or> (f\<in>old n \<and> f U\<^sub>n g \<in> old nd))"
 
 lemma expand_until_propag:
   fixes n_ns :: "_ \<times> 'a node set"
   assumes "until_propag__assm \<mu> \<eta> n_ns
            \<and> until_propag__rslt \<mu> \<eta> (snd n_ns)
            \<and> expand_assm_incoming n_ns
            \<and> expand_name_ident (snd n_ns)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. until_propag__rslt \<mu> \<eta> (snd r))"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case prems': 1
     { fix nd :: "'a node" and nd' :: "'a node"
       let ?U_prop = "\<mu> U\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming nd'
                            \<longrightarrow> \<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>n \<eta> \<in> old nd'"
       assume "nd\<in>ns" and nd'_elem: "nd'\<in>upd_incoming n ns"
       { assume "nd'\<in>ns"
         with prems' have ?U_prop using \<open>nd\<in>ns\<close> by auto }
       moreover
       { assume "nd'\<notin>ns" and
         U_in_nd: "\<mu> U\<^sub>n \<eta> \<in> old nd" and "name nd \<in>incoming nd'"
         with upd_incoming__elem[of nd' n ns] nd'_elem
         obtain nd'' where "nd''\<in>ns"
           and nd'_eq: "nd' = nd''\<lparr>incoming := incoming n \<union> incoming nd''\<rparr>"
           and old_eq: "old nd'' = old n" by auto
         { assume "name nd \<in> incoming n"
           with prems' U_in_nd \<open>nd\<in>ns\<close>
           have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>n \<eta> \<in> old n" by auto
           then have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>n \<eta> \<in> old nd'"
             using nd'_eq old_eq by simp }
         moreover
         { assume "name nd \<notin> incoming n"
           then have "name nd \<in> incoming nd''"
             using \<open>name nd \<in>incoming nd'\<close> nd'_eq by simp
           then have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>n \<eta> \<in> old nd'"
             unfolding nd'_eq
             using prems' \<open>nd\<in>ns\<close> \<open>nd''\<in>ns\<close> U_in_nd by auto }
         ultimately have "\<eta> \<in> old nd \<or> \<mu> \<in> old nd \<and> \<mu> U\<^sub>n \<eta> \<in> old nd'" by fast }
       ultimately have ?U_prop by auto }
     then show ?case by auto
   next
     case 2
     then show ?case by simp
   qed
 next
   case prems: (2 f x n ns)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and f_sup: "\<And>x. f x \<le> expand x"
     by auto
   from prems have Q: "?Q (n, ns)" by auto
   from Q have name_le: "name n < expand_new_name (name n)" by auto
   let ?x' = "(\<lparr>name = expand_new_name (name n),
                incoming = {name n}, new = next n,
                old = {}, next = {}\<rparr>, {n} \<union> ns)"
   have Q'1: "expand_assm_incoming ?x'\<and> expand_name_ident (snd ?x')"
     using \<open>new n = {}\<close> Q[THEN conjunct2, THEN conjunct2] name_le by force
   have Q'2: "until_propag__assm \<mu> \<eta> ?x' \<and> until_propag__rslt \<mu> \<eta> (snd ?x')"
     using Q \<open>new n = {}\<close> by auto
 
   show ?case
     using \<open>new n = {}\<close> unfolding \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak[where
       Q = "\<lambda>_ r. expand_name_ident (snd r)" and P = "\<lambda>_. ?P"], goal_cases)
     case 1
     then show ?case using Q'1
       by (rule_tac order_trans,
         rule_tac f_sup,
         rule_tac expand_name_propag__name_ident) auto
   next
     case 2
     then show ?case using Q'1 Q'2 by (rule_tac step) simp
   next
     case (3 nm nds)
     then show ?case by simp
   qed
 next
   case 3
   then show ?case by auto
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (5 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac SPEC_rule_param2, rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)"
     and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     and f_sup: "\<And>x. f x \<le> expand x" by auto
   let ?x = "(n\<lparr>new := new n - {\<psi>}, new := new1 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
         old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>),
                             next := next1 \<psi> \<union> next (n\<lparr>new := new n - {\<psi>}\<rparr>)
        \<rparr>, ns)"
   let ?props = "\<lambda>x r. expand_rslt_exist_eq x r
     \<and> expand_rslt_incoming r \<and> expand_rslt_name x r \<and> expand_name_ident (snd r)"
 
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_weak_nested2[where Q = "?props ?x"], goal_cases)
     case 1
     then show ?case
       by (rule_tac SPEC_rule_conjI,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_rslt_exist_eq,
              rule_tac order_trans,
              rule_tac f_sup,
              rule_tac expand_name_propag) simp+
   next
     case 2
     then show ?case
       by (rule_tac SPEC_rule_param2[where P = "\<lambda>_. ?P"], rule_tac step) auto
   next
     case prems: (3 nm nds)
     let ?x' = "(n\<lparr>new := new n - {\<psi>},
        name := fst (nm, nds),
        new := new2 \<psi> \<union> new (n\<lparr>new := new n - {\<psi>}\<rparr>),
        old := {\<psi>} \<union> old (n\<lparr>new := new n - {\<psi>}\<rparr>)\<rparr>, nds)"
     from prems show ?case
     proof (rule_tac step, goal_cases)
       case prems': 1
       then have "expand_assm_incoming ?x'" by auto
       moreover
       from prems' have nds_ident: "expand_name_ident (snd ?x')"
         by simp
       moreover
       have "(\<mu> U\<^sub>n \<eta> \<in> old (fst ?x')
              \<longrightarrow> (\<eta>\<in>old (fst ?x')\<union>new (fst ?x')
                   \<or> (\<mu>\<in>old (fst ?x')\<union>new (fst ?x')
                      \<and> \<mu> U\<^sub>n \<eta> \<in> next (fst ?x'))))"
         using Q[THEN conjunct1] goal_assms by auto
       moreover
       from prems' have "until_propag__rslt \<mu> \<eta> (snd ?x')"
         by simp
       moreover
       from prems' have name_nds_eq:
         "name ` nds = name ` ns \<union> name ` {nd\<in>nds. name nd \<ge> name n}"
         by auto
       have "\<forall>nd\<in>nds. (\<mu> U\<^sub>n \<eta> \<in> old nd \<and> name nd \<in> incoming (fst ?x'))
         \<longrightarrow> (\<eta>\<in>old nd \<or> (\<mu>\<in>old nd \<and> \<mu> U\<^sub>n \<eta> \<in>old (fst ?x')\<union>new (fst ?x')))"
        (is "\<forall>nd\<in>nds. ?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd")
       proof
         fix nd
         assume "nd\<in>nds"
         { assume loc_assm: "name nd\<in>name ` ns"
           then obtain n' where n': "n'\<in>ns" "name n' = name nd" by auto
           moreover
           from prems' n' obtain nd' where "nd'\<in>nds"
             and n'_nd'_eq: "expand_rslt_exist_eq__node n' nd'"
             by auto
           ultimately have "nd = nd'"
             using nds_ident \<open>nd\<in>nds\<close> loc_assm by auto
           moreover from prems' have "?assm n n' \<longrightarrow> ?concl n n'"
             using \<open>n'\<in>ns\<close> by auto
           ultimately have "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd"
             using n'_nd'_eq by auto }
         moreover
         { assume "name nd\<notin>name ` ns"
           with name_nds_eq \<open>nd\<in>nds\<close> have "name nd \<ge> name n" by auto
           with prems' have "\<not> (?assm (fst ?x') nd)" by auto }
         ultimately show "?assm (fst ?x') nd \<longrightarrow> ?concl (fst ?x') nd" by auto
       qed
       ultimately show ?case by simp
     qed
   qed
 qed
 
 lemma until_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. \<forall>n'\<in>nds. \<mu> U\<^sub>n \<eta>\<in>old n \<and> name n\<in>incoming n'
     \<longrightarrow> (\<eta>\<in>old n \<or> \<mu>\<in>old n \<and> \<mu> U\<^sub>n \<eta>\<in>old n'))"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_until_propag) (auto simp add:expand_new_name_expand_init)
 
 
 definition all_subfrmls :: "'a node \<Rightarrow> 'a frml set"
   where "all_subfrmls n \<equiv> \<Union>(subfrmlsn ` (new n \<union> old n \<union> next n))"
 
 lemma all_subfrmls__UnionD:
   assumes "(\<Union>x\<in>A. subfrmlsn x) \<subseteq> B"
     and "x\<in>A"
     and "y\<in>subfrmlsn x"
   shows "y\<in>B"
 proof -
   note subfrmlsn_id[of x]
   also have "subfrmlsn x \<subseteq> (\<Union>x\<in>A. subfrmlsn x)"
     using assms by auto
   finally show ?thesis using assms by auto
 qed
 
 
 lemma expand_all_subfrmls_propag:
   assumes "all_subfrmls (fst n_ns) \<subseteq> B \<and> (\<forall>nd\<in>snd n_ns. all_subfrmls nd \<subseteq> B)" (is "?Q n_ns")
   shows "expand n_ns \<le> SPEC (\<lambda>r. \<forall>nd\<in>snd r. all_subfrmls nd \<subseteq> B)"
     (is "_ \<le> SPEC ?P")
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="?Q"], simp, intro refine_vcg, goal_cases)
   case 1
   then show ?case
   proof (simp, rule_tac upd_incoming__ident, goal_cases)
     case 1
     then show ?case by auto
   next
     case 2
     then show ?case by (simp add: all_subfrmls_def)
   qed
 next
   case 2
   then show ?case by (auto simp add: all_subfrmls_def)
 next
   case 3
   then show ?case by (auto simp add: all_subfrmls_def)
 next
   case prems: (4 f)
   then have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" by simp_all
   from prems show ?case by (rule_tac step) (auto simp add: all_subfrmls_def)
 next
   case prems: (5 f _ n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> \<psi> = true\<^sub>n" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case using Q goal_assms
     by (rule_tac step) (auto dest: all_subfrmls__UnionD simp add: all_subfrmls_def)
 next
   case 6
   then show ?case by auto
 next
   case prems: (7 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)" by simp
   from prems have step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P" and Q: "?Q (n, ns)"
     by simp_all
   show ?case
     using Q goal_assms
     by (rule_tac step) (auto dest: all_subfrmls__UnionD simp add: all_subfrmls_def)
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))
     \<and> \<psi> \<noteq> true\<^sub>n \<and> \<psi> \<noteq> false\<^sub>n
     \<and>  \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have Q: "?Q (n, ns)" and step: "\<And>x. ?Q x \<Longrightarrow> f x \<le> SPEC ?P"
     by simp_all
   show ?case
     using goal_assms Q unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case
       by (rule_tac step) (auto dest: all_subfrmls__UnionD simp: all_subfrmls_def)
   next
     case 2
     then show ?case
       by (rule_tac step) (auto dest: all_subfrmls__UnionD simp: all_subfrmls_def)
   qed
 qed
 
 lemma old_propag_on_create_graph: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>n\<in>nds. old n \<subseteq> subfrmlsn \<phi>)"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_all_subfrmls_propag[where B = "subfrmlsn \<phi>"])
    (force simp add:all_subfrmls_def expand_new_name_expand_init)+
 
 lemma L4_2__aux:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> 0)"
     and "\<forall>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)) \<longrightarrow> \<eta> \<notin> old (\<sigma> j)"
   shows "\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i) \<and> \<eta> \<notin> old (\<sigma> i)"
 proof -
   have "\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)" (is "?sbthm j") for j
   proof (induct j)
     show "?sbthm 0" by auto
   next
     fix k
     assume step: "?sbthm k"
     then have \<sigma>_k_prop: "\<eta> \<notin> old (\<sigma> k)
       \<and> \<sigma> k\<in>qs \<and> \<sigma> (Suc k)\<in>qs
       \<and> name (\<sigma> k) \<in> incoming (\<sigma> (Suc k))"
     using assms run_propag_on_create_graph[OF run] by auto
     with inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
     have "{\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> k)" (is "?subsetthm")
     proof (cases k)
       assume "k = 0"
       with assms \<sigma>_k_prop
         inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       show ?subsetthm by auto
     next
       fix l
       assume "k = Suc l"
       then have "{\<mu>, \<mu> U\<^sub>n \<eta>}\<subseteq>old (\<sigma> l) \<and> \<eta>\<notin>old (\<sigma> l)
         \<and> \<sigma> l\<in>qs \<and> \<sigma> k\<in>qs
         \<and> name (\<sigma> l)\<in>incoming (\<sigma> k)"
       using step assms run_propag_on_create_graph[OF run] by auto
       with inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       have "\<mu> U\<^sub>n \<eta>\<in>old (\<sigma> k)" by auto
       with \<sigma>_k_prop
         inres_SPEC[OF res until_propag_on_create_graph[where \<mu> = \<mu> and \<eta> = \<eta>]]
       show ?subsetthm by auto
     qed
     with step show "?sbthm (Suc k)" by (metis less_SucE)
   qed
   with assms show ?thesis by auto
 qed
 
 lemma L4_2a:
   assumes "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> 0)"
   shows "(\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i) \<and> \<eta> \<notin> old (\<sigma> i))
          \<or> (\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j))"
     (is "?A \<or> ?B")
 proof (rule disjCI)
   assume "\<not> ?B"
   then show ?A
     using assms by (rule_tac L4_2__aux) blast+
 qed
 
 lemma L4_2b:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> 0)"
     and ACC: "gba.is_acc \<sigma>"
   shows "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have contr: "\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>}\<subseteq>old(\<sigma> i) \<and> \<eta>\<notin>old(\<sigma> i)"
     using assms L4_2a[of \<sigma> \<mu> \<eta>] by blast
 
   def S \<equiv> "{q \<in> qs. \<mu> U\<^sub>n \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}"
 
   from assms inres_SPEC[OF res old_propag_on_create_graph] create_gba_from_nodes__ipath
   have "\<mu> U\<^sub>n \<eta> \<in> subfrmlsn \<phi>"
     by (metis assms(2) set_mp)
   then have "S\<in>gbg_F(create_gba_from_nodes \<phi> qs)"
     unfolding S_def create_gba_from_nodes_def by auto
   with ACC have 1: "\<exists>\<^sub>\<infinity>i. \<sigma> i \<in> S"
     unfolding gba.is_acc_def by blast
 
   from INFM_EX[OF 1] obtain k where "\<sigma> k \<in> qs" and "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> k) \<longrightarrow> \<eta> \<in> old (\<sigma> k)"
     unfolding S_def by auto
   moreover have "{\<mu>, \<mu> U\<^sub>n \<eta>}\<subseteq>old(\<sigma> k) \<and> \<eta>\<notin>old(\<sigma> k)"
     using contr by auto
   ultimately show False by auto
 qed
 
 lemma L4_2c:
   assumes run: "ipath gba.E \<sigma>"
     and "\<mu> V\<^sub>n \<eta> \<in> old (\<sigma> 0)"
   shows "\<forall>i. \<eta> \<in> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))"
 proof -
   have "{\<eta>, \<mu> V\<^sub>n \<eta>} \<subseteq> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))" (is "?thm i") for i
   proof (induct i)
     case 0
     have "\<sigma> 0\<in>qs \<and> \<sigma> 1\<in>qs \<and> name (\<sigma> 0) \<in> incoming (\<sigma> 1)"
     using create_gba_from_nodes__ipath assms by auto
     then show ?case
       using assms inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
       by auto
   next
     case (Suc k)
     note \<open>?thm k\<close>
     moreover
     { assume "{\<eta>, \<mu> V\<^sub>n \<eta>} \<subseteq> old (\<sigma> k)"
       moreover
       have "\<sigma> k\<in>qs \<and> \<sigma> (Suc k)\<in>qs \<and> name (\<sigma> k) \<in> incoming (\<sigma> (Suc k))"
       using create_gba_from_nodes__ipath assms by auto
       ultimately have "\<mu> \<in> old (\<sigma> k) \<or> \<mu> V\<^sub>n \<eta> \<in> old (\<sigma> (Suc k))"
         using assms inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
         by auto
       moreover
       { assume "\<mu> \<in> old (\<sigma> k)"
         then have ?case by blast }
       moreover
       { assume "\<mu> V\<^sub>n \<eta> \<in> old (\<sigma> (Suc k))"
         moreover
         have "\<sigma> (Suc k)\<in>qs \<and> \<sigma> (Suc (Suc k))\<in>qs
           \<and> name (\<sigma> (Suc k)) \<in> incoming (\<sigma> (Suc (Suc k)))"
         using create_gba_from_nodes__ipath assms by auto
         ultimately have ?case
           using assms
             inres_SPEC[OF res release_propag_on_create_graph, of \<mu> \<eta>]
           by auto }
       ultimately have ?case by fast }
     moreover
     { assume "\<exists>j<k. \<mu> \<in> old (\<sigma> j)"
       then have ?case by auto }
     ultimately show ?case by auto
   qed
   then show ?thesis by auto
 qed
 
 lemma L4_8':
   assumes "ipath gba.E \<sigma>" (is "?inf_run \<sigma>")
     and "gba.is_acc \<sigma>" (is "?gbarel_accept \<sigma>")
     and "\<forall>i. gba.L (\<sigma> i) (\<xi> i)" (is "?lgbarel_accept \<xi> \<sigma>")
     and "\<psi> \<in> old (\<sigma> 0)"
   shows "\<xi> \<Turnstile>\<^sub>n \<psi>"
   using assms
 proof (induct \<psi> arbitrary: \<sigma> \<xi>)
   case LTLnTrue
   show ?case by auto
 next
   case LTLnFalse
   then show ?case
     using inres_SPEC[OF res false_propag_on_create_graph]
       create_gba_from_nodes__ipath
     by (metis)
 next
   case (LTLnProp p)
   then show ?case
     unfolding create_gba_from_nodes_def by auto
 next
   case (LTLnNProp p)
   then show ?case
     unfolding create_gba_from_nodes_def by auto
 next
   case (LTLnAnd \<mu> \<eta>)
   then show ?case
     using inres_SPEC[OF res and_propag_on_create_graph, of \<mu> \<eta>]
       create_gba_from_nodes__ipath
       by (metis insert_subset ltln_semantics.simps(5))
 next
   case (LTLnOr \<mu> \<eta>)
   then have "\<mu> \<in> old (\<sigma> 0) \<or> \<eta> \<in> old (\<sigma> 0)"
     using inres_SPEC[OF res or_propag_on_create_graph, of \<mu> \<eta>]
     create_gba_from_nodes__ipath
     by (metis (full_types) Int_empty_left Int_insert_left_if0)
   moreover have "\<xi> \<Turnstile>\<^sub>n \<mu>" if "\<mu> \<in> old (\<sigma> 0)"
     using LTLnOr that by auto
   moreover have "\<xi> \<Turnstile>\<^sub>n \<eta>" if "\<eta> \<in> old (\<sigma> 0)"
     using LTLnOr that by auto
   ultimately show ?case by auto
 next
   case (LTLnNext \<mu>)
   with create_gba_from_nodes__ipath[of \<sigma>]
   have "\<sigma> 0 \<in> qs \<and> \<sigma> 1 \<in> qs \<and> name (\<sigma> 0) \<in> incoming (\<sigma> 1)"
     by auto
   with inres_SPEC[OF res next_propag_on_create_graph, of \<mu>] have "\<mu>\<in>old (suffix 1 \<sigma> 0)"
     using LTLnNext by auto
   moreover
   have "?inf_run (suffix 1 \<sigma>)"
     and "?gbarel_accept (suffix 1 \<sigma>)"
     and "?lgbarel_accept (suffix 1 \<xi>) (suffix 1 \<sigma> )"
     using LTLnNext create_gba_from_nodes__ipath
     apply -
     apply (metis ipath_suffix)
     apply (auto simp del: suffix_nth) [] (* FIXME:
       "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
     apply auto
     done
   ultimately show ?case using LTLnNext by simp
 next
   case (LTLnUntil \<mu> \<eta>)
   then have "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)) \<and> \<eta> \<in> old (\<sigma> j)"
     using L4_2b by auto
   then obtain j where \<sigma>_pre: "\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> i)" and "\<eta> \<in> old (suffix j \<sigma> 0)"
     by auto
   moreover
   have "?inf_run (suffix j \<sigma>)"
     and "?gbarel_accept (suffix j \<sigma>)"
     and "?lgbarel_accept (suffix j \<xi>) (suffix j \<sigma>)"
     unfolding limit_suffix
     using LTLnUntil create_gba_from_nodes__ipath
     apply -
     apply (metis ipath_suffix)
     apply (auto simp del: suffix_nth) [] (* FIXME:
       "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
     apply auto
     done
   ultimately have "suffix j \<xi> \<Turnstile>\<^sub>n \<eta>"
     using LTLnUntil by simp
   moreover {
     fix i
     assume "i < j"
     have "?inf_run (suffix i \<sigma>)"
       and "?gbarel_accept (suffix i \<sigma>)"
       and "?lgbarel_accept (suffix i \<xi>) (suffix i \<sigma> )"
       unfolding limit_suffix
       using LTLnUntil create_gba_from_nodes__ipath
       apply -
       apply (metis ipath_suffix)
       apply (auto simp del: suffix_nth) [] (* FIXME:
         "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
       apply auto
       done
     moreover have "\<mu>\<in>old (suffix i \<sigma> 0)"
       using \<sigma>_pre \<open>i<j\<close> by auto
     ultimately have "suffix i \<xi> \<Turnstile>\<^sub>n \<mu>" using LTLnUntil by simp
   }
   ultimately show ?case by auto
 next
   case (LTLnRelease \<mu> \<eta>)
   { fix i
     assume "\<eta> \<in> old (\<sigma> i) \<or> (\<exists>j<i. \<mu> \<in> old (\<sigma> j))"
     moreover
     {
       assume *: "\<eta> \<in> old (\<sigma> i)"
       have "?inf_run (suffix i \<sigma>)"
         and "?gbarel_accept (suffix i \<sigma>)"
         and "?lgbarel_accept (suffix i \<xi>) (suffix i \<sigma> )"
         unfolding limit_suffix
         using LTLnRelease create_gba_from_nodes__ipath
         apply -
         apply (metis ipath_suffix)
         apply (auto simp del: suffix_nth) [] (* FIXME:
           "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
         apply auto
         done
       with * have "suffix i \<xi> \<Turnstile>\<^sub>n \<eta>"
         using LTLnRelease by auto
     }
     moreover
     {
       assume "\<exists>j<i. \<mu> \<in> old (\<sigma> j)"
       then obtain j where "j<i" and "\<mu> \<in> old (\<sigma> j)" by auto
       moreover
       have "?inf_run (suffix j \<sigma>)"
         and "?gbarel_accept (suffix j \<sigma>)"
         and "?lgbarel_accept (suffix j \<xi>) (suffix j \<sigma> )" unfolding limit_suffix
         using LTLnRelease create_gba_from_nodes__ipath
         apply -
         apply (metis ipath_suffix)
         apply (auto simp del: suffix_nth) [] (* FIXME:
           "\<lambda>a. suffix i \<sigma> a" is unfolded, but "suffix i \<sigma>" is not! *)
         apply auto
         done
       ultimately have "suffix j \<xi> \<Turnstile>\<^sub>n \<mu>"
         using LTLnRelease by auto
       then have "\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<mu>"
         using \<open>j<i\<close> by auto
     }
     ultimately have "suffix i \<xi> \<Turnstile>\<^sub>n \<eta> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<mu>)" by auto
   }
   then show ?case using LTLnRelease L4_2c by auto
 qed
 
 
 lemma L4_8:
   assumes "gba.is_acc_run \<sigma>"
     and "\<forall>i. gba.L (\<sigma> i) (\<xi> i)"
     and "\<psi> \<in> old (\<sigma> 0)"
   shows "\<xi> \<Turnstile>\<^sub>n \<psi>"
   using assms
   unfolding gba.is_acc_run_def gba.is_run_def
   using L4_8' by blast
 
 lemma expand_expand_init_propag:
   assumes "(\<forall>nm\<in>incoming n'. nm < name n')
            \<and> name n' \<le> name (fst n_ns)
            \<and> (incoming n' \<inter> incoming (fst n_ns) \<noteq> {}
               \<longrightarrow> new n' \<subseteq> old (fst n_ns) \<union> new (fst n_ns))
            " (is "?Q n_ns")
   and "\<forall>nd\<in>snd n_ns. \<forall>nm\<in>incoming n'. nm\<in>incoming nd \<longrightarrow> new n' \<subseteq> old nd"
     (is "?P (snd n_ns)")
   shows "expand n_ns \<le> SPEC (\<lambda>r. name n'\<le>fst r \<and> ?P (snd r))"
   using assms
 proof (rule_tac expand_rec_rule[where \<Phi>="\<lambda>x. ?Q x \<and> ?P (snd x)"],
     simp,
     intro refine_vcg, goal_cases)
   case prems: (1 f x n ns)
   then have goal_assms: "new n = {} \<and> ?Q (n, ns) \<and> ?P ns" by simp
   { fix nd nm
     assume "nd\<in>upd_incoming n ns" and "nm\<in>incoming n'" and "nm\<in>incoming nd"
     { assume "nd\<in>ns"
       with goal_assms \<open>nm\<in>incoming n'\<close> \<open>nm\<in>incoming nd\<close> have "new n' \<subseteq> old nd"
         by auto }
     moreover
     { assume "nd\<notin>ns"
       with upd_incoming__elem[OF \<open>nd\<in>upd_incoming n ns\<close>]
       obtain nd' where "nd'\<in>ns"
                    and nd_eq: "nd = nd'\<lparr>incoming := incoming n \<union> incoming nd'\<rparr>"
                    and old_next_eq: "old nd' = old n \<and> next nd' = next n" by auto
       { assume "nm\<in>incoming nd'"
         with goal_assms \<open>nm\<in>incoming n'\<close> \<open>nd'\<in>ns\<close> have "new n' \<subseteq> old nd"
           unfolding nd_eq by auto }
       moreover
       { assume "nm\<in>incoming n"
         with nd_eq old_next_eq goal_assms \<open>nm\<in>incoming n'\<close>
         have "new n' \<subseteq> old nd"
           by auto }
       ultimately have "new n' \<subseteq> old nd" using \<open>nm\<in>incoming nd\<close> nd_eq by auto }
     ultimately have "new n' \<subseteq> old nd" by fast }
   with prems show ?case by auto
 next
   case prems: (2 f x n ns)
   then have goal_assms: "new n = {} \<and> ?Q (n, ns) \<and> ?P ns" and step: "\<And>x. ?Q x \<and> ?P (snd x)
       \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp_all
   then show ?case
   proof (rule_tac step, goal_cases)
     case prems': 1
     have expand_new_name_less: "name n < expand_new_name (name n)"
       by auto
     moreover have "name n \<notin> incoming n'"
       using goal_assms by auto
     ultimately show ?case using prems' by auto
   qed
 next
   case 3 then show ?case by auto
 next
   case prems: (4 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case prems: (5 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case 6 then show ?case by auto
 next
   case prems: (7 f x n ns)
   then have step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp
   from prems show ?case by (rule_tac step) auto
 next
   case prems: (8 f x n ns \<psi>)
   then have goal_assms: "\<psi> \<in> new n
     \<and> \<not> (\<exists>q. \<psi> = prop\<^sub>n(q) \<or> \<psi> = nprop\<^sub>n(q))
     \<and> \<psi> \<noteq> true\<^sub>n \<and> \<psi> \<noteq> false\<^sub>n
     \<and> \<not> (\<exists>\<nu> \<mu>. \<psi> = \<nu> and\<^sub>n \<mu> \<or> \<psi> = X\<^sub>n \<nu>)
     \<and> (\<exists>\<nu> \<mu>. \<psi> = \<nu> or\<^sub>n \<mu> \<or> \<psi> = \<nu> U\<^sub>n \<mu> \<or> \<psi> = \<nu> V\<^sub>n \<mu>)"
     by (cases \<psi>) auto
   from prems have QP: "?Q (n, ns) \<and> ?P ns" and
     step: "\<And>x. ?Q x \<and> ?P (snd x) \<Longrightarrow> f x \<le> SPEC (\<lambda>r. name n' \<le> fst r \<and> ?P (snd r))"
     by simp_all
   show ?case
     using goal_assms QP unfolding case_prod_unfold \<open>x = (n, ns)\<close>
   proof (rule_tac SPEC_rule_nested2, goal_cases)
     case 1
     then show ?case by (rule_tac step) auto
   next
     case 2
     then show ?case by (rule_tac step) auto
   qed
 qed
 
 lemma expand_init_propag_on_create_graph:
   "create_graph \<phi> \<le> SPEC(\<lambda>nds. \<forall>nd\<in>nds. expand_init\<in>incoming nd \<longrightarrow> \<phi> \<in> old nd)"
   unfolding create_graph_def
   by (intro refine_vcg, rule_tac order_trans,
       rule_tac expand_expand_init_propag[where
           n' = "\<lparr> name = expand_new_name expand_init,
           incoming = {expand_init},
           new = {\<phi>},
           old = {},
           next = {} \<rparr>"]) (auto simp add:expand_new_name_expand_init)
 
 lemma L4_6:
   assumes "q\<in>gba.V0"
   shows "\<phi>\<in>old q"
   using assms inres_SPEC[OF res expand_init_propag_on_create_graph]
   unfolding create_gba_from_nodes_def by auto
 
 lemma L4_9:
   assumes acc: "gba.accept \<xi>"
   shows "\<xi> \<Turnstile>\<^sub>n \<phi>"
 proof -
   from acc obtain \<sigma> where accept: "gba.is_acc_run \<sigma> \<and> (\<forall>i. gba.L (\<sigma> i) (\<xi> i))"
     unfolding gba.accept_def by auto
   then have "\<sigma> 0\<in>gba.V0"
     unfolding gba.is_acc_run_def gba.is_run_def by simp
   with L4_6 have "\<phi>\<in>old (\<sigma> 0)" by auto
   with L4_8 accept show ?thesis by auto
 qed
 
 lemma L4_10:
   assumes "\<xi> \<Turnstile>\<^sub>n \<phi>"
   shows "gba.accept \<xi>"
 proof -
   def \<sigma> \<equiv> "auto_run \<xi> qs"
   let ?G = "create_graph \<phi>"
 
   have \<sigma>_prop_0: "(\<sigma> 0)\<in>qs \<and> expand_init\<in>incoming(\<sigma> 0) \<and> auto_run_j 0 \<xi> (\<sigma> 0)"
     (is "?sbthm")
   using inres_SPEC[OF res L4_7[OF \<open>\<xi> \<Turnstile>\<^sub>n \<phi>\<close>]]
   unfolding \<sigma>_def auto_run.simps by (rule_tac someI_ex, simp) blast
 
   have \<sigma>_valid: "\<forall>j. \<sigma> j \<in> qs \<and> auto_run_j j \<xi> (\<sigma> j)" (is "\<forall>j. ?\<sigma>_valid j")
   proof
     fix j
     show "?\<sigma>_valid j"
     proof(induct j)
       from \<sigma>_prop_0 show "?\<sigma>_valid 0" by fast
     next
       fix k
       assume goal_assms: "\<sigma> k \<in> qs \<and> auto_run_j k \<xi> (\<sigma> k)"
       with inres_SPEC[OF res L4_5, of "suffix k \<xi>"]
       have sbthm: "\<exists>q'. q'\<in>qs \<and> name (\<sigma> k)\<in>incoming q' \<and> auto_run_j (Suc k) \<xi> q'"
         (is "\<exists>q'. ?sbthm q'")
         by auto
       have "?sbthm (\<sigma> (Suc k))" using someI_ex[OF sbthm]
       unfolding \<sigma>_def auto_run.simps by blast
       then show "?\<sigma>_valid (Suc k)" by fast
     qed
   qed
 
   have \<sigma>_prop_Suc: "\<And>k. \<sigma> k\<in> qs \<and> \<sigma> (Suc k)\<in>qs
     \<and> name (\<sigma> k)\<in>incoming (\<sigma> (Suc k))
     \<and> auto_run_j (Suc k) \<xi> (\<sigma> (Suc k))"
   proof -
     fix k
     from \<sigma>_valid have "\<sigma> k \<in> qs" and "auto_run_j k \<xi> (\<sigma> k)" by blast+
     with inres_SPEC[OF res L4_5, of "suffix k \<xi>"]
     have sbthm: "\<exists>q'. q'\<in>qs \<and> name (\<sigma> k)\<in>incoming q'
       \<and> auto_run_j (Suc k) \<xi> q'" (is "\<exists>q'. ?sbthm q'")
       by auto
     show "\<sigma> k\<in> qs \<and> ?sbthm (\<sigma> (Suc k))" using \<open>\<sigma> k\<in>qs\<close> someI_ex[OF sbthm]
       unfolding \<sigma>_def auto_run.simps by blast
   qed
 
   have \<sigma>_vnaccpt:
     "\<forall>k \<mu> \<eta>. \<mu> U\<^sub>n \<eta> \<in> old (\<sigma> k) \<longrightarrow> \<not> (\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i)))"
   proof clarify
     fix k \<mu> \<eta>
     assume U_in: "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> k)"
       and cntr_prm: "\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i))"
     have "suffix k \<xi> \<Turnstile>\<^sub>n \<mu> U\<^sub>n \<eta>"
       using U_in \<sigma>_valid by force
     then obtain i where "suffix (k+i) \<xi> \<Turnstile>\<^sub>n \<eta>" and "\<forall>j<i. suffix (k+j) \<xi> \<Turnstile>\<^sub>n \<mu>"
       by auto
     moreover have "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> (k+i)) \<and> \<eta> \<notin> old (\<sigma> (k+i))"
       using cntr_prm by auto
     ultimately show False
       using \<sigma>_valid by force
   qed
 
   have \<sigma>_exec: "gba.is_run \<sigma>"
     using \<sigma>_prop_0 \<sigma>_prop_Suc \<sigma>_valid
     unfolding gba.is_run_def ipath_def
     unfolding create_gba_from_nodes_def
     by auto
   moreover
   have \<sigma>_vaccpt:
     "\<forall>k \<mu> \<eta>. \<mu> U\<^sub>n \<eta> \<in> old (\<sigma> k) \<longrightarrow>
       (\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> (k+i))) \<and> \<eta> \<in> old (\<sigma> (k+j)))"
   proof(clarify)
     fix k \<mu> \<eta>
     assume U_in: "\<mu> U\<^sub>n \<eta> \<in> old (\<sigma> k)"
     then have "\<not> (\<forall>i. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (suffix k \<sigma> i) \<and> \<eta> \<notin> old (suffix k \<sigma> i))"
       using \<sigma>_vnaccpt[THEN allE, of k] by auto
     moreover have "suffix k \<sigma> 0 \<in> qs" using \<sigma>_valid by auto
     ultimately show "\<exists>j. (\<forall>i<j. {\<mu>, \<mu> U\<^sub>n \<eta>} \<subseteq> old (\<sigma> (k+i))) \<and> \<eta> \<in> old (\<sigma> (k+j))"
       apply -
       apply (rule make_pos_rule'[OF L4_2a])
       apply (fold suffix_def)
       apply (rule ipath_suffix)
       using \<sigma>_exec[unfolded gba.is_run_def]
       apply simp
       using U_in apply simp
       apply simp
       done
   qed
 
   have "gba.is_acc \<sigma>"
     unfolding gba.is_acc_def
   proof
     fix S
     assume "S\<in>gba.F"
     then obtain \<mu> \<eta> where S_eq: "S = {q \<in> qs. \<mu> U\<^sub>n \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}"
       and "\<mu> U\<^sub>n \<eta> \<in> subfrmlsn \<phi>"
       by (auto simp add: create_gba_from_nodes_def)
     have range_subset: "range \<sigma> \<subseteq> qs"
     proof
       fix q
       assume "q\<in>range \<sigma>"
       with full_SetCompr_eq[of \<sigma>] obtain k where "q = \<sigma> k" by auto
       then show "q \<in> qs" using \<sigma>_valid by auto
     qed
     with limit_nonempty[of \<sigma>]
          limit_in_range[of \<sigma>]
          finite_subset[OF range_subset]
          inres_SPEC[OF res create_graph_finite]
     obtain q where q_in_limit: "q \<in> limit \<sigma>" and q_is_node: "q\<in>qs"
       by auto
     show "\<exists>\<^sub>\<infinity>i. \<sigma> i \<in> S"
     proof (cases "\<mu> U\<^sub>n \<eta> \<in> old q")
       case False
       with S_eq q_in_limit q_is_node
       show ?thesis
         by (auto simp: limit_iff_frequent intro: INFM_mono)
     next
       case True
       obtain k where q_eq: "q = \<sigma> k" using q_in_limit
         unfolding limit_iff_frequent by (metis (lifting, full_types) INFM_nat_le)
       have "\<exists>\<^sub>\<infinity> k. \<eta> \<in> old (\<sigma> k)"
         unfolding INFM_nat
       proof (rule ccontr)
         assume "\<not> (\<forall>m. \<exists>n>m. \<eta> \<in> old (\<sigma> n))"
         then obtain m where "\<forall>n>m. \<eta> \<notin> old (\<sigma> n)" by auto
         moreover
         from q_eq q_in_limit limit_iff_frequent[of q \<sigma>] INFM_nat[of "\<lambda>n. \<sigma> n = q"]
         obtain n where "m<n" and \<sigma>n_eq: "\<sigma> n = \<sigma> k" by auto
         moreover
         obtain j where "\<eta> \<in> old (\<sigma> (n+j))"
           using \<sigma>_vaccpt \<open>\<mu> U\<^sub>n \<eta> \<in> old q\<close> unfolding q_eq by (fold \<sigma>n_eq) force
         ultimately show False by auto
       qed
       then have "\<exists>\<^sub>\<infinity> k. \<sigma> k \<in> qs \<and> \<eta> \<in> old (\<sigma> k)"
         using \<sigma>_valid by (auto intro: INF_mono)
       then show "\<exists>\<^sub>\<infinity> k. \<sigma> k \<in> S"
         unfolding S_eq by (rule INFM_mono) simp
     qed
   qed
   moreover have "gba.L (\<sigma> i) (\<xi> i)" for i
   proof -
     from \<sigma>_valid have [simp]: "\<sigma> i \<in> qs" by auto
     have "\<forall>\<psi>\<in>old (\<sigma> i). suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
       using \<sigma>_valid by auto
     then show ?thesis
       unfolding create_gba_from_nodes_def by auto
   qed
   ultimately show ?thesis
     unfolding gba.accept_def gba.is_acc_run_def by blast
 qed
 
 end
 end
 
 lemma create_graph__name_ident: "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>q\<in>nds. \<exists>!q'\<in>nds. name q = name q')"
   unfolding create_graph_def
   by (intro refine_vcg,
     rule_tac order_trans,
     rule_tac expand_name_propag__name_ident)
     (auto simp add:expand_new_name_expand_init)
 
 corollary create_graph__name_inj: "create_graph \<phi> \<le> SPEC (\<lambda>nds. inj_on name nds)"
   by (rule order_trans[OF create_graph__name_ident]) (auto intro: inj_onI)
 
 
 definition
   "create_gba \<phi>
    \<equiv> do { nds \<leftarrow> create_graph\<^sub>T \<phi>;
           RETURN (create_gba_from_nodes \<phi> nds) }"
 
 lemma create_graph_precond: "create_graph \<phi>
   \<le> SPEC (create_gba_from_nodes_precond \<phi>)"
   apply (clarsimp simp: pw_le_iff create_graph_nofail)
   apply unfold_locales
   apply simp
   done
 
 lemma create_gba__invar: "create_gba \<phi> \<le> SPEC gba"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_precond])
   by (rule create_gba_from_nodes_precond.create_gba_from_nodes__invar)
 
 lemma create_gba_acc:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. \<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<phi>)"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_precond])
   using create_gba_from_nodes_precond.L4_9
   using create_gba_from_nodes_precond.L4_10
   by blast
 
 lemma create_gba__name_inj:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. (inj_on name (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__name_inj])
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 lemma create_gba__fin:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. (finite (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_finite])
   apply (auto simp: create_gba_from_nodes_def)
   done
 
 lemma create_graph_old_finite:
   "create_graph \<phi> \<le> SPEC (\<lambda>nds. \<forall>nd\<in>nds. finite (old nd))"
 proof -
   show ?thesis
     unfolding create_graph_def create_graph_eq_create_graph\<^sub>T[symmetric]
     unfolding expand_def
     apply (intro refine_vcg)
     apply (rule_tac order_trans)
     apply (rule_tac REC_le_RECT)
     apply (fold expand\<^sub>T_def)
     apply (rule_tac order_trans[OF expand_term_prop])
     apply auto[1]
     apply (rule_tac SPEC_rule)
     apply auto
     by (metis infinite_super subfrmlsn_finite)
 qed
 
 lemma create_gba__old_fin:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. \<forall>nd\<in>g_V \<A>. finite (old nd))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph_old_finite])
   apply (simp add: create_gba_from_nodes_def)
   done
 
 lemma create_gba__incoming_exists:
   shows "create_gba \<phi>
   \<le> SPEC(\<lambda>\<A>. \<forall>nd\<in>g_V \<A>. incoming nd \<subseteq> insert expand_init (name ` (g_V \<A>)))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__incoming_name_exist])
   apply (auto simp add: create_gba_from_nodes_def)
   done
 
 lemma create_gba__no_init:
   shows "create_gba \<phi> \<le> SPEC(\<lambda>\<A>. expand_init \<notin> name ` (g_V \<A>))"
   unfolding create_gba_def create_graph_eq_create_graph\<^sub>T[symmetric]
   apply (refine_rcg refine_vcg order_trans[OF create_graph__incoming_name_exist])
   apply (auto simp add: create_gba_from_nodes_def)
   done
 
 definition "nds_invars nds \<equiv>
   inj_on name nds
   \<and> finite nds
   \<and> expand_init \<notin> name`nds
   \<and> (\<forall>nd\<in>nds.
     finite (old nd)
     \<and> incoming nd \<subseteq> insert expand_init (name ` nds))"
 
 lemma create_gba_nds_invars: "create_gba \<phi> \<le> SPEC (\<lambda>\<A>. nds_invars (g_V \<A>))"
   using create_gba__name_inj[of \<phi>] create_gba__fin[of \<phi>]
     create_gba__old_fin[of \<phi>] create_gba__incoming_exists[of \<phi>]
     create_gba__no_init[of \<phi>]
   unfolding nds_invars_def
   by (simp add: pw_le_iff)
 
 theorem T4_1:
   "create_gba \<phi> \<le> SPEC(
     \<lambda>\<A>. gba \<A>
     \<and> finite (g_V \<A>)
     \<and> (\<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<phi>)
     \<and> (nds_invars (g_V \<A>)))"
   using create_gba__invar create_gba__fin create_gba_acc create_gba_nds_invars
   apply (simp add: pw_le_iff)
   apply blast
   done
 
 definition "create_name_gba \<phi> \<equiv> do {
   G \<leftarrow> create_gba \<phi>;
   ASSERT (nds_invars (g_V G));
   RETURN (gba_rename name G)
 }"
 
 
 theorem create_name_gba_correct:
   "create_name_gba \<phi> \<le> SPEC(\<lambda>\<A>. gba \<A> \<and> finite (g_V \<A>) \<and> (\<forall>\<xi>. gba.accept \<A> \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<phi>))"
   unfolding create_name_gba_def
   apply (refine_rcg refine_vcg order_trans[OF T4_1])
   apply (simp_all add: nds_invars_def gba_rename_correct)
   done
 
 definition create_name_igba :: "'a::linorder ltln \<Rightarrow> _" where
 "create_name_igba \<phi> \<equiv> do {
   A \<leftarrow> create_name_gba \<phi>;
   A' \<leftarrow> gba_to_idx A;
   stat_set_data_nres (card (g_V A)) (card (g_V0 A')) (igbg_num_acc A');
   RETURN A'
 }"
 
 lemma create_name_igba_correct: "create_name_igba \<phi> \<le> SPEC (\<lambda>G.
   igba G \<and> finite (g_V G) \<and> (\<forall>\<xi>. igba.accept G \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<phi>))"
   unfolding create_name_igba_def
   apply (refine_rcg
     order_trans[OF create_name_gba_correct]
     order_trans[OF gba.gba_to_idx_ext_correct]
     refine_vcg)
   apply clarsimp_all
 proof -
   fix G :: "(nat, 'a set) gba_rec"
   fix A :: "nat set"
   assume 1: "gba G"
   assume 2: "finite (g_V G)" "A \<in> gbg_F G"
   interpret gba G using 1 .
   show "finite A" using finite_V_Fe 2 .
 qed
 
 (* For presentation in paper*)
 context
   notes [refine_vcg] = order_trans[OF create_name_gba_correct]
 begin
 
 lemma "create_name_igba \<phi> \<le> SPEC (\<lambda>G. igba G \<and> (\<forall>\<xi>. igba.accept G \<xi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n \<phi>))"
   unfolding create_name_igba_def
 proof (refine_rcg refine_vcg, clarsimp_all)
   fix G :: "(nat, 'a set) gba_rec"
   assume "gba G"
   then interpret gba G .
   note [refine_vcg] = order_trans[OF gba_to_idx_ext_correct]
 
   assume "\<forall>\<xi>. gba.accept G \<xi> = \<xi> \<Turnstile>\<^sub>n \<phi>" "finite (g_V G)"
   then show "gba_to_idx G \<le> SPEC (\<lambda>G'. igba G' \<and> (\<forall>\<xi>. igba.accept G' \<xi> = \<xi> \<Turnstile>\<^sub>n \<phi>))"
     by (refine_rcg refine_vcg) (auto intro: finite_V_Fe)
 qed
 
 end
 
 end
diff --git a/thys/LTL_to_GBA/LTL_to_GBA_impl.thy b/thys/LTL_to_GBA/LTL_to_GBA_impl.thy
--- a/thys/LTL_to_GBA/LTL_to_GBA_impl.thy
+++ b/thys/LTL_to_GBA/LTL_to_GBA_impl.thy
@@ -1,1161 +1,1163 @@
 section \<open>Refinement to Efficient Code\<close>
 (*
   Author: Peter Lammich
   Inspired by previous version of Alexander Schimpf.
 *)
 theory LTL_to_GBA_impl
 imports 
   LTL_to_GBA
   "../Deriving/Comparator_Generator/Compare_Instances"
   "../CAVA_Automata/Automata_Impl"
   "../CAVA_Automata/CAVA_Base/CAVA_Code_Target"
 begin
 
 subsection \<open>Parametricity Setup Boilerplate\<close>
 
 subsubsection \<open>LTL Formulas\<close>
 derive linorder ltln
 
 inductive_set ltln_rel for R where
   "(LTLnTrue,LTLnTrue) \<in> ltln_rel R"
 | "(LTLnFalse,LTLnFalse) \<in> ltln_rel R"
 | "(a,a')\<in>R \<Longrightarrow> (LTLnProp a,LTLnProp a') \<in> ltln_rel R"
 | "(a,a')\<in>R \<Longrightarrow> (LTLnNProp a,LTLnNProp a') \<in> ltln_rel R"
 | "\<lbrakk>(a,a')\<in>ltln_rel R; (b,b')\<in>ltln_rel R\<rbrakk> 
   \<Longrightarrow> (LTLnAnd a b,LTLnAnd a' b') \<in> ltln_rel R"
 | "\<lbrakk>(a,a')\<in>ltln_rel R; (b,b')\<in>ltln_rel R\<rbrakk> 
   \<Longrightarrow> (LTLnOr a b,LTLnOr a' b') \<in> ltln_rel R"
 | "\<lbrakk>(a,a')\<in>ltln_rel R\<rbrakk> \<Longrightarrow> (LTLnNext a,LTLnNext a') \<in> ltln_rel R"
 | "\<lbrakk>(a,a')\<in>ltln_rel R; (b,b')\<in>ltln_rel R\<rbrakk> 
   \<Longrightarrow> (LTLnUntil a b,LTLnUntil a' b') \<in> ltln_rel R"
 | "\<lbrakk>(a,a')\<in>ltln_rel R; (b,b')\<in>ltln_rel R\<rbrakk> 
   \<Longrightarrow> (LTLnRelease a b,LTLnRelease a' b') \<in> ltln_rel R"
 
 lemmas ltln_rel_induct[induct set] 
   = ltln_rel.induct[unfolded relAPP_def[of ltln_rel, symmetric]]
 lemmas ltln_rel_cases[cases set] 
   = ltln_rel.cases[unfolded relAPP_def[of ltln_rel, symmetric]]
 lemmas ltln_rel_intros 
   = ltln_rel.intros[unfolded relAPP_def[of ltln_rel, symmetric]]
 
 inductive_simps ltln_rel_left_simps[unfolded relAPP_def[of ltln_rel, symmetric]]: 
   "(LTLnTrue,z) \<in> ltln_rel R"
   "(LTLnFalse,z) \<in> ltln_rel R"
   "(LTLnProp p, z) \<in> ltln_rel R"
   "(LTLnNProp p, z) \<in> ltln_rel R"
   "(LTLnAnd a b, z) \<in> ltln_rel R"
   "(LTLnOr a b, z) \<in> ltln_rel R"
   "(LTLnNext a, z) \<in> ltln_rel R"
   "(LTLnUntil a b, z) \<in> ltln_rel R"
   "(LTLnRelease a b, z) \<in> ltln_rel R"
 
 
 lemma ltln_rel_sv[relator_props]: 
   assumes SV: "single_valued R"  
   shows "single_valued (\<langle>R\<rangle>ltln_rel)"
 proof (intro single_valuedI allI impI)
   fix x y z
   assume "(x, y) \<in> \<langle>R\<rangle>ltln_rel" "(x, z) \<in> \<langle>R\<rangle>ltln_rel"
   then show "y=z"
     apply (induction arbitrary: z)
     apply (simp (no_asm_use) only: ltln_rel_left_simps 
       | blast intro: single_valuedD[OF SV])+
     done
 qed
 
 lemma ltln_rel_id[relator_props]: "\<lbrakk> R = Id \<rbrakk> \<Longrightarrow> \<langle>R\<rangle>ltln_rel = Id"
 proof (intro equalityI subsetI, clarsimp_all)
   fix a b
   assume "(a,b)\<in>\<langle>Id\<rangle>ltln_rel"
   then show "a=b"
     by induction auto
 next
   fix a
   show "(a,a)\<in>\<langle>Id\<rangle>ltln_rel"
     by (induction a) (auto intro: ltln_rel_intros)
 qed
 
 lemma ltln_rel_id_simp[simp]:  "\<langle>Id\<rangle>ltln_rel = Id" by (rule ltln_rel_id) simp
 
 
 consts i_ltln :: "interface \<Rightarrow> interface"
 lemmas [autoref_rel_intf] = REL_INTFI[of ltln_rel i_ltln]
 
 thm ltln_rel_intros[no_vars]
 
 lemma ltln_con_param[param, autoref_rules]:
   "(LTLnTrue, LTLnTrue) \<in> \<langle>R\<rangle>ltln_rel"
   "(LTLnFalse, LTLnFalse) \<in> \<langle>R\<rangle>ltln_rel"
   "(LTLnProp, LTLnProp) \<in> R \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnNProp, LTLnNProp) \<in> R \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnAnd, LTLnAnd) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnOr, LTLnOr) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnNext, LTLnNext) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnUntil, LTLnUntil) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel"
   "(LTLnRelease, LTLnRelease) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel"
   by (auto intro: ltln_rel_intros)
 
 lemma case_ltln_param[param, autoref_rules]: 
   "(case_ltln,case_ltln) \<in> Rv \<rightarrow> Rv \<rightarrow> (R \<rightarrow> Rv)
                 \<rightarrow> (R \<rightarrow> Rv)
                   \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv)
                     \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv)
                       \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> Rv)
                         \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv)
                           \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv) \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv"
   apply (clarsimp)
   apply (case_tac ai, simp_all add: ltln_rel_left_simps)
   apply (clarsimp_all)
   apply parametricity+
   done
 
 lemma rec_ltln_param[param, autoref_rules]: 
   "(rec_ltln,rec_ltln) \<in> Rv \<rightarrow> Rv \<rightarrow> (R \<rightarrow> Rv)
                 \<rightarrow> (R \<rightarrow> Rv)
                   \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv \<rightarrow> Rv \<rightarrow> Rv)
                     \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv \<rightarrow> Rv \<rightarrow> Rv)
                       \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> Rv \<rightarrow> Rv)
                         \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv \<rightarrow> Rv \<rightarrow> Rv)
                           \<rightarrow> (\<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv \<rightarrow> Rv \<rightarrow> Rv)
                             \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> Rv"
 proof (clarsimp, goal_cases)
   case prems: 1
   from prems(10)
   show ?case 
     apply (induction)
     using prems(1-9)
     apply simp_all
     apply parametricity+
     done
 qed
 
 lemma case_ltln_mono[refine_mono]: 
   assumes "\<phi> = LTLnTrue \<Longrightarrow> a\<le>a'"
   assumes "\<phi> = LTLnFalse \<Longrightarrow> b\<le>b'"
   assumes "\<And>p. \<phi> = LTLnProp p \<Longrightarrow> c p\<le>c' p"
   assumes "\<And>p. \<phi> = LTLnNProp p \<Longrightarrow> d p\<le>d' p"
   assumes "\<And>\<mu> \<nu>. \<phi> = LTLnAnd \<mu> \<nu> \<Longrightarrow> e \<mu> \<nu>\<le>e' \<mu> \<nu>"
   assumes "\<And>\<mu> \<nu>. \<phi> = LTLnOr \<mu> \<nu> \<Longrightarrow> f \<mu> \<nu>\<le>f' \<mu> \<nu>"
   assumes "\<And>\<mu>. \<phi> = LTLnNext \<mu> \<Longrightarrow> g \<mu>\<le>g' \<mu>"
   assumes "\<And>\<mu> \<nu>. \<phi> = LTLnUntil \<mu> \<nu> \<Longrightarrow> h \<mu> \<nu>\<le>h' \<mu> \<nu>"
   assumes "\<And>\<mu> \<nu>. \<phi> = LTLnRelease \<mu> \<nu> \<Longrightarrow> i \<mu> \<nu>\<le>i' \<mu> \<nu>"
   shows "case_ltln a b c d e f g h i \<phi> \<le> case_ltln a' b' c' d' e' f' g' h' i' \<phi>"
   using assms
   apply (cases \<phi>)
   apply simp_all
   done
 
 
 primrec ltln_eq where
   "ltln_eq eq LTLnTrue f \<longleftrightarrow> (case f of LTLnTrue \<Rightarrow> True | _ \<Rightarrow> False)"
 | "ltln_eq eq LTLnFalse f \<longleftrightarrow> (case f of LTLnFalse \<Rightarrow> True | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnProp p) f \<longleftrightarrow> (case f of LTLnProp p' \<Rightarrow> eq p p' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnNProp p) f \<longleftrightarrow> (case f of LTLnNProp p' \<Rightarrow> eq p p' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnAnd \<mu> \<nu>) f 
   \<longleftrightarrow> (case f of LTLnAnd \<mu>' \<nu>' \<Rightarrow> ltln_eq eq \<mu> \<mu>' \<and> ltln_eq eq \<nu> \<nu>' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnOr \<mu> \<nu>) f 
   \<longleftrightarrow> (case f of LTLnOr \<mu>' \<nu>' \<Rightarrow> ltln_eq eq \<mu> \<mu>' \<and> ltln_eq eq \<nu> \<nu>' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnNext \<phi>) f 
   \<longleftrightarrow> (case f of LTLnNext \<phi>' \<Rightarrow> ltln_eq eq \<phi> \<phi>' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnUntil \<mu> \<nu>) f 
   \<longleftrightarrow> (case f of LTLnUntil \<mu>' \<nu>' \<Rightarrow> ltln_eq eq \<mu> \<mu>' \<and> ltln_eq eq \<nu> \<nu>' | _ \<Rightarrow> False)"
 | "ltln_eq eq (LTLnRelease \<mu> \<nu>) f 
   \<longleftrightarrow> (case f of 
     LTLnRelease \<mu>' \<nu>' \<Rightarrow> ltln_eq eq \<mu> \<mu>' \<and> ltln_eq eq \<nu> \<nu>' 
   | _ \<Rightarrow> False)"
 
 lemma ltln_eq_autoref[autoref_rules]:
   assumes EQP: "(eq,op=) \<in> R \<rightarrow> R \<rightarrow> bool_rel"
   shows "(ltln_eq eq, op=) \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> bool_rel"
 proof (intro fun_relI)
   fix \<mu>' \<mu> \<nu>' \<nu>
   assume "(\<mu>',\<mu>)\<in>\<langle>R\<rangle>ltln_rel" and "(\<nu>',\<nu>)\<in>\<langle>R\<rangle>ltln_rel"
   then show "(ltln_eq eq \<mu>' \<nu>', \<mu>=\<nu>)\<in>bool_rel"
     apply (induction arbitrary: \<nu>' \<nu>)
     apply (erule ltln_rel_cases, simp_all) []
     apply (erule ltln_rel_cases, simp_all) []
     apply (erule ltln_rel_cases, 
       simp_all add: EQP[THEN fun_relD, THEN fun_relD, THEN IdD]) []
     apply (erule ltln_rel_cases, 
       simp_all add: EQP[THEN fun_relD, THEN fun_relD, THEN IdD]) []
     apply (rotate_tac -1)
     apply (erule ltln_rel_cases, simp_all) []
     apply (rotate_tac -1)
     apply (erule ltln_rel_cases, simp_all) []
     apply (rotate_tac -1)
     apply (erule ltln_rel_cases, simp_all) []
     apply (rotate_tac -1)
     apply (erule ltln_rel_cases, simp_all) []
     apply (rotate_tac -1)
     apply (erule ltln_rel_cases, simp_all) []
     done
 qed
 
 
 lemma ltln_dflt_cmp[autoref_rules_raw]: 
   assumes "PREFER_id R"
   shows
   "(dflt_cmp op \<le> op <, dflt_cmp op \<le> op <) 
   \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> comp_res_rel"
   using assms
   by simp
 
 
 
 type_synonym
   node_name_impl = node_name 
 
 abbreviation (input) "node_name_rel \<equiv> Id :: (node_name_impl\<times>node_name) set"
 
 
 lemma case_ltln_gtransfer:
   assumes
   "\<gamma> ai \<le> a"
   "\<gamma> bi \<le> b"
   "\<And>a. \<gamma> (ci a) \<le> c a"
   "\<And>a. \<gamma> (di a) \<le> d a"
   "\<And>ltln1 ltln2. \<gamma> (ei ltln1 ltln2) \<le> e ltln1 ltln2"
   "\<And>ltln1 ltln2. \<gamma> (fi ltln1 ltln2) \<le> f ltln1 ltln2"
   "\<And>ltln. \<gamma> (gi ltln) \<le> g ltln"
   "\<And>ltln1 ltln2. \<gamma> (hi ltln1 ltln2) \<le> h ltln1 ltln2"
-  "\<And>ltln1 ltln2. \<gamma> (ii ltln1 ltln2) \<le> i ltln1 ltln2"
-  shows "\<gamma> (case_ltln ai bi ci di ei fi gi hi ii \<phi>) 
+  "\<And>ltln1 ltln2. \<gamma> (iiv ltln1 ltln2) \<le> i ltln1 ltln2"
+  shows "\<gamma> (case_ltln ai bi ci di ei fi gi hi iiv \<phi>) 
     \<le> (case_ltln a b c d e f g h i \<phi>)"
   apply (cases \<phi>)
   apply (auto intro: assms)
   done
 
 lemmas [refine_transfer] 
   = case_ltln_gtransfer[where \<gamma>=nres_of] case_ltln_gtransfer[where \<gamma>=RETURN]
 
 lemma [refine_transfer]:
   assumes 
   "ai \<noteq> dSUCCEED"
   "bi \<noteq> dSUCCEED"
   "\<And>a. ci a \<noteq> dSUCCEED"
   "\<And>a. di a \<noteq> dSUCCEED"
   "\<And>ltln1 ltln2. ei ltln1 ltln2 \<noteq> dSUCCEED"
   "\<And>ltln1 ltln2. fi ltln1 ltln2 \<noteq> dSUCCEED"
   "\<And>ltln. gi ltln \<noteq> dSUCCEED"
   "\<And>ltln1 ltln2. hi ltln1 ltln2 \<noteq> dSUCCEED"
-  "\<And>ltln1 ltln2. ii ltln1 ltln2 \<noteq> dSUCCEED"
-  shows "case_ltln ai bi ci di ei fi gi hi ii \<phi> \<noteq> dSUCCEED"
+  "\<And>ltln1 ltln2. iiv ltln1 ltln2 \<noteq> dSUCCEED"
+  shows "case_ltln ai bi ci di ei fi gi hi iiv \<phi> \<noteq> dSUCCEED"
   apply (cases \<phi>)
   apply (simp_all add: assms)
   done
 
+hide_const (open) Re
+
 
 subsubsection \<open>Nodes\<close>
 
 record 'a node_impl =
   name_impl   :: node_name_impl
   incoming_impl :: "(node_name_impl,unit) RBT_Impl.rbt"
   new_impl :: "'a frml list"
   old_impl :: "'a frml list"
   next_impl :: "'a frml list"
 
+
+
 definition node_rel where node_rel_def_internal: "node_rel Re R \<equiv> {( 
   \<lparr> name_impl = namei, 
     incoming_impl = inci, 
     new_impl = newi,
     old_impl = oldi,
     next_impl = nexti,
     \<dots> = morei
   \<rparr>, 
   \<lparr> name = name,
     incoming = inc,
     new=new,
     old=old,
     next = next,
     \<dots> = more
   \<rparr> ) | namei name inci inc newi new oldi old nexti next morei more. 
     (namei,name)\<in>node_name_rel 
   \<and> (inci,inc)\<in>\<langle>node_name_rel\<rangle>dflt_rs_rel 
   \<and> (newi,new)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (oldi,old)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (nexti,next)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (morei,more)\<in>Re
   }"
 
 lemma node_rel_def: "\<langle>Re,R\<rangle>node_rel = {( 
   \<lparr> name_impl = namei, 
     incoming_impl = inci, 
     new_impl = newi,
     old_impl = oldi,
     next_impl = nexti,
     \<dots> = morei
   \<rparr>, 
   \<lparr> name = name,
     incoming = inc,
     new=new,
     old=old,
     next = next,
     \<dots> = more
   \<rparr> ) | namei name inci inc newi new oldi old nexti next morei more. 
     (namei,name)\<in>node_name_rel 
   \<and> (inci,inc)\<in>\<langle>node_name_rel\<rangle>dflt_rs_rel  
   \<and> (newi,new)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (oldi,old)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (nexti,next)\<in>\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel
   \<and> (morei,more)\<in>Re
   }" by (simp add: node_rel_def_internal relAPP_def)
 
 
 lemma node_rel_sv[relator_props]: 
   "single_valued Re \<Longrightarrow> single_valued R \<Longrightarrow> single_valued (\<langle>Re,R\<rangle>node_rel)"
   apply (rule single_valuedI)
   apply (simp add: node_rel_def)
   apply (auto 
     dest: single_valuedD lss.rel_sv[OF ltln_rel_sv] map2set_rel_sv[OF ahm_rel_sv] 
     dest: single_valuedD[
       OF map2set_rel_sv[OF rbt_map_rel_sv[OF single_valued_Id single_valued_Id]]
     ])
   done
 
 consts i_node :: "interface \<Rightarrow> interface \<Rightarrow> interface"
 
 lemmas [autoref_rel_intf] = REL_INTFI[of node_rel i_node]
 
 lemma [autoref_rules]: "(node_impl_ext, node_ext) \<in> 
   node_name_rel 
   \<rightarrow> \<langle>node_name_rel\<rangle>dflt_rs_rel 
   \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel 
   \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel 
   \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel 
   \<rightarrow> Re 
   \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   unfolding node_rel_def
   by auto
 
 
 term node.incoming_update
 
 lemma [autoref_rules]: 
   "(node_impl.name_impl_update,node.name_update) 
   \<in> (node_name_rel \<rightarrow> node_name_rel) \<rightarrow> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   "(node_impl.incoming_impl_update,node.incoming_update) 
   \<in> (\<langle>node_name_rel\<rangle>dflt_rs_rel \<rightarrow> \<langle>node_name_rel\<rangle>dflt_rs_rel) 
     \<rightarrow> \<langle>Re,R\<rangle>node_rel 
     \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   "(node_impl.new_impl_update,node.new_update) 
   \<in> (\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel) \<rightarrow> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   "(node_impl.old_impl_update,node.old_update) 
   \<in> (\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel) \<rightarrow> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   "(node_impl.next_impl_update,node.next_update) 
   \<in> (\<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel) \<rightarrow> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   "(node_impl.more_update,node.more_update) 
   \<in> (Re \<rightarrow> Re) \<rightarrow> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>Re,R\<rangle>node_rel"
   unfolding node_rel_def
   by (auto dest: fun_relD)
 
 term name
 lemma [autoref_rules]:
   "(node_impl.name_impl,node.name)\<in>\<langle>Re,R\<rangle>node_rel \<rightarrow> node_name_rel"
   "(node_impl.incoming_impl,node.incoming)
   \<in> \<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>node_name_rel\<rangle>dflt_rs_rel"
   "(node_impl.new_impl,node.new)\<in>\<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel"
   "(node_impl.old_impl,node.old)\<in>\<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel"
   "(node_impl.next_impl,node.next)\<in>\<langle>Re,R\<rangle>node_rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel\<rangle>lss.rel"
   "(node_impl.more, node.more)\<in>\<langle>Re,R\<rangle>node_rel \<rightarrow> Re"
   unfolding node_rel_def by auto
 
 
 subsection \<open>Massaging the Abstract Algorithm\<close>
 text \<open>
   In a first step, we do some refinement steps on the abstract data structures,
   with the goal to make the algorithm more efficient.
 \<close>
 
 subsubsection \<open>Creation of the Nodes\<close>
 text \<open>
   In the expand-algorithm, we replace nested conditionals by case-distinctions,
   and slightly stratify the code.
 \<close>
 
+hide_const (open) exp
+
 abbreviation (input) "expand2 exp n ns \<phi> n1 nx1 n2 \<equiv> do {
     (nm, nds) \<leftarrow> exp (
       n\<lparr> 
         new := insert n1 (new n), 
         old := insert \<phi> (old n), 
         next := nx1 \<union> next n \<rparr>, 
       ns);
     exp (n\<lparr> name := nm, new := n2 \<union> new n, old := {\<phi>} \<union> old n \<rparr>, nds)
   }"
 
 
-context begin interpretation LTL_Syntax .
 
 definition "expand_aimpl \<equiv> REC\<^sub>T (\<lambda>expand (n,ns). 
       if new n = {} then ( 
         if (\<exists>n'\<in>ns. old n' = old n \<and> next n' = next n) then 
           RETURN (name n, upd_incoming n ns)
         else do {
           ASSERT (n \<notin> ns);
           ASSERT (name n \<notin> name`ns);
           expand (\<lparr> 
             name=expand_new_name (name n), 
             incoming={name n}, 
             new=next n, 
             old={}, 
             next={} \<rparr>, 
             insert n ns)
         }
       ) else do { 
         \<phi> \<leftarrow> SPEC (\<lambda>x. x\<in>(new n));
         let n = n\<lparr> new := new n - {\<phi>} \<rparr>;
         case \<phi> of
           prop\<^sub>n(q) \<Rightarrow> 
             if nprop\<^sub>n(q)\<in>old n then RETURN (name n, ns)
             else expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns)
         | nprop\<^sub>n(q) \<Rightarrow> 
             if prop\<^sub>n(q)\<in>old n then RETURN (name n, ns)
             else expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns)
         | true\<^sub>n \<Rightarrow> expand (n\<lparr> old := {\<phi>} \<union> old n \<rparr>, ns)
         | false\<^sub>n \<Rightarrow> RETURN (name n, ns)
         | \<nu> and\<^sub>n \<mu> \<Rightarrow> expand (n\<lparr> 
             new := insert \<nu> (insert \<mu> (new n)), 
             old := {\<phi>} \<union> old n, 
             next := next n \<rparr>, ns)
         | X\<^sub>n \<nu> \<Rightarrow> expand 
             (n\<lparr> new := new n, old := {\<phi>} \<union> old n, next := insert \<nu> (next n) \<rparr>, ns)
         | \<mu> or\<^sub>n \<nu> \<Rightarrow> expand2 expand n ns \<phi> \<mu> {} {\<nu>}
         | \<mu> U\<^sub>n \<nu> \<Rightarrow> expand2 expand n ns \<phi> \<mu> {\<phi>} {\<nu>}
         | \<mu> V\<^sub>n \<nu> \<Rightarrow> expand2 expand n ns \<phi> \<nu> {\<phi>} {\<mu>,\<nu>}
         (*| _ \<Rightarrow> do {
           (nm, nds) \<leftarrow> expand (
             n\<lparr> 
               new := new1 \<phi> \<union> new n, 
               old := {\<phi>} \<union> old n, 
               next := next1 \<phi> \<union> next n \<rparr>,
             ns);
           expand (n\<lparr> name := nm, new := new2 \<phi> \<union> new n, old := {\<phi>} \<union> old n \<rparr>, nds)
         }*)
       }
      )"
 
-end
 
 lemma expand_aimpl_refine:
   fixes n_ns :: "('a node \<times> _)"
   defines "R \<equiv> Id \<inter> {(_,(n,ns)). \<forall>n'\<in>ns. n > name n'}"
   defines "R' \<equiv> Id \<inter> {(_,(n,ns)). \<forall>n'\<in>ns. name n > name n'}"
   assumes [refine]: "(n_ns',n_ns)\<in>R'"
   shows "expand_aimpl n_ns' \<le> \<Down>R (expand\<^sub>T n_ns)"
   using [[goals_limit = 1]]
 proof -
   have [relator_props]: "single_valued R" 
     by (auto simp add: R_def intro: single_valuedI)
   have [relator_props]: "single_valued R'" 
     by (auto simp add: R'_def intro: single_valuedI)
 
   {
     fix n :: "'a node" and ns and n' ns'
     assume "((n', ns'), (n, ns)) \<in> R'"
     then have "(RETURN (name n', ns') \<le> \<Down> R (RETURN (name n, ns)))"
       by (auto simp: R_def R'_def pw_le_iff refine_pw_simps)
   } note aux = this
 
 
   show ?thesis
     unfolding expand_aimpl_def expand\<^sub>T_def
     apply refine_rcg
     apply (simp add: R_def R'_def)
     apply (simp add: R_def R'_def)
     apply (auto simp add: R_def R'_def upd_incoming_def) []
     apply (auto simp add: R_def R'_def upd_incoming_def) []
     apply (auto simp add: R_def R'_def upd_incoming_def) []
     apply rprems
     apply (auto simp: R'_def expand_new_name_def) []
     apply (simp add: R'_def)
 
     apply (auto split: ltln.split) []
     apply (fastforce simp: R_def R'_def) []
     apply (fastforce simp: R_def R'_def) []
 
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (auto simp: R_def R'_def) []
     apply (refine_rcg, rprems, (fastforce simp: R_def R'_def)+) []
     apply (fastforce simp: R'_def) []
     apply (refine_rcg, rprems, (fastforce simp: R_def R'_def)+) []
     apply (refine_rcg, rprems, (fastforce simp: R_def R'_def)+) []
     done
 qed
 
 
 thm create_graph_def
 definition "create_graph_aimpl \<phi> = do {
   (_, nds) \<leftarrow>
   expand_aimpl
    (\<lparr>name = expand_new_name expand_init, incoming = {expand_init},
        new = {\<phi>}, old = {}, next = {}\<rparr>,
     {});
   RETURN nds
 }"
 
 lemma create_graph_aimpl_refine: "create_graph_aimpl \<phi> \<le> \<Down>Id (create_graph\<^sub>T \<phi>)"
   unfolding create_graph_aimpl_def create_graph\<^sub>T_def
   apply (refine_rcg expand_aimpl_refine)
   apply auto
   done
 
 subsubsection \<open>Creation of GBA from Nodes\<close>
 
 text \<open>
   We summarize creation of the GBA and renaming of the nodes into one step
 \<close>
 lemma create_name_gba_alt: "create_name_gba \<phi> = do {
   nds \<leftarrow> create_graph\<^sub>T \<phi>;
   ASSERT (nds_invars nds);
   RETURN (gba_rename_ext (\<lambda>_. ()) name (create_gba_from_nodes \<phi> nds))
   }"
 proof -
   have [simp]: "\<And>nds. g_V (create_gba_from_nodes \<phi> nds) = nds"
     by (auto simp: create_gba_from_nodes_def)
 
   show ?thesis
     unfolding create_name_gba_def create_gba_def
     by simp
 qed
 
 text \<open>In the following, we implement the componenents of the
   renamed GBA separately.
 \<close>
 
 text \<open>\paragraph{Successor Function}\<close>
 
 definition "build_succ nds = 
   FOREACH 
     nds (\<lambda>q' s.
     FOREACH
       (incoming q') (\<lambda>qn s. 
         if qn=expand_init then 
           RETURN s 
         else 
           RETURN (s(qn \<mapsto> insert (name q') (the_default {} (s qn))))
     ) s
   ) Map.empty"
 
 lemma build_succ_aux1:
   assumes [simp]: "finite nds"
   assumes [simp]: "\<And>q. q\<in>nds \<Longrightarrow> finite (incoming q)"
   shows "build_succ nds \<le> SPEC (\<lambda>r. r = (\<lambda>qn. 
   dflt_None_set {qn'. \<exists>q'. 
     q'\<in>nds \<and> qn' = name q' \<and> qn\<in>incoming q' \<and> qn\<noteq>expand_init 
   }))"
   unfolding build_succ_def
   apply (refine_rcg refine_vcg 
     FOREACH_rule[where
       I="\<lambda>it s. s = (\<lambda>qn. dflt_None_set {qn'. \<exists>q'. q'\<in>nds-it \<and> qn' = name q' 
     \<and> qn\<in>incoming q' \<and> qn\<noteq>expand_init })"])
 
   apply (simp_all add: dflt_None_set_def) [2]
   apply (rename_tac q' it s)
   apply (rule_tac I="\<lambda>it2 s. s = 
     (\<lambda>qn. dflt_None_set (
       {qn'. \<exists>q'. q'\<in>nds-it \<and> qn' = name q' \<and> qn\<in>incoming q' \<and> qn\<noteq>expand_init } \<union> 
       {qn' . qn'=name q' \<and> qn\<in>incoming q' - it2 \<and> qn\<noteq>expand_init} ))" 
     in FOREACH_rule)
 
   apply auto []
 
   apply (simp_all add: dflt_None_set_def)
 
   apply (refine_rcg refine_vcg)
   apply (auto simp: dflt_None_set_def intro!: ext) []
   apply (rule ext, (auto) [])+
   done
 
 lemma build_succ_aux2:
   assumes NINIT: "expand_init \<notin> name`nds"
   assumes CL: "\<And>nd. nd\<in>nds \<Longrightarrow> incoming nd \<subseteq> insert expand_init (name`nds)"
   shows
   "(\<lambda>qn. dflt_None_set 
     {qn'. \<exists>q'. q'\<in>nds \<and> qn' = name q' \<and> qn\<in>incoming q' \<and> qn\<noteq>expand_init }) 
   = (\<lambda>qn. dflt_None_set (succ_of_E 
        (rename_E name {(q, q'). q \<in> nds \<and> q' \<in> nds \<and> name q \<in> incoming q'}) qn))" 
   (is "(\<lambda>qn. dflt_None_set (?L qn)) = (\<lambda>qn. dflt_None_set (?R qn))")
   apply (intro ext)
   apply (fo_rule arg_cong)
 proof (intro ext equalityI subsetI)
   fix qn x
   assume "x\<in>?R qn"
   then show "x\<in>?L qn" using NINIT
     by (force simp: succ_of_E_def)
 next
   fix qn x
   assume XL: "x\<in>?L qn"
   show "x\<in>?R qn"
   proof (cases "qn = expand_init")
     case False
     from XL obtain q' where 
       A: "q'\<in>nds" "qn\<in>incoming q'" 
       and [simp]: "x=name q'" 
       by auto
     from False obtain q where B: "q\<in>nds" and [simp]: "qn = name q"
       using CL A by auto
 
     from A B show "x\<in>?R qn"
       by (auto simp: succ_of_E_def image_def)
   next
     case [simp]: True
     from XL show "x\<in>?R qn" by simp
   qed
 qed
 
 lemma build_succ_correct:
   assumes NINIT: "expand_init \<notin> name`nds"
   assumes FIN: "finite nds"
   assumes CL: "\<And>nd. nd\<in>nds \<Longrightarrow> incoming nd \<subseteq> insert expand_init (name`nds)"
   shows "build_succ nds \<le> SPEC (\<lambda>r. 
     E_of_succ (\<lambda>qn. the_default {} (r qn)) 
     = rename_E (\<lambda>u. name u) {(q, q'). q \<in> nds \<and> q' \<in> nds \<and> name q \<in> incoming q'})"
 proof -
   from FIN CL have FIN': "\<And>q. q\<in>nds \<Longrightarrow> finite (incoming q)"
     by (metis finite_imageI finite_insert infinite_super)
   
   note build_succ_aux1[OF FIN FIN']
   also note build_succ_aux2[OF NINIT CL]
   finally show ?thesis
     by (rule order_trans) auto
 qed
 
 text \<open>\paragraph{ Accepting Sets}\<close>
 
-context begin interpretation LTL_Syntax .
 primrec until_frmlsn :: "'a frml \<Rightarrow> ('a frml \<times> 'a frml) set" where
   "until_frmlsn (\<mu> and\<^sub>n \<psi>) = (until_frmlsn \<mu>) \<union> (until_frmlsn \<psi>)"
 | "until_frmlsn (X\<^sub>n \<mu>) = until_frmlsn \<mu>"
 | "until_frmlsn (\<mu> U\<^sub>n \<psi>) = insert (\<mu>, \<psi>) ((until_frmlsn \<mu>) \<union> (until_frmlsn \<psi>))"
 | "until_frmlsn (\<mu> V\<^sub>n \<psi>) = (until_frmlsn \<mu>) \<union> (until_frmlsn \<psi>)"
 | "until_frmlsn (\<mu> or\<^sub>n \<psi>) = (until_frmlsn \<mu>) \<union> (until_frmlsn \<psi>)"
 | "until_frmlsn (true\<^sub>n) = {}"
 | "until_frmlsn (false\<^sub>n) = {}"
 | "until_frmlsn (prop\<^sub>n(_)) = {}"
 | "until_frmlsn (nprop\<^sub>n(_)) = {}"
 
-end
-
 lemma until_frmlsn_correct: 
   "until_frmlsn \<phi> = {(\<mu>, \<eta>). LTLnUntil \<mu> \<eta> \<in> subfrmlsn \<phi>}"
   by (induct \<phi>) auto
 
 
 definition "build_F nds \<phi> 
   \<equiv> (\<lambda>(\<mu>,\<eta>). name ` {q \<in> nds. (LTLnUntil \<mu> \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q)}) `
     until_frmlsn \<phi>"
 
 lemma build_F_correct: "build_F nds \<phi> = 
   {name ` A |A. \<exists>\<mu> \<eta>. A = {q \<in> nds. LTLnUntil \<mu> \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q} \<and>
                      LTLnUntil \<mu> \<eta> \<in> subfrmlsn \<phi>}"
 proof -
   have "{name ` A |A. \<exists>\<mu> \<eta>. A = {q \<in> nds. LTLnUntil \<mu> \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q} \<and>
                      LTLnUntil \<mu> \<eta> \<in> subfrmlsn \<phi>}
     = (\<lambda>(\<mu>,\<eta>). name`{q\<in>nds. LTLnUntil \<mu> \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}) 
       ` {(\<mu>, \<eta>). LTLnUntil \<mu> \<eta> \<in> subfrmlsn \<phi>}"
     by auto
   also have "\<dots> = (\<lambda>(\<mu>,\<eta>). name`{q\<in>nds. LTLnUntil \<mu> \<eta> \<in> old q \<longrightarrow> \<eta> \<in> old q}) 
       ` until_frmlsn \<phi>"
     unfolding until_frmlsn_correct ..
   finally show ?thesis
     unfolding build_F_def by simp
 qed
 
 text \<open>\paragraph{ Labeling Function }\<close>
 definition "pn_props ps \<equiv> FOREACHi 
   (\<lambda>it (P,N). P = {p. LTLnProp p \<in> ps - it} \<and> N = {p. LTLnNProp p \<in> ps - it}) 
   ps (\<lambda>p (P,N). 
     case p of LTLnProp p \<Rightarrow> RETURN (insert p P,N)
     | LTLnNProp p \<Rightarrow> RETURN (P, insert p N)
     | _ \<Rightarrow> RETURN (P,N)
   ) ({},{})"
 
 lemma pn_props_correct: 
   assumes [simp]: "finite ps"
   shows "pn_props ps \<le> SPEC(\<lambda>r. r = 
   ({p. LTLnProp p \<in> ps}, {p. LTLnNProp p \<in> ps}))"
   unfolding pn_props_def
   apply (refine_rcg refine_vcg)
   apply (auto split: ltln.split)
   done
 
 definition "pn_map nds \<equiv> FOREACH nds 
   (\<lambda>nd m. do {
     PN \<leftarrow> pn_props (old nd);
     RETURN (m(name nd \<mapsto> PN))
   }) Map.empty"
 
 lemma pn_map_correct: 
   assumes [simp]: "finite nds"
   assumes FIN': "\<And>nd. nd\<in>nds \<Longrightarrow> finite (old nd)"
   assumes INJ: "inj_on name nds"
   shows "pn_map nds \<le> SPEC (\<lambda>r. \<forall>qn. 
     case r qn of 
       None \<Rightarrow> qn \<notin> name`nds
     | Some (P,N) \<Rightarrow> qn \<in> name`nds 
       \<and> P = {p. LTLnProp p \<in> old (the_inv_into nds name qn)}
       \<and> N = {p. LTLnNProp p \<in> old (the_inv_into nds name qn)}
   )"
   unfolding pn_map_def
   apply (refine_rcg refine_vcg
     FOREACH_rule[where I="\<lambda>it r. \<forall>qn. 
       case r qn of 
         None \<Rightarrow> qn \<notin> name`(nds - it)
       | Some (P,N) \<Rightarrow> qn \<in> name`(nds - it)
         \<and> P = {p. LTLnProp p \<in> old (the_inv_into nds name qn)}
         \<and> N = {p. LTLnNProp p \<in> old (the_inv_into nds name qn)}"]
     order_trans[OF pn_props_correct]
   )
   apply simp_all
   apply (blast dest: set_mp[THEN FIN']) []
   apply (force 
     split: option.splits 
     simp: the_inv_into_f_f[OF INJ] it_step_insert_iff) []
   apply (fastforce split: option.splits) []
   done
 
  
 text \<open>\paragraph{ Assembling the Implementation }\<close>
   
 definition "cr_rename_gba nds \<phi> \<equiv> do {
   let V = name ` nds;
   let V0 = name ` {q \<in> nds. expand_init \<in> incoming q};
   succmap \<leftarrow> build_succ nds;
   let E = E_of_succ (the_default {} o succmap);
   let F = build_F nds \<phi>;
   pnm \<leftarrow> pn_map nds;
   let L = (\<lambda>qn l. case pnm qn of 
       None \<Rightarrow> False 
     | Some (P,N) \<Rightarrow> (\<forall>p\<in>P. p\<in>(l:::\<^sub>r\<langle>Id\<rangle>fun_set_rel)) \<and> (\<forall>p\<in>N. p\<notin>l)
   );
   RETURN (\<lparr> g_V = V, g_E=E, g_V0=V0, gbg_F = F, gba_L = L \<rparr>)
 }"
 
 lemma cr_rename_gba_refine:
   assumes INV: "nds_invars nds"
   assumes REL[simplified]: "(nds',nds)\<in>Id" "(\<phi>',\<phi>)\<in>Id"
   shows "cr_rename_gba nds' \<phi>' 
   \<le> \<Down>Id (RETURN (gba_rename_ext (\<lambda>_. ()) name (create_gba_from_nodes \<phi> nds)))"
   unfolding RETURN_SPEC_conv
 proof (rule Id_SPEC_refine)
   from INV have
     NINIT: "expand_init \<notin> name`nds"
     and FIN: "finite nds"
     and FIN': "\<And>nd. nd\<in>nds \<Longrightarrow> finite (old nd)"
     and CL: "\<And>nd. nd\<in>nds \<Longrightarrow> incoming nd \<subseteq> insert expand_init (name`nds)"
     and INJ: "inj_on name nds"
     unfolding nds_invars_def by auto
   show "cr_rename_gba nds' \<phi>'
     \<le> SPEC (\<lambda>x. x = gba_rename_ext (\<lambda>_. ()) name (create_gba_from_nodes \<phi> nds))"
     unfolding REL
     unfolding cr_rename_gba_def
     apply (refine_rcg refine_vcg
       order_trans[OF build_succ_correct[OF NINIT FIN CL]]
       order_trans[OF pn_map_correct[OF FIN FIN' INJ]]
     )
     unfolding gba_rename_ecnv_def gb_rename_ecnv_def 
       fr_rename_ext_def create_gba_from_nodes_def
     apply simp
     apply (intro conjI)
     apply (simp add: comp_def)
     apply (simp add: build_F_correct)
     apply (intro ext)
     apply (drule_tac x=qn in spec)
     apply (auto simp: the_inv_into_f_f[OF INJ] split: option.split prod.split)
     done
 qed
 
 definition "create_name_gba_aimpl \<phi> \<equiv> do {
   nds \<leftarrow> create_graph_aimpl \<phi>;
   ASSERT (nds_invars nds);
   cr_rename_gba nds \<phi>
 }"
 
 
 lemma create_name_gba_aimpl_refine: 
   "create_name_gba_aimpl \<phi> \<le> \<Down>Id (create_name_gba \<phi>)"
   unfolding create_name_gba_aimpl_def create_name_gba_alt
   apply (refine_rcg create_graph_aimpl_refine cr_rename_gba_refine)
   by auto
 
 subsection \<open>Refinement to Efficient Data Structures\<close>
 
 subsubsection \<open>Creation of GBA from Nodes\<close>
 
 schematic_goal until_frmlsn_impl_aux:
   assumes [relator_props, simp]: "R=Id"
   shows "(?c,until_frmlsn) 
   \<in> \<langle>(R::(_\<times>_::linorder) set)\<rangle>ltln_rel \<rightarrow> \<langle>\<langle>R\<rangle>ltln_rel \<times>\<^sub>r \<langle>R\<rangle>ltln_rel\<rangle>dflt_rs_rel"
   unfolding until_frmlsn_def
   apply (autoref (keep_goal, trace))
   done
 concrete_definition until_frmlsn_impl uses until_frmlsn_impl_aux
 lemmas [autoref_rules] = until_frmlsn_impl.refine[OF PREFER_id_D]
 
 
 
 
 schematic_goal build_succ_impl_aux:
   shows "(?c,build_succ) \<in> 
     \<langle>\<langle>Rm,R\<rangle>node_rel\<rangle>list_set_rel 
     \<rightarrow> \<langle>\<langle>nat_rel,\<langle>nat_rel\<rangle>list_set_rel\<rangle>iam_map_rel\<rangle>nres_rel"
   unfolding build_succ_def[abs_def] expand_init_def
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 
 concrete_definition build_succ_impl uses build_succ_impl_aux
 lemmas [autoref_rules] = build_succ_impl.refine
 
 (* TODO: Post-processing should be on by default! *)
 schematic_goal build_succ_code_aux: "RETURN ?c \<le> build_succ_impl x"
   unfolding build_succ_impl_def
   apply (refine_transfer (post))
   done
 
 concrete_definition build_succ_code uses build_succ_code_aux
 lemmas [refine_transfer] = build_succ_code.refine
 
 
 
 
 schematic_goal build_F_impl_aux:
   assumes [relator_props]:  "R = Id"
   shows "(?c,build_F) \<in> 
     \<langle>\<langle>Rm,R\<rangle>node_rel\<rangle>list_set_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>\<langle>nat_rel\<rangle>list_set_rel\<rangle>list_set_rel"
   unfolding build_F_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 
 concrete_definition build_F_impl uses build_F_impl_aux
 lemmas [autoref_rules] = build_F_impl.refine[OF PREFER_id_D]
 
 
 
 
 schematic_goal pn_map_impl_aux:
   shows "(?c,pn_map) \<in> 
     \<langle>\<langle>Rm,Id\<rangle>node_rel\<rangle>list_set_rel 
     \<rightarrow> \<langle>\<langle>nat_rel,\<langle>Id\<rangle>list_set_rel \<times>\<^sub>r \<langle>Id\<rangle>list_set_rel\<rangle>iam_map_rel\<rangle>nres_rel"
   unfolding pn_map_def[abs_def] pn_props_def
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 
 concrete_definition pn_map_impl uses pn_map_impl_aux
 lemma pn_map_impl_autoref[autoref_rules]: 
   assumes "PREFER_id R"
   shows "(pn_map_impl,pn_map) \<in> 
     \<langle>\<langle>Rm,R\<rangle>node_rel\<rangle>list_set_rel 
     \<rightarrow> \<langle>\<langle>nat_rel,\<langle>R\<rangle>list_set_rel \<times>\<^sub>r \<langle>R\<rangle>list_set_rel\<rangle>iam_map_rel\<rangle>nres_rel"
   using assms pn_map_impl.refine by simp
 
 schematic_goal pn_map_code_aux: "RETURN ?c \<le> pn_map_impl x"
   unfolding pn_map_impl_def
   apply (refine_transfer (post))
   done
 concrete_definition pn_map_code uses pn_map_code_aux
 lemmas [refine_transfer] = pn_map_code.refine 
 
 
 
 
 thm autoref_tyrel
 
 
 schematic_goal cr_rename_gba_impl_aux:
   assumes ID[relator_props]: "R=Id"
   notes [autoref_tyrel del] = TYRELI[of "\<langle>nat_rel\<rangle>dflt_rs_rel"]
   shows "(?c,cr_rename_gba) \<in> 
     \<langle>\<langle>Rm,R\<rangle>node_rel\<rangle>list_set_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow> (?R::(?'c \<times> _) set)"
   unfolding ID
   unfolding cr_rename_gba_def[abs_def] expand_init_def comp_def
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 concrete_definition cr_rename_gba_impl uses cr_rename_gba_impl_aux
 
 thm cr_rename_gba_impl.refine
 
 lemma cr_rename_gba_autoref[autoref_rules]:
   assumes "PREFER_id R"
   shows "(cr_rename_gba_impl, cr_rename_gba) \<in> 
     \<langle>\<langle>Rm, R\<rangle>node_rel\<rangle>list_set_rel \<rightarrow> \<langle>R\<rangle>ltln_rel \<rightarrow>
     \<langle>gbav_impl_rel_ext unit_rel nat_rel (\<langle>R\<rangle>fun_set_rel)\<rangle>nres_rel"
   using assms cr_rename_gba_impl.refine[of R Rm] by simp
 
 
 schematic_goal cr_rename_gba_code_aux: "RETURN ?c \<le> cr_rename_gba_impl x y"
   unfolding cr_rename_gba_impl_def
   apply (refine_transfer (post))
   done
 concrete_definition cr_rename_gba_code uses cr_rename_gba_code_aux
 lemmas [refine_transfer] = cr_rename_gba_code.refine 
 
 
 subsubsection \<open>Creation of Graph\<close>
 
 text \<open>
   The implementation of the node-set. The relation enforces that there are no
   different nodes with the same name. This effectively establishes an additional
   invariant, made explicit by an assertion in the refined program. This invariant
   allows for a more efficient implementation.
 \<close>
 definition ls_nds_rel_def_internal: 
   "ls_nds_rel R \<equiv> \<langle>R\<rangle>list_set_rel \<inter> {(_,s). inj_on name s}"
 lemma ls_nds_rel_def: "\<langle>R\<rangle>ls_nds_rel = \<langle>R\<rangle>list_set_rel \<inter> {(_,s). inj_on name s}"
   by (simp add: relAPP_def ls_nds_rel_def_internal)
 
 lemmas [autoref_rel_intf] = REL_INTFI[of ls_nds_rel i_set]
 
 lemma ls_nds_rel_sv[relator_props]: 
   assumes "single_valued R" 
   shows "single_valued (\<langle>R\<rangle>ls_nds_rel)"
   using list_set_rel_sv[OF assms]
   unfolding ls_nds_rel_def
   by (metis inf.cobounded1 single_valued_subset)
 
 context begin interpretation autoref_syn .
 lemma lsnds_empty_autoref[autoref_rules]:
   assumes "PREFER_id R"
   shows "([],{})\<in>\<langle>R\<rangle>ls_nds_rel"
   using assms
   apply (simp add: ls_nds_rel_def)
   by autoref
 
 lemma lsnds_insert_autoref[autoref_rules]:
   assumes "SIDE_PRECOND (name n \<notin> name`ns)"
   assumes "(n',n)\<in>R"
   assumes "(ns',ns)\<in>\<langle>R\<rangle>ls_nds_rel"
   shows "(n'#ns',(OP insert ::: R \<rightarrow> \<langle>R\<rangle>ls_nds_rel \<rightarrow> \<langle>R\<rangle>ls_nds_rel)$n$ns)
    \<in> \<langle>R\<rangle>ls_nds_rel"
   using assms
   unfolding ls_nds_rel_def
   apply simp
 proof (elim conjE, rule conjI)
   assume [autoref_rules]: "(n', n) \<in> R" "(ns', ns) \<in> \<langle>R\<rangle>list_set_rel"
   assume "name n \<notin> name ` ns"
     and "inj_on name ns"
   then have "n \<notin> ns" by (auto)
   then show "(n' # ns', insert n ns) \<in> \<langle>R\<rangle>list_set_rel"
     by autoref
 qed auto
 
 lemma ls_nds_image_autoref_aux:
   assumes [autoref_rules]: "(fi,f) \<in> Ra \<rightarrow> Rb"
   assumes "(l,s) \<in> \<langle>Ra\<rangle>ls_nds_rel"
   assumes [simp]: "\<forall>x. name (f x) = name x"
   shows "(map fi l, f`s) \<in> \<langle>Rb\<rangle>ls_nds_rel"
 proof -
   from assms have 
     [autoref_rules]: "(l,s)\<in>\<langle>Ra\<rangle>list_set_rel" 
       and INJ: "(inj_on name s)"
     by (auto simp add: ls_nds_rel_def)
   
   have [simp]: "inj_on f s"
     by (rule inj_onI) (metis INJ assms(3) inj_on_eq_iff)
 
   have "(map fi l, f`s) \<in> \<langle>Rb\<rangle>list_set_rel"
     by (autoref (keep_goal))
   moreover have "inj_on name (f`s)"
     apply (rule inj_onI)
     apply (auto simp: image_iff dest: inj_onD[OF INJ])
     done
   ultimately show ?thesis
     by (auto simp: ls_nds_rel_def)
 qed  
 
 lemma ls_nds_image_autoref[autoref_rules]:
   assumes "(fi,f) \<in> Ra \<rightarrow> Rb"
   assumes "SIDE_PRECOND (\<forall>x. name (f x) = name x)"
   shows "(map fi, (OP op ` ::: (Ra\<rightarrow>Rb) \<rightarrow> \<langle>Ra\<rangle>ls_nds_rel \<rightarrow> \<langle>Rb\<rangle>ls_nds_rel)$f) 
     \<in> \<langle>Ra\<rangle>ls_nds_rel \<rightarrow> \<langle>Rb\<rangle>ls_nds_rel"
   using assms
   unfolding autoref_tag_defs
   using ls_nds_image_autoref_aux
   by blast
 
 lemma list_set_autoref_to_list[autoref_ga_rules]: 
   shows "is_set_to_sorted_list (\<lambda>_ _. True) R ls_nds_rel id"
   unfolding is_set_to_list_def is_set_to_sorted_list_def ls_nds_rel_def
     it_to_sorted_list_def list_set_rel_def br_def
   by auto
 
 
 end
 
+hide_const (open) Im
 
 context begin interpretation autoref_syn .
 lemma [autoref_itype]:
   "upd_incoming 
     ::\<^sub>i \<langle>Im, I\<rangle>\<^sub>ii_node \<rightarrow>\<^sub>i \<langle>\<langle>Im', I\<rangle>\<^sub>ii_node\<rangle>\<^sub>ii_set \<rightarrow>\<^sub>i \<langle>\<langle>Im', I\<rangle>\<^sub>ii_node\<rangle>\<^sub>ii_set"
   by simp
 end
 
 term upd_incoming
 schematic_goal upd_incoming_impl_aux:
   assumes "REL_IS_ID R"
   shows "(?c, upd_incoming)\<in>\<langle>Rm1,R\<rangle>node_rel 
   \<rightarrow> \<langle>\<langle>Rm2,R\<rangle>node_rel\<rangle>ls_nds_rel 
   \<rightarrow> \<langle>\<langle>Rm2,R\<rangle>node_rel\<rangle>ls_nds_rel"
   using assms apply simp
   unfolding upd_incoming_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal))
   done
 
 concrete_definition upd_incoming_impl uses upd_incoming_impl_aux
 lemmas [autoref_rules] = upd_incoming_impl.refine[OF PREFER_D[of REL_IS_ID]]
 
 
 schematic_goal expand_impl_aux: "(?c, expand_aimpl) \<in> 
   \<langle>unit_rel,Id\<rangle>node_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,Id\<rangle>node_rel\<rangle>ls_nds_rel 
   \<rightarrow> \<langle>nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,Id\<rangle>node_rel\<rangle>ls_nds_rel\<rangle>nres_rel"
   unfolding expand_aimpl_def[abs_def] expand_new_name_def
   using [[autoref_trace_failed_id, autoref_trace_intf_unif]]
   apply (autoref (trace,keep_goal))
   done
 
 concrete_definition expand_impl uses expand_impl_aux
 
 context begin interpretation autoref_syn .
 lemma [autoref_itype]: "expand\<^sub>T 
   ::\<^sub>i \<langle>\<langle>i_unit, I\<rangle>\<^sub>ii_node, \<langle>\<langle>i_unit, I\<rangle>\<^sub>ii_node\<rangle>\<^sub>ii_set\<rangle>\<^sub>ii_prod 
   \<rightarrow>\<^sub>i \<langle>\<langle>i_nat,\<langle>\<langle>i_unit, I\<rangle>\<^sub>ii_node\<rangle>\<^sub>ii_set\<rangle>\<^sub>ii_prod\<rangle>\<^sub>ii_nres" by simp
 
 lemma expand_autoref[autoref_rules]:
   assumes ID: "PREFER_id R"
   assumes A: "(n_ns', n_ns) 
     \<in> \<langle>unit_rel,R\<rangle>node_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,R\<rangle>node_rel\<rangle>list_set_rel"
   assumes B: "SIDE_PRECOND (
     let (n,ns)=n_ns in inj_on name ns \<and> (\<forall>n'\<in>ns. name n > name n')
   )"
   shows "(expand_impl n_ns', 
     (OP expand_aimpl
     ::: \<langle>unit_rel,R\<rangle>node_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,R\<rangle>node_rel\<rangle>list_set_rel 
     \<rightarrow> \<langle>nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,R\<rangle>node_rel\<rangle>list_set_rel\<rangle>nres_rel)$n_ns) 
   \<in> \<langle>nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,R\<rangle>node_rel\<rangle>list_set_rel\<rangle>nres_rel"
 proof simp
   from ID A B have 
     1: "(n_ns, n_ns) \<in> Id \<inter> {(_,(n,ns)). \<forall>n'\<in>ns. name n > name n'}"
     and 2: "(n_ns', n_ns) 
       \<in> \<langle>unit_rel,Id\<rangle>node_rel \<times>\<^sub>r \<langle>\<langle>unit_rel,Id\<rangle>node_rel\<rangle>ls_nds_rel"
     unfolding ls_nds_rel_def
     apply -
     apply auto []
     apply (cases n_ns')
     apply auto []
     done
 
   have [simp]: "single_valued (nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel, Id\<rangle>node_rel\<rangle>list_set_rel)"
     by tagged_solver
 
 
   have [relator_props]: "\<And>R. single_valued (Id \<inter> R)"
     by (metis IntE single_valuedD single_valuedI single_valued_Id)
     
   have [simp]: "single_valued ((nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel, Id\<rangle>node_rel\<rangle>ls_nds_rel) O
                           (Id \<inter> {(_, n, ns). \<forall>n'\<in>ns. name n' < n}))"
     by (tagged_solver)
     
   from expand_impl.refine[THEN fun_relD, OF 2, THEN nres_relD]
   show "(expand_impl n_ns', expand_aimpl n_ns)
     \<in> \<langle>nat_rel \<times>\<^sub>r \<langle>\<langle>unit_rel, R\<rangle>node_rel\<rangle>list_set_rel\<rangle>nres_rel"
     apply -
     apply (rule nres_relI)
     using ID
     apply (simp add: pw_le_iff refine_pw_simps)
     apply (fastforce simp: ls_nds_rel_def)
     done
 qed
 
 end
 
 
 schematic_goal expand_code_aux: "RETURN ?c \<le> expand_impl n_ns"
   unfolding expand_impl_def
   by (refine_transfer the_resI)
 concrete_definition expand_code uses expand_code_aux
 prepare_code_thms expand_code_def
 lemmas [refine_transfer] = expand_code.refine 
 
 
 schematic_goal create_graph_impl_aux: 
   assumes ID: "R=Id"
   shows "(?c, create_graph_aimpl) 
     \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>\<langle>\<langle>unit_rel,R\<rangle>node_rel\<rangle>list_set_rel\<rangle>nres_rel"
   unfolding ID
   unfolding create_graph_aimpl_def[abs_def] expand_init_def expand_new_name_def
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal))
   done
 concrete_definition create_graph_impl uses create_graph_impl_aux
 
 lemmas [autoref_rules] = create_graph_impl.refine[OF PREFER_id_D]
 
 schematic_goal create_graph_code_aux: "RETURN ?c \<le> create_graph_impl \<phi>" 
   unfolding create_graph_impl_def
   by refine_transfer
 concrete_definition create_graph_code uses create_graph_code_aux
 lemmas [refine_transfer] = create_graph_code.refine
 
 
 schematic_goal create_name_gba_impl_aux: 
   "(?c, (create_name_gba_aimpl:: 'a::linorder ltln \<Rightarrow> _)) 
   \<in> \<langle>Id\<rangle>ltln_rel \<rightarrow> (?R::(?'c\<times>_) set)"
   unfolding create_name_gba_aimpl_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (keep_goal, trace))
   done
 concrete_definition create_name_gba_impl uses create_name_gba_impl_aux
 
 lemma create_name_gba_autoref[autoref_rules]:
   assumes "PREFER_id R"
   shows
   "(create_name_gba_impl, create_name_gba)
   \<in> \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>gbav_impl_rel_ext unit_rel nat_rel (\<langle>R\<rangle>fun_set_rel)\<rangle>nres_rel" 
   (is "_:_\<rightarrow>\<langle>?R\<rangle>nres_rel")
 proof (intro fun_relI nres_relI)
   fix \<phi> \<phi>'
   assume A: "(\<phi>,\<phi>')\<in>\<langle>R\<rangle>ltln_rel"
   from assms have RID[simp]: "R=Id" by simp
     
   note create_name_gba_impl.refine[THEN fun_relD,THEN nres_relD, OF A[unfolded RID]]
   also note create_name_gba_aimpl_refine
   finally show "create_name_gba_impl \<phi> \<le> \<Down> ?R (create_name_gba \<phi>')" by simp
 qed
  
 schematic_goal create_name_gba_code_aux: "RETURN ?c \<le> create_name_gba_impl \<phi>" 
   unfolding create_name_gba_impl_def
   by (refine_transfer (post))
 concrete_definition create_name_gba_code uses create_name_gba_code_aux
 lemmas [refine_transfer] = create_name_gba_code.refine
 
 schematic_goal create_name_igba_impl_aux: 
   assumes RID: "R=Id"
   shows "(?c,create_name_igba)\<in>
   \<langle>R\<rangle>ltln_rel \<rightarrow> \<langle>igbav_impl_rel_ext unit_rel nat_rel (\<langle>R\<rangle>fun_set_rel)\<rangle>nres_rel"
   unfolding RID
   unfolding create_name_igba_def[abs_def]
   using [[autoref_trace_failed_id]]
   apply (autoref (trace, keep_goal))
   done
 concrete_definition create_name_igba_impl uses create_name_igba_impl_aux
 lemmas [autoref_rules] = create_name_igba_impl.refine[OF PREFER_id_D]
 
 schematic_goal create_name_igba_code_aux: "RETURN ?c \<le> create_name_igba_impl \<phi>" 
   unfolding create_name_igba_impl_def
   by (refine_transfer (post))
 concrete_definition create_name_igba_code uses create_name_igba_code_aux
 lemmas [refine_transfer] = create_name_igba_code.refine
 
 export_code create_name_igba_code checking SML
 
 end
diff --git a/thys/LTL_to_GBA/ROOT b/thys/LTL_to_GBA/ROOT
--- a/thys/LTL_to_GBA/ROOT
+++ b/thys/LTL_to_GBA/ROOT
@@ -1,19 +1,17 @@
 chapter AFP
 
 session LTL_to_GBA (AFP) = CAVA_Automata +
   options [timeout = 900]
   theories [document = false]
     "../Stuttering_Equivalence/PLTL"
   theories
-    LTL
-    LTL_Rewrite
     LTL_Stutter
     LTL_to_GBA
     LTL_to_GBA_impl
   theories [document = false]
     All_Of_LTL_to_GBA
   document_files
     "root.tex"
     "intro.tex"
     "root.bib"
 
diff --git a/thys/Promela/PromelaLTL.thy b/thys/Promela/PromelaLTL.thy
--- a/thys/Promela/PromelaLTL.thy
+++ b/thys/Promela/PromelaLTL.thy
@@ -1,322 +1,321 @@
 section "LTL integration"
 theory PromelaLTL
 imports
   "Promela"
   "../LTL_to_GBA/LTL"
 begin
 
 text {* We have a semantic engine for Promela. But we need to have 
 an integration with LTL -- more specificly, we must know when a proposition
 is true in a global state. This is achieved in this theory. *}
 
 subsection {* LTL optimization *}
 
 text {* For efficiency reasons, we do not store the whole @{typ expr} on the labels
 of a system automaton, but @{typ nat} instead. This index then is used to look up the
 corresponding @{typ expr}. *}
 
 type_synonym APs = "expr iarray"
 
 primrec ltlc_aps_list' :: "'a ltlc \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "ltlc_aps_list' LTLcTrue l = l"
 | "ltlc_aps_list' LTLcFalse l = l"
 | "ltlc_aps_list' (LTLcProp p) l = (if List.member l p then l else p#l)"
 | "ltlc_aps_list' (LTLcNeg x) l = ltlc_aps_list' x l"
 | "ltlc_aps_list' (LTLcNext x) l = ltlc_aps_list' x l"
 | "ltlc_aps_list' (LTLcFinal x) l = ltlc_aps_list' x l"
 | "ltlc_aps_list' (LTLcGlobal x) l = ltlc_aps_list' x l"
 | "ltlc_aps_list' (LTLcAnd x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
 | "ltlc_aps_list' (LTLcOr x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
 | "ltlc_aps_list' (LTLcImplies x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
-| "ltlc_aps_list' (LTLcIff x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
 | "ltlc_aps_list' (LTLcUntil x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
 | "ltlc_aps_list' (LTLcRelease x y) l = ltlc_aps_list' y (ltlc_aps_list' x l)"
 
 lemma ltlc_aps_list'_correct:
-  "set (ltlc_aps_list' \<phi> l) = ltlc_aprops \<phi> \<union> set l"
+  "set (ltlc_aps_list' \<phi> l) = ltlc_props \<phi> \<union> set l"
   by (induct \<phi> arbitrary: l) (auto simp add: in_set_member)
 
 lemma ltlc_aps_list'_distinct:
   "distinct l \<Longrightarrow> distinct (ltlc_aps_list' \<phi> l)"
   by (induct \<phi> arbitrary: l) (auto simp add: in_set_member)
 
 definition ltlc_aps_list :: "'a ltlc \<Rightarrow> 'a list"
 where
   "ltlc_aps_list \<phi> = ltlc_aps_list' \<phi> []"
 
 lemma ltlc_aps_list_correct:
-  "set (ltlc_aps_list \<phi>) = ltlc_aprops \<phi>"
+  "set (ltlc_aps_list \<phi>) = ltlc_props \<phi>"
   unfolding ltlc_aps_list_def
   by (force simp: ltlc_aps_list'_correct)
 
 lemma ltlc_aps_list_distinct:
   "distinct (ltlc_aps_list \<phi>)"
   unfolding ltlc_aps_list_def
   by (auto intro: ltlc_aps_list'_distinct)
 
 primrec idx' :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a \<Rightarrow> nat option" where
   "idx' _ [] _ = None"
 | "idx' ctr (x#xs) y = (if x = y then Some ctr else idx' (ctr+1) xs y)"
 
 definition "idx = idx' 0"
 
 lemma idx'_correct:
   assumes "distinct xs"
   shows "idx' ctr xs y = Some n \<longleftrightarrow> n \<ge> ctr \<and> n < length xs + ctr \<and> xs ! (n-ctr) = y"
 using assms
 proof (induction xs arbitrary: n ctr)
   case (Cons x xs)
   show ?case
   proof (cases "x=y")
     case True with Cons.prems have *: "y \<notin> set xs" by auto
     {
       assume A: "(y#xs)!(n-ctr) = y"
       and less: "ctr \<le> n"
       and length: "n < length (y#xs) + ctr"
       have "n = ctr"
       proof (rule ccontr)
         assume "n \<noteq> ctr" with less have "n-ctr > 0" by auto
         moreover from `n\<noteq>ctr` length have "n-ctr < length(y#xs)" by auto
         ultimately have "(y#xs)!(n-ctr) \<in> set xs" by simp
         with A * show False by auto
       qed
     }
     with True Cons show ?thesis by auto
   next
     case False 
     from Cons have "distinct xs" by simp
     with Cons.IH False have "idx' (Suc ctr) xs y = Some n \<longleftrightarrow> Suc ctr \<le> n \<and> n < length xs + Suc ctr \<and> xs ! (n - Suc ctr) = y"
       by simp
     with False show ?thesis
       apply -
       apply (rule iffI)
       apply clarsimp_all
       done
   qed
 qed simp
 
 lemma idx_correct:
   assumes "distinct xs"
   shows "idx xs y = Some n \<longleftrightarrow> n < length xs \<and> xs ! n = y"
   using idx'_correct[OF assms]
   by (simp add: idx_def)
 
 lemma idx_dom:
   assumes "distinct xs"
   shows "dom (idx xs) = set xs"
   by (auto simp add: idx_correct assms in_set_conv_nth)
 
 lemma idx_image_self:
   assumes "distinct xs"
   shows "(the \<circ> idx xs) ` set xs = {..<length xs}"
 proof (safe)
   fix x
   assume "x \<in> set xs" with in_set_conv_nth obtain n where n: "n < length xs" "xs ! n = x" by metis
   with idx_correct[OF assms] have "idx xs x = Some n" by simp
   hence "the (idx xs x) = n" by simp
   with n show "(the \<circ> idx xs) x < length xs" by simp
 next
   fix n
   assume "n < length xs" 
   moreover with nth_mem have "xs ! n \<in> set xs" by simp
   then obtain x where "xs ! n = x" "x \<in> set xs" by simp_all
   ultimately have "idx xs x = Some n" by (simp add: idx_correct[OF assms])
   hence "the (idx xs x) = n" by simp
   thus "n \<in> (the \<circ> idx xs) ` set xs" 
     using `x \<in> set xs` 
     by auto
 qed
 
 lemma idx_ran:
   assumes "distinct xs"
   shows "ran (idx xs) = {..<length xs}"
   using ran_is_image[where M="idx xs"]
   using idx_image_self[OF assms] idx_dom[OF assms]
   by simp
 
 lemma idx_inj_on_dom:
   assumes "distinct xs"
   shows "inj_on (idx xs) (dom (idx xs))"
   by (fastforce simp add: idx_dom assms in_set_conv_nth idx_correct
                 intro!: inj_onI)
 
 definition ltl_convert :: "expr ltlc \<Rightarrow> APs \<times> nat ltlc" where
   "ltl_convert \<phi> = (
       let APs = ltlc_aps_list \<phi>;
           \<phi>\<^sub>i = map_ltlc (the \<circ> idx APs) \<phi>
       in (IArray APs, \<phi>\<^sub>i))"
 
 lemma ltl_convert_correct:
   assumes "ltl_convert \<phi> = (APs, \<phi>\<^sub>i)"
-  shows "ltlc_aprops \<phi> = set (IArray.list_of APs)" (is "?P1")
-  and "ltlc_aprops \<phi>\<^sub>i = {..<IArray.length APs}" (is "?P2")
+  shows "ltlc_props \<phi> = set (IArray.list_of APs)" (is "?P1")
+  and "ltlc_props \<phi>\<^sub>i = {..<IArray.length APs}" (is "?P2")
   and "\<phi>\<^sub>i = map_ltlc (the \<circ> idx (IArray.list_of APs)) \<phi>" (is "?P3")
   and "distinct (IArray.list_of APs)"
 proof -
   let ?APs = "IArray.list_of APs"
 
   from assms have APs_def: "?APs = ltlc_aps_list \<phi>"
     unfolding ltl_convert_def by auto
 
   with ltlc_aps_list_correct show APs_set: ?P1 by metis
 
   from assms show ?P3
     unfolding ltl_convert_def
     by auto
 
-  from assms have "ltlc_aprops \<phi>\<^sub>i = (the \<circ> idx ?APs) ` ltlc_aprops \<phi>"
+  from assms have "ltlc_props \<phi>\<^sub>i = (the \<circ> idx ?APs) ` ltlc_props \<phi>"
     unfolding ltl_convert_def
     by (auto simp add: ltlc.set_map)
   moreover from APs_def ltlc_aps_list_distinct show "distinct ?APs" by simp
   note idx_image_self[OF this]
   moreover note APs_set
   ultimately show ?P2 by simp
 qed
 
 definition prepare 
   :: "_ \<times> (program \<Rightarrow> unit) \<Rightarrow> ast \<Rightarrow> expr ltlc \<Rightarrow> (program \<times> APs \<times> gState) \<times> nat ltlc" 
   where
   "prepare cfg ast \<phi> \<equiv>
       let 
          (prog,g\<^sub>0) = Promela.setUp ast;
          (APs,\<phi>\<^sub>i) = PromelaLTL.ltl_convert \<phi>
       in 
          ((prog, APs, g\<^sub>0), \<phi>\<^sub>i)"
 
 lemma prepare_instrument[code]:
   "prepare cfg ast \<phi> \<equiv> 
     let
          (_,printF) = cfg;
          _ = PromelaStatistics.start (); 
          (prog,g\<^sub>0) = Promela.setUp ast;
          _ = printF prog;
          (APs,\<phi>\<^sub>i) = PromelaLTL.ltl_convert \<phi>;
          _ = PromelaStatistics.stop_timer ()
       in 
          ((prog, APs, g\<^sub>0), \<phi>\<^sub>i)"
   by (simp add: prepare_def)
 
 export_code prepare checking SML
 
 subsection {* Language of a Promela program *}
 
 definition propValid :: "APs \<Rightarrow> gState \<Rightarrow> nat \<Rightarrow> bool" where
   "propValid APs g i \<longleftrightarrow> i < IArray.length APs \<and> exprArith g emptyProc (APs!!i) \<noteq> 0"
 
 definition promela_E :: "program \<Rightarrow> (gState \<times> gState) set"
   -- "Transition relation of a promela program"
 where
   "promela_E prog \<equiv> {(g,g'). g' \<in> ls.\<alpha> (nexts_code prog g)}"
 
 definition promela_E_ltl :: "program \<times> APs \<Rightarrow> (gState \<times> gState) set" where
   "promela_E_ltl = promela_E \<circ> fst"
 
 definition promela_is_run' :: "program \<times> gState \<Rightarrow> gState word \<Rightarrow> bool"
   -- "Predicate defining runs of promela programs"
 where
   "promela_is_run' progg r \<equiv> 
       let (prog,g\<^sub>0)=progg in 
            r 0 = g\<^sub>0 
         \<and> (\<forall>i. r (Suc i) \<in> ls.\<alpha> (nexts_code prog (r i)))"
 
 abbreviation "promela_is_run \<equiv> promela_is_run' \<circ> setUp"
 
 definition promela_is_run_ltl :: "program \<times> APs \<times> gState \<Rightarrow> gState word \<Rightarrow> bool"
 where 
   "promela_is_run_ltl promg r \<equiv> let (prog,APs,g) = promg in promela_is_run' (prog,g) r"
 
 definition promela_props :: "gState \<Rightarrow> expr set" 
 where
   "promela_props g = {e. exprArith g emptyProc e \<noteq> 0}"
 
 definition promela_props_ltl :: "APs \<Rightarrow> gState \<Rightarrow> nat set"
 where
   "promela_props_ltl APs g \<equiv> Collect (propValid APs g)"
 
 definition promela_language :: "ast \<Rightarrow> expr set word set" where
   "promela_language ast \<equiv> {promela_props \<circ> r | r. promela_is_run ast r}"
 
 definition promela_language_ltl :: "program \<times> APs \<times> gState \<Rightarrow> nat set word set" where
   "promela_language_ltl promg \<equiv> let (prog,APs,g) = promg in 
                     {promela_props_ltl APs \<circ> r | r. promela_is_run_ltl promg r}"
 
 lemma promela_props_ltl_map_aprops:
   assumes "ltl_convert \<phi> = (APs,\<phi>\<^sub>i)"
   shows "promela_props_ltl APs = 
-          map_aprops (idx (IArray.list_of APs)) \<circ> promela_props"
+          map_props (idx (IArray.list_of APs)) \<circ> promela_props"
 proof -
   let ?APs = "IArray.list_of APs"
   let ?idx = "idx ?APs"
 
   from ltl_convert_correct assms have D: "distinct ?APs" by simp
 
   show ?thesis
   proof (intro ext set_eqI iffI)
     fix g i
     assume "i \<in> promela_props_ltl APs g"
     hence "propValid APs g i" by (simp add: promela_props_ltl_def)
     hence l: "i < IArray.length APs" "exprArith g emptyProc (APs!!i) \<noteq> 0" 
       by (simp_all add: propValid_def)
     hence "APs!!i \<in> promela_props g" by (simp add: promela_props_def)
     moreover from idx_correct l D have "?idx (APs!!i) = Some i" by fastforce
-    ultimately show "i \<in> (map_aprops ?idx \<circ> promela_props) g"
-      unfolding o_def map_aprops_def
+    ultimately show "i \<in> (map_props ?idx \<circ> promela_props) g"
+      unfolding o_def map_props_def
       by blast
   next
     fix g i
-    assume "i \<in> (map_aprops ?idx \<circ> promela_props) g"
+    assume "i \<in> (map_props ?idx \<circ> promela_props) g"
     then obtain p where p_def: "p \<in> promela_props g" "?idx p = Some i" 
-      unfolding map_aprops_def o_def 
+      unfolding map_props_def o_def 
       by auto
     hence expr: "exprArith g emptyProc p \<noteq> 0" by (simp add: promela_props_def)
   
     from D p_def have "i < IArray.length APs" "APs !! i = p"
       using idx_correct by fastforce+
     with expr have "propValid APs g i" by (simp add: propValid_def)
     thus "i \<in> promela_props_ltl APs g"
       by (simp add: promela_props_ltl_def)
   qed
 qed
 
 lemma promela_run_in_language_iff:
   assumes conv: "ltl_convert \<phi> = (APs,\<phi>\<^sub>i)"
   shows "promela_props \<circ> \<xi> \<in> ltlc_language \<phi> 
           \<longleftrightarrow> promela_props_ltl APs \<circ> \<xi> \<in> ltlc_language \<phi>\<^sub>i" (is "?L \<longleftrightarrow> ?R")
 proof -
   let ?APs = "IArray.list_of APs"
 
   from conv have D: "distinct ?APs"
     by (simp add: ltl_convert_correct)
-  with conv have APs: "ltlc_aprops \<phi> \<subseteq> dom (idx ?APs)"
+  with conv have APs: "ltlc_props \<phi> \<subseteq> dom (idx ?APs)"
     by (simp add: idx_dom ltl_convert_correct)
 
   note map_semantics = map_ltlc_semantics[OF idx_inj_on_dom[OF D] APs]
                        promela_props_ltl_map_aprops[OF conv]
                        ltl_convert_correct[OF conv]
 
   have "?L \<longleftrightarrow> (promela_props \<circ> \<xi>) \<Turnstile>\<^sub>c \<phi>" by (simp add: ltlc_language_def)
   also have "... \<longleftrightarrow> (promela_props_ltl APs \<circ> \<xi>) \<Turnstile>\<^sub>c \<phi>\<^sub>i"
     using map_semantics
     by (simp add: o_assoc)
   also have "... \<longleftrightarrow> ?R"
     by (simp add: ltlc_language_def)
   finally show ?thesis .
 qed
 
 lemma promela_language_sub_iff:
   assumes conv: "ltl_convert \<phi> = (APs,\<phi>\<^sub>i)"
   and setUp: "setUp ast = (prog,g)"
   shows "promela_language_ltl (prog,APs,g) \<subseteq> ltlc_language \<phi>\<^sub>i \<longleftrightarrow> promela_language ast \<subseteq> ltlc_language \<phi>"
   using promela_run_in_language_iff[OF conv] setUp
   by (auto simp add: promela_language_ltl_def promela_language_def promela_is_run_ltl_def)
 
 
 (* from PromelaDatastructures *)
 hide_const (open) abort abort' abortv 
                   err err' errv
                   usc usc'
                   warn the_warn with_warn
 
 hide_const (open) idx idx'
 end
diff --git a/thys/Stuttering_Equivalence/PLTL.thy b/thys/Stuttering_Equivalence/PLTL.thy
--- a/thys/Stuttering_Equivalence/PLTL.thy
+++ b/thys/Stuttering_Equivalence/PLTL.thy
@@ -1,879 +1,797 @@
 theory PLTL
-imports StutterEquivalence
+  imports Main "../../../afp/LTL/LTL" Samplers StutterEquivalence
 begin
 
 section {* Stuttering Invariant PLTL Formulas *}
 
 text {*
   We define the syntax and semantics of propositional linear-time
   temporal logic PLTL and show that its next-free fragment is
   invariant to finite stuttering.
 *}
 
-subsection {* Syntax and semantics of PLTL *}
-
-text {*
-  PLTL formulas are built from atomic formulas, propositional connectives,
-  and the temporal operators ``next'' and ``until''. The following data
-  type definition is parameterized by the type of states over which
-  formulas are evaluated.
-*}
-
-datatype 'a pltl =
-    "false"
-  | "atom" "'a \<Rightarrow> bool"
-  | "implies" "'a pltl" "'a pltl"
-  | "next" "'a pltl"
-  | "until" "'a pltl" "'a pltl"
-
-text {*
-  The semantics of PLTL formulas is defined inductively w.r.t.
-  @{text "\<omega>"}-sequences of states.
-*}
-
-fun holds_of :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a pltl \<Rightarrow> bool" ("_ \<Turnstile> _" [70,70] 40) where
-  "(\<sigma> \<Turnstile> false) = False"
-| "(\<sigma> \<Turnstile> atom p) = p (\<sigma> 0)"
-| "(\<sigma> \<Turnstile> implies \<phi> \<psi>) = ((\<sigma> \<Turnstile> \<phi>) \<longrightarrow> (\<sigma> \<Turnstile> \<psi>))"
-| "(\<sigma> \<Turnstile> next \<phi>) = (\<sigma>[1..] \<Turnstile> \<phi>)"
-| "(\<sigma> \<Turnstile> until \<phi> \<psi>) = (\<exists>k. \<sigma>[k..] \<Turnstile> \<psi> \<and> (\<forall>i<k. \<sigma>[i..] \<Turnstile> \<phi>))"
-
-text {*
-  Further connectives of PLTL can be defined as abbreviations.
-*}
-
-definition not where "not \<phi> = implies \<phi> false"
+notation pltl_semantics ("_ \<Turnstile> _" [80,80] 80)
+  and LTLpFalse ("false")
+  and LTLpImplies ("implies")
+  and LTLpAtom ("atom")
+  and LTLpUntil ("until")
+  and LTLpNext ("next")
+  and pltl_atoms ("atoms")
 
-definition true where "true = not false"
-
-definition or where "or \<phi> \<psi> = implies (not \<phi>) \<psi>"
-
-definition "and" where "and \<phi> \<psi> = not (or (not \<phi>) (not \<psi>))"
-
-definition eventually where "eventually \<phi> = until true \<phi>"
-
-definition always where "always \<phi> = not (eventually (not \<phi>))"
-
-text {*
-  These definitions give rise to the expected semantics.
-*}
-
-lemma holds_of_not [simp]: "(\<sigma> \<Turnstile> not \<phi>) = (\<not>(\<sigma> \<Turnstile> \<phi>))"
-  by (simp add: not_def)
-
-lemma holds_of_true [simp]: "\<sigma> \<Turnstile> true"
-  by (simp add: true_def)
-
-lemma holds_of_or [simp]: "(\<sigma> \<Turnstile> or \<phi> \<psi>) = (\<sigma> \<Turnstile> \<phi> \<or> \<sigma> \<Turnstile> \<psi>)"
-  by (auto simp add: or_def)
-
-lemma holds_of_and [simp]: "(\<sigma> \<Turnstile> and \<phi> \<psi>) = (\<sigma> \<Turnstile> \<phi> \<and> \<sigma> \<Turnstile> \<psi>)"
-  by (simp add: and_def)
-
-lemma holds_of_eventually [simp]: "(\<sigma> \<Turnstile> eventually \<phi>) = (\<exists>k. \<sigma>[k..] \<Turnstile> \<phi>)"
-  by (simp add: eventually_def)
-
-lemma holds_of_always [simp]: "(\<sigma> \<Turnstile> always \<phi>) = (\<forall>k. \<sigma>[k..] \<Turnstile> \<phi>)"
-  by (simp add: always_def)
-
-text {*
-  We also define finite conjunctions and disjunctions.
-*}
+subsection {* Finite Conjunctions and Disjunctions *}
 
 (* It would be tempting to define these operators as follows:
 
 definition OR where "OR \<Phi> = Finite_Set.fold or false \<Phi>"
 definition AND where "AND \<Phi> = Finite_Set.fold and true \<Phi>"
 
 However, this would only work if "or" and "and" were left-commutative,
 which they are not (syntactically). We must therefore resort to
 the more general fold_graph predicate, effectively picking a
 conjunction (or disjunction) in arbitrary order. 
 
 An alternative would be to define these generalized operators
 over lists of formulas, but working with sets is more natural
 in the following.
 *)
 
-definition OR where "OR \<Phi> \<equiv> SOME \<phi>. fold_graph or false \<Phi> \<phi>"
+definition OR where "OR \<Phi> \<equiv> SOME \<phi>. fold_graph LTLpOr LTLpFalse \<Phi> \<phi>"
 
-definition AND where "AND \<Phi> \<equiv> SOME \<phi>. fold_graph and true \<Phi> \<phi>"
+definition AND where "AND \<Phi> \<equiv> SOME \<phi>. fold_graph LTLpAnd LTLpTrue \<Phi> \<phi>"
 
-lemma fold_graph_OR: "finite \<Phi> \<Longrightarrow> fold_graph or false \<Phi> (OR \<Phi>)"
+lemma fold_graph_OR: "finite \<Phi> \<Longrightarrow> fold_graph LTLpOr LTLpFalse \<Phi> (OR \<Phi>)"
   unfolding OR_def by (rule someI2_ex[OF finite_imp_fold_graph])
 
-lemma fold_graph_AND: "finite \<Phi> \<Longrightarrow> fold_graph and true \<Phi> (AND \<Phi>)"
+lemma fold_graph_AND: "finite \<Phi> \<Longrightarrow> fold_graph LTLpAnd LTLpTrue \<Phi> (AND \<Phi>)"
   unfolding AND_def by (rule someI2_ex[OF finite_imp_fold_graph])
 
 lemma holds_of_OR [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "(\<sigma> \<Turnstile> OR \<Phi>) = (\<exists>\<phi>\<in>\<Phi>. \<sigma> \<Turnstile> \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph or false \<Phi> \<psi>"
+    assume "fold_graph LTLpOr LTLpFalse \<Phi> \<psi>"
     hence "(\<sigma> \<Turnstile> \<psi>) = (\<exists>\<phi>\<in>\<Phi>. \<sigma> \<Turnstile> \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_OR[OF fin] show ?thesis by simp
 qed
 
 lemma holds_of_AND [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "(\<sigma> \<Turnstile> AND \<Phi>) = (\<forall>\<phi>\<in>\<Phi>. \<sigma> \<Turnstile> \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph and true \<Phi> \<psi>"
+    assume "fold_graph LTLpAnd LTLpTrue \<Phi> \<psi>"
     hence "(\<sigma> \<Turnstile> \<psi>) = (\<forall>\<phi>\<in>\<Phi>. \<sigma> \<Turnstile> \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_AND[OF fin] show ?thesis by simp
 qed
 
-
 subsection {* Next-Free PLTL Formulas *}
 
 text {*
   A PLTL formula is called \emph{next-free} if it does not contain any
-  subformula @{text "tnext f"}.
+  subformula.
 *}
 
-fun "next_free" where
+fun next_free :: "'a pltl \<Rightarrow> bool"
+where
   "next_free false = True"
 | "next_free (atom p) = True"
 | "next_free (implies \<phi> \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
 | "next_free (next \<phi>) = False"
 | "next_free (until \<phi> \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
 
-lemma next_free_not [simp]: "next_free (not \<phi>) = next_free \<phi>"
-  by (simp add: not_def)
-
-lemma next_free_true [simp]: "next_free true"
-  by (simp add: true_def)
+lemma next_free_not [simp]: 
+  "next_free (not\<^sub>p \<phi>) = next_free \<phi>"
+  by (simp add: LTLpNot_def)
 
-lemma next_free_or [simp]: "next_free (or \<phi> \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
-  by (simp add: or_def)
+lemma next_free_true [simp]: 
+  "next_free true\<^sub>p"
+  by (simp add: LTLpTrue_def)
 
-lemma next_free_and [simp]: "next_free (and \<phi> \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
-  by (simp add: and_def)
+lemma next_free_or [simp]: 
+  "next_free (\<phi> or\<^sub>p \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
+  by (simp add: LTLpOr_def)
 
-lemma next_free_eventually [simp]: "next_free (eventually \<phi>) = next_free \<phi>"
-  by (simp add: eventually_def)
+lemma next_free_and [simp]: "next_free (\<phi> and\<^sub>p \<psi>) = (next_free \<phi> \<and> next_free \<psi>)"
+  by (simp add: LTLpAnd_def)
 
-lemma next_free_always [simp]: "next_free (always \<phi>) = next_free \<phi>"
-  by (simp add: always_def)
+lemma next_free_eventually [simp]: 
+  "next_free (F\<^sub>p \<phi>) = next_free \<phi>"
+  by (simp add: LTLpEventually_def)
+
+lemma next_free_always [simp]: 
+  "next_free (G\<^sub>p \<phi>) = next_free \<phi>"
+  by (simp add: LTLpAlways_def)
 
 lemma next_free_OR [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "next_free (OR \<Phi>) = (\<forall>\<phi>\<in>\<Phi>. next_free \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph or false \<Phi> \<psi>"
+    assume "fold_graph LTLpOr LTLpFalse \<Phi> \<psi>"
     hence "next_free \<psi> = (\<forall>\<phi>\<in>\<Phi>. next_free \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_OR[OF fin] show ?thesis by simp
 qed
 
 lemma next_free_AND [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "next_free (AND \<Phi>) = (\<forall>\<phi>\<in>\<Phi>. next_free \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph and true \<Phi> \<psi>"
+    assume "fold_graph LTLpAnd LTLpTrue \<Phi> \<psi>"
     hence "next_free \<psi> = (\<forall>\<phi>\<in>\<Phi>. next_free \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_AND[OF fin] show ?thesis by simp
 qed
 
 
 subsection {* Stuttering Invariance of PLTL Without ``Next'' *}
 
 text {*
   A PLTL formula is \emph{stuttering invariant} if for any stuttering equivalent
   state sequences @{text "\<sigma> \<approx> \<tau>"}, the formula holds of @{text "\<sigma>"} iff it
   holds of @{text "\<tau>"}.
 *}
 
 definition stutter_invariant where
-  "stutter_invariant \<phi> = (\<forall>\<sigma> \<tau>. \<sigma> \<approx> \<tau> \<longrightarrow> (\<sigma> \<Turnstile> \<phi>) = (\<tau> \<Turnstile> \<phi>))"
+  "stutter_invariant \<phi> = (\<forall>\<sigma> \<tau>. (\<sigma> \<approx> \<tau>) \<longrightarrow> (\<sigma> \<Turnstile> \<phi>) = (\<tau> \<Turnstile> \<phi>))"
 
 text {*
   Since stuttering equivalence is symmetric, it is enough to show an
   implication in the above definition instead of an equivalence.
 *}
 
 lemma stutter_invariantI [intro!]:
   assumes "\<And>\<sigma> \<tau>. \<lbrakk>\<sigma> \<approx> \<tau>; \<sigma> \<Turnstile> \<phi>\<rbrakk> \<Longrightarrow> \<tau> \<Turnstile> \<phi>"
   shows "stutter_invariant \<phi>"
 proof -
   {
     fix \<sigma> \<tau>
     assume st: "\<sigma> \<approx> \<tau>" and f: "\<sigma> \<Turnstile> \<phi>"
     hence "\<tau> \<Turnstile> \<phi>" by (rule assms)
   }
 moreover
   {
     fix \<sigma> \<tau>
     assume st: "\<sigma> \<approx> \<tau>" and f: "\<tau> \<Turnstile> \<phi>"
     from st have "\<tau> \<approx> \<sigma>" by (rule stutter_equiv_sym)
     from this f have "\<sigma> \<Turnstile> \<phi>" by (rule assms)
   }
 ultimately show ?thesis by (auto simp: stutter_invariant_def)
 qed
 
 lemma stutter_invariantD [dest]:
   assumes "stutter_invariant \<phi>" and "\<sigma> \<approx> \<tau>"
   shows "(\<sigma> \<Turnstile> \<phi>) = (\<tau> \<Turnstile> \<phi>)"
   using assms by (auto simp: stutter_invariant_def)
 
 text {*
   We first show that next-free PLTL formulas are indeed stuttering invariant.
   The proof proceeds by straightforward induction on the syntax of PLTL formulas.
 *}
 theorem next_free_stutter_invariant:
   "next_free \<phi> \<Longrightarrow> stutter_invariant (\<phi>::'a pltl)"
 proof (induct "\<phi>")
     show "stutter_invariant false" by auto
 next
   fix p :: "'a \<Rightarrow> bool"
   show "stutter_invariant (atom p)"
   proof
     fix \<sigma> \<tau>
     assume "\<sigma> \<approx> \<tau>" "\<sigma> \<Turnstile> atom p"
     thus "\<tau> \<Turnstile> atom p" by (simp add: stutter_equiv_0)
   qed
 next
   fix \<phi> \<psi> :: "'a pltl"
   assume ih: "next_free \<phi> \<Longrightarrow> stutter_invariant \<phi>"
              "next_free \<psi> \<Longrightarrow> stutter_invariant \<psi>"
   assume "next_free (implies \<phi> \<psi>)"
   with ih show "stutter_invariant (implies \<phi> \<psi>)" by auto
 next
   fix \<phi> :: "'a pltl"
   assume "next_free (next \<phi>)"  -- {* hence contradiction *}
   thus "stutter_invariant (next \<phi>)" by simp
 next
   fix \<phi> \<psi> :: "'a pltl"
   assume ih: "next_free \<phi> \<Longrightarrow> stutter_invariant \<phi>"
              "next_free \<psi> \<Longrightarrow> stutter_invariant \<psi>"
   assume "next_free (until \<phi> \<psi>)"
   with ih have stinv: "stutter_invariant \<phi>" "stutter_invariant \<psi>" by auto
   show "stutter_invariant (until \<phi> \<psi>)"
   proof
     fix \<sigma> \<tau>
     assume st: "\<sigma> \<approx> \<tau>" and unt: "\<sigma> \<Turnstile> until \<phi> \<psi>"
     from unt obtain m
       where 1: "\<sigma>[m..] \<Turnstile> \<psi>" and 2: "\<forall>j<m. \<sigma>[j..] \<Turnstile> \<phi>" by auto
     from st obtain n
       where 3: "\<sigma>[m..] \<approx> \<tau>[n..]" and 4: "\<forall>i<n. \<exists>j<m. \<sigma>[j..] \<approx> \<tau>[i..]"
       by (rule stutter_equiv_suffixes_right)
     from 1 3 stinv have "\<tau>[n..] \<Turnstile> \<psi>" by auto
     moreover
     from 2 4 stinv have "\<forall>i<n. \<tau>[i..] \<Turnstile> \<phi>" by force
     ultimately show "\<tau> \<Turnstile> until \<phi> \<psi>" by auto
   qed
 qed
 
 
 subsection {* Atoms, Canonical State Sequences, and Characteristic Formulas *}
 
 text {*
   We now address the converse implication: any stutter invariant PLTL
   formula @{text "\<phi>"} can be equivalently expressed by a next-free formula.
   The construction of that formula requires attention to the atomic
   formulas that appear in @{text "\<phi>"}. We will also prove that the
   next-free formula does not need any new atoms beyond those present
   in @{text "\<phi>"}.
 
   The following function collects the atoms (of type @{text "'a \<Rightarrow> bool"})
   of a PLTL formula.
 *}
 
-fun atoms where
-  "atoms false = {}"
-| "atoms (atom p) = {p}"
-| "atoms (implies \<phi> \<psi>) = atoms \<phi> \<union> atoms \<psi>"
-| "atoms (next \<phi>) = atoms \<phi>"
-| "atoms (until \<phi> \<psi>) = atoms \<phi> \<union> atoms \<psi>"
-
-lemma atoms_finite [iff]: "finite (atoms \<phi>)"
-  by (induct \<phi>) auto
-
-lemma atoms_not [simp]: "atoms (not \<phi>) = atoms \<phi>"
-  by (simp add: not_def)
-
-lemma atoms_true [simp]: "atoms true = {}"
-  by (simp add: true_def)
-
-lemma atoms_or [simp]: "atoms (or \<phi> \<psi>) = atoms \<phi> \<union> atoms \<psi>"
-  by (simp add: or_def)
-
-lemma atoms_and [simp]: "atoms (and \<phi> \<psi>) = atoms \<phi> \<union> atoms \<psi>"
-  by (simp add: and_def)
-
-lemma atoms_eventually [simp]: "atoms (eventually \<phi>) = atoms \<phi>"
-  by (simp add: eventually_def)
-
-lemma atoms_always [simp]: "atoms (always \<phi>) = atoms \<phi>"
-  by (simp add: always_def)
 
 lemma atoms_OR [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "atoms (OR \<Phi>) = (\<Union>\<phi>\<in>\<Phi>. atoms \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph or false \<Phi> \<psi>"
+    assume "fold_graph LTLpOr LTLpFalse \<Phi> \<psi>"
     hence "atoms \<psi> = (\<Union>\<phi>\<in>\<Phi>. atoms \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_OR[OF fin] show ?thesis by simp
 qed
 
 lemma atoms_AND [simp]: 
   assumes fin: "finite (\<Phi>::'a pltl set)"
   shows "atoms (AND \<Phi>) = (\<Union>\<phi>\<in>\<Phi>. atoms \<phi>)"
 proof -
   {
     fix \<psi>::"'a pltl"
-    assume "fold_graph and true \<Phi> \<psi>"
+    assume "fold_graph LTLpAnd LTLpTrue \<Phi> \<psi>"
     hence "atoms \<psi> = (\<Union>\<phi>\<in>\<Phi>. atoms \<phi>)"
       by (rule fold_graph.induct) auto
   }
   with fold_graph_AND[OF fin] show ?thesis by simp
 qed
 
 text {*
   Given a set of atoms @{text A} as above, we say that two states
   are @{text A}-similar if they agree on all atoms in @{text A}.
   Two state sequences @{text "\<sigma>"} and @{text "\<tau>"} are @{text A}-similar
   if corresponding states are @{text A}-equal.
 *}
 
 definition state_sim :: "['a, ('a \<Rightarrow> bool) set, 'a] \<Rightarrow> bool" 
   ("_ ~_~ _" [70,100,70] 50) where
   "s ~A~ t = (\<forall>p\<in>A. p s \<longleftrightarrow> p t)"
 
 definition seq_sim :: "[nat \<Rightarrow> 'a, ('a \<Rightarrow> bool) set, nat \<Rightarrow> 'a] \<Rightarrow> bool"
   ("_ \<simeq>_\<simeq> _" [70,100,70] 50)  where
   "\<sigma> \<simeq>A\<simeq> \<tau> = (\<forall>n. (\<sigma> n) ~A~ (\<tau> n))"
 
 text {*
   These relations are (indexed) equivalence relations. Moreover
   @{text "s ~A~ t"} implies @{text "s ~B~ t"} for @{text "B \<subseteq> A"},
   and similar for @{text "\<sigma> \<simeq>A\<simeq> \<tau>"} and @{text "\<sigma> \<simeq>B\<simeq> \<tau>"}.
 *}
 
 lemma state_sim_refl [simp]: "s ~A~ s"
   by (simp add: state_sim_def)
 
 lemma state_sim_sym: "s ~A~ t \<Longrightarrow> t ~A~ s"
   by (auto simp: state_sim_def)
 
 lemma state_sim_trans[trans]: "s ~A~ t \<Longrightarrow> t ~A~ u \<Longrightarrow> s ~A~ u"
   unfolding state_sim_def by blast
 
 lemma state_sim_mono:
   assumes "s ~A~ t" and "B \<subseteq> A"
   shows "s ~B~ t"
   using assms unfolding state_sim_def by auto
 
 lemma seq_sim_refl [simp]: "\<sigma> \<simeq>A\<simeq> \<sigma>"
   by (simp add: seq_sim_def)
 
 lemma seq_sim_sym: "\<sigma> \<simeq>A\<simeq> \<tau> \<Longrightarrow> \<tau> \<simeq>A\<simeq> \<sigma>"
   by (auto simp: seq_sim_def state_sim_sym)
 
 lemma seq_sim_trans[trans]: "\<rho> \<simeq>A\<simeq> \<sigma> \<Longrightarrow> \<sigma> \<simeq>A\<simeq> \<tau> \<Longrightarrow> \<rho> \<simeq>A\<simeq> \<tau>"
   unfolding seq_sim_def by (blast intro: state_sim_trans)
 
 lemma seq_sim_mono:
   assumes "\<sigma> \<simeq>A\<simeq> \<tau>" and "B \<subseteq> A"
   shows "\<sigma> \<simeq>B\<simeq> \<tau>"
   using assms unfolding seq_sim_def by (blast intro: state_sim_mono)
 
 text {*
   State sequences that are similar w.r.t. the atoms of a PLTL formula
   evaluate that formula to the same value.  
 *}
 
 lemma pltl_seq_sim: "\<sigma> \<simeq>(atoms \<phi>)\<simeq> \<tau> \<Longrightarrow> (\<sigma> \<Turnstile> \<phi>) = (\<tau> \<Turnstile> \<phi>)"
   (is "?sim \<sigma> \<phi> \<tau> \<Longrightarrow> ?P \<sigma> \<phi> \<tau>")
 proof (induct \<phi> arbitrary: \<sigma> \<tau>)
   fix \<sigma> \<tau>
   show "?P \<sigma> false \<tau>" by simp
 next
   fix p \<sigma> \<tau>
   assume "?sim \<sigma> (atom p) \<tau>" thus "?P \<sigma> (atom p) \<tau>"
     by (auto simp: seq_sim_def state_sim_def)
 next
   fix \<phi> \<psi> \<sigma> \<tau>
   assume ih: "\<And>\<sigma> \<tau>. ?sim \<sigma> \<phi> \<tau> \<Longrightarrow> ?P \<sigma> \<phi> \<tau>" 
              "\<And>\<sigma> \<tau>. ?sim \<sigma> \<psi> \<tau> \<Longrightarrow> ?P \<sigma> \<psi> \<tau>"
      and sim: "?sim \<sigma> (implies \<phi> \<psi>) \<tau>"
   from sim have "?sim \<sigma> \<phi> \<tau>" "?sim \<sigma> \<psi> \<tau>"
     by (auto elim: seq_sim_mono)
   with ih show "?P \<sigma> (implies \<phi> \<psi>) \<tau>" by simp
 next
   fix \<phi> \<sigma> \<tau>
   assume ih: "\<And>\<sigma> \<tau>. ?sim \<sigma> \<phi> \<tau> \<Longrightarrow> ?P \<sigma> \<phi> \<tau>"
      and sim: "\<sigma> \<simeq>atoms (next \<phi>)\<simeq> \<tau>"
   from sim have "\<sigma>[1..] \<simeq>atoms \<phi>\<simeq> \<tau>[1..]"
     by (auto simp: seq_sim_def)
   with ih show "?P \<sigma> (next \<phi>) \<tau>" by auto
 next
   fix \<phi> \<psi> \<sigma> \<tau>
   assume ih: "\<And>\<sigma> \<tau>. ?sim \<sigma> \<phi> \<tau> \<Longrightarrow> ?P \<sigma> \<phi> \<tau>" 
              "\<And>\<sigma> \<tau>. ?sim \<sigma> \<psi> \<tau> \<Longrightarrow> ?P \<sigma> \<psi> \<tau>"
      and sim: "?sim \<sigma> (until \<phi> \<psi>) \<tau>"
-  from sim have "\<forall>i. \<sigma>[i..] \<simeq>atoms \<phi>\<simeq> \<tau>[i..]" "\<forall>j. \<sigma>[j..] \<simeq>atoms \<psi>\<simeq> \<tau>[j..]"
+  from sim have "\<forall>i. \<sigma>[i..] \<simeq>atoms \<phi>\<simeq> \<tau>[i..]" "\<forall>j. \<sigma>[j..] \<simeq> atoms \<psi> \<simeq> \<tau>[j..]"
     by (auto simp: seq_sim_def state_sim_def)
   with ih have "\<forall>i. ?P (\<sigma>[i..]) \<phi> (\<tau>[i..])" "\<forall>j. ?P (\<sigma>[j..]) \<psi> (\<tau>[j..])"
-    by (auto simp del: suffix_elt)
-  thus "?P \<sigma> (until \<phi> \<psi>) \<tau>" by (auto simp del: suffix_elt)
+    by blast+
+  thus "?P \<sigma> (until \<phi> \<psi>) \<tau>" 
+    by (meson pltl_semantics.simps(5))
 qed
 
 text {*
   The following function picks an arbitrary representative among
   @{text A}-similar states. Because the choice is functional,
   any two @{text A}-similar states are mapped to the same state.
 *}
 
 definition canonize where
   "canonize A s \<equiv> SOME t. t ~A~ s"
 
 lemma canonize_state_sim: "canonize A s ~A~ s"
   unfolding canonize_def by (rule someI, rule state_sim_refl)
 
 lemma canonize_canonical:
   assumes st: "s ~A~ t"
   shows "canonize A s = canonize A t"
 proof -
   from st have "\<forall>u. (u ~A~s) = (u ~A~ t)"
     by (auto elim: state_sim_sym state_sim_trans)
   thus ?thesis unfolding canonize_def by simp
 qed
 
 lemma canonize_idempotent:
   "canonize A (canonize A s) = canonize A s"
   by (rule canonize_canonical[OF canonize_state_sim])
 
 text {*
   In a canonical state sequence, any two @{text A}-similar states
   are in fact equal.
 *}
 
 definition canonical_sequence where
   "canonical_sequence A \<sigma> \<equiv> \<forall>m (n::nat). \<sigma> m ~A~ \<sigma> n \<longrightarrow> \<sigma> m = \<sigma> n"
 
 text {*
   Every suffix of a canonical sequence is canonical, as is any
   (sampled) subsequence, in particular any stutter-sampling.
 *}
 
 lemma canonical_suffix:
   "canonical_sequence A \<sigma> \<Longrightarrow> canonical_sequence A (\<sigma>[k..])"
   by (auto simp: canonical_sequence_def)
 
 lemma canonical_sampled:
   "canonical_sequence A \<sigma> \<Longrightarrow> canonical_sequence A (\<sigma> \<circ> f)"
   by (auto simp: canonical_sequence_def)
 
 lemma canonical_reduced:
   "canonical_sequence A \<sigma> \<Longrightarrow> canonical_sequence A (\<natural>\<sigma>)"
   unfolding stutter_reduced_def by (rule canonical_sampled)
 
 text {*
   For any sequence @{text "\<sigma>"} there exists a canonical
   @{text A}-similar sequence @{text "\<tau>"}. Such a @{text "\<tau>"}
   can be obtained by canonizing all states of @{text "\<sigma>"}.
 *}
 
 lemma canonical_exists:
   obtains \<tau> where "\<tau> \<simeq>A\<simeq> \<sigma>" "canonical_sequence A \<tau>"
 proof -
   have "(canonize A \<circ> \<sigma>) \<simeq>A\<simeq> \<sigma>"
     by (simp add: seq_sim_def canonize_state_sim)
   moreover
   have "canonical_sequence A (canonize A \<circ> \<sigma>)"
     by (auto simp: canonical_sequence_def canonize_idempotent
              dest: canonize_canonical)
   ultimately
   show ?thesis using that by blast
 qed
 
 text {*
   Given a state @{text s} and a set @{text A} of atoms, we define
   the characteristic formula of @{text s} as the conjunction of
   all atoms in @{text A} that hold of @{text s} and the negation of
   the atoms in @{text A} that do not hold of @{text s}.
 *}
 
 definition characteristic_formula where
   "characteristic_formula A s \<equiv>
-   (and (AND { atom p | p . p \<in> A \<and> p s })
-        (AND { not (atom p) | p . p \<in> A \<and> \<not>(p s) }))"
+   ((AND { atom p | p . p \<in> A \<and> p s }) and\<^sub>p (AND { not\<^sub>p (atom p) | p . p \<in> A \<and> \<not>(p s) }))"
 
 lemma characteristic_holds: 
   "finite A \<Longrightarrow> \<sigma> \<Turnstile> characteristic_formula A (\<sigma> 0)"
   by (auto simp: characteristic_formula_def)
 
 lemma characteristic_state_sim:
   assumes fin: "finite A"
   shows "(\<sigma> 0 ~A~ \<tau> 0) = (\<tau> \<Turnstile> characteristic_formula A (\<sigma> (0::nat)))"
 proof
   assume sim: "\<sigma> 0 ~A~ \<tau> 0"
   {
     fix p
     assume "p \<in> A"
     with sim have "p (\<tau> 0) = p (\<sigma> 0)" by (auto simp: state_sim_def)
   }
   with fin show "\<tau> \<Turnstile> characteristic_formula A (\<sigma> 0)"
     by (auto simp: characteristic_formula_def) (blast+)
 next
   assume "\<tau> \<Turnstile> characteristic_formula A (\<sigma> 0)"
   with fin show "\<sigma> 0 ~A~ \<tau> 0"
     by (auto simp: characteristic_formula_def state_sim_def)
 qed
 
 
 subsection {* Stuttering Invariant PLTL Formulas Don't Need Next *}
 
 text {*
   The following is the main lemma used in the proof of the
   completeness theorem: for any PLTL formula @{text "\<phi>"} there
   exists a next-free formula @{text "\<psi>"} such that the two
   formulas evaluate to the same value over stutter-free and
   canonical sequences (w.r.t. some @{text "A \<supseteq> atoms \<phi>"}).
 *}
 
 lemma ex_next_free_stutter_free_canonical:
   assumes A: "atoms \<phi> \<subseteq> A" and fin: "finite A"
   shows "\<exists>\<psi>. next_free \<psi> \<and> atoms \<psi> \<subseteq> A \<and>
              (\<forall>\<sigma>. stutter_free \<sigma> \<and> canonical_sequence A \<sigma> \<longrightarrow> (\<sigma> \<Turnstile> \<psi>) = (\<sigma> \<Turnstile> \<phi>))"
     (is "\<exists>\<psi>. ?P \<phi> \<psi>")
 using A proof (induct \<phi>)
   txt {* The cases of @{text "false"} and atomic formulas are trivial. *}
   have "?P false false" by auto
   thus "\<exists>\<psi>. ?P false \<psi>" ..
 next
   fix p
   assume "atoms (atom p) \<subseteq> A"
   hence "?P (atom p) (atom p)" by auto
   thus "\<exists>\<psi>. ?P (atom p) \<psi>" ..
 next
   txt {* Implication is easy, using the induction hypothesis. *}
   fix \<phi> \<psi>
   assume "atoms \<phi> \<subseteq> A \<Longrightarrow> \<exists>\<phi>'. ?P \<phi> \<phi>'"
      and "atoms \<psi> \<subseteq> A \<Longrightarrow> \<exists>\<psi>'. ?P \<psi> \<psi>'"
      and "atoms (implies \<phi> \<psi>) \<subseteq> A"
   then obtain \<phi>' \<psi>' where "?P \<phi> \<phi>'" "?P \<psi> \<psi>'" by auto
   hence "?P (implies \<phi> \<psi>) (implies \<phi>' \<psi>')" by auto
   thus "\<exists>\<chi>. ?P (implies \<phi> \<psi>) \<chi>" ..
 next
   txt {* The case of @{text "until"} follows similarly. *}
   fix \<phi> \<psi>
   assume "atoms \<phi> \<subseteq> A \<Longrightarrow> \<exists>\<phi>'. ?P \<phi> \<phi>'"
      and "atoms \<psi> \<subseteq> A \<Longrightarrow> \<exists>\<psi>'. ?P \<psi> \<psi>'"
      and "atoms (until \<phi> \<psi>) \<subseteq> A"
   then obtain \<phi>' \<psi>' where 1: "?P \<phi> \<phi>'" and 2: "?P \<psi> \<psi>'" by auto
   {
     fix \<sigma>
     assume sigma: "stutter_free \<sigma>" "canonical_sequence A \<sigma>"
     hence "\<And>k. stutter_free (\<sigma>[k..])" "\<And>k. canonical_sequence A (\<sigma>[k..])"
       by (auto simp: stutter_free_suffix canonical_suffix)
     with 1 2 
     have "\<And>k. (\<sigma>[k..] \<Turnstile> \<phi>') = (\<sigma>[k..] \<Turnstile> \<phi>)"
      and "\<And>k. (\<sigma>[k..] \<Turnstile> \<psi>') = (\<sigma>[k..] \<Turnstile> \<psi>)"
       by (blast+)
     hence "(\<sigma> \<Turnstile> until \<phi>' \<psi>') = (\<sigma> \<Turnstile> until \<phi> \<psi>)"
       by auto
   }
   with 1 2 have "?P (until \<phi> \<psi>) (until \<phi>' \<psi>')" by auto
   thus "\<exists>\<chi>. ?P (until \<phi> \<psi>) \<chi>" ..
 next
   txt {* The interesting case is the one of the @{text "next"}-operator. *}
   fix \<phi>
   assume ih: "atoms \<phi> \<subseteq> A \<Longrightarrow> \<exists>\<psi>. ?P \<phi> \<psi>" and at: "atoms (next \<phi>) \<subseteq> A"
   then obtain \<psi> where psi: "?P \<phi> \<psi>" by auto
   txt {* A valuation (over @{text A}) is a set @{text "val \<subseteq> A"} of atoms. We
     define some auxiliary notions: the valuation corresponding to a state and
     the characteristic formula for a valuation. Finally, we define the formula
     @{text "psi'"} that we will prove to be equivalent to @{text "next \<phi>"} over
     the stutter-free and canonical sequence @{text "\<sigma>"}. *}
   def stval \<equiv> "\<lambda>s. { p \<in> A . p s }"
-  def chi \<equiv> "\<lambda>val. (and (AND {atom p | p . p \<in> val}) 
-                        (AND {not (atom p) | p . p \<in> A - val}))"
-  def psi' \<equiv> "(or (and \<psi> (OR { always (chi val) | val . val \<subseteq> A }))
-                  (OR { and (chi val) (until (chi val) (and \<psi> (chi val'))) | val val'.
+  def chi \<equiv> "\<lambda>val. ((AND {atom p | p . p \<in> val}) and\<^sub>p
+                        (AND {not\<^sub>p (atom p) | p . p \<in> A - val}))"
+  def psi' \<equiv> "(LTLpOr (\<psi> and\<^sub>p (OR {G\<^sub>p (chi val) | val . val \<subseteq> A }))
+                  (OR {(chi val) and\<^sub>p (until (chi val) ( \<psi> and\<^sub>p (chi val'))) | val val'.
                         val \<subseteq> A \<and> val' \<subseteq> A \<and> val' \<noteq> val }))"
-        (is "(or (and _ (OR ?ALW)) (OR ?UNT))")
+        (is "(LTLpOr ( _ and\<^sub>p (OR ?ALW)) (OR ?UNT))")
 
-  have "\<And>s. {not (atom p) | p . p \<in> A - stval s}
-           = {not (atom p) | p . p \<in> A \<and> \<not>(p s)}"
+  have "\<And>s. {not\<^sub>p (atom p) | p . p \<in> A - stval s}
+           = {not\<^sub>p (atom p) | p . p \<in> A \<and> \<not>(p s)}"
     by (auto simp: stval_def)
   hence chi1: "\<And>s. chi (stval s) = characteristic_formula A s"
     by (auto simp: chi_def stval_def characteristic_formula_def)
   {
     fix val \<tau>
     assume val: "val \<subseteq> A" and tau: "\<tau> \<Turnstile> chi val"
     with fin have "val = stval (\<tau> 0)"
       by (auto simp: stval_def chi_def finite_subset)
   }
   note chi2 = this
 
-  have "?UNT \<subseteq> (\<lambda>(val,val'). and (chi val) (until (chi val) (and \<psi> (chi val'))))
+  have "?UNT \<subseteq> (\<lambda>(val,val'). (chi val) and\<^sub>p (until (chi val) (\<psi> and\<^sub>p (chi val'))))
                ` (Pow A \<times> Pow A)"
     (is "_ \<subseteq> ?S")
     by auto
   with fin have fin_UNT: "finite ?UNT"
     by (auto simp: finite_subset)
 
   have nf: "next_free psi'"
   proof -
     from fin have "\<And>val. val \<subseteq> A \<Longrightarrow> next_free (chi val)"
       by (auto simp: chi_def finite_subset)
     with fin fin_UNT psi show ?thesis
       by (force simp: psi'_def finite_subset)
   qed
 
   have atoms: "atoms psi' \<subseteq> A"
   proof -
     from fin have at_chi: "\<And>val. val \<subseteq> A \<Longrightarrow> atoms (chi val) \<subseteq> A"
       by (auto simp: chi_def finite_subset)
-    with fin psi have at_alw: "atoms (and \<psi> (OR ?ALW)) \<subseteq> A"
+    with fin psi have at_alw: "atoms (\<psi> and\<^sub>p (OR ?ALW)) \<subseteq> A"
       by auto blast?    (** FRAGILE: auto leaves trivial goal about subset **)
     from fin fin_UNT psi at_chi have "atoms (OR ?UNT) \<subseteq> A"
       by auto (blast+)? (** FRAGILE: even more left-over goals here **)
     with at_alw show ?thesis by (auto simp: psi'_def)
   qed
 
   {
     fix \<sigma>
     assume st: "stutter_free \<sigma>" and can: "canonical_sequence A \<sigma>"
     have "(\<sigma> \<Turnstile> next \<phi>) = (\<sigma> \<Turnstile> psi')"
     proof (cases "\<sigma> (Suc 0) = \<sigma> 0")
       case True
       txt {* In the case of a stuttering transition at the beginning, we must have
         infinite stuttering, and the first disjunct of @{text "psi'"} holds,
         whereas the second does not. *}
       {
         fix n
         have "\<sigma> n = \<sigma> 0"
         proof (cases n)
           case 0 thus ?thesis by simp
         next
           case Suc
           hence "n > 0" by simp
           with True st show ?thesis unfolding stutter_free_def by blast
         qed
       }
       note alleq = this
       have suffix: "\<And>n. \<sigma>[n..] = \<sigma>"
       proof (rule ext)
         fix n i
         have "(\<sigma>[n..]) i = \<sigma> 0" by (auto intro: alleq)
         moreover have "\<sigma> i = \<sigma> 0" by (rule alleq)
         ultimately show "(\<sigma>[n..]) i = \<sigma> i" by simp
       qed
       with st can psi have 1: "(\<sigma> \<Turnstile> next \<phi>) = (\<sigma> \<Turnstile> \<psi>)" by simp
 
       from fin have "\<sigma> \<Turnstile> chi (stval (\<sigma> 0))" by (simp add: chi1 characteristic_holds)
-      with suffix have "\<sigma> \<Turnstile> always (chi (stval (\<sigma> 0)))" (is "_ \<Turnstile> ?alw") by simp
+      with suffix have "\<sigma> \<Turnstile> G\<^sub>p (chi (stval (\<sigma> 0)))" (is "_ \<Turnstile> ?alw") by simp
       moreover have "?alw \<in> ?ALW" by (auto simp: stval_def)
       ultimately have 2: "\<sigma> \<Turnstile> OR ?ALW"
-        using fin by (auto simp: finite_subset simp del: holds_of_always)
+        using fin by (auto simp: finite_subset simp del: pltl_semantics_sugar)
 
       have 3: "\<not>(\<sigma> \<Turnstile> OR ?UNT)"
       proof
         assume unt: "\<sigma> \<Turnstile> OR ?UNT"
         with fin_UNT obtain val val' k where
           val: "val \<subseteq> A" "val' \<subseteq> A" "val' \<noteq> val" and
           now: "\<sigma> \<Turnstile> chi val" and k: "\<sigma>[k..] \<Turnstile> chi val'"
           by auto (blast+)?  (* FRAGILE: similar as above *)
         from `val \<subseteq> A` now have "val = stval (\<sigma> 0)" by (rule chi2)
         moreover
         from `val' \<subseteq> A` k suffix have "val' = stval (\<sigma> 0)" by (simp add: chi2)
         moreover note `val' \<noteq> val`
         ultimately show "False" by simp
       qed
 
       from 1 2 3 show ?thesis by (simp add: psi'_def)
 
     next
       case False
       txt {* Otherwise, @{text "\<sigma> \<Turnstile> next \<phi>"} is equivalent to @{text "\<sigma>"} satisfying
         the second disjunct of @{text "psi'"}. We show both implications separately. *}
       let ?val = "stval (\<sigma> 0)"
       let ?val' = "stval (\<sigma> 1)"
       from False can have vals: "?val' \<noteq> ?val"
         by (auto simp: canonical_sequence_def state_sim_def stval_def)
         
       show ?thesis
       proof
         assume phi: "\<sigma> \<Turnstile> next \<phi>"
         from fin have 1: "\<sigma> \<Turnstile> chi ?val" by (simp add: chi1 characteristic_holds)
 
         from st can have "stutter_free (\<sigma>[1..])" "canonical_sequence A (\<sigma>[1..])"
           by (auto simp: stutter_free_suffix canonical_suffix)
         with phi psi have 2: "\<sigma>[1..] \<Turnstile> \<psi>" by auto
 
         from fin have "\<sigma>[1..] \<Turnstile> characteristic_formula A ((\<sigma>[1..]) 0)"
           by (rule characteristic_holds)
         hence 3: "\<sigma>[1..] \<Turnstile> chi ?val'" by (simp add: chi1)
 
-        from 1 2 3 have "\<sigma> \<Turnstile> and (chi ?val) (until (chi ?val) (and \<psi> (chi ?val')))"
+        from 1 2 3 have "\<sigma> \<Turnstile> LTLpAnd (chi ?val) (until (chi ?val) (LTLpAnd \<psi> (chi ?val')))"
           (is "_ \<Turnstile> ?unt")
           by auto
         moreover from vals have "?unt \<in> ?UNT"
           by (auto simp: stval_def)
         ultimately have "\<sigma> \<Turnstile> OR ?UNT"
           using fin_UNT[THEN holds_of_OR] by blast
         thus "\<sigma> \<Turnstile> psi'" by (simp add: psi'_def)
 
       next
         assume psi': "\<sigma> \<Turnstile> psi'"
         have "\<not>(\<sigma> \<Turnstile> OR ?ALW)"
         proof
           assume "\<sigma> \<Turnstile> OR ?ALW"
           with fin obtain val where 1: "val \<subseteq> A" and 2: "\<forall>n. \<sigma>[n..] \<Turnstile> chi val"
             by (force simp: finite_subset)
           from 2 have "\<sigma>[0..] \<Turnstile> chi val" ..
           with 1 have "val = ?val" by (simp add: chi2)
           moreover
           from 2 have "\<sigma>[1..] \<Turnstile> chi val" ..
           with 1 have "val = ?val'" by (force dest: chi2)
           ultimately
           show "False" using vals by simp
         qed
         with psi' have "\<sigma> \<Turnstile> OR ?UNT" by (simp add: psi'_def)
         with fin_UNT obtain val val' k where
           val: "val \<subseteq> A" "val' \<subseteq> A" "val' \<noteq> val" and
           now: "\<sigma> \<Turnstile> chi val" and
           k: "\<sigma>[k..] \<Turnstile> \<psi>" "\<sigma>[k..] \<Turnstile> chi val'" and
           i: "\<forall>i<k. \<sigma>[i..] \<Turnstile> chi val"
           by auto (blast+)?  (* FRAGILE: similar as above *)
 
         from val now have 1: "val = ?val" by (simp add: chi2)
 
         have 2: "k \<noteq> 0"
         proof
           assume "k=0"
           with val k have "val' = ?val" by (simp add: chi2)
           with 1 `val' \<noteq> val` show "False" by simp
         qed
 
         have 3: "k \<le> 1"
         proof (rule ccontr)
           assume "\<not>(k \<le> 1)"
           with i have "\<sigma>[1..] \<Turnstile> chi val" by simp
           with 1 have "\<sigma>[1..] \<Turnstile> characteristic_formula A (\<sigma> 0)" 
             by (simp add: chi1)
           hence "(\<sigma> 0) ~A~ ((\<sigma>[1..]) 0)"
             using characteristic_state_sim[OF fin] by blast
           with can have "\<sigma> 0 = \<sigma> 1"
             by (simp add: canonical_sequence_def)
           with `\<sigma> (Suc 0) \<noteq> \<sigma> 0` show "False" by simp
         qed
 
         from 2 3 have "k=1" by simp
         moreover
         from st can have "stutter_free (\<sigma>[1..])" "canonical_sequence A (\<sigma>[1..])"
           by (auto simp: stutter_free_suffix canonical_suffix)
         ultimately show "\<sigma> \<Turnstile> next \<phi>" using `\<sigma>[k..] \<Turnstile> \<psi>` psi by auto
       qed
     qed
   }
   with nf atoms show "\<exists>\<psi>'. ?P (next \<phi>) \<psi>'" by blast
 qed
 
 text {*
   Comparing the definition of the next-free formula in the case of
   formulas @{text "next \<phi>"} with the one that appears in~\cite{peled:ltl-x},
   there is a subtle difference. Peled and Wilke define the second disjunct as
   a disjunction of formulas
 %
   \begin{center}\(
     @{text "until (chi val) (and \<psi> (chi val'))"}
   \)\end{center}
 %
   for subsets @{text "val, val' \<subseteq> A"} whereas we conjoin the formula
   @{text "chi val"} to the ``until'' formula. This conjunct is indeed
   necessary in order to rule out the case of the ``until'' formula
   being true because of @{text "chi val'"} being true immediately.
   The subtle error in the definition of the formula was acknowledged 
   by Peled and Wilke and apparently had not been noticed since the 
   publication of~\cite{peled:ltl-x} in 1996 (which has been cited more
   than a hundred times according to Google Scholar). Although the error
   was corrected easily, the fact that authors, reviewers, and readers
   appear to have missed it for so long underscores the usefulness of
   formal proofs.
 
   We now show that any stuttering invariant PLTL formula
   can be expressed without the @{text "next"} operator.
 *}
 
 theorem stutter_invariant_next_free:
   assumes phi: "stutter_invariant \<phi>"
   obtains \<psi> where "next_free \<psi>" "atoms \<psi> \<subseteq> atoms \<phi>"
                   "\<forall>\<sigma>. (\<sigma> \<Turnstile> \<psi>) = (\<sigma> \<Turnstile> \<phi>)"
 proof -
   have "atoms \<phi> \<subseteq> atoms \<phi>" "finite (atoms \<phi>)" by simp_all
   then obtain \<psi> where
     psi: "next_free \<psi>" "atoms \<psi> \<subseteq> atoms \<phi>" and
     equiv: "\<forall>\<sigma>. stutter_free \<sigma> \<and> canonical_sequence (atoms \<phi>) \<sigma> \<longrightarrow> (\<sigma> \<Turnstile> \<psi>) = (\<sigma> \<Turnstile> \<phi>)"
     by (blast dest: ex_next_free_stutter_free_canonical)
   from `next_free \<psi>` have sinv: "stutter_invariant \<psi>"
     by (rule next_free_stutter_invariant)
   {
     fix \<sigma>
     obtain \<tau> where 1: "\<tau> \<simeq> atoms \<phi> \<simeq> \<sigma>" and 2: "canonical_sequence (atoms \<phi>) \<tau>"
       by (rule canonical_exists)
     from 1 `atoms \<psi> \<subseteq> atoms \<phi>` have 3: "\<tau> \<simeq> atoms \<psi> \<simeq> \<sigma>"
       by (rule seq_sim_mono)
 
     from 1 have "(\<sigma> \<Turnstile> \<phi>) = (\<tau> \<Turnstile> \<phi>)" by (simp add: pltl_seq_sim)
     also from phi stutter_reduced_equivalent have "... = (\<natural>\<tau> \<Turnstile> \<phi>)" by auto
     also from 2[THEN canonical_reduced] equiv stutter_reduced_stutter_free 
     have "... = (\<natural>\<tau> \<Turnstile> \<psi>)" by auto
     also from sinv stutter_reduced_equivalent have "... = (\<tau> \<Turnstile> \<psi>)" by auto
     also from 3 have "... = (\<sigma> \<Turnstile> \<psi>)" by (simp add: pltl_seq_sim)
     finally have "(\<sigma> \<Turnstile> \<psi>) = (\<sigma> \<Turnstile> \<phi>)" by (rule sym)
   }
   with psi that show ?thesis by blast
 qed
 
 text {*
   Combining theorems @{text "next_free_stutter_invariant"} and
   @{text "stutter_invariant_next_free"}, it follows that a PLTL
   formula is stuttering invariant iff it is equivalent to a next-free
   formula.
 *}
 
 theorem pltl_stutter_invariant:
   "stutter_invariant \<phi> \<longleftrightarrow> 
    (\<exists>\<psi>. next_free \<psi> \<and> atoms \<psi> \<subseteq> atoms \<phi> \<and> (\<forall>\<sigma>. \<sigma> \<Turnstile> \<psi> \<longleftrightarrow> \<sigma> \<Turnstile> \<phi>))"
 proof -
   {
     assume "stutter_invariant \<phi>"
     hence "\<exists>\<psi>. next_free \<psi> \<and> atoms \<psi> \<subseteq> atoms \<phi> \<and> (\<forall>\<sigma>. \<sigma> \<Turnstile> \<psi> \<longleftrightarrow> \<sigma> \<Turnstile> \<phi>)"
       by (rule stutter_invariant_next_free) blast
   }
 moreover
   {
     fix \<psi>
     assume 1: "next_free \<psi>" and 2: "\<forall>\<sigma>. \<sigma> \<Turnstile> \<psi> \<longleftrightarrow> \<sigma> \<Turnstile> \<phi>"
     from 1 have "stutter_invariant \<psi>" by (rule next_free_stutter_invariant)
     with 2 have "stutter_invariant \<phi>" by blast
   }
 ultimately show ?thesis by blast
 qed
 
 
 end
 
diff --git a/thys/Stuttering_Equivalence/Samplers.thy b/thys/Stuttering_Equivalence/Samplers.thy
--- a/thys/Stuttering_Equivalence/Samplers.thy
+++ b/thys/Stuttering_Equivalence/Samplers.thy
@@ -1,587 +1,567 @@
 theory Samplers
-imports Main
+  imports Main "~~/src/HOL/Library/Omega_Words_Fun"
 begin
 
 section {* Utility Lemmas *}
 
 text {*
   The following lemmas about strictly monotonic functions could go
   to the standard library of Isabelle/HOL.
 *}
 
 text {*
   Strongly monotonic functions over the integers grow without bound.
 *}
 lemma strict_mono_exceeds:
   assumes f: "strict_mono (f::nat \<Rightarrow> nat)"
   shows "\<exists>k. n < f k"
 proof (induct n)
   from f have "f 0 < f 1" by (rule strict_monoD) simp
   hence "0 < f 1" by simp
   thus "\<exists>k. 0 < f k" ..
 next
   fix n
   assume "\<exists>k. n < f k"
   then obtain k where "n < f k" ..
   hence "Suc n \<le> f k" by simp
   also from f have "f k < f (Suc k)" by (rule strict_monoD) simp
   finally show "\<exists>k. Suc n < f k" ..
 qed
 
 text {*
   More precisely, any natural number @{text "n \<ge> f 0"} lies in the interval
   between @{text "f k"} and @{text "f (Suc k)"}, for some @{text k}.
 *}
 lemma strict_mono_interval:
   assumes f: "strict_mono (f::nat \<Rightarrow> nat)" and n: "f 0 \<le> n"
   obtains k where "f k \<le> n" and "n < f (Suc k)"
 proof -
   from f[THEN strict_mono_exceeds] obtain m where m: "n < f m" ..
   have "m \<noteq> 0"
   proof
     assume "m = 0"
     with m n show "False" by simp
   qed
   with m obtain m' where m': "n < f (Suc m')" by (auto simp: gr0_conv_Suc)
   let ?k = "LEAST k. n < f (Suc k)"
   from m' have 1: "n < f (Suc ?k)" by (rule LeastI)
   have "f ?k \<le> n"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     hence k: "n < f ?k" by simp
     show "False"
     proof (cases "?k")
       case 0 with k n show "False" by simp
     next
       case Suc with k show "False" by (auto dest: Least_le)
     qed
   qed
   with 1 that show ?thesis by simp
 qed
 
 lemma strict_mono_comp:
   assumes g: "strict_mono (g::'a::order \<Rightarrow> 'b::order)"
       and f: "strict_mono (f::'b::order \<Rightarrow> 'c::order)"
   shows "strict_mono (f \<circ> g)"
   using assms by (auto simp: strict_mono_def)
 
-
-text {*
-  We represent @{text \<omega>}-words as functions of type @{text "nat \<Rightarrow> 'a"}.
-  Suffixes of @{text \<omega>}-words are simply obtained by index shifting,
-  and we introduce a convenient notation.
-*}
-
-definition suffix :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> 'a)"   ("_[_ ..]" [80, 15] 80) where
-  "\<sigma>[n..] \<equiv> \<lambda>i. \<sigma> (n + i)"
-
-lemma suffix_elt [simp]: "(\<sigma>[n..]) i = \<sigma> (n+i)"
-  by (simp add: suffix_def)
-
-lemma suffix_0 [simp]: "\<sigma>[0..] = \<sigma>"
-  by (simp add: suffix_def)
-
-lemma suffix_suffix [simp]: "\<sigma>[n..][m..] = \<sigma>[n+m ..]"
-  by (simp add: suffix_def add.assoc)
-
-
 section {* Stuttering Sampling Functions *}
 
 text {*
   Given an @{text \<omega>}-sequence @{text "\<sigma>"}, a stuttering sampling function 
   is a strictly monotonic function @{text "f::nat \<Rightarrow> nat"} such that
   @{text "f 0 = 0"} and for all @{text i} and all @{text "f i \<le> k < f (i+1)"},
   the elements @{text "\<sigma> k"} are the same. In other words, @{text f} skips some
   (but not necessarily all) stuttering steps, but never skips a non-stuttering step.
   Given such @{text "\<sigma>"} and @{text f}, the (stuttering-)sampled
   reduction of @{text "\<sigma>"} is the sequence of elements of @{text "\<sigma>"} at the
   indices @{text "f i"}, which can simply be written as @{text "\<sigma> \<circ> f"}.
 *}
 
 
 subsection {* Definition and elementary properties *}
 
 definition stutter_sampler where
   -- {* f is a stuttering sampling function for @{text "\<sigma>"} *}
   "stutter_sampler (f::nat \<Rightarrow> nat) \<sigma> \<equiv>
      f 0 = 0
    \<and> strict_mono f
    \<and> (\<forall>k n. f k < n \<and> n < f (Suc k) \<longrightarrow> \<sigma> n = \<sigma> (f k))"
 
 lemma stutter_sampler_0: "stutter_sampler f \<sigma> \<Longrightarrow> f 0 = 0"
   by (simp add: stutter_sampler_def)
 
 lemma stutter_sampler_mono: "stutter_sampler f \<sigma> \<Longrightarrow> strict_mono f"
   by (simp add: stutter_sampler_def)
 
 lemma stutter_sampler_between:
   assumes f: "stutter_sampler f \<sigma>"
       and lo: "f k \<le> n" and hi: "n < f (Suc k)"
     shows "\<sigma> n = \<sigma> (f k)"
   using assms by (auto simp: stutter_sampler_def less_le)
 
 lemma stutter_sampler_interval:
   assumes f: "stutter_sampler f \<sigma>"
   obtains k where "f k \<le> n" and "n < f (Suc k)"
 using f[THEN stutter_sampler_mono] proof (rule strict_mono_interval)
   from f show "f 0 \<le> n" by (simp add: stutter_sampler_0)
 qed
 
 text {*
   The identity function is a stuttering sampling function for any @{text "\<sigma>"}.
 *}
 lemma id_stutter_sampler [iff]: "stutter_sampler id \<sigma>"
   by (auto simp: stutter_sampler_def strict_mono_def)
 
 text {*
   Stuttering sampling functions compose, sort of.
 *}
 lemma stutter_sampler_comp:
   assumes f: "stutter_sampler f \<sigma>"
       and g: "stutter_sampler g (\<sigma> \<circ> f)"
   shows "stutter_sampler (f \<circ> g) \<sigma>"
 proof (auto simp: stutter_sampler_def)
   from f g show "f (g 0) = 0" by (simp add: stutter_sampler_0)
 next
   from g[THEN stutter_sampler_mono] f[THEN stutter_sampler_mono]
   show "strict_mono (f \<circ> g)" by (rule strict_mono_comp)
 next
   fix i k
   assume lo: "f (g i) < k" and hi: "k < f (g (Suc i))"
   from f obtain m where 1: "f m \<le> k" and 2: "k < f (Suc m)"
     by (rule stutter_sampler_interval)
   with f have 3: "\<sigma> k = \<sigma> (f m)" by (rule stutter_sampler_between)
   from lo 2 have "f (g i) < f (Suc m)" by simp
   with f[THEN stutter_sampler_mono] have 4: "g i \<le> m" by (simp add: strict_mono_less)
   from 1 hi have "f m < f (g (Suc i))" by simp
   with f[THEN stutter_sampler_mono] have 5: "m < g (Suc i)"by (simp add: strict_mono_less)
   from g 4 5 have "(\<sigma> \<circ> f) m = (\<sigma> \<circ> f) (g i)" by (rule stutter_sampler_between)
   with 3 show "\<sigma> k = \<sigma> (f (g i))" by simp
 qed
 
 text {*
   Stuttering sampling functions can be extended to suffixes.
 *}
 lemma stutter_sampler_suffix:
   assumes f: "stutter_sampler f \<sigma>"
-  shows "stutter_sampler (\<lambda>k. f (n+k) - f n) (\<sigma>[f n ..])"
+  shows "stutter_sampler (\<lambda>k. f (n+k) - f n) (suffix (f n) \<sigma>)"
 proof (auto simp: stutter_sampler_def strict_mono_def)
   fix i j
   assume ij: "(i::nat) < j"
   from f have mono: "strict_mono f" by (rule stutter_sampler_mono)
 
   from mono[THEN strict_mono_mono] have "f n \<le> f (n+i)"
     by (rule monoD) simp
   moreover
   from mono[THEN strict_mono_mono] have "f n \<le> f (n+j)"
     by (rule monoD) simp
   moreover
   from mono ij have "f (n+i) < f (n+j)" by (auto intro: strict_monoD)
   ultimately
   show "f (n+i) - f n < f (n+j) - f n" by simp
 next
   fix i k
   assume lo: "f (n+i) - f n < k" and hi: "k < f (Suc (n+i)) - f n"
   from lo have "f (n+i) \<le> f n + k" by simp
   moreover
   from hi have "f n + k < f (Suc (n + i))" by simp
   moreover
   from f[THEN stutter_sampler_mono, THEN strict_mono_mono]
   have "f n \<le> f (n+i)" by (rule monoD) simp
   ultimately show "\<sigma> (f n + k) = \<sigma> (f n + (f (n+i) - f n))" 
     by (auto dest: stutter_sampler_between[OF f])
 qed
 
 
 subsection {* Preservation of properties through stuttering sampling *}
 
 text {*
   Stuttering sampling preserves the initial element of the sequence, as well as
   the presence and relative ordering of different elements.
 *}
 
 lemma stutter_sampled_0:
   assumes "stutter_sampler f \<sigma>"
   shows "\<sigma> (f 0) = \<sigma> 0"
   using assms[THEN stutter_sampler_0] by simp
 
 lemma stutter_sampled_in_range:
   assumes f: "stutter_sampler f \<sigma>" and s: "s \<in> range \<sigma>"
   shows "s \<in> range (\<sigma> \<circ> f)"
 proof -
   from s obtain n where n: "\<sigma> n = s" by auto
   from f obtain k where "f k \<le> n" "n < f (Suc k)" by (rule stutter_sampler_interval)
   with f have "\<sigma> n = \<sigma> (f k)" by (rule stutter_sampler_between)
   with n show ?thesis by auto
 qed
 
 lemma stutter_sampled_range:
   assumes "stutter_sampler f \<sigma>"
   shows "range (\<sigma> \<circ> f) = range \<sigma>"
   using assms by (auto intro: stutter_sampled_in_range)
 
 lemma stutter_sampled_precedence:
   assumes f: "stutter_sampler f \<sigma>" and ij: "i \<le> j"
   obtains k l where "k \<le> l" "\<sigma> (f k) = \<sigma> i" "\<sigma> (f l) = \<sigma> j"
 proof -
   from f obtain k where k: "f k \<le> i" "i < f (Suc k)" by (rule stutter_sampler_interval)
   with f have 1: "\<sigma> i = \<sigma> (f k)" by (rule stutter_sampler_between)
   from f obtain l where l: "f l \<le> j" "j < f (Suc l)" by (rule stutter_sampler_interval)
   with f have 2: "\<sigma> j = \<sigma> (f l)" by (rule stutter_sampler_between)
   from k l ij have "f k < f (Suc l)" by simp
   with f[THEN stutter_sampler_mono] have "k \<le> l" by (simp add: strict_mono_less)
   with 1 2 that show ?thesis by simp
 qed
 
 
 subsection {* Maximal stuttering sampling *}
 
 text {*
   We define a particular sampling function that is maximal in the sense that it
   eliminates all finite stuttering. If a sequence ends with infinite stuttering
   then it behaves as the identity over the (maximal such) suffix.
 *}
 
 fun max_stutter_sampler where
   "max_stutter_sampler \<sigma> 0 = 0"
 | "max_stutter_sampler \<sigma> (Suc n) =
     (let prev = max_stutter_sampler \<sigma> n
      in  if (\<forall>k > prev. \<sigma> k = \<sigma> prev)
          then Suc prev
          else (LEAST k. prev < k \<and> \<sigma> k \<noteq> \<sigma> prev))"
 
 text {*
   @{text max_stutter_sampler} is indeed a stuttering sampling function.
 *}
 lemma max_stutter_sampler: 
   "stutter_sampler (max_stutter_sampler \<sigma>) \<sigma>" (is "stutter_sampler ?ms _")
 proof -
   have "?ms 0 = 0" by simp
   moreover
   have "\<forall>n. ?ms n < ?ms (Suc n)"
   proof
     fix n
     show "?ms n < ?ms (Suc n)" (is "?prev < ?next")
     proof (cases "\<forall>k > ?prev. \<sigma> k = \<sigma> ?prev")
       case True thus ?thesis by (simp add: Let_def)
     next
       case False
       hence "\<exists>k. ?prev < k \<and> \<sigma> k \<noteq> \<sigma> ?prev" by simp
       from this[THEN LeastI_ex] 
       have "?prev < (LEAST k. ?prev < k \<and> \<sigma> k \<noteq> \<sigma> ?prev)" ..
       with False show ?thesis by (simp add: Let_def)
     qed
   qed
   hence "strict_mono ?ms"
     unfolding strict_mono_def by (blast intro: lift_Suc_mono_less)
   moreover
   have "\<forall>n k. ?ms n < k \<and> k < ?ms (Suc n) \<longrightarrow> \<sigma> k = \<sigma> (?ms n)"
   proof (clarify)
     fix n k
     assume lo: "?ms n < k" (is "?prev < k")
        and hi: "k < ?ms (Suc n)" (is "k < ?next")
     show "\<sigma> k = \<sigma> ?prev"
     proof (cases "\<forall>k > ?prev. \<sigma> k = \<sigma> ?prev")
       case True
       hence "?next = Suc ?prev" by (simp add: Let_def)
       with lo hi show ?thesis by simp  -- {* no room for intermediate index *}
     next
       case False
       hence "?next = (LEAST k. ?prev < k \<and> \<sigma> k \<noteq> \<sigma> ?prev)"
         by (auto simp add: Let_def)
       with lo hi show ?thesis by (auto dest: not_less_Least)
     qed
   qed
   ultimately show ?thesis unfolding stutter_sampler_def by blast
 qed
 
 text {*
   We write @{text "\<natural>\<sigma>"} for the sequence @{text "\<sigma>"} sampled by the
   maximal stuttering sampler. Also, a sequence is \emph{stutter free}
   if it contains no finite stuttering: whenever two subsequent
   elements are equal then all subsequent elements are the same.
 *}
 definition stutter_reduced ("\<natural>_" [100] 100) where
   "\<natural>\<sigma> = \<sigma> \<circ> (max_stutter_sampler \<sigma>)"
 
 definition stutter_free where
   "stutter_free \<sigma> \<equiv> \<forall>k. \<sigma> (Suc k) = \<sigma> k \<longrightarrow> (\<forall>n>k. \<sigma> n = \<sigma> k)"
 
 lemma stutter_freeI:
   assumes "\<And>k n. \<lbrakk>\<sigma> (Suc k) = \<sigma> k; n>k\<rbrakk> \<Longrightarrow> \<sigma> n = \<sigma> k"
   shows "stutter_free \<sigma>"
   using assms unfolding stutter_free_def by blast
 
 lemma stutter_freeD:
   assumes "stutter_free \<sigma>" and "\<sigma> (Suc k) = \<sigma> k" and "n>k"
   shows "\<sigma> n = \<sigma> k"
   using assms unfolding stutter_free_def by blast
 
 text {*
   Any suffix of a stutter free sequence is itself stutter free.
 *}
 lemma stutter_free_suffix: 
   assumes sigma: "stutter_free \<sigma>"
-  shows "stutter_free (\<sigma>[k..])"
+  shows "stutter_free (suffix k \<sigma>)"
 proof (rule stutter_freeI)
   fix j n
-  assume j: "(\<sigma>[k..]) (Suc j) = (\<sigma>[k..]) j" and n: "j < n"
+  assume j: "(suffix k \<sigma>) (Suc j) = (suffix k \<sigma>) j" and n: "j < n"
   from j have "\<sigma> (Suc (k+j)) = \<sigma> (k+j)" by simp
   moreover from n have "k+n > k+j" by simp
   ultimately have "\<sigma> (k+n) = \<sigma> (k+j)" by (rule stutter_freeD[OF sigma])
-  thus "(\<sigma>[k..]) n = (\<sigma>[k..]) j" by simp
+  thus "(suffix k \<sigma>) n = (suffix k \<sigma>) j" by simp
 qed
 
 lemma stutter_reduced_0: "(\<natural>\<sigma>) 0 = \<sigma> 0"
   by (simp add: stutter_reduced_def stutter_sampled_0 max_stutter_sampler)
 
 lemma stutter_free_reduced:
   assumes sigma: "stutter_free \<sigma>"
   shows "\<natural>\<sigma> = \<sigma>"
 proof -
   {
     fix n
     have "max_stutter_sampler \<sigma> n = n" (is "?ms n = n")
     proof (induct n)
       show "?ms 0 = 0" by simp
     next
       fix n
       assume ih: "?ms n = n"
       show "?ms (Suc n) = Suc n"
       proof (cases "\<sigma> (Suc n) = \<sigma> (?ms n)")
         case True
         with ih have "\<sigma> (Suc n) = \<sigma> n" by simp
         with sigma have "\<forall>k > n. \<sigma> k = \<sigma> n"
           unfolding stutter_free_def by blast
         with ih show ?thesis by (simp add: Let_def)
       next
         case False
         with ih have "(LEAST k. k>n \<and> \<sigma> k \<noteq> \<sigma> (?ms n)) = Suc n"
           by (auto intro: Least_equality)
         with ih False show ?thesis by (simp add: Let_def)
       qed
     qed
   }
   thus ?thesis by (auto simp: stutter_reduced_def)
 qed
 
 text {*
   Whenever two sequence elements at two consecutive sampling points of the 
   maximal stuttering sampler are equal then the sequence stutters infinitely 
   from the first sampling point onwards. In particular, @{text "\<natural>\<sigma>"} is
   stutter free.
 *}
 lemma max_stutter_sampler_nostuttering:
   assumes stut: "\<sigma> (max_stutter_sampler \<sigma> (Suc k)) = \<sigma> (max_stutter_sampler \<sigma> k)"
       and n: "n > max_stutter_sampler \<sigma> k" (is "_ > ?ms k")
   shows "\<sigma> n = \<sigma> (?ms k)"
 proof (rule ccontr)
   assume contr: "\<not> ?thesis"
   with n have "?ms k < n \<and> \<sigma> n \<noteq> \<sigma> (?ms k)" (is "?diff n") ..
   hence "?diff (LEAST n. ?diff n)" by (rule LeastI)
   with contr have "\<sigma> (?ms (Suc k)) \<noteq> \<sigma> (?ms k)" by (auto simp add: Let_def)
   from this stut show "False" ..
 qed
 
 lemma stutter_reduced_stutter_free: "stutter_free (\<natural>\<sigma>)"
 proof (rule stutter_freeI)
   fix k n
   assume k: "(\<natural>\<sigma>) (Suc k) = (\<natural>\<sigma>) k" and n: "k < n"
   from n have "max_stutter_sampler \<sigma> k < max_stutter_sampler \<sigma> n"
     using max_stutter_sampler[THEN stutter_sampler_mono, THEN strict_monoD]
     by blast
   with k show "(\<natural>\<sigma>) n = (\<natural>\<sigma>) k"
     unfolding stutter_reduced_def 
     by (auto elim: max_stutter_sampler_nostuttering 
              simp del: max_stutter_sampler.simps)
 qed
 
-lemma stutter_reduced_suffix: "\<natural>((\<natural>\<sigma>)[k..]) = (\<natural>\<sigma>)[k..]"
+lemma stutter_reduced_suffix: "\<natural> (suffix k (\<natural>\<sigma>)) = suffix k (\<natural>\<sigma>)"
 proof (rule stutter_free_reduced)
   have "stutter_free (\<natural>\<sigma>)" by (rule stutter_reduced_stutter_free)
-  thus "stutter_free ((\<natural>\<sigma>)[k..])" by (rule stutter_free_suffix)
+  thus "stutter_free (suffix k (\<natural>\<sigma>))" by (rule stutter_free_suffix)
 qed
 
 lemma stutter_reduced_reduced: "\<natural>\<natural>\<sigma> = \<natural>\<sigma>"
-  by (rule stutter_reduced_suffix[of "\<sigma>" "0", simplified])
-
+  by (insert stutter_reduced_suffix[of 0 "\<sigma>", simplified])
+  
 text {*
   One can define a partial order on sampling functions for a given sequence
   @{text "\<sigma>"} by saying that function @{text g} is better than function @{text f}
   if the reduced sequence induced by @{text f} can be further reduced to obtain
   the reduced sequence corresponding to @{text g}, i.e. if there exists a
   stuttering sampling function @{text h} for the reduced sequence @{text "\<sigma> \<circ> f"}
   such that @{text "\<sigma> \<circ> f \<circ> h = \<sigma> \<circ> g"}. (Note that @{text "f \<circ> h"} is indeed a stuttering
   sampling function for @{text "\<sigma>"}, by theorem @{text "stutter_sampler_comp"}.)
 
   We do not formalize this notion but prove that @{text "max_stutter_sampler \<sigma>"}
   is the best sampling function according to this order.
 *}
 
 theorem sample_max_sample:
   assumes f: "stutter_sampler f \<sigma>"
   shows "\<natural>(\<sigma> \<circ> f) = \<natural>\<sigma>"
 proof -
   let ?mss = "max_stutter_sampler \<sigma>"
   let ?mssf = "max_stutter_sampler (\<sigma> \<circ> f)"
   from f have mssf: "stutter_sampler (f \<circ> ?mssf) \<sigma>"
     by (blast intro: stutter_sampler_comp max_stutter_sampler)
   txt {*
     The following is the core invariant of the proof: the sampling functions
     @{text "max_stutter_sampler \<sigma>"} and @{text "f \<circ> (max_stutter_sampler (\<sigma> \<circ> f))"}
     work in lock-step (i.e., sample the same points), except if @{text "\<sigma>"} ends
     in infinite stuttering, at which point function @{text f} may make larger
     steps than the maximal sampling functions.
   *}
   {
     fix k
     have "  ?mss k = f (?mssf k)
           \<or> ?mss k \<le> f (?mssf k) \<and> (\<forall>n \<ge> ?mss k. \<sigma> (?mss k) = \<sigma> n)"
           (is "?P k" is "?A k \<or> ?B k")
     proof (induct k)
       from f mssf have "?mss 0 = f (?mssf 0)"
         by (simp add: max_stutter_sampler stutter_sampler_0)
       thus "?P 0" ..
     next
       fix k
       assume ih: "?P k"
       have b: "?B k \<longrightarrow> ?B (Suc k)"
       proof
         assume 0: "?B k" hence 1: "?mss k \<le> f (?mssf k)" ..
         (* NB: For some reason "... hence 1: ... and 2: ..." cannot be proved *)
         from 0 have 2: "\<forall>n \<ge> ?mss k. \<sigma> (?mss k) = \<sigma> n" ..
         hence "\<forall>n > ?mss k. \<sigma> (?mss k) = \<sigma> n" by auto
         hence "\<forall>n > ?mss k. \<sigma> n = \<sigma> (?mss k)" by auto
         hence 3: "?mss (Suc k) = Suc (?mss k)" by (simp add: Let_def)
         with 2 have "\<sigma> (?mss k) = \<sigma> (?mss (Suc k))"
           by (auto simp del: max_stutter_sampler.simps)
         from sym[OF this] 2 3 have "\<forall>n \<ge> ?mss (Suc k). \<sigma> (?mss (Suc k)) = \<sigma> n"
           by (auto simp del: max_stutter_sampler.simps)
         moreover
         from mssf[THEN stutter_sampler_mono, THEN strict_monoD] 
         have "f (?mssf k) < f (?mssf (Suc k))"
           by (simp del: max_stutter_sampler.simps)
         with 1 3 have "?mss (Suc k) \<le> f (?mssf (Suc k))"
           by (simp del: max_stutter_sampler.simps)
         ultimately show "?B (Suc k)" by blast
       qed
       from ih show "?P (Suc k)"
       proof
         assume a: "?A k"
         show ?thesis
         proof (cases "\<forall>n > ?mss k. \<sigma> n = \<sigma> (?mss k)")
           case True
           hence "\<forall>n \<ge> ?mss k. \<sigma> (?mss k) = \<sigma> n" by (auto simp: le_less)
           with a have "?B k" by simp
           with b show ?thesis by (simp del: max_stutter_sampler.simps)
         next
           case False
           hence diff: "\<sigma> (?mss (Suc k)) \<noteq> \<sigma> (?mss k)"
             by (blast dest: max_stutter_sampler_nostuttering)
           have "?A (Suc k)"
           proof (rule antisym)
             show "f (?mssf (Suc k)) \<le> ?mss (Suc k)"
             proof (rule ccontr)
               assume "\<not> ?thesis"
               hence contr: "?mss (Suc k) < f (?mssf (Suc k))" by simp
               from mssf have "\<sigma> (?mss (Suc k)) = \<sigma> ((f \<circ> ?mssf) k)"
               proof (rule stutter_sampler_between)
                 from max_stutter_sampler[of "\<sigma>", THEN stutter_sampler_mono]
                 have "?mss k < ?mss (Suc k)" by (rule strict_monoD) simp
                 with a show "(f \<circ> ?mssf) k \<le> ?mss (Suc k)"
                   by (simp add: o_def del: max_stutter_sampler.simps)
               next
                 from contr show "?mss (Suc k) < (f \<circ> ?mssf) (Suc k)" by simp
               qed
               with a have "\<sigma> (?mss (Suc k)) = \<sigma> (?mss k)"
                 by (simp add: o_def del: max_stutter_sampler.simps)
               with diff show "False" ..
             qed
           next
             have "\<exists>m > ?mssf k. f m = ?mss (Suc k)"
             proof (rule ccontr)
               assume "\<not> ?thesis"
               hence contr: "\<forall>i. f ((?mssf k) + Suc i) \<noteq> ?mss (Suc k)" by simp
               {
                 fix i
                 have "f (?mssf k + i) < ?mss (Suc k)" (is "?F i")
                 proof (induct i)
                   from a have "f (?mssf k + 0) = ?mss k" by (simp add: o_def)
                   also from max_stutter_sampler[of "\<sigma>", THEN stutter_sampler_mono] 
                        have "... < ?mss (Suc k)"
                          by (rule strict_monoD) simp
                   finally show "?F 0" .
                 next
                   fix i
                   assume ih: "?F i"
                   show "?F (Suc i)"
                   proof (rule ccontr)
                     assume "\<not> ?thesis"
                     then have "?mss (Suc k) \<le> f (?mssf k + Suc i)" 
                       by (simp add: o_def)
                     moreover from contr have "f (?mssf k + Suc i) \<noteq> ?mss (Suc k)"
                       by blast
                     ultimately have i: "?mss (Suc k) < f (?mssf k + Suc i)"
                       by (simp add: less_le)
                     from f have "\<sigma> (?mss (Suc k)) = \<sigma> (f (?mssf k + i))"
                     proof (rule stutter_sampler_between)
                       from ih show "f (?mssf k + i) \<le> ?mss (Suc k)" 
                         by (simp add: o_def)
                     next
                       from i show "?mss (Suc k) < f (Suc (?mssf k + i))" 
                         by simp
                     qed
                     also from max_stutter_sampler have "... = \<sigma> (?mss k)"
                     proof (rule stutter_sampler_between)
                       from f[THEN stutter_sampler_mono, THEN strict_mono_mono]
                       have "f (?mssf k) \<le> f (?mssf k + i)" by (rule monoD) simp
                       with a show "?mss k \<le> f (?mssf k + i)" by (simp add: o_def)
                     qed (rule ih)
                     also note diff
                     finally show "False" by simp
                   qed
                 qed
               } note bounded = this
               from f[THEN stutter_sampler_mono] 
               have "strict_mono (\<lambda>i. f (?mssf k + i))" 
                 by (auto simp: strict_mono_def)
               then obtain i where i: "?mss (Suc k) < f (?mssf k + i)"
                 by (blast dest: strict_mono_exceeds)
               from bounded have "f (?mssf k + i) < ?mss (Suc k)" .
               with i show "False" by (simp del: max_stutter_sampler.simps)
             qed
             then obtain m where m: "m > ?mssf k" and m': "f m = ?mss (Suc k)"
               by blast
             show "?mss (Suc k) \<le> f (?mssf (Suc k))"
             proof (rule ccontr)
               assume "\<not> ?thesis"
               hence contr: "f (?mssf (Suc k)) < ?mss (Suc k)" by simp
               from mssf[THEN stutter_sampler_mono]
               have "(f \<circ> ?mssf) k < (f \<circ> ?mssf) (Suc k)" 
                 by (rule strict_monoD) simp
               with a have "?mss k \<le> f (?mssf (Suc k))"
                 by (simp add: o_def)
               from this contr have "\<sigma> (f (?mssf (Suc k))) = \<sigma> (?mss k)"
                 by (rule stutter_sampler_between[OF max_stutter_sampler])
               with a have stut: "(\<sigma> \<circ> f) (?mssf (Suc k)) = (\<sigma> \<circ> f) (?mssf k)"
                 by (simp add: o_def)
               from this m have "(\<sigma> \<circ> f) m = (\<sigma> \<circ> f) (?mssf k)"
                 by (blast intro: max_stutter_sampler_nostuttering)
               with diff m' a show "False"
                 by (simp add: o_def)
             qed
           qed
           thus ?thesis ..
         qed
       next
         assume "?B k" with b show ?thesis by (simp del: max_stutter_sampler.simps)
       qed
     qed
   }
   hence "\<natural>\<sigma> = \<natural>(\<sigma> \<circ> f)" unfolding stutter_reduced_def by force
   thus ?thesis by (rule sym)
 qed
 
 
 end  (* theory Samplers *)
 
diff --git a/thys/Stuttering_Equivalence/StutterEquivalence.thy b/thys/Stuttering_Equivalence/StutterEquivalence.thy
--- a/thys/Stuttering_Equivalence/StutterEquivalence.thy
+++ b/thys/Stuttering_Equivalence/StutterEquivalence.thy
@@ -1,251 +1,255 @@
 theory StutterEquivalence
 imports Samplers
 
 begin
 
 section {* Stuttering Equivalence *}
 
 text {*
   Stuttering equivalence of two sequences is formally defined as the equality
   of their maximally reduced versions.
 *}
 
 definition stutter_equiv  (infix "\<approx>" 50) where
   "\<sigma> \<approx> \<tau> \<equiv> \<natural>\<sigma> = \<natural>\<tau>"
 
 text {*
   Stuttering equivalence is an equivalence relation.
 *}
 
 lemma stutter_equiv_refl: "\<sigma> \<approx> \<sigma>"
   unfolding stutter_equiv_def ..
 
 lemma stutter_equiv_sym [sym]: "\<sigma> \<approx> \<tau> \<Longrightarrow> \<tau> \<approx> \<sigma>"
   unfolding stutter_equiv_def by (rule sym)
 
 lemma stutter_equiv_trans [trans]: "\<rho> \<approx> \<sigma> \<Longrightarrow> \<sigma> \<approx> \<tau> \<Longrightarrow> \<rho> \<approx> \<tau>"
   unfolding stutter_equiv_def by simp
 
 text {*
   In particular, any sequence sampled by a stuttering sampler
   is stuttering equivalent to the original one.
 *}
 lemma sampled_stutter_equiv:
   assumes "stutter_sampler f \<sigma>"
   shows "\<sigma> \<circ> f \<approx> \<sigma>"
   using assms unfolding stutter_equiv_def by (rule sample_max_sample)
 
 lemma stutter_reduced_equivalent: "\<natural>\<sigma> \<approx> \<sigma>"
   unfolding stutter_equiv_def by (rule stutter_reduced_reduced)
 
 text {*
   For proving stuttering equivalence of two sequences, it is enough
   to exhibit two arbitrary sampling functions that equalize the reductions
   of the sequences. This can be more convenient than computing the
   maximal stutter-reduced version of the sequences.
 *}
 
 lemma stutter_equivI:
   assumes f: "stutter_sampler f \<sigma>" and g: "stutter_sampler g \<tau>" 
       and eq: "\<sigma> \<circ> f = \<tau> \<circ> g"
   shows "\<sigma> \<approx> \<tau>"
 proof -
   from f have "\<natural>\<sigma> = \<natural>(\<sigma> \<circ> f)" by (rule sample_max_sample[THEN sym])
   also from eq have "... = \<natural>(\<tau> \<circ> g)" by simp
   also from g have "... = \<natural>\<tau>" by (rule sample_max_sample)
   finally show ?thesis by (unfold stutter_equiv_def)
 qed
 
 text {*
   The corresponding elimination rule is easy to prove, given that the
   maximal stuttering sampling function is a stuttering sampling function.
 *}
 
 lemma stutter_equivE:
   assumes eq: "\<sigma> \<approx> \<tau>"
   and p: "\<And>f g. \<lbrakk> stutter_sampler f \<sigma>; stutter_sampler g \<tau>; \<sigma> \<circ> f = \<tau> \<circ> g \<rbrakk> \<Longrightarrow> P"
   shows "P"
 proof (rule p)
   from eq show "\<sigma> \<circ> (max_stutter_sampler \<sigma>) = \<tau> \<circ> (max_stutter_sampler \<tau>)"
     by (unfold stutter_equiv_def stutter_reduced_def)
 qed (rule max_stutter_sampler)+
 
 text {*
   Therefore we get the following alternative characterization: two
   sequences are stuttering equivalent iff there are stuttering sampling
   functions that equalize the two sequences.
 *}
 lemma stutter_equiv_eq:
   "\<sigma> \<approx> \<tau> = (\<exists>f g. stutter_sampler f \<sigma> \<and> stutter_sampler g \<tau> \<and> \<sigma> \<circ> f = \<tau> \<circ> g)"
   by (blast intro: stutter_equivI elim: stutter_equivE)
 
 text {*
   The initial elements of stutter equivalent sequences are equal.
 *}
 lemma stutter_equiv_0:
   assumes "\<sigma> \<approx> \<tau>"
   shows "\<sigma> 0 = \<tau> 0"
 proof -
   have "\<sigma> 0 = (\<natural>\<sigma>) 0" by (rule stutter_reduced_0[THEN sym])
   with assms[unfolded stutter_equiv_def] show ?thesis
     by (simp add: stutter_reduced_0)
 qed
 
+abbreviation suffix_notation ("_ [_..]")
+where
+  "suffix_notation w k \<equiv> suffix k w"
+
 text {*
   Given any stuttering sampling function @{text f} for sequence @{text "\<sigma>"},
   any suffix of @{text "\<sigma>"} starting at index @{text "f n"} is stuttering
   equivalent to the suffix of the stutter-reduced version of @{text "\<sigma>"}
   starting at @{text "n"}.
 *}
 lemma suffix_stutter_equiv:
   assumes f: "stutter_sampler f \<sigma>"
-  shows "\<sigma>[f n ..] \<approx> (\<sigma> \<circ> f)[n ..]"
+  shows "suffix (f n) \<sigma> \<approx> suffix n (\<sigma> \<circ> f)"
 proof -
   from f have "stutter_sampler (\<lambda>k. f (n+k) - f n) (\<sigma>[f n ..])"
     by (rule stutter_sampler_suffix)
   moreover
   have "stutter_sampler id ((\<sigma> \<circ> f)[n ..])"
     by (rule id_stutter_sampler)
   moreover
   have "(\<sigma>[f n ..]) \<circ> (\<lambda>k. f (n+k) - f n) = ((\<sigma> \<circ> f)[n ..]) \<circ> id"
   proof (rule ext, auto)
     fix i
     from f[THEN stutter_sampler_mono, THEN strict_mono_mono]
     have "f n \<le> f (n+i)" by (rule monoD) simp
     thus "\<sigma> (f n + (f (n+i) - f n)) = \<sigma> (f (n+i))" by simp
   qed
   ultimately show ?thesis
     by (rule stutter_equivI)
 qed
 
 text {*
   Given a stuttering sampling function @{text f} and a point @{text "n"}
   within the interval from @{text "f k"} to @{text "f (k+1)"}, the suffix
   starting at @{text n} is stuttering equivalent to the suffix starting
   at @{text "f k"}.
 *}
 lemma stutter_equiv_within_interval:
   assumes f: "stutter_sampler f \<sigma>"
       and lo: "f k \<le> n" and hi: "n < f (Suc k)"
   shows "\<sigma>[n ..] \<approx> \<sigma>[f k ..]"
 proof -
   have "stutter_sampler id (\<sigma>[n ..])" by (rule id_stutter_sampler)
   moreover
   from lo have "stutter_sampler (\<lambda>i. if i=0 then 0 else n + i - f k) (\<sigma>[f k ..])"
     (is "stutter_sampler ?f _")
   proof (auto simp: stutter_sampler_def strict_mono_def)
     fix i
     assume i: "i < Suc n - f k"
     from f show "\<sigma> (f k + i) = \<sigma> (f k)"
     proof (rule stutter_sampler_between)
       from i hi show "f k + i < f (Suc k)" by simp
     qed simp
   qed
   moreover
   have "(\<sigma>[n ..]) \<circ> id = (\<sigma>[f k ..]) \<circ> ?f"
   proof (rule ext, auto)
     from f lo hi show "\<sigma> n = \<sigma> (f k)" by (rule stutter_sampler_between)
   next
     fix i
     from lo show "\<sigma> (n+i) = \<sigma> (f k + (n + i - f k))" by simp
   qed
   ultimately show ?thesis by (rule stutter_equivI)
 qed
 
 text {*
   Given two stuttering equivalent sequences @{text "\<sigma>"} and @{text "\<tau>"},
   we obtain a zig-zag relationship as follows: for any suffix @{text "\<tau>[n..]"}
   there is a suffix @{text "\<sigma>[m..]"} such that:
   \begin{enumerate}
   \item @{text "\<sigma>[m..] \<approx> \<tau>[n..]"} and
   \item for every suffix @{text "\<sigma>[j..]"} where @{text "j<m"} there is a
     corresponding suffix @{text "\<tau>[k..]"} for some @{text "k<n"}.
   \end{enumerate}
 *}
 theorem stutter_equiv_suffixes_left:
   assumes "\<sigma> \<approx> \<tau>"
   obtains m where "\<sigma>[m..] \<approx> \<tau>[n..]" and "\<forall>j<m. \<exists>k<n. \<sigma>[j..] \<approx> \<tau>[k..]"
 using assms proof (rule stutter_equivE)
   fix f g
   assume f: "stutter_sampler f \<sigma>"
      and g: "stutter_sampler g \<tau>"
      and eq: "\<sigma> \<circ> f = \<tau> \<circ> g"
   from g obtain i where i: "g i \<le> n" "n < g (Suc i)"
     by (rule stutter_sampler_interval)
   with g have "\<tau>[n..] \<approx> \<tau>[g i ..]"
     by (rule stutter_equiv_within_interval)
   also from g have "... \<approx> (\<tau> \<circ> g)[i ..]"
     by (rule suffix_stutter_equiv)
   also from eq have "... = (\<sigma> \<circ> f)[i ..]"
     by simp
   also from f have "... \<approx> \<sigma>[f i ..]"
     by (rule suffix_stutter_equiv[THEN stutter_equiv_sym])
   finally have "\<sigma>[f i ..] \<approx> \<tau>[n ..]"
     by (rule stutter_equiv_sym)
   moreover
   {
     fix j
     assume j: "j < f i"
     from f obtain a where a: "f a \<le> j" "j < f (Suc a)"
       by (rule stutter_sampler_interval)
     from a j have "f a < f i" by simp
     with f[THEN stutter_sampler_mono] have "a < i"
       by (simp add: strict_mono_less)
     with g[THEN stutter_sampler_mono] have "g a < g i"
       by (simp add: strict_mono_less)
     with i have 1: "g a < n" by simp
 
     from f a have "\<sigma>[j..] \<approx> \<sigma>[f a ..]"
       by (rule stutter_equiv_within_interval)
     also from f have "... \<approx> (\<sigma> \<circ> f)[a ..]"
       by (rule suffix_stutter_equiv)
     also from eq have "... = (\<tau> \<circ> g)[a ..]" by simp
     also from g have "... \<approx> \<tau>[g a ..]"
       by (rule suffix_stutter_equiv[THEN stutter_equiv_sym])
     finally have "\<sigma>[j ..] \<approx> \<tau>[g a ..]" .
     with 1 have "\<exists>k<n. \<sigma>[j..] \<approx> \<tau>[k ..]" by blast
   }
   moreover
   note that
   ultimately show ?thesis by blast
 qed
 
 theorem stutter_equiv_suffixes_right:
   assumes "\<sigma> \<approx> \<tau>"
   obtains n where "\<sigma>[m..] \<approx> \<tau>[n..]" and "\<forall>j<n. \<exists>k<m. \<sigma>[k..] \<approx> \<tau>[j..]"
 proof -
   from assms have "\<tau> \<approx> \<sigma>" 
     by (rule stutter_equiv_sym)
   then obtain n where "\<tau>[n..] \<approx> \<sigma>[m..]" "\<forall>j<n. \<exists>k<m. \<tau>[j..] \<approx> \<sigma>[k..]"
     by (rule stutter_equiv_suffixes_left)
   with that show ?thesis 
     by (blast dest: stutter_equiv_sym)
 qed
 
 text {*
   In particular, if @{text "\<sigma>"} and @{text "\<tau>"} are stutter equivalent then
   every element that occurs in one sequence also occurs in the other.
 *}
 lemma stutter_equiv_element_left:
   assumes "\<sigma> \<approx> \<tau>"
   obtains m where "\<sigma> m = \<tau> n" and "\<forall>j<m. \<exists>k<n. \<sigma> j = \<tau> k"
 proof -
   from assms obtain m where "\<sigma>[m..] \<approx> \<tau>[n..]" "\<forall>j<m. \<exists>k<n. \<sigma>[j..] \<approx> \<tau>[k..]"
     by (rule stutter_equiv_suffixes_left)
   with that show ?thesis
     by (force dest: stutter_equiv_0)
 qed
 
 lemma stutter_equiv_element_right:
   assumes "\<sigma> \<approx> \<tau>"
   obtains n where "\<sigma> m = \<tau> n" and "\<forall>j<n. \<exists>k<m. \<sigma> k = \<tau> j"
 proof -
   from assms obtain n where "\<sigma>[m..] \<approx> \<tau>[n..]" "\<forall>j<n. \<exists>k<m. \<sigma>[k..] \<approx> \<tau>[j..]"
     by (rule stutter_equiv_suffixes_right)
   with that show ?thesis
     by (force dest: stutter_equiv_0)
 qed
 
 
 end (* theory StutterEquivalence *)