section {*LR1\_Property\_Satisfaction\_\_entire\_derivation\_tree\_invariant*}
theory
  LR1_Property_Satisfaction__entire_derivation_tree_invariant

imports
  PRJ_12_04_06_06_11__ENTRY

begin

definition EValidSplitExt_no_elim_before_nonterminal :: "
  ('q, 's, 't) ESplit
  \<Rightarrow> bool"
  where
    "EValidSplitExt_no_elim_before_nonterminal S \<equiv>
  \<forall>k < length S.
    (\<exists>A. ESplitItem_elem (S ! k) = Some (teA A))
    \<longrightarrow> (\<forall>i \<le> k. ESplitItem_elim (S ! i) = [])"

definition EValidSplitExt_no_pop_in_prods_before_nonterminal :: "
  ('q, 's, 't) ESplit
  \<Rightarrow> bool"
  where
    "EValidSplitExt_no_pop_in_prods_before_nonterminal S \<equiv>
  \<forall>k < length S.
    (\<exists>A. ESplitItem_elem (S ! k) = Some (teA A))
    \<longrightarrow> (\<forall>i \<le> k. \<forall>j < length (ESplitItem_prods (S ! i)) . prod_rhs (ESplitItem_prods (S ! i) ! j) \<noteq> [])"

definition Eident_line :: "
  ('q, 's, 't) ESplitItem
  \<Rightarrow> bool"
  where
    "Eident_line S \<equiv>
   (ESplitItem_prods S = []
  \<and> ESplitItem_elim S = [])"

definition Eident_lines :: "
  ('q, 's, 't) ESplit
  \<Rightarrow> nat set"
  where
    "Eident_lines S \<equiv>
  {n. n < length S
  \<and> Eident_line (S ! n) }"

definition EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal :: "
  ('q, 's, 't) ESplit
  \<Rightarrow> bool"
  where
    "EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal S \<equiv>
   (\<forall>k < length S. (\<exists>A. ESplitItem_elem (S ! k) = Some (teA A)) \<longrightarrow> (\<forall>i < k. i \<notin> Eident_lines S))"

definition EValidSplitExt :: "
  ('q, 's, 't) ESplit
  \<Rightarrow> bool"
  where
    "EValidSplitExt S \<equiv>
   (EValidSplitExt_no_elim_before_nonterminal S
  \<and> EValidSplitExt_no_pop_in_prods_before_nonterminal S
  \<and> EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal S)"

lemma entirely_ignored_can_not_happend_to_early: "
  F2LR1inputx G G'
  \<Longrightarrow> split_TSstructure G
  \<Longrightarrow> EValidSplit G (S@SX#SY#SZ#S')
  \<Longrightarrow> EValidSplitExt (S@SX#SY#SZ#S')
  \<Longrightarrow> ESplitItem_elim SY = []
  \<Longrightarrow> ESplitItem_prods SY = []
  \<Longrightarrow> ESplitItem_to SX = X#to
  \<Longrightarrow> ESplitItem_ignore SX = ig
  \<Longrightarrow> ESplitItem_ignore SZ = c @ to @ ig
  \<Longrightarrow> Q"
  apply(simp add: EValidSplit_def)
  apply(clarsimp)
  apply(simp add: EValidSplit_interline_def)
  apply(erule_tac x="length S" in allE')
  apply(erule_tac
      x="Suc(length S)"
      in allE)
  apply(clarsimp)
  apply(subgoal_tac "(S @ SX # SY # SZ # S') ! (length S) = SX")
   prefer 2
   apply(force)
  apply(subgoal_tac "(S @ SX # SY # SZ # S') ! Suc (length S) = SY")
   prefer 2
   apply (metis drop_append2 drop_nth_hlp1)
  apply(subgoal_tac "(S @ SX # SY # SZ # S') ! Suc (Suc(length S)) = SSX" for SSX)
   prefer 2
   apply(rule nth_append_2)
   apply(force)
  apply(clarsimp)
  apply(simp add: EValidSplit_interlineX_def)
  apply(case_tac "ESplitItem_from SY")
   apply(simp add: EValidSplit_producing_def)
   apply(erule_tac
      x="SY"
      in ballE_prime)
    apply(clarsimp)
   apply(simp add: option_to_list_def)
   apply(subgoal_tac "SY \<in> set (butlast (S @ SX # SY # SZ # S'))")
    apply(force)
   apply(thin_tac "SY \<notin> set (butlast (S @ SX # SY # SZ # S'))")
   apply(rule_tac
      xs="S'"
      in rev_cases)
    apply(clarsimp)
    apply(rule_tac
      t="butlast (S @ [SX, SY, SZ])"
      in ssubst)
     apply(rule butlast_direct)
     apply(force)
    apply(force)
   apply(rename_tac ys y)(*strict*)
   apply(clarsimp)
   apply(rule_tac
      t="butlast (S @ SX # SY # SZ # ys @ [y])"
      in ssubst)
    apply(rename_tac ys y)(*strict*)
    apply(rule butlast_direct)
    apply(force)
   apply(rename_tac ys y)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(case_tac "ESplitItem_from SX")
   apply(rename_tac a)(*strict*)
   apply(simp add: EValidSplit_producing_def)
   apply(erule_tac
      x="SX"
      in ballE_prime)
    apply(rename_tac a)(*strict*)
    apply(clarsimp)
   apply(rename_tac a)(*strict*)
   apply(subgoal_tac "SX \<in> set (butlast (S @ SX # SY # SZ # S'))")
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(rule_tac
      xs="S'"
      in rev_cases)
    apply(rename_tac a)(*strict*)
    apply(clarsimp)
    apply(subgoal_tac "butlast (S @ [SX, SY, SZ]) = SSX" for SSX)
     apply(rename_tac a)(*strict*)
     prefer 2
     apply(rule butlast_direct)
     apply(force)
    apply(rename_tac a)(*strict*)
    apply(clarsimp)
   apply(rename_tac a ys y)(*strict*)
   apply(clarsimp)
   apply(subgoal_tac "butlast (S @ SX # SY # SZ # ys @ [y]) = SSX" for SSX)
    apply(rename_tac a ys y)(*strict*)
    prefer 2
    apply(rule butlast_direct)
    apply(force)
   apply(rename_tac a ys y)(*strict*)
   apply(clarsimp)
  apply(rename_tac a aa)(*strict*)
  apply(clarsimp)
  apply(simp add: option_to_list_def)
  apply(case_tac "ESplitItem_to SX")
   apply(rename_tac a aa)(*strict*)
   apply(clarsimp)
  apply(rename_tac a aa ab list)(*strict*)
  apply(clarsimp)
  apply(rename_tac aa)(*strict*)
  apply(subgoal_tac "ESplitItem_to SY = []")
   apply(rename_tac aa)(*strict*)
   prefer 2
   apply(simp add: EValidSplit_ValidItem_def)
   apply(clarsimp)
   apply(simp add: EValidSplitItem_def EValidSplitItem_gen_def)
   apply(clarsimp)
   apply(rename_tac aa d da db)(*strict*)
   apply(simp add: cfgLM.trans_der_def option_to_list_def)
   apply(clarsimp)
   apply(rename_tac aa d da db e eb)(*strict*)
   apply(simp add: EValidSplit_producing_def)
   apply(erule_tac
      x="SY"
      and A="set (butlast (S @ SX # SY # SZ # S'))"
      in ballE)
    apply(rename_tac aa d da db e eb)(*strict*)
    apply(clarsimp)
    apply(case_tac "ESplitItem_to SY")
     apply(rename_tac aa d da db e eb)(*strict*)
     apply(force)
    apply(rename_tac aa d da db e eb a list)(*strict*)
    apply(force)
   apply(rename_tac aa d da db e eb)(*strict*)
   apply(subgoal_tac "SY \<in> set (butlast (S @ SX # SY # SZ # S'))")
    apply(rename_tac aa d da db e eb)(*strict*)
    apply(force)
   apply(rename_tac aa d da db e eb)(*strict*)
   apply(rule_tac
      xs="S'"
      in rev_cases)
    apply(rename_tac aa d da db e eb)(*strict*)
    apply(clarsimp)
    apply(subgoal_tac "butlast (S @ [SX, SY, SZ]) = SSX" for SSX)
     apply(rename_tac aa d da db e eb)(*strict*)
     prefer 2
     apply(rule butlast_direct)
     apply(force)
    apply(rename_tac aa d da db e eb)(*strict*)
    apply(clarsimp)
   apply(rename_tac aa d da db e eb ys y)(*strict*)
   apply(clarsimp)
   apply(rename_tac aa d da db e eb ys y dc ea)(*strict*)
   apply(subgoal_tac "butlast ((S @ SX # SY # SZ # ys) @ [y]) = SSX" for SSX)
    apply(rename_tac aa d da db e eb ys y dc ea)(*strict*)
    prefer 2
    apply(rule_tac
      w="S @ SX # SY # SZ # ys"
      in butlast_direct)
    apply(force)
   apply(rename_tac aa d da db e eb ys y dc ea)(*strict*)
   apply(clarsimp)
  apply(rename_tac aa)(*strict*)
  apply(clarsimp)
  apply(case_tac "ESplitItem_from SZ")
   apply(rename_tac aa)(*strict*)
   prefer 2
   apply(rename_tac aa a)(*strict*)
   apply(clarsimp)
  apply(rename_tac aa)(*strict*)
  apply(clarsimp)
  apply(simp add: EValidSplit_produce_or_elim_def)
  done

lemma restrict_equal_before_step_nonterminal: "
       F2LR1inputx G' G
  \<Longrightarrow> split_TSstructure G'
  \<Longrightarrow> Esplit_signature S2 = w @ teB b # liftB \<alpha>1 @ teA A2 # liftB \<alpha>2
  \<Longrightarrow> EValidSplit G' S2
  \<Longrightarrow> EValidSplit G' (S2a @ S2b)
  \<Longrightarrow> Esplit_step_relation G' S2 \<lparr>prod_lhs = A2, prod_rhs = []\<rparr> (S2a @ S2b)
  \<Longrightarrow> Esplit_signature S2a = w @ [teB b]
  \<Longrightarrow> length S2a = Suc (length w)
  \<Longrightarrow> Esplit_signature S2b = liftB \<alpha>1 @ liftB \<alpha>2
  \<Longrightarrow> EValidSplitExt S2
  \<Longrightarrow> EValidSplitExt (S2a @ S2b)
  \<Longrightarrow> restrict G G' S2 (Suc(length w)) = restrict G G' (S2a @ S2b) (Suc (length w))"
  apply(simp (no_asm) add: restrict_def restrict_map_def restrict_len_def)
  apply(clarsimp)
  apply(rule_tac
      t="min (length S2) (Suc (length w))"
      and s="Suc (length w)"
      in ssubst)
   apply(subgoal_tac "X" for X)
    prefer 2
    apply(rule_tac
      S="S2"
      and S'="[]"
      in EValidSplit_Esplit_signature_length)
    apply(force)
   apply(clarsimp)
   apply(force)
  apply(clarsimp)
  apply(rename_tac x)(*strict*)
  apply(subgoal_tac "0\<le> x \<and> x \<le> SSX" for SSX)
   apply(rename_tac x)(*strict*)
   prefer 2
   apply(rule nat_seq_in_interval)
   apply(force)
  apply(rename_tac x)(*strict*)
  apply(clarsimp)
  apply(simp add: Esplit_step_relation_def)
  apply(clarsimp)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(simp add: Xstep_gen_def)
  apply (simp add: Esplit_signature_append)
  apply(subgoal_tac "X" for X)
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply(rule_tac
      S="S1"
      and S'="SL#S2"
      in EValidSplit_Esplit_signature_length)
   apply(force)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply (rule_tac
      w="SL"
      and v="S2"
      in Esplit_signature_Cons)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(subgoal_tac "Esplit_signature S1 @ Esplit_signature [SL] @ Esplit_signature S2 = w @ teB b # liftB \<alpha>1 @ teA A2 # liftB \<alpha>2")
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(thin_tac "Esplit_signature S1 @ Esplit_signature (SL # S2) = w @ teB b # liftB \<alpha>1 @ teA A2 # liftB \<alpha>2")
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(thin_tac "Esplit_signature (SL # S2) = Esplit_signature [SL] @ Esplit_signature S2")
  apply(subgoal_tac "Esplit_signature [SL] = [teA A2]")
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply(simp add: Esplit_signature_def option_to_list_def)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "Esplit_signature S2 = liftB \<alpha>2")
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply(rule_tac
      ?w1.0="Esplit_signature S1"
      and A="A2"
      in equal_terminal_suffix)
     apply(rename_tac x S1 SL S2)(*strict*)
     apply(force)
    apply(rename_tac x S1 SL S2)(*strict*)
    apply(force)
   apply(rename_tac x S1 SL S2)(*strict*)
   apply(rule setA_liftB)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "strict_prefix S1 S2a \<or> SSX" for SSX)
   apply(rename_tac x S1 SL S2)(*strict*)
   prefer 2
   apply(rule mutual_strict_prefix_prefix)
   apply(rule sym)
   apply(force)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(erule disjE)
   apply(rename_tac x S1 SL S2)(*strict*)
   apply(simp add: strict_prefix_def)
   apply(clarsimp)
  apply(rename_tac x S1 SL S2)(*strict*)
  apply(simp add: prefix_def)
  apply(clarsimp)
  apply(rename_tac x SL S2 c)(*strict*)
  apply (simp add: Esplit_signature_append)
  apply(subgoal_tac "(S2a @ c @ SL # S2) ! x = SSX" for SSX)
   apply(rename_tac x SL S2 c)(*strict*)
   prefer 2
   apply(rule nth_append_1)
   apply(force)
  apply(rename_tac x SL S2 c)(*strict*)
  apply(clarsimp)
  done

theorem Esplit_derivation_enforces_EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal: "
  Esplit_TSstructure G
  \<Longrightarrow> F2LR1inputx G G'
  \<Longrightarrow> split_TSstructure G
  \<Longrightarrow> Esplit.derivation_initial G d
  \<Longrightarrow> d n = Some (pair e S)
  \<Longrightarrow> k<length S
  \<Longrightarrow> ESplitItem_elem (S!k) = Some (teA A)
  \<Longrightarrow> i<k
  \<Longrightarrow> i \<notin> (Eident_lines S)"
  apply(induct n arbitrary: e S k A i)
   apply(rename_tac e S k A i)(*strict*)
   apply(simp add: Esplit.derivation_initial_def)
   apply(clarsimp)
   apply(rename_tac S k A i)(*strict*)
   apply(simp add: Esplit_initial_configurations_def)
  apply(rename_tac n e S k A i)(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   apply(rename_tac n e S k A i)(*strict*)
   prefer 2
   apply(rule_tac
      G="G"
      and d="d"
      and n="n"
      and m="Suc n"
      in Esplit.step_detail_before_some_position)
     apply(rename_tac n e S k A i)(*strict*)
     apply(rule Esplit.derivation_initial_is_derivation)
     apply(force)
    apply(rename_tac n e S k A i)(*strict*)
    apply(force)
   apply(rename_tac n e S k A i)(*strict*)
   apply(force)
  apply(rename_tac n e S k A i)(*strict*)
  apply(clarsimp)
  apply(rename_tac n S k A i e1 e2 c1)(*strict*)
  apply(simp add: Esplit_step_relation_def)
  apply(clarsimp)
  apply(rename_tac n k A i e1 e2 S1 SL S2)(*strict*)
  apply(erule_tac
      x="e1"
      in meta_allE)
  apply(clarsimp)
  apply(erule_tac
      x="S1 @ SL # S2"
      in meta_allE)
  apply(clarsimp)
  apply(erule_tac
      x="length S1"
      in meta_allE)
  apply(clarsimp)
  apply(case_tac e2)
  apply(rename_tac n k A i e1 e2 S1 SL S2 prod_lhsa prod_rhsa)(*strict*)
  apply(rename_tac A w)
  apply(rename_tac n k Aa i e1 e2 S1 SL S2 A w)(*strict*)
  apply(erule_tac
      x="A"
      in meta_allE)
  apply(clarsimp)
  apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
  apply(thin_tac "Esplit.derivation_initial G d")
  apply(thin_tac "d (Suc n) = Some (pair (Some \<lparr>prod_lhs = A, prod_rhs = w\<rparr>) (S1 @ Xstep_mergeL (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL)) (nth_opt S2 0) @ drop (Suc 0) S2))")
  apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
  apply(thin_tac "d n = Some (pair e1 (S1 @ SL # S2))")
  apply(case_tac "i<length S1")
   apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
   apply(erule_tac
      x="i"
      in meta_allE)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   apply(simp add: Eident_lines_def Eident_line_def)
   apply(clarsimp)
   apply(subgoal_tac "(S1 @ SL # S2) ! i = (S1 @ Xstep_mergeL (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL)) (nth_opt S2 0) @ drop (Suc 0) S2) ! i")
    apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
    apply(clarsimp)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   apply(rule nth_eq_ignore_append)
     apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
     prefer 3
     apply(force)
    apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   apply(force)
  apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
  apply(subgoal_tac "length S1\<le>i")
   apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac n k Aa i e1 S1 SL S2 A w)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
  apply(subgoal_tac "length(Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL)) = SSX" for SSX)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   prefer 2
   apply(rule Xstep_gen_length)
    apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
    apply(simp add: split_TSstructure_def)
    apply(force)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
  apply(case_tac S2)
   apply(rename_tac k Aa i S1 SL S2 A w)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A w)(*strict*)
   apply(simp add: nth_opt_def)
   apply(simp add: Xstep_mergeL_def)
   apply(case_tac "Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL)")
    apply(rename_tac k Aa i S1 SL A w)(*strict*)
    apply(subgoal_tac "k < length S1 + (length (if True then [] else Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # butlast (Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) + length (case ESplitItem_elem (if True then Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> else last (Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) of None \<Rightarrow> [Xstep_merge1 (last (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) EmptyESplitItem] | Some e \<Rightarrow> [last (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))]))")
     apply(rename_tac k Aa i S1 SL A w)(*strict*)
     prefer 2
     apply(rule_tac
      t="True"
      and s="Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL) = []"
      in ssubst)
      apply(rename_tac k Aa i S1 SL A w)(*strict*)
      apply(force)
     apply(rename_tac k Aa i S1 SL A w)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A w)(*strict*)
    apply(thin_tac "k < length S1 + (length (if Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL) = [] then [] else Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # butlast (Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) + length (case ESplitItem_elem (if Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL) = [] then Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> else last (Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) of None \<Rightarrow> [Xstep_merge1 (last (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))) EmptyESplitItem] | Some e \<Rightarrow> [last (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr> # Xstep_gen (filterA (tl w)) (ESplitItem_to SL @ ESplitItem_ignore SL))]))")
    apply(rename_tac k Aa i S1 SL A w)(*strict*)
    apply(clarsimp)
    apply(case_tac "ESplitItem_elem (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = w\<rparr>)")
     apply(rename_tac k Aa i S1 SL A w)(*strict*)
     apply(clarsimp)
    apply(rename_tac k Aa i S1 SL A w a)(*strict*)
    apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A w a list)(*strict*)
   apply(case_tac w)
    apply(rename_tac k Aa i S1 SL A w a list)(*strict*)
    apply(clarsimp)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(subgoal_tac "a#list=[]")
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(rule_tac
      t="a#list"
      and s="Xstep_gen [] (ESplitItem_to SL @ ESplitItem_ignore SL)"
      in ssubst)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(rule_tac
      t="[]"
      and s="Xstep_gen [] (ESplitItem_to SL @ ESplitItem_ignore SL)"
      in subst)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(thin_tac "Xstep_gen [] (ESplitItem_to SL @ ESplitItem_ignore SL) = a # list")
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A w a list aa lista)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list aa lista)(*strict*)
   apply(case_tac lista)
    apply(rename_tac k Aa i S1 SL A a list aa lista)(*strict*)
    apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list aa lista ab listb)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
   apply(subgoal_tac "listb=[]")
    apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
    prefer 2
    apply(rule LR1_at_most_two_symbols)
     apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a aa ab)(*strict*)
   apply(case_tac ab)
    apply(rename_tac k Aa i S1 SL A a aa ab ac)(*strict*)
    prefer 2
    apply(rename_tac k Aa i S1 SL A a aa ab b)(*strict*)
    apply(clarsimp)
    apply(rename_tac k Aa i S1 SL A a aa b)(*strict*)
    apply(simp add: Xstep_gen_def)
   apply(rename_tac k Aa i S1 SL A a aa ab ac)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a aa ac)(*strict*)
   apply(simp add: Xstep_gen_def)
   apply(subgoal_tac "nat_seq 0 0 = [0]")
    apply(rename_tac k Aa i S1 SL A a aa ac)(*strict*)
    prefer 2
    apply (metis natUptTo_n_n)
   apply(rename_tac k Aa i S1 SL A a aa ac)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A aa ac)(*strict*)
   apply(simp add: Xstep_elem_def)
   apply(simp add: Xstep_gen_def)
   apply(simp add: nth_opt_def)
   apply(case_tac "Suc k = Suc (Suc (length S1))")
    apply(rename_tac k Aa i S1 SL A aa ac)(*strict*)
    apply(clarsimp)
    apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
    apply(subgoal_tac "(S1 @ [SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa, teA ac]\<rparr>], ESplitItem_elem := Some aa, ESplitItem_to := ac # ESplitItem_to SL\<rparr>, \<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr>]) ! Suc (length S1) = [\<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr>]!SSX" for SSX)
     apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
     prefer 2
     apply(rule nth_append_2_prime)
       apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
       apply(force)
      apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
      apply(force)
     apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
     apply(force)
    apply(rename_tac Aa i S1 SL A aa ac)(*strict*)
    apply(clarsimp)
    apply(rename_tac Aa i S1 SL A aa)(*strict*)
    apply(case_tac "i=length S1")
     apply(rename_tac Aa i S1 SL A aa)(*strict*)
     apply(clarsimp)
     apply(rename_tac Aa S1 SL A aa)(*strict*)
     apply(simp add: Eident_lines_def Eident_line_def)
    apply(rename_tac Aa i S1 SL A aa)(*strict*)
    apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A aa ac)(*strict*)
   apply(clarsimp)
  apply(rename_tac k Aa i S1 SL S2 A w a list)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A w a list)(*strict*)
  apply(simp add: nth_opt_def)
  apply(case_tac w)
   apply(rename_tac k Aa i S1 SL A w a list)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list)(*strict*)
   apply(simp add: Xstep_mergeL_def)
   apply(simp add: Xstep_gen_def)
   apply(simp add: Xstep_elem_def)
   apply(simp add: nth_opt_def)
   apply(simp add: Xstep_merge1_def)
   apply(case_tac "strict_prefix (ESplitItem_elim a) (ESplitItem_to (Xstep_elem SL \<lparr>prod_lhs = A, prod_rhs = []\<rparr>))")
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(clarsimp)
    apply(simp add: Xstep_merge1_toWasNotEliminated_def Xstep_elem_def)
    apply(case_tac "length S1=k")
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(clarsimp)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(subgoal_tac "length S1 < k")
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(clarsimp)
    apply(subgoal_tac "(S1 @ \<lparr>ESplitItem_elim = ESplitItem_elim SL, ESplitItem_from = ESplitItem_from SL, ESplitItem_ignore = ESplitItem_ignore SL, ESplitItem_elim_prods = ESplitItem_elim_prods SL, ESplitItem_prods = ESplitItem_prods SL @ \<lparr>prod_lhs = A, prod_rhs = []\<rparr> # foldl (@) [] (ESplitItem_elim_prods a) @ ESplitItem_prods a, ESplitItem_elem = ESplitItem_elem a, ESplitItem_to = ESplitItem_to a @ drop (length (ESplitItem_elim a) + length (option_to_list (ESplitItem_from a))) (ESplitItem_to SL)\<rparr> # list) ! k = SSlistX" for SSlistX)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     prefer 2
     apply(rule nth_append_2_prime)
       apply(rename_tac k Aa i S1 SL A a list)(*strict*)
       apply(force)
      apply(rename_tac k Aa i S1 SL A a list)(*strict*)
      apply(force)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(clarsimp)
    apply(thin_tac "(S1 @ \<lparr>ESplitItem_elim = ESplitItem_elim SL, ESplitItem_from = ESplitItem_from SL, ESplitItem_ignore = ESplitItem_ignore SL, ESplitItem_elim_prods = ESplitItem_elim_prods SL, ESplitItem_prods = ESplitItem_prods SL @ \<lparr>prod_lhs = A, prod_rhs = []\<rparr> # foldl (@) [] (ESplitItem_elim_prods a) @ ESplitItem_prods a, ESplitItem_elem = ESplitItem_elem a, ESplitItem_to = ESplitItem_to a @ drop (length (ESplitItem_elim a) + length (option_to_list (ESplitItem_from a))) (ESplitItem_to SL)\<rparr> # list) ! k = list ! (k - Suc (length S1))")
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(rule Esplit_signature_Cons_not_empty_setA2)
      apply(rename_tac k Aa i S1 SL A a list)(*strict*)
      apply(force)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list)(*strict*)
   apply(clarsimp)
   apply(simp add: Xstep_merge1_toWasEliminated_def Xstep_elem_def)
   apply(subgoal_tac "(S1 @ \<lparr>ESplitItem_elim = ESplitItem_elim SL @ option_to_list (ESplitItem_from SL) @ drop (length (ESplitItem_to SL)) (ESplitItem_elim a), ESplitItem_from = ESplitItem_from a, ESplitItem_ignore = ESplitItem_ignore a, ESplitItem_elim_prods = ESplitItem_elim_prods SL @ (ESplitItem_prods SL @ \<lparr>prod_lhs = A, prod_rhs = []\<rparr> # foldl (@) [] (take (length (ESplitItem_to SL)) (ESplitItem_elim_prods a))) # drop (length (ESplitItem_to SL)) (ESplitItem_elim_prods a), ESplitItem_prods = ESplitItem_prods a, ESplitItem_elem = ESplitItem_elem a, ESplitItem_to = ESplitItem_to a\<rparr> # list) ! k = SSlistX" for SSlistX)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    prefer 2
    apply(rule nth_append_2_prime)
      apply(rename_tac k Aa i S1 SL A a list)(*strict*)
      apply(force)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list)(*strict*)
   apply(clarsimp)
   apply(thin_tac "(S1 @ \<lparr>ESplitItem_elim = ESplitItem_elim SL @ option_to_list (ESplitItem_from SL) @ drop (length (ESplitItem_to SL)) (ESplitItem_elim a), ESplitItem_from = ESplitItem_from a, ESplitItem_ignore = ESplitItem_ignore a, ESplitItem_elim_prods = ESplitItem_elim_prods SL @ (ESplitItem_prods SL @ \<lparr>prod_lhs = A, prod_rhs = []\<rparr> # foldl (@) [] (take (length (ESplitItem_to SL)) (ESplitItem_elim_prods a))) # drop (length (ESplitItem_to SL)) (ESplitItem_elim_prods a), ESplitItem_prods = ESplitItem_prods a, ESplitItem_elem = ESplitItem_elem a, ESplitItem_to = ESplitItem_to a\<rparr> # list) ! k = list ! (k - Suc (length S1))")
   apply(rename_tac k Aa i S1 SL A a list)(*strict*)
   apply(rule Esplit_signature_Cons_not_empty_setA2)
     apply(rename_tac k Aa i S1 SL A a list)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL A w a list aa lista)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa lista)(*strict*)
  apply(case_tac lista)
   apply(rename_tac k Aa i S1 SL A a list aa lista)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
   apply(simp add: Xstep_mergeL_def)
   apply(simp add: Xstep_gen_def)
   apply(simp add: Xstep_elem_def)
   apply(simp add: nth_opt_def)
   apply(simp add: Xstep_elem_def)
   apply(subgoal_tac "(S1 @ SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa]\<rparr>], ESplitItem_elem := nth_opt [aa] 0\<rparr> # a # list) ! k = (a#list)!SSX" for SSX)
    apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
    prefer 2
    apply(rule nth_append_2_prime)
      apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
      apply(force)
     apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
   apply(clarsimp)
   apply(thin_tac "(S1 @ SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa]\<rparr>], ESplitItem_elem := nth_opt [aa] 0\<rparr> # a # list) ! k = (a # list) ! (k - Suc (length S1))")
   apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
   apply(case_tac "k-Suc(length S1)")
    apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
    apply(clarsimp)
    apply(rule Esplit_signature_Cons_not_empty_setA)
     apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list aa)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa nat)(*strict*)
   apply(clarsimp)
   apply(rule Esplit_signature_Cons_not_empty_setA2)
     apply(rename_tac k Aa i S1 SL A a list aa nat)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list aa nat)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa nat)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL A a list aa lista ab listb)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
  apply(subgoal_tac "listb=[]")
   apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
   prefer 2
   apply(rule LR1_at_most_two_symbols)
    apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL A a list aa ab listb)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa ab)(*strict*)
  apply(case_tac ab)
   apply(rename_tac k Aa i S1 SL A a list aa ab ac)(*strict*)
   prefer 2
   apply(rename_tac k Aa i S1 SL A a list aa ab b)(*strict*)
   apply(clarsimp)
   apply(rename_tac k Aa i S1 SL A a list aa b)(*strict*)
   apply(rule LR1_terminal_only_at_front_in_prods)
    apply(rename_tac k Aa i S1 SL A a list aa b)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa b)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL A a list aa ab ac)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
  apply(simp add: Xstep_mergeL_def)
  apply(simp add: Xstep_gen_def)
  apply(subgoal_tac "nat_seq 0 0 = [0]")
   apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
   prefer 2
   apply (metis natUptTo_n_n)
  apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
  apply(clarsimp)
  apply(simp add: Xstep_gen_def)
  apply(simp add: Xstep_elem_def)
  apply(simp add: nth_opt_def)
  apply(subgoal_tac "(S1 @ SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa, teA ac]\<rparr>], ESplitItem_elem := Some aa, ESplitItem_to := ac # ESplitItem_to SL\<rparr> # \<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr> # a # list) ! k = (SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa, teA ac]\<rparr>], ESplitItem_elem := Some aa, ESplitItem_to := ac # ESplitItem_to SL\<rparr> # \<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr> # a # list)!SSX" for SSX)
   apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
   prefer 2
   apply(rule nth_append_2_prime)
     apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
     apply(force)
    apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
    apply(force)
   apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
   apply(force)
  apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
  apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
  apply(case_tac "k-length S1")
   apply(rename_tac k Aa i S1 SL A a list aa ac)(*strict*)
   apply(clarsimp)
  apply(rename_tac k Aa i S1 SL A a list aa ac nat)(*strict*)
  apply(subgoal_tac "k=Suc nat+length S1")
   apply(rename_tac k Aa i S1 SL A a list aa ac nat)(*strict*)
   prefer 2
   apply(force)
  apply(rename_tac k Aa i S1 SL A a list aa ac nat)(*strict*)
  apply(clarsimp)
  apply(rename_tac Aa i S1 SL A a list aa ac nat)(*strict*)
  apply(case_tac nat)
   apply(rename_tac Aa i S1 SL A a list aa ac nat)(*strict*)
   apply(clarsimp)
   apply(rename_tac Aa i S1 SL A a list aa)(*strict*)
   apply(subgoal_tac "i=length S1")
    apply(rename_tac Aa i S1 SL A a list aa)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa)(*strict*)
   apply(clarsimp)
   apply(rename_tac Aa S1 SL A a list aa)(*strict*)
   apply(simp add: Eident_lines_def Eident_line_def)
  apply(rename_tac Aa i S1 SL A a list aa ac nat nata)(*strict*)
  apply(clarsimp)
  apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
  apply(case_tac "i=Suc(length S1)")
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
   apply(simp add: Eident_lines_def Eident_line_def)
   apply(clarsimp)
   apply(subgoal_tac "(S1 @ SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa, teA ac]\<rparr>], ESplitItem_elem := Some aa, ESplitItem_to := ac # ESplitItem_to SL\<rparr> # \<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr> # a # list) ! Suc (length S1) = (\<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr> # a # list)!SSY" for SSY)
    apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
    prefer 2
    apply(rule nth_append_2_prime)
      apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
      apply(force)
     apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
     apply(force)
    apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
    apply(force)
   apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(case_tac nata)
    apply(rename_tac Aa S1 SL A a list aa ac nata)(*strict*)
    apply(clarsimp)
    apply(rename_tac Aa S1 SL A a list aa ac)(*strict*)
    apply(rule Esplit_signature_Cons_not_empty_setA)
     apply(rename_tac Aa S1 SL A a list aa ac)(*strict*)
     apply(force)
    apply(rename_tac Aa S1 SL A a list aa ac)(*strict*)
    apply(force)
   apply(rename_tac Aa S1 SL A a list aa ac nata nat)(*strict*)
   apply(clarsimp)
   apply(rename_tac Aa S1 SL A a list aa ac nat)(*strict*)
   apply(rule Esplit_signature_Cons_not_empty_setA2)
     apply(rename_tac Aa S1 SL A a list aa ac nat)(*strict*)
     apply(force)
    apply(rename_tac Aa S1 SL A a list aa ac nat)(*strict*)
    apply(force)
   apply(rename_tac Aa S1 SL A a list aa ac nat)(*strict*)
   apply(force)
  apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
  apply(simp add: Eident_lines_def Eident_line_def)
  apply(subgoal_tac "(S1 @ SL\<lparr>ESplitItem_prods := ESplitItem_prods SL @ [\<lparr>prod_lhs = A, prod_rhs = [aa, teA ac]\<rparr>], ESplitItem_elem := Some aa, ESplitItem_to := ac # ESplitItem_to SL\<rparr> # \<lparr>ESplitItem_elim = [], ESplitItem_from = Some ac, ESplitItem_ignore = ESplitItem_to SL @ ESplitItem_ignore SL, ESplitItem_elim_prods = [], ESplitItem_prods = [], ESplitItem_elem = Some (teA ac), ESplitItem_to = []\<rparr> # a # list) ! i = (a#list)!SSX" for SSX)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   prefer 2
   apply(rule nth_append_2_prime)
     apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
     apply(force)
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(case_tac "i<Suc (Suc (length S1))")
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(case_tac "Suc i=Suc (Suc (length S1))")
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    apply(clarsimp)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(subgoal_tac "i < (Suc (length S1))")
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(case_tac "Suc i = Suc(length S1)")
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(subgoal_tac "Suc i<Suc (length S1)")
    apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(force)
  apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
  apply(clarsimp)
  apply(case_tac nata)
   apply(rename_tac Aa i S1 SL A a list aa ac nata)(*strict*)
   apply(clarsimp)
   apply(rename_tac Aa i S1 SL A a list aa ac)(*strict*)
   apply(rule Esplit_signature_Cons_not_empty_setA)
    apply(rename_tac Aa i S1 SL A a list aa ac)(*strict*)
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac)(*strict*)
   apply(force)
  apply(rename_tac Aa i S1 SL A a list aa ac nata nat)(*strict*)
  apply(rule Esplit_signature_Cons_not_empty_setA2)
    apply(rename_tac Aa i S1 SL A a list aa ac nata nat)(*strict*)
    apply(force)
   apply(rename_tac Aa i S1 SL A a list aa ac nata nat)(*strict*)
   apply(force)
  apply(rename_tac Aa i S1 SL A a list aa ac nata nat)(*strict*)
  apply(force)
  done

theorem Esplit_derivation_enforces_EValidSplitExt: "
  Esplit_TSstructure G
  \<Longrightarrow> F2LR1inputx G G'
  \<Longrightarrow> split_TSstructure G
  \<Longrightarrow> Esplit.derivation_initial G d
  \<Longrightarrow> d n = Some (pair e S)
  \<Longrightarrow> EValidSplitExt S"
  apply(simp add: EValidSplitExt_def)
  apply(rule conjI)
   apply(simp add: EValidSplitExt_no_elim_before_nonterminal_def)
   apply(clarsimp)
   apply(rename_tac k A i)(*strict*)
   apply(rule Esplit_derivation_enforces_EValidSplitExt_no_elim_before_nonterminal)
          apply(rename_tac k A i)(*strict*)
          apply(force)
         apply(rename_tac k A i)(*strict*)
         apply(force)
        apply(rename_tac k A i)(*strict*)
        apply(force)
       apply(rename_tac k A i)(*strict*)
       apply(force)
      apply(rename_tac k A i)(*strict*)
      apply(force)
     apply(rename_tac k A i)(*strict*)
     apply(force)
    apply(rename_tac k A i)(*strict*)
    apply(force)
   apply(rename_tac k A i)(*strict*)
   apply(force)
  apply(rule conjI)
   apply(simp add: EValidSplitExt_no_pop_in_prods_before_nonterminal_def)
   apply(clarsimp)
   apply(rename_tac k A i j)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac k A i j)(*strict*)
    prefer 2
    apply(rule Esplit_derivation_enforces_EValidSplitExt_no_pop_in_prods_before_nonterminal)
            apply(rename_tac k A i j)(*strict*)
            apply(force)
           apply(rename_tac k A i j)(*strict*)
           apply(force)
          apply(rename_tac k A i j)(*strict*)
          apply(force)
         apply(rename_tac k A i j)(*strict*)
         apply(force)
        apply(rename_tac k A i j)(*strict*)
        apply(force)
       apply(rename_tac k A i j)(*strict*)
       apply(force)
      apply(rename_tac k A i j)(*strict*)
      apply(force)
     apply(rename_tac k A i j)(*strict*)
     apply(force)
    apply(rename_tac k A i j)(*strict*)
    apply(force)
   apply(rename_tac k A i j)(*strict*)
   apply(force)
  apply(simp add: EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal_def)
  apply(rule allI)
  apply(rename_tac k)(*strict*)
  apply(rule impI)
  apply(rule impI)
  apply(rule allI)
  apply(rename_tac k i)(*strict*)
  apply(rule impI)
  apply(erule exE)+
  apply(rename_tac k i A)(*strict*)
  apply(rule Esplit_derivation_enforces_EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal)
         apply(rename_tac k i A)(*strict*)
         apply(force)
        apply(rename_tac k i A)(*strict*)
        apply(force)
       apply(rename_tac k i A)(*strict*)
       apply(force)
      apply(rename_tac k i A)(*strict*)
      apply(force)
     apply(rename_tac k i A)(*strict*)
     apply(force)
    apply(rename_tac k i A)(*strict*)
    apply(force)
   apply(rename_tac k i A)(*strict*)
   apply(force)
  apply(rename_tac k i A)(*strict*)
  apply(force)
  done

hide_fact Esplit_derivation_enforces_EValidSplitExt_ident_line_is_always_at_the_latest_nonterminal
  (* important entirely_ignored_can_not_happend_to_early *)
  (* important Esplit_derivation_enforces_EValidSplitExt *)
  (* important restrict_equal_before_step_nonterminal *)

end


(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Late_Bisim_Subst_SC
  imports Weak_Late_Bisim_Subst Strong_Late_Bisim_Subst_SC
begin

(******** Structural Congruence **********)

(******** The \<nu>-operator *****************)

lemma resComm:
  fixes P :: pi

  shows "<\<nu>a><\<nu>b>P \<approx>\<^sup>s <\<nu>b><\<nu>a>P"
proof -
  have "<\<nu>a><\<nu>b>P \<sim>\<^sup>s <\<nu>b><\<nu>a>P"
    by(rule Strong_Late_Bisim_Subst_SC.resComm)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[a\<frown>a]P \<approx>\<^sup>s P"
proof -
  have "[a\<frown>a]P \<sim>\<^sup>s P" by(rule Strong_Late_Bisim_Subst_SC.matchId)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** Mismatch *********)

  shows "[a\<noteq>a]P \<approx>\<^sup>s \<zero>"
proof -
  have "[a\<noteq>a]P \<sim>\<^sup>s \<zero>" by(rule Strong_Late_Bisim_Subst_SC.mismatchNil)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<oplus> Q \<approx>\<^sup>s Q \<oplus> P"
proof -
  have "P \<oplus> Q \<sim>\<^sup>s Q \<oplus> P" by(rule Strong_Late_Bisim_Subst_SC.sumSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P \<parallel> \<zero> \<approx>\<^sup>s P"
proof -
  have "P \<parallel> \<zero> \<sim>\<^sup>s P" by(rule Strong_Late_Bisim_Subst_SC.parZero)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<parallel> Q \<approx>\<^sup>s Q \<parallel> P"
proof -
  have "P \<parallel> Q \<sim>\<^sup>s Q \<parallel> P" by(rule Strong_Late_Bisim_Subst_SC.parSym)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<parallel> Q) \<approx>\<^sup>s P \<parallel> <\<nu>x>Q"
proof -
  from `x \<sharp> P` have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s P \<parallel> <\<nu>x>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> Q"

  shows "<\<nu>x>(P \<parallel> Q) \<approx>\<^sup>s (<\<nu>x>P) \<parallel> Q"
proof -
  from `x \<sharp> Q` have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s (<\<nu>x>P) \<parallel> Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar')
  thus ?thesis by(rule strongBisimWeakBisim)
qed

  shows "(P \<parallel> Q) \<parallel> R \<approx>\<^sup>s P \<parallel> (Q \<parallel> R)"
proof -
  have "(P \<parallel> Q) \<parallel> R \<sim>\<^sup>s P \<parallel> (Q \<parallel> R)" by(rule Strong_Late_Bisim_Subst_SC.parAssoc)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes "a \<sharp> P"

  shows "<\<nu>a>P \<approx>\<^sup>s P"
using assms
proof -
  from `a \<sharp> P` have "<\<nu>a>P \<sim>\<^sup>s P" by(rule Strong_Late_Bisim_Subst_SC.scopeFresh)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<oplus> Q) \<approx>\<^sup>s P \<oplus> <\<nu>x>Q"
proof -
  from `x \<sharp> P` have "<\<nu>x>(P \<oplus> Q) \<sim>\<^sup>s P \<oplus> <\<nu>x>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtSum)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

lemma bangSC:
  fixes P

  shows "!P \<approx>\<^sup>s P \<parallel> !P"
proof -
  have "!P \<sim>\<^sup>s P \<parallel> !P" by(rule Strong_Late_Bisim_Subst_SC.bangSC)
  thus ?thesis by(rule strongBisimWeakBisim)
qed

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |               December 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                 August 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law
imports CSP_F_law_SKIP      CSP_F_law_ref
        CSP_F_law_dist      CSP_F_law_alpha_par
        CSP_F_law_step      CSP_F_law_rep_par
        CSP_F_law_fix
        CSP_F_law_DIV       CSP_F_law_SKIP_DIV
        CSP_F_law_step_ext  CSP_F_law_norm
        CSP_T.CSP_T_law
begin

(*********************************************************
            SKIP , DIV  and Internal choice
 *********************************************************)

(*** |~| ***)

lemma cspF_SKIP_DIV_Int_choice:
  "[| P = SKIP | P = DIV ; Q = SKIP | Q = DIV |] ==>
   (P |~| Q) =F[M1,M2] (if (P = SKIP | Q = SKIP) then SKIP else DIV)"
apply (elim disjE)
apply (simp_all)
apply (rule cspF_rw_left)
apply (rule cspF_idem)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_unit)
apply (rule cspF_reflex)
apply (rule cspF_rw_left)
apply (rule cspF_idem)
apply (rule cspF_reflex)
done

(*** !! ***)

lemma cspF_SKIP_DIV_Rep_int_choice_sum:
  "[| ALL c: sumset C. (Qf c = SKIP | Qf c = DIV) |] ==>
   (!! c:C .. Qf c) =F[M1,M2]
   (if (EX c: sumset C. Qf c = SKIP) then SKIP else DIV)"
apply (case_tac " sumset C={}")
apply (simp add: cspF_Rep_int_choice_empty)
apply (case_tac "ALL c: sumset C. Qf c = DIV")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_const)
 apply (simp)
 apply (force)
 apply (simp)

 apply (simp)
 apply (elim bexE)
 apply (frule_tac x="c" in bspec)
 apply (simp_all)
 apply (intro conjI impI)

  apply (rule cspF_rw_left)
  apply (subgoal_tac
  "!! :C .. Qf =F[M1,M1]
   !! :({c:C. Qf c = SKIP}s Uns {c:C. Qf c ~= SKIP}s) .. Qf")
  apply (simp (no_asm))
  apply (rule cspF_decompo)
   apply (simp)
   apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_Rep_int_choice_union_Int)
  apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_decompo)
  apply (rule cspF_Rep_int_choice_const)
  apply (force)
  apply (rule ballI)
  apply (simp)
  apply (case_tac " sumset ({c:C. Qf c ~= SKIP}s) ={}")
   apply (rule cspF_Rep_int_choice_DIV)
   apply (simp)

   apply (rule cspF_rw_left)
   apply (rule cspF_Rep_int_choice_const)
   apply (simp_all)
   apply (intro allI impI)
   apply (subgoal_tac "Qf ca = DIV")
   apply (simp)
   apply (force)
   apply (simp)

  apply (rule cspF_rw_left)
  apply (rule cspF_unit)
  apply (simp)
done

lemma cspF_SKIP_DIV_Rep_int_choice_nat:
  "[| ALL n:N. (Qf n = SKIP | Qf n = DIV) |] ==>
   (!nat n:N .. Qf n) =F[M1,M2]
   (if (EX n:N. Qf n = SKIP) then SKIP else DIV)"
apply (unfold Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Rep_int_choice_sum)
apply (auto)
done

lemma cspF_SKIP_DIV_Rep_int_choice_set:
  "[| ALL X:Xs. (Qf X = SKIP | Qf X = DIV) |] ==>
   (!set X:Xs .. Qf X) =F[M1,M2]
   (if (EX X:Xs. Qf X = SKIP) then SKIP else DIV)"
apply (unfold Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_DIV_Rep_int_choice_sum)
apply (auto)
done

lemmas cspF_SKIP_DIV_Rep_int_choice =
       cspF_SKIP_DIV_Rep_int_choice_sum
       cspF_SKIP_DIV_Rep_int_choice_nat
       cspF_SKIP_DIV_Rep_int_choice_set

end


theory TopoS_Interface_impl
imports "Lib/FiniteGraph" "Lib/FiniteListGraph" TopoS_Interface TopoS_Helper
begin

section\<open>Executable Implementation with Lists\<close>
  text \<open>Correspondence List Implementation and set Specification\<close>

  subsection\<open>Abstraction from list implementation to set specification\<close>
  text\<open>Nomenclature: \<open>_spec\<close> is the specification, \<open>_impl\<close> the corresponding implementation.\<close>

  text\<open>\<open>_spec\<close> and \<open>_impl\<close> only need to comply for @{const wf_graph}s.
   We will always require the stricter @{const wf_list_graph}, which implies @{const wf_graph}.
\<close>
  lemma "wf_list_graph G \<Longrightarrow> wf_graph (list_graph_to_graph G)"
    by %invisible (metis wf_list_graph_def wf_list_graph_iff_wf_graph)

  locale TopoS_List_Impl =
    fixes default_node_properties :: "'a" ("\<bottom>")
    and sinvar_spec::"('v::vertex) graph \<Rightarrow> ('v::vertex \<Rightarrow> 'a) \<Rightarrow> bool"
    and sinvar_impl::"('v::vertex) list_graph \<Rightarrow> ('v::vertex \<Rightarrow> 'a) \<Rightarrow> bool"
    and receiver_violation :: "bool"
    and offending_flows_impl::"('v::vertex) list_graph \<Rightarrow> ('v \<Rightarrow> 'a) \<Rightarrow> ('v \<times> 'v) list list"
    and node_props_impl::"('v::vertex, 'a) TopoS_Params \<Rightarrow> ('v \<Rightarrow> 'a)"
    and eval_impl::"('v::vertex) list_graph \<Rightarrow> ('v, 'a) TopoS_Params \<Rightarrow> bool"
    assumes
      spec: "SecurityInvariant sinvar_spec default_node_properties receiver_violation" \<comment> \<open>specification is valid\<close>
    and
      sinvar_spec_impl: "wf_list_graph G \<Longrightarrow>
        (sinvar_spec (list_graph_to_graph G) nP) = (sinvar_impl G nP)"
    and
      offending_flows_spec_impl: "wf_list_graph G \<Longrightarrow>
      (SecurityInvariant_withOffendingFlows.set_offending_flows sinvar_spec (list_graph_to_graph G) nP) =
      set`set (offending_flows_impl G nP)"
    and
      node_props_spec_impl:
     "SecurityInvariant.node_props_formaldef default_node_properties P = node_props_impl P"
    and
      eval_spec_impl:
     "(distinct (nodesL G) \<and> distinct (edgesL G) \<and>
     SecurityInvariant.eval sinvar_spec default_node_properties (list_graph_to_graph G) P ) =
     (eval_impl G P)"

  subsection \<open>Security Invariants Packed\<close>

  text \<open>We pack all necessary functions and properties of a security invariant in a struct-like data structure.\<close>
  record ('v::vertex, 'a) TopoS_packed =
    nm_name :: "string"
    nm_receiver_violation :: "bool"
    nm_default :: "'a"
    nm_sinvar::"('v::vertex) list_graph \<Rightarrow> ('v \<Rightarrow> 'a) \<Rightarrow> bool"
    nm_offending_flows::"('v::vertex) list_graph \<Rightarrow> ('v \<Rightarrow> 'a) \<Rightarrow> ('v \<times> 'v) list list"
    nm_node_props::"('v::vertex, 'a) TopoS_Params \<Rightarrow> ('v \<Rightarrow> 'a)"
    nm_eval::"('v::vertex) list_graph \<Rightarrow> ('v, 'a)TopoS_Params \<Rightarrow> bool"

   text\<open>The packed list implementation must comply with the formal definition.\<close>
   locale TopoS_modelLibrary =
    fixes m :: "('v::vertex, 'a) TopoS_packed" \<comment> \<open>concrete model implementation\<close>
    and sinvar_spec::"('v::vertex) graph \<Rightarrow> ('v::vertex \<Rightarrow> 'a) \<Rightarrow> bool" \<comment> \<open>specification\<close>
    assumes
       name_not_empty: "length (nm_name m) > 0"
     and
       impl_spec: "TopoS_List_Impl
        (nm_default m)
        sinvar_spec
        (nm_sinvar m)
        (nm_receiver_violation m)
        (nm_offending_flows m)
        (nm_node_props m)
        (nm_eval m)"

  subsection\<open>Helpful Lemmata\<close>

  text\<open>show that @{term "sinvar"} complies\<close>
  lemma TopoS_eval_impl_proofrule:
    assumes inst: "SecurityInvariant sinvar_spec default_node_properties receiver_violation"
    assumes ev: "\<And>nP. wf_list_graph G \<Longrightarrow> sinvar_spec (list_graph_to_graph G) nP = sinvar_impl G nP"
    shows "
      (distinct (nodesL G) \<and> distinct (edgesL G) \<and>
       SecurityInvariant.eval sinvar_spec default_node_properties (list_graph_to_graph G) P) =
      (wf_list_graph G \<and> sinvar_impl G (SecurityInvariant.node_props default_node_properties P))"
  proof (cases "wf_list_graph G")
    case True
    hence "sinvar_spec (list_graph_to_graph G) (SecurityInvariant.node_props default_node_properties P) =
       sinvar_impl G (SecurityInvariant.node_props default_node_properties P)"
      using ev by blast

    with inst show ?thesis
      unfolding wf_list_graph_def
      by (simp add: wf_list_graph_iff_wf_graph SecurityInvariant.eval_def)
  next
    case False
    hence "(distinct (nodesL G) \<and> distinct (edgesL G) \<and> wf_list_graph_axioms G) = False"
      unfolding wf_list_graph_def by blast
    with False show ?thesis
      unfolding SecurityInvariant.eval_def[OF inst]
      by (fastforce simp: wf_list_graph_iff_wf_graph)
  qed

subsection \<open>Helper lemmata\<close>

  text\<open>Provide @{term sinvar} function and get back a function that computes the list of offending flows

  Exponential time!
\<close>
  definition Generic_offending_list:: "('v list_graph \<Rightarrow> ('v \<Rightarrow> 'a) \<Rightarrow> bool )\<Rightarrow> 'v list_graph \<Rightarrow> ('v \<Rightarrow> 'a) \<Rightarrow> ('v \<times> 'v) list list" where
    "Generic_offending_list sinvar G nP = [f \<leftarrow> (subseqs (edgesL G)).
    (\<not> sinvar G nP \<and> sinvar (FiniteListGraph.delete_edges G f) nP) \<and>
      (\<forall>(e1, e2)\<in>set f. \<not> sinvar (add_edge e1 e2 (FiniteListGraph.delete_edges G f)) nP)]"

  text\<open>proof rule: if @{term sinvar} complies, @{const Generic_offending_list} complies\<close>
  lemma Generic_offending_list_correct:
    assumes valid: "wf_list_graph G"
    assumes spec_impl: "\<And>G nP. wf_list_graph G \<Longrightarrow> sinvar_spec (list_graph_to_graph G) nP = sinvar_impl G nP"
    shows "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar_spec (list_graph_to_graph G) nP =
      set`set( Generic_offending_list sinvar_impl G nP )"
  proof -
    have "\<And> P G. set ` {x \<in> set (subseqs (edgesL G)). P G (set x)} = {x \<in> set ` set (subseqs (edgesL G)). P G (x)}"
      by fastforce
    hence subset_subseqs_filter: "\<And> G P. {f. f \<subseteq> edges (list_graph_to_graph G) \<and> P G f}
    = set ` set [f\<leftarrow>subseqs (edgesL G) . P G (set f)]"
      unfolding list_graph_to_graph_def
      by (auto simp: subseqs_powset)

    from valid delete_edges_wf have "\<forall>f. wf_list_graph(FiniteListGraph.delete_edges G f)" by fast
    with spec_impl[symmetric] FiniteListGraph.delete_edges_correct[of "G"] have impl_spec_delete:
      "\<forall>f. sinvar_impl (FiniteListGraph.delete_edges G f) nP =
          sinvar_spec (FiniteGraph.delete_edges (list_graph_to_graph G) (set f)) nP" by simp

    from spec_impl[OF valid, symmetric] have impl_spec_not:
      "(\<not> sinvar_impl G nP) = (\<not> sinvar_spec (list_graph_to_graph G) nP)" by auto

    from spec_impl[symmetric, OF FiniteListGraph.add_edge_wf[OF FiniteListGraph.delete_edges_wf[OF valid]]] have impl_spec_allE:
    "\<forall> e1 e2 E. sinvar_impl (FiniteListGraph.add_edge e1 e2 (FiniteListGraph.delete_edges G E)) nP =
    sinvar_spec (list_graph_to_graph (FiniteListGraph.add_edge e1 e2 (FiniteListGraph.delete_edges G E))) nP" by simp

    have list_graph: "\<And> e1 e2 G f. (list_graph_to_graph (FiniteListGraph.add_edge e1 e2 (FiniteListGraph.delete_edges G f))) =
      (FiniteGraph.add_edge e1 e2 (FiniteGraph.delete_edges (list_graph_to_graph G) (set f)))"
    by(simp add: FiniteListGraph.add_edge_correct FiniteListGraph.delete_edges_correct)

    show ?thesis
      unfolding SecurityInvariant_withOffendingFlows.set_offending_flows_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_def
      Generic_offending_list_def
        apply(subst impl_spec_delete)
        apply(subst impl_spec_not)
        apply(subst impl_spec_allE)
        apply(subst list_graph)
        apply(rule subset_subseqs_filter)
        done
  qed

  lemma all_edges_list_I: "P (list_graph_to_graph G) = Pl G \<Longrightarrow>
    (\<forall>(e1, e2)\<in> (edges (list_graph_to_graph G)). P (list_graph_to_graph G) e1 e2) = (\<forall>(e1, e2)\<in>set (edgesL G). Pl G e1 e2)"
  unfolding list_graph_to_graph_def
  by simp

  lemma all_nodes_list_I: "P (list_graph_to_graph G) = Pl G \<Longrightarrow>
    (\<forall>n \<in> (nodes (list_graph_to_graph G)). P (list_graph_to_graph G) n) = (\<forall> n \<in>set (nodesL G). Pl G n)"
  unfolding list_graph_to_graph_def
  by simp

  fun minimalize_offending_overapprox :: "('v list_graph \<Rightarrow> bool) \<Rightarrow>
    ('v \<times> 'v) list \<Rightarrow> ('v \<times> 'v) list \<Rightarrow> 'v list_graph \<Rightarrow> ('v \<times> 'v) list" where
  "minimalize_offending_overapprox _ [] keep _ = keep" |
  "minimalize_offending_overapprox m (f#fs) keep G = (if m (delete_edges G (fs@keep)) then
      minimalize_offending_overapprox m fs keep G
    else
      minimalize_offending_overapprox m fs (f#keep) G
    )"

  thm minimalize_offending_overapprox_boundnP (*is usage of this one better?*)
  lemma minimalize_offending_overapprox_spec_impl:
    assumes valid: "wf_list_graph (G::'v::vertex list_graph)"
        and spec_impl: "\<And>G nP::('v \<Rightarrow> 'a). wf_list_graph G \<Longrightarrow> sinvar_spec (list_graph_to_graph G) nP = sinvar_impl G nP"
    shows "minimalize_offending_overapprox (\<lambda>G. sinvar_impl G nP) fs keeps G =
       TopoS_withOffendingFlows.minimalize_offending_overapprox (\<lambda>G. sinvar_spec G nP) fs keeps (list_graph_to_graph G)"
    apply(subst minimalize_offending_overapprox_boundnP)
    using valid spec_impl apply(induction fs arbitrary: keeps)
     apply(simp add: SecurityInvariant_withOffendingFlows.minimalize_offending_overapprox.simps; fail)
    apply(simp add: SecurityInvariant_withOffendingFlows.minimalize_offending_overapprox.simps)
    apply (metis FiniteListGraph.delete_edges_wf delete_edges_list_set list_graph_correct(5))
    done

  text\<open>With @{const minimalize_offending_overapprox}, we can get one offending flow\<close>
  lemma minimalize_offending_overapprox_gives_some_offending_flow:
    assumes wf: "wf_list_graph G"
        and NetModelLib: "TopoS_modelLibrary m sinvar_spec"
        and violation: "\<not> (nm_sinvar m) G nP"
    shows "set (minimalize_offending_overapprox (\<lambda>G. (nm_sinvar m) G nP) (edgesL G) [] G) \<in>
            SecurityInvariant_withOffendingFlows.set_offending_flows sinvar_spec (list_graph_to_graph G) nP"
    proof -
      from wf have wfG: "wf_graph (list_graph_to_graph G)"
        by (simp add: wf_list_graph_def wf_list_graph_iff_wf_graph)
      from wf have dist_edges: "distinct (edgesL G)" by (simp add: wf_list_graph_def)

      let ?spec_algo="TopoS_withOffendingFlows.minimalize_offending_overapprox
                          (\<lambda>G. sinvar_spec G nP) (edgesL G) [] (list_graph_to_graph G)"

      note spec=TopoS_List_Impl.spec[OF TopoS_modelLibrary.impl_spec[OF NetModelLib]]

      from spec have spec_prelim: "SecurityInvariant_preliminaries sinvar_spec"
        by(simp add: SecurityInvariant_def)
      from spec_prelim SecurityInvariant_preliminaries.sinvar_monoI have mono:
        "SecurityInvariant_withOffendingFlows.sinvar_mono sinvar_spec" by blast

      from spec_prelim have empty_edges: "sinvar_spec \<lparr>nodes = set (nodesL G), edges = {}\<rparr> nP"
      using SecurityInvariant_preliminaries.defined_offending
        SecurityInvariant_withOffendingFlows.sinvar_mono_imp_sinvar_mono
        SecurityInvariant_withOffendingFlows.valid_empty_edges_iff_exists_offending_flows
        mono empty_subsetI graph.simps(1)
        list_graph_to_graph_def local.wf wf_list_graph_def wf_list_graph_iff_wf_graph
        by (metis)

      (*TODO: tune*)
      have spec_impl: "wf_list_graph G \<Longrightarrow> sinvar_spec (list_graph_to_graph G) nP = (nm_sinvar m) G nP" for G nP
        using NetModelLib TopoS_List_Impl.sinvar_spec_impl TopoS_modelLibrary.impl_spec by fastforce

      from minimalize_offending_overapprox_spec_impl[OF wf] spec_impl have alog_spec:
        "minimalize_offending_overapprox (\<lambda>G. (nm_sinvar m) G nP) fs keeps G =
         TopoS_withOffendingFlows.minimalize_offending_overapprox (\<lambda>G. sinvar_spec G nP) fs keeps (list_graph_to_graph G)"
         for fs keeps by blast

      (*TODO: tune*)
      from spec_impl violation have
        "SecurityInvariant_withOffendingFlows.is_offending_flows sinvar_spec (set (edgesL G)) (list_graph_to_graph G) nP"
        apply(simp add: SecurityInvariant_withOffendingFlows.is_offending_flows_def)
        apply(intro conjI)
         apply (simp add: local.wf; fail)
        apply(simp add: FiniteGraph.delete_edges_simp2 list_graph_to_graph_def)
        apply(simp add: empty_edges)
        done
      hence goal: "SecurityInvariant_withOffendingFlows.is_offending_flows_min_set sinvar_spec
        (set ?spec_algo) (list_graph_to_graph G) nP"
      apply(subst minimalize_offending_overapprox_boundnP) (*we do this subst pretty often. is this the right abstraction here?*)
      apply(rule SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_minimalize_offending_overapprox[OF
              mono wfG _ _ dist_edges])
       apply(simp add: list_graph_to_graph_def)+
      done

      from SecurityInvariant_withOffendingFlows.minimalize_offending_overapprox_subseteq_input[of
        "sinvar_spec" "(edgesL G)" "[]"] have subset_edges:
        "set ?spec_algo \<subseteq> edges (list_graph_to_graph G)"
        apply(subst minimalize_offending_overapprox_boundnP)
        by(simp add: list_graph_to_graph_def)

      from goal show ?thesis
        by(simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def alog_spec subset_edges)
    qed

(*TODO: this should be a header of TopoS_Libary. The header should be printed BEFORE the imports are processed. *)
section\<open>Security Invariant Library\<close>
(*The SINVAR_* theory files all use the "subsection" command. Here is the top-section.*)

end


section \<open>Sets Bounded by a Finite Cardinal $>2$ Are Not BNFs\<close>

(*<*)
theory Finitely_Bounded_Set_Counterexample
imports
  "HOL-Cardinals.Cardinals"
begin
(*>*)

text \<open>Do not import this theory. It contains an inconsistent axiomatization.
The point is to exhibit the particular inconsistency.\<close>

typedef ('a, 'k) bset ("_ set[_]" [22, 21] 21) =
  "{A :: 'a set. |A| <o |UNIV :: 'k set|}"
  morphisms set_bset Abs_bset
  by (rule exI[of _ "{}"]) (auto simp: card_of_empty4 csum_def)

setup_lifting type_definition_bset

lift_definition map_bset ::
  "('a \<Rightarrow> 'b) \<Rightarrow> 'a set['k] \<Rightarrow> 'b set['k]" is image
  using card_of_image ordLeq_ordLess_trans by blast

inductive rel_bset :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a, 'k) bset \<Rightarrow> ('b, 'k) bset \<Rightarrow> bool" for R where
  "set_bset x \<subseteq> {(x, y). R x y} \<Longrightarrow> rel_bset R (map_bset fst x) (map_bset snd x)"

text \<open>
We axiomatize the relator commutation property and show that we can deduce @{term False} from it.

We cannot do this with a locale, since we need the fully polymorphic version of the following axiom.
\<close>

axiomatization where
  inconsistent: "rel_bset R1 OO rel_bset R2 \<le> rel_bset (R1 OO R2)"

bnf "('a, 'k) bset"
  map: map_bset
  sets: set_bset
  bd: "|UNIV :: 'k set| +c natLeq"
  rel: rel_bset
proof (standard, goal_cases)
  case 1 then show ?case
    by transfer simp
next
  case 2 then show ?case
    apply (rule ext)
    apply transfer
    apply auto
    done
next
  case 3 then show ?case
    apply transfer
    apply (auto simp: image_iff)
    done
next
  case 4 then show ?case
    apply (rule ext)
    apply transfer
    apply simp
    done
next
  case 5 then show ?case by (simp add: card_order_csum natLeq_card_order)
next
  case 6 then show ?case by (simp add: cinfinite_csum natLeq_cinfinite)
next
  case 7 then show ?case
    apply transfer
    apply (erule ordLeq_transitive[OF ordLess_imp_ordLeq ordLeq_csum1])
    apply simp
    done
next
  case 8 then show ?case by (rule inconsistent) \<comment> \<open>BAAAAAMMMM\<close>
next
  case 9 then show ?case
    by (auto simp: fun_eq_iff intro: rel_bset.intros elim: rel_bset.cases)
qed

lemma card_option_finite[simp]:
  assumes "finite (UNIV :: 'k set)"
  shows "card (UNIV :: 'k option set) = Suc (card (UNIV :: 'k set))"
  (is "card ?L = Suc (card ?R)")
proof -
  have "card ?L = Suc (card (?L - {None}))" by (rule card.remove) (auto simp: assms)
  also have "card (?L - {None}) = card ?R"
    by (rule bij_betw_same_card[of the])
      (auto simp: bij_betw_def inj_on_def image_iff intro!: bexI[of _ "Some x" for x])
  finally show ?thesis .
qed

datatype ('a :: enum) x = A | B "'a option" | C

abbreviation "Bs \<equiv> B ` (insert None (Some ` set Enum.enum))"

lemma UNIV_x[simp]:
  "(UNIV :: ('a :: enum) x set) = {A, C} \<union> Bs"
  (is "_ = ?R")
proof (intro set_eqI iffI)
  fix x :: "'a x" show "x \<in> ?R" by (cases x) (auto simp add: enum_UNIV)
qed simp

lemma Collect_split_in_rel: "{(x, y). in_rel R x y} = R"
  by auto

lift_definition X :: "('a :: enum x, 'a x) bset" is "insert A Bs"
  by (subst finite_card_of_iff_card3) (auto simp: card_insert card_Diff_singleton_if)

lift_definition Y :: "('a :: enum x, 'a x) bset" is "insert C Bs"
  by (subst finite_card_of_iff_card3) (auto simp: card_insert card_Diff_singleton_if)

lift_definition Z :: "('a :: enum x, 'a x) bset" is "{A, C}"
  by (subst finite_card_of_iff_card3) (auto simp: card_insert card_Diff_singleton_if)

lift_definition R :: "('a x \<times> 'a x, 'a :: enum x) bset" is "insert (A, A) ((\<lambda>B. (B, C)) ` Bs)"
  by (subst finite_card_of_iff_card3)
    (auto simp: card_insert card_Diff_singleton_if image_iff card_image inj_on_def)

lift_definition S :: "('a x \<times> 'a x, 'a :: enum x) bset" is "insert (C, C) ((\<lambda>B. (A, B)) ` Bs)"
  by (subst finite_card_of_iff_card3)
    (auto simp: card_insert card_Diff_singleton_if image_iff card_image inj_on_def)

lift_definition in_brel :: "('a \<times> 'b, 'k) bset \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool" is in_rel .

lemma False
proof -
  have "rel_bset (in_brel R) X Z"
    unfolding bset.in_rel mem_Collect_eq
    apply (intro exI[of _ R])
    apply transfer
    apply (auto simp: image_iff)
    done
  moreover
  have "rel_bset (in_brel S) Z Y"
    unfolding bset.in_rel mem_Collect_eq
    apply (intro exI[of _ S])
    apply transfer
    apply (auto simp: image_iff)
    done
  ultimately have "rel_bset (in_brel R OO in_brel S) X Y"
    unfolding bset.rel_compp by blast
  moreover
  have *: "insert (A, A) ((\<lambda>B. (B, C)) ` Bs) O insert (C, C) ((\<lambda>B. (A, B)) ` Bs) =
    ((\<lambda>B. (B, C)) ` Bs) \<union> ((\<lambda>B. (A, B)) ` Bs)" (is "_ = ?RS" ) by auto
  have "\<not> rel_bset (in_brel R OO in_brel S) X Y"
  unfolding bset.in_rel mem_Collect_eq
  proof (transfer, safe, unfold relcompp_in_rel * Collect_split_in_rel)
    fix Z :: "('a :: enum x \<times> 'a x) set"
    note enum_UNIV[simp] UNIV_option_conv[symmetric, simp]
    assume "Z \<subseteq> ?RS" "fst ` Z = insert A Bs" "snd ` Z = insert C Bs"
    then have "Z = ?RS" unfolding fst_eq_Domain snd_eq_Range by auto
    moreover assume "|Z| <o |UNIV :: 'a x set|"
    ultimately show False unfolding \<open>Z = ?RS\<close>
      by (subst (asm) finite_card_of_iff_card3, simp, simp, subst (asm) card_Un_disjoint)
        (auto simp: card_insert card_Diff_singleton_if card_image inj_on_def split: if_splits)
  qed
  ultimately show False by blast
qed

(*<*)
end
(*>*)