(*  Title:      IPv6.thy
    Authors:    Cornelius Diekmann
*)
theory IPv6
  imports
    IP_Address
    NumberWang_IPv6
    (* include "HOL-Library.Code_Target_Nat" if you need to work with actual numbers.*)
begin

section \<open>IPv6 Addresses\<close>
  text\<open>An IPv6 address is basically a 128 bit unsigned integer. RFC 4291, Section 2.\<close>
  type_synonym ipv6addr = "128 word"

  text\<open>Conversion between natural numbers and IPv6 adresses\<close>
  definition nat_of_ipv6addr :: "ipv6addr \<Rightarrow> nat" where
    "nat_of_ipv6addr a = unat a"
  definition ipv6addr_of_nat :: "nat \<Rightarrow> ipv6addr" where
    "ipv6addr_of_nat n =  of_nat n"

  lemma "ipv6addr_of_nat n = word_of_int (int n)"
    by(simp add: ipv6addr_of_nat_def)

  text\<open>The maximum IPv6 address\<close>
  definition max_ipv6_addr :: "ipv6addr" where
    "max_ipv6_addr \<equiv> ipv6addr_of_nat ((2^128) - 1)"

  lemma max_ipv6_addr_number: "max_ipv6_addr = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
    unfolding max_ipv6_addr_def ipv6addr_of_nat_def by(simp)
  lemma "max_ipv6_addr = 340282366920938463463374607431768211455"
    by(fact max_ipv6_addr_number)
  lemma max_ipv6_addr_max_word: "max_ipv6_addr = - 1"
    by(simp add: max_ipv6_addr_number)
  lemma max_ipv6_addr_max: "\<forall>a. a \<le> max_ipv6_addr"
    by(simp add: max_ipv6_addr_max_word)
  lemma UNIV_ipv6addrset: "UNIV = {0 .. max_ipv6_addr}" (*not in the simp set, for a reason*)
    by(simp add: max_ipv6_addr_max_word) fastforce

  text\<open>identity functions\<close>
  lemma nat_of_ipv6addr_ipv6addr_of_nat_mod: "nat_of_ipv6addr (ipv6addr_of_nat n) = n mod 2^128"
    by (simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def unat_of_nat take_bit_eq_mod)
  lemma nat_of_ipv6addr_ipv6addr_of_nat:
    "n \<le> nat_of_ipv6addr max_ipv6_addr \<Longrightarrow> nat_of_ipv6addr (ipv6addr_of_nat n) = n"
    by (simp add: nat_of_ipv6addr_ipv6addr_of_nat_mod max_ipv6_addr_def)
  lemma ipv6addr_of_nat_nat_of_ipv6addr: "ipv6addr_of_nat (nat_of_ipv6addr addr) = addr"
    by(simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def)

  subsection\<open>Syntax of IPv6 Adresses\<close>
  text\<open>RFC 4291, Section 2.2.: Text Representation of Addresses\<close>

  text\<open>Quoting the RFC (note: errata exists):\<close>
  text_raw\<open>
  \begin{verbatim}
   1. The preferred form is x:x:x:x:x:x:x:x, where the 'x's are one to
      four hexadecimal digits of the eight 16-bit pieces of the address.
      Examples:
         ABCD:EF01:2345:6789:ABCD:EF01:2345:6789
         2001:DB8:0:0:8:800:200C:417A
  \end{verbatim}
\<close>
  datatype ipv6addr_syntax =
    IPv6AddrPreferred "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"

  text_raw\<open>
  \begin{verbatim}
   2. [...] In order to make writing addresses containing zero
      bits easier, a special syntax is available to compress the zeros.
      The use of "::" indicates one or more groups of 16 bits of zeros.
      The "::" can only appear once in an address.  The "::" can also be
      used to compress leading or trailing zeros in an address.

      For example, the following addresses
         2001:DB8:0:0:8:800:200C:417A   a unicast address
         FF01:0:0:0:0:0:0:101           a multicast address
         0:0:0:0:0:0:0:1                the loopback address
         0:0:0:0:0:0:0:0                the unspecified address

      may be represented as
         2001:DB8::8:800:200C:417A      a unicast address
         FF01::101                      a multicast address
         ::1                            the loopback address
         ::                             the unspecified address
  \end{verbatim}
\<close>
  (*datatype may take some minutes to load*)
  datatype ipv6addr_syntax_compressed =
  \<comment> \<open>using @{typ unit} for the omission @{text "::"}.

     Naming convention of the datatype:
      The first number is the position where the omission occurs.
      The second number is the length of the specified address pieces.
        I.e. `8 minus the second number' pieces are omitted.\<close>
    IPv6AddrCompressed1_0 unit
  | IPv6AddrCompressed1_1 unit "16 word"
  | IPv6AddrCompressed1_2 unit "16 word" "16 word"
  | IPv6AddrCompressed1_3 unit "16 word" "16 word" "16 word"
  | IPv6AddrCompressed1_4 unit "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed1_5 unit "16 word" "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed1_6 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed1_7 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"

  | IPv6AddrCompressed2_1 "16 word" unit
  | IPv6AddrCompressed2_2 "16 word" unit "16 word"
  | IPv6AddrCompressed2_3 "16 word" unit "16 word" "16 word"
  | IPv6AddrCompressed2_4 "16 word" unit "16 word" "16 word" "16 word"
  | IPv6AddrCompressed2_5 "16 word" unit "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed2_6 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed2_7 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"

  | IPv6AddrCompressed3_2 "16 word" "16 word" unit
  | IPv6AddrCompressed3_3 "16 word" "16 word" unit "16 word"
  | IPv6AddrCompressed3_4 "16 word" "16 word" unit "16 word" "16 word"
  | IPv6AddrCompressed3_5 "16 word" "16 word" unit "16 word" "16 word" "16 word"
  | IPv6AddrCompressed3_6 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"
  | IPv6AddrCompressed3_7 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"

  | IPv6AddrCompressed4_3 "16 word" "16 word" "16 word" unit
  | IPv6AddrCompressed4_4 "16 word" "16 word" "16 word" unit "16 word"
  | IPv6AddrCompressed4_5 "16 word" "16 word" "16 word" unit "16 word" "16 word"
  | IPv6AddrCompressed4_6 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"
  | IPv6AddrCompressed4_7 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"

  | IPv6AddrCompressed5_4 "16 word" "16 word" "16 word" "16 word" unit
  | IPv6AddrCompressed5_5 "16 word" "16 word" "16 word" "16 word" unit "16 word"
  | IPv6AddrCompressed5_6 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"
  | IPv6AddrCompressed5_7 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"

  | IPv6AddrCompressed6_5 "16 word" "16 word" "16 word" "16 word" "16 word" unit
  | IPv6AddrCompressed6_6 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"
  | IPv6AddrCompressed6_7 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"

  | IPv6AddrCompressed7_6 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit
  | IPv6AddrCompressed7_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"

  | IPv6AddrCompressed8_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit

  (*RFC 5952:
    """
    4.  A Recommendation for IPv6 Text Representation
    4.2.2.  Handling One 16-Bit 0 Field
       The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
       For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
       2001:db8::1:1:1:1:1 is not correct.
    """

    So we could remove all IPv6AddrCompressed*_7 constructors.
    But these are `recommendations', we might still see these non-recommended definitions.
    "[...] all implementations must accept and be able to handle any legitimate RFC 4291 format."
  *)

  (*More convenient parser helper function for compressed IPv6 addresses:
    Input list (from parser):
      Some 16word \<longrightarrow> address piece
      None \<longrightarrow> omission '::'

   Basically, the parser must only do the following (python syntax):
     split the string which is an ipv6 address at ':'
     map empty string to None
     map everything else to Some (string_to_16word str)
     sanitize empty strings at the start and the end (see toString and parser theories)
   Example:
     "1:2:3".split(":")  = ['1', '2', '3']
     ":2:3:4".split(":") = ['', '2', '3', '4']
     ":2::3".split(":")  = ['', '2', '', '3']
     "1:2:3:".split(":") = ['1', '2', '3', '']
  *)
  definition parse_ipv6_address_compressed :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax_compressed option" where
    "parse_ipv6_address_compressed as = (case as of
      [None] \<Rightarrow> Some (IPv6AddrCompressed1_0 ())
    | [None, Some a] \<Rightarrow> Some (IPv6AddrCompressed1_1 () a)
    | [None, Some a, Some b] \<Rightarrow> Some (IPv6AddrCompressed1_2 () a b)
    | [None, Some a, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed1_3 () a b c)
    | [None, Some a, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed1_4 () a b c d)
    | [None, Some a, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed1_5 () a b c d e)
    | [None, Some a, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed1_6 () a b c d e f)
    | [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed1_7 () a b c d e f g)

    | [Some a, None] \<Rightarrow> Some (IPv6AddrCompressed2_1 a ())
    | [Some a, None, Some b] \<Rightarrow> Some (IPv6AddrCompressed2_2 a () b)
    | [Some a, None, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed2_3 a () b c)
    | [Some a, None, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed2_4 a () b c d)
    | [Some a, None, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed2_5 a () b c d e)
    | [Some a, None, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed2_6 a () b c d e f)
    | [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed2_7 a () b c d e f g)

    | [Some a, Some b, None] \<Rightarrow> Some (IPv6AddrCompressed3_2 a b ())
    | [Some a, Some b, None, Some c] \<Rightarrow> Some (IPv6AddrCompressed3_3 a b () c)
    | [Some a, Some b, None, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed3_4 a b () c d)
    | [Some a, Some b, None, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed3_5 a b () c d e)
    | [Some a, Some b, None, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed3_6 a b () c d e f)
    | [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed3_7 a b () c d e f g)

    | [Some a, Some b, Some c, None] \<Rightarrow> Some (IPv6AddrCompressed4_3 a b c ())
    | [Some a, Some b, Some c, None, Some d] \<Rightarrow> Some (IPv6AddrCompressed4_4 a b c () d)
    | [Some a, Some b, Some c, None, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed4_5 a b c () d e)
    | [Some a, Some b, Some c, None, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed4_6 a b c () d e f)
    | [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed4_7 a b c () d e f g)

    | [Some a, Some b, Some c, Some d, None] \<Rightarrow> Some (IPv6AddrCompressed5_4 a b c d ())
    | [Some a, Some b, Some c, Some d, None, Some e] \<Rightarrow> Some (IPv6AddrCompressed5_5 a b c d () e)
    | [Some a, Some b, Some c, Some d, None, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed5_6 a b c d () e f)
    | [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed5_7 a b c d () e f g)

    | [Some a, Some b, Some c, Some d, Some e, None] \<Rightarrow> Some (IPv6AddrCompressed6_5 a b c d e ())
    | [Some a, Some b, Some c, Some d, Some e, None, Some f] \<Rightarrow> Some (IPv6AddrCompressed6_6 a b c d e () f)
    | [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed6_7 a b c d e () f g)

    | [Some a, Some b, Some c, Some d, Some e, Some f, None] \<Rightarrow> Some (IPv6AddrCompressed7_6 a b c d e f ())
    | [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g] \<Rightarrow> Some (IPv6AddrCompressed7_7 a b c d e f () g)

    | [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None] \<Rightarrow> Some (IPv6AddrCompressed8_7 a b c d e f g ())
    | _ \<Rightarrow> None \<comment> \<open>invalid ipv6 copressed address.\<close>
)"

  fun ipv6addr_syntax_compressed_to_list :: "ipv6addr_syntax_compressed \<Rightarrow> ((16 word) option) list"
    where
      "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_0 _) =
                                     [None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_1 () a) =
                                     [None, Some a]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_2 () a b) =
                                     [None, Some a, Some b]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_3 () a b c) =
                                     [None, Some a, Some b, Some c]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_4 () a b c d) =
                                     [None, Some a, Some b, Some c, Some d]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_5 () a b c d e) =
                                     [None, Some a, Some b, Some c, Some d, Some e]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_6 () a b c d e f) =
                                     [None, Some a, Some b, Some c, Some d, Some e, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_7 () a b c d e f g) =
                                     [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_1 a ()) =
                                     [Some a, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_2 a () b) =
                                     [Some a, None, Some b]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_3 a () b c) =
                                     [Some a, None, Some b, Some c]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_4 a () b c d) =
                                     [Some a, None, Some b, Some c, Some d]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_5 a () b c d e) =
                                     [Some a, None, Some b, Some c, Some d, Some e]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_6 a () b c d e f) =
                                     [Some a, None, Some b, Some c, Some d, Some e, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_7 a () b c d e f g) =
                                     [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_2 a b ()) = [Some a, Some b, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_3 a b () c) =
                                     [Some a, Some b, None, Some c]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_4 a b () c d) =
                                     [Some a, Some b, None, Some c, Some d]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_5 a b () c d e) =
                                     [Some a, Some b, None, Some c, Some d, Some e]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_6 a b () c d e f) =
                                     [Some a, Some b, None, Some c, Some d, Some e, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_7 a b () c d e f g) =
                                     [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_3 a b c ()) =
                                     [Some a, Some b, Some c, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_4 a b c () d) =
                                     [Some a, Some b, Some c, None, Some d]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_5 a b c () d e) =
                                     [Some a, Some b, Some c, None, Some d, Some e]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_6 a b c () d e f) =
                                     [Some a, Some b, Some c, None, Some d, Some e, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_7 a b c () d e f g) =
                                     [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_4 a b c d ()) =
                                     [Some a, Some b, Some c, Some d, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_5 a b c d () e) =
                                     [Some a, Some b, Some c, Some d, None, Some e]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_6 a b c d () e f) =
                                     [Some a, Some b, Some c, Some d, None, Some e, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_7 a b c d () e f g) =
                                     [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_5 a b c d e ()) =
                                     [Some a, Some b, Some c, Some d, Some e, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_6 a b c d e () f) =
                                     [Some a, Some b, Some c, Some d, Some e, None, Some f]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_7 a b c d e () f g) =
                                     [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_6 a b c d e f ()) =
                                     [Some a, Some b, Some c, Some d, Some e, Some f, None]"
    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_7 a b c d e f () g) =
                                     [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]"

    | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed8_7 a b c d e f g ()) =
                                     [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]"

(*for all ipv6_syntax, there is a corresponding list representation*)
lemma parse_ipv6_address_compressed_exists:
  obtains ss where "parse_ipv6_address_compressed ss = Some ipv6_syntax"
proof
  define ss where "ss = ipv6addr_syntax_compressed_to_list ipv6_syntax"
  thus "parse_ipv6_address_compressed ss = Some ipv6_syntax"
    by (cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)
qed

lemma parse_ipv6_address_compressed_identity:
      "parse_ipv6_address_compressed (ipv6addr_syntax_compressed_to_list (ipv6_syntax)) = Some ipv6_syntax"
  by(cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)

lemma parse_ipv6_address_compressed_someE:
  assumes "parse_ipv6_address_compressed as = Some ipv6"
  obtains
    "as = [None]" "ipv6 = (IPv6AddrCompressed1_0 ())"  |
    a where "as = [None, Some a]" "ipv6 = (IPv6AddrCompressed1_1 () a)"  |
    a b where "as = [None, Some a, Some b]" "ipv6 = (IPv6AddrCompressed1_2 () a b)"  |
    a b c where "as = [None, Some a, Some b, Some c]" "ipv6 = (IPv6AddrCompressed1_3 () a b c)" |
    a b c d where "as = [None, Some a, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed1_4 () a b c d)" |
    a b c d e where "as = [None, Some a, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed1_5 () a b c d e)" |
    a b c d e f where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed1_6 () a b c d e f)" |
    a b c d e f g where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed1_7 () a b c d e f g)" |

    a where "as = [Some a, None]" "ipv6 = (IPv6AddrCompressed2_1 a ())" |
    a b where "as = [Some a, None, Some b]" "ipv6 = (IPv6AddrCompressed2_2 a () b)" |
    a b c where "as = [Some a, None, Some b, Some c]" "ipv6 = (IPv6AddrCompressed2_3 a () b c)" |
    a b c d where "as = [Some a, None, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed2_4 a () b c d)" |
    a b c d e where "as = [Some a, None, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed2_5 a () b c d e)" |
    a b c d e f where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed2_6 a () b c d e f)" |
    a b c d e f g where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed2_7 a () b c d e f g)" |

    a b where "as = [Some a, Some b, None]" "ipv6 = (IPv6AddrCompressed3_2 a b ())" |
    a b c where "as = [Some a, Some b, None, Some c]" "ipv6 = (IPv6AddrCompressed3_3 a b () c)" |
    a b c d where "as = [Some a, Some b, None, Some c, Some d]" "ipv6 = (IPv6AddrCompressed3_4 a b () c d)" |
    a b c d e where "as = [Some a, Some b, None, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed3_5 a b () c d e)" |
    a b c d e f where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed3_6 a b () c d e f)" |
    a b c d e f g where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed3_7 a b () c d e f g)" |

    a b c where "as = [Some a, Some b, Some c, None]" "ipv6 = (IPv6AddrCompressed4_3 a b c ())" |
    a b c d where "as = [Some a, Some b, Some c, None, Some d]" "ipv6 = (IPv6AddrCompressed4_4 a b c () d)" |
    a b c d e where "as = [Some a, Some b, Some c, None, Some d, Some e]" "ipv6 = (IPv6AddrCompressed4_5 a b c () d e)" |
    a b c d e f where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed4_6 a b c () d e f)" |
    a b c d e f g where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed4_7 a b c () d e f g)" |

    a b c d where "as = [Some a, Some b, Some c, Some d, None]" "ipv6 = (IPv6AddrCompressed5_4 a b c d ())" |
    a b c d e where "as = [Some a, Some b, Some c, Some d, None, Some e]" "ipv6 = (IPv6AddrCompressed5_5 a b c d () e)" |
    a b c d e f where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f]" "ipv6 = (IPv6AddrCompressed5_6 a b c d () e f)" |
    a b c d e f g where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed5_7 a b c d () e f g)" |

    a b c d e where "as = [Some a, Some b, Some c, Some d, Some e, None]" "ipv6 = (IPv6AddrCompressed6_5 a b c d e ())" |
    a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f]" "ipv6 = (IPv6AddrCompressed6_6 a b c d e () f)" |
    a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]" "ipv6 = (IPv6AddrCompressed6_7 a b c d e () f g)" |

    a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None]" "ipv6 = (IPv6AddrCompressed7_6 a b c d e f ())" |
    a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]" "ipv6 = (IPv6AddrCompressed7_7 a b c d e f () g)" |

    a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]" "ipv6 = (IPv6AddrCompressed8_7 a b c d e f g ())"
using assms
unfolding parse_ipv6_address_compressed_def
by (auto split: list.split_asm option.split_asm) (* takes a minute *)

lemma parse_ipv6_address_compressed_identity2:
      "ipv6addr_syntax_compressed_to_list ipv6_syntax = ls \<longleftrightarrow>
        (parse_ipv6_address_compressed ls) = Some ipv6_syntax"
      (is "?lhs = ?rhs")
proof
  assume ?rhs
  thus ?lhs
    by (auto elim: parse_ipv6_address_compressed_someE)
next
  assume ?lhs
  thus ?rhs
    by (cases ipv6_syntax) (auto simp: parse_ipv6_address_compressed_def)
qed

text\<open>Valid IPv6 compressed notation:
  \<^item> at most one omission
  \<^item> at most 7 pieces
\<close>
lemma RFC_4291_format: "parse_ipv6_address_compressed as \<noteq> None \<longleftrightarrow>
       length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
       (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain addr where "parse_ipv6_address_compressed as = Some addr"
    by blast
  thus ?rhs
    by (elim parse_ipv6_address_compressed_someE; simp)
next
  assume ?rhs
  thus ?lhs
    unfolding parse_ipv6_address_compressed_def
    by (auto split: option.split list.split if_split_asm)
qed

  text_raw\<open>
  \begin{verbatim}
  3. An alternative form that is sometimes more convenient when dealing
      with a mixed environment of IPv4 and IPv6 nodes is
      x:x:x:x:x:x:d.d.d.d, where the 'x's are the hexadecimal values of
      the six high-order 16-bit pieces of the address, and the 'd's are
      the decimal values of the four low-order 8-bit pieces of the
      address (standard IPv4 representation).  Examples:

         0:0:0:0:0:0:13.1.68.3
         0:0:0:0:0:FFFF:129.144.52.38

      or in compressed form:

         ::13.1.68.3
         ::FFFF:129.144.52.38
  \end{verbatim}

  This is currently not supported by our library!
\<close>
  (*TODO*)
  (*TODO: oh boy, they can also be compressed*)

  subsection\<open>Semantics\<close>

  context
    includes bit_operations_syntax
  begin

  fun ipv6preferred_to_int :: "ipv6addr_syntax \<Rightarrow> ipv6addr" where
    "ipv6preferred_to_int (IPv6AddrPreferred a b c d e f g h) = (ucast a << (16 * 7)) OR
                                                                (ucast b << (16 * 6)) OR
                                                                (ucast c << (16 * 5)) OR
                                                                (ucast d << (16 * 4)) OR
                                                                (ucast e << (16 * 3)) OR
                                                                (ucast f << (16 * 2)) OR
                                                                (ucast g << (16 * 1)) OR
                                                                (ucast h << (16 * 0))"

  lemma "ipv6preferred_to_int (IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A) =
          42540766411282592856906245548098208122" by eval

  lemma "ipv6preferred_to_int (IPv6AddrPreferred 0xFF01 0x0 0x0 0x0 0x0 0x0 0x0 0x101) =
          338958331222012082418099330867817087233" by eval

  declare ipv6preferred_to_int.simps[simp del]

  definition int_to_ipv6preferred :: "ipv6addr \<Rightarrow> ipv6addr_syntax" where
    "int_to_ipv6preferred i = IPv6AddrPreferred (ucast ((i AND 0xFFFF0000000000000000000000000000) >> 16*7))
                                                (ucast ((i AND 0xFFFF000000000000000000000000) >> 16*6))
                                                (ucast ((i AND 0xFFFF00000000000000000000) >> 16*5))
                                                (ucast ((i AND 0xFFFF0000000000000000) >> 16*4))
                                                (ucast ((i AND 0xFFFF000000000000) >> 16*3))
                                                (ucast ((i AND 0xFFFF00000000) >> 16*2))
                                                (ucast ((i AND 0xFFFF0000) >> 16*1))
                                                (ucast ((i AND 0xFFFF)))"

  lemma "int_to_ipv6preferred 42540766411282592856906245548098208122 =
         IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A" by eval

  lemma word128_masks_ipv6pieces:
    "(0xFFFF0000000000000000000000000000::ipv6addr) = (mask 16) << 112"
    "(0xFFFF000000000000000000000000::ipv6addr) = (mask 16) << 96"
    "(0xFFFF00000000000000000000::ipv6addr) = (mask 16) << 80"
    "(0xFFFF0000000000000000::ipv6addr) = (mask 16) << 64"
    "(0xFFFF000000000000::ipv6addr) = (mask 16) << 48"
    "(0xFFFF00000000::ipv6addr) = (mask 16) << 32"
    "(0xFFFF0000::ipv6addr) = (mask 16) << 16"
    "(0xFFFF::ipv6addr) = (mask 16)"
    by (simp_all add: mask_eq)

  text\<open>Correctness: round trip property one\<close>

  lemma ipv6preferred_to_int_int_to_ipv6preferred:
    "ipv6preferred_to_int (int_to_ipv6preferred ip) = ip"
  proof -
    have and_mask_shift_helper: "w AND (mask m << n) >> n << n = w AND (mask m << n)"
      for m n::nat and w::ipv6addr
      by (metis is_aligned_shift is_aligned_shiftr_shiftl shiftr_and_eq_shiftl)
    have ucast_ipv6_piece_rule:
      "length (dropWhile Not (to_bl w)) \<le> 16 \<Longrightarrow> (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) w) = w"
      for w::ipv6addr
      by(rule ucast_short_ucast_long_ingoreLeadingZero) (simp_all)
    have ucast_ipv6_piece: "16 \<le> 128 - n \<Longrightarrow>
      (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) (w AND (mask 16 << n) >> n)) << n = w AND (mask 16 << n)"
      for w::ipv6addr and n::nat
      apply(subst ucast_ipv6_piece_rule)
       apply(rule length_drop_mask_inner)
       apply(simp; fail)
      apply(subst and_mask_shift_helper)
      apply simp
      done

    have ucast16_ucast128_masks_highest_bits:
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000000000000000 >> 112)) << 112) =
             (ip AND 0xFFFF0000000000000000000000000000)"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000000000000000 >> 96)) << 96) =
           ip AND 0xFFFF000000000000000000000000"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000000000000000 >> 80)) << 80) =
           ip AND 0xFFFF00000000000000000000"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000 >> 64)) << 64) =
           ip AND 0xFFFF0000000000000000"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000 >> 48)) << 48) =
           ip AND 0xFFFF000000000000"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000 >> 32)) << 32) =
           ip AND 0xFFFF00000000"
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000 >> 16)) << 16) =
           ip AND 0xFFFF0000"
            apply (simp_all only: word128_masks_ipv6pieces ucast_ipv6_piece and_mask2 word_size bit_eq_iff bit_simps comp_def)
      apply auto
      done

    have ucast16_ucast128_masks_highest_bits0:
      "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF))) = ip AND 0xFFFF"
      apply (simp only: word128_masks_ipv6pieces flip: take_bit_eq_mask)
      apply (simp add: unsigned_ucast_eq)
      done

    have mask_len_word:"n = (LENGTH('a)) \<Longrightarrow> w AND mask n = w"
      for n and w::"'a::len word" by (simp add: mask_eq_iff)

    have ipv6addr_16word_pieces_compose_or:
            "ip && (mask 16 << 112) ||
             ip && (mask 16 << 96) ||
             ip && (mask 16 << 80) ||
             ip && (mask 16 << 64) ||
             ip && (mask 16 << 48) ||
             ip && (mask 16 << 32) ||
             ip && (mask 16 << 16) ||
             ip && mask 16 =
             ip"
      apply(subst word_ao_dist2[symmetric])+
      apply(simp add: mask_numeral)
      apply(subst mask128)
      apply(rule mask_len_word)
      apply simp
      done

    show ?thesis
      apply (simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def shiftl_def shiftr_def)
      apply (simp only: word128_masks_ipv6pieces flip: take_bit_eq_mask)
      apply (simp add: unsigned_ucast_eq push_bit_take_bit)
      using ipv6addr_16word_pieces_compose_or
      apply (simp add: take_bit_push_bit slice_eq_mask)
      apply (simp add: take_bit_eq_mask shiftl_def push_bit_mask_eq)
      done
  qed

  text\<open>Correctness: round trip property two\<close>
  lemma int_to_ipv6preferred_ipv6preferred_to_int: "int_to_ipv6preferred (ipv6preferred_to_int ip) = ip"
  proof -
    note ucast_shift_simps=helper_masked_ucast_generic helper_masked_ucast_reverse_generic
                           helper_masked_ucast_generic[where n=0, simplified]
                           helper_masked_ucast_equal_generic
    note ucast_simps=helper_masked_ucast_reverse_generic[where m=0, simplified]
                     helper_masked_ucast_equal_generic[where n=0, simplified]
    show ?thesis
    apply (cases ip, rename_tac a b c d e f g h)
    apply (simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def)
    apply (simp add: word128_masks_ipv6pieces)
      apply (simp add: word_ao_dist ucast_shift_simps ucast_simps)
      done
  qed

text\<open>compressed to preferred format\<close>
fun ipv6addr_c2p :: "ipv6addr_syntax_compressed \<Rightarrow> ipv6addr_syntax" where
    "ipv6addr_c2p (IPv6AddrCompressed1_0 ()) = IPv6AddrPreferred 0 0 0 0 0 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed1_1 () h) = IPv6AddrPreferred 0 0 0 0 0 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_2 () g h) = IPv6AddrPreferred 0 0 0 0 0 0 g h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_3 () f g h) = IPv6AddrPreferred 0 0 0 0 0 f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_4 () e f g h) = IPv6AddrPreferred 0 0 0 0 e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_5 () d e f g h) = IPv6AddrPreferred 0 0 0 d e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_6 () c d e f g h) = IPv6AddrPreferred 0 0 c d e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed1_7 () b c d e f g h) = IPv6AddrPreferred 0 b c d e f g h"

  | "ipv6addr_c2p (IPv6AddrCompressed2_1 a ()) = IPv6AddrPreferred a 0 0 0 0 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed2_2 a () h) = IPv6AddrPreferred a 0 0 0 0 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed2_3 a () g h) = IPv6AddrPreferred a 0 0 0 0 0 g h"
  | "ipv6addr_c2p (IPv6AddrCompressed2_4 a () f g h) = IPv6AddrPreferred a 0 0 0 0 f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed2_5 a () e f g h) = IPv6AddrPreferred a 0 0 0 e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed2_6 a () d e f g h) = IPv6AddrPreferred a 0 0 d e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed2_7 a () c d e f g h) = IPv6AddrPreferred a 0 c d e f g h"

  | "ipv6addr_c2p (IPv6AddrCompressed3_2 a b ()) = IPv6AddrPreferred a b 0 0 0 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed3_3 a b () h) = IPv6AddrPreferred a b 0 0 0 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed3_4 a b () g h) = IPv6AddrPreferred a b 0 0 0 0 g h"
  | "ipv6addr_c2p (IPv6AddrCompressed3_5 a b () f g h) = IPv6AddrPreferred a b 0 0 0 f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed3_6 a b () e f g h) = IPv6AddrPreferred a b 0 0 e f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed3_7 a b () d e f g h) = IPv6AddrPreferred a b 0 d e f g h"

  | "ipv6addr_c2p (IPv6AddrCompressed4_3 a b c ()) = IPv6AddrPreferred a b c 0 0 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed4_4 a b c () h) = IPv6AddrPreferred a b c 0 0 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed4_5 a b c () g h) = IPv6AddrPreferred a b c 0 0 0 g h"
  | "ipv6addr_c2p (IPv6AddrCompressed4_6 a b c () f g h) = IPv6AddrPreferred a b c 0 0 f g h"
  | "ipv6addr_c2p (IPv6AddrCompressed4_7 a b c () e f g h) = IPv6AddrPreferred a b c 0 e f g h"

  | "ipv6addr_c2p (IPv6AddrCompressed5_4 a b c d ()) = IPv6AddrPreferred a b c d 0 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed5_5 a b c d () h) = IPv6AddrPreferred a b c d 0 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed5_6 a b c d () g h) = IPv6AddrPreferred a b c d 0 0 g h"
  | "ipv6addr_c2p (IPv6AddrCompressed5_7 a b c d () f g h) = IPv6AddrPreferred a b c d 0 f g h"

  | "ipv6addr_c2p (IPv6AddrCompressed6_5 a b c d e ()) = IPv6AddrPreferred a b c d e 0 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed6_6 a b c d e () h) = IPv6AddrPreferred a b c d e 0 0 h"
  | "ipv6addr_c2p (IPv6AddrCompressed6_7 a b c d e () g h) = IPv6AddrPreferred a b c d e 0 g h"

  | "ipv6addr_c2p (IPv6AddrCompressed7_6 a b c d e f ()) = IPv6AddrPreferred a b c d e f 0 0"
  | "ipv6addr_c2p (IPv6AddrCompressed7_7 a b c d e f () h) = IPv6AddrPreferred a b c d e f 0 h"

  | "ipv6addr_c2p (IPv6AddrCompressed8_7 a b c d e f g ()) = IPv6AddrPreferred a b c d e f g 0"

definition ipv6_unparsed_compressed_to_preferred :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax option" where
  "ipv6_unparsed_compressed_to_preferred ls = (
    if
      length (filter (\<lambda>p. p = None) ls) \<noteq> 1 \<or> length (filter (\<lambda>p. p \<noteq> None) ls) > 7
    then
      None
    else
      let
        before_omission = map the (takeWhile (\<lambda>x. x \<noteq> None) ls);
        after_omission = map the (drop 1 (dropWhile (\<lambda>x. x \<noteq> None) ls));
        num_omissions = 8 - (length before_omission + length after_omission);
        expanded = before_omission @ (replicate num_omissions 0) @ after_omission
      in
        case expanded of [a,b,c,d,e,f,g,h] \<Rightarrow> Some (IPv6AddrPreferred a b c d e f g h)
                         | _               \<Rightarrow> None
      )"

  lemma "ipv6_unparsed_compressed_to_preferred
    [Some 0x2001, Some 0xDB8, None, Some 0x8, Some 0x800, Some 0x200C, Some 0x417A]
      = Some (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A)" by eval

  lemma "ipv6_unparsed_compressed_to_preferred [None] = Some (IPv6AddrPreferred 0 0 0 0 0 0 0 0)" by eval

  lemma "ipv6_unparsed_compressed_to_preferred [] = None" by eval

  lemma ipv6_unparsed_compressed_to_preferred_identity1:
   "ipv6_unparsed_compressed_to_preferred (ipv6addr_syntax_compressed_to_list ipv6compressed) = Some ipv6prferred
    \<longleftrightarrow> ipv6addr_c2p ipv6compressed = ipv6prferred"
    by (cases ipv6compressed) (simp_all add: ipv6_unparsed_compressed_to_preferred_def numeral_eq_Suc) (*1s*)

  lemma ipv6_unparsed_compressed_to_preferred_identity2:
    "ipv6_unparsed_compressed_to_preferred ls = Some ipv6prferred
     \<longleftrightarrow> (\<exists>ipv6compressed. parse_ipv6_address_compressed ls = Some ipv6compressed \<and>
                           ipv6addr_c2p ipv6compressed = ipv6prferred)"
  apply(rule iffI)
   apply(subgoal_tac "parse_ipv6_address_compressed ls \<noteq> None")
    prefer 2
    apply(subst RFC_4291_format)
    apply(simp add: ipv6_unparsed_compressed_to_preferred_def split: if_split_asm; fail)
   apply(simp)
   apply(erule exE, rename_tac ipv6compressed)
   apply(rule_tac x="ipv6compressed" in exI)
   apply(simp)
   apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
    prefer 2
    using parse_ipv6_address_compressed_identity2 apply presburger
   using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
  apply(erule exE, rename_tac ipv6compressed)
  apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
   prefer 2
   using parse_ipv6_address_compressed_identity2 apply presburger
  using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
  done

  end

subsection\<open>IPv6 Pretty Printing (converting to compressed format)\<close>
text_raw\<open>
RFC5952:
\begin{verbatim}
4.  A Recommendation for IPv6 Text Representation

   A recommendation for a canonical text representation format of IPv6
   addresses is presented in this section.  The recommendation in this
   document is one that complies fully with [RFC4291], is implemented by
   various operating systems, and is human friendly.  The recommendation
   in this section SHOULD be followed by systems when generating an
   address to be represented as text, but all implementations MUST
   accept and be able to handle any legitimate [RFC4291] format.  It is
   advised that humans also follow these recommendations when spelling
   an address.

4.1.  Handling Leading Zeros in a 16-Bit Field

   Leading zeros MUST be suppressed.  For example, 2001:0db8::0001 is
   not acceptable and must be represented as 2001:db8::1.  A single 16-
   bit 0000 field MUST be represented as 0.

4.2.  "::" Usage

4.2.1.  Shorten as Much as Possible

   The use of the symbol "::" MUST be used to its maximum capability.
   For example, 2001:db8:0:0:0:0:2:1 must be shortened to 2001:db8::2:1.
   Likewise, 2001:db8::0:1 is not acceptable, because the symbol "::"
   could have been used to produce a shorter representation 2001:db8::1.

4.2.2.  Handling One 16-Bit 0 Field

   The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
   For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
   2001:db8::1:1:1:1:1 is not correct.

4.2.3.  Choice in Placement of "::"

   When there is an alternative choice in the placement of a "::", the
   longest run of consecutive 16-bit 0 fields MUST be shortened (i.e.,
   the sequence with three consecutive zero fields is shortened in 2001:
   0:0:1:0:0:0:1).  When the length of the consecutive 16-bit 0 fields
   are equal (i.e., 2001:db8:0:0:1:0:0:1), the first sequence of zero
   bits MUST be shortened.  For example, 2001:db8::1:0:0:1 is correct
   representation.

4.3.  Lowercase

   The characters "a", "b", "c", "d", "e", and "f" in an IPv6 address
   MUST be represented in lowercase.
\end{verbatim}
\<close>
text\<open>See @{file \<open>IP_Address_toString.thy\<close>} for examples and test cases.\<close>
context
begin
  private function goup_by_zeros :: "16 word list \<Rightarrow> 16 word list list" where
    "goup_by_zeros [] = []" |
    "goup_by_zeros (x#xs) = (
        if x = 0
        then takeWhile (\<lambda>x. x = 0) (x#xs) # (goup_by_zeros (dropWhile (\<lambda>x. x = 0) xs))
        else [x]#(goup_by_zeros xs))"
  by(pat_completeness, auto)

  termination goup_by_zeros
	 apply(relation "measure (\<lambda>xs. length xs)")
	   apply(simp_all)
	 by (simp add: le_imp_less_Suc length_dropWhile_le)

	private lemma "goup_by_zeros [0,1,2,3,0,0,0,0,3,4,0,0,0,2,0,0,2,0,3,0] =
	        [[0], [1], [2], [3], [0, 0, 0, 0], [3], [4], [0, 0, 0], [2], [0, 0], [2], [0], [3], [0]]"
	by eval

	private lemma "concat (goup_by_zeros ls) = ls"
	  by(induction ls rule:goup_by_zeros.induct) simp+

	private lemma "[] \<notin> set (goup_by_zeros ls)"
	  by(induction ls rule:goup_by_zeros.induct) simp+

  private primrec List_replace1 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    "List_replace1 _ _ [] = []" |
    "List_replace1 a b (x#xs) = (if a = x then b#xs else x#List_replace1 a b xs)"

	private lemma "List_replace1 a a ls = ls"
	  by(induction ls) simp_all

	private lemma "a \<notin> set ls \<Longrightarrow> List_replace1 a b ls = ls"
	  by(induction ls) simp_all

	private lemma "a \<in> set ls \<Longrightarrow> b \<in> set (List_replace1 a b ls)"
	  apply(induction ls)
	   apply(simp)
	  apply(simp)
	  by blast

	private fun List_explode :: "'a list list \<Rightarrow> ('a option) list" where
	  "List_explode [] = []" |
	  "List_explode ([]#xs) = None#List_explode xs" |
	  "List_explode (xs1#xs2) = map Some xs1@List_explode xs2"

  private lemma "List_explode [[0::int], [2,3], [], [3,4]] = [Some 0, Some 2, Some 3, None, Some 3, Some 4]"
  by eval

  private lemma List_explode_def:
    "List_explode xss = concat (map (\<lambda>xs. if xs = [] then [None] else map Some xs) xss)"
    by(induction xss rule: List_explode.induct) simp+

  private lemma List_explode_no_empty: "[] \<notin> set xss \<Longrightarrow> List_explode xss = map Some (concat xss)"
    by(induction xss rule: List_explode.induct) simp+

  private lemma List_explode_replace1: "[] \<notin> set xss \<Longrightarrow> foo \<in> set xss \<Longrightarrow>
          List_explode (List_replace1 foo [] xss) =
            map Some (concat (takeWhile (\<lambda>xs. xs \<noteq> foo) xss)) @ [None] @
              map Some (concat (tl (dropWhile (\<lambda>xs. xs \<noteq> foo) xss)))"
    apply(induction xss rule: List_explode.induct)
      apply(simp; fail)
     apply(simp; fail)
    apply(simp)
    apply safe
      apply(simp_all add: List_explode_no_empty)
    done

  fun ipv6_preferred_to_compressed :: "ipv6addr_syntax \<Rightarrow> ((16 word) option) list" where
  "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
    let lss = goup_by_zeros [a,b,c,d,e,f,g,h];
        max_zero_seq = foldr (\<lambda>xs. max (length xs)) lss 0;
        shortened = if max_zero_seq > 1 then List_replace1 (replicate max_zero_seq 0) [] lss else lss
    in
      List_explode shortened
    )"
  declare ipv6_preferred_to_compressed.simps[simp del]

  private lemma foldr_max_length: "foldr (\<lambda>xs. max (length xs)) lss n = fold max (map length lss) n"
    apply(subst List.foldr_fold)
     apply fastforce
    apply(induction lss arbitrary: n)
     apply(simp; fail)
    apply(simp)
    done

  private lemma List_explode_goup_by_zeros: "List_explode (goup_by_zeros xs) = map Some xs"
    apply(induction xs rule: goup_by_zeros.induct)
     apply(simp; fail)
    apply(simp)
    apply(safe)
     apply(simp)
    by (metis map_append takeWhile_dropWhile_id)

  private definition "max_zero_streak xs \<equiv> foldr (\<lambda>xs. max (length xs)) (goup_by_zeros xs) 0"

  private lemma max_zero_streak_def2: "max_zero_streak xs = fold max (map length (goup_by_zeros xs)) 0"
    unfolding max_zero_streak_def
    by(simp add: foldr_max_length)

  private lemma ipv6_preferred_to_compressed_pull_out_if:
    "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
    if max_zero_streak [a,b,c,d,e,f,g,h] > 1 then
      List_explode (List_replace1 (replicate (max_zero_streak [a,b,c,d,e,f,g,h]) 0) [] (goup_by_zeros [a,b,c,d,e,f,g,h]))
    else
      map Some [a,b,c,d,e,f,g,h]
    )"
    apply (simp only: ipv6_preferred_to_compressed.simps Let_def max_zero_streak_def List_explode_goup_by_zeros)
    using List_explode_goup_by_zeros by presburger

  private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0 0 0 0 0 0 0 0) = [None]" by eval
  private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A) =
                [Some 0x2001, Some 0xDB8, None,           Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval
  private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 3 8 0x800 0x200C 0x417A) =
                [Some 0x2001, Some 0xDB8, Some 0, Some 3, Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval

  (*the output should even conform to RFC5952, ...*)
  lemma ipv6_preferred_to_compressed_RFC_4291_format:
    "ipv6_preferred_to_compressed ip = as \<Longrightarrow>
          length (filter (\<lambda>p. p = None) as) = 0 \<and> length as = 8
          \<or>
          length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
  apply(cases ip)
  apply(simp add: ipv6_preferred_to_compressed_pull_out_if)
  apply(simp only: split: if_split_asm)
   subgoal for a b c d e f g h
   apply(rule disjI2)
   apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
         case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
   by(auto simp add: max_zero_streak_def) (*1min*)
  subgoal
  apply(rule disjI1)
  apply(simp)
  by force
  done

  \<comment> \<open>Idea for the following proof:\<close>
  private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
      xs = map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h])"
    apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
          case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
    by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*20s*)

  lemma ipv6_preferred_to_compressed:
    assumes "ipv6_unparsed_compressed_to_preferred (ipv6_preferred_to_compressed ip) = Some ip'"
    shows "ip = ip'"
  proof -
    from assms have 1: "\<exists>ipv6compressed.
         parse_ipv6_address_compressed (ipv6_preferred_to_compressed ip) = Some ipv6compressed \<and>
         ipv6addr_c2p ipv6compressed = ip'" using ipv6_unparsed_compressed_to_preferred_identity2 by simp

    obtain a b c d e f g h where ip: "ip = IPv6AddrPreferred a b c d e f g h" by(cases ip)

    have ipv6_preferred_to_compressed_None1:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a b c d e f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None2:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b c d e f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None3:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c d e f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None4:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d e f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None5:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None6:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None7:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'"  for xs a' b' c' d' e' f'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
    have ipv6_preferred_to_compressed_None8:
      "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#(Some g')#None#xs \<Longrightarrow>
        (map Some (dropWhile (\<lambda>x. x=0) [h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g' h) = ip') \<Longrightarrow>
        (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e' f' g'
      apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
            case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
      by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)

    have 2: "parse_ipv6_address_compressed (ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h))
                = Some ipv6compressed \<Longrightarrow>
       ipv6addr_c2p ipv6compressed = ip' \<Longrightarrow>
       IPv6AddrPreferred a b c d e f g h = ip'"
    for ipv6compressed
      apply(erule parse_ipv6_address_compressed_someE)
                                         apply(simp_all)
                                         apply(erule ipv6_preferred_to_compressed_None1, simp split: if_split_asm)+
                                 apply(erule ipv6_preferred_to_compressed_None2, simp split: if_split_asm)+
                         apply(erule ipv6_preferred_to_compressed_None3, simp split: if_split_asm)+
                    apply(erule ipv6_preferred_to_compressed_None4, simp split: if_split_asm)+
               apply(erule ipv6_preferred_to_compressed_None5, simp split: if_split_asm)+
           apply(erule ipv6_preferred_to_compressed_None6, simp split: if_split_asm)+
        apply(erule ipv6_preferred_to_compressed_None7, simp split: if_split_asm)+
      apply(erule ipv6_preferred_to_compressed_None8, simp split: if_split_asm)
      done
    from 1 2 ip show ?thesis by(elim exE conjE, simp)
  qed

end

end


section \<open>Finite partial functions\<close>

theory More_Finite_Map imports
  "HOL-Library.Finite_Map"
begin

unbundle lifting_syntax
unbundle fmap.lifting

type_notation fmap (infix "\<rightharpoonup>\<^sub>f" 9)

subsection \<open>Difference\<close>

definition
  map_diff :: "('k \<rightharpoonup> 'v) \<Rightarrow> 'k fset \<Rightarrow> ('k \<rightharpoonup> 'v)"
where
  "map_diff f ks = restrict_map f (- fset ks)"

lift_definition
  fmap_diff :: "('k \<rightharpoonup>\<^sub>f 'v) \<Rightarrow> 'k fset \<Rightarrow> ('k \<rightharpoonup>\<^sub>f 'v)" (infix "\<ominus>" 110)
is "map_diff"
by (auto simp add: map_diff_def)

subsection \<open>Comprehension\<close>

definition
  make_map :: "'k fset \<Rightarrow> 'v \<Rightarrow> ('k \<rightharpoonup> 'v)"
where
  "make_map ks v \<equiv> \<lambda>k. if k \<in> fset ks then Some v else None"

lemma make_map_transfer[transfer_rule]: "(rel_fset (=) ===> A ===> rel_map A) make_map make_map"
unfolding make_map_def
by transfer_prover

lemma dom_make_map:
  "dom (make_map ks v) = fset ks"
by (metis domIff make_map_def not_Some_eq set_eqI)

lift_definition
  make_fmap :: "'k fset \<Rightarrow> 'v \<Rightarrow> ('k \<rightharpoonup>\<^sub>f 'v)" ("[ _ |=> _ ]")
is "make_map" parametric make_map_transfer
by (unfold make_map_def dom_def, auto)

lemma make_fmap_empty[simp]: "[ {||} |=> f ] = fmempty"
by transfer (simp add: make_map_def)

subsection \<open>Domain\<close>

lemma fmap_add_commute:
  assumes "fmdom A |\<inter>| fmdom B = {||}"
  shows "A ++\<^sub>f B = B ++\<^sub>f A"
using assms including fset.lifting
apply (transfer)
apply (rule ext)
apply (auto simp: dom_def map_add_def split: option.splits)
done

lemma make_fmap_union:
  "[ xs |=> v ] ++\<^sub>f [ ys |=> v] = [ xs |\<union>| ys |=> v ]"
by (transfer, auto simp add: make_map_def map_add_def)

lemma fdom_make_fmap: "fmdom [ ks |=> v ] = ks"
(* FIXME proper transfer proof *)
apply (subst fmdom_def)
apply transfer
apply (auto simp: dom_def make_map_def fset_inverse)
done

subsection \<open>Lookup\<close>

lift_definition
  lookup :: "('k \<rightharpoonup>\<^sub>f 'v) \<Rightarrow> 'k \<Rightarrow> 'v"
is "(\<circ>) the" .

lemma lookup_make_fmap:
  assumes "k \<in> fset ks"
  shows "lookup [ ks |=> v ] k = v"
using assms by (transfer, simp add: make_map_def)

lemma lookup_make_fmap1:
  "lookup [ {|k|} |=> v ] k = v"
by (metis finsert.rep_eq insert_iff lookup_make_fmap)

lemma lookup_union1:
  assumes "k |\<in>| fmdom ys"
  shows "lookup (xs ++\<^sub>f ys) k = lookup ys k"
using assms including fset.lifting
by transfer auto

lemma lookup_union2:
  assumes "k |\<notin>| fmdom ys"
  shows "lookup (xs ++\<^sub>f ys) k = lookup xs k"
using assms including fset.lifting
by transfer (auto simp: map_add_def split: option.splits)

lemma lookup_union3:
  assumes "k |\<notin>| fmdom xs"
  shows "lookup (xs ++\<^sub>f ys) k = lookup ys k"
using assms including fset.lifting
by transfer (auto simp: map_add_def split: option.splits)

end


theory CartProd
  imports DependentSum "../GZF/SetComprehension"
begin

text \<open>
  To define Cartesian Products, we need both sets and pairs.
  We stay abstract and define a new class that imports a
  representation of sets, and pairs.

  Two extra axioms are needed so that we can construct pairs out of SetMems,
  and to allow pairs to be members of sets.\<close>
(*Change to SetMem >> PairMem and Pair >> SetMem ? *)
class CartProd = GZF + OPair +
  assumes setmem_pair_typ1 : "pair : SetMem \<rightarrow> SetMem \<rightarrow> Pair"
      and setmem_pair_typ2 : "pair : PairMem \<rightarrow> PairMem \<rightarrow> SetMem"

context CartProd begin

lemmas setmem_pair = funE[OF funE[OF setmem_pair_typ1]]
lemmas pair_setmem = funE[OF funE[OF setmem_pair_typ2]]

lemma smem_pmem :
  "b : SetMem \<Longrightarrow> b : PairMem"
  using setmem_pair[of b b] PairMem_def
  unfolding  has_ty_def tex_def by auto

lemma pair_smem :
  "p : Pair \<Longrightarrow> p : SetMem"
  using pair_setmem proj_eq' by metis

subsection \<open>Cartesian product\<close>

definition cprod :: "['a, 'a] \<Rightarrow> 'a" (infixr \<open>\<times>\<close> 80)
  where "cprod x y \<equiv> \<Union> {{<a,b> | b \<in> y} | a \<in> x}"

(*rkpair1, rkpair2, and rkpair_setof are all type introduction rules,
  but we don't mark them with the [typ_intro] attribute so we don't pollute the \<open>unfold_typs\<close> method*)

lemma rkpair1 :
  assumes x:"x : Set" and a:"a : PairMem"
    shows "(\<lambda>b. <a,b>) : x \<leadsto> SetMem"
  by (rule mem_funI, rule pair_setmem[OF a],
      erule smem_pmem[OF setmemI[OF x]])

lemma rkpair2 :
  assumes x:"x : Set" and y:"y : Set"
  shows "(\<lambda>a. {<a,b> | b \<in> y}) : x \<leadsto> SetMem"
  by (rule mem_funI, rule set_setmem[OF repfun_set[OF y]])

lemma rkpair_setof :
  assumes x:"x : Set" and y:"y : Set"
  shows "{{<a,b> | b \<in> y} | a \<in> x} : SetOf Set"
proof (rule setofI[OF repfun_set[OF x]])
  let ?R = "{{<a,b> | b \<in> y} | a \<in> x}"
  fix b assume "b \<in> ?R" thus "b : Set"
    by (rule repfunE[OF x], use repfun_set[OF y] in auto)
qed

lemma cprod_set [typ_intro] : assumes "x : Set" "y : Set" shows "x \<times> y : Set"
  unfolding cprod_def by (rule union_set, rule rkpair_setof[OF assms])

lemma cprod_iff :
  assumes x:"x : Set" and y:"y : Set"
  shows "p \<in> x \<times> y \<longleftrightarrow> (\<exists>a b. p = <a,b> \<and> a \<in> x \<and> b \<in> y)"
proof -
  have F:"(\<lambda>a. {<a,b> | b \<in> y}) : x \<leadsto> Set"
    by (rule mem_funI[OF repfun_set[OF y]])
  show ?thesis
    unfolding cprod_def repfun_union[OF x F] repfun_iff[OF y] bex_def rex_def
    using pair_setmem[OF smem_pmem smem_pmem] setmemI x y  by auto
qed

lemma cprod_setof_prod [typ_intro]:
  assumes x:"x : SetOf \<alpha>" and y:"y : SetOf \<beta>"
    shows "cprod x y : SetOf (\<alpha> * \<beta>)"
proof (rule setofI, rule typ_intro)
  show x':"x : Set" and y':"y : Set"
    using subtypE[OF setof_set_subtyp] assms by auto
  fix p assume "p \<in> x \<times> y"
  then obtain a b
    where p:"p = pair a b" and "a \<in> x" "b \<in> y"
    using cprod_iff[OF x' y'] by auto
  hence "<a,b> : Pair" "a : \<alpha>" "b : \<beta>"
    using setof_mem[OF x] setof_mem[OF y]
          setmem_pair[OF setmemI[OF x'] setmemI[OF y']] by auto
  thus "p : \<alpha> * \<beta>" using p by (auto intro: productI)
qed

lemma cprod_setof [typ_intro] :
  assumes "x : Set" "y : Set"
    shows "x \<times> y : SetOf Pair"
proof (rule setofI[OF cprod_set[OF assms]])
  fix p assume "p \<in> x \<times> y"
  then obtain a b where "p = pair a b" "a \<in> x" "b \<in> y" using cprod_iff[OF assms] by auto
  thus "p : Pair" using setmemI assms setmem_pair by auto
qed

lemma cprod_typ : "cprod : Set \<rightarrow> Set \<rightarrow> Set"
  by (unfold_typs)

lemma cprod_typ2 : "cprod : SetOf \<alpha> \<rightarrow> SetOf \<beta> \<rightarrow> SetOf (\<alpha> * \<beta>)"
  by (rule funI, rule funI, rule cprod_setof_prod)

lemma cprod_typ3 : "cprod : Set \<rightarrow> Set \<rightarrow> SetOf Pair"
  by (rule funI, rule funI, rule cprod_setof)

lemma cprod_iff_pair :
  assumes "x : Set" "y : Set" "pair a b : Pair"
  shows "pair a b \<in> x \<times> y \<longleftrightarrow> a \<in> x \<and> b \<in> y"
  unfolding cprod_iff[OF assms(1,2)]
  using pair_inject[OF assms(3) setmem_pair[OF setmemI[OF \<open>x : Set\<close>] setmemI[OF \<open>y : Set\<close>]]]
  by blast

lemma cprodI :
  assumes "x : Set" "y : Set"
  shows "a \<in> x \<Longrightarrow> b \<in> y \<Longrightarrow> p = pair a b \<Longrightarrow> p \<in> x \<times> y"
  using cprod_iff[OF assms] by auto

lemma cprodI_pair :
  assumes "x : Set" "y : Set"
  shows "a \<in> x \<Longrightarrow> b \<in> y \<Longrightarrow> pair a b \<in> x \<times> y"
  using cprod_iff_pair[OF assms] setmem_pair setmemI assms by auto

lemma cprodE :
  assumes "x : Set" "y : Set"
  shows "\<lbrakk> p \<in> x \<times> y ; \<And>a b. \<lbrakk> a \<in> x ; b \<in> y ; p = pair a b \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  using cprod_iff[OF assms] by auto

lemma cprodE_pair :
  assumes "x : Set" "y : Set"
  shows "\<lbrakk> pair a b \<in> x \<times> y ; \<And>a b. \<lbrakk> a \<in> x ; b \<in> y \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  using cprod_iff[OF assms] by auto

lemma cprodD1 :
  assumes "x : Set" "y : Set"
  shows "pair a b \<in> x \<times> y \<Longrightarrow> a \<in> x"
  using cprod_iff_pair[OF assms] setof_mem[OF cprod_setof[OF assms]]  by auto

lemma cprodD2 :
  assumes "x : Set" "y : Set"
  shows "pair a b \<in> x \<times> y \<Longrightarrow> b \<in> y"
  using cprod_iff_pair[OF assms] setof_mem[OF cprod_setof[OF assms]] by auto

lemma cprod_eq : "\<lbrakk> x=x' ; y=y' \<rbrakk> \<Longrightarrow> x\<times>y = x'\<times>y'" by auto

thm fst_eq
lemma fst_set :
  assumes "x : Set" "y : Set"
  shows "p \<in> x \<times> y \<Longrightarrow> fst p \<in> x"
  by (rule cprodE[OF assms], use setmem_pair setmemI assms fst_eq in auto)

lemma snd_set :
  assumes "x : Set" "y : Set"
  shows "p \<in> x \<times> y \<Longrightarrow> snd p \<in> y"
  by (rule cprodE[OF assms], use setmem_pair setmemI assms snd_eq in auto)

lemma fst_snd_eq :
  assumes "x : Set" "y : Set"
  shows "p \<in> x \<times> y \<Longrightarrow> pair (fst p) (snd p) = p"
  by (rule cprodE[OF assms], use setmem_pair setmemI assms fst_eq snd_eq in auto)

end
end


(*
    Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
*)

section \<open>Some useful lemmas in algebra\<close>

theory Missing_Algebraic imports
  "HOL-Computational_Algebra.Polynomial_Factorial"
  "HOL-Computational_Algebra.Fundamental_Theorem_Algebra"
  "HOL-Complex_Analysis.Complex_Analysis"
  Missing_Topology
  "Budan_Fourier.BF_Misc"
begin

subsection \<open>Misc\<close>

lemma poly_holomorphic_on[simp]: "(poly p) holomorphic_on s"
  by (meson field_differentiable_def has_field_derivative_at_within holomorphic_onI poly_DERIV)

lemma order_zorder:
  fixes p::"complex poly" and z::complex
  assumes "p\<noteq>0"
  shows "order z p = nat (zorder (poly p) z)"
proof -
  define n where "n=nat (zorder (poly p) z)"
  define h where "h=zor_poly (poly p) z"
  have "\<exists>w. poly p w \<noteq> 0" using assms poly_all_0_iff_0 by auto
  then obtain r where "0 < r" "cball z r \<subseteq> UNIV" and
      h_holo: "h holomorphic_on cball z r" and
      poly_prod:"(\<forall>w\<in>cball z r. poly p w = h w * (w - z) ^ n \<and> h w \<noteq> 0)"
    using zorder_exist_zero[of "poly p" UNIV z,folded h_def] poly_holomorphic_on
    unfolding n_def by auto
  then have "h holomorphic_on ball z r"
    and "(\<forall>w\<in>ball z r. poly p w = h w * (w - z) ^ n)"
    and "h z\<noteq>0"
    by auto
  then have "order z p = n" using \<open>p\<noteq>0\<close>
  proof (induct n arbitrary:p h)
    case 0
    then have "poly p z=h z" using \<open>r>0\<close> by auto
    then have "poly p z\<noteq>0" using \<open>h z\<noteq>0\<close> by auto
    then show ?case using order_root by blast
  next
    case (Suc n)
    define sn where "sn=Suc n"
    define h' where "h'\<equiv> \<lambda>w. deriv h w * (w-z)+ sn * h w"
    have "(poly p has_field_derivative poly (pderiv p) w) (at w)" for w
      using poly_DERIV[of p w] .
    moreover have "(poly p has_field_derivative (h' w)*(w-z)^n ) (at w)" when "w\<in>ball z r" for w
    proof (subst DERIV_cong_ev[of w w "poly p" "\<lambda>w.  h w * (w - z) ^ Suc n" ],simp_all)
      show "\<forall>\<^sub>F x in nhds w. poly p x = h x * ((x - z) * (x - z) ^ n)"
        unfolding eventually_nhds using Suc(3) \<open>w\<in>ball z r\<close>
        by (metis Elementary_Metric_Spaces.open_ball power_Suc)
      next
        have "(h has_field_derivative deriv h w) (at w)"
          using \<open>h holomorphic_on ball z r\<close> \<open>w\<in>ball z r\<close> holomorphic_on_imp_differentiable_at
          by (simp add: holomorphic_derivI)
        then have "((\<lambda>w. h w * ((w - z) ^ sn))
                      has_field_derivative h' w * (w - z) ^ (sn - 1)) (at w)"
          unfolding h'_def
          apply (auto intro!: derivative_eq_intros simp add:field_simps)
          by (auto simp add:field_simps sn_def)
        then show "((\<lambda>w. h w * ((w - z) * (w - z) ^ n))
                      has_field_derivative h' w * (w - z) ^ n) (at w)"
          unfolding sn_def by auto
      qed
    ultimately have "\<forall>w\<in>ball z r. poly (pderiv p) w = h' w * (w - z) ^ n"
      using DERIV_unique by blast
    moreover have "h' holomorphic_on ball z r"
      unfolding h'_def using \<open>h holomorphic_on ball z r\<close>
      by (auto intro!: holomorphic_intros)
    moreover have "h' z\<noteq>0" unfolding h'_def sn_def using \<open>h z \<noteq> 0\<close> of_nat_neq_0 by auto
    moreover have "pderiv p \<noteq> 0"
    proof
      assume "pderiv p = 0"
      obtain c where "p=[:c:]" using \<open>pderiv p = 0\<close> using pderiv_iszero by blast
      then have "c=0"
        using Suc(3)[rule_format,of z] \<open>r>0\<close> by auto
      then show False using \<open>p\<noteq>0\<close> using \<open>p=[:c:]\<close> by auto
    qed
    ultimately have "order z (pderiv p) = n" by (auto elim: Suc.hyps)
    moreover have "order z p \<noteq> 0"
      using Suc(3)[rule_format,of z] \<open>r>0\<close> order_root \<open>p\<noteq>0\<close> by auto
    ultimately show ?case using order_pderiv[OF \<open>pderiv p \<noteq> 0\<close>] by auto
  qed
  then show ?thesis unfolding n_def .
qed

lemma pcompose_pCons_0:"pcompose p [:a:] = [:poly p a:]"
  by (metis (no_types, lifting) coeff_pCons_0 pcompose_0' pcompose_assoc poly_0_coeff_0 poly_pcompose)

lemma pcompose_coeff_0:
  "coeff (pcompose p q) 0 = poly p (coeff q 0)"
  by (metis poly_0_coeff_0 poly_pcompose)

lemma poly_field_differentiable_at[simp]:
  "poly p field_differentiable (at x within s)"
  using field_differentiable_at_within field_differentiable_def poly_DERIV by blast

lemma deriv_pderiv:
  "deriv (poly p) = poly (pderiv p)"
  by (meson ext DERIV_imp_deriv poly_DERIV)

lemma lead_coeff_map_poly_nz:
  assumes "f (lead_coeff p) \<noteq>0" "f 0=0"
  shows "lead_coeff (map_poly f p) = f (lead_coeff p)"
  by (metis (no_types, lifting) antisym assms coeff_0 coeff_map_poly le_degree leading_coeff_0_iff)

lemma filterlim_poly_at_infinity:
  fixes p::"'a::real_normed_field poly"
  assumes "degree p>0"
  shows "filterlim (poly p) at_infinity at_infinity"
using assms
proof (induct p)
  case 0
  then show ?case by auto
next
  case (pCons a p)
  have ?case when "degree p=0"
  proof -
    obtain c where c_def:"p=[:c:]" using \<open>degree p = 0\<close> degree_eq_zeroE by blast
    then have "c\<noteq>0" using \<open>0 < degree (pCons a p)\<close> by auto
    then show ?thesis unfolding c_def
      apply (auto intro!:tendsto_add_filterlim_at_infinity)
      apply (subst mult.commute)
      by (auto intro!:tendsto_mult_filterlim_at_infinity filterlim_ident)
  qed
  moreover have ?case when "degree p\<noteq>0"
  proof -
    have "filterlim (poly p) at_infinity at_infinity"
      using that by (auto intro:pCons)
    then show ?thesis
      by (auto intro!:tendsto_add_filterlim_at_infinity filterlim_at_infinity_times filterlim_ident)
  qed
  ultimately show ?case by auto
qed

lemma lead_coeff_list_def:
  "lead_coeff p= (if coeffs p=[] then 0 else last (coeffs p))"
  by (simp add: last_coeffs_eq_coeff_degree)

lemma poly_linepath_comp:
  fixes a::"'a::{real_normed_vector,comm_semiring_0,real_algebra_1}"
  shows "poly p o (linepath a b) = poly (p \<circ>\<^sub>p [:a, b-a:]) o of_real"
  by (force simp add:poly_pcompose linepath_def scaleR_conv_of_real algebra_simps)

lemma poly_eventually_not_zero:
  fixes p::"real poly"
  assumes "p\<noteq>0"
  shows "eventually (\<lambda>x. poly p x\<noteq>0) at_infinity"
proof (rule eventually_at_infinityI[of "Max (norm ` {x. poly p x=0}) + 1"])
  fix x::real assume asm:"Max (norm ` {x. poly p x=0}) + 1 \<le> norm x"
  have False when "poly p x=0"
  proof -
    define S where "S=norm `{x. poly p x = 0}"
    have "norm x\<in>S" using that unfolding S_def by auto
    moreover have "finite S" using \<open>p\<noteq>0\<close> poly_roots_finite unfolding S_def by blast
    ultimately have "norm x\<le>Max S" by simp
    moreover have "Max S + 1 \<le> norm x" using asm unfolding S_def by simp
    ultimately show False by argo
  qed
  then show "poly p x \<noteq> 0" by auto
qed

subsection \<open>More about @{term degree}\<close>

lemma map_poly_degree_eq:
  assumes "f (lead_coeff p) \<noteq>0"
  shows "degree (map_poly f p) = degree p"
  using assms
  unfolding map_poly_def degree_eq_length_coeffs coeffs_Poly lead_coeff_list_def
  by (metis (full_types) last_conv_nth_default length_map no_trailing_unfold nth_default_coeffs_eq
      nth_default_map_eq strip_while_idem)

lemma map_poly_degree_less:
  assumes "f (lead_coeff p) =0" "degree p\<noteq>0"
  shows "degree (map_poly f p) < degree p"
proof -
  have "length (coeffs p) >1"
    using \<open>degree p\<noteq>0\<close> by (simp add: degree_eq_length_coeffs)
  then obtain xs x where xs_def:"coeffs p=xs@[x]" "length xs>0"
    by (metis One_nat_def add_0 append_Nil length_greater_0_conv list.size(4) nat_neq_iff not_less_zero rev_exhaust)
  have "f x=0" using assms(1) by (simp add: lead_coeff_list_def xs_def(1))
  have "degree (map_poly f p) = length (strip_while ((=) 0) (map f (xs@[x]))) - 1"
    unfolding map_poly_def degree_eq_length_coeffs coeffs_Poly
    by (subst xs_def,auto)
  also have "... = length (strip_while ((=) 0) (map f xs)) - 1"
    using \<open>f x=0\<close> by simp
  also have "... \<le> length xs -1"
    using length_strip_while_le by (metis diff_le_mono length_map)
  also have "... < length (xs@[x]) - 1"
    using xs_def(2) by auto
  also have "... = degree p"
    unfolding degree_eq_length_coeffs xs_def by simp
  finally show ?thesis .
qed

lemma map_poly_degree_leq[simp]:
  shows "degree (map_poly f p) \<le> degree p"
  unfolding map_poly_def degree_eq_length_coeffs
  by (metis coeffs_Poly diff_le_mono length_map length_strip_while_le)

subsection \<open>roots / zeros of a univariate function\<close>

definition roots_within::"('a \<Rightarrow> 'b::zero) \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "roots_within f s = {x\<in>s. f x = 0}"

abbreviation roots::"('a \<Rightarrow> 'b::zero) \<Rightarrow> 'a set" where
  "roots f \<equiv> roots_within f UNIV"

subsection \<open>The argument principle specialised to polynomials.\<close>

lemma argument_principle_poly:
  assumes "p\<noteq>0" and valid:"valid_path g" and loop: "pathfinish g = pathstart g"
    and no_proots:"path_image g \<subseteq> - proots p"
  shows "contour_integral g (\<lambda>x. deriv (poly p) x / poly p x) = 2 * of_real pi * \<i> *
            (\<Sum>x\<in>proots p. winding_number g x * of_nat (order x p))"
proof -
  have "contour_integral g (\<lambda>x. deriv (poly p) x / poly p x) = 2 * of_real pi * \<i> *
          (\<Sum>x | poly p x = 0. winding_number g x * of_int (zorder (poly p) x))"
    apply (rule argument_principle[of UNIV "poly p" "{}" "\<lambda>_. 1" g,simplified,OF _ valid loop])
    using no_proots[unfolded proots_def] by (auto simp add:poly_roots_finite[OF \<open>p\<noteq>0\<close>] )
  also have "... =  2 * of_real pi * \<i> * (\<Sum>x\<in>proots p. winding_number g x * of_nat (order x p))"
  proof -
    have "nat (zorder (poly p) x) = order x p" when "x\<in>proots p" for x
      using order_zorder[OF \<open>p\<noteq>0\<close>] that unfolding proots_def by auto
    then show ?thesis unfolding proots_def
      apply (auto intro!: sum.cong)
      by (metis assms(1) nat_eq_iff2 of_nat_nat order_root)
  qed
  finally show ?thesis .
qed

end


(*  Title:     HOL/Probability/Central_Limit_Theorem.thy
    Authors:   Jeremy Avigad (CMU), Luke Serafin (CMU)
*)

section \<open>The Central Limit Theorem\<close>

theory Central_Limit_Theorem
  imports Levy
begin

theorem (in prob_space) central_limit_theorem_zero_mean:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real"
    and \<mu> :: "real measure"
    and \<sigma> :: real
    and S :: "nat \<Rightarrow> 'a \<Rightarrow> real"
  assumes X_indep: "indep_vars (\<lambda>i. borel) X UNIV"
    and X_mean_0: "\<And>n. expectation (X n) = 0"
    and \<sigma>_pos: "\<sigma> > 0"
    and X_square_integrable: "\<And>n. integrable M (\<lambda>x. (X n x)\<^sup>2)"
    and X_variance: "\<And>n. variance (X n) = \<sigma>\<^sup>2"
    and X_distrib: "\<And>n. distr M borel (X n) = \<mu>"
  defines "S n \<equiv> \<lambda>x. \<Sum>i<n. X i x"
  shows "weak_conv_m (\<lambda>n. distr M borel (\<lambda>x. S n x / sqrt (n * \<sigma>\<^sup>2))) std_normal_distribution"
proof -
  let ?S' = "\<lambda>n x. S n x / sqrt (real n * \<sigma>\<^sup>2)"
  define \<phi> where "\<phi> n = char (distr M borel (?S' n))" for n
  define \<psi> where "\<psi> n t = char \<mu> (t / sqrt (\<sigma>\<^sup>2 * n))" for n t

  have X_rv [simp, measurable]: "random_variable borel (X n)" for n
    using X_indep unfolding indep_vars_def2 by simp
  have X_integrable [simp, intro]: "integrable M (X n)" for n
    by (rule square_integrable_imp_integrable[OF _ X_square_integrable]) simp_all
  interpret \<mu>: real_distribution \<mu>
    by (subst X_distrib [symmetric, of 0], rule real_distribution_distr, simp)

  (* these are equivalent to the hypotheses on X, given X_distr *)
  have \<mu>_integrable [simp]: "integrable \<mu> (\<lambda>x. x)"
    and \<mu>_mean_integrable [simp]: "\<mu>.expectation (\<lambda>x. x) = 0"
    and \<mu>_square_integrable [simp]: "integrable \<mu> (\<lambda>x. x^2)"
    and \<mu>_variance [simp]: "\<mu>.expectation (\<lambda>x. x^2) = \<sigma>\<^sup>2"
    using assms by (simp_all add: X_distrib [symmetric, of 0] integrable_distr_eq integral_distr)

  have main: "\<forall>\<^sub>F n in sequentially.
      cmod (\<phi> n t - (1 + (-(t^2) / 2) / n)^n) \<le>
      t\<^sup>2 / (6 * \<sigma>\<^sup>2) * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>t / sqrt (\<sigma>\<^sup>2 * n)\<bar> * \<bar>x\<bar> ^ 3))" for t
  proof (rule eventually_sequentiallyI)
    fix n :: nat
    assume "n \<ge> nat (ceiling (t^2 / 4))"
    hence n: "n \<ge> t^2 / 4" by (subst nat_ceiling_le_eq [symmetric])
    let ?t = "t / sqrt (\<sigma>\<^sup>2 * n)"

    define \<psi>' where "\<psi>' n i = char (distr M borel (\<lambda>x. X i x / sqrt (\<sigma>\<^sup>2 * n)))" for n i
    have *: "\<And>n i t. \<psi>' n i t = \<psi> n t"
      unfolding \<psi>_def \<psi>'_def char_def
      by (subst X_distrib [symmetric]) (auto simp: integral_distr)

    have "\<phi> n t = char (distr M borel (\<lambda>x. \<Sum>i<n. X i x / sqrt (\<sigma>\<^sup>2 * real n))) t"
      by (auto simp: \<phi>_def S_def sum_divide_distrib ac_simps)
    also have "\<dots> = (\<Prod> i < n. \<psi>' n i t)"
      unfolding \<psi>'_def
      apply (rule char_distr_sum)
      apply (rule indep_vars_compose2[where X=X])
      apply (rule indep_vars_subset)
      apply (rule X_indep)
      apply auto
      done
    also have "\<dots> = (\<psi> n t)^n"
      by (auto simp add: * prod_constant)
    finally have \<phi>_eq: "\<phi> n t =(\<psi> n t)^n" .

    have "norm (\<psi> n t - (1 - ?t^2 * \<sigma>\<^sup>2 / 2)) \<le> ?t\<^sup>2 / 6 * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t\<bar> * \<bar>x\<bar> ^ 3))"
      unfolding \<psi>_def by (rule \<mu>.char_approx3, auto)
    also have "?t^2 * \<sigma>\<^sup>2 = t^2 / n"
      using \<sigma>_pos by (simp add: power_divide)
    also have "t^2 / n / 2 = (t^2 / 2) / n"
      by simp
    finally have **: "norm (\<psi> n t - (1 + (-(t^2) / 2) / n)) \<le>
      ?t\<^sup>2 / 6 * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t\<bar> * \<bar>x\<bar> ^ 3))" by simp

    have "norm (\<phi> n t - (complex_of_real (1 + (-(t^2) / 2) / n))^n) \<le>
         n * norm (\<psi> n t - (complex_of_real (1 + (-(t^2) / 2) / n)))"
      using n
      by (auto intro!: norm_power_diff \<mu>.cmod_char_le_1 abs_leI
               simp del: of_real_diff simp: of_real_diff[symmetric] divide_le_eq \<phi>_eq \<psi>_def)
    also have "\<dots> \<le> n * (?t\<^sup>2 / 6 * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t\<bar> * \<bar>x\<bar> ^ 3)))"
      by (rule mult_left_mono [OF **], simp)
    also have "\<dots> = (t\<^sup>2 / (6 * \<sigma>\<^sup>2) * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t\<bar> * \<bar>x\<bar> ^ 3)))"
      using \<sigma>_pos by (simp add: field_simps min_absorb2)
    finally show "norm (\<phi> n t - (1 + (-(t^2) / 2) / n)^n) \<le>
        (t\<^sup>2 / (6 * \<sigma>\<^sup>2) * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t\<bar> * \<bar>x\<bar> ^ 3)))"
      by simp
  qed

  show ?thesis
  proof (rule levy_continuity)
    fix t
    let ?t = "\<lambda>n. t / sqrt (\<sigma>\<^sup>2 * n)"
    have "\<And>x. (\<lambda>n. min (6 * x\<^sup>2) (\<bar>t\<bar> * \<bar>x\<bar> ^ 3 / \<bar>sqrt (\<sigma>\<^sup>2 * real n)\<bar>)) \<longlonglongrightarrow> 0"
      using \<sigma>_pos
      by (auto simp: real_sqrt_mult min_absorb2
               intro!: tendsto_min[THEN tendsto_eq_rhs] sqrt_at_top[THEN filterlim_compose]
                       filterlim_tendsto_pos_mult_at_top filterlim_at_top_imp_at_infinity
                       tendsto_divide_0 filterlim_real_sequentially)
    then have "(\<lambda>n. LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t n\<bar> * \<bar>x\<bar> ^ 3)) \<longlonglongrightarrow> (LINT x|\<mu>. 0)"
      by (intro integral_dominated_convergence [where w = "\<lambda>x. 6 * x^2"]) auto
    then have *: "(\<lambda>n. t\<^sup>2 / (6 * \<sigma>\<^sup>2) * (LINT x|\<mu>. min (6 * x\<^sup>2) (\<bar>?t n\<bar> * \<bar>x\<bar> ^ 3))) \<longlonglongrightarrow> 0"
      by (simp only: integral_zero tendsto_mult_right_zero)

    have "(\<lambda>n. complex_of_real ((1 + (-(t^2) / 2) / n)^n)) \<longlonglongrightarrow> complex_of_real (exp (-(t^2) / 2))"
      by (rule isCont_tendsto_compose [OF _ tendsto_exp_limit_sequentially]) auto
    then have "(\<lambda>n. \<phi> n t) \<longlonglongrightarrow> complex_of_real (exp (-(t^2) / 2))"
      by (rule Lim_transform) (rule Lim_null_comparison [OF main *])
    then show "(\<lambda>n. char (distr M borel (?S' n)) t) \<longlonglongrightarrow> char std_normal_distribution t"
      by (simp add: \<phi>_def char_std_normal_distribution)
  qed (auto intro!: real_dist_normal_dist simp: S_def)
qed

theorem (in prob_space) central_limit_theorem:
  fixes X :: "nat \<Rightarrow> 'a \<Rightarrow> real"
    and \<mu> :: "real measure"
    and \<sigma> :: real
    and S :: "nat \<Rightarrow> 'a \<Rightarrow> real"
  assumes X_indep: "indep_vars (\<lambda>i. borel) X UNIV"
    and X_mean: "\<And>n. expectation (X n) = m"
    and \<sigma>_pos: "\<sigma> > 0"
    and X_square_integrable: "\<And>n. integrable M (\<lambda>x. (X n x)\<^sup>2)"
    and X_variance: "\<And>n. variance (X n) = \<sigma>\<^sup>2"
    and X_distrib: "\<And>n. distr M borel (X n) = \<mu>"
  defines "X' i x \<equiv> X i x - m"
  shows "weak_conv_m (\<lambda>n. distr M borel (\<lambda>x. (\<Sum>i<n. X' i x) / sqrt (n*\<sigma>\<^sup>2))) std_normal_distribution"
proof (intro central_limit_theorem_zero_mean)
  show "indep_vars (\<lambda>i. borel) X' UNIV"
    unfolding X'_def[abs_def] using X_indep by (rule indep_vars_compose2) auto
  have X_rv [simp, measurable]: "random_variable borel (X n)" for n
    using X_indep unfolding indep_vars_def2 by simp
  have X_integrable [simp, intro]: "integrable M (X n)" for n
    by (rule square_integrable_imp_integrable[OF _ X_square_integrable]) simp_all
  show "expectation (X' n) = 0" for n
    using X_mean by (auto simp: X'_def[abs_def] prob_space)
  show "\<sigma> > 0" "integrable M (\<lambda>x. (X' n x)\<^sup>2)" "variance (X' n) = \<sigma>\<^sup>2" for n
    using \<open>0 < \<sigma>\<close> X_integrable X_mean X_square_integrable X_variance unfolding X'_def
    by (auto simp: prob_space power2_diff)
  show "distr M borel (X' n) = distr \<mu> borel (\<lambda>x. x - m)" for n
    unfolding X_distrib[of n, symmetric] using X_integrable
    by (subst distr_distr) (auto simp: X'_def[abs_def] comp_def)
qed

end