(*** This file is part of Lem.  eth-isabelle project just uses it.  See lem-license. ***)

chapter {* Generated by Lem from list.lem. *}

theory "Lem_list"

imports
 	 Main
	 "Lem_bool"
	 "Lem_maybe"
	 "Lem_basic_classes"
	 "Lem_function"
	 "Lem_tuple"
	 "Lem_num"
	 "Lem"

begin

(*open import Bool Maybe Basic_classes Function Tuple Num*)

(*open import {coq} `Coq.Lists.List`*)
(*open import {isabelle} `$LIB_DIR/Lem`*)
(*open import {hol} `lemTheory` `listTheory` `rich_listTheory` `sortingTheory`*)

(* ========================================================================== *)
(* Basic list functions                                                       *)
(* ========================================================================== *)

(* The type of lists as well as list literals like [], [1;2], ... are hardcoded.
   Thus, we can directly dive into derived definitions. *)

(* ----------------------- *)
(* cons                    *)
(* ----------------------- *)

(*val :: : forall 'a. 'a -> list 'a -> list 'a*)

(* ----------------------- *)
(* Emptyness check         *)
(* ----------------------- *)

(*val null : forall 'a. list 'a -> bool*)
(*let null l=  match l with [] -> true | _ -> false end*)

(* ----------------------- *)
(* Length                  *)
(* ----------------------- *)

(*val length : forall 'a. list 'a -> nat*)
(*let rec length l=
  match l with
    | [] -> 0
    | x :: xs -> (Instance_Num_NumAdd_nat.+) (length xs) 1
  end*)

(* ----------------------- *)
(* Equality                *)
(* ----------------------- *)

(*val listEqual : forall 'a. Eq 'a => list 'a -> list 'a -> bool*)
(*val listEqualBy : forall 'a. ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*)

fun  listEqualBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool "  where
     " listEqualBy eq ([]) ([]) = ( True )"
|" listEqualBy eq ([]) (_ # _) = ( False )"
|" listEqualBy eq (_ # _) ([]) = ( False )"
|" listEqualBy eq (x # xs) (y # ys) = ( (eq x y \<and> listEqualBy eq xs ys))"
declare listEqualBy.simps [simp del]

(* ----------------------- *)
(* compare                 *)
(* ----------------------- *)

(*val lexicographicCompare : forall 'a. Ord 'a => list 'a -> list 'a -> ordering*)
(*val lexicographicCompareBy : forall 'a. ('a -> 'a -> ordering) -> list 'a -> list 'a -> ordering*)

fun  lexicographicCompareBy  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> ordering "  where
     " lexicographicCompareBy cmp ([]) ([]) = ( EQ )"
|" lexicographicCompareBy cmp ([]) (_ # _) = ( LT )"
|" lexicographicCompareBy cmp (_ # _) ([]) = ( GT )"
|" lexicographicCompareBy cmp (x # xs) (y # ys) = ( (
      (case  cmp x y of
          LT => LT
        | GT => GT
        | EQ => lexicographicCompareBy cmp xs ys
      )
    ))"
declare lexicographicCompareBy.simps [simp del]

(*val lexicographicLess : forall 'a. Ord 'a => list 'a -> list 'a -> bool*)
(*val lexicographicLessBy : forall 'a. ('a -> 'a -> bool) -> ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*)
fun  lexicographicLessBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool "  where
     " lexicographicLessBy less1 less_eq1 ([]) ([]) = ( False )"
|" lexicographicLessBy less1 less_eq1 ([]) (_ # _) = ( True )"
|" lexicographicLessBy less1 less_eq1 (_ # _) ([]) = ( False )"
|" lexicographicLessBy less1 less_eq1 (x # xs) (y # ys) = ( ((less1 x y) \<or> ((less_eq1 x y) \<and> (lexicographicLessBy less1 less_eq1 xs ys))))"
declare lexicographicLessBy.simps [simp del]

(*val lexicographicLessEq : forall 'a. Ord 'a => list 'a -> list 'a -> bool*)
(*val lexicographicLessEqBy : forall 'a. ('a -> 'a -> bool) -> ('a -> 'a -> bool) -> list 'a -> list 'a -> bool*)
fun  lexicographicLessEqBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool "  where
     " lexicographicLessEqBy less1 less_eq1 ([]) ([]) = ( True )"
|" lexicographicLessEqBy less1 less_eq1 ([]) (_ # _) = ( True )"
|" lexicographicLessEqBy less1 less_eq1 (_ # _) ([]) = ( False )"
|" lexicographicLessEqBy less1 less_eq1 (x # xs) (y # ys) = ( (less1 x y \<or> (less_eq1 x y \<and> lexicographicLessEqBy less1 less_eq1 xs ys)))"
declare lexicographicLessEqBy.simps [simp del]

definition instance_Basic_classes_Ord_list_dict  :: " 'a Ord_class \<Rightarrow>('a list)Ord_class "  where
     " instance_Basic_classes_Ord_list_dict dict_Basic_classes_Ord_a = ((|

  compare_method = (lexicographicCompareBy
  (compare_method   dict_Basic_classes_Ord_a)),

  isLess_method = (lexicographicLessBy
  (isLess_method   dict_Basic_classes_Ord_a) (isLessEqual_method   dict_Basic_classes_Ord_a)),

  isLessEqual_method = (lexicographicLessEqBy
  (isLess_method   dict_Basic_classes_Ord_a) (isLessEqual_method   dict_Basic_classes_Ord_a)),

  isGreater_method = (\<lambda> x y. (lexicographicLessBy
  (isLess_method   dict_Basic_classes_Ord_a) (isLessEqual_method   dict_Basic_classes_Ord_a) y x)),

  isGreaterEqual_method = (\<lambda> x y. (lexicographicLessEqBy
  (isLess_method   dict_Basic_classes_Ord_a) (isLessEqual_method   dict_Basic_classes_Ord_a) y x))|) )"

(* ----------------------- *)
(* Append                  *)
(* ----------------------- *)

(*val ++ : forall 'a. list 'a -> list 'a -> list 'a*) (* originally append *)
(*let rec ++ xs ys=  match xs with
                     | [] -> ys
                     | x :: xs' -> x :: (xs' ++ ys)
                   end*)

(* ----------------------- *)
(* snoc                    *)
(* ----------------------- *)

(*val snoc : forall 'a. 'a -> list 'a -> list 'a*)
(*let snoc e l=  l ++ [e]*)

(* ----------------------- *)
(* Reverse                 *)
(* ----------------------- *)

(* First lets define the function [reverse_append], which is
   closely related to reverse. [reverse_append l1 l2] appends the list [l2] to the reverse of [l1].
   This can be implemented more efficienctly than appending and is
   used to implement reverse. *)

(*val reverseAppend : forall 'a. list 'a -> list 'a -> list 'a*) (* originally named rev_append *)
(*let rec reverseAppend l1 l2=  match l1 with
                                | [] -> l2
                                | x :: xs -> reverseAppend xs (x :: l2)
                               end*)

(* Reversing a list *)
(*val reverse : forall 'a. list 'a -> list 'a*) (* originally named rev *)
(*let reverse l=  reverseAppend l []*)

(* ----------------------- *)
(* Map                     *)
(* ----------------------- *)

(*val map_tr : forall 'a 'b. list 'b -> ('a -> 'b) -> list 'a -> list 'b*)
function (sequential,domintros)  map_tr  :: " 'b list \<Rightarrow>('a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> 'b list "  where
     " map_tr rev_acc f ([]) = ( List.rev rev_acc )"
|" map_tr rev_acc f (x # xs) = ( map_tr ((f x) # rev_acc) f xs )"
by pat_completeness auto

(* taken from: https://blogs.janestreet.com/optimizing-list-map/ *)
(*val count_map : forall 'a 'b. ('a -> 'b) -> list 'a -> nat -> list 'b*)
function (sequential,domintros)  count_map  :: "('a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'b list "  where
     " count_map f ([]) ctr = ( [])"
|" count_map f (hd1 # tl1) ctr = ( f hd1 #
    (if ctr <( 5000 :: nat) then count_map f tl1 (ctr +( 1 :: nat))
    else map_tr [] f tl1))"
by pat_completeness auto

(*val map : forall 'a 'b. ('a -> 'b) -> list 'a -> list 'b*)
(*let map f l=  count_map f l 0*)

(* ----------------------- *)
(* Reverse Map             *)
(* ----------------------- *)

(*val reverseMap : forall 'a 'b. ('a -> 'b) -> list 'a -> list 'b*)

(* ========================================================================== *)
(* Folding                                                                    *)
(* ========================================================================== *)

(* ----------------------- *)
(* fold left               *)
(* ----------------------- *)

(*val foldl : forall 'a 'b. ('a -> 'b -> 'a) -> 'a -> list 'b -> 'a*) (* originally foldl *)

(*let rec foldl f b l=  match l with
  | []      -> b
  | x :: xs -> foldl f (f b x) xs
end*)

(* ----------------------- *)
(* fold right              *)
(* ----------------------- *)

(*val foldr : forall 'a 'b. ('a -> 'b -> 'b) -> 'b -> list 'a -> 'b*) (* originally foldr with different argument order *)
(*let rec foldr f b l=  match l with
  | []      -> b
  | x :: xs -> f x (foldr f b xs)
end*)

(* ----------------------- *)
(* concatenating lists     *)
(* ----------------------- *)

(*val concat : forall 'a. list (list 'a) -> list 'a*) (* before also called flatten *)
(*let concat=  foldr (++) []*)

(* -------------------------- *)
(* concatenating with mapping *)
(* -------------------------- *)

(*val concatMap : forall 'a 'b. ('a -> list 'b) -> list 'a -> list 'b*)

(* ------------------------- *)
(* universal qualification   *)
(* ------------------------- *)

(*val all : forall 'a. ('a -> bool) -> list 'a -> bool*) (* originally for_all *)
(*let all P l=  foldl (fun r e -> P e && r) true l*)

(* ------------------------- *)
(* existential qualification *)
(* ------------------------- *)

(*val any : forall 'a. ('a -> bool) -> list 'a -> bool*) (* originally exist *)
(*let any P l=  foldl (fun r e -> P e || r) false l*)

(* ------------------------- *)
(* dest_init                 *)
(* ------------------------- *)

(* get the initial part and the last element of the list in a safe way *)

(*val dest_init : forall 'a. list 'a -> maybe (list 'a * 'a)*)

fun  dest_init_aux  :: " 'a list \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list*'a "  where
     " dest_init_aux rev_init last_elem_seen ([]) = ( (List.rev rev_init, last_elem_seen))"
|" dest_init_aux rev_init last_elem_seen (x # xs) = ( dest_init_aux (last_elem_seen # rev_init) x xs )"
declare dest_init_aux.simps [simp del]

fun dest_init  :: " 'a list \<Rightarrow>('a list*'a)option "  where
     " dest_init ([]) = ( None )"
|" dest_init (x # xs) = ( Some (dest_init_aux [] x xs))"
declare dest_init.simps [simp del]

(* ========================================================================== *)
(* Indexing lists                                                             *)
(* ========================================================================== *)

(* ------------------------- *)
(* index / nth with maybe   *)
(* ------------------------- *)

(*val index : forall 'a. list 'a -> nat -> maybe 'a*)

(*let rec index l n=  match l with
  | []      -> Nothing
  | x :: xs -> if (Instance_Basic_classes_Eq_nat.=) n 0 then Just x else index xs ((Instance_Num_NumMinus_nat.-)n 1)
end*)

(* ------------------------- *)
(* findIndices               *)
(* ------------------------- *)

(* [findIndices P l] returns the indices of all elements of list [l] that satisfy predicate [P].
   Counting starts with 0, the result list is sorted ascendingly *)
(*val findIndices : forall 'a. ('a -> bool) -> list 'a -> list nat*)

fun  findIndices_aux  :: " nat \<Rightarrow>('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow>(nat)list "  where
     " findIndices_aux (i::nat) P ([]) = ( [])"
|" findIndices_aux (i::nat) P (x # xs) = ( if P x then i # findIndices_aux (i +( 1 :: nat)) P xs else findIndices_aux (i +( 1 :: nat)) P xs )"
declare findIndices_aux.simps [simp del]

(*let findIndices P l=  findIndices_aux 0 P l*)

(* ------------------------- *)
(* findIndex                 *)
(* ------------------------- *)

(* findIndex returns the first index of a list that satisfies a given predicate. *)
(*val findIndex : forall 'a. ('a -> bool) -> list 'a -> maybe nat*)
(*let findIndex P l=  match findIndices P l with
  | [] -> Nothing
  | x :: _ -> Just x
end*)

(* ------------------------- *)
(* elemIndices               *)
(* ------------------------- *)

(*val elemIndices : forall 'a. Eq 'a => 'a -> list 'a -> list nat*)

(* ------------------------- *)
(* elemIndex                 *)
(* ------------------------- *)

(*val elemIndex : forall 'a. Eq 'a => 'a -> list 'a -> maybe nat*)

(* ========================================================================== *)
(* Creating lists                                                             *)
(* ========================================================================== *)

(* ------------------------- *)
(* genlist                   *)
(* ------------------------- *)

(* [genlist f n] generates the list [f 0; f 1; ... (f (n-1))] *)
(*val genlist : forall 'a. (nat -> 'a) -> nat -> list 'a*)

(*let rec genlist f n=
  match n with
    | 0 -> []
    | n' + 1 -> snoc (f n') (genlist f n')
  end*)

(* ------------------------- *)
(* replicate                 *)
(* ------------------------- *)

(*val replicate : forall 'a. nat -> 'a -> list 'a*)
(*let rec replicate n x=
  match n with
    | 0 -> []
    | n' + 1 -> x :: replicate n' x
  end*)

(* ========================================================================== *)
(* Sublists                                                                   *)
(* ========================================================================== *)

(* ------------------------- *)
(* splitAt                   *)
(* ------------------------- *)

(* [splitAt n xs] returns a tuple (xs1, xs2), with append xs1 xs2 = xs and
   length xs1 = n. If there are not enough elements
   in [xs], the original list and the empty one are returned. *)
(*val splitAtAcc : forall 'a. list 'a -> nat -> list 'a -> (list 'a * list 'a)*)
function (sequential,domintros)  splitAtAcc  :: " 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list*'a list "  where
     " splitAtAcc revAcc n l = (
  (case  l of
      []    => (List.rev revAcc, [])
    | x # xs => if n \<le>( 0 :: nat) then (List.rev revAcc, l) else splitAtAcc (x # revAcc) (n-( 1 :: nat)) xs
  ))"
by pat_completeness auto

(*val splitAt : forall 'a. nat -> list 'a -> (list 'a * list 'a)*)
(*let rec splitAt n l=
   splitAtAcc [] n l*)

(* ------------------------- *)
(* take                      *)
(* ------------------------- *)

(* take n xs returns the prefix of xs of length n, or xs itself if n > length xs *)
(*val take : forall 'a. nat -> list 'a -> list 'a*)
(*let take n l=  fst (splitAt n l)*)

(* ------------------------- *)
(* drop                      *)
(* ------------------------- *)

(* [drop n xs] drops the first [n] elements of [xs]. It returns the empty list, if [n] > [length xs]. *)
(*val drop : forall 'a. nat -> list 'a -> list 'a*)
(*let drop n l=  snd (splitAt n l)*)

(* ------------------------- *)
(* dropWhile                 *)
(* ------------------------- *)

(* [dropWhile p xs] drops the first elements of [xs] that satisfy [p]. *)
(*val dropWhile : forall 'a. ('a -> bool) -> list 'a -> list 'a*)
fun  dropWhile  :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list "  where
     " dropWhile p l = ( (case  l of
    [] => []
  | x # xs => if p x then dropWhile p xs else l
))"
declare dropWhile.simps [simp del]

(* ------------------------- *)
(* takeWhile                 *)
(* ------------------------- *)

(* [takeWhile p xs] takes the first elements of [xs] that satisfy [p]. *)
(*val takeWhile : forall 'a. ('a -> bool) -> list 'a -> list 'a*)
fun  takeWhile  :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list "  where
     " takeWhile p ([]) = ( [])"
|" takeWhile p (x # xs) = ( if p x then x # takeWhile p xs else [])"
declare takeWhile.simps [simp del]

(* ------------------------- *)
(* splitWhile                *)
(* ------------------------- *)

(*val splitWhile : forall 'a. ('a -> bool) -> list 'a -> (list 'a * list 'a)*)
definition splitWhile  :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list*'a list "  where
     " splitWhile p xs = ( (takeWhile p xs, dropWhile p xs))"

(* ------------------------- *)
(* isPrefixOf                *)
(* ------------------------- *)

(*val isPrefixOf : forall 'a. Eq 'a => list 'a -> list 'a -> bool*)
fun  isPrefixOf  :: " 'a list \<Rightarrow> 'a list \<Rightarrow> bool "  where
     " isPrefixOf ([]) _ = ( True )"
|" isPrefixOf (_ # _) ([]) = ( False )"
|" isPrefixOf (x # xs) (y # ys) = ( (x = y) \<and> isPrefixOf xs ys )"
declare isPrefixOf.simps [simp del]

(* ------------------------- *)
(* update                    *)
(* ------------------------- *)
(*val update : forall 'a. list 'a -> nat -> 'a -> list 'a*)
(*let rec update l n e=
  match l with
    | []      -> []
    | x :: xs -> if (Instance_Basic_classes_Eq_nat.=) n 0 then e :: xs else x :: (update xs ((Instance_Num_NumMinus_nat.-) n 1) e)
end*)

(* ========================================================================== *)
(* Searching lists                                                            *)
(* ========================================================================== *)

(* ------------------------- *)
(* Membership test           *)
(* ------------------------- *)

(* The membership test, one of the basic list functions, is actually tricky for
   Lem, because it is tricky, which equality to use. From Lem`s point of
   perspective, we want to use the equality provided by the equality type - class.
   This allows for example to check whether a set is in a list of sets.

   However, in order to use the equality type class, elem essentially becomes
   existential quantification over lists. For types, which implement semantic
   equality (=) with syntactic equality, this is overly complicated. In
   our theorem prover backend, we would end up with overly complicated, harder
   to read definitions and some of the automation would be harder to apply.
   Moreover, nearly all the old Lem generated code would change and require
   (hopefully minor) adaptions of proofs.

   For now, we ignore this problem and just demand, that all instances of
   the equality type class do the right thing for the theorem prover backends.
*)

(*val elem : forall 'a. Eq 'a => 'a -> list 'a -> bool*)
(*val elemBy : forall 'a. ('a -> 'a -> bool) -> 'a -> list 'a -> bool*)

definition elemBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> bool "  where
     " elemBy eq e l = ( ((\<exists> x \<in> (set l).  (eq e) x)))"

(*let elem=  elemBy (=)*)

(* ------------------------- *)
(* Find                      *)
(* ------------------------- *)
(*val find : forall 'a. ('a -> bool) -> list 'a -> maybe 'a*) (* previously not of maybe type *)
(*let rec find P l=  match l with
  | []      -> Nothing
  | x :: xs -> if P x then Just x else find P xs
end*)

(* ----------------------------- *)
(* Lookup in an associative list *)
(* ----------------------------- *)
(*val lookup   : forall 'a 'b. Eq 'a              => 'a -> list ('a * 'b) -> maybe 'b*)
(*val lookupBy : forall 'a 'b. ('a -> 'a -> bool) -> 'a -> list ('a * 'b) -> maybe 'b*)

(* DPM: eta-expansion for Coq backend type-inference. *)
definition lookupBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow>('a*'b)list \<Rightarrow> 'b option "  where
     " lookupBy eq k m = ( map_option (\<lambda> x .  snd x) (List.find (\<lambda> (k', _) .  eq k k') m))"

(* ------------------------- *)
(* filter                    *)
(* ------------------------- *)
(*val filter : forall 'a. ('a -> bool) -> list 'a -> list 'a*)
(*let rec filter P l=  match l with
                       | [] -> []
                       | x :: xs -> if (P x) then x :: (filter P xs) else filter P xs
                     end*)

(* ------------------------- *)
(* partition                 *)
(* ------------------------- *)
(*val partition : forall 'a. ('a -> bool) -> list 'a -> list 'a * list 'a*)
(*let partition P l=  (filter P l, filter (fun x -> not (P x)) l)*)

(*val reversePartition : forall 'a. ('a -> bool) -> list 'a -> list 'a * list 'a*)
definition reversePartition  :: "('a \<Rightarrow> bool)\<Rightarrow> 'a list \<Rightarrow> 'a list*'a list "  where
     " reversePartition P l = ( List.partition P (List.rev l))"

(* ------------------------- *)
(* delete first element      *)
(* with certain property     *)
(* ------------------------- *)

(*val deleteFirst : forall 'a. ('a -> bool) -> list 'a -> maybe (list 'a)*)
(*let rec deleteFirst P l=  match l with
                            | [] -> Nothing
                            | x :: xs -> if (P x) then Just xs else Maybe.map (fun xs' -> x :: xs') (deleteFirst P xs)
                          end*)

(*val delete : forall 'a. Eq 'a => 'a -> list 'a -> list 'a*)
(*val deleteBy : forall 'a. ('a -> 'a -> bool) -> 'a -> list 'a -> list 'a*)

definition deleteBy  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list "  where
     " deleteBy eq x l = ( case_option l id (delete_first (eq x) l))"

(* ========================================================================== *)
(* Zipping and unzipping lists                                                *)
(* ========================================================================== *)

(* ------------------------- *)
(* zip                       *)
(* ------------------------- *)

(* zip takes two lists and returns a list of corresponding pairs. If one input list is short, excess elements of the longer list are discarded. *)
(*val zip : forall 'a 'b. list 'a -> list 'b -> list ('a * 'b)*) (* before combine *)
(*let rec zip l1 l2=  match (l1, l2) with
  | (x :: xs, y :: ys) -> (x, y) :: zip xs ys
  | _ -> []
end*)

(* ------------------------- *)
(* unzip                     *)
(* ------------------------- *)

(*val unzip: forall 'a 'b. list ('a * 'b) -> (list 'a * list 'b)*)
(*let rec unzip l=  match l with
  | [] -> ([], [])
  | (x, y) :: xys -> let (xs, ys) = unzip xys in (x :: xs, y :: ys)
end*)

(* ------------------------- *)
(* distinct elements         *)
(* ------------------------- *)

(*val allDistinct : forall 'a. Eq 'a => list 'a -> bool*)
fun  allDistinct  :: " 'a list \<Rightarrow> bool "  where
     " allDistinct ([]) = ( True )"
|" allDistinct (x # l') = ( \<not> (Set.member x (set l')) \<and> allDistinct l' )"
declare allDistinct.simps [simp del]

(* some more useful functions *)
(*val mapMaybe : forall 'a 'b. ('a -> maybe 'b) -> list 'a -> list 'b*)
function (sequential,domintros)  mapMaybe  :: "('a \<Rightarrow> 'b option)\<Rightarrow> 'a list \<Rightarrow> 'b list "  where
     " mapMaybe f ([]) = ( [])"
|" mapMaybe f (x # xs) = (
      (case  f x of
        None => mapMaybe f xs
      | Some y => y # (mapMaybe f xs)
      ))"
by pat_completeness auto

(*val mapi : forall 'a 'b. (nat -> 'a -> 'b) -> list 'a -> list 'b*)
function (sequential,domintros)  mapiAux  :: "(nat \<Rightarrow> 'b \<Rightarrow> 'a)\<Rightarrow> nat \<Rightarrow> 'b list \<Rightarrow> 'a list "  where
     " mapiAux f (n :: nat) ([]) = ( [])"
|" mapiAux f (n :: nat) (x # xs) = ( (f n x) # mapiAux f (n +( 1 :: nat)) xs )"
by pat_completeness auto

definition mapi  :: "(nat \<Rightarrow> 'a \<Rightarrow> 'b)\<Rightarrow> 'a list \<Rightarrow> 'b list "  where
     " mapi f l = ( mapiAux f(( 0 :: nat)) l )"

(*val deletes: forall 'a. Eq 'a => list 'a -> list 'a -> list 'a*)
definition deletes  :: " 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list "  where
     " deletes xs ys = (
  List.foldl ((\<lambda> x y. remove1 y x)) xs ys )"

(* ========================================================================== *)
(* Comments (not clean yet, please ignore the rest of the file)               *)
(* ========================================================================== *)

(* ----------------------- *)
(* skipped from Haskell Lib*)
(* -----------------------

intersperse :: a -> [a] -> [a]
intercalate :: [a] -> [[a]] -> [a]
transpose :: [[a]] -> [[a]]
subsequences :: [a] -> [[a]]
permutations :: [a] -> [[a]]
foldl` :: (a -> b -> a) -> a -> [b] -> aSource
foldl1` :: (a -> a -> a) -> [a] -> aSource

and
or
sum
product
maximum
minimum
scanl
scanr
scanl1
scanr1
Accumulating maps

mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])Source
mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])Source

iterate :: (a -> a) -> a -> [a]
repeat :: a -> [a]
cycle :: [a] -> [a]
unfoldr

takeWhile :: (a -> Bool) -> [a] -> [a]Source
dropWhile :: (a -> Bool) -> [a] -> [a]Source
dropWhileEnd :: (a -> Bool) -> [a] -> [a]Source
span :: (a -> Bool) -> [a] -> ([a], [a])Source
break :: (a -> Bool) -> [a] -> ([a], [a])Source
break p is equivalent to span (not . p).
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]Source
group :: Eq a => [a] -> [[a]]Source
inits :: [a] -> [[a]]Source
tails :: [a] -> [[a]]Source

isPrefixOf :: Eq a => [a] -> [a] -> BoolSource
isSuffixOf :: Eq a => [a] -> [a] -> BoolSource
isInfixOf :: Eq a => [a] -> [a] -> BoolSource

notElem :: Eq a => a -> [a] -> BoolSource

zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]Source
zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]Source
zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]Source
zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]Source
zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]Source

zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]Source
zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]Source
zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]Source
zipWith5 :: (a -> b -> c -> d -> e -> f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]Source
zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]Source
zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]Source

unzip3 :: [(a, b, c)] -> ([a], [b], [c])Source
unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])Source
unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])Source
unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])Source
unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])Source

lines :: String -> [String]Source
words :: String -> [String]Source
unlines :: [String] -> StringSource
unwords :: [String] -> StringSource
nub :: Eq a => [a] -> [a]Source
delete :: Eq a => a -> [a] -> [a]Source

() :: Eq a => [a] -> [a] -> [a]Source
union :: Eq a => [a] -> [a] -> [a]Source
intersect :: Eq a => [a] -> [a] -> [a]Source
sort :: Ord a => [a] -> [a]Source
insert :: Ord a => a -> [a] -> [a]Source

nubBy :: (a -> a -> Bool) -> [a] -> [a]Source
deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]Source
deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source
unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source
intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]Source
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]Source
sortBy :: (a -> a -> Ordering) -> [a] -> [a]Source
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]Source
maximumBy :: (a -> a -> Ordering) -> [a] -> aSource
minimumBy :: (a -> a -> Ordering) -> [a] -> aSource
genericLength :: Num i => [b] -> iSource
genericTake :: Integral i => i -> [a] -> [a]Source
genericDrop :: Integral i => i -> [a] -> [a]Source
genericSplitAt :: Integral i => i -> [b] -> ([b], [b])Source
genericIndex :: Integral a => [b] -> a -> bSource
genericReplicate :: Integral i => i -> a -> [a]Source

*)

(* ----------------------- *)
(* skipped from Lem Lib    *)
(* -----------------------

val for_all2 : forall 'a 'b. ('a -> 'b -> bool) -> list 'a -> list 'b -> bool
val exists2 : forall 'a 'b. ('a -> 'b -> bool) -> list 'a -> list 'b -> bool
val map2 : forall 'a 'b 'c. ('a -> 'b -> 'c) -> list 'a -> list 'b -> list 'c
val rev_map2 : forall 'a 'b 'c. ('a -> 'b -> 'c) -> list 'a -> list 'b -> list 'c
val fold_left2 : forall 'a 'b 'c. ('a -> 'b -> 'c -> 'a) -> 'a -> list 'b -> list 'c -> 'a
val fold_right2 : forall 'a 'b 'c. ('a -> 'b -> 'c -> 'c) -> list 'a -> list 'b -> 'c -> 'c

(* now maybe result and called lookup *)
val assoc : forall 'a 'b. 'a -> list ('a * 'b) -> 'b
let inline {ocaml} assoc = Ocaml.List.assoc

val mem_assoc : forall 'a 'b. 'a -> list ('a * 'b) -> bool
val remove_assoc : forall 'a 'b. 'a -> list ('a * 'b) -> list ('a * 'b)

val stable_sort : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a
val fast_sort : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a

val merge : forall 'a. ('a -> 'a -> num) -> list 'a -> list 'a -> list 'a
val intersect : forall 'a. list 'a -> list 'a -> list 'a

*)

(*val     catMaybes : forall 'a. list (maybe 'a) -> list 'a*)
function (sequential,domintros)  catMaybes  :: "('a option)list \<Rightarrow> 'a list "  where
     " catMaybes ([]) = (
        [])"
|" catMaybes (None # xs') = (
        catMaybes xs' )"
|" catMaybes (Some x # xs') = (
        x # catMaybes xs' )"
by pat_completeness auto

end


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
(*>*)