diff --git a/thys/CAVA_LTL_Modelchecker/SM/Impl/SM_Ample_Impl.thy b/thys/CAVA_LTL_Modelchecker/SM/Impl/SM_Ample_Impl.thy
--- a/thys/CAVA_LTL_Modelchecker/SM/Impl/SM_Ample_Impl.thy
+++ b/thys/CAVA_LTL_Modelchecker/SM/Impl/SM_Ample_Impl.thy
@@ -1,1413 +1,1413 @@
 theory SM_Ample_Impl
 imports SM_Datastructures "../Analysis/SM_POR"
   "HOL-Library.RBT_Mapping"
 begin
 
   text \<open>
     Given a sticky program, we implement
     a valid ample-function by picking the transitions from the first
     PID that qualifies as an ample-set\<close>
   context visible_prog
   begin
     definition ga_gample
       :: "(cmdc\<times>cmdc) set \<Rightarrow> pid_global_config \<Rightarrow> global_action set" 
     where
       "ga_gample sticky_E gc \<equiv> let
         lcs = pid_global_config.processes gc;
         gs = pid_global_config.state gc;
         as = find_min_idx_f (\<lambda>lc.
           let
             c = local_config.command lc;
             ls = local_config.state lc;
             as = set (comp.succ_impl c)
           in
             if (\<forall>(a,_)\<in>as. read_globals a = {} \<and> write_globals a = {}) then
               let 
                 as = {(a,c')\<in>as. la_en' (ls,gs) a}
               in
                 if as={} \<or> (\<exists>(a,c')\<in>as. (c,c')\<in>sticky_E) then 
                   None 
                 else 
                   Some (c,as)
             else
               None
         ) lcs
       in
         case as of
           Some (pid,c,as) \<Rightarrow> (\<lambda>(a,c'). (pid,c,a,c'))`as
         | None \<Rightarrow> ga_gen gc"
     
     definition "ga_ample sticky_E 
       \<equiv> stutter_extend_en (ga_gample sticky_E)"
 
     lemma ga_gample_subset: "ga_gample sticky_E gc \<subseteq> ga_gen gc"
       unfolding ga_gample_def ga_gen_def
       by (auto 
         simp: comp.astep_impl_def
         split: option.splits if_split_asm 
         dest!: find_min_idx_f_SomeD)
 
     lemma ga_gample_empty_iff: "ga_gample sticky_E gc = {} \<longleftrightarrow> ga_gen gc = {}"  
       unfolding ga_gample_def ga_gen_def
       by (fastforce 
         simp: comp.astep_impl_def
         split: option.splits if_split_asm 
         dest!: find_min_idx_f_SomeD)
 
     lemma ga_ample_None_iff: "None \<in> ga_ample sticky_E gc \<longleftrightarrow> None \<in> ga_en gc"
       by (auto 
         simp: ga_ample_def ga_en_def stutter_extend_en_def ga_gample_empty_iff)
       
     lemma ga_ample_neq_en_eq:
       assumes "ga_ample sticky_E gc \<noteq> ga_en gc"
       shows "ga_ample sticky_E gc = Some`ga_gample sticky_E gc \<and> ga_en gc = Some`ga_gen gc"
       using assms ga_gample_subset
       unfolding ga_ample_def ga_en_def stutter_extend_en_def
       by (auto split: if_split_asm simp: ga_gample_empty_iff)
 
     lemma pid_pac_alt: "pid_pac pid = insert None (Some`{(pid',cac). pid'=pid})" 
       apply (auto simp: pid_pac_def split: option.splits)
       apply (case_tac x)
       apply auto
       done
   end    
 
   context sticky_prog begin
     sublocale ample_prog prog is_vis_var sticky_E "ga_ample sticky_E"
     proof -
       have aux: "Some ` A = Some ` B \<inter> pid_pac pid \<longleftrightarrow> A = {(pid', cac). (pid', cac) \<in> B \<and> pid' = pid}"
         for A B pid
       proof
         assume 1: "Some ` A = Some ` B \<inter> pid_pac pid"
         show "A = {(pid', cac). (pid', cac) \<in> B \<and> pid' = pid}"
           using 1
           apply (auto simp: pid_pac_alt)
           unfolding image_def
           apply auto
           using 1 by blast
       next
         show "Some ` A = Some ` B \<inter> pid_pac pid" if "A = {(pid', cac). (pid', cac) \<in> B \<and> pid' = pid}"
           using that by (auto simp: pid_pac_alt)
       qed
       show "ample_prog prog is_vis_var sticky_E (ga_ample sticky_E)"
         apply unfold_locales
         apply (frule ga_ample_neq_en_eq, clarsimp)
         apply (intro conjI)
         apply (auto 
           simp: ga_gample_def sticky_ga_def
           dest!: find_min_idx_f_SomeD
           split: option.splits if_split_asm) []
         apply (fastforce
           simp: ga_gample_def sticky_ga_def
           dest!: find_min_idx_f_SomeD
           split: option.splits if_split_asm) []
         unfolding aux (* TODO: Clean up! *)
         apply (simp add: inj_image_eq_iff pid_pac_def)
         apply (thin_tac "ga_ample c a = b" for a b c)
         apply (simp add: ga_gample_def split: option.splits prod.splits)
         apply (thin_tac "a \<noteq> ga_gen b" for a b)
         apply (drule find_min_idx_f_SomeD)
         apply clarsimp
         apply (rename_tac gc pid c as)
         apply (rule_tac x=pid in exI)
         apply (auto 
           split: if_split_asm prod.splits 
           simp: ga_gen_def comp.astep_impl_def)
         unfolding is_ample_static_def comp.astep_impl_def
         apply force
         done
     qed
 
   end
 
   text \<open> The following locale expresses a correct ample-reduction on 
     the level of subset and stuttering-equivalences of traces \<close>
 
   locale hl_reduction =
     visible_prog +
     ample: sa "\<lparr> g_V = UNIV, g_E = step, g_V0 = {pid_init_gc}, sa_L = pid_interp_gc \<rparr>"
     for step +
     assumes ample_accept_subset: "ample.accept w \<Longrightarrow> lv.sa.accept w"
     assumes ample_accept_stuttering: "lv.sa.accept w \<Longrightarrow> \<exists>w'. w\<approx>w' \<and> ample.accept w'"
 
   locale hl_ample_reduction =
     visible_prog +
     ample: sa "\<lparr> g_V = UNIV, g_E = rel_of_enex (ample, ga_ex), g_V0 = {pid_init_gc},
       sa_L = pid_interp_gc \<rparr>"
     for ample +
     assumes ample_accept_subset: "ample.accept w \<Longrightarrow> lv.sa.accept w"
     assumes ample_accept_stuttering: "lv.sa.accept w \<Longrightarrow> \<exists>w'. w\<approx>w' \<and> ample.accept w'"
   begin
     sublocale hl_reduction prog is_vis_var "rel_of_enex (ample, ga_ex)"
       apply unfold_locales
       using ample_accept_subset ample_accept_stuttering by auto
   end
 
 
   context sticky_prog
   begin
     sublocale hl_ample: hl_ample_reduction prog is_vis_var "ga_ample sticky_E"
       apply unfold_locales
       unfolding ample_rel_def[symmetric]
       unfolding reduced_automaton_def[symmetric]
       apply simp
       apply simp
       using ample_accept_subset
       apply simp
       apply (erule ample_accept_stuttering)
       apply blast
       done
   end    
 
   text \<open>Next, we implement the selection of a set of sticky edges\<close>
   context visible_prog begin
     definition "cr_ample \<equiv> do {
       sticky_E \<leftarrow> find_fas_init cfgc_G vis_edges;
       RETURN (ga_ample (sticky_E))
     }"
 
     lemma cr_ample_reduction: 
       "cr_ample \<le> SPEC (hl_ample_reduction prog is_vis_var)"
       unfolding cr_ample_def
       apply (refine_vcg order_trans[OF find_fas_init_correct])
       apply unfold_locales[]
       apply simp
     proof clarify  
       fix sticky_E
       assume "is_fas cfgc_G sticky_E" "vis_edges \<subseteq> sticky_E"
       then interpret sticky_prog prog is_vis_var sticky_E
         by unfold_locales
 
       show "hl_ample_reduction prog is_vis_var (ga_ample sticky_E)" by unfold_locales
     qed
   end  
 
   text \<open>We derive an implementation for finding the feedback arcs,
     and an efficient implementation for ga_gample.\<close>
 
   text \<open>We replace finding the sticky edges by an efficient algorithm\<close>
 
   context visible_prog begin
     definition ga_gample_m 
       :: "_ \<Rightarrow> _ \<Rightarrow> pid_global_config \<Rightarrow> global_action set" 
     where
       "ga_gample_m mem sticky_E gc \<equiv> let
         lcs = pid_global_config.processes gc;
         gs = pid_global_config.state gc;
         as = find_min_idx_f (\<lambda>lc.
           let
             c = local_config.command lc;
             ls = local_config.state lc;
             as = set (comp.succ_impl c)
           in
             if (\<forall>(a,_)\<in>as. read_globals a = {} \<and> write_globals a = {}) then
               let 
                 as = {(a,c')\<in>as. la_en' (ls,gs) a}
               in
                 if as={} \<or> (\<exists>(a,c')\<in>as. mem (c,c') sticky_E) then 
                   None 
                 else 
                   Some (c,as)
             else
               None
         ) lcs
       in
         case as of
           Some (pid,c,as) \<Rightarrow> (\<lambda>(a,c'). (pid,c,a,c'))`as
         | None \<Rightarrow> ga_gen gc"
 
     lemma ga_gample_m_refine:
       fixes Rs :: "('si\<times>'s) set"
       shows "(ga_gample_m, ga_gample_m) \<in> (Id\<times>\<^sub>rId \<rightarrow> Rs \<rightarrow> bool_rel) \<rightarrow> Rs \<rightarrow> Id \<rightarrow> \<langle>Id\<rangle>set_rel"
     proof (intro fun_relI, simp)  
       fix m :: "cmdc\<times>cmdc \<Rightarrow> 's \<Rightarrow> bool" and m' :: "cmdc\<times>cmdc \<Rightarrow> 'si \<Rightarrow> bool" 
         and se se' gc
       assume "(m',m)\<in>Id \<rightarrow> Rs \<rightarrow> bool_rel" and "(se',se)\<in>Rs"
       hence "\<And>c c'. (m' (c,c') se', m (c,c') se)\<in>Id" 
         by parametricity simp_all
       hence A: "\<And>c c'. m' (c,c') se' = m (c,c') se" by simp
       show "ga_gample_m m' se' gc = ga_gample_m m se gc"
         unfolding ga_gample_m_def
         by (subst A) (rule refl)
     qed             
 
     lemma ga_gample_eq_gample_m: "ga_gample = ga_gample_m (\<in>)"
       unfolding ga_gample_def[abs_def] ga_gample_m_def[abs_def]
       by auto
 
     lemma stutter_extend_en_refine: 
       "(stutter_extend_en, stutter_extend_en) \<in> (R \<rightarrow> \<langle>Id\<rangle>set_rel) \<rightarrow> R \<rightarrow> \<langle>\<langle>Id\<rangle>option_rel\<rangle>set_rel"
       unfolding stutter_extend_en_def[abs_def]
       apply parametricity
       by auto
 
     lemma is_vis_var_refine: "(is_vis_var, is_vis_var) \<in> Id \<rightarrow> bool_rel" by simp  
 
     lemma vis_edges_refine: "(\<lambda>x. x\<in>vis_edges,vis_edges)\<in>\<langle>Id\<times>\<^sub>rId\<rangle>fun_set_rel"
       by (simp add: fun_set_rel_def br_def)
 
     lemma [autoref_op_pat_def]: 
       "vis_edges \<equiv> Autoref_Tagging.OP vis_edges"  
       "ga_gample_m \<equiv> Autoref_Tagging.OP ga_gample_m"  
       "cfgc_G \<equiv> Autoref_Tagging.OP cfgc_G"
       by simp_all
 
     schematic_goal cr_ample_impl1_aux:
       notes [autoref_rules] = 
         ga_gample_m_refine stutter_extend_en_refine is_vis_var_refine
         cfgc_G_impl_refine
         vis_edges_refine IdI[of prog]
       shows "(RETURN (?c::?'c),cr_ample)\<in>?R"
       unfolding cr_ample_def ga_ample_def ga_gample_eq_gample_m
       using [[autoref_trace_failed_id, autoref_trace_intf_unif]]
       by (autoref_monadic (plain, trace))
     concrete_definition cr_ample_impl1 uses cr_ample_impl1_aux
 
     lemma cr_ample_impl1_reduction: 
       "hl_ample_reduction prog is_vis_var cr_ample_impl1"
     proof -
       note cr_ample_impl1.refine[THEN nres_relD]
       also note cr_ample_reduction
       finally show ?thesis by simp
     qed
 
   end
 
   text \<open>The efficient implementation of @{const visible_prog.ga_gample} uses 
     the @{const collecti_index} function\<close> 
 
   lemma collecti_index_cong:
     assumes C: "\<And>i. i<length l \<Longrightarrow> f i (l!i) = f' i (l'!i)"
     assumes [simp]: "l=l'"
     shows "collecti_index f l = collecti_index f' l'"
   proof -
     {
       fix i0 s0
       assume "\<forall>i<length l. f (i0+i) (l!i) = f' (i0+i) (l!i)"
       hence "collecti_index' i0 s0 f l = collecti_index' i0 s0 f' l"
       proof (induction l arbitrary: i0 s0)
         case (Cons a l)
 
         from Cons.prems[THEN spec, of 0] have 
           [simp]: "f i0 a = f' i0 a" by simp
 
         from Cons.prems have 
           IHP: "\<forall>i<length l. f (Suc i0+i) (l!i) = f' (Suc i0+i) (l!i)"
           by auto
 
         show ?case by (auto split: bool.splits simp: Cons.IH[OF IHP])
       qed simp
     } from this[of 0 "{}"] show ?thesis using assms by simp
   qed  
 
   lemma find_min_idx_f_cong:
     assumes "\<And>x. x\<in>set l \<Longrightarrow> f x = f' x"
     assumes "l=l'"
     shows "find_min_idx_f f l = find_min_idx_f f' l'"
     unfolding assms(2)[symmetric]
     using assms(1)
     apply (induction l)
     apply (auto split: option.split)
     done
 
 
   lemma find_min_idx_impl_collecti: "(
       case find_min_idx_f f l of
         Some (i,r) \<Rightarrow> {i} \<times> s1 i r
       | None \<Rightarrow> {(i,r) | i r. i<length l \<and> r\<in>s2 i (l!i)}  
     )
   = (
     collecti_index (\<lambda>i x. 
       case f x of
         Some r \<Rightarrow> (True, s1 i r)
       | None \<Rightarrow> (False, s2 i x)
     ) l
   )" (is "?l=?r" is "_ = collecti_index ?fc l") 
   proof (cases "\<exists>i<length l. f (l!i) \<noteq> None")
     define i where "i \<equiv> LEAST i. i < length l \<and> f (l ! i) \<noteq> None"
     
     have C_ALT: "(\<exists>i<length l. f (l!i) \<noteq> None) 
       \<longleftrightarrow> (\<exists>i. i < length l \<and> fst (?fc i (l ! i)))"
       by (auto split: option.split)
 
     have i_alt: "i = (LEAST i. i < length l \<and> fst (?fc i (l ! i)))" 
       unfolding i_def 
       apply (fo_rule arg_cong)
       by (auto split: option.split)
 
     {  
       case True
   
       from LeastI_ex[OF True] obtain r where [simp]: "i<length l" "f (l!i) = Some r"
         by (auto simp: i_def)
   
       from True find_min_idx_f_LEAST_eq[of f l] 
         have "find_min_idx_f f l = Some (i, the (f (l ! i)))" 
         by (simp add: i_def)
       hence LEQ: "?l = {i} \<times> s1 i r" by simp
 
       from collecti_index_collect[of ?fc l, folded i_alt] True C_ALT have 
         REQ: "?r = {i} \<times> snd (?fc i (l!i))" 
         by simp
       show "?l=?r" unfolding LEQ unfolding REQ by auto
     }
     {
       case False
       from False find_min_idx_f_LEAST_eq[of f l] 
         have "find_min_idx_f f l = None" by simp
       hence LEQ: "?l = {(i,r) | i r. i<length l \<and> r\<in>s2 i (l!i)}" by simp
 
       from False C_ALT collecti_index_collect[of ?fc l] have
         REQ: "?r = {(i, x) |i x. i < length l \<and> x \<in> snd (?fc i (l ! i))}"
         by auto
 
       show "?l=?r" unfolding LEQ unfolding REQ using False by auto
     }
   qed
 
 
   lemma find_min_idx_impl_collecti_scheme: 
     assumes "\<And>x. s11 x = (case x of (i,r) \<Rightarrow> {i} \<times> iss i r)"
     assumes "s12 = {(i,r) | i r. i<length l \<and> r\<in>isn i (l!i)}"
     assumes "\<And>i. i<length l \<Longrightarrow> f2 i (l!i) = (case f (l!i) of
         Some r \<Rightarrow> (True, iss i r)
       | None \<Rightarrow> (False, isn i (l!i)))"
     shows "(case find_min_idx_f f l of Some x \<Rightarrow> s11 x | None \<Rightarrow> s12)
       = (collecti_index f2 l)"
     apply (simp only: assms(1,2,3) cong: collecti_index_cong)  
     apply (subst find_min_idx_impl_collecti)
     apply simp
     done
 
 
   schematic_goal stutter_extend_en_list_aux: "(?c, stutter_extend_en) 
     \<in> (R \<rightarrow> \<langle>S\<rangle>list_set_rel) \<rightarrow> R \<rightarrow> \<langle>\<langle>S\<rangle>option_rel\<rangle>list_set_rel"
     unfolding stutter_extend_en_def[abs_def]
     apply (autoref)
     done
   concrete_definition stutter_extend_en_list uses stutter_extend_en_list_aux
 
   lemma succ_of_enex_impl_aux: 
     "{s'. \<exists>a\<in>en s. s'=ex a s} = (\<lambda>a. ex a s)`en s" by auto
 
   schematic_goal succ_of_enex_list_aux: "(?c, succ_of_enex) \<in> 
     (Id \<rightarrow> \<langle>Id\<rangle>list_set_rel) \<times>\<^sub>r (Id \<rightarrow> Id \<rightarrow> Id) \<rightarrow> Id \<rightarrow> \<langle>Id\<rangle>list_set_rel"
     unfolding succ_of_enex_def[abs_def]
     unfolding succ_of_enex_impl_aux
     by (autoref (trace, keep_goal))
   concrete_definition succ_of_enex_list uses succ_of_enex_list_aux
 
   schematic_goal pred_of_enex_list_aux: "(?c, pred_of_enex) \<in> 
     (Id \<rightarrow> \<langle>Id\<rangle>list_set_rel) \<times>\<^sub>r (Id \<rightarrow> Id \<rightarrow> Id) \<rightarrow> Id \<rightarrow> Id \<rightarrow> bool_rel"
     unfolding pred_of_enex_def[abs_def]
     by (autoref (trace, keep_goal))
   concrete_definition pred_of_enex_list uses pred_of_enex_list_aux
 
   (* TODO: can this be defined using autoref? *)
   definition "rel_of_enex_list enex \<equiv> rel_of_pred (pred_of_enex_list enex)"
   lemma rel_of_enex_list_refine: "(rel_of_enex_list, rel_of_enex) \<in> 
     (Id \<rightarrow> \<langle>Id\<rangle>list_set_rel) \<times>\<^sub>r (Id \<rightarrow> Id \<rightarrow> Id) \<rightarrow> \<langle>Id \<times>\<^sub>r Id\<rangle> set_rel"
   proof -
     have 1: "rel_of_enex_list = rel_of_pred \<circ> pred_of_enex_list" using rel_of_enex_list_def by force
     have 2: "rel_of_enex = rel_of_pred \<circ> pred_of_enex" by auto
     have 3: "(rel_of_pred, rel_of_pred) \<in> (Id \<rightarrow> Id \<rightarrow> bool_rel) \<rightarrow> \<langle>Id \<times>\<^sub>r Id\<rangle>set_rel" by auto
     show ?thesis unfolding 1 2 by (parametricity add: 3 pred_of_enex_list.refine)
   qed
 
   context visible_prog begin
     definition "ga_gample_mi2 mem sticky_E (gc::pid_global_config) = (
       let 
         lcs = pid_global_config.processes gc;
         gs = pid_global_config.state gc
       in
         collecti_index (\<lambda>_ lc. let
             c = local_config.command lc;
             ls = local_config.state lc;
             as = set (comp.succ_impl c);
             s={(a,c')\<in>as. la_en' (ls,gs) a};
             ample = 
               s\<noteq>{} 
             \<and> (\<forall>(a,_)\<in>as. read_globals a = {} \<and> write_globals a = {}) 
             \<and> (\<forall>(a,c')\<in>s. \<not> mem (c,c') sticky_E)
           in
             (ample,{c}\<times>s)
         ) lcs
     )"
 
     lemma ga_gample_mi2_impl: 
       "ga_gample_m mem sticky_E gc = ga_gample_mi2 mem sticky_E gc"
       unfolding ga_gample_m_def ga_gample_mi2_def
       apply simp
       apply (rule find_min_idx_impl_collecti_scheme[where 
           iss="\<lambda>pid (c,S). (\<lambda>(a,c'). (c,a,c'))`S" and
           isn="\<lambda>pid lc. {(c,a,c'). cfgc c a c' 
             \<and> c = cmd_of_pid gc pid 
             \<and> la_en' (local_config.state lc, pid_global_config.state gc) a}"]
       )
       apply auto []
       unfolding ga_gen_def
       apply auto []
       apply (auto simp: comp.astep_impl_def)
       done
 
     definition "cr_ample_impl2 \<equiv>
       let sticky = find_fas_init_code (=) bounded_hashcode_nat
          (def_hashmap_size TYPE(nat)) cfgc_G_impl (\<lambda>x. x \<in> vis_edges)
       in stutter_extend_en (ga_gample_mi2 (\<lambda>x f. f x) sticky)"
 
     definition "ample_step_impl2 \<equiv> rel_of_enex (cr_ample_impl2,ga_ex)"
 
     lemma cr_ample_impl2_reduction: 
       "hl_reduction prog is_vis_var ample_step_impl2"
     proof -
       from cr_ample_impl1_reduction 
       interpret hl_ample_reduction prog is_vis_var cr_ample_impl1 .
       
       have 1: "ample_step_impl2 = rel_of_enex (cr_ample_impl1, ga_ex)"
         unfolding ample_step_impl2_def cr_ample_impl1_def cr_ample_impl2_def
         unfolding ga_gample_mi2_impl[abs_def]
         by simp
 
       show ?thesis
         apply unfold_locales
         unfolding 1
         apply simp
         apply simp
         apply (blast intro: ample_accept_subset ample_accept_stuttering)+
         done
     qed
   end
         
 text \<open>Implementing the State\<close>
 type_synonym valuation_impl = "(ident,uint32) mapping"
 
 definition "vi_\<alpha> \<equiv> map_option Rep_uint32 \<circ>\<circ> Mapping.rep"
 abbreviation "vi_rel \<equiv> br vi_\<alpha> (\<lambda>_. True)"
 
 abbreviation "val_rel \<equiv> br Rep_uint32 (\<lambda>_. True)"
 
 lemma vi_rel_rew: 
   "(x = vi_\<alpha> y) \<longleftrightarrow> (y,x)\<in>vi_rel"
   "(vi_\<alpha> y = x) \<longleftrightarrow> (y,x)\<in>vi_rel"
   by (auto simp: br_def)
 
 export_code Mapping.lookup Mapping.update Mapping.empty checking SML
 
 lift_definition vi_empty :: "valuation_impl" 
   is "Map.empty::valuation" .
 
 lemma [code]: "vi_empty = Mapping.empty" by transfer simp
 lemma vi_empty_correct: "vi_\<alpha> vi_empty = Map.empty"
   unfolding vi_\<alpha>_def
   by transfer auto
 
 lift_definition vi_lookup :: "valuation_impl \<Rightarrow> ident \<rightharpoonup> uint32" 
   is "\<lambda>vi::valuation. \<lambda>x. vi x" .
 lemma [code]: "vi_lookup = Mapping.lookup"
   apply (intro ext)
   unfolding vi_lookup_def Mapping.lookup_def map_fun_def[abs_def] o_def
     id_apply option.map_comp Rep_uint32_inverse option.map_ident
   by simp
 
 lemma vi_lookup_correct: "vi_lookup v x = map_option Abs_uint32 (vi_\<alpha> v x)"
   unfolding vi_\<alpha>_def
   apply transfer
   apply (simp add: option.map_comp o_def option.map_ident)
   done
 
 lift_definition vi_update :: "ident \<Rightarrow> uint32 \<Rightarrow> valuation_impl \<Rightarrow> valuation_impl" 
   is "\<lambda>x v. \<lambda>vi::valuation. vi(x\<mapsto>v)" .
 lemma [code]: "vi_update = Mapping.update"
   by transfer simp
 
-lemma vi_update_correct: "vi_\<alpha> (vi_update k v m) = vi_\<alpha> m (k\<mapsto>Rep_uint32 v)"
+lemma vi_update_correct: "vi_\<alpha> (vi_update k v m) = (vi_\<alpha> m) (k\<mapsto>Rep_uint32 v)"
   unfolding vi_\<alpha>_def
   by transfer simp
 
 export_code vi_lookup vi_update vi_empty checking SML 
 
 
 record local_state_impl = 
   variables :: valuation_impl
 
 record global_state_impl = 
   variables :: valuation_impl
 
 type_synonym focused_state_impl = "local_state_impl \<times> global_state_impl"
 
 type_synonym local_config_impl 
   = "(cmdc,local_state_impl) Gen_Scheduler.local_config"
 type_synonym pid_global_config_impl 
   = "(cmdc,local_state_impl,global_state_impl) Pid_Scheduler.pid_global_config"
 
 definition "local_state_rel \<equiv> {
   (\<lparr> local_state_impl.variables = vi \<rparr>, \<lparr> local_state.variables = v  \<rparr>) | vi v.
     v = vi_\<alpha> vi 
   }"
 
 definition "global_state_rel \<equiv> {
   (\<lparr> global_state_impl.variables = vi \<rparr>, \<lparr> global_state.variables = v  \<rparr>) | vi v.
     v = vi_\<alpha> vi 
   }"
 
 abbreviation "focused_state_rel \<equiv> local_state_rel \<times>\<^sub>r global_state_rel"
 
 definition "local_config_rel \<equiv> {
   (\<lparr> local_config.command = ci, local_config.state=lsi \<rparr>, 
    \<lparr> local_config.command = c, local_config.state=ls  \<rparr>) | ci c lsi ls.
     (ci::cmdc,c)\<in>Id \<and> (lsi,ls)\<in>local_state_rel
   }"
 
 definition "global_config_rel \<equiv> {
   (\<lparr> pid_global_config.processes = psi, pid_global_config.state = gsi \<rparr>,
    \<lparr> pid_global_config.processes = ps, pid_global_config.state = gs \<rparr>) | psi ps gsi gs.
    (psi,ps)\<in>\<langle>local_config_rel\<rangle>list_rel \<and> (gsi,gs)\<in>global_state_rel
 }"
 
 definition "init_valuation_impl vd \<equiv> fold (\<lambda>x v. vi_update x 0 v) vd (vi_empty)"
 
 lemma init_valuation_impl: 
   "(init_valuation_impl, init_valuation) \<in> \<langle>Id\<rangle>list_rel \<rightarrow> vi_rel"
 proof -
   {
     fix vd m
     have "m ++ init_valuation vd = fold (\<lambda>x v. v(x\<mapsto>0)) vd m"
       apply (rule sym)
       apply (induction vd arbitrary: m)
       unfolding init_valuation_def[abs_def]
       apply (auto intro!: ext simp: Map.map_add_def)
       done
   } note aux=this
   have E1: "\<And>vd. init_valuation vd = fold (\<lambda>x v. v(x\<mapsto>0)) vd Map.empty"
     by (subst aux[symmetric]) simp
     
   have E2: "\<And>vdi vd. (vdi,vd)\<in>\<langle>Id\<rangle>list_rel 
     \<Longrightarrow> (init_valuation_impl vdi, fold (\<lambda>x v. v(x\<mapsto>0)) vd Map.empty) \<in> vi_rel"
     unfolding init_valuation_impl_def
     apply parametricity
     apply (auto simp: vi_update_correct vi_empty_correct br_def zero_uint32.rep_eq)
     done
 
   show ?thesis
     apply (intro fun_relI)
     apply (subst E1)
     apply (rule E2)
     by auto
 qed
 
 context cprog begin
 
   definition init_pc_impl :: "proc_decl \<Rightarrow> local_config_impl" where
     "init_pc_impl pd \<equiv> \<lparr>
       local_config.command = comp.\<gamma> (proc_decl.body pd),
       local_config.state = \<lparr>
         local_state_impl.variables = init_valuation_impl (proc_decl.local_vars pd)
       \<rparr>
     \<rparr>"
 
   lemma init_pc_impl: "(init_pc_impl, init_pc) \<in> Id \<rightarrow> local_config_rel"
     apply (rule fun_relI)
     unfolding init_pc_impl_def init_pc_def local_config_rel_def local_state_rel_def
     apply (simp del: pair_in_Id_conv, intro conjI)
     apply simp
     apply (simp only: vi_rel_rew)
     apply (parametricity add: init_valuation_impl)
     apply simp
     done
   
   definition pid_init_gc_impl :: "pid_global_config_impl" where
     "pid_init_gc_impl \<equiv> \<lparr>
       pid_global_config.processes = (map init_pc_impl (program.processes prog)),
       pid_global_config.state = \<lparr>
         global_state_impl.variables = init_valuation_impl (program.global_vars prog)
       \<rparr>
     \<rparr>"
   
   lemma pid_init_gc_impl: "(pid_init_gc_impl, pid_init_gc) \<in> global_config_rel"
     unfolding pid_init_gc_impl_def pid_init_gc_def global_config_rel_def global_state_rel_def
     apply (simp del: pair_in_Id_conv, intro conjI)
     apply (parametricity add: init_pc_impl)
     apply simp
     apply (simp only: vi_rel_rew)
     apply (parametricity add: init_valuation_impl)
     apply simp
     done  
 
 end
   
 lift_definition val_of_bool_impl :: "bool \<Rightarrow> uint32" is val_of_bool .
 lemma [code]: "val_of_bool_impl b = (if b then 1 else 0)"
   by transfer auto
 
 lift_definition bool_of_val_impl :: "uint32 \<Rightarrow> bool" is bool_of_val .
 lemma [code]: "bool_of_val_impl v = (v\<noteq>0)"
   by transfer (auto simp: bool_of_val_def)
 
 definition "set_of_rel R \<equiv> {(a,b) . R b a}"
 definition "rel_of_set S \<equiv> \<lambda>b a. (a,b)\<in>S"
 
 lemma [simp]: 
   "(a,b)\<in>set_of_rel R \<longleftrightarrow> R b a"
   "rel_of_set S b a \<longleftrightarrow> (a,b)\<in>S"
   unfolding rel_of_set_def set_of_rel_def
   by auto
 
 lemma [simp]:
   "set_of_rel (rel_of_set S) = S"
   "rel_of_set (set_of_rel R) = R"
   unfolding rel_of_set_def set_of_rel_def
   by auto
 
 lemma rel_fun_2set: "rel_fun A B = rel_of_set (set_of_rel A \<rightarrow> set_of_rel B)"
   unfolding rel_fun_def fun_rel_def
   unfolding rel_of_set_def set_of_rel_def
   by (auto)
 
 lemma [simp]: 
   "set_of_rel cr_uint32 = val_rel"
   "set_of_rel (=) = Id"
   by (auto simp: br_def cr_uint32_def)
 
 lemma bool_of_val_impl: "(bool_of_val_impl, bool_of_val) \<in> val_rel \<rightarrow> bool_rel"
   using bool_of_val_impl.transfer
   by (simp add: rel_fun_2set)
   
 
 lemma smod_by_div_abs: "a smod b = a - a sdiv b * b" for a b :: \<open>'a::len word\<close>
   by (subst (2) sdiv_smod_id [of a b, symmetric]) simp
 
 lift_definition sdiv_impl :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(sdiv)" .
 lift_definition smod_impl :: "uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" is "(smod)" .
 
 (* TODO: Is there a more efficient way? *)
 lemma [code]: "sdiv_impl x y = Abs_uint32' (Rep_uint32' x sdiv Rep_uint32' y)"
   apply transfer
   by simp
 
 lemma [code]: "smod_impl a b = a - sdiv_impl a b * b"
   by transfer (simp add: smod_by_div_abs)
 
 context
   includes bit_operations_syntax
 begin
 
 primrec eval_bin_op_impl_aux :: "bin_op \<Rightarrow> uint32 \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "eval_bin_op_impl_aux bo_plus v1 v2 = v1+v2"
 | "eval_bin_op_impl_aux bo_minus v1 v2 = v1-v2"
 | "eval_bin_op_impl_aux bo_mul v1 v2 = v1*v2"
 | "eval_bin_op_impl_aux bo_div v1 v2 = sdiv_impl v1 v2"
 | "eval_bin_op_impl_aux bo_mod v1 v2 = smod_impl v1 v2"
 | "eval_bin_op_impl_aux bo_less v1 v2 = val_of_bool_impl (v1 < v2)"
 | "eval_bin_op_impl_aux bo_less_eq v1 v2 = val_of_bool_impl (v1 \<le> v2)"
 | "eval_bin_op_impl_aux bo_eq v1 v2 = val_of_bool_impl (v1 = v2)"
 | "eval_bin_op_impl_aux bo_and v1 v2 = v1 AND v2"
 | "eval_bin_op_impl_aux bo_or v1 v2 = v1 OR v2"
 | "eval_bin_op_impl_aux bo_xor v1 v2 = v1 XOR v2"
 
 end
 
 lift_definition eval_bin_op_impl :: "bin_op \<Rightarrow> uint32 \<Rightarrow> uint32 \<Rightarrow> uint32"
   is eval_bin_op .
 
 lemma [code]: "eval_bin_op_impl bop v1 v2 = eval_bin_op_impl_aux bop v1 v2"
   apply (cases bop)
   apply (transfer; simp)+
   done
 
 primrec eval_un_op_impl_aux :: "un_op \<Rightarrow> uint32 \<Rightarrow> uint32" where
   "eval_un_op_impl_aux uo_minus v = -v"
 | "eval_un_op_impl_aux uo_not v = Bit_Operations.not v"
 
 lift_definition eval_un_op_impl :: "un_op \<Rightarrow> uint32 \<Rightarrow> uint32"
   is eval_un_op .
 
 lemma [code]: "eval_un_op_impl uop v = eval_un_op_impl_aux uop v"
   apply (cases uop)
   apply simp_all
   apply (transfer, simp)+
   done  
 
 
 
 
 fun eval_exp_impl :: "exp \<Rightarrow> focused_state_impl \<rightharpoonup> uint32" where
   "eval_exp_impl (e_var x) (ls,gs) = do {
     let lv = local_state_impl.variables ls; 
     let gv = global_state_impl.variables gs;
     case vi_lookup lv x of
       Some v \<Rightarrow> Some v
     | None \<Rightarrow> (case vi_lookup gv x of
         Some v \<Rightarrow> Some v
       | None \<Rightarrow> None)
   }"
 | "eval_exp_impl (e_localvar x) (ls,gs) = vi_lookup (local_state_impl.variables ls) x"
 | "eval_exp_impl (e_globalvar x) (ls,gs) = vi_lookup (global_state_impl.variables gs) x"
 | "eval_exp_impl (e_const n) fs = do {
     assert_option (n\<ge>min_signed \<and> n\<le>max_signed);
     Some (uint32_of_int n)
   }"
 | "eval_exp_impl (e_bin bop e1 e2) fs = do {
     v1\<leftarrow>eval_exp_impl e1 fs;
     v2\<leftarrow>eval_exp_impl e2 fs;
     Some (eval_bin_op_impl bop v1 v2)
     }"
 | "eval_exp_impl (e_un uop e) fs = do {
     v\<leftarrow>eval_exp_impl e fs;
     Some (eval_un_op_impl uop v)
     }"
 
 (* TODO: Move *)
 lemma map_option_bind: "map_option f (m\<bind>g) = m \<bind> (map_option f o g)"
   by (auto split: Option.bind_split)
 
 lemma val_option_rel_as_eq: "(a,b)\<in>\<langle>val_rel\<rangle>option_rel \<longleftrightarrow> map_option Rep_uint32 a = b"
   unfolding br_def
   apply (cases a)
   apply (cases b, simp_all)
   apply (cases b, auto)
   done
 
 lemma eval_exp_impl: "(eval_exp_impl, eval_exp) \<in> Id \<rightarrow> focused_state_rel \<rightarrow> \<langle>val_rel\<rangle>option_rel"
 proof -
   {
     fix e ls gs lsi gsi
     assume "(lsi,ls)\<in>local_state_rel" "(gsi,gs)\<in>global_state_rel"
     hence "map_option Rep_uint32 (eval_exp_impl e (lsi,gsi)) = eval_exp e (ls,gs)"
       apply (induction e)
       apply (auto 
         simp: local_state_rel_def global_state_rel_def br_def
         simp: vi_lookup_correct vi_update_correct
         simp: Abs_uint32_inverse[simplified] uint32_of_int.rep_eq signed_of_int_def
         simp: option.map_comp option.map_ident o_def map_option_bind
         simp: eval_bin_op_impl.rep_eq eval_un_op_impl.rep_eq
         split: option.splits)
       apply (drule sym)
       apply (drule sym)
       apply (simp split: Option.bind_split)
 
       apply (drule sym)
       apply (simp split: Option.bind_split)
       done
   } thus ?thesis
     by (auto simp: val_option_rel_as_eq)
 qed
 
 text \<open>Enabledness and effects of actions\<close>
 primrec la_en_impl :: "focused_state_impl \<Rightarrow> action \<rightharpoonup> bool" where
   "la_en_impl fs (AAssign e _ _) = do {
     v \<leftarrow> eval_exp_impl e fs;
     Some (bool_of_val_impl v)}"
 | "la_en_impl fs (AAssign_local e _ _) = do {
     v \<leftarrow> eval_exp_impl e fs;
     Some (bool_of_val_impl v)}"
 | "la_en_impl fs (AAssign_global e _ _) = do {
     v \<leftarrow> eval_exp_impl e fs;
     Some (bool_of_val_impl v)}"
 | "la_en_impl fs (ATest e) = do {
     v \<leftarrow> eval_exp_impl e fs;
     Some (bool_of_val_impl v)}"
 | "la_en_impl _ (ASkip) = Some True"
 
 lemma param_rec_action[param]: "(rec_action, rec_action) \<in> (Id \<rightarrow> Id \<rightarrow> Id \<rightarrow> A)
     \<rightarrow> (Id \<rightarrow> Id \<rightarrow> Id \<rightarrow> A)
        \<rightarrow> (Id \<rightarrow> Id \<rightarrow> Id \<rightarrow> A) \<rightarrow> (Id \<rightarrow> A) \<rightarrow> A \<rightarrow> Id \<rightarrow> A"
   apply (intro fun_relI)
   subgoal for fi1 f1 fi2 f2 fi3 f3 fi4 f4 fi5 f5 ai a
     apply simp
     apply (induction a)
     apply simp_all
     apply (parametricity, simp_all?)+
     done
   done 
 
 (* TODO: Move *)
 lemma param_option_bind[param]:
   "(Option.bind, Option.bind) \<in> \<langle>A\<rangle>option_rel \<rightarrow> (A \<rightarrow> \<langle>B\<rangle>option_rel) \<rightarrow> \<langle>B\<rangle>option_rel"
   unfolding Option.bind_def by parametricity
 
 lemma la_en_impl: "(la_en_impl,la_en) \<in> focused_state_rel \<rightarrow> Id \<rightarrow> \<langle>Id\<rangle>option_rel"
   unfolding la_en_impl_def la_en_def
   by (parametricity add: eval_exp_impl bool_of_val_impl)
 
 definition "la_en'_impl fs a \<equiv> case la_en_impl fs a of Some b \<Rightarrow> b | None \<Rightarrow> False"
   
 lemma la_en'_impl: "(la_en'_impl,la_en') \<in> focused_state_rel \<rightarrow> Id \<rightarrow> bool_rel"
   unfolding la_en'_impl_def[abs_def] la_en'_def[abs_def]
   by (parametricity add: la_en_impl)    
 
 abbreviation "exists_var_impl v x \<equiv> vi_lookup v x \<noteq> None"
 
 fun la_ex_impl :: "focused_state_impl \<Rightarrow> action \<rightharpoonup> focused_state_impl" where
   "la_ex_impl (ls,gs) (AAssign ge x e) = do {
     v \<leftarrow> eval_exp_impl ge (ls,gs);
     assert_option (bool_of_val_impl v); 
     v \<leftarrow> eval_exp_impl e (ls,gs);
     if exists_var_impl (local_state_impl.variables ls) x then do {
       let ls = local_state_impl.variables_update (vi_update x v) ls;
       Some (ls,gs)
     } else do {
       assert_option (exists_var_impl (global_state_impl.variables gs) x);
       let gs = global_state_impl.variables_update (vi_update x v) gs;
       Some (ls,gs)
     }
   }"
 | "la_ex_impl (ls,gs) (AAssign_local ge x e) = do {
     v \<leftarrow> eval_exp_impl ge (ls,gs);
     assert_option (bool_of_val_impl v); 
     v \<leftarrow> eval_exp_impl e (ls,gs);
     assert_option (exists_var_impl (local_state_impl.variables ls) x);
     let ls = local_state_impl.variables_update (vi_update x v) ls;
     Some (ls,gs)
   }"
 | "la_ex_impl (ls,gs) (AAssign_global ge x e) = do {
     v \<leftarrow> eval_exp_impl ge (ls,gs);
     assert_option (bool_of_val_impl v); 
     v \<leftarrow> eval_exp_impl e (ls,gs);
     assert_option (exists_var_impl (global_state_impl.variables gs) x);
     let gs = global_state_impl.variables_update (vi_update x v) gs;
     Some (ls,gs)
   }"
 | "la_ex_impl fs (ATest e) = do {
     v \<leftarrow> eval_exp_impl e fs;
     assert_option (bool_of_val_impl v); 
     Some fs
   }"
 | "la_ex_impl fs ASkip = Some fs"
 
 (* TODO: Move *)
 lemma param_assert_option[param]:
   "(assert_option, assert_option) \<in> bool_rel \<rightarrow> \<langle>unit_rel\<rangle>option_rel"
   unfolding assert_option_def by parametricity
 
 
 lemma la_ex_impl: "(la_ex_impl, la_ex) 
   \<in> focused_state_rel \<rightarrow> Id \<rightarrow> \<langle>focused_state_rel\<rangle>option_rel"
 proof (intro fun_relI)
   fix fsi fs and ai a :: action
   assume "(fsi,fs)\<in>focused_state_rel" "(ai,a)\<in>Id"
   thus "(la_ex_impl fsi ai, la_ex fs a)\<in>\<langle>focused_state_rel\<rangle>option_rel"
     apply (cases fs, cases fsi, clarsimp)
     apply (cases a)
     apply simp_all
     apply (parametricity add: eval_exp_impl bool_of_val_impl)
     apply (auto 
       simp: local_state_rel_def global_state_rel_def
       simp: vi_lookup_correct vi_update_correct 
       simp: br_def 
       intro: domI) [7]
     apply (parametricity add: eval_exp_impl bool_of_val_impl)
     apply (auto 
       simp: local_state_rel_def global_state_rel_def
       simp: vi_lookup_correct vi_update_correct 
       br_def intro: domI) [9]
     apply (parametricity add: eval_exp_impl bool_of_val_impl)
     apply (auto 
       simp: local_state_rel_def global_state_rel_def
       simp: vi_lookup_correct vi_update_correct 
       br_def intro: domI) [4]
     apply (parametricity add: eval_exp_impl bool_of_val_impl)
     apply simp
     done
 qed    
 
 definition "la_ex'_impl fs a \<equiv> case la_ex_impl fs a of Some fs' \<Rightarrow> fs' | None \<Rightarrow> fs"
 lemma la_ex'_impl: "(la_ex'_impl,la_ex') \<in> focused_state_rel \<rightarrow> Id \<rightarrow> focused_state_rel"
   unfolding la_ex'_impl_def[abs_def] la_ex'_def[abs_def]
   by (parametricity add: la_ex_impl)
 
 lemma param_collecti_index: "(collecti_index, collecti_index) \<in> 
     (nat_rel \<rightarrow> B \<rightarrow> bool_rel \<times>\<^sub>r \<langle>Id\<rangle>set_rel) \<rightarrow> \<langle>B\<rangle>list_rel \<rightarrow> \<langle>nat_rel \<times>\<^sub>r Id\<rangle>set_rel"
   unfolding collecti_index'_def
   apply parametricity  
   apply auto
   done
 
 export_code la_ex_impl la_en_impl checking SML
 
 context visible_prog
 begin
 
   definition "ga_gample_mi3 mem sticky_E (gc::pid_global_config_impl) = (
     let 
       lcs = pid_global_config.processes gc;
       gs = pid_global_config.state gc
     in
       collecti_index (\<lambda>_ lc. let
           c = local_config.command lc;
           ls = local_config.state lc;
           as = set (comp.succ_impl c);
           s={(a,c')\<in>as. la_en'_impl (ls,gs) a};
           ample = 
             s\<noteq>{} 
           \<and> (\<forall>(a,_)\<in>as. read_globals a = {} \<and> write_globals a = {}) 
           \<and> (\<forall>(a,c')\<in>s. \<not> mem (c,c') sticky_E)
         in
           (ample,{c}\<times>s)
       ) lcs
   )"
 
   lemma ga_gample_mi3_refine: 
     "(ga_gample_mi3, ga_gample_mi2)\<in> 
       Id \<rightarrow> Id \<rightarrow> global_config_rel \<rightarrow> \<langle>nat_rel \<times>\<^sub>r Id\<rangle>set_rel"
   proof -
     have [param]: "(comp.succ_impl,comp.succ_impl)\<in>Id\<rightarrow>\<langle>Id\<times>\<^sub>rId\<rangle>list_rel"
       by simp
 
     from la_en'_impl have aux1: "\<And>fsi fs a. (fsi,fs)\<in>focused_state_rel \<Longrightarrow>
       la_en'_impl fsi a = la_en' fs a"
       apply (rule_tac IdD)
       apply parametricity
       by auto
 
     show ?thesis
       using [[goals_limit=1]]
       apply (intro fun_relI)
       unfolding ga_gample_mi3_def ga_gample_mi2_def
       apply (parametricity add: param_collecti_index la_en'_impl)
       apply (auto simp add: global_config_rel_def local_config_rel_def) []
       apply (auto simp add: global_config_rel_def local_config_rel_def) []
       apply (auto simp add: global_config_rel_def local_config_rel_def) []
       apply (auto simp add: global_config_rel_def local_config_rel_def) []
       apply simp
       using aux1
       apply (auto simp add: global_config_rel_def local_config_rel_def) []
       apply simp_all
       done
 
   qed    
 
   definition (in cprog) "is_vis_edge is_vis_var \<equiv> \<lambda>(c,c'). 
     \<exists>(a,cc')\<in>set (comp.succ_impl c). c'=cc' \<and> (\<exists>v\<in>write_globals a. is_vis_var v)"
 
   lemma is_vis_edge_correct: "is_vis_edge is_vis_var = (\<lambda>x. x\<in>vis_edges)"
     unfolding is_vis_edge_def vis_edges_def
     by (auto intro!: ext simp: comp.astep_impl_def)
 
 
   definition "cr_ample_impl3 \<equiv>
     let sticky = find_fas_init_code (=) bounded_hashcode_nat
          (def_hashmap_size TYPE(nat)) cfgc_G_impl (\<lambda>x. x \<in> vis_edges)
     in stutter_extend_en (ga_gample_mi3 (\<lambda>x f. f x) sticky)"
 
     
   lemma cr_ample_impl3_refine: "(cr_ample_impl3, cr_ample_impl2) 
     \<in> global_config_rel \<rightarrow> \<langle>\<langle>nat_rel\<times>\<^sub>rId\<rangle>option_rel\<rangle>set_rel"
   proof -
     have [param]: "\<And>R S. S=Id \<Longrightarrow> 
       (stutter_extend_en, stutter_extend_en)
         \<in> (R \<rightarrow> \<langle>S\<rangle>set_rel) \<rightarrow> R \<rightarrow> \<langle>\<langle>S\<rangle>option_rel\<rangle>set_rel"
       apply (simp only: )
       by (rule stutter_extend_en_refine)
     
     show ?thesis  
       unfolding cr_ample_impl3_def cr_ample_impl2_def is_vis_edge_correct
       apply (parametricity add: stutter_extend_en_refine ga_gample_mi3_refine)
       apply (rule IdI)
       by auto
   qed      
       
 (* TODO: The current Pid_Scheduler-locale is focused on refinement.
   We cannot use it to get an instantiation of ga_gex_impl.*)
 
   definition (in -) ga_gex_impl 
     :: "global_action \<Rightarrow> pid_global_config_impl \<Rightarrow> pid_global_config_impl"
   where
     "ga_gex_impl ga gc \<equiv> let 
       (pid,c,a,c') = ga;
       fs = fs_of_pid gc pid;
       (ls',gs') = la_ex'_impl fs a;
       gc' = \<lparr> 
           pid_global_config.processes = (pid_global_config.processes gc)
             [pid := 
               \<lparr> local_config.command = c', local_config.state = ls'\<rparr>
             ],
           pid_global_config.state = gs'\<rparr>
     in
       gc'"
 
 
   lemma lc_of_pid_refine:
     assumes V: "pid_valid gc pid"    
     assumes [param]: "(pidi,pid)\<in>nat_rel"
     assumes GCI: "(gci,gc)\<in>global_config_rel"
     shows "(lc_of_pid gci pidi, lc_of_pid gc pid)\<in>local_config_rel"
     apply parametricity
     apply fact
     using GCI by (auto simp: global_config_rel_def)
     
   lemma ls_of_pid_refine:
     assumes "pid_valid gc pid"    
     assumes "(pidi,pid)\<in>nat_rel"
     assumes "(gci,gc)\<in>global_config_rel"
     shows "(ls_of_pid gci pidi, ls_of_pid gc pid)\<in>local_state_rel"
     using lc_of_pid_refine[OF assms] unfolding local_config_rel_def by auto
 
 
   lemma ga_gex_impl:
     assumes V: "pid_valid gc pid"    
     assumes [param]: "(pidi,pid)\<in>Id" "(ci,c)\<in>Id" 
       "(ai,a)\<in>Id" and CI'I: "(ci',c')\<in>Id" and GCI[param]: "(gci,gc)\<in>global_config_rel"
     shows "(ga_gex_impl (pidi,ci,ai,ci') gci, ga_gex (pid,c,a,c') gc) \<in> global_config_rel"
     unfolding ga_gex_impl_def[abs_def] ga_gex_def[abs_def]
     apply simp
     apply (parametricity add: la_ex'_impl ls_of_pid_refine[OF V])
     using GCI CI'I
     apply (auto simp: global_config_rel_def local_config_rel_def) []
     apply parametricity
     apply auto []
     using GCI
     apply (auto simp: global_config_rel_def) []
     done
 
   definition (in -) "ga_ex_impl \<equiv> stutter_extend_ex ga_gex_impl"
 
   fun ga_valid where
     "ga_valid gc None = True"
   | "ga_valid gc (Some (pid,c,a,c')) = pid_valid gc pid"  
 
 
   lemma ga_ex_impl:
     assumes V: "ga_valid gc ga"    
     assumes P: "(gai,ga)\<in>Id" "(gci,gc)\<in>global_config_rel"
     shows "(ga_ex_impl gai gci, ga_ex ga gc) \<in> global_config_rel"
     using assms
     apply (cases "(gc,ga)" rule: ga_valid.cases)
     using P
     apply (simp add: ga_ex_impl_def)
 
     apply (simp add: ga_ex_impl_def ga_ex_def)
     apply (parametricity add: ga_gex_impl)
     by auto
 
   definition "ample_step_impl3 \<equiv> rel_of_enex (cr_ample_impl3,ga_ex_impl)"
 
   definition (in -) pid_interp_gc_impl 
     :: "(ident \<Rightarrow> bool) \<Rightarrow> pid_global_config_impl \<Rightarrow> exp set"
   where
     "pid_interp_gc_impl is_vis_var gci \<equiv> sm_props (
     vi_\<alpha> (global_state_impl.variables (pid_global_config.state gci)) |` Collect is_vis_var
   )"
 
   lemma pid_interp_gc_impl: 
     "(pid_interp_gc_impl is_vis_var, pid_interp_gc) \<in> global_config_rel \<rightarrow> Id"
     apply rule
     unfolding pid_interp_gc_impl_def pid_interp_gc_def
     apply (auto simp: global_config_rel_def global_state_rel_def 
       interp_gs_def sm_props_def br_def)
     done
 
   lemma cr_ample_impl3_sim_aux:
     assumes GCI: "(gci, gc) \<in> global_config_rel"
     assumes GA: "ga \<in> cr_ample_impl3 gci"
     shows "\<exists>gc'. ga\<in>cr_ample_impl2 gc 
       \<and> gc'=ga_ex ga gc 
       \<and> (ga_ex_impl ga gci, gc')\<in>global_config_rel"
   proof (clarsimp, safe)
     show G1: "ga\<in>cr_ample_impl2 gc"
       using cr_ample_impl3_refine[param_fo, OF GCI] GA by auto
 
     { (* TODO: We are re-proving the validity of the action, due
         to the lack of a clean refinement argumentation *)
       fix mem sticky_E gc pid c
       assume "(pid,c)\<in>ga_gample_m mem sticky_E gc"
       hence "pid_valid gc pid"
         unfolding ga_gample_m_def
         apply (auto split: option.splits)
         apply (auto simp: ga_gen_def) []
         apply (auto dest: find_min_idx_f_SomeD)
         done
     } note aux=this 
     from G1 have "ga_valid gc ga" 
       unfolding cr_ample_impl2_def stutter_extend_en_def
       apply (simp split: if_split_asm)
       unfolding ga_gample_mi2_impl[symmetric]
       apply (auto dest: aux)
       done
     thus "(ga_ex_impl ga gci, ga_ex ga gc)\<in>global_config_rel"
       by (parametricity add: ga_ex_impl GCI IdI[of ga])
   qed    
 
   lemma cr_ample_impl3_sim_aux2:
     assumes GCI: "(gci, gc) \<in> global_config_rel"
     assumes GA: "ga \<in> cr_ample_impl2 gc"
     shows "ga\<in>cr_ample_impl3 gci 
       \<and> (ga_ex_impl ga gci, ga_ex ga gc) \<in> global_config_rel"
   proof
     show G1: "ga\<in>cr_ample_impl3 gci"
       using cr_ample_impl3_refine[param_fo, OF GCI] GA by auto
     
     from cr_ample_impl3_sim_aux[OF GCI G1] show 
       "(ga_ex_impl ga gci, ga_ex ga gc) \<in> global_config_rel"
       by auto
   qed    
 
   sublocale impl3: sa "\<lparr> g_V = UNIV, g_E = ample_step_impl3, g_V0 = {pid_init_gc_impl},
       sa_L = pid_interp_gc_impl is_vis_var \<rparr>" by unfold_locales auto
 
   sublocale impl3_sim: lbisimulation 
     global_config_rel
     "\<lparr> g_V = UNIV, g_E = ample_step_impl3, g_V0 = {pid_init_gc_impl},
       sa_L = pid_interp_gc_impl is_vis_var \<rparr>"
     "\<lparr> g_V = UNIV, g_E = ample_step_impl2, g_V0 = {pid_init_gc},
       sa_L = pid_interp_gc \<rparr>"
     apply unfold_locales
     apply simp
     apply simp
     apply simp
     using pid_init_gc_impl
     apply (auto dest: fun_relD) []
     unfolding ample_step_impl2_def ample_step_impl3_def
     apply (auto dest: cr_ample_impl3_sim_aux) []
     using pid_interp_gc_impl
     apply (auto dest: fun_relD) []
     apply simp
     
     using pid_init_gc_impl
     apply (auto dest: fun_relD) []
     defer    
     using pid_interp_gc_impl
     apply (auto dest: fun_relD) []
     apply auto
 
     apply (auto dest: cr_ample_impl3_sim_aux2) []
     done
 
   text \<open>Correctness of impl3\<close>
   (* TODO: Locale hl_reduction seems very special, and we cannot use it here*)
   lemma impl3_accept_subset: "impl3.accept w \<Longrightarrow> lv.sa.accept w"
     using impl3_sim.accept_bisim cr_ample_impl2_reduction hl_reduction.ample_accept_subset
     by simp
 
   lemma impl3_accept_stuttering: "lv.sa.accept w \<Longrightarrow> \<exists>w'. w\<approx>w' \<and> impl3.accept w'"
     using impl3_sim.accept_bisim cr_ample_impl2_reduction hl_reduction.ample_accept_stuttering
     by simp
 
   text \<open>Next, we go from sets of actions to lists of actions\<close>
   definition (in cprog) "ga_gample_mil4 mem sticky_Ei (gc::pid_global_config_impl) = (
     let 
       lcs = pid_global_config.processes gc;
       gs = pid_global_config.state gc
     in
       collecti_index_list (\<lambda>_ lc. let
           c = local_config.command lc;
           ls = local_config.state lc;
           as = comp.succ_impl c;
           s = filter (la_en'_impl (ls,gs) o fst) as;
           ample = s\<noteq>[] 
           \<and> (\<forall>(a,_)\<in>set as. read_globals a = {} \<and> write_globals a = {}) 
           \<and> (\<forall>(a,c')\<in>set s. \<not>mem (c,c') sticky_Ei)
         in
           (ample,map (Pair c) s)
       ) lcs
   )"
 
   lemma ga_gample_mil4_refine:
     "(ga_gample_mil4, ga_gample_mi3) 
     \<in> (Id\<times>\<^sub>rId \<rightarrow> Id \<rightarrow> bool_rel) \<rightarrow> Id \<rightarrow> Id \<rightarrow> \<langle>nat_rel \<times>\<^sub>r Id\<rangle>list_set_rel"
     apply (intro fun_relI)
     unfolding ga_gample_mil4_def ga_gample_mi3_def
     apply (parametricity)
     apply simp
     apply (rule IdI)
     apply simp
     apply (rule IdI)
     apply (intro fun_relI)
     apply (rule collecti_index_list_refine[param_fo])
     apply (intro fun_relI)
     apply (simp add: list_set_rel_def br_def distinct_map 
       comp.succ_impl_invar)
     apply (auto simp: filter_empty_conv)
     apply force
     done
 
   definition (in cprog) "cr_ample_impl4 is_vis_var \<equiv>
     let sticky = find_fas_init_code (=) bounded_hashcode_nat
          (def_hashmap_size TYPE(nat)) cfgc_G_impl (is_vis_edge is_vis_var)
     in stutter_extend_en_list (ga_gample_mil4 (\<lambda>x f. f x) sticky)"
       
   lemma cr_ample_impl4_refine:
     "(cr_ample_impl4 is_vis_var, cr_ample_impl3)\<in>Id \<rightarrow> \<langle>\<langle>nat_rel \<times>\<^sub>r Id\<rangle>option_rel\<rangle>list_set_rel"
     unfolding cr_ample_impl4_def cr_ample_impl3_def
     apply (parametricity add: stutter_extend_en_list.refine ga_gample_mil4_refine)
     apply (simp_all add: is_vis_edge_correct)
     done
 
   text \<open>Finally, we combine the ample-implementation and the executable implementation
     to get a step function\<close>  
   definition (in cprog) "ample_step_impl4 is_vis_var \<equiv>
     rel_of_enex_list (cr_ample_impl4 is_vis_var,ga_ex_impl)"
 
   lemma ample_step_impl4: 
     "(ample_step_impl4 is_vis_var, ample_step_impl3) \<in> \<langle>Id \<times>\<^sub>r Id\<rangle> set_rel"
     unfolding ample_step_impl4_def ample_step_impl3_def rel_of_pred_def
     apply (parametricity add: rel_of_enex_list_refine cr_ample_impl4_refine[simplified])
     by auto
 
   sublocale impl4: sa "\<lparr> g_V = UNIV, g_E = ample_step_impl4 is_vis_var,
     g_V0 = {pid_init_gc_impl}, sa_L = pid_interp_gc_impl is_vis_var \<rparr>" by unfold_locales auto
 
   lemma impl4_accept_subset: "impl4.accept w \<Longrightarrow> lv.sa.accept w"
     using impl3_accept_subset ample_step_impl4
     by simp
 
   lemma impl4_accept_stuttering: "lv.sa.accept w \<Longrightarrow> \<exists>w'. w\<approx>w' \<and> impl4.accept w'"
     using impl3_accept_stuttering ample_step_impl4
     by simp
     
   lemma (in -) pred_of_succ_of_enex_list:
     fixes enex :: "('c \<Rightarrow> 'a list) \<times> ('a \<Rightarrow> 'c \<Rightarrow> 'c)"
     shows "pred_of_succ (set o succ_of_enex_list enex) = pred_of_enex_list enex"
   proof -
     { fix x and l
       have "glist_member (=) x l \<longleftrightarrow> x\<in>set l"
         by (induction l) auto
     } note [simp] = this
 
     {
       fix l :: "'a list" and g and l0
       have "set (foldli l (\<lambda>_. True) (\<lambda>x. glist_insert (=) (g x)) l0) = set l0 \<union> g`set l"
         by (induction l arbitrary: l0) (auto simp: glist_insert_def)
     } note [simp] = this
 
     {
       fix l::"'a list" and P i
       have "foldli l Not (\<lambda>x _. P x) i \<longleftrightarrow> i \<or> (\<exists>x\<in>set l. P x)"
         by (induction l arbitrary: i) auto
     } note [simp] = this
 
 
     show ?thesis
       unfolding succ_of_enex_list_def[abs_def] pred_of_enex_list_def[abs_def]
       by (auto simp: pred_of_succ_def gen_image_def gen_bex_def intro!: ext)
   qed    
   lemma (in -) rel_of_succ_of_enex_list:
     fixes enex :: "('c \<Rightarrow> 'a list) \<times> ('a \<Rightarrow> 'c \<Rightarrow> 'c)"
     shows "rel_of_succ (set o succ_of_enex_list enex) = rel_of_enex_list enex"
     unfolding rel_of_enex_list_def
     unfolding pred_of_succ_of_enex_list[symmetric]
     by simp
 
   definition (in cprog) "impl4_succ is_vis_var
     \<equiv> succ_of_enex_list (cr_ample_impl4 is_vis_var,ga_ex_impl)"
   lemma impl4_succ_pred: 
     "rel_of_succ (set o (impl4_succ is_vis_var)) = ample_step_impl4 is_vis_var"
     unfolding impl4_succ_def ample_step_impl4_def 
     by (simp add: rel_of_succ_of_enex_list)
     
 end
 
 export_code ga_ex_impl checking SML
 
 definition "ccfg_E_succ_impl mst \<equiv> remdups o map snd o ccfg_succ_impl mst"
 
 lemma (in cprog) ccfg_E_succ_impl: "ccfg_E_succ_impl (comp_info_of prog) = cfgc_E_succ"
   apply (intro ext) 
   unfolding ccfg_E_succ_impl_def cfgc_E_succ_def
   by (simp add: ccfg_succ_impl)
 
 
 definition init_pc_impl_impl :: "comp_info \<Rightarrow> proc_decl \<Rightarrow> local_config_impl" where
   "init_pc_impl_impl mst pd \<equiv> \<lparr>
     local_config.command = comp_\<gamma>_impl mst (proc_decl.body pd),
     local_config.state = \<lparr>
       local_state_impl.variables = init_valuation_impl (proc_decl.local_vars pd)
     \<rparr>
   \<rparr>"
 
 lemma (in cprog) init_pc_impl_impl: "init_pc_impl_impl (comp_info_of prog) = init_pc_impl"
   apply (intro ext)
   unfolding init_pc_impl_impl_def init_pc_impl_def
   by (simp add: comp_\<gamma>_impl)
 
 definition pid_init_gc_impl_impl :: "program \<Rightarrow> comp_info \<Rightarrow> pid_global_config_impl" where
   "pid_init_gc_impl_impl prog mst \<equiv> \<lparr>
     pid_global_config.processes = (map (init_pc_impl_impl mst) (program.processes prog)),
     pid_global_config.state = \<lparr>
       global_state_impl.variables = init_valuation_impl (program.global_vars prog)
     \<rparr>
   \<rparr>"
 
 lemma (in cprog) pid_init_gc_impl_impl: 
   "pid_init_gc_impl_impl prog (comp_info_of prog) = pid_init_gc_impl"
   unfolding pid_init_gc_impl_impl_def pid_init_gc_impl_def
   by (simp add: init_pc_impl_impl)
 
 definition "ccfg_V0_impl prog mst \<equiv> map (comp_\<gamma>_impl mst) (cfg_V0_list prog)"
 
 lemma (in cprog) ccfg_V0_impl: "ccfg_V0_impl prog (comp_info_of prog) = cfgc_V0_list"
   unfolding ccfg_V0_impl_def cfgc_V0_list_def
   by (simp add: comp_\<gamma>_impl)
 
 definition "ccfg_G_impl_impl prog mst \<equiv>
   \<lparr> gi_V = \<lambda> _. True, gi_E = ccfg_E_succ_impl mst, gi_V0 = ccfg_V0_impl prog mst \<rparr>"
 
 lemma (in cprog) ccfg_G_impl_impl: "ccfg_G_impl_impl prog (comp_info_of prog) = cfgc_G_impl"
   unfolding ccfg_G_impl_impl_def cfgc_G_impl_def
   unfolding ccfg_E_succ_impl ccfg_V0_impl
   by rule
 
 definition "is_vis_edge_impl mst is_vis_var \<equiv> \<lambda>(c,c'). 
   \<exists>(a,cc')\<in>set (ccfg_succ_impl mst c). c'=cc' \<and> (\<exists>v\<in>write_globals a. is_vis_var v)"
 
 lemma (in cprog) is_vis_edge_impl: "is_vis_edge_impl (comp_info_of prog) = is_vis_edge"
   apply (intro ext)
   unfolding is_vis_edge_impl_def is_vis_edge_def
   by (simp add: ccfg_succ_impl)
 
 definition "ga_gample_mil4_impl mst mem sticky_Ei (gc::pid_global_config_impl) = (
   let 
     lcs = pid_global_config.processes gc;
     gs = pid_global_config.state gc
   in
     collecti_index_list (\<lambda>_ lc. let
         c = local_config.command lc;
         ls = local_config.state lc;
         as = ccfg_succ_impl mst c;
         s = filter (la_en'_impl (ls,gs) o fst) as;
         ample = s\<noteq>[] 
         \<and> (\<forall>(a,_)\<in>set as. read_globals a = {} \<and> write_globals a = {}) 
         \<and> (\<forall>(a,c')\<in>set s. \<not>mem (c,c') sticky_Ei)
       in
         (ample,map (Pair c) s)
     ) lcs
 )"
 
 lemma (in cprog) ga_gample_mil4_impl: "ga_gample_mil4_impl (comp_info_of prog) = ga_gample_mil4"
   apply (intro ext)
   unfolding ga_gample_mil4_impl_def ga_gample_mil4_def
   by (simp add: ccfg_succ_impl)
 
 
 definition "cr_ample_impl4_impl prog mst is_vis_var \<equiv>
   let sticky = find_fas_init_code (=) bounded_hashcode_nat
        (def_hashmap_size TYPE(nat)) (ccfg_G_impl_impl prog mst)
        (is_vis_edge_impl mst is_vis_var)
   in stutter_extend_en_list (ga_gample_mil4_impl mst (\<lambda>x f. f x) sticky)"
 
 lemma (in cprog) cr_ample_impl4_impl: "cr_ample_impl4_impl prog (comp_info_of prog) = cr_ample_impl4"
   apply (intro ext)
   unfolding cr_ample_impl4_impl_def cr_ample_impl4_def
   by (simp add: ga_gample_mil4_impl ccfg_G_impl_impl is_vis_edge_impl)
 
 definition "impl4_succ_impl prog mst is_vis_var
     \<equiv> succ_of_enex_list (cr_ample_impl4_impl prog mst is_vis_var,ga_ex_impl)"
 
 lemma (in cprog) impl4_succ_impl: 
   "impl4_succ_impl prog (comp_info_of prog) = impl4_succ"
   apply (intro ext)
   unfolding impl4_succ_impl_def impl4_succ_def
   by (simp add: cr_ample_impl4_impl)
 
 definition "ample_step_impl4_impl prog mst is_vis_var 
   \<equiv> rel_of_enex_list (cr_ample_impl4_impl prog mst is_vis_var,ga_ex_impl)"
 
 lemma (in cprog) ample_step_impl4_impl: 
   "ample_step_impl4_impl prog (comp_info_of prog) = ample_step_impl4"
   apply (intro ext)
   unfolding ample_step_impl4_impl_def ample_step_impl4_def
   by (simp add: cr_ample_impl4_impl)
   
 export_code impl4_succ_impl pid_init_gc_impl_impl comp_info_of checking SML
 
 end
 
diff --git a/thys/DFS_Framework/Invars/DFS_Invars_Basic.thy b/thys/DFS_Framework/Invars/DFS_Invars_Basic.thy
--- a/thys/DFS_Framework/Invars/DFS_Invars_Basic.thy
+++ b/thys/DFS_Framework/Invars/DFS_Invars_Basic.thy
@@ -1,1657 +1,1657 @@
 section \<open>Basic Invariant Library\<close>
 theory DFS_Invars_Basic
 imports "../Param_DFS"
 begin
 
 text \<open>We provide more basic invariants of the DFS algorithm\<close>
 
 
 
 subsection \<open>Basic Timing Invariants\<close>
 
 (* Timing *)
 abbreviation "the_discovered s v \<equiv> the (discovered s v)"
 abbreviation "the_finished s v \<equiv> the (finished s v)"
 
 locale timing_syntax
 begin
   (* Timing related syntax shortcuts *) 
   notation the_discovered ("\<delta>")
   notation the_finished ("\<phi>")
 end
 
 context param_DFS begin context begin interpretation timing_syntax .
 
   definition "timing_common_inv s \<equiv> 
   \<comment> \<open>\<open>\<delta> s v < \<phi> s v\<close>\<close>
    (\<forall>v \<in> dom (finished s). \<delta> s v < \<phi> s v)
 
   \<comment> \<open>\<open>v \<noteq> w \<longrightarrow> \<delta> s v \<noteq> \<delta> s w \<and> \<phi> s v \<noteq> \<phi> s w\<close>\<close>
   \<comment> \<open>Can't use \<open>card dom = card ran\<close> as the maps may be infinite ...\<close>
   \<and> (\<forall>v \<in> dom (discovered s). \<forall>w \<in> dom (discovered s). v \<noteq> w \<longrightarrow> \<delta> s v \<noteq> \<delta> s w)
   \<and> (\<forall>v \<in> dom (finished s). \<forall>w \<in> dom (finished s). v \<noteq> w \<longrightarrow> \<phi> s v \<noteq> \<phi> s w)
 
   \<comment> \<open>\<open>\<delta> s v < counter \<and> \<phi> s v < counter\<close>\<close>
   \<and> (\<forall>v \<in> dom (discovered s). \<delta> s v < counter s)
   \<and> (\<forall>v \<in> dom (finished s). \<phi> s v < counter s)
 
   \<and> (\<forall>v \<in> dom (finished s). \<forall>w \<in> succ v. \<delta> s w < \<phi> s v)"
 
   lemma timing_common_inv: 
     "is_invar timing_common_inv"
   proof (induction rule: is_invarI)
     case (finish s s') then interpret DFS_invar where s=s by simp
 
     from finish have NE: "stack s \<noteq> []" by (simp add: cond_alt)
     
     have *: "hd (stack s) \<notin> dom (finished s)" "hd (stack s) \<in> dom (discovered s)"
       using stack_not_finished stack_discovered hd_in_set[OF NE]
       by blast+
 
     from discovered_closed have 
       "(E - pending s) `` {hd (stack s)} \<subseteq> dom (discovered s)"
       using hd_in_set[OF NE]
       by (auto simp add: discovered_closed_def)
     hence succ_hd: "pending s `` {hd (stack s)} = {} 
       \<Longrightarrow> succ (hd (stack s)) \<subseteq> dom (discovered s)"
       by blast
     
     from finish show ?case 
         apply (simp add: timing_common_inv_def)
         apply (intro conjI)
         using * apply simp
         using * apply simp
         apply (metis less_irrefl)
         apply (metis less_irrefl)
         apply (metis less_SucI)
         apply (metis less_SucI)
         apply (blast dest!: succ_hd)
         using * apply simp
         done
   next
     case (discover s) then interpret DFS_invar where s=s by simp
     from discover show ?case
       apply (simp add: timing_common_inv_def)
       apply (intro conjI)
       using finished_discovered apply fastforce
       apply (metis less_irrefl)
       apply (metis less_irrefl)
       apply (metis less_SucI)
       apply (metis less_SucI)
       using finished_imp_succ_discovered apply fastforce
       done
   next
     case (new_root s s' v0) then interpret DFS_invar where s=s by simp
     from new_root show ?case
       apply (simp add: timing_common_inv_def)
       apply (intro conjI)
       using finished_discovered apply fastforce
       apply (metis less_irrefl)
       apply (metis less_irrefl)
       apply (metis less_SucI)
       apply (metis less_SucI)
       using finished_imp_succ_discovered apply fastforce
       done
   qed (simp_all add: timing_common_inv_def)
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemmas s_timing_common_inv = 
     timing_common_inv[THEN make_invar_thm]
 
   lemma timing_less_counter:
     "v \<in> dom (discovered s) \<Longrightarrow> \<delta> s v < counter s"
     "v \<in> dom (finished s) \<Longrightarrow> \<phi> s v < counter s"
     using s_timing_common_inv
     by (auto simp add: timing_common_inv_def)
 
   lemma disc_lt_fin:
     "v \<in> dom (finished s) \<Longrightarrow> \<delta> s v < \<phi> s v"
     using s_timing_common_inv
     by (auto simp add: timing_common_inv_def)
 
   lemma disc_unequal:
     assumes "v \<in> dom (discovered s)" "w \<in> dom (discovered s)"
     and "v \<noteq> w"
     shows "\<delta> s v \<noteq> \<delta> s w"
     using s_timing_common_inv assms
     by (auto simp add: timing_common_inv_def)
 
   lemma fin_unequal:
     assumes "v \<in> dom (finished s)" "w \<in> dom (finished s)"
     and "v \<noteq> w"
     shows "\<phi> s v \<noteq> \<phi> s w"
     using s_timing_common_inv assms
     by (auto simp add: timing_common_inv_def)
 
   lemma finished_succ_fin:
     assumes "v \<in> dom (finished s)"
     and "w \<in> succ v"
     shows "\<delta> s w < \<phi> s v"
     using assms s_timing_common_inv
     by (simp add: timing_common_inv_def)
 end end
 
 context param_DFS begin context begin interpretation timing_syntax .
 
   lemma i_prev_stack_discover_all:
     "is_invar (\<lambda>s. \<forall> n < length (stack s). \<forall> v \<in> set (drop (Suc n) (stack s)). 
                    \<delta> s (stack s ! n) > \<delta> s v)"
   proof (induct rule: is_invarI)
     case (finish s) thus ?case 
       by (cases "stack s") auto
   next
     case (discover s s' u v) 
     hence EQ[simp]: "discovered s' = (discovered s)(v \<mapsto> counter s)"
                     "stack s' = v#stack s"
       by simp_all
     
     from discover interpret DFS_invar where s=s by simp
     from discover stack_discovered have v_ni: "v \<notin> set (stack s)" by auto
 
     from stack_discovered timing_less_counter have 
       "\<And>w. w \<in> set (stack s) \<Longrightarrow> \<delta> s w < counter s" 
       by blast
     with v_ni have "\<And>w. w \<in> set (stack s) \<Longrightarrow> \<delta> s' w < \<delta> s' v" by auto
     hence "\<And>w. w \<in> set (drop (Suc 0) (stack s')) \<Longrightarrow> \<delta> s' w < \<delta> s' (stack s' ! 0)" 
       by auto
       
     moreover
     from v_ni have 
       "\<And>n. \<lbrakk>n < (length (stack s')); n > 0\<rbrakk>
       \<Longrightarrow> \<delta> s' (stack s' ! n) = \<delta> s (stack s' ! n)" 
       by auto
     with discover(1) v_ni 
     have  "\<And>n. \<lbrakk>n < (length (stack s')) - 1; n > 0\<rbrakk> 
       \<Longrightarrow> \<forall> w \<in> set (drop (Suc n) (stack s')). \<delta> s' (stack s' ! n) > \<delta> s' w"
       by (auto dest: in_set_dropD)
     ultimately show ?case 
       by (metis drop_Suc_Cons length_drop length_pos_if_in_set length_tl 
         list.sel(3) neq0_conv nth_Cons_0 EQ(2) zero_less_diff)
   qed simp_all
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemmas prev_stack_discover_all 
     = i_prev_stack_discover_all[THEN make_invar_thm]
 
   lemma prev_stack_discover:
     "\<lbrakk>n < length (stack s); v \<in> set (drop (Suc n) (stack s)) \<rbrakk>
      \<Longrightarrow> \<delta> s (stack s ! n) > \<delta> s v"
     by (metis prev_stack_discover_all)
 
   lemma Suc_stack_discover:
     assumes n: "n < (length (stack s)) - 1"
     shows "\<delta> s (stack s ! n) > \<delta> s (stack s ! Suc n)"
   proof -
     from prev_stack_discover assms have 
       "\<And> v. v \<in> set (drop (Suc n) (stack s)) \<Longrightarrow> \<delta> s (stack s ! n) > \<delta> s v" 
       by fastforce
     moreover from n have "stack s ! Suc n \<in> set (drop (Suc n) (stack s))" 
       using in_set_conv_nth by fastforce
     ultimately show ?thesis .
   qed
 
   lemma tl_lt_stack_hd_discover:
     assumes notempty: "stack s \<noteq> []"
     and "x \<in> set (tl (stack s))"
     shows "\<delta> s x < \<delta> s (hd (stack s))"
   proof -
     from notempty obtain y ys where "stack s = y#ys" by (metis list.exhaust)
     with assms show ?thesis
       using prev_stack_discover
       by (cases ys) force+
   qed
 
   lemma stack_nth_order:
     assumes l: "i < length (stack s)" "j < length (stack s)"
     shows "\<delta> s (stack s ! i) < \<delta> s (stack s ! j) \<longleftrightarrow> i > j" (is "\<delta> s ?i < \<delta> s ?j \<longleftrightarrow> _")
   proof
     assume \<delta>: "\<delta> s ?i < \<delta> s ?j"
     
     from l stack_set_def have 
       disc: "?i \<in> dom (discovered s)" "?j \<in> dom (discovered s)"
       by auto
     with disc_unequal[OF disc] \<delta> have "i \<noteq> j" by auto
 
     moreover
     {
       assume "i < j"
 
       with l have "stack s ! j \<in> set (drop (Suc i) (stack s))" 
         using in_set_drop_conv_nth[of "stack s ! j" "Suc i" "stack s"]
         by fastforce
       with prev_stack_discover l have "\<delta> s (stack s ! j) < \<delta> s (stack s ! i)" 
         by simp
       with \<delta> have "False" by simp
     }
     ultimately show "i > j" by force
   next
     assume "i > j"
     with l have "stack s ! i \<in> set (drop (Suc j) (stack s))" 
       using in_set_drop_conv_nth[of "stack s ! i" "Suc j" "stack s"]
       by fastforce
     with prev_stack_discover l show "\<delta> s ?i < \<delta> s ?j" by simp
   qed
 end end
 
 subsection \<open>Paranthesis Theorem\<close>
 (* Parenthesis Thm *)
 context param_DFS begin context begin interpretation timing_syntax .
 
   definition "parenthesis s \<equiv>
     \<forall>v \<in> dom (discovered s). \<forall>w \<in> dom (discovered s).
      \<delta> s v < \<delta> s w \<and> v \<in> dom (finished s) \<longrightarrow> (
              \<phi> s v < \<delta> s w \<comment> \<open>disjoint\<close>
            \<or> (\<phi> s v > \<delta> s w \<and> w \<in> dom (finished s) \<and> \<phi> s w < \<phi> s v))"
 
   lemma i_parenthesis: "is_invar parenthesis"
   proof (induct rule: is_invarI)
     case (finish s s')
     hence EQ[simp]: "discovered s' = discovered s" 
                     "counter s' = Suc (counter s)"
-                    "finished s' = finished s(hd (stack s) \<mapsto> counter s)"
+                    "finished s' = (finished s)(hd (stack s) \<mapsto> counter s)"
       by simp_all
 
     from finish interpret DFS_invar where s=s by simp
     from finish have NE[simp]: "stack s \<noteq> []" by (simp add: cond_alt)
 
     {
       fix x y
       assume  dom: "x \<in> dom (discovered s')" "y \<in> dom (discovered s')"
         and \<delta>: "\<delta> s' x < \<delta> s' y"
         and f: "x \<in> dom (finished s')"
       hence neq: "x \<noteq> y" by force
 
       note assms = dom \<delta> f EQ
 
       let ?DISJ = "\<phi> s' x < \<delta> s' y"
       let ?IN = "\<delta> s' y < \<phi> s' x \<and> y \<in> dom (finished s') \<and> \<phi> s' y < \<phi> s' x"
 
       have "?DISJ \<or> ?IN"
       proof (cases "x = hd (stack s)")
         case True note x_is_hd = this
         hence \<phi>x: "\<phi> s' x = counter s" by simp
         from x_is_hd neq have y_not_hd: "y \<noteq> hd (stack s)" by simp
         
         have "\<delta> s y < \<phi> s' x \<and> y \<in> dom (finished s) \<and> \<phi> s y < \<phi> s' x"
         proof (cases "y \<in> set (stack s)")
           \<comment> \<open>y on stack is not possible: According to @{thm [display] \<delta>} it is discovered after @{text "x (= hd (stack s))"}\<close>
           case True with y_not_hd have "y \<in> set (tl (stack s))" 
             by (cases "stack s") simp_all
           with tl_lt_stack_hd_discover[OF NE] \<delta> x_is_hd have "\<delta> s y < \<delta> s x" 
             by simp
           with \<delta> have False by simp
           thus ?thesis ..
         next
           case False \<comment> \<open>y must be a successor of @{text "x (= (hd (stack s)))"}\<close>
           from dom have "y \<in> dom (discovered s)" by simp
           with False discovered_not_stack_imp_finished  have *: 
             "y \<in> dom (finished s)" 
             by simp
           moreover with timing_less_counter \<phi>x have "\<phi> s y < \<phi> s' x" by simp
           moreover with * disc_lt_fin \<phi>x have "\<delta> s y < \<phi> s' x" 
             by (metis less_trans)
           ultimately show ?thesis by simp
         qed
         with y_not_hd show ?thesis by simp
       next
         case False note [simp] = this
         show ?thesis
         proof (cases "y = hd (stack s)")
           case False with finish assms show ?thesis 
             by (simp add: parenthesis_def)
         next
           case True with stack_not_finished have "y \<notin> dom (finished s)" 
             using hd_in_set[OF NE] 
             by auto
           with finish assms have "\<phi> s x < \<delta> s y" 
             unfolding parenthesis_def
             by auto
           hence ?DISJ by simp
           thus ?thesis ..
         qed
       qed
     }
     thus ?case by (simp add: parenthesis_def)
   next
     case (discover s s' u v)
     hence EQ[simp]: "discovered s' = (discovered s)(v \<mapsto> counter s)" 
                     "finished s' = finished s"
                     "counter s' = Suc (counter s)"
       by simp_all
     
     from discover interpret DFS_invar where s=s by simp
     from discover finished_discovered have 
       V': "v \<notin> dom (discovered s)" "v \<notin> dom (finished s)" 
       by auto
 
     {
       fix x y
       assume  dom: "x \<in> dom (discovered s')" "y \<in> dom (discovered s')"
         and \<delta>: "\<delta> s' x < \<delta> s' y"
         and f: "x \<in> dom (finished s')"
 
       let ?DISJ = "\<phi> s' x < \<delta> s' y"
       let ?IN = "\<delta> s' y < \<phi> s' x \<and> y \<in> dom (finished s') \<and> \<phi> s' y < \<phi> s' x"
       
       from dom V' f have x: "x \<in> dom (discovered s)""x \<noteq> v" by auto
       
       have "?DISJ \<or> ?IN"
       proof (cases "y = v")
         case True hence "\<delta> s' y = counter s" by simp
         moreover from timing_less_counter x f have "\<phi> s' x < counter s" by auto
         ultimately have "?DISJ" by simp
         thus ?thesis ..
       next
         case False with dom have "y \<in> dom (discovered s)" by simp
         with discover False \<delta> f x show ?thesis by (simp add: parenthesis_def)
       qed
     }
     thus ?case by (simp add: parenthesis_def)
   next
     case (new_root s s' v0) 
     then interpret DFS_invar where s=s by simp
     
     from finished_discovered new_root have "v0 \<notin> dom (finished s')" by auto
     with new_root timing_less_counter show ?case by (simp add: parenthesis_def)
   qed (simp_all add: parenthesis_def)
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemma parenthesis:
     assumes "v \<in> dom (finished s)" "w \<in> dom (discovered s)"
     and "\<delta> s v < \<delta> s w"
     shows "\<phi> s v < \<delta> s w \<comment> \<open>disjoint\<close>
            \<or> (\<phi> s v > \<delta> s w \<and> w \<in> dom (finished s) \<and> \<phi> s w < \<phi> s v)"
     using assms
     using i_parenthesis[THEN make_invar_thm]
     using finished_discovered
     unfolding parenthesis_def
     by blast
 
   lemma parenthesis_contained:
     assumes "v \<in> dom (finished s)" "w \<in> dom (discovered s)"
     and "\<delta> s v < \<delta> s w" "\<phi> s v > \<delta> s w"
     shows "w \<in> dom (finished s) \<and> \<phi> s w < \<phi> s v"
     using parenthesis assms
     by force
   
   lemma parenthesis_disjoint:
     assumes "v \<in> dom (finished s)" "w \<in> dom (discovered s)"
     and "\<delta> s v < \<delta> s w" "\<phi> s w > \<phi> s v"
     shows "\<phi> s v < \<delta> s w"
     using parenthesis assms
     by force
 
   lemma finished_succ_contained:
     assumes "v \<in> dom (finished s)"
     and "w \<in> succ v"
     and "\<delta> s v < \<delta> s w"
     shows "w \<in> dom (finished s) \<and> \<phi> s w < \<phi> s v"
     using finished_succ_fin finished_imp_succ_discovered parenthesis_contained
     using assms
     by metis
 
 end end
 
 
 subsection \<open>Edge Types\<close>
 context param_DFS 
 begin
   abbreviation "edges s \<equiv> tree_edges s \<union> cross_edges s \<union> back_edges s"
 
   (* Demo for simple invariant proof *)
   lemma "is_invar (\<lambda>s. finite (edges s))"
     by (induction rule: establish_invarI) auto
 
   text \<open>Sometimes it's useful to just chose between tree-edges and non-tree.\<close>
   lemma edgesE_CB:
     assumes "x \<in> edges s"
     and "x \<in> tree_edges s \<Longrightarrow> P"
     and "x \<in> cross_edges s \<union> back_edges s \<Longrightarrow> P"
     shows "P"
     using assms by auto
 
   definition "edges_basic s \<equiv> 
      Field (back_edges s) \<subseteq> dom (discovered s) \<and> back_edges s \<subseteq> E - pending s
    \<and> Field (cross_edges s) \<subseteq> dom (discovered s) \<and> cross_edges s \<subseteq> E - pending s
    \<and> Field (tree_edges s) \<subseteq> dom (discovered s) \<and> tree_edges s \<subseteq> E - pending s
    \<and> back_edges s \<inter> cross_edges s = {}
    \<and> back_edges s \<inter> tree_edges s = {}
    \<and> cross_edges s \<inter> tree_edges s = {}
    "
 
   lemma i_edges_basic:
     "is_invar edges_basic"
     unfolding edges_basic_def[abs_def]
   proof (induct rule: is_invarI_full)
     case (back_edge s)
     then interpret DFS_invar where s=s by simp
     from back_edge show ?case by (auto dest: pendingD)
   next
     case (cross_edge s)
     then interpret DFS_invar where s=s by simp
     from cross_edge show ?case by (auto dest: pendingD)
   next
     case (discover s)
     then interpret DFS_invar where s=s by simp
     from discover show ?case 
       (* Speed optimized proof, using only auto takes too long *)
       apply (simp add: Field_def Range_def Domain_def)
       apply (drule pendingD) apply simp
       by (blast)
   next
     case (new_root s) 
     thus ?case by (simp add: Field_def) blast
   qed auto
 
   lemmas (in DFS_invar) edges_basic = i_edges_basic[THEN make_invar_thm]
     
   lemma i_edges_covered: 
     "is_invar (\<lambda>s. (E \<inter> dom (discovered s) \<times> UNIV) - pending s = edges s)"
   proof (induction rule: is_invarI_full)
     case (new_root s s' v0) 
     interpret DFS_invar G param s by fact  
 
     from new_root empty_stack_imp_empty_pending 
     have [simp]: "pending s = {}" by simp
 
     from \<open>v0 \<notin> dom (discovered s)\<close> 
     have [simp]: "E \<inter> insert v0 (dom (discovered s)) \<times> UNIV - {v0} \<times> succ v0 
       = E \<inter> dom (discovered s) \<times> UNIV" by auto
 
     from new_root show ?case by simp
   next
     case (cross_edge s s' u v) 
     interpret DFS_invar G param s by fact  
 
     from cross_edge stack_discovered have "u \<in> dom (discovered s)" 
       by (cases "stack s") auto
 
     with cross_edge(2-) pending_ssE have 
       "E \<inter> dom (discovered s) \<times> UNIV - (pending s - {(hd (stack s), v)})
       = insert (hd (stack s), v) (E \<inter> dom (discovered s) \<times> UNIV - pending s)"
       by auto
 
     thus ?case using cross_edge by simp
   next
     case (back_edge s s' u v)
     interpret DFS_invar G param s by fact  
 
     from back_edge stack_discovered have "u \<in> dom (discovered s)" 
       by (cases "stack s") auto
 
     with back_edge(2-) pending_ssE have 
       "E \<inter> dom (discovered s) \<times> UNIV - (pending s - {(hd (stack s), v)})
       = insert (hd (stack s), v) (E \<inter> dom (discovered s) \<times> UNIV - pending s)"
       by auto
 
     thus ?case using back_edge by simp
   next
     case (discover s s' u v)
     interpret DFS_invar G param s by fact  
 
     from discover stack_discovered have "u \<in> dom (discovered s)" 
       by (cases "stack s") auto
 
     with discover(2-) pending_ssE have 
       "E \<inter> insert v (dom (discovered s)) \<times> UNIV 
         - (pending s - {(hd (stack s), v)} \<union> {v} \<times> succ v)
       = insert (hd (stack s), v) (E \<inter> dom (discovered s) \<times> UNIV - pending s)"
       by auto
 
     thus ?case using discover by simp
   qed simp_all
 end
 
 context DFS_invar begin
 
   lemmas edges_covered = 
     i_edges_covered[THEN make_invar_thm]
 
   lemma edges_ss_reachable_edges:
     "edges s \<subseteq> E \<inter> reachable \<times> UNIV"
     using edges_covered discovered_reachable
     by (fast intro: rtrancl_image_advance_rtrancl)
 
   lemma nc_edges_covered:
     assumes "\<not>cond s" "\<not>is_break param s"
     shows "E \<inter> reachable \<times> UNIV = edges s"
   proof -
     from assms have [simp]: "stack s = []" 
       unfolding cond_def by (auto simp: pred_defs)
     hence [simp]: "pending s = {}" by (rule empty_stack_imp_empty_pending)
     
     
     from edges_covered nc_discovered_eq_reachable[OF assms] 
     show ?thesis by simp
   qed
 
   lemma 
     tree_edges_ssE: "tree_edges s \<subseteq> E" and
     tree_edges_not_pending: "tree_edges s \<subseteq> - pending s" and
     tree_edge_is_succ: "(v,w) \<in> tree_edges s \<Longrightarrow> w \<in> succ v" and
     tree_edges_discovered: "Field (tree_edges s) \<subseteq> dom (discovered s)" and
 
     cross_edges_ssE: "cross_edges s \<subseteq> E" and
     cross_edges_not_pending: "cross_edges s \<subseteq> - pending s" and
     cross_edge_is_succ: "(v,w) \<in> cross_edges s \<Longrightarrow> w \<in> succ v" and
     cross_edges_discovered: "Field (cross_edges s) \<subseteq> dom (discovered s)" and
 
     back_edges_ssE: "back_edges s \<subseteq> E" and
     back_edges_not_pending: "back_edges s \<subseteq> - pending s" and
     back_edge_is_succ: "(v,w) \<in> back_edges s \<Longrightarrow> w \<in> succ v" and
     back_edges_discovered: "Field (back_edges s) \<subseteq> dom (discovered s)"
     using edges_basic
     unfolding edges_basic_def 
     by auto
 
   lemma edges_disjoint: 
    "back_edges s \<inter> cross_edges s = {}"
    "back_edges s \<inter> tree_edges s = {}"
    "cross_edges s \<inter> tree_edges s = {}"
     using edges_basic
     unfolding edges_basic_def 
     by auto
 
   lemma tree_edge_imp_discovered:
     "(v,w) \<in> tree_edges s \<Longrightarrow> v \<in> dom (discovered s)"
     "(v,w) \<in> tree_edges s \<Longrightarrow> w \<in> dom (discovered s)"
     using tree_edges_discovered
     by (auto simp add: Field_def)
 
   lemma back_edge_imp_discovered:
     "(v,w) \<in> back_edges s \<Longrightarrow> v \<in> dom (discovered s)"
     "(v,w) \<in> back_edges s \<Longrightarrow> w \<in> dom (discovered s)"
     using back_edges_discovered
     by (auto simp add: Field_def)
 
   lemma cross_edge_imp_discovered:
     "(v,w) \<in> cross_edges s \<Longrightarrow> v \<in> dom (discovered s)"
     "(v,w) \<in> cross_edges s \<Longrightarrow> w \<in> dom (discovered s)"
     using cross_edges_discovered
     by (auto simp add: Field_def)
 
   lemma edge_imp_discovered:
     "(v,w) \<in> edges s \<Longrightarrow> v \<in> dom (discovered s)"
     "(v,w) \<in> edges s \<Longrightarrow> w \<in> dom (discovered s)"
     using tree_edge_imp_discovered cross_edge_imp_discovered back_edge_imp_discovered
     by blast+
 
   lemma tree_edges_finite[simp, intro!]: "finite (tree_edges s)"
     using finite_subset[OF tree_edges_discovered discovered_finite] by simp
 
   lemma cross_edges_finite[simp, intro!]: "finite (cross_edges s)"
     using finite_subset[OF cross_edges_discovered discovered_finite] by simp
 
   lemma back_edges_finite[simp, intro!]: "finite (back_edges s)"
     using finite_subset[OF back_edges_discovered discovered_finite] by simp
 
   lemma edges_finite: "finite (edges s)"
     by auto
 
   
 end
 
 subsubsection \<open>Properties of the DFS Tree\<close>
 (* Tree *)
 
 context DFS_invar begin context begin interpretation timing_syntax .
   lemma tree_edge_disc_lt_fin:
     "(v,w) \<in> tree_edges s \<Longrightarrow> v \<in> dom (finished s) \<Longrightarrow> \<delta> s w < \<phi> s v"
     by (metis finished_succ_fin tree_edge_is_succ)
 
   lemma back_edge_disc_lt_fin:
     "(v,w) \<in> back_edges s \<Longrightarrow> v \<in> dom (finished s) \<Longrightarrow> \<delta> s w < \<phi> s v"
     by (metis finished_succ_fin back_edge_is_succ)
 
   lemma cross_edge_disc_lt_fin:
     "(v,w) \<in> cross_edges s \<Longrightarrow> v \<in> dom (finished s) \<Longrightarrow> \<delta> s w < \<phi> s v"
     by (metis finished_succ_fin cross_edge_is_succ)
 end end
 
 (* Stack & Tree *)
 context param_DFS begin
 
   lemma i_stack_is_tree_path:
     "is_invar (\<lambda>s. stack s \<noteq> [] \<longrightarrow> (\<exists>v0 \<in> V0. 
         path (tree_edges s) v0 (rev (tl (stack s))) (hd (stack s))))"
   proof (induct rule: is_invarI)
     case (discover s s' u v)
     hence EQ[simp]: "stack s' = v # stack s"
                     "tree_edges s' = insert (hd (stack s), v) (tree_edges s)"
       by simp_all
     from discover have NE[simp]: "stack s \<noteq> []" by simp
 
     from discover obtain v0 where 
       "v0 \<in> V0"
       "path (tree_edges s) v0 (rev (tl (stack s))) (hd (stack s))"
       by blast
     with path_mono[OF _ this(2)] EQ have 
       "path (tree_edges s') v0 (rev (tl (stack s))) (hd (stack s))" 
       by blast
     with \<open>v0 \<in> V0\<close> show ?case
       by (cases "stack s") (auto simp: path_simps)
 
   next
     case (finish s s')
     hence EQ[simp]: "stack s' = tl (stack s)"
                     "tree_edges s' = tree_edges s"
       by simp_all
 
     from finish obtain v0 where
       "v0 \<in> V0"
       "path (tree_edges s) v0 (rev (tl (stack s))) (hd (stack s))"
       by blast
     hence P: "path (tree_edges s') v0 (rev (stack s')) (hd (stack s))" by simp
       
     show ?case
     proof
       assume A: "stack s' \<noteq> []"
       with P have "(hd (stack s'), hd (stack s)) \<in> tree_edges s'"
         by (auto simp: neq_Nil_conv path_simps)
       moreover from P A have 
         "path (tree_edges s') v0 (rev (tl (stack s')) @ [hd (stack s')]) (hd (stack s))"
         by (simp)
       moreover note \<open>v0 \<in> V0\<close>
       ultimately show "\<exists>v0\<in>V0. path (tree_edges s') v0 (rev (tl (stack s'))) (hd (stack s'))"
         by (auto simp add: path_append_conv)
     qed
   qed simp_all
 end
 
 context DFS_invar begin
 
   lemmas stack_is_tree_path = 
     i_stack_is_tree_path[THEN make_invar_thm, rule_format]
 
   lemma stack_is_path:
     "stack s \<noteq> [] \<Longrightarrow> \<exists>v0\<in>V0. path E v0 (rev (tl (stack s))) (hd (stack s))"
     using stack_is_tree_path path_mono[OF tree_edges_ssE]
     by blast
 
   lemma hd_succ_stack_is_path:
     assumes ne: "stack s \<noteq> []"
     and succ: "v \<in> succ (hd (stack s))"
     shows "\<exists>v0\<in>V0. path E v0 (rev (stack s)) v"
   proof -
     from stack_is_path[OF ne] succ obtain v0 where
       "v0 \<in> V0"
       "path E v0 (rev (tl (stack s)) @ [hd (stack s)]) v"
       by (auto simp add: path_append_conv)
     thus ?thesis using ne
       by (cases "stack s") auto
   qed
 
   lemma tl_stack_hd_tree_path:
     assumes "stack s \<noteq> []"
     and "v \<in> set (tl (stack s))"
     shows "(v, hd (stack s)) \<in> (tree_edges s)\<^sup>+"
   proof -
     from stack_is_tree_path assms obtain v0 where 
       "path (tree_edges s) v0 (rev (tl (stack s))) (hd (stack s))" 
       by auto
     from assms path_member_reach_end[OF this] show ?thesis by simp
   qed
 end
 
 context param_DFS begin
   definition "tree_discovered_inv s \<equiv>
                        (tree_edges s = {} \<longrightarrow> dom (discovered s) \<subseteq> V0 \<and> (stack s = [] \<or> (\<exists>v0\<in>V0. stack s = [v0])))
                      \<and> (tree_edges s \<noteq> {} \<longrightarrow> (tree_edges s)\<^sup>+ `` V0 \<union> V0 = dom (discovered s) \<union> V0)"
 
 
   lemma i_tree_discovered_inv: 
     "is_invar tree_discovered_inv"
   proof (induct rule: is_invarI)
     case (discover s s' u v) 
     hence EQ[simp]: "stack s' = v # stack s"
                     "tree_edges s' = insert (hd (stack s), v) (tree_edges s)"
                     "discovered s' = (discovered s)(v \<mapsto> counter s)"
       by simp_all
     
     from discover interpret DFS_invar where s=s by simp
 
     from discover have NE[simp]: "stack s \<noteq> []" by simp
     note TDI = \<open>tree_discovered_inv s\<close>[unfolded tree_discovered_inv_def]
 
     have "tree_edges s' = {} \<longrightarrow> dom (discovered s') \<subseteq> V0 \<and> (stack s' = [] \<or> (\<exists>v0\<in>V0. stack s' = [v0]))"
       by simp \<comment> \<open>@{text "tree_edges s' \<noteq> {}"}\<close>
 
     moreover {
       fix x
       assume A: "x \<in> (tree_edges s')\<^sup>+ `` V0 \<union> V0" "x \<notin> V0"
       then obtain y where y: "(y,x) \<in> (tree_edges s')\<^sup>+" "y \<in> V0" by auto
      
 
       have "x \<in> dom (discovered s') \<union> V0"
       proof (cases "tree_edges s = {}")
         case True with discover A have "(tree_edges s')\<^sup>+ = {(hd (stack s), v)}"
           by (simp add: trancl_single)
         with A show ?thesis by auto
       next
         case False note t_ne = this
 
         show ?thesis
         proof (cases "x = v")
           case True thus ?thesis by simp
         next
           case False with y have "(y,x) \<in> (tree_edges s)\<^sup>+"
           proof (induct rule: trancl_induct)
             case (step a b) hence "(a,b) \<in> tree_edges s" by simp
             with tree_edge_imp_discovered have "a \<in> dom (discovered s)" by simp
             with discover have "a \<noteq> v" by blast
             with step show ?case by auto
           qed simp
           with \<open>y \<in> V0\<close> have "x \<in> (tree_edges s)\<^sup>+ `` V0" by auto
           with t_ne TDI show ?thesis by auto
         qed
       qed
     } note t_d = this
 
     {
       fix x
       assume "x \<in> dom (discovered s') \<union> V0" "x \<notin> V0"
       hence A: "x \<in> dom (discovered s')" by simp
 
       have "x \<in> (tree_edges s')\<^sup>+ `` V0 \<union> V0"
       proof (cases "tree_edges s = {}")
         case True with trancl_single have "(tree_edges s')\<^sup>+ = {(hd (stack s), v)}" by simp
         moreover from True TDI have "hd (stack s) \<in> V0" "dom (discovered s) \<subseteq> V0" by auto
         ultimately show ?thesis using A \<open>x\<notin>V0\<close> by auto
       next
         case False note t_ne = this
 
         show ?thesis
         proof (cases "x=v")
           case False with A have "x \<in> dom (discovered s)" by simp
           with TDI t_ne \<open>x \<notin> V0\<close> have "x \<in> (tree_edges s)\<^sup>+ `` V0" by auto
           with trancl_sub_insert_trancl show ?thesis by simp blast
         next
           case True
           from t_ne TDI have "dom (discovered s) \<union> V0 = (tree_edges s)\<^sup>+ `` V0 \<union> V0"
             by simp
 
           moreover from stack_is_tree_path[OF NE] obtain v0 where "v0 \<in> V0" and 
             "(v0, hd (stack s)) \<in> (tree_edges s)\<^sup>*"
             by (blast intro!: path_is_rtrancl)
           with EQ have "(v0, hd (stack s)) \<in> (tree_edges s')\<^sup>*" by (auto intro: rtrancl_mono_mp)
           ultimately show ?thesis using \<open>v0 \<in> V0\<close> True by (auto elim: rtrancl_into_trancl1)
         qed
       qed
     } with t_d have "(tree_edges s')\<^sup>+ `` V0 \<union> V0 = dom (discovered s') \<union> V0" by blast
 
     ultimately show ?case by (simp add: tree_discovered_inv_def)
   qed (auto simp add: tree_discovered_inv_def)
       
   lemmas (in DFS_invar) tree_discovered_inv = 
     i_tree_discovered_inv[THEN make_invar_thm]
 
   lemma (in DFS_invar) discovered_iff_tree_path:
     "v \<notin> V0 \<Longrightarrow> v \<in> dom (discovered s) \<longleftrightarrow> (\<exists>v0\<in>V0. (v0,v) \<in> (tree_edges s)\<^sup>+)"
     using tree_discovered_inv
     by (auto simp add: tree_discovered_inv_def)
 
   lemma i_tree_one_predecessor:
     "is_invar (\<lambda>s. \<forall>(v,v') \<in> tree_edges s. \<forall>y. y \<noteq> v \<longrightarrow> (y,v') \<notin> tree_edges s)"
   proof (induct rule: is_invarI)
     case (discover s s' u v) 
     hence EQ[simp]: "tree_edges s' = insert (hd (stack s),v) (tree_edges s)" by simp
 
     from discover interpret DFS_invar where s=s by simp
     from discover have NE[simp]: "stack s \<noteq> []" by (simp add: cond_alt)
 
     {
       fix w w' y
       assume *: "(w,w') \<in> tree_edges s'"
         and  "y \<noteq> w"
 
       from discover stack_discovered have v_hd: "hd (stack s) \<noteq> v" 
         using hd_in_set[OF NE] by blast
       from discover tree_edges_discovered have 
         v_notin_tree: "\<forall>(x,x') \<in> tree_edges s. x \<noteq> v \<and> x' \<noteq> v" 
         by (blast intro!: Field_not_elem)
 
       have "(y,w') \<notin> tree_edges s'"
       proof (cases "w = hd (stack s)")
         case True
         have "(y,v) \<notin> tree_edges s'"
         proof (rule notI)
           assume "(y,v) \<in> tree_edges s'" 
           with True \<open>y\<noteq>w\<close> have "(y,v) \<in> tree_edges s" by simp
           with v_notin_tree show False by auto
         qed
         with True * \<open>y\<noteq>w\<close> v_hd show ?thesis 
           apply (cases "w = v")
           apply simp 
           using discover apply simp apply blast
           done
       next
         case False with v_notin_tree * \<open>y\<noteq>w\<close> v_hd 
         show ?thesis
           apply (cases "w' = v")
           apply simp apply blast
           using discover apply simp apply blast
           done
       qed
     }
     thus ?case by blast
   qed simp_all
  
   lemma (in DFS_invar) tree_one_predecessor:
     assumes "(v,w) \<in> tree_edges s"
     and "a \<noteq> v"
     shows "(a,w) \<notin> tree_edges s"
     using assms make_invar_thm[OF i_tree_one_predecessor]
     by blast
 
   lemma (in DFS_invar) tree_eq_rule:
     "\<lbrakk>(v,w) \<in> tree_edges s; (u,w) \<in> tree_edges s\<rbrakk> \<Longrightarrow> v=u"
     using tree_one_predecessor
     by blast
 
 context begin interpretation timing_syntax .
 
   lemma i_tree_edge_disc:
     "is_invar (\<lambda>s. \<forall>(v,v') \<in> tree_edges s. \<delta> s v < \<delta> s v')"
   proof (induct rule: is_invarI)
     case (discover s s' u v) 
     hence EQ[simp]: "tree_edges s' = insert (hd (stack s), v) (tree_edges s)"
                     "discovered s' = (discovered s)(v \<mapsto> counter s)"
       by simp_all
 
     from discover interpret DFS_invar where s=s by simp
     from discover have NE[simp]: "stack s \<noteq> []" by (simp add: cond_alt)
     
     from discover tree_edges_discovered have 
       v_notin_tree: "\<forall>(x,x') \<in> tree_edges s. x \<noteq> v \<and> x' \<noteq> v" 
       by (blast intro!: Field_not_elem)
     from discover stack_discovered have 
       v_hd: "hd (stack s) \<noteq> v" 
       using hd_in_set[OF NE] 
       by blast
     
     {
       fix a b
       assume T: "(a,b) \<in> tree_edges s'"
       have "\<delta> s' a < \<delta> s' b"
       proof (cases "b = v")
         case True with T v_notin_tree have [simp]: "a = hd (stack s)" by auto
         with stack_discovered have "a \<in> dom (discovered s)" 
           by (metis hd_in_set NE subsetD)
         with v_hd True timing_less_counter show ?thesis by simp
       next
         case False with v_notin_tree T have "(a,b) \<in> tree_edges s" "a \<noteq> v" by auto
         with discover have "\<delta> s a < \<delta> s b" by auto
         with False \<open>a\<noteq>v\<close> show ?thesis by simp
       qed
     } thus ?case by blast
   next
     case (new_root s s' v0) then interpret DFS_invar where s=s by simp
     from new_root have "tree_edges s' = tree_edges s" by simp
     moreover from tree_edge_imp_discovered new_root have "\<forall>(v,v') \<in> tree_edges s. v \<noteq> v0 \<and> v' \<noteq> v0" by blast
     ultimately show ?case using new_root by auto
   qed simp_all
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemma tree_edge_disc:
     "(v,w) \<in> tree_edges s \<Longrightarrow> \<delta> s v < \<delta> s w"
     using i_tree_edge_disc[THEN make_invar_thm]
     by blast
   
   lemma tree_path_disc:
     "(v,w) \<in> (tree_edges s)\<^sup>+ \<Longrightarrow> \<delta> s v < \<delta> s w"
     by (auto elim!: trancl_induct dest: tree_edge_disc)
 
   lemma no_loop_in_tree:
     "(v,v) \<notin> (tree_edges s)\<^sup>+"
     using tree_path_disc by auto
 
   lemma tree_acyclic:
     "acyclic (tree_edges s)"
     by (metis acyclicI no_loop_in_tree)
 
   lemma no_self_loop_in_tree:
     "(v,v) \<notin> tree_edges s"
     using tree_edge_disc by auto
 
   lemma tree_edge_unequal:
     "(v,w) \<in> tree_edges s \<Longrightarrow> v \<noteq> w"
     by (metis no_self_loop_in_tree)
 
   lemma tree_path_unequal:
     "(v,w) \<in> (tree_edges s)\<^sup>+ \<Longrightarrow> v \<noteq> w"
     by (metis no_loop_in_tree)
 
   lemma tree_subpath':
     assumes x: "(x,v) \<in> (tree_edges s)\<^sup>+"
     and y: "(y,v) \<in> (tree_edges s)\<^sup>+"
     and "x \<noteq> y"
     shows "(x,y) \<in> (tree_edges s)\<^sup>+ \<or> (y,x) \<in> (tree_edges s)\<^sup>+"
   proof -
     from x obtain px where px: "path (tree_edges s) x px v" and "px \<noteq> []"
       using trancl_is_path by metis
     from y obtain py where py: "path (tree_edges s) y py v" and "py \<noteq> []"
       using trancl_is_path by metis
 
     from \<open>px \<noteq> []\<close> \<open>py \<noteq> []\<close> px py
     show ?thesis
     proof (induction arbitrary: v rule: rev_nonempty_induct2')
       case (single) hence "(x,v) \<in> tree_edges s" "(y,v) \<in> tree_edges s" 
         by (simp_all add: path_simps)
       with tree_eq_rule have "x=y" by simp
       with \<open>x\<noteq>y\<close> show ?case by contradiction
     next
       case (snocl a as) hence "(y,v) \<in> tree_edges s" by (simp add: path_simps)
       moreover from snocl have "path (tree_edges s) x as a" "(a,v) \<in> tree_edges s" 
         by (simp_all add: path_simps)
       ultimately have "path (tree_edges s) x as y"
         using tree_eq_rule
         by auto
       with path_is_trancl \<open>as \<noteq> []\<close> show ?case by metis
     next
       case (snocr _ a as) hence "(x,v) \<in> tree_edges s" by (simp add: path_simps)
       moreover from snocr have "path (tree_edges s) y as a" "(a,v) \<in> tree_edges s" 
         by (simp_all add: path_simps)
       ultimately have "path (tree_edges s) y as x"
         using tree_eq_rule
         by auto
       with path_is_trancl \<open>as \<noteq> []\<close> show ?case by metis
     next
       case (snoclr a as b bs) hence 
         "path (tree_edges s) x as a" "(a,v) \<in> tree_edges s"
         "path (tree_edges s) y bs b" "(b,v) \<in> tree_edges s"
         by (simp_all add: path_simps)
       moreover hence "a=b"  using tree_eq_rule by simp
       ultimately show ?thesis using snoclr.IH by metis
     qed
   qed
 
   lemma tree_subpath:
     assumes "(x,v) \<in> (tree_edges s)\<^sup>+"
     and "(y,v) \<in> (tree_edges s)\<^sup>+"
     and \<delta>: "\<delta> s x < \<delta> s y"
     shows "(x,y) \<in> (tree_edges s)\<^sup>+"
   proof -
     from \<delta> have "x \<noteq> y" by auto
     with assms tree_subpath' have "(x,y) \<in> (tree_edges s)\<^sup>+ \<or> (y,x) \<in> (tree_edges s)\<^sup>+" 
       by simp
     moreover from \<delta> tree_path_disc have "(y,x) \<notin> (tree_edges s)\<^sup>+" by force
     ultimately show ?thesis by simp
   qed
 
   lemma on_stack_is_tree_path:
     assumes x: "x \<in> set (stack s)"
     and y: "y \<in> set (stack s)"
     and \<delta>: "\<delta> s x < \<delta> s y"
     shows "(x,y) \<in> (tree_edges s)\<^sup>+"
   proof -
     from x obtain i where i: "stack s ! i = x" "i < length (stack s)"
       by (metis in_set_conv_nth)
 
     from y obtain j where j: "stack s ! j = y" "j < length (stack s)"
       by (metis in_set_conv_nth)
     
     with i \<delta> stack_nth_order have "j < i" by force
     
     from x have ne[simp]: "stack s \<noteq> []" by auto
 
     from \<open>j<i\<close> have "x \<in> set (tl (stack s))"
       using nth_mem nth_tl[OF ne, of "i - 1"] i
       by auto
     with tl_stack_hd_tree_path have 
       x_path: "(x, hd (stack s)) \<in> (tree_edges s)\<^sup>+" 
       by simp
 
     then show ?thesis
     proof (cases "j=0")
       case True with j have "hd (stack s) = y" by (metis hd_conv_nth ne)
       with x_path show ?thesis by simp
     next
       case False hence "y \<in> set (tl (stack s))"
         using nth_mem nth_tl[OF ne, of "j - 1"] j
         by auto
       with tl_stack_hd_tree_path have "(y, hd (stack s)) \<in> (tree_edges s)\<^sup>+" 
         by simp
       with x_path \<delta> show ?thesis
         using tree_subpath
         by metis
     qed
   qed
 
   lemma hd_stack_tree_path_finished:
     assumes "stack s \<noteq> []"
     assumes "(hd (stack s), v) \<in> (tree_edges s)\<^sup>+"
     shows "v \<in> dom (finished s)"
   proof (cases "v \<in> set (stack s)")
     case True
     from assms no_loop_in_tree have "hd (stack s) \<noteq> v" by auto
     with True have "v \<in> set (tl (stack s))" by (cases "stack s") auto
     with tl_stack_hd_tree_path assms have "(hd (stack s), hd (stack s)) \<in> (tree_edges s)\<^sup>+" by (metis trancl_trans)
     with no_loop_in_tree show ?thesis by contradiction
   next
     case False
     from assms obtain x where "(x,v) \<in> tree_edges s" by (metis tranclE)
     with tree_edge_imp_discovered have "v \<in> dom (discovered s)" by blast
     with False show ?thesis by (simp add: stack_set_def)
   qed
 
   lemma tree_edge_impl_parenthesis:
     assumes t: "(v,w) \<in> tree_edges s"
     and f: "v \<in> dom (finished s)"
     shows "w \<in> dom (finished s) 
       \<and> \<delta> s v < \<delta> s w
       \<and> \<phi> s w < \<phi> s v "
   proof -
     from tree_edge_disc_lt_fin assms have "\<delta> s w < \<phi> s v" by simp
     with f tree_edge_imp_discovered[OF t] tree_edge_disc[OF t]
     show ?thesis
       using parenthesis_contained
       by metis
   qed
 
   lemma tree_path_impl_parenthesis:
     assumes "(v,w) \<in> (tree_edges s)\<^sup>+"
     and "v \<in> dom (finished s)"
     shows "w \<in> dom (finished s) 
       \<and> \<delta> s v < \<delta> s w
       \<and> \<phi> s w < \<phi> s v "
     using assms
     by (auto elim!: trancl_induct dest: tree_edge_impl_parenthesis)
 
   lemma nc_reachable_v0_parenthesis:
     assumes C: "\<not> cond s" "\<not> is_break param s"
     and v: "v \<in> reachable" "v \<notin> V0"
     obtains v0 where "v0 \<in> V0"
                  and "\<delta> s v0 < \<delta> s v \<and> \<phi> s v < \<phi> s v0 "
   proof -
     from nc_discovered_eq_reachable[OF C] discovered_iff_tree_path v
     obtain v0 where "v0 \<in> V0" and
       "(v0,v) \<in> (tree_edges s)\<^sup>+" 
       by auto
     moreover with nc_V0_finished[OF C] have "v0 \<in> dom (finished s)" 
       by auto
     ultimately show ?thesis
       using tree_path_impl_parenthesis that[OF \<open>v0 \<in> V0\<close>]
       by simp
   qed
 
 end end
 
 context param_DFS begin context begin interpretation timing_syntax .
 
   definition paren_imp_tree_reach where
     "paren_imp_tree_reach s \<equiv> \<forall>v \<in> dom (discovered s). \<forall>w \<in> dom (finished s). 
         \<delta> s v < \<delta> s w \<and> (v \<notin> dom (finished s) \<or> \<phi> s v > \<phi> s w) 
                \<longrightarrow> (v,w) \<in> (tree_edges s)\<^sup>+"
 
   lemma paren_imp_tree_reach:
     "is_invar paren_imp_tree_reach"
     unfolding paren_imp_tree_reach_def[abs_def]
   proof (induct rule: is_invarI)
     case (discover s s' u v) 
     hence EQ[simp]: "tree_edges s' = insert (hd (stack s), v) (tree_edges s)"
                     "finished s' = finished s"
                     "discovered s' = (discovered s)(v \<mapsto> counter s)"
       by simp_all
 
     from discover interpret DFS_invar where s=s by simp
     from discover have NE[simp]: "stack s \<noteq> []" by (simp add: cond_alt)
     
     show ?case
     proof (intro ballI impI)
       fix a b
       assume F:"a \<in> dom (discovered s')" "b \<in> dom (finished s')"
         and D: "\<delta> s' a < \<delta> s' b \<and> (a \<notin> dom (finished s') \<or> \<phi> s' a > \<phi> s' b)"
         
       from F finished_discovered discover have "b \<noteq> v" by auto
       show "(a,b) \<in> (tree_edges s')\<^sup>+"
       proof (cases "a = v")
         case True with D \<open>b\<noteq>v\<close> have "counter s < \<delta> s b" by simp
         also from F have "b \<in> dom (discovered s)" 
           using finished_discovered by auto
         with timing_less_counter have "\<delta> s b < counter s" by simp
         finally have False .
         thus ?thesis ..
       next
         case False with \<open>b\<noteq>v\<close> F D discover have "(a,b) \<in> (tree_edges s)\<^sup>+" by simp
         thus ?thesis by (auto intro: trancl_mono_mp)
       qed
     qed
   next
     case (finish s s' u) 
     hence EQ[simp]: "tree_edges s' = tree_edges s"
                     "finished s' = (finished s)(hd (stack s) \<mapsto> counter s)"
                     "discovered s' = discovered s"
                     "stack s' = tl (stack s)"
       by simp_all
 
     from finish interpret DFS_invar where s=s by simp
     from finish have NE[simp]: "stack s \<noteq> []" by (simp add: cond_alt)
 
     show ?case
     proof (intro ballI impI)
       fix a b
       assume F: "a \<in> dom (discovered s')" "b \<in> dom (finished s')"
         and paren: "\<delta> s' a < \<delta> s' b \<and> (a \<notin> dom (finished s') \<or> \<phi> s' a > \<phi> s' b)"
       hence "a \<noteq> b" by auto
       
       show "(a,b) \<in> (tree_edges s')\<^sup>+"
       proof (cases "b = hd (stack s)")
         case True hence \<phi>b: "\<phi> s' b = counter s" by simp
         have "a \<in> set (stack s)"
           unfolding stack_set_def
         proof
           from F show "a \<in> dom (discovered s)" by simp
           from True \<open>a\<noteq>b\<close> \<phi>b paren have "a \<in> dom (finished s) \<longrightarrow> \<phi> s a > counter s" by simp
           with timing_less_counter show "a \<notin> dom (finished s)" by force
         qed 
         with paren True on_stack_is_tree_path have "(a,b) \<in> (tree_edges s)\<^sup>+" by auto
         thus ?thesis by (auto intro: trancl_mono_mp)
       next
         case False note b_not_hd = this
         show ?thesis
         proof (cases "a = hd (stack s)")
           case False with b_not_hd F paren finish show ?thesis by simp
         next
           case True with paren b_not_hd F have 
             "a \<in> dom (discovered s)" "b \<in> dom (finished s)"  "\<delta> s a < \<delta> s b"  
             by simp_all
           moreover from True stack_not_finished have "a \<notin> dom (finished s)" 
             by simp
           ultimately show ?thesis by (simp add: finish)
         qed
       qed
     qed  
   next
     case (new_root s s' v0) then interpret DFS_invar where s=s by simp
     from new_root finished_discovered have "v0 \<notin> dom (finished s)" by auto
     moreover note timing_less_counter finished_discovered
     ultimately show ?case using new_root by clarsimp force
   qed simp_all
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemmas s_paren_imp_tree_reach =
     paren_imp_tree_reach[THEN make_invar_thm]
   
   lemma parenthesis_impl_tree_path_not_finished:
     assumes "v \<in> dom (discovered s)"
     and "w \<in> dom (finished s)"
     and "\<delta> s v < \<delta> s w"
     and "v \<notin> dom (finished s)"
     shows "(v,w) \<in> (tree_edges s)\<^sup>+"
     using s_paren_imp_tree_reach assms
     by (auto simp add: paren_imp_tree_reach_def)
 
   lemma parenthesis_impl_tree_path:
     assumes "v \<in> dom (finished s)" "w \<in> dom (finished s)"
     and "\<delta> s v < \<delta> s w" "\<phi> s v > \<phi> s w"
     shows "(v,w) \<in> (tree_edges s)\<^sup>+"
   proof -
     from assms(1) have "v \<in> dom (discovered s)"
       using finished_discovered by blast
     with assms show ?thesis
       using s_paren_imp_tree_reach assms
       by (auto simp add: paren_imp_tree_reach_def)
   qed
 
   lemma tree_path_iff_parenthesis:
     assumes "v \<in> dom (finished s)" "w \<in> dom (finished s)"
     shows "(v,w) \<in> (tree_edges s)\<^sup>+ \<longleftrightarrow> \<delta> s v < \<delta> s w \<and> \<phi> s v > \<phi> s w"
     using assms
     by (metis parenthesis_impl_tree_path tree_path_impl_parenthesis) 
 
   lemma no_pending_succ_impl_path_in_tree:
     assumes v: "v \<in> dom (discovered s)" "pending s `` {v} = {}"
     and w: "w \<in> succ v"
     and \<delta>: "\<delta> s v < \<delta> s w"
     shows "(v,w) \<in> (tree_edges s)\<^sup>+"
   proof (cases "v \<in> dom (finished s)")
     case True 
     with assms assms have "\<delta> s w < \<phi> s v" "w \<in> dom (discovered s)"
       using finished_succ_fin finished_imp_succ_discovered 
       by simp_all
     with True \<delta> show ?thesis
       using parenthesis_contained parenthesis_impl_tree_path
       by blast
   next
     case False
     show ?thesis
     proof (cases "w \<in> dom (finished s)")
       case True with False v \<delta> show ?thesis by (simp add: parenthesis_impl_tree_path_not_finished)
     next
       case False with \<open>v \<notin> dom (finished s)\<close> no_pending_imp_succ_discovered v w have 
         "v \<in> set (stack s)" "w \<in> set (stack s)" 
         by (simp_all add: stack_set_def)
       with on_stack_is_tree_path \<delta> show ?thesis by simp
     qed
   qed
 
   lemma finished_succ_impl_path_in_tree:
     assumes f:  "v \<in> dom (finished s)"
     and s: "w \<in> succ v"
     and \<delta>: "\<delta> s v < \<delta> s w"
     shows "(v,w) \<in> (tree_edges s)\<^sup>+"
     using no_pending_succ_impl_path_in_tree finished_no_pending finished_discovered
     using assms
     by blast
 end end
 
 subsubsection \<open>Properties of Cross Edges\<close>
 (* Cross Edges *)
 context param_DFS begin context begin interpretation timing_syntax .
 
   lemma i_cross_edges_finished: "is_invar (\<lambda>s. \<forall>(u,v)\<in>cross_edges s. 
     v \<in> dom (finished s) \<and> (u \<in> dom (finished s) \<longrightarrow> \<phi> s v < \<phi> s u))"
   proof (induction rule: is_invarI_full)
     case (finish s s' u e)
     interpret DFS_invar G param s by fact
     from finish stack_not_finished have "u \<notin> dom (finished s)" by auto
     with finish show ?case by (auto intro: timing_less_counter)
   next
     case (cross_edge s s' u v e)
     interpret DFS_invar G param s by fact
     from cross_edge stack_not_finished have "u \<notin> dom (finished s)" by auto
     with cross_edge show ?case by (auto intro: timing_less_counter)
   qed simp_all
 
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
   lemmas cross_edges_finished 
     = i_cross_edges_finished[THEN make_invar_thm]
 
   lemma cross_edges_target_finished: 
     "(u,v)\<in>cross_edges s \<Longrightarrow> v \<in> dom (finished s)" 
     using cross_edges_finished by auto
 
   lemma cross_edges_finished_decr: 
     "\<lbrakk>(u,v)\<in>cross_edges s; u\<in>dom (finished s)\<rbrakk> \<Longrightarrow> \<phi> s v < \<phi> s u" 
     using cross_edges_finished by auto
 
   lemma cross_edge_unequal:
     assumes cross: "(v,w) \<in> cross_edges s"
     shows "v \<noteq> w"
   proof -
     from cross_edges_target_finished[OF cross] have 
       w_fin: "w \<in> dom (finished s)" .
 
     show ?thesis
     proof (cases "v \<in> dom (finished s)")
       case True with cross_edges_finished_decr[OF cross] 
       show ?thesis by force
     next
       case False with w_fin show ?thesis by force
     qed
   qed 
 end end
 
 
 subsubsection \<open>Properties of Back Edges\<close>
 (* Back Edges *)
 context param_DFS begin context begin interpretation timing_syntax .
   
   lemma i_back_edge_impl_tree_path:
     "is_invar (\<lambda>s. \<forall>(v,w) \<in> back_edges s. (w,v) \<in> (tree_edges s)\<^sup>+ \<or> w = v)"
   proof (induct rule: is_invarI_full)
     case (back_edge s s' u v) then interpret DFS_invar where s=s by simp
 
     from back_edge have st: "v \<in> set (stack s)" "u \<in> set (stack s)"
       using stack_set_def
       by auto
    
     have "(v,u) \<in> (tree_edges s)\<^sup>+ \<or> u = v"
     proof (rule disjCI)
       assume "u \<noteq> v"
       with st back_edge have "v \<in> set (tl (stack s))" by (metis not_hd_in_tl)
       with tl_lt_stack_hd_discover st back_edge have "\<delta> s v < \<delta> s u" by simp
       with on_stack_is_tree_path st show "(v,u) \<in> (tree_edges s)\<^sup>+" by simp
     qed
     with back_edge show ?case by auto
   next
     case discover thus ?case using trancl_sub_insert_trancl by force
   qed simp_all
 
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemma back_edge_impl_tree_path:
     "\<lbrakk>(v,w) \<in> back_edges s; v \<noteq> w\<rbrakk> \<Longrightarrow> (w,v) \<in> (tree_edges s)\<^sup>+"
     using i_back_edge_impl_tree_path[THEN make_invar_thm]
     by blast
 
   lemma back_edge_disc:
     assumes "(v,w) \<in> back_edges s"
     shows "\<delta> s w \<le> \<delta> s v"
   proof cases
     assume "v\<noteq>w" 
     with assms back_edge_impl_tree_path have "(w,v) \<in> (tree_edges s)\<^sup>+" by simp
     with tree_path_disc show ?thesis by force
   qed simp
 
   lemma back_edges_tree_disjoint:
     "back_edges s \<inter> tree_edges s = {}"
     using back_edge_disc tree_edge_disc
     by force
 
   lemma back_edges_tree_pathes_disjoint:
     "back_edges s \<inter> (tree_edges s)\<^sup>+ = {}"
     using back_edge_disc tree_path_disc
     by force
 
   lemma back_edge_finished:
     assumes "(v,w) \<in> back_edges s"
     and "w \<in> dom (finished s)"
     shows "v \<in> dom (finished s) \<and> \<phi> s v \<le> \<phi> s w"
   proof (cases "v=w")
     case True with assms show ?thesis by simp
   next
     case False with back_edge_impl_tree_path assms have "(w,v) \<in> (tree_edges s)\<^sup>+" by simp
     with tree_path_impl_parenthesis assms show ?thesis by fastforce
   qed
 
 end end
 
 context param_DFS begin context begin interpretation timing_syntax .
   (* The lemma should probably replaced by:
      is_invar (\<lambda>s. \<forall>(v,w) \<in> (tree_edges s)\<^sup>+. v \<in> succ w \<longrightarrow> (w,v) \<in> back_edges s \<or> (w,v) \<in> pending s)
   *)
   lemma i_disc_imp_back_edge_or_pending:
     "is_invar (\<lambda>s. \<forall>(v,w) \<in> E. 
         v \<in> dom (discovered s) \<and> w \<in> dom (discovered s)
       \<and> \<delta> s v \<ge> \<delta> s w
       \<and> (w \<in> dom (finished s) \<longrightarrow> v \<in> dom (finished s) \<and> \<phi> s w \<ge> \<phi> s v)
       \<longrightarrow> (v,w) \<in> back_edges s \<or> (v,w) \<in> pending s)"
   proof (induct rule: is_invarI_full)
     case (cross_edge s s' u v) then interpret DFS_invar where s=s by simp
     from cross_edge stack_not_finished[of u] have "u \<notin> dom (finished s)"
       using hd_in_set
       by (auto simp add: cond_alt)
     with cross_edge show ?case by auto
   next
     case (finish s s' u v) then interpret DFS_invar where s=s by simp
 
     from finish have 
       IH: "\<And>v w. \<lbrakk>w \<in> succ v; v \<in> dom (discovered s); w \<in> dom (discovered s); 
                   \<delta> s w \<le> \<delta> s v;
                   (w \<in> dom (finished s) \<Longrightarrow> v \<in> dom (finished s) \<and> \<phi> s v \<le> \<phi> s w)\<rbrakk>
                  \<Longrightarrow> (v, w) \<in> back_edges s \<or> (v, w) \<in> pending s" 
       by blast
 
     from finish have ne[simp]: "stack s \<noteq> []"
                  and p[simp]: "pending s `` {hd (stack s)} = {}"
       by (simp_all)
 
     from hd_in_set[OF ne] have disc: "hd (stack s) \<in> dom (discovered s)" 
                             and not_fin: "hd (stack s) \<notin> dom (finished s)"
       using stack_discovered stack_not_finished
       by blast+
 
     {
       fix w
       assume w: "w \<in> succ (hd (stack s))" "w \<noteq> hd (stack s)" "w \<in> dom (discovered s)"
         and f: "w \<in> dom (finished s) \<longrightarrow> counter s \<le> \<phi> s w"
         and \<delta>: "\<delta> s w \<le> \<delta> s (hd (stack s))"
 
       with timing_less_counter have "w \<notin> dom (finished s)" by force
       with finish w \<delta> disc have "(hd (stack s), w) \<in> back_edges s" by blast
     }
 
     moreover
     {
       fix w
       assume "hd (stack s) \<in> succ w" "w \<noteq> hd (stack s)"
       and "w \<in> dom (finished s)" "\<delta> s (hd (stack s)) \<le> \<delta> s w"
       with IH[of "hd (stack s)" w] disc not_fin have
         "(w, hd (stack s)) \<in> back_edges s"
         using finished_discovered finished_no_pending[of w]
         by blast
     }
 
     ultimately show ?case
       using finish
       by clarsimp auto
   next
     case (discover s s' u v) then interpret DFS_invar where s=s by simp
 
     from discover show ?case 
       using timing_less_counter
       by clarsimp fastforce
   next
     case (new_root s s' v0) then interpret DFS_invar where s=s by simp
 
     from new_root empty_stack_imp_empty_pending have "pending s = {}" by simp
     with new_root show ?case 
       using timing_less_counter
       by clarsimp fastforce
   qed auto
 end end
 
 context DFS_invar begin context begin interpretation timing_syntax .
 
   lemma disc_imp_back_edge_or_pending:
     "\<lbrakk>w \<in> succ v; v \<in> dom (discovered s); w \<in> dom (discovered s); \<delta> s w \<le> \<delta> s v;
       (w \<in> dom (finished s) \<Longrightarrow> v \<in> dom (finished s) \<and> \<phi> s v \<le> \<phi> s w)\<rbrakk>
      \<Longrightarrow> (v, w) \<in> back_edges s \<or> (v, w) \<in> pending s"
     using i_disc_imp_back_edge_or_pending[THEN make_invar_thm]
     by blast
 
   lemma finished_imp_back_edge:
     "\<lbrakk>w \<in> succ v; v \<in> dom (finished s); w \<in> dom (finished s); 
       \<delta> s w \<le> \<delta> s v; \<phi> s v \<le> \<phi> s w\<rbrakk>
      \<Longrightarrow> (v, w) \<in> back_edges s"
     using disc_imp_back_edge_or_pending finished_discovered finished_no_pending
     by fast
 
   lemma finished_not_finished_imp_back_edge:
     "\<lbrakk>w \<in> succ v; v \<in> dom (finished s); w \<in> dom (discovered s);
       w \<notin> dom (finished s);
       \<delta> s w \<le> \<delta> s v\<rbrakk>
      \<Longrightarrow> (v, w) \<in> back_edges s"
     using disc_imp_back_edge_or_pending finished_discovered finished_no_pending
     by fast
 
   lemma finished_self_loop_in_back_edges:
     assumes "v \<in> dom (finished s)"
     and "(v,v) \<in> E"
     shows "(v,v) \<in> back_edges s"
     using assms
     using finished_imp_back_edge
     by blast
 end end
 
 (* Back edges and Cycles *)
 
 context DFS_invar begin 
 
   context begin interpretation timing_syntax .
     (* Cross and tree_edges edges are always acyclic *)
     lemma tree_cross_acyclic:
       "acyclic (tree_edges s \<union> cross_edges s)" (is "acyclic ?E")
     proof (rule ccontr)
       {
         fix u v
         assume *: "u \<in> dom (finished s)" and "(u,v) \<in> ?E\<^sup>+"
         from this(2) have "\<phi> s v < \<phi> s u \<and> v \<in> dom (finished s)"
         proof induct
           case base thus ?case 
             by (metis Un_iff * cross_edges_finished_decr cross_edges_target_finished tree_edge_impl_parenthesis)
         next
           case (step v w)
           hence "\<phi> s w < \<phi> s v \<and> w \<in> dom (finished s)"
             by (metis Un_iff cross_edges_finished_decr cross_edges_target_finished tree_edge_impl_parenthesis)
           with step show ?case by auto
         qed
       } note aux = this
 
       assume "\<not> acyclic ?E"
       then obtain u where path: "(u,u) \<in> ?E\<^sup>+" by (auto simp add: acyclic_def)
       show False
       proof cases
         assume "u \<in> dom (finished s)" 
         with aux path show False by blast
       next
         assume *: "u \<notin> dom (finished s)"
         moreover 
         from no_loop_in_tree have "(u,u) \<notin> (tree_edges s)\<^sup>+" .
         with trancl_union_outside[OF path] obtain x y where "(u,x) \<in> ?E\<^sup>*" "(x,y) \<in> cross_edges s" "(y,u) \<in> ?E\<^sup>*" by auto
         with cross_edges_target_finished have "y \<in> dom (finished s)" by simp
         moreover with * \<open>(y,u) \<in> ?E\<^sup>*\<close> have "(y,u) \<in> ?E\<^sup>+" by (auto simp add: rtrancl_eq_or_trancl)
         ultimately show False by (metis aux)
       qed
     qed
   end
 
   lemma cycle_contains_back_edge:
     assumes cycle: "(u,u) \<in> (edges s)\<^sup>+"
     shows "\<exists>v w. (u,v) \<in> (edges s)\<^sup>* \<and> (v,w) \<in> back_edges s \<and> (w,u) \<in> (edges s)\<^sup>*"
   proof -
     from tree_cross_acyclic have "(u,u) \<notin> (tree_edges s \<union> cross_edges s)\<^sup>+" by (simp add: acyclic_def)
     with trancl_union_outside[OF cycle] show ?thesis .
   qed
 
   lemma cycle_needs_back_edge:
     assumes "back_edges s = {}"
     shows "acyclic (edges s)"
   proof (rule ccontr)
     assume "\<not> acyclic (edges s)"
     then obtain u where "(u,u) \<in> (edges s)\<^sup>+" by (auto simp: acyclic_def)
     with assms have "(u,u) \<in> (tree_edges s \<union> cross_edges s)\<^sup>+" by auto
     with tree_cross_acyclic show False by (simp add: acyclic_def)
   qed
 
   lemma back_edge_closes_cycle:
     assumes "back_edges s \<noteq> {}"
     shows "\<not> acyclic (edges s)"
   proof -
     from assms obtain v w where be: "(v,w) \<in> back_edges s" by auto
     hence "(w,w) \<in> (edges s)\<^sup>+"
     proof (cases "v=w")
       case False 
       with be back_edge_impl_tree_path have "(w,v) \<in> (tree_edges s)\<^sup>+" by simp
       hence "(w,v) \<in> (edges s)\<^sup>+" by (blast intro: trancl_mono_mp)
       also from be have "(v,w) \<in> edges s" by simp
       finally show ?thesis .
     qed auto
     thus ?thesis by (auto simp add: acyclic_def)
   qed
 
   lemma back_edge_closes_reachable_cycle:
     "back_edges s \<noteq> {} \<Longrightarrow> \<not> acyclic (E \<inter> reachable \<times> UNIV)"
     by (metis back_edge_closes_cycle edges_ss_reachable_edges cyclic_subset)
 
   lemma cycle_iff_back_edges:
     "acyclic (edges s) \<longleftrightarrow> back_edges s = {}"
   by (metis back_edge_closes_cycle cycle_needs_back_edge)
 end 
 
 
 subsection \<open>White Path Theorem\<close>
 
 context DFS begin
 context begin interpretation timing_syntax .
 
   definition white_path where
     "white_path s x y \<equiv> x\<noteq>y 
        \<longrightarrow> (\<exists>p. path E x p y \<and> 
                (\<delta> s x < \<delta> s y \<and> (\<forall> v \<in> set (tl p). \<delta> s x < \<delta> s v)))"
 
   lemma white_path:
     "it_dfs \<le> SPEC(\<lambda>s. \<forall>x \<in> reachable. \<forall>y \<in> reachable. \<not> is_break param s \<longrightarrow> 
             white_path s x y \<longleftrightarrow> (x,y) \<in> (tree_edges s)\<^sup>*)"
   proof (rule it_dfs_SPEC, intro ballI impI)
     fix s x y
     assume DI: "DFS_invar G param s"
       and C: "\<not> cond s" "\<not> is_break param s"
       and reach: "x \<in> reachable" "y \<in> reachable"
 
     from DI interpret DFS_invar where s=s .
 
     note fin_eq_reach = nc_finished_eq_reachable[OF C]
 
     show "white_path s x y \<longleftrightarrow> (x,y) \<in> (tree_edges s)\<^sup>*"
     proof (cases "x=y")
       case True thus ?thesis by (simp add: white_path_def)
     next
       case False
       
       show ?thesis
       proof
         assume "(x,y) \<in> (tree_edges s)\<^sup>*"
         with \<open>x\<noteq>y\<close> have T: "(x,y) \<in> (tree_edges s)\<^sup>+" by (metis rtranclD)
         then obtain p where P: "path (tree_edges s) x p y" by (metis trancl_is_path)
         with tree_edges_ssE have "path E x p y" using path_mono[where E="tree_edges s"] 
           by simp
         moreover 
         from P have "\<delta> s x < \<delta> s y \<and> (\<forall> v \<in> set (tl p). \<delta> s x < \<delta> s v)"
           using \<open>x\<noteq>y\<close>
         proof (induct rule: path_tl_induct)
           case (single u) thus ?case by (fact tree_edge_disc)
         next
           case (step u v) note \<open>\<delta> s x < \<delta> s u\<close>
           also from step have "\<delta> s u < \<delta> s v" by (metis tree_edge_disc)
           finally show ?case .
         qed
         ultimately show "white_path s x y"
           by (auto simp add: \<open>x\<noteq>y\<close> white_path_def)
       next
         assume "white_path s x y"
         with \<open>x\<noteq>y\<close> obtain p where 
             P:"path E x p y" and
             white: "\<delta> s x < \<delta> s y \<and> (\<forall> v \<in> set (tl p). \<delta> s x < \<delta> s v)"
           unfolding white_path_def
           by blast
         hence "p \<noteq> []" by auto
         thus "(x,y) \<in> (tree_edges s)\<^sup>*" using P white reach(2)
         proof (induction p arbitrary: y rule: rev_nonempty_induct)
           case single hence "y \<in> succ x" by (simp add: path_cons_conv)
           with reach single show ?case 
             using fin_eq_reach finished_succ_impl_path_in_tree[of x y] 
             by simp
         next
           case (snoc u us) hence "path E x us u" by (simp add: path_append_conv)
           moreover hence "(x,u) \<in> E\<^sup>*" by (simp add: path_is_rtrancl)
           with reach have ureach: "u \<in> reachable" 
             by (metis rtrancl_image_advance_rtrancl) 
           moreover from snoc have "\<delta> s x < \<delta> s u" "(\<forall>v\<in>set (tl us). \<delta> s x < \<delta> s v)" 
             by simp_all
           ultimately have x_u: "(x,u) \<in> (tree_edges s)\<^sup>*" by (metis snoc.IH)
             
           from snoc have "y \<in> succ u" by (simp add: path_append_conv)
           from snoc(5) fin_eq_reach finished_discovered have 
             y_f_d: "y \<in> dom (finished s)" "y \<in> dom (discovered s)"
             by auto
             
           from \<open>y \<in> succ u\<close> ureach fin_eq_reach have "\<delta> s y < \<phi> s u" 
             using finished_succ_fin by simp
           also from \<open>\<delta> s x < \<delta> s u\<close> have "x \<noteq> u" by auto
           with x_u have "(x,u) \<in> (tree_edges s)\<^sup>+" by (metis rtrancl_eq_or_trancl)
           with fin_eq_reach reach have "\<phi> s u < \<phi> s x" 
             using tree_path_impl_parenthesis
             by simp
           finally have "\<phi> s y < \<phi> s x" 
             using reach fin_eq_reach y_f_d snoc
             using parenthesis_contained
             by blast
           hence "(x,y) \<in> (tree_edges s)\<^sup>+"
             using reach fin_eq_reach y_f_d snoc
             using parenthesis_impl_tree_path
             by blast
           thus ?case by auto
         qed
       qed
     qed
   qed
 end end
 
 
 end
diff --git a/thys/Eval_FO/Ailamazyan.thy b/thys/Eval_FO/Ailamazyan.thy
--- a/thys/Eval_FO/Ailamazyan.thy
+++ b/thys/Eval_FO/Ailamazyan.thy
@@ -1,5597 +1,5597 @@
 theory Ailamazyan
   imports Eval_FO Cluster Mapping_Code
 begin
 
 fun SP :: "('a, 'b) fo_fmla \<Rightarrow> nat set" where
   "SP (Eqa (Var n) (Var n')) = (if n \<noteq> n' then {n, n'} else {})"
 | "SP (Neg \<phi>) = SP \<phi>"
 | "SP (Conj \<phi> \<psi>) = SP \<phi> \<union> SP \<psi>"
 | "SP (Disj \<phi> \<psi>) = SP \<phi> \<union> SP \<psi>"
 | "SP (Exists n \<phi>) = SP \<phi> - {n}"
 | "SP (Forall n \<phi>) = SP \<phi> - {n}"
 | "SP _ = {}"
 
 lemma SP_fv: "SP \<phi> \<subseteq> fv_fo_fmla \<phi>"
   by (induction \<phi> rule: SP.induct) auto
 
 lemma finite_SP: "finite (SP \<phi>)"
   using SP_fv finite_fv_fo_fmla finite_subset by fastforce
 
 fun SP_list_rec :: "('a, 'b) fo_fmla \<Rightarrow> nat list" where
   "SP_list_rec (Eqa (Var n) (Var n')) = (if n \<noteq> n' then [n, n'] else [])"
 | "SP_list_rec (Neg \<phi>) = SP_list_rec \<phi>"
 | "SP_list_rec (Conj \<phi> \<psi>) = SP_list_rec \<phi> @ SP_list_rec \<psi>"
 | "SP_list_rec (Disj \<phi> \<psi>) = SP_list_rec \<phi> @ SP_list_rec \<psi>"
 | "SP_list_rec (Exists n \<phi>) = filter (\<lambda>m. n \<noteq> m) (SP_list_rec \<phi>)"
 | "SP_list_rec (Forall n \<phi>) = filter (\<lambda>m. n \<noteq> m) (SP_list_rec \<phi>)"
 | "SP_list_rec _ = []"
 
 definition SP_list :: "('a, 'b) fo_fmla \<Rightarrow> nat list" where
   "SP_list \<phi> = remdups_adj (sort (SP_list_rec \<phi>))"
 
 lemma SP_list_set: "set (SP_list \<phi>) = SP \<phi>"
   unfolding SP_list_def
   by (induction \<phi> rule: SP.induct) (auto simp: fv_fo_terms_set_list)
 
 lemma sorted_distinct_SP_list: "sorted_distinct (SP_list \<phi>)"
   unfolding SP_list_def
   by (auto intro: distinct_remdups_adj_sort)
 
 fun d :: "('a, 'b) fo_fmla \<Rightarrow> nat" where
   "d (Eqa (Var n) (Var n')) = (if n \<noteq> n' then 2 else 1)"
 | "d (Neg \<phi>) = d \<phi>"
 | "d (Conj \<phi> \<psi>) = max (d \<phi>) (max (d \<psi>) (card (SP (Conj \<phi> \<psi>))))"
 | "d (Disj \<phi> \<psi>) = max (d \<phi>) (max (d \<psi>) (card (SP (Disj \<phi> \<psi>))))"
 | "d (Exists n \<phi>) = d \<phi>"
 | "d (Forall n \<phi>) = d \<phi>"
 | "d _ = 1"
 
 lemma d_pos: "1 \<le> d \<phi>"
   by (induction \<phi> rule: d.induct) auto
 
 lemma card_SP_d: "card (SP \<phi>) \<le> d \<phi>"
   using dual_order.trans
   by (induction \<phi> rule: SP.induct) (fastforce simp: card_Diff1_le finite_SP)+
 
 fun eval_eterm :: "('a + 'c) val \<Rightarrow> 'a fo_term \<Rightarrow> 'a + 'c" (infix "\<cdot>e" 60) where
   "eval_eterm \<sigma> (Const c) = Inl c"
 | "eval_eterm \<sigma> (Var n) = \<sigma> n"
 
 definition eval_eterms :: "('a + 'c) val \<Rightarrow> ('a fo_term) list \<Rightarrow>
   ('a + 'c) list" (infix "\<odot>e" 60) where
   "eval_eterms \<sigma> ts = map (eval_eterm \<sigma>) ts"
 
 lemma eval_eterm_cong: "(\<And>n. n \<in> fv_fo_term_set t \<Longrightarrow> \<sigma> n = \<sigma>' n) \<Longrightarrow>
   eval_eterm \<sigma> t = eval_eterm \<sigma>' t"
   by (cases t) auto
 
 lemma eval_eterms_fv_fo_terms_set: "\<sigma> \<odot>e ts = \<sigma>' \<odot>e ts \<Longrightarrow> n \<in> fv_fo_terms_set ts \<Longrightarrow> \<sigma> n = \<sigma>' n"
 proof (induction ts)
   case (Cons t ts)
   then show ?case
     by (cases t) (auto simp: eval_eterms_def fv_fo_terms_set_def)
 qed (auto simp: eval_eterms_def fv_fo_terms_set_def)
 
 lemma eval_eterms_cong: "(\<And>n. n \<in> fv_fo_terms_set ts \<Longrightarrow> \<sigma> n = \<sigma>' n) \<Longrightarrow>
   eval_eterms \<sigma> ts = eval_eterms \<sigma>' ts"
   by (auto simp: eval_eterms_def fv_fo_terms_set_def intro: eval_eterm_cong)
 
 lemma eval_terms_eterms: "map Inl (\<sigma> \<odot> ts) = (Inl \<circ> \<sigma>) \<odot>e ts"
 proof (induction ts)
   case (Cons t ts)
   then show ?case
     by (cases t) (auto simp: eval_terms_def eval_eterms_def)
 qed (auto simp: eval_terms_def eval_eterms_def)
 
 fun ad_equiv_pair :: "'a set \<Rightarrow> ('a + 'c) \<times> ('a + 'c) \<Rightarrow> bool" where
   "ad_equiv_pair X (a, a') \<longleftrightarrow> (a \<in> Inl ` X \<longrightarrow> a = a') \<and> (a' \<in> Inl ` X \<longrightarrow> a = a')"
 
 fun sp_equiv_pair :: "'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> bool" where
   "sp_equiv_pair (a, b) (a', b') \<longleftrightarrow> (a = a' \<longleftrightarrow> b = b')"
 
 definition ad_equiv_list :: "'a set \<Rightarrow> ('a + 'c) list \<Rightarrow> ('a + 'c) list \<Rightarrow> bool" where
   "ad_equiv_list X xs ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>x \<in> set (zip xs ys). ad_equiv_pair X x)"
 
 definition sp_equiv_list :: "('a + 'c) list \<Rightarrow> ('a + 'c) list \<Rightarrow> bool" where
   "sp_equiv_list xs ys \<longleftrightarrow> length xs = length ys \<and> pairwise sp_equiv_pair (set (zip xs ys))"
 
 definition ad_agr_list :: "'a set \<Rightarrow> ('a + 'c) list \<Rightarrow> ('a + 'c) list \<Rightarrow> bool" where
   "ad_agr_list X xs ys \<longleftrightarrow> length xs = length ys \<and> ad_equiv_list X xs ys \<and> sp_equiv_list xs ys"
 
 lemma ad_equiv_pair_refl[simp]: "ad_equiv_pair X (a, a)"
   by auto
 
 declare ad_equiv_pair.simps[simp del]
 
 lemma ad_equiv_pair_comm: "ad_equiv_pair X (a, a') \<longleftrightarrow> ad_equiv_pair X (a', a)"
   by (auto simp: ad_equiv_pair.simps)
 
 lemma ad_equiv_pair_mono: "X \<subseteq> Y \<Longrightarrow> ad_equiv_pair Y (a, a') \<Longrightarrow> ad_equiv_pair X (a, a')"
   unfolding ad_equiv_pair.simps
   by fastforce
 
 lemma sp_equiv_pair_comm: "sp_equiv_pair x y \<longleftrightarrow> sp_equiv_pair y x"
   by (cases x; cases y) auto
 
 definition sp_equiv :: "('a + 'c) val \<Rightarrow> ('a + 'c) val \<Rightarrow> nat set \<Rightarrow> bool" where
   "sp_equiv \<sigma> \<tau> I \<longleftrightarrow> pairwise sp_equiv_pair ((\<lambda>n. (\<sigma> n, \<tau> n)) ` I)"
 
 lemma sp_equiv_mono: "I \<subseteq> J \<Longrightarrow> sp_equiv \<sigma> \<tau> J \<Longrightarrow> sp_equiv \<sigma> \<tau> I"
   by (auto simp: sp_equiv_def pairwise_def)
 
 definition ad_agr_sets :: "nat set \<Rightarrow> nat set \<Rightarrow> 'a set \<Rightarrow> ('a + 'c) val \<Rightarrow>
   ('a + 'c) val \<Rightarrow> bool" where
   "ad_agr_sets FV S X \<sigma> \<tau> \<longleftrightarrow> (\<forall>i \<in> FV. ad_equiv_pair X (\<sigma> i, \<tau> i)) \<and> sp_equiv \<sigma> \<tau> S"
 
 lemma ad_agr_sets_comm: "ad_agr_sets FV S X \<sigma> \<tau> \<Longrightarrow> ad_agr_sets FV S X \<tau> \<sigma>"
   unfolding ad_agr_sets_def sp_equiv_def pairwise_def
   by (subst ad_equiv_pair_comm) auto
 
 lemma ad_agr_sets_mono: "X \<subseteq> Y \<Longrightarrow> ad_agr_sets FV S Y \<sigma> \<tau> \<Longrightarrow> ad_agr_sets FV S X \<sigma> \<tau>"
   using ad_equiv_pair_mono
   by (fastforce simp: ad_agr_sets_def)
 
 lemma ad_agr_sets_mono': "S \<subseteq> S' \<Longrightarrow> ad_agr_sets FV S' X \<sigma> \<tau> \<Longrightarrow> ad_agr_sets FV S X \<sigma> \<tau>"
   by (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def)
 
 lemma ad_equiv_list_comm: "ad_equiv_list X xs ys \<Longrightarrow> ad_equiv_list X ys xs"
   by (auto simp: ad_equiv_list_def) (smt (verit, del_insts) ad_equiv_pair_comm in_set_zip prod.sel(1) prod.sel(2))
 
 lemma ad_equiv_list_mono: "X \<subseteq> Y \<Longrightarrow> ad_equiv_list Y xs ys \<Longrightarrow> ad_equiv_list X xs ys"
   using ad_equiv_pair_mono
   by (fastforce simp: ad_equiv_list_def)
 
 lemma ad_equiv_list_trans:
   assumes "ad_equiv_list X xs ys" "ad_equiv_list X ys zs"
   shows "ad_equiv_list X xs zs"
 proof -
   have lens: "length xs = length ys" "length xs = length zs" "length ys = length zs"
     using assms
     by (auto simp: ad_equiv_list_def)
   have "\<And>x z. (x, z) \<in> set (zip xs zs) \<Longrightarrow> ad_equiv_pair X (x, z)"
   proof -
     fix x z
     assume "(x, z) \<in> set (zip xs zs)"
     then obtain i where i_def: "i < length xs" "xs ! i = x" "zs ! i = z"
       by (auto simp: set_zip)
     define y where "y = ys ! i"
     have "ad_equiv_pair X (x, y)" "ad_equiv_pair X (y, z)"
       using assms lens i_def
       by (fastforce simp: set_zip y_def ad_equiv_list_def)+
     then show "ad_equiv_pair X (x, z)"
       unfolding ad_equiv_pair.simps
       by blast
   qed
   then show ?thesis
     using assms
     by (auto simp: ad_equiv_list_def)
 qed
 
 lemma ad_equiv_list_link: "(\<forall>i \<in> set ns. ad_equiv_pair X (\<sigma> i, \<tau> i)) \<longleftrightarrow>
   ad_equiv_list X (map \<sigma> ns) (map \<tau> ns)"
   by (auto simp: ad_equiv_list_def set_zip) (metis in_set_conv_nth nth_map)
 
 lemma set_zip_comm: "(x, y) \<in> set (zip xs ys) \<Longrightarrow> (y, x) \<in> set (zip ys xs)"
   by (metis in_set_zip prod.sel(1) prod.sel(2))
 
 lemma set_zip_map: "set (zip (map \<sigma> ns) (map \<tau> ns)) = (\<lambda>n. (\<sigma> n, \<tau> n)) ` set ns"
   by (induction ns) auto
 
 lemma sp_equiv_list_comm: "sp_equiv_list xs ys \<Longrightarrow> sp_equiv_list ys xs"
   unfolding sp_equiv_list_def
   using set_zip_comm
   by (auto simp: pairwise_def) force+
 
 lemma sp_equiv_list_trans:
   assumes "sp_equiv_list xs ys" "sp_equiv_list ys zs"
   shows "sp_equiv_list xs zs"
 proof -
   have lens: "length xs = length ys" "length xs = length zs" "length ys = length zs"
     using assms
     by (auto simp: sp_equiv_list_def)
   have "pairwise sp_equiv_pair (set (zip xs zs))"
   proof (rule pairwiseI)
     fix xz xz'
     assume "xz \<in> set (zip xs zs)" "xz' \<in> set (zip xs zs)"
     then obtain x z i x' z' i' where xz_def: "i < length xs" "xs ! i = x" "zs ! i = z"
       "xz = (x, z)" "i' < length xs" "xs ! i' = x'" "zs ! i' = z'" "xz' = (x', z')"
       by (auto simp: set_zip)
     define y where "y = ys ! i"
     define y' where "y' = ys ! i'"
     have "sp_equiv_pair (x, y) (x', y')" "sp_equiv_pair (y, z) (y', z')"
       using assms lens xz_def
       by (auto simp: sp_equiv_list_def pairwise_def y_def y'_def set_zip) metis+
     then show "sp_equiv_pair xz xz'"
       by (auto simp: xz_def)
   qed
   then show ?thesis
     using assms
     by (auto simp: sp_equiv_list_def)
 qed
 
 lemma sp_equiv_list_link: "sp_equiv_list (map \<sigma> ns) (map \<tau> ns) \<longleftrightarrow> sp_equiv \<sigma> \<tau> (set ns)"
   apply (auto simp: sp_equiv_list_def sp_equiv_def pairwise_def set_zip in_set_conv_nth)
      apply (metis nth_map)
     apply (metis nth_map)
    apply fastforce+
   done
 
 lemma ad_agr_list_comm: "ad_agr_list X xs ys \<Longrightarrow> ad_agr_list X ys xs"
   using ad_equiv_list_comm sp_equiv_list_comm
   by (fastforce simp: ad_agr_list_def)
 
 lemma ad_agr_list_mono: "X \<subseteq> Y \<Longrightarrow> ad_agr_list Y ys xs \<Longrightarrow> ad_agr_list X ys xs"
   using ad_equiv_list_mono
   by (force simp: ad_agr_list_def)
 
 lemma ad_agr_list_rev_mono:
   assumes "Y \<subseteq> X" "ad_agr_list Y ys xs" "Inl -` set xs \<subseteq> Y" "Inl -` set ys \<subseteq> Y"
   shows "ad_agr_list X ys xs"
 proof -
   have "(a, b) \<in> set (zip ys xs) \<Longrightarrow> ad_equiv_pair Y (a, b) \<Longrightarrow> ad_equiv_pair X (a, b)" for a b
     using assms
     apply (cases a; cases b)
        apply (auto simp: ad_agr_list_def ad_equiv_list_def vimage_def set_zip)
     unfolding ad_equiv_pair.simps
        apply (metis Collect_mem_eq Collect_mono_iff imageI nth_mem)
       apply (metis Collect_mem_eq Collect_mono_iff imageI nth_mem)
      apply (metis Collect_mem_eq Collect_mono_iff imageI nth_mem)
     apply (metis Inl_Inr_False image_iff)
     done
   then show ?thesis
     using assms
     by (fastforce simp: ad_agr_list_def ad_equiv_list_def)
 qed
 
 lemma ad_agr_list_trans: "ad_agr_list X xs ys \<Longrightarrow> ad_agr_list X ys zs \<Longrightarrow> ad_agr_list X xs zs"
   using ad_equiv_list_trans sp_equiv_list_trans
   by (force simp: ad_agr_list_def)
 
 lemma ad_agr_list_refl: "ad_agr_list X xs xs"
   by (auto simp: ad_agr_list_def ad_equiv_list_def set_zip ad_equiv_pair.simps
       sp_equiv_list_def pairwise_def)
 
 lemma ad_agr_list_set: "ad_agr_list X xs ys \<Longrightarrow> y \<in> X \<Longrightarrow> Inl y \<in> set ys \<Longrightarrow> Inl y \<in> set xs"
   by (auto simp: ad_agr_list_def ad_equiv_list_def set_zip in_set_conv_nth)
      (metis ad_equiv_pair.simps image_eqI)
 
 lemma ad_agr_list_length: "ad_agr_list X xs ys \<Longrightarrow> length xs = length ys"
   by (auto simp: ad_agr_list_def)
 
 lemma ad_agr_list_eq: "set ys \<subseteq> AD \<Longrightarrow> ad_agr_list AD (map Inl xs) (map Inl ys) \<Longrightarrow> xs = ys"
   by (fastforce simp: ad_agr_list_def ad_equiv_list_def set_zip ad_equiv_pair.simps
       intro!: nth_equalityI)
 
 lemma sp_equiv_list_subset:
   assumes "set ms \<subseteq> set ns" "sp_equiv_list (map \<sigma> ns) (map \<sigma>' ns)"
   shows "sp_equiv_list (map \<sigma> ms) (map \<sigma>' ms)"
   unfolding sp_equiv_list_def length_map pairwise_def
 proof (rule conjI, rule refl, (rule ballI)+, rule impI)
   fix x y
   assume "x \<in> set (zip (map \<sigma> ms) (map \<sigma>' ms))" "y \<in> set (zip (map \<sigma> ms) (map \<sigma>' ms))" "x \<noteq> y"
   then have "x \<in> set (zip (map \<sigma> ns) (map \<sigma>' ns))" "y \<in> set (zip (map \<sigma> ns) (map \<sigma>' ns))" "x \<noteq> y"
     using assms(1)
     by (auto simp: set_zip) (metis in_set_conv_nth nth_map subset_iff)+
   then show "sp_equiv_pair x y"
     using assms(2)
     by (auto simp: sp_equiv_list_def pairwise_def)
 qed
 
 lemma ad_agr_list_subset: "set ms \<subseteq> set ns \<Longrightarrow> ad_agr_list X (map \<sigma> ns) (map \<sigma>' ns) \<Longrightarrow>
   ad_agr_list X (map \<sigma> ms) (map \<sigma>' ms)"
   by (auto simp: ad_agr_list_def ad_equiv_list_def sp_equiv_list_subset set_zip)
      (metis (no_types, lifting) in_set_conv_nth nth_map subset_iff)
 
 lemma ad_agr_list_link: "ad_agr_sets (set ns) (set ns) AD \<sigma> \<tau> \<longleftrightarrow>
   ad_agr_list AD (map \<sigma> ns) (map \<tau> ns)"
   unfolding ad_agr_sets_def ad_agr_list_def
   using ad_equiv_list_link sp_equiv_list_link
   by fastforce
 
 definition ad_agr :: "('a, 'b) fo_fmla \<Rightarrow> 'a set \<Rightarrow> ('a + 'c) val \<Rightarrow> ('a + 'c) val \<Rightarrow> bool" where
   "ad_agr \<phi> X \<sigma> \<tau> \<longleftrightarrow> ad_agr_sets (fv_fo_fmla \<phi>) (SP \<phi>) X \<sigma> \<tau>"
 
 lemma ad_agr_sets_restrict:
   "ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD \<sigma> \<tau> \<Longrightarrow> ad_agr \<phi> AD \<sigma> \<tau>"
   using sp_equiv_mono SP_fv
   unfolding fv_fo_fmla_list_set
   by (auto simp: ad_agr_sets_def ad_agr_def) blast
 
 lemma finite_Inl: "finite X \<Longrightarrow> finite (Inl -` X)"
   using finite_vimageI[of X Inl]
   by (auto simp: vimage_def)
 
 lemma ex_out:
   assumes "finite X"
   shows "\<exists>k. k \<notin> X \<and> k < Suc (card X)"
   using card_mono[OF assms, of "{..<Suc (card X)}"]
   by auto
 
 lemma extend_\<tau>:
   assumes "ad_agr_sets (FV - {n}) (S - {n}) X \<sigma> \<tau>" "S \<subseteq> FV" "finite S" "\<tau> ` (FV - {n}) \<subseteq> Z"
     "Inl ` X \<union> Inr ` {..<max 1 (card (Inr -` \<tau> ` (S - {n})) + (if n \<in> S then 1 else 0))} \<subseteq> Z"
   shows "\<exists>k \<in> Z. ad_agr_sets FV S X (\<sigma>(n := x)) (\<tau>(n := k))"
 proof (cases "n \<in> S")
   case True
   note n_in_S = True
   show ?thesis
   proof (cases "x \<in> Inl ` X")
     case True
     show ?thesis
       using assms n_in_S True
       apply (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def intro!: bexI[of _ "x"])
       unfolding ad_equiv_pair.simps
          apply (metis True insert_Diff insert_iff subsetD)+
       done
   next
     case False
     note \<sigma>_n_not_Inl = False
     show ?thesis
     proof (cases "\<exists>m \<in> S - {n}. x = \<sigma> m")
       case True
       obtain m where m_def: "m \<in> S - {n}" "x = \<sigma> m"
         using True
         by auto
       have \<tau>_m_in: "\<tau> m \<in> Z"
         using assms m_def
         by auto
       show ?thesis
         using assms n_in_S \<sigma>_n_not_Inl True m_def
         by (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def intro!: bexI[of _ "\<tau> m"])
     next
       case False
       have out: "x \<notin> \<sigma> ` (S - {n})"
         using False
         by auto
       have fin: "finite (Inr -` \<tau> ` (S - {n}))"
         using assms(3)
         by (simp add: finite_vimageI)
       obtain k where k_def: "Inr k \<notin> \<tau> ` (S - {n})" "k < Suc (card (Inr -` \<tau> ` (S - {n})))"
         using ex_out[OF fin] True
         by auto
       show ?thesis
         using assms n_in_S \<sigma>_n_not_Inl out k_def assms(5)
         apply (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def intro!: bexI[of _ "Inr k"])
         unfolding ad_equiv_pair.simps
          apply fastforce
         apply (metis image_eqI insertE insert_Diff)
         done
     qed
   qed
 next
   case False
   show ?thesis
   proof (cases "x \<in> Inl ` X")
     case x_in: True
     then show ?thesis
       using assms False
       by (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def intro!: bexI[of _ "x"])
   next
     case x_out: False
     then show ?thesis
       using assms False
       apply (auto simp: ad_agr_sets_def sp_equiv_def pairwise_def intro!: bexI[of _ "Inr 0"])
       unfolding ad_equiv_pair.simps
       apply fastforce
       done
   qed
 qed
 
 lemma esat_Pred:
   assumes "ad_agr_sets FV S (\<Union>(set ` X)) \<sigma> \<tau>" "fv_fo_terms_set ts \<subseteq> FV" "\<sigma> \<odot>e ts \<in> map Inl ` X"
     "t \<in> set ts"
   shows "\<sigma> \<cdot>e t = \<tau> \<cdot>e t"
 proof (cases t)
   case (Var n)
   obtain vs where vs_def: "\<sigma> \<odot>e ts = map Inl vs" "vs \<in> X"
     using assms(3)
     by auto
   have "\<sigma> n \<in> set (\<sigma> \<odot>e ts)"
     using assms(4)
     by (force simp: eval_eterms_def Var)
   then have "\<sigma> n \<in> Inl ` \<Union> (set ` X)"
     using vs_def(2)
     unfolding vs_def(1)
     by auto
   moreover have "n \<in> FV"
     using assms(2,4)
     by (fastforce simp: Var fv_fo_terms_set_def)
   ultimately show ?thesis
     using assms(1)
     unfolding ad_equiv_pair.simps ad_agr_sets_def Var
     by fastforce
 qed auto
 
 lemma sp_equiv_list_fv:
   assumes "(\<And>i. i \<in> fv_fo_terms_set ts \<Longrightarrow> ad_equiv_pair X (\<sigma> i, \<tau> i))"
     "\<Union>(set_fo_term ` set ts) \<subseteq> X" "sp_equiv \<sigma> \<tau> (fv_fo_terms_set ts)"
   shows "sp_equiv_list (map ((\<cdot>e) \<sigma>) ts) (map ((\<cdot>e) \<tau>) ts)"
   using assms
 proof (induction ts)
   case (Cons t ts)
   have ind: "sp_equiv_list (map ((\<cdot>e) \<sigma>) ts) (map ((\<cdot>e) \<tau>) ts)"
     using Cons
     by (auto simp: fv_fo_terms_set_def sp_equiv_def pairwise_def)
   show ?case
   proof (cases t)
     case (Const c)
     have c_X: "c \<in> X"
       using Cons(3)
       by (auto simp: Const)
     have fv_t: "fv_fo_term_set t = {}"
       by (auto simp: Const)
     have "t' \<in> set ts \<Longrightarrow> sp_equiv_pair (\<sigma> \<cdot>e t, \<tau> \<cdot>e t) (\<sigma> \<cdot>e t', \<tau> \<cdot>e t')" for t'
       using c_X Const Cons(2)
       apply (cases t')
        apply (auto simp: fv_fo_terms_set_def)
       unfolding ad_equiv_pair.simps
       by (metis Cons(2) ad_equiv_pair.simps fv_fo_terms_setI image_insert insert_iff list.set(2)
           mk_disjoint_insert)+
     then show "sp_equiv_list (map ((\<cdot>e) \<sigma>) (t # ts)) (map ((\<cdot>e) \<tau>) (t # ts))"
       using ind pairwise_insert[of sp_equiv_pair "(\<sigma> \<cdot>e t, \<tau> \<cdot>e t)"]
       unfolding sp_equiv_list_def set_zip_map
       by (auto simp: sp_equiv_pair_comm fv_fo_terms_set_def fv_t)
   next
     case (Var n)
     have ad_n: "ad_equiv_pair X (\<sigma> n, \<tau> n)"
       using Cons(2)
       by (auto simp: fv_fo_terms_set_def Var)
     have sp_equiv_Var: "\<And>n'. Var n' \<in> set ts \<Longrightarrow> sp_equiv_pair (\<sigma> n, \<tau> n) (\<sigma> n', \<tau> n')"
       using Cons(4)
       by (auto simp: sp_equiv_def pairwise_def fv_fo_terms_set_def Var)
     have "t' \<in> set ts \<Longrightarrow> sp_equiv_pair (\<sigma> \<cdot>e t, \<tau> \<cdot>e t) (\<sigma> \<cdot>e t', \<tau> \<cdot>e t')" for t'
       using Cons(2,3) sp_equiv_Var  
       apply (cases t')
        apply (auto simp: Var)
        apply (metis SUP_le_iff ad_equiv_pair.simps ad_n fo_term.set_intros imageI subset_eq)
       apply (metis SUP_le_iff ad_equiv_pair.simps ad_n fo_term.set_intros imageI subset_eq)
       done
     then show ?thesis
       using ind pairwise_insert[of sp_equiv_pair "(\<sigma> \<cdot>e t, \<tau> \<cdot>e t)" "(\<lambda>n. (\<sigma> \<cdot>e n, \<tau> \<cdot>e n)) ` set ts"]
       unfolding sp_equiv_list_def set_zip_map
       by (auto simp: sp_equiv_pair_comm)
   qed
 qed (auto simp: sp_equiv_def sp_equiv_list_def fv_fo_terms_set_def)
 
 lemma esat_Pred_inf:
   assumes "fv_fo_terms_set ts \<subseteq> FV" "fv_fo_terms_set ts \<subseteq> S"
     "ad_agr_sets FV S AD \<sigma> \<tau>" "ad_agr_list AD (\<sigma> \<odot>e ts) vs"
     "\<Union>(set_fo_term ` set ts) \<subseteq> AD"
   shows "ad_agr_list AD (\<tau> \<odot>e ts) vs"
 proof -
   have sp: "sp_equiv \<sigma> \<tau> (fv_fo_terms_set ts)"
     using assms(2,3) sp_equiv_mono
     unfolding ad_agr_sets_def
     by auto
   have "(\<And>i. i \<in> fv_fo_terms_set ts \<Longrightarrow> ad_equiv_pair AD (\<sigma> i, \<tau> i))"
     using assms(1,3)
     by (auto simp: ad_agr_sets_def)
   then have "sp_equiv_list (map ((\<cdot>e) \<sigma>) ts) (map ((\<cdot>e) \<tau>) ts)"
     using sp_equiv_list_fv[OF _ assms(5) sp]
     by auto
   moreover have "t \<in> set ts \<Longrightarrow> \<forall>i\<in>fv_fo_terms_set ts. ad_equiv_pair AD (\<sigma> i, \<tau> i) \<Longrightarrow> sp_equiv \<sigma> \<tau> S \<Longrightarrow> ad_equiv_pair AD (\<sigma> \<cdot>e t, \<tau> \<cdot>e t)" for t
     by (cases t) (auto simp: ad_equiv_pair.simps intro!: fv_fo_terms_setI)
   ultimately have ad_agr_list:
     "ad_agr_list AD (\<sigma> \<odot>e ts) (\<tau> \<odot>e ts)"
     unfolding eval_eterms_def ad_agr_list_def ad_equiv_list_link[symmetric]
     using assms(1,3)
     by (auto simp: ad_agr_sets_def)
   show ?thesis
     by (rule ad_agr_list_comm[OF ad_agr_list_trans[OF ad_agr_list_comm[OF assms(4)] ad_agr_list]])
 qed
 
 type_synonym ('a, 'c) fo_t = "'a set \<times> nat \<times> ('a + 'c) table"
 
 fun esat :: "('a, 'b) fo_fmla \<Rightarrow> ('a table, 'b) fo_intp \<Rightarrow> ('a + nat) val \<Rightarrow> ('a + nat) set \<Rightarrow> bool" where
   "esat (Pred r ts) I \<sigma> X \<longleftrightarrow> \<sigma> \<odot>e ts \<in> map Inl ` I (r, length ts)"
 | "esat (Bool b) I \<sigma> X \<longleftrightarrow> b"
 | "esat (Eqa t t') I \<sigma> X \<longleftrightarrow> \<sigma> \<cdot>e t = \<sigma> \<cdot>e t'"
 | "esat (Neg \<phi>) I \<sigma> X \<longleftrightarrow> \<not>esat \<phi> I \<sigma> X"
 | "esat (Conj \<phi> \<psi>) I \<sigma> X \<longleftrightarrow> esat \<phi> I \<sigma> X \<and> esat \<psi> I \<sigma> X"
 | "esat (Disj \<phi> \<psi>) I \<sigma> X \<longleftrightarrow> esat \<phi> I \<sigma> X \<or> esat \<psi> I \<sigma> X"
 | "esat (Exists n \<phi>) I \<sigma> X \<longleftrightarrow> (\<exists>x \<in> X. esat \<phi> I (\<sigma>(n := x)) X)"
 | "esat (Forall n \<phi>) I \<sigma> X \<longleftrightarrow> (\<forall>x \<in> X. esat \<phi> I (\<sigma>(n := x)) X)"
 
 fun sz_fmla :: "('a, 'b) fo_fmla \<Rightarrow> nat" where
   "sz_fmla (Neg \<phi>) = Suc (sz_fmla \<phi>)"
 | "sz_fmla (Conj \<phi> \<psi>) = Suc (sz_fmla \<phi> + sz_fmla \<psi>)"
 | "sz_fmla (Disj \<phi> \<psi>) = Suc (sz_fmla \<phi> + sz_fmla \<psi>)"
 | "sz_fmla (Exists n \<phi>) = Suc (sz_fmla \<phi>)"
 | "sz_fmla (Forall n \<phi>) = Suc (Suc (Suc (Suc (sz_fmla \<phi>))))"
 | "sz_fmla _ = 0"
 
 lemma sz_fmla_induct[case_names Pred Bool Eqa Neg Conj Disj Exists Forall]:
   "(\<And>r ts. P (Pred r ts)) \<Longrightarrow> (\<And>b. P (Bool b)) \<Longrightarrow>
   (\<And>t t'. P (Eqa t t')) \<Longrightarrow> (\<And>\<phi>. P \<phi> \<Longrightarrow> P (Neg \<phi>)) \<Longrightarrow>
   (\<And>\<phi> \<psi>. P \<phi> \<Longrightarrow> P \<psi> \<Longrightarrow> P (Conj \<phi> \<psi>)) \<Longrightarrow> (\<And>\<phi> \<psi>. P \<phi> \<Longrightarrow> P \<psi> \<Longrightarrow> P (Disj \<phi> \<psi>)) \<Longrightarrow>
   (\<And>n \<phi>. P \<phi> \<Longrightarrow> P (Exists n \<phi>)) \<Longrightarrow> (\<And>n \<phi>. P (Exists n (Neg \<phi>)) \<Longrightarrow> P (Forall n \<phi>)) \<Longrightarrow> P \<phi>"
 proof (induction "sz_fmla \<phi>" arbitrary: \<phi> rule: nat_less_induct)
   case 1
   have IH: "\<And>\<psi>. sz_fmla \<psi> < sz_fmla \<phi> \<Longrightarrow> P \<psi>"
     using 1
     by auto
   then show ?case
     using 1(2,3,4,5,6,7,8,9)
     by (cases \<phi>) auto
 qed
 
 lemma esat_fv_cong: "(\<And>n. n \<in> fv_fo_fmla \<phi> \<Longrightarrow> \<sigma> n = \<sigma>' n) \<Longrightarrow> esat \<phi> I \<sigma> X \<longleftrightarrow> esat \<phi> I \<sigma>' X"
 proof (induction \<phi> arbitrary: \<sigma> \<sigma>' rule: sz_fmla_induct)
   case (Pred r ts)
   then show ?case
     by (auto simp: eval_eterms_def fv_fo_terms_set_def)
        (smt comp_apply eval_eterm_cong fv_fo_term_set_cong image_insert insertCI map_eq_conv
         mk_disjoint_insert)+
 next
   case (Eqa t t')
   then show ?case
     by (cases t; cases t') auto
 next
   case (Neg \<phi>)
   show ?case
     using Neg(1)[of \<sigma> \<sigma>'] Neg(2) by auto
 next
   case (Conj \<phi>1 \<phi>2)
   show ?case
     using Conj(1,2)[of \<sigma> \<sigma>'] Conj(3) by auto
 next
   case (Disj \<phi>1 \<phi>2)
   show ?case
     using Disj(1,2)[of \<sigma> \<sigma>'] Disj(3) by auto
 next
   case (Exists n \<phi>)
   show ?case
   proof (rule iffI)
     assume "esat (Exists n \<phi>) I \<sigma> X"
     then obtain x where x_def: "x \<in> X" "esat \<phi> I (\<sigma>(n := x)) X"
       by auto
     from x_def(2) have "esat \<phi> I (\<sigma>'(n := x)) X"
       using Exists(1)[of "\<sigma>(n := x)" "\<sigma>'(n := x)"] Exists(2) by fastforce
     with x_def(1) show "esat (Exists n \<phi>) I \<sigma>' X"
       by auto
   next
     assume "esat (Exists n \<phi>) I \<sigma>' X"
     then obtain x where x_def: "x \<in> X" "esat \<phi> I (\<sigma>'(n := x)) X"
       by auto
     from x_def(2) have "esat \<phi> I (\<sigma>(n := x)) X"
       using Exists(1)[of "\<sigma>(n := x)" "\<sigma>'(n := x)"] Exists(2) by fastforce
     with x_def(1) show "esat (Exists n \<phi>) I \<sigma> X"
       by auto
   qed
 next
   case (Forall n \<phi>)
   then show ?case
     by auto
 qed auto
 
 fun ad_terms :: "('a fo_term) list \<Rightarrow> 'a set" where
   "ad_terms ts = \<Union>(set (map set_fo_term ts))"
 
 fun act_edom :: "('a, 'b) fo_fmla \<Rightarrow> ('a table, 'b) fo_intp \<Rightarrow> 'a set" where
   "act_edom (Pred r ts) I = ad_terms ts \<union> \<Union>(set ` I (r, length ts))"
 | "act_edom (Bool b) I = {}"
 | "act_edom (Eqa t t') I = set_fo_term t \<union> set_fo_term t'"
 | "act_edom (Neg \<phi>) I = act_edom \<phi> I"
 | "act_edom (Conj \<phi> \<psi>) I = act_edom \<phi> I \<union> act_edom \<psi> I"
 | "act_edom (Disj \<phi> \<psi>) I = act_edom \<phi> I \<union> act_edom \<psi> I"
 | "act_edom (Exists n \<phi>) I = act_edom \<phi> I"
 | "act_edom (Forall n \<phi>) I = act_edom \<phi> I"
 
 lemma finite_act_edom: "wf_fo_intp \<phi> I \<Longrightarrow> finite (act_edom \<phi> I)"
   using finite_Inl
   by (induction \<phi> I rule: wf_fo_intp.induct)
      (auto simp: finite_set_fo_term vimage_def)
 
 fun fo_adom :: "('a, 'c) fo_t \<Rightarrow> 'a set" where
   "fo_adom (AD, n, X) = AD"
 
 theorem main: "ad_agr \<phi> AD \<sigma> \<tau> \<Longrightarrow> act_edom \<phi> I \<subseteq> AD \<Longrightarrow>
   Inl ` AD \<union> Inr ` {..<d \<phi>} \<subseteq> X \<Longrightarrow> \<tau> ` fv_fo_fmla \<phi> \<subseteq> X \<Longrightarrow>
   esat \<phi> I \<sigma> UNIV \<longleftrightarrow> esat \<phi> I \<tau> X"
 proof (induction \<phi> arbitrary: \<sigma> \<tau> rule: sz_fmla_induct)
   case (Pred r ts)
   have fv_sub: "fv_fo_terms_set ts \<subseteq> fv_fo_fmla (Pred r ts)"
     by auto
   have sub_AD: "\<Union>(set ` I (r, length ts)) \<subseteq> AD"
     using Pred(2)
     by auto
   show ?case
     unfolding esat.simps
   proof (rule iffI)
     assume assm: "\<sigma> \<odot>e ts \<in> map Inl ` I (r, length ts)"
     have "\<sigma> \<odot>e ts = \<tau> \<odot>e ts"
       using esat_Pred[OF ad_agr_sets_mono[OF sub_AD Pred(1)[unfolded ad_agr_def]]
             fv_sub assm]
       by (auto simp: eval_eterms_def)
     with assm show "\<tau> \<odot>e ts \<in> map Inl ` I (r, length ts)"
       by auto
   next
     assume assm: "\<tau> \<odot>e ts \<in> map Inl ` I (r, length ts)"
     have "\<tau> \<odot>e ts = \<sigma> \<odot>e ts"
       using esat_Pred[OF ad_agr_sets_comm[OF ad_agr_sets_mono[OF
             sub_AD Pred(1)[unfolded ad_agr_def]]] fv_sub assm]
       by (auto simp: eval_eterms_def)
     with assm show "\<sigma> \<odot>e ts \<in> map Inl ` I (r, length ts)"
       by auto
   qed
 next
   case (Eqa x1 x2)
   show ?case
   proof (cases x1; cases x2)
     fix c c'
     assume "x1 = Const c" "x2 = Const c'"
     with Eqa show ?thesis
       by auto
   next
     fix c m'
     assume assms: "x1 = Const c" "x2 = Var m'"
     with Eqa(1,2) have "\<sigma> m' = Inl c \<longleftrightarrow> \<tau> m' = Inl c"
       apply (auto simp: ad_agr_def ad_agr_sets_def)
       unfolding ad_equiv_pair.simps
       by fastforce+
     with assms show ?thesis
       by fastforce
   next
     fix m c'
     assume assms: "x1 = Var m" "x2 = Const c'"
     with Eqa(1,2) have "\<sigma> m = Inl c' \<longleftrightarrow> \<tau> m = Inl c'"
       apply (auto simp: ad_agr_def ad_agr_sets_def)
       unfolding ad_equiv_pair.simps
       by fastforce+
     with assms show ?thesis
       by auto
   next
     fix m m'
     assume assms: "x1 = Var m" "x2 = Var m'"
     with Eqa(1,2) have "\<sigma> m = \<sigma> m' \<longleftrightarrow> \<tau> m = \<tau> m'"
       by (auto simp: ad_agr_def ad_agr_sets_def sp_equiv_def pairwise_def split: if_splits)
     with assms show ?thesis
       by auto
   qed
 next
   case (Neg \<phi>)
   from Neg(2) have "ad_agr \<phi> AD \<sigma> \<tau>"
     by (auto simp: ad_agr_def)
   with Neg show ?case
     by auto
 next
   case (Conj \<phi>1 \<phi>2)
   have aux: "ad_agr \<phi>1 AD \<sigma> \<tau>" "ad_agr \<phi>2 AD \<sigma> \<tau>"
     "Inl ` AD \<union> Inr ` {..<d \<phi>1} \<subseteq> X" "Inl ` AD \<union> Inr ` {..<d \<phi>2} \<subseteq> X"
     "\<tau> ` fv_fo_fmla \<phi>1 \<subseteq> X" "\<tau> ` fv_fo_fmla \<phi>2 \<subseteq> X"
     using Conj(3,5,6)
     by (auto simp: ad_agr_def ad_agr_sets_def sp_equiv_def pairwise_def)
   show ?case
     using Conj(1)[OF aux(1) _ aux(3) aux(5)] Conj(2)[OF aux(2) _ aux(4) aux(6)] Conj(4)
     by auto
 next
   case (Disj \<phi>1 \<phi>2)
   have aux: "ad_agr \<phi>1 AD \<sigma> \<tau>" "ad_agr \<phi>2 AD \<sigma> \<tau>"
     "Inl ` AD \<union> Inr ` {..<d \<phi>1} \<subseteq> X" "Inl ` AD \<union> Inr ` {..<d \<phi>2} \<subseteq> X"
     "\<tau> ` fv_fo_fmla \<phi>1 \<subseteq> X" "\<tau> ` fv_fo_fmla \<phi>2 \<subseteq> X"
     using Disj(3,5,6)
     by (auto simp: ad_agr_def ad_agr_sets_def sp_equiv_def pairwise_def)
   show ?case
     using Disj(1)[OF aux(1) _ aux(3) aux(5)] Disj(2)[OF aux(2) _ aux(4) aux(6)] Disj(4)
     by auto
 next
   case (Exists m \<phi>)
   show ?case
   proof (rule iffI)
     assume "esat (Exists m \<phi>) I \<sigma> UNIV"
     then obtain x where assm: "esat \<phi> I (\<sigma>(m := x)) UNIV"
       by auto
     have "m \<in> SP \<phi> \<Longrightarrow> Suc (card (Inr -` \<tau> ` (SP \<phi> - {m}))) \<le> card (SP \<phi>)"
       by (metis Diff_insert_absorb card_image card_le_Suc_iff finite_Diff finite_SP
           image_vimage_subset inj_Inr mk_disjoint_insert surj_card_le)
     moreover have "card (Inr -` \<tau> ` SP \<phi>) \<le> card (SP \<phi>)"
       by (metis card_image finite_SP image_vimage_subset inj_Inr surj_card_le)
     ultimately have "max 1 (card (Inr -` \<tau> ` (SP \<phi> - {m})) + (if m \<in> SP \<phi> then 1 else 0)) \<le> d \<phi>"
       using d_pos card_SP_d[of \<phi>]
       by auto
     then have "\<exists>x' \<in> X. ad_agr \<phi> AD (\<sigma>(m := x)) (\<tau>(m := x'))"
       using extend_\<tau>[OF Exists(2)[unfolded ad_agr_def fv_fo_fmla.simps SP.simps]
             SP_fv[of \<phi>] finite_SP Exists(5)[unfolded fv_fo_fmla.simps]]
             Exists(4)
       by (force simp: ad_agr_def)
     then obtain x' where x'_def: "x' \<in> X" "ad_agr \<phi> AD (\<sigma>(m := x)) (\<tau>(m := x'))"
       by auto
     from Exists(5) have "\<tau>(m := x') ` fv_fo_fmla \<phi> \<subseteq> X"
       using x'_def(1) by fastforce
     then have "esat \<phi> I (\<tau>(m := x')) X"
       using Exists x'_def(1,2) assm
       by fastforce
     with x'_def show "esat (Exists m \<phi>) I \<tau> X"
       by auto
   next
     assume "esat (Exists m \<phi>) I \<tau> X"
     then obtain z where assm: "z \<in> X" "esat \<phi> I (\<tau>(m := z)) X"
       by auto
     have ad_agr: "ad_agr_sets (fv_fo_fmla \<phi> - {m}) (SP \<phi> - {m}) AD \<tau> \<sigma>"
       using Exists(2)[unfolded ad_agr_def fv_fo_fmla.simps SP.simps]
       by (rule ad_agr_sets_comm)
     have "\<exists>x. ad_agr \<phi> AD (\<sigma>(m := x)) (\<tau>(m := z))"
       using extend_\<tau>[OF ad_agr SP_fv[of \<phi>] finite_SP subset_UNIV subset_UNIV] ad_agr_sets_comm
       unfolding ad_agr_def
       by fastforce
     then obtain x where x_def: "ad_agr \<phi> AD (\<sigma>(m := x)) (\<tau>(m := z))"
       by auto
     have "\<tau>(m := z) ` fv_fo_fmla (Exists m \<phi>) \<subseteq> X"
       using Exists
       by fastforce
     with x_def have "esat \<phi> I (\<sigma>(m := x)) UNIV"
       using Exists assm
       by fastforce
     then show "esat (Exists m \<phi>) I \<sigma> UNIV"
       by auto
   qed
 next
   case (Forall n \<phi>)
   have unfold: "act_edom (Forall n \<phi>) I = act_edom (Exists n (Neg \<phi>)) I"
     "Inl ` AD \<union> Inr ` {..<d (Forall n \<phi>)} = Inl ` AD \<union> Inr ` {..<d (Exists n (Neg \<phi>))}"
     "fv_fo_fmla (Forall n \<phi>) = fv_fo_fmla (Exists n (Neg \<phi>))"
     by auto
   have pred: "ad_agr (Exists n (Neg \<phi>)) AD \<sigma> \<tau>"
     using Forall(2)
     by (auto simp: ad_agr_def)
   show ?case
     using Forall(1)[OF pred Forall(3,4,5)[unfolded unfold]]
     by auto
 qed auto
 
 lemma main_cor_inf:
   assumes "ad_agr \<phi> AD \<sigma> \<tau>" "act_edom \<phi> I \<subseteq> AD" "d \<phi> \<le> n"
     "\<tau> ` fv_fo_fmla \<phi> \<subseteq> Inl ` AD \<union> Inr ` {..<n}"
   shows "esat \<phi> I \<sigma> UNIV \<longleftrightarrow> esat \<phi> I \<tau> (Inl ` AD \<union> Inr ` {..<n})"
 proof -
   show ?thesis
     using main[OF assms(1,2) _ assms(4)] assms(3)
     by fastforce
 qed
 
 lemma esat_UNIV_cong:
   fixes \<sigma> :: "nat \<Rightarrow> 'a + nat"
   assumes "ad_agr \<phi> AD \<sigma> \<tau>" "act_edom \<phi> I \<subseteq> AD"
   shows "esat \<phi> I \<sigma> UNIV \<longleftrightarrow> esat \<phi> I \<tau> UNIV"
 proof -
   show ?thesis
     using main[OF assms(1,2) subset_UNIV subset_UNIV]
     by auto
 qed
 
 lemma esat_UNIV_ad_agr_list:
   fixes \<sigma> :: "nat \<Rightarrow> 'a + nat"
   assumes "ad_agr_list AD (map \<sigma> (fv_fo_fmla_list \<phi>)) (map \<tau> (fv_fo_fmla_list \<phi>))"
     "act_edom \<phi> I \<subseteq> AD"
   shows "esat \<phi> I \<sigma> UNIV \<longleftrightarrow> esat \<phi> I \<tau> UNIV"
   using esat_UNIV_cong[OF iffD2[OF ad_agr_def, OF ad_agr_sets_mono'[OF SP_fv],
         OF iffD2[OF ad_agr_list_link, OF assms(1), unfolded fv_fo_fmla_list_set]] assms(2)] .
 
 fun fo_rep :: "('a, 'c) fo_t \<Rightarrow> 'a table" where
   "fo_rep (AD, n, X) = {ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'}"
 
 lemma sat_esat_conv:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes fin: "wf_fo_intp \<phi> I"
   shows "sat \<phi> I \<sigma> \<longleftrightarrow> esat \<phi> I (Inl \<circ> \<sigma> :: nat \<Rightarrow> 'a + nat) UNIV"
   using assms
 proof (induction \<phi> arbitrary: I \<sigma> rule: sz_fmla_induct)
   case (Pred r ts)
   show ?case
     unfolding sat.simps esat.simps comp_def[symmetric] eval_terms_eterms[symmetric]
     by auto
 next
   case (Eqa t t')
   show ?case
     by (cases t; cases t') auto
 next
   case (Exists n \<phi>)
   show ?case
   proof (rule iffI)
     assume "sat (Exists n \<phi>) I \<sigma>"
     then obtain x where x_def: "esat \<phi> I (Inl \<circ> \<sigma>(n := x)) UNIV"
       using Exists
       by fastforce
     have Inl_unfold: "Inl \<circ> \<sigma>(n := x) = (Inl \<circ> \<sigma>)(n := Inl x)"
       by auto
     show "esat (Exists n \<phi>) I (Inl \<circ> \<sigma>) UNIV"
       using x_def
       unfolding Inl_unfold
       by auto
   next
     assume "esat (Exists n \<phi>) I (Inl \<circ> \<sigma>) UNIV"
     then obtain x where x_def: "esat \<phi> I ((Inl \<circ> \<sigma>)(n := x)) UNIV"
       by auto
     show "sat (Exists n \<phi>) I \<sigma>"
     proof (cases x)
       case (Inl a)
       have Inl_unfold: "(Inl \<circ> \<sigma>)(n := x) = Inl \<circ> \<sigma>(n := a)"
         by (auto simp: Inl)
       show ?thesis
         using x_def[unfolded Inl_unfold] Exists
         by fastforce
     next
       case (Inr b)
       obtain c where c_def: "c \<notin> act_edom \<phi> I \<union> \<sigma> ` fv_fo_fmla \<phi>"
         using arb_element finite_act_edom[OF Exists(2), simplified] finite_fv_fo_fmla
         by (metis finite_Un finite_imageI)
       have wf_local: "wf_fo_intp \<phi> I"
         using Exists(2)
         by auto
       have "(a, a') \<in> set (zip (map (\<lambda>x. if x = n then Inr b else (Inl \<circ> \<sigma>) x) (fv_fo_fmla_list \<phi>))
         (map (\<lambda>a. Inl (if a = n then c else \<sigma> a)) (fv_fo_fmla_list \<phi>))) \<Longrightarrow>
         ad_equiv_pair (act_edom \<phi> I) (a, a')" for a a'
         using c_def
         by (cases a; cases a') (auto simp: set_zip ad_equiv_pair.simps split: if_splits)
       then have "sat \<phi> I (\<sigma>(n := c))"
         using c_def[folded fv_fo_fmla_list_set]
         by (auto simp: ad_agr_list_def ad_equiv_list_def fun_upd_def sp_equiv_list_def pairwise_def set_zip split: if_splits
             intro!: Exists(1)[OF wf_local, THEN iffD2, OF esat_UNIV_ad_agr_list[OF _ subset_refl, THEN iffD1, OF _ x_def[unfolded Inr]]])
       then show ?thesis
         by auto
     qed
   qed
 next
   case (Forall n \<phi>)
   show ?case
     using Forall(1)[of I \<sigma>] Forall(2)
     by auto
 qed auto
 
 lemma sat_ad_agr_list:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
     and J :: "(('a, nat) fo_t, 'b) fo_intp"
   assumes "wf_fo_intp \<phi> I"
     "ad_agr_list AD (map (Inl \<circ> \<sigma> :: nat \<Rightarrow> 'a + nat) (fv_fo_fmla_list \<phi>))
       (map (Inl \<circ> \<tau>) (fv_fo_fmla_list \<phi>))" "act_edom \<phi> I \<subseteq> AD"
   shows "sat \<phi> I \<sigma> \<longleftrightarrow> sat \<phi> I \<tau>"
   using esat_UNIV_ad_agr_list[OF assms(2,3)] sat_esat_conv[OF assms(1)]
   by auto
 
 definition nfv :: "('a, 'b) fo_fmla \<Rightarrow> nat" where
   "nfv \<phi> = length (fv_fo_fmla_list \<phi>)"
 
 lemma nfv_card: "nfv \<phi> = card (fv_fo_fmla \<phi>)"
 proof -
   have "distinct (fv_fo_fmla_list \<phi>)"
     using sorted_distinct_fv_list
     by auto
   then have "length (fv_fo_fmla_list \<phi>) = card (set (fv_fo_fmla_list \<phi>))"
     using distinct_card by fastforce
   then show ?thesis
     unfolding fv_fo_fmla_list_set by (auto simp: nfv_def)
 qed
 
 fun rremdups :: "'a list \<Rightarrow> 'a list" where
   "rremdups [] = []"
 | "rremdups (x # xs) = x # rremdups (filter ((\<noteq>) x) xs)"
 
 lemma filter_rremdups_filter: "filter P (rremdups (filter Q xs)) =
   rremdups (filter (\<lambda>x. P x \<and> Q x) xs)"
   apply (induction xs arbitrary: Q)
    apply auto
   by metis
 
 lemma filter_rremdups: "filter P (rremdups xs) = rremdups (filter P xs)"
   using filter_rremdups_filter[where Q="\<lambda>_. True"]
   by auto
 
 lemma filter_take: "\<exists>j. filter P (take i xs) = take j (filter P xs)"
   apply (induction xs arbitrary: i)
    apply (auto)
    apply (metis filter.simps(1) filter.simps(2) take_Cons' take_Suc_Cons)
   apply (metis filter.simps(2) take0 take_Cons')
   done
 
 lemma rremdups_take: "\<exists>j. rremdups (take i xs) = take j (rremdups xs)"
 proof (induction xs arbitrary: i)
   case (Cons x xs)
   show ?case
   proof (cases i)
     case (Suc n)
     obtain j where j_def: "rremdups (take n xs) = take j (rremdups xs)"
       using Cons by auto
     obtain j' where j'_def: "filter ((\<noteq>) x) (take j (rremdups xs)) =
       take j' (filter ((\<noteq>) x) (rremdups xs))"
       using filter_take
       by blast
     show ?thesis
       by (auto simp: Suc filter_rremdups[symmetric] j_def j'_def intro: exI[of _ "Suc j'"])
   qed (auto simp add: take_Cons')
 qed auto
 
 lemma rremdups_app: "rremdups (xs @ [x]) = rremdups xs @ (if x \<in> set xs then [] else [x])"
   apply (induction xs)
    apply auto
    apply (smt filter.simps(1) filter.simps(2) filter_append filter_rremdups)+
   done
 
 lemma rremdups_set: "set (rremdups xs) = set xs"
   by (induction xs) (auto simp: filter_rremdups[symmetric])
 
 lemma distinct_rremdups: "distinct (rremdups xs)"
 proof (induction "length xs" arbitrary: xs rule: nat_less_induct)
   case 1
   then have IH: "\<And>m ys. length (ys :: 'a list) < length xs \<Longrightarrow> distinct (rremdups ys)"
     by auto
   show ?case
   proof (cases xs)
     case (Cons z zs)
     show ?thesis
       using IH
       by (auto simp: Cons rremdups_set le_imp_less_Suc)
   qed auto
 qed
 
 lemma length_rremdups: "length (rremdups xs) = card (set xs)"
   using distinct_card[OF distinct_rremdups]
   by (subst eq_commute) (auto simp: rremdups_set)
 
 lemma set_map_filter_sum: "set (List.map_filter (case_sum Map.empty Some) xs) = Inr -` set xs"
   by (induction xs) (auto simp: List.map_filter_simps split: sum.splits)
 
 definition nats :: "nat list \<Rightarrow> bool" where
   "nats ns = (ns = [0..<length ns])"
 
 definition fo_nmlzd :: "'a set \<Rightarrow> ('a + nat) list \<Rightarrow> bool" where
   "fo_nmlzd AD xs \<longleftrightarrow> Inl -` set xs \<subseteq> AD \<and>
     (let ns = List.map_filter (case_sum Map.empty Some) xs in nats (rremdups ns))"
 
 lemma fo_nmlzd_all_AD:
   assumes "set xs \<subseteq> Inl ` AD"
   shows "fo_nmlzd AD xs"
 proof -
   have "List.map_filter (case_sum Map.empty Some) xs = []"
     using assms
     by (induction xs) (auto simp: List.map_filter_simps)
   then show ?thesis
     using assms
     by (auto simp: fo_nmlzd_def nats_def Let_def)
 qed
 
 lemma card_Inr_vimage_le_length: "card (Inr -` set xs) \<le> length xs"
 proof -
   have "card (Inr -` set xs) \<le> card (set xs)"
     by (meson List.finite_set card_inj_on_le image_vimage_subset inj_Inr)
   moreover have "\<dots> \<le> length xs"
     by (rule card_length)
   finally show ?thesis .
 qed
 
 lemma fo_nmlzd_set:
   assumes "fo_nmlzd AD xs"
   shows "set xs = set xs \<inter> Inl ` AD \<union> Inr ` {..<min (length xs) (card (Inr -` set xs))}"
 proof -
   have "Inl -` set xs \<subseteq> AD"
     using assms
     by (auto simp: fo_nmlzd_def)
   moreover have "Inr -` set xs = {..<card (Inr -` set xs)}"
     using assms
     by (auto simp: Let_def fo_nmlzd_def nats_def length_rremdups set_map_filter_sum rremdups_set
         dest!: arg_cong[of _ _ set])
   ultimately have "set xs = set xs \<inter> Inl ` AD \<union> Inr ` {..<card (Inr -` set xs)}"
     by auto (metis (no_types, lifting) UNIV_I UNIV_sum UnE image_iff subset_iff vimageI)
   then show ?thesis
     using card_Inr_vimage_le_length[of xs]
     by (metis min.absorb2)
 qed
 
 lemma map_filter_take: "\<exists>j. List.map_filter f (take i xs) = take j (List.map_filter f xs)"
   apply (induction xs arbitrary: i)
    apply (auto simp: List.map_filter_simps split: option.splits)
    apply (metis map_filter_simps(1) option.case(1) take0 take_Cons')
   apply (metis map_filter_simps(1) map_filter_simps(2) option.case(2) take_Cons' take_Suc_Cons)
   done
 
 lemma fo_nmlzd_take: assumes "fo_nmlzd AD xs"
   shows "fo_nmlzd AD (take i xs)"
 proof -
   have aux: "rremdups zs = [0..<length (rremdups zs)] \<Longrightarrow> rremdups (take j zs) =
     [0..<length (rremdups (take j zs))]" for j zs
     using rremdups_take[of j zs]
     by (auto simp add: min_def) (metis add_0 linorder_le_cases take_upt)
   show ?thesis
     using assms map_filter_take[of "case_sum Map.empty Some" i xs] set_take_subset
     using aux[where ?zs="List.map_filter (case_sum Map.empty Some) xs"]
     by (fastforce simp: fo_nmlzd_def vimage_def nats_def Let_def)
 qed
 
 lemma map_filter_app: "List.map_filter f (xs @ [x]) = List.map_filter f xs @
   (case f x of Some y \<Rightarrow> [y] | _ \<Rightarrow> [])"
   by (induction xs) (auto simp: List.map_filter_simps split: option.splits)
 
 lemma fo_nmlzd_app_Inr: "Inr n \<notin> set xs \<Longrightarrow> Inr n' \<notin> set xs \<Longrightarrow> fo_nmlzd AD (xs @ [Inr n]) \<Longrightarrow>
   fo_nmlzd AD (xs @ [Inr n']) \<Longrightarrow> n = n'"
   by (auto simp: List.map_filter_simps fo_nmlzd_def nats_def Let_def map_filter_app
       rremdups_app set_map_filter_sum)
 
 fun all_tuples :: "'c set \<Rightarrow> nat \<Rightarrow> 'c table" where
   "all_tuples xs 0 = {[]}"
 | "all_tuples xs (Suc n) = \<Union>((\<lambda>as. (\<lambda>x. x # as) ` xs) ` (all_tuples xs n))"
 
 definition nall_tuples :: "'a set \<Rightarrow> nat \<Rightarrow> ('a + nat) table" where
   "nall_tuples AD n = {zs \<in> all_tuples (Inl ` AD \<union> Inr ` {..<n}) n. fo_nmlzd AD zs}"
 
 lemma all_tuples_finite: "finite xs \<Longrightarrow> finite (all_tuples xs n)"
   by (induction xs n rule: all_tuples.induct) auto
 
 lemma nall_tuples_finite: "finite AD \<Longrightarrow> finite (nall_tuples AD n)"
   by (auto simp: nall_tuples_def all_tuples_finite)
 
 lemma all_tuplesI: "length vs = n \<Longrightarrow> set vs \<subseteq> xs \<Longrightarrow> vs \<in> all_tuples xs n"
 proof (induction xs n arbitrary: vs rule: all_tuples.induct)
   case (2 xs n)
   then obtain w ws where "vs = w # ws" "length ws = n" "set ws \<subseteq> xs" "w \<in> xs"
     by (metis Suc_length_conv contra_subsetD list.set_intros(1) order_trans set_subset_Cons)
   with 2(1) show ?case
     by auto
 qed auto
 
 lemma nall_tuplesI: "length vs = n \<Longrightarrow> fo_nmlzd AD vs \<Longrightarrow> vs \<in> nall_tuples AD n"
   using fo_nmlzd_set[of AD vs]
   by (auto simp: nall_tuples_def intro!: all_tuplesI)
 
 lemma all_tuplesD: "vs \<in> all_tuples xs n \<Longrightarrow> length vs = n \<and> set vs \<subseteq> xs"
   by (induction xs n arbitrary: vs rule: all_tuples.induct) auto+
 
 lemma all_tuples_setD: "vs \<in> all_tuples xs n \<Longrightarrow> set vs \<subseteq> xs"
   by (auto dest: all_tuplesD)
 
 lemma nall_tuplesD: "vs \<in> nall_tuples AD n \<Longrightarrow>
   length vs = n \<and> set vs \<subseteq> Inl ` AD \<union> Inr ` {..<n} \<and> fo_nmlzd AD vs"
   by (auto simp: nall_tuples_def dest: all_tuplesD)
 
 lemma all_tuples_set: "all_tuples xs n = {ys. length ys = n \<and> set ys \<subseteq> xs}"
 proof (induction xs n rule: all_tuples.induct)
   case (2 xs n)
   show ?case
   proof (rule subset_antisym; rule subsetI)
     fix ys
     assume "ys \<in> all_tuples xs (Suc n)"
     then show "ys \<in> {ys. length ys = Suc n \<and> set ys \<subseteq> xs}"
       using 2 by auto
   next
     fix ys
     assume "ys \<in> {ys. length ys = Suc n \<and> set ys \<subseteq> xs}"
     then have assm: "length ys = Suc n" "set ys \<subseteq> xs"
       by auto
     then obtain z zs where zs_def: "ys = z # zs" "z \<in> xs" "length zs = n" "set zs \<subseteq> xs"
       by (cases ys) auto
     with 2 have "zs \<in> all_tuples xs n"
       by auto
     with zs_def(1,2) show "ys \<in> all_tuples xs (Suc n)"
       by auto
   qed
 qed auto
 
 lemma nall_tuples_set: "nall_tuples AD n = {ys. length ys = n \<and> fo_nmlzd AD ys}"
   using fo_nmlzd_set[of AD] card_Inr_vimage_le_length
   by (auto simp: nall_tuples_def all_tuples_set) (smt UnE nall_tuplesD nall_tuplesI subsetD)
 
 fun pos :: "'a \<Rightarrow> 'a list \<Rightarrow> nat option" where
   "pos a [] = None"
 | "pos a (x # xs) =
     (if a = x then Some 0 else (case pos a xs of Some n \<Rightarrow> Some (Suc n) | _ \<Rightarrow> None))"
 
 lemma pos_set: "pos a xs = Some i \<Longrightarrow> a \<in> set xs"
   by (induction a xs arbitrary: i rule: pos.induct) (auto split: if_splits option.splits)
 
 lemma pos_length: "pos a xs = Some i \<Longrightarrow> i < length xs"
   by (induction a xs arbitrary: i rule: pos.induct) (auto split: if_splits option.splits)
 
 lemma pos_sound: "pos a xs = Some i \<Longrightarrow> i < length xs \<and> xs ! i = a"
   by (induction a xs arbitrary: i rule: pos.induct) (auto split: if_splits option.splits)
 
 lemma pos_complete: "pos a xs = None \<Longrightarrow> a \<notin> set xs"
   by (induction a xs rule: pos.induct) (auto split: if_splits option.splits)
 
 fun rem_nth :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "rem_nth _ [] = []"
 | "rem_nth 0 (x # xs) = xs"
 | "rem_nth (Suc n) (x # xs) = x # rem_nth n xs"
 
 lemma rem_nth_length: "i < length xs \<Longrightarrow> length (rem_nth i xs) = length xs - 1"
   by (induction i xs rule: rem_nth.induct) auto
 
 lemma rem_nth_take_drop: "i < length xs \<Longrightarrow> rem_nth i xs = take i xs @ drop (Suc i) xs"
   by (induction i xs rule: rem_nth.induct) auto
 
 lemma rem_nth_sound: "distinct xs \<Longrightarrow> pos n xs = Some i \<Longrightarrow>
   rem_nth i (map \<sigma> xs) = map \<sigma> (filter ((\<noteq>) n) xs)"
   apply (induction xs arbitrary: i)
    apply (auto simp: pos_set split: option.splits)
   by (metis (mono_tags, lifting) filter_True)
 
 fun add_nth :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "add_nth 0 a xs = a # xs"
 | "add_nth (Suc n) a zs = (case zs of x # xs \<Rightarrow> x # add_nth n a xs)"
 
 lemma add_nth_length: "i \<le> length zs \<Longrightarrow> length (add_nth i z zs) = Suc (length zs)"
   by (induction i z zs rule: add_nth.induct) (auto split: list.splits)
 
 lemma add_nth_take_drop: "i \<le> length zs \<Longrightarrow> add_nth i v zs = take i zs @ v # drop i zs"
   by (induction i v zs rule: add_nth.induct) (auto split: list.splits)
 
 lemma add_nth_rem_nth_map: "distinct xs \<Longrightarrow> pos n xs = Some i \<Longrightarrow>
   add_nth i a (rem_nth i (map \<sigma> xs)) = map (\<sigma>(n := a)) xs"
   by (induction xs arbitrary: i) (auto simp: pos_set split: option.splits)
 
 lemma add_nth_rem_nth_self: "i < length xs \<Longrightarrow> add_nth i (xs ! i) (rem_nth i xs) = xs"
   by (induction i xs rule: rem_nth.induct) auto
 
 lemma rem_nth_add_nth: "i \<le> length zs \<Longrightarrow> rem_nth i (add_nth i z zs) = zs"
   by (induction i z zs rule: add_nth.induct) (auto split: list.splits)
 
 fun merge :: "(nat \<times> 'a) list \<Rightarrow> (nat \<times> 'a) list \<Rightarrow> (nat \<times> 'a) list" where
   "merge [] mys = mys"
 | "merge nxs [] = nxs"
 | "merge ((n, x) # nxs) ((m, y) # mys) =
     (if n \<le> m then (n, x) # merge nxs ((m, y) # mys)
     else (m, y) # merge ((n, x) # nxs) mys)"
 
 lemma merge_Nil2[simp]: "merge nxs [] = nxs"
   by (cases nxs) auto
 
 lemma merge_length: "length (merge nxs mys) = length (map fst nxs @ map fst mys)"
   by (induction nxs mys rule: merge.induct) auto
 
 lemma insort_aux_le: "\<forall>x\<in>set nxs. n \<le> fst x \<Longrightarrow> \<forall>x\<in>set mys. m \<le> fst x \<Longrightarrow> n \<le> m \<Longrightarrow>
   insort n (sort (map fst nxs @ m # map fst mys)) = n # sort (map fst nxs @ m # map fst mys)"
   by (induction nxs) (auto simp: insort_is_Cons insort_left_comm)
 
 lemma insort_aux_gt: "\<forall>x\<in>set nxs. n \<le> fst x \<Longrightarrow> \<forall>x\<in>set mys. m \<le> fst x \<Longrightarrow> \<not> n \<le> m \<Longrightarrow>
   insort n (sort (map fst nxs @ m # map fst mys)) =
     m # insort n (sort (map fst nxs @ map fst mys))"
   apply (induction nxs)
    apply (auto simp: insort_is_Cons)
   by (metis dual_order.trans insort_key.simps(2) insort_left_comm)
 
 lemma map_fst_merge: "sorted_distinct (map fst nxs) \<Longrightarrow> sorted_distinct (map fst mys) \<Longrightarrow>
   map fst (merge nxs mys) = sort (map fst nxs @ map fst mys)"
   by (induction nxs mys rule: merge.induct)
      (auto simp add: sorted_sort_id insort_is_Cons insort_aux_le insort_aux_gt)
 
 lemma merge_map': "sorted_distinct (map fst nxs) \<Longrightarrow> sorted_distinct (map fst mys) \<Longrightarrow>
   fst ` set nxs \<inter> fst ` set mys = {} \<Longrightarrow>
   map snd nxs = map \<sigma> (map fst nxs) \<Longrightarrow> map snd mys = map \<sigma> (map fst mys) \<Longrightarrow>
   map snd (merge nxs mys) = map \<sigma> (sort (map fst nxs @ map fst mys))"
   by (induction nxs mys rule: merge.induct)
      (auto simp: sorted_sort_id insort_is_Cons insort_aux_le insort_aux_gt)
 
 lemma merge_map: "sorted_distinct ns \<Longrightarrow> sorted_distinct ms \<Longrightarrow> set ns \<inter> set ms = {} \<Longrightarrow>
   map snd (merge (zip ns (map \<sigma> ns)) (zip ms (map \<sigma> ms))) = map \<sigma> (sort (ns @ ms))"
   using merge_map'[of "zip ns (map \<sigma> ns)" "zip ms (map \<sigma> ms)" \<sigma>]
   by auto (metis length_map list.set_map map_fst_zip)
 
 fun fo_nmlz_rec :: "nat \<Rightarrow> ('a + nat \<rightharpoonup> nat) \<Rightarrow> 'a set \<Rightarrow>
   ('a + nat) list \<Rightarrow> ('a + nat) list" where
   "fo_nmlz_rec i m AD [] = []"
 | "fo_nmlz_rec i m AD (Inl x # xs) = (if x \<in> AD then Inl x # fo_nmlz_rec i m AD xs else
     (case m (Inl x) of None \<Rightarrow> Inr i # fo_nmlz_rec (Suc i) (m(Inl x \<mapsto> i)) AD xs
     | Some j \<Rightarrow> Inr j # fo_nmlz_rec i m AD xs))"
 | "fo_nmlz_rec i m AD (Inr n # xs) = (case m (Inr n) of None \<Rightarrow>
     Inr i # fo_nmlz_rec (Suc i) (m(Inr n \<mapsto> i)) AD xs
   | Some j \<Rightarrow> Inr j # fo_nmlz_rec i m AD xs)"
 
 lemma fo_nmlz_rec_sound: "ran m \<subseteq> {..<i} \<Longrightarrow> filter ((\<le>) i) (rremdups
   (List.map_filter (case_sum Map.empty Some) (fo_nmlz_rec i m AD xs))) = ns \<Longrightarrow>
   ns = [i..<i + length ns]"
 proof (induction i m AD xs arbitrary: ns rule: fo_nmlz_rec.induct)
   case (2 i m AD x xs)
   then show ?case
   proof (cases "x \<in> AD")
     case False
     show ?thesis
     proof (cases "m (Inl x)")
       case None
       have pred: "ran (m(Inl x \<mapsto> i)) \<subseteq> {..<Suc i}"
         using 2(4) None
         by (auto simp: inj_on_def dom_def ran_def)
       have "ns = i # filter ((\<le>) (Suc i)) (rremdups
         (List.map_filter (case_sum Map.empty Some) (fo_nmlz_rec (Suc i) (m(Inl x \<mapsto> i)) AD xs)))"
         using 2(5) False None
         by (auto simp: List.map_filter_simps filter_rremdups)
            (metis Suc_leD antisym not_less_eq_eq)
       then show ?thesis
         by (auto simp: 2(2)[OF False None pred, OF refl])
            (smt Suc_le_eq Suc_pred le_add1 le_zero_eq less_add_same_cancel1 not_less_eq_eq
             upt_Suc_append upt_rec)
     next
       case (Some j)
       then have j_lt_i: "j < i"
         using 2(4)
         by (auto simp: ran_def)
       have ns_def: "ns = filter ((\<le>) i) (rremdups
         (List.map_filter (case_sum Map.empty Some) (fo_nmlz_rec i m AD xs)))"
         using 2(5) False Some j_lt_i
         by (auto simp: List.map_filter_simps filter_rremdups) (metis leD)
       show ?thesis
         by (rule 2(3)[OF False Some 2(4) ns_def[symmetric]])
     qed
   qed (auto simp: List.map_filter_simps split: option.splits)
 next
   case (3 i m AD n xs)
   show ?case
   proof (cases "m (Inr n)")
     case None
     have pred: "ran (m(Inr n \<mapsto> i)) \<subseteq> {..<Suc i}"
       using 3(3) None
       by (auto simp: inj_on_def dom_def ran_def)
     have "ns = i # filter ((\<le>) (Suc i)) (rremdups
       (List.map_filter (case_sum Map.empty Some) (fo_nmlz_rec (Suc i) (m(Inr n \<mapsto> i)) AD xs)))"
       using 3(4) None
       by (auto simp: List.map_filter_simps filter_rremdups) (metis Suc_leD antisym not_less_eq_eq)
     then show ?thesis
       by (auto simp add: 3(1)[OF None pred, OF refl])
          (smt Suc_le_eq Suc_pred le_add1 le_zero_eq less_add_same_cancel1 not_less_eq_eq
           upt_Suc_append upt_rec)
   next
     case (Some j)
     then have j_lt_i: "j < i"
       using 3(3)
       by (auto simp: ran_def)
     have ns_def: "ns = filter ((\<le>) i) (rremdups
       (List.map_filter (case_sum Map.empty Some) (fo_nmlz_rec i m AD xs)))"
       using 3(4) Some j_lt_i
       by (auto simp: List.map_filter_simps filter_rremdups) (metis leD)
     show ?thesis
       by (rule 3(2)[OF Some 3(3) ns_def[symmetric]])
   qed
 qed (auto simp: List.map_filter_simps)
 
 definition id_map :: "nat \<Rightarrow> ('a + nat \<rightharpoonup> nat)" where
   "id_map n = (\<lambda>x. case x of Inl x \<Rightarrow> None | Inr x \<Rightarrow> if x < n then Some x else None)"
 
 lemma fo_nmlz_rec_idem: "Inl -` set ys \<subseteq> AD \<Longrightarrow>
   rremdups (List.map_filter (case_sum Map.empty Some) ys) = ns \<Longrightarrow>
   set (filter (\<lambda>n. n < i) ns) \<subseteq> {..<i} \<Longrightarrow> filter ((\<le>) i) ns = [i..<i + k] \<Longrightarrow>
   fo_nmlz_rec i (id_map i) AD ys = ys"
 proof (induction ys arbitrary: i k ns)
   case (Cons y ys)
   show ?case
   proof (cases y)
     case (Inl a)
     show ?thesis
       using Cons(1)[OF _ _ Cons(4,5)] Cons(2,3)
       by (auto simp: Inl List.map_filter_simps)
   next
     case (Inr j)
     show ?thesis
     proof (cases "j < i")
       case False
       have j_i: "j = i"
         using False Cons(3,5)
         by (auto simp: Inr List.map_filter_simps filter_rremdups in_mono split: if_splits)
            (metis (no_types, lifting) upt_eq_Cons_conv)
       obtain kk where k_def: "k = Suc kk"
         using Cons(3,5)
         by (cases k) (auto simp: Inr List.map_filter_simps j_i)
       define ns' where "ns' = rremdups (List.map_filter (case_sum Map.empty Some) ys)"
       have id_map_None: "id_map i (Inr i) = None"
         by (auto simp: id_map_def)
-      have id_map_upd: "id_map i(Inr i \<mapsto> i) = id_map (Suc i)"
+      have id_map_upd: "(id_map i)(Inr i \<mapsto> i) = id_map (Suc i)"
         by (auto simp: id_map_def split: sum.splits)
       have "set (filter (\<lambda>n. n < Suc i) ns') \<subseteq> {..<Suc i}"
         using Cons(2,3)
         by auto
       moreover have "filter ((\<le>) (Suc i)) ns' = [Suc i..<i + k]"
         using Cons(3,5)
         by (auto simp: Inr List.map_filter_simps j_i filter_rremdups[symmetric] ns'_def[symmetric])
            (smt One_nat_def Suc_eq_plus1 Suc_le_eq add_diff_cancel_left' diff_is_0_eq'
             dual_order.order_iff_strict filter_cong n_not_Suc_n upt_eq_Cons_conv)
       moreover have "Inl -` set ys \<subseteq> AD"
         using Cons(2)
         by (auto simp: vimage_def)
       ultimately have "fo_nmlz_rec (Suc i) ((id_map i)(Inr i \<mapsto> i)) AD ys = ys"
         using Cons(1)[OF _ ns'_def[symmetric], of "Suc i" kk]
         by (auto simp: ns'_def k_def id_map_upd split: if_splits)
       then show ?thesis
         by (auto simp: Inr j_i id_map_None)
     next
       case True
       define ns' where "ns' = rremdups (List.map_filter (case_sum Map.empty Some) ys)"
       have "set (filter (\<lambda>y. y < i) ns') \<subseteq> set (filter (\<lambda>y. y < i) ns)"
         "filter ((\<le>) i) ns' = filter ((\<le>) i) ns"
         using Cons(3) True
         by (auto simp: Inr List.map_filter_simps filter_rremdups[symmetric] ns'_def[symmetric])
            (smt filter_cong leD)
       then have "fo_nmlz_rec i (id_map i) AD ys = ys"
         using Cons(1)[OF _ ns'_def[symmetric]] Cons(3,5) Cons(2)
         by (auto simp: vimage_def)
       then show ?thesis
         using True
         by (auto simp: Inr id_map_def)
     qed
   qed
 qed (auto simp: List.map_filter_simps intro!: exI[of _ "[]"])
 
 lemma fo_nmlz_rec_length: "length (fo_nmlz_rec i m AD xs) = length xs"
   by (induction i m AD xs rule: fo_nmlz_rec.induct) (auto simp: fun_upd_def split: option.splits)
 
 lemma insert_Inr: "\<And>X. insert (Inr i) (X \<union> Inr ` {..<i}) = X \<union> Inr ` {..<Suc i}"
   by auto
 
 lemma fo_nmlz_rec_set: "ran m \<subseteq> {..<i} \<Longrightarrow> set (fo_nmlz_rec i m AD xs) \<union> Inr ` {..<i} =
   set xs \<inter> Inl ` AD \<union> Inr ` {..<i + card (set xs - Inl ` AD - dom m)}"
 proof (induction i m AD xs rule: fo_nmlz_rec.induct)
   case (2 i m AD x xs)
   have fin: "finite (set (Inl x # xs) - Inl ` AD - dom m)"
     by auto
   show ?case
     using 2(1)[OF _ 2(4)]
   proof (cases "x \<in> AD")
     case True
     have "card (set (Inl x # xs) - Inl ` AD - dom m) = card (set xs - Inl ` AD - dom m)"
       using True
       by auto
     then show ?thesis
       using 2(1)[OF True 2(4)] True
       by auto
   next
     case False
     show ?thesis
     proof (cases "m (Inl x)")
       case None
       have pred: "ran (m(Inl x \<mapsto> i)) \<subseteq> {..<Suc i}"
         using 2(4) None
         by (auto simp: inj_on_def dom_def ran_def)
       have "set (Inl x # xs) - Inl ` AD - dom m =
         {Inl x} \<union> (set xs - Inl ` AD - dom (m(Inl x \<mapsto> i)))"
         using None False
         by (auto simp: dom_def)
       then have Suc: "Suc i + card (set xs - Inl ` AD - dom (m(Inl x \<mapsto> i))) =
         i + card (set (Inl x # xs) - Inl ` AD - dom m)"
         using None
         by auto
       show ?thesis
         using 2(2)[OF False None pred] False None
         unfolding Suc
         by (auto simp: fun_upd_def[symmetric] insert_Inr)
     next
       case (Some j)
       then have j_lt_i: "j < i"
         using 2(4)
         by (auto simp: ran_def)
       have "card (set (Inl x # xs) - Inl ` AD - dom m) = card (set xs - Inl ` AD - dom m)"
         by (auto simp: Some intro: arg_cong[of _ _ card])
       then show ?thesis
         using 2(3)[OF False Some 2(4)] False Some j_lt_i
         by auto
     qed
   qed
 next
   case (3 i m AD k xs)
   then show ?case
   proof (cases "m (Inr k)")
     case None
     have preds: "ran (m(Inr k \<mapsto> i)) \<subseteq> {..<Suc i}"
       using 3(3)
       by (auto simp: ran_def)
     have "set (Inr k # xs) - Inl ` AD - dom m =
       {Inr k} \<union> (set xs - Inl ` AD - dom (m(Inr k \<mapsto> i)))"
       using None
       by (auto simp: dom_def)
     then have Suc: "Suc i + card (set xs - Inl ` AD - dom (m(Inr k \<mapsto> i))) =
       i + card (set (Inr k # xs) - Inl ` AD - dom m)"
       using None
       by auto
     show ?thesis
       using None 3(1)[OF None preds]
       unfolding Suc
       by (auto simp: fun_upd_def[symmetric] insert_Inr)
   next
     case (Some j)
     have fin: "finite (set (Inr k # xs) - Inl ` AD - dom m)"
       by auto
     have card_eq: "card (set xs - Inl ` AD - dom m) = card (set (Inr k # xs) - Inl ` AD - dom m)"
       by (auto simp: Some intro!: arg_cong[of _ _ card])
     have j_lt_i: "j < i"
       using 3(3) Some
       by (auto simp: ran_def)
     show ?thesis
       using 3(2)[OF Some 3(3)] j_lt_i
       unfolding card_eq
       by (auto simp: ran_def insert_Inr Some)
   qed
 qed auto
 
 lemma fo_nmlz_rec_set_rev: "set (fo_nmlz_rec i m AD xs) \<subseteq> Inl ` AD \<Longrightarrow> set xs \<subseteq> Inl ` AD"
   by (induction i m AD xs rule: fo_nmlz_rec.induct) (auto split: if_splits option.splits)
 
 lemma fo_nmlz_rec_map: "inj_on m (dom m) \<Longrightarrow> ran m \<subseteq> {..<i} \<Longrightarrow> \<exists>m'. inj_on m' (dom m') \<and>
   (\<forall>n. m n \<noteq> None \<longrightarrow> m' n = m n) \<and> (\<forall>(x, y) \<in> set (zip xs (fo_nmlz_rec i m AD xs)).
     (case x of Inl x' \<Rightarrow> if x' \<in> AD then x = y else \<exists>j. m' (Inl x') = Some j \<and> y = Inr j
     | Inr n \<Rightarrow> \<exists>j. m' (Inr n) = Some j \<and> y = Inr j))"
 proof (induction i m AD xs rule: fo_nmlz_rec.induct)
   case (2 i m AD x xs)
   show ?case
     using 2(1)[OF _ 2(4,5)]
   proof (cases "x \<in> AD")
     case False
     show ?thesis
     proof (cases "m (Inl x)")
       case None
       have preds: "inj_on (m(Inl x \<mapsto> i)) (dom (m(Inl x \<mapsto> i)))" "ran (m(Inl x \<mapsto> i)) \<subseteq> {..<Suc i}"
         using 2(4,5)
         by (auto simp: inj_on_def ran_def)
       show ?thesis
         using 2(2)[OF False None preds] False None
         apply safe
         subgoal for m'
           by (auto simp: fun_upd_def split: sum.splits intro!: exI[of _ m'])
         done
     next
       case (Some j)
       show ?thesis
         using 2(3)[OF False Some 2(4,5)] False Some
         apply safe
         subgoal for m'
           by (auto split: sum.splits intro!: exI[of _ m'])
         done
     qed
   qed auto
 next
   case (3 i m AD n xs)
   show ?case
   proof (cases "m (Inr n)")
     case None
     have preds: "inj_on (m(Inr n \<mapsto> i)) (dom (m(Inr n \<mapsto> i)))" "ran (m(Inr n \<mapsto> i)) \<subseteq> {..<Suc i}"
       using 3(3,4)
       by (auto simp: inj_on_def ran_def)
     show ?thesis
       using 3(1)[OF None preds] None
       apply safe
       subgoal for m'
         by (auto simp: fun_upd_def intro!: exI[of _ m'] split: sum.splits)
       done
   next
     case (Some j)
     show ?thesis
       using 3(2)[OF Some 3(3,4)] Some
       apply safe
       subgoal for m'
         by (auto simp: fun_upd_def intro!: exI[of _ m'] split: sum.splits)
       done
   qed
 qed auto
 
 lemma ad_agr_map:
   assumes "length xs = length ys" "inj_on m (dom m)"
     "\<And>x y. (x, y) \<in> set (zip xs ys) \<Longrightarrow> (case x of Inl x' \<Rightarrow>
     if x' \<in> AD then x = y else m x = Some y \<and> (case y of Inl z \<Rightarrow> z \<notin> AD | Inr _ \<Rightarrow> True)
   | Inr n \<Rightarrow> m x = Some y \<and> (case y of Inl z \<Rightarrow> z \<notin> AD | Inr _ \<Rightarrow> True))"
   shows "ad_agr_list AD xs ys"
 proof -
   have "ad_equiv_pair AD (a, b)" if "(a, b) \<in> set (zip xs ys)" for a b
     unfolding ad_equiv_pair.simps
     using assms(3)[OF that]
     by (auto split: sum.splits if_splits)
   moreover have "False" if "(a, c) \<in> set (zip xs ys)" "(b, c) \<in> set (zip xs ys)" "a \<noteq> b" for a b c
     using assms(3)[OF that(1)] assms(3)[OF that(2)] assms(2) that(3)
     by (auto split: sum.splits if_splits) (metis domI inj_onD that(3))+
   moreover have "False" if "(a, b) \<in> set (zip xs ys)" "(a, c) \<in> set (zip xs ys)" "b \<noteq> c" for a b c
     using assms(3)[OF that(1)] assms(3)[OF that(2)] assms(2) that(3)
     by (auto split: sum.splits if_splits)
   ultimately show ?thesis
     using assms
     by (fastforce simp: ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
 qed
 
 lemma fo_nmlz_rec_take: "take n (fo_nmlz_rec i m AD xs) = fo_nmlz_rec i m AD (take n xs)"
   by (induction i m AD xs arbitrary: n rule: fo_nmlz_rec.induct)
      (auto simp: take_Cons' split: option.splits)
 
 definition fo_nmlz :: "'a set \<Rightarrow> ('a + nat) list \<Rightarrow> ('a + nat) list" where
   "fo_nmlz = fo_nmlz_rec 0 Map.empty"
 
 lemma fo_nmlz_Nil[simp]: "fo_nmlz AD [] = []"
   by (auto simp: fo_nmlz_def)
 
 lemma fo_nmlz_Cons: "fo_nmlz AD [x] =
   (case x of Inl x \<Rightarrow> if x \<in> AD then [Inl x] else [Inr 0] | _ \<Rightarrow> [Inr 0])"
   by (auto simp: fo_nmlz_def split: sum.splits)
 
 lemma fo_nmlz_Cons_Cons: "fo_nmlz AD [x, x] =
   (case x of Inl x \<Rightarrow> if x \<in> AD then [Inl x, Inl x] else [Inr 0, Inr 0] | _ \<Rightarrow> [Inr 0, Inr 0])"
   by (auto simp: fo_nmlz_def split: sum.splits)
 
 lemma fo_nmlz_sound: "fo_nmlzd AD (fo_nmlz AD xs)"
   using fo_nmlz_rec_sound[of Map.empty 0] fo_nmlz_rec_set[of Map.empty 0 AD xs]
   by (auto simp: fo_nmlzd_def fo_nmlz_def nats_def Let_def)
 
 lemma fo_nmlz_length: "length (fo_nmlz AD xs) = length xs"
   using fo_nmlz_rec_length
   by (auto simp: fo_nmlz_def)
 
 lemma fo_nmlz_map: "\<exists>\<tau>. fo_nmlz AD (map \<sigma> ns) = map \<tau> ns"
 proof -
   obtain m' where m'_def: "\<forall>(x, y)\<in>set (zip (map \<sigma> ns) (fo_nmlz AD (map \<sigma> ns))).
     case x of Inl x' \<Rightarrow> if x' \<in> AD then x = y else \<exists>j. m' (Inl x') = Some j \<and> y = Inr j
     | Inr n \<Rightarrow> \<exists>j. m' (Inr n) = Some j \<and> y = Inr j"
     using fo_nmlz_rec_map[of Map.empty 0, of "map \<sigma> ns"]
     by (auto simp: fo_nmlz_def)
   define \<tau> where "\<tau> \<equiv> (\<lambda>n. case \<sigma> n of Inl x \<Rightarrow> if x \<in> AD then Inl x else Inr (the (m' (Inl x)))
     | Inr j \<Rightarrow> Inr (the (m' (Inr j))))"
   have "fo_nmlz AD (map \<sigma> ns) = map \<tau> ns"
   proof (rule nth_equalityI)
     show "length (fo_nmlz AD (map \<sigma> ns)) = length (map \<tau> ns)"
       using fo_nmlz_length[of AD "map \<sigma> ns"]
       by auto
     fix i
     assume "i < length (fo_nmlz AD (map \<sigma> ns))"
     then show "fo_nmlz AD (map \<sigma> ns) ! i = map \<tau> ns ! i"
       using m'_def fo_nmlz_length[of AD "map \<sigma> ns"]
       apply (auto simp: set_zip \<tau>_def split: sum.splits)
         apply (metis nth_map)
        apply (metis nth_map option.sel)+
       done
   qed
   then show ?thesis
     by auto
 qed
 
 lemma card_set_minus: "card (set xs - X) \<le> length xs"
   by (meson Diff_subset List.finite_set card_length card_mono order_trans)
 
 lemma fo_nmlz_set: "set (fo_nmlz AD xs) =
   set xs \<inter> Inl ` AD \<union> Inr ` {..<min (length xs) (card (set xs - Inl ` AD))}"
   using fo_nmlz_rec_set[of Map.empty 0 AD xs]
   by (auto simp add: fo_nmlz_def card_set_minus)
 
 lemma fo_nmlz_set_rev: "set (fo_nmlz AD xs) \<subseteq> Inl ` AD \<Longrightarrow> set xs \<subseteq> Inl ` AD"
   using fo_nmlz_rec_set_rev[of 0 Map.empty AD xs]
   by (auto simp: fo_nmlz_def)
 
 lemma inj_on_empty: "inj_on Map.empty (dom Map.empty)" and ran_empty_upto: "ran Map.empty \<subseteq> {..<0}"
   by auto
 
 lemma fo_nmlz_ad_agr: "ad_agr_list AD xs (fo_nmlz AD xs)"
   using fo_nmlz_rec_map[OF inj_on_empty ran_empty_upto, of xs AD]
   unfolding fo_nmlz_def
   apply safe
   subgoal for m'
     by (fastforce simp: inj_on_def dom_def split: sum.splits if_splits
         intro!: ad_agr_map[OF fo_nmlz_rec_length[symmetric], of "map_option Inr \<circ> m'"])
   done
 
 lemma fo_nmlzd_mono: "Inl -` set xs \<subseteq> AD \<Longrightarrow> fo_nmlzd AD' xs \<Longrightarrow> fo_nmlzd AD xs"
   by (auto simp: fo_nmlzd_def)
 
 lemma fo_nmlz_idem: "fo_nmlzd AD ys \<Longrightarrow> fo_nmlz AD ys = ys"
   using fo_nmlz_rec_idem[where ?i=0]
   by (auto simp: fo_nmlzd_def fo_nmlz_def id_map_def nats_def Let_def)
 
 lemma fo_nmlz_take: "take n (fo_nmlz AD xs) = fo_nmlz AD (take n xs)"
   using fo_nmlz_rec_take
   by (auto simp: fo_nmlz_def)
 
 fun nall_tuples_rec :: "'a set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('a + nat) table" where
   "nall_tuples_rec AD i 0 = {[]}"
 | "nall_tuples_rec AD i (Suc n) = \<Union>((\<lambda>as. (\<lambda>x. x # as) ` (Inl ` AD \<union> Inr ` {..<i})) `
     nall_tuples_rec AD i n) \<union> (\<lambda>as. Inr i # as) ` nall_tuples_rec AD (Suc i) n"
 
 lemma nall_tuples_rec_Inl: "vs \<in> nall_tuples_rec AD i n \<Longrightarrow> Inl -` set vs \<subseteq> AD"
   by (induction AD i n arbitrary: vs rule: nall_tuples_rec.induct) (fastforce simp: vimage_def)+
 
 lemma nall_tuples_rec_length: "xs \<in> nall_tuples_rec AD i n \<Longrightarrow> length xs = n"
   by (induction AD i n arbitrary: xs rule: nall_tuples_rec.induct) auto
 
-lemma fun_upd_id_map: "id_map i(Inr i \<mapsto> i) = id_map (Suc i)"
+lemma fun_upd_id_map: "(id_map i)(Inr i \<mapsto> i) = id_map (Suc i)"
   by (rule ext) (auto simp: id_map_def split: sum.splits)
 
 lemma id_mapD: "id_map j (Inr i) = None \<Longrightarrow> j \<le> i" "id_map j (Inr i) = Some x \<Longrightarrow> i < j \<and> i = x"
   by (auto simp: id_map_def split: if_splits)
 
 lemma nall_tuples_rec_fo_nmlz_rec_sound: "i \<le> j \<Longrightarrow> xs \<in> nall_tuples_rec AD i n \<Longrightarrow>
   fo_nmlz_rec j (id_map j) AD xs = xs"
   apply (induction n arbitrary: i j xs)
    apply (auto simp: fun_upd_id_map dest!: id_mapD split: option.splits)
     apply (meson dual_order.strict_trans2 id_mapD(1) not_Some_eq sup.strict_order_iff)
   using Suc_leI apply blast+
   done
 
 lemma nall_tuples_rec_fo_nmlz_rec_complete:
   assumes "fo_nmlz_rec j (id_map j) AD xs = xs"
   shows "xs \<in> nall_tuples_rec AD j (length xs)"
   using assms
 proof (induction xs arbitrary: j)
   case (Cons x xs)
   show ?case
   proof (cases x)
     case (Inl a)
     have a_AD: "a \<in> AD"
       using Cons(2)
       by (auto simp: Inl split: if_splits option.splits)
     show ?thesis
       using Cons a_AD
       by (auto simp: Inl)
   next
     case (Inr b)
     have b_j: "b \<le> j"
       using Cons(2)
       by (auto simp: Inr split: option.splits dest: id_mapD)
     show ?thesis
     proof (cases "b = j")
       case True
       have preds: "fo_nmlz_rec (Suc j) (id_map (Suc j)) AD xs = xs"
         using Cons(2)
         by (auto simp: Inr True fun_upd_id_map dest: id_mapD split: option.splits)
       show ?thesis
         using Cons(1)[OF preds]
         by (auto simp: Inr True)
     next
       case False
       have b_lt_j: "b < j"
         using b_j False
         by auto
       have id_map: "id_map j (Inr b) = Some b"
         using b_lt_j
         by (auto simp: id_map_def)
       have preds: "fo_nmlz_rec j (id_map j) AD xs = xs"
         using Cons(2)
         by (auto simp: Inr id_map)
       show ?thesis
         using Cons(1)[OF preds] b_lt_j
         by (auto simp: Inr)
     qed
   qed
 qed auto
 
 lemma nall_tuples_rec_fo_nmlz: "xs \<in> nall_tuples_rec AD 0 (length xs) \<longleftrightarrow> fo_nmlz AD xs = xs"
   using nall_tuples_rec_fo_nmlz_rec_sound[of 0 0 xs AD "length xs"]
     nall_tuples_rec_fo_nmlz_rec_complete[of 0 AD xs]
   by (auto simp: fo_nmlz_def id_map_def)
 
 lemma fo_nmlzd_code[code]: "fo_nmlzd AD xs \<longleftrightarrow> fo_nmlz AD xs = xs"
   using fo_nmlz_idem fo_nmlz_sound
   by metis
 
 lemma nall_tuples_code[code]: "nall_tuples AD n = nall_tuples_rec AD 0 n"
   unfolding nall_tuples_set
   using nall_tuples_rec_length trans[OF nall_tuples_rec_fo_nmlz fo_nmlzd_code[symmetric]]
   by fastforce
 
 lemma exists_map: "length xs = length ys \<Longrightarrow> distinct xs \<Longrightarrow> \<exists>f. ys = map f xs"
 proof (induction xs ys rule: list_induct2)
   case (Cons x xs y ys)
   then obtain f where f_def: "ys = map f xs"
     by auto
   with Cons(3) have "y # ys = map (f(x := y)) (x # xs)"
     by auto
   then show ?case
     by metis
 qed auto
 
 lemma exists_fo_nmlzd:
   assumes "length xs = length ys" "distinct xs" "fo_nmlzd AD ys"
   shows "\<exists>f. ys = fo_nmlz AD (map f xs)"
   using fo_nmlz_idem[OF assms(3)] exists_map[OF _ assms(2)] assms(1)
   by metis
 
 lemma list_induct2_rev[consumes 1]: "length xs = length ys \<Longrightarrow> (P [] []) \<Longrightarrow>
   (\<And>x y xs ys. P xs ys \<Longrightarrow> P (xs @ [x]) (ys @ [y])) \<Longrightarrow> P xs ys"
 proof (induction "length xs" arbitrary: xs ys)
   case (Suc n)
   then show ?case
     by (cases xs rule: rev_cases; cases ys rule: rev_cases) auto
 qed auto
 
 lemma ad_agr_list_fo_nmlzd:
   assumes "ad_agr_list AD vs vs'" "fo_nmlzd AD vs" "fo_nmlzd AD vs'"
   shows "vs = vs'"
   using ad_agr_list_length[OF assms(1)] assms
 proof (induction vs vs' rule: list_induct2_rev)
   case (2 x y xs ys)
   have norms: "fo_nmlzd AD xs" "fo_nmlzd AD ys"
     using 2(3,4)
     by (auto simp: fo_nmlzd_def nats_def Let_def map_filter_app rremdups_app
         split: sum.splits if_splits)
   have ad_agr: "ad_agr_list AD xs ys"
     using 2(2)
     by (auto simp: ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
   note xs_ys = 2(1)[OF ad_agr norms]
   have "x = y"
   proof (cases "isl x \<or> isl y")
     case True
     then have "isl x \<longrightarrow> projl x \<in> AD" "isl y \<longrightarrow> projl y \<in> AD"
       using 2(3,4)
       by (auto simp: fo_nmlzd_def)
     then show ?thesis
       using 2(2) True
       apply (auto simp: ad_agr_list_def ad_equiv_list_def isl_def)
       unfolding ad_equiv_pair.simps
       by blast+
   next
     case False
     then obtain x' y' where inr: "x = Inr x'" "y = Inr y'"
       by (cases x; cases y) auto
     show ?thesis
       using 2(2) xs_ys
     proof (cases "x \<in> set xs \<or> y \<in> set ys")
       case False
       then show ?thesis
         using fo_nmlzd_app_Inr 2(3,4)
         unfolding inr xs_ys
         by auto
     qed (auto simp: ad_agr_list_def sp_equiv_list_def pairwise_def set_zip in_set_conv_nth)
   qed
   then show ?case
     using xs_ys
     by auto
 qed auto
 
 lemma fo_nmlz_eqI:
   assumes "ad_agr_list AD vs vs'"
   shows "fo_nmlz AD vs = fo_nmlz AD vs'"
   using ad_agr_list_fo_nmlzd[OF
         ad_agr_list_trans[OF ad_agr_list_trans[OF
         ad_agr_list_comm[OF fo_nmlz_ad_agr[of AD vs]] assms]
         fo_nmlz_ad_agr[of AD vs']] fo_nmlz_sound fo_nmlz_sound] .
 
 lemma fo_nmlz_eqD:
   assumes "fo_nmlz AD vs = fo_nmlz AD vs'"
   shows "ad_agr_list AD vs vs'"
   using ad_agr_list_trans[OF fo_nmlz_ad_agr[of AD vs, unfolded assms]
         ad_agr_list_comm[OF fo_nmlz_ad_agr[of AD vs']]] .
 
 lemma fo_nmlz_eq: "fo_nmlz AD vs = fo_nmlz AD vs' \<longleftrightarrow> ad_agr_list AD vs vs'"
   using fo_nmlz_eqI[where ?AD=AD] fo_nmlz_eqD[where ?AD=AD]
   by blast
 
 lemma fo_nmlz_mono:
   assumes "AD \<subseteq> AD'" "Inl -` set xs \<subseteq> AD"
   shows "fo_nmlz AD' xs = fo_nmlz AD xs"
 proof -
   have "fo_nmlz AD (fo_nmlz AD' xs) = fo_nmlz AD' xs"
     apply (rule fo_nmlz_idem[OF fo_nmlzd_mono[OF _ fo_nmlz_sound]])
     using assms
     by (auto simp: fo_nmlz_set)
   moreover have "fo_nmlz AD xs = fo_nmlz AD (fo_nmlz AD' xs)"
     apply (rule fo_nmlz_eqI)
     apply (rule ad_agr_list_mono[OF assms(1)])
     apply (rule fo_nmlz_ad_agr)
     done
   ultimately show ?thesis
     by auto
 qed
 
 definition proj_vals :: "'c val set \<Rightarrow> nat list \<Rightarrow> 'c table" where
   "proj_vals R ns = (\<lambda>\<tau>. map \<tau> ns) ` R"
 
 definition proj_fmla :: "('a, 'b) fo_fmla \<Rightarrow> 'c val set \<Rightarrow> 'c table" where
   "proj_fmla \<phi> R = proj_vals R (fv_fo_fmla_list \<phi>)"
 
 lemmas proj_fmla_map = proj_fmla_def[unfolded proj_vals_def]
 
 definition "extends_subst \<sigma> \<tau> = (\<forall>x. \<sigma> x \<noteq> None \<longrightarrow> \<sigma> x = \<tau> x)"
 
 definition ext_tuple :: "'a set \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow>
   ('a + nat) list \<Rightarrow> ('a + nat) list set" where
   "ext_tuple AD fv_sub fv_sub_comp as = (if fv_sub_comp = [] then {as}
     else (\<lambda>fs. map snd (merge (zip fv_sub as) (zip fv_sub_comp fs))) `
     (nall_tuples_rec AD (card (Inr -` set as)) (length fv_sub_comp)))"
 
 lemma ext_tuple_eq: "length fv_sub = length as \<Longrightarrow>
   ext_tuple AD fv_sub fv_sub_comp as =
   (\<lambda>fs. map snd (merge (zip fv_sub as) (zip fv_sub_comp fs))) `
   (nall_tuples_rec AD (card (Inr -` set as)) (length fv_sub_comp))"
   using fo_nmlz_idem[of AD as]
   by (auto simp: ext_tuple_def)
 
 lemma map_map_of: "length xs = length ys \<Longrightarrow> distinct xs \<Longrightarrow>
   ys = map (the \<circ> (map_of (zip xs ys))) xs"
   by (induction xs ys rule: list_induct2) (auto simp: fun_upd_comp)
 
 lemma id_map_empty: "id_map 0 = Map.empty"
   by (rule ext) (auto simp: id_map_def split: sum.splits)
 
 lemma fo_nmlz_rec_shift:
   fixes xs :: "('a + nat) list"
   shows "fo_nmlz_rec i (id_map i) AD xs = xs \<Longrightarrow>
   i' = card (Inr -` (Inr ` {..<i} \<union> set (take n xs))) \<Longrightarrow> n \<le> length xs \<Longrightarrow>
   fo_nmlz_rec i' (id_map i') AD (drop n xs) = drop n xs"
 proof (induction i "id_map i :: 'a + nat \<rightharpoonup> nat" AD xs arbitrary: n rule: fo_nmlz_rec.induct)
   case (2 i AD x xs)
   have preds: "x \<in> AD" "fo_nmlz_rec i (id_map i) AD xs = xs"
     using 2(4)
     by (auto split: if_splits option.splits)
   show ?case
     using 2(4,5)
   proof (cases n)
     case (Suc k)
     have k_le: "k \<le> length xs"
       using 2(6)
       by (auto simp: Suc)
     have i'_def: "i' = card (Inr -` (Inr ` {..<i} \<union> set (take k xs)))"
       using 2(5)
       by (auto simp: Suc vimage_def)
     show ?thesis
       using 2(1)[OF preds i'_def k_le]
       by (auto simp: Suc)
   qed (auto simp: inj_vimage_image_eq)
 next
   case (3 i AD j xs)
   show ?case
     using 3(3,4)
   proof (cases n)
     case (Suc k)
     have k_le: "k \<le> length xs"
       using 3(5)
       by (auto simp: Suc)
     have j_le_i: "j \<le> i"
       using 3(3)
       by (auto split: option.splits dest: id_mapD)
     show ?thesis
     proof (cases "j = i")
       case True
-      have id_map: "id_map i (Inr j) = None" "id_map i(Inr j \<mapsto> i) = id_map (Suc i)"
+      have id_map: "id_map i (Inr j) = None" "(id_map i)(Inr j \<mapsto> i) = id_map (Suc i)"
         unfolding True fun_upd_id_map
         by (auto simp: id_map_def)
       have norm_xs: "fo_nmlz_rec (Suc i) (id_map (Suc i)) AD xs = xs"
         using 3(3)
         by (auto simp: id_map split: option.splits dest: id_mapD)
       have i'_def: "i' = card (Inr -` (Inr ` {..<Suc i} \<union> set (take k xs)))"
         using 3(4)
         by (auto simp: Suc True inj_vimage_image_eq)
            (metis Un_insert_left image_insert inj_Inr inj_vimage_image_eq lessThan_Suc vimage_Un)
       show ?thesis
         using 3(1)[OF id_map norm_xs i'_def k_le]
         by (auto simp: Suc)
     next
       case False
       have id_map: "id_map i (Inr j) = Some j"
         using j_le_i False
         by (auto simp: id_map_def)
       have norm_xs: "fo_nmlz_rec i (id_map i) AD xs = xs"
         using 3(3)
         by (auto simp: id_map)
       have i'_def: "i' = card (Inr -` (Inr ` {..<i} \<union> set (take k xs)))"
         using 3(4) j_le_i False
         by (auto simp: Suc inj_vimage_image_eq insert_absorb)
       show ?thesis
         using 3(2)[OF id_map norm_xs i'_def k_le]
         by (auto simp: Suc)
     qed
   qed (auto simp: inj_vimage_image_eq)
 qed auto
 
 fun proj_tuple :: "nat list \<Rightarrow> (nat \<times> ('a + nat)) list \<Rightarrow> ('a + nat) list" where
   "proj_tuple [] mys = []"
 | "proj_tuple ns [] = []"
 | "proj_tuple (n # ns) ((m, y) # mys) =
     (if m < n then proj_tuple (n # ns) mys else
     if m = n then y # proj_tuple ns mys
     else proj_tuple ns ((m, y) # mys))"
 
 lemma proj_tuple_idle: "proj_tuple (map fst nxs) nxs = map snd nxs"
   by (induction nxs) auto
 
 lemma proj_tuple_merge: "sorted_distinct (map fst nxs) \<Longrightarrow> sorted_distinct (map fst mys) \<Longrightarrow>
   set (map fst nxs) \<inter> set (map fst mys) = {} \<Longrightarrow>
   proj_tuple (map fst nxs) (merge nxs mys) = map snd nxs"
   using proj_tuple_idle
   by (induction nxs mys rule: merge.induct) auto+
 
 lemma proj_tuple_map:
   assumes "sorted_distinct ns" "sorted_distinct ms" "set ns \<subseteq> set ms"
   shows "proj_tuple ns (zip ms (map \<sigma> ms)) = map \<sigma> ns"
 proof -
   define ns' where "ns' = filter (\<lambda>n. n \<notin> set ns) ms"
   have sd_ns': "sorted_distinct ns'"
     using assms(2) sorted_filter[of id]
     by (auto simp: ns'_def)
   have disj: "set ns \<inter> set ns' = {}"
     by (auto simp: ns'_def)
   have ms_def: "ms = sort (ns @ ns')"
     apply (rule sorted_distinct_set_unique)
     using assms
     by (auto simp: ns'_def)
   have zip: "zip ms (map \<sigma> ms) = merge (zip ns (map \<sigma> ns)) (zip ns' (map \<sigma> ns'))"
     unfolding merge_map[OF assms(1) sd_ns' disj, folded ms_def, symmetric]
     using map_fst_merge assms(1)
     by (auto simp: ms_def) (smt length_map map_fst_merge map_fst_zip sd_ns' zip_map_fst_snd)
   show ?thesis
     unfolding zip
     using proj_tuple_merge
     by (smt assms(1) disj length_map map_fst_zip map_snd_zip sd_ns')
 qed
 
 lemma proj_tuple_length:
   assumes "sorted_distinct ns" "sorted_distinct ms" "set ns \<subseteq> set ms" "length ms = length xs"
   shows "length (proj_tuple ns (zip ms xs)) = length ns"
 proof -
   obtain \<sigma> where \<sigma>: "xs = map \<sigma> ms"
     using exists_map[OF assms(4)] assms(2)
     by auto
   show ?thesis
     unfolding \<sigma>
     by (auto simp: proj_tuple_map[OF assms(1-3)])
 qed
 
 lemma ext_tuple_sound:
   assumes "sorted_distinct fv_sub" "sorted_distinct fv_sub_comp" "sorted_distinct fv_all"
     "set fv_sub \<inter> set fv_sub_comp = {}" "set fv_sub \<union> set fv_sub_comp = set fv_all"
     "ass = fo_nmlz AD ` proj_vals R fv_sub"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set fv_sub) (set fv_sub) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
     "xs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD fv_sub fv_sub_comp ` ass)"
   shows "fo_nmlz AD (proj_tuple fv_sub (zip fv_all xs)) \<in> ass"
     "xs \<in> fo_nmlz AD ` proj_vals R fv_all"
 proof -
   have fv_all_sort: "fv_all = sort (fv_sub @ fv_sub_comp)"
     using assms(1,2,3,4,5)
     by (simp add: sorted_distinct_set_unique)
   have len_in_ass: "\<And>xs. xs \<in> ass \<Longrightarrow> xs = fo_nmlz AD xs \<and> length xs = length fv_sub"
     by (auto simp: assms(6) proj_vals_def fo_nmlz_length fo_nmlz_idem fo_nmlz_sound)
   obtain as fs where as_fs_def: "as \<in> ass"
     "fs \<in> nall_tuples_rec AD (card (Inr -` set as)) (length fv_sub_comp)"
     "xs = fo_nmlz AD (map snd (merge (zip fv_sub as) (zip fv_sub_comp fs)))"
     using fo_nmlz_sound len_in_ass assms(8)
     by (auto simp: ext_tuple_def split: if_splits)
   then have vs_norm: "fo_nmlzd AD xs"
     using fo_nmlz_sound
     by auto
   obtain \<sigma> where \<sigma>_def: "\<sigma> \<in> R" "as = fo_nmlz AD (map \<sigma> fv_sub)"
     using as_fs_def(1) assms(6)
     by (auto simp: proj_vals_def)
   then obtain \<tau> where \<tau>_def: "as = map \<tau> fv_sub" "ad_agr_list AD (map \<sigma> fv_sub) (map \<tau> fv_sub)"
     using fo_nmlz_map fo_nmlz_ad_agr
     by metis
   have \<tau>_R: "\<tau> \<in> R"
     using assms(7) ad_agr_list_link \<sigma>_def(1) \<tau>_def(2)
     by fastforce
   define \<sigma>' where "\<sigma>' \<equiv> \<lambda>n. if n \<in> set fv_sub_comp then the (map_of (zip fv_sub_comp fs) n)
       else \<tau> n"
   then have "\<forall>n \<in> set fv_sub. \<tau> n = \<sigma>' n"
     using assms(4) by auto
   then have \<sigma>'_S: "\<sigma>' \<in> R"
     using assms(7) \<tau>_R
     by (fastforce simp: ad_agr_sets_def sp_equiv_def pairwise_def ad_equiv_pair.simps)
   have length_as: "length as = length fv_sub"
     using as_fs_def(1) assms(6)
     by (auto simp: proj_vals_def fo_nmlz_length)
   have length_fs: "length fs = length fv_sub_comp"
     using as_fs_def(2)
     by (auto simp: nall_tuples_rec_length)
   have map_fv_sub: "map \<sigma>' fv_sub = map \<tau> fv_sub"
     using assms(4) \<tau>_def(2)
     by (auto simp: \<sigma>'_def)
   have fs_map_map_of: "fs = map (the \<circ> (map_of (zip fv_sub_comp fs))) fv_sub_comp"
     using map_map_of length_fs assms(2)
     by metis
   have fs_map: "fs = map \<sigma>' fv_sub_comp"
     using \<sigma>'_def length_fs by (subst fs_map_map_of) simp
   have vs_map_fv_all: "xs = fo_nmlz AD (map \<sigma>' fv_all)"
     unfolding as_fs_def(3) \<tau>_def(1) map_fv_sub[symmetric] fs_map fv_all_sort
     using merge_map[OF assms(1,2,4)]
     by metis
   show "xs \<in> fo_nmlz AD ` proj_vals R fv_all"
     using \<sigma>'_S vs_map_fv_all
     by (auto simp: proj_vals_def)
   obtain \<sigma>'' where \<sigma>''_def: "xs = map \<sigma>'' fv_all"
     using exists_map[of fv_all xs] fo_nmlz_map vs_map_fv_all
     by blast
   have proj: "proj_tuple fv_sub (zip fv_all xs) = map \<sigma>'' fv_sub"
     using proj_tuple_map assms(1,3,5)
     unfolding \<sigma>''_def
     by blast
   have \<sigma>''_\<sigma>': "fo_nmlz AD (map \<sigma>'' fv_sub) = as"
     using \<sigma>''_def vs_map_fv_all \<sigma>_def(2)
     by (metis \<tau>_def(2) ad_agr_list_subset assms(5) fo_nmlz_ad_agr fo_nmlz_eqI map_fv_sub sup_ge1)
   show "fo_nmlz AD (proj_tuple fv_sub (zip fv_all xs)) \<in> ass"
     unfolding proj \<sigma>''_\<sigma>' map_fv_sub
     by (rule as_fs_def(1))
 qed
 
 lemma ext_tuple_complete:
   assumes "sorted_distinct fv_sub" "sorted_distinct fv_sub_comp" "sorted_distinct fv_all"
     "set fv_sub \<inter> set fv_sub_comp = {}" "set fv_sub \<union> set fv_sub_comp = set fv_all"
     "ass = fo_nmlz AD ` proj_vals R fv_sub"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set fv_sub) (set fv_sub) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
     "xs = fo_nmlz AD (map \<sigma> fv_all)" "\<sigma> \<in> R"
   shows "xs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD fv_sub fv_sub_comp ` ass)"
 proof -
   have fv_all_sort: "fv_all = sort (fv_sub @ fv_sub_comp)"
     using assms(1,2,3,4,5)
     by (simp add: sorted_distinct_set_unique)
   note \<sigma>_def = assms(9,8)
   have vs_norm: "fo_nmlzd AD xs"
     using \<sigma>_def(2) fo_nmlz_sound
     by auto
   define fs where "fs = map \<sigma> fv_sub_comp"
   define as where "as = map \<sigma> fv_sub"
   define nos where "nos = fo_nmlz AD (as @ fs)"
   define as' where "as' = take (length fv_sub) nos"
   define fs' where "fs' = drop (length fv_sub) nos"
   have length_as': "length as' = length fv_sub"
     by (auto simp: as'_def nos_def as_def fo_nmlz_length)
   have length_fs': "length fs' = length fv_sub_comp"
     by (auto simp: fs'_def nos_def as_def fs_def fo_nmlz_length)
   have len_fv_sub_nos: "length fv_sub \<le> length nos"
     by (auto simp: nos_def fo_nmlz_length as_def)
   have norm_as': "fo_nmlzd AD as'"
     using fo_nmlzd_take[OF fo_nmlz_sound]
     by (auto simp: as'_def nos_def)
   have as'_norm_as: "as' = fo_nmlz AD as"
     by (auto simp: as'_def nos_def as_def fo_nmlz_take)
   have ad_agr_as': "ad_agr_list AD as as'"
     using fo_nmlz_ad_agr
     unfolding as'_norm_as .
   have nos_as'_fs': "nos = as' @ fs'"
     using length_as' length_fs'
     by (auto simp: as'_def fs'_def)
   obtain \<tau> where \<tau>_def: "as' = map \<tau> fv_sub" "fs' = map \<tau> fv_sub_comp"
     using exists_map[of "fv_sub @ fv_sub_comp" "as' @ fs'"] assms(1,2,4) length_as' length_fs'
     by auto
   have "length fv_sub + length fv_sub_comp \<le> length fv_all"
     using assms(1,2,3,4,5)
     by (metis distinct_append distinct_card eq_iff length_append set_append)
   then have nos_sub: "set nos \<subseteq> Inl ` AD \<union> Inr ` {..<length fv_all}"
     using fo_nmlz_set[of AD "as @ fs"]
     by (auto simp: nos_def as_def fs_def)
   have len_fs': "length fs' = length fv_sub_comp"
     by (auto simp: fs'_def nos_def fo_nmlz_length as_def fs_def)
   have norm_nos_idem: "fo_nmlz_rec 0 (id_map 0) AD nos = nos"
     using fo_nmlz_idem[of AD nos] fo_nmlz_sound
     by (auto simp: nos_def fo_nmlz_def id_map_empty)
   have fs'_all: "fs' \<in> nall_tuples_rec AD (card (Inr -` set as')) (length fv_sub_comp)"
     unfolding len_fs'[symmetric]
     by (rule nall_tuples_rec_fo_nmlz_rec_complete)
       (rule fo_nmlz_rec_shift[OF norm_nos_idem, simplified, OF refl len_fv_sub_nos,
           folded as'_def fs'_def])
   have "as' \<in> nall_tuples AD (length fv_sub)"
     using length_as'
     apply (rule nall_tuplesI)
     using norm_as' .
   then have as'_ass: "as' \<in> ass"
     using as'_norm_as \<sigma>_def(1) as_def
     unfolding assms(6)
     by (auto simp: proj_vals_def)
   have vs_norm: "xs = fo_nmlz AD (map snd (merge (zip fv_sub as) (zip fv_sub_comp fs)))"
     using assms(1,2,4) \<sigma>_def(2)
     by (auto simp: merge_map as_def fs_def fv_all_sort)
   have set_sort': "set (sort (fv_sub @ fv_sub_comp)) = set (fv_sub @ fv_sub_comp)"
     by auto
   have "xs = fo_nmlz AD (map snd (merge (zip fv_sub as') (zip fv_sub_comp fs')))"
     unfolding vs_norm as_def fs_def \<tau>_def
       merge_map[OF assms(1,2,4)]
     apply (rule fo_nmlz_eqI)
     apply (rule ad_agr_list_subset[OF equalityD1, OF set_sort'])
     using fo_nmlz_ad_agr[of AD "as @ fs", folded nos_def, unfolded nos_as'_fs']
     unfolding as_def fs_def \<tau>_def map_append[symmetric] .
   then show ?thesis
     using as'_ass fs'_all
     by (auto simp: ext_tuple_def length_as')
 qed
 
 definition "ext_tuple_set AD ns ns' X = (if ns' = [] then X else fo_nmlz AD ` \<Union>(ext_tuple AD ns ns' ` X))"
 
 lemma ext_tuple_set_eq: "Ball X (fo_nmlzd AD) \<Longrightarrow> ext_tuple_set AD ns ns' X = fo_nmlz AD ` \<Union>(ext_tuple AD ns ns' ` X)"
   by (auto simp: ext_tuple_set_def ext_tuple_def fo_nmlzd_code)
 
 lemma ext_tuple_set_mono: "A \<subseteq> B \<Longrightarrow> ext_tuple_set AD ns ns' A \<subseteq> ext_tuple_set AD ns ns' B"
   by (auto simp: ext_tuple_set_def)
 
 lemma ext_tuple_correct:
   assumes "sorted_distinct fv_sub" "sorted_distinct fv_sub_comp" "sorted_distinct fv_all"
     "set fv_sub \<inter> set fv_sub_comp = {}" "set fv_sub \<union> set fv_sub_comp = set fv_all"
     "ass = fo_nmlz AD ` proj_vals R fv_sub"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set fv_sub) (set fv_sub) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
   shows "ext_tuple_set AD fv_sub fv_sub_comp ass = fo_nmlz AD ` proj_vals R fv_all"
 proof (rule set_eqI, rule iffI)
   fix xs
   assume xs_in: "xs \<in> ext_tuple_set AD fv_sub fv_sub_comp ass"
   show "xs \<in> fo_nmlz AD ` proj_vals R fv_all"
     using ext_tuple_sound(2)[OF assms] xs_in
     by (auto simp: ext_tuple_set_def ext_tuple_def assms(6) fo_nmlz_idem[OF fo_nmlz_sound] image_iff
         split: if_splits)
 next
   fix xs
   assume "xs \<in> fo_nmlz AD ` proj_vals R fv_all"
   then obtain \<sigma> where \<sigma>_def: "xs = fo_nmlz AD (map \<sigma> fv_all)" "\<sigma> \<in> R"
     by (auto simp: proj_vals_def)
   show "xs \<in> ext_tuple_set AD fv_sub fv_sub_comp ass"
     using ext_tuple_complete[OF assms \<sigma>_def]
     by (auto simp: ext_tuple_set_def ext_tuple_def assms(6) fo_nmlz_idem[OF fo_nmlz_sound] image_iff
         split: if_splits)
 qed
 
 lemma proj_tuple_sound:
   assumes "sorted_distinct fv_sub" "sorted_distinct fv_sub_comp" "sorted_distinct fv_all"
     "set fv_sub \<inter> set fv_sub_comp = {}" "set fv_sub \<union> set fv_sub_comp = set fv_all"
     "ass = fo_nmlz AD ` proj_vals R fv_sub"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set fv_sub) (set fv_sub) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
     "fo_nmlz AD xs = xs" "length xs = length fv_all"
     "fo_nmlz AD (proj_tuple fv_sub (zip fv_all xs)) \<in> ass"
   shows "xs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD fv_sub fv_sub_comp ` ass)"
 proof -
   have fv_all_sort: "fv_all = sort (fv_sub @ fv_sub_comp)"
     using assms(1,2,3,4,5)
     by (simp add: sorted_distinct_set_unique)
   obtain \<sigma> where \<sigma>_def: "xs = map \<sigma> fv_all"
     using exists_map[of fv_all xs] assms(3,9)
     by auto
   have xs_norm: "xs = fo_nmlz AD (map \<sigma> fv_all)"
     using assms(8)
     by (auto simp: \<sigma>_def)
   have proj: "proj_tuple fv_sub (zip fv_all xs) = map \<sigma> fv_sub"
     unfolding \<sigma>_def
     apply (rule proj_tuple_map[OF assms(1,3)])
     using assms(5)
     by blast
   obtain \<tau> where \<tau>_def: "fo_nmlz AD (map \<sigma> fv_sub) = fo_nmlz AD (map \<tau> fv_sub)" "\<tau> \<in> R"
     using assms(10)
     by (auto simp: assms(6) proj proj_vals_def)
   have \<sigma>_R: "\<sigma> \<in> R"
     using assms(7) fo_nmlz_eqD[OF \<tau>_def(1)] \<tau>_def(2)
     unfolding ad_agr_list_link[symmetric]
     by auto
   show ?thesis
     by (rule ext_tuple_complete[OF assms(1,2,3,4,5,6,7) xs_norm \<sigma>_R]) assumption
 qed
 
 lemma proj_tuple_correct:
   assumes "sorted_distinct fv_sub" "sorted_distinct fv_sub_comp" "sorted_distinct fv_all"
     "set fv_sub \<inter> set fv_sub_comp = {}" "set fv_sub \<union> set fv_sub_comp = set fv_all"
     "ass = fo_nmlz AD ` proj_vals R fv_sub"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set fv_sub) (set fv_sub) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
     "fo_nmlz AD xs = xs" "length xs = length fv_all"
   shows "xs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD fv_sub fv_sub_comp ` ass) \<longleftrightarrow>
     fo_nmlz AD (proj_tuple fv_sub (zip fv_all xs)) \<in> ass"
   using ext_tuple_sound(1)[OF assms(1,2,3,4,5,6,7)] proj_tuple_sound[OF assms]
   by blast
 
 fun unify_vals_terms :: "('a + 'c) list \<Rightarrow> ('a fo_term) list \<Rightarrow> (nat \<rightharpoonup> ('a + 'c)) \<Rightarrow>
   (nat \<rightharpoonup> ('a + 'c)) option" where
   "unify_vals_terms [] [] \<sigma> = Some \<sigma>"
 | "unify_vals_terms (v # vs) ((Const c') # ts) \<sigma> =
     (if v = Inl c' then unify_vals_terms vs ts \<sigma> else None)"
 | "unify_vals_terms (v # vs) ((Var n) # ts) \<sigma> =
     (case \<sigma> n of Some x \<Rightarrow> (if v = x then unify_vals_terms vs ts \<sigma> else None)
     | None \<Rightarrow> unify_vals_terms vs ts (\<sigma>(n := Some v)))"
 | "unify_vals_terms _ _ _ = None"
 
 lemma unify_vals_terms_extends: "unify_vals_terms vs ts \<sigma> = Some \<sigma>' \<Longrightarrow> extends_subst \<sigma> \<sigma>'"
   unfolding extends_subst_def
   by (induction vs ts \<sigma> arbitrary: \<sigma>' rule: unify_vals_terms.induct)
      (force split: if_splits option.splits)+
 
 lemma unify_vals_terms_sound: "unify_vals_terms vs ts \<sigma> = Some \<sigma>' \<Longrightarrow> (the \<circ> \<sigma>') \<odot>e ts = vs"
   using unify_vals_terms_extends
   by (induction vs ts \<sigma> arbitrary: \<sigma>' rule: unify_vals_terms.induct)
      (force simp: eval_eterms_def extends_subst_def fv_fo_terms_set_def
       split: if_splits option.splits)+
 
 lemma unify_vals_terms_complete: "\<sigma>'' \<odot>e ts = vs \<Longrightarrow> (\<And>n. \<sigma> n \<noteq> None \<Longrightarrow> \<sigma> n = Some (\<sigma>'' n)) \<Longrightarrow>
   \<exists>\<sigma>'. unify_vals_terms vs ts \<sigma> = Some \<sigma>'"
   by (induction vs ts \<sigma> rule: unify_vals_terms.induct)
      (force simp: eval_eterms_def extends_subst_def split: if_splits option.splits)+
 
 definition eval_table :: "'a fo_term list \<Rightarrow> ('a + 'c) table \<Rightarrow> ('a + 'c) table" where
   "eval_table ts X = (let fvs = fv_fo_terms_list ts in
     \<Union>((\<lambda>vs. case unify_vals_terms vs ts Map.empty of Some \<sigma> \<Rightarrow>
       {map (the \<circ> \<sigma>) fvs} | _ \<Rightarrow> {}) ` X))"
 
 lemma eval_table:
   fixes X :: "('a + 'c) table"
   shows "eval_table ts X = proj_vals {\<sigma>. \<sigma> \<odot>e ts \<in> X} (fv_fo_terms_list ts)"
 proof (rule set_eqI, rule iffI)
   fix vs
   assume "vs \<in> eval_table ts X"
   then obtain as \<sigma> where as_def: "as \<in> X" "unify_vals_terms as ts Map.empty = Some \<sigma>"
     "vs = map (the \<circ> \<sigma>) (fv_fo_terms_list ts)"
     by (auto simp: eval_table_def split: option.splits)
   have "(the \<circ> \<sigma>) \<odot>e ts \<in> X"
     using unify_vals_terms_sound[OF as_def(2)] as_def(1)
     by auto
   with as_def(3) show "vs \<in> proj_vals {\<sigma>. \<sigma> \<odot>e ts \<in> X} (fv_fo_terms_list ts)"
     by (fastforce simp: proj_vals_def)
 next
   fix vs :: "('a + 'c) list"
   assume "vs \<in> proj_vals {\<sigma>. \<sigma> \<odot>e ts \<in> X} (fv_fo_terms_list ts)"
   then obtain \<sigma> where \<sigma>_def: "vs = map \<sigma> (fv_fo_terms_list ts)" "\<sigma> \<odot>e ts \<in> X"
     by (auto simp: proj_vals_def)
   obtain \<sigma>' where \<sigma>'_def: "unify_vals_terms (\<sigma> \<odot>e ts) ts Map.empty = Some \<sigma>'"
     using unify_vals_terms_complete[OF refl, of Map.empty \<sigma> ts]
     by auto
   have "(the \<circ> \<sigma>') \<odot>e ts = (\<sigma> \<odot>e ts)"
     using unify_vals_terms_sound[OF \<sigma>'_def(1)]
     by auto
   then have "vs = map (the \<circ> \<sigma>') (fv_fo_terms_list ts)"
     using fv_fo_terms_set_list eval_eterms_fv_fo_terms_set
     unfolding \<sigma>_def(1)
     by fastforce
   then show "vs \<in> eval_table ts X"
     using \<sigma>_def(2) \<sigma>'_def
     by (force simp: eval_table_def)
 qed
 
 fun ad_agr_close_rec :: "nat \<Rightarrow> (nat \<rightharpoonup> 'a + nat) \<Rightarrow> 'a set \<Rightarrow>
   ('a + nat) list \<Rightarrow> ('a + nat) list set" where
   "ad_agr_close_rec i m AD [] = {[]}"
 | "ad_agr_close_rec i m AD (Inl x # xs) = (\<lambda>xs. Inl x # xs) ` ad_agr_close_rec i m AD xs"
 | "ad_agr_close_rec i m AD (Inr n # xs) = (case m n of None \<Rightarrow> \<Union>((\<lambda>x. (\<lambda>xs. Inl x # xs) `
     ad_agr_close_rec i (m(n := Some (Inl x))) (AD - {x}) xs) ` AD) \<union>
     (\<lambda>xs. Inr i # xs) ` ad_agr_close_rec (Suc i) (m(n := Some (Inr i))) AD xs
   | Some v \<Rightarrow> (\<lambda>xs. v # xs) ` ad_agr_close_rec i m AD xs)"
 
 lemma ad_agr_close_rec_length: "ys \<in> ad_agr_close_rec i m AD xs \<Longrightarrow> length xs = length ys"
   by (induction i m AD xs arbitrary: ys rule: ad_agr_close_rec.induct) (auto split: option.splits)
 
 lemma ad_agr_close_rec_sound: "ys \<in> ad_agr_close_rec i m AD xs \<Longrightarrow>
   fo_nmlz_rec j (id_map j) X xs = xs \<Longrightarrow> X \<inter> AD = {} \<Longrightarrow> X \<inter> Y = {} \<Longrightarrow> Y \<inter> AD = {} \<Longrightarrow>
   inj_on m (dom m) \<Longrightarrow> dom m = {..<j} \<Longrightarrow> ran m \<subseteq> Inl ` Y \<union> Inr ` {..<i} \<Longrightarrow> i \<le> j \<Longrightarrow>
   fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) ys = ys \<and>
   (\<exists>m'. inj_on m' (dom m') \<and> (\<forall>n v. m n = Some v \<longrightarrow> m' (Inr n) = Some v) \<and>
   (\<forall>(x, y) \<in> set (zip xs ys). case x of Inl x' \<Rightarrow>
       if x' \<in> X then x = y else m' x = Some y \<and> (case y of Inl z \<Rightarrow> z \<notin> X | Inr x \<Rightarrow> True)
   | Inr n \<Rightarrow> m' x = Some y \<and> (case y of Inl z \<Rightarrow> z \<notin> X | Inr x \<Rightarrow> True)))"
 proof (induction i m AD xs arbitrary: Y j ys rule: ad_agr_close_rec.induct)
   case (1 i m AD)
   then show ?case
     by (auto simp: ad_agr_list_def ad_equiv_list_def sp_equiv_list_def inj_on_def dom_def
         split: sum.splits intro!: exI[of _ "case_sum Map.empty m"])
 next
   case (2 i m AD x xs)
   obtain zs where ys_def: "ys = Inl x # zs" "zs \<in> ad_agr_close_rec i m AD xs"
     using 2(2)
     by auto
   have preds: "fo_nmlz_rec j (id_map j) X xs = xs" "x \<in> X"
     using 2(3)
     by (auto split: if_splits option.splits)
   show ?case
     using 2(1)[OF ys_def(2) preds(1) 2(4,5,6,7,8,9,10)] preds(2)
     by (auto simp: ys_def(1))
 next
   case (3 i m AD n xs)
   show ?case
   proof (cases "m n")
     case None
     obtain v zs where ys_def: "ys = v # zs"
       using 3(4)
       by (auto simp: None)
     have n_ge_j: "j \<le> n"
       using 3(9,10) None
       by (metis domIff leI lessThan_iff)
     show ?thesis
     proof (cases v)
       case (Inl x)
       have zs_def: "zs \<in> ad_agr_close_rec i (m(n \<mapsto> Inl x)) (AD - {x}) xs" "x \<in> AD"
         using 3(4)
         by (auto simp: None ys_def Inl)
       have preds: "fo_nmlz_rec (Suc j) (id_map (Suc j)) X xs = xs" "X \<inter> (AD - {x}) = {}"
         "X \<inter> (Y \<union> {x}) = {}" "(Y \<union> {x}) \<inter> (AD - {x}) = {}" "dom (m(n \<mapsto> Inl x)) = {..<Suc j}"
         "ran (m(n \<mapsto> Inl x)) \<subseteq> Inl ` (Y \<union> {x}) \<union> Inr ` {..<i}"
         "i \<le> Suc j" "n = j"
         using 3(5,6,7,8,10,11,12) n_ge_j zs_def(2)
         by (auto simp: fun_upd_id_map ran_def dest: id_mapD split: option.splits)
       have inj: "inj_on (m(n \<mapsto> Inl x)) (dom (m(n \<mapsto> Inl x)))"
         using 3(8,9,10,11,12) preds(8) zs_def(2)
         by (fastforce simp: inj_on_def dom_def ran_def)
       have sets_unfold: "X \<union> (Y \<union> {x}) \<union> (AD - {x}) = X \<union> Y \<union> AD"
         using zs_def(2)
         by auto
       note IH = 3(1)[OF None zs_def(2,1) preds(1,2,3,4) inj preds(5,6,7), unfolded sets_unfold]
       have norm_ys: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) ys = ys"
         using conjunct1[OF IH] zs_def(2)
         by (auto simp: ys_def(1) Inl split: option.splits)
       show ?thesis
         using norm_ys conjunct2[OF IH] None zs_def(2) 3(6)
         unfolding ys_def(1)
         apply safe
         subgoal for m'
           apply (auto simp: Inl dom_def intro!: exI[of _ m'] split: if_splits)
            apply (metis option.distinct(1))
           apply (fastforce split: prod.splits sum.splits)
           done
         done
     next
       case (Inr k)
       have zs_def: "zs \<in> ad_agr_close_rec (Suc i) (m(n \<mapsto> Inr i)) AD xs" "i = k"
         using 3(4)
         by (auto simp: None ys_def Inr)
       have preds: "fo_nmlz_rec (Suc n) (id_map (Suc n)) X xs = xs"
         "dom (m(n \<mapsto> Inr i)) = {..<Suc n}"
         "ran (m(n \<mapsto> Inr i)) \<subseteq> Inl ` Y \<union> Inr ` {..<Suc i}" "Suc i \<le> Suc n"
         using 3(5,10,11,12) n_ge_j
         by (auto simp: fun_upd_id_map ran_def dest: id_mapD split: option.splits)
       have inj: "inj_on (m(n \<mapsto> Inr i)) (dom (m(n \<mapsto> Inr i)))"
         using 3(9,11)
         by (auto simp: inj_on_def dom_def ran_def)
       note IH = 3(2)[OF None zs_def(1) preds(1) 3(6,7,8) inj preds(2,3,4)]
       have norm_ys: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) ys = ys"
         using conjunct1[OF IH] zs_def(2)
         by (auto simp: ys_def Inr fun_upd_id_map dest: id_mapD split: option.splits)
       show ?thesis
         using norm_ys conjunct2[OF IH] None
         unfolding ys_def(1) zs_def(2)
         apply safe
         subgoal for m'
           apply (auto simp: Inr dom_def intro!: exI[of _ m'] split: if_splits)
            apply (metis option.distinct(1))
           apply (fastforce split: prod.splits sum.splits)
           done
         done
     qed
   next
     case (Some v)
     obtain zs where ys_def: "ys = v # zs" "zs \<in> ad_agr_close_rec i m AD xs"
       using 3(4)
       by (auto simp: Some)
     have preds: "fo_nmlz_rec j (id_map j) X xs = xs" "n < j"
       using 3(5,8,10) Some
       by (auto simp: dom_def split: option.splits)
     note IH = 3(3)[OF Some ys_def(2) preds(1) 3(6,7,8,9,10,11,12)]
     have norm_ys: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) ys = ys"
       using conjunct1[OF IH] 3(11) Some
       by (auto simp: ys_def(1) ran_def id_map_def)
     have "case v of Inl z \<Rightarrow> z \<notin> X | Inr x \<Rightarrow> True"
       using 3(7,11) Some
       by (auto simp: ran_def split: sum.splits)
     then show ?thesis
       using norm_ys conjunct2[OF IH] Some
       unfolding ys_def(1)
       apply safe
       subgoal for m'
         by (auto intro!: exI[of _ m'] split: sum.splits)
       done
   qed
 qed
 
 lemma ad_agr_close_rec_complete:
   fixes xs :: "('a + nat) list"
   shows "fo_nmlz_rec j (id_map j) X xs = xs \<Longrightarrow>
   X \<inter> AD = {} \<Longrightarrow> X \<inter> Y = {} \<Longrightarrow> Y \<inter> AD = {} \<Longrightarrow>
   inj_on m (dom m) \<Longrightarrow> dom m = {..<j} \<Longrightarrow> ran m = Inl ` Y \<union> Inr ` {..<i} \<Longrightarrow> i \<le> j \<Longrightarrow>
   (\<And>n b. (Inr n, b) \<in> set (zip xs ys) \<Longrightarrow> case m n of Some v \<Rightarrow> v = b | None \<Rightarrow> b \<notin> ran m) \<Longrightarrow>
   fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) ys = ys \<Longrightarrow> ad_agr_list X xs ys \<Longrightarrow>
   ys \<in> ad_agr_close_rec i m AD xs"
 proof (induction j "id_map j :: 'a + nat \<Rightarrow> nat option" X xs arbitrary: m i ys AD Y
     rule: fo_nmlz_rec.induct)
   case (2 j X x xs)
   have x_X: "x \<in> X" "fo_nmlz_rec j (id_map j) X xs = xs"
     using 2(4)
     by (auto split: if_splits option.splits)
   obtain z zs where ys_def: "ys = Inl z # zs" "z = x"
     using 2(14) x_X(1)
     by (cases ys) (auto simp: ad_agr_list_def ad_equiv_list_def ad_equiv_pair.simps)
   have norm_zs: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) zs = zs"
     using 2(13) ys_def(2) x_X(1)
     by (auto simp: ys_def(1))
   have ad_agr: "ad_agr_list X xs zs"
     using 2(14)
     by (auto simp: ys_def ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
   show ?case
     using 2(1)[OF x_X 2(5,6,7,8,9,10,11) _ norm_zs ad_agr] 2(12)
     by (auto simp: ys_def)
 next
   case (3 j X n xs)
   obtain z zs where ys_def: "ys = z # zs"
     using 3(13)
     apply (cases ys)
      apply (auto simp: ad_agr_list_def)
     done
   show ?case
   proof (cases "j \<le> n")
     case True
     then have n_j: "n = j"
       using 3(3)
       by (auto split: option.splits dest: id_mapD)
-    have id_map: "id_map j (Inr n) = None" "id_map j(Inr n \<mapsto> j) = id_map (Suc j)"
+    have id_map: "id_map j (Inr n) = None" "(id_map j)(Inr n \<mapsto> j) = id_map (Suc j)"
       unfolding n_j fun_upd_id_map
       by (auto simp: id_map_def)
     have norm_xs: "fo_nmlz_rec (Suc j) (id_map (Suc j)) X xs = xs"
       using 3(3)
       by (auto simp: ys_def fun_upd_id_map id_map(1) split: option.splits)
     have None: "m n = None"
       using 3(8)
       by (auto simp: dom_def n_j)
     have z_out: "z \<notin> Inl ` Y \<union> Inr ` {..<i}"
       using 3(11) None
       by (force simp: ys_def 3(9))
     show ?thesis
     proof (cases z)
       case (Inl a)
       have a_in: "a \<in> AD"
         using 3(12,13) z_out
         by (auto simp: ys_def Inl ad_agr_list_def ad_equiv_list_def ad_equiv_pair.simps
             split: if_splits option.splits)
       have norm_zs: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) zs = zs"
         using 3(12) a_in
         by (auto simp: ys_def Inl)
       have preds: "X \<inter> (AD - {a}) = {}" "X \<inter> (Y \<union> {a}) = {}" "(Y \<union> {a}) \<inter> (AD - {a}) = {}"
         using 3(4,5,6) a_in
         by auto
       have inj: "inj_on (m(n := Some (Inl a))) (dom (m(n := Some (Inl a))))"
         using 3(6,7,9) None a_in
         by (auto simp: inj_on_def dom_def ran_def) blast+
       have preds': "dom (m(n \<mapsto> Inl a)) = {..<Suc j}"
         "ran (m(n \<mapsto> Inl a)) = Inl ` (Y \<union> {a}) \<union> Inr ` {..<i}" "i \<le> Suc j"
         using 3(6,8,9,10) None less_Suc_eq a_in
           apply (auto simp: n_j dom_def ran_def)
          apply (smt Un_iff image_eqI mem_Collect_eq option.simps(3))
         apply (smt 3(8) domIff image_subset_iff lessThan_iff mem_Collect_eq sup_ge2)
         done
       have a_unfold: "X \<union> (Y \<union> {a}) \<union> (AD - {a}) = X \<union> Y \<union> AD" "Y \<union> {a} \<union> (AD - {a}) = Y \<union> AD"
         using a_in
         by auto
       have ad_agr: "ad_agr_list X xs zs"
         using 3(13)
         by (auto simp: ys_def Inl ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
       have "zs \<in> ad_agr_close_rec i (m(n \<mapsto> Inl a)) (AD - {a}) xs"
         apply (rule 3(1)[OF id_map norm_xs preds inj preds' _ _ ad_agr])
         using 3(11,13) norm_zs
         unfolding 3(9) preds'(2) a_unfold
          apply (auto simp: None Inl ys_def ad_agr_list_def sp_equiv_list_def pairwise_def
             split: option.splits)
           apply (metis Un_iff image_eqI option.simps(4))
          apply (metis image_subset_iff lessThan_iff option.simps(4) sup_ge2)
         apply fastforce
         done
       then show ?thesis
         using a_in
         by (auto simp: ys_def Inl None)
     next
       case (Inr b)
       have i_b: "i = b"
         using 3(12) z_out
         by (auto simp: ys_def Inr split: option.splits dest: id_mapD)
       have norm_zs: "fo_nmlz_rec (Suc i) (id_map (Suc i)) (X \<union> Y \<union> AD) zs = zs"
         using 3(12)
         by (auto simp: ys_def Inr i_b fun_upd_id_map split: option.splits dest: id_mapD)
       have ad_agr: "ad_agr_list X xs zs"
         using 3(13)
         by (auto simp: ys_def ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
       define m' where "m' \<equiv> m(n := Some (Inr i))"
       have preds: "inj_on m' (dom m')" "dom m' = {..<Suc j}" "Suc i \<le> Suc j"
         using 3(7,8,9,10)
         by (auto simp: m'_def n_j inj_on_def dom_def ran_def image_iff)
            (metis 3(8) domI lessThan_iff less_SucI)
       have ran: "ran m' = Inl ` Y \<union> Inr ` {..<Suc i}"
         using 3(9) None
         by (auto simp: m'_def)
       have "zs \<in> ad_agr_close_rec (Suc i) m' AD xs"
         apply (rule 3(1)[OF id_map norm_xs 3(4,5,6) preds(1,2) ran preds(3) _ norm_zs ad_agr])
         using 3(11,13)
         unfolding 3(9) ys_def Inr i_b m'_def
         unfolding ran[unfolded m'_def i_b]
         apply (auto simp: ad_agr_list_def sp_equiv_list_def pairwise_def split: option.splits)
           apply (metis Un_upper1 image_subset_iff option.simps(4))
          apply (metis UnI1 image_eqI insert_iff lessThan_Suc lessThan_iff option.simps(4)
             sp_equiv_pair.simps sum.inject(2) sup_commute)
         apply fastforce
         done
       then show ?thesis
         by (auto simp: ys_def Inr None m'_def i_b)
     qed
   next
     case False
     have id_map: "id_map j (Inr n) = Some n"
       using False
       by (auto simp: id_map_def)
     have norm_xs: "fo_nmlz_rec j (id_map j) X xs = xs"
       using 3(3)
       by (auto simp: id_map)
     have Some: "m n = Some z"
       using False 3(11)[unfolded ys_def]
       by (metis (mono_tags) 3(8) domD insert_iff leI lessThan_iff list.simps(15)
           option.simps(5) zip_Cons_Cons)
     have z_in: "z \<in> Inl ` Y \<union> Inr ` {..<i}"
       using 3(9) Some
       by (auto simp: ran_def)
     have ad_agr: "ad_agr_list X xs zs"
       using 3(13)
       by (auto simp: ad_agr_list_def ys_def ad_equiv_list_def sp_equiv_list_def pairwise_def)
     show ?thesis
     proof (cases z)
       case (Inl a)
       have a_in: "a \<in> Y \<union> AD"
         using 3(12,13)
         by (auto simp: ys_def Inl ad_agr_list_def ad_equiv_list_def ad_equiv_pair.simps
             split: if_splits option.splits)
       have norm_zs: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) zs = zs"
         using 3(12) a_in
         by (auto simp: ys_def Inl)
       show ?thesis
         using 3(2)[OF id_map norm_xs 3(4,5,6,7,8,9,10) _ norm_zs ad_agr] 3(11) a_in
         by (auto simp: ys_def Inl Some split: option.splits)
     next
       case (Inr b)
       have b_lt: "b < i"
         using z_in
         by (auto simp: Inr)
       have norm_zs: "fo_nmlz_rec i (id_map i) (X \<union> Y \<union> AD) zs = zs"
         using 3(12) b_lt
         by (auto simp: ys_def Inr split: option.splits)
       show ?thesis
         using 3(2)[OF id_map norm_xs 3(4,5,6,7,8,9,10) _ norm_zs ad_agr] 3(11)
         by (auto simp: ys_def Inr Some)
     qed
   qed
 qed (auto simp: ad_agr_list_def)
 
 definition ad_agr_close :: "'a set \<Rightarrow> ('a + nat) list \<Rightarrow> ('a + nat) list set" where
   "ad_agr_close AD xs = ad_agr_close_rec 0 Map.empty AD xs"
 
 lemma ad_agr_close_sound:
   assumes "ys \<in> ad_agr_close Y xs" "fo_nmlzd X xs" "X \<inter> Y = {}"
   shows "fo_nmlzd (X \<union> Y) ys \<and> ad_agr_list X xs ys"
   using ad_agr_close_rec_sound[OF assms(1)[unfolded ad_agr_close_def]
     fo_nmlz_idem[OF assms(2), unfolded fo_nmlz_def, folded id_map_empty] assms(3)
     Int_empty_right Int_empty_left]
     ad_agr_map[OF ad_agr_close_rec_length[OF assms(1)[unfolded ad_agr_close_def]], of _ X]
     fo_nmlzd_code[unfolded fo_nmlz_def, folded id_map_empty, of "X \<union> Y" ys]
   by (auto simp: fo_nmlz_def)
 
 lemma ad_agr_close_complete:
   assumes "X \<inter> Y = {}" "fo_nmlzd X xs" "fo_nmlzd (X \<union> Y) ys" "ad_agr_list X xs ys"
   shows "ys \<in> ad_agr_close Y xs"
   using ad_agr_close_rec_complete[OF fo_nmlz_idem[OF assms(2),
         unfolded fo_nmlz_def, folded id_map_empty] assms(1) Int_empty_right Int_empty_left _ _ _
         order.refl _ _ assms(4), of Map.empty]
         fo_nmlzd_code[unfolded fo_nmlz_def, folded id_map_empty, of "X \<union> Y" ys]
         assms(3)
   unfolding ad_agr_close_def
   by (auto simp: fo_nmlz_def)
 
 lemma ad_agr_close_empty: "fo_nmlzd X xs \<Longrightarrow> ad_agr_close {} xs = {xs}"
   using ad_agr_close_complete[where ?X=X and ?Y="{}" and ?xs=xs and ?ys=xs]
     ad_agr_close_sound[where ?X=X and ?Y="{}" and ?xs=xs] ad_agr_list_refl ad_agr_list_fo_nmlzd
   by fastforce
 
 lemma ad_agr_close_set_correct:
   assumes "AD' \<subseteq> AD" "sorted_distinct ns"
   "\<And>\<sigma> \<tau>. ad_agr_sets (set ns) (set ns) AD' \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
   shows "\<Union>(ad_agr_close (AD - AD') ` fo_nmlz AD' ` proj_vals R ns) = fo_nmlz AD ` proj_vals R ns"
 proof (rule set_eqI, rule iffI)
   fix vs
   assume "vs \<in> \<Union>(ad_agr_close (AD - AD') ` fo_nmlz AD' ` proj_vals R ns)"
   then obtain \<sigma> where \<sigma>_def: "vs \<in> ad_agr_close (AD - AD') (fo_nmlz AD' (map \<sigma> ns))" "\<sigma> \<in> R"
     by (auto simp: proj_vals_def)
   have vs: "fo_nmlzd AD vs" "ad_agr_list AD' (fo_nmlz AD' (map \<sigma> ns)) vs"
     using ad_agr_close_sound[OF \<sigma>_def(1) fo_nmlz_sound] assms(1) Diff_partition
     by fastforce+
   obtain \<tau> where \<tau>_def: "vs = map \<tau> ns"
     using exists_map[of ns vs] assms(2) vs(2)
     by (auto simp: ad_agr_list_def fo_nmlz_length)
   show "vs \<in> fo_nmlz AD ` proj_vals R ns"
     apply (subst fo_nmlz_idem[OF vs(1), symmetric])
     using iffD1[OF assms(3) \<sigma>_def(2), OF iffD2[OF ad_agr_list_link ad_agr_list_trans[OF
           fo_nmlz_ad_agr[of AD' "map \<sigma> ns"] vs(2), unfolded \<tau>_def]]]
     unfolding \<tau>_def
     by (auto simp: proj_vals_def)
 next
   fix vs
   assume "vs \<in> fo_nmlz AD ` proj_vals R ns"
   then obtain \<sigma> where \<sigma>_def: "vs = fo_nmlz AD (map \<sigma> ns)" "\<sigma> \<in> R"
     by (auto simp: proj_vals_def)
   define xs where "xs = fo_nmlz AD' vs"
   have preds: "AD' \<inter> (AD - AD') = {}" "fo_nmlzd AD' xs" "fo_nmlzd (AD' \<union> (AD - AD')) vs"
     using assms(1) fo_nmlz_sound Diff_partition
     by (fastforce simp: \<sigma>_def(1) xs_def)+
   obtain \<tau> where \<tau>_def: "vs = map \<tau> ns"
     using exists_map[of "ns" vs] assms(2) \<sigma>_def(1)
     by (auto simp: fo_nmlz_length)
   have "vs \<in> ad_agr_close (AD - AD') xs"
     using ad_agr_close_complete[OF preds] ad_agr_list_comm[OF fo_nmlz_ad_agr]
     by (auto simp: xs_def)
   then show "vs \<in> \<Union>(ad_agr_close (AD - AD') ` fo_nmlz AD' ` proj_vals R ns)"
     unfolding xs_def \<tau>_def
     using iffD1[OF assms(3) \<sigma>_def(2), OF ad_agr_sets_mono[OF assms(1) iffD2[OF ad_agr_list_link
           fo_nmlz_ad_agr[of AD "map \<sigma> ns", folded \<sigma>_def(1), unfolded \<tau>_def]]]]
     by (auto simp: proj_vals_def)
 qed
 
 lemma ad_agr_close_correct:
   assumes "AD' \<subseteq> AD"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD' \<sigma> \<tau> \<Longrightarrow>
     \<sigma> \<in> R \<longleftrightarrow> \<tau> \<in> R"
   shows "\<Union>(ad_agr_close (AD - AD') ` fo_nmlz AD' ` proj_fmla \<phi> R) = fo_nmlz AD ` proj_fmla \<phi> R"
   using ad_agr_close_set_correct[OF _ sorted_distinct_fv_list, OF assms]
   by (auto simp: proj_fmla_def)
 
 definition "ad_agr_close_set AD X = (if Set.is_empty AD then X else \<Union>(ad_agr_close AD ` X))"
 
 lemma ad_agr_close_set_eq: "Ball X (fo_nmlzd AD') \<Longrightarrow> ad_agr_close_set AD X = \<Union>(ad_agr_close AD ` X)"
   by (force simp: ad_agr_close_set_def Set.is_empty_def ad_agr_close_empty)
 
 lemma Ball_fo_nmlzd: "Ball (fo_nmlz AD ` X) (fo_nmlzd AD)"
   by (auto simp: fo_nmlz_sound)
 
 lemmas ad_agr_close_set_nmlz_eq = ad_agr_close_set_eq[OF Ball_fo_nmlzd]
 
 definition eval_pred :: "('a fo_term) list \<Rightarrow> 'a table \<Rightarrow> ('a, 'c) fo_t" where
   "eval_pred ts X = (let AD = \<Union>(set (map set_fo_term ts)) \<union> \<Union>(set ` X) in
     (AD, length (fv_fo_terms_list ts), eval_table ts (map Inl ` X)))"
 
 definition eval_bool :: "bool \<Rightarrow> ('a, 'c) fo_t" where
   "eval_bool b = (if b then ({}, 0, {[]}) else ({}, 0, {}))"
 
 definition eval_eq :: "'a fo_term \<Rightarrow> 'a fo_term \<Rightarrow> ('a, nat) fo_t" where
   "eval_eq t t' = (case t of Var n \<Rightarrow>
   (case t' of Var n' \<Rightarrow>
     if n = n' then ({}, 1, {[Inr 0]})
     else ({}, 2, {[Inr 0, Inr 0]})
     | Const c' \<Rightarrow> ({c'}, 1, {[Inl c']}))
   | Const c \<Rightarrow>
     (case t' of Var n' \<Rightarrow> ({c}, 1, {[Inl c]})
     | Const c' \<Rightarrow> if c = c' then ({c}, 0, {[]}) else ({c, c'}, 0, {})))"
 
 fun eval_neg :: "nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> ('a, nat) fo_t" where
   "eval_neg ns (AD, _, X) = (AD, length ns, nall_tuples AD (length ns) - X)"
 
 definition "eval_conj_tuple AD ns\<phi> ns\<psi> xs ys =
   (let cxs = filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> isl x) (zip ns\<phi> xs);
     nxs = map fst (filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> \<not>isl x) (zip ns\<phi> xs));
     cys = filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> isl y) (zip ns\<psi> ys);
     nys = map fst (filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> \<not>isl y) (zip ns\<psi> ys)) in
   fo_nmlz AD ` ext_tuple {} (sort (ns\<phi> @ map fst cys)) nys (map snd (merge (zip ns\<phi> xs) cys)) \<inter>
   fo_nmlz AD ` ext_tuple {} (sort (ns\<psi> @ map fst cxs)) nxs (map snd (merge (zip ns\<psi> ys) cxs)))"
 
 definition "eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi> = \<Union>((\<lambda>xs. \<Union>(eval_conj_tuple AD ns\<phi> ns\<psi> xs ` X\<psi>)) ` X\<phi>)"
 
 definition "idx_join AD ns ns\<phi> X\<phi> ns\<psi> X\<psi> =
   (let idx\<phi>' = cluster (Some \<circ> (\<lambda>xs. fo_nmlz AD (proj_tuple ns (zip ns\<phi> xs)))) X\<phi>;
   idx\<psi>' = cluster (Some \<circ> (\<lambda>ys. fo_nmlz AD (proj_tuple ns (zip ns\<psi> ys)))) X\<psi> in
   set_of_idx (mapping_join (\<lambda>X\<phi>'' X\<psi>''. eval_conj_set AD ns\<phi> X\<phi>'' ns\<psi> X\<psi>'') idx\<phi>' idx\<psi>'))"
 
 fun eval_conj :: "nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow>
   ('a, nat) fo_t" where
   "eval_conj ns\<phi> (AD\<phi>, _, X\<phi>) ns\<psi> (AD\<psi>, _, X\<psi>) = (let AD = AD\<phi> \<union> AD\<psi>; AD\<Delta>\<phi> = AD - AD\<phi>; AD\<Delta>\<psi> = AD - AD\<psi>; ns = filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi> in
     (AD, card (set ns\<phi> \<union> set ns\<psi>), idx_join AD ns ns\<phi> (ad_agr_close_set AD\<Delta>\<phi> X\<phi>) ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> X\<psi>)))"
 
 fun eval_ajoin :: "nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow>
   ('a, nat) fo_t" where
   "eval_ajoin ns\<phi> (AD\<phi>, _, X\<phi>) ns\<psi> (AD\<psi>, _, X\<psi>) = (let AD = AD\<phi> \<union> AD\<psi>; AD\<Delta>\<phi> = AD - AD\<phi>; AD\<Delta>\<psi> = AD - AD\<psi>;
     ns = filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi>; ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>;
     idx\<phi> = cluster (Some \<circ> (\<lambda>xs. fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> xs)))) (ad_agr_close_set AD\<Delta>\<phi> X\<phi>);
     idx\<psi> = cluster (Some \<circ> (\<lambda>ys. fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<psi> ys)))) X\<psi> in
     (AD, card (set ns\<phi> \<union> set ns\<psi>), set_of_idx (Mapping.map_values (\<lambda>xs X. case Mapping.lookup idx\<psi> xs of Some Y \<Rightarrow>
       idx_join AD ns ns\<phi> X ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {xs} - Y)) | _ \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' X) idx\<phi>)))"
 
 fun eval_disj :: "nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow>
   ('a, nat) fo_t" where
   "eval_disj ns\<phi> (AD\<phi>, _, X\<phi>) ns\<psi> (AD\<psi>, _, X\<psi>) = (let AD = AD\<phi> \<union> AD\<psi>;
     ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>;
     ns\<psi>' = filter (\<lambda>n. n \<notin> set ns\<psi>) ns\<phi>;
     AD\<Delta>\<phi> = AD - AD\<phi>; AD\<Delta>\<psi> = AD - AD\<psi> in
     (AD, card (set ns\<phi> \<union> set ns\<psi>),
       ext_tuple_set AD ns\<phi> ns\<phi>' (ad_agr_close_set AD\<Delta>\<phi> X\<phi>) \<union>
       ext_tuple_set AD ns\<psi> ns\<psi>' (ad_agr_close_set AD\<Delta>\<psi> X\<psi>)))"
 
 fun eval_exists :: "nat \<Rightarrow> nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> ('a, nat) fo_t" where
   "eval_exists i ns (AD, _, X) = (case pos i ns of Some j \<Rightarrow>
     (AD, length ns - 1, fo_nmlz AD ` rem_nth j ` X)
   | None \<Rightarrow> (AD, length ns, X))"
 
 fun eval_forall :: "nat \<Rightarrow> nat list \<Rightarrow> ('a, nat) fo_t \<Rightarrow> ('a, nat) fo_t" where
   "eval_forall i ns (AD, _, X) = (case pos i ns of Some j \<Rightarrow>
     let n = card AD in
     (AD, length ns - 1, Mapping.keys (Mapping.filter (\<lambda>t Z. n + card (Inr -` set t) + 1 \<le> card Z)
       (cluster (Some \<circ> (\<lambda>ts. fo_nmlz AD (rem_nth j ts))) X)))
     | None \<Rightarrow> (AD, length ns, X))"
 
 lemma combine_map2: assumes "length ys = length xs" "length ys' = length xs'"
   "distinct xs" "distinct xs'" "set xs \<inter> set xs' = {}"
   shows "\<exists>f. ys = map f xs \<and> ys' = map f xs'"
 proof -
   obtain f g where fg_def: "ys = map f xs" "ys' = map g xs'"
     using assms exists_map
     by metis
   show ?thesis
     using assms
     by (auto simp: fg_def intro!: exI[of _ "\<lambda>x. if x \<in> set xs then f x else g x"])
 qed
 
 lemma combine_map3: assumes "length ys = length xs" "length ys' = length xs'" "length ys'' = length xs''"
   "distinct xs" "distinct xs'" "distinct xs''" "set xs \<inter> set xs' = {}" "set xs \<inter> set xs'' = {}" "set xs' \<inter> set xs'' = {}"
   shows "\<exists>f. ys = map f xs \<and> ys' = map f xs' \<and> ys'' = map f xs''"
 proof -
   obtain f g h where fgh_def: "ys = map f xs" "ys' = map g xs'" "ys'' = map h xs''"
     using assms exists_map
     by metis
   show ?thesis
     using assms
     by (auto simp: fgh_def intro!: exI[of _ "\<lambda>x. if x \<in> set xs then f x else if x \<in> set xs' then g x else h x"])
 qed
 
 lemma distinct_set_zip: "length nsx = length xs \<Longrightarrow> distinct nsx \<Longrightarrow>
   (a, b) \<in> set (zip nsx xs) \<Longrightarrow> (a, ba) \<in> set (zip nsx xs) \<Longrightarrow> b = ba"
   by (induction nsx xs rule: list_induct2) (auto dest: set_zip_leftD)
 
 lemma fo_nmlz_idem_isl:
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> (case x of Inl z \<Rightarrow> z \<in> X | _ \<Rightarrow> False)"
   shows "fo_nmlz X xs = xs"
 proof -
   have F1: "Inl x \<in> set xs \<Longrightarrow> x \<in> X" for x
     using assms[of "Inl x"]
     by auto
   have F2: "List.map_filter (case_sum Map.empty Some) xs = []"
     using assms
     by (induction xs) (fastforce simp: List.map_filter_def split: sum.splits)+
   show ?thesis
     by (rule fo_nmlz_idem) (auto simp: fo_nmlzd_def nats_def F2 intro: F1)
 qed
 
 lemma set_zip_mapI: "x \<in> set xs \<Longrightarrow> (f x, g x) \<in> set (zip (map f xs) (map g xs))"
   by (induction xs) auto
 
 lemma ad_agr_list_fo_nmlzd_isl:
   assumes "ad_agr_list X (map f xs) (map g xs)" "fo_nmlzd X (map f xs)" "x \<in> set xs" "isl (f x)"
   shows "f x = g x"
 proof -
   have AD: "ad_equiv_pair X (f x, g x)"
     using assms(1) set_zip_mapI[OF assms(3)]
     by (auto simp: ad_agr_list_def ad_equiv_list_def split: sum.splits)
   then show ?thesis
     using assms(2-)
     by (auto simp: fo_nmlzd_def) (metis AD ad_equiv_pair.simps ad_equiv_pair_mono image_eqI sum.collapse(1) vimageI)
 qed
 
 lemma eval_conj_tuple_close_empty2:
   assumes "fo_nmlzd X xs" "fo_nmlzd Y ys"
     "length nsx = length xs" "length nsy = length ys"
     "sorted_distinct nsx" "sorted_distinct nsy"
     "sorted_distinct ns" "set ns \<subseteq> set nsx \<inter> set nsy"
     "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs)) \<noteq> fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys)) \<or>
       (proj_tuple ns (zip nsx xs) \<noteq> proj_tuple ns (zip nsy ys) \<and>
       (\<forall>x \<in> set (proj_tuple ns (zip nsx xs)). isl x) \<and> (\<forall>y \<in> set (proj_tuple ns (zip nsy ys)). isl y))"
     "xs' \<in> ad_agr_close ((X \<union> Y) - X) xs" "ys' \<in> ad_agr_close ((X \<union> Y) - Y) ys"
   shows "eval_conj_tuple (X \<union> Y) nsx nsy xs' ys' = {}"
 proof -
   define cxs where "cxs = filter (\<lambda>(n, x). n \<notin> set nsy \<and> isl x) (zip nsx xs')"
   define nxs where "nxs = map fst (filter (\<lambda>(n, x). n \<notin> set nsy \<and> \<not>isl x) (zip nsx xs'))"
   define cys where "cys = filter (\<lambda>(n, y). n \<notin> set nsx \<and> isl y) (zip nsy ys')"
   define nys where "nys = map fst (filter (\<lambda>(n, y). n \<notin> set nsx \<and> \<not>isl y) (zip nsy ys'))"
   define both where "both = sorted_list_of_set (set nsx \<union> set nsy)"
   have close: "fo_nmlzd (X \<union> Y) xs'" "ad_agr_list X xs xs'" "fo_nmlzd (X \<union> Y) ys'" "ad_agr_list Y ys ys'"
     using ad_agr_close_sound[OF assms(10) assms(1)] ad_agr_close_sound[OF assms(11) assms(2)]
     by (auto simp add: sup_left_commute)
   have close': "length xs' = length xs" "length ys' = length ys"
     using close
     by (auto simp: ad_agr_list_length)
   have len_sort: "length (sort (nsx @ map fst cys)) = length (map snd (merge (zip nsx xs') cys))"
     "length (sort (nsy @ map fst cxs)) = length (map snd (merge (zip nsy ys') cxs))"
     by (auto simp: merge_length assms(3,4) close')
   {
     fix zs
     assume "zs \<in> fo_nmlz (X \<union> Y) ` (\<lambda>fs. map snd (merge (zip (sort (nsx @ map fst cys)) (map snd (merge (zip nsx xs') cys))) (zip nys fs))) `
       nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip nsx xs') cys)))) (length nys)"
     "zs \<in> fo_nmlz (X \<union> Y) ` (\<lambda>fs. map snd (merge (zip (sort (nsy @ map fst cxs)) (map snd (merge (zip nsy ys') cxs))) (zip nxs fs))) `
       nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip nsy ys') cxs)))) (length nxs)"
     then obtain zxs zys where nall: "zxs \<in> nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip nsx xs') cys)))) (length nys)"
       "zs = fo_nmlz (X \<union> Y) (map snd (merge (zip (sort (nsx @ map fst cys)) (map snd (merge (zip nsx xs') cys))) (zip nys zxs)))"
       "zys \<in> nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip nsy ys') cxs)))) (length nxs)"
       "zs = fo_nmlz (X \<union> Y) (map snd (merge (zip (sort (nsy @ map fst cxs)) (map snd (merge (zip nsy ys') cxs))) (zip nxs zys)))"
       by auto
     have len_zs: "length zxs = length nys" "length zys = length nxs"
       using nall(1,3)
       by (auto dest: nall_tuples_rec_length)
     have aux: "sorted_distinct (map fst cxs)" "sorted_distinct nxs" "sorted_distinct nsy"
       "sorted_distinct (map fst cys)" "sorted_distinct nys" "sorted_distinct nsx"
       "set (map fst cxs) \<inter> set nsy = {}" "set (map fst cxs) \<inter> set nxs = {}" "set nsy \<inter> set nxs = {}"
       "set (map fst cys) \<inter> set nsx = {}" "set (map fst cys) \<inter> set nys = {}" "set nsx \<inter> set nys = {}"
       using assms(3,4,5,6) close' distinct_set_zip
       by (auto simp: cxs_def nxs_def cys_def nys_def sorted_filter distinct_map_fst_filter)
          (smt (z3) distinct_set_zip)+
     obtain xf where xf_def: "map snd cxs = map xf (map fst cxs)" "ys' = map xf nsy" "zys = map xf nxs"
       using combine_map3[where ?ys="map snd cxs" and ?xs="map fst cxs" and ?ys'=ys' and ?xs'=nsy and ?ys''=zys and ?xs''=nxs] assms(4) aux close'
       by (auto simp: len_zs)
     obtain ysf where ysf_def: "ys = map ysf nsy"
       using assms(4,6) exists_map
       by auto
     obtain xg where xg_def: "map snd cys = map xg (map fst cys)" "xs' = map xg nsx" "zxs = map xg nys"
       using combine_map3[where ?ys="map snd cys" and ?xs="map fst cys" and ?ys'=xs' and ?xs'=nsx and ?ys''=zxs and ?xs''=nys] assms(3) aux close'
       by (auto simp: len_zs)
     obtain xsf where xsf_def: "xs = map xsf nsx"
       using assms(3,5) exists_map
       by auto
     have set_cxs_nxs: "set (map fst cxs @ nxs) = set nsx - set nsy"
       using assms(3)
       unfolding cxs_def nxs_def close'[symmetric]
       by (induction nsx xs' rule: list_induct2) auto
     have set_cys_nys: "set (map fst cys @ nys) = set nsy - set nsx"
       using assms(4)
       unfolding cys_def nys_def close'[symmetric]
       by (induction nsy ys' rule: list_induct2) auto
     have sort_sort_both_xs: "sort (sort (nsy @ map fst cxs) @ nxs) = both"
       apply (rule sorted_distinct_set_unique)
       using assms(3,5,6) close' set_cxs_nxs
       by (auto simp: both_def nxs_def cxs_def intro: distinct_map_fst_filter)
          (metis (no_types, lifting) distinct_set_zip)
     have sort_sort_both_ys: "sort (sort (nsx @ map fst cys) @ nys) = both"
       apply (rule sorted_distinct_set_unique)
       using assms(4,5,6) close' set_cys_nys
       by (auto simp: both_def nys_def cys_def intro: distinct_map_fst_filter)
          (metis (no_types, lifting) distinct_set_zip)
     have "map snd (merge (zip nsy ys') cxs) = map xf (sort (nsy @ map fst cxs))"
       using merge_map[where ?\<sigma>=xf and ?ns=nsy and ?ms="map fst cxs"] assms(6) aux
       unfolding xf_def(1)[symmetric] xf_def(2)
       by (auto simp: zip_map_fst_snd)
     then have zs_xf: "zs = fo_nmlz (X \<union> Y) (map xf both)"
       using merge_map[where \<sigma>=xf and ?ns="sort (nsy @ map fst cxs)" and ?ms=nxs] aux
       by (fastforce simp: nall(4) xf_def(3) sort_sort_both_xs)
     have "map snd (merge (zip nsx xs') cys) = map xg (sort (nsx @ map fst cys))"
       using merge_map[where ?\<sigma>=xg and ?ns=nsx and ?ms="map fst cys"] assms(5) aux
       unfolding xg_def(1)[symmetric] xg_def(2)
       by (fastforce simp: zip_map_fst_snd)
     then have zs_xg: "zs = fo_nmlz (X \<union> Y) (map xg both)"
       using merge_map[where \<sigma>=xg and ?ns="sort (nsx @ map fst cys)" and ?ms=nys] aux
       by (fastforce simp: nall(2) xg_def(3) sort_sort_both_ys)
     have proj_map: "proj_tuple ns (zip nsx xs') = map xg ns" "proj_tuple ns (zip nsy ys') = map xf ns"
       "proj_tuple ns (zip nsx xs) = map xsf ns" "proj_tuple ns (zip nsy ys) = map ysf ns"
       unfolding xf_def(2) xg_def(2) xsf_def ysf_def
       using assms(5,6,7,8) proj_tuple_map
       by auto
     have "ad_agr_list (X \<union> Y) (map xg both) (map xf both)"
       using zs_xg zs_xf
       by (fastforce dest: fo_nmlz_eqD)
     then have "ad_agr_list (X \<union> Y) (proj_tuple ns (zip nsx xs')) (proj_tuple ns (zip nsy ys'))"
       using assms(8)
       unfolding proj_map
       by (fastforce simp: both_def intro: ad_agr_list_subset[rotated])
     then have fo_nmlz_Un: "fo_nmlz (X \<union> Y) (proj_tuple ns (zip nsx xs')) = fo_nmlz (X \<union> Y) (proj_tuple ns (zip nsy ys'))"
       by (auto intro: fo_nmlz_eqI)
     have "False"
       using assms(9)
     proof (rule disjE)
       assume c: "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs)) \<noteq> fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys))"
       have fo_nmlz_Int: "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs')) = fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys'))"
         using fo_nmlz_Un
         by (rule fo_nmlz_eqI[OF ad_agr_list_mono, rotated, OF fo_nmlz_eqD]) auto
       have proj_xs: "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs)) = fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs'))"
         unfolding proj_map
         apply (rule fo_nmlz_eqI)
         apply (rule ad_agr_list_mono[OF Int_lower1])
         apply (rule ad_agr_list_subset[OF _ close(2)[unfolded xsf_def xg_def(2)]])
         using assms(8)
         apply (auto)
         done
       have proj_ys: "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys)) = fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys'))"
         unfolding proj_map
         apply (rule fo_nmlz_eqI)
         apply (rule ad_agr_list_mono[OF Int_lower2])
         apply (rule ad_agr_list_subset[OF _ close(4)[unfolded ysf_def xf_def(2)]])
         using assms(8)
         apply (auto)
         done
       show "False"
         using c fo_nmlz_Int proj_xs proj_ys
         by auto
     next
       assume c: "proj_tuple ns (zip nsx xs) \<noteq> proj_tuple ns (zip nsy ys) \<and>
       (\<forall>x\<in>set (proj_tuple ns (zip nsx xs)). isl x) \<and> (\<forall>y\<in>set (proj_tuple ns (zip nsy ys)). isl y)"
       have "case x of Inl z \<Rightarrow> z \<in> X \<union> Y | Inr b \<Rightarrow> False" if "x \<in> set (proj_tuple ns (zip nsx xs'))" for x
         using close(2) assms(1,8) c that ad_agr_list_fo_nmlzd_isl[where ?X=X and ?f=xsf and ?g=xg and ?xs=nsx]
         unfolding proj_map
         unfolding xsf_def xg_def(2)
         apply (auto simp: fo_nmlzd_def split: sum.splits)
          apply (metis image_eqI subsetD vimageI)
         apply (metis subsetD sum.disc(2))
         done
       then have E1: "fo_nmlz (X \<union> Y) (proj_tuple ns (zip nsx xs')) = proj_tuple ns (zip nsx xs')"
         by (rule fo_nmlz_idem_isl)
       have "case y of Inl z \<Rightarrow> z \<in> X \<union> Y | Inr b \<Rightarrow> False" if "y \<in> set (proj_tuple ns (zip nsy ys'))" for y
         using close(4) assms(2,8) c that ad_agr_list_fo_nmlzd_isl[where ?X=Y and ?f=ysf and ?g=xf and ?xs=nsy]
         unfolding proj_map
         unfolding ysf_def xf_def(2)
         apply (auto simp: fo_nmlzd_def split: sum.splits)
          apply (metis image_eqI subsetD vimageI)
         apply (metis subsetD sum.disc(2))
         done
       then have E2: "fo_nmlz (X \<union> Y) (proj_tuple ns (zip nsy ys')) = proj_tuple ns (zip nsy ys')"
         by (rule fo_nmlz_idem_isl)
       have ad: "ad_agr_list X (map xsf ns) (map xg ns)"
         using assms(8) close(2)[unfolded xsf_def xg_def(2)] ad_agr_list_subset
         by blast
       have "\<forall>x\<in>set (proj_tuple ns (zip nsx xs)). isl x"
         using c
         by auto
       then have E3: "proj_tuple ns (zip nsx xs) = proj_tuple ns (zip nsx xs')"
         using assms(8)
         unfolding proj_map
         apply (induction ns)
         using ad_agr_list_fo_nmlzd_isl[OF close(2)[unfolded xsf_def xg_def(2)] assms(1)[unfolded xsf_def]]
         by auto
       have "\<forall>x\<in>set (proj_tuple ns (zip nsy ys)). isl x"
         using c
         by auto
       then have E4: "proj_tuple ns (zip nsy ys) = proj_tuple ns (zip nsy ys')"
         using assms(8)
         unfolding proj_map
         apply (induction ns)
         using ad_agr_list_fo_nmlzd_isl[OF close(4)[unfolded ysf_def xf_def(2)] assms(2)[unfolded ysf_def]]
         by auto
       show "False"
         using c fo_nmlz_Un
         unfolding E1 E2 E3 E4
         by auto
     qed
   }
   then show ?thesis
     by (auto simp: eval_conj_tuple_def Let_def cxs_def[symmetric] nxs_def[symmetric] cys_def[symmetric] nys_def[symmetric]
         ext_tuple_eq[OF len_sort(1)] ext_tuple_eq[OF len_sort(2)])
 qed
 
 lemma eval_conj_tuple_close_empty:
   assumes "fo_nmlzd X xs" "fo_nmlzd Y ys"
     "length nsx = length xs" "length nsy = length ys"
     "sorted_distinct nsx" "sorted_distinct nsy"
     "ns = filter (\<lambda>n. n \<in> set nsy) nsx"
     "fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsx xs)) \<noteq> fo_nmlz (X \<inter> Y) (proj_tuple ns (zip nsy ys))"
     "xs' \<in> ad_agr_close ((X \<union> Y) - X) xs" "ys' \<in> ad_agr_close ((X \<union> Y) - Y) ys"
   shows "eval_conj_tuple (X \<union> Y) nsx nsy xs' ys' = {}"
 proof -
   have aux: "sorted_distinct ns" "set ns \<subseteq> set nsx \<inter> set nsy"
     using assms(5) sorted_filter[of id]
     by (auto simp: assms(7))
   show ?thesis
     using eval_conj_tuple_close_empty2[OF assms(1-6) aux] assms(8-)
     by auto
 qed
 
 lemma eval_conj_tuple_empty2:
   assumes "fo_nmlzd Z xs" "fo_nmlzd Z ys"
     "length nsx = length xs" "length nsy = length ys"
     "sorted_distinct nsx" "sorted_distinct nsy"
     "sorted_distinct ns" "set ns \<subseteq> set nsx \<inter> set nsy"
     "fo_nmlz Z (proj_tuple ns (zip nsx xs)) \<noteq> fo_nmlz Z (proj_tuple ns (zip nsy ys)) \<or>
       (proj_tuple ns (zip nsx xs) \<noteq> proj_tuple ns (zip nsy ys) \<and>
       (\<forall>x \<in> set (proj_tuple ns (zip nsx xs)). isl x) \<and> (\<forall>y \<in> set (proj_tuple ns (zip nsy ys)). isl y))"
   shows "eval_conj_tuple Z nsx nsy xs ys = {}"
   using eval_conj_tuple_close_empty2[OF assms(1-8)] assms(9) ad_agr_close_empty assms(1-2)
   by fastforce
 
 lemma eval_conj_tuple_empty:
   assumes "fo_nmlzd Z xs" "fo_nmlzd Z ys"
     "length nsx = length xs" "length nsy = length ys"
     "sorted_distinct nsx" "sorted_distinct nsy"
     "ns = filter (\<lambda>n. n \<in> set nsy) nsx"
     "fo_nmlz Z (proj_tuple ns (zip nsx xs)) \<noteq> fo_nmlz Z (proj_tuple ns (zip nsy ys))"
   shows "eval_conj_tuple Z nsx nsy xs ys = {}"
 proof -
   have aux: "sorted_distinct ns" "set ns \<subseteq> set nsx \<inter> set nsy"
     using assms(5) sorted_filter[of id]
     by (auto simp: assms(7))
   show ?thesis
     using eval_conj_tuple_empty2[OF assms(1-6) aux] assms(8-)
     by auto
 qed
 
 lemma nall_tuples_rec_filter:
   assumes "xs \<in> nall_tuples_rec AD n (length xs)" "ys = filter (\<lambda>x. \<not>isl x) xs"
   shows "ys \<in> nall_tuples_rec {} n (length ys)"
   using assms
 proof (induction xs arbitrary: n ys)
   case (Cons x xs)
   then show ?case
   proof (cases x)
     case (Inr b)
     have b_le_i: "b \<le> n"
       using Cons(2)
       by (auto simp: Inr)
     obtain zs where ys_def: "ys = Inr b # zs" "zs = filter (\<lambda>x. \<not> isl x) xs"
       using Cons(3)
       by (auto simp: Inr)
     show ?thesis
     proof (cases "b < n")
       case True
       then show ?thesis
         using Cons(1)[OF _ ys_def(2), of n] Cons(2)
         by (auto simp: Inr ys_def(1))
     next
       case False
       then show ?thesis
         using Cons(1)[OF _ ys_def(2), of "Suc n"] Cons(2)
         by (auto simp: Inr ys_def(1))
     qed
   qed auto
 qed auto
 
 lemma nall_tuples_rec_filter_rev:
   assumes "ys \<in> nall_tuples_rec {} n (length ys)" "ys = filter (\<lambda>x. \<not>isl x) xs"
     "Inl -` set xs \<subseteq> AD"
   shows "xs \<in> nall_tuples_rec AD n (length xs)"
   using assms
 proof (induction xs arbitrary: n ys)
   case (Cons x xs)
   show ?case
   proof (cases x)
     case (Inl a)
     have a_AD: "a \<in> AD"
       using Cons(4)
       by (auto simp: Inl)
     show ?thesis
       using Cons(1)[OF Cons(2)] Cons(3,4) a_AD
       by (auto simp: Inl)
   next
     case (Inr b)
     obtain zs where ys_def: "ys = Inr b # zs" "zs = filter (\<lambda>x. \<not> isl x) xs"
       using Cons(3)
       by (auto simp: Inr)
     show ?thesis
       using Cons(1)[OF _ ys_def(2)] Cons(2,4)
       by (fastforce simp: ys_def(1) Inr)
   qed
 qed auto
 
 lemma eval_conj_set_aux:
   fixes AD :: "'a set"
   assumes ns\<phi>'_def: "ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>"
     and ns\<psi>'_def: "ns\<psi>' = filter (\<lambda>n. n \<notin> set ns\<psi>) ns\<phi>"
     and X\<phi>_def: "X\<phi> = fo_nmlz AD ` proj_vals R\<phi> ns\<phi>"
     and X\<psi>_def: "X\<psi> = fo_nmlz AD ` proj_vals R\<psi> ns\<psi>"
     and distinct: "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>"
     and cxs_def: "cxs = filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> isl x) (zip ns\<phi> xs)"
     and nxs_def: "nxs = map fst (filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> \<not>isl x) (zip ns\<phi> xs))"
     and cys_def: "cys = filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> isl y) (zip ns\<psi> ys)"
     and nys_def: "nys = map fst (filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> \<not>isl y) (zip ns\<psi> ys))"
     and xs_ys_def: "xs \<in> X\<phi>" "ys \<in> X\<psi>"
     and \<sigma>xs_def: "xs = map \<sigma>xs ns\<phi>" "fs\<phi> = map \<sigma>xs ns\<phi>'"
     and \<sigma>ys_def: "ys = map \<sigma>ys ns\<psi>" "fs\<psi> = map \<sigma>ys ns\<psi>'"
     and fs\<phi>_def: "fs\<phi> \<in> nall_tuples_rec AD (card (Inr -` set xs)) (length ns\<phi>')"
     and fs\<psi>_def: "fs\<psi> \<in> nall_tuples_rec AD (card (Inr -` set ys)) (length ns\<psi>')"
     and ad_agr: "ad_agr_list AD (map \<sigma>ys (sort (ns\<psi> @ ns\<psi>'))) (map \<sigma>xs (sort (ns\<phi> @ ns\<phi>')))"
   shows
     "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) =
       map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
     (zip nys (map \<sigma>xs nys)))" and
     "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))" and
     "map \<sigma>xs nys \<in>
       nall_tuples_rec {} (card (Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))) (length nys)"
 proof -
   have len_xs_ys: "length xs = length ns\<phi>" "length ys = length ns\<psi>"
     using xs_ys_def
     by (auto simp: X\<phi>_def X\<psi>_def proj_vals_def fo_nmlz_length)
   have len_fs\<phi>: "length fs\<phi> = length ns\<phi>'"
     using \<sigma>xs_def(2)
     by auto
   have set_ns\<phi>': "set ns\<phi>' = set (map fst cys) \<union> set nys"
     using len_xs_ys(2)
     by (auto simp: ns\<phi>'_def cys_def nys_def dest: set_zip_leftD)
        (metis (no_types, lifting) image_eqI in_set_impl_in_set_zip1 mem_Collect_eq
         prod.sel(1) split_conv)
   have "\<And>x. Inl x \<in> set xs \<union> set fs\<phi> \<Longrightarrow> x \<in> AD" "\<And>y. Inl y \<in> set ys \<union> set fs\<psi> \<Longrightarrow> y \<in> AD"
     using xs_ys_def fo_nmlz_set[of AD] nall_tuples_rec_Inl[OF fs\<phi>_def]
       nall_tuples_rec_Inl[OF fs\<psi>_def]
     by (auto simp: X\<phi>_def X\<psi>_def)
   then have Inl_xs_ys:
     "\<And>n. n \<in> set ns\<phi> \<union> set ns\<psi> \<Longrightarrow> isl (\<sigma>xs n) \<longleftrightarrow> (\<exists>x. \<sigma>xs n = Inl x \<and> x \<in> AD)"
     "\<And>n. n \<in> set ns\<phi> \<union> set ns\<psi> \<Longrightarrow> isl (\<sigma>ys n) \<longleftrightarrow> (\<exists>y. \<sigma>ys n = Inl y \<and> y \<in> AD)"
     unfolding \<sigma>xs_def \<sigma>ys_def ns\<phi>'_def ns\<psi>'_def
     by (auto simp: isl_def) (smt imageI mem_Collect_eq)+
   have sort_sort: "sort (ns\<phi> @ ns\<phi>') = sort (ns\<psi> @ ns\<psi>')"
     apply (rule sorted_distinct_set_unique)
     using distinct
     by (auto simp: ns\<phi>'_def ns\<psi>'_def)
   have isl_iff: "\<And>n. n \<in> set ns\<phi>' \<union> set ns\<psi>' \<Longrightarrow> isl (\<sigma>xs n) \<or> isl (\<sigma>ys n) \<Longrightarrow> \<sigma>xs n = \<sigma>ys n"
     using ad_agr Inl_xs_ys
     unfolding sort_sort[symmetric] ad_agr_list_link[symmetric]
     unfolding ns\<phi>'_def ns\<psi>'_def
     apply (auto simp: ad_agr_sets_def)
     unfolding ad_equiv_pair.simps
        apply (metis (no_types, lifting) UnI2 image_eqI mem_Collect_eq)
       apply (metis (no_types, lifting) UnI2 image_eqI mem_Collect_eq)
      apply (metis (no_types, lifting) UnI1 image_eqI)+
     done
   have "\<And>n. n \<in> set (map fst cys) \<Longrightarrow> isl (\<sigma>xs n)"
     "\<And>n. n \<in> set (map fst cxs) \<Longrightarrow> isl (\<sigma>ys n)"
     using isl_iff
     by (auto simp: cys_def ns\<phi>'_def \<sigma>ys_def(1) cxs_def ns\<psi>'_def \<sigma>xs_def(1) set_zip)
        (metis nth_mem)+
   then have Inr_sort: "Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))) = Inr -` set xs"
     unfolding \<sigma>xs_def(1) \<sigma>ys_def(1)
     by (auto simp: zip_map_fst_snd dest: set_zip_leftD)
        (metis fst_conv image_iff sum.disc(2))+
   have map_nys: "map \<sigma>xs nys = filter (\<lambda>x. \<not>isl x) fs\<phi>"
     using isl_iff[unfolded ns\<phi>'_def]
     unfolding nys_def \<sigma>ys_def(1) \<sigma>xs_def(2) ns\<phi>'_def filter_map
     by (induction ns\<psi>) force+
   have map_nys_in_nall: "map \<sigma>xs nys \<in> nall_tuples_rec {} (card (Inr -` set xs)) (length nys)"
     using nall_tuples_rec_filter[OF fs\<phi>_def[folded len_fs\<phi>] map_nys]
     by auto
   have map_cys: "map snd cys = map \<sigma>xs (map fst cys)"
     using isl_iff
     by (auto simp: cys_def set_zip ns\<phi>'_def \<sigma>ys_def(1)) (metis nth_mem)
   show merge_xs_cys: "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))"
     apply (subst zip_map_fst_snd[of cys, symmetric])
     unfolding \<sigma>xs_def(1) map_cys
     apply (rule merge_map)
     using distinct
     by (auto simp: cys_def \<sigma>ys_def sorted_filter distinct_map_filter map_fst_zip_take)
   have merge_nys_prems: "sorted_distinct (sort (ns\<phi> @ map fst cys))" "sorted_distinct nys"
     "set (sort (ns\<phi> @ map fst cys)) \<inter> set nys = {}"
     using distinct len_xs_ys(2)
     by (auto simp: cys_def nys_def distinct_map_filter sorted_filter)
        (metis eq_key_imp_eq_value map_fst_zip)
   have map_snd_merge_nys: "map \<sigma>xs (sort (sort (ns\<phi> @ map fst cys) @ nys)) =
     map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
       (zip nys (map \<sigma>xs nys)))"
     by (rule merge_map[OF merge_nys_prems, symmetric])
   have sort_sort_nys: "sort (sort (ns\<phi> @ map fst cys) @ nys) = sort (ns\<phi> @ ns\<phi>')"
     apply (rule sorted_distinct_set_unique)
     using distinct merge_nys_prems set_ns\<phi>'
     by (auto simp: cys_def nys_def ns\<phi>'_def dest: set_zip_leftD)
   have map_merge_fs\<phi>: "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) = map \<sigma>xs (sort (ns\<phi> @ ns\<phi>'))"
     unfolding \<sigma>xs_def
     apply (rule merge_map)
     using distinct sorted_filter[of id]
     by (auto simp: ns\<phi>'_def)
   show "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) =
     map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
     (zip nys (map \<sigma>xs nys)))"
     unfolding map_merge_fs\<phi> map_snd_merge_nys[unfolded sort_sort_nys]
     by auto
   show "map \<sigma>xs nys \<in> nall_tuples_rec {}
     (card (Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))) (length nys)"
     using map_nys_in_nall
     unfolding Inr_sort[symmetric]
     by auto
 qed
 
 lemma eval_conj_set_aux':
   fixes AD :: "'a set"
   assumes ns\<phi>'_def: "ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>"
     and ns\<psi>'_def: "ns\<psi>' = filter (\<lambda>n. n \<notin> set ns\<psi>) ns\<phi>"
     and X\<phi>_def: "X\<phi> = fo_nmlz AD ` proj_vals R\<phi> ns\<phi>"
     and X\<psi>_def: "X\<psi> = fo_nmlz AD ` proj_vals R\<psi> ns\<psi>"
     and distinct: "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>"
     and cxs_def: "cxs = filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> isl x) (zip ns\<phi> xs)"
     and nxs_def: "nxs = map fst (filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> \<not>isl x) (zip ns\<phi> xs))"
     and cys_def: "cys = filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> isl y) (zip ns\<psi> ys)"
     and nys_def: "nys = map fst (filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> \<not>isl y) (zip ns\<psi> ys))"
     and xs_ys_def: "xs \<in> X\<phi>" "ys \<in> X\<psi>"
     and \<sigma>xs_def: "xs = map \<sigma>xs ns\<phi>" "map snd cys = map \<sigma>xs (map fst cys)"
       "ys\<psi> = map \<sigma>xs nys"
     and \<sigma>ys_def: "ys = map \<sigma>ys ns\<psi>" "map snd cxs = map \<sigma>ys (map fst cxs)"
       "xs\<phi> = map \<sigma>ys nxs"
     and fs\<phi>_def: "fs\<phi> = map \<sigma>xs ns\<phi>'"
     and fs\<psi>_def: "fs\<psi> = map \<sigma>ys ns\<psi>'"
     and ys\<psi>_def: "map \<sigma>xs nys \<in> nall_tuples_rec {}
       (card (Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))) (length nys)"
     and Inl_set_AD: "Inl -` (set (map snd cxs) \<union> set xs\<phi>) \<subseteq> AD"
       "Inl -` (set (map snd cys) \<union> set ys\<psi>) \<subseteq> AD"
     and ad_agr: "ad_agr_list AD (map \<sigma>ys (sort (ns\<psi> @ ns\<psi>'))) (map \<sigma>xs (sort (ns\<phi> @ ns\<phi>')))"
   shows
     "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) =
       map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
       (zip nys (map \<sigma>xs nys)))" and
     "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))"
     "fs\<phi> \<in> nall_tuples_rec AD (card (Inr -` set xs)) (length ns\<phi>')"
 proof -
   have len_xs_ys: "length xs = length ns\<phi>" "length ys = length ns\<psi>"
     using xs_ys_def
     by (auto simp: X\<phi>_def X\<psi>_def proj_vals_def fo_nmlz_length)
   have len_fs\<phi>: "length fs\<phi> = length ns\<phi>'"
     by (auto simp: fs\<phi>_def)
   have set_ns: "set ns\<phi>' = set (map fst cys) \<union> set nys"
     "set ns\<psi>' = set (map fst cxs) \<union> set nxs"
     using len_xs_ys
     by (auto simp: ns\<phi>'_def cys_def nys_def ns\<psi>'_def cxs_def nxs_def dest: set_zip_leftD)
        (metis (no_types, lifting) image_eqI in_set_impl_in_set_zip1 mem_Collect_eq
         prod.sel(1) split_conv)+
   then have set_\<sigma>_ns: "\<sigma>xs ` set ns\<psi>' \<union> \<sigma>xs ` set ns\<phi>' \<subseteq> set xs \<union> set (map snd cys) \<union> set ys\<psi>"
     "\<sigma>ys ` set ns\<phi>' \<union> \<sigma>ys ` set ns\<psi>' \<subseteq> set ys \<union> set (map snd cxs) \<union> set xs\<phi>"
     by (auto simp: \<sigma>xs_def \<sigma>ys_def ns\<phi>'_def ns\<psi>'_def)
   have Inl_sub_AD: "\<And>x. Inl x \<in> set xs \<union> set (map snd cys) \<union> set ys\<psi> \<Longrightarrow> x \<in> AD"
     "\<And>y. Inl y \<in> set ys \<union> set (map snd cxs) \<union> set xs\<phi> \<Longrightarrow> y \<in> AD"
     using xs_ys_def fo_nmlz_set[of AD] Inl_set_AD
     by (auto simp: X\<phi>_def X\<psi>_def) (metis in_set_zipE set_map subset_eq vimageI zip_map_fst_snd)+
   then have Inl_xs_ys:
     "\<And>n. n \<in> set ns\<phi>' \<union> set ns\<psi>' \<Longrightarrow> isl (\<sigma>xs n) \<longleftrightarrow> (\<exists>x. \<sigma>xs n = Inl x \<and> x \<in> AD)"
     "\<And>n. n \<in> set ns\<phi>' \<union> set ns\<psi>' \<Longrightarrow> isl (\<sigma>ys n) \<longleftrightarrow> (\<exists>y. \<sigma>ys n = Inl y \<and> y \<in> AD)"
     using set_\<sigma>_ns
     by (auto simp: isl_def rev_image_eqI)
   have sort_sort: "sort (ns\<phi> @ ns\<phi>') = sort (ns\<psi> @ ns\<psi>')"
     apply (rule sorted_distinct_set_unique)
     using distinct
     by (auto simp: ns\<phi>'_def ns\<psi>'_def)
   have isl_iff: "\<And>n. n \<in> set ns\<phi>' \<union> set ns\<psi>' \<Longrightarrow> isl (\<sigma>xs n) \<or> isl (\<sigma>ys n) \<Longrightarrow> \<sigma>xs n = \<sigma>ys n"
     using ad_agr Inl_xs_ys
     unfolding sort_sort[symmetric] ad_agr_list_link[symmetric]
     unfolding ns\<phi>'_def ns\<psi>'_def
     apply (auto simp: ad_agr_sets_def)
     unfolding ad_equiv_pair.simps
        apply (metis (no_types, lifting) UnI2 image_eqI mem_Collect_eq)
       apply (metis (no_types, lifting) UnI2 image_eqI mem_Collect_eq)
      apply (metis (no_types, lifting) UnI1 image_eqI)+
     done
   have "\<And>n. n \<in> set (map fst cys) \<Longrightarrow> isl (\<sigma>xs n)"
     "\<And>n. n \<in> set (map fst cxs) \<Longrightarrow> isl (\<sigma>ys n)"
     using isl_iff
     by (auto simp: cys_def ns\<phi>'_def \<sigma>ys_def(1) cxs_def ns\<psi>'_def \<sigma>xs_def(1) set_zip)
        (metis nth_mem)+
   then have Inr_sort: "Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))) = Inr -` set xs"
     unfolding \<sigma>xs_def(1) \<sigma>ys_def(1)
     by (auto simp: zip_map_fst_snd dest: set_zip_leftD)
        (metis fst_conv image_iff sum.disc(2))+
   have map_nys: "map \<sigma>xs nys = filter (\<lambda>x. \<not>isl x) fs\<phi>"
     using isl_iff[unfolded ns\<phi>'_def]
     unfolding nys_def \<sigma>ys_def(1) fs\<phi>_def ns\<phi>'_def
     by (induction ns\<psi>) force+
   have map_cys: "map snd cys = map \<sigma>xs (map fst cys)"
     using isl_iff
     by (auto simp: cys_def set_zip ns\<phi>'_def \<sigma>ys_def(1)) (metis nth_mem)
   show merge_xs_cys: "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))"
     apply (subst zip_map_fst_snd[of cys, symmetric])
     unfolding \<sigma>xs_def(1) map_cys
     apply (rule merge_map)
     using distinct
     by (auto simp: cys_def \<sigma>ys_def sorted_filter distinct_map_filter map_fst_zip_take)
   have merge_nys_prems: "sorted_distinct (sort (ns\<phi> @ map fst cys))" "sorted_distinct nys"
     "set (sort (ns\<phi> @ map fst cys)) \<inter> set nys = {}"
     using distinct len_xs_ys(2)
     by (auto simp: cys_def nys_def distinct_map_filter sorted_filter)
        (metis eq_key_imp_eq_value map_fst_zip)
   have map_snd_merge_nys: "map \<sigma>xs (sort (sort (ns\<phi> @ map fst cys) @ nys)) =
     map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
       (zip nys (map \<sigma>xs nys)))"
     by (rule merge_map[OF merge_nys_prems, symmetric])
   have sort_sort_nys: "sort (sort (ns\<phi> @ map fst cys) @ nys) = sort (ns\<phi> @ ns\<phi>')"
     apply (rule sorted_distinct_set_unique)
     using distinct merge_nys_prems set_ns
     by (auto simp: cys_def nys_def ns\<phi>'_def dest: set_zip_leftD)
   have map_merge_fs\<phi>: "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) = map \<sigma>xs (sort (ns\<phi> @ ns\<phi>'))"
     unfolding \<sigma>xs_def fs\<phi>_def
     apply (rule merge_map)
     using distinct sorted_filter[of id]
     by (auto simp: ns\<phi>'_def)
   show "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) =
     map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
     (zip nys (map \<sigma>xs nys)))"
     unfolding map_merge_fs\<phi> map_snd_merge_nys[unfolded sort_sort_nys]
     by auto
   have "Inl -` set fs\<phi> \<subseteq> AD"
     using Inl_sub_AD(1) set_\<sigma>_ns
     by (force simp: fs\<phi>_def)
   then show "fs\<phi> \<in> nall_tuples_rec AD (card (Inr -` set xs)) (length ns\<phi>')"
     unfolding len_fs\<phi>[symmetric]
     using nall_tuples_rec_filter_rev[OF _ map_nys] ys\<psi>_def[unfolded Inr_sort]
     by auto
 qed
 
 lemma eval_conj_set_correct:
   assumes ns\<phi>'_def: "ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>"
     and ns\<psi>'_def: "ns\<psi>' = filter (\<lambda>n. n \<notin> set ns\<psi>) ns\<phi>"
     and X\<phi>_def: "X\<phi> = fo_nmlz AD ` proj_vals R\<phi> ns\<phi>"
     and X\<psi>_def: "X\<psi> = fo_nmlz AD ` proj_vals R\<psi> ns\<psi>"
     and distinct: "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>"
   shows "eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi> = ext_tuple_set AD ns\<phi> ns\<phi>' X\<phi> \<inter> ext_tuple_set AD ns\<psi> ns\<psi>' X\<psi>"
 proof -
   have aux: "ext_tuple_set AD ns\<phi> ns\<phi>' X\<phi> = fo_nmlz AD ` \<Union>(ext_tuple AD ns\<phi> ns\<phi>' ` X\<phi>)"
     "ext_tuple_set AD ns\<psi> ns\<psi>' X\<psi> = fo_nmlz AD ` \<Union>(ext_tuple AD ns\<psi> ns\<psi>' ` X\<psi>)"
     by (auto simp: ext_tuple_set_def ext_tuple_def X\<phi>_def X\<psi>_def image_iff fo_nmlz_idem[OF fo_nmlz_sound])
   show ?thesis
     unfolding aux
   proof (rule set_eqI, rule iffI)
     fix vs
     assume "vs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD ns\<phi> ns\<phi>' ` X\<phi>) \<inter>
     fo_nmlz AD ` \<Union>(ext_tuple AD ns\<psi> ns\<psi>' ` X\<psi>)"
     then obtain xs ys where xs_ys_def: "xs \<in> X\<phi>" "vs \<in> fo_nmlz AD ` ext_tuple AD ns\<phi> ns\<phi>' xs"
       "ys \<in> X\<psi>" "vs \<in> fo_nmlz AD ` ext_tuple AD ns\<psi> ns\<psi>' ys"
       by auto
     have len_xs_ys: "length xs = length ns\<phi>" "length ys = length ns\<psi>"
       using xs_ys_def(1,3)
       by (auto simp: X\<phi>_def X\<psi>_def proj_vals_def fo_nmlz_length)
     obtain fs\<phi> where fs\<phi>_def: "vs = fo_nmlz AD (map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)))"
       "fs\<phi> \<in> nall_tuples_rec AD (card (Inr -` set xs)) (length ns\<phi>')"
       using xs_ys_def(1,2)
       by (auto simp: X\<phi>_def proj_vals_def ext_tuple_def split: if_splits)
         (metis fo_nmlz_map length_map map_snd_zip)
     obtain fs\<psi> where fs\<psi>_def: "vs = fo_nmlz AD (map snd (merge (zip ns\<psi> ys) (zip ns\<psi>' fs\<psi>)))"
       "fs\<psi> \<in> nall_tuples_rec AD (card (Inr -` set ys)) (length ns\<psi>')"
       using xs_ys_def(3,4)
       by (auto simp: X\<psi>_def proj_vals_def ext_tuple_def split: if_splits)
         (metis fo_nmlz_map length_map map_snd_zip)
     note len_fs\<phi> = nall_tuples_rec_length[OF fs\<phi>_def(2)]
     note len_fs\<psi> = nall_tuples_rec_length[OF fs\<psi>_def(2)]
     obtain \<sigma>xs where \<sigma>xs_def: "xs = map \<sigma>xs ns\<phi>" "fs\<phi> = map \<sigma>xs ns\<phi>'"
       using exists_map[of "ns\<phi> @ ns\<phi>'" "xs @ fs\<phi>"] len_xs_ys(1) len_fs\<phi> distinct
       by (auto simp: ns\<phi>'_def)
     obtain \<sigma>ys where \<sigma>ys_def: "ys = map \<sigma>ys ns\<psi>" "fs\<psi> = map \<sigma>ys ns\<psi>'"
       using exists_map[of "ns\<psi> @ ns\<psi>'" "ys @ fs\<psi>"] len_xs_ys(2) len_fs\<psi> distinct
       by (auto simp: ns\<psi>'_def)
     have map_merge_fs\<phi>: "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) = map \<sigma>xs (sort (ns\<phi> @ ns\<phi>'))"
       unfolding \<sigma>xs_def
       apply (rule merge_map)
       using distinct sorted_filter[of id]
       by (auto simp: ns\<phi>'_def)
     have map_merge_fs\<psi>: "map snd (merge (zip ns\<psi> ys) (zip ns\<psi>' fs\<psi>)) = map \<sigma>ys (sort (ns\<psi> @ ns\<psi>'))"
       unfolding \<sigma>ys_def
       apply (rule merge_map)
       using distinct sorted_filter[of id]
       by (auto simp: ns\<psi>'_def)
     define cxs where "cxs = filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> isl x) (zip ns\<phi> xs)"
     define nxs where "nxs = map fst (filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> \<not>isl x) (zip ns\<phi> xs))"
     define cys where "cys = filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> isl y) (zip ns\<psi> ys)"
     define nys where "nys = map fst (filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> \<not>isl y) (zip ns\<psi> ys))"
     note ad_agr1 = fo_nmlz_eqD[OF trans[OF fs\<phi>_def(1)[symmetric] fs\<psi>_def(1)],
         unfolded map_merge_fs\<phi> map_merge_fs\<psi>]
     note ad_agr2 = ad_agr_list_comm[OF ad_agr1]
     obtain \<sigma>xs where aux1:
       "map snd (merge (zip ns\<phi> xs) (zip ns\<phi>' fs\<phi>)) =
       map snd (merge (zip (sort (ns\<phi> @ map fst cys)) (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))
       (zip nys (map \<sigma>xs nys)))"
       "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))"
       "map \<sigma>xs nys \<in> nall_tuples_rec {}
       (card (Inr -` set (map \<sigma>xs (sort (ns\<phi> @ map fst cys))))) (length nys)"
       using eval_conj_set_aux[OF ns\<phi>'_def ns\<psi>'_def X\<phi>_def X\<psi>_def distinct cxs_def nxs_def
           cys_def nys_def xs_ys_def(1,3) \<sigma>xs_def \<sigma>ys_def fs\<phi>_def(2) fs\<psi>_def(2) ad_agr2]
       by blast
     obtain \<sigma>ys where aux2:
       "map snd (merge (zip ns\<psi> ys) (zip ns\<psi>' fs\<psi>)) =
       map snd (merge (zip (sort (ns\<psi> @ map fst cxs)) (map \<sigma>ys (sort (ns\<psi> @ map fst cxs))))
       (zip nxs (map \<sigma>ys nxs)))"
       "map snd (merge (zip ns\<psi> ys) cxs) = map \<sigma>ys (sort (ns\<psi> @ map fst cxs))"
       "map \<sigma>ys nxs \<in> nall_tuples_rec {}
       (card (Inr -` set (map \<sigma>ys (sort (ns\<psi> @ map fst cxs))))) (length nxs)"
       using eval_conj_set_aux[OF ns\<psi>'_def ns\<phi>'_def X\<psi>_def X\<phi>_def distinct(2,1) cys_def nys_def
           cxs_def nxs_def xs_ys_def(3,1) \<sigma>ys_def \<sigma>xs_def fs\<psi>_def(2) fs\<phi>_def(2) ad_agr1]
       by blast
     have vs_ext_nys: "vs \<in> fo_nmlz AD ` ext_tuple {} (sort (ns\<phi> @ map fst cys)) nys
     (map snd (merge (zip ns\<phi> xs) cys))"
       using aux1(3)
       unfolding fs\<phi>_def(1) aux1(1)
       by (simp add: ext_tuple_eq[OF length_map[symmetric]] aux1(2))
     have vs_ext_nxs: "vs \<in> fo_nmlz AD ` ext_tuple {} (sort (ns\<psi> @ map fst cxs)) nxs
     (map snd (merge (zip ns\<psi> ys) cxs))"
       using aux2(3)
       unfolding fs\<psi>_def(1) aux2(1)
       by (simp add: ext_tuple_eq[OF length_map[symmetric]] aux2(2))
     show "vs \<in> eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi>"
       using vs_ext_nys vs_ext_nxs xs_ys_def(1,3)
       by (auto simp: eval_conj_set_def eval_conj_tuple_def nys_def cys_def nxs_def cxs_def Let_def)
   next
     fix vs
     assume "vs \<in> eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi>"
     then obtain xs ys cxs nxs cys nys where
       cxs_def: "cxs = filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> isl x) (zip ns\<phi> xs)" and
       nxs_def: "nxs = map fst (filter (\<lambda>(n, x). n \<notin> set ns\<psi> \<and> \<not>isl x) (zip ns\<phi> xs))" and
       cys_def: "cys = filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> isl y) (zip ns\<psi> ys)" and
       nys_def: "nys = map fst (filter (\<lambda>(n, y). n \<notin> set ns\<phi> \<and> \<not>isl y) (zip ns\<psi> ys))" and
       xs_def: "xs \<in> X\<phi>" "vs \<in> fo_nmlz AD ` ext_tuple {} (sort (ns\<phi> @ map fst cys)) nys
       (map snd (merge (zip ns\<phi> xs) cys))" and
       ys_def: "ys \<in> X\<psi>" "vs \<in> fo_nmlz AD ` ext_tuple {} (sort (ns\<psi> @ map fst cxs)) nxs
       (map snd (merge (zip ns\<psi> ys) cxs))"
       by (auto simp: eval_conj_set_def eval_conj_tuple_def Let_def) (metis (no_types, lifting) image_eqI)
     have len_xs_ys: "length xs = length ns\<phi>" "length ys = length ns\<psi>"
       using xs_def(1) ys_def(1)
       by (auto simp: X\<phi>_def X\<psi>_def proj_vals_def fo_nmlz_length)
     have len_merge_cys: "length (map snd (merge (zip ns\<phi> xs) cys)) =
     length (sort (ns\<phi> @ map fst cys))"
       using merge_length[of "zip ns\<phi> xs" cys] len_xs_ys
       by auto
     obtain ys\<psi> where ys\<psi>_def: "vs = fo_nmlz AD (map snd (merge (zip (sort (ns\<phi> @ map fst cys))
     (map snd (merge (zip ns\<phi> xs) cys))) (zip nys ys\<psi>)))"
       "ys\<psi> \<in> nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip ns\<phi> xs) cys))))
       (length nys)"
       using xs_def(2)
       unfolding ext_tuple_eq[OF len_merge_cys[symmetric]]
       by auto
     have distinct_nys: "distinct (ns\<phi> @ map fst cys @ nys)"
       using distinct len_xs_ys
       by (auto simp: cys_def nys_def sorted_filter distinct_map_filter)
         (metis eq_key_imp_eq_value map_fst_zip)
     obtain \<sigma>xs where \<sigma>xs_def: "xs = map \<sigma>xs ns\<phi>" "map snd cys = map \<sigma>xs (map fst cys)"
       "ys\<psi> = map \<sigma>xs nys"
       using exists_map[OF _ distinct_nys, of "xs @ map snd cys @ ys\<psi>"] len_xs_ys(1)
         nall_tuples_rec_length[OF ys\<psi>_def(2)]
       by (auto simp: ns\<phi>'_def)
     have len_merge_cxs: "length (map snd (merge (zip ns\<psi> ys) cxs)) =
     length (sort (ns\<psi> @ map fst cxs))"
       using merge_length[of "zip ns\<psi> ys"] len_xs_ys
       by auto
     obtain xs\<phi> where xs\<phi>_def: "vs = fo_nmlz AD (map snd (merge (zip (sort (ns\<psi> @ map fst cxs))
     (map snd (merge (zip ns\<psi> ys) cxs))) (zip nxs xs\<phi>)))"
       "xs\<phi> \<in> nall_tuples_rec {} (card (Inr -` set (map snd (merge (zip ns\<psi> ys) cxs))))
       (length nxs)"
       using ys_def(2)
       unfolding ext_tuple_eq[OF len_merge_cxs[symmetric]]
       by auto
     have distinct_nxs: "distinct (ns\<psi> @ map fst cxs @ nxs)"
       using distinct len_xs_ys(1)
       by (auto simp: cxs_def nxs_def sorted_filter distinct_map_filter)
         (metis eq_key_imp_eq_value map_fst_zip)
     obtain \<sigma>ys where \<sigma>ys_def: "ys = map \<sigma>ys ns\<psi>" "map snd cxs = map \<sigma>ys (map fst cxs)"
       "xs\<phi> = map \<sigma>ys nxs"
       using exists_map[OF _ distinct_nxs, of "ys @ map snd cxs @ xs\<phi>"] len_xs_ys(2)
         nall_tuples_rec_length[OF xs\<phi>_def(2)]
       by (auto simp: ns\<psi>'_def)
     have sd_cs_ns: "sorted_distinct (map fst cxs)" "sorted_distinct nxs"
       "sorted_distinct (map fst cys)" "sorted_distinct nys"
       "sorted_distinct (sort (ns\<psi> @ map fst cxs))"
       "sorted_distinct (sort (ns\<phi> @ map fst cys))"
       using distinct len_xs_ys
       by (auto simp: cxs_def nxs_def cys_def nys_def sorted_filter distinct_map_filter)
     have set_cs_ns_disj: "set (map fst cxs) \<inter> set nxs = {}" "set (map fst cys) \<inter> set nys = {}"
       "set (sort (ns\<phi> @ map fst cys)) \<inter> set nys = {}"
       "set (sort (ns\<psi> @ map fst cxs)) \<inter> set nxs = {}"
       using distinct nth_eq_iff_index_eq
       by (auto simp: cxs_def nxs_def cys_def nys_def set_zip) blast+
     have merge_sort_cxs: "map snd (merge (zip ns\<psi> ys) cxs) = map \<sigma>ys (sort (ns\<psi> @ map fst cxs))"
       unfolding \<sigma>ys_def(1)
       apply (subst zip_map_fst_snd[of cxs, symmetric])
       unfolding \<sigma>ys_def(2)
       apply (rule merge_map)
       using distinct(2) sd_cs_ns
       by (auto simp: cxs_def)
     have merge_sort_cys: "map snd (merge (zip ns\<phi> xs) cys) = map \<sigma>xs (sort (ns\<phi> @ map fst cys))"
       unfolding \<sigma>xs_def(1)
       apply (subst zip_map_fst_snd[of cys, symmetric])
       unfolding \<sigma>xs_def(2)
       apply (rule merge_map)
       using distinct(1) sd_cs_ns
       by (auto simp: cys_def)
     have set_ns\<phi>': "set ns\<phi>' = set (map fst cys) \<union> set nys"
       using len_xs_ys(2)
       by (auto simp: ns\<phi>'_def cys_def nys_def dest: set_zip_leftD)
         (metis (no_types, lifting) image_eqI in_set_impl_in_set_zip1 mem_Collect_eq
           prod.sel(1) split_conv)
     have sort_sort_nys: "sort (sort (ns\<phi> @ map fst cys) @ nys) = sort (ns\<phi> @ ns\<phi>')"
       apply (rule sorted_distinct_set_unique)
       using distinct sd_cs_ns set_cs_ns_disj set_ns\<phi>'
       by (auto simp: cys_def nys_def ns\<phi>'_def dest: set_zip_leftD)
     have set_ns\<psi>': "set ns\<psi>' = set (map fst cxs) \<union> set nxs"
       using len_xs_ys(1)
       by (auto simp: ns\<psi>'_def cxs_def nxs_def dest: set_zip_leftD)
         (metis (no_types, lifting) image_eqI in_set_impl_in_set_zip1 mem_Collect_eq
           prod.sel(1) split_conv)
     have sort_sort_nxs: "sort (sort (ns\<psi> @ map fst cxs) @ nxs) = sort (ns\<psi> @ ns\<psi>')"
       apply (rule sorted_distinct_set_unique)
       using distinct sd_cs_ns set_cs_ns_disj set_ns\<psi>'
       by (auto simp: cxs_def nxs_def ns\<psi>'_def dest: set_zip_leftD)
     have ad_agr1: "ad_agr_list AD (map \<sigma>ys (sort (ns\<psi> @ ns\<psi>'))) (map \<sigma>xs (sort (ns\<phi> @ ns\<phi>')))"
       using fo_nmlz_eqD[OF trans[OF xs\<phi>_def(1)[symmetric] ys\<psi>_def(1)]]
       unfolding \<sigma>xs_def(3) \<sigma>ys_def(3) merge_sort_cxs merge_sort_cys
       unfolding merge_map[OF sd_cs_ns(5) sd_cs_ns(2) set_cs_ns_disj(4)]
       unfolding merge_map[OF sd_cs_ns(6) sd_cs_ns(4) set_cs_ns_disj(3)]
       unfolding sort_sort_nxs sort_sort_nys .
     note ad_agr2 = ad_agr_list_comm[OF ad_agr1]
     have Inl_set_AD: "Inl -` (set (map snd cxs) \<union> set xs\<phi>) \<subseteq> AD"
       "Inl -` (set (map snd cys) \<union> set ys\<psi>) \<subseteq> AD"
       using xs_def(1) nall_tuples_rec_Inl[OF xs\<phi>_def(2)] ys_def(1)
         nall_tuples_rec_Inl[OF ys\<psi>_def(2)] fo_nmlz_set[of AD]
       by (fastforce simp: cxs_def X\<phi>_def cys_def X\<psi>_def dest!: set_zip_rightD)+
     note aux1 = eval_conj_set_aux'[OF ns\<phi>'_def ns\<psi>'_def X\<phi>_def X\<psi>_def distinct cxs_def nxs_def
         cys_def nys_def xs_def(1) ys_def(1) \<sigma>xs_def \<sigma>ys_def refl refl
         ys\<psi>_def(2)[unfolded \<sigma>xs_def(3) merge_sort_cys] Inl_set_AD ad_agr1]
     note aux2 = eval_conj_set_aux'[OF ns\<psi>'_def ns\<phi>'_def X\<psi>_def X\<phi>_def distinct(2,1) cys_def nys_def
         cxs_def nxs_def ys_def(1) xs_def(1) \<sigma>ys_def \<sigma>xs_def refl refl
         xs\<phi>_def(2)[unfolded \<sigma>ys_def(3) merge_sort_cxs] Inl_set_AD(2,1) ad_agr2]
     show "vs \<in> fo_nmlz AD ` \<Union>(ext_tuple AD ns\<phi> ns\<phi>' ` X\<phi>) \<inter>
     fo_nmlz AD ` \<Union>(ext_tuple AD ns\<psi> ns\<psi>' ` X\<psi>)"
       using xs_def(1) ys_def(1) ys\<psi>_def(1) xs\<phi>_def(1) aux1(3) aux2(3)
         ext_tuple_eq[OF len_xs_ys(1)[symmetric], of AD ns\<phi>']
         ext_tuple_eq[OF len_xs_ys(2)[symmetric], of AD ns\<psi>']
       unfolding aux1(2) aux2(2) \<sigma>ys_def(3) \<sigma>xs_def(3) aux1(1)[symmetric] aux2(1)[symmetric]
       by blast
   qed
 qed
 
 lemma esat_exists_not_fv: "n \<notin> fv_fo_fmla \<phi> \<Longrightarrow> X \<noteq> {} \<Longrightarrow>
   esat (Exists n \<phi>) I \<sigma> X \<longleftrightarrow> esat \<phi> I \<sigma> X"
 proof (rule iffI)
   assume assms: "n \<notin> fv_fo_fmla \<phi>" "esat (Exists n \<phi>) I \<sigma> X"
   then obtain x where "esat \<phi> I (\<sigma>(n := x)) X"
     by auto
   with assms(1) show "esat \<phi> I \<sigma> X"
     using esat_fv_cong[of \<phi> \<sigma> "\<sigma>(n := x)"] by fastforce
 next
   assume assms: "n \<notin> fv_fo_fmla \<phi>" "X \<noteq> {}" "esat \<phi> I \<sigma> X"
   from assms(2) obtain x where x_def: "x \<in> X"
     by auto
   with assms(1,3) have "esat \<phi> I (\<sigma>(n := x)) X"
     using esat_fv_cong[of \<phi> \<sigma> "\<sigma>(n := x)"] by fastforce
   with x_def show "esat (Exists n \<phi>) I \<sigma> X"
     by auto
 qed
 
 lemma esat_forall_not_fv: "n \<notin> fv_fo_fmla \<phi> \<Longrightarrow> X \<noteq> {} \<Longrightarrow>
   esat (Forall n \<phi>) I \<sigma> X \<longleftrightarrow> esat \<phi> I \<sigma> X"
   using esat_exists_not_fv[of n "Neg \<phi>" X I \<sigma>]
   by auto
 
 lemma proj_sat_vals: "proj_sat \<phi> I =
   proj_vals {\<sigma>. sat \<phi> I \<sigma>} (fv_fo_fmla_list \<phi>)"
   by (auto simp: proj_sat_def proj_vals_def)
 
 lemma fv_fo_fmla_list_Pred: "remdups_adj (sort (fv_fo_terms_list ts)) = fv_fo_terms_list ts"
   unfolding fv_fo_terms_list_def
   by (simp add: distinct_remdups_adj_sort remdups_adj_distinct sorted_sort_id)
 
 lemma ad_agr_list_fv_list': "\<Union>(set (map set_fo_term ts)) \<subseteq> X \<Longrightarrow>
   ad_agr_list X (map \<sigma> (fv_fo_terms_list ts)) (map \<tau> (fv_fo_terms_list ts)) \<Longrightarrow>
   ad_agr_list X (\<sigma> \<odot>e ts) (\<tau> \<odot>e ts)"
 proof (induction ts)
   case (Cons t ts)
   have IH: "ad_agr_list X (\<sigma> \<odot>e ts) (\<tau> \<odot>e ts)"
     using Cons
     by (auto simp: ad_agr_list_def ad_equiv_list_link[symmetric] fv_fo_terms_set_list
         fv_fo_terms_set_def sp_equiv_list_link sp_equiv_def pairwise_def) blast+
   have ad_equiv: "\<And>i. i \<in> fv_fo_term_set t \<union> \<Union>(fv_fo_term_set ` set ts) \<Longrightarrow>
     ad_equiv_pair X (\<sigma> i, \<tau> i)"
     using Cons(3)
     by (auto simp: ad_agr_list_def ad_equiv_list_link[symmetric] fv_fo_terms_set_list
         fv_fo_terms_set_def)
   have sp_equiv: "\<And>i j. i \<in> fv_fo_term_set t \<union> \<Union>(fv_fo_term_set ` set ts) \<Longrightarrow>
     j \<in> fv_fo_term_set t \<union> \<Union>(fv_fo_term_set ` set ts) \<Longrightarrow> sp_equiv_pair (\<sigma> i, \<tau> i) (\<sigma> j, \<tau> j)"
     using Cons(3)
     by (auto simp: ad_agr_list_def sp_equiv_list_link fv_fo_terms_set_list
         fv_fo_terms_set_def sp_equiv_def pairwise_def)
   show ?case
   proof (cases t)
     case (Const c)
     show ?thesis
       using IH Cons(2)
       apply (auto simp: ad_agr_list_def eval_eterms_def ad_equiv_list_def Const
           sp_equiv_list_def pairwise_def set_zip)
       unfolding ad_equiv_pair.simps
           apply (metis nth_map rev_image_eqI)+
       done
   next
     case (Var n)
     note t_def = Var
     have ad: "ad_equiv_pair X (\<sigma> n, \<tau> n)"
       using ad_equiv
       by (auto simp: Var)
     have "\<And>y. y \<in> set (zip (map ((\<cdot>e) \<sigma>) ts) (map ((\<cdot>e) \<tau>) ts)) \<Longrightarrow> y \<noteq> (\<sigma> n, \<tau> n) \<Longrightarrow>
       sp_equiv_pair (\<sigma> n, \<tau> n) y \<and> sp_equiv_pair y (\<sigma> n, \<tau> n)"
     proof -
       fix y
       assume "y \<in> set (zip (map ((\<cdot>e) \<sigma>) ts) (map ((\<cdot>e) \<tau>) ts))"
       then obtain t' where y_def: "t' \<in> set ts" "y = (\<sigma> \<cdot>e t', \<tau> \<cdot>e t')"
         using nth_mem
         by (auto simp: set_zip) blast
       show "sp_equiv_pair (\<sigma> n, \<tau> n) y \<and> sp_equiv_pair y (\<sigma> n, \<tau> n)"
       proof (cases t')
         case (Const c')
         have c'_X: "c' \<in> X"
           using Cons(2) y_def(1)
           by (auto simp: Const) (meson SUP_le_iff fo_term.set_intros subsetD)
         then show ?thesis
           using ad_equiv[of n] y_def(1)
           unfolding y_def
           apply (auto simp: Const t_def)
           unfolding ad_equiv_pair.simps
              apply fastforce+
            apply force
           apply (metis rev_image_eqI)
           done
       next
         case (Var n')
         show ?thesis
           using sp_equiv[of n n'] y_def(1)
           unfolding y_def
           by (fastforce simp: t_def Var)
       qed
     qed
     then show ?thesis
       using IH Cons(3)
       by (auto simp: ad_agr_list_def eval_eterms_def ad_equiv_list_def Var ad sp_equiv_list_def
           pairwise_insert)
   qed
 qed (auto simp: eval_eterms_def ad_agr_list_def ad_equiv_list_def sp_equiv_list_def)
 
 lemma ext_tuple_ad_agr_close:
   assumes S\<phi>_def: "S\<phi> \<equiv> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     and AD_sub: "act_edom \<phi> I \<subseteq> AD\<phi>" "AD\<phi> \<subseteq> AD"
     and X\<phi>_def: "X\<phi> = fo_nmlz AD\<phi> ` proj_vals S\<phi> (fv_fo_fmla_list \<phi>)"
     and ns\<phi>'_def: "ns\<phi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<phi>) ns\<psi>"
     and sd_ns\<psi>: "sorted_distinct ns\<psi>"
     and fv_Un: "fv_fo_fmla \<psi> = fv_fo_fmla \<phi> \<union> set ns\<psi>"
   shows "ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' (ad_agr_close_set (AD - AD\<phi>) X\<phi>) =
     fo_nmlz AD ` proj_vals S\<phi> (fv_fo_fmla_list \<psi>)"
     "ad_agr_close_set (AD - AD\<phi>) X\<phi> = fo_nmlz AD ` proj_vals S\<phi> (fv_fo_fmla_list \<phi>)"
 proof -
   have ad_agr_\<phi>:
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD\<phi> \<sigma> \<tau> \<Longrightarrow>
       \<sigma> \<in> S\<phi> \<longleftrightarrow> \<tau> \<in> S\<phi>"
     using esat_UNIV_cong[OF ad_agr_sets_restrict, OF _ subset_refl] ad_agr_sets_mono AD_sub
     unfolding S\<phi>_def
     by blast
   show ad_close_alt: "ad_agr_close_set (AD - AD\<phi>) X\<phi> = fo_nmlz AD ` proj_vals S\<phi> (fv_fo_fmla_list \<phi>)"
     using ad_agr_close_correct[OF AD_sub(2) ad_agr_\<phi>] AD_sub(2)
     unfolding X\<phi>_def S\<phi>_def[symmetric] proj_fmla_def
     by (auto simp: ad_agr_close_set_def Set.is_empty_def)
   have fv_\<phi>: "set (fv_fo_fmla_list \<phi>) \<subseteq> set (fv_fo_fmla_list \<psi>)"
     using fv_Un
     by (auto simp: fv_fo_fmla_list_set)
   have sd_ns\<phi>': "sorted_distinct ns\<phi>'"
     using sd_ns\<psi> sorted_filter[of id]
     by (auto simp: ns\<phi>'_def)
   show "ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' (ad_agr_close_set (AD - AD\<phi>) X\<phi>) =
     fo_nmlz AD ` proj_vals S\<phi> (fv_fo_fmla_list \<psi>)"
     apply (rule ext_tuple_correct)
     using sorted_distinct_fv_list ad_close_alt ad_agr_\<phi> ad_agr_sets_mono[OF AD_sub(2)]
       fv_Un sd_ns\<phi>'
     by (fastforce simp: ns\<phi>'_def fv_fo_fmla_list_set)+
 qed
 
 lemma proj_ext_tuple:
   assumes S\<phi>_def: "S\<phi> \<equiv> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     and AD_sub: "act_edom \<phi> I \<subseteq> AD"
     and X\<phi>_def: "X\<phi> = fo_nmlz AD ` proj_vals S\<phi> (fv_fo_fmla_list \<phi>)"
     and ns\<phi>'_def: "ns\<phi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<phi>) ns\<psi>"
     and sd_ns\<psi>: "sorted_distinct ns\<psi>"
     and fv_Un: "fv_fo_fmla \<psi> = fv_fo_fmla \<phi> \<union> set ns\<psi>"
     and Z_props: "\<And>xs. xs \<in> Z \<Longrightarrow> fo_nmlz AD xs = xs \<and> length xs = length (fv_fo_fmla_list \<psi>)"
   shows "Z \<inter> ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' X\<phi> =
     {xs \<in> Z. fo_nmlz AD (proj_tuple (fv_fo_fmla_list \<phi>) (zip (fv_fo_fmla_list \<psi>) xs)) \<in> X\<phi>}"
     "Z - ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' X\<phi> =
     {xs \<in> Z. fo_nmlz AD (proj_tuple (fv_fo_fmla_list \<phi>) (zip (fv_fo_fmla_list \<psi>) xs)) \<notin> X\<phi>}"
 proof -
   have ad_agr_\<phi>:
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD \<sigma> \<tau> \<Longrightarrow>
       \<sigma> \<in> S\<phi> \<longleftrightarrow> \<tau> \<in> S\<phi>"
     using esat_UNIV_cong[OF ad_agr_sets_restrict, OF _ subset_refl] ad_agr_sets_mono AD_sub
     unfolding S\<phi>_def
     by blast
   have sd_ns\<phi>': "sorted_distinct ns\<phi>'"
     using sd_ns\<psi> sorted_filter[of id]
     by (auto simp: ns\<phi>'_def)
   have disj: "set (fv_fo_fmla_list \<phi>) \<inter> set ns\<phi>' = {}"
     by (auto simp: ns\<phi>'_def fv_fo_fmla_list_set)
   have Un: "set (fv_fo_fmla_list \<phi>) \<union> set ns\<phi>' = set (fv_fo_fmla_list \<psi>)"
     using fv_Un
     by (auto simp: ns\<phi>'_def fv_fo_fmla_list_set)
   note proj = proj_tuple_correct[OF sorted_distinct_fv_list sd_ns\<phi>' sorted_distinct_fv_list
       disj Un X\<phi>_def ad_agr_\<phi>, simplified]
   have "fo_nmlz AD ` X\<phi> = X\<phi>"
     using fo_nmlz_idem[OF fo_nmlz_sound]
     by (auto simp: X\<phi>_def image_iff)
   then have aux: "ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' X\<phi> = fo_nmlz AD ` \<Union>(ext_tuple AD (fv_fo_fmla_list \<phi>) ns\<phi>' ` X\<phi>)"
     by (auto simp: ext_tuple_set_def ext_tuple_def)
   show "Z \<inter> ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' X\<phi> =
     {xs \<in> Z. fo_nmlz AD (proj_tuple (fv_fo_fmla_list \<phi>) (zip (fv_fo_fmla_list \<psi>) xs)) \<in> X\<phi>}"
     using Z_props proj
     by (auto simp: aux)
   show "Z - ext_tuple_set AD (fv_fo_fmla_list \<phi>) ns\<phi>' X\<phi> =
     {xs \<in> Z. fo_nmlz AD (proj_tuple (fv_fo_fmla_list \<phi>) (zip (fv_fo_fmla_list \<psi>) xs)) \<notin> X\<phi>}"
     using Z_props proj
     by (auto simp: aux)
 qed
 
 lemma fo_nmlz_proj_sub: "fo_nmlz AD ` proj_fmla \<phi> R \<subseteq> nall_tuples AD (nfv \<phi>)"
   by (auto simp: proj_fmla_map fo_nmlz_length fo_nmlz_sound nfv_def
       intro: nall_tuplesI)
 
 lemma fin_ad_agr_list_iff:
   fixes AD :: "('a :: infinite) set"
   assumes "finite AD" "\<And>vs. vs \<in> Z \<Longrightarrow> length vs = n"
     "Z = {ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'}"
   shows "finite Z \<longleftrightarrow> \<Union>(set ` Z) \<subseteq> AD"
 proof (rule iffI, rule ccontr)
   assume fin: "finite Z"
   assume "\<not>\<Union>(set ` Z) \<subseteq> AD"
   then obtain \<sigma> i vs where \<sigma>_def: "map \<sigma> [0..<n] \<in> Z" "i < n" "\<sigma> i \<notin> AD" "vs \<in> X"
     "ad_agr_list AD (map (Inl \<circ> \<sigma>) [0..<n]) vs"
     using assms(2)
     by (auto simp: assms(3) in_set_conv_nth) (metis map_map map_nth)
   define Y where "Y \<equiv> AD \<union> \<sigma> ` {0..<n}"
   have inf_UNIV_Y: "infinite (UNIV - Y)"
     using assms(1)
     by (auto simp: Y_def infinite_UNIV)
   have "\<And>y. y \<notin> Y \<Longrightarrow> map ((\<lambda>z. if z = \<sigma> i then y else z) \<circ> \<sigma>) [0..<n] \<in> Z"
     using \<sigma>_def(3)
     by (auto simp: assms(3) intro!: bexI[OF _ \<sigma>_def(4)] ad_agr_list_trans[OF _ \<sigma>_def(5)])
        (auto simp: ad_agr_list_def ad_equiv_list_def set_zip Y_def ad_equiv_pair.simps
         sp_equiv_list_def pairwise_def split: if_splits)
   then have "(\<lambda>x'. map ((\<lambda>z. if z = \<sigma> i then x' else z) \<circ> \<sigma>) [0..<n]) `
     (UNIV - Y) \<subseteq> Z"
     by auto
   moreover have "inj (\<lambda>x'. map ((\<lambda>z. if z = \<sigma> i then x' else z) \<circ> \<sigma>) [0..<n])"
     using \<sigma>_def(2)
     by (auto simp: inj_def)
   ultimately show "False"
     using inf_UNIV_Y fin
     by (meson inj_on_diff inj_on_finite)
 next
   assume "\<Union>(set ` Z) \<subseteq> AD"
   then have "Z \<subseteq> all_tuples AD n"
     using assms(2)
     by (auto intro: all_tuplesI)
   then show "finite Z"
     using all_tuples_finite[OF assms(1)] finite_subset
     by auto
 qed
 
 lemma proj_out_list:
   fixes AD :: "('a :: infinite) set"
     and \<sigma> :: "nat \<Rightarrow> 'a + nat"
     and ns :: "nat list"
   assumes "finite AD"
   shows "\<exists>\<tau>. ad_agr_list AD (map \<sigma> ns) (map (Inl \<circ> \<tau>) ns) \<and>
     (\<forall>j x. j \<in> set ns \<longrightarrow> \<sigma> j = Inl x \<longrightarrow> \<tau> j = x)"
 proof -
   have fin: "finite (AD \<union> Inl -` set (map \<sigma> ns))"
     using assms(1) finite_Inl[OF finite_set]
     by blast
   obtain f where f_def: "inj (f :: nat \<Rightarrow> 'a)"
     "range f \<subseteq> UNIV - (AD \<union> Inl -` set (map \<sigma> ns))"
     using arb_countable_map[OF fin]
     by auto
   define \<tau> where "\<tau> = case_sum id f \<circ> \<sigma>"
   have f_out: "\<And>i x. i < length ns \<Longrightarrow> \<sigma> (ns ! i) = Inl (f x) \<Longrightarrow> False"
     using f_def(2)
     by (auto simp: vimage_def)
        (metis (no_types, lifting) DiffE UNIV_I UnCI imageI image_subset_iff mem_Collect_eq nth_mem)
   have "(a, b) \<in> set (zip (map \<sigma> ns) (map (Inl \<circ> \<tau>) ns)) \<Longrightarrow> ad_equiv_pair AD (a, b)" for a b
     using f_def(2)
     by (auto simp: set_zip \<tau>_def ad_equiv_pair.simps split: sum.splits)+
   moreover have "sp_equiv_list (map \<sigma> ns) (map (Inl \<circ> \<tau>) ns)"
     using f_def(1) f_out
     by (auto simp: sp_equiv_list_def pairwise_def set_zip \<tau>_def inj_def split: sum.splits)+
   ultimately have "ad_agr_list AD (map \<sigma> ns) (map (Inl \<circ> \<tau>) ns)"
     by (auto simp: ad_agr_list_def ad_equiv_list_def)
   then show ?thesis
     by (auto simp: \<tau>_def intro!: exI[of _ \<tau>])
 qed
 
 lemma proj_out:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
     and J :: "(('a, nat) fo_t, 'b) fo_intp"
   assumes "wf_fo_intp \<phi> I" "esat \<phi> I \<sigma> UNIV"
   shows "\<exists>\<tau>. esat \<phi> I (Inl \<circ> \<tau>) UNIV \<and> (\<forall>i x. i \<in> fv_fo_fmla \<phi> \<and> \<sigma> i = Inl x \<longrightarrow> \<tau> i = x) \<and>
     ad_agr_list (act_edom \<phi> I) (map \<sigma> (fv_fo_fmla_list \<phi>)) (map (Inl \<circ> \<tau>) (fv_fo_fmla_list \<phi>))"
   using proj_out_list[OF finite_act_edom[OF assms(1)], of \<sigma> "fv_fo_fmla_list \<phi>"]
     esat_UNIV_ad_agr_list[OF _ subset_refl] assms(2)
   unfolding fv_fo_fmla_list_set
   by fastforce
 
 lemma proj_fmla_esat_sat:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
     and J :: "(('a, nat) fo_t, 'b) fo_intp"
   assumes wf: "wf_fo_intp \<phi> I"
   shows "proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter> map Inl ` UNIV =
     map Inl ` proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
   unfolding sat_esat_conv[OF wf]
 proof (rule set_eqI, rule iffI)
   fix vs
   assume "vs \<in> proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter> map Inl ` UNIV"
   then obtain \<sigma> where \<sigma>_def: "vs = map \<sigma> (fv_fo_fmla_list \<phi>)" "esat \<phi> I \<sigma> UNIV"
     "set vs \<subseteq> range Inl"
     by (auto simp: proj_fmla_map) (metis image_subset_iff list.set_map range_eqI)
   obtain \<tau> where \<tau>_def: "esat \<phi> I (Inl \<circ> \<tau>) UNIV"
     "\<And>i x. i \<in> fv_fo_fmla \<phi> \<Longrightarrow> \<sigma> i = Inl x \<Longrightarrow> \<tau> i = x"
     using proj_out[OF assms \<sigma>_def(2)]
     by fastforce
   have "vs = map (Inl \<circ> \<tau>) (fv_fo_fmla_list \<phi>)"
     using \<sigma>_def(1,3) \<tau>_def(2)
     by (auto simp: fv_fo_fmla_list_set)
   then show "vs \<in> map Inl ` proj_fmla \<phi> {\<sigma>. esat \<phi> I (Inl \<circ> \<sigma>) UNIV}"
     using \<tau>_def(1)
     by (force simp: proj_fmla_map)
 qed (auto simp: proj_fmla_map)
 
 lemma norm_proj_fmla_esat_sat:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes "wf_fo_intp \<phi> I"
   shows "fo_nmlz (act_edom \<phi> I) ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV} =
     fo_nmlz (act_edom \<phi> I) ` map Inl ` proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
 proof -
   have "fo_nmlz (act_edom \<phi> I) (map \<sigma> (fv_fo_fmla_list \<phi>)) = fo_nmlz (act_edom \<phi> I) x"
     "x \<in> (\<lambda>\<tau>. map \<tau> (fv_fo_fmla_list \<phi>)) ` {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter> range (map Inl)"
     if "esat \<phi> I \<sigma> UNIV" "esat \<phi> I (Inl \<circ> \<tau>) UNIV" "x = map (Inl \<circ> \<tau>) (fv_fo_fmla_list \<phi>)"
       "ad_agr_list (act_edom \<phi> I) (map \<sigma> (fv_fo_fmla_list \<phi>)) (map (Inl \<circ> \<tau>) (fv_fo_fmla_list \<phi>))"
     for \<sigma> \<tau> x
     using that
     by (auto intro!: fo_nmlz_eqI) (metis map_map range_eqI)
   then show ?thesis
     unfolding proj_fmla_esat_sat[OF assms, symmetric]
     using proj_out[OF assms]
     by (fastforce simp: image_iff proj_fmla_map)
 qed
 
 lemma proj_sat_fmla: "proj_sat \<phi> I = proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
   by (auto simp: proj_sat_def proj_fmla_map)
 
 fun fo_wf :: "('a, 'b) fo_fmla \<Rightarrow> ('b \<times> nat \<Rightarrow> 'a list set) \<Rightarrow> ('a, nat) fo_t \<Rightarrow> bool" where
   "fo_wf \<phi> I (AD, n, X) \<longleftrightarrow> finite AD \<and> finite X \<and> n = nfv \<phi> \<and>
     wf_fo_intp \<phi> I \<and> AD = act_edom \<phi> I \<and> fo_rep (AD, n, X) = proj_sat \<phi> I \<and>
     Inl -` \<Union>(set ` X) \<subseteq> AD \<and> (\<forall>vs \<in> X. fo_nmlzd AD vs \<and> length vs = n)"
 
 fun fo_fin :: "('a, nat) fo_t \<Rightarrow> bool" where
   "fo_fin (AD, n, X) \<longleftrightarrow> (\<forall>x \<in> \<Union>(set ` X). isl x)"
 
 lemma fo_rep_fin:
   assumes "fo_wf \<phi> I (AD, n, X)" "fo_fin (AD, n, X)"
   shows "fo_rep (AD, n, X) = map projl ` X"
 proof (rule set_eqI, rule iffI)
   fix vs
   assume "vs \<in> fo_rep (AD, n, X)"
   then obtain xs where xs_def: "xs \<in> X" "ad_agr_list AD (map Inl vs) xs"
     by auto
   obtain zs where zs_def: "xs = map Inl zs"
     using xs_def(1) assms
     by auto (meson ex_map_conv isl_def)
   have "set zs \<subseteq> AD"
     using assms(1) xs_def(1) zs_def
     by (force simp: vimage_def)
   then have vs_zs: "vs = zs"
     using xs_def(2)
     unfolding zs_def
     by (fastforce simp: ad_agr_list_def ad_equiv_list_def set_zip ad_equiv_pair.simps
         intro!: nth_equalityI)
   show "vs \<in> map projl ` X"
     using xs_def(1) zs_def
     by (auto simp: image_iff comp_def vs_zs intro!: bexI[of _ "map Inl zs"])
 next
   fix vs
   assume "vs \<in> map projl ` X"
   then obtain xs where xs_def: "xs \<in> X" "vs = map projl xs"
     by auto
   have xs_map_Inl: "xs = map Inl vs"
     using assms xs_def
     by (auto simp: map_idI)
   show "vs \<in> fo_rep (AD, n, X)"
     using xs_def(1)
     by (auto simp: xs_map_Inl intro!: bexI[of _ xs] ad_agr_list_refl)
 qed
 
 definition eval_abs :: "('a, 'b) fo_fmla \<Rightarrow> ('a table, 'b) fo_intp \<Rightarrow> ('a, nat) fo_t" where
   "eval_abs \<phi> I = (act_edom \<phi> I, nfv \<phi>, fo_nmlz (act_edom \<phi> I) ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV})"
 
 lemma map_projl_Inl: "map projl (map Inl xs) = xs"
   by (metis (mono_tags, lifting) length_map nth_equalityI nth_map sum.sel(1))
 
 lemma fo_rep_eval_abs:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes "wf_fo_intp \<phi> I"
   shows "fo_rep (eval_abs \<phi> I) = proj_sat \<phi> I"
 proof -
   obtain AD n X where AD_X_def: "eval_abs \<phi> I = (AD, n, X)" "AD = act_edom \<phi> I"
     "n = nfv \<phi>" "X = fo_nmlz (act_edom \<phi> I) ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     by (cases "eval_abs \<phi> I") (auto simp: eval_abs_def)
   have AD_sub: "act_edom \<phi> I \<subseteq> AD"
     by (auto simp: AD_X_def)
   have X_def: "X = fo_nmlz AD ` map Inl ` proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
     using AD_X_def norm_proj_fmla_esat_sat[OF assms]
     by auto
   have "{ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'} = proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
   proof (rule set_eqI, rule iffI)
     fix vs
     assume "vs \<in> {ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'}"
     then obtain vs' where vs'_def: "vs' \<in> proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
       "ad_agr_list AD (map Inl vs) (fo_nmlz AD (map Inl vs'))"
       using X_def
       by auto
     have "length vs = length (fv_fo_fmla_list \<phi>)"
       using vs'_def
       by (auto simp: proj_fmla_map ad_agr_list_def fo_nmlz_length)
     then obtain \<sigma> where \<sigma>_def: "vs = map \<sigma> (fv_fo_fmla_list \<phi>)"
       using exists_map[of "fv_fo_fmla_list \<phi>" vs] sorted_distinct_fv_list
       by fastforce
     obtain \<tau> where \<tau>_def: "fo_nmlz AD (map Inl vs') = map \<tau> (fv_fo_fmla_list \<phi>)"
       using vs'_def fo_nmlz_map
       by (fastforce simp: proj_fmla_map)
     have ad_agr: "ad_agr_list AD (map (Inl \<circ> \<sigma>) (fv_fo_fmla_list \<phi>)) (map \<tau> (fv_fo_fmla_list \<phi>))"
       by (metis \<sigma>_def \<tau>_def map_map vs'_def(2))
     obtain \<tau>' where \<tau>'_def: "map Inl vs' = map (Inl \<circ> \<tau>') (fv_fo_fmla_list \<phi>)"
       "sat \<phi> I \<tau>'"
       using vs'_def(1)
       by (fastforce simp: proj_fmla_map)
     have ad_agr': "ad_agr_list AD (map \<tau> (fv_fo_fmla_list \<phi>))
         (map (Inl \<circ> \<tau>') (fv_fo_fmla_list \<phi>))"
       by (rule ad_agr_list_comm) (metis fo_nmlz_ad_agr \<tau>'_def(1) \<tau>_def map_map map_projl_Inl)
     have esat: "esat \<phi> I \<tau> UNIV"
       using esat_UNIV_ad_agr_list[OF ad_agr' AD_sub, folded sat_esat_conv[OF assms]] \<tau>'_def(2)
       by auto
     show "vs \<in> proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
       using esat_UNIV_ad_agr_list[OF ad_agr AD_sub, folded sat_esat_conv[OF assms]] esat
       unfolding \<sigma>_def
       by (auto simp: proj_fmla_map)
   next
     fix vs
     assume "vs \<in> proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
     then have vs_X: "fo_nmlz AD (map Inl vs) \<in> X"
       using X_def
       by auto
     then show "vs \<in> {ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'}"
       using fo_nmlz_ad_agr
       by auto
   qed
   then show ?thesis
     by (auto simp: AD_X_def proj_sat_fmla)
 qed
 
 lemma fo_wf_eval_abs:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes "wf_fo_intp \<phi> I"
   shows "fo_wf \<phi> I (eval_abs \<phi> I)"
   using fo_nmlz_set[of "act_edom \<phi> I"] finite_act_edom[OF assms(1)]
     finite_subset[OF fo_nmlz_proj_sub, OF nall_tuples_finite]
     fo_rep_eval_abs[OF assms] assms
   by (auto simp: eval_abs_def fo_nmlz_sound fo_nmlz_length nfv_def proj_sat_def proj_fmla_map) blast
 
 lemma fo_fin:
   fixes t :: "('a :: infinite, nat) fo_t"
   assumes "fo_wf \<phi> I t"
   shows "fo_fin t = finite (fo_rep t)"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)"
     using assms
     by (cases t) auto
   have fin: "finite AD" "finite X"
     using assms
     by (auto simp: t_def)
   have len_in_X: "\<And>vs. vs \<in> X \<Longrightarrow> length vs = n"
     using assms
     by (auto simp: t_def)
   have Inl_X_AD: "\<And>x. Inl x \<in> \<Union>(set ` X) \<Longrightarrow> x \<in> AD"
     using assms
     by (fastforce simp: t_def)
   define Z where "Z = {ts. \<exists>ts' \<in> X. ad_agr_list AD (map Inl ts) ts'}"
   have fin_Z_iff: "finite Z = (\<Union>(set ` Z) \<subseteq> AD)"
     using assms fin_ad_agr_list_iff[OF fin(1) _ Z_def, of n]
     by (auto simp: Z_def t_def ad_agr_list_def)
   moreover have "(\<Union>(set ` Z) \<subseteq> AD) \<longleftrightarrow> (\<forall>x \<in> \<Union>(set ` X). isl x)"
   proof (rule iffI, rule ccontr)
     fix x
     assume Z_sub_AD: "\<Union>(set ` Z) \<subseteq> AD"
     assume "\<not>(\<forall>x \<in> \<Union>(set ` X). isl x)"
     then obtain vs i m where vs_def: "vs \<in> X" "i < n" "vs ! i = Inr m"
       using len_in_X
       by (auto simp: in_set_conv_nth) (metis sum.collapse(2))
     obtain \<sigma> where \<sigma>_def: "vs = map \<sigma> [0..<n]"
       using exists_map[of "[0..<n]" vs] len_in_X[OF vs_def(1)]
       by auto
     obtain \<tau> where \<tau>_def: "ad_agr_list AD vs (map Inl (map \<tau> [0..<n]))"
       using proj_out_list[OF fin(1), of \<sigma> "[0..<n]"]
       by (auto simp: \<sigma>_def)
     have map_\<tau>_in_Z: "map \<tau> [0..<n] \<in> Z"
       using vs_def(1) ad_agr_list_comm[OF \<tau>_def]
       by (auto simp: Z_def)
     moreover have "\<tau> i \<notin> AD"
       using \<tau>_def vs_def(2,3)
       apply (auto simp: ad_agr_list_def ad_equiv_list_def set_zip comp_def \<sigma>_def)
       unfolding ad_equiv_pair.simps
       by (metis (no_types, lifting) Inl_Inr_False diff_zero image_iff length_upt nth_map nth_upt
           plus_nat.add_0)
     ultimately show "False"
       using vs_def(2) Z_sub_AD
       by fastforce
   next
     assume "\<forall>x \<in> \<Union>(set ` X). isl x"
     then show "\<Union>(set ` Z) \<subseteq> AD"
       using Inl_X_AD
       apply (auto simp: Z_def ad_agr_list_def ad_equiv_list_def set_zip in_set_conv_nth)
       unfolding ad_equiv_pair.simps
       by (metis image_eqI isl_def nth_map nth_mem)
   qed
   ultimately show ?thesis
     by (auto simp: t_def Z_def[symmetric])
 qed
 
 lemma eval_pred:
   fixes I :: "'b \<times> nat \<Rightarrow> 'a :: infinite list set"
   assumes "finite (I (r, length ts))"
   shows "fo_wf (Pred r ts) I (eval_pred ts (I (r, length ts)))"
 proof -
   define \<phi> where "\<phi> = Pred r ts"
   have nfv_len: "nfv \<phi> = length (fv_fo_terms_list ts)"
     by (auto simp: \<phi>_def nfv_def fv_fo_fmla_list_def fv_fo_fmla_list_Pred)
   have vimage_unfold: "Inl -` (\<Union>x\<in>I (r, length ts). Inl ` set x) = \<Union>(set ` I (r, length ts))"
     by auto
   have "eval_table ts (map Inl ` I (r, length ts)) \<subseteq> nall_tuples (act_edom \<phi> I) (nfv \<phi>)"
     by (auto simp: \<phi>_def proj_vals_def eval_table nfv_len[unfolded \<phi>_def]
         fo_nmlz_length fo_nmlz_sound eval_eterms_def fv_fo_terms_set_list fv_fo_terms_set_def
         vimage_unfold intro!: nall_tuplesI fo_nmlzd_all_AD dest!: fv_fo_term_setD)
        (smt UN_I Un_iff eval_eterm.simps(2) imageE image_eqI list.set_map)
   then have eval: "eval_pred ts (I (r, length ts)) = eval_abs \<phi> I"
     by (force simp: eval_abs_def \<phi>_def proj_fmla_def eval_pred_def eval_table fv_fo_fmla_list_def
         fv_fo_fmla_list_Pred nall_tuples_set fo_nmlz_idem nfv_len[unfolded \<phi>_def])
   have fin: "wf_fo_intp (Pred r ts) I"
     using assms
     by auto
   show ?thesis
     using fo_wf_eval_abs[OF fin]
     by (auto simp: eval \<phi>_def)
 qed
 
 lemma ad_agr_list_eval: "\<Union>(set (map set_fo_term ts)) \<subseteq> AD \<Longrightarrow> ad_agr_list AD (\<sigma> \<odot>e ts) zs \<Longrightarrow>
   \<exists>\<tau>. zs = \<tau> \<odot>e ts"
 proof (induction ts arbitrary: zs)
   case (Cons t ts)
   obtain w ws where zs_split: "zs = w # ws"
     using Cons(3)
     by (cases zs) (auto simp: ad_agr_list_def eval_eterms_def)
   obtain \<tau> where \<tau>_def: "ws = \<tau> \<odot>e ts"
     using Cons
     by (fastforce simp: zs_split ad_agr_list_def ad_equiv_list_def sp_equiv_list_def pairwise_def
         eval_eterms_def)
   show ?case
   proof (cases t)
     case (Const c)
     then show ?thesis
       using Cons(3)[unfolded zs_split] Cons(2)
       unfolding Const
       apply (auto simp: zs_split eval_eterms_def \<tau>_def ad_agr_list_def ad_equiv_list_def)
       unfolding ad_equiv_pair.simps
       by blast
   next
     case (Var n)
     show ?thesis
     proof (cases "n \<in> fv_fo_terms_set ts")
       case True
       obtain i where i_def: "i < length ts" "ts ! i = Var n"
         using True
         by (auto simp: fv_fo_terms_set_def in_set_conv_nth dest!: fv_fo_term_setD)
       have "w = \<tau> n"
         using Cons(3)[unfolded zs_split \<tau>_def] i_def
         using pairwiseD[of sp_equiv_pair _ "(\<sigma> n, w)" "(\<sigma> \<cdot>e (ts ! i), \<tau> \<cdot>e (ts ! i))"]
         by (force simp: Var eval_eterms_def ad_agr_list_def sp_equiv_list_def set_zip)
       then show ?thesis
         by (auto simp: Var zs_split eval_eterms_def \<tau>_def)
     next
       case False
       then have "ws = (\<tau>(n := w)) \<odot>e ts"
         using eval_eterms_cong[of ts \<tau> "\<tau>(n := w)"] \<tau>_def
         by fastforce
       then show ?thesis
         by (auto simp: zs_split eval_eterms_def Var fun_upd_def intro: exI[of _ "\<tau>(n := w)"])
     qed
   qed
 qed (auto simp: ad_agr_list_def eval_eterms_def)
 
 lemma sp_equiv_list_fv_list:
   assumes "sp_equiv_list (\<sigma> \<odot>e ts) (\<tau> \<odot>e ts)"
   shows "sp_equiv_list (map \<sigma> (fv_fo_terms_list ts)) (map \<tau> (fv_fo_terms_list ts))"
 proof -
   have "sp_equiv_list (\<sigma> \<odot>e (map Var (fv_fo_terms_list ts)))
     (\<tau> \<odot>e (map Var (fv_fo_terms_list ts)))"
     unfolding eval_eterms_def
     by (rule sp_equiv_list_subset[OF _ assms[unfolded eval_eterms_def]])
        (auto simp: fv_fo_terms_set_list dest: fv_fo_terms_setD)
   then show ?thesis
     by (auto simp: eval_eterms_def comp_def)
 qed
 
 lemma ad_agr_list_fv_list: "ad_agr_list X (\<sigma> \<odot>e ts) (\<tau> \<odot>e ts) \<Longrightarrow>
   ad_agr_list X (map \<sigma> (fv_fo_terms_list ts)) (map \<tau> (fv_fo_terms_list ts))"
   using sp_equiv_list_fv_list
   by (auto simp: eval_eterms_def ad_agr_list_def ad_equiv_list_def sp_equiv_list_def set_zip)
      (metis (no_types, opaque_lifting) eval_eterm.simps(2) fv_fo_terms_setD fv_fo_terms_set_list
       in_set_conv_nth nth_map)
 
 lemma eval_bool: "fo_wf (Bool b) I (eval_bool b)"
   by (auto simp: eval_bool_def fo_nmlzd_def nats_def Let_def List.map_filter_simps
       proj_sat_def fv_fo_fmla_list_def ad_agr_list_def ad_equiv_list_def sp_equiv_list_def nfv_def)
 
 lemma eval_eq: fixes I :: "'b \<times> nat \<Rightarrow> 'a :: infinite list set"
   shows "fo_wf (Eqa t t') I (eval_eq t t')"
 proof -
   define \<phi> :: "('a, 'b) fo_fmla" where "\<phi> = Eqa t t'"
   obtain AD n X where AD_X_def: "eval_eq t t' = (AD, n, X)"
     by (cases "eval_eq t t'") auto
   have AD_def: "AD = act_edom \<phi> I"
     using AD_X_def
     by (auto simp: eval_eq_def \<phi>_def split: fo_term.splits if_splits)
   have n_def: "n = nfv \<phi>"
     using AD_X_def
     by (cases t; cases t')
        (auto simp: \<phi>_def fv_fo_fmla_list_def eval_eq_def nfv_def split: if_splits)
   have fo_nmlz_empty_x_x: "fo_nmlz {} [x, x] = [Inr 0, Inr 0]" for x :: "'a + nat"
     by (cases x) (auto simp: fo_nmlz_def)
   have Inr_0_in_fo_nmlz_empty: "[Inr 0, Inr 0] \<in> fo_nmlz {} ` (\<lambda>x. [x n', x n']) ` {\<sigma> :: nat \<Rightarrow> 'a + nat. \<sigma> n = \<sigma> n'}" for n n'
     by (auto simp: image_def fo_nmlz_empty_x_x intro!: exI[of _ "[Inr 0, Inr 0]"])
   have X_def: "X = fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
   proof (rule set_eqI, rule iffI)
     fix vs
     assume assm: "vs \<in> X"
     define pes where "pes = proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     have "\<And>c c'. t = Const c \<and> t' = Const c' \<Longrightarrow>
       fo_nmlz AD ` pes = (if c = c' then {[]} else {})"
       by (auto simp: \<phi>_def pes_def proj_fmla_map fo_nmlz_def fv_fo_fmla_list_def)
     moreover have "\<And>c n. (t = Const c \<and> t' = Var n) \<or> (t' = Const c \<and> t = Var n) \<Longrightarrow>
       fo_nmlz AD ` pes = {[Inl c]}"
       by (auto simp: \<phi>_def AD_def pes_def proj_fmla_map fo_nmlz_Cons fv_fo_fmla_list_def image_def
           split: sum.splits) (auto simp: fo_nmlz_def)
     moreover have "\<And>n. t = Var n \<Longrightarrow> t' = Var n \<Longrightarrow> fo_nmlz AD ` pes = {[Inr 0]}"
       by (auto simp: \<phi>_def AD_def pes_def proj_fmla_map fo_nmlz_Cons fv_fo_fmla_list_def image_def
           split: sum.splits)
     moreover have "\<And>n n'. t = Var n \<Longrightarrow> t' = Var n' \<Longrightarrow> n \<noteq> n' \<Longrightarrow>
       fo_nmlz AD ` pes = {[Inr 0, Inr 0]}"
       using Inr_0_in_fo_nmlz_empty
       by (auto simp: \<phi>_def AD_def pes_def proj_fmla_map fo_nmlz_Cons fv_fo_fmla_list_def fo_nmlz_empty_x_x
           split: sum.splits)
     ultimately show "vs \<in> fo_nmlz AD ` pes"
       using assm AD_X_def
       by (cases t; cases t') (auto simp: eval_eq_def split: if_splits)
   next
     fix vs
     assume assm: "vs \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     obtain \<sigma> where \<sigma>_def: "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
       "esat (Eqa t t') I \<sigma> UNIV"
       using assm
       by (auto simp: \<phi>_def fv_fo_fmla_list_def proj_fmla_map)
     show "vs \<in> X"
       using \<sigma>_def AD_X_def
       by (cases t; cases t')
          (auto simp: \<phi>_def eval_eq_def fv_fo_fmla_list_def fo_nmlz_Cons fo_nmlz_Cons_Cons
           split: sum.splits)
   qed
   have eval: "eval_eq t t' = eval_abs \<phi> I"
     using X_def[unfolded AD_def]
     by (auto simp: eval_abs_def AD_X_def AD_def n_def)
   have fin: "wf_fo_intp \<phi> I"
     by (auto simp: \<phi>_def)
   show ?thesis
     using fo_wf_eval_abs[OF fin]
     by (auto simp: eval \<phi>_def)
 qed
 
 lemma fv_fo_terms_list_Var: "fv_fo_terms_list_rec (map Var ns) = ns"
   by (induction ns) auto
 
 lemma eval_eterms_map_Var: "\<sigma> \<odot>e map Var ns = map \<sigma> ns"
   by (auto simp: eval_eterms_def)
 
 lemma fo_wf_eval_table:
   fixes AD :: "'a set"
   assumes "fo_wf \<phi> I (AD, n, X)"
   shows "X = fo_nmlz AD ` eval_table (map Var [0..<n]) X"
 proof -
   have AD_sup: "Inl -` \<Union>(set ` X) \<subseteq> AD"
     using assms
     by fastforce
   have fvs: "fv_fo_terms_list (map Var [0..<n]) = [0..<n]"
     by (auto simp: fv_fo_terms_list_def fv_fo_terms_list_Var remdups_adj_distinct)
   have "\<And>vs. vs \<in> X \<Longrightarrow> length vs = n"
     using assms
     by auto
   then have X_map: "\<And>vs. vs \<in> X \<Longrightarrow> \<exists>\<sigma>. vs = map \<sigma> [0..<n]"
     using exists_map[of "[0..<n]"]
     by auto
   then have proj_vals_X: "proj_vals {\<sigma>. \<sigma> \<odot>e map Var [0..<n] \<in> X} [0..<n] = X"
     by (auto simp: eval_eterms_map_Var proj_vals_def)
   then show "X = fo_nmlz AD ` eval_table (map Var [0..<n]) X"
     unfolding eval_table fvs proj_vals_X
     using assms fo_nmlz_idem image_iff
     by fastforce
 qed
 
 lemma fo_rep_norm:
   fixes AD :: "('a :: infinite) set"
   assumes "fo_wf \<phi> I (AD, n, X)"
   shows "X = fo_nmlz AD ` map Inl ` fo_rep (AD, n, X)"
 proof (rule set_eqI, rule iffI)
   fix vs
   assume vs_in: "vs \<in> X"
   have fin_AD: "finite AD"
     using assms(1)
     by auto
   have len_vs: "length vs = n"
     using vs_in assms(1)
     by auto
   obtain \<tau> where \<tau>_def: "ad_agr_list AD vs (map Inl (map \<tau> [0..<n]))"
     using proj_out_list[OF fin_AD, of "(!) vs" "[0..<length vs]", unfolded map_nth]
     by (auto simp: len_vs)
   have map_\<tau>_in: "map \<tau> [0..<n] \<in> fo_rep (AD, n, X)"
     using vs_in ad_agr_list_comm[OF \<tau>_def]
     by auto
   have "vs = fo_nmlz AD (map Inl (map \<tau> [0..<n]))"
     using fo_nmlz_eqI[OF \<tau>_def] fo_nmlz_idem vs_in assms(1)
     by fastforce
   then show "vs \<in> fo_nmlz AD ` map Inl ` fo_rep (AD, n, X)"
     using map_\<tau>_in
     by blast
 next
   fix vs
   assume "vs \<in> fo_nmlz AD ` map Inl ` fo_rep (AD, n, X)"
   then obtain xs xs' where vs_def: "xs' \<in> X" "ad_agr_list AD (map Inl xs) xs'"
     "vs = fo_nmlz AD (map Inl xs)"
     by auto
   then have "vs = fo_nmlz AD xs'"
     using fo_nmlz_eqI[OF vs_def(2)]
     by auto
   then have "vs = xs'"
     using vs_def(1) assms(1) fo_nmlz_idem
     by fastforce
   then show "vs \<in> X"
     using vs_def(1)
     by auto
 qed
 
 lemma fo_wf_X:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I (AD, n, X)"
   shows "X = fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
 proof -
   have fin: "wf_fo_intp \<phi> I"
     using wf
     by auto
   have AD_def: "AD = act_edom \<phi> I"
     using wf
     by auto
   have fo_wf: "fo_wf \<phi> I (AD, n, X)"
     using wf
     by auto
   have fo_rep: "fo_rep (AD, n, X) = proj_fmla \<phi> {\<sigma>. sat \<phi> I \<sigma>}"
     using wf
     by (auto simp: proj_sat_def proj_fmla_map)
   show ?thesis
     using fo_rep_norm[OF fo_wf] norm_proj_fmla_esat_sat[OF fin]
     unfolding fo_rep AD_def[symmetric]
     by auto
 qed
 
 lemma eval_neg:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t"
   shows "fo_wf (Neg \<phi>) I (eval_neg (fv_fo_fmla_list \<phi>) t)"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)"
     by (cases t) auto
   have eval_neg: "eval_neg (fv_fo_fmla_list \<phi>) t = (AD, nfv \<phi>, nall_tuples AD (nfv \<phi>) - X)"
     by (auto simp: t_def nfv_def)
   have fv_unfold: "fv_fo_fmla_list (Neg \<phi>) = fv_fo_fmla_list \<phi>"
     by (auto simp: fv_fo_fmla_list_def)
   then have nfv_unfold: "nfv (Neg \<phi>) = nfv \<phi>"
     by (auto simp: nfv_def)
   have AD_def: "AD = act_edom (Neg \<phi>) I"
     using wf
     by (auto simp: t_def)
   note X_def = fo_wf_X[OF wf[unfolded t_def]]
   have esat_iff: "\<And>vs. vs \<in> nall_tuples AD (nfv \<phi>) \<Longrightarrow>
     vs \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV} \<longleftrightarrow>
     vs \<notin> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat (Neg \<phi>) I \<sigma> UNIV}"
   proof (rule iffI; rule ccontr)
     fix vs
     assume "vs \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     then obtain \<sigma> where \<sigma>_def: "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
       "esat \<phi> I \<sigma> UNIV"
       by (auto simp: proj_fmla_map)
     assume "\<not>vs \<notin> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat (Neg \<phi>) I \<sigma> UNIV}"
     then obtain \<sigma>' where \<sigma>'_def: "vs = fo_nmlz AD (map \<sigma>' (fv_fo_fmla_list \<phi>))"
       "esat (Neg \<phi>) I \<sigma>' UNIV"
       by (auto simp: proj_fmla_map)
     have "esat \<phi> I \<sigma> UNIV = esat \<phi> I \<sigma>' UNIV"
       using esat_UNIV_cong[OF ad_agr_sets_restrict[OF iffD2[OF ad_agr_list_link],
             OF fo_nmlz_eqD[OF trans[OF \<sigma>_def(1)[symmetric] \<sigma>'_def(1)]]]]
       by (auto simp: AD_def)
     then show "False"
       using \<sigma>_def(2) \<sigma>'_def(2) by simp
   next
     fix vs
     assume assms: "vs \<notin> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat (Neg \<phi>) I \<sigma> UNIV}"
       "vs \<notin> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
     assume "vs \<in> nall_tuples AD (nfv \<phi>)"
     then have l_vs: "length vs = length (fv_fo_fmla_list \<phi>)" "fo_nmlzd AD vs"
       by (auto simp: nfv_def dest: nall_tuplesD)
     obtain \<sigma> where "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
       using l_vs sorted_distinct_fv_list exists_fo_nmlzd by metis
     with assms show "False"
       by (auto simp: proj_fmla_map)
   qed
   moreover have "\<And>R. fo_nmlz AD ` proj_fmla \<phi> R \<subseteq> nall_tuples AD (nfv \<phi>)"
     by (auto simp: proj_fmla_map nfv_def nall_tuplesI fo_nmlz_length fo_nmlz_sound)
   ultimately have eval: "eval_neg (fv_fo_fmla_list \<phi>) t = eval_abs (Neg \<phi>) I"
     unfolding eval_neg eval_abs_def AD_def[symmetric]
     by (auto simp: X_def proj_fmla_def fv_unfold nfv_unfold image_subset_iff)
   have wf_neg: "wf_fo_intp (Neg \<phi>) I"
     using wf
     by (auto simp: t_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_neg]
     by (auto simp: eval)
 qed
 
 definition "cross_with f t t' = \<Union>((\<lambda>xs. \<Union>(f xs ` t')) ` t)"
 
 lemma mapping_join_cross_with:
   assumes "\<And>x x'. x \<in> t \<Longrightarrow> x' \<in> t' \<Longrightarrow> h x \<noteq> h' x' \<Longrightarrow> f x x' = {}"
   shows "set_of_idx (mapping_join (cross_with f) (cluster (Some \<circ> h) t) (cluster (Some \<circ> h') t')) = cross_with f t t'"
 proof -
   have sub: "cross_with f {y \<in> t. h y = h x} {y \<in> t'. h' y = h x} \<subseteq> cross_with f t t'" for t t' x
     by (auto simp: cross_with_def)
   have "\<exists>a. a \<in> h ` t \<and> a \<in> h' ` t' \<and> z \<in> cross_with f {y \<in> t. h y = a} {y \<in> t'. h' y = a}" if z: "z \<in> cross_with f t t'" for z
   proof -
     obtain xs ys where wit: "xs \<in> t" "ys \<in> t'" "z \<in> f xs ys"
       using z
       by (auto simp: cross_with_def)
     have h: "h xs = h' ys"
       using assms(1)[OF wit(1-2)] wit(3)
       by auto
     have hys: "h' ys \<in> h ` t"
       using wit(1)
       by (auto simp: h[symmetric])
     show ?thesis
       apply (rule exI[of _ "h xs"])
       using wit hys h
       by (auto simp: cross_with_def)
   qed
   then show ?thesis
     using sub
     apply (transfer fixing: f h h')
     apply (auto simp: ran_def)
      apply fastforce+
     done
 qed
 
 lemma fo_nmlzd_mono_sub: "X \<subseteq> X' \<Longrightarrow> fo_nmlzd X xs \<Longrightarrow> fo_nmlzd X' xs"
   by (meson fo_nmlzd_def order_trans)
 
 lemma idx_join:
   assumes X\<phi>_props: "\<And>vs. vs \<in> X\<phi> \<Longrightarrow> fo_nmlzd AD vs \<and> length vs = length ns\<phi>"
   assumes X\<psi>_props: "\<And>vs. vs \<in> X\<psi> \<Longrightarrow> fo_nmlzd AD vs \<and> length vs = length ns\<psi>"
   assumes sd_ns: "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>"
   assumes ns_def: "ns = filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi>"
   shows "idx_join AD ns ns\<phi> X\<phi> ns\<psi> X\<psi> = eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi>"
 proof -
   have ect_empty: "x \<in> X\<phi> \<Longrightarrow> x' \<in> X\<psi> \<Longrightarrow> fo_nmlz AD (proj_tuple ns (zip ns\<phi> x)) \<noteq> fo_nmlz AD (proj_tuple ns (zip ns\<psi> x')) \<Longrightarrow>
     eval_conj_tuple AD ns\<phi> ns\<psi> x x' = {}"
     if "X\<phi>' \<subseteq> X\<phi>" "X\<psi>' \<subseteq> X\<psi>" for X\<phi>' X\<psi>' and x x'
     apply (rule eval_conj_tuple_empty[where ?ns="filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi>"])
     using X\<phi>_props X\<psi>_props that sd_ns
     by (auto simp: ns_def ad_agr_close_set_def split: if_splits)
   have cross_eval_conj_tuple: "(\<lambda>X\<phi>''. eval_conj_set AD ns\<phi> X\<phi>'' ns\<psi>) = cross_with (eval_conj_tuple AD ns\<phi> ns\<psi>)" for AD :: "'a set" and ns\<phi> ns\<psi>
     by (rule ext)+ (auto simp: eval_conj_set_def cross_with_def)
   have "idx_join AD ns ns\<phi> X\<phi> ns\<psi> X\<psi> = cross_with (eval_conj_tuple AD ns\<phi> ns\<psi>) X\<phi> X\<psi>"
     unfolding idx_join_def Let_def cross_eval_conj_tuple
     by (rule mapping_join_cross_with[OF ect_empty]) auto
   moreover have "\<dots> = eval_conj_set AD ns\<phi> X\<phi> ns\<psi> X\<psi>"
     by (auto simp: cross_with_def eval_conj_set_def)
   finally show ?thesis .
 qed
 
 lemma proj_fmla_conj_sub:
   assumes AD_sub: "act_edom \<psi> I \<subseteq> AD"
   shows "fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter>
     fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<psi> I \<sigma> UNIV} \<subseteq>
     fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat (Conj \<phi> \<psi>) I \<sigma> UNIV}"
 proof (rule subsetI)
   fix vs
   assume "vs \<in> fo_nmlz AD `  proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter>
       fo_nmlz AD `  proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<psi> I \<sigma> UNIV}"
   then obtain \<sigma> \<sigma>' where \<sigma>_def:
     "\<sigma> \<in> {\<sigma>. esat \<phi> I \<sigma> UNIV}" "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list (Conj \<phi> \<psi>)))"
     "\<sigma>' \<in> {\<sigma>. esat \<psi> I \<sigma> UNIV}" "vs = fo_nmlz AD (map \<sigma>' (fv_fo_fmla_list (Conj \<phi> \<psi>)))"
     unfolding proj_fmla_map
     by blast
   have ad_sub: "act_edom \<psi> I \<subseteq> AD"
     using assms(1)
     by auto
   have ad_agr: "ad_agr_list AD (map \<sigma> (fv_fo_fmla_list \<psi>)) (map \<sigma>' (fv_fo_fmla_list \<psi>))"
     by (rule ad_agr_list_subset[OF _ fo_nmlz_eqD[OF trans[OF \<sigma>_def(2)[symmetric] \<sigma>_def(4)]]])
        (auto simp: fv_fo_fmla_list_set)
   have "\<sigma> \<in> {\<sigma>. esat \<psi> I \<sigma> UNIV}"
     using esat_UNIV_cong[OF ad_agr_sets_restrict[OF iffD2[OF ad_agr_list_link]],
           OF ad_agr ad_sub] \<sigma>_def(3)
     by blast
   then show "vs \<in> fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat (Conj \<phi> \<psi>) I \<sigma> UNIV}"
     using \<sigma>_def(1,2)
     by (auto simp: proj_fmla_map)
 qed
 
 lemma eval_conj:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t\<phi>" "fo_wf \<psi> I t\<psi>"
   shows "fo_wf (Conj \<phi> \<psi>) I (eval_conj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>)"
 proof -
   obtain AD\<phi> n\<phi> X\<phi> AD\<psi> n\<psi> X\<psi> where ts_def:
     "t\<phi> = (AD\<phi>, n\<phi>, X\<phi>)" "t\<psi> = (AD\<psi>, n\<psi>, X\<psi>)"
     "AD\<phi> = act_edom \<phi> I" "AD\<psi> = act_edom \<psi> I"
     using assms
     by (cases t\<phi>, cases t\<psi>) auto
   have AD_sub: "act_edom \<phi> I \<subseteq> AD\<phi>" "act_edom \<psi> I \<subseteq> AD\<psi>"
     by (auto simp: ts_def(3,4))
 
   obtain AD n X where AD_X_def:
     "eval_conj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> = (AD, n, X)"
     by (cases "eval_conj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>") auto
   have AD_def: "AD = act_edom (Conj \<phi> \<psi>) I" "act_edom (Conj \<phi> \<psi>) I \<subseteq> AD"
     "AD\<phi> \<subseteq> AD" "AD\<psi> \<subseteq> AD" "AD = AD\<phi> \<union> AD\<psi>"
     using AD_X_def
     by (auto simp: ts_def Let_def)
   have n_def: "n = nfv (Conj \<phi> \<psi>)"
     using AD_X_def
     by (auto simp: ts_def Let_def nfv_card fv_fo_fmla_list_set)
 
   define S\<phi> where "S\<phi> \<equiv> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
   define S\<psi> where "S\<psi> \<equiv> {\<sigma>. esat \<psi> I \<sigma> UNIV}"
   define AD\<Delta>\<phi> where "AD\<Delta>\<phi> = AD - AD\<phi>"
   define AD\<Delta>\<psi> where "AD\<Delta>\<psi> = AD - AD\<psi>"
   define ns\<phi> where "ns\<phi> = fv_fo_fmla_list \<phi>"
   define ns\<psi> where "ns\<psi> = fv_fo_fmla_list \<psi>"
   define ns where "ns = filter (\<lambda>n. n \<in> fv_fo_fmla \<phi>) (fv_fo_fmla_list \<psi>)"
   define ns\<phi>' where "ns\<phi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<phi>) (fv_fo_fmla_list \<psi>)"
   define ns\<psi>' where "ns\<psi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<psi>) (fv_fo_fmla_list \<phi>)"
 
   note X\<phi>_def = fo_wf_X[OF wf(1)[unfolded ts_def(1)], unfolded proj_fmla_def, folded S\<phi>_def]
   note X\<psi>_def = fo_wf_X[OF wf(2)[unfolded ts_def(2)], unfolded proj_fmla_def, folded S\<psi>_def]
 
   have sd_ns: "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>"
     by (auto simp: ns\<phi>_def ns\<psi>_def sorted_distinct_fv_list)
   have ad_agr_X\<phi>: "ad_agr_close_set AD\<Delta>\<phi> X\<phi> = fo_nmlz AD ` proj_vals S\<phi> ns\<phi>"
     unfolding X\<phi>_def ad_agr_close_set_nmlz_eq ns\<phi>_def[symmetric] AD\<Delta>\<phi>_def
     apply (rule ad_agr_close_set_correct[OF AD_def(3) sd_ns(1)])
     using AD_sub(1) esat_UNIV_ad_agr_list
     by (fastforce simp: ad_agr_list_link S\<phi>_def ns\<phi>_def)
   have ad_agr_X\<psi>: "ad_agr_close_set AD\<Delta>\<psi> X\<psi> = fo_nmlz AD ` proj_vals S\<psi> ns\<psi>"
     unfolding X\<psi>_def ad_agr_close_set_nmlz_eq ns\<psi>_def[symmetric] AD\<Delta>\<psi>_def
     apply (rule ad_agr_close_set_correct[OF AD_def(4) sd_ns(2)])
     using AD_sub(2) esat_UNIV_ad_agr_list
     by (fastforce simp: ad_agr_list_link S\<psi>_def ns\<psi>_def)
 
   have idx_join_eval_conj: "idx_join AD (filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi>) ns\<phi> (ad_agr_close_set AD\<Delta>\<phi> X\<phi>) ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> X\<psi>) =
     eval_conj_set AD ns\<phi> (ad_agr_close_set AD\<Delta>\<phi> X\<phi>) ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> X\<psi>)"
     apply (rule idx_join[OF _ _ sd_ns])
     unfolding ad_agr_X\<phi> ad_agr_X\<psi>
     by (auto simp: fo_nmlz_sound fo_nmlz_length proj_vals_def)
 
   have fv_sub: "fv_fo_fmla (Conj \<phi> \<psi>) = fv_fo_fmla \<phi> \<union> set (fv_fo_fmla_list \<psi>)"
     "fv_fo_fmla (Conj \<phi> \<psi>) = fv_fo_fmla \<psi> \<union> set (fv_fo_fmla_list \<phi>)"
     by (auto simp: fv_fo_fmla_list_set)
   note res_left_alt = ext_tuple_ad_agr_close[OF S\<phi>_def AD_sub(1) AD_def(3)
        X\<phi>_def(1)[folded S\<phi>_def] ns\<phi>'_def sorted_distinct_fv_list fv_sub(1)]
   note res_right_alt = ext_tuple_ad_agr_close[OF S\<psi>_def AD_sub(2) AD_def(4)
        X\<psi>_def(1)[folded S\<psi>_def] ns\<psi>'_def sorted_distinct_fv_list fv_sub(2)]
 
   note eval_conj_set = eval_conj_set_correct[OF ns\<phi>'_def[folded fv_fo_fmla_list_set]
        ns\<psi>'_def[folded fv_fo_fmla_list_set] res_left_alt(2) res_right_alt(2)
        sorted_distinct_fv_list sorted_distinct_fv_list]
   have "X = fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter>
      fo_nmlz AD ` proj_fmla (Conj \<phi> \<psi>) {\<sigma>. esat \<psi> I \<sigma> UNIV}"
     using AD_X_def
     apply (simp add: ts_def(1,2) Let_def ts_def(3,4)[symmetric] AD_def(5)[symmetric] idx_join_eval_conj[unfolded ns\<phi>_def ns\<psi>_def AD\<Delta>\<phi>_def AD\<Delta>\<psi>_def])
     unfolding eval_conj_set proj_fmla_def
     unfolding res_left_alt(1) res_right_alt(1) S\<phi>_def S\<psi>_def
     by auto
   then have eval: "eval_conj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> =
     eval_abs (Conj \<phi> \<psi>) I"
     using proj_fmla_conj_sub[OF AD_def(4)[unfolded ts_def(4)], of \<phi>]
     unfolding AD_X_def AD_def(1)[symmetric] n_def eval_abs_def
     by (auto simp: proj_fmla_map)
   have wf_conj: "wf_fo_intp (Conj \<phi> \<psi>) I"
     using wf
     by (auto simp: ts_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_conj]
     by (auto simp: eval)
 qed
 
 lemma map_values_cluster: "(\<And>w z Z. Z \<subseteq> X \<Longrightarrow> z \<in> Z \<Longrightarrow> w \<in> f (h z) {z} \<Longrightarrow> w \<in> f (h z) Z) \<Longrightarrow>
   (\<And>w z Z. Z \<subseteq> X \<Longrightarrow> z \<in> Z \<Longrightarrow> w \<in> f (h z) Z \<Longrightarrow> (\<exists>z'\<in>Z. w \<in> f (h z) {z'})) \<Longrightarrow>
   set_of_idx (Mapping.map_values f (cluster (Some \<circ> h) X)) = \<Union>((\<lambda>x. f (h x) {x}) ` X)"
   apply transfer
   apply (auto simp: ran_def)
    apply (smt (verit, del_insts) mem_Collect_eq subset_eq)
   apply (smt (z3) imageI mem_Collect_eq subset_iff)
   done
 
 lemma fo_nmlz_twice:
   assumes "sorted_distinct ns" "sorted_distinct ns'" "set ns \<subseteq> set ns'"
   shows "fo_nmlz AD (proj_tuple ns (zip ns' (fo_nmlz AD (map \<sigma> ns')))) = fo_nmlz AD (map \<sigma> ns)"
 proof -
   obtain \<sigma>' where \<sigma>': "fo_nmlz AD (map \<sigma> ns') = map \<sigma>' ns'"
     using exists_map[where ?ys="fo_nmlz AD (map \<sigma> ns')" and ?xs=ns'] assms
     by (auto simp: fo_nmlz_length)
   have proj: "proj_tuple ns (zip ns' (map \<sigma>' ns')) = map \<sigma>' ns"
     by (rule proj_tuple_map[OF assms])
   show ?thesis
     unfolding \<sigma>' proj
     apply (rule fo_nmlz_eqI)
     using \<sigma>'
     by (metis ad_agr_list_comm ad_agr_list_subset assms(3) fo_nmlz_ad_agr)
 qed
 
 lemma map_values_cong:
   assumes "\<And>x y. Mapping.lookup t x = Some y \<Longrightarrow> f x y = f' x y"
   shows "Mapping.map_values f t = Mapping.map_values f' t"
 proof -
   have "map_option (f x) (Mapping.lookup t x) = map_option (f' x) (Mapping.lookup t x)" for x
     using assms
     by (cases "Mapping.lookup t x") auto
   then show ?thesis
     by (auto simp: lookup_map_values intro!: mapping_eqI)
 qed
 
 lemma ad_agr_close_set_length: "z \<in> ad_agr_close_set AD X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> length x = n) \<Longrightarrow> length z = n"
   by (auto simp: ad_agr_close_set_def ad_agr_close_def split: if_splits dest: ad_agr_close_rec_length)
 
 lemma ad_agr_close_set_sound: "z \<in> ad_agr_close_set (AD - AD') X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> fo_nmlzd AD' x) \<Longrightarrow> AD' \<subseteq> AD \<Longrightarrow> fo_nmlzd AD z"
   using ad_agr_close_sound[where ?X=AD' and ?Y="AD - AD'"]
   by (auto simp: ad_agr_close_set_def Set.is_empty_def split: if_splits) (metis Diff_partition Un_Diff_cancel)
 
 lemma ext_tuple_set_length: "z \<in> ext_tuple_set AD ns ns' X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> length x = length ns) \<Longrightarrow> length z = length ns + length ns'"
   by (auto simp: ext_tuple_set_def ext_tuple_def fo_nmlz_length merge_length dest: nall_tuples_rec_length split: if_splits)
 
 lemma eval_ajoin:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t\<phi>" "fo_wf \<psi> I t\<psi>"
   shows "fo_wf (Conj \<phi> (Neg \<psi>)) I
     (eval_ajoin (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>)"
 proof -
   obtain AD\<phi> n\<phi> X\<phi> AD\<psi> n\<psi> X\<psi> where ts_def:
     "t\<phi> = (AD\<phi>, n\<phi>, X\<phi>)" "t\<psi> = (AD\<psi>, n\<psi>, X\<psi>)"
     "AD\<phi> = act_edom \<phi> I" "AD\<psi> = act_edom \<psi> I"
     using assms
     by (cases t\<phi>, cases t\<psi>) auto
   have AD_sub: "act_edom \<phi> I \<subseteq> AD\<phi>" "act_edom \<psi> I \<subseteq> AD\<psi>"
     by (auto simp: ts_def(3,4))
 
   obtain AD n X where AD_X_def:
     "eval_ajoin (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> = (AD, n, X)"
     by (cases "eval_ajoin (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>") auto
   have AD_def: "AD = act_edom (Conj \<phi> (Neg \<psi>)) I"
     "act_edom (Conj \<phi> (Neg \<psi>)) I \<subseteq> AD" "AD\<phi> \<subseteq> AD" "AD\<psi> \<subseteq> AD" "AD = AD\<phi> \<union> AD\<psi>"
     using AD_X_def
     by (auto simp: ts_def Let_def)
   have n_def: "n = nfv (Conj \<phi> (Neg \<psi>))"
     using AD_X_def
     by (auto simp: ts_def Let_def nfv_card fv_fo_fmla_list_set)
 
   define S\<phi> where "S\<phi> \<equiv> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
   define S\<psi> where "S\<psi> \<equiv> {\<sigma>. esat \<psi> I \<sigma> UNIV}"
   define both where "both = remdups_adj (sort (fv_fo_fmla_list \<phi> @ fv_fo_fmla_list \<psi>))"
   define ns\<phi>' where "ns\<phi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<phi>) (fv_fo_fmla_list \<psi>)"
   define ns\<psi>' where "ns\<psi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<psi>) (fv_fo_fmla_list \<phi>)"
 
   define AD\<Delta>\<phi> where "AD\<Delta>\<phi> = AD - AD\<phi>"
   define AD\<Delta>\<psi> where "AD\<Delta>\<psi> = AD - AD\<psi>"
   define ns\<phi> where "ns\<phi> = fv_fo_fmla_list \<phi>"
   define ns\<psi> where "ns\<psi> = fv_fo_fmla_list \<psi>"
   define ns where "ns = filter (\<lambda>n. n \<in> set ns\<psi>) ns\<phi>"
   define X\<phi>' where "X\<phi>' = ext_tuple_set AD ns\<phi> ns\<phi>' (ad_agr_close_set AD\<Delta>\<phi> X\<phi>)"
   define idx\<phi> where "idx\<phi> = cluster (Some \<circ> (\<lambda>xs. fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> xs)))) (ad_agr_close_set AD\<Delta>\<phi> X\<phi>)"
   define idx\<psi> where "idx\<psi> = cluster (Some \<circ> (\<lambda>ys. fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<psi> ys)))) X\<psi>"
   define res where "res = Mapping.map_values (\<lambda>xs X. case Mapping.lookup idx\<psi> xs of
     Some Y \<Rightarrow> eval_conj_set AD ns\<phi> X ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {xs} - Y))
     | _ \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' X) idx\<phi>"
 
   note X\<phi>_def = fo_wf_X[OF wf(1)[unfolded ts_def(1)], unfolded proj_fmla_def, folded S\<phi>_def]
   note X\<psi>_def = fo_wf_X[OF wf(2)[unfolded ts_def(2)], unfolded proj_fmla_def, folded S\<psi>_def]
 
   have fv_sub: "fv_fo_fmla (Conj \<phi> (Neg \<psi>)) = fv_fo_fmla \<psi> \<union> set (fv_fo_fmla_list \<phi>)"
     by (auto simp: fv_fo_fmla_list_set)
   have fv_sort: "fv_fo_fmla_list (Conj \<phi> (Neg \<psi>)) = both"
     unfolding both_def
     apply (rule sorted_distinct_set_unique)
     using sorted_distinct_fv_list
     by (auto simp: fv_fo_fmla_list_def distinct_remdups_adj_sort)
 
   have AD_disj: "AD\<phi> \<inter> AD\<Delta>\<phi> = {}" "AD\<psi> \<inter> AD\<Delta>\<psi> = {}"
     by (auto simp: AD\<Delta>\<phi>_def AD\<Delta>\<psi>_def)
   have AD_delta: "AD = AD\<phi> \<union> AD\<Delta>\<phi>" "AD = AD\<psi> \<union> AD\<Delta>\<psi>"
     by (auto simp: AD\<Delta>\<phi>_def AD\<Delta>\<psi>_def AD_def ts_def)
   have fo_nmlzd_X: "Ball X\<phi> (fo_nmlzd AD\<phi>)" "Ball X\<psi> (fo_nmlzd AD\<psi>)"
     using wf
     by (auto simp: ts_def)
   have Ball_ad_agr: "Ball (ad_agr_close_set AD\<Delta>\<phi> X\<phi>) (fo_nmlzd AD)"
     using ad_agr_close_sound[where ?X="AD\<phi>" and ?Y="AD\<Delta>\<phi>"] fo_nmlzd_X(1)
     by (auto simp: ad_agr_close_set_eq[OF fo_nmlzd_X(1)] AD_disj AD_delta)
   have ad_agr_\<phi>:
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD\<phi> \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> S\<phi> \<longleftrightarrow> \<tau> \<in> S\<phi>"
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<phi>)) (set (fv_fo_fmla_list \<phi>)) AD \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> S\<phi> \<longleftrightarrow> \<tau> \<in> S\<phi>"
     using esat_UNIV_cong[OF ad_agr_sets_restrict, OF _ subset_refl] ad_agr_sets_mono AD_sub(1) subset_trans[OF AD_sub(1) AD_def(3)]
     unfolding S\<phi>_def
     by blast+
   have ad_agr_S\<phi>: "\<tau>' \<in> S\<phi> \<Longrightarrow> ad_agr_list AD\<phi> (map \<tau>' ns\<phi>) (map \<tau>'' ns\<phi>) \<Longrightarrow> \<tau>'' \<in> S\<phi>" for \<tau>' \<tau>''
     using ad_agr_\<phi>
     by (auto simp: ad_agr_list_link ns\<phi>_def)
   have ad_agr_\<psi>:
     "\<And>\<sigma> \<tau>. ad_agr_sets (set (fv_fo_fmla_list \<psi>)) (set (fv_fo_fmla_list \<psi>)) AD\<psi> \<sigma> \<tau> \<Longrightarrow> \<sigma> \<in> S\<psi> \<longleftrightarrow> \<tau> \<in> S\<psi>"
     using esat_UNIV_cong[OF ad_agr_sets_restrict, OF _ subset_refl] ad_agr_sets_mono[OF AD_sub(2)]
     unfolding S\<psi>_def
     by blast+
   have ad_agr_S\<psi>: "\<tau>' \<in> S\<psi> \<Longrightarrow> ad_agr_list AD\<psi> (map \<tau>' ns\<psi>) (map \<tau>'' ns\<psi>) \<Longrightarrow> \<tau>'' \<in> S\<psi>" for \<tau>' \<tau>''
     using ad_agr_\<psi>
     by (auto simp: ad_agr_list_link ns\<psi>_def)
   have aux: "sorted_distinct ns\<phi>" "sorted_distinct ns\<phi>'" "sorted_distinct both" "set ns\<phi> \<inter> set ns\<phi>' = {}" "set ns\<phi> \<union> set ns\<phi>' = set both"
     by (auto simp: ns\<phi>_def ns\<phi>'_def fv_sort[symmetric] fv_fo_fmla_list_set sorted_distinct_fv_list intro: sorted_filter[where ?f=id, simplified])
   have aux2: "ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<phi>'" "ns\<phi> = filter (\<lambda>n. n \<notin> set ns\<phi>') ns\<phi>"
     by (auto simp: ns\<phi>_def ns\<phi>'_def ns\<psi>_def ns\<psi>'_def fv_fo_fmla_list_set)
   have aux3: "set ns\<phi>' \<inter> set ns = {}" "set ns\<phi>' \<union> set ns = set ns\<psi>"
     by (auto simp: ns\<phi>_def ns\<phi>'_def ns\<psi>_def ns_def fv_fo_fmla_list_set)
   have aux4: "set ns \<inter> set ns\<phi>' = {}" "set ns \<union> set ns\<phi>' = set ns\<psi>"
     by (auto simp: ns\<phi>_def ns\<phi>'_def ns\<psi>_def ns_def fv_fo_fmla_list_set)
   have aux5: "ns\<phi>' = filter (\<lambda>n. n \<notin> set ns\<phi>) ns\<psi>" "ns\<psi>' = filter (\<lambda>n. n \<notin> set ns\<psi>) ns\<phi>"
     by (auto simp: ns\<phi>_def ns\<phi>'_def ns\<psi>_def ns\<psi>'_def fv_fo_fmla_list_set)
   have aux6: "set ns\<psi> \<inter> set ns\<psi>' = {}" "set ns\<psi> \<union> set ns\<psi>' = set both"
     by (auto simp: ns\<phi>_def ns\<phi>'_def ns\<psi>_def ns\<psi>'_def both_def fv_fo_fmla_list_set)
   have ns_sd: "sorted_distinct ns" "sorted_distinct ns\<phi>" "sorted_distinct ns\<psi>" "set ns \<subseteq> set ns\<phi>" "set ns \<subseteq> set ns\<psi>" "set ns \<subseteq> set both" "set ns\<phi>' \<subseteq> set ns\<psi>" "set ns\<psi> \<subseteq> set both"
     by (auto simp: ns_def ns\<phi>_def ns\<phi>'_def ns\<psi>_def both_def sorted_distinct_fv_list intro: sorted_filter[where ?f=id, simplified])
   have ns_sd': "sorted_distinct ns\<psi>'"
     by (auto simp: ns\<psi>'_def sorted_distinct_fv_list intro: sorted_filter[where ?f=id, simplified])
   have ns: "ns = filter (\<lambda>n. n \<in> fv_fo_fmla \<phi>) (fv_fo_fmla_list \<psi>)"
     by (rule sorted_distinct_set_unique)
        (auto simp: ns_def ns\<phi>_def ns\<psi>_def fv_fo_fmla_list_set sorted_distinct_fv_list intro: sorted_filter[where ?f=id, simplified])
   have len_ns\<psi>: "length ns + length ns\<phi>' = length ns\<psi>"
     using sum_length_filter_compl[where ?P="\<lambda>n. n \<in> fv_fo_fmla \<phi>" and ?xs="fv_fo_fmla_list \<psi>"]
     by (auto simp: ns ns\<phi>_def ns\<phi>'_def ns\<psi>_def fv_fo_fmla_list_set)
 
   have res_eq: "res = Mapping.map_values (\<lambda>xs X. case Mapping.lookup idx\<psi> xs of
     Some Y \<Rightarrow> idx_join AD ns ns\<phi> X ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {xs} - Y))
     | _ \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' X) idx\<phi>"
   proof -
     have ad_agr_X\<phi>: "ad_agr_close_set AD\<Delta>\<phi> X\<phi> = fo_nmlz AD ` proj_vals S\<phi> ns\<phi>"
       unfolding X\<phi>_def ad_agr_close_set_nmlz_eq ns\<phi>_def[symmetric]
       apply (rule ad_agr_close_set_correct[OF AD_def(3) aux(1), folded AD\<Delta>\<phi>_def])
       using ad_agr_S\<phi> ad_agr_list_comm
       by (fastforce simp: ad_agr_list_link)
     have idx_eval: "idx_join AD ns ns\<phi> y ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {x} - x2)) =
        eval_conj_set AD ns\<phi> y ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {x} - x2))"
       if lup: "Mapping.lookup idx\<phi> x = Some y" "Mapping.lookup idx\<psi> x = Some x2" for x y x2
     proof -
       have "vs \<in> y \<Longrightarrow> fo_nmlzd AD vs \<and> length vs = length ns\<phi>" for vs
         using lup(1)
         by (auto simp: idx\<phi>_def lookup_cluster' ad_agr_X\<phi> fo_nmlz_sound fo_nmlz_length proj_vals_def split: if_splits)
       moreover have "vs \<in> ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {x} - x2) \<Longrightarrow> fo_nmlzd AD vs" for vs
         apply (rule ad_agr_close_set_sound[OF _ _ AD_def(4), folded AD\<Delta>\<psi>_def, where ?X="ext_tuple_set AD\<psi> ns ns\<phi>' {x} - x2"])
         using lup(1)
         by (auto simp: idx\<phi>_def lookup_cluster' ext_tuple_set_def fo_nmlz_sound split: if_splits)
       moreover have "vs \<in> ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {x} - x2) \<Longrightarrow> length vs = length ns\<psi>" for vs
         apply (erule ad_agr_close_set_length)
         apply (rule ext_tuple_set_length[where ?AD=AD\<psi> and ?ns=ns and ?ns'=ns\<phi>' and ?X="{x}", unfolded len_ns\<psi>])
         using lup(1) ns_sd(1,2,4)
         by (auto simp: idx\<phi>_def lookup_cluster' fo_nmlz_length ad_agr_X\<phi> proj_vals_def intro!: proj_tuple_length split: if_splits)
       ultimately show ?thesis
         by (auto intro!: idx_join[OF _ _ ns_sd(2-3) ns_def])
     qed
     show ?thesis
       unfolding res_def
       by (rule map_values_cong) (auto simp: idx_eval split: option.splits)
   qed
 
   have eval_conj: "eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y)) =
   ext_tuple_set AD ns\<phi> ns\<phi>' {x} \<inter> ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>)"
     if x_ns: "proj_tuple ns (zip ns\<phi> x) = map \<sigma>' ns"
       and x_proj_singleton: "{x} = fo_nmlz AD ` proj_vals {\<sigma>} ns\<phi>"
       and Some: "Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) = Some Y"
     for x Y \<sigma> \<sigma>'
   proof -
     have "Y = {ys \<in> fo_nmlz AD\<psi> ` proj_vals S\<psi> ns\<psi>. fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<psi> ys)) = fo_nmlz AD\<psi> (map \<sigma>' ns)}"
       using Some
       apply (auto simp: X\<psi>_def idx\<psi>_def ns\<psi>_def x_ns lookup_cluster' split: if_splits)
       done
     moreover have "\<dots> = fo_nmlz AD\<psi> ` proj_vals {\<sigma> \<in> S\<psi>. fo_nmlz AD\<psi> (map \<sigma> ns) = fo_nmlz AD\<psi> (map \<sigma>' ns)} ns\<psi>"
       by (auto simp: proj_vals_def fo_nmlz_twice[OF ns_sd(1,3,5)])+
     moreover have "\<dots> = fo_nmlz AD\<psi> ` proj_vals {\<sigma> \<in> S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       by (auto simp: fo_nmlz_eq)
     ultimately have Y_def: "Y = fo_nmlz AD\<psi> ` proj_vals {\<sigma> \<in> S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       by auto
     have R_def: "{fo_nmlz AD\<psi> (map \<sigma>' ns)} = fo_nmlz AD\<psi> ` proj_vals {\<sigma>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns"
       using ad_agr_list_refl
       by (auto simp: proj_vals_def intro: fo_nmlz_eqI)
     have "ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (map \<sigma>' ns)} = fo_nmlz AD\<psi> ` proj_vals {\<sigma>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       apply (rule ext_tuple_correct[OF ns_sd(1) aux(2) ns_sd(3) aux4 R_def])
       using ad_agr_list_trans ad_agr_list_comm
       apply (auto simp: ad_agr_list_link)
       by fast
     then have "ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (map \<sigma>' ns)} - Y = fo_nmlz AD\<psi> ` proj_vals {\<sigma> \<in> -S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       apply (auto simp: Y_def proj_vals_def fo_nmlz_eq)
       using ad_agr_S\<psi> ad_agr_list_comm
       by blast+
     moreover have "ad_agr_close_set AD\<Delta>\<psi> (fo_nmlz AD\<psi> ` proj_vals {\<sigma> \<in> -S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>) =
       fo_nmlz AD ` proj_vals {\<sigma> \<in> -S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       unfolding ad_agr_close_set_eq[OF Ball_fo_nmlzd]
       apply (rule ad_agr_close_set_correct[OF AD_def(4) ns_sd(3), folded AD\<Delta>\<psi>_def])
       apply (auto simp: ad_agr_list_link)
       using ad_agr_S\<psi> ad_agr_list_comm ad_agr_list_subset[OF ns_sd(5)] ad_agr_list_trans
       by blast+
     ultimately have comp_proj: "ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (map \<sigma>' ns)} - Y) =
           fo_nmlz AD ` proj_vals {\<sigma> \<in> -S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>"
       by simp
     have "ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>) = fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} both"
       apply (rule ext_tuple_correct[OF ns_sd(3) ns_sd'(1) aux(3) aux6 refl])
       apply (auto simp: ad_agr_list_link)
       using ad_agr_S\<psi> ad_agr_list_comm ad_agr_list_subset[OF ns_sd(5)] ad_agr_list_trans ad_agr_list_mono[OF AD_def(4)]
       by fast+
     show "eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y)) =
       ext_tuple_set AD ns\<phi> ns\<phi>' {x} \<inter> ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>)"
       unfolding x_ns comp_proj
       using eval_conj_set_correct[OF aux5 x_proj_singleton refl aux(1) ns_sd(3)]
       by auto
   qed
 
   have "X = set_of_idx res"
     using AD_X_def
     unfolding eval_ajoin.simps ts_def(1,2) Let_def AD_def(5)[symmetric] fv_fo_fmla_list_set
       ns\<phi>'_def[symmetric] fv_sort[symmetric] proj_fmla_def S\<phi>_def[symmetric] S\<psi>_def[symmetric]
       AD\<Delta>\<phi>_def[symmetric] AD\<Delta>\<psi>_def[symmetric]
       ns\<phi>_def[symmetric] ns\<phi>'_def[symmetric, folded fv_fo_fmla_list_set[of \<phi>, folded ns\<phi>_def] ns\<psi>_def] ns\<psi>_def[symmetric] ns_def[symmetric]
       X\<phi>'_def[symmetric] idx\<phi>_def[symmetric] idx\<psi>_def[symmetric] res_eq[symmetric]
     by auto
   moreover have "\<dots> = (\<Union>x\<in>ad_agr_close_set AD\<Delta>\<phi> X\<phi>.
       case Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) of None \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' {x}
       | Some Y \<Rightarrow> eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y)))"
     unfolding res_def[unfolded idx\<phi>_def]
     apply (rule map_values_cluster)
      apply (auto simp: eval_conj_set_def split: option.splits)
      apply (auto simp: ext_tuple_set_def split: if_splits)
     done
   moreover have "\<dots> = fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat \<phi> I \<sigma> UNIV} -
      fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat \<psi> I \<sigma> UNIV}"
     unfolding S\<phi>_def[symmetric] S\<psi>_def[symmetric] proj_fmla_def fv_sort
   proof (rule set_eqI, rule iffI)
     fix t
     assume "t \<in> (\<Union>x\<in>ad_agr_close_set AD\<Delta>\<phi> X\<phi>. case Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) of
       None \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' {x}
     | Some Y \<Rightarrow> eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y)))"
     then obtain x where x: "x \<in> ad_agr_close_set AD\<Delta>\<phi> X\<phi>"
       "Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) = None \<Longrightarrow> t \<in> ext_tuple_set AD ns\<phi> ns\<phi>' {x}"
       "\<And>Y. Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) = Some Y \<Longrightarrow>
       t \<in> eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y))"
       by (fastforce split: option.splits)
     obtain \<sigma> where val: "\<sigma> \<in> S\<phi>" "x = fo_nmlz AD (map \<sigma> ns\<phi>)"
       using ad_agr_close_correct[OF AD_def(3) ad_agr_\<phi>(1), folded AD\<Delta>\<phi>_def] X\<phi>_def[folded proj_fmla_def] ad_agr_close_set_eq[OF fo_nmlzd_X(1)] x(1)
       apply (auto simp: proj_fmla_def proj_vals_def ns\<phi>_def)
       apply fast
       done
     obtain \<sigma>' where \<sigma>': "x = map \<sigma>' ns\<phi>"
       using exists_map[where ?ys=x and ?xs=ns\<phi>] aux(1)
       by (auto simp: val(2) fo_nmlz_length)
     have x_proj_singleton: "{x} = fo_nmlz AD ` proj_vals {\<sigma>} ns\<phi>"
       by (auto simp: val(2) proj_vals_def)
     have x_ns: "proj_tuple ns (zip ns\<phi> x) = map \<sigma>' ns"
       unfolding \<sigma>'
       by (rule proj_tuple_map[OF ns_sd(1-2,4)])
     have ad_agr_\<sigma>_\<sigma>': "ad_agr_list AD (map \<sigma> ns\<phi>) (map \<sigma>' ns\<phi>)"
       using \<sigma>'
       by (auto simp: val(2)) (metis fo_nmlz_ad_agr)
     have x_proj_ad_agr: "{x} = fo_nmlz AD ` proj_vals {\<sigma>. ad_agr_list AD (map \<sigma> ns\<phi>) (map \<sigma>' ns\<phi>)} ns\<phi>"
       using ad_agr_\<sigma>_\<sigma>' ad_agr_list_comm ad_agr_list_trans
       by (auto simp: val(2) proj_vals_def fo_nmlz_eq) blast
     have "t \<in> fo_nmlz AD ` \<Union> (ext_tuple AD ns\<phi> ns\<phi>' ` {x}) \<Longrightarrow> fo_nmlz AD (proj_tuple ns\<phi> (zip both t)) \<in> {x}"
       apply (rule ext_tuple_sound(1)[OF aux x_proj_ad_agr])
        apply (auto simp: ad_agr_list_link)
       using ad_agr_list_comm ad_agr_list_trans
       by blast+
     then have x_proj: "t \<in> ext_tuple_set AD ns\<phi> ns\<phi>' {x} \<Longrightarrow> x = fo_nmlz AD (proj_tuple ns\<phi> (zip both t))"
       using ext_tuple_set_eq[where ?AD=AD] Ball_ad_agr x(1)
       by (auto simp: val(2) proj_vals_def)
     have x_S\<phi>: "t \<in> ext_tuple_set AD ns\<phi> ns\<phi>' {x} \<Longrightarrow> t \<in> fo_nmlz AD ` proj_vals S\<phi> both"
       using ext_tuple_correct[OF aux refl ad_agr_\<phi>(2)[folded ns\<phi>_def]] ext_tuple_set_mono[of "{x}" "fo_nmlz AD ` proj_vals S\<phi> ns\<phi>"] val(1)
       by (fastforce simp: val(2) proj_vals_def)
     show "t \<in> fo_nmlz AD ` proj_vals S\<phi> both - fo_nmlz AD ` proj_vals S\<psi> both"
     proof (cases "Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x)))")
       case None
       have "False" if t_in_S\<psi>: "t \<in> fo_nmlz AD ` proj_vals S\<psi> both"
       proof -
         obtain \<tau> where \<tau>: "\<tau> \<in> S\<psi>" "t = fo_nmlz AD (map \<tau> both)"
           using t_in_S\<psi>
           by (auto simp: proj_vals_def)
         obtain \<tau>' where t_\<tau>': "t = map \<tau>' both"
           using aux(3) exists_map[where ?ys=t and ?xs=both]
           by (auto simp: \<tau>(2) fo_nmlz_length)
         obtain \<tau>'' where \<tau>'': "fo_nmlz AD\<psi> (map \<tau> ns\<psi>) = map \<tau>'' ns\<psi>"
           using ns_sd exists_map[where ?ys="fo_nmlz AD\<psi> (map \<tau> ns\<psi>)" and xs=ns\<psi>]
           by (auto simp: fo_nmlz_length)
         have proj_\<tau>'': "proj_tuple ns (zip ns\<psi> (map \<tau>'' ns\<psi>)) = map \<tau>'' ns"
           apply (rule proj_tuple_map)
           using ns_sd
           by auto
         have "proj_tuple ns\<phi> (zip both t) = map \<tau>' ns\<phi>"
           unfolding t_\<tau>'
           apply (rule proj_tuple_map)
           using aux
           by auto
         then have x_\<tau>': "x = fo_nmlz AD (map \<tau>' ns\<phi>)"
           by (auto simp: x_proj[OF x(2)[OF None]])
         obtain \<tau>''' where \<tau>''': "x = map \<tau>''' ns\<phi>"
           using aux exists_map[where ?ys=x and ?xs=ns\<phi>]
           by (auto simp: x_\<tau>' fo_nmlz_length)
         have ad_\<tau>_\<tau>': "ad_agr_list AD (map \<tau> both) (map \<tau>' both)"
           using t_\<tau>'
           by (auto simp: \<tau>) (metis fo_nmlz_ad_agr)
         have ad_\<tau>_\<tau>'': "ad_agr_list AD\<psi> (map \<tau> ns\<psi>) (map \<tau>'' ns\<psi>)"
           using \<tau>''
           by (metis fo_nmlz_ad_agr)
         have ad_\<tau>'_\<tau>''': "ad_agr_list AD (map \<tau>' ns\<phi>) (map \<tau>''' ns\<phi>)"
           using \<tau>'''
           by (auto simp: x_\<tau>') (metis fo_nmlz_ad_agr)
         have proj_\<tau>''': "proj_tuple ns (zip ns\<phi> (map \<tau>''' ns\<phi>)) = map \<tau>''' ns"
           apply (rule proj_tuple_map)
           using aux ns_sd
           by auto
         have "fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x)) = fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<psi> (fo_nmlz AD\<psi> (map \<tau> ns\<psi>))))"
           unfolding \<tau>'' proj_\<tau>'' \<tau>''' proj_\<tau>'''
           apply (rule fo_nmlz_eqI)
           using ad_agr_list_trans ad_agr_list_subset ns_sd(4-6) ad_agr_list_mono[OF AD_def(4)] ad_agr_list_comm[OF ad_\<tau>'_\<tau>'''] ad_agr_list_comm[OF ad_\<tau>_\<tau>'] ad_\<tau>_\<tau>''
           by metis
         then show ?thesis
           using None \<tau>(1)
           by (auto simp: idx\<psi>_def lookup_cluster' X\<psi>_def ns\<psi>_def[symmetric] proj_vals_def split: if_splits)
       qed
       then show ?thesis
         using x_S\<phi>[OF x(2)[OF None]]
         by auto
     next
       case (Some Y)
       have t_in: "t \<in> ext_tuple_set AD ns\<phi> ns\<phi>' {x}" "t \<in> ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>)"
         using x(3)[OF Some] eval_conj[OF x_ns x_proj_singleton Some]
         by auto
       have "ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>) = fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} both"
         apply (rule ext_tuple_correct[OF ns_sd(3) ns_sd'(1) aux(3) aux6 refl])
         apply (auto simp: ad_agr_list_link)
         using ad_agr_S\<psi> ad_agr_list_comm ad_agr_list_subset[OF ns_sd(5)] ad_agr_list_trans ad_agr_list_mono[OF AD_def(4)]
         by fast+
       then have t_both: "t \<in> fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} both"
         using t_in(2)
         by auto
       {
         assume "t \<in> fo_nmlz AD ` proj_vals S\<psi> both"
         then obtain \<tau> where \<tau>: "\<tau> \<in> S\<psi>" "t = fo_nmlz AD (map \<tau> both)"
           by (auto simp: proj_vals_def)
         obtain \<tau>' where \<tau>': "\<tau>' \<notin> S\<psi>" "t = fo_nmlz AD (map \<tau>' both)"
           using t_both
           by (auto simp: proj_vals_def)
         have "False"
           using \<tau> \<tau>'
           apply (auto simp: fo_nmlz_eq)
           using ad_agr_S\<psi> ad_agr_list_comm ad_agr_list_subset[OF ns_sd(8)] ad_agr_list_mono[OF AD_def(4)]
           by blast
       }
       then show ?thesis
         using x_S\<phi>[OF t_in(1)]
         by auto
     qed
   next
     fix t
     assume t_in_asm: "t \<in> fo_nmlz AD ` proj_vals S\<phi> both - fo_nmlz AD ` proj_vals S\<psi> both"
     then obtain \<sigma> where val: "\<sigma> \<in> S\<phi>" "t = fo_nmlz AD (map \<sigma> both)"
       by (auto simp: proj_vals_def)
     define x where "x = fo_nmlz AD (map \<sigma> ns\<phi>)"
     obtain \<sigma>' where \<sigma>': "x = map \<sigma>' ns\<phi>"
       using exists_map[where ?ys=x and ?xs=ns\<phi>] aux(1)
       by (auto simp: x_def fo_nmlz_length)
     have x_proj_singleton: "{x} = fo_nmlz AD ` proj_vals {\<sigma>} ns\<phi>"
       by (auto simp: x_def proj_vals_def)
     have x_in_ad_agr_close: "x \<in> ad_agr_close_set AD\<Delta>\<phi> X\<phi>"
       using ad_agr_close_correct[OF AD_def(3) ad_agr_\<phi>(1), folded AD\<Delta>\<phi>_def] val(1)
       unfolding ad_agr_close_set_eq[OF fo_nmlzd_X(1)] x_def
       unfolding X\<phi>_def[folded proj_fmla_def] proj_fmla_map
       by (fastforce simp: x_def ns\<phi>_def)
     have ad_agr_\<sigma>_\<sigma>': "ad_agr_list AD (map \<sigma> ns\<phi>) (map \<sigma>' ns\<phi>)"
       using \<sigma>'
       by (auto simp: x_def) (metis fo_nmlz_ad_agr)
     have x_proj_ad_agr: "{x} = fo_nmlz AD ` proj_vals {\<sigma>. ad_agr_list AD (map \<sigma> ns\<phi>) (map \<sigma>' ns\<phi>)} ns\<phi>"
       using ad_agr_\<sigma>_\<sigma>' ad_agr_list_comm ad_agr_list_trans
       by (auto simp: x_def proj_vals_def fo_nmlz_eq) blast+
     have x_ns: "proj_tuple ns (zip ns\<phi> x) = map \<sigma>' ns"
       unfolding \<sigma>'
       by (rule proj_tuple_map[OF ns_sd(1-2,4)])
     have "ext_tuple_set AD ns\<phi> ns\<phi>' {x} = fo_nmlz AD ` proj_vals {\<sigma>. ad_agr_list AD (map \<sigma> ns\<phi>) (map \<sigma>' ns\<phi>)} both"
       apply (rule ext_tuple_correct[OF aux x_proj_ad_agr])
       using ad_agr_list_comm ad_agr_list_trans
       by (auto simp: ad_agr_list_link) blast+
     then have t_in_ext_x: "t \<in> ext_tuple_set AD ns\<phi> ns\<phi>' {x}"
       using ad_agr_\<sigma>_\<sigma>'
       by (auto simp: val(2) proj_vals_def)
     {
       fix Y
       assume Some: "Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (map \<sigma>' ns)) = Some Y"
       have tmp: "proj_tuple ns (zip ns\<phi> x) = map \<sigma>' ns"
         unfolding \<sigma>'
         by (rule proj_tuple_map[OF ns_sd(1) aux(1) ns_sd(4)])
       have unfold: "ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>) =
         fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} both"
         apply (rule ext_tuple_correct[OF ns_sd(3) ns_sd'(1) aux(3) aux6 refl])
         apply (auto simp: ad_agr_list_link)
         using ad_agr_S\<psi> ad_agr_list_mono[OF AD_def(4)] ad_agr_list_comm ad_agr_list_trans ad_agr_list_subset[OF ns_sd(5)]
         by blast+
       have "\<sigma> \<notin> S\<psi>"
         using t_in_asm
         by (auto simp: val(2) proj_vals_def)
       moreover have "ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)"
         using ad_agr_\<sigma>_\<sigma>' ad_agr_list_mono[OF AD_def(4)] ad_agr_list_subset[OF ns_sd(4)]
         by blast
       ultimately have "t \<in> ext_tuple_set AD ns\<psi> ns\<psi>' (fo_nmlz AD ` proj_vals {\<sigma> \<in> - S\<psi>. ad_agr_list AD\<psi> (map \<sigma> ns) (map \<sigma>' ns)} ns\<psi>)"
         unfolding unfold val(2)
         by (auto simp: proj_vals_def)
       then have "t \<in> eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (map \<sigma>' ns)} - Y))"
         using eval_conj[OF tmp x_proj_singleton Some[folded x_ns]] t_in_ext_x
         by (auto simp: x_ns)
     }
     then show "t \<in> (\<Union>x\<in>ad_agr_close_set AD\<Delta>\<phi> X\<phi>. case Mapping.lookup idx\<psi> (fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))) of
       None \<Rightarrow> ext_tuple_set AD ns\<phi> ns\<phi>' {x}
     | Some Y \<Rightarrow> eval_conj_set AD ns\<phi> {x} ns\<psi> (ad_agr_close_set AD\<Delta>\<psi> (ext_tuple_set AD\<psi> ns ns\<phi>' {fo_nmlz AD\<psi> (proj_tuple ns (zip ns\<phi> x))} - Y)))"
       using t_in_ext_x
       by (intro UN_I[OF x_in_ad_agr_close]) (auto simp: x_ns split: option.splits)
   qed
   ultimately have X_def: "X = fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat \<phi> I \<sigma> UNIV} -
     fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat \<psi> I \<sigma> UNIV}"
     by simp
 
   have AD_Neg_sub: "act_edom (Neg \<psi>) I \<subseteq> AD"
     by (auto simp: AD_def(1))
   have "X = fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat \<phi> I \<sigma> UNIV} \<inter>
     fo_nmlz AD ` proj_fmla (Conj \<phi> (Neg \<psi>)) {\<sigma>. esat (Neg \<psi>) I \<sigma> UNIV}"
     unfolding X_def
     by (auto simp: proj_fmla_map dest!: fo_nmlz_eqD)
        (metis AD_def(4) ad_agr_list_subset esat_UNIV_ad_agr_list fv_fo_fmla_list_set fv_sub
         sup_ge1 ts_def(4))
   then have eval: "eval_ajoin (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> =
     eval_abs (Conj \<phi> (Neg \<psi>)) I"
     using proj_fmla_conj_sub[OF AD_Neg_sub, of \<phi>]
     unfolding AD_X_def AD_def(1)[symmetric] n_def eval_abs_def
     by (auto simp: proj_fmla_map)
   have wf_conj_neg: "wf_fo_intp (Conj \<phi> (Neg \<psi>)) I"
     using wf
     by (auto simp: ts_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_conj_neg]
     by (auto simp: eval)
 qed
 
 lemma eval_disj:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t\<phi>" "fo_wf \<psi> I t\<psi>"
   shows "fo_wf (Disj \<phi> \<psi>) I
     (eval_disj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>)"
 proof -
   obtain AD\<phi> n\<phi> X\<phi> AD\<psi> n\<psi> X\<psi> where ts_def:
     "t\<phi> = (AD\<phi>, n\<phi>, X\<phi>)" "t\<psi> = (AD\<psi>, n\<psi>, X\<psi>)"
     "AD\<phi> = act_edom \<phi> I" "AD\<psi> = act_edom \<psi> I"
     using assms
     by (cases t\<phi>, cases t\<psi>) auto
   have AD_sub: "act_edom \<phi> I \<subseteq> AD\<phi>" "act_edom \<psi> I \<subseteq> AD\<psi>"
     by (auto simp: ts_def(3,4))
 
   obtain AD n X where AD_X_def:
     "eval_disj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> = (AD, n, X)"
     by (cases "eval_disj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi>") auto
   have AD_def: "AD = act_edom (Disj \<phi> \<psi>) I" "act_edom (Disj \<phi> \<psi>) I \<subseteq> AD"
     "AD\<phi> \<subseteq> AD" "AD\<psi> \<subseteq> AD" "AD = AD\<phi> \<union> AD\<psi>"
     using AD_X_def
     by (auto simp: ts_def Let_def)
   have n_def: "n = nfv (Disj \<phi> \<psi>)"
     using AD_X_def
     by (auto simp: ts_def Let_def nfv_card fv_fo_fmla_list_set)
 
   define S\<phi> where "S\<phi> \<equiv> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
   define S\<psi> where "S\<psi> \<equiv> {\<sigma>. esat \<psi> I \<sigma> UNIV}"
   define ns\<phi>' where "ns\<phi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<phi>) (fv_fo_fmla_list \<psi>)"
   define ns\<psi>' where "ns\<psi>' = filter (\<lambda>n. n \<notin> fv_fo_fmla \<psi>) (fv_fo_fmla_list \<phi>)"
 
   note X\<phi>_def = fo_wf_X[OF wf(1)[unfolded ts_def(1)], unfolded proj_fmla_def, folded S\<phi>_def]
   note X\<psi>_def = fo_wf_X[OF wf(2)[unfolded ts_def(2)], unfolded proj_fmla_def, folded S\<psi>_def]
   have fv_sub: "fv_fo_fmla (Disj \<phi> \<psi>) = fv_fo_fmla \<phi> \<union> set (fv_fo_fmla_list \<psi>)"
     "fv_fo_fmla (Disj \<phi> \<psi>) = fv_fo_fmla \<psi> \<union> set (fv_fo_fmla_list \<phi>)"
     by (auto simp: fv_fo_fmla_list_set)
   note res_left_alt = ext_tuple_ad_agr_close[OF S\<phi>_def AD_sub(1) AD_def(3)
        X\<phi>_def(1)[folded S\<phi>_def] ns\<phi>'_def sorted_distinct_fv_list fv_sub(1)]
   note res_right_alt = ext_tuple_ad_agr_close[OF S\<psi>_def AD_sub(2) AD_def(4)
        X\<psi>_def(1)[folded S\<psi>_def] ns\<psi>'_def sorted_distinct_fv_list fv_sub(2)]
 
   have "X = fo_nmlz AD ` proj_fmla (Disj \<phi> \<psi>) {\<sigma>. esat \<phi> I \<sigma> UNIV} \<union>
      fo_nmlz AD ` proj_fmla (Disj \<phi> \<psi>) {\<sigma>. esat \<psi> I \<sigma> UNIV}"
     using AD_X_def
     apply (simp add: ts_def(1,2) Let_def AD_def(5)[symmetric])
     unfolding fv_fo_fmla_list_set proj_fmla_def ns\<phi>'_def[symmetric] ns\<psi>'_def[symmetric]
       S\<phi>_def[symmetric] S\<psi>_def[symmetric]
     using res_left_alt(1) res_right_alt(1)
     by auto
   then have eval: "eval_disj (fv_fo_fmla_list \<phi>) t\<phi> (fv_fo_fmla_list \<psi>) t\<psi> =
     eval_abs (Disj \<phi> \<psi>) I"
     unfolding AD_X_def AD_def(1)[symmetric] n_def eval_abs_def
     by (auto simp: proj_fmla_map)
   have wf_disj: "wf_fo_intp (Disj \<phi> \<psi>) I"
     using wf
     by (auto simp: ts_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_disj]
     by (auto simp: eval)
 qed
 
 lemma fv_ex_all:
   assumes "pos i (fv_fo_fmla_list \<phi>) = None"
   shows "fv_fo_fmla_list (Exists i \<phi>) = fv_fo_fmla_list \<phi>"
     "fv_fo_fmla_list (Forall i \<phi>) = fv_fo_fmla_list \<phi>"
   using pos_complete[of i "fv_fo_fmla_list \<phi>"] fv_fo_fmla_list_eq[of "Exists i \<phi>" \<phi>]
     fv_fo_fmla_list_eq[of "Forall i \<phi>" \<phi>] assms
   by (auto simp: fv_fo_fmla_list_set)
 
 lemma nfv_ex_all:
   assumes Some: "pos i (fv_fo_fmla_list \<phi>) = Some j"
   shows "nfv \<phi> = Suc (nfv (Exists i \<phi>))" "nfv \<phi> = Suc (nfv (Forall i \<phi>))"
 proof -
   have "i \<in> fv_fo_fmla \<phi>" "j < nfv \<phi>" "i \<in> set (fv_fo_fmla_list \<phi>)"
     using fv_fo_fmla_list_set pos_set[of i "fv_fo_fmla_list \<phi>"]
       pos_length[of i "fv_fo_fmla_list \<phi>"] Some
     by (fastforce simp: nfv_def)+
   then show "nfv \<phi> = Suc (nfv (Exists i \<phi>))" "nfv \<phi> = Suc (nfv (Forall i \<phi>))"
     using nfv_card[of \<phi>] nfv_card[of "Exists i \<phi>"] nfv_card[of "Forall i \<phi>"]
     by (auto simp: finite_fv_fo_fmla)
 qed
 
 lemma fv_fo_fmla_list_exists: "fv_fo_fmla_list (Exists n \<phi>) = filter ((\<noteq>) n) (fv_fo_fmla_list \<phi>)"
   by (auto simp: fv_fo_fmla_list_def)
      (metis (mono_tags, lifting) distinct_filter distinct_remdups_adj_sort
       distinct_remdups_id filter_set filter_sort remdups_adj_set sorted_list_of_set_sort_remdups
       sorted_remdups_adj sorted_sort sorted_sort_id)
 
 lemma eval_exists:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t"
   shows "fo_wf (Exists i \<phi>) I (eval_exists i (fv_fo_fmla_list \<phi>) t)"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)"
     "AD = act_edom \<phi> I" "AD = act_edom (Exists i \<phi>) I"
     using assms
     by (cases t) auto
   note X_def = fo_wf_X[OF wf[unfolded t_def], folded t_def(2)]
   have eval: "eval_exists i (fv_fo_fmla_list \<phi>) t = eval_abs (Exists i \<phi>) I"
   proof (cases "pos i (fv_fo_fmla_list \<phi>)")
     case None
     note fv_eq = fv_ex_all[OF None]
     have "X = fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat \<phi> I \<sigma> UNIV}"
       unfolding X_def
       by (auto simp: proj_fmla_def fv_eq)
     also have "\<dots> = fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat (Exists i \<phi>) I \<sigma> UNIV}"
       using esat_exists_not_fv[of i \<phi> UNIV I] pos_complete[OF None]
       by (simp add: fv_fo_fmla_list_set)
     finally show ?thesis
       by (auto simp: t_def None eval_abs_def fv_eq nfv_def)
   next
     case (Some j)
     have "fo_nmlz AD ` rem_nth j ` X =
       fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat (Exists i \<phi>) I \<sigma> UNIV}"
     proof (rule set_eqI, rule iffI)
       fix vs
       assume "vs \<in> fo_nmlz AD ` rem_nth j ` X"
       then obtain ws where ws_def: "ws \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
         "vs = fo_nmlz AD (rem_nth j ws)"
         unfolding X_def
         by auto
       then obtain \<sigma> where \<sigma>_def: "esat \<phi> I \<sigma> UNIV"
         "ws = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
         by (auto simp: proj_fmla_map)
       obtain \<tau> where \<tau>_def: "ws = map \<tau> (fv_fo_fmla_list \<phi>)"
         using fo_nmlz_map \<sigma>_def(2)
         by blast
       have esat_\<tau>: "esat (Exists i \<phi>) I \<tau> UNIV"
         using esat_UNIV_ad_agr_list[OF fo_nmlz_ad_agr[of AD "map \<sigma> (fv_fo_fmla_list \<phi>)",
               folded \<sigma>_def(2), unfolded \<tau>_def]] \<sigma>_def(1)
         by (auto simp: t_def intro!: exI[of _ "\<tau> i"])
       have rem_nth_ws: "rem_nth j ws = map \<tau> (fv_fo_fmla_list (Exists i \<phi>))"
         using rem_nth_sound[of "fv_fo_fmla_list \<phi>" i j \<tau>] sorted_distinct_fv_list Some
         unfolding fv_fo_fmla_list_exists \<tau>_def
         by auto
       have "vs \<in> fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat (Exists i \<phi>) I \<sigma> UNIV}"
         using ws_def(2) esat_\<tau>
         unfolding rem_nth_ws
         by (auto simp: proj_fmla_map)
       then show "vs \<in> fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat (Exists i \<phi>) I \<sigma> UNIV}"
         by auto
     next
       fix vs
       assume assm: "vs \<in> fo_nmlz AD ` proj_fmla (Exists i \<phi>) {\<sigma>. esat (Exists i \<phi>) I \<sigma> UNIV}"
       from assm obtain \<sigma> where \<sigma>_def: "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list (Exists i \<phi>)))"
         "esat (Exists i \<phi>) I \<sigma> UNIV"
         by (auto simp: proj_fmla_map)
       then obtain x where x_def: "esat \<phi> I (\<sigma>(i := x)) UNIV"
         by auto
       define ws where "ws \<equiv> fo_nmlz AD (map (\<sigma>(i := x)) (fv_fo_fmla_list \<phi>))"
       then have "length ws = nfv \<phi>"
         using nfv_def fo_nmlz_length by (metis length_map)
       then have ws_in: "ws \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
         using x_def ws_def
         by (auto simp: fo_nmlz_sound proj_fmla_map)
       obtain \<tau> where \<tau>_def: "ws = map \<tau> (fv_fo_fmla_list \<phi>)"
         using fo_nmlz_map ws_def
         by blast
       have rem_nth_ws: "rem_nth j ws = map \<tau> (fv_fo_fmla_list (Exists i \<phi>))"
         using rem_nth_sound[of "fv_fo_fmla_list \<phi>" i j] sorted_distinct_fv_list Some
         unfolding fv_fo_fmla_list_exists \<tau>_def
         by auto
       have "set (fv_fo_fmla_list (Exists i \<phi>)) \<subseteq> set (fv_fo_fmla_list \<phi>)"
         by (auto simp: fv_fo_fmla_list_exists)
       then have ad_agr: "ad_agr_list AD (map (\<sigma>(i := x)) (fv_fo_fmla_list (Exists i \<phi>)))
         (map \<tau> (fv_fo_fmla_list (Exists i \<phi>)))"
         by (rule ad_agr_list_subset)
           (rule fo_nmlz_ad_agr[of AD "map (\<sigma>(i := x)) (fv_fo_fmla_list \<phi>)", folded ws_def,
               unfolded \<tau>_def])
       have map_fv_cong: "map (\<sigma>(i := x)) (fv_fo_fmla_list (Exists i \<phi>)) =
         map \<sigma> (fv_fo_fmla_list (Exists i \<phi>))"
         by (auto simp: fv_fo_fmla_list_exists)
       have vs_rem_nth: "vs = fo_nmlz AD (rem_nth j ws)"
         unfolding \<sigma>_def(1) rem_nth_ws
         apply (rule fo_nmlz_eqI)
         using ad_agr[unfolded map_fv_cong] .
       show "vs \<in> fo_nmlz AD ` rem_nth j ` X"
         using Some ws_in
         unfolding vs_rem_nth X_def
         by auto
     qed
     then show ?thesis
       using nfv_ex_all[OF Some]
       by (auto simp: t_def Some eval_abs_def nfv_def)
   qed
   have wf_ex: "wf_fo_intp (Exists i \<phi>) I"
     using wf
     by (auto simp: t_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_ex]
     by (auto simp: eval)
 qed
 
 lemma fv_fo_fmla_list_forall: "fv_fo_fmla_list (Forall n \<phi>) = filter ((\<noteq>) n) (fv_fo_fmla_list \<phi>)"
   by (auto simp: fv_fo_fmla_list_def)
      (metis (mono_tags, lifting) distinct_filter distinct_remdups_adj_sort
       distinct_remdups_id filter_set filter_sort remdups_adj_set sorted_list_of_set_sort_remdups
       sorted_remdups_adj sorted_sort sorted_sort_id)
 
 lemma pairwise_take_drop:
   assumes "pairwise P (set (zip xs ys))" "length xs = length ys"
   shows "pairwise P (set (zip (take i xs @ drop (Suc i) xs) (take i ys @ drop (Suc i) ys)))"
   by (rule pairwise_subset[OF assms(1)]) (auto simp: set_zip assms(2))
 
 lemma fo_nmlz_set_card:
   "fo_nmlz AD xs = xs \<Longrightarrow> set xs = set xs \<inter> Inl ` AD \<union> Inr ` {..<card (Inr -` set xs)}"
   by (metis fo_nmlz_sound fo_nmlzd_set card_Inr_vimage_le_length min.absorb2)
 
 lemma ad_agr_list_take_drop: "ad_agr_list AD xs ys \<Longrightarrow>
   ad_agr_list AD (take i xs @ drop (Suc i) xs) (take i ys @ drop (Suc i) ys)"
   apply (auto simp: ad_agr_list_def ad_equiv_list_def sp_equiv_list_def)
     apply (metis take_zip in_set_takeD)
    apply (metis drop_zip in_set_dropD)
   using pairwise_take_drop
   by fastforce
 
 lemma fo_nmlz_rem_nth_add_nth:
   assumes "fo_nmlz AD zs = zs" "i \<le> length zs"
   shows "fo_nmlz AD (rem_nth i (fo_nmlz AD (add_nth i z zs))) = zs"
 proof -
   have ad_agr: "ad_agr_list AD (add_nth i z zs) (fo_nmlz AD (add_nth i z zs))"
     using fo_nmlz_ad_agr
     by auto
   have i_lt_add: "i < length (add_nth i z zs)" "i < length (fo_nmlz AD (add_nth i z zs))"
     using add_nth_length assms(2)
     by (fastforce simp: fo_nmlz_length)+
   show ?thesis
     using ad_agr_list_take_drop[OF ad_agr, of i, folded rem_nth_take_drop[OF i_lt_add(1)]
         rem_nth_take_drop[OF i_lt_add(2)], unfolded rem_nth_add_nth[OF assms(2)]]
     apply (subst eq_commute)
     apply (subst assms(1)[symmetric])
     apply (auto intro: fo_nmlz_eqI)
     done
 qed
 
 lemma ad_agr_list_add:
   assumes "ad_agr_list AD xs ys" "i \<le> length xs"
   shows "\<exists>z' \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set ys))} \<union> set ys.
     ad_agr_list AD (take i xs @ z # drop i xs) (take i ys @ z' # drop i ys)"
 proof -
   define n where "n = length xs"
   have len_ys: "n = length ys"
     using assms(1)
     by (auto simp: ad_agr_list_def n_def)
   obtain \<sigma> where \<sigma>_def: "xs = map \<sigma> [0..<n]"
     unfolding n_def
     by (metis map_nth)
   obtain \<tau> where \<tau>_def: "ys = map \<tau> [0..<n]"
     unfolding len_ys
     by (metis map_nth)
   have i_le_n: "i \<le> n"
     using assms(2)
     by (auto simp: n_def)
   have set_n: "set [0..<n] = {..n} - {n}" "set ([0..<i] @ n # [i..<n]) = {..n}"
     using i_le_n
     by auto
   have ad_agr: "ad_agr_sets ({..n} - {n}) ({..n} - {n}) AD \<sigma> \<tau>"
     using iffD2[OF ad_agr_list_link, OF assms(1)[unfolded \<sigma>_def \<tau>_def]]
     unfolding set_n .
   have set_ys: "\<tau> ` ({..n} - {n}) = set ys"
     by (auto simp: \<tau>_def)
   obtain z' where z'_def: "z' \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set ys))} \<union> set ys"
     "ad_agr_sets {..n} {..n} AD (\<sigma>(n := z)) (\<tau>(n := z'))"
     using extend_\<tau>[OF ad_agr subset_refl,
         of "Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set ys))} \<union> set ys" z]
     by (auto simp: set_ys)
   have map_take: "map (\<sigma>(n := z)) ([0..<i] @ n # [i..<n]) = take i xs @ z # drop i xs"
     "map (\<tau>(n := z')) ([0..<i] @ n # [i..<n]) = take i ys @ z' # drop i ys"
     using i_le_n
     by (auto simp: \<sigma>_def \<tau>_def take_map drop_map)
   show ?thesis
     using iffD1[OF ad_agr_list_link, OF z'_def(2)[unfolded set_n[symmetric]]] z'_def(1)
     unfolding map_take
     by auto
 qed
 
 lemma add_nth_restrict:
   assumes "fo_nmlz AD zs = zs" "i \<le> length zs"
   shows "\<exists>z' \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}.
     fo_nmlz AD (add_nth i z zs) = fo_nmlz AD (add_nth i z' zs)"
 proof -
   have "set zs \<subseteq> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}"
     using fo_nmlz_set_card[OF assms(1)]
     by auto
   then obtain z' where z'_def:
     "z' \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}"
     "ad_agr_list AD (take i zs @ z # drop i zs) (take i zs @ z' # drop i zs)"
     using ad_agr_list_add[OF ad_agr_list_refl assms(2), of AD z]
     by auto blast
   then show ?thesis
     unfolding add_nth_take_drop[OF assms(2)]
     by (auto intro: fo_nmlz_eqI)
 qed
 
 lemma fo_nmlz_add_rem:
   assumes "i \<le> length zs"
   shows "\<exists>z'. fo_nmlz AD (add_nth i z zs) = fo_nmlz AD (add_nth i z' (fo_nmlz AD zs))"
 proof -
   have ad_agr: "ad_agr_list AD zs (fo_nmlz AD zs)"
     using fo_nmlz_ad_agr
     by auto
   have i_le_fo_nmlz: "i \<le> length (fo_nmlz AD zs)"
     using assms(1)
     by (auto simp: fo_nmlz_length)
   obtain x where x_def: "ad_agr_list AD (add_nth i z zs) (add_nth i x (fo_nmlz AD zs))"
     using ad_agr_list_add[OF ad_agr assms(1)]
     by (auto simp: add_nth_take_drop[OF assms(1)] add_nth_take_drop[OF i_le_fo_nmlz])
   then show ?thesis
     using fo_nmlz_eqI
     by auto
 qed
 
 lemma fo_nmlz_add_rem':
   assumes "i \<le> length zs"
   shows "\<exists>z'. fo_nmlz AD (add_nth i z (fo_nmlz AD zs)) = fo_nmlz AD (add_nth i z' zs)"
 proof -
   have ad_agr: "ad_agr_list AD (fo_nmlz AD zs) zs"
     using ad_agr_list_comm[OF fo_nmlz_ad_agr]
     by auto
   have i_le_fo_nmlz: "i \<le> length (fo_nmlz AD zs)"
     using assms(1)
     by (auto simp: fo_nmlz_length)
   obtain x where x_def: "ad_agr_list AD (add_nth i z (fo_nmlz AD zs)) (add_nth i x zs)"
     using ad_agr_list_add[OF ad_agr i_le_fo_nmlz]
     by (auto simp: add_nth_take_drop[OF assms(1)] add_nth_take_drop[OF i_le_fo_nmlz])
   then show ?thesis
     using fo_nmlz_eqI
     by auto
 qed
 
 lemma fo_nmlz_add_nth_rem_nth:
   assumes "fo_nmlz AD xs = xs" "i < length xs"
   shows "\<exists>z. fo_nmlz AD (add_nth i z (fo_nmlz AD (rem_nth i xs))) = xs"
   using rem_nth_length[OF assms(2)] fo_nmlz_add_rem[of i "rem_nth i xs" AD "xs ! i",
       unfolded assms(1) add_nth_rem_nth_self[OF assms(2)]] assms(2)
   by (subst eq_commute) auto
 
 lemma sp_equiv_list_almost_same: "sp_equiv_list (xs @ v # ys) (xs @ w # ys) \<Longrightarrow>
   v \<in> set xs \<union> set ys \<or> w \<in> set xs \<union> set ys \<Longrightarrow> v = w"
   by (auto simp: sp_equiv_list_def pairwise_def) (metis UnCI sp_equiv_pair.simps zip_same)+
 
 lemma ad_agr_list_add_nth:
   assumes "i \<le> length zs" "ad_agr_list AD (add_nth i v zs) (add_nth i w zs)" "v \<noteq> w"
   shows "{v, w} \<inter> (Inl ` AD \<union> set zs) = {}"
   using assms(2)[unfolded add_nth_take_drop[OF assms(1)]] assms(1,3) sp_equiv_list_almost_same
   by (auto simp: ad_agr_list_def ad_equiv_list_def ad_equiv_pair.simps)
      (smt append_take_drop_id set_append sp_equiv_list_almost_same)+
 
 lemma Inr_in_tuple:
   assumes "fo_nmlz AD zs = zs" "n < card (Inr -` set zs)"
   shows "Inr n \<in> set zs"
   using assms fo_nmlz_set_card[OF assms(1)]
   by (auto simp: fo_nmlzd_code[symmetric])
 
 lemma card_wit_sub:
   assumes "finite Z" "card Z \<le> card {ts \<in> X. \<exists>z \<in> Z. ts = f z}"
   shows "f ` Z \<subseteq> X"
 proof -
   have set_unfold: "{ts \<in> X. \<exists>z \<in> Z. ts = f z} = f ` Z \<inter> X"
     by auto
   show ?thesis
     using assms
     unfolding set_unfold
     by (metis Int_lower1 card_image_le card_seteq finite_imageI inf.absorb_iff1 le_antisym
         surj_card_le)
 qed
 
 lemma add_nth_iff_card:
   assumes "(\<And>xs. xs \<in> X \<Longrightarrow> fo_nmlz AD xs = xs)" "(\<And>xs. xs \<in> X \<Longrightarrow> i < length xs)"
     "fo_nmlz AD zs = zs" "i \<le> length zs" "finite AD" "finite X"
   shows "(\<forall>z. fo_nmlz AD (add_nth i z zs) \<in> X) \<longleftrightarrow>
     Suc (card AD + card (Inr -` set zs)) \<le> card {ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth i z zs)}"
 proof -
   have inj: "inj_on (\<lambda>z. fo_nmlz AD (add_nth i z zs))
     (Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))})"
     using ad_agr_list_add_nth[OF assms(4)] Inr_in_tuple[OF assms(3)] less_Suc_eq
     by (fastforce simp: inj_on_def dest!: fo_nmlz_eqD)
   have card_Un: "card (Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}) =
       Suc (card AD + card (Inr -` set zs))"
     using card_Un_disjoint[of "Inl ` AD" "Inr ` {..<Suc (card (Inr -` set zs))}"] assms(5)
     by (auto simp add: card_image disjoint_iff_not_equal)
   have restrict_z: "(\<forall>z. fo_nmlz AD (add_nth i z zs) \<in> X) \<longleftrightarrow>
     (\<forall>z \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}. fo_nmlz AD (add_nth i z zs) \<in> X)"
     using add_nth_restrict[OF assms(3,4)]
     by metis
   have restrict_z': "{ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth i z zs)} =
     {ts \<in> X. \<exists>z \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}.
       ts = fo_nmlz AD (add_nth i z zs)}"
     using add_nth_restrict[OF assms(3,4)]
     by auto
   {
     assume "\<And>z. fo_nmlz AD (add_nth i z zs) \<in> X"
     then have image_sub: "(\<lambda>z. fo_nmlz AD (add_nth i z zs)) `
       (Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}) \<subseteq>
       {ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth i z zs)}"
       by auto
     have "Suc (card AD + card (Inr -` set zs)) \<le>
       card {ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth i z zs)}"
       unfolding card_Un[symmetric]
       using card_inj_on_le[OF inj image_sub] assms(6)
       by auto
     then have "Suc (card AD + card (Inr -` set zs)) \<le>
       card {ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth i z zs)}"
       by (auto simp: card_image)
   }
   moreover
   {
     assume assm: "card (Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}) \<le>
       card {ts \<in> X. \<exists>z \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}.
         ts = fo_nmlz AD (add_nth i z zs)}"
     have "\<forall>z \<in> Inl ` AD \<union> Inr ` {..<Suc (card (Inr -` set zs))}. fo_nmlz AD (add_nth i z zs) \<in> X"
       using card_wit_sub[OF _ assm] assms(5)
       by auto
   }
   ultimately show ?thesis
     unfolding restrict_z[symmetric] restrict_z'[symmetric] card_Un
     by auto
 qed
 
 lemma set_fo_nmlz_add_nth_rem_nth:
   assumes "j < length xs" "\<And>x. x \<in> X \<Longrightarrow> fo_nmlz AD x = x"
     "\<And>x. x \<in> X \<Longrightarrow> j < length x"
   shows "{ts \<in> X. \<exists>z. ts = fo_nmlz AD (add_nth j z (fo_nmlz AD (rem_nth j xs)))} =
   {y \<in> X. fo_nmlz AD (rem_nth j y) = fo_nmlz AD (rem_nth j xs)}"
   using fo_nmlz_rem_nth_add_nth[where ?zs="fo_nmlz AD (rem_nth j xs)"] rem_nth_length[OF assms(1)] fo_nmlz_add_nth_rem_nth assms
   by (fastforce simp: fo_nmlz_idem[OF fo_nmlz_sound] fo_nmlz_length)
 
 lemma eval_forall:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   assumes wf: "fo_wf \<phi> I t"
   shows "fo_wf (Forall i \<phi>) I (eval_forall i (fv_fo_fmla_list \<phi>) t)"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)" "AD = act_edom \<phi> I"
     "AD = act_edom (Forall i \<phi>) I"
     using assms
     by (cases t) auto
   have AD_sub: "act_edom \<phi> I \<subseteq> AD"
     by (auto simp: t_def(2))
   have fin_AD: "finite AD"
     using finite_act_edom wf
     by (auto simp: t_def)
   have fin_X: "finite X"
     using wf
     by (auto simp: t_def)
   note X_def = fo_wf_X[OF wf[unfolded t_def], folded t_def(2)]
   have eval: "eval_forall i (fv_fo_fmla_list \<phi>) t = eval_abs (Forall i \<phi>) I"
   proof (cases "pos i (fv_fo_fmla_list \<phi>)")
     case None
     note fv_eq = fv_ex_all[OF None]
     have "X = fo_nmlz AD ` proj_fmla (Forall i \<phi>) {\<sigma>. esat \<phi> I \<sigma> UNIV}"
       unfolding X_def
       by (auto simp: proj_fmla_def fv_eq)
     also have "\<dots> = fo_nmlz AD ` proj_fmla (Forall i \<phi>) {\<sigma>. esat (Forall i \<phi>) I \<sigma> UNIV}"
       using esat_forall_not_fv[of i \<phi> UNIV I] pos_complete[OF None]
       by (auto simp: fv_fo_fmla_list_set)
     finally show ?thesis
       by (auto simp: t_def None eval_abs_def fv_eq nfv_def)
   next
     case (Some j)
     have i_in_fv: "i \<in> fv_fo_fmla \<phi>"
       by (rule pos_set[OF Some, unfolded fv_fo_fmla_list_set])
     have fo_nmlz_X: "\<And>xs. xs \<in> X \<Longrightarrow> fo_nmlz AD xs = xs"
       by (auto simp: X_def proj_fmla_map fo_nmlz_idem[OF fo_nmlz_sound])
     have j_lt_len: "\<And>xs. xs \<in> X \<Longrightarrow> j < length xs"
       using pos_sound[OF Some]
       by (auto simp: X_def proj_fmla_map fo_nmlz_length)
     have rem_nth_j_le_len: "\<And>xs. xs \<in> X \<Longrightarrow> j \<le> length (fo_nmlz AD (rem_nth j xs))"
       using rem_nth_length j_lt_len
       by (fastforce simp: fo_nmlz_length)
     have img_proj_fmla: "Mapping.keys (Mapping.filter (\<lambda>t Z. Suc (card AD + card (Inr -` set t)) \<le> card Z)
       (cluster (Some \<circ> (\<lambda>ts. fo_nmlz AD (rem_nth j ts))) X)) =
       fo_nmlz AD ` proj_fmla (Forall i \<phi>) {\<sigma>. esat (Forall i \<phi>) I \<sigma> UNIV}"
     proof (rule set_eqI, rule iffI)
       fix vs
       assume "vs \<in> Mapping.keys (Mapping.filter (\<lambda>t Z. Suc (card AD + card (Inr -` set t)) \<le> card Z)
         (cluster (Some \<circ> (\<lambda>ts. fo_nmlz AD (rem_nth j ts))) X))"
       then obtain ws where ws_def: "ws \<in> X" "vs = fo_nmlz AD (rem_nth j ws)"
         "\<And>a. fo_nmlz AD (add_nth j a (fo_nmlz AD (rem_nth j ws))) \<in> X"
         using add_nth_iff_card[OF fo_nmlz_X j_lt_len fo_nmlz_idem[OF fo_nmlz_sound]
             rem_nth_j_le_len fin_AD fin_X] set_fo_nmlz_add_nth_rem_nth[OF j_lt_len fo_nmlz_X j_lt_len]
         by transfer (fastforce split: option.splits if_splits)
       then obtain \<sigma> where \<sigma>_def:
         "esat \<phi> I \<sigma> UNIV" "ws = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
         unfolding X_def
         by (auto simp: proj_fmla_map)
       obtain \<tau> where \<tau>_def: "ws = map \<tau> (fv_fo_fmla_list \<phi>)"
         using fo_nmlz_map \<sigma>_def(2)
         by blast
       have fo_nmlzd_\<tau>: "fo_nmlzd AD (map \<tau> (fv_fo_fmla_list \<phi>))"
         unfolding \<tau>_def[symmetric] \<sigma>_def(2)
         by (rule fo_nmlz_sound)
       have rem_nth_j_ws: "rem_nth j ws = map \<tau> (filter ((\<noteq>) i) (fv_fo_fmla_list \<phi>))"
         using rem_nth_sound[OF _ Some] sorted_distinct_fv_list
         by (auto simp: \<tau>_def)
       have esat_\<tau>: "esat (Forall i \<phi>) I \<tau> UNIV"
         unfolding esat.simps
       proof (rule ballI)
         fix x
         have "fo_nmlz AD (add_nth j x (rem_nth j ws)) \<in> X"
           using fo_nmlz_add_rem[of j "rem_nth j ws" AD x] rem_nth_length
             j_lt_len[OF ws_def(1)] ws_def(3)
           by fastforce
         then have "fo_nmlz AD (map (\<tau>(i := x)) (fv_fo_fmla_list \<phi>)) \<in> X"
           using add_nth_rem_nth_map[OF _ Some, of x] sorted_distinct_fv_list
           unfolding \<tau>_def
           by fastforce
         then show "esat \<phi> I (\<tau>(i := x)) UNIV"
           by (auto simp: X_def proj_fmla_map esat_UNIV_ad_agr_list[OF _ AD_sub]
               dest!: fo_nmlz_eqD)
       qed
       have rem_nth_ws: "rem_nth j ws = map \<tau> (fv_fo_fmla_list (Forall i \<phi>))"
         using rem_nth_sound[OF _ Some] sorted_distinct_fv_list
         by (auto simp: fv_fo_fmla_list_forall \<tau>_def)
       then show "vs \<in> fo_nmlz AD ` proj_fmla (Forall i \<phi>) {\<sigma>. esat (Forall i \<phi>) I \<sigma> UNIV}"
         using ws_def(2) esat_\<tau>
         by (auto simp: proj_fmla_map rem_nth_ws)
     next
       fix vs
       assume assm: "vs \<in> fo_nmlz AD ` proj_fmla (Forall i \<phi>) {\<sigma>. esat (Forall i \<phi>) I \<sigma> UNIV}"
       from assm obtain \<sigma> where \<sigma>_def: "vs = fo_nmlz AD (map \<sigma> (fv_fo_fmla_list (Forall i \<phi>)))"
         "esat (Forall i \<phi>) I \<sigma> UNIV"
         by (auto simp: proj_fmla_map)
       then have all_esat: "\<And>x. esat \<phi> I (\<sigma>(i := x)) UNIV"
         by auto
       define ws where "ws \<equiv> fo_nmlz AD (map \<sigma> (fv_fo_fmla_list \<phi>))"
       then have "length ws = nfv \<phi>"
         using nfv_def fo_nmlz_length by (metis length_map)
       then have ws_in: "ws \<in> fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
         using all_esat[of "\<sigma> i"] ws_def
         by (auto simp: fo_nmlz_sound proj_fmla_map)
       then have ws_in_X: "ws \<in> X"
         by (auto simp: X_def)
       obtain \<tau> where \<tau>_def: "ws = map \<tau> (fv_fo_fmla_list \<phi>)"
         using fo_nmlz_map ws_def
         by blast
       have rem_nth_ws: "rem_nth j ws = map \<tau> (fv_fo_fmla_list (Forall i \<phi>))"
         using rem_nth_sound[of "fv_fo_fmla_list \<phi>" i j] sorted_distinct_fv_list Some
         unfolding fv_fo_fmla_list_forall \<tau>_def
         by auto
       have "set (fv_fo_fmla_list (Forall i \<phi>)) \<subseteq> set (fv_fo_fmla_list \<phi>)"
         by (auto simp: fv_fo_fmla_list_forall)
       then have ad_agr: "ad_agr_list AD (map \<sigma> (fv_fo_fmla_list (Forall i \<phi>)))
         (map \<tau> (fv_fo_fmla_list (Forall i \<phi>)))"
         apply (rule ad_agr_list_subset)
         using fo_nmlz_ad_agr[of AD] ws_def \<tau>_def
         by metis
       have map_fv_cong: "\<And>x. map (\<sigma>(i := x)) (fv_fo_fmla_list (Forall i \<phi>)) =
         map \<sigma> (fv_fo_fmla_list (Forall i \<phi>))"
         by (auto simp: fv_fo_fmla_list_forall)
       have vs_rem_nth: "vs = fo_nmlz AD (rem_nth j ws)"
         unfolding \<sigma>_def(1) rem_nth_ws
         apply (rule fo_nmlz_eqI)
         using ad_agr[unfolded map_fv_cong] .
       have "\<And>a. fo_nmlz AD (add_nth j a (fo_nmlz AD (rem_nth j ws))) \<in>
         fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
       proof -
         fix a
         obtain x where add_rem: "fo_nmlz AD (add_nth j a (fo_nmlz AD (rem_nth j ws))) =
           fo_nmlz AD (map (\<tau>(i := x)) (fv_fo_fmla_list \<phi>))"
           using add_nth_rem_nth_map[OF _ Some, of _ \<tau>] sorted_distinct_fv_list
             fo_nmlz_add_rem'[of j "rem_nth j ws"] rem_nth_length[of j ws]
             j_lt_len[OF ws_in_X]
           by (fastforce simp: \<tau>_def)
         have "esat (Forall i \<phi>) I \<tau> UNIV"
           apply (rule iffD1[OF esat_UNIV_ad_agr_list \<sigma>_def(2), OF _ subset_refl, folded t_def])
           using fo_nmlz_ad_agr[of AD "map \<sigma> (fv_fo_fmla_list \<phi>)", folded ws_def, unfolded \<tau>_def]
           unfolding ad_agr_list_link[symmetric]
           by (auto simp: fv_fo_fmla_list_set ad_agr_sets_def sp_equiv_def pairwise_def)
         then have "esat \<phi> I (\<tau>(i := x)) UNIV"
           by auto
         then show "fo_nmlz AD (add_nth j a (fo_nmlz AD (rem_nth j ws))) \<in>
           fo_nmlz AD ` proj_fmla \<phi> {\<sigma>. esat \<phi> I \<sigma> UNIV}"
           by (auto simp: add_rem proj_fmla_map)
       qed
       then show "vs \<in> Mapping.keys (Mapping.filter (\<lambda>t Z. Suc (card AD + card (Inr -` set t)) \<le> card Z)
         (cluster (Some \<circ> (\<lambda>ts. fo_nmlz AD (rem_nth j ts))) X))"
         unfolding vs_rem_nth X_def[symmetric]
         using add_nth_iff_card[OF fo_nmlz_X j_lt_len fo_nmlz_idem[OF fo_nmlz_sound]
             rem_nth_j_le_len fin_AD fin_X] set_fo_nmlz_add_nth_rem_nth[OF j_lt_len fo_nmlz_X j_lt_len] ws_in_X
         by transfer (fastforce split: option.splits if_splits)
     qed
     show ?thesis
       using nfv_ex_all[OF Some]
       by (simp add: t_def Some eval_abs_def nfv_def img_proj_fmla[unfolded t_def(2)]
           split: option.splits)
   qed
   have wf_all: "wf_fo_intp (Forall i \<phi>) I"
     using wf
     by (auto simp: t_def)
   show ?thesis
     using fo_wf_eval_abs[OF wf_all]
     by (auto simp: eval)
 qed
 
 fun fo_res :: "('a, nat) fo_t \<Rightarrow> 'a eval_res" where
   "fo_res (AD, n, X) = (if fo_fin (AD, n, X) then Fin (map projl ` X) else Infin)"
 
 lemma fo_res_fin:
   fixes t :: "('a :: infinite, nat) fo_t"
   assumes "fo_wf \<phi> I t" "finite (fo_rep t)"
   shows "fo_res t = Fin (fo_rep t)"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)"
     using assms(1)
     by (cases t) auto
   show ?thesis
     using fo_fin assms
     by (fastforce simp only: t_def fo_res.simps fo_rep_fin split: if_splits)
 qed
 
 lemma fo_res_infin:
   fixes t :: "('a :: infinite, nat) fo_t"
   assumes "fo_wf \<phi> I t" "\<not>finite (fo_rep t)"
   shows "fo_res t = Infin"
 proof -
   obtain AD n X where t_def: "t = (AD, n, X)"
     using assms(1)
     by (cases t) auto
   show ?thesis
     using fo_fin assms
     by (fastforce simp only: t_def fo_res.simps split: if_splits)
 qed
 
 lemma fo_rep: "fo_wf \<phi> I t \<Longrightarrow> fo_rep t = proj_sat \<phi> I"
   by (cases t) auto
 
 global_interpretation Ailamazyan: eval_fo fo_wf eval_pred fo_rep fo_res
   eval_bool eval_eq eval_neg eval_conj eval_ajoin eval_disj
   eval_exists eval_forall
   defines eval_fmla = Ailamazyan.eval_fmla
       and eval = Ailamazyan.eval
   apply standard
              apply (rule fo_rep, assumption+)
             apply (rule fo_res_fin, assumption+)
            apply (rule fo_res_infin, assumption+)
           apply (rule eval_pred, assumption+)
          apply (rule eval_bool)
         apply (rule eval_eq)
        apply (rule eval_neg, assumption+)
       apply (rule eval_conj, assumption+)
      apply (rule eval_ajoin, assumption+)
     apply (rule eval_disj, assumption+)
    apply (rule eval_exists, assumption+)
   apply (rule eval_forall, assumption+)
   done
 
 definition esat_UNIV :: "('a :: infinite, 'b) fo_fmla \<Rightarrow> ('a table, 'b) fo_intp \<Rightarrow> ('a + nat) val \<Rightarrow> bool" where
   "esat_UNIV \<phi> I \<sigma> = esat \<phi> I \<sigma> UNIV"
 
 lemma esat_UNIV_code[code]: "esat_UNIV \<phi> I \<sigma> \<longleftrightarrow> (if wf_fo_intp \<phi> I then
   (case eval_fmla \<phi> I of (AD, n, X) \<Rightarrow>
     fo_nmlz (act_edom \<phi> I) (map \<sigma> (fv_fo_fmla_list \<phi>)) \<in> X)
   else esat_UNIV \<phi> I \<sigma>)"
 proof -
   obtain AD n T where t_def: "Ailamazyan.eval_fmla \<phi> I = (AD, n, T)"
     by (cases "Ailamazyan.eval_fmla \<phi> I") auto
   {
     assume wf_fo_intp: "wf_fo_intp \<phi> I"
     note fo_wf = Ailamazyan.eval_fmla_correct[OF wf_fo_intp, unfolded t_def]
     note T_def = fo_wf_X[OF fo_wf]
     have AD_def: "AD = act_edom \<phi> I"
       using fo_wf
       by auto
     have "esat_UNIV \<phi> I \<sigma> \<longleftrightarrow>
       fo_nmlz (act_edom \<phi> I) (map \<sigma> (fv_fo_fmla_list \<phi>)) \<in> T"
       using esat_UNIV_ad_agr_list[OF _ subset_refl]
       by (force simp add: esat_UNIV_def T_def AD_def proj_fmla_map
           dest!: fo_nmlz_eqD)
   }
   then show ?thesis
     by (auto simp: t_def)
 qed
 
 lemma sat_code[code]:
   fixes \<phi> :: "('a :: infinite, 'b) fo_fmla"
   shows "sat \<phi> I \<sigma> \<longleftrightarrow> (if wf_fo_intp \<phi> I then
   (case eval_fmla \<phi> I of (AD, n, X) \<Rightarrow>
     fo_nmlz (act_edom \<phi> I) (map (Inl \<circ> \<sigma>) (fv_fo_fmla_list \<phi>)) \<in> X)
   else sat \<phi> I \<sigma>)"
   using esat_UNIV_code sat_esat_conv[folded esat_UNIV_def]
   by metis
 
 end
diff --git a/thys/HRB-Slicing/JinjaVM_Inter/JVMCFG.thy b/thys/HRB-Slicing/JinjaVM_Inter/JVMCFG.thy
--- a/thys/HRB-Slicing/JinjaVM_Inter/JVMCFG.thy
+++ b/thys/HRB-Slicing/JinjaVM_Inter/JVMCFG.thy
@@ -1,825 +1,825 @@
 chapter \<open>A Control Flow Graph for Jinja Byte Code\<close>
 
 section \<open>Formalizing the CFG\<close>
 
 theory JVMCFG imports "../StaticInter/BasicDefs" Jinja.BVExample begin
 
 declare lesub_list_impl_same_size [simp del]
 declare nlistsE_length [simp del]
 
 subsection \<open>Type definitions\<close>
 
 subsubsection \<open>Wellformed Programs\<close>
 
 definition "wf_jvmprog = {(P, Phi). wf_jvm_prog\<^bsub>Phi\<^esub> P}"
 
 typedef wf_jvmprog = "wf_jvmprog"
 proof
   show "(E, Phi) \<in> wf_jvmprog"
     unfolding wf_jvmprog_def by (auto intro: wf_prog)
 qed
 
 hide_const Phi E
 
 abbreviation PROG :: "wf_jvmprog \<Rightarrow> jvm_prog"
   where "PROG P \<equiv> fst(Rep_wf_jvmprog(P))"
 
 abbreviation TYPING :: "wf_jvmprog \<Rightarrow> ty\<^sub>P"
   where "TYPING P \<equiv> snd(Rep_wf_jvmprog(P))"
 
 lemma wf_jvmprog_is_wf_typ: "wf_jvm_prog\<^bsub>TYPING P\<^esub> (PROG P)"
 using Rep_wf_jvmprog [of P]
   by (auto simp: wf_jvmprog_def split_beta)
 
 lemma wf_jvmprog_is_wf: "wf_jvm_prog (PROG P)"
   using wf_jvmprog_is_wf_typ unfolding wf_jvm_prog_def
   by blast
 
 subsubsection \<open>Interprocedural CFG\<close>
 
 type_synonym jvm_method = "wf_jvmprog \<times> cname \<times> mname"
 datatype var = Heap | Local "nat" | Stack "nat" | Exception
 datatype val = Hp "heap" | Value "Value.val"
 
 type_synonym state = "var \<rightharpoonup> val"
 
 definition valid_state :: "state \<Rightarrow> bool"
   where "valid_state s \<equiv> (\<forall>val. s Heap \<noteq> Some (Value val))
   \<and> (s Exception = None \<or> (\<exists>addr. s Exception = Some (Value (Addr addr))))
   \<and> (\<forall>var. var \<noteq> Heap \<and> var \<noteq> Exception \<longrightarrow> (\<forall>h. s var \<noteq> Some (Hp h)))"
 
 fun the_Heap :: "val \<Rightarrow> heap"
   where "the_Heap (Hp h) = h"
 
 fun the_Value :: "val \<Rightarrow> Value.val"
   where "the_Value (Value v) = v"
 
 abbreviation heap_of :: "state \<Rightarrow> heap"
   where "heap_of s \<equiv> the_Heap (the (s Heap))"
 
 abbreviation exc_flag :: "state \<Rightarrow> addr option"
   where "exc_flag s \<equiv> case (s Exception) of None \<Rightarrow> None
   | Some v \<Rightarrow> Some (THE a. v = Value (Addr a))"
 
 abbreviation stkAt :: "state \<Rightarrow> nat \<Rightarrow> Value.val"
   where "stkAt s n \<equiv> the_Value (the (s (Stack n)))"
 
 abbreviation locAt :: "state \<Rightarrow> nat \<Rightarrow> Value.val"
   where "locAt s n \<equiv> the_Value (the (s (Local n)))"
 
 datatype nodeType = Enter | Normal | Return | Exceptional "pc option" "nodeType"
 type_synonym cfg_node = "cname \<times> mname \<times> pc option \<times> nodeType"
 
 type_synonym
   cfg_edge = "cfg_node \<times> (var, val, cname \<times> mname \<times> pc, cname \<times> mname) edge_kind \<times> cfg_node"
 
 definition ClassMain :: "wf_jvmprog \<Rightarrow> cname"
   where "ClassMain P \<equiv> SOME Name. \<not> is_class (PROG P) Name"
 
 definition MethodMain :: "wf_jvmprog \<Rightarrow> mname"
   where "MethodMain P \<equiv> SOME Name.
   \<forall>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<longrightarrow> (\<forall>m \<in> set ms. Name \<noteq> fst m)"
 
 definition stkLength :: "jvm_method \<Rightarrow> pc \<Rightarrow> nat"
   where
   "stkLength m pc \<equiv> let (P, C, M) = m in (
   if (C = ClassMain P) then 1 else (
     length (fst(the(((TYPING P) C M) ! pc)))
   ))"
 
 definition locLength :: "jvm_method \<Rightarrow> pc \<Rightarrow> nat"
   where
   "locLength m pc \<equiv> let (P, C, M) = m in (
   if (C = ClassMain P) then 1 else (
     length (snd(the(((TYPING P) C M) ! pc)))
   ))"
 
 lemma ex_new_class_name: "\<exists>C. \<not> is_class P C"
 proof -
   have "\<not> finite (UNIV :: cname set)"
     by (rule infinite_UNIV_listI)
   hence "\<exists>C. C \<notin> set (map fst P)"
     by -(rule ex_new_if_finite, auto)
   then obtain C where "C \<notin> set (map fst P)"
     by blast
   have "\<not> is_class P C"
   proof
     assume "is_class P C"
     then obtain D fs ms where "class P C = \<lfloor>(D, fs, ms)\<rfloor>"
       by auto
     with \<open>C \<notin> set (map fst P)\<close> show False
       by (auto dest: map_of_SomeD intro!: image_eqI simp: class_def)
   qed
   thus ?thesis
     by blast
 qed
 
 lemma ClassMain_unique_in_P:
   assumes "is_class (PROG P) C"
   shows "ClassMain P \<noteq> C"
 proof -
   from ex_new_class_name [of "PROG P"] obtain D where "\<not> is_class (PROG P) D"
     by blast
   with \<open>is_class (PROG P) C\<close> show ?thesis
     unfolding ClassMain_def
     by -(rule someI2, fastforce+)
 qed
 
 lemma map_of_fstD: "\<lbrakk> map_of xs a = \<lfloor>b\<rfloor>; \<forall>x \<in> set xs. fst x \<noteq> a \<rbrakk> \<Longrightarrow> False"
   by (induct xs, auto)
 
 lemma map_of_fstE: "\<lbrakk> map_of xs a = \<lfloor>b\<rfloor>; \<exists>x \<in> set xs. fst x = a \<Longrightarrow> thesis \<rbrakk> \<Longrightarrow> thesis"
   by (induct xs) (auto split: if_split_asm)
 
 lemma ex_unique_method_name:
   "\<exists>Name. \<forall>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<longrightarrow> (\<forall>m\<in>set ms. Name \<noteq> fst m)"
 proof -
   from wf_jvmprog_is_wf [of P]
   have "distinct_fst (PROG P)"
     by (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def wf_prog_def)
   hence "{C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>} = fst ` set (PROG P)"
     by (fastforce elim: map_of_fstE simp: class_def intro: map_of_SomeI)
   hence "finite {C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
     by auto
   moreover have "{ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}
     = snd ` snd ` the ` (\<lambda>C. class (PROG P) C) ` {C. \<exists>D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
     by (fastforce intro: rev_image_eqI map_of_SomeI simp: class_def)
   ultimately have "finite {ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}"
     by auto
   moreover have "\<not> finite (UNIV :: mname set)"
     by (rule infinite_UNIV_listI)
   ultimately
   have "\<exists>Name. Name \<notin> fst ` (\<Union>ms \<in> {ms. \<exists>C D fs. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor>}. set ms)"
     by -(rule ex_new_if_finite, auto)
   thus ?thesis
     by fastforce
 qed
 
 lemma MethodMain_unique_in_P:
   assumes "PROG P \<turnstile> D sees M:Ts\<rightarrow>T = mb in C"
   shows "MethodMain P \<noteq> M"
 proof -
   from ex_unique_method_name [of P] obtain M'
     where "\<And>C D fs ms. class (PROG P) C = \<lfloor>(D, fs, ms)\<rfloor> \<Longrightarrow> (\<forall>m \<in> set ms. M' \<noteq> fst m)"
     by blast
   with \<open>PROG P \<turnstile> D sees M:Ts\<rightarrow>T = mb in C\<close>
   show ?thesis
     unfolding MethodMain_def
     by -(rule someI2_ex, fastforce, fastforce dest!: visible_method_exists elim: map_of_fstE)
 qed
 
 lemma ClassMain_is_no_class [dest!]: "is_class (PROG P) (ClassMain P) \<Longrightarrow> False"
 proof (erule rev_notE)
   from ex_new_class_name [of "PROG P"] obtain C where "\<not> is_class (PROG P) C"
     by blast
   thus "\<not> is_class (PROG P) (ClassMain P)" unfolding ClassMain_def
     by (rule someI)
 qed
 
 lemma MethodMain_not_seen [dest!]: "PROG P \<turnstile> C sees (MethodMain P):Ts\<rightarrow>T = mb in D \<Longrightarrow> False"
   by (fastforce dest: MethodMain_unique_in_P)
 
 lemma no_Call_from_ClassMain [dest!]: "PROG P \<turnstile> ClassMain P sees M:Ts\<rightarrow>T = mb in C \<Longrightarrow> False"
   by (fastforce dest: sees_method_is_class)
 
 lemma no_Call_in_ClassMain [dest!]: "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = mb in ClassMain P \<Longrightarrow> False"
   by (fastforce dest: sees_method_idemp)
 
 inductive JVMCFG :: "jvm_method \<Rightarrow> cfg_node \<Rightarrow> (var, val, cname \<times> mname \<times> pc, cname \<times> mname) edge_kind \<Rightarrow> cfg_node \<Rightarrow> bool" (" _ \<turnstile> _ -_\<rightarrow> _")
   and reachable :: "jvm_method \<Rightarrow> cfg_node \<Rightarrow> bool" (" _ \<turnstile> \<Rightarrow>_")
   where
     Entry_reachable: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, None, Enter)"
   | reachable_step: "\<lbrakk> P \<turnstile> \<Rightarrow>n; P \<turnstile> n -(e)\<rightarrow> n' \<rbrakk> \<Longrightarrow> P \<turnstile> \<Rightarrow>n'"
   | Main_to_Call: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)
   \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter) -\<Up>id\<rightarrow> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
   | Main_Call_LFalse: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)
   \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"
   | Main_Call: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal);
      PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D;
      initParams = [(\<lambda>s. s Heap),(\<lambda>s. \<lfloor>Value Null\<rfloor>)];
      ek = (\<lambda>(s, ret). True):(ClassMain P, MethodMain P, 0)\<hookrightarrow>\<^bsub>(D, Main)\<^esub>initParams \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal) -(ek)\<rightarrow> (D, Main, None, Enter)"
   | Main_Return_to_Exit: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)
   \<Longrightarrow> (P, C0, Main) \<turnstile> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return) -(\<Up>id)\<rightarrow> (ClassMain P, MethodMain P, None, Return)"
   | Method_LFalse: "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Enter) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (C, M, None, Return)"
   | Method_LTrue: "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Enter) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (C, M, \<lfloor>0\<rfloor>, Enter)"
   | CFG_Load: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Load n;
     ek = \<Up>(\<lambda>s. s(Stack (stkLength (P, C, M) pc) := s (Local n))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Store: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Store n;
     ek = \<Up>(\<lambda>s. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Push: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Push v;
     ek = \<Up>(\<lambda>s. s(Stack (stkLength (P, C, M) pc) \<mapsto> Value v)) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Pop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Pop;
     ek = \<Up>id \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_IAdd: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = IAdd;
     ek = \<Up>(\<lambda>s. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
                    i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
                 in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Intg (i1 + i2)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Goto: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = Goto i \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -((\<lambda>s. True)\<^sub>\<surd>)\<rightarrow> (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
   | CFG_CmpEq: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter); instrs_of (PROG P) C M ! pc = CmpEq;
     ek = \<Up>(\<lambda>s. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
                    e2 = stkAt s (stkLength (P, C, M) pc - 2)
                 in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Bool (e1 = e2)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_IfFalse_False: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = IfFalse i;
     i \<noteq> 1;
     ek = (\<lambda>s. stkAt s (stkLength(P, C, M) pc - 1) = Bool False)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
   | CFG_IfFalse_True: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = IfFalse i;
     ek = (\<lambda>s. stkAt s (stkLength(P, C, M) pc - 1) \<noteq> Bool False \<or> i = 1)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_New_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = New Cl;
     ek = (\<lambda>s. new_Addr (heap_of s) \<noteq> None)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
   | CFG_New_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = New Cl;
     pc' = (case (match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M)) of
              None \<Rightarrow> None
            | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
     ek = (\<lambda>s. new_Addr (heap_of s) = None)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
   | CFG_New_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
     instrs_of (PROG P) C M ! pc = New Cl;
     ek = \<Up>(\<lambda>s. let a = the (new_Addr (heap_of s))
-                in s(Heap \<mapsto> Hp ((heap_of s)(a \<mapsto> blank (PROG P) Cl)))
-                    (Stack (stkLength(P, C, M) pc) \<mapsto> Value (Addr a))) \<rbrakk>
+                in s(Heap \<mapsto> Hp ((heap_of s)(a \<mapsto> blank (PROG P) Cl)),
+                    Stack (stkLength(P, C, M) pc) \<mapsto> Value (Addr a))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_New_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = New Cl;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt OutOfMemory)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_New_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     instrs_of (PROG P) C M ! pc = New Cl;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt OutOfMemory)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Getfield_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Getfield F Cl;
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
   | CFG_Getfield_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Getfield F Cl;
     pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
              None \<Rightarrow> None
            | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) = Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
   | CFG_Getfield_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
     instrs_of (PROG P) C M ! pc = Getfield F Cl;
     ek = \<Up>(\<lambda>s. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
                  in s(Stack (stkLength(P, C, M) pc - 1) \<mapsto> Value (the (fs (F, Cl))))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Getfield_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = Getfield F Cl;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Getfield_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     instrs_of (PROG P) C M ! pc = Getfield F Cl;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Putfield_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Putfield F Cl;
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
   | CFG_Putfield_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Putfield F Cl;
     pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
              None \<Rightarrow> None
            | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) = Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
   | CFG_Putfield_Update: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
     instrs_of (PROG P) C M ! pc = Putfield F Cl;
     ek = \<Up>(\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
                    r = stkAt s (stkLength (P, C, M) pc - 2);
                    a = the_Addr r;
                    (D, fs) = the (heap_of s a);
                    h' = (heap_of s)(a \<mapsto> (D, fs((F, Cl) \<mapsto> v)))
                  in s(Heap \<mapsto> Hp h')) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Putfield_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = Putfield F Cl;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Putfield_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     instrs_of (PROG P) C M ! pc = Putfield F Cl;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Checkcast_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Checkcast Cl;
     ek = (\<lambda>s. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Checkcast_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Checkcast Cl;
     pc' = (case (match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M)) of
              None \<Rightarrow> None
            | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
     ek = (\<lambda>s. \<not> cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
   | CFG_Checkcast_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = Checkcast Cl;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt ClassCast)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Checkcast_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     instrs_of (PROG P) C M ! pc = Checkcast Cl;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt ClassCast)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Throw_Check: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Throw;
     pc' = None \<or> match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(the pc', d)\<rfloor>;
     ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
                   Cl = if (v = Null) then NullPointer else (cname_of (heap_of s) (the_Addr v))
                in case pc' of
                   None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
                 | Some pc'' \<Rightarrow> \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M)
                                   = \<lfloor>(pc'', d)\<rfloor>
     )\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
 
   | CFG_Throw_prop: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = Throw;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (stkAt s (stkLength (P, C, M) pc - 1)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Throw_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     pc' \<noteq> length (instrs_of (PROG P) C M);
     instrs_of (PROG P) C M ! pc = Throw;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (stkAt s (stkLength (P, C, M) pc - 1)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Invoke_Check_NP_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) \<noteq> Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Normal)"
   | CFG_Invoke_Check_NP_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
              None \<Rightarrow> None
            | Some (pc'', d) \<Rightarrow> \<lfloor>pc''\<rfloor>);
     ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
   | CFG_Invoke_NP_prop: "\<lbrakk> C \<noteq> ClassMain P;
     (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     ek = \<Up>(\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Invoke_NP_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
-    ek = \<Up>(\<lambda>s. s(Exception := None)
+    ek = \<Up>(\<lambda>s. (s(Exception := None))
                 (Stack (stkLength (P, C, M) pc' - 1) \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Invoke_Call: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     TYPING P C M ! pc = \<lfloor>(ST, LT)\<rfloor>;
     ST ! n = Class D';
     PROG P \<turnstile> D' sees M':Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D;
     Q = (\<lambda>(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
                         C' = fst (the (heap_of s (the_Addr r)))
                      in D = fst (method (PROG P) C' M'));
     paramDefs = (\<lambda>s. s Heap)
                 # (\<lambda>s. s (Stack (stkLength (P, C, M) pc - Suc n)))
                 # (rev (map (\<lambda>i. (\<lambda>s. s (Stack (stkLength (P, C, M) pc - Suc i)))) [0..<n]));
     ek = Q:(C, M, pc)\<hookrightarrow>\<^bsub>(D,M')\<^esub>paramDefs
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (D, M', None, Enter)"
   | CFG_Invoke_False: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     ek = (\<lambda>s. False)\<^sub>\<surd>
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Normal) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Return)"
   | CFG_Invoke_Return_Check_Normal: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     (TYPING P) C M ! pc = \<lfloor>(ST, LT)\<rfloor>;
     ST ! n \<noteq> NT;
     ek = (\<lambda>s. s Exception = None)\<^sub>\<surd>
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
   | CFG_Invoke_Return_Check_Exceptional: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', diff)\<rfloor>;
     pc' \<noteq> length (instrs_of (PROG P) C M);
     ek = (\<lambda>s. \<exists>v d. s Exception = \<lfloor>v\<rfloor> \<and>
                   match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d)\<rfloor>)\<^sub>\<surd>
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)"
   | CFG_Invoke_Return_Exceptional_handle: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     ek = \<Up>(\<lambda>s. s(Exception := None,
                  Stack (stkLength (P, C, M) pc' - 1) := s Exception)) \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return) -(ek)\<rightarrow> (C, M, \<lfloor>pc'\<rfloor>, Enter)"
   | CFG_Invoke_Return_Exceptional_prop: "\<lbrakk> C \<noteq> ClassMain P;
     (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return);
     instrs_of (PROG P) C M ! pc = Invoke M' n;
     ek = (\<lambda>s. \<exists>v. s Exception = \<lfloor>v\<rfloor> \<and>
               match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = None)\<^sub>\<surd> \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Return) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Return: "\<lbrakk> C \<noteq> ClassMain P; (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter);
     instrs_of (PROG P) C M ! pc = instr.Return;
     ek = \<Up>(\<lambda>s. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1))))
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -(ek)\<rightarrow> (C, M, None, Return)"
   | CFG_Return_from_Method: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Return);
     (P, C0, Main) \<turnstile> (C', M', \<lfloor>pc'\<rfloor>, Normal) -(Q':(C', M', pc')\<hookrightarrow>\<^bsub>(C,M)\<^esub>ps)\<rightarrow> (C, M, None, Enter);
     Q = (\<lambda>(s, ret). ret = (C', M', pc'));
     stateUpdate = (\<lambda>s s'. s'(Heap := s Heap,
                             Exception := s Exception,
                             Stack (stkLength (P, C', M') (Suc pc') - 1) := s (Stack 0))
                   );
     ek = Q\<hookleftarrow>\<^bsub>(C, M)\<^esub>stateUpdate
   \<rbrakk>
   \<Longrightarrow> (P, C0, Main) \<turnstile> (C, M, None, Return) -(ek)\<rightarrow> (C', M', \<lfloor>pc'\<rfloor>, Return)"
 
 
 (* This takes veeeery long *)
 lemma JVMCFG_edge_det: "\<lbrakk> P \<turnstile> n -(et)\<rightarrow> n'; P \<turnstile> n -(et')\<rightarrow> n' \<rbrakk> \<Longrightarrow> et = et'"
   by (erule JVMCFG.cases) (erule JVMCFG.cases, (fastforce dest: sees_method_fun)+)+
 
 lemma sourcenode_reachable: "P \<turnstile> n -(ek)\<rightarrow> n' \<Longrightarrow> P \<turnstile> \<Rightarrow>n"
   by (erule JVMCFG.cases, auto)
 
 lemma targetnode_reachable:
   assumes edge: "P \<turnstile> n -(ek)\<rightarrow> n'"
   shows "P \<turnstile> \<Rightarrow>n'"
 proof -
   from edge have "P \<turnstile> \<Rightarrow>n"
     by -(drule sourcenode_reachable)
   with edge show ?thesis
     by -(rule JVMCFG_reachable.intros)
 qed
 
 lemmas JVMCFG_reachable_inducts = JVMCFG_reachable.inducts[split_format (complete)]
 
 lemma ClassMain_imp_MethodMain:
   "(P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (ClassMain P, M, pc, nt) \<Longrightarrow> M = MethodMain P"
   "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, M, pc, nt) \<Longrightarrow> M = MethodMain P"
 proof (induct P=="P" C0\<equiv>"C0" Main\<equiv>Main C' M' pc' nt' ek C''=="ClassMain P" M pc nt and
               P=="P" C0\<equiv>"C0" Main\<equiv>Main C'=="ClassMain P" M pc nt
        rule: JVMCFG_reachable_inducts)
   case CFG_Return_from_Method
   thus ?case
     by (fastforce elim: JVMCFG.cases)
 qed auto
 
 lemma ClassMain_no_Call_target [dest!]:
   "(P, C0, Main) \<turnstile> (C, M, pc, nt) -Q:(C', M', pc')\<hookrightarrow>\<^bsub>(D,M'')\<^esub>paramDefs\<rightarrow> (ClassMain P, M''', pc'', nt')
   \<Longrightarrow> False"
   and
   "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt) \<Longrightarrow> True"
   by (induct  P C0 Main C M pc nt ek=="Q:(C', M', pc')\<hookrightarrow>\<^bsub>(D,M'')\<^esub>paramDefs"
                          C''=="ClassMain P" M''' pc'' nt' and
                P C0 Main C M pc nt
     rule: JVMCFG_reachable_inducts) auto
 
 lemma method_of_src_and_trg_exists:
   "\<lbrakk> (P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (C, M, pc, nt); C \<noteq> ClassMain P; C' \<noteq> ClassMain P \<rbrakk>
   \<Longrightarrow> (\<exists>Ts T mb. (PROG P) \<turnstile> C sees M:Ts\<rightarrow>T = mb in C) \<and>
      (\<exists>Ts T mb. (PROG P) \<turnstile> C' sees M':Ts\<rightarrow>T = mb in C')"
   and method_of_reachable_node_exists:
   "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P \<rbrakk>
   \<Longrightarrow> \<exists>Ts T mb. (PROG P) \<turnstile> C sees M:Ts\<rightarrow>T = mb in C"
 proof (induct rule: JVMCFG_reachable_inducts)
   case CFG_Invoke_Call
   thus ?case
     by (blast dest: sees_method_idemp)
 next
   case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
   show ?case
   proof (cases "C = ClassMain P")
     case True
     with \<open>(P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')\<close> \<open>C' \<noteq> ClassMain P\<close>
     show ?thesis
     proof cases
       case Main_Call
       thus ?thesis
         by (blast dest: sees_method_idemp)
     qed auto
   next
     case False
     with reachable_step show ?thesis
       by simp
   qed
 qed simp_all
 
 lemma "\<lbrakk> (P, C0, Main) \<turnstile> (C', M', pc', nt') -ek\<rightarrow> (C, M, pc, nt); C \<noteq> ClassMain P; C' \<noteq> ClassMain P \<rbrakk>
   \<Longrightarrow> (case pc of None \<Rightarrow> True |
     \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C M ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C M)) \<and>
   (case pc' of None \<Rightarrow> True |
     \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C' M' ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C' M'))"
   and instr_of_reachable_node_typable: "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P \<rbrakk>
   \<Longrightarrow> case pc of None \<Rightarrow> True |
   \<lfloor>pc''\<rfloor> \<Rightarrow> (TYPING P) C M ! pc'' \<noteq> None \<and> pc'' < length (instrs_of (PROG P) C M)"
 proof (induct rule: JVMCFG_reachable_inducts)
   case (CFG_Load C P C0 Main M pc n ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Load show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Store C P C0 Main M pc n ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Store show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Push C P C0 Main M pc v ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Push show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Pop C P C0 Main M pc ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Pop show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_IAdd C P C0 Main M pc ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_IAdd show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Goto C P C0 Main M pc i)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Goto show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_CmpEq C P C0 Main M pc ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_CmpEq show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_IfFalse_False C P C0 Main M pc i ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_IfFalse_False show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_IfFalse_True C P C0 Main M pc i ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_IfFalse_True show ?case
     using [[simproc del: list_to_set_comprehension]] by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_New_Update C P C0 Main M pc Cl ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_New_Update show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> New Cl,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = New Cl\<close> obtain d'
     where "match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) OutOfMemory pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Getfield_Update show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Getfield F Cl,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close> obtain d'
     where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Putfield_Update show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Putfield F Cl,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close> obtain d'
     where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Checkcast_Check_Normal show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next
   case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Checkcast Cl,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close> obtain d'
     where "match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) ClassCast pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Throw_handle C P C0 Main M pc pc' ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Throw,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Throw\<close> obtain d' Exc
     where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Invoke M' n,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> obtain d'
     where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
   hence "TYPING P C M ! pc \<noteq> None" and "pc < length (instrs_of (PROG P) C M)"
     by simp_all
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 where
     "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
     by (fastforce dest: method_of_reachable_node_exists)
   with \<open>pc < length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
   have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     \<turnstile> Invoke M' n,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
   moreover from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)\<close> \<open>C \<noteq> ClassMain P\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> obtain d' Exc
     where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', d')\<rfloor>"
     by cases (fastforce elim: JVMCFG.cases)
   hence "\<exists>(f, t, D, h, d)\<in>set (ex_table_of (PROG P) C M).
     matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) \<and> h = pc' \<and> d = d'"
     by -(drule match_ex_table_SomeD)
   ultimately show ?case using \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
 next
   case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Return)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with CFG_Invoke_Return_Check_Normal show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
 next 
   case (Method_LTrue P C0 Main C M)
   from \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)\<close> \<open>C \<noteq> ClassMain P\<close>
   obtain Ts T mxs mxl\<^sub>0 "is" xt where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "instrs_of (PROG P) C M = is"
     by -(drule method_of_reachable_node_exists, auto)
   with Method_LTrue show ?case
     by (fastforce dest!: wt_jvm_prog_impl_wt_start [OF wf_jvmprog_is_wf_typ] simp: wt_start_def)
 next
   case (reachable_step P C0 Main C M opc nt ek C' M' opc' nt')
   thus ?case
     by (cases "C = ClassMain P") (fastforce elim: JVMCFG.cases, simp)
 qed simp_all
 
 lemma reachable_node_impl_wt_instr:
   assumes "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nt)"
   and "C \<noteq> ClassMain P"
   shows "\<exists>T mxs mpc xt. PROG P,T,mxs,mpc,xt \<turnstile> (instrs_of (PROG P) C M ! pc),pc :: TYPING P C M"
 proof -
   from \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nt)\<close>
     method_of_reachable_node_exists [of P C0 Main C M "\<lfloor>pc\<rfloor>" nt]
     instr_of_reachable_node_typable [of P C0 Main C M "\<lfloor>pc\<rfloor>" nt]
   obtain Ts T mxs mxl\<^sub>0 "is" xt
     where "PROG P \<turnstile> C sees M:Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in C"
     and "TYPING P C M ! pc \<noteq> None"
     and "pc < length (instrs_of (PROG P) C M)"
     by fastforce+
   with wf_jvmprog_is_wf_typ [of P]
   have "PROG P,T,mxs,length is,xt \<turnstile> instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
     by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
   thus ?thesis
     by blast
 qed
 
 lemma
   "\<lbrakk> (P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt'); C \<noteq> ClassMain P \<or> C' \<noteq> ClassMain P \<rbrakk>
   \<Longrightarrow> \<exists>T mb D. PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = mb in D"
   and reachable_node_impl_Main_ex:
   "\<lbrakk> (P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt); C \<noteq> ClassMain P\<rbrakk>
   \<Longrightarrow> \<exists>T mb D. PROG P \<turnstile> C0 sees Main:[]\<rightarrow>T = mb in D"
   by (induct rule: JVMCFG_reachable_inducts) fastforce+
 
 end
diff --git a/thys/HRB-Slicing/JinjaVM_Inter/JVMPostdomination.thy b/thys/HRB-Slicing/JinjaVM_Inter/JVMPostdomination.thy
--- a/thys/HRB-Slicing/JinjaVM_Inter/JVMPostdomination.thy
+++ b/thys/HRB-Slicing/JinjaVM_Inter/JVMPostdomination.thy
@@ -1,1244 +1,1244 @@
 theory JVMPostdomination imports JVMInterpretation "../StaticInter/Postdomination" begin
 
 context CFG begin
 
 lemma vp_snocI:
   "\<lbrakk>n -as\<rightarrow>\<^sub>\<surd>* n'; n' -[a]\<rightarrow>* n''; \<forall>Q p ret fs. kind a \<noteq> Q\<hookleftarrow>\<^bsub>p\<^esub>ret \<rbrakk> \<Longrightarrow> n -as @ [a]\<rightarrow>\<^sub>\<surd>* n''"
   by (cases "kind a") (auto intro: path_Append valid_path_aux_Append simp: vp_def valid_path_def)
 
 lemma valid_node_cases' [case_names Source Target, consumes 1]:
   "\<lbrakk> valid_node n; \<And>e. \<lbrakk> valid_edge e; sourcenode e = n \<rbrakk> \<Longrightarrow> thesis;
   \<And>e. \<lbrakk> valid_edge e; targetnode e = n \<rbrakk> \<Longrightarrow> thesis \<rbrakk>
   \<Longrightarrow> thesis"
   by (auto simp: valid_node_def)
 
 end
 
 lemma disjE_strong: "\<lbrakk>P \<or> Q; P \<Longrightarrow> R; \<lbrakk>Q; \<not> P\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
   by auto
 
 lemmas path_intros [intro] = JVMCFG_Interpret.path.Cons_path JVMCFG_Interpret.path.empty_path
 declare JVMCFG_Interpret.vp_snocI [intro]
 declare JVMCFG_Interpret.valid_node_def [simp add]
   valid_edge_def [simp add]
   JVMCFG_Interpret.intra_path_def [simp add]
 
 abbreviation vp_snoc :: "wf_jvmprog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> cfg_edge list \<Rightarrow> cfg_node
   \<Rightarrow> (var, val, cname \<times> mname \<times> pc, cname \<times> mname) edge_kind \<Rightarrow> cfg_node \<Rightarrow> bool"
   where "vp_snoc P C0 Main as n ek n'
   \<equiv> JVMCFG_Interpret.valid_path' P C0 Main
   (ClassMain P, MethodMain P, None, Enter) (as @ [(n,ek,n')]) n'"
 
 lemma
   "(P, C0, Main) \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')
   \<Longrightarrow> (\<exists>as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
   (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)) \<and>
   (\<exists>as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
   (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C', M', pc', nt'))"
   and valid_Entry_path: "(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, pc, nt)
   \<Longrightarrow> \<exists>as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
   (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)"
 proof (induct rule: JVMCFG_reachable_inducts)
   case (Entry_reachable P C0 Main)
   hence "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) [] (ClassMain P, MethodMain P, None, Enter)"
     by (fastforce intro: JVMCFG_Interpret.intra_path_vp Method_LTrue
       JVMCFG_reachable.Entry_reachable)
   thus ?case by blast
 next
   case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
   thus ?case by simp
 next
   case (Main_to_Call P C0 Main)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)\<close>
   have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter) \<Up>id
     (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
     by (fastforce intro: JVMCFG_reachable.Main_to_Call)
   ultimately show ?case by blast
 next
   case (Main_Call_LFalse P C0 Main)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)\<close>
   have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal) (\<lambda>s. False)\<^sub>\<surd>
     (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"
     by (fastforce intro: JVMCFG_reachable.Main_Call_LFalse)
   ultimately show ?case by blast
 next
   case (Main_Call P C0 Main T mxs mxl\<^sub>0 "is" xt D initParams ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)\<close>
     \<open>PROG P \<turnstile> C0 sees Main: []\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D\<close>
     \<open>initParams = [\<lambda>s. s Heap, \<lambda>s. \<lfloor>Value Null\<rfloor>]\<close>
     \<open>ek = \<lambda>(s, ret). True:(ClassMain P, MethodMain P, 0)\<hookrightarrow>\<^bsub>(D, Main)\<^esub>initParams\<close>
   have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)
     ((\<lambda>(s, ret). True):(ClassMain P, MethodMain P, 0)\<hookrightarrow>\<^bsub>(D, Main)\<^esub>[(\<lambda>s. s Heap),(\<lambda>s. \<lfloor>Value Null\<rfloor>)])
     (D, Main, None, Enter)"
     by (fastforce intro: JVMCFG_reachable.Main_Call)
   ultimately show ?case by blast
 next
   case (Main_Return_to_Exit P C0 Main)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, nodeType.Return)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, nodeType.Return)\<close>
   have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, nodeType.Return) \<Up>id
     (ClassMain P, MethodMain P, None, nodeType.Return)"
     by (fastforce intro: JVMCFG_reachable.Main_Return_to_Exit)
   ultimately show ?case by blast
 next
   case (Method_LFalse P C0 Main C M)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)\<close>
   have "vp_snoc P C0 Main as (C, M, None, Enter) (\<lambda>s. False)\<^sub>\<surd> (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.Method_LFalse)
   ultimately show ?case by blast
 next
   case (Method_LTrue P C0 Main C M)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
     by blast
   moreover with \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, None, Enter)\<close>
   have "vp_snoc P C0 Main as (C, M, None, Enter) (\<lambda>s. True)\<^sub>\<surd> (C, M, \<lfloor>0\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.Method_LTrue)
   ultimately show ?case by blast
 next
   case (CFG_Load C P C0 Main M pc n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Load n\<close>
     \<open>ek = \<Up>\<lambda>s. s(Stack (stkLength (P, C, M) pc) := s (Local n))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Load)
   ultimately show ?case by blast
 next
   case (CFG_Store C P C0 Main M pc n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Store n\<close>
     \<open>ek = \<Up>\<lambda>s. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Store)
   ultimately show ?case by blast
 next
   case (CFG_Push C P C0 Main M pc v ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Push v\<close>
     \<open>ek = \<Up>\<lambda>s. s(Stack (stkLength (P, C, M) pc) \<mapsto> Value v)\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Push)
   ultimately show ?case by blast
 next
   case (CFG_Pop C P C0 Main M pc ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Pop\<close> \<open>ek = \<Up>id\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Pop)
   ultimately show ?case by blast
 next
   case (CFG_IAdd C P C0 Main M pc ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = IAdd\<close>
     \<open>ek = \<Up>\<lambda>s. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
                    i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
     in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Intg (i1 + i2)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_IAdd)
   ultimately show ?case by blast
 next
   case (CFG_Goto C P C0 Main M pc i)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Goto i\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) (\<lambda>s. True)\<^sub>\<surd> (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Goto)
   ultimately show ?case by blast
 next
   case (CFG_CmpEq C P C0 Main M pc ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = CmpEq\<close>
     \<open>ek = \<Up>\<lambda>s. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
                    e2 = stkAt s (stkLength (P, C, M) pc - 2)
     in s(Stack (stkLength (P, C, M) pc - 2) \<mapsto> Value (Bool (e1 = e2)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_CmpEq)
   ultimately show ?case by blast
 next
   case (CFG_IfFalse_False C P C0 Main M pc i ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = IfFalse i\<close> \<open>i \<noteq> 1\<close>
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) = Bool False)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>nat (int pc + i)\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_False)
   ultimately show ?case by blast
 next
   case (CFG_IfFalse_True C P C0 Main M pc i ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = IfFalse i\<close>
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) \<noteq> Bool False \<or> i = 1)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_True)
   ultimately show ?case by blast
 next
   case (CFG_New_Check_Normal C P C0 Main M pc Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = New Cl\<close> \<open>ek = (\<lambda>s. new_Addr (heap_of s) \<noteq> None)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Normal)
   ultimately show ?case by blast
 next
   case (CFG_New_Check_Exceptional C P C0 Main M pc Cl pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open> instrs_of (PROG P) C M ! pc = New Cl\<close>
     \<open>pc' = (case match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) of None \<Rightarrow> None
     | \<lfloor>(pc'', d)\<rfloor> \<Rightarrow> \<lfloor>pc''\<rfloor>)\<close> \<open>ek = (\<lambda>s. new_Addr (heap_of s) = None)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_New_Update C P C0 Main M pc Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close>
     \<open> instrs_of (PROG P) C M ! pc = New Cl\<close>
     \<open> ek = \<Up>\<lambda>s. let a = the (new_Addr (heap_of s)) in
-    s(Heap \<mapsto> Hp (heap_of s(a \<mapsto> blank (PROG P) Cl)),
+    s(Heap \<mapsto> Hp ((heap_of s)(a \<mapsto> blank (PROG P) Cl)),
       Stack (stkLength (P, C, M) pc) \<mapsto> Value (Addr a))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Normal) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_New_Update)
   ultimately show ?case by blast
 next
   case (CFG_New_Exceptional_prop C P C0 Main M pc Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt OutOfMemory)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_prop)
   ultimately show ?case by blast
 next
   case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = New Cl\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (Addr (addr_of_sys_xcpt OutOfMemory)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_handle)
   ultimately show ?case by blast
 next
   case (CFG_Getfield_Check_Normal C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) \<noteq> Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Normal)
   ultimately show ?case by blast
 next
   case (CFG_Getfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
     \<open>pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None \<Rightarrow> None
     | \<lfloor>(pc'', d)\<rfloor> \<Rightarrow> \<lfloor>pc''\<rfloor>)\<close> \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 1) = Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
     \<open>ek = \<Up>\<lambda>s. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
     in s(Stack (stkLength (P, C, M) pc - 1) \<mapsto> Value (the (fs (F, Cl))))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Normal) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Update)
   ultimately show ?case by blast
 next
   case (CFG_Getfield_Exceptional_prop C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_prop)
   ultimately show ?case by blast
 next
   case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Getfield F Cl\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_handle)
   ultimately show ?case by blast
 next
   case (CFG_Putfield_Check_Normal C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) \<noteq> Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Normal)
   ultimately show ?case by blast
 next
   case (CFG_Putfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
     \<open>pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None \<Rightarrow> None
     | \<lfloor>(pc'', d)\<rfloor> \<Rightarrow> \<lfloor>pc''\<rfloor>)\<close> \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - 2) = Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
     \<open>ek = \<Up>\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
     r = stkAt s (stkLength (P, C, M) pc - 2);
-    a = the_Addr r; (D, fs) = the (heap_of s a); h' = heap_of s(a \<mapsto> (D, fs((F, Cl) \<mapsto> v)))
+    a = the_Addr r; (D, fs) = the (heap_of s a); h' = (heap_of s)(a \<mapsto> (D, fs((F, Cl) \<mapsto> v)))
     in s(Heap \<mapsto> Hp h')\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Normal) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Update)
   ultimately show ?case by blast
 next
   case (CFG_Putfield_Exceptional_prop C P C0 Main M pc F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_prop)
   ultimately show ?case by blast
 next
   case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Putfield F Cl\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_handle)
   ultimately show ?case by blast
 next
   case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
     \<open>ek = (\<lambda>s. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Normal)
   ultimately show ?case by blast
 next
   case (CFG_Checkcast_Check_Exceptional C P C0 Main M pc Cl pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
     \<open>pc' = (case match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) of None \<Rightarrow> None
     | \<lfloor>(pc'', d)\<rfloor> \<Rightarrow> \<lfloor>pc''\<rfloor>)\<close>
     \<open>ek = (\<lambda>s. \<not> cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_Checkcast_Exceptional_prop C P C0 Main M pc Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt ClassCast)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_prop)
   ultimately show ?case by blast
 next
   case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Checkcast Cl\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (Addr (addr_of_sys_xcpt ClassCast)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_handle)
   ultimately show ?case by blast
 next
   case (CFG_Throw_Check C P C0 Main M pc pc' Exc d ek)
   then obtain as where path_src: "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   from \<open>pc' = None \<or> match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(the pc', d)\<rfloor>\<close>
   show ?case
   proof (elim disjE_strong)
     assume "pc' = None"
     with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
     \<open>ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
            Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
        in case pc' of None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
           | \<lfloor>pc''\<rfloor> \<Rightarrow>
               \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = \<lfloor>(pc'', d)\<rfloor>)\<^sub>\<surd>\<close>
     have "(P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -
       (\<lambda>s. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null \<longrightarrow>
         match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = None) \<and>
         (stkAt s (stkLength (P, C, M) pc - Suc 0) \<noteq> Null \<longrightarrow>
           match_ex_table (PROG P) (cname_of (heap_of s)
            (the_Addr (stkAt s (stkLength (P, C, M) pc - Suc 0)))) pc (ex_table_of (PROG P) C M) =
       None))\<^sub>\<surd>\<rightarrow> (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
       by -(erule JVMCFG_reachable.CFG_Throw_Check, simp_all)
     with path_src \<open>pc' = None\<close> \<open>ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
            Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
        in case pc' of None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
           | \<lfloor>pc''\<rfloor> \<Rightarrow>
               \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = \<lfloor>(pc'', d)\<rfloor>)\<^sub>\<surd>\<close>
     have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
       by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
     with path_src \<open>pc' = None\<close> show ?thesis by blast
   next
     assume met: "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(the pc', d)\<rfloor>"
       and pc': "pc' \<noteq> None"
     with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
     \<open>ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
            Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
        in case pc' of None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
           | \<lfloor>pc''\<rfloor> \<Rightarrow>
               \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = \<lfloor>(pc'', d)\<rfloor>)\<^sub>\<surd>\<close>
     have "(P, C0, Main) \<turnstile> (C, M, \<lfloor>pc\<rfloor>, Enter) -
       (\<lambda>s. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null \<longrightarrow>
                                     (\<exists>d. match_ex_table (PROG P) NullPointer pc
                                           (ex_table_of (PROG P) C M) =
                                          \<lfloor>(the pc', d)\<rfloor>)) \<and>
                                    (stkAt s (stkLength (P, C, M) pc - Suc 0) \<noteq> Null \<longrightarrow>
                                     (\<exists>d. match_ex_table (PROG P)
                                           (cname_of (heap_of s)
                                             (the_Addr
                                               (stkAt s (stkLength (P, C, M) pc - Suc 0))))
                                           pc (ex_table_of (PROG P) C M) =
                                          \<lfloor>(the pc', d)\<rfloor>)))\<^sub>\<surd>\<rightarrow>
       (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>the pc'\<rfloor> Enter)"
       by -(rule JVMCFG_reachable.CFG_Throw_Check, simp_all)
     with met pc' path_src \<open>ek = (\<lambda>s. let v = stkAt s (stkLength (P, C, M) pc - 1);
            Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
        in case pc' of None \<Rightarrow> match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
           | \<lfloor>pc''\<rfloor> \<Rightarrow>
               \<exists>d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = \<lfloor>(pc'', d)\<rfloor>)\<^sub>\<surd>\<close>
     have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
       by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
     with path_src show ?thesis by blast
   qed
 next
   case (CFG_Throw_prop C P C0 Main M pc ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (stkAt s (stkLength (P, C, M) pc - 1)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, nodeType.Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Throw_prop)
   ultimately show ?case by blast
 next
   case (CFG_Throw_handle C P C0 Main M pc pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>pc' \<noteq> length (instrs_of (PROG P) C M)\<close> \<open>instrs_of (PROG P) C M ! pc = Throw\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (stkAt s (stkLength (P, C, M) pc - 1)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Throw_handle)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Check_NP_Normal C P C0 Main M pc M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> 
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) \<noteq> Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Normal)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Check_NP_Exceptional C P C0 Main M pc M' n pc' ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     \<open>pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None \<Rightarrow> None
     | \<lfloor>(pc'', d)\<rfloor> \<Rightarrow> \<lfloor>pc''\<rfloor>)\<close>
     \<open>ek = (\<lambda>s. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional pc' Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_NP_prop C P C0 Main M pc M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception \<mapsto> Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional None Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_prop)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
-    \<open>ek = \<Up>\<lambda>s. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
+    \<open>ek = \<Up>\<lambda>s. (s(Exception := None))(Stack (stkLength (P, C, M) pc' - 1) \<mapsto>
     Value (Addr (addr_of_sys_xcpt NullPointer)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Enter) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_handle)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Call C P C0 Main M pc M' n ST LT D' Ts T mxs mxl\<^sub>0 "is" xt D Q paramDefs ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> \<open>TYPING P C M ! pc = \<lfloor>(ST, LT)\<rfloor>\<close>
     \<open>ST ! n = Class D'\<close> \<open>PROG P \<turnstile> D' sees M': Ts\<rightarrow>T = (mxs, mxl\<^sub>0, is, xt) in D\<close>
     \<open>Q = (\<lambda>(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
               C' = cname_of (heap_of s) (the_Addr r) in D = fst (method (PROG P) C' M'))\<close>
     \<open>paramDefs = (\<lambda>s. s Heap) # (\<lambda>s. s (Stack (stkLength (P, C, M) pc - Suc n))) #
     rev (map (\<lambda>i s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])\<close>
     \<open>ek = Q:(C, M, pc)\<hookrightarrow>\<^bsub>(D, M')\<^esub>paramDefs\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Normal) ek (D, M', None, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Call)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_False C P C0 Main M pc M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Normal)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Normal)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> \<open>ek = (\<lambda>s. False)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Normal) ek (C, M, \<lfloor>pc\<rfloor>, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_False)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, nodeType.Return)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nodeType.Return)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close> \<open>TYPING P C M ! pc = \<lfloor>(ST, LT)\<rfloor>\<close>
     \<open>ST ! n \<noteq> NT\<close> \<open>ek = (\<lambda>s. s Exception = None)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Return) ek (C, M, \<lfloor>Suc pc\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Normal)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Return_Check_Exceptional C P C0 Main M pc M' n Exc pc' diff ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, nodeType.Return)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nodeType.Return)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     \<open>match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = \<lfloor>(pc', diff)\<rfloor>\<close>
     \<open>pc' \<noteq> length (instrs_of (PROG P) C M)\<close>
     \<open>ek = (\<lambda>s. \<exists>v d. s Exception = \<lfloor>v\<rfloor> \<and>
              match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
               (ex_table_of (PROG P) C M) = \<lfloor>(pc', d)\<rfloor>)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Return) ek (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Exceptional)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> nodeType.Return)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> nodeType.Return)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     \<open>ek = \<Up>\<lambda>s. s(Exception := None, Stack (stkLength (P, C, M) pc' - 1) := s Exception)\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Exceptional \<lfloor>pc'\<rfloor> Return) ek (C, M, \<lfloor>pc'\<rfloor>, Enter)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_handle)
   ultimately show ?case by blast
 next
   case (CFG_Invoke_Return_Exceptional_prop C P C0 Main M pc M' n ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, nodeType.Return)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, nodeType.Return)\<close>
     \<open>instrs_of (PROG P) C M ! pc = Invoke M' n\<close>
     \<open>ek = (\<lambda>s. \<exists>v. s Exception = \<lfloor>v\<rfloor> \<and>
            match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
             (ex_table_of (PROG P) C M) = None)\<^sub>\<surd>\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Return) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_prop)
   ultimately show ?case by blast
 next
   case (CFG_Return C P C0 Main M pc ek)
   then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
     (ClassMain P, MethodMain P, None, Enter) as (C, M, \<lfloor>pc\<rfloor>, Enter)"
     by blast
   moreover with \<open>C \<noteq> ClassMain P\<close> \<open>(P, C0, Main) \<turnstile> \<Rightarrow>(C, M, \<lfloor>pc\<rfloor>, Enter)\<close>
     \<open>instrs_of (PROG P) C M ! pc = instr.Return\<close>
     \<open>ek = \<Up>\<lambda>s. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1)))\<close>
   have "vp_snoc P C0 Main as (C, M, \<lfloor>pc\<rfloor>, Enter) ek (C, M, None, Return)"
     by (fastforce intro: JVMCFG_reachable.CFG_Return)
   ultimately show ?case by blast
 next
   case (CFG_Return_from_Method P C0 Main C M C' M' pc' Q' ps Q stateUpdate ek)
   from \<open>(P, C0, Main) \<turnstile> (C', M', \<lfloor>pc'\<rfloor>, Normal) -Q':(C', M', pc')\<hookrightarrow>\<^bsub>(C, M)\<^esub>ps\<rightarrow> (C, M, None, Enter)\<close>
   show ?case
   proof cases
     case Main_Call
     with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
       (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
       by blast
     moreover with Main_Call have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)
       (\<lambda>s. False)\<^sub>\<surd> (ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"
       by (fastforce intro: Main_Call_LFalse)
     ultimately show ?thesis using Main_Call CFG_Return_from_Method by blast
   next
     case CFG_Invoke_Call
     with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
       (ClassMain P, MethodMain P, None, Enter) as (C', M', \<lfloor>pc'\<rfloor>, Normal)"
       by blast
     moreover with CFG_Invoke_Call
     have "vp_snoc P C0 Main as (C', M', \<lfloor>pc'\<rfloor>, Normal) (\<lambda>s. False)\<^sub>\<surd> (C', M', \<lfloor>pc'\<rfloor>, Return)"
       by (fastforce intro: CFG_Invoke_False)
     ultimately show ?thesis using CFG_Invoke_Call CFG_Return_from_Method by blast
   qed
 qed
 
 declare JVMCFG_Interpret.vp_snocI []
 declare JVMCFG_Interpret.valid_node_def [simp del]
   valid_edge_def [simp del]
   JVMCFG_Interpret.intra_path_def [simp del]
 
 
 definition EP :: jvm_prog
   where "EP = (''C'', Object, [],
   [(''M'', [], Void, 1::nat, 0::nat, [Push Unit, instr.Return], [])]) # SystemClasses"
 
 definition Phi_EP :: ty\<^sub>P
   where "Phi_EP C M = (if C = ''C'' \<and> M = ''M''
       then [\<lfloor>([],[OK (Class ''C'')])\<rfloor>,\<lfloor>([Void],[OK (Class ''C'')])\<rfloor>] else [])"
 
 lemma distinct_classes'':
   "''C'' \<noteq> Object"
   "''C'' \<noteq> NullPointer"
   "''C'' \<noteq> OutOfMemory"
   "''C'' \<noteq> ClassCast"
   by (simp_all add: Object_def NullPointer_def OutOfMemory_def ClassCast_def)
 
 lemmas distinct_classes =
   distinct_classes distinct_classes'' distinct_classes'' [symmetric]
   
 declare distinct_classes [simp add]
 
 lemma i_max_2D: "i < Suc (Suc 0) \<Longrightarrow> i = 0 \<or> i = 1" by auto
 
 lemma EP_wf: "wf_jvm_prog\<^bsub>Phi_EP\<^esub> EP"
   unfolding wf_jvm_prog_phi_def wf_prog_def
 proof
   show "wf_syscls EP"
     by (simp add: EP_def wf_syscls_def SystemClasses_def sys_xcpts_def
       ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
 next
   have distinct_EP: "distinct_fst EP"
     by (auto simp: EP_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def
       ClassCastC_def)
   moreover have classes_wf:
     "\<forall>c\<in>set EP. wf_cdecl
     (\<lambda>P C (M, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt). wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt (Phi_EP C M)) EP c"
   proof
     fix C
     assume C_in_EP: "C \<in> set EP"
     show "wf_cdecl
       (\<lambda>P C (M, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt). wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt (Phi_EP C M)) EP C"
     proof (cases "C \<in> set SystemClasses")
       case True
       thus ?thesis
         by (auto simp: wf_cdecl_def SystemClasses_def ObjectC_def NullPointerC_def
           OutOfMemoryC_def ClassCastC_def EP_def class_def)
     next
       case False
       with C_in_EP have "C = (''C'', the (class EP ''C''))"
         by (auto simp: EP_def SystemClasses_def class_def)
       thus ?thesis
         by (auto dest!: i_max_2D elim: Methods.cases
           simp: wf_cdecl_def class_def EP_def wf_mdecl_def wt_method_def Phi_EP_def
           wt_start_def check_types_def states_def JVM_SemiType.sl_def SystemClasses_def
           stk_esl_def upto_esl_def loc_sl_def SemiType.esl_def ObjectC_def
           SemiType.sup_def Err.sl_def Err.le_def err_def Listn.sl_def Method_def
           Err.esl_def Opt.esl_def Product.esl_def relevant_entries_def)
     qed
   qed
   ultimately show "(\<forall>c\<in>set EP. wf_cdecl
     (\<lambda>P C (M, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt). wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt (Phi_EP C M)) EP c) \<and>
     distinct_fst EP"
     by simp
 qed
 
 lemma [simp]: "PROG (Abs_wf_jvmprog (EP, Phi_EP)) = EP"
 proof (cases "(EP, Phi_EP) \<in> wf_jvmprog")
   case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
 next
   case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
 qed
 
 lemma [simp]: "TYPING (Abs_wf_jvmprog (EP, Phi_EP)) = Phi_EP"
 proof (cases "(EP, Phi_EP) \<in> wf_jvmprog")
   case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
 next
   case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
 qed
 
 lemma method_in_EP_is_M:
   "EP \<turnstile> C sees M: Ts\<rightarrow>T = (mxs, mxl, is, xt) in D
   \<Longrightarrow> C = ''C'' \<and> M = ''M'' \<and> Ts = [] \<and> T = Void \<and> mxs = 1 \<and> mxl = 0 \<and>
   is = [Push Unit, instr.Return] \<and> xt = [] \<and> D = ''C''"
   by (fastforce elim: Methods.cases 
     simp: class_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def
     if_split_eq1 EP_def Method_def)
 
 lemma [simp]:
   "\<exists>T Ts mxs mxl is. (\<exists>xt. EP \<turnstile> ''C'' sees ''M'': Ts\<rightarrow>T = (mxs, mxl, is, xt) in ''C'') \<and> is \<noteq> []"
   using EP_wf
   by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
 
 lemma [simp]:
   "\<exists>T Ts mxs mxl is. (\<exists>xt. EP \<turnstile> ''C'' sees ''M'': Ts\<rightarrow>T = (mxs, mxl, is, xt) in ''C'') \<and> 
   Suc 0 < length is"
   using EP_wf
   by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
 
 lemma C_sees_M_in_EP [simp]:
   "EP \<turnstile> ''C'' sees ''M'': []\<rightarrow>Void = (Suc 0, 0, [Push Unit, instr.Return], []) in ''C''"
 proof -
   have "EP \<turnstile> ''C'' sees_methods [''M'' \<mapsto> (([], Void, 1, 0, [Push Unit, instr.Return], []), ''C'')]"
     by (fastforce intro: Methods.intros simp: class_def SystemClasses_def ObjectC_def EP_def)
   thus ?thesis by (fastforce simp: Method_def)
 qed
 
 lemma instrs_of_EP_C_M [simp]:
   "instrs_of EP ''C'' ''M'' = [Push Unit, instr.Return]"
   unfolding method_def
   by (rule theI2 [where P = "\<lambda>(D, Ts, T, m). EP \<turnstile> ''C'' sees ''M'': Ts\<rightarrow>T = m in D"])
 (auto dest: method_in_EP_is_M)
 
 lemma ClassMain_not_C [simp]: "ClassMain (Abs_wf_jvmprog (EP, Phi_EP)) \<noteq> ''C''"
   by (fastforce intro: no_Call_in_ClassMain [where P="Abs_wf_jvmprog (EP, Phi_EP)"] C_sees_M_in_EP)
 
 lemma method_entry [dest!]: "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') \<turnstile> \<Rightarrow>(C, M, None, Enter)
   \<Longrightarrow> (C = ClassMain (Abs_wf_jvmprog (EP, Phi_EP)) \<and> M = MethodMain (Abs_wf_jvmprog (EP, Phi_EP)))
   \<or> (C = ''C'' \<and> M = ''M'')"
   by (fastforce elim: reachable.cases elim!: JVMCFG.cases dest!: method_in_EP_is_M)
 
 lemma valid_node_in_EP_D:
   assumes vn: "JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M'' n"
   shows "n \<in> {
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter),
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Return),
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), \<lfloor>0\<rfloor>, Enter),
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), \<lfloor>0\<rfloor>, Normal),
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), \<lfloor>0\<rfloor>, Return),
   (''C'', ''M'', None, Enter),
   (''C'', ''M'', \<lfloor>0\<rfloor>, Enter),
   (''C'', ''M'', \<lfloor>1\<rfloor>, Enter),
   (''C'', ''M'', None, Return)
   }"
   using vn
 proof (cases rule: JVMCFG_Interpret.valid_node_cases')
   let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
   case (Source e)
   then obtain C M pc nt ek C' M' pc' nt'
     where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
     and [simp]: "n = (C, M, pc, nt)"
     and edge: "(?prog, ''C'', ''M'') \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')"
     by (cases e) (fastforce simp: valid_edge_def)
   from edge have src_reachable: "(?prog, ''C'', ''M'') \<turnstile> \<Rightarrow>(C, M, pc, nt)"
     by -(drule sourcenode_reachable)
   show ?thesis
   proof (cases "C = ClassMain ?prog")
     case True
     with src_reachable have "M = MethodMain ?prog"
       by (fastforce dest: ClassMain_imp_MethodMain)
     with True edge show ?thesis
       by clarsimp (erule JVMCFG.cases, simp_all)
   next
     case False
     with src_reachable obtain T Ts mb where "EP \<turnstile> C sees M:Ts\<rightarrow>T = mb in C"
       by (fastforce dest: method_of_reachable_node_exists)
     hence [simp]: "C = ''C''"
       and [simp]: "M = ''M''"
       and [simp]: "Ts = []"
       and [simp]: "T = Void"
       and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
       by (cases mb, fastforce dest: method_in_EP_is_M)+
     from src_reachable False have "pc \<in> {None, \<lfloor>0\<rfloor>, \<lfloor>1\<rfloor>}"
       by (fastforce dest: instr_of_reachable_node_typable)
     show ?thesis
     proof (cases pc)
       case None
       with edge False show ?thesis
         by clarsimp (erule JVMCFG.cases, simp_all)
     next
       case (Some pc')
       show ?thesis
       proof (cases pc')
         case 0
         with Some False edge show ?thesis
           by clarsimp (erule JVMCFG.cases, fastforce+)
       next
         case (Suc n)
         with \<open>pc \<in> {None, \<lfloor>0\<rfloor>, \<lfloor>1\<rfloor>}\<close> Some have "pc = \<lfloor>1\<rfloor>"
           by simp
         with False edge show ?thesis
           by clarsimp (erule JVMCFG.cases, fastforce+)
       qed
     qed
   qed
 next
   let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
   case (Target e)
   then obtain C M pc nt ek C' M' pc' nt'
     where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
     and [simp]: "n = (C', M', pc', nt')"
     and edge: "(?prog, ''C'', ''M'') \<turnstile> (C, M, pc, nt) -ek\<rightarrow> (C', M', pc', nt')"
     by (cases e) (fastforce simp: valid_edge_def)
   from edge have trg_reachable: "(?prog, ''C'', ''M'') \<turnstile> \<Rightarrow>(C', M', pc', nt')"
     by -(drule targetnode_reachable)
   show ?thesis
   proof (cases "C' = ClassMain ?prog")
     case True
     with trg_reachable have "M' = MethodMain ?prog"
       by (fastforce dest: ClassMain_imp_MethodMain)
     with True edge show ?thesis
       by -(clarsimp, (erule JVMCFG.cases, simp_all))+
   next
     case False
     with trg_reachable obtain T Ts mb where "EP \<turnstile> C' sees M':Ts\<rightarrow>T = mb in C'"
       by (fastforce dest: method_of_reachable_node_exists)
     hence [simp]: "C' = ''C''"
       and [simp]: "M' = ''M''"
       and [simp]: "Ts = []"
       and [simp]: "T = Void"
       and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
       by (cases mb, fastforce dest: method_in_EP_is_M)+
     from trg_reachable False have "pc' \<in> {None, \<lfloor>0\<rfloor>, \<lfloor>1\<rfloor>}"
       by (fastforce dest: instr_of_reachable_node_typable)
     show ?thesis
     proof (cases pc')
       case None
       with edge False show ?thesis
         by clarsimp (erule JVMCFG.cases, simp_all)
     next
       case (Some pc'')
       show ?thesis
       proof (cases pc'')
         case 0
         with Some False edge show ?thesis
           by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
       next
         case (Suc n)
         with \<open>pc' \<in> {None, \<lfloor>0\<rfloor>, \<lfloor>1\<rfloor>}\<close> Some have "pc' = \<lfloor>1\<rfloor>"
           by simp
         with False edge show ?thesis
           by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
       qed
     qed
   qed
 qed
 
 lemma Main_Entry_valid [simp]:
   "JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M''
   (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter)"
 proof -
   have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
     ((ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
       Enter),
     (\<lambda>s. False)\<^sub>\<surd>,
     (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
       Return))"
     by (auto simp: valid_edge_def intro: JVMCFG_reachable.intros)
   thus ?thesis by (fastforce simp: JVMCFG_Interpret.valid_node_def)
 qed
 
 lemma main_0_Enter_reachable [simp]: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)"
   by (rule reachable_step [where n="(ClassMain P, MethodMain P, None, Enter)"])
 (fastforce intro: JVMCFG_reachable.intros)+
 
 lemma main_0_Normal_reachable [simp]: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"
   by (rule reachable_step [where n="(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Enter)"], simp)
 (fastforce intro: JVMCFG_reachable.intros)
 
 lemma main_0_Return_reachable [simp]: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"
   by (rule reachable_step [where n="(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Normal)"], simp)
 (fastforce intro: JVMCFG_reachable.intros)
 
 lemma Exit_reachable [simp]: "(P, C0, Main) \<turnstile> \<Rightarrow>(ClassMain P, MethodMain P, None, Return)"
   by (rule reachable_step [where n="(ClassMain P, MethodMain P, \<lfloor>0\<rfloor>, Return)"], simp)
 (fastforce intro: JVMCFG_reachable.intros)
 
 definition
   "cfg_wf_prog =
     {(P, C0, Main). (\<forall>n. JVMCFG_Interpret.valid_node P C0 Main n \<longrightarrow>
          (\<exists>as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
                          (get_return_edges P) n as (ClassMain P, MethodMain P, None, Return)))}"
 
 typedef cfg_wf_prog = cfg_wf_prog
   unfolding cfg_wf_prog_def
 proof
   let ?prog = "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')"
   let ?edge_main0 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
     (\<lambda>s. False)\<^sub>\<surd>,
     (ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
   let ?edge_main1 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
     (\<lambda>s. True)\<^sub>\<surd>,
     (ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Enter))"
   let ?edge_main2 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Enter),
     \<Up>id,
     (ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Normal))"
   let ?edge_main3 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Normal),
     (\<lambda>s. False)\<^sub>\<surd>,
     (ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Return))"
   let ?edge_main4 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Return),
     \<Up>id,
     (ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
   let ?edge_call = "((ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Normal),
     ((\<lambda>(s, ret). True):(ClassMain (fst ?prog),
       MethodMain (fst ?prog), 0)\<hookrightarrow>\<^bsub>(''C'', ''M'')\<^esub>[(\<lambda>s. s Heap),(\<lambda>s. \<lfloor>Value Null\<rfloor>)]),
     (''C'', ''M'', None, Enter))"
   let ?edge_C0 = "((''C'', ''M'', None, Enter),
     (\<lambda>s. False)\<^sub>\<surd>,
     (''C'', ''M'', None, Return))"
   let ?edge_C1 = "((''C'', ''M'', None, Enter),
     (\<lambda>s. True)\<^sub>\<surd>,
     (''C'', ''M'', \<lfloor>0\<rfloor>, Enter))"
   let ?edge_C2 = "((''C'', ''M'', \<lfloor>0\<rfloor>, Enter),
     \<Up>(\<lambda>s. s(Stack 0 \<mapsto> Value Unit)),
     (''C'', ''M'', \<lfloor>1\<rfloor>, Enter))"
   let ?edge_C3 = "((''C'', ''M'', \<lfloor>1\<rfloor>, Enter),
     \<Up>(\<lambda>s. s(Stack 0 := s (Stack 0))),
     (''C'', ''M'', None, Return))"
   let ?edge_return = "((''C'', ''M'', None, Return),
     (\<lambda>(s, ret). ret = (ClassMain (fst ?prog),
       MethodMain (fst ?prog), 0))\<hookleftarrow>\<^bsub>(''C'',''M'')\<^esub>(\<lambda>s s'. s'(Heap := s Heap,
                             Exception := s Exception,
                             Stack 0 := s (Stack 0))),
     (ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Return))"
   have [simp]:
     "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') \<turnstile> \<Rightarrow>(''C'', ''M'', None, Enter)"
     by (rule reachable_step [where n="(ClassMain (fst ?prog), MethodMain (fst ?prog), \<lfloor>0\<rfloor>, Normal)"]
       , simp)
   (fastforce intro: Main_Call C_sees_M_in_EP)
   hence [simp]:
     "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') \<turnstile> \<Rightarrow>(''C'', ''M'', None, nodeType.Return)"
     by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"])
   (fastforce intro: JVMCFG_reachable.intros)
   have [simp]:
     "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') \<turnstile> \<Rightarrow>(''C'', ''M'', \<lfloor>0\<rfloor>, Enter)"
     by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"], simp)
   (fastforce intro: JVMCFG_reachable.intros)
   hence [simp]:
     "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') \<turnstile> \<Rightarrow>(''C'', ''M'', \<lfloor>Suc 0\<rfloor>, Enter)"
     by (fastforce intro: reachable_step [where n="(''C'', ''M'', \<lfloor>0\<rfloor>, Enter)"] CFG_Push
       simp: ClassMain_not_C [symmetric])
   show "?prog \<in> {(P, C0, Main).
           \<forall>n. CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n \<longrightarrow>
               (\<exists>as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
                      (get_return_edges P) n as
                      (ClassMain P, MethodMain P, None, nodeType.Return))}"
   proof (auto dest!: valid_node_in_EP_D)
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, Enter)
           [?edge_main0]
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
         simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
     thus " \<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, Enter)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)
       [] (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_Interpret.intra_path_vp simp: JVMCFG_Interpret.intra_path_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, Enter)
       [?edge_main2, ?edge_main3, ?edge_main4]
       (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
         simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, Enter)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, Normal)
       [?edge_main3, ?edge_main4]
       (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
         simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, Normal)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, nodeType.Return)
       [?edge_main4]
       (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
         simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            \<lfloor>0\<rfloor>, nodeType.Return)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter)
       [?edge_C0, ?edge_return, ?edge_main4]
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
         simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def JVMCFG_Interpret.valid_path_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter) as
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', \<lfloor>0\<rfloor>, Enter)
       [?edge_C2, ?edge_C3, ?edge_return, ?edge_main4]
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by (fastforce intro: Main_Return_to_Exit CFG_Return_from_Method Main_Call
         C_sees_M_in_EP CFG_Return CFG_Push
         simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
         ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', \<lfloor>0\<rfloor>, Enter) as
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', \<lfloor>Suc 0\<rfloor>, Enter)
       [?edge_C3, ?edge_return, ?edge_main4]
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
         simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
         ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', \<lfloor>Suc 0\<rfloor>, Enter) as
           (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
            None, nodeType.Return)"
       by blast
   next
     have "CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
           [?edge_return, ?edge_main4]
       (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
         simp: JVMCFG_Interpret.vp_def valid_edge_def JVMCFG_Interpret.valid_path_def stkLength_def)
     thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
           (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
           (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
           as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
               None, nodeType.Return)"
       by blast
   qed
 qed
 
 
 abbreviation lift_to_cfg_wf_prog :: "(jvm_method \<Rightarrow> 'a) \<Rightarrow> (cfg_wf_prog \<Rightarrow> 'a)"
   ("_\<^bsub>CFG\<^esub>")
   where "f\<^bsub>CFG\<^esub> \<equiv> (\<lambda>P. f (Rep_cfg_wf_prog P))"
 
 lemma valid_edge_CFG_def: "valid_edge\<^bsub>CFG\<^esub> P = valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P))"
   by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)
 
 interpretation JVMCFG_Postdomination:
   Postdomination "sourcenode" "targetnode" "kind" "valid_edge\<^bsub>CFG\<^esub> P"
   "(ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, Enter)"
   "(\<lambda>(C, M, pc, type). (C, M))" "get_return_edges (fst\<^bsub>CFG\<^esub> P)"
   "((ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P)),[],[]) # procs (PROG (fst\<^bsub>CFG\<^esub> P))"
   "(ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P))"
   "(ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, Return)"
   for P
   unfolding valid_edge_CFG_def
 proof
   fix n
   obtain P' C0 Main where [simp]: "fst\<^bsub>CFG\<^esub> P = P'" and [simp]: "fst (snd\<^bsub>CFG\<^esub> P) = C0"
     and [simp]: "snd (snd\<^bsub>CFG\<^esub> P) = Main"
     by (cases P) clarsimp
   assume "CFG.valid_node sourcenode targetnode
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P))) n"
   thus "\<exists>as. CFG.valid_path' sourcenode targetnode kind
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P)))
     (get_return_edges (fst\<^bsub>CFG\<^esub> P))
     (ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, Enter) as n"
     by (auto dest: sourcenode_reachable targetnode_reachable valid_Entry_path
       simp: JVMCFG_Interpret.valid_node_def valid_edge_def)
 next
   fix n
   obtain P' C0 Main where [simp]: "fst\<^bsub>CFG\<^esub> P = P'" and [simp]: "fst (snd\<^bsub>CFG\<^esub> P) = C0"
     and [simp]: "snd (snd\<^bsub>CFG\<^esub> P) = Main"
     and "(P', C0, Main) \<in> cfg_wf_prog"
     by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)
   assume "CFG.valid_node sourcenode targetnode
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P))) n"
   with \<open>(P', C0, Main) \<in> cfg_wf_prog\<close>
   show "\<exists>as. CFG.valid_path' sourcenode targetnode kind
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P)))
     (get_return_edges (fst\<^bsub>CFG\<^esub> P)) n as
     (ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, nodeType.Return)"
     by (cases n) (fastforce simp: cfg_wf_prog_def)
 next
   fix n n'
   obtain P' C0 Main where [simp]: "fst\<^bsub>CFG\<^esub> P = P'" and [simp]: "fst (snd\<^bsub>CFG\<^esub> P) = C0"
     and [simp]: "snd (snd\<^bsub>CFG\<^esub> P) = Main"
     by (cases P) clarsimp
   assume "CFGExit.method_exit sourcenode kind
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P)))
     (ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, nodeType.Return) n"
     and "CFGExit.method_exit sourcenode kind
     (valid_edge (fst\<^bsub>CFG\<^esub> P, fst (snd\<^bsub>CFG\<^esub> P), snd (snd\<^bsub>CFG\<^esub> P)))
     (ClassMain (fst\<^bsub>CFG\<^esub> P), MethodMain (fst\<^bsub>CFG\<^esub> P), None, nodeType.Return) n'"
     and "(\<lambda>(C, M, pc, type). (C, M)) n = (\<lambda>(C, M, pc, type). (C, M)) n'"
   thus "n = n'"
     by (auto simp: JVMCFG_Exit_Interpret.method_exit_def valid_edge_def)
   (fastforce elim: JVMCFG.cases)+
 qed
 
 end
diff --git a/thys/MFODL_Monitor_Optimized/Monitor.thy b/thys/MFODL_Monitor_Optimized/Monitor.thy
--- a/thys/MFODL_Monitor_Optimized/Monitor.thy
+++ b/thys/MFODL_Monitor_Optimized/Monitor.thy
@@ -1,5600 +1,5600 @@
 (*<*)
 theory Monitor
   imports
     Formula
     Optimized_Join
     "MFOTL_Monitor.Abstract_Monitor"
     "HOL-Library.While_Combinator"
     "HOL-Library.Mapping"
     "Deriving.Derive"
     "Generic_Join.Generic_Join_Correctness"
 begin
 (*>*)
 
 section \<open>Generic monitoring algorithm\<close>
 
 text \<open>The algorithm defined here abstracts over the implementation of the temporal operators.\<close>
 
 subsection \<open>Monitorable formulas\<close>
 
 definition "mmonitorable \<phi> \<longleftrightarrow> safe_formula \<phi> \<and> Formula.future_bounded \<phi>"
 definition "mmonitorable_regex b g r \<longleftrightarrow> safe_regex b g r \<and> Regex.pred_regex Formula.future_bounded r"
 
 definition is_simple_eq :: "Formula.trm \<Rightarrow> Formula.trm \<Rightarrow> bool" where
   "is_simple_eq t1 t2 = (Formula.is_Const t1 \<and> (Formula.is_Const t2 \<or> Formula.is_Var t2) \<or>
     Formula.is_Var t1 \<and> Formula.is_Const t2)"
 
 fun mmonitorable_exec :: "Formula.formula \<Rightarrow> bool" where
   "mmonitorable_exec (Formula.Eq t1 t2) = is_simple_eq t1 t2"
 | "mmonitorable_exec (Formula.Neg (Formula.Eq (Formula.Var x) (Formula.Var y))) = (x = y)"
 | "mmonitorable_exec (Formula.Pred e ts) = list_all (\<lambda>t. Formula.is_Var t \<or> Formula.is_Const t) ts"
 | "mmonitorable_exec (Formula.Let p \<phi> \<psi>) = ({0..<Formula.nfv \<phi>} \<subseteq> Formula.fv \<phi> \<and> mmonitorable_exec \<phi> \<and> mmonitorable_exec \<psi>)"
 | "mmonitorable_exec (Formula.Neg \<phi>) = (fv \<phi> = {} \<and> mmonitorable_exec \<phi>)"
 | "mmonitorable_exec (Formula.Or \<phi> \<psi>) = (fv \<phi> = fv \<psi> \<and> mmonitorable_exec \<phi> \<and> mmonitorable_exec \<psi>)"
 | "mmonitorable_exec (Formula.And \<phi> \<psi>) = (mmonitorable_exec \<phi> \<and>
     (safe_assignment (fv \<phi>) \<psi> \<or> mmonitorable_exec \<psi> \<or>
       fv \<psi> \<subseteq> fv \<phi> \<and> (is_constraint \<psi> \<or> (case \<psi> of Formula.Neg \<psi>' \<Rightarrow> mmonitorable_exec \<psi>' | _ \<Rightarrow> False))))"
 | "mmonitorable_exec (Formula.Ands l) = (let (pos, neg) = partition mmonitorable_exec l in
     pos \<noteq> [] \<and> list_all mmonitorable_exec (map remove_neg neg) \<and>
     \<Union>(set (map fv neg)) \<subseteq> \<Union>(set (map fv pos)))"
 | "mmonitorable_exec (Formula.Exists \<phi>) = (mmonitorable_exec \<phi>)"
 | "mmonitorable_exec (Formula.Agg y \<omega> b f \<phi>) = (mmonitorable_exec \<phi> \<and>
     y + b \<notin> Formula.fv \<phi> \<and> {0..<b} \<subseteq> Formula.fv \<phi> \<and> Formula.fv_trm f \<subseteq> Formula.fv \<phi>)"
 | "mmonitorable_exec (Formula.Prev I \<phi>) = (mmonitorable_exec \<phi>)"
 | "mmonitorable_exec (Formula.Next I \<phi>) = (mmonitorable_exec \<phi>)"
 | "mmonitorable_exec (Formula.Since \<phi> I \<psi>) = (Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and>
     (mmonitorable_exec \<phi> \<or> (case \<phi> of Formula.Neg \<phi>' \<Rightarrow> mmonitorable_exec \<phi>' | _ \<Rightarrow> False)) \<and> mmonitorable_exec \<psi>)"
 | "mmonitorable_exec (Formula.Until \<phi> I \<psi>) = (Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and> right I \<noteq> \<infinity> \<and>
     (mmonitorable_exec \<phi> \<or> (case \<phi> of Formula.Neg \<phi>' \<Rightarrow> mmonitorable_exec \<phi>' | _ \<Rightarrow> False)) \<and> mmonitorable_exec \<psi>)"
 | "mmonitorable_exec (Formula.MatchP I r) = Regex.safe_regex Formula.fv (\<lambda>g \<phi>. mmonitorable_exec \<phi> \<or> (g = Lax \<and> (case \<phi> of Formula.Neg \<phi>' \<Rightarrow> mmonitorable_exec \<phi>' | _ \<Rightarrow> False))) Past Strict r"
 | "mmonitorable_exec (Formula.MatchF I r) = (Regex.safe_regex Formula.fv (\<lambda>g \<phi>. mmonitorable_exec \<phi> \<or> (g = Lax \<and> (case \<phi> of Formula.Neg \<phi>' \<Rightarrow> mmonitorable_exec \<phi>' | _ \<Rightarrow> False))) Futu Strict r \<and> right I \<noteq> \<infinity>)"
 | "mmonitorable_exec _ = False"
 
 lemma cases_Neg_iff:
   "(case \<phi> of formula.Neg \<psi> \<Rightarrow> P \<psi> | _ \<Rightarrow> False) \<longleftrightarrow> (\<exists>\<psi>. \<phi> = formula.Neg \<psi> \<and> P \<psi>)"
   by (cases \<phi>) auto
 
 lemma safe_formula_mmonitorable_exec: "safe_formula \<phi> \<Longrightarrow> Formula.future_bounded \<phi> \<Longrightarrow> mmonitorable_exec \<phi>"
 proof (induct \<phi> rule: safe_formula.induct)
   case (8 \<phi> \<psi>)
   then show ?case
     unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
     by (auto simp: cases_Neg_iff)
 next
   case (9 \<phi> \<psi>)
   then show ?case
     unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
     by (auto simp: cases_Neg_iff)
 next
   case (10 l)
   from "10.prems"(2) have bounded: "Formula.future_bounded \<phi>" if "\<phi> \<in> set l" for \<phi>
     using that by (auto simp: list.pred_set)
   obtain poss negs where posnegs: "(poss, negs) = partition safe_formula l" by simp
   obtain posm negm where posnegm: "(posm, negm) = partition mmonitorable_exec l" by simp
   have "set poss \<subseteq> set posm"
   proof (rule subsetI)
     fix x assume "x \<in> set poss"
     then have "x \<in> set l" "safe_formula x" using posnegs by simp_all
     then have "mmonitorable_exec x" using "10.hyps"(1) bounded by blast
     then show "x \<in> set posm" using \<open>x \<in> set poss\<close> posnegm posnegs by simp
   qed
   then have "set negm \<subseteq> set negs" using posnegm posnegs by auto
   obtain "poss \<noteq> []" "list_all safe_formula (map remove_neg negs)"
     "(\<Union>x\<in>set negs. fv x) \<subseteq> (\<Union>x\<in>set poss. fv x)"
     using "10.prems"(1) posnegs by simp
   then have "posm \<noteq> []" using \<open>set poss \<subseteq> set posm\<close> by auto
   moreover have "list_all mmonitorable_exec (map remove_neg negm)"
   proof -
     let ?l = "map remove_neg negm"
     have "\<And>x. x \<in> set ?l \<Longrightarrow> mmonitorable_exec x"
     proof -
       fix x assume "x \<in> set ?l"
       then obtain y where "y \<in> set negm" "x = remove_neg y" by auto
       then have "y \<in> set negs" using \<open>set negm \<subseteq> set negs\<close> by blast
       then have "safe_formula x"
         unfolding \<open>x = remove_neg y\<close> using \<open>list_all safe_formula (map remove_neg negs)\<close>
         by (simp add: list_all_def)
       show "mmonitorable_exec x"
       proof (cases "\<exists>z. y = Formula.Neg z")
         case True
         then obtain z where "y = Formula.Neg z" by blast
         then show ?thesis
           using "10.hyps"(2)[OF posnegs refl] \<open>x = remove_neg y\<close> \<open>y \<in> set negs\<close> posnegs bounded
             \<open>safe_formula x\<close> by fastforce
       next
         case False
         then have "remove_neg y = y" by (cases y) simp_all
         then have "y = x" unfolding \<open>x = remove_neg y\<close> by simp
         show ?thesis
           using "10.hyps"(1) \<open>y \<in> set negs\<close> posnegs \<open>safe_formula x\<close> unfolding \<open>y = x\<close>
           by auto
       qed
     qed
     then show ?thesis by (simp add: list_all_iff)
   qed
   moreover have "(\<Union>x\<in>set negm. fv x) \<subseteq> (\<Union>x\<in>set posm. fv x)"
     using \<open>\<Union> (fv ` set negs) \<subseteq> \<Union> (fv ` set poss)\<close> \<open>set poss \<subseteq> set posm\<close> \<open>set negm \<subseteq> set negs\<close>
     by fastforce
   ultimately show ?case using posnegm by simp
 next
   case (15 \<phi> I \<psi>)
   then show ?case
     unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
     by (auto simp: cases_Neg_iff)
 next
   case (16 \<phi> I \<psi>)
   then show ?case
     unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
     by (auto simp: cases_Neg_iff)
 next
   case (17 I r)
   then show ?case
     by (auto elim!: safe_regex_mono[rotated] simp: cases_Neg_iff regex.pred_set)
 next
   case (18 I r)
   then show ?case
     by (auto elim!: safe_regex_mono[rotated] simp: cases_Neg_iff regex.pred_set)
 qed (auto simp add: is_simple_eq_def list.pred_set)
 
 lemma safe_assignment_future_bounded: "safe_assignment X \<phi> \<Longrightarrow> Formula.future_bounded \<phi>"
   unfolding safe_assignment_def by (auto split: formula.splits)
 
 lemma is_constraint_future_bounded: "is_constraint \<phi> \<Longrightarrow> Formula.future_bounded \<phi>"
   by (induction rule: is_constraint.induct) simp_all
 
 lemma mmonitorable_exec_mmonitorable: "mmonitorable_exec \<phi> \<Longrightarrow> mmonitorable \<phi>"
 proof (induct \<phi> rule: mmonitorable_exec.induct)
   case (7 \<phi> \<psi>)
   then show ?case
     unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
     by (auto simp: cases_Neg_iff intro: safe_assignment_future_bounded is_constraint_future_bounded)
 next
   case (8 l)
   obtain poss negs where posnegs: "(poss, negs) = partition safe_formula l" by simp
   obtain posm negm where posnegm: "(posm, negm) = partition mmonitorable_exec l" by simp
   have pos_monitorable: "list_all mmonitorable_exec posm" using posnegm by (simp add: list_all_iff)
   have neg_monitorable: "list_all mmonitorable_exec (map remove_neg negm)"
     using "8.prems" posnegm by (simp add: list_all_iff)
   have "set posm \<subseteq> set poss"
     using "8.hyps"(1) posnegs posnegm unfolding mmonitorable_def by auto
   then have "set negs \<subseteq> set negm"
     using posnegs posnegm by auto
 
   have "poss \<noteq> []" using "8.prems" posnegm \<open>set posm \<subseteq> set poss\<close> by auto
   moreover have "list_all safe_formula (map remove_neg negs)"
     using neg_monitorable "8.hyps"(2)[OF posnegm refl] \<open>set negs \<subseteq> set negm\<close>
     unfolding mmonitorable_def by (auto simp: list_all_iff)
   moreover have "\<Union> (fv ` set negm) \<subseteq> \<Union> (fv ` set posm)"
     using "8.prems" posnegm by simp
   then have "\<Union> (fv ` set negs) \<subseteq> \<Union> (fv ` set poss)"
     using \<open>set posm \<subseteq> set poss\<close> \<open>set negs \<subseteq> set negm\<close> by fastforce
   ultimately have "safe_formula (Formula.Ands l)" using posnegs by simp
   moreover have "Formula.future_bounded (Formula.Ands l)"
   proof -
     have "list_all Formula.future_bounded posm"
       using pos_monitorable "8.hyps"(1) posnegm unfolding mmonitorable_def
       by (auto elim!: list.pred_mono_strong)
     moreover have fnegm: "list_all Formula.future_bounded (map remove_neg negm)"
       using neg_monitorable "8.hyps"(2) posnegm unfolding mmonitorable_def
       by (auto elim!: list.pred_mono_strong)
     then have "list_all Formula.future_bounded negm"
     proof -
       have "\<And>x. x \<in> set negm \<Longrightarrow> Formula.future_bounded x"
       proof -
         fix x assume "x \<in> set negm"
         have "Formula.future_bounded (remove_neg x)" using fnegm \<open>x \<in> set negm\<close> by (simp add: list_all_iff)
         then show "Formula.future_bounded x" by (cases x) auto
       qed
       then show ?thesis by (simp add: list_all_iff)
     qed
     ultimately have "list_all Formula.future_bounded l" using posnegm by (auto simp: list_all_iff)
     then show ?thesis by (auto simp: list_all_iff)
   qed
   ultimately show ?case unfolding mmonitorable_def ..
 next
   case (13 \<phi> I \<psi>)
   then show ?case
     unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
     by (fastforce simp: cases_Neg_iff)
 next
   case (14 \<phi> I \<psi>)
   then show ?case
     unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
     by (fastforce simp: one_enat_def cases_Neg_iff)
 next
   case (15 I r)
   then show ?case
     by (auto elim!: safe_regex_mono[rotated] dest: safe_regex_safe[rotated]
         simp: mmonitorable_regex_def mmonitorable_def cases_Neg_iff regex.pred_set)
 next
   case (16 I r)
   then show ?case
     by (auto 0 3 elim!: safe_regex_mono[rotated] dest: safe_regex_safe[rotated]
         simp: mmonitorable_regex_def mmonitorable_def cases_Neg_iff regex.pred_set)
 qed (auto simp add: mmonitorable_def mmonitorable_regex_def is_simple_eq_def one_enat_def list.pred_set)
 
 lemma monitorable_formula_code[code]: "mmonitorable \<phi> = mmonitorable_exec \<phi>"
   using mmonitorable_exec_mmonitorable safe_formula_mmonitorable_exec mmonitorable_def
   by blast
 
 subsection \<open>Handling regular expressions\<close>
 
 datatype mregex =
   MSkip nat
   | MTestPos nat
   | MTestNeg nat
   | MPlus mregex mregex
   | MTimes mregex mregex
   | MStar mregex
 
 primrec ok where
   "ok _ (MSkip n) = True"
 | "ok m (MTestPos n) = (n < m)"
 | "ok m (MTestNeg n) = (n < m)"
 | "ok m (MPlus r s) = (ok m r \<and> ok m s)"
 | "ok m (MTimes r s) = (ok m r \<and> ok m s)"
 | "ok m (MStar r) = ok m r"
 
 primrec from_mregex where
   "from_mregex (MSkip n) _ = Regex.Skip n"
 | "from_mregex (MTestPos n) \<phi>s = Regex.Test (\<phi>s ! n)"
 | "from_mregex (MTestNeg n) \<phi>s = (if safe_formula (Formula.Neg (\<phi>s ! n))
     then Regex.Test (Formula.Neg (Formula.Neg (Formula.Neg (\<phi>s ! n))))
     else Regex.Test (Formula.Neg (\<phi>s ! n)))"
 | "from_mregex (MPlus r s) \<phi>s = Regex.Plus (from_mregex r \<phi>s) (from_mregex s \<phi>s)"
 | "from_mregex (MTimes r s) \<phi>s = Regex.Times (from_mregex r \<phi>s) (from_mregex s \<phi>s)"
 | "from_mregex (MStar r) \<phi>s = Regex.Star (from_mregex r \<phi>s)"
 
 primrec to_mregex_exec where
   "to_mregex_exec (Regex.Skip n) xs = (MSkip n, xs)"
 | "to_mregex_exec (Regex.Test \<phi>) xs = (if safe_formula \<phi> then (MTestPos (length xs), xs @ [\<phi>])
      else case \<phi> of Formula.Neg \<phi>' \<Rightarrow> (MTestNeg (length xs), xs @ [\<phi>']) | _ \<Rightarrow> (MSkip 0, xs))"
 | "to_mregex_exec (Regex.Plus r s) xs =
      (let (mr, ys) = to_mregex_exec r xs; (ms, zs) = to_mregex_exec s ys
      in (MPlus mr ms, zs))"
 | "to_mregex_exec (Regex.Times r s) xs =
      (let (mr, ys) = to_mregex_exec r xs; (ms, zs) = to_mregex_exec s ys
      in (MTimes mr ms, zs))"
 | "to_mregex_exec (Regex.Star r) xs =
      (let (mr, ys) = to_mregex_exec r xs in (MStar mr, ys))"
 
 primrec shift where
   "shift (MSkip n) k = MSkip n"
 | "shift (MTestPos i) k = MTestPos (i + k)"
 | "shift (MTestNeg i) k = MTestNeg (i + k)"
 | "shift (MPlus r s) k = MPlus (shift r k) (shift s k)"
 | "shift (MTimes r s) k = MTimes (shift r k) (shift s k)"
 | "shift (MStar r) k = MStar (shift r k)"
 
 primrec to_mregex where
   "to_mregex (Regex.Skip n) = (MSkip n, [])"
 | "to_mregex (Regex.Test \<phi>) = (if safe_formula \<phi> then (MTestPos 0, [\<phi>])
      else case \<phi> of Formula.Neg \<phi>' \<Rightarrow> (MTestNeg 0, [\<phi>']) | _ \<Rightarrow> (MSkip 0, []))"
 | "to_mregex (Regex.Plus r s) =
      (let (mr, ys) = to_mregex r; (ms, zs) = to_mregex s
      in (MPlus mr (shift ms (length ys)), ys @ zs))"
 | "to_mregex (Regex.Times r s) =
      (let (mr, ys) = to_mregex r; (ms, zs) = to_mregex s
      in (MTimes mr (shift ms (length ys)), ys @ zs))"
 | "to_mregex (Regex.Star r) =
      (let (mr, ys) = to_mregex r in (MStar mr, ys))"
 
 lemma shift_0: "shift r 0 = r"
   by (induct r) auto
 
 lemma shift_shift: "shift (shift r k) j = shift r (k + j)"
   by (induct r) auto
 
 lemma to_mregex_to_mregex_exec:
   "case to_mregex r of (mr, \<phi>s) \<Rightarrow> to_mregex_exec r xs = (shift mr (length xs), xs @ \<phi>s)"
   by (induct r arbitrary: xs)
     (auto simp: shift_shift ac_simps split: formula.splits prod.splits)
 
 lemma to_mregex_to_mregex_exec_Nil[code]: "to_mregex r = to_mregex_exec r []"
   using to_mregex_to_mregex_exec[where xs="[]" and r = r] by (auto simp: shift_0)
 
 lemma ok_mono: "ok m mr \<Longrightarrow> m \<le> n \<Longrightarrow> ok n mr"
   by (induct mr) auto
 
 lemma from_mregex_cong: "ok m mr \<Longrightarrow> (\<forall>i < m. xs ! i = ys ! i) \<Longrightarrow> from_mregex mr xs = from_mregex mr ys"
   by (induct mr) auto
 
 lemma not_Neg_cases:
   "(\<forall>\<psi>. \<phi> \<noteq> Formula.Neg \<psi>) \<Longrightarrow> (case \<phi> of formula.Neg \<psi> \<Rightarrow> f \<psi> | _ \<Rightarrow> x) = x"
   by (cases \<phi>) auto
 
 lemma to_mregex_exec_ok:
   "to_mregex_exec r xs = (mr, ys) \<Longrightarrow> \<exists>zs. ys = xs @ zs \<and> set zs = atms r \<and> ok (length ys) mr"
 proof (induct r arbitrary: xs mr ys)
   case (Skip x)
   then show ?case by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
 next
   case (Test x)
   show ?case proof (cases "\<exists>x'. x = Formula.Neg x'")
     case True
     with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
   next
     case False
     with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def not_Neg_cases elim: ok_mono)
   qed
 next
   case (Plus r1 r2)
   then show ?case by (fastforce split: if_splits prod.splits formula.splits simp: atms_def elim: ok_mono)
 next
   case (Times r1 r2)
   then show ?case by (fastforce split: if_splits prod.splits formula.splits simp: atms_def elim: ok_mono)
 next
   case (Star r)
   then show ?case by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
 qed
 
 lemma ok_shift: "ok (i + m) (Monitor.shift r i) \<longleftrightarrow> ok m r"
   by (induct r) auto
 
 lemma to_mregex_ok: "to_mregex r = (mr, ys) \<Longrightarrow> set ys = atms r \<and> ok (length ys) mr"
 proof (induct r arbitrary: mr ys)
   case (Skip x)
   then show ?case by (auto simp: atms_def elim: ok_mono split: if_splits prod.splits)
 next
   case (Test x)
   show ?case proof (cases "\<exists>x'. x = Formula.Neg x'")
     case True
     with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
   next
     case False
     with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def not_Neg_cases elim: ok_mono)
   qed
 next
   case (Plus r1 r2)
   then show ?case by (fastforce simp: ok_shift atms_def elim: ok_mono split: if_splits prod.splits)
 next
   case (Times r1 r2)
   then show ?case by (fastforce simp: ok_shift atms_def elim: ok_mono split: if_splits prod.splits)
 next
   case (Star r)
   then show ?case by (auto simp: atms_def elim: ok_mono split: if_splits prod.splits)
 qed
 
 lemma from_mregex_shift: "from_mregex (shift r (length xs)) (xs @ ys) = from_mregex r ys"
   by (induct r) (auto simp: nth_append)
 
 lemma from_mregex_to_mregex: "safe_regex m g r \<Longrightarrow> case_prod from_mregex (to_mregex r) = r"
   by (induct r rule: safe_regex.induct)
     (auto dest: to_mregex_ok intro!: from_mregex_cong simp: nth_append from_mregex_shift cases_Neg_iff
       split: prod.splits modality.splits)
 
 lemma from_mregex_eq: "safe_regex m g r \<Longrightarrow> to_mregex r = (mr, \<phi>s) \<Longrightarrow> from_mregex mr \<phi>s = r"
   using from_mregex_to_mregex[of m g r] by auto
 
 lemma from_mregex_to_mregex_exec: "safe_regex m g r \<Longrightarrow> case_prod from_mregex (to_mregex_exec r xs) = r"
 proof (induct r arbitrary: xs rule: safe_regex_induct)
   case (Plus b g r s)
   from Plus(3) Plus(1)[of xs] Plus(2)[of "snd (to_mregex_exec r xs)"] show ?case
     by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
         intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
 next
   case (TimesF g r s)
   from TimesF(3) TimesF(2)[of xs] TimesF(1)[of "snd (to_mregex_exec r xs)"] show ?case
     by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
         intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
 next
   case (TimesP g r s)
   from TimesP(3) TimesP(1)[of xs] TimesP(2)[of "snd (to_mregex_exec r xs)"] show ?case
     by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
         intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
 next
   case (Star b g r)
   from Star(2) Star(1)[of xs] show ?case
     by (auto split: prod.splits)
 qed (auto split: prod.splits simp: cases_Neg_iff)
 
 
 derive linorder mregex
 
 subsubsection \<open>LPD\<close>
 
 definition saturate where
   "saturate f = while (\<lambda>S. f S \<noteq> S) f"
 
 lemma saturate_code[code]:
   "saturate f S = (let S' = f S in if S' = S then S else saturate f S')"
   unfolding saturate_def Let_def
   by (subst while_unfold) auto
 
 definition "MTimesL r S = MTimes r ` S"
 definition "MTimesR R s = (\<lambda>r. MTimes r s) ` R"
 
 primrec LPD where
   "LPD (MSkip n) = (case n of 0 \<Rightarrow> {} | Suc m \<Rightarrow> {MSkip m})"
 | "LPD (MTestPos \<phi>) = {}"
 | "LPD (MTestNeg \<phi>) = {}"
 | "LPD (MPlus r s) = (LPD r \<union> LPD s)"
 | "LPD (MTimes r s) = MTimesR (LPD r) s \<union> LPD s"
 | "LPD (MStar r) = MTimesR (LPD r) (MStar r)"
 
 primrec LPDi where
   "LPDi 0 r = {r}"
 | "LPDi (Suc i) r = (\<Union>s \<in> LPD r. LPDi i s)"
 
 lemma LPDi_Suc_alt: "LPDi (Suc i) r = (\<Union>s \<in> LPDi i r. LPD s)"
   by (induct i arbitrary: r) fastforce+
 
 definition "LPDs r = (\<Union>i. LPDi i r)"
 
 lemma LPDs_refl: "r \<in> LPDs r"
   by (auto simp: LPDs_def intro: exI[of _ 0])
 lemma LPDs_trans: "r \<in> LPD s \<Longrightarrow> s \<in> LPDs t \<Longrightarrow> r \<in> LPDs t"
   by (force simp: LPDs_def LPDi_Suc_alt simp del: LPDi.simps intro: exI[of _ "Suc _"])
 
 lemma LPDi_Test:
   "LPDi i (MSkip 0) \<subseteq> {MSkip 0}"
   "LPDi i (MTestPos \<phi>) \<subseteq> {MTestPos \<phi>}"
   "LPDi i (MTestNeg \<phi>) \<subseteq> {MTestNeg \<phi>}"
   by (induct i) auto
 
 lemma LPDs_Test:
   "LPDs (MSkip 0) \<subseteq> {MSkip 0}"
   "LPDs (MTestPos \<phi>) \<subseteq> {MTestPos \<phi>}"
   "LPDs (MTestNeg \<phi>) \<subseteq> {MTestNeg \<phi>}"
   unfolding LPDs_def using LPDi_Test by blast+
 
 lemma LPDi_MSkip: "LPDi i (MSkip n) \<subseteq> MSkip ` {i. i \<le> n}"
   by (induct i arbitrary: n) (auto dest: set_mp[OF LPDi_Test(1)] simp: le_Suc_eq split: nat.splits)
 
 lemma LPDs_MSkip: "LPDs (MSkip n) \<subseteq> MSkip ` {i. i \<le> n}"
   unfolding LPDs_def using LPDi_MSkip by auto
 
 lemma LPDi_Plus: "LPDi i (MPlus r s) \<subseteq> {MPlus r s} \<union> LPDi i r \<union> LPDi i s"
   by (induct i arbitrary: r s) auto
 
 lemma LPDs_Plus: "LPDs (MPlus r s) \<subseteq> {MPlus r s} \<union> LPDs r \<union> LPDs s"
   unfolding LPDs_def using LPDi_Plus[of _ r s] by auto
 
 lemma LPDi_Times:
   "LPDi i (MTimes r s) \<subseteq> {MTimes r s} \<union> MTimesR (\<Union>j \<le> i. LPDi j r) s \<union> (\<Union>j \<le> i. LPDi j s)"
 proof (induct i arbitrary: r s)
   case (Suc i)
   show ?case
     by (fastforce simp: MTimesR_def dest: bspec[of _ _ "Suc _"] dest!: set_mp[OF Suc])
 qed simp
 
 lemma LPDs_Times: "LPDs (MTimes r s) \<subseteq> {MTimes r s} \<union> MTimesR (LPDs r) s \<union> LPDs s"
   unfolding LPDs_def using LPDi_Times[of _ r s] by (force simp: MTimesR_def)
 
 lemma LPDi_Star: "j \<le> i \<Longrightarrow> LPDi j (MStar r) \<subseteq> {MStar r} \<union> MTimesR (\<Union>j \<le> i. LPDi j r) (MStar r)"
 proof (induct i arbitrary: j r)
   case (Suc i)
   from Suc(2) show ?case
     by (auto 0 5 simp: MTimesR_def image_iff le_Suc_eq
         dest: bspec[of _ _ "Suc 0"] bspec[of _ _ "Suc _"] set_mp[OF Suc(1)] dest!: set_mp[OF LPDi_Times])
 qed simp
 
 lemma LPDs_Star: "LPDs (MStar r) \<subseteq> {MStar r} \<union> MTimesR (LPDs r) (MStar r)"
   unfolding LPDs_def using LPDi_Star[OF order_refl, of _ r] by (force simp: MTimesR_def)
 
 lemma finite_LPDs: "finite (LPDs r)"
 proof (induct r)
   case (MSkip n)
   then show ?case by (intro finite_subset[OF LPDs_MSkip]) simp
 next
   case (MTestPos \<phi>)
   then show ?case by (intro finite_subset[OF LPDs_Test(2)]) simp
 next
   case (MTestNeg \<phi>)
   then show ?case by (intro finite_subset[OF LPDs_Test(3)]) simp
 next
   case (MPlus r s)
   then show ?case by (intro finite_subset[OF LPDs_Plus]) simp
 next
   case (MTimes r s)
   then show ?case by (intro finite_subset[OF LPDs_Times]) (simp add: MTimesR_def)
 next
   case (MStar r)
   then show ?case by (intro finite_subset[OF LPDs_Star]) (simp add: MTimesR_def)
 qed
 
 context begin
 
 private abbreviation (input) "addLPD r \<equiv> \<lambda>S. insert r S \<union> Set.bind (insert r S) LPD"
 
 private lemma mono_addLPD: "mono (addLPD r)"
   unfolding mono_def Set.bind_def by auto
 
 private lemma LPDs_aux1: "lfp (addLPD r) \<subseteq> LPDs r"
   by (rule lfp_induct[OF mono_addLPD], auto intro: LPDs_refl LPDs_trans simp: Set.bind_def)
 
 private lemma LPDs_aux2: "LPDi i r \<subseteq> lfp (addLPD r)"
 proof (induct i)
   case 0
   then show ?case
     by (subst lfp_unfold[OF mono_addLPD]) auto
 next
   case (Suc i)
   then show ?case
     by (subst lfp_unfold[OF mono_addLPD]) (auto simp: LPDi_Suc_alt simp del: LPDi.simps)
 qed
 
 lemma LPDs_alt: "LPDs r = lfp (addLPD r)"
   using LPDs_aux1 LPDs_aux2 by (force simp: LPDs_def)
 
 lemma LPDs_code[code]:
   "LPDs r = saturate (addLPD r) {}"
   unfolding LPDs_alt saturate_def
   by (rule lfp_while[OF mono_addLPD _ finite_LPDs, of r]) (auto simp: LPDs_refl LPDs_trans Set.bind_def)
 
 end
 
 subsubsection \<open>RPD\<close>
 
 primrec RPD where
   "RPD (MSkip n) = (case n of 0 \<Rightarrow> {} | Suc m \<Rightarrow> {MSkip m})"
 | "RPD (MTestPos \<phi>) = {}"
 | "RPD (MTestNeg \<phi>) = {}"
 | "RPD (MPlus r s) = (RPD r \<union> RPD s)"
 | "RPD (MTimes r s) = MTimesL r (RPD s) \<union> RPD r"
 | "RPD (MStar r) = MTimesL (MStar r) (RPD r)"
 
 primrec RPDi where
   "RPDi 0 r = {r}"
 | "RPDi (Suc i) r = (\<Union>s \<in> RPD r. RPDi i s)"
 
 lemma RPDi_Suc_alt: "RPDi (Suc i) r = (\<Union>s \<in> RPDi i r. RPD s)"
   by (induct i arbitrary: r) fastforce+
 
 definition "RPDs r = (\<Union>i. RPDi i r)"
 
 lemma RPDs_refl: "r \<in> RPDs r"
   by (auto simp: RPDs_def intro: exI[of _ 0])
 lemma RPDs_trans: "r \<in> RPD s \<Longrightarrow> s \<in> RPDs t \<Longrightarrow> r \<in> RPDs t"
   by (force simp: RPDs_def RPDi_Suc_alt simp del: RPDi.simps intro: exI[of _ "Suc _"])
 
 lemma RPDi_Test:
   "RPDi i (MSkip 0) \<subseteq> {MSkip 0}"
   "RPDi i (MTestPos \<phi>) \<subseteq> {MTestPos \<phi>}"
   "RPDi i (MTestNeg \<phi>) \<subseteq> {MTestNeg \<phi>}"
   by (induct i) auto
 
 lemma RPDs_Test:
   "RPDs (MSkip 0) \<subseteq> {MSkip 0}"
   "RPDs (MTestPos \<phi>) \<subseteq> {MTestPos \<phi>}"
   "RPDs (MTestNeg \<phi>) \<subseteq> {MTestNeg \<phi>}"
   unfolding RPDs_def using RPDi_Test by blast+
 
 lemma RPDi_MSkip: "RPDi i (MSkip n) \<subseteq> MSkip ` {i. i \<le> n}"
   by (induct i arbitrary: n) (auto dest: set_mp[OF RPDi_Test(1)] simp: le_Suc_eq split: nat.splits)
 
 lemma RPDs_MSkip: "RPDs (MSkip n) \<subseteq> MSkip ` {i. i \<le> n}"
   unfolding RPDs_def using RPDi_MSkip by auto
 
 lemma RPDi_Plus: "RPDi i (MPlus r s) \<subseteq> {MPlus r s} \<union> RPDi i r \<union> RPDi i s"
   by (induct i arbitrary: r s) auto
 
 lemma RPDi_Suc_RPD_Plus:
   "RPDi (Suc i) r \<subseteq> RPDs (MPlus r s)"
   "RPDi (Suc i) s \<subseteq> RPDs (MPlus r s)"
   unfolding RPDs_def by (force intro!: exI[of _ "Suc i"])+
 
 lemma RPDs_Plus: "RPDs (MPlus r s) \<subseteq> {MPlus r s} \<union> RPDs r \<union> RPDs s"
   unfolding RPDs_def using RPDi_Plus[of _ r s] by auto
 
 lemma RPDi_Times:
   "RPDi i (MTimes r s) \<subseteq> {MTimes r s} \<union> MTimesL r (\<Union>j \<le> i. RPDi j s) \<union> (\<Union>j \<le> i. RPDi j r)"
 proof (induct i arbitrary: r s)
   case (Suc i)
   show ?case
     by (fastforce simp: MTimesL_def dest: bspec[of _ _ "Suc _"] dest!: set_mp[OF Suc])
 qed simp
 
 lemma RPDs_Times: "RPDs (MTimes r s) \<subseteq> {MTimes r s} \<union> MTimesL r (RPDs s) \<union> RPDs r"
   unfolding RPDs_def using RPDi_Times[of _ r s] by (force simp: MTimesL_def)
 
 lemma RPDi_Star: "j \<le> i \<Longrightarrow> RPDi j (MStar r) \<subseteq> {MStar r} \<union> MTimesL (MStar r) (\<Union>j \<le> i. RPDi j r)"
 proof (induct i arbitrary: j r)
   case (Suc i)
   from Suc(2) show ?case
     by (auto 0 5 simp: MTimesL_def image_iff le_Suc_eq
         dest: bspec[of _ _ "Suc 0"] bspec[of _ _ "Suc _"] set_mp[OF Suc(1)] dest!: set_mp[OF RPDi_Times])
 qed simp
 
 lemma RPDs_Star: "RPDs (MStar r) \<subseteq> {MStar r} \<union> MTimesL (MStar r) (RPDs r)"
   unfolding RPDs_def using RPDi_Star[OF order_refl, of _ r] by (force simp: MTimesL_def)
 
 lemma finite_RPDs: "finite (RPDs r)"
 proof (induct r)
   case MSkip
   then show ?case by (intro finite_subset[OF RPDs_MSkip]) simp
 next
   case (MTestPos \<phi>)
   then show ?case by (intro finite_subset[OF RPDs_Test(2)]) simp
 next
   case (MTestNeg \<phi>)
   then show ?case by (intro finite_subset[OF RPDs_Test(3)]) simp
 next
   case (MPlus r s)
   then show ?case by (intro finite_subset[OF RPDs_Plus]) simp
 next
   case (MTimes r s)
   then show ?case by (intro finite_subset[OF RPDs_Times]) (simp add: MTimesL_def)
 next
   case (MStar r)
   then show ?case by (intro finite_subset[OF RPDs_Star]) (simp add: MTimesL_def)
 qed
 
 context begin
 
 private abbreviation (input) "addRPD r \<equiv> \<lambda>S. insert r S \<union> Set.bind (insert r S) RPD"
 
 private lemma mono_addRPD: "mono (addRPD r)"
   unfolding mono_def Set.bind_def by auto
 
 private lemma RPDs_aux1: "lfp (addRPD r) \<subseteq> RPDs r"
   by (rule lfp_induct[OF mono_addRPD], auto intro: RPDs_refl RPDs_trans simp: Set.bind_def)
 
 private lemma RPDs_aux2: "RPDi i r \<subseteq> lfp (addRPD r)"
 proof (induct i)
   case 0
   then show ?case
     by (subst lfp_unfold[OF mono_addRPD]) auto
 next
   case (Suc i)
   then show ?case
     by (subst lfp_unfold[OF mono_addRPD]) (auto simp: RPDi_Suc_alt simp del: RPDi.simps)
 qed
 
 lemma RPDs_alt: "RPDs r = lfp (addRPD r)"
   using RPDs_aux1 RPDs_aux2 by (force simp: RPDs_def)
 
 lemma RPDs_code[code]:
   "RPDs r = saturate (addRPD r) {}"
   unfolding RPDs_alt saturate_def
   by (rule lfp_while[OF mono_addRPD _ finite_RPDs, of r]) (auto simp: RPDs_refl RPDs_trans Set.bind_def)
 
 end
 
 subsection \<open>The executable monitor\<close>
 
 type_synonym ts = nat
 
 type_synonym 'a mbuf2 = "'a table list \<times> 'a table list"
 type_synonym 'a mbufn = "'a table list list"
 type_synonym 'a msaux = "(ts \<times> 'a table) list"
 type_synonym 'a muaux = "(ts \<times> 'a table \<times> 'a table) list"
 type_synonym 'a mr\<delta>aux = "(ts \<times> (mregex, 'a table) mapping) list"
 type_synonym 'a ml\<delta>aux = "(ts \<times> 'a table list \<times> 'a table) list"
 
 datatype mconstraint = MEq | MLess | MLessEq
 
 record args =
   args_ivl :: \<I>
   args_n :: nat
   args_L :: "nat set"
   args_R :: "nat set"
   args_pos :: bool
 
 datatype (dead 'msaux, dead 'muaux) mformula =
   MRel "event_data table"
   | MPred Formula.name "Formula.trm list"
   | MLet Formula.name nat "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula"
   | MAnd "nat set" "('msaux, 'muaux) mformula" bool "nat set" "('msaux, 'muaux) mformula" "event_data mbuf2"
   | MAndAssign "('msaux, 'muaux) mformula" "nat \<times> Formula.trm"
   | MAndRel "('msaux, 'muaux) mformula" "Formula.trm \<times> bool \<times> mconstraint \<times> Formula.trm"
   | MAnds "nat set list" "nat set list" "('msaux, 'muaux) mformula list" "event_data mbufn"
   | MOr "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2"
   | MNeg "('msaux, 'muaux) mformula"
   | MExists "('msaux, 'muaux) mformula"
   | MAgg bool nat Formula.agg_op nat "Formula.trm" "('msaux, 'muaux) mformula"
   | MPrev \<I> "('msaux, 'muaux) mformula" bool "event_data table list" "ts list"
   | MNext \<I> "('msaux, 'muaux) mformula" bool "ts list"
   | MSince args "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2" "ts list" "'msaux"
   | MUntil args "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2" "ts list" "'muaux"
   | MMatchP \<I> "mregex" "mregex list" "('msaux, 'muaux) mformula list" "event_data mbufn" "ts list" "event_data mr\<delta>aux"
   | MMatchF \<I> "mregex" "mregex list" "('msaux, 'muaux) mformula list" "event_data mbufn" "ts list" "event_data ml\<delta>aux"
 
 record ('msaux, 'muaux) mstate =
   mstate_i :: nat
   mstate_m :: "('msaux, 'muaux) mformula"
   mstate_n :: nat
 
 fun eq_rel :: "nat \<Rightarrow> Formula.trm \<Rightarrow> Formula.trm \<Rightarrow> event_data table" where
   "eq_rel n (Formula.Const x) (Formula.Const y) = (if x = y then unit_table n else empty_table)"
 | "eq_rel n (Formula.Var x) (Formula.Const y) = singleton_table n x y"
 | "eq_rel n (Formula.Const x) (Formula.Var y) = singleton_table n y x"
 | "eq_rel n _ _ = undefined"
 
 lemma regex_atms_size: "x \<in> regex.atms r \<Longrightarrow> size x < regex.size_regex size r"
   by (induct r) auto
 
 lemma atms_size:
   assumes "x \<in> atms r"
   shows "size x < Regex.size_regex size r"
 proof -
   { fix y assume "y \<in> regex.atms r" "case y of formula.Neg z \<Rightarrow> x = z | _ \<Rightarrow> False"
     then have "size x < Regex.size_regex size r"
       by (cases y rule: formula.exhaust) (auto dest: regex_atms_size)
   }
   with assms show ?thesis
     unfolding atms_def
     by (auto split: formula.splits dest: regex_atms_size)
 qed
 
 definition init_args :: "\<I> \<Rightarrow> nat \<Rightarrow> nat set \<Rightarrow> nat set \<Rightarrow> bool \<Rightarrow> args" where
   "init_args I n L R pos = \<lparr>args_ivl = I, args_n = n, args_L = L, args_R = R, args_pos = pos\<rparr>"
 
 locale msaux =
   fixes valid_msaux :: "args \<Rightarrow> ts \<Rightarrow> 'msaux \<Rightarrow> event_data msaux \<Rightarrow> bool"
     and init_msaux :: "args \<Rightarrow> 'msaux"
     and add_new_ts_msaux :: "args \<Rightarrow> ts \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and join_msaux :: "args \<Rightarrow> event_data table \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and add_new_table_msaux :: "args \<Rightarrow> event_data table \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and result_msaux :: "args \<Rightarrow> 'msaux \<Rightarrow> event_data table"
   assumes valid_init_msaux: "L \<subseteq> R \<Longrightarrow>
     valid_msaux (init_args I n L R pos) 0 (init_msaux (init_args I n L R pos)) []"
   assumes valid_add_new_ts_msaux: "valid_msaux args cur aux auxlist \<Longrightarrow> nt \<ge> cur \<Longrightarrow>
     valid_msaux args nt (add_new_ts_msaux args nt aux)
     (filter (\<lambda>(t, rel). enat (nt - t) \<le> right (args_ivl args)) auxlist)"
   assumes valid_join_msaux: "valid_msaux args cur aux auxlist \<Longrightarrow>
     table (args_n args) (args_L args) rel1 \<Longrightarrow>
     valid_msaux args cur (join_msaux args rel1 aux)
     (map (\<lambda>(t, rel). (t, join rel (args_pos args) rel1)) auxlist)"
   assumes valid_add_new_table_msaux: "valid_msaux args cur aux auxlist \<Longrightarrow>
     table (args_n args) (args_R args) rel2 \<Longrightarrow>
     valid_msaux args cur (add_new_table_msaux args rel2 aux)
     (case auxlist of
       [] => [(cur, rel2)]
     | ((t, y) # ts) \<Rightarrow> if t = cur then (t, y \<union> rel2) # ts else (cur, rel2) # auxlist)"
     and valid_result_msaux: "valid_msaux args cur aux auxlist \<Longrightarrow> result_msaux args aux =
     foldr (\<union>) [rel. (t, rel) \<leftarrow> auxlist, left (args_ivl args) \<le> cur - t] {}"
 
 fun check_before :: "\<I> \<Rightarrow> ts \<Rightarrow> (ts \<times> 'a \<times> 'b) \<Rightarrow> bool" where
   "check_before I dt (t, a, b) \<longleftrightarrow> enat t + right I < enat dt"
 
 fun proj_thd :: "('a \<times> 'b \<times> 'c) \<Rightarrow> 'c" where
   "proj_thd (t, a1, a2) = a2"
 
 definition update_until :: "args \<Rightarrow> event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow> event_data muaux \<Rightarrow> event_data muaux" where
   "update_until args rel1 rel2 nt aux =
     (map (\<lambda>x. case x of (t, a1, a2) \<Rightarrow> (t, if (args_pos args) then join a1 True rel1 else a1 \<union> rel1,
       if mem (nt - t) (args_ivl args) then a2 \<union> join rel2 (args_pos args) a1 else a2)) aux) @
     [(nt, rel1, if left (args_ivl args) = 0 then rel2 else empty_table)]"
 
 lemma map_proj_thd_update_until: "map proj_thd (takeWhile (check_before (args_ivl args) nt) auxlist) =
   map proj_thd (takeWhile (check_before (args_ivl args) nt) (update_until args rel1 rel2 nt auxlist))"
 proof (induction auxlist)
   case Nil
   then show ?case by (simp add: update_until_def)
 next
   case (Cons a auxlist)
   then show ?case
     by (cases "right (args_ivl args)") (auto simp add: update_until_def split: if_splits prod.splits)
 qed
 
 fun eval_until :: "\<I> \<Rightarrow> ts \<Rightarrow> event_data muaux \<Rightarrow> event_data table list \<times> event_data muaux" where
   "eval_until I nt [] = ([], [])"
 | "eval_until I nt ((t, a1, a2) # aux) = (if t + right I < nt then
     (let (xs, aux) = eval_until I nt aux in (a2 # xs, aux)) else ([], (t, a1, a2) # aux))"
 
 lemma eval_until_length:
   "eval_until I nt auxlist = (res, auxlist') \<Longrightarrow> length auxlist = length res + length auxlist'"
   by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
     (auto split: if_splits prod.splits)
 
 lemma eval_until_res: "eval_until I nt auxlist = (res, auxlist') \<Longrightarrow>
   res = map proj_thd (takeWhile (check_before I nt) auxlist)"
   by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
     (auto split: prod.splits)
 
 lemma eval_until_auxlist': "eval_until I nt auxlist = (res, auxlist') \<Longrightarrow>
   auxlist' = drop (length res) auxlist"
   by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
     (auto split: if_splits prod.splits)
 
 locale muaux =
   fixes valid_muaux :: "args \<Rightarrow> ts \<Rightarrow> 'muaux \<Rightarrow> event_data muaux \<Rightarrow> bool"
     and init_muaux :: "args \<Rightarrow> 'muaux"
     and add_new_muaux :: "args \<Rightarrow> event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow> 'muaux \<Rightarrow> 'muaux"
     and length_muaux :: "args \<Rightarrow> 'muaux \<Rightarrow> nat"
     and eval_muaux :: "args \<Rightarrow> ts \<Rightarrow> 'muaux \<Rightarrow> event_data table list \<times> 'muaux"
   assumes valid_init_muaux: "L \<subseteq> R \<Longrightarrow>
     valid_muaux (init_args I n L R pos) 0 (init_muaux (init_args I n L R pos)) []"
   assumes valid_add_new_muaux: "valid_muaux args cur aux auxlist \<Longrightarrow>
     table (args_n args) (args_L args) rel1 \<Longrightarrow>
     table (args_n args) (args_R args) rel2 \<Longrightarrow>
     nt \<ge> cur \<Longrightarrow>
     valid_muaux args nt (add_new_muaux args rel1 rel2 nt aux)
     (update_until args rel1 rel2 nt auxlist)"
   assumes valid_length_muaux: "valid_muaux args cur aux auxlist \<Longrightarrow> length_muaux args aux = length auxlist"
   assumes valid_eval_muaux: "valid_muaux args cur aux auxlist \<Longrightarrow> nt \<ge> cur \<Longrightarrow>
     eval_muaux args nt aux = (res, aux') \<Longrightarrow> eval_until (args_ivl args) nt auxlist = (res', auxlist') \<Longrightarrow>
     res = res' \<and> valid_muaux args cur aux' auxlist'"
 
 locale maux = msaux valid_msaux init_msaux add_new_ts_msaux join_msaux add_new_table_msaux result_msaux +
   muaux valid_muaux init_muaux add_new_muaux length_muaux eval_muaux
   for valid_msaux :: "args \<Rightarrow> ts \<Rightarrow> 'msaux \<Rightarrow> event_data msaux \<Rightarrow> bool"
     and init_msaux :: "args \<Rightarrow> 'msaux"
     and add_new_ts_msaux :: "args \<Rightarrow> ts \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and join_msaux :: "args \<Rightarrow> event_data table \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and add_new_table_msaux :: "args \<Rightarrow> event_data table \<Rightarrow> 'msaux \<Rightarrow> 'msaux"
     and result_msaux :: "args \<Rightarrow> 'msaux \<Rightarrow> event_data table"
     and valid_muaux :: "args \<Rightarrow> ts \<Rightarrow> 'muaux \<Rightarrow> event_data muaux \<Rightarrow> bool"
     and init_muaux :: "args \<Rightarrow> 'muaux"
     and add_new_muaux :: "args \<Rightarrow> event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow> 'muaux \<Rightarrow> 'muaux"
     and length_muaux :: "args \<Rightarrow> 'muaux \<Rightarrow> nat"
     and eval_muaux :: "args \<Rightarrow> nat \<Rightarrow> 'muaux \<Rightarrow> event_data table list \<times> 'muaux"
 
 fun split_assignment :: "nat set \<Rightarrow> Formula.formula \<Rightarrow> nat \<times> Formula.trm" where
   "split_assignment X (Formula.Eq t1 t2) = (case (t1, t2) of
       (Formula.Var x, Formula.Var y) \<Rightarrow> if x \<in> X then (y, t1) else (x, t2)
     | (Formula.Var x, _) \<Rightarrow> (x, t2)
     | (_, Formula.Var y) \<Rightarrow> (y, t1))"
 | "split_assignment _ _ = undefined"
 
 fun split_constraint :: "Formula.formula \<Rightarrow> Formula.trm \<times> bool \<times> mconstraint \<times> Formula.trm" where
   "split_constraint (Formula.Eq t1 t2) = (t1, True, MEq, t2)"
 | "split_constraint (Formula.Less t1 t2) = (t1, True, MLess, t2)"
 | "split_constraint (Formula.LessEq t1 t2) = (t1, True, MLessEq, t2)"
 | "split_constraint (Formula.Neg (Formula.Eq t1 t2)) = (t1, False, MEq, t2)"
 | "split_constraint (Formula.Neg (Formula.Less t1 t2)) = (t1, False, MLess, t2)"
 | "split_constraint (Formula.Neg (Formula.LessEq t1 t2)) = (t1, False, MLessEq, t2)"
 | "split_constraint _ = undefined"
 
 function (in maux) (sequential) minit0 :: "nat \<Rightarrow> Formula.formula \<Rightarrow> ('msaux, 'muaux) mformula" where
   "minit0 n (Formula.Neg \<phi>) = (if fv \<phi> = {} then MNeg (minit0 n \<phi>) else MRel empty_table)"
 | "minit0 n (Formula.Eq t1 t2) = MRel (eq_rel n t1 t2)"
 | "minit0 n (Formula.Pred e ts) = MPred e ts"
 | "minit0 n (Formula.Let p \<phi> \<psi>) = MLet p (Formula.nfv \<phi>) (minit0 (Formula.nfv \<phi>) \<phi>) (minit0 n \<psi>)"
 | "minit0 n (Formula.Or \<phi> \<psi>) = MOr (minit0 n \<phi>) (minit0 n \<psi>) ([], [])"
 | "minit0 n (Formula.And \<phi> \<psi>) = (if safe_assignment (fv \<phi>) \<psi> then
       MAndAssign (minit0 n \<phi>) (split_assignment (fv \<phi>) \<psi>)
     else if safe_formula \<psi> then
       MAnd (fv \<phi>) (minit0 n \<phi>) True (fv \<psi>) (minit0 n \<psi>) ([], [])
     else if is_constraint \<psi> then
       MAndRel (minit0 n \<phi>) (split_constraint \<psi>)
     else (case \<psi> of Formula.Neg \<psi> \<Rightarrow>
       MAnd (fv \<phi>) (minit0 n \<phi>) False (fv \<psi>) (minit0 n \<psi>) ([], [])))"
 | "minit0 n (Formula.Ands l) = (let (pos, neg) = partition safe_formula l in
     let mpos = map (minit0 n) pos in
     let mneg = map (minit0 n) (map remove_neg neg) in
     let vpos = map fv pos in
     let vneg = map fv neg in
     MAnds vpos vneg (mpos @ mneg) (replicate (length l) []))"
 | "minit0 n (Formula.Exists \<phi>) = MExists (minit0 (Suc n) \<phi>)"
 | "minit0 n (Formula.Agg y \<omega> b f \<phi>) = MAgg (fv \<phi> \<subseteq> {0..<b}) y \<omega> b f (minit0 (b + n) \<phi>)"
 | "minit0 n (Formula.Prev I \<phi>) = MPrev I (minit0 n \<phi>) True [] []"
 | "minit0 n (Formula.Next I \<phi>) = MNext I (minit0 n \<phi>) True []"
 | "minit0 n (Formula.Since \<phi> I \<psi>) = (if safe_formula \<phi>
     then MSince (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) True) (minit0 n \<phi>) (minit0 n \<psi>) ([], []) [] (init_msaux (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) True))
     else (case \<phi> of
       Formula.Neg \<phi> \<Rightarrow> MSince (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) False) (minit0 n \<phi>) (minit0 n \<psi>) ([], []) [] (init_msaux (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) False))
     | _ \<Rightarrow> undefined))"
 | "minit0 n (Formula.Until \<phi> I \<psi>) = (if safe_formula \<phi>
     then MUntil (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) True) (minit0 n \<phi>) (minit0 n \<psi>) ([], []) [] (init_muaux (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) True))
     else (case \<phi> of
       Formula.Neg \<phi> \<Rightarrow> MUntil (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) False) (minit0 n \<phi>) (minit0 n \<psi>) ([], []) [] (init_muaux (init_args I n (Formula.fv \<phi>) (Formula.fv \<psi>) False))
     | _ \<Rightarrow> undefined))"
 | "minit0 n (Formula.MatchP I r) =
     (let (mr, \<phi>s) = to_mregex r
     in MMatchP I mr (sorted_list_of_set (RPDs mr)) (map (minit0 n) \<phi>s) (replicate (length \<phi>s) []) [] [])"
 | "minit0 n (Formula.MatchF I r) =
     (let (mr, \<phi>s) = to_mregex r
     in MMatchF I mr (sorted_list_of_set (LPDs mr)) (map (minit0 n) \<phi>s) (replicate (length \<phi>s) []) [] [])"
 | "minit0 n _ = undefined"
   by pat_completeness auto
 termination (in maux)
   by (relation "measure (\<lambda>(_, \<phi>). size \<phi>)")
     (auto simp: less_Suc_eq_le size_list_estimation' size_remove_neg
       dest!: to_mregex_ok[OF sym] atms_size)
 
 definition (in maux) minit :: "Formula.formula \<Rightarrow> ('msaux, 'muaux) mstate" where
   "minit \<phi> = (let n = Formula.nfv \<phi> in \<lparr>mstate_i = 0, mstate_m = minit0 n \<phi>, mstate_n = n\<rparr>)"
 
 definition (in maux) minit_safe where
   "minit_safe \<phi> = (if mmonitorable_exec \<phi> then minit \<phi> else undefined)"
 
 fun mprev_next :: "\<I> \<Rightarrow> event_data table list \<Rightarrow> ts list \<Rightarrow> event_data table list \<times> event_data table list \<times> ts list" where
   "mprev_next I [] ts = ([], [], ts)"
 | "mprev_next I xs [] = ([], xs, [])"
 | "mprev_next I xs [t] = ([], xs, [t])"
 | "mprev_next I (x # xs) (t # t' # ts) = (let (ys, zs) = mprev_next I xs (t' # ts)
     in ((if mem (t' - t) I then x else empty_table) # ys, zs))"
 
 fun mbuf2_add :: "event_data table list \<Rightarrow> event_data table list \<Rightarrow> event_data mbuf2 \<Rightarrow> event_data mbuf2" where
   "mbuf2_add xs' ys' (xs, ys) = (xs @ xs', ys @ ys')"
 
 fun mbuf2_take :: "(event_data table \<Rightarrow> event_data table \<Rightarrow> 'b) \<Rightarrow> event_data mbuf2 \<Rightarrow> 'b list \<times> event_data mbuf2" where
   "mbuf2_take f (x # xs, y # ys) = (let (zs, buf) = mbuf2_take f (xs, ys) in (f x y # zs, buf))"
 | "mbuf2_take f (xs, ys) = ([], (xs, ys))"
 
 fun mbuf2t_take :: "(event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow>
     event_data mbuf2 \<Rightarrow> ts list \<Rightarrow> 'b \<times> event_data mbuf2 \<times> ts list" where
   "mbuf2t_take f z (x # xs, y # ys) (t # ts) = mbuf2t_take f (f x y t z) (xs, ys) ts"
 | "mbuf2t_take f z (xs, ys) ts = (z, (xs, ys), ts)"
 
 lemma size_list_length_diff1: "xs \<noteq> [] \<Longrightarrow> [] \<notin> set xs \<Longrightarrow>
   size_list (\<lambda>xs. length xs - Suc 0) xs < size_list length xs"
 proof (induct xs)
   case (Cons x xs)
   then show ?case
     by (cases xs) auto
 qed simp
 
 fun mbufn_add :: "event_data table list list \<Rightarrow> event_data mbufn \<Rightarrow> event_data mbufn" where
   "mbufn_add xs' xs = List.map2 (@) xs xs'"
 
 function mbufn_take :: "(event_data table list \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> event_data mbufn \<Rightarrow> 'b \<times> event_data mbufn" where
   "mbufn_take f z buf = (if buf = [] \<or> [] \<in> set buf then (z, buf)
     else mbufn_take f (f (map hd buf) z) (map tl buf))"
   by pat_completeness auto
 termination by (relation "measure (\<lambda>(_, _, buf). size_list length buf)")
     (auto simp: comp_def Suc_le_eq size_list_length_diff1)
 
 fun mbufnt_take :: "(event_data table list \<Rightarrow> ts \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow>
     'b \<Rightarrow> event_data mbufn \<Rightarrow> ts list \<Rightarrow> 'b \<times> event_data mbufn \<times> ts list" where
   "mbufnt_take f z buf ts =
     (if [] \<in> set buf \<or> ts = [] then (z, buf, ts)
     else mbufnt_take f (f (map hd buf) (hd ts) z) (map tl buf) (tl ts))"
 
 fun match :: "Formula.trm list \<Rightarrow> event_data list \<Rightarrow> (nat \<rightharpoonup> event_data) option" where
   "match [] [] = Some Map.empty"
 | "match (Formula.Const x # ts) (y # ys) = (if x = y then match ts ys else None)"
 | "match (Formula.Var x # ts) (y # ys) = (case match ts ys of
       None \<Rightarrow> None
     | Some f \<Rightarrow> (case f x of
         None \<Rightarrow> Some (f(x \<mapsto> y))
       | Some z \<Rightarrow> if y = z then Some f else None))"
 | "match _ _ = None"
 
 fun meval_trm :: "Formula.trm \<Rightarrow> event_data tuple \<Rightarrow> event_data" where
   "meval_trm (Formula.Var x) v = the (v ! x)"
 | "meval_trm (Formula.Const x) v = x"
 | "meval_trm (Formula.Plus x y) v = meval_trm x v + meval_trm y v"
 | "meval_trm (Formula.Minus x y) v = meval_trm x v - meval_trm y v"
 | "meval_trm (Formula.UMinus x) v = - meval_trm x v"
 | "meval_trm (Formula.Mult x y) v = meval_trm x v * meval_trm y v"
 | "meval_trm (Formula.Div x y) v = meval_trm x v div meval_trm y v"
 | "meval_trm (Formula.Mod x y) v = meval_trm x v mod meval_trm y v"
 | "meval_trm (Formula.F2i x) v = EInt (integer_of_event_data (meval_trm x v))"
 | "meval_trm (Formula.I2f x) v = EFloat (double_of_event_data (meval_trm x v))"
 
 definition eval_agg :: "nat \<Rightarrow> bool \<Rightarrow> nat \<Rightarrow> Formula.agg_op \<Rightarrow> nat \<Rightarrow> Formula.trm \<Rightarrow>
   event_data table \<Rightarrow> event_data table" where
   "eval_agg n g0 y \<omega> b f rel = (if g0 \<and> rel = empty_table
     then singleton_table n y (eval_agg_op \<omega> {})
     else (\<lambda>k.
       let group = Set.filter (\<lambda>x. drop b x = k) rel;
         M = (\<lambda>y. (y, ecard (Set.filter (\<lambda>x. meval_trm f x = y) group))) ` meval_trm f ` group
       in k[y:=Some (eval_agg_op \<omega> M)]) ` (drop b) ` rel)"
 
 definition (in maux) update_since :: "args \<Rightarrow> event_data table \<Rightarrow> event_data table \<Rightarrow> ts \<Rightarrow>
   'msaux \<Rightarrow> event_data table \<times> 'msaux" where
   "update_since args rel1 rel2 nt aux =
     (let aux0 = join_msaux args rel1 (add_new_ts_msaux args nt aux);
          aux' = add_new_table_msaux args rel2 aux0
     in (result_msaux args aux', aux'))"
 
 definition "lookup = Mapping.lookup_default empty_table"
 
 fun \<epsilon>_lax where
   "\<epsilon>_lax guard \<phi>s (MSkip n) = (if n = 0 then guard else empty_table)"
 | "\<epsilon>_lax guard \<phi>s (MTestPos i) = join guard True (\<phi>s ! i)"
 | "\<epsilon>_lax guard \<phi>s (MTestNeg i) = join guard False (\<phi>s ! i)"
 | "\<epsilon>_lax guard \<phi>s (MPlus r s) = \<epsilon>_lax guard \<phi>s r \<union> \<epsilon>_lax guard \<phi>s s"
 | "\<epsilon>_lax guard \<phi>s (MTimes r s) = join (\<epsilon>_lax guard \<phi>s r) True (\<epsilon>_lax guard \<phi>s s)"
 | "\<epsilon>_lax guard \<phi>s (MStar r) = guard"
 
 fun r\<epsilon>_strict where
   "r\<epsilon>_strict n \<phi>s (MSkip m) = (if m = 0 then unit_table n else empty_table)"
 | "r\<epsilon>_strict n \<phi>s (MTestPos i) = \<phi>s ! i"
 | "r\<epsilon>_strict n \<phi>s (MTestNeg i) = (if \<phi>s ! i = empty_table then unit_table n else empty_table)"
 | "r\<epsilon>_strict n \<phi>s (MPlus r s) = r\<epsilon>_strict n \<phi>s r \<union> r\<epsilon>_strict n \<phi>s s"
 | "r\<epsilon>_strict n \<phi>s (MTimes r s) = \<epsilon>_lax (r\<epsilon>_strict n \<phi>s r) \<phi>s s"
 | "r\<epsilon>_strict n \<phi>s (MStar r) = unit_table n"
 
 fun l\<epsilon>_strict where
   "l\<epsilon>_strict n \<phi>s (MSkip m) = (if m = 0 then unit_table n else empty_table)"
 | "l\<epsilon>_strict n \<phi>s (MTestPos i) = \<phi>s ! i"
 | "l\<epsilon>_strict n \<phi>s (MTestNeg i) = (if \<phi>s ! i = empty_table then unit_table n else empty_table)"
 | "l\<epsilon>_strict n \<phi>s (MPlus r s) = l\<epsilon>_strict n \<phi>s r \<union> l\<epsilon>_strict n \<phi>s s"
 | "l\<epsilon>_strict n \<phi>s (MTimes r s) = \<epsilon>_lax (l\<epsilon>_strict n \<phi>s s) \<phi>s r"
 | "l\<epsilon>_strict n \<phi>s (MStar r) = unit_table n"
 
 fun r\<delta> :: "(mregex \<Rightarrow> mregex) \<Rightarrow> (mregex, 'a table) mapping \<Rightarrow> 'a table list \<Rightarrow> mregex \<Rightarrow> 'a table"  where
   "r\<delta> \<kappa> X \<phi>s (MSkip n) = (case n of 0 \<Rightarrow> empty_table | Suc m \<Rightarrow> lookup X (\<kappa> (MSkip m)))"
 | "r\<delta> \<kappa> X \<phi>s (MTestPos i) = empty_table"
 | "r\<delta> \<kappa> X \<phi>s (MTestNeg i) = empty_table"
 | "r\<delta> \<kappa> X \<phi>s (MPlus r s) = r\<delta> \<kappa> X \<phi>s r \<union> r\<delta> \<kappa> X \<phi>s s"
 | "r\<delta> \<kappa> X \<phi>s (MTimes r s) = r\<delta> (\<lambda>t. \<kappa> (MTimes r t)) X \<phi>s s \<union> \<epsilon>_lax (r\<delta> \<kappa> X \<phi>s r) \<phi>s s"
 | "r\<delta> \<kappa> X \<phi>s (MStar r) = r\<delta> (\<lambda>t. \<kappa> (MTimes (MStar r) t)) X \<phi>s r"
 
 fun l\<delta> :: "(mregex \<Rightarrow> mregex) \<Rightarrow> (mregex, 'a table) mapping \<Rightarrow> 'a table list \<Rightarrow> mregex \<Rightarrow> 'a table" where
   "l\<delta> \<kappa> X \<phi>s (MSkip n) = (case n of 0 \<Rightarrow> empty_table | Suc m \<Rightarrow> lookup X (\<kappa> (MSkip m)))"
 | "l\<delta> \<kappa> X \<phi>s (MTestPos i) = empty_table"
 | "l\<delta> \<kappa> X \<phi>s (MTestNeg i) = empty_table"
 | "l\<delta> \<kappa> X \<phi>s (MPlus r s) = l\<delta> \<kappa> X \<phi>s r \<union> l\<delta> \<kappa> X \<phi>s s"
 | "l\<delta> \<kappa> X \<phi>s (MTimes r s) = l\<delta> (\<lambda>t. \<kappa> (MTimes t s)) X \<phi>s r \<union> \<epsilon>_lax (l\<delta> \<kappa> X \<phi>s s) \<phi>s r"
 | "l\<delta> \<kappa> X \<phi>s (MStar r) = l\<delta> (\<lambda>t. \<kappa> (MTimes t (MStar r))) X \<phi>s r"
 
 lift_definition mrtabulate :: "mregex list \<Rightarrow> (mregex \<Rightarrow> 'b table) \<Rightarrow> (mregex, 'b table) mapping"
   is "\<lambda>ks f. (map_of (List.map_filter (\<lambda>k. let fk = f k in if fk = empty_table then None else Some (k, fk)) ks))" .
 
 lemma lookup_tabulate:
   "distinct xs \<Longrightarrow> lookup (mrtabulate xs f) x = (if x \<in> set xs then f x else empty_table)"
   unfolding lookup_default_def lookup_def
   by transfer (auto simp: Let_def map_filter_def map_of_eq_None_iff o_def image_image dest!: map_of_SomeD
       split: if_splits option.splits)
 
 definition update_matchP :: "nat \<Rightarrow> \<I> \<Rightarrow> mregex \<Rightarrow> mregex list \<Rightarrow> event_data table list \<Rightarrow> ts \<Rightarrow>
   event_data mr\<delta>aux \<Rightarrow> event_data table \<times> event_data mr\<delta>aux" where
   "update_matchP n I mr mrs rels nt aux =
     (let aux = (case [(t, mrtabulate mrs (\<lambda>mr.
         r\<delta> id rel rels mr \<union> (if t = nt then r\<epsilon>_strict n rels mr else {}))).
       (t, rel) \<leftarrow> aux, enat (nt - t) \<le> right I]
       of [] \<Rightarrow> [(nt, mrtabulate mrs (r\<epsilon>_strict n rels))]
       | x # aux' \<Rightarrow> (if fst x = nt then x # aux'
                      else (nt, mrtabulate mrs (r\<epsilon>_strict n rels)) # x # aux'))
     in (foldr (\<union>) [lookup rel mr. (t, rel) \<leftarrow> aux, left I \<le> nt - t] {}, aux))"
 
 definition update_matchF_base where
   "update_matchF_base n I mr mrs rels nt =
      (let X = mrtabulate mrs (l\<epsilon>_strict n rels)
      in ([(nt, rels, if left I = 0 then lookup X mr else empty_table)], X))"
 
 definition update_matchF_step where
   "update_matchF_step I mr mrs nt = (\<lambda>(t, rels', rel) (aux', X).
      (let Y = mrtabulate mrs (l\<delta> id X rels')
      in ((t, rels', if mem (nt - t) I then rel \<union> lookup Y mr else rel) # aux', Y)))"
 
 definition update_matchF :: "nat \<Rightarrow> \<I> \<Rightarrow> mregex \<Rightarrow> mregex list \<Rightarrow> event_data table list \<Rightarrow> ts \<Rightarrow> event_data ml\<delta>aux \<Rightarrow> event_data ml\<delta>aux" where
   "update_matchF n I mr mrs rels nt aux =
      fst (foldr (update_matchF_step I mr mrs nt) aux (update_matchF_base n I mr mrs rels nt))"
 
 fun eval_matchF :: "\<I> \<Rightarrow> mregex \<Rightarrow> ts \<Rightarrow> event_data ml\<delta>aux \<Rightarrow> event_data table list \<times> event_data ml\<delta>aux" where
   "eval_matchF I mr nt [] = ([], [])"
 | "eval_matchF I mr nt ((t, rels, rel) # aux) = (if t + right I < nt then
     (let (xs, aux) = eval_matchF I mr nt aux in (rel # xs, aux)) else ([], (t, rels, rel) # aux))"
 
 primrec map_split where
   "map_split f [] = ([], [])"
 | "map_split f (x # xs) =
     (let (y, z) = f x; (ys, zs) = map_split f xs
     in (y # ys, z # zs))"
 
 fun eval_assignment :: "nat \<times> Formula.trm \<Rightarrow> event_data tuple \<Rightarrow> event_data tuple" where
   "eval_assignment (x, t) y = (y[x:=Some (meval_trm t y)])"
 
 fun eval_constraint0 :: "mconstraint \<Rightarrow> event_data \<Rightarrow> event_data \<Rightarrow> bool" where
   "eval_constraint0 MEq x y = (x = y)"
 | "eval_constraint0 MLess x y = (x < y)"
 | "eval_constraint0 MLessEq x y = (x \<le> y)"
 
 fun eval_constraint :: "Formula.trm \<times> bool \<times> mconstraint \<times> Formula.trm \<Rightarrow> event_data tuple \<Rightarrow> bool" where
   "eval_constraint (t1, p, c, t2) x = (eval_constraint0 c (meval_trm t1 x) (meval_trm t2 x) = p)"
 
 primrec (in maux) meval :: "nat \<Rightarrow> ts \<Rightarrow> Formula.database \<Rightarrow> ('msaux, 'muaux) mformula \<Rightarrow>
     event_data table list \<times> ('msaux, 'muaux) mformula" where
   "meval n t db (MRel rel) = ([rel], MRel rel)"
 | "meval n t db (MPred e ts) = (map (\<lambda>X. (\<lambda>f. Table.tabulate f 0 n) ` Option.these
     (match ts ` X)) (case Mapping.lookup db e of None \<Rightarrow> [{}] | Some xs \<Rightarrow> xs), MPred e ts)"
 | "meval n t db (MLet p m \<phi> \<psi>) =
     (let (xs, \<phi>) = meval m t db \<phi>; (ys, \<psi>) = meval n t (Mapping.update p (map (image (map the)) xs) db) \<psi>
     in (ys, MLet p m \<phi> \<psi>))"
 | "meval n t db (MAnd A_\<phi> \<phi> pos A_\<psi> \<psi> buf) =
     (let (xs, \<phi>) = meval n t db \<phi>; (ys, \<psi>) = meval n t db \<psi>;
       (zs, buf) = mbuf2_take (\<lambda>r1 r2. bin_join n A_\<phi> r1 pos A_\<psi> r2) (mbuf2_add xs ys buf)
     in (zs, MAnd A_\<phi> \<phi> pos A_\<psi> \<psi> buf))"
 | "meval n t db (MAndAssign \<phi> conf) =
     (let (xs, \<phi>) = meval n t db \<phi> in (map (\<lambda>r. eval_assignment conf ` r) xs, MAndAssign \<phi> conf))"
 | "meval n t db (MAndRel \<phi> conf) =
     (let (xs, \<phi>) = meval n t db \<phi> in (map (Set.filter (eval_constraint conf)) xs, MAndRel \<phi> conf))"
 | "meval n t db (MAnds A_pos A_neg L buf) =
     (let R = map (meval n t db) L in
     let buf = mbufn_add (map fst R) buf in
     let (zs, buf) = mbufn_take (\<lambda>xs zs. zs @ [mmulti_join n A_pos A_neg xs]) [] buf in
     (zs, MAnds A_pos A_neg (map snd R) buf))"
 | "meval n t db (MOr \<phi> \<psi> buf) =
     (let (xs, \<phi>) = meval n t db \<phi>; (ys, \<psi>) = meval n t db \<psi>;
       (zs, buf) = mbuf2_take (\<lambda>r1 r2. r1 \<union> r2) (mbuf2_add xs ys buf)
     in (zs, MOr \<phi> \<psi> buf))"
 | "meval n t db (MNeg \<phi>) =
     (let (xs, \<phi>) = meval n t db \<phi> in (map (\<lambda>r. (if r = empty_table then unit_table n else empty_table)) xs, MNeg \<phi>))"
 | "meval n t db (MExists \<phi>) =
     (let (xs, \<phi>) = meval (Suc n) t db \<phi> in (map (\<lambda>r. tl ` r) xs, MExists \<phi>))"
 | "meval n t db (MAgg g0 y \<omega> b f \<phi>) =
     (let (xs, \<phi>) = meval (b + n) t db \<phi> in (map (eval_agg n g0 y \<omega> b f) xs, MAgg g0 y \<omega> b f \<phi>))"
 | "meval n t db (MPrev I \<phi> first buf nts) =
     (let (xs, \<phi>) = meval n t db \<phi>;
       (zs, buf, nts) = mprev_next I (buf @ xs) (nts @ [t])
     in (if first then empty_table # zs else zs, MPrev I \<phi> False buf nts))"
 | "meval n t db (MNext I \<phi> first nts) =
     (let (xs, \<phi>) = meval n t db \<phi>;
       (xs, first) = (case (xs, first) of (_ # xs, True) \<Rightarrow> (xs, False) | a \<Rightarrow> a);
       (zs, _, nts) = mprev_next I xs (nts @ [t])
     in (zs, MNext I \<phi> first nts))"
 | "meval n t db (MSince args \<phi> \<psi> buf nts aux) =
     (let (xs, \<phi>) = meval n t db \<phi>; (ys, \<psi>) = meval n t db \<psi>;
       ((zs, aux), buf, nts) = mbuf2t_take (\<lambda>r1 r2 t (zs, aux).
         let (z, aux) = update_since args r1 r2 t aux
         in (zs @ [z], aux)) ([], aux) (mbuf2_add xs ys buf) (nts @ [t])
     in (zs, MSince args \<phi> \<psi> buf nts aux))"
 | "meval n t db (MUntil args \<phi> \<psi> buf nts aux) =
     (let (xs, \<phi>) = meval n t db \<phi>; (ys, \<psi>) = meval n t db \<psi>;
       (aux, buf, nts) = mbuf2t_take (add_new_muaux args) aux (mbuf2_add xs ys buf) (nts @ [t]);
       (zs, aux) = eval_muaux args (case nts of [] \<Rightarrow> t | nt # _ \<Rightarrow> nt) aux
     in (zs, MUntil args \<phi> \<psi> buf nts aux))"
 | "meval n t db (MMatchP I mr mrs \<phi>s buf nts aux) =
     (let (xss, \<phi>s) = map_split id (map (meval n t db) \<phi>s);
       ((zs, aux), buf, nts) = mbufnt_take (\<lambda>rels t (zs, aux).
         let (z, aux) = update_matchP n I mr mrs rels t aux
         in (zs @ [z], aux)) ([], aux) (mbufn_add xss buf) (nts @ [t])
     in (zs, MMatchP I mr mrs \<phi>s buf nts aux))"
 | "meval n t db (MMatchF I mr mrs \<phi>s buf nts aux) =
     (let (xss, \<phi>s) = map_split id (map (meval n t db) \<phi>s);
       (aux, buf, nts) = mbufnt_take (update_matchF n I mr mrs) aux (mbufn_add xss buf) (nts @ [t]);
       (zs, aux) = eval_matchF I mr (case nts of [] \<Rightarrow> t | nt # _ \<Rightarrow> nt) aux
     in (zs, MMatchF I mr mrs \<phi>s buf nts aux))"
 
 definition (in maux) mstep :: "Formula.database \<times> ts \<Rightarrow> ('msaux, 'muaux) mstate \<Rightarrow> (nat \<times> event_data table) list \<times> ('msaux, 'muaux) mstate" where
   "mstep tdb st =
      (let (xs, m) = meval (mstate_n st) (snd tdb) (fst tdb) (mstate_m st)
      in (List.enumerate (mstate_i st) xs,
       \<lparr>mstate_i = mstate_i st + length xs, mstate_m = m, mstate_n = mstate_n st\<rparr>))"
 
 subsection \<open>Verdict delay\<close>
 
 context fixes \<sigma> :: Formula.trace begin
 
 fun progress :: "(Formula.name \<rightharpoonup> nat) \<Rightarrow> Formula.formula \<Rightarrow> nat \<Rightarrow> nat" where
   "progress P (Formula.Pred e ts) j = (case P e of None \<Rightarrow> j | Some k \<Rightarrow> k)"
 | "progress P (Formula.Let p \<phi> \<psi>) j = progress (P(p \<mapsto> progress P \<phi> j)) \<psi> j"
 | "progress P (Formula.Eq t1 t2) j = j"
 | "progress P (Formula.Less t1 t2) j = j"
 | "progress P (Formula.LessEq t1 t2) j = j"
 | "progress P (Formula.Neg \<phi>) j = progress P \<phi> j"
 | "progress P (Formula.Or \<phi> \<psi>) j = min (progress P \<phi> j) (progress P \<psi> j)"
 | "progress P (Formula.And \<phi> \<psi>) j = min (progress P \<phi> j) (progress P \<psi> j)"
 | "progress P (Formula.Ands l) j = (if l = [] then j else Min (set (map (\<lambda>\<phi>. progress P \<phi> j) l)))"
 | "progress P (Formula.Exists \<phi>) j = progress P \<phi> j"
 | "progress P (Formula.Agg y \<omega> b f \<phi>) j = progress P \<phi> j"
 | "progress P (Formula.Prev I \<phi>) j = (if j = 0 then 0 else min (Suc (progress P \<phi> j)) j)"
 | "progress P (Formula.Next I \<phi>) j = progress P \<phi> j - 1"
 | "progress P (Formula.Since \<phi> I \<psi>) j = min (progress P \<phi> j) (progress P \<psi> j)"
 | "progress P (Formula.Until \<phi> I \<psi>) j =
     Inf {i. \<forall>k. k < j \<and> k \<le> min (progress P \<phi> j) (progress P \<psi> j) \<longrightarrow> \<tau> \<sigma> i + right I \<ge> \<tau> \<sigma> k}"
 | "progress P (Formula.MatchP I r) j = min_regex_default (progress P) r j"
 | "progress P (Formula.MatchF I r) j =
     Inf {i. \<forall>k. k < j \<and> k \<le> min_regex_default (progress P) r j \<longrightarrow> \<tau> \<sigma> i + right I \<ge> \<tau> \<sigma> k}"
 
 definition "progress_regex P = min_regex_default (progress P)"
 
 declare progress.simps[simp del]
 lemmas progress_simps[simp] = progress.simps[folded progress_regex_def[THEN fun_cong, THEN fun_cong]]
 
 end
 
 definition "pred_mapping Q = pred_fun (\<lambda>_. True) (pred_option Q)"
 definition "rel_mapping Q = rel_fun (=) (rel_option Q)"
 
 lemma pred_mapping_alt: "pred_mapping Q P = (\<forall>p \<in> dom P. Q (the (P p)))"
   unfolding pred_mapping_def pred_fun_def option.pred_set dom_def
   by (force split: option.splits)
 
 lemma rel_mapping_alt: "rel_mapping Q P P' = (dom P = dom P' \<and> (\<forall>p \<in> dom P. Q (the (P p)) (the (P' p))))"
   unfolding rel_mapping_def rel_fun_def rel_option_iff dom_def
   by (force split: option.splits)
 
 lemma rel_mapping_map_upd[simp]: "Q x y \<Longrightarrow> rel_mapping Q P P' \<Longrightarrow> rel_mapping Q (P(p \<mapsto> x)) (P'(p \<mapsto> y))"
   by (auto simp: rel_mapping_alt)
 
 lemma pred_mapping_map_upd[simp]: "Q x \<Longrightarrow> pred_mapping Q P \<Longrightarrow> pred_mapping Q (P(p \<mapsto> x))"
   by (auto simp: pred_mapping_alt)
 
 lemma pred_mapping_empty[simp]: "pred_mapping Q Map.empty"
   by (auto simp: pred_mapping_alt)
 
 lemma pred_mapping_mono: "pred_mapping Q P \<Longrightarrow> Q \<le> R \<Longrightarrow> pred_mapping R P"
   by (auto simp: pred_mapping_alt)
 
 lemma pred_mapping_mono_strong: "pred_mapping Q P \<Longrightarrow>
   (\<And>p. p \<in> dom P \<Longrightarrow> Q (the (P p)) \<Longrightarrow> R (the (P p))) \<Longrightarrow> pred_mapping R P"
   by (auto simp: pred_mapping_alt)
 
 lemma progress_mono_gen: "j \<le> j' \<Longrightarrow> rel_mapping (\<le>) P P' \<Longrightarrow> progress \<sigma> P \<phi> j \<le> progress \<sigma> P' \<phi> j'"
 proof (induction \<phi> arbitrary: P P')
   case (Pred e ts)
   then show ?case
     by (force simp: rel_mapping_alt dom_def split: option.splits)
 next
   case (Ands l)
   then show ?case
     by (auto simp: image_iff intro!: Min.coboundedI[THEN order_trans])
 next
   case (Until \<phi> I \<psi>)
   from Until(1,2)[of P P'] Until.prems show ?case
     by (cases "right I")
       (auto dest: trans_le_add1[OF \<tau>_mono] intro!: cInf_superset_mono)
 next
   case (MatchF I r)
   from MatchF(1)[of _ P P'] MatchF.prems show ?case
     by (cases "right I"; cases "regex.atms r = {}")
       (auto 0 3 simp: Min_le_iff progress_regex_def dest: trans_le_add1[OF \<tau>_mono]
         intro!: cInf_superset_mono elim!: less_le_trans order_trans)
 qed (force simp: Min_le_iff progress_regex_def split: option.splits)+
 
 lemma rel_mapping_reflp: "reflp Q \<Longrightarrow> rel_mapping Q P P"
   by (auto simp: rel_mapping_alt reflp_def)
 
 lemmas progress_mono = progress_mono_gen[OF _ rel_mapping_reflp[unfolded reflp_def], simplified]
 
 lemma progress_le_gen: "pred_mapping (\<lambda>x. x \<le> j) P \<Longrightarrow> progress \<sigma> P \<phi> j \<le> j"
 proof (induction \<phi> arbitrary: P)
   case (Pred e ts)
   then show ?case
     by (auto simp: pred_mapping_alt dom_def split: option.splits)
 next
   case (Ands l)
   then show ?case
     by (auto simp: image_iff intro!: Min.coboundedI[where a="progress \<sigma> P (hd l) j", THEN order_trans])
 next
   case (Until \<phi> I \<psi>)
   then show ?case
     by (cases "right I")
       (auto intro: trans_le_add1[OF \<tau>_mono] intro!: cInf_lower)
 next
   case (MatchF I r)
   then show ?case
     by (cases "right I")
       (auto intro: trans_le_add1[OF \<tau>_mono] intro!: cInf_lower)
 qed (force simp: Min_le_iff progress_regex_def split: option.splits)+
 
 lemma progress_le: "progress \<sigma> Map.empty \<phi> j \<le> j"
   using progress_le_gen[of _ Map.empty] by auto
 
 lemma progress_0_gen[simp]:
   "pred_mapping (\<lambda>x. x = 0) P \<Longrightarrow> progress \<sigma> P \<phi> 0 = 0"
   using progress_le_gen[of 0 P] by auto
 
 lemma progress_0[simp]:
   "progress \<sigma> Map.empty \<phi> 0 = 0"
   by (auto simp: pred_mapping_alt)
 
 definition max_mapping :: "('b \<Rightarrow> 'a option) \<Rightarrow> ('b \<Rightarrow> 'a option) \<Rightarrow> 'b \<Rightarrow> ('a :: linorder) option" where
   "max_mapping P P' x = (case (P x, P' x) of
     (None, None) \<Rightarrow> None
   | (Some x, None) \<Rightarrow> None
   | (None, Some x) \<Rightarrow> None
   | (Some x, Some y) \<Rightarrow> Some (max x y))"
 
 definition Max_mapping :: "('b \<Rightarrow> 'a option) set \<Rightarrow> 'b \<Rightarrow> ('a :: linorder) option" where
   "Max_mapping Ps x = (if (\<forall>P \<in> Ps. P x \<noteq> None) then Some (Max ((\<lambda>P. the (P x)) ` Ps)) else None)"
 
 lemma dom_max_mapping[simp]: "dom (max_mapping P1 P2) = dom P1 \<inter> dom P2"
   unfolding max_mapping_def by (auto split: option.splits)
 
 lemma dom_Max_mapping[simp]: "dom (Max_mapping X) = (\<Inter>P \<in> X. dom P)"
   unfolding Max_mapping_def by (auto split: if_splits)
 
 lemma Max_mapping_coboundedI:
   assumes "finite X" "\<forall>Q \<in> X. dom Q = dom P" "P \<in> X"
   shows "rel_mapping (\<le>) P (Max_mapping X)"
   unfolding rel_mapping_alt
 proof (intro conjI ballI)
   from assms(3) have "X \<noteq> {}" by auto
   then show "dom P = dom (Max_mapping X)" using assms(2) by auto
 next
   fix p
   assume "p \<in> dom P"
   with assms show "the (P p) \<le> the (Max_mapping X p)"
     by (force simp add: Max_mapping_def intro!: Max.coboundedI imageI)
 qed
 
 lemma rel_mapping_trans: "P OO Q \<le> R \<Longrightarrow>
   rel_mapping P P1 P2 \<Longrightarrow> rel_mapping Q P2 P3 \<Longrightarrow> rel_mapping R P1 P3"
   by (force simp: rel_mapping_alt dom_def set_eq_iff)
 
 abbreviation range_mapping :: "nat \<Rightarrow> nat \<Rightarrow> ('b \<Rightarrow> nat option) \<Rightarrow> bool" where
   "range_mapping i j P \<equiv> pred_mapping (\<lambda>x. i \<le> x \<and> x \<le> j) P"
 
 lemma range_mapping_relax:
   "range_mapping i j P \<Longrightarrow> i' \<le> i \<Longrightarrow> j' \<ge> j \<Longrightarrow> range_mapping i' j' P"
   by (auto simp: pred_mapping_alt dom_def set_eq_iff max_mapping_def split: option.splits)
 
 lemma range_mapping_max_mapping[simp]:
   "range_mapping i j1 P1 \<Longrightarrow> range_mapping i j2 P2 \<Longrightarrow> range_mapping i (max j1 j2) (max_mapping P1 P2)"
   by (auto simp: pred_mapping_alt dom_def set_eq_iff max_mapping_def split: option.splits)
 
 lemma range_mapping_Max_mapping[simp]:
   "finite X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<forall>x\<in>X. range_mapping i (j x) (P x) \<Longrightarrow> range_mapping i (Max (j ` X)) (Max_mapping (P ` X))"
   by (force simp: pred_mapping_alt Max_mapping_def dom_def image_iff
       intro!: Max_ge_iff[THEN iffD2] split: if_splits)
 
 lemma pred_mapping_le:
   "pred_mapping ((\<le>) i) P1 \<Longrightarrow> rel_mapping (\<le>) P1 P2 \<Longrightarrow> pred_mapping ((\<le>) (i :: nat)) P2"
   by (force simp: rel_mapping_alt pred_mapping_alt dom_def set_eq_iff)
 
 lemma pred_mapping_le':
   "pred_mapping ((\<le>) j) P1 \<Longrightarrow> i \<le> j \<Longrightarrow> rel_mapping (\<le>) P1 P2 \<Longrightarrow> pred_mapping ((\<le>) (i :: nat)) P2"
   by (force simp: rel_mapping_alt pred_mapping_alt dom_def set_eq_iff)
 
 lemma max_mapping_cobounded1: "dom P1 \<subseteq> dom P2 \<Longrightarrow> rel_mapping (\<le>) P1 (max_mapping P1 P2)"
   unfolding max_mapping_def rel_mapping_alt by (auto simp: dom_def split: option.splits)
 
 lemma max_mapping_cobounded2: "dom P2 \<subseteq> dom P1 \<Longrightarrow> rel_mapping (\<le>) P2 (max_mapping P1 P2)"
   unfolding max_mapping_def rel_mapping_alt by (auto simp: dom_def split: option.splits)
 
 lemma max_mapping_fun_upd2[simp]:
-  "max_mapping P1 (P2(p := y))(p \<mapsto> x) = (max_mapping P1 P2)(p \<mapsto> x)"
+  "(max_mapping P1 (P2(p := y)))(p \<mapsto> x) = (max_mapping P1 P2)(p \<mapsto> x)"
   by (auto simp: max_mapping_def)
 
 lemma rel_mapping_max_mapping_fun_upd: "dom P2 \<subseteq> dom P1 \<Longrightarrow> p \<in> dom P2 \<Longrightarrow> the (P2 p) \<le> y \<Longrightarrow>
-  rel_mapping (\<le>) P2 (max_mapping P1 P2(p \<mapsto> y))"
+  rel_mapping (\<le>) P2 ((max_mapping P1 P2)(p \<mapsto> y))"
   by (auto simp: rel_mapping_alt max_mapping_def split: option.splits)
 
 lemma progress_ge_gen: "Formula.future_bounded \<phi> \<Longrightarrow>
    \<exists>P j. dom P = S \<and> range_mapping i j P \<and> i \<le> progress \<sigma> P \<phi> j"
 proof (induction \<phi> arbitrary: i S)
   case (Pred e ts)
   then show ?case
     by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"])
       (auto split: option.splits if_splits simp: rel_mapping_alt pred_mapping_alt dom_def)
 next
   case (Let p \<phi> \<psi>)
   from Let.prems obtain P2 j2 where P2: "dom P2 = insert p S" "range_mapping i j2 P2"
     "i \<le> progress \<sigma> P2 \<psi> j2"
     by (atomize_elim, intro Let(2)) (force simp: pred_mapping_alt rel_mapping_alt dom_def)+
   from Let.prems obtain P1 j1 where P1: "dom P1 = S" "range_mapping (the (P2 p)) j1 P1"
     "the (P2 p) \<le> progress \<sigma> P1 \<phi> j1"
     by (atomize_elim, intro Let(1)) auto
   let ?P12 = "max_mapping P1 P2"
   from P1 P2 have le1: "progress \<sigma> P1 \<phi> j1 \<le> progress \<sigma> (?P12(p := P1 p)) \<phi> (max j1 j2)"
     by (intro progress_mono_gen) (auto simp: rel_mapping_alt max_mapping_def)
   from P1 P2 have le2: "progress \<sigma> P2 \<psi> j2 \<le> progress \<sigma> (?P12(p \<mapsto> progress \<sigma> P1 \<phi> j1)) \<psi> (max j1 j2)"
     by (intro progress_mono_gen) (auto simp: rel_mapping_alt max_mapping_def)
   show ?case
     unfolding progress.simps
   proof (intro exI[of _ "?P12(p := P1 p)"] exI[of _ "max j1 j2"] conjI)
     show "dom (?P12(p := P1 p)) = S"
       using P1 P2 by (auto simp: dom_def max_mapping_def)
   next
     show "range_mapping i (max j1 j2) (?P12(p := P1 p))"
       using P1 P2 by (force simp add: pred_mapping_alt dom_def max_mapping_def split: option.splits)
   next
     have "i \<le> progress \<sigma> P2 \<psi> j2" by fact
     also have "... \<le> progress \<sigma> (?P12(p \<mapsto> progress \<sigma> P1 \<phi> j1)) \<psi> (max j1 j2)"
       using le2 by blast
-    also have "... \<le> progress \<sigma> (?P12(p := P1 p)(p\<mapsto>progress \<sigma> (?P12(p := P1 p)) \<phi> (max j1 j2))) \<psi> (max j1 j2)"
+    also have "... \<le> progress \<sigma> ((?P12(p := P1 p))(p\<mapsto>progress \<sigma> (?P12(p := P1 p)) \<phi> (max j1 j2))) \<psi> (max j1 j2)"
       by (auto intro!: progress_mono_gen simp: le1 rel_mapping_alt)
     finally show "i \<le> ..." .
   qed
 next
   case (Eq _ _)
   then show ?case
     by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
 next
   case (Less _ _)
   then show ?case
     by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
 next
   case (LessEq _ _)
   then show ?case
     by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
 next
   case (Or \<phi>1 \<phi>2)
   from Or(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i \<le> progress \<sigma> P1 \<phi>1 j1"
     using Or(1)[of S i] by auto
   moreover
   from Or(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i \<le> progress \<sigma> P2 \<phi>2 j2"
     using Or(2)[of S i] by auto
   ultimately have "i \<le> progress \<sigma> (max_mapping P1 P2) (Formula.Or \<phi>1 \<phi>2) (max j1 j2)"
     by (auto 0 3 elim!: order.trans[OF _ progress_mono_gen] intro: max_mapping_cobounded1 max_mapping_cobounded2)
   with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) auto
 next
   case (And \<phi>1 \<phi>2)
   from And(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i \<le> progress \<sigma> P1 \<phi>1 j1"
     using And(1)[of S i] by auto
   moreover
   from And(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i \<le> progress \<sigma> P2 \<phi>2 j2"
     using And(2)[of S i] by auto
   ultimately have "i \<le> progress \<sigma> (max_mapping P1 P2) (Formula.And \<phi>1 \<phi>2) (max j1 j2)"
     by (auto 0 3 elim!: order.trans[OF _ progress_mono_gen] intro: max_mapping_cobounded1 max_mapping_cobounded2)
   with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) auto
 next
   case (Ands l)
   show ?case proof (cases "l = []")
     case True
     then show ?thesis
       by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"])
         (auto split: if_splits simp: pred_mapping_alt)
   next
     case False
     then obtain \<phi> where "\<phi> \<in> set l" by (cases l) auto
     from Ands.prems have "\<forall>\<phi>\<in>set l. Formula.future_bounded \<phi>"
       by (simp add: list.pred_set)
     { fix \<phi>
       assume "\<phi> \<in> set l"
       with Ands.prems obtain P j where "dom P = S" "range_mapping i j P" "i \<le> progress \<sigma> P \<phi> j"
         by (atomize_elim, intro Ands(1)[of \<phi> S i]) (auto simp: list.pred_set)
       then have "\<exists>Pj. dom (fst Pj) = S \<and> range_mapping i (snd Pj) (fst Pj) \<and> i \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj)"
         (is "\<exists>Pj. ?P Pj")
         by (intro exI[of _ "(P, j)"]) auto
     }
     then have "\<forall>\<phi>\<in>set l. \<exists>Pj. dom (fst Pj) = S \<and> range_mapping i (snd Pj) (fst Pj) \<and> i \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj)"
       (is "\<forall>\<phi>\<in>set l. \<exists>Pj. ?P Pj \<phi>")
       by blast
     with Ands(1) Ands.prems False have "\<exists>Pjf. \<forall>\<phi>\<in>set l. ?P (Pjf \<phi>) \<phi>"
       by (auto simp: Ball_def intro: choice)
     then obtain Pjf where Pjf: "\<forall>\<phi>\<in>set l. ?P (Pjf \<phi>) \<phi>" ..
     define Pf where "Pf = fst o Pjf"
     define jf where "jf = snd o Pjf"
     have *: "dom (Pf \<phi>) = S" "range_mapping i (jf \<phi>) (Pf \<phi>)" "i \<le> progress \<sigma> (Pf \<phi>) \<phi> (jf \<phi>)"
       if "\<phi> \<in> set l" for \<phi>
       using Pjf[THEN bspec, OF that] unfolding Pf_def jf_def by auto
     with False show ?thesis
       unfolding progress.simps eq_False[THEN iffD2, OF False] if_False
       by ((subst Min_ge_iff; simp add: False),
           intro exI[where x="MAX \<phi>\<in>set l. jf \<phi>"] exI[where x="Max_mapping (Pf ` set l)"]
           conjI ballI order.trans[OF *(3) progress_mono_gen] Max_mapping_coboundedI)
         (auto simp: False *[OF \<open>\<phi> \<in> set l\<close>] \<open>\<phi> \<in> set l\<close>)
   qed
 next
   case (Exists \<phi>)
   then show ?case by simp
 next
   case (Prev I \<phi>)
   then obtain P j where "dom P = S" "range_mapping i j P" "i \<le> progress \<sigma> P \<phi> j"
     by (atomize_elim, intro Prev(1)) (auto simp: pred_mapping_alt dom_def)
   with Prev(2) have
     "dom P = S \<and> range_mapping i (max i j) P \<and> i \<le> progress \<sigma> P (formula.Prev I \<phi>) (max i j)"
     by (auto simp: le_Suc_eq max_def pred_mapping_alt split: if_splits
         elim: order.trans[OF _ progress_mono])
   then show ?case by blast
 next
   case (Next I \<phi>)
   then obtain P j where "dom P = S" "range_mapping (Suc i) j P" "Suc i \<le> progress \<sigma> P \<phi> j"
     by (atomize_elim, intro Next(1)) (auto simp: pred_mapping_alt dom_def)
   then show ?case
     by (intro exI[of _ P] exI[of _ j]) (auto 0 3 simp: pred_mapping_alt dom_def)
 next
   case (Since \<phi>1 I \<phi>2)
   from Since(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i \<le> progress \<sigma> P1 \<phi>1 j1"
     using Since(1)[of S i] by auto
   moreover
   from Since(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i \<le> progress \<sigma> P2 \<phi>2 j2"
     using Since(2)[of S i] by auto
   ultimately have "i \<le> progress \<sigma> (max_mapping P1 P2) (Formula.Since \<phi>1 I \<phi>2) (max j1 j2)"
     by (auto elim!: order.trans[OF _ progress_mono_gen] simp: max_mapping_cobounded1 max_mapping_cobounded2)
   with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"])
       (auto elim!: pred_mapping_le intro: max_mapping_cobounded1)
 next
   case (Until \<phi>1 I \<phi>2)
   from Until.prems obtain b where [simp]: "right I = enat b"
     by (cases "right I") (auto)
   obtain i' where "i < i'" and "\<tau> \<sigma> i + b + 1 \<le> \<tau> \<sigma> i'"
     using ex_le_\<tau>[where x="\<tau> \<sigma> i + b + 1"] by (auto simp add: less_eq_Suc_le)
   then have 1: "\<tau> \<sigma> i + b < \<tau> \<sigma> i'" by simp
   from Until.prems obtain P1 j1 where P1: "dom P1 = S" "range_mapping (Suc i') j1 P1" "Suc i' \<le> progress \<sigma> P1 \<phi>1 j1"
     by (atomize_elim, intro Until(1)) (auto simp: pred_mapping_alt dom_def)
   from Until.prems obtain P2 j2 where P2: "dom P2 = S" "range_mapping (Suc i') j2 P2" "Suc i' \<le> progress \<sigma> P2 \<phi>2 j2"
     by (atomize_elim, intro Until(2)) (auto simp: pred_mapping_alt dom_def)
   let ?P12 = "max_mapping P1 P2"
   have "i \<le> progress \<sigma> ?P12 (Formula.Until \<phi>1 I \<phi>2) (max j1 j2)"
     unfolding progress.simps
   proof (intro cInf_greatest, goal_cases nonempty greatest)
     case nonempty
     then show ?case
       by (auto simp: trans_le_add1[OF \<tau>_mono] intro!: exI[of _ "max j1 j2"])
   next
     case (greatest x)
     from P1(2,3) have "i' < j1"
       by (auto simp: less_eq_Suc_le intro!: progress_le_gen elim!: order.trans pred_mapping_mono_strong)
     then have "i' < max j1 j2" by simp
     have "progress \<sigma> P1 \<phi>1 j1 \<le> progress \<sigma> ?P12 \<phi>1 (max j1 j2)"
       using P1(1) P2(1) by (auto intro!: progress_mono_gen max_mapping_cobounded1)
     moreover have "progress \<sigma> P2 \<phi>2 j2 \<le> progress \<sigma> ?P12 \<phi>2 (max j1 j2)"
       using P1(1) P2(1) by (auto intro!: progress_mono_gen max_mapping_cobounded2)
     ultimately have "i' \<le> min (progress \<sigma> ?P12 \<phi>1 (max j1 j2)) (progress \<sigma> ?P12 \<phi>2 (max j1 j2))"
       using P1(3) P2(3) by simp
     with greatest \<open>i' < max j1 j2\<close> have "\<tau> \<sigma> i' \<le> \<tau> \<sigma> x + b"
       by simp
     with 1 have "\<tau> \<sigma> i < \<tau> \<sigma> x" by simp
     then show ?case by (auto dest!: less_\<tau>D)
   qed
   with P1 P2 \<open>i < i'\<close> show ?case
     by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) (auto simp: range_mapping_relax)
 next
   case (MatchP I r)
   then show ?case
   proof (cases "regex.atms r = {}")
     case True
     with MatchP.prems show ?thesis
       unfolding progress.simps
       by (intro exI[of _ "\<lambda>e. if e \<in> S then Some i else None"] exI[of _ i])
         (auto split: if_splits simp: pred_mapping_alt regex.pred_set)
   next
     case False
     define pick where "pick = (\<lambda>\<phi>. SOME Pj. dom (fst Pj) = S \<and> range_mapping i (snd Pj) (fst Pj) \<and>
        i \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj))"
     let ?pickP = "fst o pick" let ?pickj = "snd o pick"
     from MatchP have pick: "\<phi> \<in> regex.atms r \<Longrightarrow> dom (?pickP \<phi>) = S \<and>
       range_mapping i (?pickj \<phi>) (?pickP \<phi>) \<and> i \<le> progress \<sigma> (?pickP \<phi>) \<phi> (?pickj \<phi>)" for \<phi>
       unfolding pick_def o_def future_bounded.simps regex.pred_set
       by (intro someI_ex[where P = "\<lambda>Pj. dom (fst Pj) = S \<and> range_mapping i (snd Pj) (fst Pj) \<and>
          i \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj)"]) auto
     with False show ?thesis
       unfolding progress.simps
       by (intro exI[of _ "Max_mapping (?pickP ` regex.atms r)"] exI[of _ "Max (?pickj ` regex.atms r)"])
         (auto simp: Max_mapping_coboundedI
           order_trans[OF pick[THEN conjunct2, THEN conjunct2] progress_mono_gen])
   qed
 next
   case (MatchF I r)
   from MatchF.prems obtain b where [simp]: "right I = enat b"
     by auto
   obtain i' where i': "i < i'" "\<tau> \<sigma> i + b + 1 \<le> \<tau> \<sigma> i'"
     using ex_le_\<tau>[where x="\<tau> \<sigma> i + b + 1"] by (auto simp add: less_eq_Suc_le)
   then have 1: "\<tau> \<sigma> i + b < \<tau> \<sigma> i'" by simp
   have ix: "i \<le> x" if "\<tau> \<sigma> i' \<le> b + \<tau> \<sigma> x" "b + \<tau> \<sigma> i < \<tau> \<sigma> i'" for x
     using less_\<tau>D[of \<sigma> i] that less_le_trans by fastforce
   show ?case
   proof (cases "regex.atms r = {}")
     case True
     with MatchF.prems i' ix show ?thesis
       unfolding progress.simps
       by (intro exI[of _ "\<lambda>e. if e \<in> S then Some (Suc i') else None"] exI[of _ "Suc i'"])
         (auto split: if_splits simp: pred_mapping_alt regex.pred_set add.commute less_Suc_eq
           intro!: cInf_greatest dest!: spec[of _ i'] less_imp_le[THEN \<tau>_mono, of _ i' \<sigma>])
   next
     case False
     then obtain \<phi> where \<phi>: "\<phi> \<in> regex.atms r" by auto
     define pick where "pick = (\<lambda>\<phi>. SOME Pj. dom (fst Pj) = S \<and> range_mapping (Suc i') (snd Pj) (fst Pj) \<and>
       Suc i' \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj))"
     define pickP where "pickP = fst o pick" define pickj where "pickj = snd o pick"
     from MatchF have pick: "\<phi> \<in> regex.atms r \<Longrightarrow> dom (pickP \<phi>) = S \<and>
     range_mapping (Suc i') (pickj \<phi>) (pickP \<phi>) \<and> Suc i' \<le> progress \<sigma> (pickP \<phi>) \<phi> (pickj \<phi>)" for \<phi>
       unfolding pick_def o_def future_bounded.simps regex.pred_set pickj_def pickP_def
       by (intro someI_ex[where P = "\<lambda>Pj. dom (fst Pj) = S \<and> range_mapping (Suc i') (snd Pj) (fst Pj) \<and>
        Suc i' \<le> progress \<sigma> (fst Pj) \<phi> (snd Pj)"]) auto
     let ?P = "Max_mapping (pickP ` regex.atms r)" let ?j = "Max (pickj ` regex.atms r)"
     from pick[OF \<phi>] False \<phi> have "Suc i' \<le> ?j"
       by (intro order_trans[OF pick[THEN conjunct2, THEN conjunct2], OF \<phi>] order_trans[OF progress_le_gen])
         (auto simp: Max_ge_iff dest: range_mapping_relax[of _ _ _ 0, OF _ _ order_refl, simplified])
     moreover
     note i' 1 ix
     moreover
     from MatchF.prems have "Regex.pred_regex Formula.future_bounded r"
       by auto
     ultimately show ?thesis using \<tau>_mono[of _ ?j \<sigma>] less_\<tau>D[of \<sigma> i] pick False
       by (intro exI[of _ "?j"]  exI[of _ "?P"])
         (auto 0 3 intro!: cInf_greatest
           order_trans[OF le_SucI[OF order_refl] order_trans[OF pick[THEN conjunct2, THEN conjunct2] progress_mono_gen]]
           range_mapping_Max_mapping[OF _ _ ballI[OF range_mapping_relax[of "Suc i'" _ _ i, OF _ _ order_refl]]]
           simp: ac_simps Suc_le_eq trans_le_add2 Max_mapping_coboundedI progress_regex_def
           dest: spec[of _ "i'"] spec[of _ ?j])
   qed
 qed (auto split: option.splits)
 
 lemma progress_ge: "Formula.future_bounded \<phi> \<Longrightarrow> \<exists>j. i \<le> progress \<sigma> Map.empty \<phi> j"
   using progress_ge_gen[of \<phi> "{}" i \<sigma>]
   by auto
 
 lemma cInf_restrict_nat:
   fixes x :: nat
   assumes "x \<in> A"
   shows "Inf A = Inf {y \<in> A. y \<le> x}"
   using assms by (auto intro!: antisym intro: cInf_greatest cInf_lower Inf_nat_def1)
 
 lemma progress_time_conv:
   assumes "\<forall>i<j. \<tau> \<sigma> i = \<tau> \<sigma>' i"
   shows "progress \<sigma> P \<phi> j = progress \<sigma>' P \<phi> j"
   using assms proof (induction \<phi> arbitrary: P)
   case (Until \<phi>1 I \<phi>2)
   have *: "i \<le> j - 1 \<longleftrightarrow> i < j" if "j \<noteq> 0" for i
     using that by auto
   with Until show ?case
   proof (cases "right I")
     case (enat b)
     then show ?thesis
     proof (cases "j")
       case (Suc n)
       with enat * Until show ?thesis
         using \<tau>_mono[THEN trans_le_add1]
         by (auto 8 0
             intro!: box_equals[OF arg_cong[where f=Inf]
               cInf_restrict_nat[symmetric, where x=n] cInf_restrict_nat[symmetric, where x=n]])
     qed simp
   qed simp
 next
   case (MatchF I r)
   have *: "i \<le> j - 1 \<longleftrightarrow> i < j" if "j \<noteq> 0" for i
     using that by auto
   with MatchF show ?case using \<tau>_mono[THEN trans_le_add1]
     by (cases "right I"; cases j)
       ((auto 6 0 simp: progress_le_gen progress_regex_def intro!: box_equals[OF arg_cong[where f=Inf]
             cInf_restrict_nat[symmetric, where x="j-1"] cInf_restrict_nat[symmetric, where x="j-1"]]) [])+
 qed (auto simp: progress_regex_def)
 
 lemma Inf_UNIV_nat: "(Inf UNIV :: nat) = 0"
   by (simp add: cInf_eq_minimum)
 
 lemma progress_prefix_conv:
   assumes "prefix_of \<pi> \<sigma>" and "prefix_of \<pi> \<sigma>'"
   shows "progress \<sigma> P \<phi> (plen \<pi>) = progress \<sigma>' P \<phi> (plen \<pi>)"
   using assms by (auto intro: progress_time_conv \<tau>_prefix_conv)
 
 lemma bounded_rtranclp_mono:
   fixes n :: "'x :: linorder"
   assumes "\<And>i j. R i j \<Longrightarrow> j < n \<Longrightarrow> S i j" "\<And>i j. R i j \<Longrightarrow> i \<le> j"
   shows "rtranclp R i j \<Longrightarrow> j < n \<Longrightarrow> rtranclp S i j"
 proof (induct rule: rtranclp_induct)
   case (step y z)
   then show ?case
     using assms(1,2)[of y z]
     by (auto elim!: rtrancl_into_rtrancl[to_pred, rotated])
 qed auto
 
 lemma sat_prefix_conv_gen:
   assumes "prefix_of \<pi> \<sigma>" and "prefix_of \<pi> \<sigma>'"
   shows "i < progress \<sigma> P \<phi> (plen \<pi>) \<Longrightarrow> dom V = dom V' \<Longrightarrow> dom P = dom V \<Longrightarrow>
     pred_mapping (\<lambda>x. x \<le> plen \<pi>) P \<Longrightarrow>
     (\<And>p i \<phi>. p \<in> dom V \<Longrightarrow> i < the (P p) \<Longrightarrow> the (V p) i = the (V' p) i) \<Longrightarrow>
     Formula.sat \<sigma> V v i \<phi> \<longleftrightarrow> Formula.sat \<sigma>' V' v i \<phi>"
 proof (induction \<phi> arbitrary: P V V' v i)
   case (Pred e ts)
   from Pred.prems(1,4) have "i < plen \<pi>"
     by (blast intro!: order.strict_trans2 progress_le_gen)
   show ?case proof (cases "V e")
     case None
     then have "V' e = None" using \<open>dom V = dom V'\<close> by auto
     with None \<Gamma>_prefix_conv[OF assms(1,2) \<open>i < plen \<pi>\<close>] show ?thesis by simp
   next
     case (Some a)
     obtain a' where "V' e = Some a'" using Some \<open>dom V = dom V'\<close> by auto
     then have "i < the (P e)"
       using Pred.prems(1-3) by (auto split: option.splits)
     then have "the (V e) i = the (V' e) i"
       using Some by (intro Pred.prems(5)) (simp_all add: domI)
     with Some \<open>V' e = Some a'\<close> show ?thesis by simp
   qed
 next
   case (Let p \<phi> \<psi>)
   let ?V = "\<lambda>V \<sigma>. (V(p \<mapsto> \<lambda>i. {v. length v = Formula.nfv \<phi> \<and> Formula.sat \<sigma> V v i \<phi>}))"
   show ?case unfolding sat.simps proof (rule Let.IH(2))
     from Let.prems show "i < progress \<sigma> (P(p \<mapsto> progress \<sigma> P \<phi> (plen \<pi>))) \<psi> (plen \<pi>)"
       by simp
     from Let.prems show "dom (?V V \<sigma>) = dom (?V V' \<sigma>')"
       by simp
     from Let.prems show "dom (P(p \<mapsto> progress \<sigma> P \<phi> (plen \<pi>))) = dom (?V V \<sigma>)"
       by simp
     from Let.prems show "pred_mapping (\<lambda>x. x \<le> plen \<pi>) (P(p \<mapsto> progress \<sigma> P \<phi> (plen \<pi>)))"
       by (auto intro!: pred_mapping_map_upd elim!: progress_le_gen)
   next
     fix p' i \<phi>'
     assume 1: "p' \<in> dom (?V V \<sigma>)" and 2: "i < the ((P(p \<mapsto> progress \<sigma> P \<phi> (plen \<pi>))) p')"
     show "the (?V V \<sigma> p') i = the (?V V' \<sigma>' p') i" proof (cases "p' = p")
       case True
       with Let 2 show ?thesis by auto
     next
       case False
       with 1 2 show ?thesis by (auto intro!: Let.prems(5))
     qed
   qed
 next
   case (Eq t1 t2)
   show ?case by simp
 next
   case (Neg \<phi>)
   then show ?case by simp
 next
   case (Or \<phi>1 \<phi>2)
   then show ?case by auto
 next
   case (Ands l)
   from Ands.prems have "\<forall>\<phi>\<in>set l. i < progress \<sigma> P \<phi> (plen \<pi>)"
     by (cases l) simp_all
   with Ands show ?case unfolding sat_Ands by blast
 next
   case (Exists \<phi>)
   then show ?case by simp
 next
   case (Prev I \<phi>)
   with \<tau>_prefix_conv[OF assms(1,2)] show ?case
     by (cases i) (auto split: if_splits)
 next
   case (Next I \<phi>)
   then have "Suc i < plen \<pi>"
     by (auto intro: order.strict_trans2[OF _ progress_le_gen[of _ P \<sigma> \<phi>]])
   with Next.prems \<tau>_prefix_conv[OF assms(1,2)] show ?case
     unfolding sat.simps
     by (intro conj_cong Next) auto
 next
   case (Since \<phi>1 I \<phi>2)
   then have "i < plen \<pi>"
     by (auto elim!: order.strict_trans2[OF _ progress_le_gen])
   with Since.prems \<tau>_prefix_conv[OF assms(1,2)] show ?case
     unfolding sat.simps
     by (intro conj_cong ex_cong ball_cong Since) auto
 next
   case (Until \<phi>1 I \<phi>2)
   from Until.prems obtain b where right[simp]: "right I = enat b"
     by (cases "right I") (auto simp add: Inf_UNIV_nat)
   from Until.prems obtain j where "\<tau> \<sigma> i + b + 1 \<le> \<tau> \<sigma> j"
     "j \<le> progress \<sigma> P \<phi>1 (plen \<pi>)" "j \<le> progress \<sigma> P \<phi>2 (plen \<pi>)"
     by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le intro: Suc_leI dest: spec[of _ "i"]
         dest!: le_cInf_iff[THEN iffD1, rotated -1])
   then have 1: "k < progress \<sigma> P \<phi>1 (plen \<pi>)" and 2: "k < progress \<sigma> P \<phi>2 (plen \<pi>)"
     if "\<tau> \<sigma> k \<le> \<tau> \<sigma> i + b" for k
     using that by (fastforce elim!: order.strict_trans2[rotated] intro: less_\<tau>D[of \<sigma>])+
   have 3: "k < plen \<pi>" if "\<tau> \<sigma> k \<le> \<tau> \<sigma> i + b" for k
     using 1[OF that] Until(6) by (auto simp only: less_eq_Suc_le order.trans[OF _ progress_le_gen])
 
   from Until.prems have "i < progress \<sigma>' P (Formula.Until \<phi>1 I \<phi>2) (plen \<pi>)"
     unfolding progress_prefix_conv[OF assms(1,2)] by blast
   then obtain j where "\<tau> \<sigma>' i + b + 1 \<le> \<tau> \<sigma>' j"
     "j \<le> progress \<sigma>' P \<phi>1 (plen \<pi>)" "j \<le> progress \<sigma>' P \<phi>2 (plen \<pi>)"
     by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le intro: Suc_leI dest: spec[of _ "i"]
         dest!: le_cInf_iff[THEN iffD1, rotated -1])
   then have 11: "k < progress \<sigma> P \<phi>1 (plen \<pi>)" and 21: "k < progress \<sigma> P \<phi>2 (plen \<pi>)"
     if "\<tau> \<sigma>' k \<le> \<tau> \<sigma>' i + b" for k
     unfolding progress_prefix_conv[OF assms(1,2)]
     using that by (fastforce elim!: order.strict_trans2[rotated] intro: less_\<tau>D[of \<sigma>'])+
   have 31: "k < plen \<pi>" if "\<tau> \<sigma>' k \<le> \<tau> \<sigma>' i + b" for k
     using 11[OF that] Until(6) by (auto simp only: less_eq_Suc_le order.trans[OF _ progress_le_gen])
   show ?case unfolding sat.simps
   proof ((intro ex_cong iffI; elim conjE), goal_cases LR RL)
     case (LR j)
     with Until(1)[OF 1] Until(2)[OF 2] \<tau>_prefix_conv[OF assms(1,2) 3] Until.prems show ?case
       by (auto 0 4 simp: le_diff_conv add.commute dest: less_imp_le order.trans[OF \<tau>_mono, rotated])
   next
     case (RL j)
     with Until(1)[OF 11] Until(2)[OF 21] \<tau>_prefix_conv[OF assms(1,2) 31] Until.prems show ?case
       by (auto 0 4 simp: le_diff_conv add.commute dest: less_imp_le order.trans[OF \<tau>_mono, rotated])
   qed
 next
   case (MatchP I r)
   then have "i < plen \<pi>"
     by (force simp: pred_mapping_alt elim!: order.strict_trans2[OF _ progress_le_gen])
   with MatchP.prems \<tau>_prefix_conv[OF assms(1,2)] show ?case
     unfolding sat.simps
     by (intro ex_cong conj_cong match_cong_strong MatchP) (auto simp: progress_regex_def split: if_splits)
 next
   case (MatchF I r)
   from MatchF.prems obtain b where right[simp]: "right I = enat b"
     by (cases "right I") (auto simp add: Inf_UNIV_nat)
   show ?case
   proof (cases "regex.atms r = {}")
     case True
     from MatchF.prems(1) obtain j where "\<tau> \<sigma> i + b + 1 \<le> \<tau> \<sigma> j" "j \<le> plen \<pi>"
       by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le dest!: le_cInf_iff[THEN iffD1, rotated -1])
     then have 1: "k < plen \<pi>" if "\<tau> \<sigma> k \<le> \<tau> \<sigma> i + b" for k
       by (meson \<tau>_mono discrete not_le order.strict_trans2 that)
     from MatchF.prems have "i < progress \<sigma>' P (Formula.MatchF I r) (plen \<pi>)"
       unfolding progress_prefix_conv[OF assms(1,2)] by blast
     then obtain j where "\<tau> \<sigma>' i + b + 1 \<le> \<tau> \<sigma>' j" "j \<le> plen \<pi>"
       by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le dest!: le_cInf_iff[THEN iffD1, rotated -1])
     then have 2: "k < plen \<pi>" if "\<tau> \<sigma>' k \<le> \<tau> \<sigma>' i + b" for k
       by (meson \<tau>_mono discrete not_le order.strict_trans2 that)
     from MatchF.prems(1,4) True show ?thesis
       unfolding sat.simps conj_commute[of "left I \<le> _" "_ \<le> _"]
     proof (intro ex_cong conj_cong match_cong_strong, goal_cases left right sat)
       case (left j)
       then show ?case
         by (intro iffI)
           ((subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 1, symmetric]; auto elim: order.trans[OF \<tau>_mono, rotated]),
             (subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 2]; auto elim: order.trans[OF \<tau>_mono, rotated]))
     next
       case (right j)
       then show ?case
         by (intro iffI)
           ((subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 2, symmetric]; auto elim: order.trans[OF \<tau>_mono, rotated]),
             (subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 2]; auto elim: order.trans[OF \<tau>_mono, rotated]))
     qed auto
   next
     case False
     from MatchF.prems(1) False obtain j where "\<tau> \<sigma> i + b + 1 \<le> \<tau> \<sigma> j" "(\<forall>x\<in>regex.atms r. j \<le> progress \<sigma> P x (plen \<pi>))"
       by atomize_elim (auto 0 6 simp add: less_eq_Suc_le not_le progress_regex_def
         dest!: le_cInf_iff[THEN iffD1, rotated -1])
     then have 1: "\<phi> \<in> regex.atms r \<Longrightarrow> k < progress \<sigma> P \<phi> (plen \<pi>)" if "\<tau> \<sigma> k \<le> \<tau> \<sigma> i + b" for k \<phi>
       using that
       by (fastforce elim!: order.strict_trans2[rotated] intro: less_\<tau>D[of \<sigma>])
     then have 2: "k < plen \<pi>" if "\<tau> \<sigma> k \<le> \<tau> \<sigma> i + b" "regex.atms r \<noteq> {}" for k
       using that
       by (fastforce intro: order.strict_trans2[OF _ progress_le_gen[OF MatchF(5), of \<sigma>], of k])
 
     from MatchF.prems have "i < progress \<sigma>' P (Formula.MatchF I r) (plen \<pi>)"
       unfolding progress_prefix_conv[OF assms(1,2)] by blast
     with False obtain j where "\<tau> \<sigma>' i + b + 1 \<le> \<tau> \<sigma>' j" "(\<forall>x\<in>regex.atms r. j \<le> progress \<sigma>' P x (plen \<pi>))"
       by atomize_elim (auto 0 6 simp add: less_eq_Suc_le not_le progress_regex_def
         dest!: le_cInf_iff[THEN iffD1, rotated -1])
     then have 11:  "\<phi> \<in> regex.atms r \<Longrightarrow> k < progress \<sigma> P \<phi> (plen \<pi>)" if "\<tau> \<sigma>' k \<le> \<tau> \<sigma>' i + b" for k \<phi>
       using that using progress_prefix_conv[OF assms(1,2)]
       by (auto 0 3 elim!: order.strict_trans2[rotated] intro: less_\<tau>D[of \<sigma>'])
     have 21: "k < plen \<pi>" if "\<tau> \<sigma>' k \<le> \<tau> \<sigma>' i + b" for k
       using 11[OF that(1)] False by (fastforce intro: order.strict_trans2[OF _ progress_le_gen[OF MatchF(5), of \<sigma>], of k])
     show ?thesis unfolding sat.simps conj_commute[of "left I \<le> _" "_ \<le> _"]
     proof ((intro ex_cong conj_cong match_cong_strong MatchF(1)[OF _ _ MatchF(3-6)]; assumption?), goal_cases right left progress)
       case (right j)
       with False show ?case
         by (intro iffI)
           ((subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 2, symmetric]; auto elim: order.trans[OF \<tau>_mono, rotated]),
             (subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 21]; auto elim: order.trans[OF \<tau>_mono, rotated]))
     next
       case (left j)
       with False show ?case unfolding right enat_ord_code le_diff_conv add.commute[of b]
         by (intro iffI)
           ((subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 21, symmetric]; auto elim: order.trans[OF \<tau>_mono, rotated]),
             (subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 21]; auto elim: order.trans[OF \<tau>_mono, rotated]))
     next
       case (progress j k z)
       with False show ?case unfolding right enat_ord_code le_diff_conv add.commute[of b]
         by (elim 1[rotated])
           (subst (1 2) \<tau>_prefix_conv[OF assms(1,2) 21]; auto elim!: order.trans[OF \<tau>_mono, rotated])
     qed
   qed
 qed auto
 
 lemma sat_prefix_conv:
   assumes "prefix_of \<pi> \<sigma>" and "prefix_of \<pi> \<sigma>'"
   shows "i < progress \<sigma> Map.empty \<phi> (plen \<pi>) \<Longrightarrow>
     Formula.sat \<sigma> Map.empty v i \<phi> \<longleftrightarrow> Formula.sat \<sigma>' Map.empty v i \<phi>"
   by (erule sat_prefix_conv_gen[OF assms]) auto
 
 lemma progress_remove_neg[simp]: "progress \<sigma> P (remove_neg \<phi>) j = progress \<sigma> P \<phi> j"
   by (cases \<phi>) simp_all
 
 lemma safe_progress_get_and: "safe_formula \<phi> \<Longrightarrow>
   Min ((\<lambda>\<phi>. progress \<sigma> P \<phi> j) ` set (get_and_list \<phi>)) = progress \<sigma> P \<phi> j"
   by (induction \<phi> rule: get_and_list.induct) auto
 
 lemma progress_convert_multiway: "safe_formula \<phi> \<Longrightarrow> progress \<sigma> P (convert_multiway \<phi>) j = progress \<sigma> P \<phi> j"
 proof (induction \<phi> arbitrary: P rule: safe_formula_induct)
   case (And_safe \<phi> \<psi>)
   let ?c = "convert_multiway (Formula.And \<phi> \<psi>)"
   let ?c\<phi> = "convert_multiway \<phi>"
   let ?c\<psi> = "convert_multiway \<psi>"
   have c_eq: "?c = Formula.Ands (get_and_list ?c\<phi> @ get_and_list ?c\<psi>)"
     using And_safe by simp
   from \<open>safe_formula \<phi>\<close> have "safe_formula ?c\<phi>" by (rule safe_convert_multiway)
   moreover from \<open>safe_formula \<psi>\<close> have "safe_formula ?c\<psi>" by (rule safe_convert_multiway)
   ultimately show ?case
     unfolding c_eq
     using And_safe.IH
     by (auto simp: get_and_nonempty Min.union safe_progress_get_and)
 next
   case (And_Not \<phi> \<psi>)
   let ?c = "convert_multiway (Formula.And \<phi> (Formula.Neg \<psi>))"
   let ?c\<phi> = "convert_multiway \<phi>"
   let ?c\<psi> = "convert_multiway \<psi>"
   have c_eq: "?c = Formula.Ands (Formula.Neg ?c\<psi> # get_and_list ?c\<phi>)"
     using And_Not by simp
   from \<open>safe_formula \<phi>\<close> have "safe_formula ?c\<phi>" by (rule safe_convert_multiway)
   moreover from \<open>safe_formula \<psi>\<close> have "safe_formula ?c\<psi>" by (rule safe_convert_multiway)
   ultimately show ?case
     unfolding c_eq
     using And_Not.IH
     by (auto simp: get_and_nonempty Min.union safe_progress_get_and)
 next
   case (MatchP I r)
   from MatchP show ?case
     unfolding progress.simps regex.map convert_multiway.simps regex.set_map image_image
     by (intro if_cong arg_cong[of _ _ Min] image_cong)
       (auto 0 4 simp: atms_def elim!: disjE_Not2 dest: safe_regex_safe_formula)
 next
   case (MatchF I r)
   from MatchF show ?case
     unfolding progress.simps regex.map convert_multiway.simps regex.set_map image_image
     by (intro if_cong arg_cong[of _ _ Min] arg_cong[of _ _ Inf] arg_cong[of _ _ "(\<le>) _"]
       image_cong Collect_cong all_cong1 imp_cong conj_cong image_cong)
       (auto 0 4 simp: atms_def elim!: disjE_Not2 dest: safe_regex_safe_formula)
 qed auto
 
 
 subsection \<open>Specification\<close>
 
 definition pprogress :: "Formula.formula \<Rightarrow> Formula.prefix \<Rightarrow> nat" where
   "pprogress \<phi> \<pi> = (THE n. \<forall>\<sigma>. prefix_of \<pi> \<sigma> \<longrightarrow> progress \<sigma> Map.empty \<phi> (plen \<pi>) = n)"
 
 lemma pprogress_eq: "prefix_of \<pi> \<sigma> \<Longrightarrow> pprogress \<phi> \<pi> = progress \<sigma> Map.empty \<phi> (plen \<pi>)"
   unfolding pprogress_def using progress_prefix_conv
   by blast
 
 locale future_bounded_mfodl =
   fixes \<phi> :: Formula.formula
   assumes future_bounded: "Formula.future_bounded \<phi>"
 
 sublocale future_bounded_mfodl \<subseteq> sliceable_timed_progress "Formula.nfv \<phi>" "Formula.fv \<phi>" "relevant_events \<phi>"
   "\<lambda>\<sigma> v i. Formula.sat \<sigma> Map.empty v i \<phi>" "pprogress \<phi>"
 proof (unfold_locales, goal_cases)
   case (1 x)
   then show ?case by (simp add: fvi_less_nfv)
 next
   case (2 v v' \<sigma> i)
   then show ?case by (simp cong: sat_fv_cong[rule_format])
 next
   case (3 v S \<sigma> i)
   then show ?case
     using sat_slice_iff[symmetric] by simp
 next
   case (4 \<pi> \<pi>')
   moreover obtain \<sigma> where "prefix_of \<pi>' \<sigma>"
     using ex_prefix_of ..
   moreover have "prefix_of \<pi> \<sigma>"
     using prefix_of_antimono[OF \<open>\<pi> \<le> \<pi>'\<close> \<open>prefix_of \<pi>' \<sigma>\<close>] .
   ultimately show ?case
     by (simp add: pprogress_eq plen_mono progress_mono)
 next
   case (5 \<sigma> x)
   obtain j where "x \<le> progress \<sigma> Map.empty \<phi> j"
     using future_bounded progress_ge by blast
   then have "x \<le> pprogress \<phi> (take_prefix j \<sigma>)"
     by (simp add: pprogress_eq[of _ \<sigma>])
   then show ?case by force
 next
   case (6 \<pi> \<sigma> \<sigma>' i v)
   then have "i < progress \<sigma> Map.empty \<phi> (plen \<pi>)"
     by (simp add: pprogress_eq)
   with 6 show ?case
     using sat_prefix_conv by blast
 next
   case (7 \<pi> \<pi>')
   then have "plen \<pi> = plen \<pi>'"
     by transfer (simp add: list_eq_iff_nth_eq)
   moreover obtain \<sigma> \<sigma>' where "prefix_of \<pi> \<sigma>" "prefix_of \<pi>' \<sigma>'"
     using ex_prefix_of by blast+
   moreover have "\<forall>i < plen \<pi>. \<tau> \<sigma> i = \<tau> \<sigma>' i"
     using 7 calculation
     by transfer (simp add: list_eq_iff_nth_eq)
   ultimately show ?case
     by (simp add: pprogress_eq progress_time_conv)
 qed
 
 locale verimon_spec =
   fixes \<phi> :: Formula.formula
   assumes monitorable: "mmonitorable \<phi>"
 
 sublocale verimon_spec \<subseteq> future_bounded_mfodl
   using monitorable by unfold_locales (simp add: mmonitorable_def)
 
 
 subsection \<open>Correctness\<close>
 
 subsubsection \<open>Invariants\<close>
 
 definition wf_mbuf2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> event_data table \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> event_data table \<Rightarrow> bool) \<Rightarrow>
     event_data mbuf2 \<Rightarrow> bool" where
   "wf_mbuf2 i ja jb P Q buf \<longleftrightarrow> i \<le> ja \<and> i \<le> jb \<and> (case buf of (xs, ys) \<Rightarrow>
     list_all2 P [i..<ja] xs \<and> list_all2 Q [i..<jb] ys)"
 
 inductive list_all3 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list \<Rightarrow> bool" for P :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> bool)" where
   "list_all3 P [] [] []"
 | "P a1 a2 a3 \<Longrightarrow> list_all3 P q1 q2 q3 \<Longrightarrow> list_all3 P (a1 # q1) (a2 # q2) (a3 # q3)"
 
 lemma list_all3_list_all2D: "list_all3 P xs ys zs \<Longrightarrow>
   (length xs = length ys \<and> list_all2 (case_prod P) (zip xs ys) zs)"
   by (induct xs ys zs rule: list_all3.induct) auto
 
 lemma list_all2_list_all3I: "length xs = length ys \<Longrightarrow> list_all2 (case_prod P) (zip xs ys) zs \<Longrightarrow>
   list_all3 P xs ys zs"
   by (induct xs ys arbitrary: zs rule: list_induct2)
     (auto simp: list_all2_Cons1 intro: list_all3.intros)
 
 lemma list_all3_list_all2_eq: "list_all3 P xs ys zs \<longleftrightarrow>
   (length xs = length ys \<and> list_all2 (case_prod P) (zip xs ys) zs)"
   using list_all2_list_all3I list_all3_list_all2D by blast
 
 lemma list_all3_mapD: "list_all3 P (map f xs) (map g ys) (map h zs) \<Longrightarrow>
   list_all3 (\<lambda>x y z. P (f x) (g y) (h z)) xs ys zs"
   by (induct "map f xs" "map g ys" "map h zs" arbitrary: xs ys zs rule: list_all3.induct)
     (auto intro: list_all3.intros)
 
 lemma list_all3_mapI: "list_all3 (\<lambda>x y z. P (f x) (g y) (h z)) xs ys zs \<Longrightarrow>
   list_all3 P (map f xs) (map g ys) (map h zs)"
   by (induct xs ys zs rule: list_all3.induct)
     (auto intro: list_all3.intros)
 
 lemma list_all3_map_iff: "list_all3 P (map f xs) (map g ys) (map h zs) \<longleftrightarrow>
   list_all3 (\<lambda>x y z. P (f x) (g y) (h z)) xs ys zs"
   using list_all3_mapD list_all3_mapI by blast
 
 lemmas list_all3_map =
   list_all3_map_iff[where g=id and h=id, unfolded list.map_id id_apply]
   list_all3_map_iff[where f=id and h=id, unfolded list.map_id id_apply]
   list_all3_map_iff[where f=id and g=id, unfolded list.map_id id_apply]
 
 lemma list_all3_conv_all_nth:
   "list_all3 P xs ys zs =
   (length xs = length ys \<and> length ys = length zs \<and> (\<forall>i < length xs. P (xs!i) (ys!i) (zs!i)))"
   by (auto simp add: list_all3_list_all2_eq list_all2_conv_all_nth)
 
 lemma list_all3_refl [intro?]:
   "(\<And>x. x \<in> set xs \<Longrightarrow> P x x x) \<Longrightarrow> list_all3 P xs xs xs"
   by (simp add: list_all3_conv_all_nth)
 
 definition wf_mbufn :: "nat \<Rightarrow> nat list \<Rightarrow> (nat \<Rightarrow> event_data table \<Rightarrow> bool) list \<Rightarrow> event_data mbufn \<Rightarrow> bool" where
   "wf_mbufn i js Ps buf \<longleftrightarrow> list_all3 (\<lambda>P j xs. i \<le> j \<and> list_all2 P [i..<j] xs) Ps js buf"
 
 definition wf_mbuf2' :: "Formula.trace \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> event_data list set \<Rightarrow>
   Formula.formula \<Rightarrow> Formula.formula \<Rightarrow> event_data mbuf2 \<Rightarrow> bool" where
   "wf_mbuf2' \<sigma> P V j n R \<phi> \<psi> buf \<longleftrightarrow> wf_mbuf2 (min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j))
     (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)
     (\<lambda>i. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
     (\<lambda>i. qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>)) buf"
 
 definition wf_mbufn' :: "Formula.trace \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> event_data list set \<Rightarrow>
   Formula.formula Regex.regex \<Rightarrow> event_data mbufn \<Rightarrow> bool" where
   "wf_mbufn' \<sigma>  P V j n R r buf \<longleftrightarrow> (case to_mregex r of (mr, \<phi>s) \<Rightarrow>
     wf_mbufn (progress_regex \<sigma> P r j) (map (\<lambda>\<phi>. progress \<sigma> P \<phi> j) \<phi>s)
     (map (\<lambda>\<phi> i. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>)) \<phi>s)
     buf)"
 
 lemma wf_mbuf2'_UNIV_alt: "wf_mbuf2' \<sigma> P V j n UNIV \<phi> \<psi> buf \<longleftrightarrow> (case buf of (xs, ys) \<Rightarrow>
   list_all2 (\<lambda>i. wf_table n (Formula.fv \<phi>) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
     [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j) ..< (progress \<sigma> P \<phi> j)] xs \<and>
   list_all2 (\<lambda>i. wf_table n (Formula.fv \<psi>) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>))
     [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j) ..< (progress \<sigma> P \<psi> j)] ys)"
   unfolding wf_mbuf2'_def wf_mbuf2_def
   by (simp add: mem_restr_UNIV[THEN eqTrueI, abs_def] split: prod.split)
 
 definition wf_ts :: "Formula.trace \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> Formula.formula \<Rightarrow> Formula.formula \<Rightarrow> ts list \<Rightarrow> bool" where
   "wf_ts \<sigma> P j \<phi> \<psi> ts \<longleftrightarrow> list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)..<j] ts"
 
 definition wf_ts_regex :: "Formula.trace \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> Formula.formula Regex.regex \<Rightarrow> ts list \<Rightarrow> bool" where
   "wf_ts_regex \<sigma> P j r ts \<longleftrightarrow> list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [progress_regex \<sigma> P r j..<j] ts"
 
 abbreviation "Sincep pos \<phi> I \<psi> \<equiv> Formula.Since (if pos then \<phi> else Formula.Neg \<phi>) I \<psi>"
 
 definition (in msaux) wf_since_aux :: "Formula.trace \<Rightarrow> _ \<Rightarrow> event_data list set \<Rightarrow> args \<Rightarrow>
   Formula.formula \<Rightarrow> Formula.formula \<Rightarrow> 'msaux \<Rightarrow> nat \<Rightarrow> bool" where
   "wf_since_aux \<sigma> V R args \<phi> \<psi> aux ne \<longleftrightarrow> Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and> (\<exists>cur auxlist. valid_msaux args cur aux auxlist \<and>
     cur = (if ne = 0 then 0 else \<tau> \<sigma> (ne - 1)) \<and>
     sorted_wrt (\<lambda>x y. fst x > fst y) auxlist \<and>
     (\<forall>t X. (t, X) \<in> set auxlist \<longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne - 1) \<and> \<tau> \<sigma> (ne - 1) - t \<le> right (args_ivl args) \<and> (\<exists>i. \<tau> \<sigma> i = t) \<and>
       qtable (args_n args) (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne-1) (Sincep (args_pos args) \<phi> (point (\<tau> \<sigma> (ne - 1) - t)) \<psi>)) X) \<and>
     (\<forall>t. ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne - 1) \<and> \<tau> \<sigma> (ne - 1) - t \<le> right (args_ivl args) \<and> (\<exists>i. \<tau> \<sigma> i = t) \<longrightarrow>
       (\<exists>X. (t, X) \<in> set auxlist)))"
 
 definition wf_matchP_aux :: "Formula.trace \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> event_data list set \<Rightarrow>
     \<I> \<Rightarrow> Formula.formula Regex.regex \<Rightarrow> event_data mr\<delta>aux \<Rightarrow> nat \<Rightarrow> bool" where
   "wf_matchP_aux \<sigma> V n R I r aux ne \<longleftrightarrow> sorted_wrt (\<lambda>x y. fst x > fst y) aux \<and>
     (\<forall>t X. (t, X) \<in> set aux \<longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne-1) \<and> \<tau> \<sigma> (ne-1) - t \<le> right I \<and> (\<exists>i. \<tau> \<sigma> i = t) \<and>
       (case to_mregex r of (mr, \<phi>s) \<Rightarrow>
       (\<forall>ms \<in> RPDs mr. qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne-1)
          (Formula.MatchP (point (\<tau> \<sigma> (ne-1) - t)) (from_mregex ms \<phi>s)))
          (lookup X ms)))) \<and>
     (\<forall>t. ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne-1) \<and> \<tau> \<sigma> (ne-1) - t \<le> right I \<and> (\<exists>i. \<tau> \<sigma> i = t) \<longrightarrow>
       (\<exists>X. (t, X) \<in> set aux))"
 
 lemma qtable_mem_restr_UNIV: "qtable n A(mem_restr UNIV) Q X = wf_table n A Q X"
   unfolding qtable_def by auto
 
 lemma (in msaux) wf_since_aux_UNIV_alt:
   "wf_since_aux \<sigma> V UNIV args \<phi> \<psi> aux ne \<longleftrightarrow> Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and> (\<exists>cur auxlist. valid_msaux args cur aux auxlist \<and>
     cur = (if ne = 0 then 0 else \<tau> \<sigma> (ne - 1)) \<and>
     sorted_wrt (\<lambda>x y. fst x > fst y) auxlist \<and>
     (\<forall>t X. (t, X) \<in> set auxlist \<longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne - 1) \<and> \<tau> \<sigma> (ne - 1) - t \<le> right (args_ivl args) \<and> (\<exists>i. \<tau> \<sigma> i = t) \<and>
       wf_table (args_n args) (Formula.fv \<psi>)
           (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne - 1) (Sincep (args_pos args) \<phi> (point (\<tau> \<sigma> (ne - 1) - t)) \<psi>)) X) \<and>
     (\<forall>t. ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne - 1) \<and> \<tau> \<sigma> (ne - 1) - t \<le> right (args_ivl args) \<and> (\<exists>i. \<tau> \<sigma> i = t) \<longrightarrow>
       (\<exists>X. (t, X) \<in> set auxlist)))"
   unfolding wf_since_aux_def qtable_mem_restr_UNIV ..
 
 definition wf_until_auxlist :: "Formula.trace \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> event_data list set \<Rightarrow> bool \<Rightarrow>
     Formula.formula \<Rightarrow> \<I> \<Rightarrow> Formula.formula \<Rightarrow> event_data muaux \<Rightarrow> nat \<Rightarrow> bool" where
   "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> auxlist ne \<longleftrightarrow>
     list_all2 (\<lambda>x i. case x of (t, r1, r2) \<Rightarrow> t = \<tau> \<sigma> i \<and>
       qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. if pos then (\<forall>k\<in>{i..<ne+length auxlist}. Formula.sat \<sigma> V (map the v) k \<phi>)
           else (\<exists>k\<in>{i..<ne+length auxlist}. Formula.sat \<sigma> V (map the v) k \<phi>)) r1 \<and>
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. (\<exists>j. i \<le> j \<and> j < ne + length auxlist \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) I \<and>
           Formula.sat \<sigma> V (map the v) j \<psi> \<and>
           (\<forall>k\<in>{i..<j}. if pos then Formula.sat \<sigma> V (map the v) k \<phi> else \<not> Formula.sat \<sigma> V (map the v) k \<phi>))) r2)
       auxlist [ne..<ne+length auxlist]"
 
 definition (in muaux) wf_until_aux :: "Formula.trace \<Rightarrow> _ \<Rightarrow> event_data list set \<Rightarrow> args \<Rightarrow>
   Formula.formula \<Rightarrow> Formula.formula \<Rightarrow> 'muaux \<Rightarrow> nat \<Rightarrow> bool" where
   "wf_until_aux \<sigma> V R args \<phi> \<psi> aux ne \<longleftrightarrow> Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and>
     (\<exists>cur auxlist. valid_muaux args cur aux auxlist \<and>
       cur = (if ne + length auxlist = 0 then 0 else \<tau> \<sigma> (ne + length auxlist - 1)) \<and>
       wf_until_auxlist \<sigma> V (args_n args) R (args_pos args) \<phi> (args_ivl args) \<psi> auxlist ne)"
 
 lemma (in muaux) wf_until_aux_UNIV_alt:
   "wf_until_aux \<sigma> V UNIV args \<phi> \<psi> aux ne \<longleftrightarrow> Formula.fv \<phi> \<subseteq> Formula.fv \<psi> \<and>
     (\<exists>cur auxlist. valid_muaux args cur aux auxlist \<and>
       cur = (if ne + length auxlist = 0 then 0 else \<tau> \<sigma> (ne + length auxlist - 1)) \<and>
       list_all2 (\<lambda>x i. case x of (t, r1, r2) \<Rightarrow> t = \<tau> \<sigma> i \<and>
       wf_table (args_n args) (Formula.fv \<phi>) (\<lambda>v. if (args_pos args)
           then (\<forall>k\<in>{i..<ne+length auxlist}. Formula.sat \<sigma> V (map the v) k \<phi>)
           else (\<exists>k\<in>{i..<ne+length auxlist}. Formula.sat \<sigma> V (map the v) k \<phi>)) r1 \<and>
       wf_table (args_n args) (Formula.fv \<psi>) (\<lambda>v. \<exists>j. i \<le> j \<and> j < ne + length auxlist \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) (args_ivl args) \<and>
           Formula.sat \<sigma> V (map the v) j \<psi> \<and>
           (\<forall>k\<in>{i..<j}. if (args_pos args) then Formula.sat \<sigma> V (map the v) k \<phi> else \<not> Formula.sat \<sigma> V (map the v) k \<phi>)) r2)
       auxlist [ne..<ne+length auxlist])"
   unfolding wf_until_aux_def wf_until_auxlist_def qtable_mem_restr_UNIV ..
 
 definition wf_matchF_aux :: "Formula.trace \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> event_data list set \<Rightarrow>
     \<I> \<Rightarrow> Formula.formula Regex.regex \<Rightarrow> event_data ml\<delta>aux \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
   "wf_matchF_aux \<sigma> V n R I r aux ne k \<longleftrightarrow> (case to_mregex r of (mr, \<phi>s) \<Rightarrow>
       list_all2 (\<lambda>x i. case x of (t, rels, rel) \<Rightarrow> t = \<tau> \<sigma> i \<and>
         list_all2 (\<lambda>\<phi>. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v.
           Formula.sat \<sigma> V (map the v) i \<phi>)) \<phi>s rels \<and>
         qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v. (\<exists>j. i \<le> j \<and> j < ne + length aux + k \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) I \<and>
           Regex.match (Formula.sat \<sigma> V (map the v)) r i j)) rel)
     aux [ne..<ne+length aux])"
 
 definition wf_matchF_invar where
   "wf_matchF_invar \<sigma> V n R I r st i =
      (case st of (aux, Y) \<Rightarrow> aux \<noteq> [] \<and> wf_matchF_aux \<sigma> V n R I r aux i 0 \<and>
      (case to_mregex r of (mr, \<phi>s) \<Rightarrow> \<forall>ms \<in> LPDs mr.
        qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v.
          Regex.match (Formula.sat \<sigma> V (map the v)) (from_mregex ms \<phi>s) i (i + length aux - 1)) (lookup Y ms)))"
 
 definition lift_envs' :: "nat \<Rightarrow> event_data list set \<Rightarrow> event_data list set" where
   "lift_envs' b R = (\<lambda>(xs,ys). xs @ ys) ` ({xs. length xs = b} \<times> R)"
 
 fun formula_of_constraint :: "Formula.trm \<times> bool \<times> mconstraint \<times> Formula.trm \<Rightarrow> Formula.formula" where
   "formula_of_constraint (t1, True, MEq, t2) = Formula.Eq t1 t2"
 | "formula_of_constraint (t1, True, MLess, t2) = Formula.Less t1 t2"
 | "formula_of_constraint (t1, True, MLessEq, t2) = Formula.LessEq t1 t2"
 | "formula_of_constraint (t1, False, MEq, t2) = Formula.Neg (Formula.Eq t1 t2)"
 | "formula_of_constraint (t1, False, MLess, t2) = Formula.Neg (Formula.Less t1 t2)"
 | "formula_of_constraint (t1, False, MLessEq, t2) = Formula.Neg (Formula.LessEq t1 t2)"
 
 inductive (in maux) wf_mformula :: "Formula.trace \<Rightarrow> nat \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow>
   nat \<Rightarrow> event_data list set \<Rightarrow> ('msaux, 'muaux) mformula \<Rightarrow> Formula.formula \<Rightarrow> bool"
   for \<sigma> j where
     Eq: "is_simple_eq t1 t2 \<Longrightarrow>
     \<forall>x\<in>Formula.fv_trm t1. x < n \<Longrightarrow> \<forall>x\<in>Formula.fv_trm t2. x < n \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MRel (eq_rel n t1 t2)) (Formula.Eq t1 t2)"
   | neq_Var: "x < n \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MRel empty_table) (Formula.Neg (Formula.Eq (Formula.Var x) (Formula.Var x)))"
   | Pred: "\<forall>x\<in>Formula.fv (Formula.Pred e ts). x < n \<Longrightarrow>
     \<forall>t\<in>set ts. Formula.is_Var t \<or> Formula.is_Const t \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MPred e ts) (Formula.Pred e ts)"
   | Let: "wf_mformula \<sigma> j P V m UNIV \<phi> \<phi>' \<Longrightarrow>
     wf_mformula \<sigma> j (P(p \<mapsto> progress \<sigma> P \<phi>' j))
       (V(p \<mapsto> \<lambda>i. {v. length v = m \<and> Formula.sat \<sigma> V v i \<phi>'})) n R \<psi> \<psi>' \<Longrightarrow>
     {0..<m} \<subseteq> Formula.fv \<phi>' \<Longrightarrow> b \<le> m \<Longrightarrow> m = Formula.nfv \<phi>' \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MLet p m \<phi> \<psi>) (Formula.Let p \<phi>' \<psi>')"
   | And: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> wf_mformula \<sigma> j P V n R \<psi> \<psi>' \<Longrightarrow>
     if pos then \<chi> = Formula.And \<phi>' \<psi>'
       else \<chi> = Formula.And \<phi>' (Formula.Neg \<psi>') \<and> Formula.fv \<psi>' \<subseteq> Formula.fv \<phi>' \<Longrightarrow>
     wf_mbuf2' \<sigma> P V j n R \<phi>' \<psi>' buf \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MAnd (fv \<phi>') \<phi> pos (fv \<psi>') \<psi> buf) \<chi>"
   | AndAssign: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow>
     x < n \<Longrightarrow> x \<notin> Formula.fv \<phi>' \<Longrightarrow> Formula.fv_trm t \<subseteq> Formula.fv \<phi>' \<Longrightarrow> (x, t) = conf \<Longrightarrow>
     \<psi>' = Formula.Eq (Formula.Var x) t \<or> \<psi>' = Formula.Eq t (Formula.Var x) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MAndAssign \<phi> conf) (Formula.And \<phi>' \<psi>')"
   | AndRel: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow>
     \<psi>' = formula_of_constraint conf \<Longrightarrow>
     (let (t1, _, _, t2) = conf in Formula.fv_trm t1 \<union> Formula.fv_trm t2 \<subseteq> Formula.fv \<phi>') \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MAndRel \<phi> conf) (Formula.And \<phi>' \<psi>')"
   | Ands: "list_all2 (\<lambda>\<phi> \<phi>'. wf_mformula \<sigma> j P V n R \<phi> \<phi>') l (l_pos @ map remove_neg l_neg) \<Longrightarrow>
     wf_mbufn (progress \<sigma> P (Formula.Ands l') j) (map (\<lambda>\<psi>. progress \<sigma> P \<psi> j) (l_pos @ map remove_neg l_neg)) (map (\<lambda>\<psi> i.
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>)) (l_pos @ map remove_neg l_neg)) buf \<Longrightarrow>
     (l_pos, l_neg) = partition safe_formula l' \<Longrightarrow>
     l_pos \<noteq> [] \<Longrightarrow>
     list_all safe_formula (map remove_neg l_neg) \<Longrightarrow>
     A_pos = map fv l_pos \<Longrightarrow>
     A_neg = map fv l_neg \<Longrightarrow>
     \<Union>(set A_neg) \<subseteq> \<Union>(set A_pos) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MAnds A_pos A_neg l buf) (Formula.Ands l')"
   | Or: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> wf_mformula \<sigma> j P V n R \<psi> \<psi>' \<Longrightarrow>
     Formula.fv \<phi>' = Formula.fv \<psi>' \<Longrightarrow>
     wf_mbuf2' \<sigma> P V j n R \<phi>' \<psi>' buf \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MOr \<phi> \<psi> buf) (Formula.Or \<phi>' \<psi>')"
   | Neg: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> Formula.fv \<phi>' = {} \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MNeg \<phi>) (Formula.Neg \<phi>')"
   | Exists: "wf_mformula \<sigma> j P V (Suc n) (lift_envs R) \<phi> \<phi>' \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MExists \<phi>) (Formula.Exists \<phi>')"
   | Agg: "wf_mformula \<sigma> j P V (b + n) (lift_envs' b R) \<phi> \<phi>' \<Longrightarrow>
     y < n \<Longrightarrow>
     y + b \<notin> Formula.fv \<phi>' \<Longrightarrow>
     {0..<b} \<subseteq> Formula.fv \<phi>' \<Longrightarrow>
     Formula.fv_trm f \<subseteq> Formula.fv \<phi>' \<Longrightarrow>
     g0 = (Formula.fv \<phi>' \<subseteq> {0..<b}) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MAgg g0 y \<omega> b f \<phi>) (Formula.Agg y \<omega> b f \<phi>')"
   | Prev: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow>
     first \<longleftrightarrow> j = 0 \<Longrightarrow>
     list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>'))
       [min (progress \<sigma> P \<phi>' j) (j-1)..<progress \<sigma> P \<phi>' j] buf \<Longrightarrow>
     list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min (progress \<sigma> P \<phi>' j) (j-1)..<j] nts \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MPrev I \<phi> first buf nts) (Formula.Prev I \<phi>')"
   | Next: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow>
     first \<longleftrightarrow> progress \<sigma> P \<phi>' j = 0 \<Longrightarrow>
     list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [progress \<sigma> P \<phi>' j - 1..<j] nts \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MNext I \<phi> first nts) (Formula.Next I \<phi>')"
   | Since: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> wf_mformula \<sigma> j P V n R \<psi> \<psi>' \<Longrightarrow>
     if args_pos args then \<phi>'' = \<phi>' else \<phi>'' = Formula.Neg \<phi>' \<Longrightarrow>
     safe_formula \<phi>'' = args_pos args \<Longrightarrow>
     args_ivl args = I \<Longrightarrow>
     args_n args = n \<Longrightarrow>
     args_L args = Formula.fv \<phi>' \<Longrightarrow>
     args_R args = Formula.fv \<psi>' \<Longrightarrow>
     Formula.fv \<phi>' \<subseteq> Formula.fv \<psi>' \<Longrightarrow>
     wf_mbuf2' \<sigma> P V j n R \<phi>' \<psi>' buf \<Longrightarrow>
     wf_ts \<sigma> P j \<phi>' \<psi>' nts \<Longrightarrow>
     wf_since_aux \<sigma> V R args \<phi>' \<psi>' aux (progress \<sigma> P (Formula.Since \<phi>'' I \<psi>') j) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MSince args \<phi> \<psi> buf nts aux) (Formula.Since \<phi>'' I \<psi>')"
   | Until: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> wf_mformula \<sigma> j P V n R \<psi> \<psi>' \<Longrightarrow>
     if args_pos args then \<phi>'' = \<phi>' else \<phi>'' = Formula.Neg \<phi>' \<Longrightarrow>
     safe_formula \<phi>'' = args_pos args \<Longrightarrow>
     args_ivl args = I \<Longrightarrow>
     args_n args = n \<Longrightarrow>
     args_L args = Formula.fv \<phi>' \<Longrightarrow>
     args_R args = Formula.fv \<psi>' \<Longrightarrow>
     Formula.fv \<phi>' \<subseteq> Formula.fv \<psi>' \<Longrightarrow>
     wf_mbuf2' \<sigma> P V j n R \<phi>' \<psi>' buf \<Longrightarrow>
     wf_ts \<sigma> P j \<phi>' \<psi>' nts \<Longrightarrow>
     wf_until_aux \<sigma> V R args \<phi>' \<psi>' aux (progress \<sigma> P (Formula.Until \<phi>'' I \<psi>') j) \<Longrightarrow>
     progress \<sigma> P (Formula.Until \<phi>'' I \<psi>') j + length_muaux args aux = min (progress \<sigma> P \<phi>' j) (progress \<sigma> P \<psi>' j) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MUntil args \<phi> \<psi> buf nts aux) (Formula.Until \<phi>'' I \<psi>')"
   | MatchP: "(case to_mregex r of (mr', \<phi>s') \<Rightarrow>
       list_all2 (wf_mformula \<sigma> j P V n R) \<phi>s \<phi>s' \<and> mr = mr') \<Longrightarrow>
     mrs = sorted_list_of_set (RPDs mr) \<Longrightarrow>
     safe_regex Past Strict r \<Longrightarrow>
     wf_mbufn' \<sigma> P V j n R r buf \<Longrightarrow>
     wf_ts_regex \<sigma> P j r nts \<Longrightarrow>
     wf_matchP_aux \<sigma> V n R I r aux (progress \<sigma> P (Formula.MatchP I r) j) \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MMatchP I mr mrs \<phi>s buf nts aux) (Formula.MatchP I r)"
   | MatchF: "(case to_mregex r of (mr', \<phi>s') \<Rightarrow>
       list_all2 (wf_mformula \<sigma> j P V n R) \<phi>s \<phi>s' \<and> mr = mr') \<Longrightarrow>
     mrs = sorted_list_of_set (LPDs mr) \<Longrightarrow>
     safe_regex Futu Strict r \<Longrightarrow>
     wf_mbufn' \<sigma> P V j n R r buf \<Longrightarrow>
     wf_ts_regex \<sigma> P j r nts \<Longrightarrow>
     wf_matchF_aux \<sigma> V n R I r aux (progress \<sigma> P (Formula.MatchF I r) j) 0 \<Longrightarrow>
     progress \<sigma> P (Formula.MatchF I r) j + length aux = progress_regex \<sigma> P r j \<Longrightarrow>
     wf_mformula \<sigma> j P V n R (MMatchF I mr mrs \<phi>s buf nts aux) (Formula.MatchF I r)"
 
 definition (in maux) wf_mstate :: "Formula.formula \<Rightarrow> Formula.prefix \<Rightarrow> event_data list set \<Rightarrow> ('msaux, 'muaux) mstate \<Rightarrow> bool" where
   "wf_mstate \<phi> \<pi> R st \<longleftrightarrow> mstate_n st = Formula.nfv \<phi> \<and> (\<forall>\<sigma>. prefix_of \<pi> \<sigma> \<longrightarrow>
     mstate_i st = progress \<sigma> Map.empty \<phi> (plen \<pi>) \<and>
     wf_mformula \<sigma> (plen \<pi>) Map.empty Map.empty (mstate_n st) R (mstate_m st) \<phi>)"
 
 
 subsubsection \<open>Initialisation\<close>
 
 
 lemma wf_mbuf2'_0: "pred_mapping (\<lambda>x. x = 0) P \<Longrightarrow> wf_mbuf2' \<sigma> P V 0 n R \<phi> \<psi> ([], [])"
   unfolding wf_mbuf2'_def wf_mbuf2_def by simp
 
 lemma wf_mbufn'_0: "to_mregex r = (mr, \<phi>s) \<Longrightarrow> pred_mapping (\<lambda>x. x = 0) P \<Longrightarrow> wf_mbufn' \<sigma> P V 0 n R r (replicate (length \<phi>s) [])"
   unfolding wf_mbufn'_def wf_mbufn_def map_replicate_const[symmetric]
   by (auto simp: list_all3_map intro: list_all3_refl simp: Min_eq_iff progress_regex_def)
 
 lemma wf_ts_0: "wf_ts \<sigma> P 0 \<phi> \<psi> []"
   unfolding wf_ts_def by simp
 
 lemma wf_ts_regex_0: "wf_ts_regex \<sigma> P 0 r []"
   unfolding wf_ts_regex_def by simp
 
 lemma (in msaux) wf_since_aux_Nil: "Formula.fv \<phi>' \<subseteq> Formula.fv \<psi>' \<Longrightarrow>
   wf_since_aux \<sigma> V R (init_args I n (Formula.fv \<phi>') (Formula.fv \<psi>') b) \<phi>' \<psi>' (init_msaux (init_args I n (Formula.fv \<phi>') (Formula.fv \<psi>') b)) 0"
   unfolding wf_since_aux_def by (auto intro!: valid_init_msaux)
 
 lemma (in muaux) wf_until_aux_Nil: "Formula.fv \<phi>' \<subseteq> Formula.fv \<psi>' \<Longrightarrow>
   wf_until_aux \<sigma> V R (init_args I n (Formula.fv \<phi>') (Formula.fv \<psi>') b) \<phi>' \<psi>' (init_muaux (init_args I n (Formula.fv \<phi>') (Formula.fv \<psi>') b)) 0"
   unfolding wf_until_aux_def wf_until_auxlist_def by (auto intro: valid_init_muaux)
 
 lemma wf_matchP_aux_Nil: "wf_matchP_aux \<sigma> V n R I r [] 0"
   unfolding wf_matchP_aux_def by simp
 
 lemma wf_matchF_aux_Nil: "wf_matchF_aux \<sigma> V n R I r [] 0 k"
   unfolding wf_matchF_aux_def by simp
 
 lemma fv_regex_alt: "safe_regex m g r \<Longrightarrow> Formula.fv_regex r = (\<Union>\<phi> \<in> atms r. Formula.fv \<phi>)"
   unfolding fv_regex_alt atms_def
   by (auto 0 3 dest: safe_regex_safe_formula)
 
 lemmas to_mregex_atms =
   to_mregex_ok[THEN conjunct1, THEN equalityD1, THEN set_mp, rotated]
 
 lemma (in maux) wf_minit0: "safe_formula \<phi> \<Longrightarrow> \<forall>x\<in>Formula.fv \<phi>. x < n \<Longrightarrow>
   pred_mapping (\<lambda>x. x = 0) P \<Longrightarrow>
   wf_mformula \<sigma> 0 P V n R (minit0 n \<phi>) \<phi>"
 proof (induction arbitrary: n R P V rule: safe_formula_induct)
   case (Eq_Const c d)
   then show ?case
     by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
 next
   case (Eq_Var1 c x)
   then show ?case
     by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
 next
   case (Eq_Var2 c x)
   then show ?case
     by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
 next
   case (neq_Var x y)
   then show ?case by (auto intro!: wf_mformula.neq_Var)
 next
   case (Pred e ts)
   then show ?case by (auto intro!: wf_mformula.Pred)
 next
   case (Let p \<phi> \<psi>)
   with fvi_less_nfv show ?case
     by (auto simp: pred_mapping_alt dom_def intro!: wf_mformula.Let Let(4,5))
 next
   case (And_assign \<phi> \<psi>)
   then have 1: "\<forall>x\<in>fv \<psi>. x < n" by simp
   from 1 \<open>safe_assignment (fv \<phi>) \<psi>\<close>
   obtain x t where
     "x < n" "x \<notin> fv \<phi>" "fv_trm t \<subseteq> fv \<phi>"
     "\<psi> = Formula.Eq (Formula.Var x) t \<or> \<psi> = Formula.Eq t (Formula.Var x)"
     unfolding safe_assignment_def by (force split: formula.splits trm.splits)
   with And_assign show ?case
     by (auto intro!: wf_mformula.AndAssign split: trm.splits)
 next
   case (And_safe \<phi> \<psi>)
   then show ?case by (auto intro!: wf_mformula.And wf_mbuf2'_0)
 next
   case (And_constraint \<phi> \<psi>)
   from \<open>fv \<psi> \<subseteq> fv \<phi>\<close> \<open>is_constraint \<psi>\<close>
   obtain t1 p c t2 where
     "(t1, p, c, t2) = split_constraint \<psi>"
     "formula_of_constraint (split_constraint \<psi>) = \<psi>"
     "fv_trm t1 \<union> fv_trm t2 \<subseteq> fv \<phi>"
     by (induction rule: is_constraint.induct) auto
   with And_constraint show ?case
     by (auto 0 3 intro!: wf_mformula.AndRel)
 next
   case (And_Not \<phi> \<psi>)
   then show ?case by (auto intro!: wf_mformula.And wf_mbuf2'_0)
 next
   case (Ands l pos neg)
   note posneg = "Ands.hyps"(1)
   let ?wf_minit = "\<lambda>x. wf_mformula \<sigma> 0 P V n R (minit0 n x)"
   let ?pos = "filter safe_formula l"
   let ?neg = "filter (Not \<circ> safe_formula) l"
   have "list_all2 ?wf_minit ?pos pos"
     using Ands.IH(1) Ands.prems posneg by (auto simp: list_all_iff intro!: list.rel_refl_strong)
   moreover have "list_all2 ?wf_minit (map remove_neg ?neg) (map remove_neg neg)"
     using Ands.IH(2) Ands.prems posneg by (auto simp: list.rel_map list_all_iff intro!: list.rel_refl_strong)
   moreover have "list_all3 (\<lambda>_ _ _. True) (?pos @ map remove_neg ?neg) (?pos @ map remove_neg ?neg) l"
     by (auto simp: list_all3_conv_all_nth comp_def sum_length_filter_compl)
   moreover have "l \<noteq> [] \<Longrightarrow> (MIN \<phi>\<in>set l. (0 :: nat)) = 0"
     by (cases l) (auto simp: Min_eq_iff)
   ultimately show ?case using Ands.hyps Ands.prems(2)
     by (auto simp: wf_mbufn_def list_all3_map list.rel_map map_replicate_const[symmetric] subset_eq
         map_map[symmetric] map_append[symmetric] simp del: map_map map_append
         intro!: wf_mformula.Ands list_all2_appendI)
 next
   case (Neg \<phi>)
   then show ?case by (auto intro!: wf_mformula.Neg)
 next
   case (Or \<phi> \<psi>)
   then show ?case by (auto intro!: wf_mformula.Or wf_mbuf2'_0)
 next
   case (Exists \<phi>)
   then show ?case by (auto simp: fvi_Suc_bound intro!: wf_mformula.Exists)
 next
   case (Agg y \<omega> b f \<phi>)
   then show ?case by (auto intro!: wf_mformula.Agg Agg.IH fvi_plus_bound)
 next
   case (Prev I \<phi>)
   thm wf_mformula.Prev[where P=P]
   then show ?case by (auto intro!: wf_mformula.Prev)
 next
   case (Next I \<phi>)
   then show ?case by (auto intro!: wf_mformula.Next)
 next
   case (Since \<phi> I \<psi>)
   then show ?case
     using wf_since_aux_Nil
     by (auto simp add: init_args_def intro!: wf_mformula.Since wf_mbuf2'_0 wf_ts_0)
 next
   case (Not_Since \<phi> I \<psi>)
   then show ?case
     using wf_since_aux_Nil
     by (auto simp add: init_args_def intro!: wf_mformula.Since wf_mbuf2'_0 wf_ts_0)
 next
   case (Until \<phi> I \<psi>)
   then show ?case
     using valid_length_muaux[OF valid_init_muaux[OF Until(1)]] wf_until_aux_Nil
     by (auto simp add: init_args_def simp del: progress_simps intro!: wf_mformula.Until wf_mbuf2'_0 wf_ts_0)
 next
   case (Not_Until \<phi> I \<psi>)
   then show ?case
     using valid_length_muaux[OF valid_init_muaux[OF Not_Until(1)]] wf_until_aux_Nil
     by (auto simp add: init_args_def simp del: progress_simps intro!: wf_mformula.Until wf_mbuf2'_0 wf_ts_0)
 next
   case (MatchP I r)
   then show ?case
     by (auto simp: list.rel_map fv_regex_alt simp del: progress_simps split: prod.split
         intro!: wf_mformula.MatchP list.rel_refl_strong wf_mbufn'_0 wf_ts_regex_0 wf_matchP_aux_Nil
         dest!: to_mregex_atms)
 next
   case (MatchF I r)
   then show ?case
     by (auto simp: list.rel_map fv_regex_alt progress_le Min_eq_iff progress_regex_def
         simp del: progress_simps split: prod.split
         intro!: wf_mformula.MatchF list.rel_refl_strong wf_mbufn'_0 wf_ts_regex_0 wf_matchF_aux_Nil
         dest!: to_mregex_atms)
 qed
 
 lemma (in maux) wf_mstate_minit: "safe_formula \<phi> \<Longrightarrow> wf_mstate \<phi> pnil R (minit \<phi>)"
   unfolding wf_mstate_def minit_def Let_def
   by (auto intro!: wf_minit0 fvi_less_nfv)
 
 
 subsubsection \<open>Evaluation\<close>
 
 lemma match_wf_tuple: "Some f = match ts xs \<Longrightarrow>
   wf_tuple n (\<Union>t\<in>set ts. Formula.fv_trm t) (Table.tabulate f 0 n)"
   by (induction ts xs arbitrary: f rule: match.induct)
     (fastforce simp: wf_tuple_def split: if_splits option.splits)+
 
 lemma match_fvi_trm_None: "Some f = match ts xs \<Longrightarrow> \<forall>t\<in>set ts. x \<notin> Formula.fv_trm t \<Longrightarrow> f x = None"
   by (induction ts xs arbitrary: f rule: match.induct) (auto split: if_splits option.splits)
 
 lemma match_fvi_trm_Some: "Some f = match ts xs \<Longrightarrow> t \<in> set ts \<Longrightarrow> x \<in> Formula.fv_trm t \<Longrightarrow> f x \<noteq> None"
   by (induction ts xs arbitrary: f rule: match.induct) (auto split: if_splits option.splits)
 
 lemma match_eval_trm: "\<forall>t\<in>set ts. \<forall>i\<in>Formula.fv_trm t. i < n \<Longrightarrow> Some f = match ts xs \<Longrightarrow>
     map (Formula.eval_trm (Table.tabulate (\<lambda>i. the (f i)) 0 n)) ts = xs"
 proof (induction ts xs arbitrary: f rule: match.induct)
   case (3 x ts y ys)
   from 3(1)[symmetric] 3(2,3) show ?case
     by (auto 0 3 dest: match_fvi_trm_Some sym split: option.splits if_splits intro!: eval_trm_fv_cong)
 qed (auto split: if_splits)
 
 lemma wf_tuple_tabulate_Some: "wf_tuple n A (Table.tabulate f 0 n) \<Longrightarrow> x \<in> A \<Longrightarrow> x < n \<Longrightarrow> \<exists>y. f x = Some y"
   unfolding wf_tuple_def by auto
 
 lemma ex_match: "wf_tuple n (\<Union>t\<in>set ts. Formula.fv_trm t) v \<Longrightarrow>
   \<forall>t\<in>set ts. (\<forall>x\<in>Formula.fv_trm t. x < n) \<and> (Formula.is_Var t \<or> Formula.is_Const t) \<Longrightarrow>
   \<exists>f. match ts (map (Formula.eval_trm (map the v)) ts) = Some f \<and> v = Table.tabulate f 0 n"
 proof (induction ts "map (Formula.eval_trm (map the v)) ts" arbitrary: v rule: match.induct)
   case (3 x ts y ys)
   then show ?case
   proof (cases "x \<in> (\<Union>t\<in>set ts. Formula.fv_trm t)")
     case True
     with 3 show ?thesis
       by (auto simp: insert_absorb dest!: wf_tuple_tabulate_Some meta_spec[of _ v])
   next
     case False
     with 3(3,4) have
       *: "map (Formula.eval_trm (map the v)) ts = map (Formula.eval_trm (map the (v[x := None]))) ts"
       by (auto simp: wf_tuple_def nth_list_update intro!: eval_trm_fv_cong)
     from False 3(2-4) obtain f where
       "match ts (map (Formula.eval_trm (map the v)) ts) = Some f" "v[x := None] = Table.tabulate f 0 n"
       unfolding *
       by (atomize_elim, intro 3(1)[of "v[x := None]"])
         (auto simp: wf_tuple_def nth_list_update intro!: eval_trm_fv_cong)
     moreover from False this have "f x = None" "length v = n"
       by (auto dest: match_fvi_trm_None[OF sym] arg_cong[of _ _ length])
     ultimately show ?thesis using 3(3)
       by (auto simp: list_eq_iff_nth_eq wf_tuple_def)
   qed
 qed (auto simp: wf_tuple_def intro: nth_equalityI)
 
 lemma eq_rel_eval_trm: "v \<in> eq_rel n t1 t2 \<Longrightarrow> is_simple_eq t1 t2 \<Longrightarrow>
   \<forall>x\<in>Formula.fv_trm t1 \<union> Formula.fv_trm t2. x < n \<Longrightarrow>
   Formula.eval_trm (map the v) t1 = Formula.eval_trm (map the v) t2"
   by (cases t1; cases t2) (simp_all add: is_simple_eq_def singleton_table_def split: if_splits)
 
 lemma in_eq_rel: "wf_tuple n (Formula.fv_trm t1 \<union> Formula.fv_trm t2) v \<Longrightarrow>
   is_simple_eq t1 t2 \<Longrightarrow>
   Formula.eval_trm (map the v) t1 = Formula.eval_trm (map the v) t2 \<Longrightarrow>
   v \<in> eq_rel n t1 t2"
   by (cases t1; cases t2)
     (auto simp: is_simple_eq_def singleton_table_def wf_tuple_def unit_table_def
       intro!: nth_equalityI split: if_splits)
 
 lemma table_eq_rel: "is_simple_eq t1 t2 \<Longrightarrow>
   table n (Formula.fv_trm t1 \<union> Formula.fv_trm t2) (eq_rel n t1 t2)"
   by (cases t1; cases t2; simp add: is_simple_eq_def)
 
 lemma wf_tuple_Suc_fviD: "wf_tuple (Suc n) (Formula.fvi b \<phi>) v \<Longrightarrow> wf_tuple n (Formula.fvi (Suc b) \<phi>) (tl v)"
   unfolding wf_tuple_def by (simp add: fvi_Suc nth_tl)
 
 lemma table_fvi_tl: "table (Suc n) (Formula.fvi b \<phi>) X \<Longrightarrow> table n (Formula.fvi (Suc b) \<phi>) (tl ` X)"
   unfolding table_def by (auto intro: wf_tuple_Suc_fviD)
 
 lemma wf_tuple_Suc_fvi_SomeI: "0 \<in> Formula.fvi b \<phi> \<Longrightarrow> wf_tuple n (Formula.fvi (Suc b) \<phi>) v \<Longrightarrow>
   wf_tuple (Suc n) (Formula.fvi b \<phi>) (Some x # v)"
   unfolding wf_tuple_def
   by (auto simp: fvi_Suc less_Suc_eq_0_disj)
 
 lemma wf_tuple_Suc_fvi_NoneI: "0 \<notin> Formula.fvi b \<phi> \<Longrightarrow> wf_tuple n (Formula.fvi (Suc b) \<phi>) v \<Longrightarrow>
   wf_tuple (Suc n) (Formula.fvi b \<phi>) (None # v)"
   unfolding wf_tuple_def
   by (auto simp: fvi_Suc less_Suc_eq_0_disj)
 
 lemma qtable_project_fv: "qtable (Suc n) (fv \<phi>) (mem_restr (lift_envs R)) P X \<Longrightarrow>
     qtable n (Formula.fvi (Suc 0) \<phi>) (mem_restr R)
       (\<lambda>v. \<exists>x. P ((if 0 \<in> fv \<phi> then Some x else None) # v)) (tl ` X)"
   using neq0_conv by (fastforce simp: image_iff Bex_def fvi_Suc elim!: qtable_cong dest!: qtable_project)
 
 lemma mem_restr_lift_envs'_append[simp]:
   "length xs = b \<Longrightarrow> mem_restr (lift_envs' b R) (xs @ ys) = mem_restr R ys"
   unfolding mem_restr_def lift_envs'_def
   by (auto simp: list_all2_append list.rel_map intro!: exI[where x="map the xs"] list.rel_refl)
 
 lemma nth_list_update_alt: "xs[i := x] ! j = (if i < length xs \<and> i = j then x else xs ! j)"
   by auto
 
 lemma wf_tuple_upd_None: "wf_tuple n A xs \<Longrightarrow> A - {i} = B \<Longrightarrow> wf_tuple n B (xs[i:=None])"
   unfolding wf_tuple_def
   by (auto simp: nth_list_update_alt)
 
 lemma mem_restr_upd_None: "mem_restr R xs \<Longrightarrow> mem_restr R (xs[i:=None])"
   unfolding mem_restr_def
   by (auto simp: list_all2_conv_all_nth nth_list_update_alt)
 
 lemma mem_restr_dropI: "mem_restr (lift_envs' b R) xs \<Longrightarrow> mem_restr R (drop b xs)"
   unfolding mem_restr_def lift_envs'_def
   by (auto simp: append_eq_conv_conj list_all2_append2)
 
 lemma mem_restr_dropD:
   assumes "b \<le> length xs" and "mem_restr R (drop b xs)"
   shows "mem_restr (lift_envs' b R) xs"
 proof -
   let ?R = "\<lambda>a b. a \<noteq> None \<longrightarrow> a = Some b"
   from assms(2) obtain v where "v \<in> R" and "list_all2 ?R (drop b xs) v"
     unfolding mem_restr_def ..
   show ?thesis unfolding mem_restr_def proof
     have "list_all2 ?R (take b xs) (map the (take b xs))"
       by (auto simp: list.rel_map intro!: list.rel_refl)
     moreover note \<open>list_all2 ?R (drop b xs) v\<close>
     ultimately have "list_all2 ?R (take b xs @ drop b xs) (map the (take b xs) @ v)"
       by (rule list_all2_appendI)
     then show "list_all2 ?R xs (map the (take b xs) @ v)" by simp
     show "map the (take b xs) @ v \<in> lift_envs' b R"
       unfolding lift_envs'_def using assms(1) \<open>v \<in> R\<close> by auto
   qed
 qed
 
 lemma wf_tuple_append: "wf_tuple a {x \<in> A. x < a} xs \<Longrightarrow>
   wf_tuple b {x - a | x. x \<in> A \<and> x \<ge> a} ys \<Longrightarrow>
   wf_tuple (a + b) A (xs @ ys)"
   unfolding wf_tuple_def by (auto simp: nth_append eq_diff_iff)
 
 lemma wf_tuple_map_Some: "length xs = n \<Longrightarrow> {0..<n} \<subseteq> A \<Longrightarrow> wf_tuple n A (map Some xs)"
   unfolding wf_tuple_def by auto
 
 lemma wf_tuple_drop: "wf_tuple (b + n) A xs \<Longrightarrow> {x - b | x. x \<in> A \<and> x \<ge> b} = B \<Longrightarrow>
   wf_tuple n B (drop b xs)"
   unfolding wf_tuple_def by force
 
 lemma ecard_image: "inj_on f A \<Longrightarrow> ecard (f ` A) = ecard A"
   unfolding ecard_def by (auto simp: card_image dest: finite_imageD)
 
 lemma meval_trm_eval_trm: "wf_tuple n A x \<Longrightarrow> fv_trm t \<subseteq> A \<Longrightarrow> \<forall>i\<in>A. i < n \<Longrightarrow>
     meval_trm t x = Formula.eval_trm (map the x) t"
   unfolding wf_tuple_def
   by (induction t) simp_all
 
 lemma list_update_id: "xs ! i = z \<Longrightarrow> xs[i:=z] = xs"
   by (induction xs arbitrary: i) (auto split: nat.split)
 
 lemma qtable_wf_tupleD: "qtable n A P Q X \<Longrightarrow> \<forall>x\<in>X. wf_tuple n A x"
   unfolding qtable_def table_def by blast
 
 lemma qtable_eval_agg:
   assumes inner: "qtable (b + n) (Formula.fv \<phi>) (mem_restr (lift_envs' b R))
       (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) rel"
     and n: "\<forall>x\<in>Formula.fv (Formula.Agg y \<omega> b f \<phi>). x < n"
     and fresh: "y + b \<notin> Formula.fv \<phi>"
     and b_fv: "{0..<b} \<subseteq> Formula.fv \<phi>"
     and f_fv: "Formula.fv_trm f \<subseteq> Formula.fv \<phi>"
     and g0: "g0 = (Formula.fv \<phi> \<subseteq> {0..<b})"
   shows "qtable n (Formula.fv (Formula.Agg y \<omega> b f \<phi>)) (mem_restr R)
       (\<lambda>v. Formula.sat \<sigma> V (map the v) i (Formula.Agg y \<omega> b f \<phi>)) (eval_agg n g0 y \<omega> b f rel)"
     (is "qtable _ ?fv _ ?Q ?rel'")
 proof -
   define M where "M = (\<lambda>v. {(x, ecard Zs) | x Zs.
       Zs = {zs. length zs = b \<and> Formula.sat \<sigma> V (zs @ v) i \<phi> \<and> Formula.eval_trm (zs @ v) f = x} \<and>
       Zs \<noteq> {}})"
   have f_fvi: "Formula.fvi_trm b f \<subseteq> Formula.fvi b \<phi>"
     using f_fv by (auto simp: fvi_trm_iff_fv_trm[where b=b] fvi_iff_fv[where b=b])
   show ?thesis proof (cases "g0 \<and> rel = empty_table")
     case True
     then have [simp]: "Formula.fvi b \<phi> = {}"
       by (auto simp: g0 fvi_iff_fv(1)[where b=b])
     then have [simp]: "Formula.fvi_trm b f = {}"
       using f_fvi by auto
     show ?thesis proof (rule qtableI)
       show "table n ?fv ?rel'" by (simp add: eval_agg_def True)
     next
       fix v
       assume "wf_tuple n ?fv v" "mem_restr R v"
       have "\<not> Formula.sat \<sigma> V (zs @ map the v) i \<phi>" if [simp]: "length zs = b" for zs
       proof -
         let ?zs = "map2 (\<lambda>z i. if i \<in> Formula.fv \<phi> then Some z else None) zs [0..<b]"
         have "wf_tuple b {x \<in> fv \<phi>. x < b} ?zs"
           by (simp add: wf_tuple_def)
         then have "wf_tuple (b + n) (Formula.fv \<phi>) (?zs @ v[y:=None])"
           using \<open>wf_tuple n ?fv v\<close> True
           by (auto simp: g0 intro!: wf_tuple_append wf_tuple_upd_None)
         then have "\<not> Formula.sat \<sigma> V (map the (?zs @ v[y:=None])) i \<phi>"
           using True \<open>mem_restr R v\<close>
           by (auto simp del: map_append dest!: in_qtableI[OF inner, rotated -1]
               intro!: mem_restr_upd_None)
         also have "Formula.sat \<sigma> V (map the (?zs @ v[y:=None])) i \<phi> \<longleftrightarrow> Formula.sat \<sigma> V (zs @ map the v) i \<phi>"
           using True by (auto simp: g0 nth_append intro!: sat_fv_cong)
         finally show ?thesis .
       qed
       then have M_empty: "M (map the v) = {}"
         unfolding M_def by blast
       show "Formula.sat \<sigma> V (map the v) i (Formula.Agg y \<omega> b f \<phi>)"
         if "v \<in> eval_agg n g0 y \<omega> b f rel"
         using M_empty True that n
         by (simp add: M_def eval_agg_def g0 singleton_table_def)
       have "v \<in> singleton_table n y (the (v ! y))" "length v = n"
         using \<open>wf_tuple n ?fv v\<close> unfolding wf_tuple_def singleton_table_def
         by (auto simp add: tabulate_alt map_nth
             intro!: trans[OF map_cong[where g="(!) v", simplified nth_map, OF refl], symmetric])
       then show "v \<in> eval_agg n g0 y \<omega> b f rel"
         if "Formula.sat \<sigma> V (map the v) i (Formula.Agg y \<omega> b f \<phi>)"
         using M_empty True that n
         by (simp add: M_def eval_agg_def g0)
     qed
   next
     case non_default_case: False
     have union_fv: "{0..<b} \<union> (\<lambda>x. x + b) ` Formula.fvi b \<phi> = fv \<phi>"
       using b_fv
       by (auto simp: fvi_iff_fv(1)[where b=b] intro!: image_eqI[where b=x and x="x - b" for x])
     have b_n: "\<forall>x\<in>fv \<phi>. x < b + n"
     proof
       fix x assume "x \<in> fv \<phi>"
       show "x < b + n" proof (cases "x \<ge> b")
         case True
         with \<open>x \<in> fv \<phi>\<close> have "x - b \<in> ?fv"
           by (simp add: fvi_iff_fv(1)[where b=b])
         then show ?thesis using n f_fvi by (auto simp: Un_absorb2)
       qed simp
     qed
 
     define M' where "M' = (\<lambda>k. let group = Set.filter (\<lambda>x. drop b x = k) rel;
         images = meval_trm f ` group
       in (\<lambda>y. (y, ecard (Set.filter (\<lambda>x. meval_trm f x = y) group))) ` images)"
     have M'_M: "M' (drop b x) = M (map the (drop b x))" if "x \<in> rel" "mem_restr (lift_envs' b R) x" for x
     proof -
       from that have wf_x: "wf_tuple (b + n) (fv \<phi>) x"
         by (auto elim!: in_qtableE[OF inner])
       then have wf_zs_x: "wf_tuple (b + n) (fv \<phi>) (map Some zs @ drop b x)"
         if "length zs = b" for zs
         using that b_fv
         by (auto intro!: wf_tuple_append wf_tuple_map_Some wf_tuple_drop)
       have 1: "(length zs = b \<and> Formula.sat \<sigma> V (zs @ map the (drop b x)) i \<phi> \<and>
           Formula.eval_trm (zs @ map the (drop b x)) f = y) \<longleftrightarrow>
         (\<exists>a. a \<in> rel \<and> take b a = map Some zs \<and> drop b a = drop b x \<and> meval_trm f a = y)"
         (is "?A \<longleftrightarrow> (\<exists>a. ?B a)") for y zs
       proof (intro iffI conjI)
         assume ?A
         then have "?B (map Some zs @ drop (length zs) x)"
           using in_qtableI[OF inner wf_zs_x] \<open>mem_restr (lift_envs' b R) x\<close>
             meval_trm_eval_trm[OF wf_zs_x f_fv b_n]
           by (auto intro!: mem_restr_dropI)
         then show "\<exists>a. ?B a" ..
       next
         assume "\<exists>a. ?B a"
         then obtain a where "?B a" ..
         then have "a \<in> rel" and a_eq: "a = map Some zs @ drop b x"
           using append_take_drop_id[of b a] by auto
         then have "length a = b + n"
           using inner unfolding qtable_def table_def
           by (blast intro!: wf_tuple_length)
         then show "length zs = b"
           using wf_tuple_length[OF wf_x] unfolding a_eq by simp
         then have "mem_restr (lift_envs' b R) a"
           using \<open>mem_restr _ x\<close> unfolding a_eq by (auto intro!: mem_restr_dropI)
         then show "Formula.sat \<sigma> V (zs @ map the (drop b x)) i \<phi>"
           using in_qtableE[OF inner \<open>a \<in> rel\<close>]
           by (auto simp: a_eq sat_fv_cong[THEN iffD1, rotated -1])
         from \<open>?B a\<close> show "Formula.eval_trm (zs @ map the (drop b x)) f = y"
           using meval_trm_eval_trm[OF wf_zs_x f_fv b_n, OF \<open>length zs = b\<close>]
           unfolding a_eq by simp
       qed
       have 2: "map Some (map the (take b a)) = take b a" if "a \<in> rel" for a
         using that b_fv inner[THEN qtable_wf_tupleD]
         unfolding table_def wf_tuple_def
         by (auto simp: list_eq_iff_nth_eq)
       have 3: "ecard {zs. \<exists>a. a \<in> rel \<and> take b a = map Some zs \<and> drop b a = drop b x \<and> P a} =
         ecard {a. a \<in> rel \<and> drop b a = drop b x \<and> P a}" (is "ecard ?A = ecard ?B") for P
       proof -
         have "ecard ?A = ecard ((\<lambda>zs. map Some zs @ drop b x) ` ?A)"
           by (auto intro!: ecard_image[symmetric] inj_onI)
         also have "(\<lambda>zs. map Some zs @ drop b x) ` ?A = ?B"
           by (subst (1 2) eq_commute) (auto simp: image_iff, metis "2" append_take_drop_id)
         finally show ?thesis .
       qed
       show ?thesis
         unfolding M_def M'_def
         by (auto simp: non_default_case Let_def image_def Set.filter_def 1 3, metis "2")
     qed
     have drop_lift: "mem_restr (lift_envs' b R) x" if "x \<in> rel" "mem_restr R ((drop b x)[y:=z])" for x z
     proof -
       have "(drop b x)[y:=None] = (drop b x)[y:=drop b x ! y]" proof -
         from \<open>x \<in> rel\<close> have "drop b x ! y = None"
           using fresh n inner[THEN qtable_wf_tupleD]
           by (simp add: add.commute wf_tuple_def)
         then show ?thesis by simp
       qed
       then have "(drop b x)[y:=None] = drop b x" by simp
       moreover from \<open>x \<in> rel\<close> have "length x = b + n"
         using inner[THEN qtable_wf_tupleD]
         by (simp add: wf_tuple_def)
       moreover from that(2) have "mem_restr R ((drop b x)[y:=z, y:=None])"
         by (rule mem_restr_upd_None)
       ultimately show ?thesis
         by (auto intro!: mem_restr_dropD)
     qed
 
     {
       fix v
       assume "mem_restr R v"
       have "v \<in> (\<lambda>k. k[y:=Some (eval_agg_op \<omega> (M' k))]) ` drop b ` rel \<longleftrightarrow>
           v \<in> (\<lambda>k. k[y:=Some (eval_agg_op \<omega> (M (map the k)))]) ` drop b ` rel"
         (is "v \<in> ?A \<longleftrightarrow> v \<in> ?B")
       proof
         assume "v \<in> ?A"
         then obtain v' where *: "v' \<in> rel" "v = (drop b v')[y:=Some (eval_agg_op \<omega> (M' (drop b v')))]"
           by auto
         then have "M' (drop b v') = M (map the (drop b v'))"
           using \<open>mem_restr R v\<close> by (auto intro!: M'_M drop_lift)
         with * show "v \<in> ?B" by simp
       next
         assume "v \<in> ?B"
         then obtain v' where *: "v' \<in> rel" "v = (drop b v')[y:=Some (eval_agg_op \<omega> (M (map the (drop b v'))))]"
           by auto
         then have "M (map the (drop b v')) = M' (drop b v')"
           using \<open>mem_restr R v\<close> by (auto intro!: M'_M[symmetric] drop_lift)
         with * show "v \<in> ?A" by simp
       qed
       then have "v \<in> eval_agg n g0 y \<omega> b f rel \<longleftrightarrow> v \<in> (\<lambda>k. k[y:=Some (eval_agg_op \<omega> (M (map the k)))]) ` drop b ` rel"
         by (simp add: non_default_case eval_agg_def M'_def Let_def)
     }
     note alt = this
 
     show ?thesis proof (rule qtableI)
       show "table n ?fv ?rel'"
         using inner[THEN qtable_wf_tupleD] n f_fvi
         by (auto simp: eval_agg_def non_default_case table_def wf_tuple_def Let_def nth_list_update
             fvi_iff_fv[where b=b] add.commute)
     next
       fix v
       assume "wf_tuple n ?fv v" "mem_restr R v"
       then have length_v: "length v = n" by (simp add: wf_tuple_def)
 
       show "Formula.sat \<sigma> V (map the v) i (Formula.Agg y \<omega> b f \<phi>)"
         if "v \<in> eval_agg n g0 y \<omega> b f rel"
       proof -
         from that obtain v' where "v' \<in> rel"
           "v = (drop b v')[y:=Some (eval_agg_op \<omega> (M (map the (drop b v'))))]"
           using alt[OF \<open>mem_restr R v\<close>] by blast
         then have length_v': "length v' = b + n"
           using inner[THEN qtable_wf_tupleD]
           by (simp add: wf_tuple_def)
         have "Formula.sat \<sigma> V (map the v') i \<phi>"
           using \<open>v' \<in> rel\<close> \<open>mem_restr R v\<close>
           by (auto simp: \<open>v = _\<close> elim!: in_qtableE[OF inner] intro!: drop_lift \<open>v' \<in> rel\<close>)
         then have "Formula.sat \<sigma> V (map the (take b v') @ map the v) i \<phi>"
         proof (rule sat_fv_cong[THEN iffD1, rotated], intro ballI)
           fix x
           assume "x \<in> fv \<phi>"
           then have "x \<noteq> y + b" using fresh by blast
           moreover have "x < length v'"
             using \<open>x \<in> fv \<phi>\<close> b_n by (simp add: length_v')
           ultimately show "map the v' ! x = (map the (take b v') @ map the v) ! x"
             by (auto simp: \<open>v = _\<close> nth_append)
         qed
         then have 1: "M (map the v) \<noteq> {}" by (force simp: M_def length_v')
 
         have "y < length (drop b v')" using n by (simp add: length_v')
         moreover have "Formula.sat \<sigma> V (zs @ map the v) i \<phi> \<longleftrightarrow>
           Formula.sat \<sigma> V (zs @ map the (drop b v')) i \<phi>" if "length zs = b" for zs
         proof (intro sat_fv_cong ballI)
           fix x
           assume "x \<in> fv \<phi>"
           then have "x \<noteq> y + b" using fresh by blast
           moreover have "x < length v'"
             using \<open>x \<in> fv \<phi>\<close> b_n by (simp add: length_v')
           ultimately show "(zs @ map the v) ! x = (zs @ map the (drop b v')) ! x"
             by (auto simp: \<open>v = _\<close> that nth_append)
         qed
         moreover have "Formula.eval_trm (zs @ map the v) f =
           Formula.eval_trm (zs @ map the (drop b v')) f" if "length zs = b" for zs
         proof (intro eval_trm_fv_cong ballI)
           fix x
           assume "x \<in> fv_trm f"
           then have "x \<noteq> y + b" using f_fv fresh by blast
           moreover have "x < length v'"
             using \<open>x \<in> fv_trm f\<close> f_fv b_n by (auto simp: length_v')
           ultimately show "(zs @ map the v) ! x = (zs @ map the (drop b v')) ! x"
             by (auto simp: \<open>v = _\<close> that nth_append)
         qed
         ultimately have "map the v ! y = eval_agg_op \<omega> (M (map the v))"
           by (simp add: M_def \<open>v = _\<close> conj_commute cong: conj_cong)
         with 1 show ?thesis by (auto simp: M_def)
       qed
 
       show "v \<in> eval_agg n g0 y \<omega> b f rel"
         if sat_Agg: "Formula.sat \<sigma> V (map the v) i (Formula.Agg y \<omega> b f \<phi>)"
       proof -
         obtain zs where "length zs = b" and "map Some zs @ v[y:=None] \<in> rel"
         proof (cases "fv \<phi> \<subseteq> {0..<b}")
           case True
           with non_default_case have "rel \<noteq> empty_table" by (simp add: g0)
           then obtain x where "x \<in> rel" by auto
           have "(\<forall>i < n. (v[y:=None]) ! i = None)"
             using True \<open>wf_tuple n ?fv v\<close> f_fv
             by (fastforce simp: wf_tuple_def fvi_iff_fv[where b=b] fvi_trm_iff_fv_trm[where b=b])
           moreover have x: "(\<forall>i < n. drop b x ! i = None) \<and> length x = b + n"
             using True \<open>x \<in> rel\<close> inner[THEN qtable_wf_tupleD] f_fv
             by (auto simp: wf_tuple_def)
           ultimately have "v[y:=None] = drop b x"
             unfolding list_eq_iff_nth_eq by (auto simp: length_v)
           with \<open>x \<in> rel\<close> have "take b x @ v[y:=None] \<in> rel" by simp
           moreover have "map (Some \<circ> the) (take b x) = take b x"
             using True \<open>x \<in> rel\<close> inner[THEN qtable_wf_tupleD] b_fv
             by (subst map_cong[where g=id, OF refl]) (auto simp: wf_tuple_def in_set_conv_nth)
           ultimately have "map Some (map the (take b x)) @ v[y:=None] \<in> rel" by simp
           then show thesis using x[THEN conjunct2] by (fastforce intro!: that[rotated])
         next
           case False
           with sat_Agg obtain zs where "length zs = b" and "Formula.sat \<sigma> V (zs @ map the v) i \<phi>"
             by auto
           then have "Formula.sat \<sigma> V (zs @ map the (v[y:=None])) i \<phi>"
             using fresh
             by (auto simp: map_update not_less nth_append elim!: sat_fv_cong[THEN iffD1, rotated]
                 intro!: nth_list_update_neq[symmetric])
           then have "map Some zs @ v[y:=None] \<in> rel"
             using b_fv f_fv fresh
             by (auto intro!: in_qtableI[OF inner] wf_tuple_append wf_tuple_map_Some
                 wf_tuple_upd_None \<open>wf_tuple n ?fv v\<close> mem_restr_upd_None \<open>mem_restr R v\<close>
                 simp: \<open>length zs = b\<close> set_eq_iff fvi_iff_fv[where b=b] fvi_trm_iff_fv_trm[where b=b])
               force+
           with that \<open>length zs = b\<close> show thesis by blast
         qed
         then have 1: "v[y:=None] \<in> drop b ` rel" by (intro image_eqI) auto
 
         have y_length: "y < length v" using n by (simp add: length_v)
         moreover have "Formula.sat \<sigma> V (zs @ map the (v[y:=None])) i \<phi> \<longleftrightarrow>
           Formula.sat \<sigma> V (zs @ map the v) i \<phi>" if "length zs = b" for zs
         proof (intro sat_fv_cong ballI)
           fix x
           assume "x \<in> fv \<phi>"
           then have "x \<noteq> y + b" using fresh by blast
           moreover have "x < b + length v"
             using \<open>x \<in> fv \<phi>\<close> b_n by (simp add: length_v)
           ultimately show "(zs @ map the (v[y:=None])) ! x = (zs @ map the v) ! x"
             by (auto simp: that nth_append)
         qed
         moreover have "Formula.eval_trm (zs @ map the (v[y:=None])) f =
           Formula.eval_trm (zs @ map the v) f" if "length zs = b" for zs
         proof (intro eval_trm_fv_cong ballI)
           fix x
           assume "x \<in> fv_trm f"
           then have "x \<noteq> y + b" using f_fv fresh by blast
           moreover have "x < b + length v"
             using \<open>x \<in> fv_trm f\<close> f_fv b_n by (auto simp: length_v)
           ultimately show "(zs @ map the (v[y:=None])) ! x = (zs @ map the v) ! x"
             by (auto simp: that nth_append)
         qed
         ultimately have "map the v ! y = eval_agg_op \<omega> (M (map the (v[y:=None])))"
           using sat_Agg by (simp add: M_def cong: conj_cong) (simp cong: rev_conj_cong)
         then have 2: "v ! y = Some (eval_agg_op \<omega> (M (map the (v[y:=None]))))"
           using \<open>wf_tuple n ?fv v\<close> y_length by (auto simp add: wf_tuple_def)
         show ?thesis
           unfolding alt[OF \<open>mem_restr R v\<close>]
           by (rule image_eqI[where x="v[y:=None]"]) (use 1 2 in \<open>auto simp: y_length list_update_id\<close>)
       qed
     qed
   qed
 qed
 
 lemma mprev: "mprev_next I xs ts = (ys, xs', ts') \<Longrightarrow>
   list_all2 P [i..<j'] xs \<Longrightarrow> list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [i..<j] ts \<Longrightarrow> i \<le> j' \<Longrightarrow> i < j \<Longrightarrow>
   list_all2 (\<lambda>i X. if mem (\<tau> \<sigma> (Suc i) - \<tau> \<sigma> i) I then P i X else X = empty_table)
     [i..<min j' (j-1)] ys \<and>
   list_all2 P [min j' (j-1)..<j'] xs' \<and>
   list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min j' (j-1)..<j] ts'"
 proof (induction I xs ts arbitrary: i ys xs' ts' rule: mprev_next.induct)
   case (1 I ts)
   then have "min j' (j-1) = i" by auto
   with 1 show ?case by auto
 next
   case (3 I v v' t)
   then have "min j' (j-1) = i" by (auto simp: list_all2_Cons2 upt_eq_Cons_conv)
   with 3 show ?case by auto
 next
   case (4 I x xs t t' ts)
   from 4(1)[of "tl ys" xs' ts' "Suc i"] 4(2-6) show ?case
     by (auto simp add: list_all2_Cons2 upt_eq_Cons_conv Suc_less_eq2
         elim!: list.rel_mono_strong split: prod.splits if_splits)
 qed simp
 
 lemma mnext: "mprev_next I xs ts = (ys, xs', ts') \<Longrightarrow>
   list_all2 P [Suc i..<j'] xs \<Longrightarrow> list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [i..<j] ts \<Longrightarrow> Suc i \<le> j' \<Longrightarrow> i < j \<Longrightarrow>
   list_all2 (\<lambda>i X. if mem (\<tau> \<sigma> (Suc i) - \<tau> \<sigma> i) I then P (Suc i) X else X = empty_table)
     [i..<min (j'-1) (j-1)] ys \<and>
   list_all2 P [Suc (min (j'-1) (j-1))..<j'] xs' \<and>
   list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min (j'-1) (j-1)..<j] ts'"
 proof (induction I xs ts arbitrary: i ys xs' ts' rule: mprev_next.induct)
   case (1 I ts)
   then have "min (j' - 1) (j-1) = i" by auto
   with 1 show ?case by auto
 next
   case (3 I v v' t)
   then have "min (j' - 1) (j-1) = i" by (auto simp: list_all2_Cons2 upt_eq_Cons_conv)
   with 3 show ?case by auto
 next
   case (4 I x xs t t' ts)
   from 4(1)[of "tl ys" xs' ts' "Suc i"] 4(2-6) show ?case
     by (auto simp add: list_all2_Cons2 upt_eq_Cons_conv Suc_less_eq2
         elim!: list.rel_mono_strong split: prod.splits if_splits) (* slow 10 sec *)
 qed simp
 
 lemma in_foldr_UnI: "x \<in> A \<Longrightarrow> A \<in> set xs \<Longrightarrow> x \<in> foldr (\<union>) xs {}"
   by (induction xs) auto
 
 lemma in_foldr_UnE: "x \<in> foldr (\<union>) xs {} \<Longrightarrow> (\<And>A. A \<in> set xs \<Longrightarrow> x \<in> A \<Longrightarrow> P) \<Longrightarrow> P"
   by (induction xs) auto
 
 lemma sat_the_restrict: "fv \<phi> \<subseteq> A \<Longrightarrow> Formula.sat \<sigma> V (map the (restrict A v)) i \<phi> = Formula.sat \<sigma> V (map the v) i \<phi>"
   by (rule sat_fv_cong) (auto intro!: map_the_restrict)
 
 lemma eps_the_restrict: "fv_regex r \<subseteq> A \<Longrightarrow> Regex.eps (Formula.sat \<sigma> V (map the (restrict A v))) i r = Regex.eps (Formula.sat \<sigma> V (map the v)) i r"
   by (rule eps_fv_cong) (auto intro!: map_the_restrict)
 
 lemma sorted_wrt_filter[simp]: "sorted_wrt R xs \<Longrightarrow> sorted_wrt R (filter P xs)"
   by (induct xs) auto
 
 lemma concat_map_filter[simp]:
   "concat (map f (filter P xs)) = concat (map (\<lambda>x. if P x then f x else []) xs)"
   by (induct xs) auto
 
 lemma map_filter_alt:
   "map f (filter P xs) = concat (map (\<lambda>x. if P x then [f x] else []) xs)"
   by (induct xs) auto
 
 lemma (in maux) update_since:
   assumes pre: "wf_since_aux \<sigma> V R args \<phi> \<psi> aux ne"
     and qtable1: "qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne \<phi>) rel1"
     and qtable2: "qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne \<psi>) rel2"
     and result_eq: "(rel, aux') = update_since args rel1 rel2 (\<tau> \<sigma> ne) aux"
     and fvi_subset: "Formula.fv \<phi> \<subseteq> Formula.fv \<psi>"
     and args_ivl: "args_ivl args = I"
     and args_n: "args_n args = n"
     and args_L: "args_L args = Formula.fv \<phi>"
     and args_R: "args_R args = Formula.fv \<psi>"
     and args_pos: "args_pos args = pos"
   shows "wf_since_aux \<sigma> V R args \<phi> \<psi> aux' (Suc ne)"
     and "qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Sincep pos \<phi> I \<psi>)) rel"
 proof -
   let ?wf_tuple = "\<lambda>v. wf_tuple n (Formula.fv \<psi>) v"
   note sat.simps[simp del]
   from pre[unfolded wf_since_aux_def] obtain cur auxlist where aux: "valid_msaux args cur aux auxlist"
     "sorted_wrt (\<lambda>x y. fst y < fst x) auxlist"
     "\<And>t X. (t, X) \<in> set auxlist \<Longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne - 1) \<and> \<tau> \<sigma> (ne - 1) - t \<le> right I \<and>
       (\<exists>i. \<tau> \<sigma> i = t) \<and>
       qtable n (fv \<psi>) (mem_restr R)
         (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne - 1) (Sincep pos \<phi> (point (\<tau> \<sigma> (ne - 1) - t)) \<psi>)) X"
     "\<And>t. ne \<noteq> 0 \<Longrightarrow> t \<le> \<tau> \<sigma> (ne - 1) \<Longrightarrow> \<tau> \<sigma> (ne - 1) - t \<le> right I \<Longrightarrow> (\<exists>i. \<tau> \<sigma> i = t) \<Longrightarrow>
       (\<exists>X. (t, X) \<in> set auxlist)"
     and cur_def:
     "cur = (if ne = 0 then 0 else \<tau> \<sigma> (ne - 1))"
     unfolding args_ivl args_n args_pos by blast
   from pre[unfolded wf_since_aux_def] have fv_sub: "Formula.fv \<phi> \<subseteq> Formula.fv \<psi>" by simp
 
   define aux0 where "aux0 = join_msaux args rel1 (add_new_ts_msaux args (\<tau> \<sigma> ne) aux)"
   define auxlist0 where "auxlist0 = [(t, join rel pos rel1). (t, rel) \<leftarrow> auxlist, \<tau> \<sigma> ne - t \<le> right I]"
   have tabL: "table (args_n args) (args_L args) rel1"
     using qtable1[unfolded qtable_def] unfolding args_n[symmetric] args_L[symmetric] by simp
   have cur_le: "cur \<le> \<tau> \<sigma> ne"
     unfolding cur_def by auto
   have valid0: "valid_msaux args (\<tau> \<sigma> ne) aux0 auxlist0" unfolding aux0_def auxlist0_def
     using valid_join_msaux[OF valid_add_new_ts_msaux[OF aux(1)], OF cur_le tabL]
     by (auto simp: args_ivl args_pos cur_def map_filter_alt split_beta cong: map_cong)
   from aux(2) have sorted_auxlist0: "sorted_wrt (\<lambda>x y. fst x > fst y) auxlist0"
     unfolding auxlist0_def
     by (induction auxlist) (auto simp add: sorted_wrt_append)
   have in_auxlist0_1: "(t, X) \<in> set auxlist0 \<Longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> (ne-1) \<and> \<tau> \<sigma> ne - t \<le> right I \<and>
       (\<exists>i. \<tau> \<sigma> i = t) \<and>
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. (Formula.sat \<sigma> V (map the v) (ne-1) (Sincep pos \<phi> (point (\<tau> \<sigma> (ne-1) - t)) \<psi>) \<and>
         (if pos then Formula.sat \<sigma> V (map the v) ne \<phi> else \<not> Formula.sat \<sigma> V (map the v) ne \<phi>))) X" for t X
     unfolding auxlist0_def using fvi_subset
     by (auto 0 1 elim!: qtable_join[OF _ qtable1] simp: sat_the_restrict dest!: aux(3))
   then have in_auxlist0_le_\<tau>: "(t, X) \<in> set auxlist0 \<Longrightarrow> t \<le> \<tau> \<sigma> ne" for t X
     by (meson \<tau>_mono diff_le_self le_trans)
   have in_auxlist0_2: "ne \<noteq> 0 \<Longrightarrow> t \<le> \<tau> \<sigma> (ne-1) \<Longrightarrow> \<tau> \<sigma> ne - t \<le> right I \<Longrightarrow> \<exists>i. \<tau> \<sigma> i = t \<Longrightarrow>
     \<exists>X. (t, X) \<in> set auxlist0" for t
   proof -
     fix t
     assume "ne \<noteq> 0" "t \<le> \<tau> \<sigma> (ne-1)" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t"
     then obtain X where "(t, X) \<in> set auxlist"
       by (atomize_elim, intro aux(4))
         (auto simp: gr0_conv_Suc elim!: order_trans[rotated] intro!: diff_le_mono \<tau>_mono)
     with \<open>\<tau> \<sigma> ne - t \<le> right I\<close> have "(t, join X pos rel1) \<in> set auxlist0"
       unfolding auxlist0_def by (auto elim!: bexI[rotated] intro!: exI[of _ X])
     then show "\<exists>X. (t, X) \<in> set auxlist0"
       by blast
   qed
   have auxlist0_Nil: "auxlist0 = [] \<Longrightarrow> ne = 0 \<or> ne \<noteq> 0 \<and> (\<forall>t. t \<le> \<tau> \<sigma> (ne-1) \<and> \<tau> \<sigma> ne - t \<le> right I \<longrightarrow>
         (\<nexists>i. \<tau> \<sigma> i = t))"
     using in_auxlist0_2 by (auto)
 
   have aux'_eq: "aux' = add_new_table_msaux args rel2 aux0"
     using result_eq unfolding aux0_def update_since_def Let_def by simp
   define auxlist' where
     auxlist'_eq: "auxlist' = (case auxlist0 of
       [] \<Rightarrow> [(\<tau> \<sigma> ne, rel2)]
     | x # auxlist' \<Rightarrow> (if fst x = \<tau> \<sigma> ne then (fst x, snd x \<union> rel2) # auxlist' else (\<tau> \<sigma> ne, rel2) # x # auxlist'))"
   have tabR: "table (args_n args) (args_R args) rel2"
     using qtable2[unfolded qtable_def] unfolding args_n[symmetric] args_R[symmetric] by simp
   have valid': "valid_msaux args (\<tau> \<sigma> ne) aux' auxlist'"
     unfolding aux'_eq auxlist'_eq using valid_add_new_table_msaux[OF valid0 tabR]
     by (auto simp: not_le split: list.splits option.splits if_splits)
   have sorted_auxlist': "sorted_wrt (\<lambda>x y. fst x > fst y) auxlist'"
     unfolding auxlist'_eq
     using sorted_auxlist0 in_auxlist0_le_\<tau> by (cases auxlist0) fastforce+
   have in_auxlist'_1: "t \<le> \<tau> \<sigma> ne \<and> \<tau> \<sigma> ne - t \<le> right I \<and> (\<exists>i. \<tau> \<sigma> i = t) \<and>
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Sincep pos \<phi> (point (\<tau> \<sigma> ne - t)) \<psi>)) X"
     if auxlist': "(t, X) \<in> set auxlist'" for t X
   proof (cases auxlist0)
     case Nil
     with auxlist' show ?thesis
       unfolding auxlist'_eq using qtable2 auxlist0_Nil
       by (auto simp: zero_enat_def[symmetric] sat_Since_rec[where i=ne]
           dest: spec[of _ "\<tau> \<sigma> (ne-1)"] elim!: qtable_cong[OF _ refl])
   next
     case (Cons a as)
     show ?thesis
     proof (cases "t = \<tau> \<sigma> ne")
       case t: True
       show ?thesis
       proof (cases "fst a = \<tau> \<sigma> ne")
         case True
         with auxlist' Cons t have "X = snd a \<union> rel2"
           unfolding auxlist'_eq using sorted_auxlist0 by (auto split: if_splits)
         moreover from in_auxlist0_1[of "fst a" "snd a"] Cons have "ne \<noteq> 0"
           "fst a \<le> \<tau> \<sigma> (ne - 1)" "\<tau> \<sigma> ne - fst a \<le> right I" "\<exists>i. \<tau> \<sigma> i = fst a"
           "qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne - 1)
             (Sincep pos \<phi> (point (\<tau> \<sigma> (ne - 1) - fst a)) \<psi>) \<and> (if pos then Formula.sat \<sigma> V (map the v) ne \<phi>
               else \<not> Formula.sat \<sigma> V (map the v) ne \<phi>)) (snd a)"
           by (auto simp: True[symmetric] zero_enat_def[symmetric])
         ultimately show ?thesis using qtable2 t True
           by (auto simp: sat_Since_rec[where i=ne] sat.simps(6) elim!: qtable_union)
       next
         case False
         with auxlist' Cons t have "X = rel2"
           unfolding auxlist'_eq using sorted_auxlist0 in_auxlist0_le_\<tau>[of "fst a" "snd a"] by (auto split: if_splits)
         with auxlist' Cons t False show ?thesis
           unfolding auxlist'_eq using qtable2 in_auxlist0_2[of "\<tau> \<sigma> (ne-1)"] in_auxlist0_le_\<tau>[of "fst a" "snd a"] sorted_auxlist0
           by (auto simp: sat_Since_rec[where i=ne] sat.simps(3) zero_enat_def[symmetric] enat_0_iff not_le
               elim!: qtable_cong[OF _ refl] dest!: le_\<tau>_less meta_mp)
       qed
     next
       case False
       with auxlist' Cons have "(t, X) \<in> set auxlist0"
         unfolding auxlist'_eq by (auto split: if_splits)
       then have "ne \<noteq> 0" "t \<le> \<tau> \<sigma> (ne - 1)" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t"
         "qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne - 1) (Sincep pos \<phi> (point (\<tau> \<sigma> (ne - 1) - t)) \<psi>) \<and>
            (if pos then Formula.sat \<sigma> V (map the v) ne \<phi> else \<not> Formula.sat \<sigma> V (map the v) ne \<phi>)) X"
         using in_auxlist0_1 by blast+
       with False auxlist' Cons show ?thesis
         unfolding auxlist'_eq using qtable2
         by (fastforce simp: sat_Since_rec[where i=ne] sat.simps(6)
             diff_diff_right[where i="\<tau> \<sigma> ne" and j="\<tau> \<sigma> _ + \<tau> \<sigma> ne" and k="\<tau> \<sigma> (ne - 1)",
               OF trans_le_add2, simplified] elim!: qtable_cong[OF _ refl] order_trans dest: le_\<tau>_less)
     qed
   qed
 
   have in_auxlist'_2: "\<exists>X. (t, X) \<in> set auxlist'" if "t \<le> \<tau> \<sigma> ne" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t" for t
   proof (cases "t = \<tau> \<sigma> ne")
     case True
     then show ?thesis
     proof (cases auxlist0)
       case Nil
       with True show ?thesis unfolding auxlist'_eq by (simp add: zero_enat_def[symmetric])
     next
       case (Cons a as)
       with True show ?thesis unfolding auxlist'_eq
         by (cases "fst a = \<tau> \<sigma> ne") (auto simp: zero_enat_def[symmetric])
     qed
   next
     case False
     with that have "ne \<noteq> 0"
       using le_\<tau>_less neq0_conv by blast
     moreover from False that have  "t \<le> \<tau> \<sigma> (ne-1)"
       by (metis One_nat_def Suc_leI Suc_pred \<tau>_mono diff_is_0_eq' order.antisym neq0_conv not_le)
     ultimately obtain X where "(t, X) \<in> set auxlist0" using \<open>\<tau> \<sigma> ne - t \<le> right I\<close> \<open>\<exists>i. \<tau> \<sigma> i = t\<close>
       using \<tau>_mono[of "ne - 1" "ne" \<sigma>] by (atomize_elim, cases "right I") (auto intro!: in_auxlist0_2 simp del: \<tau>_mono)
     then show ?thesis unfolding auxlist'_eq using False \<open>\<tau> \<sigma> ne - t \<le> right I\<close>
       by (auto intro: exI[of _ X] split: list.split)
   qed
 
   show "wf_since_aux \<sigma> V R args \<phi> \<psi> aux' (Suc ne)"
     unfolding wf_since_aux_def args_ivl args_n args_pos
     by (auto simp add: fv_sub dest: in_auxlist'_1 intro: sorted_auxlist' in_auxlist'_2
         intro!: exI[of _ auxlist'] valid')
 
   have "rel = result_msaux args aux'"
     using result_eq by (auto simp add: update_since_def Let_def)
   with valid' have rel_eq: "rel = foldr (\<union>) [rel. (t, rel) \<leftarrow> auxlist', left I \<le> \<tau> \<sigma> ne - t] {}"
     by (auto simp add: args_ivl valid_result_msaux
         intro!: arg_cong[where f = "\<lambda>x. foldr (\<union>) (concat x) {}"] split: option.splits)
   have rel_alt: "rel = (\<Union>(t, rel) \<in> set auxlist'. if left I \<le> \<tau> \<sigma> ne - t then rel else empty_table)"
     unfolding rel_eq
     by (auto elim!: in_foldr_UnE bexI[rotated] intro!: in_foldr_UnI)
   show "qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Sincep pos \<phi> I \<psi>)) rel"
     unfolding rel_alt
   proof (rule qtable_Union[where Qi="\<lambda>(t, X) v.
     left I \<le> \<tau> \<sigma> ne - t \<and> Formula.sat \<sigma> V (map the v) ne (Sincep pos \<phi> (point (\<tau> \<sigma> ne - t)) \<psi>)"],
         goal_cases finite qtable equiv)
     case (equiv v)
     show ?case
     proof (rule iffI, erule sat_Since_point, goal_cases left right)
       case (left j)
       then show ?case using in_auxlist'_2[of "\<tau> \<sigma> j", OF _ _ exI, OF _ _ refl] by auto
     next
       case right
       then show ?case by (auto elim!: sat_Since_pointD dest: in_auxlist'_1)
     qed
   qed (auto dest!: in_auxlist'_1 intro!: qtable_empty)
 qed
 
 lemma fv_regex_from_mregex:
   "ok (length \<phi>s) mr \<Longrightarrow> fv_regex (from_mregex mr \<phi>s) \<subseteq> (\<Union>\<phi> \<in> set \<phi>s. fv \<phi>)"
   by (induct mr) (auto simp: Bex_def in_set_conv_nth)+
 
 lemma qtable_\<epsilon>_lax:
   assumes "ok (length \<phi>s) mr"
     and "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) rel) \<phi>s rels"
     and "fv_regex (from_mregex mr \<phi>s) \<subseteq> A" and "qtable n A (mem_restr R) Q guard"
   shows "qtable n A (mem_restr R)
    (\<lambda>v. Regex.eps (Formula.sat \<sigma> V (map the v)) i (from_mregex mr \<phi>s) \<and> Q v) (\<epsilon>_lax guard rels mr)"
   using assms
 proof (induct mr)
   case (MPlus mr1 mr2)
   from MPlus(3-6) show ?case
     by (auto intro!: qtable_union[OF MPlus(1,2)])
 next
   case (MTimes mr1 mr2)
   then have "fv_regex (from_mregex mr1 \<phi>s) \<subseteq> A" "fv_regex (from_mregex mr2 \<phi>s) \<subseteq> A"
     using fv_regex_from_mregex[of \<phi>s mr1] fv_regex_from_mregex[of \<phi>s mr2] by (auto simp: subset_eq)
   with MTimes(3-6) show ?case
     by (auto simp: eps_the_restrict restrict_idle intro!: qtable_join[OF MTimes(1,2)])
 qed (auto split: prod.splits if_splits simp: qtable_empty_iff list_all2_conv_all_nth
     in_set_conv_nth restrict_idle sat_the_restrict
     intro: in_qtableI qtableI elim!: qtable_join[where A=A and C=A])
 
 lemma nullary_qtable_cases: "qtable n {} P Q X \<Longrightarrow> (X = empty_table \<or> X = unit_table n)"
   by (simp add: qtable_def table_empty)
 
 lemma qtable_empty_unit_table:
   "qtable n {} R P empty_table \<Longrightarrow> qtable n {} R (\<lambda>v. \<not> P v) (unit_table n)"
   by (auto intro: qtable_unit_table simp add: qtable_empty_iff)
 
 lemma qtable_unit_empty_table:
   "qtable n {} R P (unit_table n) \<Longrightarrow> qtable n {} R (\<lambda>v. \<not> P v) empty_table"
   by (auto intro!: qtable_empty elim: in_qtableE simp add: wf_tuple_empty unit_table_def)
 
 lemma qtable_nonempty_empty_table:
   "qtable n {} R P X \<Longrightarrow> x \<in> X \<Longrightarrow> qtable n {} R (\<lambda>v. \<not> P v) empty_table"
   by (frule nullary_qtable_cases) (auto dest: qtable_unit_empty_table)
 
 
 lemma qtable_r\<epsilon>_strict:
   assumes "safe_regex Past Strict (from_mregex mr \<phi>s)" "ok (length \<phi>s) mr" "A = fv_regex (from_mregex mr \<phi>s)"
     and "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) rel) \<phi>s rels"
   shows "qtable n A (mem_restr R) (\<lambda>v. Regex.eps (Formula.sat \<sigma> V (map the v)) i (from_mregex mr \<phi>s)) (r\<epsilon>_strict n rels mr)"
   using assms
 proof (hypsubst, induct Past Strict "from_mregex mr \<phi>s" arbitrary: mr rule: safe_regex_induct)
   case (Skip n)
   then show ?case
     by (cases mr) (auto simp: qtable_empty_iff qtable_unit_table split: if_splits)
 next
   case (Test \<phi>)
   then show ?case
     by (cases mr) (auto simp: list_all2_conv_all_nth qtable_empty_unit_table
         dest!: qtable_nonempty_empty_table split: if_splits)
 next
   case (Plus r s)
   then show ?case
     by (cases mr) (fastforce intro: qtable_union split: if_splits)+
 next
   case (TimesP r s)
   then show ?case
     by (cases mr) (auto intro: qtable_cong[OF qtable_\<epsilon>_lax] split: if_splits)+
 next
   case (Star r)
   then show ?case
     by (cases mr) (auto simp: qtable_unit_table split: if_splits)
 qed
 
 lemma qtable_l\<epsilon>_strict:
   assumes "safe_regex Futu Strict (from_mregex mr \<phi>s)" "ok (length \<phi>s) mr" "A = fv_regex (from_mregex mr \<phi>s)"
     and "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) rel) \<phi>s rels"
   shows "qtable n A (mem_restr R) (\<lambda>v. Regex.eps (Formula.sat \<sigma> V (map the v)) i (from_mregex mr \<phi>s)) (l\<epsilon>_strict n rels mr)"
   using assms
 proof (hypsubst, induct Futu Strict "from_mregex mr \<phi>s" arbitrary: mr rule: safe_regex_induct)
   case (Skip n)
   then show ?case
     by (cases mr) (auto simp: qtable_empty_iff qtable_unit_table split: if_splits)
 next
   case (Test \<phi>)
   then show ?case
     by (cases mr) (auto simp: list_all2_conv_all_nth qtable_empty_unit_table
         dest!: qtable_nonempty_empty_table split: if_splits)
 next
   case (Plus r s)
   then show ?case
     by (cases mr) (fastforce intro: qtable_union split: if_splits)+
 next
   case (TimesF r s)
   then show ?case
     by (cases mr) (auto intro: qtable_cong[OF qtable_\<epsilon>_lax] split: if_splits)+
 next
   case (Star r)
   then show ?case
     by (cases mr) (auto simp: qtable_unit_table split: if_splits)
 qed
 
 lemma rtranclp_False: "(\<lambda>i j. False)\<^sup>*\<^sup>* = (=)"
 proof -
   have "(\<lambda>i j. False)\<^sup>*\<^sup>* i j \<Longrightarrow> i = j" for i j :: 'a
     by (induct i j rule: rtranclp.induct) auto
   then show ?thesis
     by (auto intro: exI[of _ 0])
 qed
 
 inductive ok_rctxt for \<phi>s where
   "ok_rctxt \<phi>s id id"
 | "ok_rctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> ok_rctxt \<phi>s (\<lambda>t. \<kappa> (MTimes mr t)) (\<lambda>t. \<kappa>' (Regex.Times (from_mregex mr \<phi>s) t))"
 
 lemma ok_rctxt_swap: "ok_rctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> from_mregex (\<kappa> mr) \<phi>s = \<kappa>' (from_mregex mr \<phi>s)"
   by (induct \<kappa> \<kappa>' arbitrary: mr rule: ok_rctxt.induct) auto
 
 lemma ok_rctxt_cong: "ok_rctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> Regex.match (Formula.sat \<sigma> V v) r = Regex.match (Formula.sat \<sigma> V v) s \<Longrightarrow>
   Regex.match (Formula.sat \<sigma> V v) (\<kappa>' r) i j = Regex.match (Formula.sat \<sigma> V v) (\<kappa>' s) i j"
   by (induct \<kappa> \<kappa>' arbitrary: r s rule: ok_rctxt.induct) simp_all
 
 lemma qtable_r\<delta>\<kappa>:
   assumes "ok (length \<phi>s) mr" "fv_regex (from_mregex mr \<phi>s) \<subseteq> A"
     and "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) j \<phi>) rel) \<phi>s rels"
     and "ok_rctxt \<phi>s \<kappa> \<kappa>'"
     and "\<forall>ms \<in> \<kappa> ` RPD mr. qtable n A (mem_restr R) (\<lambda>v. Q (map the v) (from_mregex ms \<phi>s)) (lookup rel ms)"
   shows "qtable n A (mem_restr R)
   (\<lambda>v. \<exists>s \<in> Regex.rpd\<kappa> \<kappa>' (Formula.sat \<sigma> V (map the v)) j (from_mregex mr \<phi>s). Q (map the v) s)
   (r\<delta> \<kappa> rel rels mr)"
   using assms
 proof (induct mr arbitrary: \<kappa> \<kappa>')
   case MSkip
   then show ?case
     by (auto simp: rtranclp_False ok_rctxt_swap qtable_empty_iff
         elim!: qtable_cong[OF _ _ ok_rctxt_cong[of _ \<kappa> \<kappa>']] split: nat.splits)
 next
   case (MPlus mr1 mr2)
   from MPlus(3-7) show ?case
     by (auto intro!: qtable_union[OF MPlus(1,2)])
 next
   case (MTimes mr1 mr2)
   from MTimes(3-7) show ?case
     by (auto intro!: qtable_union[OF MTimes(2) qtable_\<epsilon>_lax[OF _ _ _ MTimes(1)]]
         elim!: ok_rctxt.intros(2) simp: MTimesL_def Ball_def)
 next
   case (MStar mr)
   from MStar(2-6) show ?case
     by (auto intro!: qtable_cong[OF MStar(1)] intro: ok_rctxt.intros simp: MTimesL_def Ball_def)
 qed (auto simp: qtable_empty_iff)
 
 lemmas qtable_r\<delta> = qtable_r\<delta>\<kappa>[OF _ _ _ ok_rctxt.intros(1), unfolded rpd\<kappa>_rpd image_id id_apply]
 
 inductive ok_lctxt for \<phi>s where
   "ok_lctxt \<phi>s id id"
 | "ok_lctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> ok_lctxt \<phi>s (\<lambda>t. \<kappa> (MTimes t mr)) (\<lambda>t. \<kappa>' (Regex.Times t (from_mregex mr \<phi>s)))"
 
 lemma ok_lctxt_swap: "ok_lctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> from_mregex (\<kappa> mr) \<phi>s = \<kappa>' (from_mregex mr \<phi>s)"
   by (induct \<kappa> \<kappa>' arbitrary: mr rule: ok_lctxt.induct) auto
 
 lemma ok_lctxt_cong: "ok_lctxt \<phi>s \<kappa> \<kappa>' \<Longrightarrow> Regex.match (Formula.sat \<sigma> V v) r = Regex.match (Formula.sat \<sigma> V v) s \<Longrightarrow>
   Regex.match (Formula.sat \<sigma> V v) (\<kappa>' r) i j = Regex.match (Formula.sat \<sigma> V v) (\<kappa>' s) i j"
   by (induct \<kappa> \<kappa>' arbitrary: r s rule: ok_lctxt.induct) simp_all
 
 lemma qtable_l\<delta>\<kappa>:
   assumes "ok (length \<phi>s) mr" "fv_regex (from_mregex mr \<phi>s) \<subseteq> A"
     and "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) j \<phi>) rel) \<phi>s rels"
     and "ok_lctxt \<phi>s \<kappa> \<kappa>'"
     and "\<forall>ms \<in> \<kappa> ` LPD mr. qtable n A (mem_restr R) (\<lambda>v. Q (map the v) (from_mregex ms \<phi>s)) (lookup rel ms)"
   shows "qtable n A (mem_restr R)
   (\<lambda>v. \<exists>s \<in> Regex.lpd\<kappa> \<kappa>' (Formula.sat \<sigma> V (map the v)) j (from_mregex mr \<phi>s). Q (map the v) s)
   (l\<delta> \<kappa> rel rels mr)"
   using assms
 proof (induct mr arbitrary: \<kappa> \<kappa>')
   case MSkip
   then show ?case
     by (auto simp: rtranclp_False ok_lctxt_swap qtable_empty_iff
         elim!: qtable_cong[OF _ _ ok_rctxt_cong[of _ \<kappa> \<kappa>']] split: nat.splits)
 next
   case (MPlus mr1 mr2)
   from MPlus(3-7) show ?case
     by (auto intro!: qtable_union[OF MPlus(1,2)])
 next
   case (MTimes mr1 mr2)
   from MTimes(3-7) show ?case
     by (auto intro!: qtable_union[OF MTimes(1) qtable_\<epsilon>_lax[OF _ _ _ MTimes(2)]]
         elim!: ok_lctxt.intros(2) simp: MTimesR_def Ball_def)
 next
   case (MStar mr)
   from MStar(2-6) show ?case
     by (auto intro!: qtable_cong[OF MStar(1)] intro: ok_lctxt.intros simp: MTimesR_def Ball_def)
 qed (auto simp: qtable_empty_iff)
 
 lemmas qtable_l\<delta> = qtable_l\<delta>\<kappa>[OF _ _ _ ok_lctxt.intros(1), unfolded lpd\<kappa>_lpd image_id id_apply]
 
 lemma RPD_fv_regex_le:
   "ms \<in> RPD mr \<Longrightarrow> fv_regex (from_mregex ms \<phi>s) \<subseteq> fv_regex (from_mregex mr \<phi>s)"
   by (induct mr arbitrary: ms) (auto simp: MTimesL_def split: nat.splits)+
 
 lemma RPD_safe: "safe_regex Past g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPD mr \<Longrightarrow> safe_regex Past g (from_mregex ms \<phi>s)"
 proof (induct Past g "from_mregex mr \<phi>s" arbitrary: mr ms rule: safe_regex_induct)
   case Skip
   then show ?case
     by (cases mr) (auto split: nat.splits)
 next
   case (Test g \<phi>)
   then show ?case
     by (cases mr) auto
 next
   case (Plus g r s mrs)
   then show ?case
   proof (cases mrs)
     case (MPlus mr ms)
     with Plus(3-5) show ?thesis
       by (auto dest!: Plus(1,2))
   qed auto
 next
   case (TimesP g r s mrs)
   then show ?case
   proof (cases mrs)
     case (MTimes mr ms)
     with TimesP(3-5) show ?thesis
       by (cases g) (auto 0 4 simp: MTimesL_def dest: RPD_fv_regex_le TimesP(1,2))
   qed auto
 next
   case (Star g r)
   then show ?case
   proof (cases mr)
     case (MStar x6)
     with Star(2-4) show ?thesis
       by (cases g) (auto 0 4 simp: MTimesL_def dest: RPD_fv_regex_le
           elim!: safe_cosafe[rotated] dest!: Star(1))
   qed auto
 qed
 
 lemma RPDi_safe: "safe_regex Past g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPDi n mr ==> safe_regex Past g (from_mregex ms \<phi>s)"
   by (induct n arbitrary: ms mr) (auto dest: RPD_safe)
 
 lemma RPDs_safe: "safe_regex Past g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPDs mr ==> safe_regex Past g (from_mregex ms \<phi>s)"
   unfolding RPDs_def by (auto dest: RPDi_safe)
 
 lemma RPD_safe_fv_regex: "safe_regex Past Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPD mr \<Longrightarrow> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
 proof (induct Past Strict "from_mregex mr \<phi>s" arbitrary: mr rule: safe_regex_induct)
   case (Skip n)
   then show ?case
     by (cases mr) (auto split: nat.splits)
 next
   case (Test \<phi>)
   then show ?case
     by (cases mr) auto
 next
   case (Plus r s)
   then show ?case
     by (cases mr) auto
 next
   case (TimesP r s)
   then show ?case
     by (cases mr) (auto 0 3 simp: MTimesL_def dest: RPD_fv_regex_le split: modality.splits)
 next
   case (Star r)
   then show ?case
     by (cases mr) (auto 0 3 simp: MTimesL_def dest: RPD_fv_regex_le)
 qed
 
 lemma RPDi_safe_fv_regex: "safe_regex Past Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPDi n mr ==> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
   by (induct n arbitrary: ms mr) (auto 5 0 dest: RPD_safe_fv_regex RPD_safe)
 
 lemma RPDs_safe_fv_regex: "safe_regex Past Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> RPDs mr ==> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
   unfolding RPDs_def by (auto dest: RPDi_safe_fv_regex)
 
 lemma RPD_ok: "ok m mr \<Longrightarrow> ms \<in> RPD mr \<Longrightarrow> ok m ms"
 proof (induct mr arbitrary: ms)
   case (MPlus mr1 mr2)
   from MPlus(3,4) show ?case
     by (auto elim: MPlus(1,2))
 next
   case (MTimes mr1 mr2)
   from MTimes(3,4) show ?case
     by (auto elim: MTimes(1,2) simp: MTimesL_def)
 next
   case (MStar mr)
   from MStar(2,3) show ?case
     by (auto elim: MStar(1) simp: MTimesL_def)
 qed (auto split: nat.splits)
 
 lemma RPDi_ok: "ok m mr \<Longrightarrow> ms \<in> RPDi n mr \<Longrightarrow> ok m ms"
   by (induct n arbitrary: ms mr) (auto intro: RPD_ok)
 
 lemma RPDs_ok: "ok m mr \<Longrightarrow> ms \<in> RPDs mr \<Longrightarrow> ok m ms"
   unfolding RPDs_def by (auto intro: RPDi_ok)
 
 lemma LPD_fv_regex_le:
   "ms \<in> LPD mr \<Longrightarrow> fv_regex (from_mregex ms \<phi>s) \<subseteq> fv_regex (from_mregex mr \<phi>s)"
   by (induct mr arbitrary: ms) (auto simp: MTimesR_def split: nat.splits)+
 
 lemma LPD_safe: "safe_regex Futu g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPD mr ==> safe_regex Futu g (from_mregex ms \<phi>s)"
 proof (induct Futu g "from_mregex mr \<phi>s" arbitrary: mr ms rule: safe_regex_induct)
   case Skip
   then show ?case
     by (cases mr) (auto split: nat.splits)
 next
   case (Test g \<phi>)
   then show ?case
     by (cases mr) auto
 next
   case (Plus g r s mrs)
   then show ?case
   proof (cases mrs)
     case (MPlus mr ms)
     with Plus(3-5) show ?thesis
       by (auto dest!: Plus(1,2))
   qed auto
 next
   case (TimesF g r s mrs)
   then show ?case
   proof (cases mrs)
     case (MTimes mr ms)
     with TimesF(3-5) show ?thesis
       by (cases g) (auto 0 4 simp: MTimesR_def dest: LPD_fv_regex_le split: modality.splits dest: TimesF(1,2))
   qed auto
 next
   case (Star g r)
   then show ?case
   proof (cases mr)
     case (MStar x6)
     with Star(2-4) show ?thesis
       by (cases g) (auto 0 4 simp: MTimesR_def dest: LPD_fv_regex_le
           elim!: safe_cosafe[rotated] dest!: Star(1))
   qed auto
 qed
 
 lemma LPDi_safe: "safe_regex Futu g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPDi n mr ==> safe_regex Futu g (from_mregex ms \<phi>s)"
   by (induct n arbitrary: ms mr) (auto dest: LPD_safe)
 
 lemma LPDs_safe: "safe_regex Futu g (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPDs mr ==> safe_regex Futu g (from_mregex ms \<phi>s)"
   unfolding LPDs_def by (auto dest: LPDi_safe)
 
 lemma LPD_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPD mr ==> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
 proof (induct Futu Strict "from_mregex mr \<phi>s" arbitrary: mr rule: safe_regex_induct)
   case Skip
   then show ?case
     by (cases mr) (auto split: nat.splits)
 next
   case (Test \<phi>)
   then show ?case
     by (cases mr) auto
 next
   case (Plus r s)
   then show ?case
     by (cases mr) auto
 next
   case (TimesF r s)
   then show ?case
     by (cases mr) (auto 0 3 simp: MTimesR_def dest: LPD_fv_regex_le split: modality.splits)
 next
   case (Star r)
   then show ?case
     by (cases mr) (auto 0 3 simp: MTimesR_def dest: LPD_fv_regex_le)
 qed
 
 lemma LPDi_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPDi n mr ==> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
   by (induct n arbitrary: ms mr) (auto 5 0 dest: LPD_safe_fv_regex LPD_safe)
 
 lemma LPDs_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr \<phi>s) \<Longrightarrow>
   ms \<in> LPDs mr ==> fv_regex (from_mregex ms \<phi>s) = fv_regex (from_mregex mr \<phi>s)"
   unfolding LPDs_def by (auto dest: LPDi_safe_fv_regex)
 
 lemma LPD_ok: "ok m mr \<Longrightarrow> ms \<in> LPD mr \<Longrightarrow> ok m ms"
 proof (induct mr arbitrary: ms)
   case (MPlus mr1 mr2)
   from MPlus(3,4) show ?case
     by (auto elim: MPlus(1,2))
 next
   case (MTimes mr1 mr2)
   from MTimes(3,4) show ?case
     by (auto elim: MTimes(1,2) simp: MTimesR_def)
 next
   case (MStar mr)
   from MStar(2,3) show ?case
     by (auto elim: MStar(1) simp: MTimesR_def)
 qed (auto split: nat.splits)
 
 lemma LPDi_ok: "ok m mr \<Longrightarrow> ms \<in> LPDi n mr \<Longrightarrow> ok m ms"
   by (induct n arbitrary: ms mr) (auto intro: LPD_ok)
 
 lemma LPDs_ok: "ok m mr \<Longrightarrow> ms \<in> LPDs mr \<Longrightarrow> ok m ms"
   unfolding LPDs_def by (auto intro: LPDi_ok)
 
 lemma update_matchP:
   assumes pre: "wf_matchP_aux \<sigma> V n R I r aux ne"
     and safe: "safe_regex Past Strict r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and mrs: "mrs = sorted_list_of_set (RPDs mr)"
     and qtables: "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne \<phi>) rel) \<phi>s rels"
     and result_eq: "(rel, aux') = update_matchP n I mr mrs rels (\<tau> \<sigma> ne) aux"
   shows "wf_matchP_aux \<sigma> V n R I r aux' (Suc ne)"
     and "qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Formula.MatchP I r)) rel"
 proof -
   let ?wf_tuple = "\<lambda>v. wf_tuple n (Formula.fv_regex r) v"
   let ?update = "\<lambda>rel t. mrtabulate mrs (\<lambda>mr.
     r\<delta> id rel rels mr \<union> (if t = \<tau> \<sigma> ne then r\<epsilon>_strict n rels mr else {}))"
   note sat.simps[simp del]
 
   define aux0 where "aux0 = [(t, ?update rel t). (t, rel) \<leftarrow> aux, enat (\<tau> \<sigma> ne - t) \<le> right I]"
   have sorted_aux0: "sorted_wrt (\<lambda>x y. fst x > fst y) aux0"
     using pre[unfolded wf_matchP_aux_def, THEN conjunct1]
     unfolding aux0_def
     by (induction aux) (auto simp add: sorted_wrt_append)
   { fix ms
     assume "ms \<in> RPDs mr"
     then have "fv_regex (from_mregex ms \<phi>s) = fv_regex r"
       "safe_regex Past Strict (from_mregex ms \<phi>s)" "ok (length \<phi>s) ms" "RPD ms \<subseteq> RPDs mr"
       using safe RPDs_safe RPDs_safe_fv_regex mr from_mregex_to_mregex RPDs_ok to_mregex_ok RPDs_trans
       by fastforce+
   } note * = this
   have **: "\<tau> \<sigma> ne - (\<tau> \<sigma> i + \<tau> \<sigma> ne - \<tau> \<sigma> (ne - Suc 0)) = \<tau> \<sigma> (ne - Suc 0) - \<tau> \<sigma> i" for i
     by (metis (no_types, lifting) Nat.diff_diff_right \<tau>_mono add.commute add_diff_cancel_left diff_le_self le_add2 order_trans)
   have ***: "\<tau> \<sigma> i = \<tau> \<sigma> ne"
     if  "\<tau> \<sigma> ne \<le> \<tau> \<sigma> i" "\<tau> \<sigma> i \<le> \<tau> \<sigma> (ne - Suc 0)" "ne > 0" for i
     by (metis (no_types, lifting) Suc_pred \<tau>_mono diff_le_self le_\<tau>_less le_antisym not_less_eq that)
   then have in_aux0_1: "(t, X) \<in> set aux0 \<Longrightarrow> ne \<noteq> 0 \<and> t \<le> \<tau> \<sigma> ne \<and> \<tau> \<sigma> ne - t \<le> right I \<and>
       (\<exists>i. \<tau> \<sigma> i = t) \<and>
       (\<forall>ms\<in>RPDs mr. qtable n (fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne
          (Formula.MatchP (point (\<tau> \<sigma> ne - t)) (from_mregex ms \<phi>s))) (lookup X ms))" for t X
     unfolding aux0_def using safe mr mrs
     by (auto simp: lookup_tabulate map_of_map_restrict restrict_map_def finite_RPDs * ** RPDs_trans diff_le_mono2
         intro!: sat_MatchP_rec[of \<sigma> _ _ ne, THEN iffD2]
         qtable_union[OF qtable_r\<delta>[OF _ _ qtables] qtable_r\<epsilon>_strict[OF _ _ _ qtables],
           of ms "fv_regex r" "\<lambda>v r. Formula.sat \<sigma> V v (ne - Suc 0) (Formula.MatchP (point 0) r)" _ ms for ms]
         qtable_cong[OF qtable_r\<delta>[OF _ _ qtables],
           of ms "fv_regex r" "\<lambda>v r. Formula.sat \<sigma> V v (ne - Suc 0) (Formula.MatchP (point (\<tau> \<sigma> (ne - Suc 0) - \<tau> \<sigma> i)) r)"
           _ _  "(\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Formula.MatchP (point (\<tau> \<sigma> ne - \<tau> \<sigma> i))  (from_mregex ms \<phi>s)))" for ms i]
         dest!: assms(1)[unfolded wf_matchP_aux_def, THEN conjunct2, THEN conjunct1, rule_format]
         sat_MatchP_rec["of" \<sigma> _ _ ne, THEN iffD1]
         elim!: bspec order.trans[OF _ \<tau>_mono] bexI[rotated] split: option.splits if_splits) (* slow 7 sec *)
   then have in_aux0_le_\<tau>: "(t, X) \<in> set aux0 \<Longrightarrow> t \<le> \<tau> \<sigma> ne" for t X
     by (meson \<tau>_mono diff_le_self le_trans)
   have in_aux0_2: "ne \<noteq> 0 \<Longrightarrow> t \<le> \<tau> \<sigma> (ne-1) \<Longrightarrow> \<tau> \<sigma> ne - t \<le> right I \<Longrightarrow> \<exists>i. \<tau> \<sigma> i = t \<Longrightarrow>
     \<exists>X. (t, X) \<in> set aux0" for t
   proof -
     fix t
     assume "ne \<noteq> 0" "t \<le> \<tau> \<sigma> (ne-1)" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t"
     then obtain X where "(t, X) \<in> set aux"
       by (atomize_elim, intro assms(1)[unfolded wf_matchP_aux_def, THEN conjunct2, THEN conjunct2, rule_format])
         (auto simp: gr0_conv_Suc elim!: order_trans[rotated] intro!: diff_le_mono \<tau>_mono)
     with \<open>\<tau> \<sigma> ne - t \<le> right I\<close> have "(t, ?update X t) \<in> set aux0"
       unfolding aux0_def by (auto simp: id_def elim!: bexI[rotated] intro!: exI[of _ X])
     then show "\<exists>X. (t, X) \<in> set aux0"
       by blast
   qed
   have aux0_Nil: "aux0 = [] \<Longrightarrow> ne = 0 \<or> ne \<noteq> 0 \<and> (\<forall>t. t \<le> \<tau> \<sigma> (ne-1) \<and> \<tau> \<sigma> ne - t \<le> right I \<longrightarrow>
         (\<nexists>i. \<tau> \<sigma> i = t))"
     using in_aux0_2 by (cases "ne = 0") (auto)
 
   have aux'_eq: "aux' = (case aux0 of
       [] \<Rightarrow> [(\<tau> \<sigma> ne, mrtabulate mrs (r\<epsilon>_strict n rels))]
     | x # aux' \<Rightarrow> (if fst x = \<tau> \<sigma> ne then x # aux'
        else (\<tau> \<sigma> ne, mrtabulate mrs (r\<epsilon>_strict n rels)) # x # aux'))"
     using result_eq unfolding aux0_def update_matchP_def Let_def by simp
   have sorted_aux': "sorted_wrt (\<lambda>x y. fst x > fst y) aux'"
     unfolding aux'_eq
     using sorted_aux0 in_aux0_le_\<tau> by (cases aux0) (fastforce)+
 
   have in_aux'_1: "t \<le> \<tau> \<sigma> ne \<and> \<tau> \<sigma> ne - t \<le> right I \<and> (\<exists>i. \<tau> \<sigma> i = t) \<and>
      (\<forall>ms\<in>RPDs mr. qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v.
         Formula.sat \<sigma> V (map the v) ne (Formula.MatchP (point (\<tau> \<sigma> ne - t)) (from_mregex ms \<phi>s))) (lookup X ms))"
     if aux': "(t, X) \<in> set aux'" for t X
   proof (cases aux0)
     case Nil
     with aux' show ?thesis
       unfolding aux'_eq using safe mrs qtables aux0_Nil *
       by (auto simp: zero_enat_def[symmetric] sat_MatchP_rec[where i=ne]
           lookup_tabulate finite_RPDs split: option.splits
           intro!: qtable_cong[OF qtable_r\<epsilon>_strict]
           dest: spec[of _ "\<tau> \<sigma> (ne-1)"])
   next
     case (Cons a as)
     show ?thesis
     proof (cases "t = \<tau> \<sigma> ne")
       case t: True
       show ?thesis
       proof (cases "fst a = \<tau> \<sigma> ne")
         case True
         with aux' Cons t have "X = snd a"
           unfolding aux'_eq using sorted_aux0 by auto
         moreover from in_aux0_1[of "fst a" "snd a"] Cons have "ne \<noteq> 0"
           "fst a \<le> \<tau> \<sigma> ne" "\<tau> \<sigma> ne - fst a \<le> right I" "\<exists>i. \<tau> \<sigma> i = fst a"
           "\<forall>ms \<in> RPDs mr. qtable n (fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne
             (Formula.MatchP (point (\<tau> \<sigma> ne - fst a)) (from_mregex ms \<phi>s))) (lookup (snd a) ms)"
           by auto
         ultimately show ?thesis using t True
           by auto
       next
         case False
         with aux' Cons t have "X = mrtabulate mrs (r\<epsilon>_strict n rels)"
           unfolding aux'_eq using sorted_aux0 in_aux0_le_\<tau>[of "fst a" "snd a"] by auto
         with aux' Cons t False show ?thesis
           unfolding aux'_eq using safe mrs qtables * in_aux0_2[of "\<tau> \<sigma> (ne-1)"] in_aux0_le_\<tau>[of "fst a" "snd a"] sorted_aux0
           by (auto simp: sat_MatchP_rec[where i=ne] zero_enat_def[symmetric] enat_0_iff not_le
               lookup_tabulate finite_RPDs split: option.splits
               intro!: qtable_cong[OF qtable_r\<epsilon>_strict] dest!: le_\<tau>_less meta_mp)
       qed
     next
       case False
       with aux' Cons have "(t, X) \<in> set aux0"
         unfolding aux'_eq by (auto split: if_splits)
       then have "ne \<noteq> 0" "t \<le> \<tau> \<sigma> ne" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t"
         "\<forall>ms \<in> RPDs mr. qtable n (fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne
           (Formula.MatchP (point (\<tau> \<sigma> ne - t)) (from_mregex ms \<phi>s))) (lookup X ms)"
         using in_aux0_1 by blast+
       with False aux' Cons show ?thesis
         unfolding aux'_eq by auto
     qed
   qed
 
   have in_aux'_2: "\<exists>X. (t, X) \<in> set aux'" if "t \<le> \<tau> \<sigma> ne" "\<tau> \<sigma> ne - t \<le> right I" "\<exists>i. \<tau> \<sigma> i = t" for t
   proof (cases "t = \<tau> \<sigma> ne")
     case True
     then show ?thesis
     proof (cases aux0)
       case Nil
       with True show ?thesis unfolding aux'_eq by simp
     next
       case (Cons a as)
       with True show ?thesis unfolding aux'_eq using eq_fst_iff[of t a]
         by (cases "fst a = \<tau> \<sigma> ne") auto
     qed
   next
     case False
     with that have "ne \<noteq> 0"
       using le_\<tau>_less neq0_conv by blast
     moreover from False that have  "t \<le> \<tau> \<sigma> (ne-1)"
       by (metis One_nat_def Suc_leI Suc_pred \<tau>_mono diff_is_0_eq' order.antisym neq0_conv not_le)
     ultimately obtain X where "(t, X) \<in> set aux0" using \<open>\<tau> \<sigma> ne - t \<le> right I\<close> \<open>\<exists>i. \<tau> \<sigma> i = t\<close>
       by atomize_elim (auto intro!: in_aux0_2)
     then show ?thesis unfolding aux'_eq using False
       by (auto intro: exI[of _ X] split: list.split)
   qed
 
   show "wf_matchP_aux \<sigma> V n R I r aux' (Suc ne)"
     unfolding wf_matchP_aux_def using mr
     by (auto dest: in_aux'_1 intro: sorted_aux' in_aux'_2)
 
   have rel_eq: "rel = foldr (\<union>) [lookup rel mr. (t, rel) \<leftarrow> aux', left I \<le> \<tau> \<sigma> ne - t] {}"
     unfolding aux'_eq aux0_def
     using result_eq by (simp add: update_matchP_def Let_def)
   have rel_alt: "rel = (\<Union>(t, rel) \<in> set aux'. if left I \<le> \<tau> \<sigma> ne - t then lookup rel mr else empty_table)"
     unfolding rel_eq
     by (auto elim!: in_foldr_UnE bexI[rotated] intro!: in_foldr_UnI)
   show "qtable n (fv_regex r) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) ne (Formula.MatchP I r)) rel"
     unfolding rel_alt
   proof (rule qtable_Union[where Qi="\<lambda>(t, X) v.
     left I \<le> \<tau> \<sigma> ne - t \<and> Formula.sat \<sigma> V (map the v) ne (Formula.MatchP (point (\<tau> \<sigma> ne - t)) r)"],
         goal_cases finite qtable equiv)
     case (equiv v)
     show ?case
     proof (rule iffI, erule sat_MatchP_point, goal_cases left right)
       case (left j)
       then show ?case using in_aux'_2[of "\<tau> \<sigma> j", OF _ _ exI, OF _ _ refl] by auto
     next
       case right
       then show ?case by (auto elim!: sat_MatchP_pointD dest: in_aux'_1)
     qed
   qed (auto dest!: in_aux'_1 intro!: qtable_empty dest!: bspec[OF _ RPDs_refl]
       simp: from_mregex_eq[OF safe mr])
 qed
 
 lemma length_update_until: "length (update_until args rel1 rel2 nt aux) = Suc (length aux)"
   unfolding update_until_def by simp
 
 lemma wf_update_until_auxlist:
   assumes pre: "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> auxlist ne"
     and qtable1: "qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne + length auxlist) \<phi>) rel1"
     and qtable2: "qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne + length auxlist) \<psi>) rel2"
     and fvi_subset: "Formula.fv \<phi> \<subseteq> Formula.fv \<psi>"
     and args_ivl: "args_ivl args = I"
     and args_n: "args_n args = n"
     and args_pos: "args_pos args = pos"
   shows "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> (update_until args rel1 rel2 (\<tau> \<sigma> (ne + length auxlist)) auxlist) ne"
   unfolding wf_until_auxlist_def length_update_until
   unfolding update_until_def list.rel_map add_Suc_right upt.simps eqTrueI[OF le_add1] if_True
 proof (rule list_all2_appendI, unfold list.rel_map, goal_cases old new)
   case old
   show ?case
   proof (rule list.rel_mono_strong[OF assms(1)[unfolded wf_until_auxlist_def]]; safe, goal_cases mono1 mono2)
     case (mono1 i X Y v)
     then show ?case
       by (fastforce simp: args_ivl args_n args_pos sat_the_restrict less_Suc_eq
           elim!: qtable_join[OF _ qtable1] qtable_union[OF _ qtable1])
   next
     case (mono2 i X Y v)
     then show ?case using fvi_subset
       by (auto 0 3 simp: args_ivl args_n args_pos sat_the_restrict less_Suc_eq split: if_splits
           elim!: qtable_union[OF _ qtable_join_fixed[OF qtable2]]
           elim: qtable_cong[OF _ refl] intro: exI[of _ "ne + length auxlist"]) (* slow 8 sec*)
   qed
 next
   case new
   then show ?case
     by (auto intro!: qtable_empty qtable1 qtable2[THEN qtable_cong] exI[of _ "ne + length auxlist"]
         simp: args_ivl args_n args_pos less_Suc_eq zero_enat_def[symmetric])
 qed
 
 lemma (in muaux) wf_update_until:
   assumes pre: "wf_until_aux \<sigma> V R args \<phi> \<psi> aux ne"
     and qtable1: "qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne + length_muaux args aux) \<phi>) rel1"
     and qtable2: "qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne + length_muaux args aux) \<psi>) rel2"
     and fvi_subset: "Formula.fv \<phi> \<subseteq> Formula.fv \<psi>"
     and args_ivl: "args_ivl args = I"
     and args_n: "args_n args = n"
     and args_L: "args_L args = Formula.fv \<phi>"
     and args_R: "args_R args = Formula.fv \<psi>"
     and args_pos: "args_pos args = pos"
   shows "wf_until_aux \<sigma> V R args \<phi> \<psi> (add_new_muaux args rel1 rel2 (\<tau> \<sigma> (ne + length_muaux args aux)) aux) ne \<and>
       length_muaux args (add_new_muaux args rel1 rel2 (\<tau> \<sigma> (ne + length_muaux args aux)) aux) = Suc (length_muaux args aux)"
 proof -
   from pre obtain cur auxlist where valid_aux: "valid_muaux args cur aux auxlist" and
     cur: "cur = (if ne + length auxlist = 0 then 0 else \<tau> \<sigma> (ne + length auxlist - 1))" and
     pre_list: "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> auxlist ne"
     unfolding wf_until_aux_def args_ivl args_n args_pos by auto
   have length_aux: "length_muaux args aux = length auxlist"
     using valid_length_muaux[OF valid_aux] .
   define nt where "nt \<equiv> \<tau> \<sigma> (ne + length_muaux args aux)"
   have nt_mono: "cur \<le> nt"
     unfolding cur nt_def length_aux by simp
   define auxlist' where "auxlist' \<equiv> update_until args rel1 rel2 (\<tau> \<sigma> (ne + length auxlist)) auxlist"
   have length_auxlist': "length auxlist' = Suc (length auxlist)"
     unfolding auxlist'_def by (auto simp add: length_update_until)
   have tab1: "table (args_n args) (args_L args) rel1"
     using qtable1 unfolding args_n[symmetric] args_L[symmetric] by (auto simp add: qtable_def)
   have tab2: "table (args_n args) (args_R args) rel2"
     using qtable2 unfolding args_n[symmetric] args_R[symmetric] by (auto simp add: qtable_def)
   have fv_sub: "fv \<phi> \<subseteq> fv \<psi>"
     using pre unfolding wf_until_aux_def by auto
   moreover have valid_add_new_auxlist: "valid_muaux args nt (add_new_muaux args rel1 rel2 nt aux) auxlist'"
     using valid_add_new_muaux[OF valid_aux tab1 tab2 nt_mono]
     unfolding auxlist'_def nt_def length_aux .
   moreover have "length_muaux args (add_new_muaux args rel1 rel2 nt aux) = Suc (length_muaux args aux)"
     using valid_length_muaux[OF valid_add_new_auxlist] unfolding length_auxlist' length_aux[symmetric] .
   moreover have "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> auxlist' ne"
     using wf_update_until_auxlist[OF pre_list qtable1[unfolded length_aux] qtable2[unfolded length_aux] fv_sub args_ivl args_n args_pos]
     unfolding auxlist'_def .
   moreover have "\<tau> \<sigma> (ne + length auxlist) = (if ne + length auxlist' = 0 then 0 else \<tau> \<sigma> (ne + length auxlist' - 1))"
     unfolding cur length_auxlist' by auto
   ultimately show ?thesis
     unfolding wf_until_aux_def nt_def length_aux args_ivl args_n args_pos by fast
 qed
 
 lemma length_update_matchF_base:
   "length (fst (update_matchF_base I mr mrs nt entry st)) = Suc 0"
   by (auto simp: Let_def update_matchF_base_def)
 
 lemma length_update_matchF_step:
   "length (fst (update_matchF_step I mr mrs nt entry st)) = Suc (length (fst st))"
   by (auto simp: Let_def update_matchF_step_def split: prod.splits)
 
 lemma length_foldr_update_matchF_step:
   "length (fst (foldr (update_matchF_step I mr mrs nt) aux base)) = length aux + length (fst base)"
   by (induct aux arbitrary: base) (auto simp: Let_def length_update_matchF_step)
 
 lemma length_update_matchF: "length (update_matchF n I mr mrs rels nt aux) = Suc (length aux)"
   unfolding update_matchF_def update_matchF_base_def length_foldr_update_matchF_step
   by (auto simp: Let_def)
 
 lemma wf_update_matchF_base_invar:
   assumes safe: "safe_regex Futu Strict r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and mrs: "mrs = sorted_list_of_set (LPDs mr)"
     and qtables: "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) j \<phi>) rel) \<phi>s rels"
   shows "wf_matchF_invar \<sigma> V n R I r (update_matchF_base n I mr mrs rels (\<tau> \<sigma> j)) j"
 proof -
   have from_mregex: "from_mregex mr \<phi>s = r"
     using safe mr using from_mregex_eq by blast
   { fix ms
     assume "ms \<in> LPDs mr"
     then have "fv_regex (from_mregex ms \<phi>s) = fv_regex r"
       "safe_regex Futu Strict (from_mregex ms \<phi>s)" "ok (length \<phi>s) ms" "LPD ms \<subseteq> LPDs mr"
       using safe LPDs_safe LPDs_safe_fv_regex mr from_mregex_to_mregex LPDs_ok to_mregex_ok LPDs_trans
       by fastforce+
   } note * = this
   show ?thesis
     unfolding wf_matchF_invar_def wf_matchF_aux_def update_matchF_base_def mr prod.case Let_def mrs
     using safe
     by (auto simp: * from_mregex qtables qtable_empty_iff zero_enat_def[symmetric]
         lookup_tabulate finite_LPDs eps_match less_Suc_eq LPDs_refl
         intro!: qtable_cong[OF qtable_l\<epsilon>_strict[where \<phi>s=\<phi>s]] intro: qtables exI[of _ j]
         split: option.splits)
 qed
 
 lemma Un_empty_table[simp]: "rel \<union> empty_table = rel" "empty_table \<union> rel = rel"
   unfolding empty_table_def by auto
 
 lemma wf_matchF_invar_step:
   assumes wf: "wf_matchF_invar \<sigma> V n R I r st (Suc i)"
     and safe: "safe_regex Futu Strict r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and mrs: "mrs = sorted_list_of_set (LPDs mr)"
     and qtables: "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) rel) \<phi>s rels"
     and rel: "qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v. (\<exists>j. i \<le> j \<and> j < i + length (fst st) \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) I \<and>
           Regex.match (Formula.sat \<sigma> V (map the v)) r i j)) rel"
     and entry: "entry = (\<tau> \<sigma> i, rels, rel)"
     and nt: "nt = \<tau> \<sigma> (i + length (fst st))"
   shows "wf_matchF_invar \<sigma> V n R I r (update_matchF_step I mr mrs nt entry st) i"
 proof -
   have from_mregex: "from_mregex mr \<phi>s = r"
     using safe mr using from_mregex_eq by blast
   { fix ms
     assume "ms \<in> LPDs mr"
     then have "fv_regex (from_mregex ms \<phi>s) = fv_regex r"
       "safe_regex Futu Strict (from_mregex ms \<phi>s)" "ok (length \<phi>s) ms" "LPD ms \<subseteq> LPDs mr"
       using safe LPDs_safe LPDs_safe_fv_regex mr from_mregex_to_mregex LPDs_ok to_mregex_ok LPDs_trans
       by fastforce+
   } note * = this
   { fix aux X ms
     assume "st = (aux, X)" "ms \<in> LPDs mr"
     with wf mr have "qtable n (fv_regex r) (mem_restr R)
       (\<lambda>v. Regex.match (Formula.sat \<sigma> V (map the v)) (from_mregex ms \<phi>s) i (i + length aux))
       (l\<delta> (\<lambda>x. x) X rels ms)"
       by (intro qtable_cong[OF qtable_l\<delta>[where \<phi>s=\<phi>s and A="fv_regex r" and
               Q="\<lambda>v r. Regex.match (Formula.sat \<sigma> V v) r (Suc i) (i + length aux)", OF _ _ qtables]])
         (auto simp: wf_matchF_invar_def * LPDs_trans lpd_match[of i] elim!: bspec)
   } note l\<delta> = this
   have "lookup (mrtabulate mrs f) ms = f ms" if "ms \<in> LPDs mr" for ms and f :: "mregex \<Rightarrow> 'a table"
     using that mrs  by (fastforce simp: lookup_tabulate finite_LPDs split: option.splits)+
   then show ?thesis
     using wf mr mrs entry nt LPDs_trans
     by (auto 0 3 simp: Let_def wf_matchF_invar_def update_matchF_step_def wf_matchF_aux_def mr * LPDs_refl
         list_all2_Cons1 append_eq_Cons_conv upt_eq_Cons_conv Suc_le_eq qtables
         lookup_tabulate finite_LPDs id_def l\<delta> from_mregex less_Suc_eq
         intro!: qtable_union[OF rel l\<delta>] qtable_cong[OF rel]
         intro: exI[of _ "i + length _"]
         split: if_splits prod.splits)
 qed
 
 lemma wf_update_matchF_invar:
   assumes pre: "wf_matchF_aux \<sigma> V n R I r aux ne (length (fst st) - 1)"
     and wf: "wf_matchF_invar \<sigma> V n R I r st (ne + length aux)"
     and safe: "safe_regex Futu Strict r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and mrs: "mrs = sorted_list_of_set (LPDs mr)"
     and j: "j = ne + length aux + length (fst st) - 1"
   shows "wf_matchF_invar \<sigma> V n R I r (foldr (update_matchF_step I mr mrs (\<tau> \<sigma> j)) aux st) ne"
   using pre wf unfolding j
 proof (induct aux arbitrary: ne)
   case (Cons entry aux)
   from Cons(1)[of "Suc ne"] Cons(2,3) show ?case
     unfolding foldr.simps o_apply
     by (intro wf_matchF_invar_step[where rels = "fst (snd entry)" and rel = "snd (snd entry)"])
       (auto simp: safe mr mrs wf_matchF_aux_def wf_matchF_invar_def list_all2_Cons1 append_eq_Cons_conv
         Suc_le_eq upt_eq_Cons_conv length_foldr_update_matchF_step add.assoc split: if_splits)
 qed simp
 
 
 lemma wf_update_matchF:
   assumes pre: "wf_matchF_aux \<sigma> V n R I r aux ne 0"
     and safe: "safe_regex Futu Strict r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and mrs: "mrs = sorted_list_of_set (LPDs mr)"
     and nt: "nt = \<tau> \<sigma> (ne + length aux)"
     and qtables: "list_all2 (\<lambda>\<phi> rel. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) (ne + length aux) \<phi>) rel) \<phi>s rels"
   shows "wf_matchF_aux \<sigma> V n R I r (update_matchF n I mr mrs rels nt aux) ne 0"
   unfolding update_matchF_def using wf_update_matchF_base_invar[OF safe mr mrs qtables, of I]
   unfolding nt
   by (intro wf_update_matchF_invar[OF _ _ safe mr mrs, unfolded wf_matchF_invar_def split_beta, THEN conjunct2, THEN conjunct1])
     (auto simp: length_update_matchF_base wf_matchF_invar_def update_matchF_base_def Let_def pre)
 
 lemma wf_until_aux_Cons: "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> (a # aux) ne \<Longrightarrow>
   wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> aux (Suc ne)"
   unfolding wf_until_auxlist_def
   by (simp add: upt_conv_Cons del: upt_Suc cong: if_cong)
 
 lemma wf_matchF_aux_Cons: "wf_matchF_aux \<sigma> V n R I r (entry # aux) ne i \<Longrightarrow>
   wf_matchF_aux \<sigma> V n R I r aux (Suc ne) i"
   unfolding wf_matchF_aux_def
   by (simp add: upt_conv_Cons del: upt_Suc cong: if_cong split: prod.splits)
 
 lemma wf_until_aux_Cons1: "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> ((t, a1, a2) # aux) ne \<Longrightarrow> t = \<tau> \<sigma> ne"
   unfolding wf_until_auxlist_def
   by (simp add: upt_conv_Cons del: upt_Suc)
 
 lemma wf_matchF_aux_Cons1: "wf_matchF_aux \<sigma> V n R I r ((t, rels, rel) # aux) ne i \<Longrightarrow> t = \<tau> \<sigma> ne"
   unfolding wf_matchF_aux_def
   by (simp add: upt_conv_Cons del: upt_Suc split: prod.splits)
 
 lemma wf_until_aux_Cons3: "wf_until_auxlist \<sigma> V n R pos \<phi> I \<psi> ((t, a1, a2) # aux) ne \<Longrightarrow>
   qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. (\<exists>j. ne \<le> j \<and> j < Suc (ne + length aux) \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> ne) I \<and>
     Formula.sat \<sigma> V (map the v) j \<psi> \<and> (\<forall>k\<in>{ne..<j}. if pos then Formula.sat \<sigma> V (map the v) k \<phi> else \<not> Formula.sat \<sigma> V (map the v) k \<phi>))) a2"
   unfolding wf_until_auxlist_def
   by (simp add: upt_conv_Cons del: upt_Suc)
 
 lemma wf_matchF_aux_Cons3: "wf_matchF_aux \<sigma> V n R I r ((t, rels, rel) # aux) ne i \<Longrightarrow>
   qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v. (\<exists>j. ne \<le> j \<and> j < Suc (ne + length aux + i) \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> ne) I \<and>
     Regex.match (Formula.sat \<sigma> V (map the v)) r ne j)) rel"
   unfolding wf_matchF_aux_def
   by (simp add: upt_conv_Cons del: upt_Suc split: prod.splits)
 
 lemma upt_append: "a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> [a..<b] @ [b..<c] = [a..<c]"
   by (metis le_Suc_ex upt_add_eq_append)
 
 lemma wf_mbuf2_add:
   assumes "wf_mbuf2 i ja jb P Q buf"
     and "list_all2 P [ja..<ja'] xs"
     and "list_all2 Q [jb..<jb'] ys"
     and "ja \<le> ja'" "jb \<le> jb'"
   shows "wf_mbuf2 i ja' jb' P Q (mbuf2_add xs ys buf)"
   using assms unfolding wf_mbuf2_def
   by (auto 0 3 simp: list_all2_append2 upt_append dest: list_all2_lengthD
       intro: exI[where x="[i..<ja]"] exI[where x="[ja..<ja']"]
       exI[where x="[i..<jb]"] exI[where x="[jb..<jb']"] split: prod.splits)
 
 lemma wf_mbufn_add:
   assumes "wf_mbufn i js Ps buf"
     and "list_all3 list_all2 Ps (List.map2 (\<lambda>j j'. [j..<j']) js js') xss"
     and "list_all2 (\<le>) js js'"
   shows "wf_mbufn i js' Ps (mbufn_add xss buf)"
   unfolding wf_mbufn_def list_all3_conv_all_nth
 proof safe
   show "length Ps = length js'" "length js' = length (mbufn_add xss buf)"
     using assms unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth by auto
 next
   fix k assume k: "k < length Ps"
   then show "i \<le> js' ! k"
     using assms unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth
     by (auto 0 4 dest: spec[of _ i])
   from k have " [i..<js' ! k] =  [i..<js ! k] @ [js ! k ..<js' ! k]" and
     "length [i..<js ! k] = length (buf ! k)"
     using assms(1,3) unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth
     by (auto simp: upt_append)
   with k show "list_all2 (Ps ! k) [i..<js' ! k] (mbufn_add xss buf ! k)"
     using assms[unfolded wf_mbufn_def list_all3_conv_all_nth]
     by (auto simp add: list_all2_append)
 qed
 
 lemma mbuf2_take_eqD:
   assumes "mbuf2_take f buf = (xs, buf')"
     and "wf_mbuf2 i ja jb P Q buf"
   shows "wf_mbuf2 (min ja jb) ja jb P Q buf'"
     and "list_all2 (\<lambda>i z. \<exists>x y. P i x \<and> Q i y \<and> z = f x y) [i..<min ja jb] xs"
   using assms unfolding wf_mbuf2_def
   by (induction f buf arbitrary: i xs buf' rule: mbuf2_take.induct)
     (fastforce simp add: list_all2_Cons2 upt_eq_Cons_conv min_absorb1 min_absorb2 split: prod.splits)+
 
 lemma list_all3_Nil[simp]:
   "list_all3 P xs ys [] \<longleftrightarrow> xs = [] \<and> ys = []"
   "list_all3 P xs [] zs \<longleftrightarrow> xs = [] \<and> zs = []"
   "list_all3 P [] ys zs \<longleftrightarrow> ys = [] \<and> zs = []"
   unfolding list_all3_conv_all_nth by auto
 
 lemma list_all3_Cons:
   "list_all3 P xs ys (z # zs) \<longleftrightarrow> (\<exists>x xs' y ys'. xs = x # xs' \<and> ys = y # ys' \<and> P x y z \<and> list_all3 P xs' ys' zs)"
   "list_all3 P xs (y # ys) zs \<longleftrightarrow> (\<exists>x xs' z zs'. xs = x # xs' \<and> zs = z # zs' \<and> P x y z \<and> list_all3 P xs' ys zs')"
   "list_all3 P (x # xs) ys zs \<longleftrightarrow> (\<exists>y ys' z zs'. ys = y # ys' \<and> zs = z # zs' \<and> P x y z \<and> list_all3 P xs ys' zs')"
   unfolding list_all3_conv_all_nth
   by (auto simp: length_Suc_conv Suc_length_conv nth_Cons split: nat.splits)
 
 lemma list_all3_mono_strong: "list_all3 P xs ys zs \<Longrightarrow>
   (\<And>x y z. x \<in> set xs \<Longrightarrow> y \<in> set ys \<Longrightarrow> z \<in> set zs \<Longrightarrow> P x y z \<Longrightarrow> Q x y z) \<Longrightarrow>
   list_all3 Q xs ys zs"
   by (induct xs ys zs rule: list_all3.induct) (auto intro: list_all3.intros)
 
 definition Mini where
   "Mini i js = (if js = [] then i else Min (set js))"
 
 lemma wf_mbufn_in_set_Mini:
   assumes "wf_mbufn i js Ps buf"
   shows "[] \<in> set buf \<Longrightarrow> Mini i js = i"
   unfolding in_set_conv_nth
 proof (elim exE conjE)
   fix k
   have "i \<le> j" if "j \<in> set js" for j
     using that assms unfolding wf_mbufn_def list_all3_conv_all_nth in_set_conv_nth by auto
   moreover assume "k < length buf" "buf ! k = []"
   ultimately show ?thesis using assms
     unfolding Mini_def wf_mbufn_def list_all3_conv_all_nth
     by (auto 0 4 dest!: spec[of _ k] intro: Min_eqI simp: in_set_conv_nth)
 qed
 
 lemma wf_mbufn_notin_set:
   assumes "wf_mbufn i js Ps buf"
   shows "[] \<notin> set buf \<Longrightarrow> j \<in> set js \<Longrightarrow> i < j"
   using assms unfolding wf_mbufn_def list_all3_conv_all_nth
   by (cases "i \<in> set js") (auto intro: le_neq_implies_less simp: in_set_conv_nth)
 
 lemma wf_mbufn_map_tl:
   "wf_mbufn i js Ps buf \<Longrightarrow> [] \<notin> set buf \<Longrightarrow> wf_mbufn (Suc i) js Ps (map tl buf)"
   by (auto simp: wf_mbufn_def list_all3_map Suc_le_eq
       dest: rel_funD[OF tl_transfer]  elim!: list_all3_mono_strong le_neq_implies_less)
 
 lemma list_all3_list_all2I: "list_all3 (\<lambda>x y z. Q x z) xs ys zs \<Longrightarrow> list_all2 Q xs zs"
   by (induct xs ys zs rule: list_all3.induct) auto
 
 lemma mbuf2t_take_eqD:
   assumes "mbuf2t_take f z buf nts = (z', buf', nts')"
     and "wf_mbuf2 i ja jb P Q buf"
     and "list_all2 R [i..<j] nts"
     and "ja \<le> j" "jb \<le> j"
   shows "wf_mbuf2 (min ja jb) ja jb P Q buf'"
     and "list_all2 R [min ja jb..<j] nts'"
   using assms unfolding wf_mbuf2_def
   by (induction f z buf nts arbitrary: i z' buf' nts' rule: mbuf2t_take.induct)
     (auto simp add: list_all2_Cons2 upt_eq_Cons_conv less_eq_Suc_le min_absorb1 min_absorb2
       split: prod.split)
 
 lemma wf_mbufn_take:
   assumes "mbufn_take f z buf = (z', buf')"
     and "wf_mbufn i js Ps buf"
   shows "wf_mbufn (Mini i js) js Ps buf'"
   using assms unfolding wf_mbufn_def
 proof (induction f z buf arbitrary: i z' buf' rule: mbufn_take.induct)
   case rec: (1 f z buf)
   show ?case proof (cases "buf = []")
     case True
     with rec.prems show ?thesis by simp
   next
     case nonempty: False
     show ?thesis proof (cases "[] \<in> set buf")
       case True
       from rec.prems(2) have "\<forall>j\<in>set js. i \<le> j"
         by (auto simp: in_set_conv_nth list_all3_conv_all_nth)
       moreover from True rec.prems(2) have "i \<in> set js"
         by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
       ultimately have "Mini i js = i"
         unfolding Mini_def
         by (auto intro!: antisym[OF Min.coboundedI Min.boundedI])
       with rec.prems nonempty True show ?thesis by simp
     next
       case False
       from nonempty rec.prems(2) have "Mini i js = Mini (Suc i) js"
         unfolding Mini_def by auto
       show ?thesis
         unfolding \<open>Mini i js = Mini (Suc i) js\<close>
       proof (rule rec.IH)
         show "\<not> (buf = [] \<or> [] \<in> set buf)" using nonempty False by simp
         show "list_all3 (\<lambda>P j xs. Suc i \<le> j \<and> list_all2 P [Suc i..<j] xs) Ps js (map tl buf)"
           using False rec.prems(2)
           by (auto simp: list_all3_map elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
         show "mbufn_take f (f (map hd buf) z) (map tl buf) = (z', buf')"
           using nonempty False rec.prems(1) by simp
       qed
     qed
   qed
 qed
 
 lemma mbufnt_take_eqD:
   assumes "mbufnt_take f z buf nts = (z', buf', nts')"
     and "wf_mbufn i js Ps buf"
     and "list_all2 R [i..<j] nts"
     and "\<And>k. k \<in> set js \<Longrightarrow> k \<le> j"
     and "k = Mini (i + length nts) js"
   shows "wf_mbufn k js Ps buf'"
     and "list_all2 R [k..<j] nts'"
   using assms(1-4) unfolding assms(5)
 proof (induction f z buf nts arbitrary: i z' buf' nts' rule: mbufnt_take.induct)
   case IH: (1 f z buf nts)
   note mbufnt_take.simps[simp del]
   case 1
   then have *: "list_all2 R [Suc i..<j] (tl nts)"
     by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
   from 1 show ?case
     using wf_mbufn_in_set_Mini[OF 1(2)]
     by (subst (asm) mbufnt_take.simps)
       (force simp: Mini_def wf_mbufn_def split: if_splits prod.splits elim!: list_all3_mono_strong
         dest!: IH(1)[rotated, OF _ wf_mbufn_map_tl[OF 1(2)] *])
   case 2
   then have *: "list_all2 R [Suc i..<j] (tl nts)"
     by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
   have [simp]: "Suc (i + (length nts - Suc 0)) = i + length nts" if "nts \<noteq> []"
     using that by (fastforce simp flip: length_greater_0_conv)
   with 2 show ?case
     using wf_mbufn_in_set_Mini[OF 2(2)] wf_mbufn_notin_set[OF 2(2)]
     by (subst (asm) mbufnt_take.simps) (force simp: Mini_def wf_mbufn_def
         dest!: IH(2)[rotated, OF _ wf_mbufn_map_tl[OF 2(2)] *]
         split: if_splits prod.splits)
 qed
 
 lemma mbuf2t_take_induct[consumes 5, case_names base step]:
   assumes "mbuf2t_take f z buf nts = (z', buf', nts')"
     and "wf_mbuf2 i ja jb P Q buf"
     and "list_all2 R [i..<j] nts"
     and "ja \<le> j" "jb \<le> j"
     and "U i z"
     and "\<And>k x y t z. i \<le> k \<Longrightarrow> Suc k \<le> ja \<Longrightarrow> Suc k \<le> jb \<Longrightarrow>
       P k x \<Longrightarrow> Q k y \<Longrightarrow> R k t \<Longrightarrow> U k z \<Longrightarrow> U (Suc k) (f x y t z)"
   shows "U (min ja jb) z'"
   using assms unfolding wf_mbuf2_def
   by (induction f z buf nts arbitrary: i z' buf' nts' rule: mbuf2t_take.induct)
     (auto simp add: list_all2_Cons2 upt_eq_Cons_conv less_eq_Suc_le min_absorb1 min_absorb2
       elim!: arg_cong2[of _ _ _ _ U, OF _ refl, THEN iffD1, rotated] split: prod.split)
 
 lemma list_all2_hdD:
   assumes "list_all2 P [i..<j] xs" "xs \<noteq> []"
   shows "P i (hd xs)" "i < j"
   using assms unfolding list_all2_conv_all_nth
   by (auto simp: hd_conv_nth intro: zero_less_diff[THEN iffD1] dest!: spec[of _ 0])
 
 lemma mbufn_take_induct[consumes 3, case_names base step]:
   assumes "mbufn_take f z buf = (z', buf')"
     and "wf_mbufn i js Ps buf"
     and "U i z"
     and "\<And>k xs z. i \<le> k \<Longrightarrow> Suc k \<le> Mini i js \<Longrightarrow>
       list_all2 (\<lambda>P x. P k x) Ps xs \<Longrightarrow> U k z \<Longrightarrow> U (Suc k) (f xs z)"
   shows "U (Mini i js) z'"
   using assms unfolding wf_mbufn_def
 proof (induction f z buf arbitrary: i z' buf' rule: mbufn_take.induct)
   case rec: (1 f z buf)
   show ?case proof (cases "buf = []")
     case True
     with rec.prems show ?thesis unfolding Mini_def by simp
   next
     case nonempty: False
     show ?thesis proof (cases "[] \<in> set buf")
       case True
       from rec.prems(2) have "\<forall>j\<in>set js. i \<le> j"
         by (auto simp: in_set_conv_nth list_all3_conv_all_nth)
       moreover from True rec.prems(2) have "i \<in> set js"
         by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
       ultimately have "Mini i js = i"
         unfolding Mini_def
         by (auto intro!: antisym[OF Min.coboundedI Min.boundedI])
       with rec.prems nonempty True show ?thesis by simp
     next
       case False
       with nonempty rec.prems(2) have more: "Suc i \<le> Mini i js"
         using diff_is_0_eq not_le unfolding Mini_def
         by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
       then have "Mini i js = Mini (Suc i) js" unfolding Mini_def by auto
       show ?thesis
         unfolding \<open>Mini i js = Mini (Suc i) js\<close>
       proof (rule rec.IH)
         show "\<not> (buf = [] \<or> [] \<in> set buf)" using nonempty False by simp
         show "mbufn_take f (f (map hd buf) z) (map tl buf) = (z', buf')"
           using nonempty False rec.prems by simp
         show "list_all3 (\<lambda>P j xs. Suc i \<le> j \<and> list_all2 P [Suc i..<j] xs) Ps js (map tl buf)"
           using False rec.prems
           by (auto simp: list_all3_map elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
         show "U (Suc i) (f (map hd buf) z)"
           using more False rec.prems
           by (auto 0 4 simp: list_all3_map intro!: rec.prems(4) list_all3_list_all2I
               elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
         show "\<And>k xs z. Suc i \<le> k \<Longrightarrow> Suc k \<le> Mini (Suc i) js \<Longrightarrow>
           list_all2 (\<lambda>P. P k) Ps xs \<Longrightarrow> U k z \<Longrightarrow> U (Suc k) (f xs z)"
           by (rule rec.prems(4)) (auto simp: Mini_def)
       qed
     qed
   qed
 qed
 
 lemma mbufnt_take_induct[consumes 5, case_names base step]:
   assumes "mbufnt_take f z buf nts = (z', buf', nts')"
     and "wf_mbufn i js Ps buf"
     and "list_all2 R [i..<j] nts"
     and "\<And>k. k \<in> set js \<Longrightarrow> k \<le> j"
     and "U i z"
     and "\<And>k xs t z. i \<le> k \<Longrightarrow> Suc k \<le> Mini j js \<Longrightarrow>
       list_all2 (\<lambda>P x. P k x) Ps xs \<Longrightarrow> R k t \<Longrightarrow> U k z \<Longrightarrow> U (Suc k) (f xs t z)"
   shows "U (Mini (i + length nts) js) z'"
   using assms
 proof (induction f z buf nts arbitrary: i z' buf' nts' rule: mbufnt_take.induct)
   case (1 f z buf nts)
   then have *: "list_all2 R [Suc i..<j] (tl nts)"
     by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
   note mbufnt_take.simps[simp del]
   from 1(2-6) have "i = Min (set js)" if "js \<noteq> []" "nts = []"
     using that unfolding wf_mbufn_def using wf_mbufn_in_set_Mini[OF 1(3)]
     by (fastforce simp: Mini_def list_all3_Cons neq_Nil_conv)
   with 1(2-7) list_all2_hdD[OF 1(4)] show ?case
     unfolding wf_mbufn_def using wf_mbufn_in_set_Mini[OF 1(3)] wf_mbufn_notin_set[OF 1(3)]
     by (subst (asm) mbufnt_take.simps)
       (auto simp add: Mini_def list.rel_map Suc_le_eq
         elim!: arg_cong2[of _ _ _ _ U, OF _ refl, THEN iffD1, rotated]
         list_all3_mono_strong[THEN list_all3_list_all2I[of _ _ js]] list_all2_hdD
         dest!: 1(1)[rotated, OF _ wf_mbufn_map_tl[OF 1(3)] * _ 1(7)] split: prod.split if_splits)
 qed
 
 lemma mbuf2_take_add':
   assumes eq: "mbuf2_take f (mbuf2_add xs ys buf) = (zs, buf')"
     and pre: "wf_mbuf2' \<sigma> P V j n R \<phi> \<psi> buf"
     and rm: "rel_mapping (\<le>) P P'"
     and xs: "list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
       [progress \<sigma> P \<phi> j..<progress \<sigma> P' \<phi> j'] xs"
     and ys: "list_all2 (\<lambda>i. qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>))
       [progress \<sigma> P \<psi> j..<progress \<sigma> P' \<psi> j'] ys"
     and "j \<le> j'"
   shows "wf_mbuf2' \<sigma> P' V j' n R \<phi> \<psi> buf'"
     and "list_all2 (\<lambda>i Z. \<exists>X Y.
       qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>) X \<and>
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>) Y \<and>
       Z = f X Y)
       [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)..<min (progress \<sigma> P' \<phi> j') (progress \<sigma> P' \<psi> j')] zs"
   using pre rm unfolding wf_mbuf2'_def
   by (force intro!: mbuf2_take_eqD[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF \<open>j \<le> j'\<close> rm])+
 
 lemma mbuf2t_take_add':
   assumes eq: "mbuf2t_take f z (mbuf2_add xs ys buf) nts = (z', buf', nts')"
     and bounded: "pred_mapping (\<lambda>x. x \<le> j) P" "pred_mapping (\<lambda>x. x \<le> j') P'"
     and rm: "rel_mapping (\<le>) P P'"
     and pre_buf: "wf_mbuf2' \<sigma> P V j n R \<phi> \<psi> buf"
     and pre_nts: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)..<j'] nts"
     and xs: "list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
       [progress \<sigma> P \<phi> j..<progress \<sigma> P' \<phi> j'] xs"
     and ys: "list_all2 (\<lambda>i. qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>))
       [progress \<sigma> P \<psi> j..<progress \<sigma> P' \<psi> j'] ys"
     and "j \<le> j'"
   shows "wf_mbuf2' \<sigma> P' V j' n R \<phi> \<psi> buf'"
     and "wf_ts \<sigma> P' j' \<phi> \<psi> nts'"
   using pre_buf pre_nts bounded rm unfolding wf_mbuf2'_def wf_ts_def
   by (auto intro!: mbuf2t_take_eqD[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF \<open>j \<le> j'\<close> rm]
       progress_le_gen)
 
 lemma ok_0_atms: "ok 0 mr \<Longrightarrow> regex.atms (from_mregex mr []) = {}"
   by (induct mr) auto
 
 lemma ok_0_progress: "ok 0 mr \<Longrightarrow> progress_regex \<sigma> P (from_mregex mr []) j = j"
   by (drule ok_0_atms) (auto simp: progress_regex_def)
 
 lemma atms_empty_atms: "safe_regex m g r \<Longrightarrow> atms r = {} \<longleftrightarrow> regex.atms r = {}"
   by (induct r rule: safe_regex_induct) (auto split: if_splits simp: cases_Neg_iff)
 
 lemma atms_empty_progress: "safe_regex m g r \<Longrightarrow> atms r = {} \<Longrightarrow> progress_regex \<sigma> P r j = j"
   by (drule atms_empty_atms) (auto simp: progress_regex_def)
 
 lemma to_mregex_empty_progress: "safe_regex m g r \<Longrightarrow> to_mregex r = (mr, []) \<Longrightarrow>
   progress_regex \<sigma> P r j = j"
   using from_mregex_eq ok_0_progress to_mregex_ok atms_empty_atms by fastforce
 
 lemma progress_regex_le: "pred_mapping (\<lambda>x. x \<le> j) P \<Longrightarrow> progress_regex \<sigma> P r j \<le> j"
   by (auto intro!: progress_le_gen simp: Min_le_iff progress_regex_def)
 
 lemma Neg_acyclic: "formula.Neg x = x \<Longrightarrow> P"
   by (induct x) auto
 
 lemma case_Neg_in_iff: "x \<in> (case y of formula.Neg \<phi>' \<Rightarrow> {\<phi>'} | _ \<Rightarrow> {}) \<longleftrightarrow> y = formula.Neg x"
   by (cases y) auto
 
 lemma atms_nonempty_progress:
   "safe_regex m g r \<Longrightarrow> atms r \<noteq> {} \<Longrightarrow> (\<lambda>\<phi>. progress \<sigma> P \<phi> j) ` atms r = (\<lambda>\<phi>. progress \<sigma> P \<phi> j) ` regex.atms r"
   by (frule atms_empty_atms; simp)
     (auto 0 3 simp: atms_def image_iff case_Neg_in_iff elim!: disjE_Not2 dest: safe_regex_safe_formula)
 
 lemma to_mregex_nonempty_progress: "safe_regex m g r \<Longrightarrow> to_mregex r = (mr, \<phi>s) \<Longrightarrow> \<phi>s \<noteq> [] \<Longrightarrow>
   progress_regex \<sigma> P r j = (MIN \<phi>\<in>set \<phi>s. progress \<sigma> P \<phi> j)"
   using atms_nonempty_progress to_mregex_ok unfolding progress_regex_def by fastforce
 
 lemma to_mregex_progress: "safe_regex m g r \<Longrightarrow> to_mregex r = (mr, \<phi>s) \<Longrightarrow>
   progress_regex \<sigma> P r j = (if \<phi>s = [] then j else (MIN \<phi>\<in>set \<phi>s. progress \<sigma> P \<phi> j))"
   using to_mregex_nonempty_progress to_mregex_empty_progress unfolding progress_regex_def by auto
 
 lemma mbufnt_take_add':
   assumes eq: "mbufnt_take f z (mbufn_add xss buf) nts = (z', buf', nts')"
     and bounded: "pred_mapping (\<lambda>x. x \<le> j) P" "pred_mapping (\<lambda>x. x \<le> j') P'"
     and rm: "rel_mapping (\<le>) P P'"
     and safe: "safe_regex m g r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and pre_buf: "wf_mbufn' \<sigma> P V j n R r buf"
     and pre_nts: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [progress_regex \<sigma> P r j..<j'] nts"
     and xss: "list_all3 list_all2
      (map (\<lambda>\<phi> i. qtable n (fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>)) \<phi>s)
      (map2 upt (map (\<lambda>\<phi>. progress \<sigma> P \<phi> j) \<phi>s) (map (\<lambda>\<phi>. progress \<sigma> P' \<phi> j') \<phi>s)) xss"
     and "j \<le> j'"
   shows "wf_mbufn' \<sigma> P' V j' n R r buf'"
     and "wf_ts_regex \<sigma> P' j' r nts'"
   using pre_buf pre_nts bounded rm mr safe xss \<open>j \<le> j'\<close>  unfolding wf_mbufn'_def wf_ts_regex_def
   using atms_empty_progress[of m g r] to_mregex_ok[OF mr]
   by (auto 0 3 simp: list.rel_map to_mregex_empty_progress to_mregex_nonempty_progress Mini_def
       intro: progress_mono_gen[OF \<open>j \<le> j'\<close> rm] list.rel_refl_strong progress_le_gen
       dest: list_all2_lengthD elim!: mbufnt_take_eqD[OF eq wf_mbufn_add])
 
 lemma mbuf2t_take_add_induct'[consumes 6, case_names base step]:
   assumes eq: "mbuf2t_take f z (mbuf2_add xs ys buf) nts = (z', buf', nts')"
     and bounded: "pred_mapping (\<lambda>x. x \<le> j) P" "pred_mapping (\<lambda>x. x \<le> j') P'"
     and rm: "rel_mapping (\<le>) P P'"
     and pre_buf: "wf_mbuf2' \<sigma> P V j n R \<phi> \<psi> buf"
     and pre_nts: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)..<j'] nts"
     and xs: "list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
       [progress \<sigma> P \<phi> j..<progress \<sigma> P' \<phi> j'] xs"
     and ys: "list_all2 (\<lambda>i. qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>))
       [progress \<sigma> P \<psi> j..<progress \<sigma> P' \<psi> j'] ys"
     and "j \<le> j'"
     and base: "U (min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)) z"
     and step: "\<And>k X Y z. min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j) \<le> k \<Longrightarrow>
       Suc k \<le> progress \<sigma> P' \<phi> j' \<Longrightarrow> Suc k \<le> progress \<sigma> P' \<psi> j' \<Longrightarrow>
       qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) k \<phi>) X \<Longrightarrow>
       qtable n (Formula.fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) k \<psi>) Y \<Longrightarrow>
       U k z \<Longrightarrow> U (Suc k) (f X Y (\<tau> \<sigma> k) z)"
   shows "U (min (progress \<sigma> P' \<phi> j') (progress \<sigma> P' \<psi> j')) z'"
   using pre_buf pre_nts bounded rm unfolding wf_mbuf2'_def
   by (blast intro!: mbuf2t_take_induct[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF \<open>j \<le> j'\<close> rm]
       progress_le_gen base step)
 
 lemma mbufnt_take_add_induct'[consumes 6, case_names base step]:
   assumes eq: "mbufnt_take f z (mbufn_add xss buf) nts = (z', buf', nts')"
     and bounded: "pred_mapping (\<lambda>x. x \<le> j) P" "pred_mapping (\<lambda>x. x \<le> j') P'"
     and rm: "rel_mapping (\<le>) P P'"
     and safe: "safe_regex m g r"
     and mr: "to_mregex r = (mr, \<phi>s)"
     and pre_buf: "wf_mbufn' \<sigma> P V j n R r buf"
     and pre_nts: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [progress_regex \<sigma> P r j..<j'] nts"
     and xss: "list_all3 list_all2
      (map (\<lambda>\<phi> i. qtable n (fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>)) \<phi>s)
      (map2 upt (map (\<lambda>\<phi>. progress \<sigma> P \<phi> j) \<phi>s) (map (\<lambda>\<phi>. progress \<sigma> P' \<phi> j') \<phi>s)) xss"
     and "j \<le> j'"
     and base: "U (progress_regex \<sigma> P r j) z"
     and step: "\<And>k Xs z. progress_regex \<sigma> P r j \<le> k \<Longrightarrow> Suc k \<le> progress_regex \<sigma> P' r j' \<Longrightarrow>
       list_all2 (\<lambda>\<phi>. qtable n (Formula.fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) k \<phi>)) \<phi>s Xs \<Longrightarrow>
       U k z \<Longrightarrow> U (Suc k) (f Xs (\<tau> \<sigma> k) z)"
   shows "U (progress_regex \<sigma> P' r j') z'"
   using pre_buf pre_nts bounded rm \<open>j \<le> j'\<close> to_mregex_progress[OF safe mr, of \<sigma> P' j'] to_mregex_empty_progress[OF safe, of mr \<sigma> P j] base
   unfolding wf_mbufn'_def mr prod.case
   by (fastforce dest!: mbufnt_take_induct[OF eq wf_mbufn_add[OF _ xss] pre_nts, of U]
       simp: list.rel_map le_imp_diff_is_add ac_simps Mini_def
       intro: progress_mono_gen[OF \<open>j \<le> j'\<close> rm] list.rel_refl_strong progress_le_gen
       intro!: base step  dest: list_all2_lengthD split: if_splits)
 
 lemma progress_Until_le: "progress \<sigma> P (Formula.Until \<phi> I \<psi>) j \<le> min (progress \<sigma> P \<phi> j) (progress \<sigma> P \<psi> j)"
   by (cases "right I") (auto simp: trans_le_add1 intro!: cInf_lower)
 
 lemma progress_MatchF_le: "progress \<sigma> P (Formula.MatchF I r) j \<le> progress_regex \<sigma> P r j"
   by (cases "right I") (auto simp: trans_le_add1 progress_regex_def intro!: cInf_lower)
 
 lemma list_all2_upt_Cons: "P a x \<Longrightarrow> list_all2 P [Suc a..<b] xs \<Longrightarrow> Suc a \<le> b \<Longrightarrow>
   list_all2 P [a..<b] (x # xs)"
   by (simp add: list_all2_Cons2 upt_eq_Cons_conv)
 
 lemma list_all2_upt_append: "list_all2 P [a..<b] xs \<Longrightarrow> list_all2 P [b..<c] ys \<Longrightarrow>
   a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> list_all2 P [a..<c] (xs @ ys)"
   by (induction xs arbitrary: a) (auto simp add: list_all2_Cons2 upt_eq_Cons_conv)
 
 lemma list_all3_list_all2_conv: "list_all3 R xs xs ys = list_all2 (\<lambda>x. R x x) xs ys"
   by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth)
 
 lemma map_split_map: "map_split f (map g xs) = map_split (f o g) xs"
   by (induct xs) auto
 
 lemma map_split_alt: "map_split f xs = (map (fst o f) xs, map (snd o f) xs)"
   by (induct xs) (auto split: prod.splits)
 
 lemma fv_formula_of_constraint: "fv (formula_of_constraint (t1, p, c, t2)) = fv_trm t1 \<union> fv_trm t2"
   by (induction "(t1, p, c, t2)" rule: formula_of_constraint.induct) simp_all
 
 lemma (in maux) wf_mformula_wf_set: "wf_mformula \<sigma> j P V n R \<phi> \<phi>' \<Longrightarrow> wf_set n (Formula.fv \<phi>')"
   unfolding wf_set_def
 proof (induction rule: wf_mformula.induct)
   case (AndRel P V n R \<phi> \<phi>' \<psi>' conf)
   then show ?case by (auto simp: fv_formula_of_constraint dest!: subsetD)
 next
   case (Ands P V n R l l_pos l_neg l' buf A_pos A_neg)
   from Ands.IH have "\<forall>\<phi>'\<in>set (l_pos @ map remove_neg l_neg). \<forall>x\<in>fv \<phi>'. x < n"
     by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of "_ @ _"] del: set_append)
   then have "\<forall>\<phi>'\<in>set (l_pos @ l_neg). \<forall>x\<in>fv \<phi>'. x < n"
     by (auto dest: bspec[where x="remove_neg _"])
   then show ?case using Ands.hyps(2) by auto
 next
   case (Agg P V b n R \<phi> \<phi>' y f g0 \<omega>)
   then have "Formula.fvi_trm b f \<subseteq> Formula.fvi b \<phi>'"
     by (auto simp: fvi_trm_iff_fv_trm[where b=b] fvi_iff_fv[where b=b])
   with Agg show ?case by (auto 0 3 simp: Un_absorb2 fvi_iff_fv[where b=b])
 next
   case (MatchP r P V n R \<phi>s mr mrs buf nts I aux)
   then obtain \<phi>s' where conv: "to_mregex r = (mr, \<phi>s')" by blast
   with MatchP have "\<forall>\<phi>'\<in>set \<phi>s'. \<forall>x\<in>fv \<phi>'. x < n"
     by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of \<phi>s'])
   with conv show ?case
     by (simp add: to_mregex_ok[THEN conjunct1] fv_regex_alt[OF \<open>safe_regex _ _ r\<close>])
 next
   case (MatchF r  P V n R \<phi>s mr mrs buf nts I aux)
   then obtain \<phi>s' where conv: "to_mregex r = (mr, \<phi>s')" by blast
   with MatchF have "\<forall>\<phi>'\<in>set \<phi>s'. \<forall>x\<in>fv \<phi>'. x < n"
     by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of \<phi>s'])
   with conv show ?case
     by (simp add: to_mregex_ok[THEN conjunct1] fv_regex_alt[OF \<open>safe_regex _ _ r\<close>])
 qed (auto simp: fvi_Suc split: if_splits)
 
 lemma qtable_mmulti_join:
   assumes pos: "list_all3 (\<lambda>A Qi X. qtable n A P Qi X \<and> wf_set n A) A_pos Q_pos L_pos"
     and neg: "list_all3 (\<lambda>A Qi X. qtable n A P Qi X \<and> wf_set n A) A_neg Q_neg L_neg"
     and C_eq: "C = \<Union>(set A_pos)" and L_eq: "L = L_pos @ L_neg"
     and "A_pos \<noteq> []" and fv_subset: "\<Union>(set A_neg) \<subseteq> \<Union>(set A_pos)"
     and restrict_pos: "\<And>x. wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> list_all (\<lambda>A. P (restrict A x)) A_pos"
     and restrict_neg: "\<And>x. wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> list_all (\<lambda>A. P (restrict A x)) A_neg"
     and Qs: "\<And>x. wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> Q x \<longleftrightarrow>
       list_all2 (\<lambda>A Qi. Qi (restrict A x)) A_pos Q_pos \<and>
       list_all2 (\<lambda>A Qi. \<not> Qi (restrict A x)) A_neg Q_neg"
   shows "qtable n C P Q (mmulti_join n A_pos A_neg L)"
 proof (rule qtableI)
   from pos have 1: "list_all2 (\<lambda>A X. table n A X \<and> wf_set n A) A_pos L_pos"
     by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth qtable_def)
   moreover from neg have "list_all2 (\<lambda>A X. table n A X \<and> wf_set n A) A_neg L_neg"
     by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth qtable_def)
   ultimately have L: "list_all2 (\<lambda>A X. table n A X \<and> wf_set n A) (A_pos @ A_neg) (L_pos @ L_neg)"
     by (rule list_all2_appendI)
   note in_join_iff = mmulti_join_correct[OF \<open>A_pos \<noteq> []\<close> L]
   from 1 have take_eq: "take (length A_pos) (L_pos @ L_neg) = L_pos"
     by (auto dest!: list_all2_lengthD)
   from 1 have drop_eq: "drop (length A_pos) (L_pos @ L_neg) = L_neg"
     by (auto dest!: list_all2_lengthD)
 
   note mmulti_join.simps[simp del]
   show "table n C (mmulti_join n A_pos A_neg L)"
     unfolding C_eq L_eq table_def by (simp add: in_join_iff)
   show "Q x" if "x \<in> mmulti_join n A_pos A_neg L" "wf_tuple n C x" "P x" for x
     using that(2,3)
   proof (rule Qs[THEN iffD2, OF _ _ conjI])
     have pos': "list_all2 (\<lambda>A. (\<in>) (restrict A x)) A_pos L_pos"
       and neg': "list_all2 (\<lambda>A. (\<notin>) (restrict A x)) A_neg L_neg"
       using that(1) unfolding L_eq in_join_iff take_eq drop_eq by simp_all
     show "list_all2 (\<lambda>A Qi. Qi (restrict A x)) A_pos Q_pos"
       using pos pos' restrict_pos that(2,3)
       by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def)
     have fv_subset': "\<And>i. i < length A_neg \<Longrightarrow> A_neg ! i \<subseteq> C"
       using fv_subset unfolding C_eq by (auto simp: Sup_le_iff)
     show "list_all2 (\<lambda>A Qi. \<not> Qi (restrict A x)) A_neg Q_neg"
       using neg neg' restrict_neg that(2,3)
       by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def
           wf_tuple_restrict_simple[OF _ fv_subset'])
   qed
   show "x \<in> mmulti_join n A_pos A_neg L" if "wf_tuple n C x" "P x" "Q x" for x
     unfolding L_eq in_join_iff take_eq drop_eq
   proof (intro conjI)
     from that have pos': "list_all2 (\<lambda>A Qi. Qi (restrict A x)) A_pos Q_pos"
       and neg': "list_all2 (\<lambda>A Qi. \<not> Qi (restrict A x)) A_neg Q_neg"
       using Qs[THEN iffD1] by auto
     show "wf_tuple n (\<Union>A\<in>set A_pos. A) x"
       using \<open>wf_tuple n C x\<close> unfolding C_eq by simp
     show "list_all2 (\<lambda>A. (\<in>) (restrict A x)) A_pos L_pos"
       using pos pos' restrict_pos that(1,2)
       by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def
           C_eq wf_tuple_restrict_simple[OF _ Sup_upper])
     show "list_all2 (\<lambda>A. (\<notin>) (restrict A x)) A_neg L_neg"
       using neg neg' restrict_neg that(1,2)
       by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def)
   qed
 qed
 
 lemma nth_filter: "i < length (filter P xs) \<Longrightarrow>
   (\<And>i'. i' < length xs \<Longrightarrow> P (xs ! i') \<Longrightarrow> Q (xs ! i')) \<Longrightarrow> Q (filter P xs ! i)"
   by (metis (lifting) in_set_conv_nth set_filter mem_Collect_eq)
 
 lemma nth_partition: "i < length xs \<Longrightarrow>
   (\<And>i'. i' < length (filter P xs) \<Longrightarrow> Q (filter P xs ! i')) \<Longrightarrow>
   (\<And>i'. i' < length (filter (Not \<circ> P) xs) \<Longrightarrow> Q (filter (Not \<circ> P) xs ! i')) \<Longrightarrow> Q (xs ! i)"
   by (metis (no_types, lifting) in_set_conv_nth set_filter mem_Collect_eq comp_apply)
 
 lemma qtable_bin_join:
   assumes "qtable n A P Q1 X" "qtable n B P Q2 Y" "\<not> b \<Longrightarrow> B \<subseteq> A" "C = A \<union> B"
     "\<And>x. wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> P (restrict A x) \<and> P (restrict B x)"
     "\<And>x. b \<Longrightarrow> wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> Q x \<longleftrightarrow> Q1 (restrict A x) \<and> Q2 (restrict B x)"
     "\<And>x. \<not> b \<Longrightarrow> wf_tuple n C x \<Longrightarrow> P x \<Longrightarrow> Q x \<longleftrightarrow> Q1 (restrict A x) \<and> \<not> Q2 (restrict B x)"
   shows "qtable n C P Q (bin_join n A X b B Y)"
   using qtable_join[OF assms] bin_join_table[of n A X B Y b] assms(1,2)
   by (auto simp add: qtable_def)
 
 lemma restrict_update: "y \<notin> A \<Longrightarrow> y < length x \<Longrightarrow> restrict A (x[y:=z]) = restrict A x"
   unfolding restrict_def by (auto simp add: nth_list_update)
 
 lemma qtable_assign:
   assumes "qtable n A P Q X"
     "y < n" "insert y A = A'" "y \<notin> A"
     "\<And>x'. wf_tuple n A' x' \<Longrightarrow> P x' \<Longrightarrow> P (restrict A x')"
     "\<And>x. wf_tuple n A x \<Longrightarrow> P x \<Longrightarrow> Q x \<Longrightarrow> Q' (x[y:=Some (f x)])"
     "\<And>x'. wf_tuple n A' x' \<Longrightarrow> P x' \<Longrightarrow> Q' x' \<Longrightarrow> Q (restrict A x') \<and> x' ! y = Some (f (restrict A x'))"
   shows "qtable n A' P Q' ((\<lambda>x. x[y:=Some (f x)]) ` X)" (is "qtable _ _ _ _ ?Y")
 proof (rule qtableI)
   from assms(1) have "table n A X" unfolding qtable_def by simp
   then show "table n A' ?Y"
     unfolding table_def wf_tuple_def using assms(2,3)
     by (auto simp: nth_list_update)
 next
   fix x'
   assume "x' \<in> ?Y" "wf_tuple n A' x'" "P x'"
   then obtain x where "x \<in> X" and x'_eq: "x' = x[y:=Some (f x)]" by blast
   then have "wf_tuple n A x"
     using assms(1) unfolding qtable_def table_def by blast
   then have "y < length x" using assms(2) by (simp add: wf_tuple_def)
   with \<open>wf_tuple n A x\<close> have "restrict A x' = x"
     unfolding x'_eq by (simp add: restrict_update[OF assms(4)] restrict_idle)
   with \<open>wf_tuple n A' x'\<close> \<open>P x'\<close> have "P x"
     using assms(5) by blast
   with \<open>wf_tuple n A x\<close> \<open>x \<in> X\<close> have "Q x"
     using assms(1) by (elim in_qtableE)
   with \<open>wf_tuple n A x\<close> \<open>P x\<close> show "Q' x'"
     unfolding x'_eq by (rule assms(6))
 next
   fix x'
   assume "wf_tuple n A' x'" "P x'" "Q' x'"
   then have "wf_tuple n A (restrict A x')"
     using assms(3) by (auto intro!: wf_tuple_restrict_simple)
   moreover have "P (restrict A x')"
     using \<open>wf_tuple n A' x'\<close> \<open>P x'\<close> by (rule assms(5))
   moreover have "Q (restrict A x')" and y: "x' ! y = Some (f (restrict A x'))"
     using \<open>wf_tuple n A' x'\<close> \<open>P x'\<close> \<open>Q' x'\<close> by (auto dest!: assms(7))
   ultimately have "restrict A x' \<in> X" by (intro in_qtableI[OF assms(1)])
   moreover have "x' = (restrict A x')[y:=Some (f (restrict A x'))]"
     using y assms(2,3) \<open>wf_tuple n A (restrict A x')\<close> \<open>wf_tuple n A' x'\<close>
     by (auto simp: list_eq_iff_nth_eq wf_tuple_def nth_list_update nth_restrict)
   ultimately show "x' \<in> ?Y" by simp
 qed
 
 lemma sat_the_update: "y \<notin> fv \<phi> \<Longrightarrow> Formula.sat \<sigma> V (map the (x[y:=z])) i \<phi> = Formula.sat \<sigma> V (map the x) i \<phi>"
   by (rule sat_fv_cong) (metis map_update nth_list_update_neq)
 
 lemma progress_constraint: "progress \<sigma> P (formula_of_constraint c) j = j"
   by (induction rule: formula_of_constraint.induct) simp_all
 
 lemma qtable_filter:
   assumes "qtable n A P Q X"
     "\<And>x. wf_tuple n A x \<Longrightarrow> P x \<Longrightarrow> Q x \<and> R x \<longleftrightarrow> Q' x"
   shows "qtable n A P Q' (Set.filter R X)" (is "qtable _ _ _ _ ?Y")
 proof (rule qtableI)
   from assms(1) have "table n A X"
     unfolding qtable_def by simp
   then show "table n A ?Y"
     unfolding table_def wf_tuple_def by simp
 next
   fix x
   assume "x \<in> ?Y" "wf_tuple n A x" "P x"
   with assms show "Q' x" by (auto elim!: in_qtableE)
 next
   fix x
   assume "wf_tuple n A x" "P x" "Q' x"
   with assms show "x \<in> Set.filter R X" by (auto intro!: in_qtableI)
 qed
 
 lemma eval_constraint_sat_eq: "wf_tuple n A x \<Longrightarrow> fv_trm t1 \<subseteq> A \<Longrightarrow> fv_trm t2 \<subseteq> A \<Longrightarrow>
   \<forall>i\<in>A. i < n \<Longrightarrow> eval_constraint (t1, p, c, t2) x =
     Formula.sat \<sigma> V (map the x) i (formula_of_constraint (t1, p, c, t2))"
   by (induction "(t1, p, c, t2)" rule: formula_of_constraint.induct)
     (simp_all add: meval_trm_eval_trm)
 
 declare progress_le_gen[simp]
 
 definition "wf_envs \<sigma> j P P' V db =
   (dom V = dom P \<and>
    Mapping.keys db = dom P \<union> {p. p \<in> fst ` \<Gamma> \<sigma> j} \<and>
    rel_mapping (\<le>) P P' \<and>
    pred_mapping (\<lambda>i. i \<le> j) P \<and>
    pred_mapping (\<lambda>i. i \<le> Suc j) P' \<and>
    (\<forall>p \<in> Mapping.keys db - dom P. the (Mapping.lookup db p) = [{ts. (p, ts) \<in> \<Gamma> \<sigma> j}]) \<and>
    (\<forall>p \<in> dom P. list_all2 (\<lambda>i X. X = the (V p) i) [the (P p)..<the (P' p)] (the (Mapping.lookup db p))))"
 
 
 lift_definition mk_db :: "(Formula.name \<times> event_data list) set \<Rightarrow> Formula.database" is
   "\<lambda>X p. (if p \<in> fst ` X then Some [{ts. (p, ts) \<in> X}] else None)" .
 
 lemma wf_envs_mk_db: "wf_envs \<sigma> j Map.empty Map.empty Map.empty (mk_db (\<Gamma> \<sigma> j))"
   unfolding wf_envs_def mk_db_def
   by transfer (force split: if_splits simp: image_iff rel_mapping_alt)
 
 lemma wf_envs_update:
   assumes wf_envs: "wf_envs \<sigma> j P P' V db"
     and m_eq: "m = Formula.nfv \<phi>"
     and in_fv: "{0 ..< m} \<subseteq> fv \<phi>"
     and xs: "list_all2 (\<lambda>i. qtable m (Formula.fv \<phi>) (mem_restr UNIV) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>))
       [progress \<sigma> P \<phi> j..<progress \<sigma> P' \<phi> (Suc j)] xs"
   shows "wf_envs \<sigma> j (P(p \<mapsto> progress \<sigma> P \<phi> j)) (P'(p \<mapsto> progress \<sigma> P' \<phi> (Suc j)))
     (V(p \<mapsto> \<lambda>i. {v. length v = m \<and> Formula.sat \<sigma> V v i \<phi>}))
     (Mapping.update p (map (image (map the)) xs) db)"
   unfolding wf_envs_def
 proof (intro conjI ballI, goal_cases)
   case 3
   from assms show ?case
     by (auto simp: wf_envs_def pred_mapping_alt progress_le progress_mono_gen
         intro!: rel_mapping_map_upd)
 next
   case (6 p')
   with assms show ?case by (cases "p' \<in> dom P") (auto simp: wf_envs_def lookup_update')
 next
   case (7 p')
   from xs in_fv have "list_all2 (\<lambda>x y. map the ` y = {v. length v = m \<and> Formula.sat \<sigma> V v x \<phi>})
       [progress \<sigma> P \<phi> j..<progress \<sigma> P' \<phi> (Suc j)] xs"
     by (elim list.rel_mono_strong) (auto 0 3 simp: wf_tuple_def nth_append
       elim!: in_qtableE in_qtableI intro!: image_eqI[where x="map Some _"])
   moreover have "list_all2 (\<lambda>i X. X = the (V p') i) [the (P p')..<the (P' p')] (the (Mapping.lookup db p'))"
     if "p \<noteq> p'"
   proof -
     from that 7 have "p' \<in> dom P" by simp
     with wf_envs show ?thesis by (simp add: wf_envs_def)
   qed
   ultimately show ?case
     by (simp add: list.rel_map image_iff lookup_update')
 qed (use assms in \<open>auto simp: wf_envs_def\<close>)
 
 lemma wf_envs_P_simps[simp]:
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> pred_mapping (\<lambda>i. i \<le> j) P"
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> pred_mapping (\<lambda>i. i \<le> Suc j) P'"
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> rel_mapping (\<le>) P P'"
   unfolding wf_envs_def by auto
 
 lemma wf_envs_progress_le[simp]:
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> progress \<sigma> P \<phi> j \<le> j"
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> progress \<sigma> P' \<phi> (Suc j) \<le> Suc j"
   unfolding wf_envs_def by auto
 
 lemma wf_envs_progress_regex_le[simp]:
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> progress_regex \<sigma> P r j \<le> j"
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> progress_regex \<sigma> P' r (Suc j) \<le> Suc j"
   unfolding wf_envs_def by (auto simp: progress_regex_le)
 
 lemma wf_envs_progress_mono[simp]:
    "wf_envs \<sigma> j P P' V db \<Longrightarrow> a \<le> b \<Longrightarrow> progress \<sigma> P \<phi> a \<le> progress \<sigma> P' \<phi> b"
   unfolding wf_envs_def
   by (auto simp: progress_mono_gen)
 
 lemma qtable_wf_tuple_cong: "qtable n A P Q X \<Longrightarrow> A = B \<Longrightarrow> (\<And>v. wf_tuple n A v \<Longrightarrow> P v \<Longrightarrow> Q v = Q' v) \<Longrightarrow> qtable n B P Q' X"
   unfolding qtable_def table_def by blast
 
 lemma (in maux) meval:
   assumes "wf_mformula \<sigma> j P V n R \<phi> \<phi>'" "wf_envs \<sigma> j P P' V db"
   shows "case meval n (\<tau> \<sigma> j) db \<phi> of (xs, \<phi>\<^sub>n) \<Rightarrow> wf_mformula \<sigma> (Suc j) P' V n R \<phi>\<^sub>n \<phi>' \<and>
     list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>'))
     [progress \<sigma> P \<phi>' j..<progress \<sigma> P' \<phi>' (Suc j)] xs"
   using assms
 proof (induction \<phi> arbitrary: db P P' V n R \<phi>')
   case (MRel rel)
   then show ?case
     by (cases rule: wf_mformula.cases)
       (auto simp add: ball_Un intro: wf_mformula.intros table_eq_rel eq_rel_eval_trm
         in_eq_rel qtable_empty qtable_unit_table intro!: qtableI)
 next
   case (MPred e ts)
   then show ?case
   proof (cases "e \<in> dom P")
     case True
     with MPred(2) have "e \<in> Mapping.keys db" "e \<in> dom P'" "e \<in> dom V"
       "list_all2 (\<lambda>i X. X = the (V e) i) [the (P e)..<the (P' e)]
          (the (Mapping.lookup db e))" unfolding wf_envs_def rel_mapping_alt by blast+
     with MPred(1) True show ?thesis
       by (cases rule: wf_mformula.cases)
         (fastforce intro!: wf_mformula.Pred qtableI bexI[where P="\<lambda>x. _ = tabulate x 0 n", OF refl]
         elim!: list.rel_mono_strong bexI[rotated] dest: ex_match
         simp: list.rel_map table_def match_wf_tuple in_these_eq match_eval_trm image_iff
           list.map_comp keys_dom_lookup)
   next
     note MPred(1)
     moreover
     case False
     moreover
     from False MPred(2) have "e \<notin> dom P'" "e \<notin> dom V"
       unfolding wf_envs_def rel_mapping_alt by auto
     moreover
     from False MPred(2) have *: "e \<in> fst ` \<Gamma> \<sigma> j \<longleftrightarrow> e \<in> Mapping.keys db"
       unfolding wf_envs_def by auto
     from False MPred(2) have
       "e \<in> Mapping.keys db \<Longrightarrow> Mapping.lookup db e = Some [{ts. (e, ts) \<in> \<Gamma> \<sigma> j}]"
       unfolding wf_envs_def keys_dom_lookup by (metis Diff_iff domD option.sel)
     with * have "(case Mapping.lookup db e of None \<Rightarrow> [{}] | Some xs \<Rightarrow> xs) = [{ts. (e, ts) \<in> \<Gamma> \<sigma> j}]"
       by (cases "e \<in> fst ` \<Gamma> \<sigma> j") (auto simp: image_iff keys_dom_lookup split: option.splits)
     ultimately show ?thesis
       by (cases rule: wf_mformula.cases)
         (fastforce intro!: wf_mformula.Pred qtableI bexI[where P="\<lambda>x. _ = tabulate x 0 n", OF refl]
         elim!: list.rel_mono_strong bexI[rotated] dest: ex_match
         simp: list.rel_map table_def match_wf_tuple in_these_eq match_eval_trm image_iff list.map_comp)
   qed
 next
   case (MLet p m \<phi>1 \<phi>2)
   from MLet.prems(1) obtain \<phi>1' \<phi>2' where Let: "\<phi>' = Formula.Let p \<phi>1' \<phi>2'" and
     1: "wf_mformula \<sigma> j P V m UNIV \<phi>1 \<phi>1'" and
     fv: "m = Formula.nfv \<phi>1'" "{0..<m} \<subseteq> fv \<phi>1'" and
     2: "wf_mformula \<sigma> j (P(p \<mapsto> progress \<sigma> P \<phi>1' j))
       (V(p \<mapsto> \<lambda>i. {v. length v = m \<and> Formula.sat \<sigma> V v i \<phi>1'}))
       n R \<phi>2 \<phi>2'"
     by (cases rule: wf_mformula.cases) auto
   obtain xs \<phi>1_new where e1: "meval m (\<tau> \<sigma> j) db \<phi>1 = (xs, \<phi>1_new)" and
       wf1: "wf_mformula \<sigma> (Suc j) P' V m UNIV \<phi>1_new \<phi>1'" and
       res1: "list_all2 (\<lambda>i. qtable m (fv \<phi>1') (mem_restr UNIV) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>1'))
        [progress \<sigma> P \<phi>1' j..<progress \<sigma> P' \<phi>1' (Suc j)] xs"
     using MLet(1)[OF 1(1) MLet.prems(2)] by (auto simp: eqTrueI[OF mem_restr_UNIV, abs_def])
   from MLet(2)[OF 2 wf_envs_update[OF MLet.prems(2) fv res1]] wf1 e1 fv
   show ?case unfolding Let
     by (auto simp: fun_upd_def intro!: wf_mformula.Let)
 next
   case (MAnd A_\<phi> \<phi> pos A_\<psi> \<psi> buf)
   from MAnd.prems show ?case
     by (cases rule: wf_mformula.cases)
       (auto simp: sat_the_restrict simp del: bin_join.simps
         dest!: MAnd.IH split: if_splits prod.splits intro!: wf_mformula.And qtable_bin_join
         elim: mbuf2_take_add'(1) list.rel_mono_strong[OF mbuf2_take_add'(2)])
 next
   case (MAndAssign \<phi> conf)
   from MAndAssign.prems obtain \<phi>'' x t \<psi>'' where
     wf_envs: "wf_envs \<sigma> j P P' V db" and
     \<phi>'_eq: "\<phi>' = formula.And \<phi>'' \<psi>''" and
     wf_\<phi>: "wf_mformula \<sigma> j P V n R \<phi> \<phi>''" and
     "x < n" and
     "x \<notin> fv \<phi>''" and
     fv_t_subset: "fv_trm t \<subseteq> fv \<phi>''" and
     conf: "(x, t) = conf" and
     \<psi>''_eqs: "\<psi>'' = formula.Eq (trm.Var x) t \<or> \<psi>'' = formula.Eq t (trm.Var x)"
     by (cases rule: wf_mformula.cases)
   from wf_\<phi> wf_envs obtain xs \<phi>\<^sub>n where
     meval_eq: "meval n (\<tau> \<sigma> j) db \<phi> = (xs, \<phi>\<^sub>n)" and
     wf_\<phi>\<^sub>n: "wf_mformula \<sigma> (Suc j) P' V n R \<phi>\<^sub>n \<phi>''" and
     xs: "list_all2 (\<lambda>i. qtable n (fv \<phi>'') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>''))
         [progress \<sigma> P \<phi>'' j..<progress \<sigma> P' \<phi>'' (Suc j)] xs"
     by (auto dest!: MAndAssign.IH)
   have progress_eqs:
       "progress \<sigma> P \<phi>' j = progress \<sigma> P \<phi>'' j"
       "progress \<sigma> P' \<phi>' (Suc j) = progress \<sigma> P' \<phi>'' (Suc j)"
     using \<psi>''_eqs wf_envs_progress_le[OF wf_envs] by (auto simp: \<phi>'_eq)
 
   show ?case proof (simp add: meval_eq, intro conjI)
     show "wf_mformula \<sigma> (Suc j) P' V n R (MAndAssign \<phi>\<^sub>n conf) \<phi>'"
       unfolding \<phi>'_eq
       by (rule wf_mformula.AndAssign) fact+
   next
     show "list_all2 (\<lambda>i. qtable n (fv \<phi>') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>'))
         [progress \<sigma> P \<phi>' j..<progress \<sigma> P' \<phi>' (Suc j)] (map ((`) (eval_assignment conf)) xs)"
       unfolding list.rel_map progress_eqs conf[symmetric] eval_assignment.simps
       using xs
     proof (rule list.rel_mono_strong)
       fix i X
       assume qtable: "qtable n (fv \<phi>'') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>'') X"
       then show "qtable n (fv \<phi>') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<phi>')
           ((\<lambda>y. y[x := Some (meval_trm t y)]) ` X)"
       proof (rule qtable_assign)
         show "x < n" by fact
         show "insert x (fv \<phi>'') = fv \<phi>'"
           using \<psi>''_eqs fv_t_subset by (auto simp: \<phi>'_eq)
         show "x \<notin> fv \<phi>''" by fact
       next
         fix v
         assume wf_v: "wf_tuple n (fv \<phi>') v" and "mem_restr R v"
         then show "mem_restr R (restrict (fv \<phi>'') v)" by simp
 
         assume sat: "Formula.sat \<sigma> V (map the v) i \<phi>'"
         then have A: "Formula.sat \<sigma> V (map the (restrict (fv \<phi>'') v)) i \<phi>''" (is ?A)
           by (simp add: \<phi>'_eq sat_the_restrict)
         have "map the v ! x = Formula.eval_trm (map the v) t"
           using sat \<psi>''_eqs by (auto simp: \<phi>'_eq)
         also have "... = Formula.eval_trm (map the (restrict (fv \<phi>'') v)) t"
           using fv_t_subset by (auto simp: map_the_restrict intro!: eval_trm_fv_cong)
         finally have "map the v ! x = meval_trm t (restrict (fv \<phi>'') v)"
           using meval_trm_eval_trm[of n "fv \<phi>''" "restrict (fv \<phi>'') v" t]
             fv_t_subset wf_v wf_mformula_wf_set[unfolded wf_set_def, OF wf_\<phi>]
           by (fastforce simp: \<phi>'_eq intro!: wf_tuple_restrict)
         then have B: "v ! x = Some (meval_trm t (restrict (fv \<phi>'') v))" (is ?B)
           using \<psi>''_eqs wf_v \<open>x < n\<close> by (auto simp: wf_tuple_def \<phi>'_eq)
         from A B show "?A \<and> ?B" ..
       next
         fix v
         assume wf_v: "wf_tuple n (fv \<phi>'') v" and "mem_restr R v"
           and sat: "Formula.sat \<sigma> V (map the v) i \<phi>''"
         let ?v = "v[x := Some (meval_trm t v)]"
         from sat have A: "Formula.sat \<sigma> V (map the ?v) i \<phi>''"
           using \<open>x \<notin> fv \<phi>''\<close> by (simp add: sat_the_update)
         have "y \<in> fv_trm t \<Longrightarrow> x \<noteq> y" for y
           using fv_t_subset \<open>x \<notin> fv \<phi>''\<close> by auto
         then have B: "Formula.sat \<sigma> V (map the ?v) i \<psi>''"
           using \<psi>''_eqs meval_trm_eval_trm[of n "fv \<phi>''" v t] \<open>x < n\<close>
             fv_t_subset wf_v wf_mformula_wf_set[unfolded wf_set_def, OF wf_\<phi>]
           by (auto simp: wf_tuple_def map_update intro!: eval_trm_fv_cong)
         from A B show "Formula.sat \<sigma> V (map the ?v) i \<phi>'"
           by (simp add: \<phi>'_eq)
       qed
     qed
   qed
 next
   case (MAndRel \<phi> conf)
   from MAndRel.prems show ?case
     by (cases rule: wf_mformula.cases)
       (auto simp: progress_constraint progress_le list.rel_map fv_formula_of_constraint
         Un_absorb2 wf_mformula_wf_set[unfolded wf_set_def] split: prod.splits
         dest!: MAndRel.IH[where db=db and P=P and P'=P'] eval_constraint_sat_eq[THEN iffD2]
         intro!: wf_mformula.AndRel
         elim!: list.rel_mono_strong qtable_filter eval_constraint_sat_eq[THEN iffD1])
 next
   case (MAnds A_pos A_neg l buf)
   note mbufn_take.simps[simp del] mbufn_add.simps[simp del] mmulti_join.simps[simp del]
 
   from MAnds.prems obtain pos neg l' where
     wf_l: "list_all2 (wf_mformula \<sigma> j P V n R) l (pos @ map remove_neg neg)" and
     wf_buf: "wf_mbufn (progress \<sigma> P (formula.Ands l') j) (map (\<lambda>\<psi>. progress \<sigma> P \<psi> j) (pos @ map remove_neg neg))
       (map (\<lambda>\<psi> i. qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>)) (pos @ map remove_neg neg)) buf" and
     posneg: "(pos, neg) = partition safe_formula l'" and
     "pos \<noteq> []" and
     safe_neg: "list_all safe_formula (map remove_neg neg)" and
     A_eq: "A_pos = map fv pos" "A_neg = map fv neg" and
     fv_subset: "\<Union> (set A_neg) \<subseteq> \<Union> (set A_pos)" and
     "\<phi>' = Formula.Ands l'"
     by (cases rule: wf_mformula.cases) simp
   have progress_eq: "progress \<sigma> P' (formula.Ands l') (Suc j) =
       Mini (progress \<sigma> P (formula.Ands l') j) (map (\<lambda>\<psi>. progress \<sigma> P' \<psi> (Suc j)) (pos @ map remove_neg neg))"
     using \<open>pos \<noteq> []\<close> posneg
     by (auto simp: Mini_def image_Un[symmetric] Collect_disj_eq[symmetric] intro!: arg_cong[where f=Min])
 
   have join_ok: "qtable n (\<Union> (fv ` set l')) (mem_restr R)
         (\<lambda>v. list_all (Formula.sat \<sigma> V (map the v) k) l')
         (mmulti_join n A_pos A_neg L)"
     if args_ok: "list_all2 (\<lambda>x. qtable n (fv x) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) k x))
         (pos @ map remove_neg neg) L"
     for k L
   proof (rule qtable_mmulti_join)
     let ?ok = "\<lambda>A Qi X. qtable n A (mem_restr R) Qi X \<and> wf_set n A"
     let ?L_pos = "take (length A_pos) L"
     let ?L_neg = "drop (length A_pos) L"
     have 1: "length pos \<le> length L"
       using args_ok by (auto dest!: list_all2_lengthD)
     show "list_all3 ?ok A_pos (map (\<lambda>\<psi> v. Formula.sat \<sigma> V (map the v) k \<psi>) pos) ?L_pos"
       using args_ok wf_l unfolding A_eq
       by (auto simp add: list_all3_conv_all_nth list_all2_conv_all_nth nth_append
           split: if_splits intro!: wf_mformula_wf_set[of \<sigma> j P V n R]
           dest: order.strict_trans2[OF _ 1])
     from args_ok have prems_neg: "list_all2 (\<lambda>\<psi>. qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) k (remove_neg \<psi>))) neg ?L_neg"
       by (auto simp: A_eq list_all2_append1 list.rel_map)
     show "list_all3 ?ok A_neg (map (\<lambda>\<psi> v. Formula.sat \<sigma> V (map the v) k (remove_neg \<psi>)) neg) ?L_neg"
       using prems_neg wf_l unfolding A_eq
       by (auto simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length nth_append less_diff_conv
           split: if_splits intro!: wf_mformula_wf_set[of \<sigma> j P V n R _ "remove_neg _", simplified])
     show "\<Union>(fv ` set l') = \<Union>(set A_pos)"
       using fv_subset posneg unfolding A_eq by auto
     show "L = take (length A_pos) L @ drop (length A_pos) L" by simp
     show "A_pos \<noteq> []" using \<open>pos \<noteq> []\<close> A_eq by simp
 
     fix x :: "event_data tuple"
     assume "wf_tuple n (\<Union> (fv ` set l')) x" and "mem_restr R x"
     then show "list_all (\<lambda>A. mem_restr R (restrict A x)) A_pos"
       and "list_all (\<lambda>A. mem_restr R (restrict A x)) A_neg"
       by (simp_all add: list.pred_set)
 
     have "list_all Formula.is_Neg neg"
       using posneg safe_neg
       by (auto 0 3 simp add: list.pred_map elim!: list.pred_mono_strong
           intro: formula.exhaust[of \<psi> "Formula.is_Neg \<psi>" for \<psi>])
     then have "list_all (\<lambda>\<psi>. Formula.sat \<sigma> V (map the v) i (remove_neg \<psi>) \<longleftrightarrow>
       \<not> Formula.sat \<sigma> V (map the v) i \<psi>) neg" for v i
       by (fastforce simp: Formula.is_Neg_def elim!: list.pred_mono_strong)
     then show "list_all (Formula.sat \<sigma> V (map the x) k) l' =
        (list_all2 (\<lambda>A Qi. Qi (restrict A x)) A_pos
          (map (\<lambda>\<psi> v. Formula.sat \<sigma> V (map the v) k \<psi>) pos) \<and>
         list_all2 (\<lambda>A Qi. \<not> Qi (restrict A x)) A_neg
          (map (\<lambda>\<psi> v. Formula.sat \<sigma> V (map the v) k
                        (remove_neg \<psi>))
            neg))"
       using posneg
       by (auto simp add: A_eq list_all2_conv_all_nth list_all_length sat_the_restrict
           elim: nth_filter nth_partition[where P=safe_formula and Q="Formula.sat _ _ _ _"])
   qed fact
 
   from MAnds.prems(2) show ?case
     unfolding \<open>\<phi>' = Formula.Ands l'\<close>
     by (auto 0 3 simp add: list.rel_map progress_eq map2_map_map list_all3_map
         list_all3_list_all2_conv list.pred_map
         simp del: set_append map_append progress_simps split: prod.splits
         intro!: wf_mformula.Ands[OF _ _ posneg \<open>pos \<noteq> []\<close> safe_neg A_eq fv_subset]
         list.rel_mono_strong[OF wf_l] wf_mbufn_add[OF wf_buf]
         list.rel_flip[THEN iffD1, OF list.rel_mono_strong, OF wf_l]
         list.rel_refl join_ok[unfolded list.pred_set]
         dest!: MAnds.IH[OF _ _ MAnds.prems(2), rotated]
         elim!: wf_mbufn_take list_all2_appendI
         elim: mbufn_take_induct[OF _ wf_mbufn_add[OF wf_buf]])
 next
   case (MOr \<phi> \<psi> buf)
   from MOr.prems show ?case
     by (cases rule: wf_mformula.cases)
       (auto dest!: MOr.IH split: if_splits prod.splits intro!: wf_mformula.Or qtable_union
         elim: mbuf2_take_add'(1) list.rel_mono_strong[OF mbuf2_take_add'(2)])
 next
   case (MNeg \<phi>)
   have *: "qtable n {} (mem_restr R) (\<lambda>v. P v) X \<Longrightarrow>
     \<not> qtable n {} (mem_restr R) (\<lambda>v. \<not> P v) empty_table \<Longrightarrow> x \<in> X \<Longrightarrow> False" for P x X
     using nullary_qtable_cases qtable_unit_empty_table by fastforce
   from MNeg.prems show ?case
     by (cases rule: wf_mformula.cases)
       (auto 0 4 intro!: wf_mformula.Neg dest!: MNeg.IH
         simp add: list.rel_map
         dest: nullary_qtable_cases qtable_unit_empty_table intro!: qtable_empty_unit_table
         elim!: list.rel_mono_strong elim: *)
 next
   case (MExists \<phi>)
   from MExists.prems show ?case
     by (cases rule: wf_mformula.cases)
       (force simp: list.rel_map fvi_Suc sat_fv_cong nth_Cons'
         intro!: wf_mformula.Exists dest!: MExists.IH qtable_project_fv
         elim!: list.rel_mono_strong table_fvi_tl qtable_cong sat_fv_cong[THEN iffD1, rotated -1]
         split: if_splits)+
 next
   case (MAgg g0 y \<omega> b f \<phi>)
   from MAgg.prems show ?case
     using wf_mformula_wf_set[OF MAgg.prems(1), unfolded wf_set_def]
     by (cases rule: wf_mformula.cases)
       (auto 0 3 simp add: list.rel_map simp del: sat.simps fvi.simps split: prod.split
         intro!: wf_mformula.Agg qtable_eval_agg dest!: MAgg.IH elim!: list.rel_mono_strong)
 next
   case (MPrev I \<phi> first buf nts)
   from MPrev.prems show ?case
   proof (cases rule: wf_mformula.cases)
     case (Prev \<psi>)
     let ?xs = "fst (meval n (\<tau> \<sigma> j) db \<phi>)"
     let ?\<phi> = "snd (meval n (\<tau> \<sigma> j) db \<phi>)"
     let ?ls = "fst (mprev_next I (buf @ ?xs) (nts @ [\<tau> \<sigma> j]))"
     let ?rs = "fst (snd (mprev_next I (buf @ ?xs) (nts @ [\<tau> \<sigma> j])))"
     let ?ts = "snd (snd (mprev_next I (buf @ ?xs) (nts @ [\<tau> \<sigma> j])))"
     let ?P = "\<lambda>i X. qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>) X"
     let ?min = "min (progress \<sigma> P' \<psi> (Suc j)) (Suc j - 1)"
     from Prev MPrev.IH[OF _ MPrev.prems(2), of n R \<psi>] have IH: "wf_mformula \<sigma> (Suc j) P' V n R ?\<phi> \<psi>" and
       "list_all2 ?P [progress \<sigma> P \<psi> j..<progress \<sigma> P' \<psi> (Suc j)] ?xs" by auto
     with Prev(4,5) MPrev.prems(2) have "list_all2 (\<lambda>i X. if mem (\<tau> \<sigma> (Suc i) - \<tau> \<sigma> i) I then ?P i X else X = empty_table)
         [min (progress \<sigma> P \<psi> j) (j - 1)..<?min] ?ls \<and>
        list_all2 ?P [?min..<progress \<sigma> P' \<psi> (Suc j)] ?rs \<and>
        list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [?min..<Suc j] ?ts"
       by (intro mprev) (auto intro!: list_all2_upt_append list_all2_appendI order.trans[OF min.cobounded1])
     moreover have "min (Suc (progress \<sigma> P \<psi> j)) j = Suc (min (progress \<sigma> P \<psi> j) (j-1))" if "j > 0"
       using that by auto
     ultimately show ?thesis using Prev(1,3) MPrev.prems(2) IH
       by (auto simp: map_Suc_upt[symmetric] upt_Suc[of 0] list.rel_map qtable_empty_iff
           simp del: upt_Suc elim!: wf_mformula.Prev list.rel_mono_strong
           split: prod.split if_split_asm)
   qed
 next
   case (MNext I \<phi> first nts)
   from MNext.prems show ?case
   proof (cases rule: wf_mformula.cases)
     case (Next \<psi>)
 
     have min[simp]:
       "min (progress \<sigma> P \<psi> j - Suc 0) (j - Suc 0) = progress \<sigma> P \<psi> j - Suc 0"
       "min (progress \<sigma> P' \<psi> (Suc j) - Suc 0) j = progress \<sigma> P' \<psi> (Suc j) - Suc 0"
       using wf_envs_progress_le[OF MNext.prems(2), of \<psi>] by auto
 
     let ?xs = "fst (meval n (\<tau> \<sigma> j) db \<phi>)"
     let ?ys = "case (?xs, first) of (_ # xs, True) \<Rightarrow> xs | _ \<Rightarrow> ?xs"
     let ?\<phi> = "snd (meval n (\<tau> \<sigma> j) db \<phi>)"
     let ?ls = "fst (mprev_next I ?ys (nts @ [\<tau> \<sigma> j]))"
     let ?rs = "fst (snd (mprev_next I ?ys (nts @ [\<tau> \<sigma> j])))"
     let ?ts = "snd (snd (mprev_next I ?ys (nts @ [\<tau> \<sigma> j])))"
     let ?P = "\<lambda>i X. qtable n (fv \<psi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i \<psi>) X"
     let ?min = "min (progress \<sigma> P' \<psi> (Suc j) - 1) (Suc j - 1)"
     from Next MNext.IH[OF _ MNext.prems(2), of n R \<psi>] have IH: "wf_mformula \<sigma> (Suc j) P' V  n R ?\<phi> \<psi>"
       "list_all2 ?P [progress \<sigma> P \<psi> j..<progress \<sigma> P' \<psi> (Suc j)] ?xs" by auto
     with Next have "list_all2 (\<lambda>i X. if mem (\<tau> \<sigma> (Suc i) - \<tau> \<sigma> i) I then ?P (Suc i) X else X = empty_table)
         [progress \<sigma> P \<psi> j - 1..<?min] ?ls \<and>
        list_all2 ?P [Suc ?min..<progress \<sigma> P' \<psi> (Suc j)] ?rs \<and>
        list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [?min..<Suc j] ?ts" if "progress \<sigma> P \<psi> j < progress \<sigma> P' \<psi> (Suc j)"
       using that wf_envs_progress_le[OF MNext.prems(2), of \<psi>]
       by (intro mnext) (auto simp: list_all2_Cons2 upt_eq_Cons_conv
           intro!: list_all2_upt_append list_all2_appendI split: list.splits)
     then show ?thesis using wf_envs_progress_le[OF MNext.prems(2), of \<psi>]
       wf_envs_progress_mono[OF MNext.prems(2), of j "Suc j" \<psi>, simplified] Next IH
       by (cases "progress \<sigma> P' \<psi> (Suc j) > progress \<sigma> P \<psi> j")
         (auto 0 3 simp: qtable_empty_iff le_Suc_eq le_diff_conv
           elim!: wf_mformula.Next list.rel_mono_strong list_all2_appendI
           split: prod.split list.splits if_split_asm)  (* slow 5 sec*)
   qed
 next
   case (MSince args \<phi> \<psi> buf nts aux)
   note sat.simps[simp del]
   from MSince.prems obtain \<phi>'' \<phi>''' \<psi>'' I where Since_eq: "\<phi>' = Formula.Since \<phi>''' I \<psi>''"
     and pos: "if args_pos args then \<phi>''' = \<phi>'' else \<phi>''' = Formula.Neg \<phi>''"
     and pos_eq: "safe_formula \<phi>''' = args_pos args"
     and \<phi>: "wf_mformula \<sigma> j P V n R \<phi> \<phi>''"
     and \<psi>: "wf_mformula \<sigma> j P V n R \<psi> \<psi>''"
     and fvi_subset: "Formula.fv \<phi>'' \<subseteq> Formula.fv \<psi>''"
     and buf: "wf_mbuf2' \<sigma> P V j n R \<phi>'' \<psi>'' buf"
     and nts: "wf_ts \<sigma> P j \<phi>'' \<psi>'' nts"
     and aux: "wf_since_aux \<sigma> V R args \<phi>'' \<psi>'' aux (progress \<sigma> P (Formula.Since \<phi>''' I \<psi>'') j)"
     and args_ivl: "args_ivl args = I"
     and args_n: "args_n args = n"
     and args_L: "args_L args = Formula.fv \<phi>''"
     and args_R: "args_R args = Formula.fv \<psi>''"
     by (cases rule: wf_mformula.cases) (auto)
   have \<phi>''': "Formula.fv \<phi>''' = Formula.fv \<phi>''" "progress \<sigma> P \<phi>''' j = progress \<sigma> P \<phi>'' j"
     "progress \<sigma> P' \<phi>''' j = progress \<sigma> P' \<phi>'' j" for j
     using pos by (simp_all split: if_splits)
   from MSince.prems(2) have nts_snoc: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i)
     [min (progress \<sigma> P \<phi>'' j) (progress \<sigma> P \<psi>'' j)..<Suc j] (nts @ [\<tau> \<sigma> j])"
     using nts unfolding wf_ts_def
     by (auto simp add: wf_envs_progress_le[THEN min.coboundedI1] intro: list_all2_appendI)
   have update: "wf_since_aux \<sigma> V R args \<phi>'' \<psi>'' (snd (zs, aux')) (progress \<sigma> P' (Formula.Since \<phi>''' I \<psi>'') (Suc j)) \<and>
     list_all2 (\<lambda>i. qtable n (Formula.fv \<phi>''' \<union> Formula.fv \<psi>'') (mem_restr R)
       (\<lambda>v. Formula.sat \<sigma> V (map the v) i (Formula.Since \<phi>''' I \<psi>'')))
       [progress \<sigma> P (Formula.Since \<phi>''' I \<psi>'') j..<progress \<sigma> P' (Formula.Since \<phi>''' I \<psi>'') (Suc j)] (fst (zs, aux'))"
     if eval_\<phi>: "fst (meval n (\<tau> \<sigma> j) db \<phi>) = xs"
       and eval_\<psi>: "fst (meval n (\<tau> \<sigma> j) db \<psi>) = ys"
       and eq: "mbuf2t_take (\<lambda>r1 r2 t (zs, aux).
         case update_since args r1 r2 t aux of (z, x) \<Rightarrow> (zs @ [z], x))
         ([], aux) (mbuf2_add xs ys buf) (nts @ [\<tau> \<sigma> j]) = ((zs, aux'), buf', nts')"
     for xs ys zs aux' buf' nts'
     unfolding progress_simps \<phi>'''
   proof (rule mbuf2t_take_add_induct'[where j=j and j'="Suc j" and z'="(zs, aux')",
       OF eq wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc],
       goal_cases xs ys _ base step)
     case xs
     then show ?case
       using MSince.IH(1)[OF \<phi> MSince.prems(2)] eval_\<phi> by auto
   next
     case ys
     then show ?case
       using MSince.IH(2)[OF \<psi> MSince.prems(2)] eval_\<psi> by auto
   next
     case base
     then show ?case
       using aux by (simp add: \<phi>''')
   next
     case (step k X Y z)
     then show ?case
       using fvi_subset pos
       by (auto 0 3 simp: args_ivl args_n args_L args_R Un_absorb1
           elim!: update_since(1) list_all2_appendI dest!: update_since(2)
           split: prod.split if_splits)
   qed simp
   with MSince.IH(1)[OF \<phi> MSince.prems(2)] MSince.IH(2)[OF \<psi> MSince.prems(2)] show ?case
     by (auto 0 3 simp: Since_eq split: prod.split
         intro: wf_mformula.Since[OF _ _ pos pos_eq args_ivl args_n args_L args_R fvi_subset]
         elim: mbuf2t_take_add'(1)[OF _ wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc]
               mbuf2t_take_add'(2)[OF _ wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc])
 next
   case (MUntil args \<phi> \<psi> buf nts aux)
   note sat.simps[simp del] progress_simps[simp del]
   from MUntil.prems obtain \<phi>'' \<phi>''' \<psi>'' I where Until_eq: "\<phi>' = Formula.Until \<phi>''' I \<psi>''"
     and pos: "if args_pos args then \<phi>''' = \<phi>'' else \<phi>''' = Formula.Neg \<phi>''"
     and pos_eq: "safe_formula \<phi>''' = args_pos args"
     and \<phi>: "wf_mformula \<sigma> j P V n R \<phi> \<phi>''"
     and \<psi>: "wf_mformula \<sigma> j P V n R \<psi> \<psi>''"
     and fvi_subset: "Formula.fv \<phi>'' \<subseteq> Formula.fv \<psi>''"
     and buf: "wf_mbuf2' \<sigma> P V j n R \<phi>'' \<psi>'' buf"
     and nts: "wf_ts \<sigma> P j \<phi>'' \<psi>'' nts"
     and aux: "wf_until_aux \<sigma> V R args \<phi>'' \<psi>'' aux (progress \<sigma> P (Formula.Until \<phi>''' I \<psi>'') j)"
     and args_ivl: "args_ivl args = I"
     and args_n: "args_n args = n"
     and args_L: "args_L args = Formula.fv \<phi>''"
     and args_R: "args_R args = Formula.fv \<psi>''"
     and length_aux: "progress \<sigma> P (Formula.Until \<phi>''' I \<psi>'') j + length_muaux args aux =
       min (progress \<sigma> P \<phi>'' j) (progress \<sigma> P \<psi>'' j)"
     by (cases rule: wf_mformula.cases) (auto)
   define pos where args_pos: "pos = args_pos args"
   have \<phi>''': "progress \<sigma> P \<phi>''' j = progress \<sigma> P \<phi>'' j"  "progress \<sigma> P' \<phi>''' j = progress \<sigma> P' \<phi>'' j" for j
     using pos by (simp_all add: progress.simps split: if_splits)
   from MUntil.prems(2) have nts_snoc: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i)
     [min (progress \<sigma> P \<phi>'' j) (progress \<sigma> P \<psi>'' j)..<Suc j] (nts @ [\<tau> \<sigma> j])"
     using nts unfolding wf_ts_def
     by (auto simp add: wf_envs_progress_le[THEN min.coboundedI1] intro: list_all2_appendI)
   {
     fix xs ys zs aux' aux'' buf' nts'
     assume eval_\<phi>: "fst (meval n (\<tau> \<sigma> j) db \<phi>) = xs"
       and eval_\<psi>: "fst (meval n (\<tau> \<sigma> j) db \<psi>) = ys"
       and eq1: "mbuf2t_take (add_new_muaux args) aux (mbuf2_add xs ys buf) (nts @ [\<tau> \<sigma> j]) =
         (aux', buf', nts')"
       and eq2: "eval_muaux args (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # _ \<Rightarrow> nt) aux' = (zs, aux'')"
     define ne where "ne \<equiv> progress \<sigma> P (Formula.Until \<phi>''' I \<psi>'') j"
     have update1: "wf_until_aux \<sigma> V R args \<phi>'' \<psi>'' aux' (progress \<sigma> P (Formula.Until \<phi>''' I \<psi>'') j) \<and>
       ne + length_muaux args aux' = min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j))"
       using MUntil.IH(1)[OF \<phi> MUntil.prems(2)] eval_\<phi> MUntil.IH(2)[OF \<psi> MUntil.prems(2)]
         eval_\<psi> nts_snoc nts_snoc length_aux aux fvi_subset
       unfolding \<phi>'''
       by (elim mbuf2t_take_add_induct'[where j'="Suc j", OF eq1 wf_envs_P_simps[OF MUntil.prems(2)] buf])
         (auto simp: args_n args_L args_R ne_def wf_update_until)
     then obtain cur auxlist' where valid_aux': "valid_muaux args cur aux' auxlist'" and
       cur: "cur = (if ne + length auxlist' = 0 then 0 else \<tau> \<sigma> (ne + length auxlist' - 1))" and
       wf_auxlist': "wf_until_auxlist \<sigma> V n R pos \<phi>'' I \<psi>'' auxlist' (progress \<sigma> P (Formula.Until \<phi>''' I \<psi>'') j)"
       unfolding wf_until_aux_def ne_def args_ivl args_n args_pos by auto
     have length_aux': "length_muaux args aux' = length auxlist'"
       using valid_length_muaux[OF valid_aux'] .
     have nts': "wf_ts \<sigma> P' (Suc j) \<phi>'' \<psi>'' nts'"
       using MUntil.IH(1)[OF \<phi> MUntil.prems(2)] eval_\<phi> MUntil.IH(2)[OF \<psi> MUntil.prems(2)]
         MUntil.prems(2) eval_\<psi> nts_snoc
       unfolding wf_ts_def
       by (intro mbuf2t_take_eqD(2)[OF eq1]) (auto intro: wf_mbuf2_add buf[unfolded wf_mbuf2'_def])
     define zs'' where "zs'' = fst (eval_until I (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt) auxlist')"
     define auxlist'' where "auxlist'' = snd (eval_until I (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt) auxlist')"
     have current_w_le: "cur \<le> (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)"
     proof (cases nts')
       case Nil
       have p_le: "min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)) - 1 \<le> j"
         using wf_envs_progress_le[OF MUntil.prems(2)]
         by (auto simp: min_def le_diff_conv)
       then show ?thesis
         unfolding cur conjunct2[OF update1, unfolded length_aux']
         using Nil by auto
     next
       case (Cons nt x)
       have progress_\<phi>''': "progress \<sigma> P' \<phi>'' (Suc j) = progress \<sigma> P' \<phi>''' (Suc j)"
         using pos by (auto simp add: progress.simps split: if_splits)
       have "nt = \<tau> \<sigma> (min (progress \<sigma> P' \<phi>'' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)))"
         using nts'[unfolded wf_ts_def Cons]
         unfolding list_all2_Cons2 upt_eq_Cons_conv by auto
       then show ?thesis
         unfolding cur conjunct2[OF update1, unfolded length_aux'] Cons progress_\<phi>'''
         by (auto split: if_splits list.splits intro!: \<tau>_mono)
     qed
     have valid_aux'': "valid_muaux args cur aux'' auxlist''"
       using valid_eval_muaux[OF valid_aux' current_w_le eq2, of zs'' auxlist'']
       by (auto simp add: args_ivl zs''_def auxlist''_def)
     have length_aux'': "length_muaux args aux'' = length auxlist''"
       using valid_length_muaux[OF valid_aux''] .
     have eq2': "eval_until I (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # _ \<Rightarrow> nt) auxlist' = (zs, auxlist'')"
       using valid_eval_muaux[OF valid_aux' current_w_le eq2, of zs'' auxlist'']
       by (auto simp add: args_ivl zs''_def auxlist''_def)
     have length_aux'_aux'': "length_muaux args aux' = length zs + length_muaux args aux''"
       using eval_until_length[OF eq2'] unfolding length_aux' length_aux'' .
     have "i \<le> progress \<sigma> P' (Formula.Until \<phi>''' I \<psi>'') (Suc j) \<Longrightarrow>
       wf_until_auxlist \<sigma> V n R pos \<phi>'' I \<psi>'' auxlist' i \<Longrightarrow>
       i + length auxlist' = min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)) \<Longrightarrow>
       wf_until_auxlist \<sigma> V n R pos \<phi>'' I \<psi>'' auxlist'' (progress \<sigma> P' (Formula.Until \<phi>''' I \<psi>'') (Suc j)) \<and>
         i + length zs = progress \<sigma> P' (Formula.Until \<phi>''' I \<psi>'') (Suc j) \<and>
         i + length zs + length auxlist'' = min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)) \<and>
         list_all2 (\<lambda>i. qtable n (Formula.fv \<psi>'') (mem_restr R)
           (\<lambda>v. Formula.sat \<sigma> V (map the v) i (Formula.Until (if pos then \<phi>'' else Formula.Neg \<phi>'') I \<psi>'')))
           [i..<i + length zs] zs" for i
       using eq2'
     proof (induction auxlist' arbitrary: zs auxlist'' i)
       case Nil
       then show ?case
         by (auto dest!: antisym[OF progress_Until_le])
     next
       case (Cons a aux')
       obtain t a1 a2 where "a = (t, a1, a2)" by (cases a)
       from Cons.prems(2) have aux': "wf_until_auxlist \<sigma> V n R pos \<phi>'' I \<psi>'' aux' (Suc i)"
         by (rule wf_until_aux_Cons)
       from Cons.prems(2) have 1: "t = \<tau> \<sigma> i"
         unfolding \<open>a = (t, a1, a2)\<close> by (rule wf_until_aux_Cons1)
       from Cons.prems(2) have 3: "qtable n (Formula.fv \<psi>'') (mem_restr R) (\<lambda>v.
         (\<exists>j\<ge>i. j < Suc (i + length aux') \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) I \<and> Formula.sat \<sigma> V (map the v) j \<psi>'' \<and>
         (\<forall>k\<in>{i..<j}. if pos then Formula.sat \<sigma> V (map the v) k \<phi>'' else \<not> Formula.sat \<sigma> V (map the v) k \<phi>''))) a2"
         unfolding \<open>a = (t, a1, a2)\<close> by (rule wf_until_aux_Cons3)
       from Cons.prems(3) have Suc_i_aux': "Suc i + length aux' =
           min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j))"
         by simp
       have "i \<ge> progress \<sigma> P' (Formula.Until \<phi>''' I \<psi>'') (Suc j)"
         if "enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt) \<le> enat t + right I"
         using that nts' unfolding wf_ts_def progress.simps
         by (auto simp add: 1 list_all2_Cons2 upt_eq_Cons_conv \<phi>'''
             intro!: cInf_lower \<tau>_mono elim!: order.trans[rotated] simp del: upt_Suc split: if_splits list.splits)
       moreover
       have "Suc i \<le> progress \<sigma> P' (Formula.Until \<phi>''' I \<psi>'') (Suc j)"
         if "enat t + right I < enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)"
       proof -
         from that obtain m where m: "right I = enat m" by (cases "right I") auto
         have \<tau>_min:  "\<tau> \<sigma> (min j k) = min (\<tau> \<sigma> j) (\<tau> \<sigma> k)" for k
           by (simp add: min_of_mono monoI)
         have le_progress_iff[simp]: "(Suc j) \<le> progress \<sigma> P' \<phi> (Suc j) \<longleftrightarrow> progress \<sigma> P' \<phi> (Suc j) = (Suc j)" for \<phi>
           using wf_envs_progress_le[OF MUntil.prems(2), of \<phi>] by auto
         have min_Suc[simp]: "min j (Suc j) = j" by auto
         let ?X = "{i. \<forall>k. k < Suc j \<and> k \<le>min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)) \<longrightarrow> enat (\<tau> \<sigma> k) \<le> enat (\<tau> \<sigma> i) + right I}"
         let ?min = "min j (min (progress \<sigma> P' \<phi>'' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)))"
         have "\<tau> \<sigma> ?min \<le> \<tau> \<sigma> j"
           by (rule \<tau>_mono) auto
         from m have "?X \<noteq> {}"
           by (auto dest!: \<tau>_mono[of _ "progress \<sigma> P' \<phi>'' (Suc j)" \<sigma>]
               simp: not_le not_less \<phi>''' intro!: exI[of _ "progress \<sigma> P' \<phi>'' (Suc j)"])
         from m show ?thesis
           using that nts' unfolding wf_ts_def progress.simps
           by (intro cInf_greatest[OF \<open>?X \<noteq> {}\<close>])
             (auto simp: 1 \<phi>''' not_le not_less list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq
               simp del: upt_Suc split: list.splits if_splits
               dest!: spec[of _ "?min"] less_le_trans[of "\<tau> \<sigma> i + m" "\<tau> \<sigma> _" "\<tau> \<sigma> _ + m"] less_\<tau>D)
       qed
       moreover have *: "k < progress \<sigma> P' \<psi> (Suc j)" if
         "enat (\<tau> \<sigma> i) + right I < enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)"
         "enat (\<tau> \<sigma> k - \<tau> \<sigma> i) \<le> right I" "\<psi> = \<psi>'' \<or> \<psi> = \<phi>''" for k \<psi>
       proof -
         from that(1,2) obtain m where "right I = enat m"
           "\<tau> \<sigma> i + m < (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)" "\<tau> \<sigma> k - \<tau> \<sigma> i \<le> m"
           by (cases "right I") auto
         with that(3) nts' progress_le[of \<sigma> \<psi>'' "Suc j"] progress_le[of \<sigma> \<phi>'' "Suc j"]
         show ?thesis
           unfolding wf_ts_def le_diff_conv
           by (auto simp: not_le list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq add.commute
               simp del: upt_Suc split: list.splits if_splits dest!: le_less_trans[of "\<tau> \<sigma> k"] less_\<tau>D)
       qed
       ultimately show ?case using Cons.prems Suc_i_aux'[simplified]
         unfolding \<open>a = (t, a1, a2)\<close>
         by (auto simp: \<phi>''' 1 sat.simps upt_conv_Cons dest!:  Cons.IH[OF _ aux' Suc_i_aux']
             simp del: upt_Suc split: if_splits prod.splits intro!: iff_exI qtable_cong[OF 3 refl])
     qed
     thm this
     note wf_aux'' = this[OF wf_envs_progress_mono[OF MUntil.prems(2) le_SucI[OF order_refl]]
       wf_auxlist' conjunct2[OF update1, unfolded ne_def length_aux']]
     have "progress \<sigma> P (formula.Until \<phi>''' I \<psi>'') j + length auxlist' =
       progress \<sigma> P' (formula.Until \<phi>''' I \<psi>'') (Suc j) + length auxlist''"
       using wf_aux'' valid_aux'' length_aux'_aux''
       by (auto simp add: ne_def length_aux' length_aux'')
     then have "cur =
       (if progress \<sigma> P' (formula.Until \<phi>''' I \<psi>'') (Suc j) + length auxlist'' = 0 then 0
       else \<tau> \<sigma> (progress \<sigma> P' (formula.Until \<phi>''' I \<psi>'') (Suc j) + length auxlist'' - 1))"
       unfolding cur ne_def by auto
     then have "wf_until_aux \<sigma> V R args \<phi>'' \<psi>'' aux'' (progress \<sigma> P' (formula.Until \<phi>''' I \<psi>'') (Suc j)) \<and>
       progress \<sigma> P (formula.Until \<phi>''' I \<psi>'') j + length zs = progress \<sigma> P' (formula.Until \<phi>''' I \<psi>'') (Suc j) \<and>
       progress \<sigma> P (formula.Until \<phi>''' I \<psi>'') j + length zs + length_muaux args aux'' = min (progress \<sigma> P' \<phi>''' (Suc j)) (progress \<sigma> P' \<psi>'' (Suc j)) \<and>
       list_all2 (\<lambda>i. qtable n (fv \<psi>'') (mem_restr R) (\<lambda>v. Formula.sat \<sigma> V (map the v) i (formula.Until (if pos then \<phi>'' else formula.Neg \<phi>'') I \<psi>'')))
       [progress \<sigma> P (formula.Until \<phi>''' I \<psi>'') j..<progress \<sigma> P (formula.Until \<phi>''' I \<psi>'') j + length zs] zs"
       using wf_aux'' valid_aux'' fvi_subset
       unfolding wf_until_aux_def length_aux'' args_ivl args_n args_pos by (auto simp only: length_aux'')
   }
   note update = this
   from MUntil.IH(1)[OF \<phi> MUntil.prems(2)] MUntil.IH(2)[OF \<psi> MUntil.prems(2)] pos pos_eq fvi_subset show ?case
     by (auto 0 4 simp: args_ivl args_n args_pos Until_eq \<phi>''' progress.simps(6) split: prod.split if_splits
         dest!: update[OF refl refl, rotated]
         intro!: wf_mformula.Until[OF _ _ _ _ args_ivl args_n args_L args_R fvi_subset]
         elim!: list.rel_mono_strong qtable_cong
         elim: mbuf2t_take_add'(1)[OF _ wf_envs_P_simps[OF MUntil.prems(2)] buf nts_snoc]
               mbuf2t_take_add'(2)[OF _ wf_envs_P_simps[OF MUntil.prems(2)] buf nts_snoc])
 next
   case (MMatchP I mr mrs \<phi>s buf nts aux)
   note sat.simps[simp del] mbufnt_take.simps[simp del] mbufn_add.simps[simp del]
   from MMatchP.prems obtain r \<psi>s where eq: "\<phi>' = Formula.MatchP I r"
     and safe: "safe_regex Past Strict r"
     and mr: "to_mregex r = (mr, \<psi>s)"
     and mrs: "mrs = sorted_list_of_set (RPDs mr)"
     and \<psi>s: "list_all2 (wf_mformula \<sigma> j P V n R) \<phi>s \<psi>s"
     and buf: "wf_mbufn' \<sigma> P V j n R r buf"
     and nts: "wf_ts_regex \<sigma> P j r nts"
     and aux: "wf_matchP_aux \<sigma> V n R I r aux (progress \<sigma> P (Formula.MatchP I r) j)"
     by (cases rule: wf_mformula.cases) (auto)
   have nts_snoc: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i) [progress_regex \<sigma> P r j..<Suc j] (nts @ [\<tau> \<sigma> j])"
     using nts unfolding wf_ts_regex_def
     by (auto simp add: wf_envs_progress_regex_le[OF MMatchP.prems(2)] intro: list_all2_appendI)
   have update: "wf_matchP_aux \<sigma> V n R I r (snd (zs, aux')) (progress \<sigma> P' (Formula.MatchP I r) (Suc j)) \<and>
     list_all2 (\<lambda>i. qtable n (Formula.fv_regex r) (mem_restr R)
       (\<lambda>v. Formula.sat \<sigma> V (map the v) i (Formula.MatchP I r)))
       [progress \<sigma> P (Formula.MatchP I r) j..<progress \<sigma> P' (Formula.MatchP I r) (Suc j)] (fst (zs, aux'))"
     if eval: "map (fst o meval n (\<tau> \<sigma> j) db) \<phi>s = xss"
       and eq: "mbufnt_take (\<lambda>rels t (zs, aux).
         case update_matchP n I mr mrs rels t aux of (z, x) \<Rightarrow> (zs @ [z], x))
         ([], aux) (mbufn_add xss buf) (nts @ [\<tau> \<sigma> j]) = ((zs, aux'), buf', nts')"
     for xss zs aux' buf' nts'
     unfolding progress_simps
   proof (rule mbufnt_take_add_induct'[where j'="Suc j" and z'="(zs, aux')", OF eq wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc],
       goal_cases xss _ base step)
     case xss
     then show ?case
       using eval \<psi>s
       by (auto simp: list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map
           list.rel_flip[symmetric, of _ \<psi>s \<phi>s] dest!: MMatchP.IH(1)[OF _ _ MMatchP.prems(2)]
           elim!: list.rel_mono_strong split: prod.splits)
   next
     case base
     then show ?case
       using aux by auto
   next
     case (step k Xs z)
     then show ?case
       by (auto simp: Un_absorb1 mrs safe mr elim!: update_matchP(1) list_all2_appendI
           dest!: update_matchP(2) split: prod.split)
   qed simp
   then show ?case using \<psi>s
     by (auto simp: eq mr mrs safe map_split_alt list.rel_flip[symmetric, of _ \<psi>s \<phi>s]
         list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map intro!: wf_mformula.intros
         elim!: list.rel_mono_strong mbufnt_take_add'(1)[OF _ wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc]
         mbufnt_take_add'(2)[OF _ wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc]
         dest!: MMatchP.IH[OF _ _ MMatchP.prems(2)] split: prod.splits)
 next
   case (MMatchF I mr mrs \<phi>s buf nts aux)
   note sat.simps[simp del] mbufnt_take.simps[simp del] mbufn_add.simps[simp del] progress_simps[simp del]
   from MMatchF.prems obtain r \<psi>s where eq: "\<phi>' = Formula.MatchF I r"
     and safe: "safe_regex Futu Strict r"
     and mr: "to_mregex r = (mr, \<psi>s)"
     and mrs: "mrs = sorted_list_of_set (LPDs mr)"
     and \<psi>s: "list_all2 (wf_mformula \<sigma> j P V n R) \<phi>s \<psi>s"
     and buf: "wf_mbufn' \<sigma> P V j n R r buf"
     and nts: "wf_ts_regex \<sigma> P j r nts"
     and aux: "wf_matchF_aux \<sigma> V n R I r aux (progress \<sigma> P (Formula.MatchF I r) j) 0"
     and length_aux: "progress \<sigma> P (Formula.MatchF I r) j + length aux = progress_regex \<sigma> P r j"
     by (cases rule: wf_mformula.cases) (auto)
   have nts_snoc: "list_all2 (\<lambda>i t. t = \<tau> \<sigma> i)
     [progress_regex \<sigma> P r j..<Suc j] (nts @ [\<tau> \<sigma> j])"
     using nts unfolding wf_ts_regex_def
     by (auto simp add: wf_envs_progress_regex_le[OF MMatchF.prems(2)] intro: list_all2_appendI)
   {
     fix xss zs aux' aux'' buf' nts'
     assume eval: "map (fst o meval n (\<tau> \<sigma> j) db) \<phi>s = xss"
       and eq1: "mbufnt_take (update_matchF n I mr mrs) aux (mbufn_add xss buf) (nts @ [\<tau> \<sigma> j]) =
         (aux', buf', nts')"
       and eq2: "eval_matchF I mr (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # _ \<Rightarrow> nt) aux' = (zs, aux'')"
     have update1: "wf_matchF_aux \<sigma> V n R I r aux' (progress \<sigma> P (Formula.MatchF I r) j) 0 \<and>
       progress \<sigma> P (Formula.MatchF I r) j + length aux' = progress_regex \<sigma> P' r (Suc j)"
       using eval nts_snoc nts_snoc length_aux aux \<psi>s
       by (elim mbufnt_take_add_induct'[where j'="Suc j", OF eq1 wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf])
         (auto simp: length_update_matchF
           list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map list.rel_flip[symmetric, of _ \<psi>s \<phi>s]
           dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)]
           elim: wf_update_matchF[OF _ safe mr mrs] elim!: list.rel_mono_strong)
     from MMatchF.prems(2) have nts': "wf_ts_regex \<sigma> P' (Suc j) r nts'"
       using eval eval nts_snoc \<psi>s
       unfolding wf_ts_regex_def
       by (intro mbufnt_take_eqD(2)[OF eq1 wf_mbufn_add[where js'="map (\<lambda>\<phi>. progress \<sigma> P' \<phi> (Suc j)) \<psi>s",
               OF buf[unfolded wf_mbufn'_def mr prod.case]]])
         (auto simp: to_mregex_progress[OF safe mr] Mini_def
           list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map list.rel_flip[symmetric, of _ \<psi>s \<phi>s]
           list_all2_Cons1 elim!: list.rel_mono_strong intro!: list.rel_refl_strong
           dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)])
     have "i \<le> progress \<sigma> P' (Formula.MatchF I r) (Suc j) \<Longrightarrow>
       wf_matchF_aux \<sigma> V n R I r aux' i 0 \<Longrightarrow>
       i + length aux' = progress_regex \<sigma> P' r (Suc j) \<Longrightarrow>
       wf_matchF_aux \<sigma> V n R I r aux'' (progress \<sigma> P' (Formula.MatchF I r) (Suc j)) 0 \<and>
         i + length zs = progress \<sigma> P' (Formula.MatchF I r) (Suc j) \<and>
         i + length zs + length aux'' = progress_regex \<sigma> P' r (Suc j) \<and>
         list_all2 (\<lambda>i. qtable n (Formula.fv_regex r) (mem_restr R)
           (\<lambda>v. Formula.sat \<sigma> V (map the v) i (Formula.MatchF I r)))
           [i..<i + length zs] zs" for i
       using eq2
     proof (induction aux' arbitrary: zs aux'' i)
       case Nil
       then show ?case by (auto dest!: antisym[OF progress_MatchF_le])
     next
       case (Cons a aux')
       obtain t rels rel where "a = (t, rels, rel)" by (cases a)
       from Cons.prems(2) have aux': "wf_matchF_aux \<sigma> V n R I r aux' (Suc i) 0"
         by (rule wf_matchF_aux_Cons)
       from Cons.prems(2) have 1: "t = \<tau> \<sigma> i"
         unfolding \<open>a = (t, rels, rel)\<close> by (rule wf_matchF_aux_Cons1)
       from Cons.prems(2) have 3: "qtable n (Formula.fv_regex r) (mem_restr R) (\<lambda>v.
         (\<exists>j\<ge>i. j < Suc (i + length aux') \<and> mem (\<tau> \<sigma> j - \<tau> \<sigma> i) I \<and> Regex.match (Formula.sat \<sigma> V (map the v)) r i j)) rel"
         unfolding \<open>a = (t, rels, rel)\<close> using wf_matchF_aux_Cons3 by force
       from Cons.prems(3) have Suc_i_aux': "Suc i + length aux' = progress_regex \<sigma> P' r (Suc j)"
         by simp
       have "i \<ge> progress \<sigma> P' (Formula.MatchF I r) (Suc j)"
         if "enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt) \<le> enat t + right I"
         using that nts' unfolding wf_ts_regex_def progress_simps
         by (auto simp add: 1 list_all2_Cons2 upt_eq_Cons_conv
             intro!: cInf_lower \<tau>_mono elim!: order.trans[rotated] simp del: upt_Suc split: if_splits list.splits)
       moreover
       have "Suc i \<le> progress \<sigma> P' (Formula.MatchF I r) (Suc j)"
         if "enat t + right I < enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)"
       proof -
         from that obtain m where m: "right I = enat m" by (cases "right I") auto
         have \<tau>_min:  "\<tau> \<sigma> (min j k) = min (\<tau> \<sigma> j) (\<tau> \<sigma> k)" for k
           by (simp add: min_of_mono monoI)
         have le_progress_iff[simp]: "Suc j \<le> progress \<sigma> P' \<phi> (Suc j) \<longleftrightarrow> progress \<sigma> P' \<phi> (Suc j) = (Suc j)" for \<phi>
           using wf_envs_progress_le[OF MMatchF.prems(2), of \<phi>] by auto
         have min_Suc[simp]: "min j (Suc j) = j" by auto
         let ?X = "{i. \<forall>k. k < Suc j \<and> k \<le> progress_regex \<sigma> P' r (Suc j) \<longrightarrow> enat (\<tau> \<sigma> k) \<le> enat (\<tau> \<sigma> i) + right I}"
         let ?min = "min j (progress_regex \<sigma> P' r (Suc j))"
         have "\<tau> \<sigma> ?min \<le> \<tau> \<sigma> j"
           by (rule \<tau>_mono) auto
         from m have "?X \<noteq> {}"
           by (auto dest!: less_\<tau>D add_lessD1 simp: not_le not_less)
         from m show ?thesis
           using that nts' wf_envs_progress_regex_le[OF MMatchF.prems(2), of r]
           unfolding wf_ts_regex_def progress_simps
           by (intro cInf_greatest[OF \<open>?X \<noteq> {}\<close>])
             (auto simp: 1 not_le not_less list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq
               simp del: upt_Suc split: list.splits if_splits
               dest!: spec[of _ "?min"] less_le_trans[of "\<tau> \<sigma> i + m" "\<tau> \<sigma> _" "\<tau> \<sigma> _ + m"] less_\<tau>D)
       qed
       moreover have *: "k < progress_regex \<sigma> P' r (Suc j)" if
         "enat (\<tau> \<sigma> i) + right I < enat (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)"
         "enat (\<tau> \<sigma> k - \<tau> \<sigma> i) \<le> right I" for k
       proof -
         from that(1,2) obtain m where "right I = enat m"
           "\<tau> \<sigma> i + m < (case nts' of [] \<Rightarrow> \<tau> \<sigma> j | nt # x \<Rightarrow> nt)" "\<tau> \<sigma> k - \<tau> \<sigma> i \<le> m"
           by (cases "right I") auto
         with nts' wf_envs_progress_regex_le[OF MMatchF.prems(2), of r]
         show ?thesis
           unfolding wf_ts_regex_def le_diff_conv
           by (auto simp: not_le list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq add.commute
               simp del: upt_Suc split: list.splits if_splits dest!: le_less_trans[of "\<tau> \<sigma> k"] less_\<tau>D)
       qed
       ultimately show ?case using Cons.prems Suc_i_aux'[simplified]
         unfolding \<open>a = (t, rels, rel)\<close>
         by (auto simp: 1 sat.simps upt_conv_Cons dest!:  Cons.IH[OF _ aux' Suc_i_aux']
             simp del: upt_Suc split: if_splits prod.splits intro!: iff_exI qtable_cong[OF 3 refl])
 
     qed
     note this[OF progress_mono_gen[OF le_SucI, OF order.refl] conjunct1[OF update1] conjunct2[OF update1]]
   }
   note update = this[OF refl, rotated]
   with MMatchF.prems(2) show ?case using \<psi>s
     by (auto simp: eq mr mrs safe map_split_alt list.rel_flip[symmetric, of _ \<psi>s \<phi>s]
         list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map intro!: wf_mformula.intros
         elim!: list.rel_mono_strong mbufnt_take_add'(1)[OF _ wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf nts_snoc]
         mbufnt_take_add'(2)[OF _ wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf nts_snoc]
         dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)] update split: prod.splits)
 qed
 
 
 subsubsection \<open>Monitor step\<close>
 
 lemma (in maux) wf_mstate_mstep: "wf_mstate \<phi> \<pi> R st \<Longrightarrow> last_ts \<pi> \<le> snd tdb \<Longrightarrow>
   wf_mstate \<phi> (psnoc \<pi> tdb) R (snd (mstep (map_prod mk_db id tdb) st))"
   unfolding wf_mstate_def mstep_def Let_def
   by (fastforce simp add: progress_mono le_imp_diff_is_add split: prod.splits
       elim!: prefix_of_psnocE dest: meval[OF _ wf_envs_mk_db] list_all2_lengthD)
 
 definition "flatten_verdicts Vs = (\<Union> (set (map (\<lambda>(i, X). (\<lambda>v. (i, v)) ` X) Vs)))"
 
 lemma flatten_verdicts_append[simp]:
   "flatten_verdicts (Vs @ Us) = flatten_verdicts Vs \<union> flatten_verdicts Us"
   by (induct Vs) (auto simp: flatten_verdicts_def)
 
 lemma (in maux) mstep_output_iff:
   assumes "wf_mstate \<phi> \<pi> R st" "last_ts \<pi> \<le> snd tdb" "prefix_of (psnoc \<pi> tdb) \<sigma>" "mem_restr R v"
   shows "(i, v) \<in> flatten_verdicts (fst (mstep (map_prod mk_db id tdb) st)) \<longleftrightarrow>
     progress \<sigma> Map.empty \<phi> (plen \<pi>) \<le> i \<and> i < progress \<sigma> Map.empty \<phi> (Suc (plen \<pi>)) \<and>
     wf_tuple (Formula.nfv \<phi>) (Formula.fv \<phi>) v \<and> Formula.sat \<sigma> Map.empty (map the v) i \<phi>"
 proof -
   from prefix_of_psnocE[OF assms(3,2)] have "prefix_of \<pi> \<sigma>"
     "\<Gamma> \<sigma> (plen \<pi>) = fst tdb" "\<tau> \<sigma> (plen \<pi>) = snd tdb" by auto
   moreover from assms(1) \<open>prefix_of \<pi> \<sigma>\<close> have "mstate_n st = Formula.nfv \<phi>"
     "mstate_i st = progress \<sigma> Map.empty \<phi> (plen \<pi>)" "wf_mformula \<sigma> (plen \<pi>) Map.empty Map.empty (mstate_n st) R (mstate_m st) \<phi>"
     unfolding wf_mstate_def by blast+
   moreover from meval[OF \<open>wf_mformula \<sigma> (plen \<pi>) Map.empty Map.empty (mstate_n st) R (mstate_m st) \<phi>\<close> wf_envs_mk_db] obtain Vs st' where
     "meval (mstate_n st) (\<tau> \<sigma> (plen \<pi>)) (mk_db (\<Gamma> \<sigma> (plen \<pi>))) (mstate_m st) = (Vs, st')"
     "wf_mformula \<sigma> (Suc (plen \<pi>))  Map.empty Map.empty (mstate_n st) R st' \<phi>"
     "list_all2 (\<lambda>i. qtable (mstate_n st) (fv \<phi>) (mem_restr R) (\<lambda>v. Formula.sat \<sigma> Map.empty (map the v) i \<phi>))
       [progress \<sigma> Map.empty \<phi> (plen \<pi>)..<progress \<sigma> Map.empty \<phi> (Suc (plen \<pi>))] Vs" by blast
   moreover from this assms(4) have "qtable (mstate_n st) (fv \<phi>) (mem_restr R)
     (\<lambda>v. Formula.sat \<sigma> Map.empty (map the v) i \<phi>) (Vs ! (i - progress \<sigma> Map.empty \<phi> (plen \<pi>)))"
     if "progress \<sigma> Map.empty \<phi> (plen \<pi>) \<le> i" "i < progress \<sigma> Map.empty \<phi> (Suc (plen \<pi>))"
     using that by (auto simp: list_all2_conv_all_nth
         dest!: spec[of _ "(i - progress \<sigma> Map.empty \<phi> (plen \<pi>))"])
   ultimately show ?thesis
     using assms(4) unfolding mstep_def Let_def flatten_verdicts_def
     by (auto simp: in_set_enumerate_eq list_all2_conv_all_nth progress_mono le_imp_diff_is_add
         elim!: in_qtableE in_qtableI intro!: bexI[of _ "(i, Vs ! (i - progress \<sigma> Map.empty \<phi> (plen \<pi>)))"])
 qed
 
 
 subsubsection \<open>Monitor function\<close>
 
 locale verimon = verimon_spec + maux
 
 lemma (in verimon) mstep_mverdicts:
   assumes wf: "wf_mstate \<phi> \<pi> R st"
     and le[simp]: "last_ts \<pi> \<le> snd tdb"
     and restrict: "mem_restr R v"
   shows "(i, v) \<in> flatten_verdicts (fst (mstep (map_prod mk_db id tdb) st)) \<longleftrightarrow>
     (i, v) \<in> M (psnoc \<pi> tdb) - M \<pi>"
 proof -
   obtain \<sigma> where p2: "prefix_of (psnoc \<pi> tdb) \<sigma>"
     using ex_prefix_of by blast
   with le have p1: "prefix_of \<pi> \<sigma>" by (blast elim!: prefix_of_psnocE)
   show ?thesis
     unfolding M_def
     by (auto 0 3 simp: p2 progress_prefix_conv[OF _ p1] sat_prefix_conv[OF _ p1] not_less
         pprogress_eq[OF p1] pprogress_eq[OF p2]
         dest: mstep_output_iff[OF wf le p2 restrict, THEN iffD1] spec[of _ \<sigma>]
         mstep_output_iff[OF wf le _ restrict, THEN iffD1] progress_sat_cong[OF p1]
         intro: mstep_output_iff[OF wf le p2 restrict, THEN iffD2] p1)
 qed
 
 context maux
 begin
 
 primrec msteps0 where
   "msteps0 [] st = ([], st)"
 | "msteps0 (tdb # \<pi>) st =
     (let (V', st') = mstep (map_prod mk_db id tdb) st; (V'', st'') = msteps0 \<pi> st' in (V' @ V'', st''))"
 
 primrec msteps0_stateless where
   "msteps0_stateless [] st = []"
 | "msteps0_stateless (tdb # \<pi>) st = (let (V', st') = mstep (map_prod mk_db id tdb) st in V' @ msteps0_stateless \<pi> st')"
 
 lemma msteps0_msteps0_stateless: "fst (msteps0 w st) = msteps0_stateless w st"
   by (induct w arbitrary: st) (auto simp: split_beta)
 
 lift_definition msteps :: "Formula.prefix \<Rightarrow> ('msaux, 'muaux) mstate \<Rightarrow> (nat \<times> event_data table) list \<times> ('msaux, 'muaux) mstate"
   is msteps0 .
 
 lift_definition msteps_stateless :: "Formula.prefix \<Rightarrow> ('msaux, 'muaux) mstate \<Rightarrow> (nat \<times> event_data table) list"
   is msteps0_stateless .
 
 lemma msteps_msteps_stateless: "fst (msteps w st) = msteps_stateless w st"
   by transfer (rule msteps0_msteps0_stateless)
 
 lemma msteps0_snoc: "msteps0 (\<pi> @ [tdb]) st =
    (let (V', st') = msteps0 \<pi> st; (V'', st'') = mstep (map_prod mk_db id tdb) st' in (V' @ V'', st''))"
   by (induct \<pi> arbitrary: st) (auto split: prod.splits)
 
 lemma msteps_psnoc: "last_ts \<pi> \<le> snd tdb \<Longrightarrow> msteps (psnoc \<pi> tdb) st =
    (let (V', st') = msteps \<pi> st; (V'', st'') = mstep (map_prod mk_db id tdb) st' in (V' @ V'', st''))"
   by transfer' (auto simp: msteps0_snoc split: list.splits prod.splits if_splits)
 
 definition monitor where
   "monitor \<phi> \<pi> = msteps_stateless \<pi> (minit_safe \<phi>)"
 
 end
 
 lemma Suc_length_conv_snoc: "(Suc n = length xs) = (\<exists>y ys. xs = ys @ [y] \<and> length ys = n)"
   by (cases xs rule: rev_cases) auto
 
 lemma (in verimon) wf_mstate_msteps: "wf_mstate \<phi> \<pi> R st \<Longrightarrow> mem_restr R v \<Longrightarrow> \<pi> \<le> \<pi>' \<Longrightarrow>
   X = msteps (pdrop (plen \<pi>) \<pi>') st \<Longrightarrow> wf_mstate \<phi> \<pi>' R (snd X) \<and>
   ((i, v) \<in> flatten_verdicts (fst X)) = ((i, v) \<in> M \<pi>' - M \<pi>)"
 proof (induct "plen \<pi>' - plen \<pi>" arbitrary: X st \<pi> \<pi>')
   case 0
   from 0(1,4,5) have "\<pi> = \<pi>'"  "X = ([], st)"
     by (transfer; auto)+
   with 0(2) show ?case unfolding flatten_verdicts_def by simp
 next
   case (Suc x)
   from Suc(2,5) obtain \<pi>'' tdb where "x = plen \<pi>'' - plen \<pi>"  "\<pi> \<le> \<pi>''"
     "\<pi>' = psnoc \<pi>'' tdb" "pdrop (plen \<pi>) (psnoc \<pi>'' tdb) = psnoc (pdrop (plen \<pi>) \<pi>'') tdb"
     "last_ts (pdrop (plen \<pi>) \<pi>'') \<le> snd tdb" "last_ts \<pi>'' \<le> snd tdb"
     "\<pi>'' \<le> psnoc \<pi>'' tdb"
   proof (atomize_elim, transfer, elim exE, goal_cases prefix)
     case (prefix _ _ \<pi>' _ \<pi>_tdb)
     then show ?case
     proof (cases \<pi>_tdb rule: rev_cases)
       case (snoc \<pi> tdb)
       with prefix show ?thesis
         by (intro bexI[of _ "\<pi>' @ \<pi>"] exI[of _ tdb])
           (force simp: sorted_append append_eq_Cons_conv split: list.splits if_splits)+
     qed simp
   qed
   with Suc(1)[OF this(1) Suc.prems(1,2) this(2) refl] Suc.prems show ?case
     unfolding msteps_msteps_stateless[symmetric]
     by (auto simp: msteps_psnoc split_beta mstep_mverdicts
         dest: mono_monitor[THEN set_mp, rotated] intro!: wf_mstate_mstep)
 qed
 
 lemma (in verimon) wf_mstate_msteps_stateless:
   assumes "wf_mstate \<phi> \<pi> R st" "mem_restr R v" "\<pi> \<le> \<pi>'"
   shows "(i, v) \<in> flatten_verdicts (msteps_stateless (pdrop (plen \<pi>) \<pi>') st) \<longleftrightarrow> (i, v) \<in> M \<pi>' - M \<pi>"
   using wf_mstate_msteps[OF assms refl] unfolding msteps_msteps_stateless by simp
 
 lemma (in verimon) wf_mstate_msteps_stateless_UNIV: "wf_mstate \<phi> \<pi> UNIV st \<Longrightarrow> \<pi> \<le> \<pi>' \<Longrightarrow>
   flatten_verdicts (msteps_stateless (pdrop (plen \<pi>) \<pi>') st) = M \<pi>' - M \<pi>"
   by (auto dest: wf_mstate_msteps_stateless[OF _ mem_restr_UNIV])
 
 lemma (in verimon) mverdicts_Nil: "M pnil = {}"
   by (simp add: M_def pprogress_eq)
 
 context maux
 begin
 
 lemma minit_safe_minit: "mmonitorable \<phi> \<Longrightarrow> minit_safe \<phi> = minit \<phi>"
   unfolding minit_safe_def monitorable_formula_code by simp
 
 lemma wf_mstate_minit_safe: "mmonitorable \<phi> \<Longrightarrow> wf_mstate \<phi> pnil R (minit_safe \<phi>)"
   using wf_mstate_minit minit_safe_minit mmonitorable_def by metis
 
 end
 
 lemma (in verimon) monitor_mverdicts: "flatten_verdicts (monitor \<phi> \<pi>) = M \<pi>"
   unfolding monitor_def using monitorable
   by (subst wf_mstate_msteps_stateless_UNIV[OF wf_mstate_minit_safe, simplified])
     (auto simp: mmonitorable_def mverdicts_Nil)
 
 subsection \<open>Collected correctness results\<close>
 
 context verimon
 begin
 
 text \<open>We summarize the main results proved above.
 \begin{enumerate}
 \item The term @{term M} describes semantically the monitor's expected behaviour:
 \begin{itemize}
 \item @{thm[source] mono_monitor}: @{thm mono_monitor[no_vars]}
 \item @{thm[source] sound_monitor}: @{thm sound_monitor[no_vars]}
 \item @{thm[source] complete_monitor}: @{thm complete_monitor[no_vars]}
 \item @{thm[source] sliceable_M}: @{thm sliceable_M[no_vars]}
 \end{itemize}
 \item The executable monitor's online interface @{term minit_safe} and @{term mstep}
   preserves the invariant @{term wf_mstate} and produces the the verdicts according
   to @{term M}:
 \begin{itemize}
 \item @{thm[source] wf_mstate_minit_safe}: @{thm wf_mstate_minit_safe[no_vars]}
 \item @{thm[source] wf_mstate_mstep}: @{thm wf_mstate_mstep[no_vars]}
 \item @{thm[source] mstep_mverdicts}: @{thm mstep_mverdicts[no_vars]}
 \end{itemize}
 \item The executable monitor's offline interface @{term monitor} implements @{term M}:
 \begin{itemize}
 \item @{thm[source] monitor_mverdicts}: @{thm monitor_mverdicts[no_vars]}
 \end{itemize}
 \end{enumerate}
 \<close>
 
 end
 
 (*<*)
 end
 (*>*)
diff --git a/thys/Prim_Dijkstra_Simple/Dijkstra_Impl.thy b/thys/Prim_Dijkstra_Simple/Dijkstra_Impl.thy
--- a/thys/Prim_Dijkstra_Simple/Dijkstra_Impl.thy
+++ b/thys/Prim_Dijkstra_Simple/Dijkstra_Impl.thy
@@ -1,285 +1,285 @@
 section \<open>Implementation of Dijkstra's Algorithm\<close>
 theory Dijkstra_Impl
 imports 
   Dijkstra_Abstract
   "Directed_Graph_Impl"
   "HOL-Library.While_Combinator"
   "Priority_Search_Trees.PST_RBT"
   "HOL-Data_Structures.RBT_Map"
 begin
 
 subsection \<open>Implementation using ADT Interfaces\<close>
 
 locale Dijkstra_Impl_Adts = 
   G: adt_finite_wgraph G_invar G_succ G_empty G_add G_\<alpha>
 + M: Map M_empty M_update M_delete M_lookup M_invar
 + Q: PrioMap Q_empty Q_update Q_delete Q_invar Q_lookup Q_is_empty Q_getmin
   
   for G_\<alpha> :: "'g \<Rightarrow> ('v) wgraph" and G_invar G_succ G_empty G_add
   
   and M_empty M_update M_delete and M_lookup :: "'m \<Rightarrow> 'v \<Rightarrow> nat option" 
   and M_invar
   
   and Q_empty Q_update Q_delete Q_invar and Q_lookup :: "'q \<Rightarrow> 'v \<Rightarrow> nat option" 
   and Q_is_empty Q_getmin
 begin
 
 text \<open>Simplifier setup\<close>
 lemmas [simp] = G.wgraph_specs
 lemmas [simp] = M.map_specs
 lemmas [simp] = Q.prio_map_specs
 
 end  
   
 
 context PrioMap begin
 
 lemma map_getminE:
   assumes "getmin m = (k,p)" "invar m" "lookup m \<noteq> Map.empty" 
   obtains "lookup m k = Some p" "\<forall>k' p'. lookup m k' = Some p' \<longrightarrow> p\<le>p'"  
   using map_getmin[OF assms]
   by (auto simp: ran_def)
     
 end
 
 locale Dijkstra_Impl_Defs = Dijkstra_Impl_Adts where G_\<alpha> = G_\<alpha>
   + Dijkstra \<open>G_\<alpha> g\<close> s
   for G_\<alpha> :: "'g \<Rightarrow> ('v::linorder) wgraph" and g s 
 
 
 locale Dijkstra_Impl = Dijkstra_Impl_Defs where G_\<alpha> = G_\<alpha>  
   for G_\<alpha> :: "'g \<Rightarrow> ('v::linorder) wgraph" 
   +
   assumes G_invar[simp]: "G_invar g"
 begin  
 
 lemma finite_all_dnodes[simp, intro!]: "finite all_dnodes"
 proof -  
   have "all_dnodes \<subseteq> Set.insert s (snd ` edges)"
     by (fastforce simp: all_dnodes_def edges_def image_iff)
   also have "finite \<dots>" by (auto simp: G.finite)
   finally (finite_subset) show ?thesis .
 qed
 
 lemma finite_unfinished_dnodes[simp, intro!]: "finite (unfinished_dnodes S)"
   using finite_subset[OF unfinished_nodes_subset] by auto
   
 
 lemma (in -) fold_refine:
   assumes "I s"
   assumes "\<And>s x. I s \<Longrightarrow> x\<in>set l \<Longrightarrow> I (f x s) \<and> \<alpha> (f x s) = f' x (\<alpha> s)"
   shows "I (fold f l s) \<and> \<alpha> (fold f l s) = fold f' l (\<alpha> s)"
   using assms
   by (induction l arbitrary: s) auto
 
 definition (in Dijkstra_Impl_Defs) "Q_relax_outgoing u du V Q = fold (\<lambda>(d,v) Q.
   case Q_lookup Q v of 
     None \<Rightarrow> if M_lookup V v \<noteq> None then Q else Q_update v (du+d) Q
   | Some d' \<Rightarrow> Q_update v (min (du+d) d') Q) ((G_succ g u)) Q"
   
 lemma Q_relax_outgoing[simp]:
   assumes [simp]: "Q_invar Q"
   shows "Q_invar (Q_relax_outgoing u du V Q) 
        \<and> Q_lookup (Q_relax_outgoing u du V Q) 
           = relax_outgoing' u du (M_lookup V) (Q_lookup Q)"
   apply (subst relax_outgoing''_refine[symmetric, where l="G_succ g u"])
   apply simp
   unfolding Q_relax_outgoing_def relax_outgoing''_def
   apply (rule fold_refine[where I=Q_invar and \<alpha>=Q_lookup])
   by (auto split: option.split)
   
 definition (in Dijkstra_Impl_Defs) "D_invar_impl Q V \<equiv> 
   Q_invar Q \<and> M_invar V \<and> D_invar' (Q_lookup Q) (M_lookup V)"
 
 definition (in Dijkstra_Impl_Defs)
   "Q_initQ \<equiv> Q_update s 0 Q_empty"
           
 lemma Q_init_Q[simp]:
   shows "Q_invar (Q_initQ)" "Q_lookup (Q_initQ) = initQ"
   by (auto simp: Q_initQ_def initQ_def)
   
 definition (in Dijkstra_Impl_Defs)
   "M_initV \<equiv> M_empty"
   
 lemma M_initS[simp]: "M_invar M_initV" "M_lookup M_initV = initV" 
   unfolding M_initV_def initV_def by auto
 
 term Q_getmin
 
 definition (in Dijkstra_Impl_Defs) 
   "dijkstra_loop \<equiv> while (\<lambda>(Q,V). \<not> Q_is_empty Q) (\<lambda>(Q,V). 
     let
       (u,du) = Q_getmin Q;
       Q = Q_relax_outgoing u du V Q;
       Q = Q_delete u Q;
       V = M_update u du V
     in
       (Q,V)
   ) (Q_initQ,M_initV)"
 
 definition (in Dijkstra_Impl_Defs) "dijkstra \<equiv> snd dijkstra_loop"
 
 lemma transfer_preconditions:
   assumes "coupling Q V D S"
   shows "Q u = Some du \<longleftrightarrow> D u = enat du \<and> u\<notin>S"
   using assms
   by (auto simp: coupling_def)
 
 
 lemma dijkstra_loop_invar_and_empty:
   shows "case dijkstra_loop of (Q,V) \<Rightarrow> D_invar_impl Q V \<and> Q_is_empty Q"
   unfolding dijkstra_loop_def
   apply (rule while_rule[where 
         P="case_prod D_invar_impl" 
     and r="inv_image finite_psubset (unfinished_dnodes' o M_lookup o snd)"])
   apply (all \<open>(clarsimp split: prod.splits)?\<close>)
   subgoal
     apply (simp add: D_invar_impl_def)
     apply (simp add: D_invar'_def)
     apply (intro exI conjI)
     apply (rule coupling_init)
     using initD_def initS_def invar_init by auto
 proof -  
   fix Q V u du
   assume "\<not> Q_is_empty Q" "D_invar_impl Q V" "Q_getmin Q = (u, du)"
   hence "Q_lookup Q \<noteq> Map.empty" "D_invar' (Q_lookup Q) (M_lookup V)"
     and [simp]: "Q_invar Q" "M_invar V"
     and "Q_lookup Q u = Some du" "\<forall>k' p'. Q_lookup Q k' = Some p' \<longrightarrow> du \<le> p'"
     by (auto simp: D_invar_impl_def elim: Q.map_getminE)
     
   then obtain D S where 
     "D_invar D S" 
     and COUPLING: "coupling (Q_lookup Q) (M_lookup V) D S"  
     and ABS_PRE: "D u = enat du" "u\<notin>S" "\<forall>v. v \<notin> S \<longrightarrow> D u \<le> D v"
     by (auto 
           simp: D_invar'_def transfer_preconditions less_eq_enat_def 
           split: enat.splits) 
     
   then interpret Dijkstra_Invar "G_\<alpha> g" s D S by simp
     
   have COUPLING': "coupling 
     ((relax_outgoing' u du (M_lookup V) (Q_lookup Q))(u := None)) 
-    (M_lookup V(u \<mapsto> du)) 
+    ((M_lookup V)(u \<mapsto> du)) 
     (relax_outgoing u D) 
     (Set.insert u S)"  
     using coupling_step[OF COUPLING \<open>u\<notin>S\<close> \<open>D u = enat du\<close>] by auto
     
   show "D_invar_impl (Q_delete u (Q_relax_outgoing u du V Q)) (M_update u du V)"
     using maintain_D_invar[OF \<open>u\<notin>S\<close>] ABS_PRE
     using COUPLING'
     by (auto simp: D_invar_impl_def D_invar'_def)
   
   show "unfinished_dnodes' (M_lookup (M_update u du V)) 
         \<subset> unfinished_dnodes' (M_lookup V) 
       \<and> finite (unfinished_dnodes' (M_lookup V))"
     using coupling_unfinished[OF COUPLING] coupling_unfinished[OF COUPLING']
     using unfinished_nodes_decr[OF \<open>u\<notin>S\<close>] ABS_PRE
     by simp
 qed  
   
 lemma dijkstra_correct: 
   "M_invar dijkstra" 
   "M_lookup dijkstra u = Some d \<longleftrightarrow> \<delta> s u = enat d"
   using dijkstra_loop_invar_and_empty
   unfolding dijkstra_def
   apply -
   apply (all \<open>clarsimp simp: D_invar_impl_def\<close>)
   apply (clarsimp simp: D_invar'_def)
   subgoal for Q V D S  
     using Dijkstra_Invar.invar_finish_imp_correct[of "G_\<alpha> g" s D S u]
     apply (clarsimp simp: coupling_def)
     by (auto simp: domIff)
   done
 
   
 end       
 
 
 subsection \<open>Instantiation of ADTs and Code Generation\<close>
 
 global_interpretation 
   G: wgraph_by_map RBT_Set.empty RBT_Map.update 
                    RBT_Map.delete Lookup2.lookup RBT_Map.M.invar
   defines G_empty = G.empty_graph
       and G_add_edge = G.add_edge
       and G_succ = G.succ
   by unfold_locales
 
 global_interpretation Dijkstra_Impl_Adts
   G.\<alpha> G.invar G.succ G.empty_graph G.add_edge
   
   RBT_Set.empty RBT_Map.update RBT_Map.delete Lookup2.lookup RBT_Map.M.invar
   
   PST_RBT.empty PST_RBT.update PST_RBT.delete PST_RBT.PM.invar 
   Lookup2.lookup PST_RBT.rbt_is_empty pst_getmin
   ..
 
 global_interpretation D: Dijkstra_Impl_Defs  
   G.invar G.succ G.empty_graph G.add_edge
   
   RBT_Set.empty RBT_Map.update RBT_Map.delete Lookup2.lookup RBT_Map.M.invar
   
   PST_RBT.empty PST_RBT.update PST_RBT.delete PST_RBT.PM.invar 
   Lookup2.lookup PST_RBT.rbt_is_empty pst_getmin
   
   G.\<alpha> g s for g and s::"'v::linorder"
   defines dijkstra = D.dijkstra
       and dijkstra_loop = D.dijkstra_loop
       and Q_relax_outgoing = D.Q_relax_outgoing
       and M_initV = D.M_initV
       and Q_initQ = D.Q_initQ
   ..
   
 (* TODO: Why is this fix necessary? *)
 lemmas [code] =    
   D.dijkstra_def D.dijkstra_loop_def  
   
 context
   fixes g
   assumes [simp]: "G.invar g"  
 begin  
   
 interpretation AUX: Dijkstra_Impl
   G.invar G.succ G.empty_graph G.add_edge
   
   RBT_Set.empty RBT_Map.update RBT_Map.delete Lookup2.lookup RBT_Map.M.invar
   
   PST_RBT.empty PST_RBT.update PST_RBT.delete PST_RBT.PM.invar 
   Lookup2.lookup PST_RBT.rbt_is_empty pst_getmin
   
   g s G.\<alpha> for s
   by unfold_locales simp_all
 
 lemmas dijkstra_correct = AUX.dijkstra_correct[folded dijkstra_def]
 
 end  
 
 subsection \<open>Combination with Graph Parser\<close>  
 text \<open>We combine the algorithm with a parser from lists to graphs\<close>
 
 global_interpretation 
   G: wgraph_from_list_algo G.\<alpha> G.invar G.succ G.empty_graph G.add_edge
   defines from_list = G.from_list
   ..
   
   
 definition "dijkstra_list l s \<equiv> 
   if valid_graph_rep l then Some (dijkstra (from_list l) s) else None"
 
 theorem dijkstra_list_correct:
   "case dijkstra_list l s of
     None \<Rightarrow> \<not>valid_graph_rep l
   | Some D \<Rightarrow> 
         valid_graph_rep l 
       \<and> M.invar D 
       \<and> (\<forall>u d. lookup D u = Some d \<longleftrightarrow> WGraph.\<delta> (wgraph_of_list l) s u = enat d)"
   unfolding dijkstra_list_def
   by (auto simp: dijkstra_correct G.from_list_correct)
 
 export_code dijkstra_list checking SML OCaml? Scala Haskell?
   
 value "dijkstra_list [(1::nat,2,7),(1,3,1),(3,2,2)] 1"
 value "dijkstra_list [(1::nat,2,7),(1,3,1),(3,2,2)] 3"
 
 
 end
diff --git a/thys/ROBDD/Pointer_Map.thy b/thys/ROBDD/Pointer_Map.thy
--- a/thys/ROBDD/Pointer_Map.thy
+++ b/thys/ROBDD/Pointer_Map.thy
@@ -1,162 +1,162 @@
 section\<open>Pointermap\<close>
 theory Pointer_Map
 imports Main
 begin
 
 text\<open>
   We need a datastructure that supports the following two operations:
   \begin{itemize}
     \item Given an element, it can construct a pointer (i.e., a small representation) of that element. It will always construct the same pointer for equal elements.
     \item Given a pointer, we can retrieve the element
   \end{itemize}
 \<close>
 
 record 'a pointermap = 
   entries :: "'a list"
   getentry :: "'a \<Rightarrow> nat option"
   
 definition "pointermap_sane m \<equiv> (distinct (entries m) \<and> 
   (\<forall>n \<in> {..<length (entries m)}. getentry m (entries m ! n) = Some n) \<and> 
   (\<forall>p i. getentry m p = Some i \<longrightarrow> entries m ! i = p \<and> i < length (entries m)))"
 
 definition "empty_pointermap \<equiv> \<lparr>entries = [], getentry = \<lambda>p. None \<rparr>"
 lemma pointermap_empty_sane[simp, intro!]: "pointermap_sane empty_pointermap" unfolding empty_pointermap_def pointermap_sane_def by simp
 
 definition "pointermap_insert a m \<equiv> \<lparr>entries = (entries m)@[a], getentry = (getentry m)(a \<mapsto> length (entries m))\<rparr>"
 
 definition "pm_pth m p \<equiv> entries m ! p"
 
 definition "pointermap_p_valid p m \<equiv> p < length (entries m)"
 
 definition "pointermap_getmk a m \<equiv> (case getentry m a of Some p \<Rightarrow> (p,m) | None \<Rightarrow> let u = pointermap_insert a m in (the (getentry u a), u))"  
 
 lemma pointermap_sane_appendD: "pointermap_sane s \<Longrightarrow> m \<notin> set (entries s) \<Longrightarrow> pointermap_sane (pointermap_insert m s)"
 unfolding pointermap_sane_def pointermap_insert_def
 proof(intro conjI[rotated],goal_cases)
   case 3 thus ?case by simp
 next
   case 2
   {
     fix n
     have " \<lbrakk>distinct (entries s) \<and> (\<forall>x. x \<in> {..<length (entries s)} \<longrightarrow> getentry s (entries s ! x) = Some x) \<and> (\<forall>p i. getentry s p = Some i \<longrightarrow> entries s ! i = p \<and> i < length (entries s)); m \<notin> set (entries s);
-          n \<in> {..<length (entries \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr>)}; n < length (entries s)\<rbrakk>
-         \<Longrightarrow> getentry \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr> (entries \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr> ! n) = Some n"
-         "\<lbrakk>distinct (entries s) \<and> (\<forall>x. x \<in> {..<length (entries s)} \<longrightarrow> getentry s (entries s ! x) = Some x) \<and> (\<forall>p i. getentry s p = Some i \<longrightarrow> entries s ! i = p \<and> i < length (entries s)); m \<notin> set (entries s);
-          n \<in> {..<length (entries \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr>)}; \<not> n < length (entries s)\<rbrakk>
-         \<Longrightarrow> getentry \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr> (entries \<lparr>entries = entries s @ [m], getentry = getentry s(m \<mapsto> length (entries s))\<rparr> ! n) = Some n"
+          n \<in> {..<length (entries \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr>)}; n < length (entries s)\<rbrakk>
+         \<Longrightarrow> getentry \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr> (entries \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr> ! n) = Some n"
+         "\<lbrakk>distinct (entries s) \<and> (\<forall>x. x \<in> {..<length (entries s)} \<longrightarrow> (getentry s) (entries s ! x) = Some x) \<and> (\<forall>p i. getentry s p = Some i \<longrightarrow> entries s ! i = p \<and> i < length (entries s)); m \<notin> set (entries s);
+          n \<in> {..<length (entries \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr>)}; \<not> n < length (entries s)\<rbrakk>
+         \<Longrightarrow> getentry \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr> (entries \<lparr>entries = entries s @ [m], getentry = (getentry s)(m \<mapsto> length (entries s))\<rparr> ! n) = Some n"
       proof(goal_cases)
         case 1 note goal1 = 1
         from goal1(4) have sa: "\<And>a. (entries s @ a) ! n = entries s ! n" by (simp add: nth_append)
         from goal1(1,4) have ih: "getentry s (entries s ! n) = Some n" by simp
         from goal1(2,4) have ne: "entries s ! n \<noteq> m" using nth_mem by fastforce
         from sa ih ne show ?case by simp
       next
         case 2 note goal2 = 2
         from goal2(3,4) have ln: "n = length (entries s)" by simp
         hence sa: "\<And>a. (entries s @ [a]) ! n = a" by simp
         from sa ln show ?case by simp
       qed
   } note h = this
   with 2 show ?case by blast
     (*apply(unfold Ball_def) 
     apply(rule)
     apply(rule)
     apply(rename_tac n)
     apply(case_tac "n < length (entries s)")
   by(fact h)+*)
 next
   case 1 thus ?case
     by(clarsimp simp add: nth_append fun_upd_same Ball_def) force
 qed
 
 lemma luentries_noneD: "getentry s a = None \<Longrightarrow> pointermap_sane s \<Longrightarrow> a \<notin> set (entries s)"
 unfolding pointermap_sane_def
 proof(rule ccontr, goal_cases)
   case 1
   from 1(3) obtain n where "n < length (entries s)" "entries s ! n = a" unfolding in_set_conv_nth by blast
   with 1(2,1) show False by force
 qed
 
 lemma pm_pth_append: "pointermap_p_valid p m \<Longrightarrow> pm_pth (pointermap_insert a m) p = pm_pth m p"
   unfolding pointermap_p_valid_def pm_pth_def pointermap_insert_def
   by(simp add: nth_append)
 
 lemma pointermap_insert_in: "u = (pointermap_insert a m) \<Longrightarrow> pm_pth u (the (getentry u a)) = a"
 unfolding pointermap_insert_def pm_pth_def
 by(simp)
 
 lemma pointermap_insert_p_validI: "pointermap_p_valid p m \<Longrightarrow> pointermap_p_valid p (pointermap_insert a m)"
   unfolding pointermap_insert_def pointermap_p_valid_def
   by simp
 
 thm nth_eq_iff_index_eq
 lemma pth_eq_iff_index_eq: "pointermap_sane m \<Longrightarrow> pointermap_p_valid p1 m \<Longrightarrow> pointermap_p_valid p2 m \<Longrightarrow> (pm_pth m p1 = pm_pth m p2) \<longleftrightarrow> (p1 = p2)"
   unfolding pointermap_sane_def pointermap_p_valid_def pm_pth_def
   using nth_eq_iff_index_eq by blast
   
 lemma pointermap_p_valid_updateI: "pointermap_sane m \<Longrightarrow> getentry m a = None \<Longrightarrow> u = pointermap_insert a m \<Longrightarrow> p = the (getentry u a) \<Longrightarrow> pointermap_p_valid p u"
 by(simp add: pointermap_sane_def pointermap_p_valid_def pointermap_insert_def)
 
 lemma pointermap_get_validI: "pointermap_sane m \<Longrightarrow> getentry m a = Some p \<Longrightarrow> pointermap_p_valid p m"
 by(simp add: pointermap_sane_def pointermap_p_valid_def)
 
 lemma pointermap_sane_getmkD: 
   assumes sn: "pointermap_sane m"
   assumes res: "pointermap_getmk a m = (p,u)"
   shows "pointermap_sane u \<and> pointermap_p_valid p u"
 using sn res[symmetric]
   apply(cases "getentry m a")
    apply(simp_all add: pointermap_getmk_def Let_def split: option.split)
    apply(rule)
     apply(rule pointermap_sane_appendD)
      apply(clarify;fail)+
     apply(rule luentries_noneD)
      apply(clarify;fail)+
    apply(rule pointermap_p_valid_updateI[OF _ _ refl refl])
     apply(clarify;fail)+
   apply(erule pointermap_get_validI)
   by simp
 
 lemma pointermap_update_pthI: 
   assumes sn: "pointermap_sane m"
   assumes res: "pointermap_getmk a m = (p,u)"
   shows "pm_pth u p = a"
 using assms
   apply(simp add: pointermap_getmk_def Let_def split: option.splits)
    apply(meson pointermap_insert_in)
   apply(clarsimp simp: pointermap_sane_def pm_pth_def)
 done
 
 lemma pointermap_p_valid_inv:
   assumes "pointermap_p_valid p m"
   assumes "pointermap_getmk a m = (x,u)"
   shows "pointermap_p_valid p u"
 using assms
 by(simp add: pointermap_getmk_def Let_def split: option.splits) (meson pointermap_insert_p_validI)
 
 lemma pointermap_p_pth_inv:
   assumes pv: "pointermap_p_valid p m"
   assumes u: "pointermap_getmk a m = (x,u)"
   shows "pm_pth u p = pm_pth m p"
 using pm_pth_append[OF pv] u
 by(clarsimp simp: pointermap_getmk_def Let_def split: option.splits)
 
 lemma pointermap_backward_valid:
   assumes puv: "pointermap_p_valid p u"
   assumes u: "pointermap_getmk a m = (x,u)"
   assumes ne: "x \<noteq> p"
   shows "pointermap_p_valid p m"
 (*using u
 unfolding pointermap_getmk_def
 apply(simp add: Let_def split: option.splits)
 prefer 2 using puv apply(simp)
 apply(clarify)
 apply(simp add: pointermap_insert_def)
 using puv apply(clarify)
 apply(simp add: pointermap_p_valid_def)
 using ne by linarith
 *)
 using assms
 by (auto simp: Let_def pointermap_getmk_def pointermap_p_valid_def pointermap_insert_def split: option.splits)
 
 end
diff --git a/thys/Refine_Imperative_HOL/IICF/Impl/Heaps/IICF_Abs_Heapmap.thy b/thys/Refine_Imperative_HOL/IICF/Impl/Heaps/IICF_Abs_Heapmap.thy
--- a/thys/Refine_Imperative_HOL/IICF/Impl/Heaps/IICF_Abs_Heapmap.thy
+++ b/thys/Refine_Imperative_HOL/IICF/Impl/Heaps/IICF_Abs_Heapmap.thy
@@ -1,1214 +1,1214 @@
 section \<open>Priority Maps implemented with List and Map\<close>
 theory IICF_Abs_Heapmap
 imports IICF_Abs_Heap "HOL-Library.Rewrite" "../../Intf/IICF_Prio_Map"
 begin
 
   type_synonym ('k,'v) ahm = "'k list \<times> ('k \<rightharpoonup> 'v)"
 
   subsection \<open>Basic Setup\<close>
 
   text \<open>First, we define a mapping to list-based heaps\<close>
   definition hmr_\<alpha> :: "('k,'v) ahm \<Rightarrow> 'v heap" where
     "hmr_\<alpha> \<equiv> \<lambda>(pq,m). map (the o m) pq"
 
   definition "hmr_invar \<equiv> \<lambda>(pq,m). distinct pq \<and> dom m = set pq"
 
   definition "hmr_rel \<equiv> br hmr_\<alpha> hmr_invar"
 
   lemmas hmr_rel_defs = hmr_rel_def br_def hmr_\<alpha>_def hmr_invar_def
 
   lemma hmr_empty_invar[simp]: "hmr_invar ([],Map.empty)"
     by (auto simp: hmr_invar_def)
 
 
   locale hmstruct = h: heapstruct prio for prio :: "'v \<Rightarrow> 'b::linorder"
   begin
 
     text \<open>Next, we define a mapping to priority maps.\<close>
 
     definition heapmap_\<alpha> :: "('k,'v) ahm \<Rightarrow> ('k \<rightharpoonup> 'v)" where
       "heapmap_\<alpha> \<equiv> \<lambda>(pq,m). m"
 
     definition heapmap_invar :: "('k,'v) ahm \<Rightarrow> bool" where
       "heapmap_invar \<equiv> \<lambda>hm. hmr_invar hm \<and> h.heap_invar (hmr_\<alpha> hm)"
       
     definition "heapmap_rel \<equiv> br heapmap_\<alpha> heapmap_invar"
 
     lemmas heapmap_rel_defs = heapmap_rel_def br_def heapmap_\<alpha>_def heapmap_invar_def
 
     lemma [refine_dref_RELATES]: "RELATES hmr_rel" by (simp add: RELATES_def)
 
 
     lemma h_heap_invarI[simp]: "heapmap_invar hm \<Longrightarrow> h.heap_invar (hmr_\<alpha> hm)"  
       by (simp add: heapmap_invar_def)
 
     lemma hmr_invarI[simp]: "heapmap_invar hm \<Longrightarrow> hmr_invar hm"  
       unfolding heapmap_invar_def by blast
 
 
 
     lemma set_hmr_\<alpha>[simp]: "hmr_invar hm \<Longrightarrow> set (hmr_\<alpha> hm) = ran (heapmap_\<alpha> hm)"
       apply (clarsimp simp: hmr_\<alpha>_def hmr_invar_def heapmap_\<alpha>_def 
         eq_commute[of "dom _" "set _"] ran_def)
       apply force
       done
 
     lemma in_h_hmr_\<alpha>_conv[simp]: "hmr_invar hm \<Longrightarrow> x \<in># h.\<alpha> (hmr_\<alpha> hm) \<longleftrightarrow> x \<in> ran (heapmap_\<alpha> hm)"  
       by (force simp: hmr_\<alpha>_def hmr_invar_def heapmap_\<alpha>_def in_multiset_in_set ran_is_image)
 
     subsection \<open>Basic Operations\<close>
     (* length, val_of_op, update, butlast, append, empty *)
 
     text \<open>In this section, we define the basic operations on heapmaps, 
       and their relations to heaps and maps.\<close>
 
     subsubsection \<open>Length\<close>
     text \<open>Length of the list that represents the heap\<close>
     definition hm_length :: "('k,'v) ahm \<Rightarrow> nat" where
       "hm_length \<equiv> \<lambda>(pq,_). length pq"
 
     lemma hm_length_refine: "(hm_length, length) \<in> hmr_rel \<rightarrow> nat_rel"  
       apply (intro fun_relI)
       unfolding hm_length_def
       by (auto simp: hmr_rel_defs)
         
     lemma hm_length_hmr_\<alpha>[simp]: "length (hmr_\<alpha> hm) = hm_length hm"
       by (auto simp: hm_length_def hmr_\<alpha>_def split: prod.splits)
 
     lemmas [refine] = hm_length_refine[param_fo]
 
     subsubsection \<open>Valid\<close>
     text \<open>Check whether index is valid\<close>
     definition "hm_valid hm i \<equiv> i>0 \<and> i\<le> hm_length hm"
 
     lemma hm_valid_refine: "(hm_valid,h.valid)\<in>hmr_rel \<rightarrow> nat_rel \<rightarrow> bool_rel"
       apply (intro fun_relI)
       unfolding hm_valid_def h.valid_def
       by (parametricity add: hm_length_refine)
 
     lemma hm_valid_hmr_\<alpha>[simp]: "h.valid (hmr_\<alpha> hm) = hm_valid hm"
       by (intro ext) (auto simp: h.valid_def hm_valid_def)
 
     subsubsection \<open>Key-Of\<close>
     definition hm_key_of :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> 'k" where  
       "hm_key_of \<equiv> \<lambda>(pq,m) i. pq!(i - 1)"
 
     definition hm_key_of_op :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> 'k nres" where
       "hm_key_of_op \<equiv> \<lambda>(pq,m) i. ASSERT (i>0) \<then> mop_list_get pq (i - 1)"
 
     lemma hm_key_of_op_unfold:
       shows "hm_key_of_op hm i = ASSERT (hm_valid hm i) \<then> RETURN (hm_key_of hm i)"
       unfolding hm_valid_def hm_length_def hm_key_of_op_def hm_key_of_def
       by (auto split: prod.splits simp: pw_eq_iff refine_pw_simps)
 
     lemma val_of_hmr_\<alpha>[simp]: "hm_valid hm i \<Longrightarrow> h.val_of (hmr_\<alpha> hm) i 
       = the (heapmap_\<alpha> hm (hm_key_of hm i))"
       by (auto 
         simp: hmr_\<alpha>_def h.val_of_def heapmap_\<alpha>_def hm_key_of_def hm_valid_def hm_length_def
         split: prod.splits)
  
     lemma hm_\<alpha>_key_ex[simp]:
       "\<lbrakk>hmr_invar hm; hm_valid hm i\<rbrakk> \<Longrightarrow> (heapmap_\<alpha> hm (hm_key_of hm i) \<noteq> None)"
       unfolding heapmap_invar_def hmr_invar_def hm_valid_def heapmap_\<alpha>_def 
         hm_key_of_def hm_length_def
       by (auto split: prod.splits)  
 
     subsubsection \<open>Lookup\<close>
     abbreviation (input) hm_lookup where "hm_lookup \<equiv> heapmap_\<alpha>"
 
     definition "hm_the_lookup_op hm k \<equiv> 
       ASSERT (heapmap_\<alpha> hm k \<noteq> None \<and> hmr_invar hm) 
       \<then> RETURN (the (heapmap_\<alpha> hm k))"
 
 
     subsubsection \<open>Exchange\<close>  
     text \<open>Exchange two indices\<close>
 
     definition "hm_exch_op \<equiv> \<lambda>(pq,m) i j. do {
       ASSERT (hm_valid (pq,m) i);
       ASSERT (hm_valid (pq,m) j);
       ASSERT (hmr_invar (pq,m));
       pq \<leftarrow> mop_list_swap pq (i - 1) (j - 1);
       RETURN (pq,m)
     }"
 
     lemma hm_exch_op_invar: "hm_exch_op hm i j \<le>\<^sub>n SPEC hmr_invar"
       unfolding hm_exch_op_def h.exch_op_def h.val_of_op_def h.update_op_def
       apply simp
       apply refine_vcg
       apply (auto simp: hm_valid_def map_swap hm_length_def hmr_rel_defs)
       done
 
     lemma hm_exch_op_refine: "(hm_exch_op,h.exch_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> nat_rel \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_exch_op_def h.exch_op_def h.val_of_op_def h.update_op_def
       apply simp
       apply refine_vcg
       apply (auto simp: hm_valid_def map_swap hm_length_def hmr_rel_defs)
       done
       
     lemmas hm_exch_op_refine'[refine] = hm_exch_op_refine[param_fo, THEN nres_relD]
 
     definition hm_exch :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('k,'v) ahm"
       where "hm_exch \<equiv> \<lambda>(pq,m) i j. (swap pq (i-1) (j-1),m)"
 
       
     lemma hm_exch_op_\<alpha>_correct: "hm_exch_op hm i j \<le>\<^sub>n SPEC (\<lambda>hm'. 
       hm_valid hm i \<and> hm_valid hm j \<and> hm'=hm_exch hm i j
       )"
       unfolding hm_exch_op_def
       apply refine_vcg
       apply (vc_solve simp: hm_valid_def hm_length_def heapmap_\<alpha>_def solve: asm_rl)
       apply (auto simp add: hm_key_of_def hm_exch_def swap_def) []
       done
 
     lemma hm_exch_\<alpha>[simp]: "heapmap_\<alpha> (hm_exch hm i j) = (heapmap_\<alpha> hm)"
       by (auto simp: heapmap_\<alpha>_def hm_exch_def split: prod.splits)
     lemma hm_exch_valid[simp]: "hm_valid (hm_exch hm i j) = hm_valid hm"
       by (intro ext) (auto simp: hm_valid_def hm_length_def hm_exch_def split: prod.splits)
     lemma hm_exch_length[simp]: "hm_length (hm_exch hm i j) = hm_length hm"
       by (auto simp: hm_length_def hm_exch_def split: prod.splits)
 
     lemma hm_exch_same[simp]: "hm_exch hm i i = hm"  
       by (auto simp: hm_exch_def split: prod.splits)
       
 
     lemma hm_key_of_exch_conv[simp]:   
       "\<lbrakk>hm_valid hm i; hm_valid hm j; hm_valid hm k\<rbrakk> \<Longrightarrow> 
         hm_key_of (hm_exch hm i j) k = (
           if k=i then hm_key_of hm j
           else if k=j then hm_key_of hm i
           else hm_key_of hm k
           )"
       unfolding hm_exch_def hm_valid_def hm_length_def hm_key_of_def
       by (auto split: prod.splits)
 
     lemma hm_key_of_exch_matching[simp]:  
       "\<lbrakk>hm_valid hm i; hm_valid hm j\<rbrakk> \<Longrightarrow> hm_key_of (hm_exch hm i j) i = hm_key_of hm j"
       "\<lbrakk>hm_valid hm i; hm_valid hm j\<rbrakk> \<Longrightarrow> hm_key_of (hm_exch hm i j) j = hm_key_of hm i"
       by simp_all
 
     subsubsection \<open>Index\<close>
     text \<open>Obtaining the index of a key\<close>
     definition "hm_index \<equiv> \<lambda>(pq,m) k. index pq k + 1"
 
     lemma hm_index_valid[simp]: "\<lbrakk>hmr_invar hm; heapmap_\<alpha> hm k \<noteq> None\<rbrakk> \<Longrightarrow> hm_valid hm (hm_index hm k)"
       by (force simp: hm_valid_def heapmap_\<alpha>_def hmr_invar_def hm_index_def hm_length_def Suc_le_eq)
 
     lemma hm_index_key_of[simp]: "\<lbrakk>hmr_invar hm; heapmap_\<alpha> hm k \<noteq> None\<rbrakk> \<Longrightarrow> hm_key_of hm (hm_index hm k) = k"
       by (force 
           simp: hm_valid_def heapmap_\<alpha>_def hmr_invar_def hm_index_def hm_length_def hm_key_of_def Suc_le_eq)
 
 
     definition "hm_index_op \<equiv> \<lambda>(pq,m) k. 
       do {
         ASSERT (hmr_invar (pq,m) \<and> heapmap_\<alpha> (pq,m) k \<noteq> None);
         i \<leftarrow> mop_list_index pq k;
         RETURN (i+1)
       }"
 
     lemma hm_index_op_correct:
       assumes "hmr_invar hm"
       assumes "heapmap_\<alpha> hm k \<noteq> None"
       shows "hm_index_op hm k \<le> SPEC (\<lambda>r. r= hm_index hm k)"
       using assms unfolding hm_index_op_def
       apply refine_vcg
       apply (auto simp: heapmap_\<alpha>_def hmr_invar_def hm_index_def index_nth_id)
       done
     lemmas [refine_vcg] = hm_index_op_correct  
       
 
     subsubsection \<open>Update\<close>  
     text \<open>Updating the heap at an index\<close>
     definition hm_update_op :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> 'v \<Rightarrow> ('k,'v) ahm nres" where
       "hm_update_op \<equiv> \<lambda>(pq,m) i v. do {
         ASSERT (hm_valid (pq,m) i \<and> hmr_invar (pq,m));
         k \<leftarrow> mop_list_get pq (i - 1);
         RETURN (pq, m(k \<mapsto> v))
       }"
     
     lemma hm_update_op_invar: "hm_update_op hm k v \<le>\<^sub>n SPEC hmr_invar"
       unfolding hm_update_op_def h.update_op_def
       apply refine_vcg
       by (auto simp: hmr_rel_defs map_distinct_upd_conv hm_valid_def hm_length_def)
 
     lemma hm_update_op_refine: "(hm_update_op, h.update_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> Id \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_update_op_def h.update_op_def mop_list_get_alt mop_list_set_alt
       apply refine_vcg
       apply (auto simp: hmr_rel_defs map_distinct_upd_conv hm_valid_def hm_length_def)
       done
       
     lemmas [refine] = hm_update_op_refine[param_fo, THEN nres_relD]
 
     lemma hm_update_op_\<alpha>_correct:
       assumes "hmr_invar hm"
       assumes "heapmap_\<alpha> hm k \<noteq> None"
       shows "hm_update_op hm (hm_index hm k) v \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k\<mapsto>v))"  
       using assms
       unfolding hm_update_op_def
       apply refine_vcg
       apply (force simp: heapmap_rel_defs hmr_rel_defs hm_index_def)
       done
 
     subsubsection \<open>Butlast\<close>  
     text \<open>Remove last element\<close>  
     definition hm_butlast_op :: "('k,'v) ahm \<Rightarrow> ('k,'v) ahm nres" where
       "hm_butlast_op \<equiv> \<lambda>(pq,m). do {
         ASSERT (hmr_invar (pq,m));
         k \<leftarrow> mop_list_get pq (length pq - 1);
         pq \<leftarrow> mop_list_butlast pq;
         let m = m(k:=None);
         RETURN (pq,m)
       }"
 
     lemma hm_butlast_op_refine: "(hm_butlast_op, h.butlast_op) \<in> hmr_rel \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       supply [simp del] = map_upd_eq_restrict
       apply (intro fun_relI nres_relI)
       unfolding hm_butlast_op_def h.butlast_op_def
       apply simp
       apply refine_vcg
       apply (clarsimp_all simp: hmr_rel_defs map_butlast distinct_butlast)
       apply (auto simp: neq_Nil_rev_conv) []
       done
 
     lemmas [refine] = hm_butlast_op_refine[param_fo, THEN nres_relD]
 
     lemma hm_butlast_op_\<alpha>_correct: "hm_butlast_op hm \<le>\<^sub>n SPEC (
       \<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)( hm_key_of hm (hm_length hm) := None ))"
       unfolding hm_butlast_op_def
       apply refine_vcg
       apply (auto simp: heapmap_\<alpha>_def hm_key_of_def hm_length_def)
       done
       
     subsubsection \<open>Append\<close>
     text \<open>Append new element at end of heap\<close>
 
     definition hm_append_op :: "('k,'v) ahm \<Rightarrow> 'k \<Rightarrow> 'v \<Rightarrow> ('k,'v) ahm nres"
       where "hm_append_op \<equiv> \<lambda>(pq,m) k v. do {
         ASSERT (k \<notin> dom m);
         ASSERT (hmr_invar (pq,m));
         pq \<leftarrow> mop_list_append pq k;
         let m = m (k \<mapsto> v);
         RETURN (pq,m)
       }"
 
     lemma hm_append_op_invar: "hm_append_op hm k v \<le>\<^sub>n SPEC hmr_invar"  
       unfolding hm_append_op_def h.append_op_def
       apply refine_vcg
       unfolding heapmap_\<alpha>_def hmr_rel_defs
       apply auto
       done
 
     lemma hm_append_op_refine: "\<lbrakk> heapmap_\<alpha> hm k = None; (hm,h)\<in>hmr_rel \<rbrakk> 
       \<Longrightarrow> (hm_append_op hm k v, h.append_op h v) \<in> \<langle>hmr_rel\<rangle>nres_rel"  
       apply (intro fun_relI nres_relI)
       unfolding hm_append_op_def h.append_op_def
       apply refine_vcg
       unfolding heapmap_\<alpha>_def hmr_rel_defs
       apply auto
       done
 
     lemmas hm_append_op_refine'[refine] = hm_append_op_refine[param_fo, THEN nres_relD]
     
     lemma hm_append_op_\<alpha>_correct: 
       "hm_append_op hm k v \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm) (k \<mapsto> v))"
       unfolding hm_append_op_def
       apply refine_vcg
       by (auto simp: heapmap_\<alpha>_def)
 
 
     subsection \<open>Auxiliary Operations\<close>  
     text \<open>Auxiliary operations on heapmaps, which are derived 
       from the basic operations, but do not correspond to 
       operations of the priority map interface\<close>
     
 
     text \<open>We start with some setup\<close>
 
     lemma heapmap_hmr_relI: "(hm,h)\<in>heapmap_rel \<Longrightarrow> (hm,hmr_\<alpha> hm) \<in> hmr_rel"  
       by (auto simp: heapmap_rel_defs hmr_rel_defs)
 
     lemma heapmap_hmr_relI': "heapmap_invar hm \<Longrightarrow> (hm,hmr_\<alpha> hm) \<in> hmr_rel"  
       by (auto simp: heapmap_rel_defs hmr_rel_defs)
 
     text \<open>The basic principle how we prove correctness of our operations:
       Invariant preservation is shown by relating the operations to 
       operations on heaps. Then, only correctness on the abstraction 
       remains to be shown, assuming the operation does not fail.
       \<close>  
     lemma heapmap_nres_relI':
       assumes "hm \<le> \<Down>hmr_rel h'"
       assumes "h' \<le> SPEC (h.heap_invar)"
       assumes "hm \<le>\<^sub>n SPEC (\<lambda>hm'. RETURN (heapmap_\<alpha> hm') \<le> h)"
       shows "hm \<le> \<Down>heapmap_rel h"
       using assms
       unfolding heapmap_rel_defs hmr_rel_def
       by (auto simp: pw_le_iff pw_leof_iff refine_pw_simps)
 
     lemma heapmap_nres_relI'':
       assumes "hm \<le> \<Down>hmr_rel h'"
       assumes "h' \<le> SPEC \<Phi>"
       assumes "\<And>h'. \<Phi> h' \<Longrightarrow> h.heap_invar h'"
       assumes "hm \<le>\<^sub>n SPEC (\<lambda>hm'. RETURN (heapmap_\<alpha> hm') \<le> h)"
       shows "hm \<le> \<Down>heapmap_rel h"
       apply (rule heapmap_nres_relI')
       apply fact
       apply (rule order_trans, fact)
       apply (clarsimp; fact)
       apply fact
       done
 
     subsubsection \<open>Val-of\<close>
     text \<open>Indexing into the heap\<close>
     definition hm_val_of_op :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> 'v nres" where
       "hm_val_of_op \<equiv> \<lambda>hm i. do {
         k \<leftarrow> hm_key_of_op hm i;
         v \<leftarrow> hm_the_lookup_op hm k;
         RETURN v
       }"
 
     lemma hm_val_of_op_refine: "(hm_val_of_op,h.val_of_op) \<in> (hmr_rel \<rightarrow> nat_rel \<rightarrow> \<langle>Id\<rangle>nres_rel)"  
       apply (intro fun_relI nres_relI)
       unfolding hm_val_of_op_def h.val_of_op_def 
         hm_key_of_op_def hm_key_of_def hm_valid_def hm_length_def
         hm_the_lookup_op_def
       apply clarsimp
       apply (rule refine_IdD)
       apply refine_vcg
       apply (auto simp: hmr_rel_defs heapmap_\<alpha>_def)
       done
 
     lemmas [refine] = hm_val_of_op_refine[param_fo, THEN nres_relD]
 
     subsubsection \<open>Prio-of\<close>  
     text \<open>Priority of key\<close>
     definition "hm_prio_of_op h i \<equiv> do {v \<leftarrow> hm_val_of_op h i; RETURN (prio v)}"
     
     lemma hm_prio_of_op_refine: "(hm_prio_of_op, h.prio_of_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> \<langle>Id\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_prio_of_op_def h.prio_of_op_def
       apply refine_rcg
       by auto
 
     lemmas hm_prio_of_op_refine'[refine] = hm_prio_of_op_refine[param_fo, THEN nres_relD]
 
     subsubsection \<open>Swim\<close>
 
     definition hm_swim_op :: "('k,'v) ahm \<Rightarrow> nat \<Rightarrow> ('k,'v) ahm nres" where
       "hm_swim_op h i \<equiv> do {
         RECT (\<lambda>swim (h,i). do {
           ASSERT (hm_valid h i \<and> h.swim_invar (hmr_\<alpha> h) i);
           if hm_valid h (h.parent i) then do {
             ppi \<leftarrow> hm_prio_of_op h (h.parent i);
             pi \<leftarrow> hm_prio_of_op h i;
             if (\<not>ppi \<le> pi) then do {
               h \<leftarrow> hm_exch_op h i (h.parent i);
               swim (h, h.parent i)
             } else
               RETURN h
           } else 
             RETURN h
         }) (h,i)
       }"
 
     lemma hm_swim_op_refine: "(hm_swim_op, h.swim_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_swim_op_def h.swim_op_def
       apply refine_rcg
       apply refine_dref_type
       apply (clarsimp_all simp: hm_valid_refine[param_fo, THEN IdD])
       apply (simp add: hmr_rel_def in_br_conv)
       done
 
     lemmas hm_swim_op_refine'[refine] = hm_swim_op_refine[param_fo, THEN nres_relD]
 
 
     lemma hm_swim_op_nofail_imp_valid: 
       "nofail (hm_swim_op hm i) \<Longrightarrow> hm_valid hm i \<and> h.swim_invar (hmr_\<alpha> hm) i"
       unfolding hm_swim_op_def
       apply (subst (asm) RECT_unfold, refine_mono)
       by (auto simp: refine_pw_simps)
 
     lemma hm_swim_op_\<alpha>_correct: "hm_swim_op hm i \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm)"
       apply (rule leof_add_nofailI)
       apply (drule hm_swim_op_nofail_imp_valid)
       unfolding hm_swim_op_def
       apply (rule RECT_rule_leof[where 
             pre="\<lambda>(hm',i). hm_valid hm' i \<and> heapmap_\<alpha> hm' = heapmap_\<alpha> hm"
             and V = "inv_image less_than snd"
             ])
       apply simp
       apply simp
 
       unfolding hm_prio_of_op_def hm_val_of_op_def 
         hm_exch_op_def hm_key_of_op_def hm_the_lookup_op_def
       apply (refine_vcg)
       apply (vc_solve simp add: hm_valid_def hm_length_def)
       apply rprems
       apply (vc_solve simp: heapmap_\<alpha>_def h.parent_def)
       done
 
     subsubsection \<open>Sink\<close>  
     definition hm_sink_op
     where   
       "hm_sink_op h k \<equiv> RECT (\<lambda>D (h,k). do {
         ASSERT (k>0 \<and> k\<le>hm_length h);
         let len = hm_length h;
         if (2*k \<le> len) then do {
           let j = 2*k;
           pj \<leftarrow> hm_prio_of_op h j;
 
           j \<leftarrow> (
             if j<len then do {
               psj \<leftarrow> hm_prio_of_op h (Suc j);
               if pj>psj then RETURN (j+1) else RETURN j
             } else RETURN j);
 
           pj \<leftarrow> hm_prio_of_op h j;
           pk \<leftarrow> hm_prio_of_op h k;
           if (pk > pj) then do {
             h \<leftarrow> hm_exch_op h k j;
             D (h,j)
           } else
             RETURN h
         } else RETURN h    
       }) (h,k)"
     
     lemma hm_sink_op_refine: "(hm_sink_op, h.sink_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_sink_op_def h.sink_op_opt_eq[symmetric] h.sink_op_opt_def
       apply refine_rcg
       apply refine_dref_type
 
       unfolding hmr_rel_def heapmap_rel_def 
       apply (clarsimp_all simp: in_br_conv)
       done
 
     lemmas hm_sink_op_refine'[refine] = hm_sink_op_refine[param_fo, THEN nres_relD]
 
     lemma hm_sink_op_nofail_imp_valid: "nofail (hm_sink_op hm i) \<Longrightarrow> hm_valid hm i"
       unfolding hm_sink_op_def
       apply (subst (asm) RECT_unfold, refine_mono)
       by (auto simp: refine_pw_simps hm_valid_def)
       
     lemma hm_sink_op_\<alpha>_correct: "hm_sink_op hm i \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm)"
       apply (rule leof_add_nofailI)
       apply (drule hm_sink_op_nofail_imp_valid)
       unfolding hm_sink_op_def
       apply (rule RECT_rule_leof[where 
             pre="\<lambda>(hm',i). hm_valid hm' i \<and> heapmap_\<alpha> hm' = heapmap_\<alpha> hm \<and> hm_length hm' = hm_length hm"
             and V = "measure (\<lambda>(hm',i). hm_length hm' - i)"
             ])
       apply simp
       apply simp
 
       unfolding hm_prio_of_op_def hm_val_of_op_def hm_exch_op_def 
         hm_key_of_op_def hm_the_lookup_op_def
       apply (refine_vcg)
       apply (vc_solve simp add: hm_valid_def hm_length_def) (* Takes long *)
       apply rprems
       apply (vc_solve simp: heapmap_\<alpha>_def h.parent_def split: prod.splits)
       apply (auto)
       done
 
     subsubsection \<open>Repair\<close>
     definition "hm_repair_op hm i \<equiv> do {
       hm \<leftarrow> hm_sink_op hm i;
       hm \<leftarrow> hm_swim_op hm i;
       RETURN hm
     }"
     
     lemma hm_repair_op_refine: "(hm_repair_op, h.repair_op) \<in> hmr_rel \<rightarrow> nat_rel \<rightarrow> \<langle>hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_repair_op_def h.repair_op_def
       by refine_rcg
       
     lemmas hm_repair_op_refine'[refine] = hm_repair_op_refine[param_fo, THEN nres_relD]
 
     lemma hm_repair_op_\<alpha>_correct: "hm_repair_op hm i \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm)"
       unfolding hm_repair_op_def
       apply (refine_vcg 
         hm_swim_op_\<alpha>_correct[THEN leof_trans] 
         hm_sink_op_\<alpha>_correct[THEN leof_trans])
       by auto
 
 
     subsection \<open>Operations\<close>    
     text \<open>In this section, we define the operations that implement the priority-map interface\<close>
 
     subsubsection \<open>Empty\<close>
     definition hm_empty_op :: "('k,'v) ahm nres" 
       where "hm_empty_op \<equiv> RETURN ([],Map.empty)"
 
     lemma hm_empty_aref: "(hm_empty_op,RETURN op_map_empty) \<in> \<langle>heapmap_rel\<rangle>nres_rel"  
       unfolding hm_empty_op_def 
       by (auto simp: heapmap_rel_defs hmr_rel_defs intro: nres_relI)
 
     subsubsection \<open>Insert\<close>
     definition hm_insert_op :: "'k \<Rightarrow> 'v \<Rightarrow> ('k,'v) ahm \<Rightarrow> ('k,'v) ahm nres" where
       "hm_insert_op \<equiv> \<lambda>k v h. do {
         ASSERT (h.heap_invar (hmr_\<alpha> h));
         h \<leftarrow> hm_append_op h k v;
         let l = hm_length h;
         h \<leftarrow> hm_swim_op h l;
         RETURN h
       }"
       
     lemma hm_insert_op_refine[refine]: "\<lbrakk> heapmap_\<alpha> hm k = None; (hm,h)\<in>hmr_rel \<rbrakk> \<Longrightarrow>
       hm_insert_op k v hm \<le> \<Down>hmr_rel (h.insert_op v h)"
       unfolding hm_insert_op_def h.insert_op_def
       apply refine_rcg
       by (auto simp: hmr_rel_def br_def)
 
     lemma hm_insert_op_aref: 
       "(hm_insert_op,mop_map_update_new) \<in> Id \<rightarrow> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding mop_map_update_new_alt
       apply (rule ASSERT_refine_right)
       apply (rule heapmap_nres_relI''[OF hm_insert_op_refine h.insert_op_correct])
       apply (unfold heapmap_rel_def in_br_conv; clarsimp)
       apply (erule heapmap_hmr_relI)
       apply (unfold heapmap_rel_def in_br_conv; clarsimp)
       apply (unfold heapmap_rel_def in_br_conv; clarsimp)
       unfolding hm_insert_op_def
       apply (refine_vcg 
         hm_append_op_\<alpha>_correct[THEN leof_trans]
         hm_swim_op_\<alpha>_correct[THEN leof_trans])
       apply (unfold heapmap_rel_def in_br_conv; clarsimp)
       done
 
     subsubsection \<open>Is-Empty\<close>  
 
     lemma hmr_\<alpha>_empty_iff[simp]: 
       "hmr_invar hm \<Longrightarrow> hmr_\<alpha> hm = [] \<longleftrightarrow> heapmap_\<alpha> hm = Map.empty"  
       by (auto 
         simp: hmr_\<alpha>_def heapmap_invar_def heapmap_\<alpha>_def hmr_invar_def
         split: prod.split)  
 
     definition hm_is_empty_op :: "('k,'v) ahm \<Rightarrow> bool nres" where
       "hm_is_empty_op \<equiv> \<lambda>hm. do {
         ASSERT (hmr_invar hm);
         let l = hm_length hm;
         RETURN (l=0)
       }"
 
     lemma hm_is_empty_op_refine: "(hm_is_empty_op, h.is_empty_op) \<in> hmr_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"  
       apply (intro fun_relI nres_relI)
       unfolding hm_is_empty_op_def h.is_empty_op_def
       apply refine_rcg
       apply (auto simp: hmr_rel_defs) []
       apply (parametricity add: hm_length_refine)
       done
 
 
     lemma hm_is_empty_op_aref: "(hm_is_empty_op, RETURN o op_map_is_empty) \<in> heapmap_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_is_empty_op_def
       apply refine_vcg
       apply (auto simp: hmr_rel_defs heapmap_rel_defs hm_length_def)
       done
 
     subsubsection \<open>Lookup\<close>  
 
     definition hm_lookup_op :: "'k \<Rightarrow> ('k,'v) ahm \<Rightarrow> 'v option nres"
       where "hm_lookup_op \<equiv> \<lambda>k hm. ASSERT (heapmap_invar hm) \<then> RETURN (hm_lookup hm k)"
 
     lemma hm_lookup_op_aref: "(hm_lookup_op,RETURN oo op_map_lookup) \<in> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>\<langle>Id\<rangle>option_rel\<rangle>nres_rel"  
       apply (intro fun_relI nres_relI)
       unfolding hm_lookup_op_def heapmap_rel_def in_br_conv
       apply refine_vcg
       apply simp_all
       done
 
     subsubsection \<open>Contains-Key\<close>  
 
     definition "hm_contains_key_op \<equiv> \<lambda>k (pq,m). ASSERT (heapmap_invar (pq,m)) \<then> RETURN (k\<in>dom m)"
     lemma hm_contains_key_op_aref: "(hm_contains_key_op,RETURN oo op_map_contains_key) \<in> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"  
       apply (intro fun_relI nres_relI)
       unfolding hm_contains_key_op_def heapmap_rel_defs
       apply refine_vcg
       by (auto)
 
     subsubsection \<open>Decrease-Key\<close>  
 
 
     definition "hm_decrease_key_op \<equiv> \<lambda>k v hm. do {
       ASSERT (heapmap_invar hm);
       ASSERT (heapmap_\<alpha> hm k \<noteq> None \<and> prio v \<le> prio (the (heapmap_\<alpha> hm k)));
       i \<leftarrow> hm_index_op hm k;
       hm \<leftarrow> hm_update_op hm i v;
       hm_swim_op hm i
     }"
 
     definition (in heapstruct) "decrease_key_op i v h \<equiv> do {
       ASSERT (valid h i \<and> prio v \<le> prio_of h i);
       h \<leftarrow> update_op h i v;
       swim_op h i
     }"
 
     lemma (in heapstruct) decrease_key_op_invar: 
       "\<lbrakk>heap_invar h; valid h i; prio v \<le> prio_of h i\<rbrakk> \<Longrightarrow> decrease_key_op i v h \<le> SPEC heap_invar"
       unfolding decrease_key_op_def
       apply refine_vcg
       by (auto simp: swim_invar_decr)
 
 
     lemma index_op_inline_refine:
       assumes "heapmap_invar hm"
       assumes "heapmap_\<alpha> hm k \<noteq> None"
       assumes "f (hm_index hm k) \<le> m"
       shows "do {i \<leftarrow> hm_index_op hm k; f i} \<le> m"  
       using hm_index_op_correct[of hm k] assms
       by (auto simp: pw_le_iff refine_pw_simps)
 
     lemma hm_decrease_key_op_refine: 
       "\<lbrakk>(hm,h)\<in>hmr_rel; (hm,m)\<in>heapmap_rel; m k = Some v'\<rbrakk> 
         \<Longrightarrow> hm_decrease_key_op k v hm \<le>\<Down>hmr_rel (h.decrease_key_op (hm_index hm k) v h)"  
       unfolding hm_decrease_key_op_def h.decrease_key_op_def
       (*apply (rewrite at "Let (hm_index hm k) _" Let_def)*)
       apply (refine_rcg index_op_inline_refine)
       unfolding hmr_rel_def heapmap_rel_def in_br_conv
       apply (clarsimp_all)
       done
 
     lemma hm_index_op_inline_leof: 
       assumes "f (hm_index hm k) \<le>\<^sub>n m"
       shows "do {i \<leftarrow> hm_index_op hm k; f i} \<le>\<^sub>n m"
       using hm_index_op_correct[of hm k] assms unfolding hm_index_op_def
       by (auto simp: pw_le_iff pw_leof_iff refine_pw_simps split: prod.splits)
 
     lemma hm_decrease_key_op_\<alpha>_correct: 
-      "heapmap_invar hm \<Longrightarrow> hm_decrease_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm(k\<mapsto>v))"
+      "heapmap_invar hm \<Longrightarrow> hm_decrease_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k\<mapsto>v))"
       unfolding hm_decrease_key_op_def
       apply (refine_vcg 
         hm_update_op_\<alpha>_correct[THEN leof_trans] 
         hm_swim_op_\<alpha>_correct[THEN leof_trans]
         hm_index_op_inline_leof
         )
       apply simp_all
       done
 
     lemma hm_decrease_key_op_aref: 
       "(hm_decrease_key_op, PR_CONST (mop_pm_decrease_key prio)) \<in> Id \<rightarrow> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       unfolding PR_CONST_def
       apply (intro fun_relI nres_relI)
       apply (frule heapmap_hmr_relI)
       unfolding mop_pm_decrease_key_alt
       apply (rule ASSERT_refine_right; clarsimp)
       apply (rule heapmap_nres_relI')
       apply (rule hm_decrease_key_op_refine; assumption)
       unfolding heapmap_rel_def hmr_rel_def in_br_conv
       apply (rule h.decrease_key_op_invar; simp; fail )
       apply (refine_vcg hm_decrease_key_op_\<alpha>_correct[THEN leof_trans]; simp; fail)
       done
 
     subsubsection \<open>Increase-Key\<close>  
 
     definition "hm_increase_key_op \<equiv> \<lambda>k v hm. do {
       ASSERT (heapmap_invar hm);
       ASSERT (heapmap_\<alpha> hm k \<noteq> None \<and> prio v \<ge> prio (the (heapmap_\<alpha> hm k)));
       i \<leftarrow> hm_index_op hm k;
       hm \<leftarrow> hm_update_op hm i v;
       hm_sink_op hm i
     }"
 
     definition (in heapstruct) "increase_key_op i v h \<equiv> do {
       ASSERT (valid h i \<and> prio v \<ge> prio_of h i);
       h \<leftarrow> update_op h i v;
       sink_op h i
     }"
 
     lemma (in heapstruct) increase_key_op_invar: 
       "\<lbrakk>heap_invar h; valid h i; prio v \<ge> prio_of h i\<rbrakk> \<Longrightarrow> increase_key_op i v h \<le> SPEC heap_invar"
       unfolding increase_key_op_def
       apply refine_vcg
       by (auto simp: sink_invar_incr)
 
     lemma hm_increase_key_op_refine: 
       "\<lbrakk>(hm,h)\<in>hmr_rel; (hm,m)\<in>heapmap_rel; m k = Some v'\<rbrakk> 
         \<Longrightarrow> hm_increase_key_op k v hm \<le>\<Down>hmr_rel (h.increase_key_op (hm_index hm k) v h)"  
       unfolding hm_increase_key_op_def h.increase_key_op_def
       (*apply (rewrite at "Let (hm_index hm k) _" Let_def)*)
       apply (refine_rcg index_op_inline_refine)
       unfolding hmr_rel_def heapmap_rel_def in_br_conv
       apply (clarsimp_all)
       done
 
     lemma hm_increase_key_op_\<alpha>_correct: 
-      "heapmap_invar hm \<Longrightarrow> hm_increase_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm(k\<mapsto>v))"
+      "heapmap_invar hm \<Longrightarrow> hm_increase_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k\<mapsto>v))"
       unfolding hm_increase_key_op_def
       apply (refine_vcg 
         hm_update_op_\<alpha>_correct[THEN leof_trans] 
         hm_sink_op_\<alpha>_correct[THEN leof_trans]
         hm_index_op_inline_leof)
       apply simp_all
       done
 
     lemma hm_increase_key_op_aref: 
       "(hm_increase_key_op, PR_CONST (mop_pm_increase_key prio)) \<in> Id \<rightarrow> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       unfolding PR_CONST_def
       apply (intro fun_relI nres_relI)
       apply (frule heapmap_hmr_relI)
       unfolding mop_pm_increase_key_alt
       apply (rule ASSERT_refine_right; clarsimp)
       apply (rule heapmap_nres_relI')
       apply (rule hm_increase_key_op_refine; assumption)
       unfolding heapmap_rel_def hmr_rel_def in_br_conv
       apply (rule h.increase_key_op_invar; simp; fail )
       apply (refine_vcg hm_increase_key_op_\<alpha>_correct[THEN leof_trans]; simp)
       done
 
     subsubsection \<open>Change-Key\<close>  
 
     definition "hm_change_key_op \<equiv> \<lambda>k v hm. do {
       ASSERT (heapmap_invar hm);
       ASSERT (heapmap_\<alpha> hm k \<noteq> None);
       i \<leftarrow> hm_index_op hm k;
       hm \<leftarrow> hm_update_op hm i v;
       hm_repair_op hm i
     }"
 
     definition (in heapstruct) "change_key_op i v h \<equiv> do {
       ASSERT (valid h i);
       h \<leftarrow> update_op h i v;
       repair_op h i
     }"
 
     lemma (in heapstruct) change_key_op_invar: 
       "\<lbrakk>heap_invar h; valid h i\<rbrakk> \<Longrightarrow> change_key_op i v h \<le> SPEC heap_invar"
       unfolding change_key_op_def
       apply (refine_vcg)
       apply hypsubst
       apply refine_vcg
       by (auto simp: sink_invar_incr)
 
     lemma hm_change_key_op_refine: 
       "\<lbrakk>(hm,h)\<in>hmr_rel; (hm,m)\<in>heapmap_rel; m k = Some v'\<rbrakk> 
         \<Longrightarrow> hm_change_key_op k v hm \<le>\<Down>hmr_rel (h.change_key_op (hm_index hm k) v h)"  
       unfolding hm_change_key_op_def h.change_key_op_def
       (*apply (rewrite at "Let (hm_index hm k) _" Let_def)*)
       apply (refine_rcg index_op_inline_refine)
       unfolding hmr_rel_def heapmap_rel_def in_br_conv
       apply (clarsimp_all)
       done
 
     lemma hm_change_key_op_\<alpha>_correct: 
-      "heapmap_invar hm \<Longrightarrow> hm_change_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = heapmap_\<alpha> hm(k\<mapsto>v))"
+      "heapmap_invar hm \<Longrightarrow> hm_change_key_op k v hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k\<mapsto>v))"
       unfolding hm_change_key_op_def
       apply (refine_vcg 
         hm_update_op_\<alpha>_correct[THEN leof_trans] 
         hm_repair_op_\<alpha>_correct[THEN leof_trans]
         hm_index_op_inline_leof)
       unfolding heapmap_rel_def in_br_conv
       apply simp
       apply simp
       done
 
     lemma hm_change_key_op_aref: 
       "(hm_change_key_op, mop_map_update_ex) \<in> Id \<rightarrow> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       apply (frule heapmap_hmr_relI)
       unfolding mop_map_update_ex_alt
       apply (rule ASSERT_refine_right; clarsimp)
       apply (rule heapmap_nres_relI')
       apply (rule hm_change_key_op_refine; assumption)
       unfolding heapmap_rel_def hmr_rel_def in_br_conv
       apply (rule h.change_key_op_invar; simp; fail )
       apply ((refine_vcg hm_change_key_op_\<alpha>_correct[THEN leof_trans]; simp))
       done
 
     subsubsection \<open>Set\<close>  
 
     text \<open>Realized as generic algorithm!\<close> (* TODO: Implement as such! *)
     lemma (in -) op_pm_set_gen_impl: "RETURN ooo op_map_update = (\<lambda>k v m. do {
       c \<leftarrow> RETURN (op_map_contains_key k m);
       if c then 
         mop_map_update_ex k v m
       else
         mop_map_update_new k v m
     })"
       apply (intro ext)
       unfolding op_map_contains_key_def mop_map_update_ex_def mop_map_update_new_def
       by simp
 
     definition "hm_set_op k v hm \<equiv> do {
       c \<leftarrow> hm_contains_key_op k hm;
       if c then
         hm_change_key_op k v hm
       else
         hm_insert_op k v hm
     }"
 
     lemma hm_set_op_aref: 
       "(hm_set_op, RETURN ooo op_map_update) \<in> Id \<rightarrow> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       unfolding op_pm_set_gen_impl
       apply (intro fun_relI nres_relI)
       unfolding hm_set_op_def o_def
       apply (refine_rcg 
         hm_contains_key_op_aref[param_fo, unfolded o_def, THEN nres_relD]
         hm_change_key_op_aref[param_fo, THEN nres_relD]
         hm_insert_op_aref[param_fo, THEN nres_relD]
         )
       by auto
 
 
  
     subsubsection \<open>Pop-Min\<close>  
 
     definition hm_pop_min_op :: "('k,'v) ahm \<Rightarrow> (('k\<times>'v) \<times> ('k,'v) ahm) nres" where
       "hm_pop_min_op hm \<equiv> do {
         ASSERT (heapmap_invar hm);
         ASSERT (hm_valid hm 1);
         k \<leftarrow> hm_key_of_op hm 1;
         v \<leftarrow> hm_the_lookup_op hm k;
         let l = hm_length hm;
         hm \<leftarrow> hm_exch_op hm 1 l;
         hm \<leftarrow> hm_butlast_op hm;
         
         if (l\<noteq>1) then do {
           hm \<leftarrow> hm_sink_op hm 1;
           RETURN ((k,v),hm)
         } else RETURN ((k,v),hm)
       }"
 
     lemma hm_pop_min_op_refine: 
       "(hm_pop_min_op, h.pop_min_op) \<in> hmr_rel \<rightarrow> \<langle>UNIV \<times>\<^sub>r hmr_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding hm_pop_min_op_def h.pop_min_op_def
       (* Project away stuff of second component *)
       unfolding ignore_snd_refine_conv hm_the_lookup_op_def hm_key_of_op_unfold
       apply (simp cong: if_cong add: Let_def)
       apply (simp add: unused_bind_conv h.val_of_op_def refine_pw_simps)
 
       (* Prove refinement *)
       apply refine_rcg
       unfolding hmr_rel_def in_br_conv
       apply (unfold heapmap_invar_def;simp)
       apply (auto simp: in_br_conv)
       done
 
     text \<open>We demonstrate two different approaches for proving correctness 
       here.
       The first approach uses the relation to plain heaps only to establish
       the invariant. 
 
       The second approach also uses the relation to heaps to establish 
       correctness of the result.
 
       The first approach seems to be more robust against badly set 
       up simpsets, which may be the case in early stages of development.
 
       Assuming a working simpset, the second approach may be less work,
       and the proof may look more elegant.
       \<close>  
 
     text_raw \<open>\paragraph{First approach}\<close>
     text \<open>Transfer heapmin-property to heapmap-domain\<close>
     lemma heapmap_min_prop:
       assumes INV: "heapmap_invar hm"  
       assumes V': "heapmap_\<alpha> hm k = Some v'"
       assumes NE: "hm_valid hm (Suc 0)"
       shows "prio (the (heapmap_\<alpha> hm (hm_key_of hm (Suc 0)))) \<le> prio v'"
     proof -  
       \<comment> \<open>Transform into the domain of heaps\<close>
       obtain pq m where [simp]: "hm=(pq,m)" by (cases hm)
 
       from NE have [simp]: "pq\<noteq>[]" by (auto simp: hm_valid_def hm_length_def)
 
       have CNV_LHS: "prio (the (heapmap_\<alpha> hm (hm_key_of hm (Suc 0)))) 
         = h.prio_of (hmr_\<alpha> hm) (Suc 0)"
         by (auto simp: heapmap_\<alpha>_def hm_key_of_def hmr_\<alpha>_def h.val_of_def)
         
       from INV have INV': "h.heap_invar (hmr_\<alpha> hm)"  
         unfolding heapmap_invar_def by auto
 
       from V' INV obtain i where IDX: "h.valid (hmr_\<alpha> hm) i" 
         and CNV_RHS: "prio v' = h.prio_of (hmr_\<alpha> hm) i" 
         apply (clarsimp simp: heapmap_\<alpha>_def heapmap_invar_def hmr_invar_def hmr_\<alpha>_def
           h.valid_def h.val_of_def)
         by (metis (no_types, opaque_lifting) Suc_leI comp_apply diff_Suc_Suc 
           diff_zero domI index_less_size_conv neq0_conv nth_index nth_map 
           old.nat.distinct(2) option.sel)
         
       from h.heap_min_prop[OF INV' IDX] show ?thesis
         unfolding CNV_LHS CNV_RHS .
     qed    
 
 
     text \<open>With the above lemma, the correctness proof is straightforward\<close>
     lemma hm_pop_min_\<alpha>_correct: "hm_pop_min_op hm \<le>\<^sub>n SPEC (\<lambda>((k,v),hm'). 
         heapmap_\<alpha> hm k = Some v 
       \<and> heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k:=None) 
       \<and> (\<forall>k' v'. heapmap_\<alpha> hm k' = Some v' \<longrightarrow> prio v \<le> prio v'))"  
       unfolding hm_pop_min_op_def hm_key_of_op_unfold hm_the_lookup_op_def
       apply (refine_vcg 
         hm_exch_op_\<alpha>_correct[THEN leof_trans]
         hm_butlast_op_\<alpha>_correct[THEN leof_trans]
         hm_sink_op_\<alpha>_correct[THEN leof_trans]
         )
       apply (auto simp: heapmap_min_prop)
       done  
 
     lemma heapmap_nres_rel_prodI:
       assumes "hmx \<le> \<Down>(UNIV \<times>\<^sub>r hmr_rel) h'x"
       assumes "h'x \<le> SPEC (\<lambda>(_,h'). h.heap_invar h')"
       assumes "hmx \<le>\<^sub>n SPEC (\<lambda>(r,hm'). RETURN (r,heapmap_\<alpha> hm') \<le> \<Down>(R\<times>\<^sub>rId) hx)"
       shows "hmx \<le> \<Down>(R\<times>\<^sub>rheapmap_rel) hx"
       using assms
       unfolding heapmap_rel_def hmr_rel_def br_def heapmap_invar_def
       apply (auto simp: pw_le_iff pw_leof_iff refine_pw_simps; blast)
       done
       
 
     lemma hm_pop_min_op_aref: "(hm_pop_min_op, PR_CONST (mop_pm_pop_min prio)) \<in> heapmap_rel \<rightarrow> \<langle>(Id\<times>\<^sub>rId)\<times>\<^sub>rheapmap_rel\<rangle>nres_rel"  
       unfolding PR_CONST_def
       apply (intro fun_relI nres_relI)
       apply (frule heapmap_hmr_relI)
       unfolding mop_pm_pop_min_alt
       apply (intro ASSERT_refine_right)
       apply (rule heapmap_nres_rel_prodI)
       apply (rule hm_pop_min_op_refine[param_fo, THEN nres_relD]; assumption)
       unfolding heapmap_rel_def hmr_rel_def in_br_conv
       apply (refine_vcg; simp)
       apply (refine_vcg hm_pop_min_\<alpha>_correct[THEN leof_trans]; simp split: prod.splits)
       done
       
     text_raw \<open>\paragraph{Second approach}\<close>
 
     (* Alternative approach: Also use knowledge about result
       in multiset domain. Obtaining property seems infeasible at first attempt! *)  
 
     definition "hm_kv_of_op hm i \<equiv> do {
       ASSERT (hm_valid hm i \<and> hmr_invar hm);
       k \<leftarrow> hm_key_of_op hm i;
       v \<leftarrow> hm_the_lookup_op hm k;
       RETURN (k, v)
     }"
 
 
     definition "kvi_rel hm i \<equiv> {((k,v),v) | k v. hm_key_of hm i = k}"
 
     lemma hm_kv_op_refine[refine]:
       assumes "(hm,h)\<in>hmr_rel"
       shows "hm_kv_of_op hm i \<le> \<Down>(kvi_rel hm i) (h.val_of_op h i)"
       unfolding hm_kv_of_op_def h.val_of_op_def kvi_rel_def 
         hm_key_of_op_unfold hm_the_lookup_op_def
       apply simp  
       apply refine_vcg
       using assms
       by (auto 
         simp: hm_valid_def hm_length_def hmr_rel_defs heapmap_\<alpha>_def hm_key_of_def
         split: prod.splits)
 
     definition hm_pop_min_op' :: "('k,'v) ahm \<Rightarrow> (('k\<times>'v) \<times> ('k,'v) ahm) nres" where
       "hm_pop_min_op' hm \<equiv> do {
         ASSERT (heapmap_invar hm);
         ASSERT (hm_valid hm 1);
         kv \<leftarrow> hm_kv_of_op hm 1;
         let l = hm_length hm;
         hm \<leftarrow> hm_exch_op hm 1 l;
         hm \<leftarrow> hm_butlast_op hm;
         
         if (l\<noteq>1) then do {
           hm \<leftarrow> hm_sink_op hm 1;
           RETURN (kv,hm)
         } else RETURN (kv,hm)
       }"
 
 
     lemma hm_pop_min_op_refine': 
       "\<lbrakk> (hm,h)\<in>hmr_rel \<rbrakk> \<Longrightarrow> hm_pop_min_op' hm \<le> \<Down>(kvi_rel hm 1 \<times>\<^sub>r hmr_rel) (h.pop_min_op h)"
       unfolding hm_pop_min_op'_def h.pop_min_op_def
       (* Project away stuff of second component *)
       unfolding ignore_snd_refine_conv
       (* Prove refinement *)
       apply refine_rcg
       unfolding hmr_rel_def heapmap_rel_def
       apply (unfold heapmap_invar_def; simp add: in_br_conv)
       apply (simp_all add: in_br_conv)
       done
 
 
     lemma heapmap_nres_rel_prodI':
       assumes "hmx \<le> \<Down>(S \<times>\<^sub>r hmr_rel) h'x"
       assumes "h'x \<le> SPEC \<Phi>"
       assumes "\<And>h' r. \<Phi> (r,h') \<Longrightarrow> h.heap_invar h'"
       assumes "hmx \<le>\<^sub>n SPEC (\<lambda>(r,hm'). (\<exists>r'. (r,r')\<in>S \<and> \<Phi> (r',hmr_\<alpha> hm')) \<and> hmr_invar hm' \<longrightarrow> RETURN (r,heapmap_\<alpha> hm') \<le> \<Down>(R\<times>\<^sub>rId) hx)"
       shows "hmx \<le> \<Down>(R\<times>\<^sub>rheapmap_rel) hx"
       using assms
       unfolding heapmap_rel_def hmr_rel_def heapmap_invar_def
       apply (auto 
         simp: pw_le_iff pw_leof_iff refine_pw_simps in_br_conv
         )
       by meson
 
     lemma ex_in_kvi_rel_conv:
       "(\<exists>r'. (r,r')\<in>kvi_rel hm i \<and> \<Phi> r') \<longleftrightarrow> (fst r = hm_key_of hm i \<and> \<Phi> (snd r))"  
       unfolding kvi_rel_def
       apply (cases r)
       apply auto
       done
 
       
     lemma hm_pop_min_aref': "(hm_pop_min_op', mop_pm_pop_min prio) \<in> heapmap_rel \<rightarrow> \<langle>(Id\<times>\<^sub>rId) \<times>\<^sub>r heapmap_rel\<rangle>nres_rel"  
       apply (intro fun_relI nres_relI)
       apply (frule heapmap_hmr_relI)
       unfolding mop_pm_pop_min_alt
       apply (intro ASSERT_refine_right)
       apply (rule heapmap_nres_rel_prodI')
         apply (erule hm_pop_min_op_refine')
 
         apply (unfold heapmap_rel_def hmr_rel_def in_br_conv) []
         apply (rule h.pop_min_op_correct)
         apply simp
         apply simp
 
         apply simp
 
         apply (clarsimp simp: ex_in_kvi_rel_conv split: prod.splits)
         unfolding hm_pop_min_op'_def hm_kv_of_op_def hm_key_of_op_unfold
           hm_the_lookup_op_def
         apply (refine_vcg 
           hm_exch_op_\<alpha>_correct[THEN leof_trans]
           hm_butlast_op_\<alpha>_correct[THEN leof_trans]
           hm_sink_op_\<alpha>_correct[THEN leof_trans]
           )
         unfolding heapmap_rel_def hmr_rel_def in_br_conv
         apply (auto intro: ranI) 
       done
 
     subsubsection \<open>Remove\<close>  
 
     definition "hm_remove_op k hm \<equiv> do {
       ASSERT (heapmap_invar hm);
       ASSERT (k \<in> dom (heapmap_\<alpha> hm));
       i \<leftarrow> hm_index_op hm k;
       let l = hm_length hm;
       hm \<leftarrow> hm_exch_op hm i l;
       hm \<leftarrow> hm_butlast_op hm;
       if i \<noteq> l then
         hm_repair_op hm i
       else  
         RETURN hm
     }"
 
     definition (in heapstruct) "remove_op i h \<equiv> do {
       ASSERT (heap_invar h);
       ASSERT (valid h i);
       let l = length h;
       h \<leftarrow> exch_op h i l;
       h \<leftarrow> butlast_op h;
       if i \<noteq> l then
         repair_op h i
       else  
         RETURN h
     }"
 
     lemma (in -) swap_empty_iff[iff]: "swap l i j = [] \<longleftrightarrow> l=[]"
       by (auto simp: swap_def)
 
     lemma (in heapstruct) 
       butlast_exch_last: "butlast (exch h i (length h)) = update (butlast h) i (last h)"  
       unfolding exch_def update_def
       apply (cases h rule: rev_cases)
       apply (auto simp: swap_def butlast_list_update)
       done
 
     lemma (in heapstruct) remove_op_invar: 
       "\<lbrakk> heap_invar h; valid h i \<rbrakk> \<Longrightarrow> remove_op i h \<le> SPEC heap_invar"
       unfolding remove_op_def
       apply refine_vcg
       apply (auto simp: valid_def) []
       apply (auto simp: valid_def exch_def) []
       apply (simp add: butlast_exch_last)
       apply refine_vcg
       apply auto []
       apply auto []
       apply (auto simp: valid_def) []
       apply auto []
       apply auto []
       done
 
     lemma hm_remove_op_refine[refine]: 
       "\<lbrakk> (hm,m)\<in>heapmap_rel; (hm,h)\<in>hmr_rel; heapmap_\<alpha> hm k \<noteq> None\<rbrakk> \<Longrightarrow> 
         hm_remove_op k hm \<le> \<Down>hmr_rel (h.remove_op (hm_index hm k) h)"
       unfolding hm_remove_op_def h.remove_op_def heapmap_rel_def
       (*apply (rewrite at "Let (hm_index hm k) _" Let_def)*)
       apply (refine_rcg index_op_inline_refine)
       unfolding hmr_rel_def
       apply (auto simp: in_br_conv)
       done
 
     lemma hm_remove_op_\<alpha>_correct: 
       "hm_remove_op k hm \<le>\<^sub>n SPEC (\<lambda>hm'. heapmap_\<alpha> hm' = (heapmap_\<alpha> hm)(k:=None))"  
       unfolding hm_remove_op_def
       apply (refine_vcg 
         hm_exch_op_\<alpha>_correct[THEN leof_trans]
         hm_butlast_op_\<alpha>_correct[THEN leof_trans]
         hm_repair_op_\<alpha>_correct[THEN leof_trans]
         hm_index_op_inline_leof
         )
       apply (auto; fail)
       
       apply clarsimp
       apply (rewrite at "hm_index _ k = hm_length _" in asm eq_commute)
       apply (auto; fail)
       done
 
     lemma hm_remove_op_aref:
       "(hm_remove_op,mop_map_delete_ex) \<in> Id \<rightarrow> heapmap_rel \<rightarrow> \<langle>heapmap_rel\<rangle>nres_rel"
       apply (intro fun_relI nres_relI)
       unfolding mop_map_delete_ex_alt
       apply (rule ASSERT_refine_right)
       apply (frule heapmap_hmr_relI)
       apply (rule heapmap_nres_relI')
       apply (rule hm_remove_op_refine; assumption?)
       apply (unfold heapmap_rel_def in_br_conv; auto)
 
       unfolding heapmap_rel_def hmr_rel_def in_br_conv 
       apply (refine_vcg h.remove_op_invar; clarsimp; fail)
       apply (refine_vcg hm_remove_op_\<alpha>_correct[THEN leof_trans]; simp; fail)
       done
       
     subsubsection \<open>Peek-Min\<close> 
 
 
     definition hm_peek_min_op :: "('k,'v) ahm \<Rightarrow> ('k\<times>'v) nres" where
       "hm_peek_min_op hm \<equiv> hm_kv_of_op hm 1"
 
     lemma hm_peek_min_op_aref: 
       "(hm_peek_min_op, PR_CONST (mop_pm_peek_min prio)) \<in> heapmap_rel \<rightarrow> \<langle>Id\<times>\<^sub>rId\<rangle>nres_rel"  
       unfolding PR_CONST_def
       apply (intro fun_relI nres_relI)
     proof -  
       fix hm and m :: "'k \<rightharpoonup> 'v"
       assume A: "(hm,m)\<in>heapmap_rel"
       
       from A have [simp]: "h.heap_invar (hmr_\<alpha> hm)" "hmr_invar hm" "m=heapmap_\<alpha> hm"
         unfolding heapmap_rel_def in_br_conv heapmap_invar_def
         by simp_all
 
       have "hm_peek_min_op hm \<le> \<Down> (kvi_rel hm 1) (h.peek_min_op (hmr_\<alpha> hm))"
         unfolding hm_peek_min_op_def  h.peek_min_op_def
         apply (refine_rcg hm_kv_op_refine)
         using A
         apply (simp add: heapmap_hmr_relI)
         done
       also have "\<lbrakk>hmr_\<alpha> hm \<noteq> []\<rbrakk> \<Longrightarrow> (h.peek_min_op (hmr_\<alpha> hm)) 
         \<le> SPEC (\<lambda>v. v\<in>ran (heapmap_\<alpha> hm) \<and> (\<forall>v'\<in>ran (heapmap_\<alpha> hm). prio v \<le> prio v'))"  
         apply refine_vcg
         by simp_all
       finally show "hm_peek_min_op hm \<le> \<Down> (Id \<times>\<^sub>r Id) (mop_pm_peek_min prio m)"  
         unfolding mop_pm_peek_min_alt
         apply (simp add: pw_le_iff refine_pw_simps hm_peek_min_op_def hm_kv_of_op_def 
             hm_key_of_op_unfold hm_the_lookup_op_def)
         apply (fastforce simp: kvi_rel_def ran_def)
         done
 
     qed    
 
 
   end
 
 end
diff --git a/thys/Transitive-Closure/RBT_Map_Set_Extension.thy b/thys/Transitive-Closure/RBT_Map_Set_Extension.thy
--- a/thys/Transitive-Closure/RBT_Map_Set_Extension.thy
+++ b/thys/Transitive-Closure/RBT_Map_Set_Extension.thy
@@ -1,324 +1,324 @@
 (*  Title:       Executable Transitive Closures of Finite Relations
     Author:      Christian Sternagel <c.sternagel@gmail.com>
                  René Thiemann       <rene.thiemann@uibk.ac.at>
     Maintainer:  Christian Sternagel and René Thiemann
     License:     LGPL
 *)
 
 section \<open>Accessing Values via Keys\<close>
 
 theory RBT_Map_Set_Extension
 imports
   Collections.RBTMapImpl 
   Collections.RBTSetImpl
   Matrix.Utility
 begin
 
 text \<open>
   We provide two extensions of the red black tree implementation.
 
   The first extension provides two convenience methods on sets which are represented by red black
   trees: a check on subsets and the big union operator. 
 
   The second extension is to provide two operations @{term elem_list_to_rm} and @{term
   rm_set_lookup} which can be used to index a set of values via keys. More precisely, given a list
   of values of type @{typ "'v"} and a key function of type @{typ "'v => 'k"}, @{term
   elem_list_to_rm} will generate a map of type @{typ "'k => 'v set"}. Then with @{term
   rs_set_lookup} we can efficiently access all values which match a given key.
 \<close>
 
 subsection \<open>Subset and Union\<close>
 
 text \<open>
   For the subset operation @{term "r \<subseteq> s"} we provide two implementations. The first one (@{term
   rs_subset}) traverses over @{term r} and then performs membership tests \<open>\<in> s\<close>. Its
   complexity is ${\cal O}(|r| \cdot log (|s|))$. The second one (@{term rs_subset_list}) generates
   sorted lists for both @{term r} and @{term s} and then linearly checks the subset condition. Its
   complexity is ${\cal O}(|r| + |s|)$.
 \<close>
 
 text \<open>
   As union operator we use the standard fold function. Note that the order of the union is important
   so that new sets are added to the big union.
 \<close>
 
 (* perhaps there is a smarter way to use two iterates at the same time, however,
   when writing this theory this feature was not detected in the RBTSetImpl theory *)
 definition rs_subset :: "('a :: linorder) rs \<Rightarrow> 'a rs \<Rightarrow> 'a option"
 where
   "rs_subset as bs = rs.iteratei
     as
     (\<lambda> maybe. case maybe of None \<Rightarrow> True | Some _ \<Rightarrow> False)
     (\<lambda> a _. if rs.memb a bs then None else Some a)
     None"
 
 lemma rs_subset [simp]:
   "rs_subset as bs = None \<longleftrightarrow> rs.\<alpha> as \<subseteq> rs.\<alpha> bs"
 proof -
   let ?abort = "\<lambda> maybe. case maybe of None \<Rightarrow> True | Some _ \<Rightarrow> False"
   let ?I = "\<lambda> aas maybe. maybe = None \<longleftrightarrow> (\<forall> a. a \<in> rs.\<alpha> as - aas \<longrightarrow> a \<in> rs.\<alpha> bs)"
   let ?it = "rs_subset as bs"
   have "?I {} ?it \<or> (\<exists> it \<subseteq> rs.\<alpha> as. it \<noteq> {} \<and> \<not> ?abort ?it \<and> ?I it ?it)"
     unfolding rs_subset_def
     by (rule rs.iteratei_rule_P [where I="?I"]) (auto simp: rs.correct)
   then show ?thesis by auto
 qed
     
 definition rs_subset_list :: "('a :: linorder) rs \<Rightarrow> 'a rs \<Rightarrow> 'a option"
 where
   "rs_subset_list as bs = sorted_list_subset (rs.to_sorted_list as) (rs.to_sorted_list bs)"
 
 lemma rs_subset_list [simp]:
   "rs_subset_list as bs = None \<longleftrightarrow> rs.\<alpha> as \<subseteq> rs.\<alpha> bs"
   unfolding rs_subset_list_def
     sorted_list_subset[OF rs.to_sorted_list_correct(3)[OF rs.invar, of as]
     rs.to_sorted_list_correct(3)[OF rs.invar, of bs]]
   by (simp add: rs.to_sorted_list_correct)
 
 definition rs_Union :: "('q :: linorder) rs list \<Rightarrow> 'q rs"
 where
   "rs_Union = foldl rs.union (rs.empty ())"
 
 lemma rs_Union [simp]:
   "rs.\<alpha> (rs_Union qs) = \<Union> (rs.\<alpha> ` set qs)"
 proof -
   { 
     fix start
     have "rs.\<alpha> (foldl rs.union start qs) = rs.\<alpha> start \<union> \<Union> (rs.\<alpha> ` set qs)"
       by (induct qs arbitrary: start, auto simp: rs.correct)
   } from this[of "rs.empty ()"]
   show ?thesis unfolding rs_Union_def
     by (auto simp: rs.correct)
 qed
 
 subsection \<open>Grouping Values via Keys\<close>
  
 text \<open>
   The functions to produce the index (@{term elem_list_to_rm}) and the lookup function (@{term
   rm_set_lookup}) are straight-forward, however it requires some tedious reasoning that they perform
   as they should.
 \<close>
 fun elem_list_to_rm :: "('d \<Rightarrow> 'k :: linorder) \<Rightarrow> 'd list \<Rightarrow> ('k, 'd list) rm"
 where
   "elem_list_to_rm key [] = rm.empty ()" |
   "elem_list_to_rm key (d # ds) =
     (let
       rm = elem_list_to_rm key ds;
       k = key d
     in
       (case rm.\<alpha> rm k of
         None \<Rightarrow> rm.update_dj k [d] rm
       | Some data \<Rightarrow> rm.update k (d # data) rm))"
 
 definition "rm_set_lookup rm = (\<lambda> a. (case rm.\<alpha> rm a of None \<Rightarrow> [] | Some rules \<Rightarrow> rules))"
 
 lemma rm_to_list_empty [simp]:
   "rm.to_list (rm.empty ()) = []" 
 proof -
   have "map_of (rm.to_list (rm.empty ())) = Map.empty" 
     by (simp add: rm.correct)
   moreover have map_of_empty_iff: "\<And>l. map_of l = Map.empty \<longleftrightarrow> l = []"
     by (case_tac l) auto
   ultimately show ?thesis by metis
 qed
 
 locale rm_set = 
   fixes rm :: "('k :: linorder, 'd list) rm"
     and key :: "'d \<Rightarrow> 'k"
     and data :: "'d set"
   assumes rm_set_lookup: "\<And> k. set (rm_set_lookup rm k) = {d \<in> data. key d = k}"
 begin
 
 lemma data_lookup:
   "data = \<Union> {set (rm_set_lookup rm k) | k. True}" (is "_ = ?R")
 proof -
   { 
     fix d
     assume d: "d \<in> data"
     then have d: "d \<in> {d' \<in> data. key d' = key d}" by auto
     have "d \<in> ?R"
       by (rule UnionI[OF _ d], rule CollectI, rule exI[of _ "key d"], unfold rm_set_lookup[of "key d"], simp)
   }
   moreover
   {
     fix d
     assume "d \<in> ?R"
     from this[unfolded rm_set_lookup]
     have "d \<in> data" by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma finite_data:
   "finite data"
   unfolding data_lookup
 proof
   show "finite {set (rm_set_lookup rm k) | k. True}" (is "finite ?L")
   proof - 
     let ?rmset = "rm.\<alpha> rm"
     let ?M = "?rmset ` Map.dom ?rmset"
     let ?N = "((\<lambda> e. set (case e of None \<Rightarrow> [] | Some ds \<Rightarrow> ds)) ` ?M)"
     let ?K = "?N \<union> {{}}"
     from rm.finite[of rm] have fin: "finite ?K" by auto 
     show ?thesis 
     proof (rule finite_subset[OF _ fin], rule)
       fix ds
       assume "ds \<in> ?L"
       from this[unfolded rm_set_lookup_def]
       obtain fn where ds: "ds = set (case rm.\<alpha> rm fn of None \<Rightarrow> []
           | Some ds \<Rightarrow> ds)" by auto
       show "ds \<in> ?K" 
       proof (cases "rm.\<alpha> rm fn")
         case None
         then show ?thesis unfolding ds by auto
       next
         case (Some rules)
         from Some have fn: "fn \<in> Map.dom ?rmset" by auto
         have "ds \<in> ?N"
           unfolding ds
           by (rule, rule refl, rule, rule refl, rule fn)
         then show ?thesis by auto
       qed
     qed
   qed
 qed (force simp: rm_set_lookup_def)
 
 end
 
 interpretation elem_list_to_rm: rm_set "elem_list_to_rm key ds" key "set ds"
 proof
   fix k
   show "set (rm_set_lookup (elem_list_to_rm key ds) k) = {d \<in> set ds. key d = k}"
   proof (induct ds arbitrary: k)
     case Nil
     then show ?case unfolding rm_set_lookup_def 
       by (simp add: rm.correct)
   next
     case (Cons d ds k)
     let ?el = "elem_list_to_rm key"
     let ?l = "\<lambda>k ds. set (rm_set_lookup (?el ds) k)"
     let ?r = "\<lambda>k ds. {d \<in> set ds. key d = k}"
     from Cons have ind:
       "\<And> k. ?l k ds = ?r k ds" by auto
     show "?l k (d # ds) = ?r k (d # ds)"
     proof (cases "rm.\<alpha> (?el ds) (key d)")
       case None
       from None ind[of "key d"] have r: "{da \<in> set ds. key da = key d} = {}"
         unfolding rm_set_lookup_def by auto
       from None have el: "?el (d # ds) = rm.update_dj (key d) [d] (?el ds)"
         by simp
       from None have ndom: "key d \<notin> Map.dom (rm.\<alpha> (?el ds))" by auto
       have r: "?r k (d # ds) = ?r k ds \<inter> {da. key da \<noteq> key d} \<union> {da . key da = k \<and> da = d}" (is "_ = ?r1 \<union> ?r2") using r by auto
       from ndom have l: "?l k (d # ds) = 
-        set (case (rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> [d])) k of None \<Rightarrow> []
+        set (case ((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> [d])) k of None \<Rightarrow> []
         | Some rules \<Rightarrow> rules)" (is "_ = ?l") unfolding el rm_set_lookup_def 
         by (simp add: rm.correct)
       {
         fix da
         assume "da \<in> ?r1 \<union> ?r2"
         then have "da \<in> ?l"
         proof
           assume "da \<in> ?r2"
           then have da: "da = d" and k: "key d = k" by auto
           show ?thesis unfolding da k by auto
         next
           assume "da \<in> ?r1"
           from this[unfolded ind[symmetric] rm_set_lookup_def]
           obtain das where rm: "rm.\<alpha> (?el ds) k = Some das" and da: "da \<in> set das" and k: "key da \<noteq> key d" by (cases "rm.\<alpha> (?el ds) k", auto)
           from ind[of k, unfolded rm_set_lookup_def] rm da k have k: "key d \<noteq> k" by auto
-          have rm: "(rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> [d])) k = Some das"
+          have rm: "((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> [d])) k = Some das"
             unfolding rm[symmetric] using k by auto
           show ?thesis unfolding rm using da by auto
         qed
       } 
       moreover 
       {
         fix da
         assume l: "da \<in> ?l"
         let ?rm = "((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> [d])) k"
         from l obtain das where rm: "?rm = Some das" and da: "da \<in> set das"
           by (cases ?rm, auto)
         have "da \<in> ?r1 \<union> ?r2" 
         proof (cases "k = key d")
           case True
           with rm da have da: "da = d" by auto
           then show ?thesis using True by auto
         next
           case False
           with rm have "rm.\<alpha> (?el ds) k = Some das" by auto
           from ind[of k, unfolded rm_set_lookup_def this] da False
           show ?thesis by auto
         qed
       }
       ultimately have "?l = ?r1 \<union> ?r2" by blast
       then show ?thesis unfolding l r .
     next
       case (Some das)
       from Some ind[of "key d"] have das: "{da \<in> set ds. key da = key d} = set das"
         unfolding rm_set_lookup_def by auto
       from Some have el: "?el (d # ds) = rm.update (key d) (d # das) (?el ds)"
         by simp
       from Some have dom: "key d \<in> Map.dom (rm.\<alpha> (?el ds))" by auto
       from dom have l: "?l k (d # ds) = 
-        set (case (rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> (d # das))) k of None \<Rightarrow> []
+        set (case ((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> (d # das))) k of None \<Rightarrow> []
         | Some rules \<Rightarrow> rules)" (is "_ = ?l") unfolding el rm_set_lookup_def 
         by (simp add: rm.correct)
       have r: "?r k (d # ds) = ?r k ds \<union> {da. key da = k \<and> da = d}" (is "_ = ?r1 \<union> ?r2")  by auto
       {
         fix da
         assume "da \<in> ?r1 \<union> ?r2"
         then have "da \<in> ?l"
         proof
           assume "da \<in> ?r2"
           then have da: "da = d" and k: "key d = k" by auto
           show ?thesis unfolding da k by auto
         next
           assume "da \<in> ?r1"
           from this[unfolded ind[symmetric] rm_set_lookup_def]
           obtain das' where rm: "rm.\<alpha> (?el ds) k = Some das'" and da: "da \<in> set das'" by (cases "rm.\<alpha> (?el ds) k", auto)
           from ind[of k, unfolded rm_set_lookup_def rm] have das': "set das' = {d \<in> set ds. key d = k}" by auto
           show ?thesis 
           proof (cases "k = key d")
             case True
             show ?thesis using das' das da unfolding True by simp
           next
             case False
             then show ?thesis using das' da rm by auto
           qed
         qed
       } 
       moreover 
       {
         fix da
         assume l: "da \<in> ?l"
         let ?rm = "((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> d # das)) k"
         from l obtain das' where rm: "?rm = Some das'" and da: "da \<in> set das'"
           by (cases ?rm, auto)
         have "da \<in> ?r1 \<union> ?r2" 
         proof (cases "k = key d")
           case True
           with rm da das have da: "da \<in> set (d # das)" by auto
           then have "da = d \<or> da \<in> set das" by auto
           then have k: "key da = k" 
           proof
             assume "da = d"
             then show ?thesis using True by simp
           next
             assume "da \<in> set das"
             with das True show ?thesis by auto
           qed
           from da k show ?thesis using das by auto
         next
           case False
           with rm have "rm.\<alpha> (?el ds) k = Some das'" by auto
           from ind[of k, unfolded rm_set_lookup_def this] da False
           show ?thesis by auto
         qed
       }
       ultimately have "?l = ?r1 \<union> ?r2" by blast
       then show ?thesis unfolding l r .
     qed
   qed
 qed
 
 end