theory FWBisimLift imports
  FWInitFinLift
  FWBisimulation
begin

context FWbisimulation_base begin

inductive init_fin_bisim :: "'t \<Rightarrow> ((status \<times> 'x1) \<times> 'm1, (status \<times> 'x2) \<times> 'm2) bisim"
  ("_ \<turnstile> _ \<approx>i _"[50,50,50] 60)
for t :: 't
where
  PreStart: "t \<turnstile> (x1, m1) \<approx> (x2, m2) \<Longrightarrow> t \<turnstile> ((PreStart, x1), m1) \<approx>i ((PreStart, x2), m2)"
| Running: "t \<turnstile> (x1, m1) \<approx> (x2, m2) \<Longrightarrow> t \<turnstile> ((Running, x1), m1) \<approx>i ((Running, x2), m2)"
| Finished:
    "\<lbrakk> t \<turnstile> (x1, m1) \<approx> (x2, m2); final1 x1; final2 x2 \<rbrakk>
    \<Longrightarrow> t \<turnstile> ((Finished, x1), m1) \<approx>i ((Finished, x2), m2)"

definition init_fin_bisim_wait :: "(status \<times> 'x1, status \<times> 'x2) bisim" ("_ \<approx>iw _" [50,50] 60)
where
  "init_fin_bisim_wait = (\<lambda>(status1, x1) (status2, x2). status1 = Running \<and> status2 = Running \<and> x1 \<approx>w x2)"

inductive_simps init_fin_bisim_simps [simp]:
  "t \<turnstile> ((PreStart, x1), m1) \<approx>i ((s2, x2), m2)"
  "t \<turnstile> ((Running, x1), m1) \<approx>i ((s2, x2), m2)"
  "t \<turnstile> ((Finished, x1), m1) \<approx>i ((s2, x2), m2)"
  "t \<turnstile> ((s1, x1), m1) \<approx>i ((PreStart, x2), m2)"
  "t \<turnstile> ((s1, x1), m1) \<approx>i ((Running, x2), m2)"
  "t \<turnstile> ((s1, x1), m1) \<approx>i ((Finished, x2), m2)"

lemma init_fin_bisim_iff:
  "t \<turnstile> ((s1, x1), m1) \<approx>i ((s2, x2), m2) \<longleftrightarrow>
   s1 = s2 \<and> t \<turnstile> (x1, m1) \<approx> (x2, m2) \<and> (s2 = Finished \<longrightarrow> final1 x1 \<and> final2 x2)"
by(cases s1) auto

lemma nta_bisim_init_fin_bisim [simp]:
  "nta_bisim init_fin_bisim (convert_new_thread_action (Pair PreStart) nt1)
      (convert_new_thread_action (Pair PreStart) nt2) =
   nta_bisim bisim nt1 nt2"
by(cases nt1) simp_all

lemma ta_bisim_init_fin_bisim_convert [simp]:
  "ta_bisim init_fin_bisim (convert_TA_initial (convert_obs_initial ta1)) (convert_TA_initial (convert_obs_initial ta2)) \<longleftrightarrow> ta1 \<sim>m ta2"
by(auto simp add: ta_bisim_def list_all2_map1 list_all2_map2)

lemma ta_bisim_init_fin_bisim_InitialThreadAction [simp]:
  "ta_bisim init_fin_bisim \<lbrace>InitialThreadAction\<rbrace> \<lbrace>InitialThreadAction\<rbrace>"
by(simp add: ta_bisim_def)

lemma ta_bisim_init_fin_bisim_ThreadFinishAction [simp]:
  "ta_bisim init_fin_bisim \<lbrace>ThreadFinishAction\<rbrace> \<lbrace>ThreadFinishAction\<rbrace>"
by(simp add: ta_bisim_def)

lemma init_fin_bisim_wait_simps [simp]:
  "(status1, x1) \<approx>iw (status2, x2) \<longleftrightarrow> status1 = Running \<and> status2 = Running \<and> x1 \<approx>w x2"
by(simp add: init_fin_bisim_wait_def)

lemma init_fin_lift_state_mbisimI:
  "s \<approx>m s' \<Longrightarrow>
  FWbisimulation_base.mbisim init_fin_bisim init_fin_bisim_wait (init_fin_lift_state Running s) (init_fin_lift_state Running s')"
apply(rule FWbisimulation_base.mbisimI)
      apply(simp add: thr_init_fin_list_state' o_def dom_map_option mbisim_finite1)
     apply(simp add: locks_init_fin_lift_state mbisim_def)
    apply(simp add: wset_init_fin_lift_state mbisim_def)
   apply(simp add: interrupts_init_fin_lift_stae mbisim_def)
  apply(clarsimp simp add: wset_init_fin_lift_state mbisim_def thr_init_fin_list_state' o_def wset_thread_ok_conv_dom dom_map_option del: subsetI)
 apply(drule_tac t=t in mbisim_thrNone_eq)
 apply(simp add: thr_init_fin_list_state)
apply(clarsimp simp add: thr_init_fin_list_state shr_init_fin_lift_state wset_init_fin_lift_state init_fin_bisim_iff)
apply(frule (1) mbisim_thrD1)
apply(simp add: mbisim_def)
done

end

context FWdelay_bisimulation_base begin

lemma init_fin_delay_bisimulation_final_base:
  "delay_bisimulation_final_base (r1.init_fin t) (r2.init_fin t) (init_fin_bisim t)
     r1.init_fin_\<tau>move r2.init_fin_\<tau>move (\<lambda>(x1, m). r1.init_fin_final x1) (\<lambda>(x2, m). r2.init_fin_final x2)"
by(unfold_locales)(auto 4 3)

end

lemma init_fin_bisim_flip [flip_simps]:
  "FWbisimulation_base.init_fin_bisim final2 final1 (\<lambda>t. flip (bisim t)) =
   (\<lambda>t. flip (FWbisimulation_base.init_fin_bisim final1 final2 bisim t))"
by(auto simp only: FWbisimulation_base.init_fin_bisim_iff flip_simps fun_eq_iff split_paired_Ex)

lemma init_fin_bisim_wait_flip [flip_simps]:
  "FWbisimulation_base.init_fin_bisim_wait (flip bisim_wait) =
   flip (FWbisimulation_base.init_fin_bisim_wait bisim_wait)"
by(auto simp add: fun_eq_iff FWbisimulation_base.init_fin_bisim_wait_simps flip_simps)

context FWdelay_bisimulation_lift_aux begin

lemma init_fin_FWdelay_bisimulation_lift_aux:
  "FWdelay_bisimulation_lift_aux r1.init_fin_final r1.init_fin r2.init_fin_final r2.init_fin r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
by(intro FWdelay_bisimulation_lift_aux.intro r1.\<tau>multithreaded_wf_init_fin r2.\<tau>multithreaded_wf_init_fin)

lemma init_fin_FWdelay_bisimulation_final_base:
  "FWdelay_bisimulation_final_base
     r1.init_fin_final r1.init_fin r2.init_fin_final r2.init_fin
     init_fin_bisim r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
by(intro FWdelay_bisimulation_final_base.intro init_fin_FWdelay_bisimulation_lift_aux FWdelay_bisimulation_final_base_axioms.intro init_fin_delay_bisimulation_final_base)

end

context FWdelay_bisimulation_obs begin

lemma init_fin_simulation1:
  assumes bisim: "t \<turnstile> s1 \<approx>i s2"
    and red1: "r1.init_fin t s1 tl1 s1'"
    and \<tau>1: "\<not> r1.init_fin_\<tau>move s1 tl1 s1'"
  shows "\<exists>s2' s2'' tl2. (\<tau>trsys.silent_move (r2.init_fin t) r2.init_fin_\<tau>move)\<^sup>*\<^sup>* s2 s2' \<and>
             r2.init_fin t s2' tl2 s2'' \<and> \<not> r2.init_fin_\<tau>move s2' tl2 s2'' \<and>
             t \<turnstile> s1' \<approx>i s2'' \<and> ta_bisim init_fin_bisim tl1 tl2"
proof -
  from bisim obtain status x1 m1 x2 m2
    where s1: "s1 = ((status, x1), m1)"
    and s2: "s2 = ((status, x2), m2)"
    and bisim: "t \<turnstile> (x1, m1) \<approx> (x2, m2)"
    and finished: "status = Finished \<Longrightarrow> final1 x1 \<and> final2 x2"
    by(cases s1)(cases s2, fastforce simp add: init_fin_bisim_iff)
  from red1 show ?thesis unfolding s1
  proof(cases)
    case (NormalAction ta1 x1' m1')
    with \<tau>1 s1 have "\<not> \<tau>move1 (x1, m1) ta1 (x1', m1')" by(simp)
    from simulation1[OF bisim \<open>t \<turnstile> (x1, m1) -1-ta1\<rightarrow> (x1', m1')\<close> this]
    obtain x2' m2' x2'' m2'' ta2
      where red2: "r2.silent_moves t (x2, m2) (x2', m2')"
      and red2': "t \<turnstile> (x2', m2') -2-ta2\<rightarrow> (x2'', m2'')"
      and \<tau>2: "\<not> \<tau>move2 (x2', m2') ta2 (x2'', m2'')"
      and bisim': "t \<turnstile> (x1', m1') \<approx> (x2'', m2'')"
      and tasim: "ta1 \<sim>m ta2" by auto
    let ?s2' = "((Running, x2'), m2')"
    let ?s2'' = "((Running, x2''), m2'')"
    let ?ta2 = "(convert_TA_initial (convert_obs_initial ta2))"
    from red2 have "\<tau>trsys.silent_moves (r2.init_fin t) r2.init_fin_\<tau>move s2 ?s2'"
      unfolding s2 \<open>status = Running\<close> by(rule r2.init_fin_silent_moves_RunningI)
    moreover from red2' have "r2.init_fin t ?s2' ?ta2 ?s2''" by(rule r2.init_fin.NormalAction)
    moreover from \<tau>2 have "\<not> r2.init_fin_\<tau>move ?s2' ?ta2 ?s2''" by simp
    moreover from bisim' have "t \<turnstile> s1' \<approx>i ?s2''"using \<open>s1' = ((Running, x1'), m1')\<close> by simp
    moreover from tasim \<open>tl1 = convert_TA_initial (convert_obs_initial ta1)\<close>
    have "ta_bisim init_fin_bisim tl1 ?ta2" by simp
    ultimately show ?thesis by blast
  next
    case InitialThreadAction
    with s1 s2 bisim show ?thesis by(auto simp del: split_paired_Ex)
  next
    case ThreadFinishAction
    from final1_simulation[OF bisim] \<open>final1 x1\<close>
    obtain x2' m2' where red2: "r2.silent_moves t (x2, m2) (x2', m2')"
      and bisim': "t \<turnstile> (x1, m1) \<approx> (x2', m2')"
      and fin2: "final2 x2'" by auto
    let ?s2' = "((Running, x2'), m2')"
    let ?s2'' = "((Finished, x2'), m2')"
    from red2 have "\<tau>trsys.silent_moves (r2.init_fin t) r2.init_fin_\<tau>move s2 ?s2'"
      unfolding s2 \<open>status = Running\<close> by(rule r2.init_fin_silent_moves_RunningI)
    moreover from fin2 have "r2.init_fin t ?s2' \<lbrace>ThreadFinishAction\<rbrace> ?s2''" ..
    moreover have "\<not> r2.init_fin_\<tau>move ?s2' \<lbrace>ThreadFinishAction\<rbrace> ?s2''" by simp
    moreover have "t \<turnstile> s1' \<approx>i ?s2''"
      using \<open>s1' = ((Finished, x1), m1)\<close> fin2 \<open>final1 x1\<close> bisim' by simp
    ultimately show ?thesis unfolding \<open>tl1 = \<lbrace>ThreadFinishAction\<rbrace>\<close>
      by(blast intro: ta_bisim_init_fin_bisim_ThreadFinishAction)
  qed
qed

lemma init_fin_simulation2:
  "\<lbrakk> t \<turnstile> s1 \<approx>i s2; r2.init_fin t s2 tl2 s2'; \<not> r2.init_fin_\<tau>move s2 tl2 s2' \<rbrakk>
  \<Longrightarrow> \<exists>s1' s1'' tl1. (\<tau>trsys.silent_move (r1.init_fin t) r1.init_fin_\<tau>move)\<^sup>*\<^sup>* s1 s1' \<and>
             r1.init_fin t s1' tl1 s1'' \<and> \<not> r1.init_fin_\<tau>move s1' tl1 s1'' \<and>
             t \<turnstile> s1'' \<approx>i s2' \<and> ta_bisim init_fin_bisim tl1 tl2"
using FWdelay_bisimulation_obs.init_fin_simulation1[OF FWdelay_bisimulation_obs_flip]
unfolding flip_simps .

lemma init_fin_simulation_Wakeup1:
  assumes bisim: "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)"
  and wait: "sx1 \<approx>iw sx2"
  and red1: "r1.init_fin t (sx1, m1) ta1 (sx1', m1')"
  and wakeup: "Notified \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub>"
  shows "\<exists>ta2 sx2' m2'. r2.init_fin t (sx2, m2) ta2 (sx2', m2') \<and> t \<turnstile> (sx1', m1') \<approx>i (sx2', m2') \<and>
                        ta_bisim init_fin_bisim ta1 ta2"
proof -
  from bisim wait obtain status x1 x2
    where sx1: "sx1 = (status, x1)"
    and sx2: "sx2 = (status, x2)"
    and Bisim: "t \<turnstile> (x1, m1) \<approx> (x2, m2)"
    and Wait: "x1 \<approx>w x2" by cases auto
  from red1 wakeup sx1 obtain x1' ta1'
    where sx1': "sx1' = (Running, x1')"
    and status: "status = Running"
    and Red1: "t \<turnstile> (x1, m1) -1-ta1'\<rightarrow> (x1', m1')"
    and ta1: "ta1 = convert_TA_initial (convert_obs_initial ta1')"
    and Wakeup: "Notified \<in> set \<lbrace>ta1'\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta1'\<rbrace>\<^bsub>w\<^esub>"
    by cases auto
  from simulation_Wakeup1[OF Bisim Wait Red1 Wakeup] obtain ta2' x2' m2'
    where red2: "t \<turnstile> (x2, m2) -2-ta2'\<rightarrow> (x2', m2')"
    and bisim': "t \<turnstile> (x1', m1') \<approx> (x2', m2')"
    and tasim: "ta1' \<sim>m ta2'" by blast
  let ?sx2' = "(Running, x2')"
  let ?ta2 = "convert_TA_initial (convert_obs_initial ta2')"
  from red2 have "r2.init_fin t (sx2, m2) ?ta2 (?sx2', m2')" unfolding sx2 status ..
  moreover from bisim' sx1' have "t \<turnstile> (sx1', m1') \<approx>i (?sx2', m2')" by simp
  moreover from tasim ta1 have "ta_bisim init_fin_bisim ta1 ?ta2" by simp
  ultimately show ?thesis by blast
qed

lemma init_fin_simulation_Wakeup2:
  "\<lbrakk> t \<turnstile> (sx1, m1) \<approx>i (sx2, m2); sx1 \<approx>iw sx2; r2.init_fin t (sx2, m2) ta2 (sx2', m2');
    Notified \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub> \<rbrakk>
  \<Longrightarrow> \<exists>ta1 sx1' m1'. r1.init_fin t (sx1, m1) ta1 (sx1', m1') \<and> t \<turnstile> (sx1', m1') \<approx>i (sx2', m2') \<and>
                     ta_bisim init_fin_bisim ta1 ta2"
using FWdelay_bisimulation_obs.init_fin_simulation_Wakeup1[OF FWdelay_bisimulation_obs_flip]
unfolding flip_simps .

lemma init_fin_delay_bisimulation_obs:
  "delay_bisimulation_obs (r1.init_fin t) (r2.init_fin t) (init_fin_bisim t) (ta_bisim init_fin_bisim)
         r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
by(unfold_locales)(erule (2) init_fin_simulation1 init_fin_simulation2)+

lemma init_fin_FWdelay_bisimulation_obs:
  "FWdelay_bisimulation_obs r1.init_fin_final r1.init_fin r2.init_fin_final r2.init_fin init_fin_bisim init_fin_bisim_wait r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
proof(intro FWdelay_bisimulation_obs.intro init_fin_FWdelay_bisimulation_final_base FWdelay_bisimulation_obs_axioms.intro init_fin_delay_bisimulation_obs)
  fix t' sx m1 sxx m2 t sx1 sx2 sx1' ta1 sx1'' m1' sx2' ta2 sx2'' m2'
  assume bisim: "t' \<turnstile> (sx, m1) \<approx>i (sxx, m2)"
    and bisim1: "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)"
    and red1: "\<tau>trsys.silent_moves (r1.init_fin t) r1.init_fin_\<tau>move (sx1, m1) (sx1', m1)"
    and red1': "r1.init_fin t (sx1', m1) ta1 (sx1'', m1')"
    and \<tau>1: "\<not> r1.init_fin_\<tau>move (sx1', m1) ta1 (sx1'', m1')"
    and red2: "\<tau>trsys.silent_moves (r2.init_fin t) r2.init_fin_\<tau>move (sx2, m2) (sx2', m2)"
    and red2':"r2.init_fin t (sx2', m2) ta2 (sx2'', m2')"
    and \<tau>2: "\<not> r2.init_fin_\<tau>move (sx2', m2) ta2 (sx2'', m2')"
    and bisim1': "t \<turnstile> (sx1'', m1') \<approx>i (sx2'', m2')"
    and tasim: "ta_bisim init_fin_bisim ta1 ta2"
  from bisim obtain status x xx
    where sx:"sx = (status, x)"
    and sxx: "sxx = (status, xx)"
    and Bisim: "t' \<turnstile> (x, m1) \<approx> (xx, m2)"
    and Finish: "status = Finished \<Longrightarrow> final1 x \<and> final2 xx"
    by(cases sx)(cases sxx, auto simp add: init_fin_bisim_iff)
  from bisim1 obtain status1 x1 x2
    where sx1: "sx1 = (status1, x1)"
    and sx2: "sx2 = (status1, x2)"
    and Bisim1: "t \<turnstile> (x1, m1) \<approx> (x2, m2)"
    by(cases sx1)(cases sx2, auto simp add: init_fin_bisim_iff)
  from bisim1' obtain status1' x1'' x2''
    where sx1'': "sx1'' = (status1', x1'')"
    and sx2'': "sx2'' = (status1', x2'')"
    and Bisim1': "t \<turnstile> (x1'', m1') \<approx> (x2'', m2')"
     by(cases sx1'')(cases sx2'', auto simp add: init_fin_bisim_iff)
  from red1 sx1 obtain x1' where sx1': "sx1' = (status1, x1')"
    and Red1: "r1.silent_moves t (x1, m1) (x1', m1)"
    by(cases sx1')(auto dest: r1.init_fin_silent_movesD)
  from red2 sx2 obtain x2' where sx2': "sx2' = (status1, x2')"
    and Red2: "r2.silent_moves t (x2, m2) (x2', m2)"
    by(cases sx2')(auto dest: r2.init_fin_silent_movesD)
  show "t' \<turnstile> (sx, m1') \<approx>i (sxx, m2')"
  proof(cases "status1 = Running \<and> status1' = Running")
    case True
    with red1' sx1' sx1'' obtain ta1'
      where Red1': "t \<turnstile> (x1', m1) -1-ta1'\<rightarrow> (x1'', m1')"
      and ta1: "ta1 = convert_TA_initial (convert_obs_initial ta1')"
      by cases auto
    from red2' sx2' sx2'' True obtain ta2'
      where Red2': "t \<turnstile> (x2', m2) -2-ta2'\<rightarrow> (x2'', m2')"
      and ta2: "ta2 = convert_TA_initial (convert_obs_initial ta2')"
      by cases auto
    from \<tau>1 sx1' sx1'' ta1 True have \<tau>1':"\<not> \<tau>move1 (x1', m1) ta1' (x1'', m1')" by simp
    from \<tau>2 sx2' sx2'' ta2 True have \<tau>2':"\<not> \<tau>move2 (x2', m2) ta2' (x2'', m2')" by simp
    from tasim ta1 ta2 have "ta1' \<sim>m ta2'" by simp
    with Bisim Bisim1 Red1 Red1' \<tau>1' Red2 Red2' \<tau>2' Bisim1'
    have "t' \<turnstile> (x, m1') \<approx> (xx, m2')" by(rule bisim_inv_red_other)
    with True Finish show ?thesis unfolding sx sxx by(simp add: init_fin_bisim_iff)
  next
    case False
    with red1' sx1' sx1'' have "m1' = m1" by cases auto
    moreover from red2' sx2' sx2'' False have "m2' = m2" by cases auto
    ultimately show ?thesis using bisim by simp
  qed
next
  fix t sx1 m1 sx2 m2 sx1' ta1 sx1'' m1' sx2' ta2 sx2'' m2' w
  assume bisim: "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)"
    and red1: "\<tau>trsys.silent_moves (r1.init_fin t) r1.init_fin_\<tau>move (sx1, m1) (sx1', m1)"
    and red1': "r1.init_fin t (sx1', m1) ta1 (sx1'', m1')"
    and \<tau>1: "\<not> r1.init_fin_\<tau>move (sx1', m1) ta1 (sx1'', m1')"
    and red2: "\<tau>trsys.silent_moves (r2.init_fin t) r2.init_fin_\<tau>move (sx2, m2) (sx2', m2)"
    and red2': "r2.init_fin t (sx2', m2) ta2 (sx2'', m2')"
    and \<tau>2: "\<not> r2.init_fin_\<tau>move (sx2', m2) ta2 (sx2'', m2')"
    and bisim': "t \<turnstile> (sx1'', m1') \<approx>i (sx2'', m2')"
    and tasim: "ta_bisim init_fin_bisim ta1 ta2"
    and suspend1: "Suspend w \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub>"
    and suspend2: "Suspend w \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub>"
  from bisim obtain status x1 x2
    where sx1: "sx1 = (status, x1)"
    and sx2: "sx2 = (status, x2)"
    and Bisim: "t \<turnstile> (x1, m1) \<approx> (x2, m2)"
    by(cases sx1)(cases sx2, auto simp add: init_fin_bisim_iff)
  from bisim' obtain status' x1'' x2''
    where sx1'': "sx1'' = (status', x1'')"
    and sx2'': "sx2'' = (status', x2'')"
    and Bisim': "t \<turnstile> (x1'', m1') \<approx> (x2'', m2')"
     by(cases sx1'')(cases sx2'', auto simp add: init_fin_bisim_iff)
  from red1 sx1 obtain x1' where sx1': "sx1' = (status, x1')"
    and Red1: "r1.silent_moves t (x1, m1) (x1', m1)"
    by(cases sx1')(auto dest: r1.init_fin_silent_movesD)
  from red2 sx2 obtain x2' where sx2': "sx2' = (status, x2')"
    and Red2: "r2.silent_moves t (x2, m2) (x2', m2)"
    by(cases sx2')(auto dest: r2.init_fin_silent_movesD)
  from red1' sx1' sx1'' suspend1 obtain ta1'
    where Red1': "t \<turnstile> (x1', m1) -1-ta1'\<rightarrow> (x1'', m1')"
    and ta1: "ta1 = convert_TA_initial (convert_obs_initial ta1')"
    and Suspend1: "Suspend w \<in> set \<lbrace>ta1'\<rbrace>\<^bsub>w\<^esub>"
    and status: "status = Running" "status' = Running" by cases auto
  from red2' sx2' sx2'' suspend2 obtain ta2'
    where Red2': "t \<turnstile> (x2', m2) -2-ta2'\<rightarrow> (x2'', m2')"
    and ta2: "ta2 = convert_TA_initial (convert_obs_initial ta2')"
    and Suspend2: "Suspend w \<in> set \<lbrace>ta2'\<rbrace>\<^bsub>w\<^esub>" by cases auto
  from \<tau>1 sx1' sx1'' ta1 status have \<tau>1':"\<not> \<tau>move1 (x1', m1) ta1' (x1'', m1')" by simp
  from \<tau>2 sx2' sx2'' ta2 status have \<tau>2':"\<not> \<tau>move2 (x2', m2) ta2' (x2'', m2')" by simp
  from tasim ta1 ta2 have "ta1' \<sim>m ta2'" by simp
  with Bisim Red1 Red1' \<tau>1' Red2 Red2' \<tau>2' Bisim' have "x1'' \<approx>w x2''"
    using Suspend1 Suspend2 by(rule bisim_waitI)
  thus "sx1'' \<approx>iw sx2''" using sx1'' sx2'' status by simp
next
  fix t sx1 m1 sx2 m2 ta1 sx1' m1'
  assume "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)" and "sx1 \<approx>iw sx2"
    and "r1.init_fin t (sx1, m1) ta1 (sx1', m1')"
    and "Notified \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta1\<rbrace>\<^bsub>w\<^esub>"
  thus "\<exists>ta2 sx2' m2'. r2.init_fin t (sx2, m2) ta2 (sx2', m2') \<and> t \<turnstile> (sx1', m1') \<approx>i (sx2', m2') \<and>
                       ta_bisim init_fin_bisim ta1 ta2"
    by(rule init_fin_simulation_Wakeup1)
next
  fix t sx1 m1 sx2 m2 ta2 sx2' m2'
  assume "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)" and "sx1 \<approx>iw sx2"
    and "r2.init_fin t (sx2, m2) ta2 (sx2', m2')"
    and "Notified \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub> \<or> WokenUp \<in> set \<lbrace>ta2\<rbrace>\<^bsub>w\<^esub>"
  thus "\<exists>ta1 sx1' m1'. r1.init_fin t (sx1, m1) ta1 (sx1', m1') \<and> t \<turnstile> (sx1', m1') \<approx>i (sx2', m2') \<and>
                       ta_bisim init_fin_bisim ta1 ta2"
    by(rule init_fin_simulation_Wakeup2)
next
  show "(\<exists>sx1. r1.init_fin_final sx1) = (\<exists>sx2. r2.init_fin_final sx2)"
    using ex_final1_conv_ex_final2 by(auto)
qed

end

context FWdelay_bisimulation_diverge begin

lemma init_fin_simulation_silent1:
  "\<lbrakk> t \<turnstile> sxm1 \<approx>i sxm2; \<tau>trsys.silent_move (r1.init_fin t) r1.init_fin_\<tau>move sxm1 sxm1' \<rbrakk>
  \<Longrightarrow> \<exists>sxm2'. \<tau>trsys.silent_moves (r2.init_fin t) r2.init_fin_\<tau>move sxm2 sxm2' \<and> t \<turnstile> sxm1' \<approx>i sxm2'"
by(cases sxm1')(auto 4 4 elim!: init_fin_bisim.cases dest!: r1.init_fin_silent_moveD dest: simulation_silent1 intro!: r2.init_fin_silent_moves_RunningI)

lemma init_fin_simulation_silent2:
  "\<lbrakk> t \<turnstile> sxm1 \<approx>i sxm2; \<tau>trsys.silent_move (r2.init_fin t) r2.init_fin_\<tau>move sxm2 sxm2' \<rbrakk>
  \<Longrightarrow> \<exists>sxm1'. \<tau>trsys.silent_moves (r1.init_fin t) r1.init_fin_\<tau>move sxm1 sxm1' \<and> t \<turnstile> sxm1' \<approx>i sxm2'"
using FWdelay_bisimulation_diverge.init_fin_simulation_silent1[OF FWdelay_bisimulation_diverge_flip]
unfolding flip_simps .

lemma init_fin_\<tau>diverge_bisim_inv:
  "t \<turnstile> sxm1 \<approx>i sxm2
  \<Longrightarrow> \<tau>trsys.\<tau>diverge (r1.init_fin t) r1.init_fin_\<tau>move sxm1 =
      \<tau>trsys.\<tau>diverge (r2.init_fin t) r2.init_fin_\<tau>move sxm2"
by(cases sxm1)(cases sxm2, auto simp add: r1.init_fin_\<tau>diverge_conv r2.init_fin_\<tau>diverge_conv init_fin_bisim_iff \<tau>diverge_bisim_inv)

lemma init_fin_delay_bisimulation_diverge:
  "delay_bisimulation_diverge (r1.init_fin t) (r2.init_fin t) (init_fin_bisim t) (ta_bisim init_fin_bisim)
         r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
by(blast intro: delay_bisimulation_diverge.intro init_fin_delay_bisimulation_obs delay_bisimulation_diverge_axioms.intro init_fin_simulation_silent1 init_fin_simulation_silent2 init_fin_\<tau>diverge_bisim_inv del: iffI)+

lemma init_fin_FWdelay_bisimulation_diverge:
  "FWdelay_bisimulation_diverge r1.init_fin_final r1.init_fin r2.init_fin_final r2.init_fin init_fin_bisim init_fin_bisim_wait r1.init_fin_\<tau>move r2.init_fin_\<tau>move"
by(intro FWdelay_bisimulation_diverge.intro init_fin_FWdelay_bisimulation_obs FWdelay_bisimulation_diverge_axioms.intro init_fin_delay_bisimulation_diverge)

end

context FWbisimulation begin

lemma init_fin_simulation1:
  assumes "t \<turnstile> s1 \<approx>i s2" and "r1.init_fin t s1 tl1 s1'"
  shows "\<exists>s2' tl2. r2.init_fin t s2 tl2 s2' \<and> t \<turnstile> s1' \<approx>i s2' \<and> ta_bisim init_fin_bisim tl1 tl2"
using init_fin_simulation1[OF assms] by(auto simp add: \<tau>moves_False init_fin_\<tau>moves_False)

lemma init_fin_simulation2:
  "\<lbrakk> t \<turnstile> s1 \<approx>i s2; r2.init_fin t s2 tl2 s2' \<rbrakk>
  \<Longrightarrow> \<exists>s1' tl1. r1.init_fin t s1 tl1 s1' \<and> t \<turnstile> s1' \<approx>i s2' \<and> ta_bisim init_fin_bisim tl1 tl2"
using FWbisimulation.init_fin_simulation1[OF FWbisimulation_flip]
unfolding flip_simps .

lemma init_fin_bisimulation:
  "bisimulation (r1.init_fin t) (r2.init_fin t)  (init_fin_bisim t) (ta_bisim init_fin_bisim)"
by(unfold_locales)(erule (1) init_fin_simulation1 init_fin_simulation2)+

lemma init_fin_FWbisimulation:
  "FWbisimulation r1.init_fin_final r1.init_fin r2.init_fin_final r2.init_fin init_fin_bisim"
proof(intro FWbisimulation.intro r1.multithreaded_init_fin r2.multithreaded_init_fin FWbisimulation_axioms.intro init_fin_bisimulation)
  fix t sx1 m1 sx2 m2
  assume "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)"
  thus "r1.init_fin_final sx1 = r2.init_fin_final sx2"
    by cases simp_all
next
  fix t' sx m1 sxx m2 t sx1 sx2 ta1 sx1' m1' ta2 sx2' m2'
  assume "t' \<turnstile> (sx, m1) \<approx>i (sxx, m2)" "t \<turnstile> (sx1, m1) \<approx>i (sx2, m2)"
    and "r1.init_fin t (sx1, m1) ta1 (sx1', m1')"
    and "r2.init_fin t (sx2, m2) ta2 (sx2', m2')"
    and "t \<turnstile> (sx1', m1') \<approx>i (sx2', m2')"
    and "ta_bisim init_fin_bisim ta1 ta2"
  from FWdelay_bisimulation_obs.bisim_inv_red_other
  [OF init_fin_FWdelay_bisimulation_obs, OF this(1-2) _ this(3) _ _ this(4) _ this(5-6)]
  show "t' \<turnstile> (sx, m1') \<approx>i (sxx, m2')" by(simp add: init_fin_\<tau>moves_False)
next
  show "(\<exists>sx1. r1.init_fin_final sx1) = (\<exists>sx2. r2.init_fin_final sx2)"
    using ex_final1_conv_ex_final2 by(auto)
qed

end

end


theory (*calc_name_core*)
imports Main "~~/src/HOL/Library/Code_Char" "~~/src/HOL/Code_Numeral" (*always keep Code_char import last! its added for code generator to output Haskell strings instead of the isabelle nibble stuff *)
begin

(*calc_structure*)

class Varmatch =
  (* match takes a string occurring in a pattern and a term and returns the string
     with a matching subterm. Never returns a list longer than 1. *)
  fixes "match" :: "'a \<Rightarrow> 'a \<Rightarrow> ('a * 'a) list"
  fixes "freevars" :: "'a \<Rightarrow> 'a set"
  (* first argument matches return-type of match *)
  fixes "replace" :: "('a * 'a) \<Rightarrow> 'a \<Rightarrow> 'a"

definition m_clash :: "'a \<times> 'b \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> bool" (infix "\<inter>m" 400) where
"x \<inter>m y \<equiv> \<exists>a \<in> set y. fst a = fst x \<and> snd a \<noteq> snd x"

lemma m_clash_simp[simp] : "set (map fst m1) \<inter> set (map fst m2) = {} \<longrightarrow> (\<forall>x \<in> set m1. \<not>(x \<inter>m m2))"
unfolding m_clash_def by auto

fun merge :: "('a * 'b) list \<Rightarrow> ('a * 'b) list  \<Rightarrow> ('a * 'b) list " (infix "@m" 400) where
"[] @m y = y" |
"(x#xs) @m y = ( if x \<inter>m y
                 then [a \<leftarrow> xs. fst a \<noteq> fst x] @m [a \<leftarrow> y . fst a \<noteq> fst x]
                 else x#(xs @m y) )"

lemma merge_simp[simp] :
  fixes m1 m2
  assumes "(\<forall>a\<in>set m1. case a of (x, y) \<Rightarrow> x = y)"
  and "\<forall>a\<in>set m2. case a of (x, y) \<Rightarrow> x = y"
  shows "set (m1 @m m2) = set m1 \<union> set m2"
using assms(1)
proof (induct m1)
  case Nil
    show ?case by simp
next
  case (Cons x xs)
    have "\<forall>a\<in>set xs. case a of (a, b) \<Rightarrow> a = b"
      by (metis Cons.prems(1) contra_subsetD set_subset_Cons)
    with Cons(1) have 1: "set (xs @m m2) = set xs \<union> set m2" by simp
    { assume "\<not>(x \<inter>m m2)"
      then have "set ((x # xs) @m m2) = set (x#xs @m m2)" by simp
      with 1 have ?case by simp }
    { assume "(x \<inter>m m2)"
      then have "\<exists>a \<in> set m2. fst a = fst x \<and> snd a \<noteq> snd x" unfolding m_clash_def by simp
      then obtain a where 2: "a \<in> set m2" and 3: "fst a = fst x" and 4: "snd a \<noteq> snd x" by auto
      then have False by (metis (full_types) Cons.prems(1) assms(2) fst_conv insertI1 old.prod.exhaust set_simps(2) snd_eqD split_beta)
      then have ?case .. }
    thus ?case
      by (metis `\<not> x \<inter>m m2 \<Longrightarrow> set ((x # xs) @m m2) = set (x # xs) \<union> set m2`)
qed

lemma merge_simp2[simp] :
  fixes m1 m2
  assumes "set (map fst m1) \<inter> set (map fst m2) = {}"
  shows "set (m1 @m m2) = set m1 \<union> set m2"
using assms
proof (induct m1)
case Nil
  show ?case by simp
next
case (Cons x xs)
  then have "set (map fst xs) \<inter> set (map fst m2) = {}" by simp
  with Cons(1) have 1: "set (xs @m m2) = set xs \<union> set m2" by simp
  with Cons(2) have "\<not>(x \<inter>m m2)" by (metis insertCI m_clash_simp set_simps(2))
  then have "set ((x # xs) @m m2) = set( x#(xs @m m2) )" by simp
  then have "set ((x # xs) @m m2) = set(xs @m m2) \<union> {x}" by simp
  with 1 have "set ((x # xs) @m m2) = set xs \<union> set m2 \<union> {x}" by simp
  thus ?case by simp
qed

fun(in Varmatch) replaceAll :: "('a * 'a) list \<Rightarrow> 'a \<Rightarrow> 'a"
where
  "replaceAll Nil mtch = mtch"
| "replaceAll (x # xs) mtch = replaceAll xs (replace x mtch)"

lemma replaceAll_simp: "(replaceAll [(x, r)] m) \<equiv> (replace (x, r) m)" by auto

definition(in Varmatch) ruleMatch :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
"ruleMatch r m = (if freevars m = {} then (replaceAll (match r m) r) = m else False)"

(*lemma(in Varmatch) ruleMatch_simp[simp]: "freevars m = {} \<longrightarrow> ruleMatch r m \<equiv> (replaceAll (match r m) r) = m"*)

class Varmatch_preserving = Varmatch +
  assumes inv: "a = (replaceAll (match a a) a)"

instantiation Atprop :: Varmatch
begin
  fun match_Atprop :: "Atprop \<Rightarrow> Atprop \<Rightarrow> (Atprop * Atprop) list"
  where
    "match_Atprop (Atprop_Freevar free) mtch = [((Atprop_Freevar free), mtch)]" |
    "match_Atprop _ _ = []"

  fun freevars_Atprop :: "Atprop \<Rightarrow> Atprop set"
  where
    "freevars_Atprop (Atprop_Freevar var) = {(Atprop_Freevar var)}" |
    "freevars_Atprop _ = {}"

  fun replace_Atprop :: "(Atprop * Atprop) \<Rightarrow> Atprop \<Rightarrow> Atprop"
  where
    "replace_Atprop ((Atprop_Freevar x), mtch) (Atprop_Freevar free) = (if x = free then mtch else (Atprop_Freevar free))" |
    "replace_Atprop _ pttrn = pttrn"

instance ..
end

instantiation Action :: Varmatch
begin
  fun match_Action :: "Action \<Rightarrow> Action \<Rightarrow> (Action * Action) list"
  where
    "match_Action (Action_Freevar free) mtch = [((Action_Freevar free), mtch)]" |
    "match_Action _ _ = []"

  fun freevars_Action :: "Action \<Rightarrow> Action set"
  where
    "freevars_Action (Action_Freevar var) = {(Action_Freevar var)}" |
    "freevars_Action _ = {}"

  fun replace_Action :: "(Action * Action) \<Rightarrow> Action \<Rightarrow> Action"
  where
    "replace_Action ((Action_Freevar x), mtch) (Action_Freevar free) = (if x = free then mtch else (Action_Freevar free))" |
    "replace_Action _ pttrn = pttrn"

instance ..
end

instantiation Agent :: Varmatch
begin
  fun match_Agent :: "Agent \<Rightarrow> Agent \<Rightarrow> (Agent * Agent) list"
  where
    "match_Agent (Agent_Freevar free) mtch = [((Agent_Freevar free), mtch)]" |
    "match_Agent _ _ = []"

  fun freevars_Agent :: "Agent \<Rightarrow> Agent set"
  where
    "freevars_Agent (Agent_Freevar var) = {(Agent_Freevar var)}" |
    "freevars_Agent _ = {}"

  fun replace_Agent :: "(Agent * Agent) \<Rightarrow> Agent \<Rightarrow> Agent"
  where
    "replace_Agent ((Agent_Freevar x), mtch) (Agent_Freevar free) = (if x = free then mtch else (Agent_Freevar free))" |
    "replace_Agent _ pttrn = pttrn"

instance ..
end

instantiation Formula :: Varmatch
begin
  fun match_Formula :: "Formula \<Rightarrow> Formula \<Rightarrow> (Formula * Formula) list"
  where
    "match_Formula (Formula_Atprop rule) (Formula_Atprop atprop) = map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match rule atprop)"
  | "match_Formula (Formula_Bin var11 op1 var12) (Formula_Bin var21 op2 var22) = (if op1 = op2 then (match var11 var21) @m (match var12 var22) else [])"
  | "match_Formula (Formula_Freevar free) mtch = [((Formula_Freevar free), mtch)]"

  | "match_Formula (Formula_Action_Formula op1 act1 form1) (Formula_Action_Formula op2 act2 form2) = (if op1 = op2 then map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match act1 act2) @m (match form1 form2) else [])"
  | "match_Formula (Formula_Agent_Formula op1 ag1 form1) (Formula_Agent_Formula op2 ag2 form2) = (if op1 = op2 then map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match ag1 ag2) @m (match form1 form2) else [])"
  | "match_Formula (Formula_Precondition act1) (Formula_Precondition act2) = map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match act1 act2)"
  | "match_Formula _ _ = []"

  fun freevars_Formula :: "Formula \<Rightarrow> Formula set"
  where
    "freevars_Formula (Formula_Atprop var) = image (\<lambda>x. Formula_Atprop x) (freevars var)"
  | "freevars_Formula (Formula_Bin var1 _ var2) = (freevars var1) \<union> (freevars var2)"
  | "freevars_Formula (Formula_Freevar var) = {(Formula_Freevar var)}"

  | "freevars_Formula (Formula_Action_Formula _ act1 form1) = image (\<lambda>x. Formula_Action x) (freevars act1) \<union> (freevars form1)"
  | "freevars_Formula (Formula_Agent_Formula _ ag1 form1) = image (\<lambda>x. Formula_Agent x) (freevars ag1) \<union> (freevars form1)"
  | "freevars_Formula (Formula_Precondition act1) = image (\<lambda>x. Formula_Action x) (freevars act1)"
  | "freevars_Formula _ = {}"

  fun replace_Formula :: "(Formula * Formula) \<Rightarrow> Formula \<Rightarrow> Formula"
  where
    "replace_Formula ((Formula_Atprop x), (Formula_Atprop rep)) (Formula_Atprop atprop) = Formula_Atprop (replace (x, rep) atprop)"
  | "replace_Formula (x, rep) (Formula_Bin var1 op1 var2) = Formula_Bin (replace (x, rep) var1) op1 (replace (x, rep) var2)"
  | "replace_Formula (x, mtch) (Formula_Freevar free) = (if x = (Formula_Freevar free) then mtch else (Formula_Freevar free))"

  | "replace_Formula ((Formula_Action x), (Formula_Action rep)) (Formula_Action_Formula op1 act1 form1) = Formula_Action_Formula op1 (replace (x, rep) act1) (replace ((Formula_Action x), (Formula_Action rep)) form1)"
  | "replace_Formula ((Formula_Agent x), (Formula_Agent rep)) (Formula_Agent_Formula op1 ag1 form1) = Formula_Agent_Formula op1 (replace (x, rep) ag1) (replace ((Formula_Agent x), (Formula_Agent rep)) form1)"

  | "replace_Formula (x, rep) (Formula_Action_Formula op1 act1 form1) = Formula_Action_Formula op1 act1 (replace (x, rep) form1)"
  | "replace_Formula (x, rep) (Formula_Agent_Formula op1 ag1 form1) = Formula_Agent_Formula op1 ag1 (replace (x, rep) form1)"

  | "replace_Formula ((Formula_Action x), (Formula_Action rep)) (Formula_Precondition act1) = Formula_Precondition (replace (x, rep) act1)"

  | "replace_Formula (_, _) y = y"
instance ..
end

instantiation Structure :: Varmatch
begin
  fun match_Structure :: "Structure \<Rightarrow> Structure \<Rightarrow> (Structure * Structure) list"
  where
(*(*uncommentL?Structure_Formula*)  "match_Structure (Structure_Formula rule) (Structure_Formula form) = map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match rule form)" |(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*)  "match_Structure (Structure_Bin var11 op1 var12) (Structure_Bin var21 op2 var22) = (if op1 = op2 then (match var11 var21) @m (match var12 var22) else [])" |(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*)  "match_Structure (Structure_Freevar free) mtch = [((Structure_Freevar free), mtch)]" |(*uncommentR?Structure_Freevar*)*)

  "match_Structure (Structure_Action_Structure op1 act1 struct1) (Structure_Action_Structure op2 act2 struct2) = (if op1 = op2 then map (\<lambda>(x,y). (Structure_Formula (Formula_Action x), Structure_Formula (Formula_Action y))) (match act1 act2) @m (match struct1 struct2) else [])" |
  "match_Structure (Structure_Agent_Structure op1 ag1 struct1) (Structure_Agent_Structure op2 ag2 struct2) = (if op1 = op2 then map (\<lambda>(x,y). (Structure_Formula (Formula_Agent x), Structure_Formula (Formula_Agent y))) (match ag1 ag2) @m (match struct1 struct1) else [])" |
  "match_Structure (Structure_Phi act1) (Structure_Phi act2) = map (\<lambda>(x,y). (Structure_Formula (Formula_Action x), Structure_Formula (Formula_Action y))) (match act1 act2)" |

  "match_Structure _ _ = []"

  fun freevars_Structure :: "Structure \<Rightarrow> Structure set"
  where
(*(*uncommentL?Structure_Formula*)  "freevars_Structure (Structure_Formula var) = image (\<lambda>x. Structure_Formula x) (freevars var)" |(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*)  "freevars_Structure (Structure_Bin var1 _ var2) = (freevars var1) \<union> (freevars var2)" |(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*)  "freevars_Structure (Structure_Freevar var) = {(Structure_Freevar var)}" |(*uncommentR?Structure_Freevar*)*)
  "freevars_Structure (Structure_Action_Structure _ act1 struct) = image (\<lambda>x. Structure_Formula (Formula_Action x)) (freevars act1) \<union> (freevars struct)" |
  "freevars_Structure (Structure_Agent_Structure _ ag1 struct) = image (\<lambda>x. Structure_Formula (Formula_Agent x)) (freevars ag1) \<union> (freevars struct)" |
  "freevars_Structure (Structure_Phi act1) = image (\<lambda>x. Structure_Formula (Formula_Action x)) (freevars act1)" |

  "freevars_Structure _ = {}"

  fun replace_Structure :: "(Structure * Structure) \<Rightarrow> Structure \<Rightarrow> Structure"
  where
(*(*uncommentL?Structure_Formula*)  "replace_Structure ((Structure_Formula x), (Structure_Formula rep)) (Structure_Formula form) = Structure_Formula (replace (x, rep) form)" |(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Bin*)  "replace_Structure (x, rep) (Structure_Bin var1 op1 var2) = Structure_Bin (replace (x, rep) var1) op1 (replace (x, rep) var2)" |(*uncommentR?Structure_Bin*)*)
(*(*uncommentL?Structure_Freevar*)  "replace_Structure (x, mtch) (Structure_Freevar free) = (if x = (Structure_Freevar free) then mtch else (Structure_Freevar free))" |(*uncommentR?Structure_Freevar*)*)

  "replace_Structure ((Structure_Formula (Formula_Action x)), (Structure_Formula (Formula_Action rep))) (Structure_Action_Structure op1 act1 struct) = Structure_Action_Structure op1 (replace (x, rep) act1) (replace ((Structure_Formula (Formula_Action x)), (Structure_Formula (Formula_Action rep))) struct)" |
  "replace_Structure ((Structure_Formula (Formula_Agent x)), (Structure_Formula (Formula_Agent rep))) (Structure_Agent_Structure op1 ag1 struct) = Structure_Agent_Structure op1 (replace (x, rep) ag1) (replace ((Structure_Formula (Formula_Agent x)), (Structure_Formula (Formula_Agent rep))) struct)" |

  "replace_Structure (x, rep) (Structure_Action_Structure op1 act1 struct) = Structure_Action_Structure op1 act1 (replace (x, rep) struct)" |
  "replace_Structure (x, rep) (Structure_Agent_Structure op1 ag1 struct) = Structure_Agent_Structure op1 ag1 (replace (x, rep) struct)" |

  "replace_Structure ((Structure_Formula (Formula_Action x)), (Structure_Formula (Formula_Action rep))) (Structure_Phi act1) = Structure_Phi (replace (x, rep) act1)" |
  "replace_Structure (_, _) y = y"

instance ..
end

lemma inv_Atprop[simp]:
  fixes a::Atprop
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
by (cases a, metis replace_Atprop.simps(3))
(metis assms in_set_insert insert_Nil match_Atprop.simps(1) not_Cons_self2 replace_Atprop.simps(1) set_ConsD)

lemma inv_Atprop_2[simp]:
  fixes a::Atprop
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Atprop.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Atprop_simp[simp]: "free \<notin> freevars (a::Atprop) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto, metis Atprop.exhaust replace_Atprop.simps(1) replace_Atprop.simps(2))

lemma freevars_replace_Atprop_simp2 : "free \<in> freevars (a::Atprop) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Atprop_simp : "\<forall>(x, y) \<in> set (match (a::Atprop) a). x = y"
by (cases a) auto

lemma inv_Action[simp]:
  fixes a::Action
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
by (cases a, metis replace_Action.simps(3))
(metis assms in_set_insert insert_Nil match_Action.simps(1) not_Cons_self2 replace_Action.simps(1) set_ConsD)

lemma inv_Action_2[simp]:
  fixes a::Action
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Action.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Action_simp[simp]: "free \<notin> freevars (a::Action) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto, metis Action.exhaust replace_Action.simps(1) replace_Action.simps(2))

lemma freevars_replace_Action_simp2 : "free \<in> freevars (a::Action) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Action_simp : "\<forall>(x, y) \<in> set (match (a::Action) a). x = y"
by (cases a) auto

lemma inv_Agent[simp]:
  fixes a::Agent
  assumes "free \<in> set (match a a)"
  shows "a = replace free a"
by (cases a, metis replace_Agent.simps(3))
(metis assms in_set_insert insert_Nil match_Agent.simps(1) not_Cons_self2 replace_Agent.simps(1) set_ConsD)

lemma inv_Agent_2[simp]:
  fixes a::Agent
  shows "a = replaceAll (match a a) a"
by (cases a, metis match_Agent.simps(2) replaceAll.simps(1), simp)

lemma freevars_replace_Agent_simp[simp]: "free \<notin> freevars (a::Agent) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto, metis Agent.exhaust replace_Agent.simps(1) replace_Agent.simps(2))

lemma freevars_replace_Agent_simp2 : "free \<in> freevars (a::Agent) \<longrightarrow> replace (free,free) a = a"
by (induct a) (cases free, auto)

lemma match_Agent_simp : "\<forall>(x, y) \<in> set (match (a::Agent) a). x = y"
by (cases a) auto

lemma freevars_replace_Formula_simp[simp]: "free \<notin> freevars (a::Formula) \<longrightarrow> replace (free,free) a = a"
apply (induct a)
apply (cases a)
apply (simp_all)
apply (cases free)
apply auto
apply (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
apply (cases free)
apply auto
apply (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
apply (cases free)
apply auto
apply (metis freevars_replace_Atprop_simp freevars_replace_Atprop_simp2)
apply (cases free)
apply auto
apply (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
done

lemma freevars_replace_Formula_simp2 : "free \<in> freevars (a::Formula) \<longrightarrow> replace (free,free) a = a"
proof (rule, induct a)
  case (Formula_Atprop x)
    have 0: "freevars (Formula_Atprop x) = image (\<lambda>x. Formula_Atprop x) (freevars x)" by simp
    then obtain afree where "afree \<in> freevars x" "Formula_Atprop afree = free"
      by (metis Formula_Atprop.prems freevars_Formula.simps(1) imageE)
    then have "replace (free, free) (Formula_Atprop x) = Formula_Atprop (replace (afree, afree) x)" by (metis replace_Formula.simps(1))
    thus ?case
      by (metis freevars_replace_Atprop_simp freevars_replace_Atprop_simp2)
next
  case (Formula_Freevar x)
    show ?case by simp
next
  case (Formula_Bin x c y)
    have 1: "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) x = x"
    proof rule
      assume "free \<in> freevars (Formula_Bin x c y)"
    { assume "free \<notin> freevars x" then have "replace (free, free) x = x" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) x = x" by (metis Formula_Bin.hyps(1))
    qed
    have 2: "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Bin x c y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Bin.hyps(2))
    qed
    have "free \<in> freevars (Formula_Bin x c y) \<longrightarrow> replace (free, free) (Formula_Bin x c y) = Formula_Bin (replace (free, free) x) c (replace (free, free) y)" by (metis replace_Formula.simps)
    with 1 2 show ?case by (metis Formula_Bin.prems)
next
    case (Formula_Action x)
    show ?case by simp
next
  case (Formula_Agent x)
    show ?case by simp
next
  case (Formula_Precondition x)
    have 0: "freevars (Formula_Precondition x) = image (\<lambda>x. Formula_Action x) (freevars x)" by simp
    then obtain afree where "afree \<in> freevars x" "Formula_Action afree = free"
      by (metis Formula_Precondition.prems freevars_Formula.simps(6) imageE)
    then have "replace (free, free) (Formula_Precondition x) = Formula_Precondition (replace (afree, afree) x)" by (metis replace_Formula.simps(34))
    thus ?case by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
  case (Formula_Action_Formula c x y)
    have 1: "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Action x) = (Formula_Action x)" by simp
    have 2: "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Action_Formula c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Action_Formula.hyps)
    qed
    with 1 have "free \<in> freevars (Formula_Action_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace (free, free) y)"
      by (cases free, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
    with 2 show ?case by (metis Formula_Action_Formula.prems)
next
  case (Formula_Agent_Formula c x y)
    have 1: "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Agent x) = (Formula_Agent x)" by simp
    have 2: "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Formula_Agent_Formula c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Formula_simp by simp }
      thus "replace (free, free) y = y" by (metis Formula_Agent_Formula.hyps)
    qed
    with 1 have "free \<in> freevars (Formula_Agent_Formula c x y) \<longrightarrow> replace (free, free) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace (free, free) y)"
      by (cases free, simp_all) (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    with 2 show ?case by (metis Formula_Agent_Formula.prems)
qed

lemma match_Formula_simp : "\<forall>(x, y) \<in> set (match (a::Formula) a). x = y"
proof (induct a)
  case (Formula_Atprop x)
    have 0: "match (Formula_Atprop x) (Formula_Atprop x) = map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Atprop_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Formula_Atprop x, Formula_Atprop y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
  case (Formula_Freevar x)
    show ?case by auto
next
  case (Formula_Bin x c y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b"
      by (metis Formula_Bin.hyps(1)) (metis Formula_Bin.hyps(2))
    have 0: "set (match (Formula_Bin x c y) (Formula_Bin x c y)) = set ((match x x) @m (match y y))" by simp
    from Formula_Bin have "set ((match x x) @m (match y y)) = set (match x x) \<union> set (match y y)" by simp
    with assms 0 show ?case by auto
next
  case (Formula_Action x)
    show ?case by simp
next
  case (Formula_Agent x)
    show ?case by simp
next
  case (Formula_Precondition x)
    have 0: "match (Formula_Precondition x) (Formula_Precondition x) = map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Action_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
  case (Formula_Action_Formula c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Formula_Action_Formula c x y) (Formula_Action_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y) )" by simp
    with a Formula_Action_Formula have "set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Formula_Action_Formula.hyps Un_iff a)
next
  case (Formula_Agent_Formula c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Formula_Agent_Formula c x y) (Formula_Agent_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y) )" by simp
    with a Formula_Agent_Formula have "set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Formula_Agent_Formula.hyps Un_iff a)
qed

lemma inv_Formula[simp]:
  fixes a::Formula
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
  case (Formula_Atprop x)
    show ?case by auto
next
  case (Formula_Bin x c y)
    obtain z where 0: "z = (Formula_Bin x c y)" by simp
    have 1: "\<forall>free \<in> set (match z z). replace free z = Formula_Bin (replace free x) c (replace free y)"
      by (metis "0" old.prod.exhaust replace_Formula.simps)
    have "\<forall>free \<in> set (match z z). replace free x = x" "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) splitD)
      have x: "a \<notin> freevars x \<longrightarrow> replace (a,b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a,b) x = x"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace (a, b) x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed
    thus ?case by (metis "0" "1")
next
  case (Formula_Freevar x)
    show ?case by simp
next
  case (Formula_Action x)
    show ?case by simp
next
  case (Formula_Agent x)
    show ?case by simp
next
  case (Formula_Precondition x)
    show ?case by auto
next
  case (Formula_Action_Formula c x y)
    obtain z where 0: "z = (Formula_Action_Formula c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Formula_Action x) = (Formula_Action x)" by auto
    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) splitD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace free y)"
    proof auto
      fix a b
      assume assm: "(a,b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) splitD)

      from 0 have "match z z = map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m match y y" by simp
      then have 3: "set (match z z) = set (map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y))" by simp

      have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
      then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
      have 0: "set (match (Formula_Action_Formula c x y) (Formula_Action_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y) )" by simp
      with a match_Formula_simp have "set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x) ) \<union> set (match y y)" by simp
      with 3 eq 0 assm have ab_in_z: "(a,b) \<in> set (map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x)) \<union> set (match y y)" by simp

      { assume "(a,b) \<in> set (map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x))"
        then obtain a' b' where "Formula_Action a' = a" "Formula_Action b' = b" by auto
        then have 1: "replace (a,b) (Formula_Action_Formula c x y) = Formula_Action_Formula c (replace (a',b') x) (replace (a,b) y)" by auto
        have "(replace (a',b') x) = x" by (metis Formula.inject(1) `Formula_Action a' = a` `Formula_Action b' = b` eq freevars_replace_Action_simp freevars_replace_Action_simp2)
        with 1 have "replace (a,b) (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace (a,b) y)" by simp }
      { assume "(a,b) \<notin> set (map (\<lambda>(x,y). (Formula_Action x, Formula_Action y)) (match x x))"
        with ab_in_z have "(a,b) \<in> set (match y y)" by simp
        then have 1: "replace (a,b) (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace (a,b) y)"
          by (cases a, cases b, auto) (metis Formula.inject(1) eq freevars_replace_Action_simp freevars_replace_Action_simp2) }
      thus "replace (a,b) (Formula_Action_Formula c x y) = Formula_Action_Formula c x (replace (a,b) y)"
        by (metis `(a, b) \<in> set (map (\<lambda>(x, y). (Formula_Action x, Formula_Action y)) (match x x)) \<Longrightarrow> replace (a, b) (ActF\<^sub>F c x y) = ActF\<^sub>F c x replace (a, b) y`)
    qed
    with 0 1 2 show ?case by simp
next
  case (Formula_Agent_Formula c x y)
    obtain z where 0: "z = (Formula_Agent_Formula c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Formula_Agent x) = (Formula_Agent x)" by auto
    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) splitD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Formula_simp) (metis freevars_replace_Formula_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace free y)"
    proof auto
      fix a b
      assume assm: "(a,b) \<in> set (match z z)"
      then have eq: "a = b" using match_Formula_simp by (metis (full_types) splitD)

      from 0 have "match z z = map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m match y y" by simp
      then have 3: "set (match z z) = set (map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y))" by simp

      have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
      then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
      have 0: "set (match (Formula_Agent_Formula c x y) (Formula_Agent_Formula c x y)) = set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y) )" by simp
      with a match_Formula_simp have "set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x) ) \<union> set (match y y)" by simp
      with 3 eq 0 assm have ab_in_z: "(a,b) \<in> set (map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x)) \<union> set (match y y)" by simp

      { assume "(a,b) \<in> set (map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x))"
        then obtain a' b' where "Formula_Agent a' = a" "Formula_Agent b' = b" by auto
        then have 1: "replace (a,b) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c (replace (a',b') x) (replace (a,b) y)" by auto
        have "(replace (a',b') x) = x" by (metis Formula.inject(3) `Formula_Agent a' = a` `Formula_Agent b' = b` eq freevars_replace_Agent_simp freevars_replace_Agent_simp2)
        with 1 have "replace (a,b) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace (a,b) y)" by simp }
      { assume "(a,b) \<notin> set (map (\<lambda>(x,y). (Formula_Agent x, Formula_Agent y)) (match x x))"
        with ab_in_z have "(a,b) \<in> set (match y y)" by simp
        then have 1: "replace (a,b) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace (a,b) y)"
          by (cases a, auto, cases b, auto) (metis Formula.inject(3) eq freevars_replace_Agent_simp freevars_replace_Agent_simp2) }
      thus "replace (a,b) (Formula_Agent_Formula c x y) = Formula_Agent_Formula c x (replace (a,b) y)"
        by (metis `(a, b) \<in> set (map (\<lambda>(x, y). (Formula_Agent x, Formula_Agent y)) (match x x)) \<Longrightarrow> replace (a, b) (AgF\<^sub>F c x y) = AgF\<^sub>F c x replace (a, b) y` eq)
    qed
    with 0 1 2 show ?case by simp
qed

lemma inv_Formula2_aux[simp]:
fixes a::Formula and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Formula replaceAll.simps(2) set_simps(2))

lemma inv_Formula2: "replaceAll (match a a) a = (a::Formula)" by simp

lemma freevars_replace_Structure_simp : "free \<notin> freevars (a::Structure) \<longrightarrow> replace (free,free) a = a"
proof (rule, induct a)
  case Structure_Formula thus ?case by (cases free, auto) (metis freevars_replace_Formula_simp freevars_replace_Formula_simp2)
next
  case Structure_Zer thus ?case by simp
next
  case Structure_Bin thus ?case by simp
next
  case Structure_Freevar thus ?case by simp
next
  case (Structure_Phi act)
    thus ?case
    apply(cases free, cases act, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all)
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
  case (Structure_Action_Structure op a s)
    thus ?case
    apply(cases free, cases s, cases a, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all)
    by (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
  case (Structure_Agent_Structure op a s)
    thus ?case
    apply(cases free, cases s, cases a, simp_all, case_tac Formula, simp_all, case_tac Agent, simp_all)
    by (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
qed

lemma freevars_replace_Structure_simp2 : "free \<in> freevars (a::Structure) \<longrightarrow> replace (free,free) a = a"
proof (rule, induct a)
(*(*uncommentL?Structure_Formula*)
  case (Structure_Formula x)
    have 0: "freevars (Structure_Formula x) = image (\<lambda>x. Structure_Formula x) (freevars x)" by simp
    then obtain ffree where "ffree \<in> freevars x"
      by (metis Structure_Formula.prems freevars_Structure.simps(1) imageE)
    with 0 have "replace (free, free) (Structure_Formula x) = Structure_Formula (replace (ffree, ffree) x)"
    proof -
      have "replace (ffree, ffree) x = x" by (metis `ffree \<in> freevars x` freevars_replace_Formula_simp2)
      thus "replace (free, free) (x \<^sub>S) = replace (ffree, ffree) x \<^sub>S" using Structure_Formula.prems freevars_replace_Formula_simp2 by auto
    qed
    thus ?case
      by (metis freevars_replace_Formula_simp freevars_replace_Formula_simp2)
(*uncommentR?Structure_Formula*)*)
(*(*uncommentL?Structure_Zer*)
next
  case (Structure_Zer c)
    thus ?case by simp
(*uncommentR?Structure_Zer*)*)
next
  case (Structure_Freevar x)
    thus ?case by simp
next
  case (Structure_Bin x c y)
    have 1: "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> (replace (free, free) x) = x"
    proof rule
      assume "free \<in> freevars (Structure_Bin x c y)"
    { assume "free \<notin> freevars x" then have "replace (free, free) x = x" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) x = x" by (metis Structure_Bin.hyps(1))
    qed
    have 2: "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Bin x c y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Bin.hyps(2))
    qed
    have "free \<in> freevars (Structure_Bin x c y) \<longrightarrow> replace (free, free) (Structure_Bin x c y) = Structure_Bin (replace (free, free) x) c (replace (free, free) y)" by (metis replace_Structure.simps(2))
    thus ?case by (metis "1" "2" Structure_Bin.prems)
next
  case (Structure_Phi a)
    thus ?case by(cases free, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
next
  case (Structure_Action_Structure c x y)
    have 1: "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Formula (Formula_Action x)) = (Structure_Formula (Formula_Action x))" by(cases free, simp_all)
    have 2: "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Action_Structure c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Action_Structure.hyps)
    qed
    with 1 have "free \<in> freevars (Structure_Action_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace (free, free) y)"
      by (cases free, simp_all, case_tac Formula, simp_all, case_tac Action, simp_all) (metis freevars_replace_Action_simp freevars_replace_Action_simp2)
    with 2 show ?case by (metis Structure_Action_Structure.prems)
next
  case (Structure_Agent_Structure c x y)
    have 1: "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Formula (Formula_Agent x)) = (Structure_Formula (Formula_Agent x))" by(cases free, simp_all)
    have 2: "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) y = y"
    proof
      assume "free \<in> freevars (Structure_Agent_Structure c x y)"
    { assume "free \<notin> freevars y" then have "replace (free, free) y = y" using freevars_replace_Structure_simp by simp }
      thus "replace (free, free) y = y" by (metis Structure_Agent_Structure.hyps)
    qed
    with 1 have "free \<in> freevars (Structure_Agent_Structure c x y) \<longrightarrow> replace (free, free) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace (free, free) y)"
      by (cases free, simp_all, case_tac Formula, simp_all, case_tac Agent, simp_all) (metis freevars_replace_Agent_simp freevars_replace_Agent_simp2)
    with 2 show ?case by (metis Structure_Agent_Structure.prems)
qed

lemma match_Structure_simp : "\<forall>(x, y) \<in> set (match (a::Structure) a). x = y"
proof (induct a)
  case (Structure_Formula x)
    have 0: "match (Structure_Formula x) (Structure_Formula x) = map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Formula_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Structure_Formula x, Structure_Formula y)) (match x x)). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Formula_simp by simp
next
  case (Structure_Zer x)
    show ?case by auto
next
  case (Structure_Freevar x)
    show ?case by auto
next
  case (Structure_Bin x c y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b"
      by (metis Structure_Bin.hyps(1)) (metis Structure_Bin.hyps(2))
    have 0: "set (match (Structure_Bin x c y) (Structure_Bin x c y)) = set ((match x x) @m (match y y))" by simp
    from Structure_Bin have "set ((match x x) @m (match y y)) = set (match x x) \<union> set (match y y)" by simp
    with assms 0 show ?case by auto
next
  case (Structure_Phi x)
    have 0: "match (Structure_Phi x) (Structure_Phi x) = map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x)" by simp
    have "\<forall>a\<in>set (match x x). case a of (x, y) \<Rightarrow> x = y" by (metis match_Action_simp)
    then have "\<forall>a\<in>set( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    with 0 show ?case using match_Atprop_simp by simp
next
  case (Structure_Action_Structure c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Structure_Action_Structure c x y) (Structure_Action_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) @m (match y y) )" by simp
    with a Structure_Action_Structure have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y))) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Structure_Action_Structure.hyps Un_iff a)
next
  case (Structure_Agent_Structure c x y)
    have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
    then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
    have 0: "set (match (Structure_Agent_Structure c x y) (Structure_Agent_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) @m (match y y) )" by simp
    with a Structure_Agent_Structure have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y))) (match x x) ) \<union> set (match y y)" by simp
    with assms 0 show ?case by (metis Structure_Agent_Structure.hyps Un_iff a)
qed

lemma inv_Structure[simp]:
  fixes a::Structure
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
  case (Structure_Formula x)
    thus ?case by auto
next
  case (Structure_Zer x)
    show ?case by simp
next
  case (Structure_Bin x c y)
    obtain z where 0: "z = (Structure_Bin x c y)" by simp
    have 1: "\<forall>free \<in> set (match z z). replace free z = Structure_Bin (replace free x) c (replace free y)"
      by (metis "0" old.prod.exhaust replace_Structure.simps(2))
    have "\<forall>free \<in> set (match z z). replace free x = x" "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) splitD)
      have x: "a \<notin> freevars x \<longrightarrow> replace (a,b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a,b) x = x"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed
    thus ?case by (metis "0" "1")
next
  case (Structure_Freevar x)
    show ?case by simp
next
  case(Structure_Phi x)
    show ?case by auto
next
  case (Structure_Action_Structure c x y)
    obtain z where 0: "z = (Structure_Action_Structure c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Structure_Formula(Formula_Action x)) = (Structure_Formula(Formula_Action x))"
    apply (rule)
    apply(case_tac free, auto)
    apply(case_tac aa, auto)
    apply(case_tac ba, auto)
    done

    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) splitD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace free y)"
    proof auto
      fix a b
      assume assm: "(a,b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) splitD)

      from 0 have "match z z = map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) @m match y y" by simp
      then have 3: "set (match z z) = set (map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) @m (match y y))" by simp

      have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Action_simp by simp
      then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
      have 0: "set (match (Structure_Action_Structure c x y) (Structure_Action_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) @m (match y y) )" by simp
      with a match_Structure_simp have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x) ) \<union> set (match y y)" by simp
      with 3 eq 0 assm have ab_in_z: "(a,b) \<in> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x)) \<union> set (match y y)" by simp

      { assume "(a,b) \<in> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x))"
        then obtain a' b' where fact: "Structure_Formula(Formula_Action a') = a" "Structure_Formula (Formula_Action b') = b" by auto
        then have 1: "replace (a,b) (Structure_Action_Structure c x y) = Structure_Action_Structure c (replace (a',b') x) (replace (a,b) y)" by auto
        with fact have "(replace (a',b') x) = x" by (metis Formula.inject(1) Structure.inject(4) eq freevars_replace_Action_simp freevars_replace_Action_simp2)
        with 1 have "replace (a,b) (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace (a,b) y)" by simp }
      { assume "(a,b) \<notin> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Action x), Structure_Formula(Formula_Action y)) ) (match x x))"
        with ab_in_z have "(a,b) \<in> set (match y y)" by simp
        then have 1: "replace (a,b) (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace (a,b) y)"
          apply (cases a, auto, case_tac Formula, simp_all)
          apply (cases b, auto, case_tac Formulaa, simp_all) by (metis Formula.inject(1) Structure.inject(4) eq freevars_replace_Action_simp freevars_replace_Action_simp2) }
      thus "replace (a,b) (Structure_Action_Structure c x y) = Structure_Action_Structure c x (replace (a,b) y)"
        by (metis `(a, b) \<in> set (map (\<lambda>(x, y). (Formula_Action x \<^sub>S, Formula_Action y \<^sub>S)) (match x x)) \<Longrightarrow> replace (a, b) (ActS\<^sub>S c x y) = ActS\<^sub>S c x replace (a, b) y`)
    qed
    with 0 1 2 show ?case by simp
next
    case (Structure_Agent_Structure c x y)
    obtain z where 0: "z = (Structure_Agent_Structure c x y)" by simp

    have 1: "\<forall>free \<in> set (match z z). replace free (Structure_Formula(Formula_Agent x)) = (Structure_Formula(Formula_Agent x))"
    apply (rule)
    apply(case_tac free, auto)
    apply(case_tac aa, auto)
    apply(case_tac ba, auto)
    done

    have 2: "\<forall>free \<in> set (match z z). replace free y = y"
    proof auto
      fix a b
      assume "(a, b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) splitD)
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed

    have "\<forall>free \<in> set (match z z). replace free (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace free y)"
    proof auto
      fix a b
      assume assm: "(a,b) \<in> set (match z z)"
      then have eq: "a = b" using match_Structure_simp by (metis (full_types) splitD)

      from 0 have "match z z = map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) @m match y y" by simp
      then have 3: "set (match z z) = set (map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) @m (match y y))" by simp

      have assms: "\<forall>(a, b) \<in> set (match x x). a = b" using match_Agent_simp by simp
      then have a: "\<forall>a\<in>set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) ). case a of (x, y) \<Rightarrow> x = y" by auto
      have 0: "set (match (Structure_Agent_Structure c x y) (Structure_Agent_Structure c x y)) = set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) @m (match y y) )" by simp
      with a match_Structure_simp have "set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) @m (match y y)) =
      set ( map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x) ) \<union> set (match y y)" by simp
      with 3 eq 0 assm have ab_in_z: "(a,b) \<in> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x)) \<union> set (match y y)" by simp

      { assume "(a,b) \<in> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x))"
        then obtain a' b' where fact: "Structure_Formula(Formula_Agent a') = a" "Structure_Formula (Formula_Agent b') = b" by auto
        then have 1: "replace (a,b) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c (replace (a',b') x) (replace (a,b) y)" by auto
        with fact have "(replace (a',b') x) = x" by (metis Formula.inject(3) Structure.inject(4) eq freevars_replace_Agent_simp freevars_replace_Agent_simp2)
        with 1 have "replace (a,b) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace (a,b) y)" by simp }
      { assume "(a,b) \<notin> set (map (\<lambda>(x,y). (Structure_Formula(Formula_Agent x), Structure_Formula(Formula_Agent y)) ) (match x x))"
        with ab_in_z have "(a,b) \<in> set (match y y)" by simp
        then have 1: "replace (a,b) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace (a,b) y)"
          apply (cases a, auto, case_tac Formula, simp_all)
          apply (cases b, auto, case_tac Formulaa, simp_all) by (metis Formula.inject(3) Structure.inject(4) eq freevars_replace_Agent_simp freevars_replace_Agent_simp2) }
      thus "replace (a,b) (Structure_Agent_Structure c x y) = Structure_Agent_Structure c x (replace (a,b) y)"
        by (metis `(a, b) \<in> set (map (\<lambda>(x, y). (Formula_Agent x \<^sub>S, Formula_Agent y \<^sub>S)) (match x x)) \<Longrightarrow> replace (a, b) (AgS\<^sub>S c x y) = AgS\<^sub>S c x replace (a, b) y`)
    qed
    with 0 1 2 show ?case by simp
qed

lemma inv_Structure2_aux[simp]:
fixes a::Structure and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Structure replaceAll.simps(2) set_simps(2))

lemma inv_Structure2: "replaceAll (match a a) a = (a::Structure)" by simp

instantiation Sequent :: Varmatch
begin
  fun match_Sequent :: "Sequent \<Rightarrow> Sequent \<Rightarrow> (Sequent * Sequent) list"
  where
    "match_Sequent (Sequent var11 var12) (Sequent var21 var22) = (map (\<lambda>(x,y). (Sequent_Structure x, Sequent_Structure y)) ((match var11 var21) @m (match var12 var22)))"
  | "match_Sequent _ _ = []"

  fun freevars_Sequent :: "Sequent \<Rightarrow> Sequent set"
  where
    "freevars_Sequent (Sequent var1 var2) = image (\<lambda>x. Sequent_Structure x) (freevars var1 \<union> freevars var2)"
  | "freevars_Sequent _ = {}"

  fun replace_Sequent :: "(Sequent * Sequent) \<Rightarrow> Sequent \<Rightarrow> Sequent"
  where
    "replace_Sequent ((Sequent_Structure x), (Sequent_Structure rep))  (Sequent var1 var2) = Sequent (replace (x, rep) var1) (replace (x, rep) var2)"
  | "replace_Sequent (_, _) y = y"
instance ..
end

lemma inv_Sequent[simp]:
  fixes a::Sequent
  shows "\<forall>free \<in> set (match a a). a = replace free a"
proof (induct a)
  case (Sequent_Structure x)
    thus ?case by auto
next
  case (Sequent x y)
    have "\<forall>(a, b) \<in> set (match x x @m match y y). replace (a, b) x = x"  "\<forall>(a, b) \<in> set (match x x @m match y y). replace (a, b) y = y"
    proof auto
      fix a b
      assume 0: "(a, b) \<in> set (match x x @m match y y)"
      have "\<forall>(a, b) \<in> set (match x x). a = b" "\<forall>(a, b) \<in> set (match y y). a = b" by (metis match_Structure_simp)+
      with 0 have eq: "a = b" by auto
      have "a \<notin> freevars x \<longrightarrow> replace (a, b) x = x" and "a \<in> freevars x \<longrightarrow> replace (a, b) x = x"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) x = x" by auto
      from eq have "a \<notin> freevars y \<longrightarrow> replace (a,b) y = y" "a \<in> freevars y \<longrightarrow> replace (a,b) y = y"
        by (metis eq freevars_replace_Structure_simp) (metis freevars_replace_Structure_simp2 eq)
      thus "replace (a, b) y = y" by auto
    qed
    thus ?case by auto
qed

lemma inv_Sequent2_aux[simp]:
fixes a::Sequent and list
assumes "set list \<subseteq> set (match a a)"
shows "replaceAll list a = a"
using assms
by (induct list a rule:replaceAll.induct, simp) (metis insert_subset inv_Sequent replaceAll.simps(2) set_simps(2))

lemma inv_Sequent2: "replaceAll (match a a) a = (a::Sequent)" by simp

definition "export = (Atprop ''A'')\<^sub>F\<^sub>S \<turnstile>\<^sub>S (Atprop ''A'')\<^sub>F\<^sub>S"

export_code open export in Scala
module_name (*calc_name*) file (*export_path*)
end


theory Preliminaries
  imports Computation
begin

context NFT
begin

definition "bv' t \<longleftrightarrow> (\<forall>f1 f2 q1 q2 a b1 b2 v1 v2 w1 w2.
  accept f1 \<and> accept f2 \<and> q1 \<in> Q \<and> q2 \<in> Q \<and>
  init \<leadsto>(a, v1) q1 \<and> q1 \<leadsto>(b1, w1) f1 \<and>
  init \<leadsto>(a, v2) q2 \<and> q2 \<leadsto>(b2, w2) f2 \<longrightarrow> lcp_dist v1 v2 \<le> t)"

(* Lemma 7 *)

lemma bv_prop: "(\<forall>k. \<exists>t. bv k t) \<longleftrightarrow> (\<exists>t. bv' t)"
proof (rule iffI)
  assume "\<forall>k. \<exists>t. bv k t"
  then obtain t where t_def:
    "\<And>f1 f2 q1 q2 a b1 b2 u v1 v2 w1 w2. accept f1 \<Longrightarrow> accept f2 \<Longrightarrow> q1 \<in> Q \<Longrightarrow> q2 \<in> Q \<Longrightarrow>
      init \<leadsto>(a, u @ v1) q1 \<Longrightarrow> q1 \<leadsto>(b1, w1) f1 \<Longrightarrow>
      init \<leadsto>(a, u @ v2) q2 \<Longrightarrow> q2 \<leadsto>(b2, w2) f2 \<Longrightarrow>
      length b1 + length b2 \<le> sg + sg \<Longrightarrow> lcp_dist (v1 @ w1) (v2 @ w2) \<le> t"
    unfolding bv_def
    by metis
  {
    fix k
    fix f1 f2 q1 q2 a b1 b2 v1 v2 w1 w2
    assume assms: "accept f1" "accept f2" "q1 \<in> Q" "q2 \<in> Q"
      "init \<leadsto>(a, [] @ v1) q1" "q1 \<leadsto>(b1, w1) f1"
      "init \<leadsto>(a, [] @ v2) q2" "q2 \<leadsto>(b2, w2) f2"
    obtain b1' w1' f1' where sg1: "q1 \<leadsto>(b1', w1') f1'" "accept f1'" "length b1' \<le> sg"
      using active_Nil_dest_sg[OF _ assms(3)] assms(1,6)
      by (auto simp: active_def)
    obtain b2' w2' f2' where sg2: "q2 \<leadsto>(b2', w2') f2'" "accept f2'" "length b2' \<le> sg"
      using active_Nil_dest_sg[OF _ assms(4)] assms(2,8)
      by (auto simp: active_def)
    have "lcp_dist (v1 @ w1') (v2 @ w2') \<le> t"
      using t_def[OF sg1(2) sg2(2) assms(3,4,5) sg1(1) assms(7) sg2(1)] sg1(3) sg2(3)
      by auto
    then have "lcp_dist v1 v2 \<le> t + length w1' + length w2'"
      using lcp_dist_le_app_sum[of v1 v2 w1' w2']
      by auto
    also have "\<dots> \<le> t + length b1' * output_speed + length b2' * output_speed"
      using output_speed_computation[OF sg1(1) assms(3)]
        output_speed_computation[OF sg2(1) assms(4)]
      by auto
    also have "\<dots> \<le> t + sg * output_speed + sg * output_speed"
      using sg1(3) sg2(3)
      by (auto simp add: add_mono)
    finally have "lcp_dist v1 v2 \<le> t + sg * output_speed + sg * output_speed" .
  }
  then show "\<exists>t. bv' t"
    unfolding bv'_def
    by auto blast
next
  assume "\<exists>t. bv' t"
  then obtain t where t_def:
    "\<And>f1 f2 q1 q2 a b1 b2 v1 v2 w1 w2. accept f1 \<Longrightarrow> accept f2 \<Longrightarrow> q1 \<in> Q \<Longrightarrow> q2 \<in> Q \<Longrightarrow>
      init \<leadsto>(a, v1) q1 \<Longrightarrow> q1 \<leadsto>(b1, w1) f1 \<Longrightarrow>
      init \<leadsto>(a, v2) q2 \<Longrightarrow> q2 \<leadsto>(b2, w2) f2 \<Longrightarrow> lcp_dist v1 v2 \<le> t"
    unfolding bv'_def
    by metis
  {
    fix k
    fix f1 f2 q1 q2 a b1 b2 u v1 v2 w1 w2
    assume assms: "accept f1" "accept f2" "q1 \<in> Q" "q2 \<in> Q"
      "init \<leadsto>(a, u @ v1) q1" "q1 \<leadsto>(b1, w1) f1"
      "init \<leadsto>(a, u @ v2) q2" "q2 \<leadsto>(b2, w2) f2"
      "length b1 + length b2 \<le> k"
    have "lcp_dist (v1 @ w1) (v2 @ w2) \<le> t + length b1 * output_speed + length b2 * output_speed"
      using lcp_dist_app_le_sum[of v1 w1 v2 w2] t_def[OF assms(1,2,3,4,5,6,7,8)]
        output_speed_computation[OF assms(6,3)] output_speed_computation[OF assms(8,4)]
      unfolding lcp_dist_same_pref
      by auto
    also have "\<dots> \<le> t + k * output_speed"
      using assms(9)
      by auto (metis add_mult_distrib mult_le_mono1)
    finally have "lcp_dist (v1 @ w1) (v2 @ w2) \<le> t + k * output_speed" .
  }
  then show "\<forall>k. \<exists>t. bv k t"
    unfolding bv_def
    by blast
qed

lemma bv'_bounded:
  assumes "bv' t"
  shows "bounded t"
proof -
  have bv': "\<And>f1 f2 q1 q2 a b1 b2 v1 v2 w1 w2. accept f1 \<Longrightarrow> accept f2 \<Longrightarrow> q1 \<in> Q \<Longrightarrow> q2 \<in> Q \<Longrightarrow>
    init \<leadsto>(a, v1) q1 \<Longrightarrow> q1 \<leadsto>(b1, w1) f1 \<Longrightarrow>
    init \<leadsto>(a, v2) q2 \<Longrightarrow> q2 \<leadsto>(b2, w2) f2 \<Longrightarrow> lcp_dist v1 v2 \<le> t"
    using assms
    by (fastforce simp: bv'_def)
  {
    fix q q' u v v'
    assume prems: "init \<leadsto>(u, v @ v') q" "active q []"
      "init \<leadsto>(u, v) q'" "active q' v'"
    obtain r as bs where tail: "q \<leadsto>(as, bs) r" "accept r"
      using prems(2)
      by (auto simp: active_def)
    obtain r' as' bs' where tail': "q' \<leadsto>(as', v' @ bs') r'" "accept r'"
      using prems(4)
      by (auto simp: active_def)
    note q_Q = comp_closed[OF prems(1) init_in_Q]
    note q'_Q = comp_closed[OF prems(3) init_in_Q]
    have "lcp_dist (v @ v') v = lcp_dist (v @ v') (v @ [])"
      by auto
    moreover have "\<dots> = length v'"
      unfolding lcp_dist_same_pref
      by simp
    finally have "length v' \<le> t"
      using bv'[OF tail(2) tail'(2) q_Q q'_Q prems(1) tail(1) prems(3) tail'(1)]
      by auto
  }
  then show ?thesis
    by (auto simp: bounded_def)
qed

end

end