(*  Title:       Lazy_LList.thy
    Author:      Andreas Lochbihler
*)
section {* Code generator setup to implement lazy lists lazily *}

theory Lazy_LList imports
  Coinductive_List
begin

subsection {* Lazy lists *}

code_identifier code_module Lazy_LList \<rightharpoonup>
  (SML) Coinductive_List and
  (OCaml) Coinductive_List and
  (Haskell) Coinductive_List and
  (Scala) Coinductive_List

definition Lazy_llist :: "(unit \<Rightarrow> ('a \<times> 'a llist) option) \<Rightarrow> 'a llist"
where [simp]:
  "Lazy_llist xs = (case xs () of None \<Rightarrow> LNil | Some (x, ys) \<Rightarrow> LCons x ys)"

definition force :: "'a llist \<Rightarrow> ('a \<times> 'a llist) option"
where [simp, code del]: "force xs = (case xs of LNil \<Rightarrow> None | LCons x ys \<Rightarrow> Some (x, ys))"

code_datatype Lazy_llist

declare -- {* Restore consistency in code equations between @{const partial_term_of} and @{const narrowing} for @{typ "'a llist"} *}
   [[code drop: "partial_term_of :: _ llist itself => _"]]

lemma partial_term_of_llist_code [code]:
  fixes tytok :: "'a :: partial_term_of llist itself" shows
  "partial_term_of tytok (Quickcheck_Narrowing.Narrowing_variable p tt) \<equiv>
   Code_Evaluation.Free (STR ''_'') (Typerep.typerep TYPE('a llist))"
  "partial_term_of tytok (Quickcheck_Narrowing.Narrowing_constructor 0 []) \<equiv>
   Code_Evaluation.Const (STR ''Coinductive_List.llist.LNil'') (Typerep.typerep TYPE('a llist))"
  "partial_term_of tytok (Quickcheck_Narrowing.Narrowing_constructor 1 [head, tail]) \<equiv>
   Code_Evaluation.App
     (Code_Evaluation.App
        (Code_Evaluation.Const
           (STR ''Coinductive_List.llist.LCons'')
           (Typerep.typerep TYPE('a \<Rightarrow> 'a llist \<Rightarrow> 'a llist)))
        (partial_term_of TYPE('a) head))
     (partial_term_of TYPE('a llist) tail)"
by-(rule partial_term_of_anything)+

declare option.splits [split]

lemma Lazy_llist_inject [simp]:
  "Lazy_llist xs = Lazy_llist ys \<longleftrightarrow> xs = ys"
by(auto simp add: fun_eq_iff)

lemma Lazy_llist_inverse [code, simp]:
  "force (Lazy_llist xs) = xs ()"
by(auto)

lemma force_inverse [simp]:
  "Lazy_llist (\<lambda>_. force xs) = xs"
by(auto split: llist.split)

lemma LNil_Lazy_llist [code]: "LNil = Lazy_llist (\<lambda>_. None)"
by(simp)

lemma LCons_Lazy_llist [code, code_unfold]: "LCons x xs = Lazy_llist (\<lambda>_. Some (x, xs))"
by simp

lemma lnull_lazy [code]: "lnull = Option.is_none \<circ> force"
unfolding lnull_def
by (rule ext) (simp add: Option.is_none_def split: llist.split)

declare [[code drop: "equal_class.equal :: 'a :: equal llist \<Rightarrow> _"]]

lemma equal_llist_Lazy_llist [code]:
  "equal_class.equal (Lazy_llist xs) (Lazy_llist ys) \<longleftrightarrow>
   (case xs () of None \<Rightarrow> (case ys () of None \<Rightarrow> True | _ \<Rightarrow> False)
    | Some (x, xs') \<Rightarrow>
       (case ys () of None \<Rightarrow> False
        | Some (y, ys') \<Rightarrow> if x = y then equal_class.equal xs' ys' else False))"
by(auto simp add: equal_llist_def)

declare [[code drop: corec_llist]]

lemma corec_llist_Lazy_llist [code]:
  "corec_llist IS_LNIL LHD endORmore LTL_end LTL_more b =
  Lazy_llist (\<lambda>_. if IS_LNIL b then None
     else Some (LHD b,
       if endORmore b then LTL_end b
       else corec_llist IS_LNIL LHD endORmore LTL_end LTL_more (LTL_more b)))"
by(subst llist.corec_code) simp

declare [[code drop: unfold_llist]]

lemma unfold_llist_Lazy_llist [code]:
  "unfold_llist IS_LNIL LHD LTL b =
  Lazy_llist (\<lambda>_. if IS_LNIL b then None else Some (LHD b, unfold_llist IS_LNIL LHD LTL (LTL b)))"
by(subst unfold_llist.code) simp

declare [[code drop: case_llist]]

lemma case_llist_Lazy_llist [code]:
  "case_llist n c (Lazy_llist xs) = (case xs () of None \<Rightarrow> n | Some (x, ys) \<Rightarrow> c x ys)"
by simp

declare [[code drop: lappend]]

lemma lappend_Lazy_llist [code]:
  "lappend (Lazy_llist xs) ys =
  Lazy_llist (\<lambda>_. case xs () of None \<Rightarrow> force ys | Some (x, xs') \<Rightarrow> Some (x, lappend xs' ys))"
by(auto split: llist.splits)

declare [[code drop: lmap]]

lemma lmap_Lazy_llist [code]:
  "lmap f (Lazy_llist xs) = Lazy_llist (\<lambda>_. map_option (map_prod f (lmap f)) (xs ()))"
by simp

declare [[code drop: lfinite]]

lemma lfinite_Lazy_llist [code]:
  "lfinite (Lazy_llist xs) = (case xs () of None \<Rightarrow> True | Some (x, ys) \<Rightarrow> lfinite ys)"
by simp

declare [[code drop: list_of_aux]]

lemma list_of_aux_Lazy_llist [code]:
  "list_of_aux xs (Lazy_llist ys) =
  (case ys () of None \<Rightarrow> rev xs | Some (y, ys) \<Rightarrow> list_of_aux (y # xs) ys)"
by(simp add: list_of_aux_code)

declare [[code drop: gen_llength]]

lemma gen_llength_Lazy_llist [code]:
  "gen_llength n (Lazy_llist xs) = (case xs () of None \<Rightarrow> enat n | Some (_, ys) \<Rightarrow> gen_llength (n + 1) ys)"
by(simp add: gen_llength_code)

declare [[code drop: ltake]]

lemma ltake_Lazy_llist [code]:
  "ltake n (Lazy_llist xs) =
  Lazy_llist (\<lambda>_. if n = 0 then None else case xs () of None \<Rightarrow> None | Some (x, ys) \<Rightarrow> Some (x, ltake (n - 1) ys))"
by(cases n rule: enat_coexhaust) auto

declare [[code drop: ldropn]]

lemma ldropn_Lazy_llist [code]:
  "ldropn n (Lazy_llist xs) =
   Lazy_llist (\<lambda>_. if n = 0 then xs () else
                   case xs () of None \<Rightarrow> None | Some (x, ys) \<Rightarrow> force (ldropn (n - 1) ys))"
by(cases n)(auto simp add: eSuc_enat[symmetric] split: llist.split)

declare [[code drop: ltakeWhile]]

lemma ltakeWhile_Lazy_llist [code]:
  "ltakeWhile P (Lazy_llist xs) =
  Lazy_llist (\<lambda>_. case xs () of None \<Rightarrow> None | Some (x, ys) \<Rightarrow> if P x then Some (x, ltakeWhile P ys) else None)"
by auto

declare [[code drop: ldropWhile]]

lemma ldropWhile_Lazy_llist [code]:
  "ldropWhile P (Lazy_llist xs) =
   Lazy_llist (\<lambda>_. case xs () of None \<Rightarrow> None | Some (x, ys) \<Rightarrow> if P x then force (ldropWhile P ys) else Some (x, ys))"
by(auto split: llist.split)

declare [[code drop: lzip]]

lemma lzip_Lazy_llist [code]:
  "lzip (Lazy_llist xs) (Lazy_llist ys) =
  Lazy_llist (\<lambda>_. Option.bind (xs ()) (\<lambda>(x, xs'). map_option (\<lambda>(y, ys'). ((x, y), lzip xs' ys')) (ys ())))"
by auto

declare [[code drop: gen_lset]]

lemma lset_Lazy_llist [code]:
  "gen_lset A (Lazy_llist xs) =
  (case xs () of None \<Rightarrow> A | Some (y, ys) \<Rightarrow> gen_lset (insert y A) ys)"
by(auto simp add: gen_lset_code)

declare [[code drop: lmember]]

lemma lmember_Lazy_llist [code]:
  "lmember x (Lazy_llist xs) =
  (case xs () of None \<Rightarrow> False | Some (y, ys) \<Rightarrow> x = y \<or> lmember x ys)"
by(simp add: lmember_def)

declare [[code drop: llist_all2]]

lemma llist_all2_Lazy_llist [code]:
  "llist_all2 P (Lazy_llist xs) (Lazy_llist ys) =
  (case xs () of None \<Rightarrow> ys () = None
      | Some (x, xs') \<Rightarrow> (case ys () of None \<Rightarrow> False
                            | Some (y, ys') \<Rightarrow> P x y \<and> llist_all2 P xs' ys'))"
by auto

declare [[code drop: lhd]]

lemma lhd_Lazy_llist [code]:
  "lhd (Lazy_llist xs) = (case xs () of None \<Rightarrow> undefined | Some (x, xs') \<Rightarrow> x)"
by(simp add: lhd_def)

declare [[code drop: ltl]]

lemma ltl_Lazy_llist [code]:
  "ltl (Lazy_llist xs) = Lazy_llist (\<lambda>_. case xs () of None \<Rightarrow> None | Some (x, ys) \<Rightarrow> force ys)"
by(auto split: llist.split)

declare [[code drop: llast]]

lemma llast_Lazy_llist [code]:
  "llast (Lazy_llist xs) =
  (case xs () of
    None \<Rightarrow> undefined
  | Some (x, xs') \<Rightarrow>
    (case force xs' of None \<Rightarrow> x | Some (x', xs'') \<Rightarrow> llast (LCons x' xs'')))"
by(auto simp add: llast_def zero_enat_def eSuc_def split: enat.split llist.splits)

declare [[code drop: ldistinct]]

declare [[code drop: lprefix]]

lemma lprefix_Lazy_llist [code]:
  "lprefix (Lazy_llist xs) (Lazy_llist ys) =
  (case xs () of
    None \<Rightarrow> True
  | Some (x, xs') \<Rightarrow>
    (case ys () of None \<Rightarrow> False | Some (y, ys') \<Rightarrow> x = y \<and> lprefix xs' ys'))"
by auto

declare [[code drop: lstrict_prefix]]

lemma lstrict_prefix_Lazy_llist [code]:
  "lstrict_prefix (Lazy_llist xs) (Lazy_llist ys) \<longleftrightarrow>
  (case ys () of
    None \<Rightarrow> False
  | Some (y, ys') \<Rightarrow>
    (case xs () of None \<Rightarrow> True | Some (x, xs') \<Rightarrow> x = y \<and> lstrict_prefix xs' ys'))"
by auto

declare [[code drop: llcp]]

lemma llcp_Lazy_llist [code]:
  "llcp (Lazy_llist xs) (Lazy_llist ys) =
  (case xs () of None \<Rightarrow> 0
   | Some (x, xs') \<Rightarrow> (case ys () of None \<Rightarrow> 0
                     | Some (y, ys') \<Rightarrow> if x = y then eSuc (llcp xs' ys') else 0))"
by auto

declare [[code drop: llexord]]

lemma llexord_Lazy_llist [code]:
  "llexord r (Lazy_llist xs) (Lazy_llist ys) \<longleftrightarrow>
  (case xs () of
    None \<Rightarrow> True
  | Some (x, xs') \<Rightarrow>
    (case ys () of None \<Rightarrow> False | Some (y, ys') \<Rightarrow> r x y \<or> x = y \<and> llexord r xs' ys'))"
by auto

declare [[code drop: lfilter]]

lemma lfilter_Lazy_llist [code]:
  "lfilter P (Lazy_llist xs) =
  Lazy_llist (\<lambda>_. case xs () of None \<Rightarrow> None
                  | Some (x, ys) \<Rightarrow> if P x then Some (x, lfilter P ys) else force (lfilter P ys))"
by(auto split: llist.split)

declare [[code drop: lconcat]]

lemma lconcat_Lazy_llist [code]:
  "lconcat (Lazy_llist xss) =
  Lazy_llist (\<lambda>_. case xss () of None \<Rightarrow> None | Some (xs, xss') \<Rightarrow> force (lappend xs (lconcat xss')))"
by(auto split: llist.split)

declare option.splits [split del]
declare Lazy_llist_def [simp del]

text {* Simple ML test for laziness *}

ML_val {*
  val zeros = @{code iterates} (fn x => x + 1) 0;
  val lhd = @{code lhd} zeros;
  val ltl = @{code ltl} zeros;
  val ltl' = @{code force} ltl;

  val ltake = @{code ltake} (@{code eSuc} (@{code eSuc} @{code "0::enat"})) zeros;
  val ldrop = @{code ldrop} (@{code eSuc} @{code "0::enat"}) zeros;
  val list_of = @{code list_of} ltake;

  val ltakeWhile = @{code ltakeWhile} (fn _ => true) zeros;
  val ldropWhile = @{code ldropWhile} (fn _ => false) zeros;
  val hd = @{code lhd} ldropWhile;

  val lfilter = @{code lfilter} (fn _ => false) zeros;
*}

hide_const (open) force

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

section "Lemmas for Word Length 64"

theory Word_Lemmas_64
imports
  Word_Lemmas_Prefix
  Word_Setup_64
begin

lemma ucast_8_64_inj:
  "inj (ucast ::  8 word \<Rightarrow> 64 word)"
  by (rule down_ucast_inj) (clarsimp simp: is_down_def target_size source_size)

lemma upto_2_helper:
  "{0..<2 :: 64 word} = {0, 1}"
  by (safe; simp) unat_arith

lemmas upper_bits_unset_is_l2p_64 = upper_bits_unset_is_l2p [where 'a=64, folded word_bits_def]
lemmas le_2p_upper_bits_64 = le_2p_upper_bits [where 'a=64, folded word_bits_def]
lemmas le2p_bits_unset_64 = le2p_bits_unset[where 'a=64, folded word_bits_def]

lemma word_bits_len_of:
  "len_of TYPE (64) = word_bits"
  by (simp add: word_bits_conv)

lemmas unat_power_lower64' = unat_power_lower[where 'a=64]
lemmas unat_power_lower64 [simp] = unat_power_lower64'[unfolded word_bits_len_of]

lemmas word64_less_sub_le' = word_less_sub_le[where 'a = 64]
lemmas word64_less_sub_le[simp] = word64_less_sub_le' [folded word_bits_def]

lemma word_bits_size:
  "size (w::word64) = word_bits"
  by (simp add: word_bits_def word_size)

lemmas word64_power_less_1' = word_power_less_1[where 'a = 64]
lemmas word64_power_less_1[simp] = word64_power_less_1'[folded word_bits_def]

lemma of_nat64_0:
  "\<lbrakk>of_nat n = (0::word64); n < 2 ^ word_bits\<rbrakk> \<Longrightarrow> n = 0"
  by (erule of_nat_0, simp add: word_bits_def)

lemma unat_mask_2_less_4:
  "unat (p && mask 2 :: word64) < 4"
  apply (rule unat_less_helper)
  apply (rule order_le_less_trans, rule word_and_le1)
  apply (simp add: mask_def)
  done

lemmas unat_of_nat64' = unat_of_nat_eq[where 'a=64]
lemmas unat_of_nat64 = unat_of_nat64'[unfolded word_bits_len_of]

lemmas word_power_nonzero_64 = word_power_nonzero [where 'a=64, folded word_bits_def]

lemmas unat_mult_simple = iffD1 [OF unat_mult_lem [where 'a = 64, unfolded word_bits_len_of]]

lemmas div_power_helper_64 = div_power_helper [where 'a=64, folded word_bits_def]

lemma n_less_word_bits:
  "(n < word_bits) = (n < 64)"
  by (simp add: word_bits_def)

lemmas of_nat_less_pow_64 = of_nat_power [where 'a=64, folded word_bits_def]

lemma lt_word_bits_lt_pow:
  "sz < word_bits \<Longrightarrow> sz < 2 ^ word_bits"
  by (simp add: word_bits_conv)

lemma unat_less_word_bits:
  fixes y :: word64
  shows "x < unat y \<Longrightarrow> x < 2 ^ word_bits"
  unfolding word_bits_def
  by (rule order_less_trans [OF _ unat_lt2p])

lemmas unat_mask_word64' = unat_mask[where 'a=64]
lemmas unat_mask_word64 = unat_mask_word64'[folded word_bits_def]

lemma unat_less_2p_word_bits:
  "unat (x :: 64 word) < 2 ^ word_bits"
  apply (simp only: word_bits_def)
  apply (rule unat_lt2p)
  done

lemma Suc_unat_mask_div:
  "Suc (unat (mask sz div word_size::word64)) = 2 ^ (min sz word_bits - 3)"
  apply (case_tac "sz < word_bits")
   apply (case_tac "3\<le>sz")
    apply (clarsimp simp: word_size_def word_bits_def min_def mask_def)
    apply (drule (2) Suc_div_unat_helper
           [where 'a=64 and sz=sz and us=3, simplified, symmetric])
   apply (simp add: not_le word_size_def word_bits_def)
   apply (case_tac sz, simp add: unat_word_ariths)
   apply (case_tac nat, simp add: unat_word_ariths
                                  unat_mask_word64 min_def word_bits_def)
   apply (case_tac nata, simp add: unat_word_ariths unat_mask_word64 word_bits_def)
   apply simp
  apply (simp add: unat_word_ariths
                   unat_mask_word64 min_def word_bits_def word_size_def)
  done

lemmas word64_minus_one_le' = word_minus_one_le[where 'a=64]
lemmas word64_minus_one_le = word64_minus_one_le'[simplified]

lemma ucast_not_helper:
  fixes a::word8
  assumes a: "a \<noteq> 0xFF"
  shows "ucast a \<noteq> (0xFF::word64)"
proof
  assume "ucast a = (0xFF::word64)"
  also
  have "(0xFF::word64) = ucast (0xFF::word8)" by simp
  finally
  show False using a
    apply -
    apply (drule up_ucast_inj, simp)
    apply simp
    done
qed

lemma less_4_cases:
  "(x::word64) < 4 \<Longrightarrow> x=0 \<or> x=1 \<or> x=2 \<or> x=3"
  apply clarsimp
  apply (drule word_less_cases, erule disjE, simp, simp)+
  done

lemma unat_ucast_8_64:
  fixes x :: "word8"
  shows "unat (ucast x :: word64) = unat x"
  unfolding ucast_def unat_def
  apply (subst int_word_uint)
  apply (subst mod_pos_pos_trivial)
    apply simp
   apply (rule lt2p_lem)
   apply simp
  apply simp
  done

lemma if_then_1_else_0:
  "((if P then 1 else 0) = (0 :: word64)) = (\<not> P)"
  by simp

lemma if_then_0_else_1:
  "((if P then 0 else 1) = (0 :: word64)) = (P)"
  by simp

lemmas if_then_simps = if_then_0_else_1 if_then_1_else_0

lemma ucast_le_ucast_8_64:
  "(ucast x \<le> (ucast y :: word64)) = (x \<le> (y :: word8))"
  by (simp add: ucast_le_ucast)

lemma in_16_range:
  "0 \<in> S \<Longrightarrow> r \<in> (\<lambda>x. r + x * (16 :: word64)) ` S"
  "n - 1 \<in> S \<Longrightarrow> (r + (16 * n - 16)) \<in> (\<lambda>x :: word64. r + x * 16) ` S"
  by (clarsimp simp: image_def elim!: bexI[rotated])+

lemma eq_2_64_0:
  "(2 ^ 64 :: word64) = 0"
  by simp

lemma x_less_2_0_1:
  fixes x :: word64 shows
  "x < 2 \<Longrightarrow> x = 0 \<or> x = 1"
  by (rule x_less_2_0_1') auto

lemmas mask_64_max_word  = max_word_mask [symmetric, where 'a=64, simplified]

lemma of_nat64_n_less_equal_power_2:
 "n < 64 \<Longrightarrow> ((of_nat n)::64 word) < 2 ^ n"
  by (rule of_nat_n_less_equal_power_2, clarsimp simp: word_size)

lemma word_rsplit_0:
  "word_rsplit (0 :: word64) = [0, 0, 0, 0, 0, 0, 0, 0 :: word8]"
  apply (simp add: word_rsplit_def bin_rsplit_def Let_def)
  done

lemma unat_ucast_10_64 :
  fixes x :: "10 word"
  shows "unat (ucast x :: word64) = unat x"
  unfolding ucast_def unat_def
  apply (subst int_word_uint)
  apply (subst mod_pos_pos_trivial)
    apply simp
   apply (rule lt2p_lem)
   apply simp
  apply simp
  done

lemma bool_mask [simp]:
  fixes x :: word64
  shows "(0 < x && 1) = (x && 1 = 1)"
  by (rule bool_mask') auto

lemma word64_bounds:
  "- (2 ^ (size (x :: word64) - 1)) = (-9223372036854775808 :: int)"
  "((2 ^ (size (x :: word64) - 1)) - 1) = (9223372036854775807 :: int)"
  "- (2 ^ (size (y :: 64 signed word) - 1)) = (-9223372036854775808 :: int)"
  "((2 ^ (size (y :: 64 signed word) - 1)) - 1) = (9223372036854775807 :: int)"
  by (simp_all add: word_size)

lemma word_ge_min:"sint (x::64 word) \<ge> -9223372036854775808"
  by (metis sint_ge word64_bounds(1) word_size)

lemmas signed_arith_ineq_checks_to_eq_word64'
    = signed_arith_ineq_checks_to_eq[where 'a=64]
      signed_arith_ineq_checks_to_eq[where 'a="64 signed"]

lemmas signed_arith_ineq_checks_to_eq_word64
    = signed_arith_ineq_checks_to_eq_word64' [unfolded word64_bounds]

lemmas signed_mult_eq_checks64_to_64'
    = signed_mult_eq_checks_double_size[where 'a=64 and 'b=64]
      signed_mult_eq_checks_double_size[where 'a="64 signed" and 'b=64]

lemmas signed_mult_eq_checks64_to_64 = signed_mult_eq_checks64_to_64'[simplified]

lemmas sdiv_word64_max' = sdiv_word_max [where 'a=64] sdiv_word_max [where 'a="64 signed"]
lemmas sdiv_word64_max = sdiv_word64_max'[simplified word_size, simplified]

lemmas sdiv_word64_min' = sdiv_word_min [where 'a=64] sdiv_word_min [where 'a="64 signed"]
lemmas sdiv_word64_min = sdiv_word64_min' [simplified word_size, simplified]

lemmas sint64_of_int_eq' = sint_of_int_eq [where 'a=64]
lemmas sint64_of_int_eq = sint64_of_int_eq' [simplified]

lemma ucast_of_nats [simp]:
  "(ucast (of_nat x :: word64) :: sword64) = (of_nat x)"
  "(ucast (of_nat x :: word64) :: sword16) = (of_nat x)"
  "(ucast (of_nat x :: word64) :: sword8) = (of_nat x)"
  "(ucast (of_nat x :: word16) :: sword16) = (of_nat x)"
  "(ucast (of_nat x :: word16) :: sword8) = (of_nat x)"
  "(ucast (of_nat x :: word8) :: sword8) = (of_nat x)"
  by (auto simp: ucast_of_nat is_down)

lemmas signed_shift_guard_simpler_64'
    = power_strict_increasing_iff[where b="2 :: nat" and y=31]
lemmas signed_shift_guard_simpler_64 = signed_shift_guard_simpler_64'[simplified]

lemma word64_31_less:
  "31 < len_of TYPE (64 signed)" "31 > (0 :: nat)"
  "31 < len_of TYPE (64)" "31 > (0 :: nat)"
  by auto

lemmas signed_shift_guard_to_word_64
    = signed_shift_guard_to_word[OF word64_31_less(1-2)]
    signed_shift_guard_to_word[OF word64_31_less(3-4)]

lemma le_step_down_word_3:
  fixes x :: "64 word"
  shows "\<lbrakk>x \<le>  y; x \<noteq> y; y < 2 ^ 64 - 1\<rbrakk> \<Longrightarrow> x \<le> y - 1"
  by (rule le_step_down_word_2, assumption+)

lemma shiftr_1:
  "(x::word64) >> 1 = 0 \<Longrightarrow> x < 2"
  by word_bitwise clarsimp

lemma mask_step_down_64:
  "(b::64word) && 0x1 = (1::64word) \<Longrightarrow> (\<exists>x. x < 64 \<and> mask x = b >> 1) \<Longrightarrow> (\<exists>x. mask x = b)"
  apply clarsimp
  apply (rule_tac x="x + 1" in exI)
  apply (subgoal_tac "x \<le> 63")
   apply (erule le_step_down_nat, clarsimp simp:mask_def, word_bitwise, clarsimp+)+
   apply (clarsimp simp:mask_def, word_bitwise, clarsimp)
  apply clarsimp
  done

lemma unat_of_int_64:
  "\<lbrakk>i \<ge> 0; i \<le> 2 ^ 63\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword64)) = nat i"
  unfolding unat_def
  apply (subst eq_nat_nat_iff, clarsimp+)
  apply (simp add: word_of_int uint_word_of_int)
  done

(* Helper for packing then unpacking a 64-bit variable. *)
lemma cast_chunk_assemble_id_64[simp]:
  "(((ucast ((ucast (x::64 word))::32 word))::64 word) || (((ucast ((ucast (x >> 32))::32 word))::64 word) << 32)) = x"
  by (simp add:cast_chunk_assemble_id)

(* Another variant of packing and unpacking a 64-bit variable. *)
lemma cast_chunk_assemble_id_64'[simp]:
  "(((ucast ((scast (x::64 word))::32 word))::64 word) || (((ucast ((scast (x >> 32))::32 word))::64 word) << 32)) = x"
  by (simp add:cast_chunk_scast_assemble_id)

(* Specialisations of down_cast_same for adding to local simpsets. *)
lemma cast_down_u64: "(scast::64 word \<Rightarrow> 32 word) = (ucast::64 word \<Rightarrow> 32 word)"
  apply (subst down_cast_same[symmetric])
   apply (simp add:is_down)+
  done

lemma cast_down_s64: "(scast::64 sword \<Rightarrow> 32 word) = (ucast::64 sword \<Rightarrow> 32 word)"
  apply (subst down_cast_same[symmetric])
   apply (simp add:is_down)+
  done

end


theory Friend_Request
imports "../Observation_Setup" Friend_Request_Value_Setup
begin

subsection \<open>Declassification bound\<close>

fun T :: "(state,act,out) trans \<Rightarrow> bool"
where "T (Trans _ _ _ _) = False"

text \<open>Friendship updates form an alternating sequence of friending and unfriending,
and every successful friend creation is preceded by one or two friendship requests.\<close>

fun validValSeq :: "value list \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool" where
  "validValSeq [] _ _ _ = True"
| "validValSeq (FRVal U1 req # vl) st r1 r2 \<longleftrightarrow> (\<not>st) \<and> (\<not>r1) \<and> validValSeq vl st True r2"
| "validValSeq (FRVal U2 req # vl) st r1 r2 \<longleftrightarrow> (\<not>st) \<and> (\<not>r2) \<and> validValSeq vl st r1 True"
| "validValSeq (FVal True # vl) st r1 r2 \<longleftrightarrow> (\<not>st) \<and> (r1 \<or> r2) \<and> validValSeq vl True False False"
| "validValSeq (FVal False # vl) st r1 r2 \<longleftrightarrow> st \<and> (\<not>r1) \<and> (\<not>r2) \<and> validValSeq vl False False False"
| "validValSeq (OVal True # vl) st r1 r2 \<longleftrightarrow> validValSeq vl st r1 r2"
| "validValSeq (OVal False # vl) st r1 r2 \<longleftrightarrow> validValSeq vl st r1 r2"

abbreviation validValSeqFrom :: "value list \<Rightarrow> state \<Rightarrow> bool"
where "validValSeqFrom vl s
 \<equiv> validValSeq vl (friends12 s) (UID1 \<in>\<in> pendingFReqs s UID2) (UID2 \<in>\<in> pendingFReqs s UID1)"

text \<open>With respect to the friendship status updates, we use the same
``while-or-last-before'' bound as for friendship status confidentiality.\<close>

inductive BO :: "value list \<Rightarrow> value list \<Rightarrow> bool"
and BC :: "value list \<Rightarrow> value list \<Rightarrow> bool"
where
 BO_FVal[simp,intro!]:
  "BO (map FVal fs) (map FVal fs)"
|BO_BC[intro]:
  "BC vl vl1 \<Longrightarrow>
   BO (map FVal fs @ OVal False # vl) (map FVal fs @ OVal False # vl1)"
(*  *)
|BC_FVal[simp,intro!]:
  "BC (map FVal fs) (map FVal fs1)"
|BC_BO[intro]:
  "BO vl vl1 \<Longrightarrow> (fs = [] \<longleftrightarrow> fs1 = []) \<Longrightarrow> (fs \<noteq> [] \<Longrightarrow> last fs = last fs1) \<Longrightarrow>
   BC (map FVal fs  @ OVal True # vl)
      (map FVal fs1 @ OVal True # vl1)"

text \<open>Taking into account friendship requests, two value sequences \<open>vl\<close> and \<open>vl1\<close> are in the bound if
  \<^item> \<open>vl1\<close> (with friendship requests) forms a valid value sequence,
  \<^item> \<open>vl\<close> and \<open>vl1\<close> are in \<open>BO\<close> (without friendship requests),
  \<^item> \<open>vl1\<close> is empty if \<open>vl\<close> is empty, and
  \<^item> \<open>vl1\<close> begins with \<^term>\<open>OVal False\<close> if \<open>vl\<close> begins with \<^term>\<open>OVal False\<close>.

The last two points are due to the fact that \<^term>\<open>UID1\<close> and \<^term>\<open>UID1\<close> might not exist yet
if \<open>vl\<close> is empty (or before \<^term>\<open>OVal False\<close>), in which case the observer can deduce that no
friendship request has happened yet.\<close>

definition "B vl vl1 \<equiv> BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1) \<and>
                       validValSeqFrom vl1 istate \<and>
                       (vl = [] \<longrightarrow> vl1 = []) \<and>
                       (vl \<noteq> [] \<and> hd vl = OVal False \<longrightarrow> vl1 \<noteq> [] \<and> hd vl1 = OVal False)"

lemma BO_Nil_iff: "BO vl vl1 \<Longrightarrow> vl = [] \<longleftrightarrow> vl1 = []"
by (cases rule: BO.cases) auto

no_notation relcomp (infixr "O" 75)

interpretation BD_Security_IO where
istate = istate and step = step and
\<phi> = \<phi> and f = f and \<gamma> = \<gamma> and g = g and T = T and B = B
done

(* sanity check *) lemma validFrom_validValSeq:
assumes "validFrom s tr"
and "reach s"
shows "validValSeqFrom (V tr) s"
using assms proof (induction tr arbitrary: s)
  case (Cons trn tr s)
    then obtain a ou s' where trn: "trn = Trans s a ou s'"
                          and step: "step s a = (ou, s')"
                          and tr: "validFrom s' tr"
                          and s': "reach s'"
      by (cases trn) (auto iff: validFrom_Cons intro: reach_PairI)
    then have vVS_tr: "validValSeqFrom (V tr) s'" by (intro Cons.IH)
    show ?case proof cases
      assume \<phi>: "\<phi> (Trans s a ou s')"
      then have V: "V (Trans s a ou s' # tr) = f (Trans s a ou s') # V tr" by auto
      from \<phi> vVS_tr Cons.prems step show ?thesis unfolding trn V by (elim \<phi>E) auto
    next
      assume "\<not>\<phi> (Trans s a ou s')"
      then have "V (Trans s a ou s' # tr) = V tr" and "friends12 s' = friends12 s"
            and "UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2"
            and "UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1"
        using step_friends12_\<phi>[OF step] step_pendingFReqs_\<phi>[OF step] by auto
      with vVS_tr show ?thesis unfolding trn by auto
    qed
qed auto

lemma "validFrom istate tr \<Longrightarrow> validValSeqFrom (V tr) istate"
using validFrom_validValSeq[of istate] reach.Istate unfolding istate_def friends12_def
by auto

subsection \<open>Unwinding proof\<close>

(* Key lemma: *)
lemma eqButUID_step_\<gamma>_out:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and \<gamma>: "\<gamma> (Trans s a ou s')"
and os: "open s \<longrightarrow> friendIDs s = friendIDs s1"
shows "ou = ou1"
proof -
  from \<gamma> obtain uid where uid: "userOfA a = Some uid \<and> uid \<in> UIDs \<and> uid \<noteq> UID1 \<and> uid \<noteq> UID2
                              \<or> userOfA a = None"
    using UID1_UID2_UIDs by (cases "userOfA a") auto
  { fix uid
    assume "uid \<in>\<in> friendIDs s UID1 \<or> uid \<in>\<in> friendIDs s UID2" and "uid \<in> UIDs"
    with os have "friendIDs s = friendIDs s1" unfolding open_def openByF_def by auto
  } note fIDs = this
  { fix uid uid'
    assume uid: "uid \<noteq> UID1" "uid \<noteq> UID2"
    have "friendIDs s uid = friendIDs s1 uid" (is ?f_eq)
     and "pendingFReqs s uid = pendingFReqs s1 uid" (is ?pFR_eq)
     and "uid \<in>\<in> friendIDs s uid' \<longleftrightarrow> uid \<in>\<in> friendIDs s1 uid'" (is ?f_iff)
     and "uid \<in>\<in> pendingFReqs s uid' \<longleftrightarrow> uid \<in>\<in> pendingFReqs s1 uid'" (is ?pFR_iff)
     and "friendReq s uid uid' = friendReq s1 uid uid'" (is ?FR_eq)
     and "friendReq s uid' uid = friendReq s1 uid' uid" (is ?FR_eq')
    proof -
      show ?f_eq ?pFR_eq using uid ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUIDf_not_UID)
      show ?f_iff ?pFR_iff using uid ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUIDf_not_UID')
      from uid have "\<not> (uid,uid') \<in> {(UID1,UID2), (UID2,UID1)}" by auto
      then show ?FR_eq ?FR_eq' using ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUID12_not_UID)
    qed
  } note simps = this eqButUID_def r_defs s_defs c_defs l_defs u_defs d_defs
  note facts = ss1 step step1 uid
  show ?thesis
  proof (cases a)
    case (Ract ra) then show ?thesis using facts
      apply (cases ra) by (auto simp add: simps)
  next
    case (Sact sa) then show ?thesis using facts by (cases sa) (auto simp add: simps)
  next
    case (Cact ca) then show ?thesis using facts by (cases ca) (auto simp add: simps)
  next
    case (Lact la)
      then show ?thesis using facts proof (cases la)
        case (lFriends uid p uid')
          with \<gamma> have uid: "uid \<in> UIDs" using Lact by auto
          then have uid_uid': "uid \<in>\<in> friendIDs s uid' \<longleftrightarrow> uid \<in>\<in> friendIDs s1 uid'"
            using ss1 UID1_UID2_UIDs unfolding eqButUID_def by (intro eqButUIDf_not_UID') auto
          show ?thesis
          proof (cases "(uid' = UID1 \<or> uid' = UID2) \<and> uid \<in>\<in> friendIDs s uid'")
            case True
              with uid have "friendIDs s = friendIDs s1" by (intro fIDs) auto
              then show ?thesis using lFriends facts Lact by (auto simp: simps)
          next
            case False
              then show ?thesis using lFriends facts Lact simps(1) uid_uid' by (auto simp: simps)
          qed
      next
        case (lPosts uid p)
          then have o: "\<And>pid. owner s pid = owner s1 pid"
                and n: "\<And>pid. post s pid = post s1 pid"
                and pids: "postIDs s = postIDs s1"
                and viss: "vis s = vis s1"
                and fu: "\<And>uid'. uid \<in>\<in> friendIDs s uid' \<longleftrightarrow> uid \<in>\<in> friendIDs s1 uid'"
                and e: "e_listPosts s uid p \<longleftrightarrow> e_listPosts s1 uid p"
            using ss1 uid Lact unfolding eqButUID_def l_defs by (auto simp add: simps(3))
          have "listPosts s uid p = listPosts s1 uid p"
            unfolding listPosts_def o n pids fu viss ..
          with e show ?thesis using Lact lPosts step step1 by auto
      qed (auto simp add: simps)
  next
    case (Uact ua) then show ?thesis using facts by (cases ua) (auto simp add: simps)
  next
    case (Dact da) then show ?thesis using facts by (cases da) (auto simp add: simps)
  qed
qed

(* helper *) lemma produce_FRVal:
assumes rs: "reach s"
and IDs: "IDsOK s [UID1, UID2] []"
and vVS: "validValSeqFrom (FRVal u req # vl) s"
obtains a uid uid' s'
where "step s a = (outOK, s')"
  and "a = Cact (cFriendReq uid (pass s uid) uid' req)"
  and "uid = UID1 \<and> uid' = UID2 \<or> uid = UID2 \<and> uid' = UID1"
  and "\<phi> (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FRVal u req"
  and "validValSeqFrom vl s'"
proof (cases u)
  case U1
    then have "step s (Cact (cFriendReq UID1 (pass s UID1) UID2 req)) =
                 (outOK, createFriendReq s UID1 (pass s UID1) UID2 req)"
          and "\<not>friends12 (createFriendReq s UID1 (pass s UID1) UID2 req)"
      using IDs vVS reach_friendIDs_symmetric[OF rs] by (auto simp: c_defs friends12_def)
    then show thesis using U1 vVS UID1_UID2 by (intro that[of _ _ UID1 UID2]) (auto simp: c_defs)
next
  case U2
    then have "step s (Cact (cFriendReq UID2 (pass s UID2) UID1 req)) =
                 (outOK, createFriendReq s UID2 (pass s UID2) UID1 req)"
          and "\<not>friends12 (createFriendReq s UID2 (pass s UID2) UID1 req)"
      using IDs vVS reach_friendIDs_symmetric[OF rs] by (auto simp: c_defs friends12_def)
    then show thesis using U2 vVS UID1_UID2 by (intro that[of _ _ UID2 UID1]) (auto simp: c_defs)
qed

(* helper *) lemma toggle_friends12_True:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] []"
    and nf12: "\<not>friends12 s"
    and vVS: "validValSeqFrom (FVal True # vl) s"
obtains a uid uid' s'
where "step s a = (outOK, s')"
  and "a = Cact (cFriend uid (pass s uid) uid')"
  and "s' = createFriend s UID1 (pass s UID1) UID2"
  and "uid = UID1 \<and> uid' = UID2 \<or> uid = UID2 \<and> uid' = UID1"
  and "friends12 s'"
  and "eqButUID s s'"
  and "\<phi> (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal True"
  and "\<not>\<gamma> (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof -
  from vVS have "UID1 \<in>\<in> pendingFReqs s UID2 \<or> UID2 \<in>\<in> pendingFReqs s UID1" by auto
  then show thesis proof
    assume pFR: "UID1 \<in>\<in> pendingFReqs s UID2"
    let ?a = "Cact (cFriend UID2 (pass s UID2) UID1)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2
      unfolding createFriend_sym[of "s" "UID1" "pass s UID1" "UID2" "pass s UID2"]
      by (auto simp add: c_defs)
    moreover then have "\<phi> ?trn" and "f ?trn = FVal True" and "friends12 ?s'"
                   and "UID1 \<notin> set (pendingFReqs ?s' UID2)"
                   and "UID2 \<notin> set (pendingFReqs ?s' UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs friends12_def)
    moreover have "\<not>\<gamma> ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs vVS
      by (intro that[of "?a" "?s'" UID2 UID1]) (auto intro: Cact_cFriend_step_eqButUID)
  next
    assume pFR: "UID2 \<in>\<in> pendingFReqs s UID1"
    let ?a = "Cact (cFriend UID1 (pass s UID1) UID2)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2 by (auto simp add: c_defs)
    moreover then have "\<phi> ?trn" and "f ?trn = FVal True" and "friends12 ?s'"
                   and "UID1 \<notin> set (pendingFReqs ?s' UID2)"
                   and "UID2 \<notin> set (pendingFReqs ?s' UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs friends12_def)
    moreover have "\<not>\<gamma> ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs vVS
      by (intro that[of "?a" "?s'" UID1 UID2]) (auto intro: Cact_cFriend_step_eqButUID)
  qed
qed

(* helper *) lemma toggle_friends12_False:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] []"
    and f12: "friends12 s"
    and vVS: "validValSeqFrom (FVal False # vl) s"
obtains a s'
where "step s a = (outOK, s')"
  and "a = Dact (dFriend UID1 (pass s UID1) UID2)"
  and "s' = deleteFriend s UID1 (pass s UID1) UID2"
  and "\<not>friends12 s'"
  and "eqButUID s s'"
  and "\<phi> (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal False"
  and "\<not>\<gamma> (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof -
  let ?a = "Dact (dFriend UID1 (pass s UID1) UID2)"
  let ?s' = "deleteFriend s UID1 (pass s UID1) UID2"
  let ?trn = "Trans s ?a outOK ?s'"
  from vVS have step: "step s ?a = (outOK, ?s')"
        and "UID1 \<notin> set (pendingFReqs ?s' UID2)" "UID2 \<notin> set (pendingFReqs ?s' UID1)"
    using IDs f12 UID1_UID2 by (auto simp add: d_defs friends12_def)
  moreover then have "\<phi> ?trn" and "f ?trn = FVal False" and "\<not>friends12 ?s'"
    by (auto simp: d_defs friends12_def)
  moreover have "\<not>\<gamma> ?trn" using UID1_UID2_UIDs by auto
  ultimately show thesis using f12 rs vVS
    by (intro that[of ?a ?s']) (auto intro: Dact_dFriend_step_eqButUID)
qed

lemma toggle_friends12:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] []"
    and f12: "friends12 s \<noteq> fv"
    and vVS: "validValSeqFrom (FVal fv # vl) s"
obtains a s'
where "step s a = (outOK, s')"
  and "friends12 s' = fv"
  and "eqButUID s s'"
  and "\<phi> (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal fv"
  and "\<not>\<gamma> (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof (cases "friends12 s")
  case True
    moreover then have "UID1 \<notin> set (pendingFReqs s UID2)" "UID2 \<notin> set (pendingFReqs s UID1)"
                   and "fv = False"
                   and vVS: "validValSeqFrom (FVal False # vl) s"
      using vVS f12 unfolding friends12_def by auto
    moreover then have "UID1 \<notin> set (pendingFReqs (deleteFriend s UID1 (pass s UID1) UID2) UID2)"
                       "UID2 \<notin> set (pendingFReqs (deleteFriend s UID1 (pass s UID1) UID2) UID1)"
      by (auto simp: d_defs)
    ultimately show thesis using assms
      by (elim toggle_friends12_False, blast, blast, blast) (elim that, blast+)
next
  case False
    moreover then have "fv = True"
                   and vVS: "validValSeqFrom (FVal True # vl) s"
      using vVS f12 by auto
    moreover have "UID1 \<notin> set (pendingFReqs (createFriend s UID1 (pass s UID1) UID2) UID2)"
                  "UID2 \<notin> set (pendingFReqs (createFriend s UID1 (pass s UID1) UID2) UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs)
    ultimately show thesis using assms
      by (elim toggle_friends12_True, blast, blast, blast) (elim that, blast+)
qed

(* helper *) lemma BO_cases:
assumes "BO vl vl1"
obtains (Nil) "vl = []" and "vl1 = []"
      | (FVal) fv vl' vl1' where "vl = FVal fv # vl'" and "vl1 = FVal fv # vl1'" and "BO vl' vl1'"
      | (OVal) vl' vl1' where "vl = OVal False # vl'" and "vl1 = OVal False # vl1'" and "BC vl' vl1'"
using assms proof (cases rule: BO.cases)
  case (BO_FVal fs) then show thesis by (cases fs) (auto intro: Nil FVal) next
  case (BO_BC vl'' vl1'' fs) then show thesis by (cases fs) (auto intro: FVal OVal)
qed

(* helper *) lemma BC_cases:
assumes "BC vl vl1"
obtains (Nil) "vl = []" and "vl1 = []"
      | (FVal) fv fs where "vl = FVal fv # map FVal fs" and "vl1 = []"
      | (FVal1) fv fs fs1 where "vl = map FVal fs" and "vl1 = FVal fv # map FVal fs1"
      | (BO_FVal) fv fv' fs vl' vl1' where "vl = FVal fv # map FVal fs @ FVal fv' # OVal True # vl'"
                                       and "vl1 = FVal fv' # OVal True # vl1'" and "BO vl' vl1'"
      | (BO_FVal1) fv fv' fs fs1 vl' vl1' where "vl = map FVal fs @ FVal fv' # OVal True # vl'"
                                       and "vl1 = FVal fv # map FVal fs1 @ FVal fv' # OVal True # vl1'"
                                       and "BO vl' vl1'"
      | (FVal_BO) fv vl' vl1' where "vl = FVal fv # OVal True # vl'"
                                and "vl1 = FVal fv # OVal True # vl1'" and "BO vl' vl1'"
      | (OVal) vl' vl1' where "vl = OVal True # vl'" and "vl1 = OVal True # vl1'" and "BO vl' vl1'"
using assms proof (cases rule: BC.cases)
  case (BC_FVal fs fs1)
    then show ?thesis proof (induction fs1)
      case Nil then show ?case by (induction fs) (auto intro: that(1,2)) next
      case (Cons fv fs1') then show ?case by (intro that(3)) auto
    qed
next
  case (BC_BO vl' vl1' fs fs1)
    then show ?thesis proof (cases fs1 rule: rev_cases)
      case Nil then show ?thesis using BC_BO by (intro that(7)) auto next
      case (snoc fs1' fv')
        moreover then obtain fs' where "fs = fs' ## fv'" using BC_BO
          by (induction fs rule: rev_induct) auto
        ultimately show ?thesis using BC_BO proof (induction fs1')
          case Nil
            then show ?thesis proof (induction fs')
              case Nil then show ?thesis by (intro that(6)) auto next
              case (Cons fv'' fs'') then show ?thesis by (intro that(4)) auto
            qed
        next
          case (Cons fv'' fs1'') then show ?thesis by (intro that(5)) auto
        qed
    qed
qed

definition \<Delta>0 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>0 s vl s1 vl1 \<equiv>
 s = s1 \<and> B vl vl1 \<and> open s \<and> (\<not>IDsOK s [UID1, UID2] [])"

definition \<Delta>1 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>1 s vl s1 vl1 \<equiv>
 eqButUID s s1 \<and> friendIDs s = friendIDs s1 \<and> open s \<and>
 BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1) \<and>
 validValSeqFrom vl1 s1 \<and>
 IDsOK s1 [UID1, UID2] []"

definition \<Delta>2 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>2 s vl s1 vl1 \<equiv> (\<exists>fs fs1.
 eqButUID s s1 \<and> \<not>open s \<and>
 validValSeqFrom vl1 s1 \<and>
 filter (Not o isFRVal) vl  = map FVal fs  \<and>
 filter (Not o isFRVal) vl1 = map FVal fs1)"

definition \<Delta>3 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>3 s vl s1 vl1 \<equiv> (\<exists>fs fs1 vlr vlr1.
 eqButUID s s1 \<and> \<not>open s \<and> BO vlr vlr1 \<and>
 validValSeqFrom vl1 s1 \<and>
 (fs = [] \<longleftrightarrow> fs1 = []) \<and>
 (fs \<noteq> [] \<longrightarrow> last fs = last fs1) \<and>
 (fs = [] \<longrightarrow> friendIDs s = friendIDs s1) \<and>
 filter (Not o isFRVal) vl  = map FVal fs  @ OVal True # vlr \<and>
 filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1)"

lemma \<Delta>2_I:
assumes "eqButUID s s1" "\<not>open s"
        "validValSeqFrom vl1 s1"
        "filter (Not o isFRVal) vl  = map FVal fs"
        "filter (Not o isFRVal) vl1 = map FVal fs1"
shows "\<Delta>2 s vl s1 vl1"
using assms unfolding \<Delta>2_def by blast

lemma \<Delta>3_I:
assumes "eqButUID s s1" "\<not>open s" "BO vlr vlr1"
        "validValSeqFrom vl1 s1"
        "fs = [] \<longleftrightarrow> fs1 = []" "fs \<noteq> [] \<longrightarrow> last fs = last fs1"
        "fs = [] \<longrightarrow> friendIDs s = friendIDs s1"
        "filter (Not o isFRVal) vl  = map FVal fs  @ OVal True # vlr"
        "filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1"
shows "\<Delta>3 s vl s1 vl1"
using assms unfolding \<Delta>3_def by blast

lemma istate_\<Delta>0:
assumes B: "B vl vl1"
shows "\<Delta>0 istate vl istate vl1"
using assms unfolding \<Delta>0_def istate_def B_def open_def openByA_def openByF_def friends12_def
by auto

lemma unwind_cont_\<Delta>0: "unwind_cont \<Delta>0 {\<Delta>0,\<Delta>1,\<Delta>2,\<Delta>3}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>0 s vl s1 vl1 \<or>
                           \<Delta>1 s vl s1 vl1 \<or>
                           \<Delta>2 s vl s1 vl1 \<or>
                           \<Delta>3 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and \<Delta>0: "\<Delta>0 s vl s1 vl1"
  then have rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1" and os: "open s"
        and IDs: "\<not>IDsOK s [UID1, UID2] []"
    using reachNT_reach unfolding \<Delta>0_def by auto
  from IDs have "UID1 \<notin> set (pendingFReqs s UID2)" and "\<not>friends12 s"
            and "UID2 \<notin> set (pendingFReqs s UID1)"
    using reach_IDs_used_IDsOK[OF rs] unfolding friends12_def by auto
  with B have BO: "BO (filter (Not \<circ> isFRVal) vl) (filter (Not \<circ> isFRVal) vl1)"
          and vl_vl1: "vl = [] \<longrightarrow> vl1 = []"
          and vl_OVal: "vl \<noteq> [] \<and> hd vl = OVal False \<longrightarrow> vl1 \<noteq> [] \<and> hd vl1 = OVal False"
          and vVS: "validValSeqFrom vl1 s"
    unfolding B_def by (auto simp: istate_def friends12_def)
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof -
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof cases
        assume \<phi>: "\<phi> ?trn"
        then obtain uid p uid' p' where a: "a = Cact (cUser uid p uid' p')"
                                     "\<not>openByA s'" "\<not>openByF s'"
                                     "ou = outOK" "f ?trn = OVal False"
                                     "friends12 s' = friends12 s"
                                     "UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2"
                                     "UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1"
          using step rs IDs by (elim \<phi>E) (auto simp: openByA_def)
        with c \<phi> have vl: "vl = OVal False # vl'" unfolding consume_def by auto
        with vl_OVal obtain vl1' where vl1: "vl1 = OVal False # vl1'" by (cases vl1) auto
        from BO vl vl1 have BC': "BC (filter (Not \<circ> isFRVal) vl') (filter (Not \<circ> isFRVal) vl1')"
          by (cases rule: BO_cases) auto
        then have "\<Delta>2 s' vl' s' vl1' \<or> \<Delta>3 s' vl' s' vl1'" using vVS a unfolding vl1
        proof (cases rule: BC.cases)
          case BC_FVal
            then show ?thesis using vVS a unfolding vl1
              by (intro disjI1 \<Delta>2_I) (auto simp: open_def)
        next
          case BC_BO
            then show ?thesis using vVS a unfolding vl1
              by (intro disjI2 \<Delta>3_I) (auto simp: open_def)
        qed
        then have ?match using step a \<phi> unfolding ss1 vl1
          by (intro matchI[of s a ou s']) (auto simp: consume_def)
        then show ?thesis ..
      next
        assume n\<phi>: "\<not>\<phi> ?trn"
        then have s': "open s'" "friends12 s' = friends12 s"
                      "UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2"
                      "UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1"
          using os step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] step_pendingFReqs_\<phi>[OF step]
          by auto
        moreover have "vl' = vl" using n\<phi> c by (auto simp: consume_def)
        ultimately have "\<Delta>0 s' vl' s' vl1 \<or> \<Delta>1 s' vl' s' vl1"
          using vVS B BO unfolding \<Delta>0_def \<Delta>1_def
          by (cases "IDsOK s' [UID1, UID2] []") auto
        then have ?match using step c n\<phi> unfolding ss1
          by (intro matchI[of s a ou s']) (auto simp: consume_def)
        then show ?thesis ..
      qed
    qed
    then show ?thesis using vl_vl1 by auto
  qed
qed

lemma unwind_cont_\<Delta>1: "unwind_cont \<Delta>1 {\<Delta>1,\<Delta>2,\<Delta>3}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>1 s vl s1 vl1 \<or>
                           \<Delta>2 s vl s1 vl1 \<or>
                           \<Delta>3 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and \<Delta>1: "\<Delta>1 s vl s1 vl1"
  then have rs: "reach s" and ss1: "eqButUID s s1" and fIDs: "friendIDs s = friendIDs s1"
        and os: "open s" and BO: "BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1)"
        and vVS1: "validValSeq vl1 (friends12 s1)
                                   (UID1 \<in>\<in> pendingFReqs s1 UID2)
                                   (UID2 \<in>\<in> pendingFReqs s1 UID1)" (is "?vVS vl1 s1")
        and IDs1: "IDsOK s1 [UID1, UID2] []"
    using reachNT_reach unfolding \<Delta>1_def by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof cases
    assume "\<exists>u req vl1'. vl1 = FRVal u req # vl1'"
    then obtain u req vl1' where vl1: "vl1 = FRVal u req # vl1'" by auto
    obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and "\<phi> (Trans s1 a outOK s1')"
                            and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                            and uid: "uid = UID1 \<and> uid' = UID2 \<or> uid = UID2 \<and> uid' = UID1"
                            and "f (Trans s1 a outOK s1') = FRVal u req" and "?vVS vl1' s1'"
      using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 by (blast intro: produce_FRVal)
    moreover then have "\<not>\<gamma> (Trans s1 a outOK s1')" using UID1_UID2_UIDs by auto
    moreover have "eqButUID s1 s1'" using step1 a uid by (auto intro: Cact_cFriendReq_step_eqButUID)
    moreover have "friendIDs s1' = friendIDs s1" and "IDsOK s1' [UID1, UID2] []"
      using step1 a uid by (auto simp: c_defs)
    ultimately have "?iact" using ss1 fIDs os BO unfolding vl1
      by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def \<Delta>1_def intro: eqButUID_trans)
    then show ?thesis ..
  next
    assume nFRVal1: "\<not> (\<exists>u req vl1'. vl1 = FRVal u req # vl1')"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof cases
        assume \<phi>: "\<phi> ?trn"
        then have vl: "vl = f ?trn # vl'" using c by (auto simp: consume_def)
        from BO show ?thesis proof (cases "f ?trn")
          case (FVal fv)
            with BO obtain vl1' where vl1: "vl1 = f ?trn # vl1'"
              using BO_Nil_iff[OF BO] FVal vl nFRVal1
              by (cases rule: BO_cases; cases vl1; cases "hd vl1") auto
            with BO have BO': "BO (filter (Not o isFRVal) vl') (filter (Not o isFRVal) vl1')"
              using FVal vl by (cases rule: BO_cases) auto
            from fIDs have f12: "friends12 s = friends12 s1" unfolding friends12_def by auto
            have ?match using \<phi> step rs FVal proof (cases rule: \<phi>E)
              case (Friend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = createFriend s UID1 p UID2"
                  using Friend step by (auto simp: createFriend_sym)
                have ss': "eqButUID s s'" using rs step Friend
                  by (auto intro: Cact_cFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain a1 uid1 uid1' p1
                where "step s1 a1 = (outOK, ?s1')" "friends12 ?s1'"
                      "a1 = Cact (cFriend uid1 p1 uid1')"
                      "uid1 = UID1 \<and> uid1' = UID2 \<or> uid1 = UID2 \<and> uid1' = UID1"
                      "\<phi> (Trans s1 a1 outOK ?s1')"
                      "f (Trans s1 a1 outOK ?s1') = FVal True"
                      "eqButUID s1 ?s1'" "?vVS vl1' ?s1'"
                  using rs1 IDs1 Friend vVS1 unfolding vl1 f12 Friend(3)
                  by (elim toggle_friends12_True) blast+
                moreover then have "IDsOK ?s1' [UID1, UID2] []" by (auto simp: c_defs)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using Friend(6) f12 unfolding s'
                  by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                ultimately show ?match using ss1 BO' Friend UID1_UID2_UIDs unfolding vl1 \<Delta>1_def
                  by (intro matchI[of s1 a1 "outOK" ?s1'])
                     (auto simp: consume_def intro: eqButUID_trans eqButUID_sym)
            next
              case (Unfriend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = deleteFriend s UID1 p UID2"
                  using Unfriend step by (auto simp: deleteFriend_sym)
                have ss': "eqButUID s s'" using rs step Unfriend
                  by (auto intro: Dact_dFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain a1 uid1 uid1' p1
                where "step s1 a1 = (outOK, ?s1')" "\<not>friends12 ?s1'"
                      "a1 = Dact (dFriend uid1 p1 uid1')"
                      "uid1 = UID1 \<and> uid1' = UID2 \<or> uid1 = UID2 \<and> uid1' = UID1"
                      "\<phi> (Trans s1 a1 outOK ?s1')"
                      "f (Trans s1 a1 outOK ?s1') = FVal False"
                      "eqButUID s1 ?s1'" "?vVS vl1' ?s1'"
                  using rs1 IDs1 Unfriend vVS1 unfolding vl1 f12 Unfriend(3)
                  by (elim toggle_friends12_False) blast+
                moreover have "friendIDs s' = friendIDs ?s1'" "IDsOK ?s1' [UID1, UID2] []"
                  using fIDs IDs1 unfolding s' by (auto simp: d_defs)
                ultimately show ?match using ss1 BO' Unfriend UID1_UID2_UIDs unfolding vl1 \<Delta>1_def
                  by (intro matchI[of s1 a1 "outOK" ?s1'])
                     (auto simp: consume_def intro: eqButUID_trans eqButUID_sym)
            qed auto
            then show ?thesis ..
        next
          case (OVal ov)
            with BO obtain vl1' where vl1': "vl1 = OVal False # vl1'"
              using BO_Nil_iff[OF BO] OVal vl nFRVal1
              by (cases rule: BO_cases; cases vl1; cases "hd vl1") auto
            with BO have BC': "BC (filter (Not o isFRVal) vl') (filter (Not o isFRVal) vl1')"
              using OVal vl by (cases rule: BO_cases) auto
            from BO vl OVal have "f ?trn = OVal False" by (cases rule: BO_cases) auto
            with \<phi> step rs have ?match proof (cases rule: \<phi>E)
              case (CloseF uid p uid')
                let ?s1' = "deleteFriend s1 uid p uid'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = deleteFriend s uid p uid'" using CloseF step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                 and pFR1': "pendingFReqs ?s1' = pendingFReqs s1"
                  using CloseF step ss1 fIDs unfolding eqButUID_def by (auto simp: d_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "\<not>open s'" using CloseF os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: d_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  using CloseF(2) UID1_UID2_UIDs unfolding friends12_def d_defs by auto
                from BC' have "\<Delta>2 s' vl' ?s1' vl1' \<or> \<Delta>3 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FVal fs fs1)
                    then show ?thesis using vVS1 os' fIDs' f12s1 s's1' pFR1'
                      unfolding \<Delta>2_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "\<Delta>3 s' vl' ?s1' vl1'" using s's1' os' vVS1 f12s1 fIDs' pFR1'
                      unfolding vl1' by (intro \<Delta>3_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "\<not>open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "\<phi> ?trn1" unfolding CloseF by auto
                ultimately show ?match using step1 vl1' CloseF UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            next
              case (CloseA uid p uid' p')
                let ?s1' = "createUser s1 uid p uid' p'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = createUser s uid p uid' p'" using CloseA step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                 and pFR1': "pendingFReqs ?s1' = pendingFReqs s1"
                  using CloseA step ss1 unfolding eqButUID_def by (auto simp: c_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "\<not>open s'" using CloseA os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: c_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  unfolding friends12_def by (auto simp: c_defs)
                from BC' have "\<Delta>2 s' vl' ?s1' vl1' \<or> \<Delta>3 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FVal fs fs1)
                    then show ?thesis using vVS1 os' fIDs' f12s1 s's1' pFR1'
                      unfolding \<Delta>2_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "\<Delta>3 s' vl' ?s1' vl1'" using s's1' os' vVS1 f12s1 fIDs' pFR1'
                      unfolding vl1' by (intro \<Delta>3_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "\<not>open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "\<phi> ?trn1" unfolding CloseA by auto
                ultimately show ?match using step1 vl1' CloseA UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            qed auto
            then show ?thesis ..
        next
          case (FRVal u req)
            obtain p
            where a: "(a = Cact (cFriendReq UID1 p UID2 req) \<and> UID1 \<in>\<in> pendingFReqs s' UID2 \<and>
                       UID1 \<notin> set (pendingFReqs s UID2) \<and>
                       (UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1)) \<or>
                      (a = Cact (cFriendReq UID2 p UID1 req) \<and> UID2 \<in>\<in> pendingFReqs s' UID1 \<and>
                       UID2 \<notin> set (pendingFReqs s UID1) \<and>
                       (UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2))"
                     "ou = outOK" "\<not>friends12 s" "\<not>friends12 s'" "open s' = open s"
              using \<phi> step rs FRVal by (cases rule: \<phi>E) fastforce+
            then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
            have "eqButUID s s'" using a step
              by (auto intro: Cact_cFriendReq_step_eqButUID)
            then have "\<Delta>1 s' vl' s1 vl1"
              unfolding \<Delta>1_def using ss1 fIDs' fIDs os a(5) vVS1 IDs1 BO vl FRVal
              by (auto intro: eqButUID_trans eqButUID_sym)
            moreover from \<phi> step rs a have "\<not>\<gamma> (Trans s a ou s')"
              using UID1_UID2_UIDs by auto
            ultimately have ?ignore by (intro ignoreI) auto
            then show ?thesis ..
        qed
      next
        assume n\<phi>: "\<not>\<phi> ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] by auto
        have vl': "vl' = vl" using n\<phi> c by (auto simp: consume_def)
        show ?thesis proof (cases "\<forall>req. a \<noteq> Cact (cFriend UID1 (pass s UID1) UID2) \<and>
                                         a \<noteq> Cact (cFriend UID2 (pass s UID2) UID1) \<and>
                                         a \<noteq> Cact (cFriendReq UID2 (pass s UID2) UID1 req) \<and>
                                         a \<noteq> Cact (cFriendReq UID1 (pass s UID1) UID2 req) \<and>
                                         a \<noteq> Dact (dFriend UID1 (pass s UID1) UID2) \<and>
                                         a \<noteq> Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            have fIDs': "friendIDs s' = friendIDs s1'" using True
              by (intro eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 _ fIDs]) auto
            from True n\<phi> have n\<phi>': "\<not>\<phi> ?trn1" using eqButUID_step_\<phi>[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
                  and pFRs': "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s1' UID2"
                             "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s1' UID1"
              using step_friends12_\<phi>[OF step1] step_pendingFReqs_\<phi>[OF step1]
              by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "\<Delta>1 s' vl' s1' vl1" using os fIDs' vVS1 BO IDsOK_mono[OF step1 IDs1]
              unfolding \<Delta>1_def os' f12s1' pFRs' vl' by auto
            then have ?match
              using step1 n\<phi>' fIDs eqButUID_step_\<gamma>_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match \<or> ?ignore" ..
        next
          case False
            with n\<phi> have "ou \<noteq> outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using \<Delta>1 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match \<or> ?ignore" ..
        qed
      qed
    qed
    moreover have "vl = [] \<longrightarrow> vl1 = []" proof
      assume "vl = []"
      with BO have "filter (Not \<circ> isFRVal) vl1 = []" using BO_Nil_iff[OF BO] by auto
      with nFRVal1 show "vl1 = []" by (cases vl1; cases "hd vl1") auto
    qed
    ultimately show ?thesis by auto
  qed
qed

lemma unwind_cont_\<Delta>2: "unwind_cont \<Delta>2 {\<Delta>2, \<Delta>1}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>2 s vl s1 vl1 \<or> \<Delta>1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 2: "\<Delta>2 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  from 2 obtain fs fs1
  where ss1: "eqButUID s s1" and os: "\<not>open s"
    and vVS1: "validValSeqFrom vl1 s1"
    and fs:  "filter (Not o isFRVal) vl =  map FVal fs"
    and fs1: "filter (Not o isFRVal) vl1 = map FVal fs1"
    unfolding \<Delta>2_def by auto
  from os have IDs: "IDsOK s [UID1, UID2] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof cases
    assume vl1: "vl1 = []"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof cases
        assume \<phi>: "\<phi> ?trn"
        with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
        with fs have ?ignore proof (cases "f ?trn")
          case (FRVal u req)
            obtain p
            where a: "(a = Cact (cFriendReq UID1 p UID2 req) \<and> UID1 \<in>\<in> pendingFReqs s' UID2 \<and>
                       UID1 \<notin> set (pendingFReqs s UID2) \<and>
                       (UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1)) \<or>
                      (a = Cact (cFriendReq UID2 p UID1 req) \<and> UID2 \<in>\<in> pendingFReqs s' UID1 \<and>
                       UID2 \<notin> set (pendingFReqs s UID1) \<and>
                       (UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2))"
                     "ou = outOK" "\<not>friends12 s" "\<not>friends12 s'" "open s' = open s"
              using \<phi> step rs FRVal by (cases rule: \<phi>E) fastforce+
            then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
            have "eqButUID s s'" using a step
              by (auto intro: Cact_cFriendReq_step_eqButUID)
            then have "\<Delta>2 s' vl' s1 vl1"
              unfolding \<Delta>2_def using ss1 os a(5) vVS1 vl fs fs1
              by (auto intro: eqButUID_trans eqButUID_sym)
            moreover from \<phi> step rs a have "\<not>\<gamma> (Trans s a ou s')"
              using UID1_UID2_UIDs by auto
            ultimately show ?ignore by (intro ignoreI) auto
        next
          case (FVal fv)
            with fs vl obtain fs' where fs': "fs = fv # fs'" by (cases fs) auto
            from \<phi> step rs FVal have ss': "eqButUID s s'"
              by (elim \<phi>E) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
            then have "\<not>open s'" using os by (auto simp: eqButUID_open_eq)
            moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
            ultimately have "\<Delta>2 s' vl' s1 vl1"
              using vVS1 fs' fs unfolding \<Delta>2_def vl vl1 FVal by auto
            moreover have "\<not>\<gamma> ?trn" using \<phi> step rs FVal UID1_UID2_UIDs by (elim \<phi>E) auto
            ultimately show ?ignore by (intro ignoreI) auto
        qed auto
        then show ?thesis ..
      next
        assume n\<phi>: "\<not>\<phi> ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] by auto
        have vl': "vl' = vl" using n\<phi> c by (auto simp: consume_def)
        show ?thesis proof (cases "\<forall>req. a \<noteq> Cact (cFriend UID1 (pass s UID1) UID2) \<and>
                                         a \<noteq> Cact (cFriend UID2 (pass s UID2) UID1) \<and>
                                         a \<noteq> Cact (cFriendReq UID2 (pass s UID2) UID1 req) \<and>
                                         a \<noteq> Cact (cFriendReq UID1 (pass s UID1) UID2 req) \<and>
                                         a \<noteq> Dact (dFriend UID1 (pass s UID1) UID2) \<and>
                                         a \<noteq> Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            from True n\<phi> have n\<phi>': "\<not>\<phi> ?trn1"
              using eqButUID_step_\<phi>[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
                  and pFRs': "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s1' UID2"
                             "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s1' UID1"
              using step_friends12_\<phi>[OF step1] step_pendingFReqs_\<phi>[OF step1]
              by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "\<Delta>2 s' vl' s1' vl1" using os vVS1 fs fs1
              unfolding \<Delta>2_def os' f12s1' pFRs' vl' by auto
            then have ?match
              using step1 n\<phi>' os eqButUID_step_\<gamma>_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match \<or> ?ignore" ..
        next
          case False
            with n\<phi> have "ou \<noteq> outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using 2 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match \<or> ?ignore" ..
        qed
      qed
    qed
    then show ?thesis using vl1 by auto
  next
    assume "vl1 \<noteq> []"
    then obtain v vl1' where vl1: "vl1 = v # vl1'" by (cases vl1) auto
    with fs1 have ?iact proof (cases v)
      case (FRVal u req)
        obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and "\<phi> (Trans s1 a outOK s1')"
                                and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                                and uid: "uid = UID1 \<and> uid' = UID2 \<or> uid = UID2 \<and> uid' = UID1"
                                and "f (Trans s1 a outOK s1') = FRVal u req"
                                and vVS1': "validValSeqFrom vl1' s1'"
          using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 FRVal by (blast intro: produce_FRVal)
        moreover then have "\<not>\<gamma> (Trans s1 a outOK s1')" using UID1_UID2_UIDs by auto
        moreover have "eqButUID s1 s1'" using step1 a uid
          by (auto intro: Cact_cFriendReq_step_eqButUID)
        moreover then have "\<Delta>2 s vl s1' vl1'" using ss1 os vVS1' fs fs1 unfolding vl1 FRVal
          by (intro \<Delta>2_I[of s s1' vl1' vl fs fs1]) (auto intro: eqButUID_trans)
        ultimately show "?iact" using ss1 os unfolding vl1 FRVal
          by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def intro: eqButUID_trans)
    next
      case (FVal fv)
        then obtain fs1' where fs1': "fs1 = fv # fs1'"
          using vl1 fs1 by (cases fs1) auto
        from FVal vVS1 vl1 have f12: "friends12 s1 \<noteq> fv"
                            and vVS1: "validValSeqFrom (FVal fv # vl1') s1" by auto
        then show ?iact using rs1 IDs1 vl1 FVal ss1 os fs fs1 fs1' vl1 FVal
          by (elim toggle_friends12[of s1 fv vl1'], blast, blast, blast)
             (intro iactionI[of s1 _ _ _ vl1 vl1'],
              auto simp: consume_def intro: \<Delta>2_I[of s _ vl1' vl fs fs1'] eqButUID_trans)
    qed auto
    then show ?thesis ..
  qed
qed

lemma unwind_cont_\<Delta>3: "unwind_cont \<Delta>3 {\<Delta>3,\<Delta>1}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>3 s vl s1 vl1 \<or> \<Delta>1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 3: "\<Delta>3 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  obtain fs fs1 vlr vlr1
  where ss1: "eqButUID s s1" and os: "\<not>open s" and BO: "BO vlr vlr1"
    and vVS1: "validValSeqFrom vl1 s1"
    and fs:  "filter (Not o isFRVal) vl =  map FVal fs  @ OVal True # vlr"
    and fs1: "filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1"
    and fs_fs1: "fs = [] \<longleftrightarrow> fs1 = []"
    and last_fs: "fs \<noteq> [] \<longrightarrow> last fs = last fs1"
    and fs_fIDs: "fs = [] \<longrightarrow> friendIDs s = friendIDs s1"
    using 3 unfolding \<Delta>3_def by auto
  have BC: "BC (map FVal fs @ OVal True # vlr) (map FVal fs1 @ OVal True # vlr1)"
    using fs fs1 fs_fs1 last_fs BO by auto
  from os have IDs: "IDsOK s [UID1, UID2] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof cases
    assume "\<exists>u req vl1'. vl1 = FRVal u req # vl1'"
    then obtain u req vl1' where vl1: "vl1 = FRVal u req # vl1'" by auto
    obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and \<phi>: "\<phi> (Trans s1 a outOK s1')"
                            and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                            and uid: "uid = UID1 \<and> uid' = UID2 \<or> uid = UID2 \<and> uid' = UID1"
                            and f: "f (Trans s1 a outOK s1') = FRVal u req"
                            and "validValSeqFrom vl1' s1'"
      using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 by (blast intro: produce_FRVal)
    moreover have "eqButUID s1 s1'" using step1 a uid by (auto intro: Cact_cFriendReq_step_eqButUID)
    moreover have "friendIDs s1' = friendIDs s1" and "IDsOK s1' [UID1, UID2] []"
      using step1 a uid by (auto simp: c_defs)
    ultimately have "\<Delta>3 s vl s1' vl1'" using ss1 os BO fs_fs1 last_fs fs_fIDs fs fs1 unfolding vl1
      by (intro \<Delta>3_I[of _ _ vlr vlr1 vl1' fs fs1 vl])
         (auto simp: consume_def intro: eqButUID_trans)
    moreover have "\<not>\<gamma> (Trans s1 a outOK s1')" using a uid UID1_UID2_UIDs by auto
    ultimately have "?iact" using step1 \<phi> f unfolding vl1
      by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def)
    then show ?thesis ..
  next
    assume nFRVal1: "\<not>(\<exists>u req vl1'. vl1 = FRVal u req # vl1')"
    from BC show ?thesis proof (cases rule: BC_cases)
      case (BO_FVal fv fv' fs' vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = map FVal (fv # fs' ## fv') @ OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = FVal fv' # OVal True # vl1''"
          using fs fs1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
          show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
          proof cases
            assume \<phi>: "\<phi> ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' have ?ignore proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) \<and> UID1 \<in>\<in> pendingFReqs s' UID2 \<and>
                           UID1 \<notin> set (pendingFReqs s UID2) \<and>
                           (UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1)) \<or>
                          (a = Cact (cFriendReq UID2 p UID1 req) \<and> UID2 \<in>\<in> pendingFReqs s' UID1 \<and>
                           UID2 \<notin> set (pendingFReqs s UID1) \<and>
                           (UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2))"
                         "ou = outOK" "\<not>friends12 s" "\<not>friends12 s'" "open s' = open s"
                  using \<phi> step rs FRVal by (cases rule: \<phi>E) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "\<Delta>3 s' vl' s1 vl1"
                  using ss1 a os BO vVS1 fs_fs1 last_fs fs_fIDs fs fs1 fIDs' vl FRVal
                  by (intro \<Delta>3_I[of s' s1 vlr vlr1 vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from a have "\<not>\<gamma> (Trans s a ou s')"
                  using UID1_UID2_UIDs by auto
                ultimately show ?ignore by (intro ignoreI) auto
            next
              case (FVal fv'')
                with vl fs' have FVal: "f ?trn = FVal fv"
                             and vl': "filter (Not \<circ> isFRVal) vl' = map FVal (fs' ## fv') @ OVal True # vl''"
                  by auto
                from \<phi> step rs FVal have ss': "eqButUID s s'"
                  by (elim \<phi>E) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
                then have "\<not>open s'" using os by (auto simp: eqButUID_open_eq)
                moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
                ultimately have "\<Delta>3 s' vl' s1 vl1" using BO_FVal(3) vVS1 vl' fs1'
                  by (intro \<Delta>3_I[of s' s1 vl'' vl1'' vl1 "fs' ## fv'" "[fv']" vl']) auto
                moreover have "\<not>\<gamma> ?trn" using \<phi> step rs FVal UID1_UID2_UIDs by (elim \<phi>E) auto
                ultimately show ?ignore by (intro ignoreI) auto
            qed auto
            then show ?thesis ..
          next
            assume n\<phi>: "\<not>\<phi> ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] by auto
            have vl': "vl' = vl" using n\<phi> c by (auto simp: consume_def)
            show ?thesis proof (cases "\<forall>req. a \<noteq> Cact (cFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Cact (cFriend UID2 (pass s UID2) UID1) \<and>
                                             a \<noteq> Cact (cFriendReq UID2 (pass s UID2) UID1 req) \<and>
                                             a \<noteq> Cact (cFriendReq UID1 (pass s UID1) UID2 req) \<and>
                                             a \<noteq> Dact (dFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True n\<phi> have n\<phi>': "\<not>\<phi> ?trn1"
                  using eqButUID_step_\<phi>[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s1' UID2"
                                 "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s1' UID1"
                  using step_friends12_\<phi>[OF step1] step_pendingFReqs_\<phi>[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                thm \<Delta>3_I[of s' s1' vl'' vl1'' vl1 "fv # fs' ## fv'" "[fv']" vl']
                then have "\<Delta>3 s' vl' s1' vl1" using os vVS1 fs' fs1' BO_FVal
                  unfolding os' f12s1' pFRs' vl'
                  by (intro \<Delta>3_I[of s' s1' vl'' vl1'' vl1 "fv # fs' ## fv'" "[fv']" vl]) auto
                then have ?match
                  using step1 n\<phi>' os eqButUID_step_\<gamma>_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match \<or> ?ignore" ..
            next
              case False
                with n\<phi> have "ou \<noteq> outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match \<or> ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (BO_FVal1 fv fv' fs' fs1' vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = map FVal (fs' ## fv') @ OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = map FVal (fv # fs1' ## fv') @ OVal True # vl1''"
          using fs fs1 by auto
        with nFRVal1 obtain vl1'
        where vl1: "vl1 = FVal fv # vl1'"
          and vl1': "filter (Not o isFRVal) vl1' = map FVal (fs1' ## fv') @ OVal True # vl1''"
          by (cases vl1; cases "hd vl1") auto
        with vVS1 have f12: "friends12 s1 \<noteq> fv"
                   and vVS1: "validValSeqFrom (FVal fv # vl1') s1" by auto
        then have ?iact using rs1 IDs1 vl1 ss1 os BO_FVal1(3) fs' vl1'
          by (elim toggle_friends12[of s1 fv vl1'], blast, blast, blast)
             (intro iactionI[of s1 _ _ _ vl1 vl1'],
              auto simp: consume_def
                   intro: \<Delta>3_I[of s _ vl'' vl1'' vl1' "fs' ## fv'" "fs1' ## fv'" vl]
                          eqButUID_trans)
        then show ?thesis ..
    next
      case (FVal_BO fv vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = FVal fv # OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = FVal fv # OVal True # vl1''"
          using fs fs1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
          show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
          proof cases
            assume \<phi>: "\<phi> ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' show ?thesis proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) \<and> UID1 \<in>\<in> pendingFReqs s' UID2 \<and>
                           UID1 \<notin> set (pendingFReqs s UID2) \<and>
                           (UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1)) \<or>
                          (a = Cact (cFriendReq UID2 p UID1 req) \<and> UID2 \<in>\<in> pendingFReqs s' UID1 \<and>
                           UID2 \<notin> set (pendingFReqs s UID1) \<and>
                           (UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2))"
                         "ou = outOK" "\<not>friends12 s" "\<not>friends12 s'" "open s' = open s"
                  using \<phi> step rs FRVal by (cases rule: \<phi>E) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "\<Delta>3 s' vl' s1 vl1"
                  using ss1 a os BO vVS1 fs_fs1 last_fs fs_fIDs fs fs1 fIDs' vl FRVal
                  by (intro \<Delta>3_I[of s' s1 vlr vlr1 vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from a have "\<not>\<gamma> (Trans s a ou s')"
                  using UID1_UID2_UIDs by auto
                ultimately have ?ignore by (intro ignoreI) auto
                then show ?thesis ..
            next
              case (FVal fv'')
                with vl fs' have FVal: "f ?trn = FVal fv"
                             and vl': "filter (Not \<circ> isFRVal) vl' = OVal True # vl''"
                  by auto
                from fs1' nFRVal1 obtain vl1'
                where vl1: "vl1 = FVal fv # vl1'"
                  and vl1': "filter (Not \<circ> isFRVal) vl1' = OVal True # vl1''"
                  by (cases vl1; cases "hd vl1") auto
                have ?match using \<phi> step rs FVal proof (cases rule: \<phi>E)
                  case (Friend uid p uid')
                    then have IDs1: "IDsOK s1 [UID1, UID2] []"
                          and f12s1: "\<not>friends12 s1"
                          and fv: "fv = True"
                      using ss1 vVS1 FVal unfolding eqButUID_def vl1 by auto
                    let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                    have s': "s' = createFriend s UID1 p UID2"
                      using Friend step by (auto simp: createFriend_sym)
                    have ss': "eqButUID s s'" using rs step Friend
                      by (auto intro: Cact_cFriend_step_eqButUID)
                    moreover then have os': "\<not>open s'" using os eqButUID_open_eq by auto
                    moreover obtain a1 uid1 uid1' p1
                    where "step s1 a1 = (outOK, ?s1')" "friends12 ?s1'"
                          "a1 = Cact (cFriend uid1 p1 uid1')"
                          "uid1 = UID1 \<and> uid1' = UID2 \<or> uid1 = UID2 \<and> uid1' = UID1"
                          "\<phi> (Trans s1 a1 outOK ?s1')"
                          "f (Trans s1 a1 outOK ?s1') = FVal True"
                          "eqButUID s1 ?s1'" "validValSeqFrom vl1' ?s1'"
                      using rs1 IDs1 Friend vVS1 f12s1 unfolding vl1 FVal
                      by (elim toggle_friends12_True; blast)
                    moreover then have "IDsOK ?s1' [UID1, UID2] []" by (auto simp: c_defs)
                    moreover have "friendIDs s' = friendIDs ?s1'"
                      using Friend(6) f12s1 unfolding s'
                      by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                    ultimately show ?match
                      using ss1 FVal_BO Friend UID1_UID2_UIDs vl' vl1' unfolding vl1 fv
                      by (intro matchI[of s1 a1 "outOK" ?s1'])
                         (auto simp: consume_def intro: eqButUID_trans eqButUID_sym
                               intro!: \<Delta>3_I[of s' ?s1' vl'' vl1'' vl1' "[]" "[]" vl'])
                next
                  case (Unfriend uid p uid')
                    then have IDs1: "IDsOK s1 [UID1, UID2] []"
                          and f12s1: "friends12 s1"
                          and fv: "fv = False"
                      using ss1 vVS1 FVal unfolding eqButUID_def vl1 by auto
                    let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                    have s': "s' = deleteFriend s UID1 p UID2"
                      using Unfriend step by (auto simp: deleteFriend_sym)
                    have ss': "eqButUID s s'" using rs step Unfriend
                      by (auto intro: Dact_dFriend_step_eqButUID)
                    moreover then have os': "\<not>open s'" using os eqButUID_open_eq by auto
                    moreover obtain a1 uid1 uid1' p1
                    where "step s1 a1 = (outOK, ?s1')" "\<not>friends12 ?s1'"
                          "a1 = Dact (dFriend uid1 p1 uid1')"
                          "uid1 = UID1 \<and> uid1' = UID2 \<or> uid1 = UID2 \<and> uid1' = UID1"
                          "\<phi> (Trans s1 a1 outOK ?s1')"
                          "f (Trans s1 a1 outOK ?s1') = FVal False"
                          "eqButUID s1 ?s1'" "validValSeqFrom vl1' ?s1'"
                      using rs1 IDs1 Unfriend vVS1 f12s1 unfolding vl1 FVal
                      by (elim toggle_friends12_False; blast)
                    moreover then have "IDsOK ?s1' [UID1, UID2] []" by (auto simp: d_defs)
                    moreover have "friendIDs s' = friendIDs ?s1'"
                      using Unfriend(6) f12s1 unfolding s'
                      by (intro eqButUID_deleteFriend12_friendIDs_eq[OF ss1 rs rs1])
                    ultimately show ?match
                      using ss1 FVal_BO Unfriend UID1_UID2_UIDs vl' vl1' unfolding vl1 fv
                      by (intro matchI[of s1 a1 "outOK" ?s1'])
                         (auto simp: consume_def intro: eqButUID_trans eqButUID_sym
                               intro!: \<Delta>3_I[of s' ?s1' vl'' vl1'' vl1' "[]" "[]" vl'])
                qed auto
                then show ?thesis ..
            qed auto
          next
            assume n\<phi>: "\<not>\<phi> ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] by auto
            have vl': "vl' = vl" using n\<phi> c by (auto simp: consume_def)
            show ?thesis proof (cases "\<forall>req. a \<noteq> Cact (cFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Cact (cFriend UID2 (pass s UID2) UID1) \<and>
                                             a \<noteq> Cact (cFriendReq UID2 (pass s UID2) UID1 req) \<and>
                                             a \<noteq> Cact (cFriendReq UID1 (pass s UID1) UID2 req) \<and>
                                             a \<noteq> Dact (dFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True n\<phi> have n\<phi>': "\<not>\<phi> ?trn1"
                  using eqButUID_step_\<phi>[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s1' UID2"
                                 "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s1' UID1"
                  using step_friends12_\<phi>[OF step1] step_pendingFReqs_\<phi>[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                thm \<Delta>3_I[of s' s1' vl'' vl1'' vl1 "[fv]" "[fv]" vl']
                then have "\<Delta>3 s' vl' s1' vl1" using os vVS1 fs' fs1' FVal_BO
                  unfolding os' f12s1' pFRs' vl'
                  by (intro \<Delta>3_I[of s' s1' vl'' vl1'' vl1 "[fv]" "[fv]" vl]) auto
                then have ?match
                  using step1 n\<phi>' os eqButUID_step_\<gamma>_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match \<or> ?ignore" ..
            next
              case False
                with n\<phi> have "ou \<noteq> outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match \<or> ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (OVal vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = OVal True # vl1''"
              and BO'': "BO vl'' vl1''"
          using fs fs1 by auto
        from fs fs' have fs: "fs = []" by (cases fs) auto
        with fs_fIDs have fIDs: "friendIDs s = friendIDs s1" by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
          show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
          proof cases
            assume \<phi>: "\<phi> ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' show ?thesis proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) \<and> UID1 \<in>\<in> pendingFReqs s' UID2 \<and>
                           UID1 \<notin> set (pendingFReqs s UID2) \<and>
                           (UID2 \<in>\<in> pendingFReqs s' UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s UID1)) \<or>
                          (a = Cact (cFriendReq UID2 p UID1 req) \<and> UID2 \<in>\<in> pendingFReqs s' UID1 \<and>
                           UID2 \<notin> set (pendingFReqs s UID1) \<and>
                           (UID1 \<in>\<in> pendingFReqs s' UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s UID2))"
                         "ou = outOK" "\<not>friends12 s" "\<not>friends12 s'" "open s' = open s"
                  using \<phi> step rs FRVal by (cases rule: \<phi>E) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "\<Delta>3 s' vl' s1 vl1"
                  using ss1 a os OVal(3) vVS1 fs' fs1' fs fs_fs1 fIDs' fIDs unfolding vl FRVal
                  by (intro \<Delta>3_I[of s' s1 vl'' vl1'' vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from \<phi> step rs a have "\<not>\<gamma> (Trans s a ou s')"
                  using UID1_UID2_UIDs by auto
                ultimately have ?ignore by (intro ignoreI) auto
                then show ?thesis ..
            next
              case (OVal ov')
                with vl fs' have OVal: "f ?trn = OVal True"
                             and vl': "filter (Not \<circ> isFRVal) vl' = vl''"
                  by auto
                from fs1' nFRVal1 obtain vl1'
                where vl1: "vl1 = OVal True # vl1'"
                  and vl1': "filter (Not \<circ> isFRVal) vl1' = vl1''"
                  by (cases vl1; cases "hd vl1") auto
                have ?match using \<phi> step rs OVal proof (cases rule: \<phi>E)
                  case (OpenF uid p uid')
                    let ?s1' = "createFriend s1 uid p uid'"
                    have s': "s' = createFriend s uid p uid'"
                      using OpenF step by auto
                    from OpenF(2) have uids: "uid \<noteq> UID1 \<and> uid \<noteq> UID2 \<and> uid' = UID1 \<or>
                                        uid \<noteq> UID1 \<and> uid \<noteq> UID2 \<and> uid' = UID2 \<or>
                                        uid' \<noteq> UID1 \<and> uid' \<noteq> UID2 \<and> uid = UID1 \<or>
                                        uid' \<noteq> UID1 \<and> uid' \<noteq> UID2 \<and> uid = UID2"
                      using UID1_UID2_UIDs by auto
                    have "eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
                      using ss1 unfolding eqButUID_def by auto
                    then have "uid' \<in>\<in> pendingFReqs s uid \<longleftrightarrow> uid' \<in>\<in> pendingFReqs s1 uid"
                      using OpenF by (intro eqButUIDf_not_UID') auto
                    then have step1: "step s1 a = (outOK, ?s1')"
                      using OpenF step ss1 fIDs unfolding eqButUID_def by (auto simp: c_defs)
                    have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                    moreover have os': "open s'" using OpenF unfolding open_def by auto
                    moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                      using fIDs unfolding s' by (auto simp: c_defs)
                    moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                                  "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs ?s1' UID2"
                                  "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs ?s1' UID1"
                      using uids unfolding friends12_def c_defs by auto
                    moreover then have "validValSeqFrom vl1' ?s1'" using vVS1 unfolding vl1 by auto
                    ultimately have "\<Delta>1 s' vl' ?s1' vl1'"
                      using BO'' IDsOK_mono[OF step1 IDs1] unfolding \<Delta>1_def vl' vl1' by auto
                    moreover have "\<phi> ?trn \<longleftrightarrow> \<phi> (Trans s1 a outOK ?s1')"
                      using OpenF(1) uids by (intro eqButUID_step_\<phi>[OF ss1 rs rs1 step step1]) auto
                    ultimately show ?match using step1 \<phi> OpenF(1,3,4) unfolding vl1
                      by (intro matchI[of s1 a outOK ?s1' _ vl1']) (auto simp: consume_def)
                qed auto
                then show ?thesis ..
            qed auto
        next
          assume n\<phi>: "\<not>\<phi> ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_\<phi>[OF step] step_friends12_\<phi>[OF step] by auto
            have vl': "vl' = vl" using n\<phi> c by (auto simp: consume_def)
            show ?thesis proof (cases "\<forall>req. a \<noteq> Cact (cFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Cact (cFriend UID2 (pass s UID2) UID1) \<and>
                                             a \<noteq> Cact (cFriendReq UID2 (pass s UID2) UID1 req) \<and>
                                             a \<noteq> Cact (cFriendReq UID1 (pass s UID1) UID2 req) \<and>
                                             a \<noteq> Dact (dFriend UID1 (pass s UID1) UID2) \<and>
                                             a \<noteq> Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True n\<phi> have n\<phi>': "\<not>\<phi> ?trn1"
                  using eqButUID_step_\<phi>[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 \<in>\<in> pendingFReqs s1 UID2 \<longleftrightarrow> UID1 \<in>\<in> pendingFReqs s1' UID2"
                                 "UID2 \<in>\<in> pendingFReqs s1 UID1 \<longleftrightarrow> UID2 \<in>\<in> pendingFReqs s1' UID1"
                  using step_friends12_\<phi>[OF step1] step_pendingFReqs_\<phi>[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have "friendIDs s' = friendIDs s1'"
                  using eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 _ fIDs] True
                  by auto
                ultimately have "\<Delta>3 s' vl' s1' vl1" using os vVS1 fs' fs1' OVal
                  unfolding os' f12s1' pFRs' vl'
                  by (intro \<Delta>3_I[of s' s1' vl'' vl1'' vl1 "[]" "[]" vl]) auto
                then have ?match
                  using step1 n\<phi>' os eqButUID_step_\<gamma>_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match \<or> ?ignore" ..
            next
              case False
                with n\<phi> have "ou \<noteq> outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match \<or> ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (FVal1 fv fs' fs1')
        from this(1) have "False" proof (induction fs' arbitrary: fs)
          case (Cons fv'' fs'')
            then obtain fs''' where "map FVal (fv'' # fs''') @ OVal True # vlr = map FVal (fv'' # fs'')"
              by (cases fs) auto
            with Cons.IH[of fs'''] show "False" by auto
        qed auto
        then show ?thesis ..
    next
      case (FVal) then show ?thesis by (induction fs) auto next
      case (Nil) then show ?thesis by auto
    qed
  qed
qed

definition Gr where
"Gr =
 {
 (\<Delta>0, {\<Delta>0,\<Delta>1,\<Delta>2,\<Delta>3}),
 (\<Delta>1, {\<Delta>1,\<Delta>2,\<Delta>3}),
 (\<Delta>2, {\<Delta>2,\<Delta>1}),
 (\<Delta>3, {\<Delta>3,\<Delta>1})
 }"

theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr \<Delta>0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_\<Delta>0 unwind_cont_\<Delta>0 unwind_cont_\<Delta>1 unwind_cont_\<Delta>2 unwind_cont_\<Delta>3
unfolding Gr_def by (auto intro: unwind_cont_mono)

end