(*  Title:      Labeled_Strands.thy
    Author:     Andreas Viktor Hess, DTU
    Author:     Sebastian A. Mödersheim, DTU
    Author:     Achim D. Brucker, The University of Sheffield
    SPDX-License-Identifier: BSD-3-Clause
*)

section \<open>Labeled Strands\<close>
theory Labeled_Strands
imports Strands_and_Constraints
begin

subsection \<open>Definitions: Labeled Strands and Constraints\<close>
datatype 'l strand_label =
  LabelN (the_LabelN: "'l") ("ln _")
| LabelS ("\<star>")

text \<open>Labeled strands are strands whose steps are equipped with labels\<close>
type_synonym ('a,'b,'c) labeled_strand_step = "'c strand_label \<times> ('a,'b) strand_step"
type_synonym ('a,'b,'c) labeled_strand = "('a,'b,'c) labeled_strand_step list"

abbreviation has_LabelN where "has_LabelN n x \<equiv> fst x = ln n"
abbreviation has_LabelS where "has_LabelS x \<equiv> fst x = \<star>"

definition unlabel where "unlabel S \<equiv> map snd S"
definition proj where "proj n S \<equiv> filter (\<lambda>s. has_LabelN n s \<or> has_LabelS s) S"
abbreviation proj_unl where "proj_unl n S \<equiv> unlabel (proj n S)"

abbreviation wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t where "wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> wfrestrictedvars\<^sub>s\<^sub>t (unlabel S)"

abbreviation subst_apply_labeled_strand_step (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p" 51) where
  "x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta> \<equiv> (case x of (l, s) \<Rightarrow> (l, s \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>))"

abbreviation subst_apply_labeled_strand (infix "\<cdot>\<^sub>l\<^sub>s\<^sub>t" 51) where
  "S \<cdot>\<^sub>l\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>l\<^sub>s\<^sub>t\<^sub>p \<theta>) S"

abbreviation trms\<^sub>l\<^sub>s\<^sub>t where "trms\<^sub>l\<^sub>s\<^sub>t S \<equiv> trms\<^sub>s\<^sub>t (unlabel S)"
abbreviation trms_proj\<^sub>l\<^sub>s\<^sub>t where "trms_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> trms\<^sub>s\<^sub>t (proj_unl n S)"

abbreviation vars\<^sub>l\<^sub>s\<^sub>t where "vars\<^sub>l\<^sub>s\<^sub>t S \<equiv> vars\<^sub>s\<^sub>t (unlabel S)"
abbreviation vars_proj\<^sub>l\<^sub>s\<^sub>t where "vars_proj\<^sub>l\<^sub>s\<^sub>t n S \<equiv> vars\<^sub>s\<^sub>t (proj_unl n S)"

abbreviation bvars\<^sub>l\<^sub>s\<^sub>t where "bvars\<^sub>l\<^sub>s\<^sub>t S \<equiv> bvars\<^sub>s\<^sub>t (unlabel S)"
abbreviation fv\<^sub>l\<^sub>s\<^sub>t where "fv\<^sub>l\<^sub>s\<^sub>t S \<equiv> fv\<^sub>s\<^sub>t (unlabel S)"

abbreviation wf\<^sub>l\<^sub>s\<^sub>t where "wf\<^sub>l\<^sub>s\<^sub>t V S \<equiv> wf\<^sub>s\<^sub>t V (unlabel S)"

subsection \<open>Lemmata: Projections\<close>
lemma has_LabelS_proj_iff_not_has_LabelN:
  "list_all has_LabelS (proj l A) \<longleftrightarrow> \<not>list_ex (has_LabelN l) A"
by (induct A) (auto simp add: proj_def)

lemma proj_subset_if_no_label:
  assumes "\<not>list_ex (has_LabelN l) A"
  shows "set (proj l A) \<subseteq> set (proj l' A)"
    and "set (proj_unl l A) \<subseteq> set (proj_unl l' A)"
using assms by (induct A) (auto simp add: unlabel_def proj_def)

lemma proj_in_setD:
  assumes a: "a \<in> set (proj l A)"
  obtains k b where "a = (k, b)" "k = (ln l) \<or> k = \<star>"
using that a unfolding proj_def by (cases a) auto

lemma proj_set_mono:
  assumes "set A \<subseteq> set B"
  shows "set (proj n A) \<subseteq> set (proj n B)"
    and "set (proj_unl n A) \<subseteq> set (proj_unl n B)"
using assms unfolding proj_def unlabel_def by auto

lemma unlabel_nil[simp]: "unlabel [] = []"
by (simp add: unlabel_def)

lemma unlabel_mono: "set A \<subseteq> set B \<Longrightarrow> set (unlabel A) \<subseteq> set (unlabel B)"
by (auto simp add: unlabel_def)

lemma unlabel_in: "(l,x) \<in> set A \<Longrightarrow> x \<in> set (unlabel A)"
unfolding unlabel_def by force

lemma unlabel_mem_has_label: "x \<in> set (unlabel A) \<Longrightarrow> \<exists>l. (l,x) \<in> set A"
unfolding unlabel_def by auto

lemma proj_ident:
  assumes "list_all (\<lambda>s. has_LabelN l s \<or> has_LabelS s) S"
  shows "proj l S = S"
using assms unfolding proj_def list_all_iff by fastforce

lemma proj_elims_label:
  assumes "k \<noteq> l"
  shows "\<not>list_ex (has_LabelN l) (proj k S)"
using assms unfolding proj_def list_ex_iff by force

lemma proj_nil[simp]: "proj n [] = []" "proj_unl n [] = []"
unfolding unlabel_def proj_def by auto

lemma singleton_lst_proj[simp]:
  "proj_unl l [(ln l, a)] = [a]"
  "l \<noteq> l' \<Longrightarrow> proj_unl l' [(ln l, a)] = []"
  "proj_unl l [(\<star>, a)] = [a]"
  "unlabel [(l'', a)] = [a]"
unfolding proj_def unlabel_def by simp_all

lemma unlabel_nil_only_if_nil[simp]: "unlabel A = [] \<Longrightarrow> A = []"
unfolding unlabel_def by auto

lemma unlabel_Cons[simp]:
  "unlabel ((l,a)#A) = a#unlabel A"
  "unlabel (b#A) = snd b#unlabel A"
unfolding unlabel_def by simp_all

lemma unlabel_append[simp]: "unlabel (A@B) = unlabel A@unlabel B"
unfolding unlabel_def by auto

lemma proj_Cons[simp]:
  "proj n ((ln n,a)#A) = (ln n,a)#proj n A"
  "proj n ((\<star>,a)#A) = (\<star>,a)#proj n A"
  "m \<noteq> n \<Longrightarrow> proj n ((ln m,a)#A) = proj n A"
  "l = (ln n) \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A"
  "l = \<star> \<Longrightarrow> proj n ((l,a)#A) = (l,a)#proj n A"
  "fst b \<noteq> \<star> \<Longrightarrow> fst b \<noteq> (ln n) \<Longrightarrow> proj n (b#A) = proj n A"
unfolding proj_def by auto

lemma proj_append[simp]:
  "proj l (A'@B') = proj l A'@proj l B'"
  "proj_unl l (A@B) = proj_unl l A@proj_unl l B"
unfolding proj_def unlabel_def by auto

lemma proj_unl_cons[simp]:
  "proj_unl l ((ln l, a)#A) = a#proj_unl l A"
  "l \<noteq> l' \<Longrightarrow> proj_unl l' ((ln l, a)#A) = proj_unl l' A"
  "proj_unl l ((\<star>, a)#A) = a#proj_unl l A"
unfolding proj_def unlabel_def by simp_all

lemma trms_unlabel_proj[simp]:
  "trms\<^sub>s\<^sub>t\<^sub>p (snd (ln l, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(ln l, x)]"
by auto

lemma trms_unlabel_star[simp]:
  "trms\<^sub>s\<^sub>t\<^sub>p (snd (\<star>, x)) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l [(\<star>, x)]"
by auto

lemma trms\<^sub>l\<^sub>s\<^sub>t_union[simp]: "trms\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)"
proof (induction A)
  case (Cons a A)
  obtain l s where ls: "a = (l,s)" by moura
  have "trms\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a])"
  proof -
    have *: "trms\<^sub>l\<^sub>s\<^sub>t [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
    show ?thesis
    proof (cases l)
      case (LabelN n)
      hence "trms_proj\<^sub>l\<^sub>s\<^sub>t n [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> trms_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto
      ultimately show ?thesis using * ls by fastforce
    next
      case LabelS
      hence "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] = trms\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
      thus ?thesis using * ls by fastforce
    qed
  qed
  moreover have "\<forall>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = trms_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l A"
    unfolding unlabel_def proj_def by auto
  hence "(\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A)" by auto
  ultimately show ?case using Cons.IH ls by auto
qed simp

lemma trms\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms\<^sub>l\<^sub>s\<^sub>t (A@B) = trms\<^sub>l\<^sub>s\<^sub>t A \<union> trms\<^sub>l\<^sub>s\<^sub>t B"
by (metis trms\<^sub>s\<^sub>t_append unlabel_append)

lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_append[simp]: "trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B) = trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<union> trms_proj\<^sub>l\<^sub>s\<^sub>t l B"
by (metis (no_types, lifting) filter_append proj_def trms\<^sub>l\<^sub>s\<^sub>t_append)

lemma trms_proj\<^sub>l\<^sub>s\<^sub>t_subset[simp]:
  "trms_proj\<^sub>l\<^sub>s\<^sub>t l A \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)"
  "trms_proj\<^sub>l\<^sub>s\<^sub>t l B \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t l (A@B)"
using trms_proj\<^sub>l\<^sub>s\<^sub>t_append[of l] by blast+

lemma trms\<^sub>l\<^sub>s\<^sub>t_subset[simp]:
  "trms\<^sub>l\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)"
  "trms\<^sub>l\<^sub>s\<^sub>t B \<subseteq> trms\<^sub>l\<^sub>s\<^sub>t (A@B)"
proof (induction A)
  case (Cons a A)
  obtain l s where *: "a = (l,s)" by moura
  { case 1 thus ?case using Cons * by auto }
  { case 2 thus ?case using Cons * by auto }
qed simp_all

lemma vars\<^sub>l\<^sub>s\<^sub>t_union: "vars\<^sub>l\<^sub>s\<^sub>t A = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)"
proof (induction A)
  case (Cons a A)
  obtain l s where ls: "a = (l,s)" by moura
  have "vars\<^sub>l\<^sub>s\<^sub>t [a] = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a])"
  proof -
    have *: "vars\<^sub>l\<^sub>s\<^sub>t [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
    show ?thesis
    proof (cases l)
      case (LabelN n)
      hence "vars_proj\<^sub>l\<^sub>s\<^sub>t n [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> vars_proj\<^sub>l\<^sub>s\<^sub>t m [a] = {}" using ls LabelN by auto
      ultimately show ?thesis using * ls by fast
    next
      case LabelS
      hence "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] = vars\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
      thus ?thesis using * ls by fast
    qed
  qed
  moreover have "\<forall>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A) = vars_proj\<^sub>l\<^sub>s\<^sub>t l [a] \<union> vars_proj\<^sub>l\<^sub>s\<^sub>t l A"
    unfolding unlabel_def proj_def by auto
  hence "(\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l (a#A)) = (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l [a]) \<union> (\<Union>l. vars_proj\<^sub>l\<^sub>s\<^sub>t l A)"
    using strand_vars_split(1) by auto
  ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto
qed simp

lemma unlabel_Cons_inv:
  "unlabel A = b#B \<Longrightarrow> \<exists>A'. (\<exists>n. A = (ln n, b)#A') \<or> A = (\<star>, b)#A'"
proof -
  assume *: "unlabel A = b#B"
  then obtain l A' where "A = (l,b)#A'" unfolding unlabel_def by moura
  thus "\<exists>A'. (\<exists>l. A = (ln l, b)#A') \<or> A = (\<star>, b)#A'" by (metis strand_label.exhaust)
qed

lemma unlabel_snoc_inv:
  "unlabel A = B@[b] \<Longrightarrow> \<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]"
proof -
  assume *: "unlabel A = B@[b]"
  then obtain A' l where "A = A'@[(l,b)]"
    unfolding unlabel_def by (induct A rule: List.rev_induct) auto
  thus "\<exists>A'. (\<exists>n. A = A'@[(ln n, b)]) \<or> A = A'@[(\<star>, b)]" by (cases l) auto
qed

lemma proj_idem[simp]: "proj l (proj l A) = proj l A"
unfolding proj_def by auto

lemma proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set:
  "ik\<^sub>s\<^sub>t (proj_unl n A) =
    {t. \<exists>ts. ((ln n, Receive ts) \<in> set A \<or> (\<star>, Receive ts) \<in> set A) \<and> t \<in> set ts} "
using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def proj_def by force

lemma unlabel_ik\<^sub>s\<^sub>t_is_rcv_set:
  "ik\<^sub>s\<^sub>t (unlabel A) = {t | l t ts. (l, Receive ts) \<in> set A \<and> t \<in> set ts}"
using ik\<^sub>s\<^sub>t_is_rcv_set unfolding unlabel_def by force

lemma proj_ik_union_is_unlabel_ik:
  "ik\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))"
proof
  show "(\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A)) \<subseteq> ik\<^sub>s\<^sub>t (unlabel A)"
    using unlabel_ik\<^sub>s\<^sub>t_is_rcv_set[of A] proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by auto

  show "ik\<^sub>s\<^sub>t (unlabel A) \<subseteq> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))"
  proof
    fix t assume "t \<in> ik\<^sub>s\<^sub>t (unlabel A)"
    then obtain l ts where "(l, Receive ts) \<in> set A" "t \<in> set ts"
      using ik\<^sub>s\<^sub>t_is_rcv_set unlabel_mem_has_label[of _ A]
      by moura
    thus "t \<in> (\<Union>l. ik\<^sub>s\<^sub>t (proj_unl l A))" using proj_ik\<^sub>s\<^sub>t_is_proj_rcv_set[of _ A] by (cases l) auto
  qed
qed

lemma proj_ik_append[simp]:
  "ik\<^sub>s\<^sub>t (proj_unl l (A@B)) = ik\<^sub>s\<^sub>t (proj_unl l A) \<union> ik\<^sub>s\<^sub>t (proj_unl l B)"
using proj_append(2)[of l A B] ik_append by auto

lemma proj_ik_append_subst_all:
  "ik\<^sub>s\<^sub>t (proj_unl l (A@B)) \<cdot>\<^sub>s\<^sub>e\<^sub>t I = (ik\<^sub>s\<^sub>t (proj_unl l A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<union> (ik\<^sub>s\<^sub>t (proj_unl l B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I)"
using proj_ik_append[of l] by auto

lemma ik_proj_subset[simp]: "ik\<^sub>s\<^sub>t (proj_unl n A) \<subseteq> trms_proj\<^sub>l\<^sub>s\<^sub>t n A"
by auto

lemma prefix_unlabel:
  "prefix A B \<Longrightarrow> prefix (unlabel A) (unlabel B)"
unfolding prefix_def unlabel_def by auto

lemma prefix_proj:
  "prefix A B \<Longrightarrow> prefix (proj n A) (proj n B)"
  "prefix A B \<Longrightarrow> prefix (proj_unl n A) (proj_unl n B)"
unfolding prefix_def proj_def by auto

lemma suffix_unlabel:
  "suffix A B \<Longrightarrow> suffix (unlabel A) (unlabel B)"
unfolding suffix_def unlabel_def by auto

lemma suffix_proj:
  "suffix A B \<Longrightarrow> suffix (proj n A) (proj n B)"
  "suffix A B \<Longrightarrow> suffix (proj_unl n A) (proj_unl n B)"
unfolding suffix_def proj_def by auto

subsection \<open>Lemmata: Well-formedness\<close>
lemma wfvarsoccs\<^sub>s\<^sub>t_proj_union:
  "wfvarsoccs\<^sub>s\<^sub>t (unlabel A) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))"
proof (induction A)
  case (Cons a A)
  obtain l s where ls: "a = (l,s)" by moura
  have "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]))"
  proof -
    have *: "wfvarsoccs\<^sub>s\<^sub>t (unlabel [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
    show ?thesis
    proof (cases l)
      case (LabelN n)
      hence "wfvarsoccs\<^sub>s\<^sub>t (proj_unl n [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by simp
      moreover have "\<forall>m. n \<noteq> m \<longrightarrow> wfvarsoccs\<^sub>s\<^sub>t (proj_unl m [a]) = {}" using ls LabelN by auto
      ultimately show ?thesis using * ls by fast
    next
      case LabelS
      hence "\<forall>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) = wfvarsoccs\<^sub>s\<^sub>t\<^sub>p s" using ls by auto
      thus ?thesis using * ls by fast
    qed
  qed
  moreover have
      "wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A)) =
       wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a]) \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)"
    for l
    unfolding unlabel_def proj_def by auto
  hence "(\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l (a#A))) =
         (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l [a])) \<union> (\<Union>l. wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A))"
    using strand_vars_split(1) by auto
  ultimately show ?case using Cons.IH ls strand_vars_split(1) by auto
qed simp

lemma wf_if_wf_proj:
  assumes "\<forall>l. wf\<^sub>s\<^sub>t V (proj_unl l A)"
  shows "wf\<^sub>s\<^sub>t V (unlabel A)"
using assms
proof (induction A arbitrary: V rule: List.rev_induct)
  case (snoc a A)
  hence IH: "wf\<^sub>s\<^sub>t V (unlabel A)" using proj_append(2)[of _ A] by auto
  obtain b l where b: "a = (ln l, b) \<or> a = (\<star>, b)" by (cases a, metis strand_label.exhaust)
  hence *: "wf\<^sub>s\<^sub>t V (proj_unl l A@[b])"
    by (metis snoc.prems proj_append(2) singleton_lst_proj(1) proj_unl_cons(1,3))
  thus ?case using IH b snoc.prems proj_append(2)[of l A "[a]"] unlabel_append[of A "[a]"]
  proof (cases b)
    case (Receive ts)
    have "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V"
    proof
      fix x assume "x \<in> fv\<^sub>s\<^sub>e\<^sub>t (set ts)"
      hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Receive by auto
      thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto
    qed
    hence "fv\<^sub>s\<^sub>e\<^sub>t (set ts) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (unlabel A) \<union> V"
      using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] by blast
    hence "wf\<^sub>s\<^sub>t V (unlabel A@[Receive ts])" by (rule wf_rcv_append'''[OF IH])
    thus ?thesis using b Receive unlabel_append[of A "[a]"] by auto
  next
    case (Equality ac s t)
    have "fv t \<subseteq> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" when "ac = Assign"
    proof
      fix x assume "x \<in> fv t"
      hence "x \<in> V \<union> wfvarsoccs\<^sub>s\<^sub>t (proj_unl l A)" using wf_append_exec[OF *] b Equality that by auto
      thus "x \<in> wfvarsoccs\<^sub>s\<^sub>t (unlabel A) \<union> V" using wfvarsoccs\<^sub>s\<^sub>t_proj_union[of A] by auto
    qed
    hence "fv t \<subseteq> wfrestrictedvars\<^sub>l\<^sub>s\<^sub>t A \<union> V" when "ac = Assign"
      using vars_snd_rcv_strand_subset2(4)[of "unlabel A"] that by blast
    hence "wf\<^sub>s\<^sub>t V (unlabel A@[Equality ac s t])"
      by (cases ac) (metis wf_eq_append'''[OF IH], metis wf_eq_check_append''[OF IH])
    thus ?thesis using b Equality unlabel_append[of A "[a]"] by auto
  qed auto
qed simp

end


(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      StateSpace.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2004-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section {* State Space Template *}
theory StateSpace imports Main
begin

record 'g state = "globals"::'g

definition
  upd_globals:: "('g \<Rightarrow> 'g) \<Rightarrow> ('g,'z) state_scheme \<Rightarrow> ('g,'z) state_scheme"
where
  "upd_globals upd s = s\<lparr>globals := upd (globals s)\<rparr>"

record ('g, 'n, 'val) stateSP = "'g state" +
  locals :: "'n \<Rightarrow> 'val"

lemma upd_globals_conv: "upd_globals f = (\<lambda>s. s\<lparr>globals := f (globals s)\<rparr>)"
  by (rule ext) (simp add: upd_globals_def)

end


section \<open>CFG\<close>

theory WCFG imports Com "../Basic/BasicDefs" begin

subsection\<open>CFG nodes\<close>

datatype w_node = Node nat ("'('_ _ '_')")
  | Entry ("'('_Entry'_')")
  | Exit ("'('_Exit'_')")

fun label_incr :: "w_node \<Rightarrow> nat \<Rightarrow> w_node" ("_ \<oplus> _" 60)
where "(_ l _) \<oplus> i = (_ l + i _)"
  | "(_Entry_) \<oplus> i = (_Entry_)"
  | "(_Exit_) \<oplus> i  = (_Exit_)"

lemma Exit_label_incr [dest]: "(_Exit_) = n \<oplus> i \<Longrightarrow> n = (_Exit_)"
  by(cases n,auto)

lemma label_incr_Exit [dest]: "n \<oplus> i = (_Exit_) \<Longrightarrow> n = (_Exit_)"
  by(cases n,auto)

lemma Entry_label_incr [dest]: "(_Entry_) = n \<oplus> i \<Longrightarrow> n = (_Entry_)"
  by(cases n,auto)

lemma label_incr_Entry [dest]: "n \<oplus> i = (_Entry_) \<Longrightarrow> n = (_Entry_)"
  by(cases n,auto)

lemma label_incr_inj:
  "n \<oplus> c = n' \<oplus> c \<Longrightarrow> n = n'"
by(cases n)(cases n',auto)+

lemma label_incr_simp:"n \<oplus> i = m \<oplus> (i + j) \<Longrightarrow> n = m \<oplus> j"
by(cases n,auto,cases m,auto)

lemma label_incr_start_Node_smaller:
  "(_ l _) = n \<oplus> i \<Longrightarrow> n = (_(l - i)_)"
by(cases n,auto)

lemma label_incr_ge:"(_ l _) = n \<oplus> i \<Longrightarrow> l \<ge> i"
by(cases n) auto

lemma label_incr_0 [dest]:
  "\<lbrakk>(_0_) = n \<oplus> i; i > 0\<rbrakk> \<Longrightarrow> False"
by(cases n) auto

lemma label_incr_0_rev [dest]:
  "\<lbrakk>n \<oplus> i = (_0_); i > 0\<rbrakk> \<Longrightarrow> False"
by(cases n) auto

subsection\<open>CFG edges\<close>

type_synonym w_edge = "(w_node \<times> state edge_kind \<times> w_node)"

inductive While_CFG :: "cmd \<Rightarrow> w_node \<Rightarrow> state edge_kind \<Rightarrow> w_node \<Rightarrow> bool"
  ("_ \<turnstile> _ -_\<rightarrow> _")
where

WCFG_Entry_Exit:
  "prog \<turnstile> (_Entry_) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (_Exit_)"

| WCFG_Entry:
  "prog \<turnstile> (_Entry_) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (_0_)"

| WCFG_Skip:
  "Skip \<turnstile> (_0_) -\<Up>id\<rightarrow> (_Exit_)"

| WCFG_LAss:
  "V:=e \<turnstile> (_0_) -\<Up>(\<lambda>s. s(V:=(interpret e s)))\<rightarrow> (_1_)"

| WCFG_LAssSkip:
  "V:=e \<turnstile> (_1_) -\<Up>id\<rightarrow> (_Exit_)"

| WCFG_SeqFirst:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'; n' \<noteq> (_Exit_)\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n -et\<rightarrow> n'"

| WCFG_SeqConnect:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow> (_Exit_); n \<noteq> (_Entry_)\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n -et\<rightarrow> (_0_) \<oplus> #:c\<^sub>1"

| WCFG_SeqSecond:
  "\<lbrakk>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'; n \<noteq> (_Entry_)\<rbrakk> \<Longrightarrow> c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -et\<rightarrow> n' \<oplus> #:c\<^sub>1"

| WCFG_CondTrue:
    "if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some true)\<^sub>\<surd>\<rightarrow> (_0_) \<oplus> 1"

| WCFG_CondFalse:
    "if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some false)\<^sub>\<surd>\<rightarrow> (_0_) \<oplus> (#:c\<^sub>1 + 1)"

| WCFG_CondThen:
  "\<lbrakk>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'; n \<noteq> (_Entry_)\<rbrakk> \<Longrightarrow> if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -et\<rightarrow> n' \<oplus> 1"

| WCFG_CondElse:
  "\<lbrakk>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'; n \<noteq> (_Entry_)\<rbrakk>
  \<Longrightarrow> if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> (#:c\<^sub>1 + 1) -et\<rightarrow> n' \<oplus> (#:c\<^sub>1 + 1)"

| WCFG_WhileTrue:
    "while (b) c' \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some true)\<^sub>\<surd>\<rightarrow> (_0_) \<oplus> 2"

| WCFG_WhileFalse:
    "while (b) c' \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some false)\<^sub>\<surd>\<rightarrow> (_1_)"

| WCFG_WhileFalseSkip:
  "while (b) c' \<turnstile> (_1_) -\<Up>id\<rightarrow> (_Exit_)"

| WCFG_WhileBody:
  "\<lbrakk>c' \<turnstile> n -et\<rightarrow> n'; n \<noteq> (_Entry_); n' \<noteq> (_Exit_)\<rbrakk>
  \<Longrightarrow> while (b) c' \<turnstile> n \<oplus> 2 -et\<rightarrow> n' \<oplus> 2"

| WCFG_WhileBodyExit:
  "\<lbrakk>c' \<turnstile> n -et\<rightarrow> (_Exit_); n \<noteq> (_Entry_)\<rbrakk> \<Longrightarrow> while (b) c' \<turnstile> n \<oplus> 2 -et\<rightarrow> (_0_)"

lemmas WCFG_intros = While_CFG.intros[split_format (complete)]
lemmas WCFG_elims = While_CFG.cases[split_format (complete)]
lemmas WCFG_induct = While_CFG.induct[split_format (complete)]

subsection \<open>Some lemmas about the CFG\<close>

lemma WCFG_Exit_no_sourcenode [dest]:
  "prog \<turnstile> (_Exit_) -et\<rightarrow> n' \<Longrightarrow> False"
by(induct prog n\<equiv>"(_Exit_)" et n' rule:WCFG_induct,auto)

lemma WCFG_Entry_no_targetnode [dest]:
  "prog \<turnstile> n -et\<rightarrow> (_Entry_) \<Longrightarrow> False"
by(induct prog n et n'\<equiv>"(_Entry_)" rule:WCFG_induct,auto)

lemma WCFG_targetlabel_less_num_nodes:
  "prog \<turnstile> n -et\<rightarrow> (_ l _) \<Longrightarrow> l < #:prog"
proof(induct prog n et "(_ l _)" arbitrary:l rule:WCFG_induct)
  case (WCFG_SeqFirst c\<^sub>1 n et c\<^sub>2)
  from \<open>l < #:c\<^sub>1\<close> show ?case by simp
next
  case (WCFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1)
  note IH = \<open>\<And>l. n' = (_ l _) \<Longrightarrow> l < #:c\<^sub>2\<close>
  from \<open>n' \<oplus> #:c\<^sub>1 = (_ l _)\<close> obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with \<open>n' \<oplus> #:c\<^sub>1 = (_ l _)\<close> \<open>n' = (_ l' _)\<close> show ?case by simp
next
  case (WCFG_CondThen c\<^sub>1 n et n' b c\<^sub>2)
  note IH = \<open>\<And>l. n' = (_ l _) \<Longrightarrow> l < #:c\<^sub>1\<close>
  from \<open>n' \<oplus> 1 = (_ l _)\<close> obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>1" .
  with \<open>n' \<oplus> 1 = (_ l _)\<close> \<open>n' = (_ l' _)\<close> show ?case by simp
next
  case (WCFG_CondElse c\<^sub>2 n et n' b c\<^sub>1)
  note IH = \<open>\<And>l. n' = (_ l _) \<Longrightarrow> l < #:c\<^sub>2\<close>
  from \<open>n' \<oplus> (#:c\<^sub>1 + 1) = (_ l _)\<close> obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c\<^sub>2" .
  with \<open>n' \<oplus> (#:c\<^sub>1 + 1) = (_ l _)\<close> \<open>n' = (_ l' _)\<close> show ?case by simp
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = \<open>\<And>l. n' = (_ l _) \<Longrightarrow> l < #:c'\<close>
  from \<open>n' \<oplus> 2 = (_ l _)\<close> obtain l' where "n' = (_ l' _)" by(cases n') auto
  from IH[OF this] have "l' < #:c'" .
  with \<open>n' \<oplus> 2 = (_ l _)\<close> \<open>n' = (_ l' _)\<close> show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)

lemma WCFG_EntryD:
  "prog \<turnstile> (_Entry_) -et\<rightarrow> n'
  \<Longrightarrow> (n' = (_Exit_) \<and> et = (\<lambda>s. False)\<^sub>\<surd>) \<or> (n' = (_0_) \<and> et = (\<lambda>s. True)\<^sub>\<surd>)"
by(induct prog n\<equiv>"(_Entry_)" et n' rule:WCFG_induct,auto)

(*<*)declare One_nat_def [simp del] add_2_eq_Suc' [simp del](*>*)

lemma WCFG_edge_det:
  "\<lbrakk>prog \<turnstile> n -et\<rightarrow> n'; prog \<turnstile> n -et'\<rightarrow> n'\<rbrakk> \<Longrightarrow> et = et'"
proof(induct rule:WCFG_induct)
  case WCFG_Entry_Exit thus ?case by(fastforce dest:WCFG_EntryD)
next
  case WCFG_Entry thus ?case by(fastforce dest:WCFG_EntryD)
next
  case WCFG_Skip thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_LAss thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_LAssSkip thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_SeqFirst c\<^sub>1 n et n' c\<^sub>2)
  note IH = \<open>c\<^sub>1 \<turnstile> n -et'\<rightarrow> n' \<Longrightarrow> et = et'\<close>
  from \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n' \<noteq> (_Exit_)\<close> obtain l where "n' = (_ l _)"
    by (cases n') auto
  with \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> have "l < #:c\<^sub>1"
    by(fastforce intro:WCFG_targetlabel_less_num_nodes)
  with \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n -et'\<rightarrow> n'\<close> \<open>n' = (_ l _)\<close> have "c\<^sub>1 \<turnstile> n -et'\<rightarrow> n'"
    by(fastforce elim:WCFG_elims intro:WCFG_intros dest:label_incr_ge)
  from IH[OF this] show ?case .
next
  case (WCFG_SeqConnect c\<^sub>1 n et c\<^sub>2)
  note IH = \<open>c\<^sub>1 \<turnstile> n -et'\<rightarrow> (_Exit_) \<Longrightarrow> et = et'\<close>
  from \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> (_Exit_)\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  with \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> (_Exit_)\<close> have "l < #:c\<^sub>1"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n -et'\<rightarrow> (_ 0 _) \<oplus> #:c\<^sub>1\<close> \<open>n = (_ l _)\<close> have "c\<^sub>1 \<turnstile> n -et'\<rightarrow> (_Exit_)"
    by(fastforce elim:WCFG_elims dest:WCFG_targetlabel_less_num_nodes label_incr_ge)
  from IH[OF this] show ?case .
next
  case (WCFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1)
  note IH = \<open>c\<^sub>2 \<turnstile> n -et'\<rightarrow> n' \<Longrightarrow> et = et'\<close>
  from \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  with \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> have "l < #:c\<^sub>2"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n \<oplus> #:c\<^sub>1 -et'\<rightarrow> n' \<oplus> #:c\<^sub>1\<close> \<open>n = (_ l _)\<close> have "c\<^sub>2 \<turnstile> n -et'\<rightarrow> n'"
    by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes label_incr_ge
                                    dest!:label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case WCFG_CondTrue thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_CondFalse thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_CondThen c\<^sub>1 n et n' b c\<^sub>2)
  note IH = \<open>c\<^sub>1 \<turnstile> n -et'\<rightarrow> n' \<Longrightarrow> et = et'\<close>
  from \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  with \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> have "l < #:c\<^sub>1"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> 1 -et'\<rightarrow> n' \<oplus> 1\<close> \<open>n = (_ l _)\<close>
  have "c\<^sub>1 \<turnstile> n -et'\<rightarrow> n'"
    by -(erule WCFG_elims,(fastforce dest:label_incr_ge label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case (WCFG_CondElse c\<^sub>2 n et n' b c\<^sub>1)
  note IH = \<open>c\<^sub>2 \<turnstile> n -et'\<rightarrow> n' \<Longrightarrow> et = et'\<close>
  from \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  with \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> have "l < #:c\<^sub>2"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n \<oplus> (#:c\<^sub>1 + 1) -et'\<rightarrow> n' \<oplus> (#:c\<^sub>1 + 1)\<close> \<open>n = (_ l _)\<close>
  have "c\<^sub>2 \<turnstile> n -et'\<rightarrow> n'"
    by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes
                             label_incr_inj label_incr_ge label_incr_simp_rev)+)
  from IH[OF this] show ?case .
next
  case WCFG_WhileTrue thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_WhileFalse thus ?case by(fastforce elim:WCFG_elims)
next
  case WCFG_WhileFalseSkip thus ?case by(fastforce elim:WCFG_elims)
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = \<open>c' \<turnstile> n -et'\<rightarrow> n' \<Longrightarrow> et = et'\<close>
  from \<open>c' \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  moreover
  with \<open>c' \<turnstile> n -et\<rightarrow> n'\<close> have "l < #:c'"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  moreover
  from \<open>c' \<turnstile> n -et\<rightarrow> n'\<close> \<open>n' \<noteq> (_Exit_)\<close> obtain l' where "n' = (_ l' _)"
    by (cases n') auto
  moreover
  with \<open>c' \<turnstile> n -et\<rightarrow> n'\<close> have "l' < #:c'"
    by(fastforce intro:WCFG_targetlabel_less_num_nodes)
  ultimately have "c' \<turnstile> n -et'\<rightarrow> n'" using \<open>while (b) c' \<turnstile> n \<oplus> 2 -et'\<rightarrow> n' \<oplus> 2\<close>
    by(fastforce elim:WCFG_elims dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = \<open>c' \<turnstile> n -et'\<rightarrow> (_Exit_) \<Longrightarrow> et = et'\<close>
  from \<open>c' \<turnstile> n -et\<rightarrow> (_Exit_)\<close> \<open>n \<noteq> (_Entry_)\<close> obtain l where "n = (_ l _)"
    by (cases n) auto
  with \<open>c' \<turnstile> n -et\<rightarrow> (_Exit_)\<close> have "l < #:c'"
    by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
  with \<open>while (b) c' \<turnstile> n \<oplus> 2 -et'\<rightarrow> (_0_)\<close> \<open>n = (_ l _)\<close>
  have "c' \<turnstile> n -et'\<rightarrow> (_Exit_)"
    by -(erule WCFG_elims,auto dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
qed

(*<*)declare One_nat_def [simp] add_2_eq_Suc' [simp](*>*)

lemma less_num_nodes_edge_Exit:
  obtains l et where "l < #:prog" and "prog \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)"
proof -
  have "\<exists>l et. l < #:prog \<and> prog \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)"
  proof(induct prog)
    case Skip
    have "0 < #:Skip" by simp
    moreover have "Skip \<turnstile> (_0_) -\<Up>id\<rightarrow> (_Exit_)" by(rule WCFG_Skip)
    ultimately show ?case by blast
  next
    case (LAss V e)
    have "1 < #:(V:=e)" by simp
    moreover have "V:=e \<turnstile> (_1_) -\<Up>id\<rightarrow> (_Exit_)" by(rule WCFG_LAssSkip)
    ultimately show ?case by blast
  next
    case (Seq prog1 prog2)
    from \<open>\<exists>l et. l < #:prog2 \<and> prog2 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)\<close>
    obtain l et where "l < #:prog2" and "prog2 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)"
      by blast
    from \<open>prog2 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)\<close>
    have "prog1;;prog2 \<turnstile> (_ l _) \<oplus> #:prog1 -et\<rightarrow> (_Exit_) \<oplus> #:prog1"
      by(fastforce intro:WCFG_SeqSecond)
    with \<open>l < #:prog2\<close> show ?case by(rule_tac x="l + #:prog1" in exI,auto)
  next
    case (Cond b prog1 prog2)
    from \<open>\<exists>l et. l < #:prog1 \<and> prog1 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)\<close>
    obtain l et where "l < #:prog1" and "prog1 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)"
      by blast
    from \<open>prog1 \<turnstile> (_ l _) -et\<rightarrow> (_Exit_)\<close>
    have "if (b) prog1 else prog2 \<turnstile> (_ l _) \<oplus> 1 -et\<rightarrow> (_Exit_) \<oplus> 1"
      by(fastforce intro:WCFG_CondThen)
    with \<open>l < #:prog1\<close> show ?case by(rule_tac x="l + 1" in exI,auto)
  next
    case (While b prog')
    have "1 < #:(while (b) prog')" by simp
    moreover have "while (b) prog' \<turnstile> (_1_) -\<Up>id\<rightarrow> (_Exit_)"
      by(rule WCFG_WhileFalseSkip)
    ultimately show ?case by blast
  qed
  with that show ?thesis by blast
qed

lemma less_num_nodes_edge:
  "l < #:prog \<Longrightarrow> \<exists>n et. prog \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog \<turnstile> (_ l _) -et\<rightarrow> n"
proof(induct prog arbitrary:l)
  case Skip
  from \<open>l < #:Skip\<close> have "l = 0" by simp
  hence "Skip \<turnstile> (_ l _) -\<Up>id\<rightarrow> (_Exit_)" by(fastforce intro:WCFG_Skip)
  thus ?case by blast
next
  case (LAss V e)
  from \<open>l < #:V:=e\<close> have "l = 0 \<or> l = 1" by auto
  thus ?case
  proof
    assume "l = 0"
    hence "V:=e \<turnstile> (_Entry_) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (_ l _)" by(fastforce intro:WCFG_Entry)
    thus ?thesis by blast
  next
    assume "l = 1"
    hence "V:=e \<turnstile> (_ l _) -\<Up>id\<rightarrow> (_Exit_)" by(fastforce intro:WCFG_LAssSkip)
    thus ?thesis by blast
  qed
next
  case (Seq prog1 prog2)
  note IH1 = \<open>\<And>l. l < #:prog1 \<Longrightarrow>
              \<exists>n et. prog1 \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog1 \<turnstile> (_ l _) -et\<rightarrow> n\<close>
  note IH2 = \<open>\<And>l. l < #:prog2 \<Longrightarrow>
              \<exists>n et. prog2 \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog2 \<turnstile> (_ l _) -et\<rightarrow> n\<close>
  show ?case
  proof(cases "l < #:prog1")
    case True
    from IH1[OF this] obtain n et
      where "prog1 \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog1 \<turnstile> (_ l _) -et\<rightarrow> n" by blast
    thus ?thesis
    proof
      assume "prog1 \<turnstile> n -et\<rightarrow> (_ l _)"
      hence "prog1;; prog2 \<turnstile> n -et\<rightarrow> (_ l _)" by(fastforce intro:WCFG_SeqFirst)
      thus ?thesis by blast
    next
      assume edge:"prog1 \<turnstile> (_ l _) -et\<rightarrow> n"
      show ?thesis
      proof(cases "n = (_Exit_)")
        case True
        with edge have "prog1;; prog2 \<turnstile> (_ l _) -et\<rightarrow> (_0_) \<oplus> #:prog1"
          by(fastforce intro:WCFG_SeqConnect)
        thus ?thesis by blast
      next
        case False
        with edge have "prog1;; prog2 \<turnstile> (_ l _) -et\<rightarrow> n"
          by(fastforce intro:WCFG_SeqFirst)
        thus ?thesis by blast
      qed
    qed
  next
    case False
    hence "#:prog1 \<le> l" by simp
    then obtain l' where "l = l' + #:prog1" and "l' = l - #:prog1" by simp
    from \<open>l = l' + #:prog1\<close> \<open>l < #:prog1;; prog2\<close> have "l' < #:prog2" by simp
    from IH2[OF this] obtain n et
      where "prog2 \<turnstile> n -et\<rightarrow> (_ l' _) \<or> prog2 \<turnstile> (_ l' _) -et\<rightarrow> n" by blast
    thus ?thesis
    proof
      assume "prog2 \<turnstile> n -et\<rightarrow> (_ l' _)"
      show ?thesis
      proof(cases "n = (_Entry_)")
        case True
        with \<open>prog2 \<turnstile> n -et\<rightarrow> (_ l' _)\<close> have "l' = 0" by(auto dest:WCFG_EntryD)
        obtain l'' et'' where "l'' < #:prog1"
          and "prog1 \<turnstile> (_ l'' _) -et''\<rightarrow> (_Exit_)"
          by(erule less_num_nodes_edge_Exit)
        hence "prog1;;prog2 \<turnstile> (_ l'' _) -et''\<rightarrow> (_0_) \<oplus> #:prog1"
          by(fastforce intro:WCFG_SeqConnect)
        with \<open>l' = 0\<close> \<open>l = l' + #:prog1\<close> show ?thesis by simp blast
      next
        case False
        with \<open>prog2 \<turnstile> n -et\<rightarrow> (_ l' _)\<close>
        have "prog1;;prog2 \<turnstile> n \<oplus> #:prog1 -et\<rightarrow> (_ l' _) \<oplus> #:prog1"
          by(fastforce intro:WCFG_SeqSecond)
        with \<open>l = l' + #:prog1\<close> show ?thesis  by simp blast
      qed
    next
      assume "prog2 \<turnstile> (_ l' _) -et\<rightarrow> n"
      hence "prog1;;prog2 \<turnstile> (_ l' _) \<oplus> #:prog1 -et\<rightarrow> n \<oplus> #:prog1"
        by(fastforce intro:WCFG_SeqSecond)
      with \<open>l = l' + #:prog1\<close> show ?thesis  by simp blast
    qed
  qed
next
  case (Cond b prog1 prog2)
  note IH1 = \<open>\<And>l. l < #:prog1 \<Longrightarrow>
              \<exists>n et. prog1 \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog1 \<turnstile> (_ l _) -et\<rightarrow> n\<close>
  note IH2 = \<open>\<And>l. l < #:prog2 \<Longrightarrow>
              \<exists>n et. prog2 \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog2 \<turnstile> (_ l _) -et\<rightarrow> n\<close>
  show ?case
  proof(cases "l = 0")
    case True
    have "if (b) prog1 else prog2 \<turnstile> (_Entry_) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (_0_)"
      by(rule WCFG_Entry)
    with True show ?thesis by simp blast
  next
    case False
    hence "0 < l" by simp
    then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
    thus ?thesis
    proof(cases "l' < #:prog1")
      case True
      from IH1[OF this] obtain n et
        where "prog1 \<turnstile> n -et\<rightarrow> (_ l' _) \<or> prog1 \<turnstile> (_ l' _) -et\<rightarrow> n" by blast
      thus ?thesis
      proof
        assume edge:"prog1 \<turnstile> n -et\<rightarrow> (_ l' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with edge have "l' = 0" by(auto dest:WCFG_EntryD)
          have "if (b) prog1 else prog2 \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some true)\<^sub>\<surd>\<rightarrow>
                                          (_0_) \<oplus> 1"
            by(rule WCFG_CondTrue)
          with \<open>l' = 0\<close> \<open>l = l' + 1\<close> show ?thesis by simp blast
        next
          case False
          with edge have "if (b) prog1 else prog2 \<turnstile> n \<oplus> 1 -et\<rightarrow> (_ l' _) \<oplus> 1"
            by(fastforce intro:WCFG_CondThen)
          with \<open>l = l' + 1\<close> show ?thesis by simp blast
        qed
      next
        assume "prog1 \<turnstile> (_ l' _) -et\<rightarrow> n"
        hence "if (b) prog1 else prog2 \<turnstile> (_ l' _) \<oplus> 1 -et\<rightarrow> n \<oplus> 1"
          by(fastforce intro:WCFG_CondThen)
        with \<open>l = l' + 1\<close> show ?thesis by simp blast
      qed
    next
      case False
      hence "#:prog1 \<le> l'" by simp
      then obtain l'' where "l' = l'' + #:prog1" and "l'' = l' - #:prog1"
        by simp
      from \<open>l' = l'' + #:prog1\<close> \<open>l = l' + 1\<close> \<open>l < #:(if (b) prog1 else prog2)\<close>
      have "l'' < #:prog2" by simp
      from IH2[OF this] obtain n et
        where "prog2 \<turnstile> n -et\<rightarrow> (_ l'' _) \<or> prog2 \<turnstile> (_ l'' _) -et\<rightarrow> n" by blast
      thus ?thesis
      proof
        assume "prog2 \<turnstile> n -et\<rightarrow> (_ l'' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with \<open>prog2 \<turnstile> n -et\<rightarrow> (_ l'' _)\<close> have "l'' = 0" by(auto dest:WCFG_EntryD)
          have "if (b) prog1 else prog2 \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some false)\<^sub>\<surd>\<rightarrow>
                                          (_0_) \<oplus> (#:prog1 + 1)"
            by(rule WCFG_CondFalse)
          with \<open>l'' = 0\<close> \<open>l' = l'' + #:prog1\<close> \<open>l = l' + 1\<close> show ?thesis by simp blast
        next
          case False
          with \<open>prog2 \<turnstile> n -et\<rightarrow> (_ l'' _)\<close>
          have "if (b) prog1 else prog2 \<turnstile> n \<oplus> (#:prog1 + 1) -et\<rightarrow>
                                          (_ l'' _) \<oplus> (#:prog1 + 1)"
            by(fastforce intro:WCFG_CondElse)
          with \<open>l = l' + 1\<close> \<open>l' = l'' + #:prog1\<close> show ?thesis by simp blast
        qed
      next
        assume "prog2 \<turnstile> (_ l'' _) -et\<rightarrow> n"
        hence "if (b) prog1 else prog2 \<turnstile> (_ l'' _) \<oplus> (#:prog1 + 1) -et\<rightarrow>
                                         n \<oplus> (#:prog1 + 1)"
          by(fastforce intro:WCFG_CondElse)
        with \<open>l = l' + 1\<close> \<open>l' = l'' + #:prog1\<close> show ?thesis by simp blast
      qed
    qed
  qed
next
  case (While b prog')
  note IH = \<open>\<And>l. l < #:prog'
             \<Longrightarrow> \<exists>n et. prog' \<turnstile> n -et\<rightarrow> (_ l _) \<or> prog' \<turnstile> (_ l _) -et\<rightarrow> n\<close>
  show ?case
  proof(cases "l < 1")
    case True
    have "while (b) prog' \<turnstile> (_Entry_) -(\<lambda>s. True)\<^sub>\<surd>\<rightarrow> (_0_)" by(rule WCFG_Entry)
    with True show ?thesis by simp blast
  next
    case False
    hence "1 \<le> l" by simp
    thus ?thesis
    proof(cases "l < 2")
      case True
      with \<open>1 \<le> l\<close> have "l = 1" by simp
      have "while (b) prog' \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some false)\<^sub>\<surd>\<rightarrow> (_1_)"
        by(rule WCFG_WhileFalse)
      with \<open>l = 1\<close> show ?thesis by simp blast
    next
      case False
      with \<open>1 \<le> l\<close> have "2 \<le> l" by simp
      then obtain l' where "l = l' + 2" and "l' = l - 2"
        by(simp del:add_2_eq_Suc')
      from \<open>l = l' + 2\<close> \<open>l < #:while (b) prog'\<close> have "l' < #:prog'" by simp
      from IH[OF this] obtain n et
        where "prog' \<turnstile> n -et\<rightarrow> (_ l' _) \<or> prog' \<turnstile> (_ l' _) -et\<rightarrow> n" by blast
      thus ?thesis
      proof
        assume "prog' \<turnstile> n -et\<rightarrow> (_ l' _)"
        show ?thesis
        proof(cases "n = (_Entry_)")
          case True
          with \<open>prog' \<turnstile> n -et\<rightarrow> (_ l' _)\<close> have "l' = 0" by(auto dest:WCFG_EntryD)
          have "while (b) prog' \<turnstile> (_0_) -(\<lambda>s. interpret b s = Some true)\<^sub>\<surd>\<rightarrow>
                                  (_0_) \<oplus> 2"
            by(rule WCFG_WhileTrue)
          with \<open>l' = 0\<close> \<open>l = l' + 2\<close> show ?thesis by simp blast
        next
          case False
          with \<open>prog' \<turnstile> n -et\<rightarrow> (_ l' _)\<close>
          have "while (b) prog' \<turnstile> n \<oplus> 2 -et\<rightarrow> (_ l' _) \<oplus> 2"
            by(fastforce intro:WCFG_WhileBody)
          with \<open>l = l' + 2\<close> show ?thesis by simp blast
        qed
      next
        assume "prog' \<turnstile> (_ l' _) -et\<rightarrow> n"
        show ?thesis
        proof(cases "n = (_Exit_)")
          case True
          with \<open>prog' \<turnstile> (_ l' _) -et\<rightarrow> n\<close>
          have "while (b) prog' \<turnstile> (_ l' _) \<oplus> 2 -et\<rightarrow> (_0_)"
            by(fastforce intro:WCFG_WhileBodyExit)
          with \<open>l = l' + 2\<close> show ?thesis by simp blast
        next
          case False
          with \<open>prog' \<turnstile> (_ l' _) -et\<rightarrow> n\<close>
          have "while (b) prog' \<turnstile> (_ l' _) \<oplus> 2 -et\<rightarrow> n \<oplus> 2"
            by(fastforce intro:WCFG_WhileBody)
          with \<open>l = l' + 2\<close> show ?thesis by simp blast
        qed
      qed
    qed
  qed
qed

(*<*)declare One_nat_def [simp del](*>*)

lemma WCFG_deterministic:
  "\<lbrakk>prog \<turnstile> n\<^sub>1 -et\<^sub>1\<rightarrow> n\<^sub>1'; prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n\<^sub>1 = n\<^sub>2; n\<^sub>1' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et\<^sub>1 = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))"
proof(induct arbitrary:n\<^sub>2 n\<^sub>2' rule:WCFG_induct)
  case (WCFG_Entry_Exit prog)
  from \<open>prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_Entry_) = n\<^sub>2\<close> \<open>(_Exit_) \<noteq> n\<^sub>2'\<close>
  have "et\<^sub>2 = (\<lambda>s. True)\<^sub>\<surd>" by(fastforce dest:WCFG_EntryD)
  thus ?case by simp
next
  case (WCFG_Entry prog)
  from \<open>prog \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_Entry_) = n\<^sub>2\<close> \<open>(_0_) \<noteq> n\<^sub>2'\<close>
  have "et\<^sub>2 = (\<lambda>s. False)\<^sub>\<surd>" by(fastforce dest:WCFG_EntryD)
  thus ?case by simp
next
  case WCFG_Skip
  from \<open>Skip \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_Exit_) \<noteq> n\<^sub>2'\<close>
  have False by(fastforce elim:WCFG.While_CFG.cases)
  thus ?case by simp
next
  case (WCFG_LAss V e)
  from \<open>V:=e \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_1_) \<noteq> n\<^sub>2'\<close>
  have False by -(erule WCFG.While_CFG.cases,auto)
  thus ?case by simp
next
  case (WCFG_LAssSkip V e)
  from \<open>V:=e \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_1_) = n\<^sub>2\<close> \<open>(_Exit_) \<noteq> n\<^sub>2'\<close>
  have False by -(erule WCFG.While_CFG.cases,auto)
  thus ?case by simp
next
  case (WCFG_SeqFirst c\<^sub>1 n et n' c\<^sub>2)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n = n\<^sub>2\<close> \<open>n' \<noteq> n\<^sub>2'\<close>
  have "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2' \<or> (c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> (_Exit_) \<and> n\<^sub>2' = (_0_) \<oplus> #:c\<^sub>1)"
    apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
    by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
  thus ?case
  proof
    assume "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'"
    from IH[OF this \<open>n = n\<^sub>2\<close> \<open>n' \<noteq> n\<^sub>2'\<close>] show ?case .
  next
    assume "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> (_Exit_) \<and> n\<^sub>2' = (_0_) \<oplus> #:c\<^sub>1"
    hence edge:"c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> (_Exit_)" and n2':"n\<^sub>2' = (_0_) \<oplus> #:c\<^sub>1" by simp_all
    from IH[OF edge \<open>n = n\<^sub>2\<close> \<open>n' \<noteq> (_Exit_)\<close>] show ?case .
  qed
next
  case (WCFG_SeqConnect c\<^sub>1 n et c\<^sub>2)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; (_Exit_) \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> (_Exit_)\<close> \<open>n = n\<^sub>2\<close> \<open>n \<noteq> (_Entry_)\<close>
    \<open>(_0_) \<oplus> #:c\<^sub>1 \<noteq> n\<^sub>2'\<close> have "c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2' \<and> (_Exit_) \<noteq> n\<^sub>2'"
    apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
    by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
  from IH[OF this[THEN conjunct1] \<open>n = n\<^sub>2\<close> this[THEN conjunct2]]
  show ?case .
next
  case (WCFG_SeqSecond c\<^sub>2 n et n' c\<^sub>1)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
  \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>c\<^sub>1;;c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<oplus> #:c\<^sub>1 = n\<^sub>2\<close>
    \<open>n' \<oplus> #:c\<^sub>1 \<noteq> n\<^sub>2'\<close> \<open>n \<noteq> (_Entry_)\<close>
  obtain nx where "c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow> nx \<and> nx \<oplus> #:c\<^sub>1 = n\<^sub>2'"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
      apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
     apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  with \<open>n' \<oplus> #:c\<^sub>1 \<noteq> n\<^sub>2'\<close> have edge:"c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow> nx" and neq:"n' \<noteq> nx"
    by auto
  from IH[OF edge _ neq] show ?case by simp
next
  case (WCFG_CondTrue b c\<^sub>1 c\<^sub>2)
  from \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_0_) \<oplus> 1 \<noteq> n\<^sub>2'\<close>
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_CondFalse b c\<^sub>1 c\<^sub>2)
  from \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_0_) \<oplus> #:c\<^sub>1 + 1 \<noteq> n\<^sub>2'\<close>
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_CondThen c\<^sub>1 n et n' b c\<^sub>2)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>1 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c\<^sub>1 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close>
    \<open>n \<oplus> 1 = n\<^sub>2\<close> \<open>n' \<oplus> 1 \<noteq> n\<^sub>2'\<close>
  obtain nx where "c\<^sub>1 \<turnstile> n -et\<^sub>2\<rightarrow> nx \<and> n' \<noteq> nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(drule label_incr_inj) apply auto
    apply(drule label_incr_simp_rev[OF sym])
    by(case_tac na,auto dest:WCFG_sourcelabel_less_num_nodes)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_CondElse c\<^sub>2 n et n' b c\<^sub>1)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>if (b) c\<^sub>1 else c\<^sub>2 \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c\<^sub>2 \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close>
    \<open>n \<oplus> #:c\<^sub>1 + 1 = n\<^sub>2\<close> \<open>n' \<oplus> #:c\<^sub>1 + 1 \<noteq> n\<^sub>2'\<close>
  obtain nx where "c\<^sub>2 \<turnstile> n -et\<^sub>2\<rightarrow> nx \<and> n' \<noteq> nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(drule label_incr_simp_rev)
     apply(case_tac na,auto,cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_WhileTrue b c')
  from \<open>while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_0_) \<oplus> 2 \<noteq> n\<^sub>2'\<close>
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_WhileFalse b c')
  from \<open>while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_0_) = n\<^sub>2\<close> \<open>(_1_) \<noteq> n\<^sub>2'\<close>
  show ?case by -(erule WCFG.While_CFG.cases,auto)
next
  case (WCFG_WhileFalseSkip b c')
  from \<open>while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>(_1_) = n\<^sub>2\<close> \<open>(_Exit_) \<noteq> n\<^sub>2'\<close>
  show ?case by -(erule WCFG.While_CFG.cases,auto dest:label_incr_ge)
next
  case (WCFG_WhileBody c' n et n' b)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; n' \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c' \<turnstile> n -et\<rightarrow> n'\<close> \<open>n \<noteq> (_Entry_)\<close>
    \<open>n' \<noteq> (_Exit_)\<close> \<open>n \<oplus> 2 = n\<^sub>2\<close> \<open>n' \<oplus> 2 \<noteq> n\<^sub>2'\<close>
  obtain nx where "c' \<turnstile> n -et\<^sub>2\<rightarrow> nx \<and> n' \<noteq> nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
      apply(fastforce dest:label_incr_ge[OF sym])
     apply(fastforce dest:label_incr_inj)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (WCFG_WhileBodyExit c' n et b)
  note IH = \<open>\<And>n\<^sub>2 n\<^sub>2'. \<lbrakk>c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'; n = n\<^sub>2; (_Exit_) \<noteq> n\<^sub>2'\<rbrakk>
    \<Longrightarrow> \<exists>Q Q'. et = (Q)\<^sub>\<surd> \<and> et\<^sub>2 = (Q')\<^sub>\<surd> \<and> (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))\<close>
  from \<open>while (b) c' \<turnstile> n\<^sub>2 -et\<^sub>2\<rightarrow> n\<^sub>2'\<close> \<open>c' \<turnstile> n -et\<rightarrow> (_Exit_)\<close> \<open>n \<noteq> (_Entry_)\<close>
    \<open>n \<oplus> 2 = n\<^sub>2\<close> \<open>(_0_) \<noteq> n\<^sub>2'\<close>
  obtain nx where "c' \<turnstile> n -et\<^sub>2\<rightarrow> nx \<and> (_Exit_) \<noteq> nx"
    apply - apply(erule WCFG.While_CFG.cases)
    apply(auto intro:WCFG.While_CFG.intros)
     apply(fastforce dest:label_incr_ge[OF sym])
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
qed

(*<*)declare One_nat_def [simp](*>*)

end


theory Logical_Equivalence
imports
  Validity
begin

section \<open>(Strong) Logical Equivalence\<close>

text \<open>The definition of formulas is parametric in the index type, but from now on we want to work
with a fixed (sufficiently large) index type.\<close>

locale indexed_nominal_ts = nominal_ts satisfies transition
  for satisfies :: "'state::fs \<Rightarrow> 'pred::fs \<Rightarrow> bool" (infix "\<turnstile>" 70)
  and transition :: "'state \<Rightarrow> ('act::bn,'state) residual \<Rightarrow> bool" (infix "\<rightarrow>" 70) +
  assumes card_idx_perm: "|UNIV::perm set| <o |UNIV::'idx set|"
      and card_idx_state: "|UNIV::'state set| <o |UNIV::'idx set|"
begin

  definition logically_equivalent :: "'state \<Rightarrow> 'state \<Rightarrow> bool" where
    "logically_equivalent P Q \<equiv> (\<forall>x::('idx,'pred,'act) formula. P \<Turnstile> x \<longleftrightarrow> Q \<Turnstile> x)"

  notation logically_equivalent (infix "=\<cdot>" 50)

  lemma logically_equivalent_eqvt:
    assumes "P =\<cdot> Q" shows "p \<bullet> P =\<cdot> p \<bullet> Q"
  using assms unfolding logically_equivalent_def
  by (metis (mono_tags) permute_minus_cancel(1) valid_eqvt)

end

end