(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2007  Slawomir Kolodynski

    This program is free software Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES LOSS OF USE, DATA, OR PROFITS
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Finite sequences\<close>

theory FiniteSeq_ZF imports Nat_ZF_IML func1

begin

text\<open>This theory treats finite sequences (i.e. maps $n\rightarrow X$, where
  $n=\{0,1,..,n-1\}$ is a natural number) as lists. It defines and proves
  the properties of basic operations on lists: concatenation, appending
  and element etc.\<close>

subsection\<open>Lists as finite sequences\<close>

text\<open>A natural way of representing (finite) lists in set theory is through
  (finite) sequences.
  In such view a list of elements of a set $X$ is a
  function that maps the set $\{0,1,..n-1\}$ into $X$. Since natural numbers
  in set theory are defined so that $n =\{0,1,..n-1\}$, a list of length $n$
  can be understood as an element of the function space $n\rightarrow X$.
\<close>

text\<open>We define the set of lists with values in set $X$ as \<open>Lists(X)\<close>.\<close>

definition
  "Lists(X) \<equiv> \<Union>n\<in>nat.(n\<rightarrow>X)"

text\<open>The set of nonempty $X$-value listst will be called \<open>NELists(X)\<close>.\<close>

definition
  "NELists(X) \<equiv> \<Union>n\<in>nat.(succ(n)\<rightarrow>X)"

text\<open>We first define the shift that moves the second sequence
  to the domain $\{n,..,n+k-1\}$, where $n,k$ are the lengths of the first
  and the second sequence, resp.
  To understand the notation in the definitions below recall that in Isabelle/ZF
  \<open>pred(n)\<close> is the previous natural number and
   denotes the difference between natural numbers $n$ and $k$.\<close>

definition
  "ShiftedSeq(b,n) \<equiv> {\<langle>j, b`(j #- n)\<rangle>. j \<in> NatInterval(n,domain(b))}"

text\<open>We define concatenation of two sequences as the union of the first sequence
  with the shifted second sequence. The result of concatenating lists
  $a$ and $b$ is called \<open>Concat(a,b)\<close>.\<close>

definition
  "Concat(a,b) \<equiv> a \<union> ShiftedSeq(b,domain(a))"

text\<open>For a finite sequence we define the sequence of all elements
  except the first one. This corresponds to the "tail" function in Haskell.
  We call it \<open>Tail\<close> here as well.\<close>

definition
  "Tail(a) \<equiv> {\<langle>k, a`(succ(k))\<rangle>. k \<in> pred(domain(a))}"

text\<open>A dual notion to \<open>Tail\<close> is the list
  of all elements of a list except the last one. Borrowing
  the terminology from Haskell again, we will call this \<open>Init\<close>.\<close>

definition
  "Init(a) \<equiv> restrict(a,pred(domain(a)))"

text\<open>Another obvious operation we can talk about is appending an element
  at the end of a sequence. This is called \<open>Append\<close>.\<close>

definition
  "Append(a,x) \<equiv> a \<union> {\<langle>domain(a),x\<rangle>}"

text\<open>If lists are modeled as finite sequences (i.e. functions on natural
  intervals $\{0,1,..,n-1\} = n$) it is easy to get the first element
  of a list as the value of the sequence at $0$. The last element is the
  value at $n-1$. To hide this behind a familiar name we define the \<open>Last\<close>
  element of a list.\<close>

definition
  "Last(a) \<equiv> a`(pred(domain(a)))"

text\<open>Shifted sequence is a function on a the interval of natural numbers.\<close>

lemma shifted_seq_props:
  assumes A1: "n \<in> nat"  "k \<in> nat" and A2: "b:k\<rightarrow>X"
  shows
  "ShiftedSeq(b,n): NatInterval(n,k) \<rightarrow> X"
  "\<forall>i \<in> NatInterval(n,k). ShiftedSeq(b,n)`(i) = b`(i #- n)"
  "\<forall>j\<in>k. ShiftedSeq(b,n)`(n #+ j) = b`(j)"
proof -
  let ?I = "NatInterval(n,domain(b))"
  from A2 have Fact: "?I = NatInterval(n,k)" using func1_1_L1 by simp
  with A1 A2 have "\<forall>j\<in> ?I. b`(j #- n) \<in> X"
    using inter_diff_in_len apply_funtype by simp
  then have
    "{\<langle>j, b`(j #- n)\<rangle>. j \<in> ?I} : ?I \<rightarrow> X" by (rule ZF_fun_from_total)
  with Fact show thesis_1: "ShiftedSeq(b,n): NatInterval(n,k) \<rightarrow> X"
    using ShiftedSeq_def by simp
  { fix i
    from Fact thesis_1 have  "ShiftedSeq(b,n): ?I \<rightarrow> X" by simp
    moreover
    assume "i \<in> NatInterval(n,k)"
    with Fact have "i \<in> ?I" by simp
    moreover from Fact have
      "ShiftedSeq(b,n) = {\<langle>i, b`(i #- n)\<rangle>. i \<in> ?I}"
      using ShiftedSeq_def by simp
    ultimately have "ShiftedSeq(b,n)`(i) =  b`(i #- n)"
      by (rule ZF_fun_from_tot_val)
  } then show thesis1:
      "\<forall>i \<in> NatInterval(n,k). ShiftedSeq(b,n)`(i) = b`(i #- n)"
    by simp
  { fix j
    let ?i = "n #+ j"
    assume A3: "j\<in>k"
    with A1 have "j \<in> nat" using elem_nat_is_nat by blast
    then have "?i #- n = j" using diff_add_inverse by simp
    with A3 thesis1 have "ShiftedSeq(b,n)`(?i) = b`(j)"
      using NatInterval_def by auto
  } then show "\<forall>j\<in>k. ShiftedSeq(b,n)`(n #+ j) = b`(j)"
    by simp
qed

text\<open>Basis properties of the contatenation of two finite sequences.\<close>

theorem concat_props:
  assumes A1: "n \<in> nat"  "k \<in> nat" and A2: "a:n\<rightarrow>X"   "b:k\<rightarrow>X"
  shows
  "Concat(a,b): n #+ k \<rightarrow> X"
  "\<forall>i\<in>n. Concat(a,b)`(i) = a`(i)"
  "\<forall>i \<in> NatInterval(n,k). Concat(a,b)`(i) =  b`(i #- n)"
  "\<forall>j \<in> k. Concat(a,b)`(n #+ j) = b`(j)"
proof -
  from A1 A2 have
    "a:n\<rightarrow>X"  and I: "ShiftedSeq(b,n): NatInterval(n,k) \<rightarrow> X"
    and "n \<inter> NatInterval(n,k) = 0"
    using shifted_seq_props length_start_decomp by auto
  then have
    "a \<union> ShiftedSeq(b,n): n \<union> NatInterval(n,k) \<rightarrow> X \<union> X"
    by (rule fun_disjoint_Un)
  with A1 A2 show "Concat(a,b): n #+ k \<rightarrow> X"
    using func1_1_L1 Concat_def length_start_decomp by auto
  { fix i assume "i \<in> n"
    with A1 I have "i \<notin> domain(ShiftedSeq(b,n))"
      using length_start_decomp func1_1_L1 by auto
    with A2 have "Concat(a,b)`(i) = a`(i)"
      using func1_1_L1 fun_disjoint_apply1 Concat_def by simp
  } thus "\<forall>i\<in>n. Concat(a,b)`(i) = a`(i)" by simp
  { fix i assume A3: "i \<in> NatInterval(n,k)"
    with A1 A2 have "i \<notin> domain(a)"
      using length_start_decomp func1_1_L1 by auto
    with A1 A2 A3 have "Concat(a,b)`(i) =  b`(i #- n)"
      using func1_1_L1 fun_disjoint_apply2 Concat_def shifted_seq_props
      by simp
  } thus II: "\<forall>i \<in> NatInterval(n,k). Concat(a,b)`(i) =  b`(i #- n)"
    by simp
  { fix j
    let ?i = "n #+ j"
    assume A3: "j\<in>k"
    with A1 have "j \<in> nat" using elem_nat_is_nat by blast
    then have "?i #- n = j" using diff_add_inverse by simp
     with A3 II have "Concat(a,b)`(?i) = b`(j)"
      using NatInterval_def by auto
  } thus "\<forall>j \<in> k. Concat(a,b)`(n #+ j) = b`(j)"
    by simp
qed

text\<open>Properties of concatenating three lists.\<close>

lemma concat_concat_list:
  assumes A1: "n \<in> nat"  "k \<in> nat"  "m \<in> nat" and
  A2: "a:n\<rightarrow>X"   "b:k\<rightarrow>X"  "c:m\<rightarrow>X" and
  A3: "d = Concat(Concat(a,b),c)"
  shows
  "d : n #+k #+ m \<rightarrow> X"
  "\<forall>j \<in> n. d`(j) = a`(j)"
  "\<forall>j \<in> k. d`(n #+ j) = b`(j)"
  "\<forall>j \<in> m. d`(n #+ k #+ j) = c`(j)"
proof -
  from A1 A2 have I:
    "n #+ k \<in> nat"   "m \<in> nat"
    "Concat(a,b): n #+ k \<rightarrow> X"   "c:m\<rightarrow>X"
    using concat_props by auto
  with A3 show "d: n #+k #+ m \<rightarrow> X"
    using concat_props by simp
  from I have II: "\<forall>i \<in> n #+ k.
    Concat(Concat(a,b),c)`(i) = Concat(a,b)`(i)"
    by (rule concat_props)
  { fix j assume A4: "j \<in> n"
    moreover from A1 have "n \<subseteq> n #+ k" using add_nat_le by simp
    ultimately have "j \<in> n #+ k" by auto
    with A3 II have "d`(j) =  Concat(a,b)`(j)" by simp
    with A1 A2 A4 have "d`(j) = a`(j)"
      using concat_props by simp
  } thus "\<forall>j \<in> n. d`(j) = a`(j)" by simp
  { fix j assume A5: "j \<in> k"
    with A1 A3 II have "d`(n #+ j) = Concat(a,b)`(n #+ j)"
      using add_lt_mono by simp
    also from A1 A2 A5 have "\<dots> = b`(j)"
      using concat_props by simp
    finally have "d`(n #+ j) = b`(j)" by simp
  } thus "\<forall>j \<in> k. d`(n #+ j) = b`(j)" by simp
  from I have "\<forall>j \<in> m. Concat(Concat(a,b),c)`(n #+ k #+ j) = c`(j)"
    by (rule concat_props)
  with A3 show "\<forall>j \<in> m. d`(n #+ k #+ j) = c`(j)"
    by simp
qed

text\<open>Properties of concatenating a list with a concatenation
  of two other lists.\<close>

lemma concat_list_concat:
  assumes A1: "n \<in> nat"  "k \<in> nat"  "m \<in> nat" and
  A2: "a:n\<rightarrow>X"   "b:k\<rightarrow>X"  "c:m\<rightarrow>X" and
  A3: "e = Concat(a, Concat(b,c))"
  shows
  "e : n #+k #+ m \<rightarrow> X"
  "\<forall>j \<in> n. e`(j) = a`(j)"
  "\<forall>j \<in> k. e`(n #+ j) = b`(j)"
  "\<forall>j \<in> m. e`(n #+ k #+ j) = c`(j)"
proof -
  from A1 A2 have I:
    "n \<in> nat"  "k #+ m \<in> nat"
    "a:n\<rightarrow>X"  "Concat(b,c): k #+ m \<rightarrow> X"
    using concat_props by auto
  with A3 show  "e : n #+k #+ m \<rightarrow> X"
    using concat_props add_assoc by simp
  from I have "\<forall>j \<in> n. Concat(a, Concat(b,c))`(j) = a`(j)"
    by (rule concat_props)
  with A3 show "\<forall>j \<in> n. e`(j) = a`(j)" by simp
  from I have II:
    "\<forall>j \<in> k #+ m. Concat(a, Concat(b,c))`(n #+ j) = Concat(b,c)`(j)"
    by (rule concat_props)
  { fix j assume A4: "j \<in> k"
    moreover from A1 have "k \<subseteq> k #+ m" using add_nat_le by simp
    ultimately have "j \<in> k #+ m" by auto
    with A3 II have "e`(n #+ j) =  Concat(b,c)`(j)" by simp
    also from A1 A2 A4 have "\<dots> = b`(j)"
      using concat_props by simp
    finally have "e`(n #+ j) = b`(j)" by simp
  } thus "\<forall>j \<in> k. e`(n #+ j) = b`(j)" by simp
  { fix j assume A5: "j \<in> m"
    with A1 II A3 have "e`(n #+ k #+ j) = Concat(b,c)`(k #+ j)"
      using add_lt_mono add_assoc by simp
    also from A1 A2 A5 have "\<dots> = c`(j)"
      using concat_props by simp
    finally have "e`(n #+ k #+ j) = c`(j)" by simp
  } then show "\<forall>j \<in> m. e`(n #+ k #+ j) = c`(j)"
    by simp
qed

text\<open>Concatenation is associative.\<close>

theorem concat_assoc:
  assumes A1: "n \<in> nat"  "k \<in> nat"  "m \<in> nat" and
  A2: "a:n\<rightarrow>X"   "b:k\<rightarrow>X"   "c:m\<rightarrow>X"
  shows "Concat(Concat(a,b),c) =  Concat(a, Concat(b,c))"
proof -
  let ?d = "Concat(Concat(a,b),c)"
  let ?e = "Concat(a, Concat(b,c))"
  from A1 A2 have
    "?d : n #+k #+ m \<rightarrow> X" and "?e : n #+k #+ m \<rightarrow> X"
    using concat_concat_list concat_list_concat by auto
  moreover have "\<forall>i \<in>  n #+k #+ m. ?d`(i) = ?e`(i)"
  proof -
    { fix i assume "i \<in> n #+k #+ m"
      moreover from A1 have
	"n #+k #+ m = n \<union> NatInterval(n,k) \<union> NatInterval(n #+ k,m)"
	using adjacent_intervals3 by simp
      ultimately have
	"i \<in> n \<or> i \<in> NatInterval(n,k) \<or> i \<in> NatInterval(n #+ k,m)"
	by simp
      moreover
      { assume "i \<in> n"
	with A1 A2 have "?d`(i) = ?e`(i)"
	using concat_concat_list concat_list_concat by simp }
      moreover
      { assume "i \<in> NatInterval(n,k)"
	then obtain j where "j\<in>k" and "i = n #+ j"
	  using NatInterval_def by auto
	with A1 A2 have "?d`(i) = ?e`(i)"
	  using concat_concat_list concat_list_concat by simp }
      moreover
      { assume "i \<in> NatInterval(n #+ k,m)"
	then obtain j where "j \<in> m" and "i = n #+ k #+ j"
	  using NatInterval_def by auto
	with A1 A2 have "?d`(i) = ?e`(i)"
	  using concat_concat_list concat_list_concat by simp }
      ultimately have "?d`(i) = ?e`(i)" by auto
    } thus ?thesis by simp
  qed
  ultimately show "?d = ?e" by (rule func_eq)
qed

text\<open>Properties of \<open>Tail\<close>.\<close>

theorem tail_props:
  assumes A1: "n \<in> nat" and A2: "a: succ(n) \<rightarrow> X"
  shows
  "Tail(a) : n \<rightarrow> X"
  "\<forall>k \<in> n. Tail(a)`(k) = a`(succ(k))"
proof -
  from A1 A2 have "\<forall>k \<in> n. a`(succ(k)) \<in> X"
    using succ_ineq apply_funtype by simp
  then have "{\<langle>k, a`(succ(k))\<rangle>. k \<in> n} : n \<rightarrow> X"
    by (rule ZF_fun_from_total)
  with A2 show I: "Tail(a) : n \<rightarrow> X"
    using func1_1_L1 pred_succ_eq Tail_def by simp
  moreover from A2 have "Tail(a) = {\<langle>k, a`(succ(k))\<rangle>. k \<in> n}"
    using func1_1_L1 pred_succ_eq Tail_def by simp
  ultimately show "\<forall>k \<in> n. Tail(a)`(k) = a`(succ(k))"
    by (rule ZF_fun_from_tot_val0)
qed

text\<open>Properties of \<open>Append\<close>. It is a bit surprising that
  the we don't need to assume that $n$ is a natural number.\<close>

theorem append_props:
  assumes A1: "a: n \<rightarrow> X" and A2: "x\<in>X" and A3: "b = Append(a,x)"
  shows
  "b : succ(n) \<rightarrow> X"
  "\<forall>k\<in>n. b`(k) = a`(k)"
  "b`(n) = x"
proof -
  note A1
  moreover have I: "n \<notin> n" using mem_not_refl by simp
  moreover from A1 A3 have II: "b = a \<union> {\<langle>n,x\<rangle>}"
    using func1_1_L1 Append_def by simp
  ultimately have "b : n \<union> {n} \<rightarrow> X \<union> {x}"
    by (rule func1_1_L11D)
  with A2 show "b : succ(n) \<rightarrow> X"
    using succ_explained set_elem_add by simp
  from A1 I II show "\<forall>k\<in>n. b`(k) = a`(k)" and "b`(n) = x"
    using func1_1_L11D by auto
qed

text\<open>A special case of \<open>append_props\<close>: appending to a nonempty
  list does not change the head (first element) of the list.\<close>

corollary head_of_append:
  assumes "n\<in> nat" and "a: succ(n) \<rightarrow> X" and "x\<in>X"
  shows "Append(a,x)`(0) = a`(0)"
  using assms append_props empty_in_every_succ by auto

(*text{*A bit technical special case of @{text "append_props"} that tells us
  what is the value of the appended list at the sucessor of some argument.*}

corollary append_val_succ:
  assumes "n \<in> nat" and "a: succ(n) \<rightarrow> X" and "x\<in>X" and "k \<in> n"
  shows "Append(a,x)`(succ(k)) = a`(succ(k))"
  using assms succ_ineq append_props by simp*)

text\<open>\<open>Tail\<close> commutes with \<open>Append\<close>.\<close>

theorem tail_append_commute:
  assumes A1: "n \<in> nat" and A2: "a: succ(n) \<rightarrow> X" and A3: "x\<in>X"
  shows "Append(Tail(a),x) = Tail(Append(a,x))"
proof -
  let ?b = "Append(Tail(a),x)"
  let ?c = "Tail(Append(a,x))"
  from A1 A2 have I: "Tail(a) : n \<rightarrow> X" using tail_props
    by simp
  from A1 A2 A3 have
    "succ(n) \<in> nat" and "Append(a,x) : succ(succ(n)) \<rightarrow> X"
    using append_props by auto
  then have II: "\<forall>k \<in> succ(n). ?c`(k) = Append(a,x)`(succ(k))"
    by (rule tail_props)
  from assms have
    "?b : succ(n) \<rightarrow> X" and "?c : succ(n) \<rightarrow> X"
    using tail_props append_props by auto
  moreover have "\<forall>k \<in> succ(n). ?b`(k) = ?c`(k)"
  proof -
    { fix k assume "k \<in> succ(n)"
      hence "k \<in> n \<or> k = n" by auto
      moreover
      { assume A4: "k \<in> n"
	with assms II have "?c`(k) = a`(succ(k))"
	  using succ_ineq append_props by simp
	moreover
	from A3 I have "\<forall>k\<in>n. ?b`(k) = Tail(a)`(k)"
	  using append_props by simp
	with A1 A2 A4 have "?b`(k) =  a`(succ(k))"
	  using tail_props by simp
	ultimately have "?b`(k) = ?c`(k)" by simp }
      moreover
      { assume A5: "k = n"
	with A2 A3 I II have "?b`(k) = ?c`(k)"
	  using append_props by auto }
      ultimately have "?b`(k) = ?c`(k)" by auto
    } thus ?thesis by simp
  qed
  ultimately show "?b = ?c" by (rule func_eq)
qed

text\<open>@{term NELists} are non-empty lists\<close>

lemma non_zero_List_func_is_NEList:
  shows "NELists(X) = {a\<in>Lists(X). a\<noteq>0}"
proof-
  { fix a assume as: "a\<in>{a\<in>Lists(X). a\<noteq>0}"
    from as obtain n where a: "n\<in>nat" "a:n\<rightarrow> X" unfolding Lists_def
      by auto
    { assume "n=0"
      with a(2) have "a=0" unfolding Pi_def by auto
      with as have False by auto
    }
    hence "n\<noteq>0" by auto
    with a(1) obtain k where "k\<in>nat" "n=succ(k)" using Nat_ZF_1_L3
      by auto
    with a(2) have "a \<in> NELists(X)" unfolding NELists_def by auto
  } moreover
  { fix a assume as: "a\<in>NELists(X)"
    then obtain k where k: "a:succ(k)\<rightarrow>X" "k\<in>nat"
      unfolding NELists_def by auto
    { assume "a=0"
      hence "domain(a) = 0" by auto
      with k(1) have "succ(k) = 0" using domain_of_fun by auto
      hence False by auto
    } moreover
    { from k(2) have "succ(k)\<in>nat" using nat_succI by auto
      with k(1) have "a\<in>Lists(X)" unfolding Lists_def by auto
    } ultimately
    have "a\<in>{a\<in>Lists(X). a\<noteq>0}" by auto
  }
  ultimately show ?thesis by auto
qed

text\<open>Properties of \<open>Init\<close>.\<close>

theorem init_props:
  assumes A1: "n \<in> nat" and A2: "a: succ(n) \<rightarrow> X"
  shows
  "Init(a) : n \<rightarrow> X"
  "\<forall>k\<in>n. Init(a)`(k) = a`(k)"
  "a = Append(Init(a), a`(n))"
proof -
  have "n \<subseteq> succ(n)" by auto
  with A2 have "restrict(a,n): n \<rightarrow> X"
    using restrict_type2 by simp
  moreover from A1 A2 have I: "restrict(a,n) = Init(a)"
    using func1_1_L1 pred_succ_eq Init_def by simp
  ultimately show thesis1: "Init(a) : n \<rightarrow> X" by simp
  { fix k assume "k\<in>n"
    then have "restrict(a,n)`(k) = a`(k)"
      using restrict by simp
    with I have "Init(a)`(k) = a`(k)" by simp
  } then show thesis2: "\<forall>k\<in>n. Init(a)`(k) = a`(k)" by simp
  let ?b = "Append(Init(a), a`(n))"
  from A2 thesis1 have II:
    "Init(a) : n \<rightarrow> X"   "a`(n) \<in> X"
    "?b = Append(Init(a), a`(n))"
    using apply_funtype by auto
  note A2
  moreover from II have "?b : succ(n) \<rightarrow> X"
    by (rule append_props)
  moreover have "\<forall>k \<in> succ(n). a`(k) = ?b`(k)"
  proof -
    { fix k assume A3: "k \<in> n"
      from II have "\<forall>j\<in>n. ?b`(j) = Init(a)`(j)"
	by (rule append_props)
      with thesis2 A3 have "a`(k) = ?b`(k)" by simp }
    moreover
    from II have "?b`(n) = a`(n)"
      by (rule append_props)
    hence " a`(n) = ?b`(n)" by simp
    ultimately show "\<forall>k \<in> succ(n). a`(k) = ?b`(k)"
      by simp
  qed
  ultimately show "a = ?b" by (rule func_eq)
qed

text\<open>The initial part of a non-empty list
  is a list, and the domain of the original list
  is the successor of its initial part.\<close>

theorem init_NElist:
  assumes "a \<in> NELists(X)"
  shows "Init(a) \<in> Lists(X)" and "succ(domain(Init(a))) = domain(a)"
proof -
  from assms obtain n where n: "n\<in>nat" "a:succ(n) \<rightarrow> X"
    unfolding NELists_def by auto
  then have tailF: "Init(a):n \<rightarrow> X" using init_props(1) by auto
  with n(1) show "Init(a) \<in> Lists(X)" unfolding Lists_def by auto
  from tailF have "domain(Init(a)) = n" using domain_of_fun by auto
  moreover from n(2) have "domain(a) = succ(n)" using domain_of_fun
    by auto
  ultimately show "succ(domain(Init(a))) = domain(a)" by auto
qed

text\<open>If we take init of the result of append, we get back the same list.\<close>

lemma init_append: assumes A1: "n \<in> nat" and A2: "a:n\<rightarrow>X" and A3: "x \<in> X"
  shows "Init(Append(a,x)) = a"
proof -
  from A2 A3 have "Append(a,x): succ(n)\<rightarrow>X" using append_props by simp
  with A1 have "Init(Append(a,x)):n\<rightarrow>X" and "\<forall>k\<in>n. Init(Append(a,x))`(k) = Append(a,x)`(k)"
    using init_props by auto
  with A2 A3 have "\<forall>k\<in>n. Init(Append(a,x))`(k) = a`(k)" using append_props by simp
  with \<open>Init(Append(a,x)):n\<rightarrow>X\<close> A2 show ?thesis by (rule func_eq)
qed

text\<open>A reformulation of definition of \<open>Init\<close>.\<close>

lemma init_def: assumes "n \<in> nat" and "a:succ(n)\<rightarrow>X"
  shows "Init(a) = restrict(a,n)"
  using assms func1_1_L1 Init_def by simp

text\<open>Another reformulation of the definition of \<open>Init\<close>, starting with the
  expression defining the list.\<close>

lemma init_def_alt: assumes "n\<in>nat" and "\<forall>k\<in>n #+ 1. q(k) \<in> X"
  shows "Init({\<langle>k,q(k)\<rangle>. k\<in>n #+ 1}) = {\<langle>k,q(k)\<rangle>. k\<in>n}"
proof -
  let ?a = "{\<langle>k,q(k)\<rangle>. k\<in>n #+ 1}"
  from assms(2) have "?a:n #+ 1\<rightarrow>X" by (rule ZF_fun_from_total)
  moreover from assms(1) have "n #+ 1 = succ(n)" using succ_add_one(1)
    by simp
  ultimately have "?a:succ(n)\<rightarrow>X" by simp
  with assms(1) have "Init(?a) = restrict(?a,n)" using init_def by simp
  moreover
  from assms(1) have "n \<subseteq> n #+ 1" by auto
  then have "restrict(?a,n) = {\<langle>k,q(k)\<rangle>. k\<in>n}"
    by (rule restrict_def_alt)
  ultimately show ?thesis by simp
qed

text\<open>A lemma about extending a finite sequence by one more value. This is
  just a more explicit version of \<open>append_props\<close>.\<close>

lemma finseq_extend:
  assumes  "a:n\<rightarrow>X"   "y\<in>X"   "b = a \<union> {\<langle>n,y\<rangle>}"
  shows
  "b: succ(n) \<rightarrow> X"
  "\<forall>k\<in>n. b`(k) = a`(k)"
  "b`(n) = y"
  using assms Append_def func1_1_L1 append_props by auto

text\<open>The next lemma is a bit displaced as it is mainly
  about finite sets. It is proven here because it uses
  the notion of \<open>Append\<close>.
  Suppose we have a list of element of $A$ is a bijection.
  Then for every element that does not belong to $A$
  we can we can construct
  a bijection for the set $A \cup \{ x\}$ by appending $x$.
  This is just a specialised version of lemma \<open>bij_extend_point\<close>
  from \<open>func1.thy\<close>.
\<close>

lemma bij_append_point:
  assumes A1: "n \<in> nat" and A2: "b \<in> bij(n,X)" and A3: "x \<notin> X"
  shows "Append(b,x) \<in> bij(succ(n), X \<union> {x})"
proof -
  from A2 A3 have "b \<union> {\<langle>n,x\<rangle>} \<in> bij(n \<union> {n},X \<union> {x})"
    using mem_not_refl bij_extend_point by simp
  moreover have "Append(b,x) = b \<union> {\<langle>n,x\<rangle>}"
  proof -
    from A2 have "b:n\<rightarrow>X"
      using bij_def surj_def by simp
    then have "b : n \<rightarrow> X \<union> {x}" using func1_1_L1B
      by blast
    then show "Append(b,x) = b \<union> {\<langle>n,x\<rangle>}"
      using Append_def func1_1_L1 by simp
  qed
  ultimately show ?thesis using succ_explained by auto
qed

text\<open>The next lemma rephrases the definition of \<open>Last\<close>.
  Recall that in ZF we have $\{0,1,2,..,n\} = n+1=$\<open>succ\<close>$(n)$.\<close>

lemma last_seq_elem: assumes "a: succ(n) \<rightarrow> X" shows "Last(a) = a`(n)"
  using assms func1_1_L1 pred_succ_eq Last_def by simp

text\<open>The last element of a non-empty list valued in $X$ is in $X$.\<close>

lemma last_type: assumes "a \<in> NELists(X)" shows "Last(a) \<in> X"
  using assms last_seq_elem apply_funtype unfolding NELists_def
  by auto

text\<open>If two finite sequences are the same when restricted to domain one
  shorter than the original and have the same value on the last element,
  then they are equal.\<close>

lemma finseq_restr_eq: assumes A1: "n \<in> nat" and
  A2: "a: succ(n) \<rightarrow> X"  "b: succ(n) \<rightarrow> X" and
  A3: "restrict(a,n) = restrict(b,n)" and
  A4: "a`(n) = b`(n)"
  shows "a = b"
proof -
  { fix k assume "k \<in> succ(n)"
    then have "k \<in> n \<or> k = n" by auto
    moreover
    { assume "k \<in> n"
      then have
	"restrict(a,n)`(k) = a`(k)" and "restrict(b,n)`(k) = b`(k)"
	using restrict by auto
      with A3 have "a`(k) = b`(k)" by simp }
    moreover
    { assume "k = n"
      with A4 have "a`(k) = b`(k)" by simp }
    ultimately have "a`(k) = b`(k)" by auto
  } then have "\<forall> k \<in> succ(n). a`(k) = b`(k)" by simp
  with A2 show "a = b" by (rule func_eq)
qed

text\<open>Concatenating a list of length $1$ is the same as appending its
  first (and only) element. Recall that in ZF set theory
  $1 = \{ 0 \} $.\<close>

lemma append_1elem: assumes A1: "n \<in> nat" and
  A2: "a: n \<rightarrow> X"  and A3: "b : 1 \<rightarrow> X"
  shows "Concat(a,b) = Append(a,b`(0))"
proof -
  let ?C = "Concat(a,b)"
  let ?A = "Append(a,b`(0))"
  from A1 A2 A3 have I:
    "n \<in> nat"  "1 \<in> nat"
    "a:n\<rightarrow>X"   "b:1\<rightarrow>X" by auto
  have "?C : succ(n) \<rightarrow> X"
  proof -
    from I have "?C : n #+ 1 \<rightarrow> X"
      by (rule concat_props)
    with A1 show "?C : succ(n) \<rightarrow> X" by simp
  qed
  moreover from A2 A3 have "?A : succ(n) \<rightarrow> X"
    using apply_funtype append_props by simp
  moreover have "\<forall>k \<in> succ(n). ?C`(k) = ?A`(k)"
  proof
    fix k assume "k \<in> succ(n)"
    moreover
    { assume "k \<in> n"
      moreover from I have "\<forall>i \<in> n. ?C`(i) = a`(i)"
	by (rule concat_props)
      moreover from A2 A3 have "\<forall>i\<in>n. ?A`(i) = a`(i)"
	using apply_funtype append_props by simp
      ultimately have "?C`(k) =  ?A`(k)" by simp }
    moreover have "?C`(n) = ?A`(n)"
    proof -
      from I have "\<forall>j \<in> 1. ?C`(n #+ j) = b`(j)"
	by (rule concat_props)
      with A1 A2 A3 show "?C`(n) = ?A`(n)"
	using apply_funtype append_props by simp
    qed
    ultimately show "?C`(k) = ?A`(k)" by auto
  qed
  ultimately show "?C = ?A" by (rule func_eq)
qed

text\<open>If $x\in X$ then the singleton set with the pair $\langle 0,x\rangle$
  as the only element is a list of length 1 and hence a nonempty list. \<close>

lemma list_len1_singleton: assumes "x\<in>X"
  shows "{\<langle>0,x\<rangle>} : 1 \<rightarrow> X" and "{\<langle>0,x\<rangle>} \<in> NELists(X)"
proof -
  from assms have "{\<langle>0,x\<rangle>} : {0} \<rightarrow> X" using pair_func_singleton
    by simp
  moreover have "{0} = 1" by auto
  ultimately show "{\<langle>0,x\<rangle>} : 1 \<rightarrow> X" and "{\<langle>0,x\<rangle>} \<in> NELists(X)"
    unfolding NELists_def by auto
qed

text\<open>A singleton list is in fact a singleton set with a pair as the only element.\<close>

lemma list_singleton_pair: assumes A1: "x:1\<rightarrow>X" shows "x = {\<langle>0,x`(0)\<rangle>}"
proof -
  from A1 have "x = {\<langle>t,x`(t)\<rangle>. t\<in>1}" by (rule fun_is_set_of_pairs)
  hence "x = {\<langle>t,x`(t)\<rangle>. t\<in>{0} }" by simp
  thus ?thesis by simp
qed

text\<open>When we append an element to the empty list we get
  a list with length $1$.\<close>

lemma empty_append1: assumes A1: "x\<in>X"
  shows "Append(0,x): 1 \<rightarrow> X" and "Append(0,x)`(0) = x"
proof -
  let ?a = "Append(0,x)"
  have "?a = {\<langle>0,x\<rangle>}" using Append_def by auto
  with A1 show "?a : 1 \<rightarrow> X" and "?a`(0) = x"
    using list_len1_singleton pair_func_singleton
    by auto
qed

(*text{*Tail of a list of length 1 is a list of length 0.*}

lemma list_len1_tail: assumes "a:1\<rightarrow>X"
  shows "Tail(a) : 0 \<rightarrow> X"
  using assms tail_props by blast *)

text\<open>Appending an element is the same as concatenating
  with certain pair.\<close>

lemma append_concat_pair:
  assumes "n \<in> nat" and "a: n \<rightarrow> X" and "x\<in>X"
  shows "Append(a,x) = Concat(a,{\<langle>0,x\<rangle>})"
  using assms list_len1_singleton append_1elem pair_val
  by simp

text\<open>An associativity property involving concatenation
  and appending. For proof we just convert appending to
  concatenation and use \<open>concat_assoc\<close>.\<close>

lemma concat_append_assoc: assumes A1: "n \<in> nat"  "k \<in> nat" and
  A2: "a:n\<rightarrow>X"   "b:k\<rightarrow>X" and A3: "x \<in> X"
  shows "Append(Concat(a,b),x) = Concat(a, Append(b,x))"
proof -
  from A1 A2 A3 have
    "n #+ k \<in> nat"   "Concat(a,b) : n #+ k \<rightarrow> X"   "x \<in> X"
    using concat_props by auto
  then have
    "Append(Concat(a,b),x) =  Concat(Concat(a,b),{\<langle>0,x\<rangle>})"
    by (rule append_concat_pair)
  moreover
  from A1 A2 A3 have
    "n \<in> nat"  "k \<in> nat"  "1 \<in> nat"
     "a:n\<rightarrow>X"   "b:k\<rightarrow>X"  "{\<langle>0,x\<rangle>} :  1 \<rightarrow> X"
    using list_len1_singleton by auto
  then have
    "Concat(Concat(a,b),{\<langle>0,x\<rangle>}) = Concat(a, Concat(b,{\<langle>0,x\<rangle>}))"
    by (rule concat_assoc)
  moreover from A1 A2 A3 have "Concat(b,{\<langle>0,x\<rangle>}) =  Append(b,x)"
    using list_len1_singleton append_1elem pair_val by simp
  ultimately show "Append(Concat(a,b),x) = Concat(a, Append(b,x))"
    by simp
qed

text\<open>An identity involving concatenating with init
  and appending the last element.\<close>

lemma concat_init_last_elem:
  assumes "n \<in> nat"  "k \<in> nat" and
  "a: n \<rightarrow> X"  and "b : succ(k) \<rightarrow> X"
  shows "Append(Concat(a,Init(b)),b`(k)) = Concat(a,b)"
  using assms init_props apply_funtype concat_append_assoc
  by simp

text\<open>A lemma about creating lists by composition and how
  \<open>Append\<close> behaves in such case.\<close>

lemma list_compose_append:
  assumes A1: "n \<in> nat" and A2: "a : n \<rightarrow> X" and
  A3: "x \<in> X" and A4: "c : X \<rightarrow> Y"
  shows
  "c O Append(a,x) : succ(n) \<rightarrow> Y"
  "c O Append(a,x) = Append(c O a, c`(x))"
proof -
  let ?b = "Append(a,x)"
  let ?d = "Append(c O a, c`(x))"
  from A2 A4 have "c O a : n \<rightarrow> Y"
    using comp_fun by simp
  from A2 A3 have "?b : succ(n) \<rightarrow> X"
    using append_props by simp
  with A4 show "c O ?b : succ(n) \<rightarrow> Y"
    using comp_fun by simp
  moreover from A3 A4 \<open>c O a : n \<rightarrow> Y\<close> have
    "?d: succ(n) \<rightarrow> Y"
    using apply_funtype append_props by simp
  moreover have "\<forall>k \<in> succ(n). (c O ?b) `(k) = ?d`(k)"
  proof -
    { fix k assume "k \<in> succ(n)"
      with \<open>?b : succ(n) \<rightarrow> X\<close> have
	"(c O ?b) `(k) = c`(?b`(k))"
	using comp_fun_apply by simp
      with A2 A3 A4 \<open>c O a : n \<rightarrow> Y\<close> \<open>c O a : n \<rightarrow> Y\<close> \<open>k \<in> succ(n)\<close>
      have "(c O ?b) `(k) = ?d`(k)"
	using append_props comp_fun_apply apply_funtype
	by auto
    } thus ?thesis by simp
  qed
  ultimately show "c O ?b = ?d" by (rule func_eq)
qed

text\<open>A lemma about appending an element to a list defined by set
  comprehension.\<close>

lemma set_list_append: assumes
  A1: "\<forall>i \<in> succ(k). b(i) \<in> X" and
  A2: "a = {\<langle>i,b(i)\<rangle>. i \<in> succ(k)}"
  shows
  "a: succ(k) \<rightarrow> X"
  "{\<langle>i,b(i)\<rangle>. i \<in> k}: k \<rightarrow> X"
  "a = Append({\<langle>i,b(i)\<rangle>. i \<in> k},b(k))"
proof -
  from A1 have "{\<langle>i,b(i)\<rangle>. i \<in> succ(k)} : succ(k) \<rightarrow> X"
    by (rule ZF_fun_from_total)
  with A2 show "a: succ(k) \<rightarrow> X" by simp
  from A1 have "\<forall>i \<in> k. b(i) \<in> X"
    by simp
  then show "{\<langle>i,b(i)\<rangle>. i \<in> k}: k \<rightarrow> X"
    by (rule ZF_fun_from_total)
  with A2 show "a = Append({\<langle>i,b(i)\<rangle>. i \<in> k},b(k))"
    using func1_1_L1 Append_def by auto
qed

text\<open>A version of \<open>set_list_append\<close> using $n+1$ instead of \<open>succ(n)\<close>. \<close>

lemma set_list_append1:
  assumes "n\<in>nat" and "\<forall>k\<in>n #+ 1. q(k) \<in> X"
  defines "a\<equiv>{\<langle>k,q(k)\<rangle>. k\<in>n #+ 1}"
  shows
  "a: n #+ 1 \<rightarrow> X"
  "{\<langle>k,q(k)\<rangle>. k \<in> n}: n \<rightarrow> X"
  "Init(a) = {\<langle>k,q(k)\<rangle>. k \<in> n}"
  "a = Append({\<langle>k,q(k)\<rangle>. k \<in> n},q(n))"
  "a = Append(Init(a), q(n))"
  "a = Append(Init(a), a`(n))"
proof -
  from assms(1) have I: "n #+ 1 = succ(n)" using succ_add_one(1)
    by simp
  with assms show
    "a: n #+ 1 \<rightarrow> X" and "{\<langle>k,q(k)\<rangle>. k \<in> n}: n \<rightarrow> X"
    and II: "Init(a) = {\<langle>k,q(k)\<rangle>. k \<in> n}"
    using set_list_append(1,2) init_def_alt by simp_all
  from assms(2,3) I have
    "\<forall>k\<in>succ(n). q(k) \<in> X" and "a = {\<langle>k,q(k)\<rangle>. k \<in> succ(n)}"
    by simp_all
  then show "a = Append({\<langle>k,q(k)\<rangle>. k \<in> n},q(n))"
    using set_list_append(3) by simp
  with II show "a = Append(Init(a), q(n))" by simp
  from I have "n \<in> n #+ 1" by simp
  then have "{\<langle>k,q(k)\<rangle>. k\<in>n #+ 1}`(n) = q(n)"
    by (rule ZF_fun_from_tot_val1)
  with assms(3) \<open>a = Append(Init(a), q(n))\<close> show "a = Append(Init(a), a`(n))"
    by simp
qed

text\<open>An induction theorem for lists.\<close>

lemma list_induct: assumes A1: "\<forall>b\<in>1\<rightarrow>X. P(b)" and
  A2: "\<forall>b\<in>NELists(X). P(b) \<longrightarrow> (\<forall>x\<in>X. P(Append(b,x)))" and
  A3: "d \<in> NELists(X)"
  shows "P(d)"
proof -
  { fix n
    assume "n\<in>nat"
    moreover from A1 have "\<forall>b\<in>succ(0)\<rightarrow>X. P(b)" by simp
    moreover have "\<forall>k\<in>nat. ((\<forall>b\<in>succ(k)\<rightarrow>X. P(b)) \<longrightarrow> (\<forall>c\<in>succ(succ(k))\<rightarrow>X. P(c)))"
    proof -
      { fix k assume "k \<in> nat" assume "\<forall>b\<in>succ(k)\<rightarrow>X. P(b)"
        have "\<forall>c\<in>succ(succ(k))\<rightarrow>X. P(c)"
        proof
          fix c assume "c: succ(succ(k))\<rightarrow>X"
          let ?b = "Init(c)"
          let ?x = "c`(succ(k))"
          from \<open>k \<in> nat\<close> \<open>c: succ(succ(k))\<rightarrow>X\<close> have "?b:succ(k)\<rightarrow>X"
            using init_props by simp
          with A2 \<open>k \<in> nat\<close> \<open>\<forall>b\<in>succ(k)\<rightarrow>X. P(b)\<close> have "\<forall>x\<in>X. P(Append(?b,x))"
            using NELists_def by auto
          with \<open>c: succ(succ(k))\<rightarrow>X\<close> have "P(Append(?b,?x))" using apply_funtype by simp
          with \<open>k \<in> nat\<close> \<open>c: succ(succ(k))\<rightarrow>X\<close> show "P(c)"
            using init_props by simp
        qed
      } thus ?thesis by simp
    qed
    ultimately have "\<forall>b\<in>succ(n)\<rightarrow>X. P(b)" by (rule ind_on_nat)
  } with A3 show ?thesis using NELists_def by auto
qed

text\<open>A dual notion to \<open>Append\<close> is \<open>Prepend\<close> where we add an element to the list at the beginning of the
  list. We define the value of the list $a$ prepended by an element $x$ as
  $x$ if index is 0 and $a(k-1)$ otherwise.\<close>

definition
  "Prepend(a,x) \<equiv> {\<langle>k,if k = 0 then x else a`(k #- 1)\<rangle>. k\<in>domain(a) #+ 1}"

text\<open>If $a:n\rightarrow X$ is a list, then $a$ with prepended $x\in X$ is a list as well and
  its first element is $x$. \<close>

lemma prepend_props:
  assumes "n\<in>nat" "a:n\<rightarrow>X" "x\<in>X"
  shows "Prepend(a,x):(n #+ 1)\<rightarrow>X" and "Prepend(a,x)`(0) = x"
proof -
  let ?b = "{\<langle>k,if k = 0 then x else a`(k #- 1)\<rangle>. k\<in>n #+ 1}"
  have "\<forall>k\<in>n #+ 1. (if k = 0 then x else a`(k #- 1)) \<in> X"
  proof -
    { fix k assume "k \<in> n #+ 1"
      let ?v = "if k = 0 then x else a`(k #- 1)"
      { assume "k\<noteq>0"
        with \<open>k \<in> n #+ 1\<close> have "n\<noteq>0" by auto
        from assms(1) \<open>k \<in> n #+ 1\<close> have "k \<in> nat"
          using elem_nat_is_nat(2) by blast
        from assms(1) have "succ(n) = n #+ 1"
          using succ_add_one(1) by simp
        with \<open>k \<in> n #+ 1\<close> have "k\<in>succ(n)" by simp
        with assms(1) \<open>n\<noteq>0\<close> have "pred(k) \<in> n"
          using pred_succ_mem by simp
        with assms(2) \<open>k \<in> nat\<close> \<open>k\<noteq>0\<close> have "?v\<in>X"
          using pred_minus_one apply_funtype by simp
      }
      with assms(3) have "?v \<in> X" by simp
    } thus ?thesis by simp
  qed
  then have "?b: (n #+ 1)\<rightarrow>X" by (rule ZF_fun_from_total)
  with assms(2) show "Prepend(a,x):(n #+ 1)\<rightarrow>X"
    using func1_1_L1 unfolding Prepend_def by simp
  from assms(1) have "0 \<in> n #+ 1"
    using succ_add_one(1) empty_in_every_succ by simp
  then have "?b`(0) = (if 0 = 0 then x else a`(0 #- 1))"
    by (rule ZF_fun_from_tot_val1)
  with assms(2) show  "Prepend(a,x)`(0) = x"
    using func1_1_L1 unfolding Prepend_def by simp
qed

text\<open>When prepending an element to a list the values at positive indices do not change.\<close>

lemma prepend_val: assumes "n\<in>nat" "a:n\<rightarrow>X" "x\<in>X" "k\<in>n"
  shows "Prepend(a,x)`(k #+ 1) = a`(k)"
proof -
  let ?b = "{\<langle>k,if k = 0 then x else a`(k #- 1)\<rangle>. k\<in>n #+ 1}"
  from assms(1,4) have "k\<in>nat"
    using elem_nat_is_nat(2) by simp
  with assms(1) have "succ(n) = n #+ 1" and "succ(k) = k #+ 1"
    using succ_add_one(1) by auto
  with assms(1,4) have "k #+ 1 \<in> n #+ 1"
    using succ_ineq by simp
  from \<open>k #+ 1 \<in> n #+ 1\<close> have
    "?b`(k #+ 1) = (if k #+ 1 = 0 then x else a`((k #+ 1) #- 1))"
    by (rule ZF_fun_from_tot_val1)
  with assms(2) \<open>k\<in>nat\<close> show ?thesis
    using func1_1_L1 unfolding Prepend_def by simp
qed

subsection\<open>Lists and cartesian products\<close>

text\<open>Lists of length $n$ of elements of some set $X$ can be thought of as a
model of the cartesian product $X^n$ which is more convenient in many applications.\<close>

text\<open>There is a natural bijection between the space $(n+1)\rightarrow X$ of lists of length
$n+1$ of elements of $X$ and the cartesian product $(n\rightarrow X)\times X$.\<close>

lemma lists_cart_prod: assumes "n \<in> nat"
  shows "{\<langle>x,\<langle>Init(x),x`(n)\<rangle>\<rangle>. x \<in> succ(n)\<rightarrow>X} \<in> bij(succ(n)\<rightarrow>X,(n\<rightarrow>X)\<times>X)"
proof -
  let ?f = "{\<langle>x,\<langle>Init(x),x`(n)\<rangle>\<rangle>. x \<in> succ(n)\<rightarrow>X}"
  from assms have "\<forall>x \<in> succ(n)\<rightarrow>X. \<langle>Init(x),x`(n)\<rangle> \<in> (n\<rightarrow>X)\<times>X"
    using init_props succ_iff apply_funtype by simp
  then have I: "?f: (succ(n)\<rightarrow>X)\<rightarrow>((n\<rightarrow>X)\<times>X)" by (rule ZF_fun_from_total)
  moreover from assms I have "\<forall>x\<in>succ(n)\<rightarrow>X.\<forall>y\<in>succ(n)\<rightarrow>X. ?f`(x)=?f`(y) \<longrightarrow> x=y"
    using ZF_fun_from_tot_val init_def finseq_restr_eq by auto
  moreover have "\<forall>p\<in>(n\<rightarrow>X)\<times>X.\<exists>x\<in>succ(n)\<rightarrow>X. ?f`(x) = p"
  proof
    fix p assume "p \<in> (n\<rightarrow>X)\<times>X"
    let ?x = "Append(fst(p),snd(p))"
    from assms \<open>p \<in> (n\<rightarrow>X)\<times>X\<close> have "?x:succ(n)\<rightarrow>X" using append_props by simp
    with I have "?f`(?x) = \<langle>Init(?x),?x`(n)\<rangle>" using succ_iff ZF_fun_from_tot_val by simp
    moreover from assms \<open>p \<in> (n\<rightarrow>X)\<times>X\<close> have "Init(?x) = fst(p)" and "?x`(n) = snd(p)"
      using init_append append_props by auto
    ultimately have "?f`(?x) = \<langle>fst(p),snd(p)\<rangle>" by auto
    with \<open>p \<in> (n\<rightarrow>X)\<times>X\<close> \<open>?x:succ(n)\<rightarrow>X\<close> show "\<exists>x\<in>succ(n)\<rightarrow>X. ?f`(x) = p" by auto
  qed
  ultimately show ?thesis using inj_def surj_def bij_def by auto
qed

text\<open>We can identify a set $X$ with lists of length one of elements of $X$.\<close>

lemma singleton_list_bij: shows "{\<langle>x,x`(0)\<rangle>. x\<in>1\<rightarrow>X} \<in> bij(1\<rightarrow>X,X)"
proof -
  let ?f = "{\<langle>x,x`(0)\<rangle>. x\<in>1\<rightarrow>X}"
  have "\<forall>x\<in>1\<rightarrow>X. x`(0) \<in> X" using apply_funtype by simp
  then have I: "?f:(1\<rightarrow>X)\<rightarrow>X" by (rule ZF_fun_from_total)
  moreover have "\<forall>x\<in>1\<rightarrow>X.\<forall>y\<in>1\<rightarrow>X. ?f`(x) = ?f`(y) \<longrightarrow> x=y"
  proof -
    { fix x y
      assume "x:1\<rightarrow>X" "y:1\<rightarrow>X" and "?f`(x) = ?f`(y)"
      with I have "x`(0) = y`(0)" using ZF_fun_from_tot_val by auto
      moreover from \<open>x:1\<rightarrow>X\<close> \<open>y:1\<rightarrow>X\<close> have "x = {\<langle>0,x`(0)\<rangle>}" and "y = {\<langle>0,y`(0)\<rangle>}"
        using list_singleton_pair by auto
      ultimately have "x=y" by simp
    } thus ?thesis by auto
  qed
  moreover have "\<forall>y\<in>X. \<exists>x\<in>1\<rightarrow>X. ?f`(x)=y"
  proof
    fix y assume "y\<in>X"
    let ?x = "{\<langle>0,y\<rangle>}"
    from I \<open>y\<in>X\<close> have "?x:1\<rightarrow>X" and "?f`(?x) = y"
      using list_len1_singleton ZF_fun_from_tot_val pair_val by auto
    thus "\<exists>x\<in>1\<rightarrow>X. ?f`(x)=y" by auto
  qed
  ultimately show ?thesis using inj_def surj_def bij_def by simp
qed

text\<open>We can identify a set of $X$-valued lists of length with $X$.\<close>

lemma list_singleton_bij: shows
  "{\<langle>x,{\<langle>0,x\<rangle>}\<rangle>.x\<in>X} \<in> bij(X,1\<rightarrow>X)" and
  "{\<langle>y,y`(0)\<rangle>. y\<in>1\<rightarrow>X} = converse({\<langle>x,{\<langle>0,x\<rangle>}\<rangle>.x\<in>X})" and
  "{\<langle>x,{\<langle>0,x\<rangle>}\<rangle>.x\<in>X} = converse({\<langle>y,y`(0)\<rangle>. y\<in>1\<rightarrow>X})"
proof -
  let ?f = "{\<langle>y,y`(0)\<rangle>. y\<in>1\<rightarrow>X}"
  let ?g = "{\<langle>x,{\<langle>0,x\<rangle>}\<rangle>.x\<in>X}"
  have "1 = {0}" by auto
  then have "?f \<in> bij(1\<rightarrow>X,X)" and "?g:X\<rightarrow>(1\<rightarrow>X)"
    using singleton_list_bij pair_func_singleton ZF_fun_from_total
    by auto
  moreover have "\<forall>y\<in>1\<rightarrow>X.?g`(?f`(y)) = y"
  proof
    fix y assume "y:1\<rightarrow>X"
    have "?f:(1\<rightarrow>X)\<rightarrow>X" using singleton_list_bij bij_def inj_def by simp
    with \<open>1 = {0}\<close> \<open>y:1\<rightarrow>X\<close> \<open>?g:X\<rightarrow>(1\<rightarrow>X)\<close> show "?g`(?f`(y)) = y"
      using ZF_fun_from_tot_val apply_funtype func_singleton_pair
      by simp
  qed
  ultimately show "?g \<in> bij(X,1\<rightarrow>X)" and "?f = converse(?g)" and "?g = converse(?f)"
    using comp_conv_id by auto
qed

text\<open>What is the inverse image of a set by the natural bijection between $X$-valued
  singleton lists and $X$?\<close>

lemma singleton_vimage: assumes "U\<subseteq>X" shows "{x\<in>1\<rightarrow>X. x`(0) \<in> U} = { {\<langle>0,y\<rangle>}. y\<in>U}"
proof
  have "1 = {0}" by auto
  { fix x assume "x \<in> {x\<in>1\<rightarrow>X. x`(0) \<in> U}"
    with \<open>1 = {0}\<close> have "x = {\<langle>0, x`(0)\<rangle>}" using func_singleton_pair by auto
  } thus "{x\<in>1\<rightarrow>X. x`(0) \<in> U} \<subseteq> { {\<langle>0,y\<rangle>}. y\<in>U}" by auto
  { fix x assume "x \<in> { {\<langle>0,y\<rangle>}. y\<in>U}"
    then obtain y where "x = {\<langle>0,y\<rangle>}" and "y\<in>U" by auto
    with \<open>1 = {0}\<close> assms have "x:1\<rightarrow>X" using pair_func_singleton by auto
  } thus "{ {\<langle>0,y\<rangle>}. y\<in>U} \<subseteq> {x\<in>1\<rightarrow>X. x`(0) \<in> U}" by auto
qed

text\<open>A technical lemma about extending a list by values from a set.\<close>

lemma list_append_from: assumes A1: "n \<in> nat" and A2: "U \<subseteq> n\<rightarrow>X" and A3: "V \<subseteq> X"
  shows
  "{x \<in> succ(n)\<rightarrow>X. Init(x) \<in> U \<and> x`(n) \<in> V} = (\<Union>y\<in>V.{Append(x,y).x\<in>U})"
proof -
  { fix x assume "x \<in> {x \<in> succ(n)\<rightarrow>X. Init(x) \<in> U \<and> x`(n) \<in> V}"
    then have "x \<in> succ(n)\<rightarrow>X" and "Init(x) \<in> U" and I: "x`(n) \<in> V"
      by auto
    let ?y = "x`(n)"
    from A1 and \<open>x \<in> succ(n)\<rightarrow>X\<close>  have "x = Append(Init(x),?y)"
      using init_props by simp
    with I and \<open>Init(x) \<in> U\<close> have "x \<in> (\<Union>y\<in>V.{Append(a,y).a\<in>U})" by auto
  }
  moreover
  { fix x assume "x \<in> (\<Union>y\<in>V.{Append(a,y).a\<in>U})"
    then obtain a y where "y\<in>V" and "a\<in>U" and "x = Append(a,y)" by auto
    with A2 A3 have "x: succ(n)\<rightarrow>X" using append_props by blast
    from A2 A3 \<open>y\<in>V\<close> \<open>a\<in>U\<close> have "a:n\<rightarrow>X" and "y\<in>X" by auto
    with A1 \<open>a\<in>U\<close>  \<open>y\<in>V\<close> \<open>x = Append(a,y)\<close> have "Init(x) \<in> U" and  "x`(n) \<in> V"
      using append_props init_append by auto
    with \<open>x: succ(n)\<rightarrow>X\<close> have "x \<in> {x \<in> succ(n)\<rightarrow>X. Init(x) \<in> U \<and> x`(n) \<in> V}"
      by auto
  }
  ultimately show ?thesis by blast
qed

end


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

theory CSP_F_law_SKIP
imports CSP_F_law_basic CSP_T_law_SKIP
begin

(*****************************************************************

         1. SKIP |[X]| SKIP
         2. SKIP |[X]| P
         3. P |[X]| SKIP
         4. SKIP -- X
         5. SKIP [[r]]
         6. SKIP ;; P
         7. P ;; SKIP
         8. SKIP |. n

 *****************************************************************)

(*********************************************************
                    SKIP |[X]| SKIP
 *********************************************************)

lemma cspF_Parallel_term:
   "SKIP |[X]| SKIP =F[M1,M2] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Parallel_term)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (erule disjE)
  apply (simp)
  apply (fast)

  apply (simp)
  apply (fast)
done

(*********************************************************
                      SKIP |[X]| P
 *********************************************************)

lemma cspF_Parallel_preterm_l_set1:
  "[| Ya - insert Tick (Ev ` X) = Z - insert Tick (Ev ` X) ; Ev ` Y Int Z = {} |]
   ==> Ev ` (Y - X) Int (Ya Un Z) = {}"
by (auto)

lemma cspF_Parallel_preterm_l:
   "SKIP |[X]| (? :Y -> Qf) =F[M,M] ? x:(Y-X) -> (SKIP |[X]| Qf x)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Parallel_preterm_l)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (elim disjE conjE exE)
  apply (simp_all)

  apply (simp add: cspF_Parallel_preterm_l_set1)

  apply (drule_tac x="s" in spec)
  apply (erule disjE, simp)
  apply (erule disjE, simp)
  apply (elim conjE exE, simp)
  apply (simp add: par_tr_head)
  apply (fast)

      (* automatized by "par_tr_nil_Tick" *)

  apply (drule_tac x="s" in spec)
  apply (erule disjE, simp)
  apply (erule disjE, simp)
  apply (elim conjE exE, simp)
  apply (simp add: par_tr_head)
  apply (fast)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (erule disjE, simp)
  apply (rule_tac x="Xa - {Tick}" in exI)
  apply (rule_tac x="Xa - (Ev ` X)" in exI)
  apply (rule conjI, fast)
  apply (rule conjI, fast)

  apply (rule conjI)
  apply (simp add: Evset_def, fast)
  apply (fast)

 (* *)
  apply (elim disjE conjE exE)
  apply (simp_all)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Z" in exI, simp)
   apply (rule_tac x="<>" in exI)
   apply (rule_tac x="<Ev a> ^^^ t" in exI, simp)
   apply (simp add: par_tr_head)

   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Z" in exI, simp)
   apply (rule_tac x="<Tick>" in exI)
   apply (rule_tac x="<Ev a> ^^^ t" in exI, simp)
   apply (simp add: par_tr_head)
done

(*********************************************************
                      P |[X]| SKIP
 *********************************************************)

lemma cspF_Parallel_preterm_r:
   "(? :Y -> Pf) |[X]| SKIP
     =F[M,M] ? x:(Y-X) -> (Pf x |[X]| SKIP)"
apply (rule cspF_trans)
apply (rule cspF_Parallel_commut)
apply (rule cspF_trans)
apply (rule cspF_Parallel_preterm_l)
apply (rule cspF_rm_head, simp)
apply (rule cspF_Parallel_commut)
done

lemmas cspF_Parallel_preterm = cspF_Parallel_preterm_l cspF_Parallel_preterm_r

(*********************************************************
                      SKIP and Parallel
 *********************************************************)

(* p.288 *)

lemma cspF_SKIP_Parallel_Ext_choice_SKIP_l:
  "((? :Y -> Pf) [+] SKIP) |[X]| SKIP =F[M,M]
   (? x:(Y - X) -> (Pf x |[X]| SKIP)) [+] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Parallel_Ext_choice_SKIP_l)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (rule disjI1)
  apply (blast)

  apply (simp add: par_tr_nil_right)
  apply (elim conjE)
  apply (simp add: image_iff)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp add: par_tr_nil_right)

  apply (rule, simp add: in_traces)

  apply (simp add: par_tr_Tick_right)
  apply (elim conjE)
  apply (simp add: image_iff)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp add: par_tr_Tick_right)

(* <= *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (simp add: in_traces)
  apply (rule_tac x="Xa" in exI)
  apply (rule_tac x="Xa" in exI)
  apply (simp)

  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp add: par_tr_nil_right)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp add: par_tr_nil_right)
  apply (simp add: image_iff)
  apply (fast)

  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Z" in exI)
  apply (simp add: par_tr_Tick_right)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp add: par_tr_Tick_right)
  apply (simp add: image_iff)
  apply (fast)

  apply (rule_tac x="Xa" in exI)
  apply (rule_tac x="Xa" in exI)
  apply (simp)

  apply (simp add: in_traces)

  apply (rule_tac x="Xa" in exI)
  apply (rule_tac x="Xa" in exI)
  apply (simp)
done

lemma cspF_SKIP_Parallel_Ext_choice_SKIP_r:
  "SKIP |[X]| ((? :Y -> Pf) [+] SKIP)  =F[M,M]
    (? x:(Y - X) -> (SKIP |[X]| Pf x)) [+] SKIP"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_SKIP_Parallel_Ext_choice_SKIP_l)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
done

lemmas cspF_SKIP_Parallel_Ext_choice_SKIP =
       cspF_SKIP_Parallel_Ext_choice_SKIP_l
       cspF_SKIP_Parallel_Ext_choice_SKIP_r

(*********************************************************
                      SKIP -- X
 *********************************************************)

lemma cspF_SKIP_Hiding_Id:
   "SKIP -- X =F[M,M] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Hiding_Id)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
  apply (rule_tac x="<>" in exI)
  apply (simp add: Evset_def)
  apply (fast)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp)
done

(*********************************************************
                      SKIP and Hiding
 *********************************************************)

(* p.288 version
  "((? :Y -> Pf) [+] SKIP) -- X =F[M,M]
       IF (Y Int X = {}) THEN ((? x:Y -> (Pf x -- X)) [+] SKIP)
                         ELSE (((? x:(Y-X) -> (Pf x -- X)) [+] SKIP)
                               |~| (! x:(Y Int X) .. (Pf x -- X)))"
*)

lemma cspF_SKIP_Hiding_step:
  "((? :Y -> Pf) [+] SKIP) -- X =F[M,M]
   (((? x:(Y-X) -> (Pf x -- X)) [+] SKIP) |~| (! x:(Y Int X) .. (Pf x -- X)))"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Hiding_step)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (simp_all)
 apply (simp_all add: in_traces)

  apply (case_tac "a : X")
  apply (simp)
  apply (blast)
  apply (force)

(* <= *)
 apply (rule)

  apply (simp add: in_failures)
  apply (elim conjE exE bexE disjE)
  apply (simp_all)

   apply (rule_tac x="<>" in exI)
   apply (simp add: in_traces)
   apply (simp add: Evset_def)
   apply (fast)

   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (simp)

   apply (rule_tac x="<Tick>" in exI)
   apply (simp)

   apply (simp add: in_traces)

   apply (rule_tac x="<>" in exI)
   apply (simp add: Evset_def)
   apply (fast)

   apply (rule_tac x="<Ev a> ^^^ sa" in exI)
   apply (simp)
done

(*********************************************************
                      SKIP [[r]]
 *********************************************************)

lemma cspF_SKIP_Renaming_Id:
   "SKIP [[r]] =F[M1,M2] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Renaming_Id)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (force)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (force)
done

(*********************************************************
                       SKIP ;; P
 *********************************************************)

lemma cspF_Seq_compo_unit_l: "SKIP ;; P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Seq_compo_unit_l)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim conjE disjE)
 apply (simp_all add: Evset_def)
 apply (elim conjE exE)
 apply (simp add: in_traces)

(* <= *)
 apply (rule, simp add: in_failures)
 apply (rule disjI2)
 apply (rule_tac x="<>" in exI)
 apply (rule_tac x="s" in exI)
 apply (simp add: in_traces)
done

(*********************************************************
                       P ;; SKIP
 *********************************************************)

lemma cspF_Seq_compo_unit_r: "P ;; SKIP =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Seq_compo_unit_r)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE exE disjE)
 apply (rule memF_F2, simp, fast)
 apply (rule domF_F2_F4, simp_all)
 apply (fold comp_def, simp)
 apply (rule domF_T3, simp_all)
 apply (fold comp_def, simp)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (insert trace_last_noTick_or_Tick)
 apply (drule_tac x="s" in spec)
 apply (erule disjE)
  apply (case_tac "Tick : X")
   apply (rule disjI1, simp)
   apply (subgoal_tac "insert Tick X = X", simp, fast)
   (* Tick ~: X *)
   apply (case_tac "s ^^^ <Tick> ~:t [[P]]Tf (fstF o M)")
    apply (rule disjI1, simp)
    apply (rule domF_F3[of "[[P]]Tf (fstF o M)" "failures P M" _ _ "{Tick}", simplified])
    apply (simp_all add: semTf_def)
    (* *)
    apply (rule disjI2)
    apply (rule_tac x="s" in exI)
    apply (rule_tac x="<>" in exI, simp)
    apply (simp add: Evset_def, fast)
  (* *)
  apply (elim conjE exE, simp)
  apply (rule_tac x="sa" in exI)
  apply (rule_tac x="<Tick>" in exI)
  apply (simp)
  apply (rule domF_T2[of _ "failures P M"], simp_all)
done

lemmas cspF_Seq_compo_unit = cspF_Seq_compo_unit_l cspF_Seq_compo_unit_r

(*********************************************************
               SKIP and Sequential composition
 *********************************************************)

(* p.141 *)

lemma cspF_SKIP_Seq_compo_step:
  "((? :X -> Pf) [> SKIP) ;; Q =F[M,M] (? x:X -> (Pf x ;; Q)) [> Q"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Seq_compo_step)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)
 apply (simp add: Evset_def)
 apply (simp add: Evset_def)
 apply (simp add: Evset_def)

 apply (rule disjI2)
 apply (rule disjI1)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (drule_tac x="sa" in spec)

 apply (elim disjE conjE exE)
  apply (simp_all)
  apply (simp add: appt_assoc)
  apply (rule disjI2)
  apply (rule disjI1)
  apply (rule_tac x="sc" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp)

(* <= *)
 apply (rule, simp add: in_failures in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (rule disjI2)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp)

  apply (rule disjI2)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp)

  apply (rule disjI2)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp add: appt_assoc)

  apply (rule disjI2)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="s" in exI)
  apply (simp)

  apply (rule disjI2)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp)
  apply (rule proc_F2_F4)
  apply (simp_all)
done

(*********************************************************
                      SKIP |. n
 *********************************************************)

lemma cspF_SKIP_Depth_rest:
   "SKIP |. Suc n =F[M1,M2] SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_SKIP_Depth_rest)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE disjE)
 apply (simp)
 apply (simp)
 apply (case_tac "0 < n", simp)
 apply (simp)
 apply (rule_tac x="<>" in exI)
 apply (simp)
done

(*********************************************************
                      cspF_SKIP
 *********************************************************)

lemmas cspF_SKIP =
       cspF_Parallel_term
       cspF_Parallel_preterm
       cspF_SKIP_Parallel_Ext_choice_SKIP
       cspF_SKIP_Hiding_Id
       cspF_SKIP_Hiding_step
       cspF_SKIP_Renaming_Id
       cspF_Seq_compo_unit
       cspF_SKIP_Seq_compo_step
       cspF_SKIP_Depth_rest

(*********************************************************
                       P [+] SKIP
 *********************************************************)

(* p.141 *)

lemma cspF_Ext_choice_SKIP_resolve: "P [+] SKIP =F[M,M] P [> SKIP"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_SKIP_resolve)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(* =================================================== *
 |             addition for CSP-Prover 5               |
 * =================================================== *)

(*********************************************************
                    SKIP ||| P   (--> SKIP)
 *********************************************************)

lemma cspF_Interleave_unit_l:
  "SKIP ||| P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Interleave_unit_l)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
  apply (simp add: par_tr_nil_left)
  apply (subgoal_tac "Y Un Z = Z")
  apply (simp)
  apply (simp add: Evset_def)
  apply (force)

  apply (simp add: par_tr_Tick_left)
  apply (simp add: Tick_in_sett)
  apply (elim conjE exE)
  apply (rotate_tac -3)
  apply (drule sym)
  apply (simp)
  apply (rule proc_T2_T3)
  apply (simp_all)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (rule_tac x="X-{Tick}" in exI)
 apply (rule_tac x="X" in exI)
 apply (simp)
  apply (rule conjI)
  apply (force)

 apply (case_tac "noTick s")

  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="s" in exI)
  apply (simp add: par_tr_nil_left)
  apply (simp add: noTick_def)
  apply (simp add: Evset_def)
  apply (force)

  apply (rule_tac x="<Tick>" in exI)
  apply (rule_tac x="s" in exI)
  apply (simp)
  apply (simp add: par_tr_Tick_left)
  apply (simp add: noTick_def)
done

(*********************************************************
                    P ||| SKIP (SKIP)
 *********************************************************)

lemma cspF_Interleave_unit_r:
  "P ||| SKIP =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (simp add: cspF_Interleave_unit_l)
done

lemmas cspF_Interleave_unit =
       cspF_Interleave_unit_l
       cspF_Interleave_unit_r

end


section {* Proof of the agreement property of AbstractMultiPaxos. *}

theory AbstractMultiPaxosCorrectness
imports AbstractMultiPaxos IOA_Automation BallotArrayProperties
begin

locale amp_proof = quorums quorums + amp_ioa quorums for quorums +
  fixes the_ioa
  defines "the_ioa \<equiv> amp_ioa"
  -- {* Here we have to fix the constant @{term the_ioa} in order to fix all type variables.
  Otherwise, there are problems in Eisbach when matching the same polymorphic constant appearing in several terms. *}
begin

interpretation IOA .

subsection {* Automation setup and a few lemmas *}

lemmas amp_ioa_defs =
   is_trans_def actions_def amp_trans_def amp_start_def
   externals_def amp_ioa_def the_ioa_def paxos_asig_def

declare amp_ioa_defs[inv_proofs_defs]
declare amp_ioa_def[inv_proofs_defs]

declare propose_def[simp] join_ballot_def[simp] do_vote_def[simp]
  learn_def[simp] Let_def[simp] if_split[split] if_split_asm[split]

subsection {* @{term conservative_array}  is an inductive invariant *}

declare ballot_array.conservative_array_def[inv_proofs_defs]

abbreviation conservative_array where
"conservative_array s \<equiv>  \<forall> i . conservative_at s i"

lemma conservative_inductive:
  "invariant the_ioa conservative_array"
  apply (try_solve_inv2 case_thm:trans_cases inv_proofs_defs:inv_proofs_defs ballot_array.conservative_def invs:invs)
  apply (case_tac a)
  apply (auto simp add:inv_proofs_defs split:option.split_asm)
done
declare conservative_inductive[invs]

subsection {* @{term safe} is inductive relative to @{term conservative_array}} *}

text {*
We first prove that when the algorithm takes a step, the old state is a prefix
of the new state. With this fact, we obtain that (1) a safe value remains safe after a step using the lemma @{thm ballot_array_prefix.safe_at_mono }.
Then we prove that (2) when a vote is cast at a ballot b from a safe state, then the voted value is safe at b.
Given those two facts, the inductiveness of safe follows.  *}

abbreviation safe_at where "safe_at s i \<equiv> ballot_array.safe_at  quorums (ballot s) (vote s i)"

lemma trans_imp_prefix_order:
  assumes "s \<midarrow>a\<midarrow>the_ioa\<longrightarrow> t"
  shows "is_prefix (ballot s) (ballot t) (vote s i) (vote t i)" using assms
by (cases a) (auto simp add:is_prefix_def inv_proofs_defs split:option.split_asm)

lemma safe_mono:
  -- {* @{term safe_at} is monotonic. *}
  assumes "s \<midarrow>a\<midarrow>the_ioa\<longrightarrow> t" and "safe_at s i v b"
  shows "safe_at t i v b" using assms ballot_array_prefix.safe_at_mono
by (metis ballot_array_prefix_axioms.intro ballot_array_prefix_def quorums_axioms trans_imp_prefix_order)

abbreviation safe where "safe s \<equiv> \<forall> i . ballot_array.safe  quorums (ballot s) (vote s i)"

lemma safe_votes:
  assumes "s \<midarrow>aa\<midarrow>the_ioa\<longrightarrow> t" and "vote s i a b  \<noteq> vote t i a b" and "vote t i a b = Some v"
    and "conservative_array s" and "safe s"
  shows "safe_at t i v b"
  using assms
  apply (cases aa)
    apply (auto simp add:inv_proofs_defs)
  subgoal premises prems
  proof -
    have "safe_at s i v (ballot s a)" by (smt assms(4) ballot_array.safe_def ballot_array_props.intro ballot_array_props.proved_safe_at_abs_imp_safe_at option.case_eq_if option.distinct(1) option.sel prems(2) prems(6) quorums_axioms)
    thus ?thesis by (metis amp_state.select_convs(2) amp_state.select_convs(3) amp_state.surjective amp_state.update_convs(3) assms(1) fun_upd_apply prems(9) safe_mono)
  qed
  done

lemma safe_inv:
  "invariant the_ioa safe"
apply (try_solve_inv2 case_thm:trans_cases inv_proofs_defs:inv_proofs_defs ballot_array.safe_def invs:invs)
subgoal premises prems for s t act
proof (auto simp add:ballot_array.safe_def split:option.splits)
  fix i b a v
  assume "vote t i a b = Some v"
  show "safe_at t i v b"
  proof (cases "vote s i a b = vote t i a b")
    case True
    hence "safe_at s i v b" using prems(1) by (metis \<open>vote t i a b = Some v\<close> ballot_array.safe_def option.simps(5))
    thus ?thesis using prems(2) safe_mono
      by fastforce
  next
    case False thus ?thesis using safe_votes
      using \<open>vote t i a b = Some v\<close> prems(1-3) by blast
  qed
qed
done
declare safe_inv[invs]

subsection {* Finally, the proof that agreement holds (trivial, follows immediately from safe).*}

definition agreement where
  "agreement s \<equiv> \<forall> v w i . chosen s i v \<and> chosen s i w \<longrightarrow> v = w"

lemma agreement:"invariant the_ioa agreement"
apply(rule invariantI)
    apply(auto simp add: inv_proofs_defs agreement_def ballot_array.chosen_def ballot_array.chosen_at_def)[1]
  apply (metis (mono_tags, lifting) IOA.invariant_def IOA.reachable_n agreement_def amp_proof.safe_inv amp_proof_axioms ballot_array_props.intro ballot_array_props.safe_imp_agreement quorums_axioms the_ioa_def)
done

end

end