(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory GraphLangLemmas

imports GraphLang CommonOpsLemmas

begin

definition
  get_state_function_call :: "(string \<Rightarrow> graph_function option)
    \<Rightarrow> (next_node \<times> state \<times> string) \<Rightarrow> string option"
where
  "get_state_function_call Gamma x \<equiv> case x of (NextNode nn, st, fname) \<Rightarrow>
        (case Gamma fname of Some gf \<Rightarrow>
            (case function_graph gf nn of Some (Call _ fname' _ _) \<Rightarrow> Some fname' | _ \<Rightarrow> None)
          | None \<Rightarrow> None)
    | _ \<Rightarrow> None"

definition
  exec_graph_invariant :: "(string \<Rightarrow> graph_function option) \<Rightarrow> string \<Rightarrow> stack \<Rightarrow> bool"
where
  "exec_graph_invariant Gamma gf xs = (xs \<noteq> []
    \<and> (\<forall>frame \<in> set (tl xs). get_state_function_call Gamma frame \<noteq> None)
    \<and> map (Some o snd o snd) xs = map (get_state_function_call Gamma) (tl xs) @ [Some gf])"

lemma exec_graph_invariant_Cons:
  "exec_graph_invariant Gamma fname (x # xs) = (if xs = [] then snd (snd x) = fname
    else (get_state_function_call Gamma (hd xs) = Some (snd (snd x))
        \<and> exec_graph_invariant Gamma fname xs))"
  by (cases xs, auto simp add: exec_graph_invariant_def)

lemma exec_step_invariant:
  "(stack, stack') \<in> exec_graph_step Gamma
    \<Longrightarrow> exec_graph_invariant Gamma gf stack
    \<Longrightarrow> exec_graph_invariant Gamma gf stack'"
  by (auto simp: all_exec_graph_step_cases exec_graph_invariant_Cons
                 get_state_function_call_def
          split: graph_function.split_asm)

lemma exec_trace_invariant':
  "tr \<in> exec_trace Gamma gf
    \<Longrightarrow> (\<forall>stack. tr i = Some stack
        \<longrightarrow> exec_graph_invariant Gamma gf stack)"
  apply (induct i)
   apply (clarsimp simp: exec_trace_def exec_graph_invariant_def)
   apply (clarsimp split: next_node.split_asm list.split_asm)
  apply (clarsimp simp: exec_trace_def nat_trace_rel_def)
  apply (drule_tac x=i in spec, clarsimp)
  apply (auto elim: exec_step_invariant)
  done

lemmas exec_trace_invariant = exec_trace_invariant'[rule_format]

lemma exec_trace_Nil:
  "tr \<in> exec_trace Gamma gf \<Longrightarrow> tr i \<noteq> Some []"
  apply safe
  apply (drule(1) exec_trace_invariant)
  apply (simp add: exec_graph_invariant_def)
  done

lemma exec_trace_step_cases:
  assumes exec: "tr \<in> exec_trace Gamma gf"
  shows "((tr i = None \<and> tr (Suc i) = None))
        \<or> (\<exists>state. tr i = Some [state] \<and> fst state \<in> {Ret, Err} \<and> tr (Suc i) = None)
        \<or> (tr i \<noteq> None \<and> tr (Suc i) \<noteq> None \<and> (the (tr i), the (tr (Suc i))) \<in> exec_graph_step Gamma)"
  using exec exec_trace_Nil[OF exec]
  apply (clarsimp simp: exec_trace_def nat_trace_rel_def continuing_def Ball_def)
  apply (drule_tac x=i in spec)+
  apply (auto split: list.split_asm option.split_asm prod.split_asm next_node.split_asm)[1]
  done

definition
  reachable_step :: "(nat \<Rightarrow> node option) \<Rightarrow> (next_node \<times> next_node) set"
where
  "reachable_step graph = {(s, t). (case s of NextNode i \<Rightarrow>
    (case graph i of None \<Rightarrow> False
        | Some (Cond l r _) \<Rightarrow> (t = l \<or> t = r)
        | Some (Basic c _) \<Rightarrow> t = c
        | Some (Call c _ _ _) \<Rightarrow> t = c \<or> t = Err) | _ \<Rightarrow> False)}"

abbreviation
  "reachable_step' gf \<equiv> reachable_step (function_graph gf)"

lemma exec_trace_None_dom_subset:
  "tr n = None \<Longrightarrow> tr \<in> exec_trace Gamma f
    \<Longrightarrow> dom tr \<subseteq> {..< n}"
  unfolding exec_trace_def
  by (blast elim: CollectE dest: trace_None_dom_subset)

lemma trace_Some_dom_superset:
  "tr \<in> nat_trace_rel c R
    \<Longrightarrow> tr i = Some v
    \<Longrightarrow> {..i} \<subseteq> dom tr"
  apply (clarsimp, rule ccontr, clarsimp)
  apply (drule(1) trace_None_dom_subset)
  apply auto
  done

lemma nat_trace_rel_final:
  "tr \<in> nat_trace_rel c R
    \<Longrightarrow> tr i = Some v
    \<Longrightarrow> \<not> c' v
    \<Longrightarrow> restrict_map tr {.. i} \<in> nat_trace_rel c' R"
  apply (frule(1) trace_Some_dom_superset)
  apply (clarsimp simp: nat_trace_rel_def restrict_map_def Suc_le_eq)
  apply (drule_tac c="Suc n" in subsetD, auto)
  done

lemma trace_None_dom_eq:
  "tr n = None \<Longrightarrow> tr \<in> nat_trace_rel cont R
    \<Longrightarrow> (\<exists>n'. n' \<le> n \<and> dom tr = {..< n'})"
  apply (cases "\<forall>i. tr i = None")
   apply (rule_tac x=0 in exI)
   apply (simp add: fun_eq_iff)
  apply clarsimp
  apply (rule_tac x="Suc (Max (dom tr))" in exI)
  apply (drule(1) nat_trace_Max_dom_None[rotated, simplified, OF exI])
  apply clarsimp
  apply (frule(1) trace_None_dom_subset)
  apply (rule conjI)
   apply auto[1]
  apply (rule equalityI)
   apply (auto simp: less_Suc_eq_le intro!: Max_ge elim: finite_subset)[1]
  apply (clarsimp, rule ccontr, clarsimp simp: less_Suc_eq_le)
  apply (drule(1) trace_None_dom_subset)+
  apply auto
  done

lemma trace_end_eq_Some:
  "tr \<in> nat_trace_rel c R
    \<Longrightarrow> tr i = Some v
    \<Longrightarrow> tr (Suc i) = None
    \<Longrightarrow> trace_end tr = Some v"
  apply (frule(1) trace_Some_dom_superset)
  apply (frule(1) trace_None_dom_eq)
  apply (clarsimp simp: le_Suc_eq lessThan_Suc_atMost[symmetric])
  apply (simp add: trace_end_def)
  apply (subst Max_eqI[where x=i], simp_all)
  apply auto
  done

lemma trace_end_cut:
  "tr \<in> nat_trace_rel c R
    \<Longrightarrow> tr i = Some v
    \<Longrightarrow> trace_end (restrict_map tr {.. i}) = Some v"
  apply (frule(1) trace_Some_dom_superset)
  apply (simp add: trace_end_def Int_absorb1)
  apply (subst Max_eqI[where x=i], simp_all)
  apply (simp add: restrict_map_def)
  apply (metis Suc_n_not_le_n)
  done

definition
  trace_drop_n :: "nat \<Rightarrow> nat \<Rightarrow> trace \<Rightarrow> trace"
where
  "trace_drop_n start n_drop tr = (\<lambda>i. if (\<forall>j < i. tr (start + j) \<noteq> None
        \<and> continuing (rev (drop n_drop (rev (the (tr (start + j)))))))
    then option_map (rev o drop n_drop o rev) (tr (i + start)) else None)"

lemma rev_drop_step:
  "(stack, stack') \<in> exec_graph_step Gamma
    \<Longrightarrow> continuing (rev (drop k (rev stack)))
    \<Longrightarrow> (rev (drop k (rev stack)), rev (drop k (rev stack'))) \<in> exec_graph_step Gamma"
  apply (subgoal_tac "\<exists>xs ys. stack = xs @ ys \<and> k = length ys")
   apply clarsimp
   apply (frule(1) exec_graph_step_stack_extend[THEN iffD1])
   apply clarsimp
  apply (rule_tac x="take (length stack - k) stack" in exI)
  apply (rule_tac x="drop (length stack - k) stack" in exI)
  apply (cases "length (rev (drop k (rev stack)))")
   apply simp
  apply simp
  done

lemma rev_drop_continuing:
  "continuing (rev (drop k (rev stack))) \<Longrightarrow> continuing stack"
  by (simp add: continuing_def split: list.split next_node.split,
      auto simp: drop_Cons split: nat.split_asm)

lemma all_less_Suc_eq:
  "(\<forall>x < Suc i. P x) = (P i \<and> (\<forall>x < i. P x))"
  by (auto simp: less_Suc_eq)

lemma exec_trace_drop_n_Cons:
  assumes tr: "tr \<in> exec_trace Gamma fn" "Gamma fn'' = Some gf"
  shows "tr i = Some ((NextNode n, st, fn'') # xs)
    \<Longrightarrow> function_graph gf n = Some (Call nn fn' inps outps)
    \<Longrightarrow> Gamma fn' = Some gf'
    \<Longrightarrow> trace_drop_n (Suc i) (Suc (length xs)) tr \<in> exec_trace Gamma fn'"
  using tr
  apply (clarsimp simp: exec_trace_def)
  apply (intro conjI)
   apply (simp add: trace_drop_n_def)
   apply (cut_tac exec_trace_step_cases[where i=i, OF tr(1)])
   apply (clarsimp simp: all_exec_graph_step_cases exec_graph_invariant_Cons
                  split: graph_function.split_asm)
  apply (clarsimp simp: nat_trace_rel_def trace_drop_n_def
                        all_less_Suc_eq
             split del: if_split)
  apply (cut_tac i="Suc i + na" in exec_trace_Nil[OF tr(1)])
  apply (drule_tac x="Suc i + na" in spec)+
  apply (clarsimp simp: field_simps)
  apply (safe, simp_all)
  apply (safe intro!: rev_drop_step)
  apply (auto dest!: rev_drop_continuing)
  done

lemma exec_trace_drop_n:
  assumes tr: "tr \<in> exec_trace Gamma fn" "Gamma fn = Some gf"
  shows "tr i = Some [(NextNode n, st, fn'')]
    \<Longrightarrow> function_graph gf n = Some (Call nn fn' inps outps)
    \<Longrightarrow> Gamma fn' = Some gf'
    \<Longrightarrow> trace_drop_n (Suc i) 1 tr \<in> exec_trace Gamma fn'"
  apply (frule exec_trace_invariant[OF tr(1)])
  apply (simp add: exec_graph_invariant_Cons)
  apply (drule(2) exec_trace_drop_n_Cons[OF tr])
  apply simp
  done

lemma exec_trace_drop_n_rest_Cons:
  "tr \<in> exec_trace Gamma fn
    \<Longrightarrow> tr i = Some ((NextNode n, st, fn'') # xs)
    \<Longrightarrow> Gamma fn'' = Some gf
    \<Longrightarrow> function_graph gf n = Some (Call nn fn' inps outps)
    \<Longrightarrow> Gamma fn' = Some gf'
    \<Longrightarrow> (\<forall>stk. trace_drop_n (Suc i) (Suc (length xs)) tr k = Some stk
     \<longrightarrow> tr (Suc i + k) = Some (stk @ (NextNode n, st, fn'') # xs))"
proof (induct k)
  case 0 show ?case using 0
    apply (clarsimp simp: trace_drop_n_def)
    apply (frule_tac i=i in exec_trace_step_cases)
    apply (clarsimp simp: exec_graph_step_def exec_graph_invariant_Cons
                   split: graph_function.split_asm)
    done
next
  case (Suc k)
  have rev_drop_eq: "\<And>xs ys n. length ys = n
    \<Longrightarrow> (xs = rev (drop n (rev xs)) @ ys)
        = (\<exists>zs. xs = zs @ ys)"
    by auto
  show ?case using Suc.prems Suc.hyps
    apply (clarsimp simp: trace_drop_n_def field_simps)
    apply (frule_tac i="Suc k + i" in exec_trace_step_cases)
    apply (clarsimp simp: field_simps all_less_Suc_eq rev_drop_eq)
    apply (clarsimp simp: exec_graph_step_stack_extend)
    done
qed

lemma exec_trace_drop_n_rest:
  "tr \<in> exec_trace Gamma fn \<Longrightarrow> Gamma fn = Some gf
    \<Longrightarrow> tr i = Some [(NextNode n, st, fn'')]
    \<Longrightarrow> function_graph gf n = Some (Call nn fn' inps outps)
    \<Longrightarrow> Gamma fn' = Some gf'
    \<Longrightarrow> (\<forall>stk. trace_drop_n (Suc i) 1 tr k = Some stk
     \<longrightarrow> tr (Suc i + k) = Some (stk @ [(NextNode n, st, fn'')]))"
  apply (frule(1) exec_trace_invariant)
  apply (clarsimp simp: exec_graph_invariant_Cons)
  apply (drule(4) exec_trace_drop_n_rest_Cons)
  apply auto
  done

lemma trace_drop_n_init:
  "tr \<in> exec_trace Gamma fn \<Longrightarrow> Gamma fn = Some f
    \<Longrightarrow> function_graph f n = Some (Call nn fname inputs outputs)
    \<Longrightarrow> Gamma fname = Some f'
    \<Longrightarrow> tr i = Some [(NextNode n, st, fn')]
    \<Longrightarrow> trace_drop_n (Suc i) 1 tr 0 = Some [(NextNode (entry_point f'),
            init_vars (function_inputs f') inputs st, fname)]"
  apply (frule(1) exec_trace_invariant)
  apply (clarsimp simp: exec_graph_invariant_Cons)
  apply (frule_tac i=i in exec_trace_step_cases, clarsimp)
  apply (clarsimp simp: all_exec_graph_step_cases trace_drop_n_def)
  done

lemma exec_trace_init:
  "tr \<in> exec_trace Gamma fn
   \<Longrightarrow> \<exists>st gf. Gamma fn = Some gf \<and> tr 0 = Some [(NextNode (entry_point gf), st, fn)]"
  by (clarsimp simp: exec_trace_def)

lemma dom_Max_None:
  "tr \<in> exec_trace Gamma f \<Longrightarrow> (tr (Max (dom tr)) \<noteq> None)"
  apply (rule notI)
  apply (frule(1) exec_trace_None_dom_subset)
  apply (cases "dom tr = {}")
   apply (clarsimp dest!: exec_trace_init)
  apply (drule Max_in[rotated])
   apply (simp add: finite_subset)
  apply clarsimp
  done

lemma trace_end_trace_drop_n_None:
  "trace_end (trace_drop_n i j tr) = None \<Longrightarrow> tr \<in> exec_trace Gamma f
    \<Longrightarrow> trace_drop_n i j tr \<in> exec_trace Gamma f'
    \<Longrightarrow> trace_end tr = None"
  apply (clarsimp simp: trace_end_def dom_Max_None split: if_split_asm)
  apply (rule ccontr, simp)
  apply (drule(1) exec_trace_None_dom_subset)
  apply (drule_tac x="n + i + 1" in spec)
  apply (clarsimp simp: trace_drop_n_def split: if_split_asm)
  apply auto[1]
  done

lemma trace_end_trace_drop_n_Some:
  "trace_end (trace_drop_n (Suc i) (Suc 0) tr) = Some [(Ret, st', dontcare)]
    \<Longrightarrow> tr \<in> exec_trace Gamma fn \<Longrightarrow> Gamma fn = Some f
    \<Longrightarrow> function_graph f n = Some (Call nn fname inputs outputs)
    \<Longrightarrow> Gamma fname = Some f'
    \<Longrightarrow> tr i = Some [(NextNode n, st, fn')]
    \<Longrightarrow> \<exists>j. tr (Suc i + j) = Some [(nn, return_vars (function_outputs f') outputs st' st, fn)]
"
  apply (frule(4) exec_trace_drop_n)
  apply (drule trace_end_SomeD, fastforce simp add: exec_trace_def)
  apply clarsimp
  apply (frule(4) exec_trace_drop_n_rest, simp, drule spec, drule(1) mp)
  apply simp
  apply (frule(1) exec_trace_invariant[where stack="[a, b]" for a b])
  apply (clarsimp simp: exec_graph_invariant_Cons get_state_function_call_def)
  apply (frule_tac i="Suc i + na" in exec_trace_step_cases, clarsimp)
  apply (clarsimp simp: all_exec_graph_step_cases)
  apply (metis add_Suc_right)
  done

end


(******************************************************************************
 * Orca: A Functional Correctness Verifier for Imperative Programs
 *       Based on Isabelle/UTP
 *
 * Copyright (c) 2016-2018 Virginia Tech, USA
 *               2016-2018 Technische Universität München, Germany
 *               2016-2018 University of York, UK
 *               2016-2018 Université Paris-Saclay, Univ. Paris-Sud, France
 *
 * This software may be distributed and modified according to the terms of
 * the GNU Lesser General Public License version 3.0 or any later version.
 * Note that NO WARRANTY is provided.
 *
 * See CONTRIBUTORS, LICENSE and CITATION files for details.
 ******************************************************************************)

theory utp_sp
imports "../../Isabelle-UTP/utp/utp_wp"

begin

named_theorems slp

method slp_tac = (simp add: slp)

consts
  usp :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infix "slp" 60)

text \<open>Since the definition of strongest post condition  below do not require termination. We name
      it strongest liberal post-condition. Thus we follow Dijkstra terminology.\<close>

definition slp_upred :: "'\<alpha> cond \<Rightarrow> ('\<alpha>, '\<beta>) rel \<Rightarrow> '\<beta> cond" where
"slp_upred p Q = \<lfloor>(\<lceil>p\<rceil>\<^sub>> ;; Q) :: ('\<alpha>, '\<beta>) rel\<rfloor>\<^sub>>"

adhoc_overloading
  usp slp_upred

declare slp_upred_def [upred_defs]

lemma slp_false [slp]: "p slp false = false"
  by (rel_simp)

lemma slp_true [slp]: "q \<noteq> false \<Longrightarrow> q slp true = true"
  by (rel_auto)

lemma slp_is_post_condition:
  "\<lbrace>p\<rbrace>prog\<lbrace>p slp prog\<rbrace>\<^sub>u"
  by rel_blast

lemma slp_is_the_strongest_post:
  "`p slp prog \<Rightarrow> Q`\<Longrightarrow>\<lbrace>p\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u"
  by rel_blast

lemma slp_is_the_strongest_post':
  "(Q \<sqsubseteq> p slp prog) \<Longrightarrow>\<lbrace>p\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u"
  by rel_auto

lemma hoare_r_slp_eq:
  " \<lbrace>p\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u = `p slp prog \<Rightarrow> Q` "
  by rel_blast

theorem hoare_r_slp_eq':
  "\<lbrace>p\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u \<longleftrightarrow> (Q \<sqsubseteq> p slp prog)"
  by rel_auto

theorem slp_eq_intro:
  "\<lbrakk>\<And>r. r slp P = r slp Q\<rbrakk> \<Longrightarrow> P = Q"
  by (rel_auto robust, fastforce+)

lemma wlp_slp_sym:
  "`prog wp (true slp prog)`"
  by rel_auto

lemma wlp_is_pre_condition:
  "\<lbrace>prog wp Q\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u"
  by rel_blast

lemma wlp_is_the_weakest_pre:
  "`P \<Rightarrow> prog wp Q` \<Longrightarrow> \<lbrace>P\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u"
  by rel_blast

lemma wlp_is_the_weakest_pre':
  "(prog wp Q) \<sqsubseteq> P \<Longrightarrow> \<lbrace>P\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u"
  by rel_blast

lemma hoare_r_wlp_eq:
  "\<lbrace>P\<rbrace>prog\<lbrace>Q\<rbrace>\<^sub>u = `P \<Rightarrow> prog wp Q`"
  by rel_blast

lemma skip_r_slp:
  "P slp SKIP\<^sub>r = P"
  by rel_simp

lemma skip_r_wlp:
  "SKIP\<^sub>r wp Q = Q"
  by rel_simp

lemma assigns_r_slp[slp]:
  "vwb_lens x \<Longrightarrow> (p slp x :== e ) = (\<^bold>\<exists>v \<bullet> p\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk> \<and> &x =\<^sub>u e\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk>)"
  apply (rel_simp)
    apply transfer
  apply auto
   apply (rule_tac x = \<open>get\<^bsub>x\<^esub> y\<close> in exI)
    apply simp
  apply (metis vwb_lens.put_eq)
  done

lemma assigns_r_wlp[wp]:
  "(\<langle>\<sigma>\<rangle>\<^sub>a wp Q) = (\<sigma> \<dagger> Q)"
  by rel_simp

lemma seq_r_slp[slp]:
  " P slp (S\<^sub>1 ;; S\<^sub>2) = (P slp S\<^sub>1) slp S\<^sub>2"
  by rel_auto

lemma seq_r_wlp[wp]:
  "(S\<^sub>1 ;; S\<^sub>2) wp Q = S\<^sub>1 wp (S\<^sub>2 wp Q)"
  by rel_auto

lemma If_r_slp[slp]:
  "P slp (bif b then S\<^sub>1 else S\<^sub>2 eif) = (((P \<and> b) slp S\<^sub>1) \<or> ((P \<and> \<not>b) slp S\<^sub>2))"
  by rel_auto

lemma If_r_wlp[wp]:
  "(bif b then S\<^sub>1 else S\<^sub>2 eif) wp Q = ((S\<^sub>1 wp Q \<and> b)\<or> (S\<^sub>2 wp Q \<and> \<not>b))"
  by rel_auto

lemma while_gfp_rel_slp [slp]:
  "P slp (while\<^sup>\<top> b do body od) = ((((P \<and> b) slp body) slp (while\<^sup>\<top> b do body od)) \<or> (P \<and> \<not>b))"
  apply (subst while_gfp_rel_unfold)
  apply rel_auto
  done

lemma while_gfp_rel_wlp[wp]:
  "(while\<^sup>\<top> b do body od) wp Q = ((body wp ((while\<^sup>\<top> b do body od)  wp Q) \<and> b) \<or> (Q \<and> \<not>b))"
  apply (subst while_gfp_rel_unfold)
  apply rel_auto
  done

lemma gfp_rel_slp [slp]:
  "mono F \<Longrightarrow> P slp \<nu> F =  P slp F(\<nu> F)"
  apply (subst lfp_unfold)
   apply simp_all
  done

lemma gfp_rel_wlp [wp]:
  "mono F \<Longrightarrow> \<nu> F wp Q  =  F(\<nu> F) wp Q"
  apply (subst lfp_unfold)
   apply simp_all
  done
end


theory InstanceTrees
imports NonFreeAnimation
begin

datatype 'a tree2 = Tree2 "'a" "('a treelist)"
  and 'a treelist = Emp2 | Cons2 "('a tree2)" "('a treelist)"

thm tree2_treelist.induct tree2_treelist.inducts

(* these don't work, mutually rec datatypes must have exact same type parameters *)
(* datatype 'a bla = Emp3 | One "'a blub"
   and  'b blub = Blub *)
(* datatype 'a bla = Emp3 | One3 'a | Blub1 "blub"
  and blub = Blub *)

(*
Finitely branching unordered trees

datatype  'a tree = Tree 'a ('a tfset)
and      'a tfset = Emp | Ins ('a tree) ('a tfset)
where
  Ins a (Ins a s) = Ins a s

  Ins a1 (Ins a2 s) = Ins a2 (Ins a1 s)
*)

locale results =
  fixes alpha :: tyvar
    and tree_name :: tyco
    and tfset_name :: tyco
    and Empty_name :: oper
    and Ins_name :: oper
    and Tree_name :: oper
    and dummy :: 'a
begin

lemma [ffact]: "decl_tyvars () [alpha]" ..
lemma [ffact]: "alpha tyinterpr TYPE('a)" ..

lemma [ffact]: "tree_name tycohaskind (ExtType =K=> IntType)" ..
lemma [ffact]: "tfset_name tycohaskind (ExtType =K=> IntType)" ..

lemma [ffact]: "Empty_name operhasty (tfset_name ** alpha)" ..
lemma [ffact]: "Ins_name operhasty (tree_name ** alpha =T=> tfset_name ** alpha =T=> tfset_name ** alpha)" ..
lemma [ffact]: "Tree_name operhasty (alpha =T=> tfset_name ** alpha =T=> tree_name ** alpha)" ..

definition "ins_clause1_name = (0::nat)"
definition "ins_clause2_name = (0::nat)"

lemma [ffact]: "decl_hcl ins_clause1_name (QUANT t: tree_name ** alpha. QUANT S: tfset_name ** alpha.
  Ins_name $ t $ (Ins_name $ t $ S) === Ins_name $ t $ S)" ..
lemma [ffact]: "decl_hcl ins_clause2_name (QUANT t: tree_name ** alpha. QUANT t2: tree_name ** alpha. QUANT S: tfset_name ** alpha.
  Ins_name $ t $ (Ins_name $ t2 $ S) === Ins_name $ t2 $ (Ins_name $ t $ S))" ..

(*
local_setup {*  MetaRec.add_non_pervasive_declaration (fn _ => MetaRec.set_trace_depth (10, 10))  *}
declare [[show_hyps]]
*)

local_setup {* MetaRec.run_expl_frules *}

end

thm results.ins_clause2

term "TYPE('b results.tree)"

(*type_synonym 'a tree = "'a results.sorts_enum_Constr0_reified"
type_synonym 'a tfset = "'a results.sorts_enum_Constr1_reified" *)

locale map_fun =
  results alpha tree_name tfset_name Empty_name Ins_name Tree_name dummy
     for alpha :: tyvar and tree_name :: tyco and tfset_name :: tyco and Empty_name :: oper
     and Ins_name :: oper and Tree_name :: oper  and dummy :: 'a +
  fixes f :: "'a => 'b"
begin

lemma tree_ty_interpr[ffact]: "(tree_name ** alpha) alginterpr TYPE('b tree)" ..
lemma tfset_ty_interpr[ffact]: "(tfset_name ** alpha) alginterpr TYPE('b tfset)" ..

lemma empty_interpr[ffact]: "Empty_name operalginterpr (results.Empty :: 'b tfset)" ..
lemma ins_interpr[ffact]: "Ins_name operalginterpr (results.Ins :: 'b tree => 'b tfset => 'b tfset)" ..
lemma tree_interpr[ffact]: "Tree_name operalginterpr (% (x::'a) (ts :: 'b tfset). results.Tree (f x) ts)" ..

lemma [ffact]: "proven_hcl (ALL t :: 'b tree. ALL S :: 'b tfset.
  results.Ins t (results.Ins t S) = results.Ins t S)" sorry
lemma [ffact]: "proven_hcl (ALL t :: 'b tree. ALL t2 :: 'b tree. ALL S :: 'b tfset.
  results.Ins t (results.Ins t2 S) = results.Ins t2 (results.Ins t S))" sorry

ML {*
  MetaRec.print_depgraph (Context.Proof @{context})
*}

local_setup {*
  (* MetaRec.set_running_expl_frules true
  #> MetaRec.add_facts_decl [@{thm tree_ty_interpr}, @{thm tfset_ty_interpr},
    @{thm empty_interpr}, @{thm ins_interpr}, @{thm tree_interpr}]
  #> *)
  MetaRec.run_expl_frules
*}

end

thm map_fun.iter_op_clauses0

end


theory task2
  imports task1
begin

definition inv_s' :: "state \<Rightarrow> bool" where
 "inv_s' s = (s T \<le> 0.045 \<and> s C \<le> 0.02)"

definition T2 :: "estate proc" where
"T2 = IF (\<lambda>(a,s) . status a = WAIT)
        THEN (Cont (ODE ((\<lambda> _ _ . 0)(T := (\<lambda> _ .1)))) (\<lambda> s. s T < 0.045);T ::= (\<lambda>_. 0); Basic (ent_assign ezero);Basic (ready_assign))
      ELSE
      (IF(\<lambda>(a,s) . status a = READY)
        THEN (Cm ((req_ch 2)[!](\<lambda>(a,s). task_prior a));
             (Interrupt (ODE ((\<lambda> _ _ . 0)(T := (\<lambda> _ .1)))) (\<lambda> s. s T < 0.045) [(run_ch 2[?]F,Basic run_assign)]);
             (IF (\<lambda>(a,s) . status a = READY \<and> s T = 0.045) THEN (EChoice [(exit_ch 2[!](\<lambda>_.0),Basic wait_assign),(run_ch 2[?]F,Basic run_assign)]) ELSE Skip FI))
      ELSE
      (IF(\<lambda>(a,s) . entered a = ezero) THEN
             (C ::= (\<lambda>_ . 0); Basic (ent_assign eone)) ELSE Skip FI;
        (Interrupt (ODE ((\<lambda> _ _ . 0)(T := (\<lambda> _ .1),C := (\<lambda>_ .1)))) (\<lambda> s. s T < 0.045 \<and> s C < 0.02) [(preempt_ch 2[?]F,Basic ready_assign)]);
        IF (\<lambda>(a,s) . status a = RUNNING) THEN EChoice [(free_ch 2[!](\<lambda>_.0),Basic wait_assign),(preempt_ch 2[?]F,Basic wait_assign)] ELSE Skip FI)
      FI) FI"

fun T2_tr:: "nat \<Rightarrow> estate ext_state \<Rightarrow> estate tassn" where
  "T2_tr 0 (Task st ent tp,ss)  = emp\<^sub>t"
| "T2_tr (Suc k) (Task WAIT ent tp,ss) =
   (Wait\<^sub>t (9 / 200 - ss T) (\<lambda>t. EState (Task WAIT ent tp, ss(T:= ss T + t))) ({}, {}) @\<^sub>t T2_tr k (Task READY ezero tp,ss(T:=0)))"
| "T2_tr (Suc k) (Task READY ent tp,ss) = (
             (\<exists>\<^sub>t v tt. \<up>(tt\<ge>0 \<and> tt \<le> 0.045 - ss T) \<and>\<^sub>t Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp @\<^sub>t
                   Waitin\<^sub>t tt (\<lambda>t. EState (Task READY ent tp, ss(T := ss T + t)))
                    (run_ch 2) v ({}, {run_ch 2}) @\<^sub>t
                   T2_tr k (Task RUNNING ent tp,ss(T := ss T + tt, F:=v)))
           \<or>\<^sub>t (Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    (outrdy_assn (Task READY ent tp, ss(T:=0.045)) (exit_ch 2) 0 ({exit_ch 2},{run_ch 2}) @\<^sub>t T2_tr k (Task WAIT ent tp,ss(T:=0.045))
                  \<or>\<^sub>t (\<exists>\<^sub>t v. inrdy_assn (Task READY ent tp, ss(T:=0.045)) (run_ch 2) v ({exit_ch 2},{run_ch 2}) @\<^sub>t T2_tr k (Task RUNNING ent tp,ss(T:=0.045,F:=v))))))"
| "T2_tr (Suc k) (Task RUNNING ent tp,ss) = (
             (\<exists>\<^sub>t v tt. \<up>(tt\<ge>0 \<and> tt \<le> (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) \<and>\<^sub>t Waitin\<^sub>t tt
                           (\<lambda>t. EState
                                 (Task RUNNING eone tp, ss
                                  (T := ss T + t,
                                   C := C_upd ent (ss C) + t)))
                           (preempt_ch 2) v ({}, {preempt_ch 2}) @\<^sub>t
                         T2_tr k (Task READY eone tp,ss
                         (T := ss T + tt,
                          C := C_upd ent (ss C) + tt, F := v)))
            \<or>\<^sub>t (Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             ((Outrdy\<^sub>t ((Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C))))) (free_ch 2) 0 ({free_ch 2},{preempt_ch 2})@\<^sub>t
                T2_tr k (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))))
     \<or>\<^sub>t (\<exists>\<^sub>t v.(Inrdy\<^sub>t ((Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C))))) (preempt_ch 2) v ({free_ch 2},{preempt_ch 2})@\<^sub>t
                T2_tr k (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)),F:=v)))))
)
)"

lemma T2_Valid_WAIT:
"\<Turnstile> {\<lambda>s t. s = (Task WAIT ent tp,ss) \<and> inv_s' (snd s) \<and> P s t}
   T2
    {\<lambda> s t. s = (Task READY ezero tp,ss(T:=0)) \<and> inv_s' (snd s) \<and> (P (Task WAIT ent tp,ss) @\<^sub>t Wait\<^sub>t (9 / 200 - ss T) (\<lambda>t. EState (Task WAIT ent tp, ss(T:= ss T + t))) ({}, {})) t}"
  unfolding T2_def
  apply(rule Valid_strengthen_post)
   prefer 2
   apply(rule Valid_cond_sp)
    apply(rule Valid_seq)
     apply(rule Valid_pre_cases'[where P="\<lambda>(a,s) . s T< 0.045"])
      apply(rule Valid_weaken_pre)
       prefer 2
       apply(rule Valid_strengthen_post[where Q'="\<lambda> s t. s = (Task WAIT ent tp,ss(T:=0.045)) \<and> inv_s' (snd s) \<and> (P (Task WAIT ent tp,ss) @\<^sub>t
         Wait\<^sub>t (45 / 10 ^ 3 - ss T) (\<lambda>t. EState (Task WAIT ent tp, ss(T := ss T + t))) ({}, {})) t"])
        prefer 2
        apply(rule Valid_ode_sol_sp[where ss= ss and aa = "Task WAIT ent tp" and d="0.045- ss T" and p="\<lambda> t. ss(T:= ss T+t)" and P = "\<lambda>(a,s) t. inv_s' (snd (a, s)) \<and> P (a, s) t"])
     subgoal by auto
     subgoal
       apply auto unfolding state2vec_def has_vderiv_on_def
       apply clarify
       apply (rule has_vector_derivative_projI)
       apply auto
       apply (rule has_vector_derivative_eq_rhs)
        apply (fast intro!: derivative_intros)
       by auto
     subgoal by auto
     subgoal by auto
     subgoal
       apply auto unfolding state2vec_def vec2state_def
       apply (rule c1_implies_local_lipschitz[where f'="(\<lambda>(t,v). Blinfun(\<lambda>(v::vec) . \<chi> x. 0))"])
       apply auto
       unfolding has_derivative_def
       apply auto
        prefer 2
        apply (rule vec_tendstoI)
       subgoal
       proof-
         have b1:"bounded_linear (\<lambda> (v::vec). \<chi> a . 0)"
           apply (rule bounded_linearI')
           using vec_lambda_unique by fastforce+
         then have b2:"blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)) = (\<lambda>v. \<chi> x. 0)"
           apply(rule bounded_linear_Blinfun_apply)
           done
         then have b3:"bounded_linear (blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)))"
           using b1
           by (simp add: blinfun.bounded_linear_right)
         show ?thesis
           by(auto simp add:b2)
       qed
       by (simp add: blinfun.bounded_linear_right)
     subgoal
       unfolding entails_def inv_s'_def by (auto simp add:C_def T_def pure_assn_def conj_assn_def)
     subgoal unfolding entails_def by auto
        apply(rule Valid_weaken_pre)
         prefer 2
         apply(rule Valid_strengthen_post)
          prefer 2
          apply(rule Valid_ode_not_sp[where ss= ss and aa = "Task WAIT ent tp" and d="0.045- ss T" and p="\<lambda> t. ss(T:= ss T+t)" and P = "\<lambda>(a,s) t. inv_s' (snd (a, s)) \<and> P (a, s) t"])
     subgoal by auto
     subgoal by auto
     subgoal unfolding entails_def inv_s'_def by (auto simp add:C_def T_def pure_assn_def conj_assn_def)
     subgoal unfolding entails_def inv_s'_def by (auto simp add:C_def T_def)
     apply(rule Valid_seq)
  apply(rule Valid_assign_sp1)
    apply(rule Valid_seq)
     apply(rule Valid_basic_sp1)
    apply simp
    apply(rule Valid_basic_sp1)
  unfolding entails_def
   apply simp
   apply(rule Valid_weaken_pre[where P'="\<lambda> s t. False"])
  unfolding entails_def
    apply auto[1]
   apply(rule Valid_False)
  apply(auto simp add: pure_assn_def conj_assn_def inv_s'_def C_def T_def)
  subgoal for ss' tr x
    apply (rule ext) subgoal for v
      apply (cases "v = CHR ''t''")
      subgoal by auto
      subgoal premises pre proof -
        have "(ss'(CHR ''t'' := x)) v = (ss(CHR ''t'' := 9 / 200)) v"
          using pre(2) by auto
        then have "ss' v = ss v"
          using pre(6) by auto
        then show ?thesis
          using pre(6) by auto
      qed
      done
    done
  done

lemma T2_Valid_READY:
"\<Turnstile> {\<lambda>s t. s = (Task READY ent tp,ss) \<and> inv_s' (snd s) \<and> P s t}
   T2
    {\<lambda> s tr. (inv_s' (snd s) \<and> (\<exists> tt v. tt\<ge>0 \<and> tt \<le> 0.045 - ss T \<and> s = (Task RUNNING ent tp,ss(T:= ss T + tt,F := v)) \<and>
                    ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Waitin\<^sub>t tt (\<lambda>t. EState (Task READY ent tp, ss(T := ss T + t)))
                    (run_ch 2) v ({}, {run_ch 2})) tr))
              \<or> (inv_s' (snd s) \<and> s = (Task WAIT ent tp,ss(T:=0.045)) \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    Outrdy\<^sub>t (Task READY ent tp, ss(T:=0.045)) (exit_ch 2) 0 ({exit_ch 2},{run_ch 2}))
                   tr)
              \<or> (\<exists> v. (inv_s' (snd s) \<and> s = (Task RUNNING ent tp,ss(T:=0.045,F:=v)) \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    Inrdy\<^sub>t (Task READY ent tp, ss(T:=0.045)) (run_ch 2) v ({exit_ch 2},{run_ch 2}))
                   tr))}"
unfolding T2_def
  apply(rule Valid_strengthen_post)
   prefer 2
   apply(rule Valid_cond_sp)
  apply(rule Valid_weaken_pre[where P'="\<lambda> s t. False"])
unfolding entails_def
    apply auto[1]
  apply(rule Valid_False)
  apply(rule Valid_cond_sp)
  prefer 2
apply(rule Valid_weaken_pre[where P'="\<lambda> s t. False"])
unfolding entails_def
    apply auto[1]
  apply(rule Valid_False)
  apply(rule Valid_seq)
  apply(rule Valid_send_sp)
  apply(rule Valid_seq[where
    Q="\<lambda> (a,s) tr. (\<exists> tt v. tt\<ge>0 \<and> tt \<le> 0.045 - ss T \<and> (a,s) = (Task RUNNING ent tp,ss(T:= ss T + tt,F := v)) \<and> inv_s' s \<and> (
                   (P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Waitin\<^sub>t tt (\<lambda>t. EState (Task READY ent tp, ss(T := ss T + t)))
                    (run_ch 2) v ({}, {run_ch 2})) tr)
              \<or>  ((a,s) = (Task READY ent tp,ss(T:=0.045)) \<and> inv_s' s \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}))
                   tr)"])
  apply(rule Valid_pre_cases'[where P="(\<lambda>(a,s). s T < 45 / 10 ^ 3)"])
   apply(rule Valid_weaken_pre)
  prefer 2
  apply(rule Valid_strengthen_post)
     prefer 2
     apply(rule Valid_interrupt_in_sol[where ss= ss and d="0.045- ss T" and p="\<lambda> t. ss(T:= ss T + t)" and aa= "Task READY ent tp" and P="\<lambda>(a,s) t. inv_s' s \<and> (P (a, s) @\<^sub>t Out\<^sub>t (EState (a, s)) (req_ch 2) tp) t"])
  subgoal by auto
  subgoal
    apply auto unfolding state2vec_def has_vderiv_on_def
    apply clarify
    apply (rule has_vector_derivative_projI)
    apply auto
    apply (rule has_vector_derivative_eq_rhs)
     apply (fast intro!: derivative_intros)
    by auto
  subgoal by auto
  subgoal by auto
  subgoal
    apply auto unfolding state2vec_def vec2state_def
    apply (rule c1_implies_local_lipschitz[where f'="(\<lambda>(t,v). Blinfun(\<lambda>(v::vec) . \<chi> x. 0))"])
       apply auto
    unfolding has_derivative_def
    apply auto
    prefer 2
     apply (rule vec_tendstoI)
    subgoal
    proof-
    have b1:"bounded_linear (\<lambda> (v::vec). \<chi> a . 0)"
      apply (rule bounded_linearI')
      using vec_lambda_unique by fastforce+
    then have b2:"blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)) = (\<lambda>v. \<chi> x. 0)"
      apply(rule bounded_linear_Blinfun_apply)
      done
    then have b3:"bounded_linear (blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)))"
      using b1
      by (simp add: blinfun.bounded_linear_right)
    show ?thesis
      by(auto simp add:b2)
  qed
  by (simp add: blinfun.bounded_linear_right)
     apply auto[1]
     apply(rule Valid_basic_sp1)
    prefer 2
  subgoal unfolding entails_def join_assn_def by auto
     prefer 2
  apply(rule Valid_weaken_pre)
  prefer 2
  apply(rule Valid_strengthen_post)
       prefer 2
       apply(rule Valid_interrupt_in_not[where p = "\<lambda> t. ss(T:= ss T + t)" and ss= ss and aa= "Task READY ent tp" and P="\<lambda>(a,s) t. inv_s' s \<and> (P (a, s) @\<^sub>t Out\<^sub>t (EState (a, s)) (req_ch 2) tp) t"])
  subgoal by auto
  apply auto[1]
       apply(rule Valid_basic_sp1)
      prefer 2
  subgoal unfolding entails_def join_assn_def by auto
  subgoal unfolding entails_def inv_s'_def pure_assn_def join_assn_def conj_assn_def
    apply (auto simp add: T_def C_def F_def)
    subgoal for v tr1 tr3 tr2
      apply(rule exI[where x = 0])
      apply auto
      apply(rule exI[where x = v])
      apply auto
      apply(rule exI[where x = "tr1@tr2"])
      by auto
    done
  subgoal
    apply(rule entails_disjE)
     apply (auto simp del: fun_upd_apply)
    subgoal
    apply(rule entails_trans[where Q ="(\<lambda>a. case a of
         (a, s) \<Rightarrow>
           \<lambda>tr. (\<exists>tt\<ge>0.
                    tt \<le> 9 / 200 - ss T \<and>
                    a = Task RUNNING ent tp \<and>
                    (\<exists>v. s = ss(T := ss T + tt, F := v) \<and>
                         inv_s' s \<and>
                         ((P (Task READY ent tp, ss) @\<^sub>t
                           Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                          Waitin\<^sub>t tt (\<lambda>t. EState (Task READY ent tp, ss(T := ss T + t)))
                           (run_ch 2) v ({}, {run_ch 2}))
                          tr)))"])
      subgoal
        unfolding entails_def C_def T_def F_def inv_s'_def pure_assn_def conj_assn_def join_assn_def
        apply (auto simp del: fun_upd_apply)
        subgoal for tt vv tr1 tr2 tr3
          apply(rule exI[where x="tt"])
          apply auto
          apply(rule exI[where x="vv"])
          apply auto
          apply(rule exI[where x="tr1@tr3"])
          by auto
        done
      unfolding entails_def by auto
    subgoal
      apply(rule entails_trans[where Q="\<lambda>a. case a of
         (a, s) \<Rightarrow>
           \<lambda>tr. a = Task READY ent tp \<and>
                s = ss(T := 9 / 200) \<and>
                inv_s' s \<and>
                ((P (Task READY ent tp, ss) @\<^sub>t
                  Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                 Wait\<^sub>t (9 / 200 - ss T)
                  (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>))) ({}, {run_ch 2}))
                 tr"])
      unfolding entails_def C_def T_def F_def inv_s'_def pure_assn_def conj_assn_def join_assn_def
      by auto
    done
   apply(rule Valid_cond_sp)
  apply simp
  apply(rule Valid_echoice[where R ="\<lambda> s tr.(inv_s' (snd s) \<and> s = (Task WAIT ent tp,ss(T:=0.045)) \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    Outrdy\<^sub>t (Task READY ent tp, ss(T:=0.045)) (exit_ch 2) 0 ({exit_ch 2},{run_ch 2}))
                   tr)
              \<or> (\<exists> v. (inv_s' (snd s) \<and> s = (Task RUNNING ent tp,ss(T:=0.045,F:=v)) \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    Inrdy\<^sub>t (Task READY ent tp, ss(T:=0.045)) (run_ch 2) v ({exit_ch 2},{run_ch 2}))
                   tr))"])
  subgoal for i
    apply(cases i)
    subgoal
      apply auto
      apply(rule exI[where x="\<lambda>s tr.
               inv_s' (snd s) \<and>
               s = (Task READY ent tp, ss(T := 9 / 200)) \<and>
               ((P (Task READY ent tp, ss) @\<^sub>t
                 Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                Wait\<^sub>t (9 / 200 - ss T)
                 (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>))) ({}, {run_ch 2}) @\<^sub>t
                Outrdy\<^sub>t (Task READY ent tp, ss(T := 9 / 200)) (exit_ch 2) 0
                 ({exit_ch 2}, {run_ch 2}))
                tr"])
      apply auto
      subgoal
        apply(rule Valid_strengthen_post)
         prefer 2
         apply(rule Valid_basic_sp1)
        unfolding entails_def
        by auto
      subgoal unfolding entails_def
        apply (auto simp add:join_assn_def join_assoc)
        subgoal for tr1a tr2 tr2a
          apply(rule exI[where x="tr1a@tr2a"])
          apply auto
          apply(rule exI[where x="tr2"])
          apply auto
          apply(rule )
          done
        done
      subgoal unfolding entails_def
        apply (auto simp add:join_assn_def join_assoc)
        subgoal for d tr1a tr2 tr2a
          apply(rule exI[where x="tr1a@tr2a"])
          apply auto
          apply(rule exI[where x="tr2"])
          apply auto
          apply rule
          by auto
        done
      done
    subgoal for i'
      apply auto
      apply(rule exI[where x="\<lambda> s tr. (\<exists> v. (inv_s' (snd s) \<and> s = (Task READY ent tp,ss(T:=0.045,F:=v)) \<and>
                   ((P (Task READY ent tp, ss) @\<^sub>t
                    Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                   Wait\<^sub>t (9 / 200 - ss T) (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>)))
                    ({}, {run_ch 2}) @\<^sub>t
                    Inrdy\<^sub>t (Task READY ent tp, ss(T:=0.045)) (run_ch 2) v ({exit_ch 2},{run_ch 2}))
                   tr))"])
      apply auto
      subgoal
        apply(rule Valid_strengthen_post)
         prefer 2
         apply(rule Valid_basic_sp1)
        unfolding entails_def
        by auto
      subgoal unfolding entails_def
        apply (auto simp add:inv_s'_def F_def T_def C_def join_assn_def join_assoc)
        subgoal for tr1a tr2 tr2a v
          apply(rule exI[where x=v])
          apply auto
          apply(rule exI[where x="tr1a@tr2a"])
          apply auto
          apply(rule exI[where x=tr2])
          apply auto
          apply rule
          done
        done
      subgoal unfolding entails_def
        apply (auto simp add:inv_s'_def F_def T_def C_def join_assn_def join_assoc)
        subgoal for d tr1a tr2 tr2a v
          apply(rule exI[where x=v])
          apply auto
          apply(rule exI[where x="tr1a@tr2a"])
          apply auto
          apply(rule exI[where x=tr2])
          apply auto
          apply rule
          by auto
        done
      done
    done
   apply(rule Valid_skip)
  by auto

lemma T2_Valid_RUNNING:
"\<Turnstile> {\<lambda>s t. s = (Task RUNNING ent tp,ss) \<and> inv_s' (snd s) \<and> P s t}
   T2
    {\<lambda> s tr. ((inv_s' (snd s) \<and> (\<exists> tt v. tt\<ge>0 \<and> tt \<le> (min (0.045 - ss T) (0.02 - C_upd ent (ss C))) \<and>
                          s = (Task READY eone tp,ss
                         (CHR ''t'' := ss CHR ''t'' + tt,
                          CHR ''c'' := C_upd ent (ss CHR ''c'') + tt, F := v)) \<and> (
                    P (Task RUNNING ent tp, ss) @\<^sub>t
                          Waitin\<^sub>t tt
                           (\<lambda>t. EState
                                 (Task RUNNING eone tp, ss
                                  (CHR ''t'' := ss CHR ''t'' + t,
                                   CHR ''c'' := C_upd ent (ss CHR ''c'') + t)))
                           (preempt_ch 2) v ({}, {preempt_ch 2}))
                          tr))
              \<or>  (inv_s' (snd s) \<and> s =
          (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Outrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (free_ch 2) 0 ({free_ch 2},{preempt_ch 2}))
         tr)
             \<or> (\<exists> v. (inv_s' (snd s) \<and> s =
          (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)), F := v)) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Inrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (preempt_ch 2) v ({free_ch 2},{preempt_ch 2}))
         tr)))}"
  unfolding T2_def
apply(rule Valid_strengthen_post)
   prefer 2
   apply(rule Valid_cond_sp)
  apply(rule Valid_weaken_pre[where P'="\<lambda> s t. False"])
unfolding entails_def
    apply auto[1]
  apply(rule Valid_False)
apply(rule Valid_cond_sp)
  apply(rule Valid_weaken_pre[where P'="\<lambda> s t. False"])
unfolding entails_def
    apply auto[1]
  apply(rule Valid_False)
  apply(rule Valid_seq[where Q="\<lambda> s t. s = (Task RUNNING eone tp, ss(C := C_upd ent (ss C))) \<and> inv_s' (snd s) \<and> P (Task RUNNING ent tp, ss) t"])
  apply(rule Valid_strengthen_post)
  prefer 2
   apply(rule Valid_cond_sp)
   apply(rule Valid_seq)
    apply(rule Valid_assign_sp1)
    apply(rule Valid_basic_sp1)
   apply(rule Valid_skip)
  subgoal unfolding entails_def inv_s'_def C_upd_def
    apply auto
    using entered.exhaust by blast
   apply(rule Valid_seq[where
    Q="\<lambda> (a,s) tr. (\<exists> tt v. tt\<ge>0 \<and> tt \<le> (min (0.045 - ss T) (0.02 - C_upd ent (ss C))) \<and>
                          (a,s) = (Task READY eone tp,ss
                         (CHR ''t'' := ss CHR ''t'' + tt,
                          CHR ''c'' := C_upd ent (ss CHR ''c'') + tt, F := v)) \<and> inv_s' s \<and> (
                    P (Task RUNNING ent tp, ss) @\<^sub>t
                          Waitin\<^sub>t tt
                           (\<lambda>t. EState
                                 (Task RUNNING eone tp, ss
                                  (CHR ''t'' := ss CHR ''t'' + t,
                                   CHR ''c'' := C_upd ent (ss CHR ''c'') + t)))
                           (preempt_ch 2) v ({}, {preempt_ch 2}))
                          tr)
              \<or>  ((a, s) =
          (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) \<and> inv_s' s \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}))
         tr)"])
 apply(rule Valid_pre_cases'[where P="(\<lambda>(a,s). s T < 45 / 10 ^ 3 \<and> s C < 2 / 10\<^sup>2)"])
   apply(rule Valid_weaken_pre)
  prefer 2
  apply(rule Valid_strengthen_post)
     prefer 2
     apply(rule Valid_interrupt_in_sol[where ss= "ss(C := C_upd ent (ss C))" and d="min (0.045 - ss T) (0.02 - C_upd ent (ss C))" and p="\<lambda> t. ss(T:= ss T + t, C:= C_upd ent (ss C) + t)" and aa= "Task RUNNING eone tp" and P="\<lambda>(a,s) t. inv_s' s \<and> P (Task RUNNING ent tp, ss)  t"])
  subgoal apply auto unfolding T_def C_def by auto
  subgoal
    apply auto unfolding state2vec_def has_vderiv_on_def
    apply clarify
    apply (rule has_vector_derivative_projI)
    apply auto
    unfolding T_def C_def
    apply auto
    apply (rule has_vector_derivative_eq_rhs)
      apply (fast intro!: derivative_intros)
     apply auto
      apply (rule has_vector_derivative_eq_rhs)
      apply (fast intro!: derivative_intros)
    by auto
  subgoal by auto
  subgoal unfolding T_def C_def
     apply auto
    apply(cases "(9 / 200 - ss CHR ''t'') \<le> (2 / 100 - C_upd ent (ss CHR ''c''))")
    by auto
  subgoal
    apply auto unfolding state2vec_def vec2state_def
    apply (rule c1_implies_local_lipschitz[where f'="(\<lambda>(t,v). Blinfun(\<lambda>(v::vec) . \<chi> x. 0))"])
       apply auto
    unfolding has_derivative_def
    apply auto
    prefer 2
     apply (rule vec_tendstoI)
    subgoal
    proof-
    have b1:"bounded_linear (\<lambda> (v::vec). \<chi> a . 0)"
      apply (rule bounded_linearI')
      using vec_lambda_unique by fastforce+
    then have b2:"blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)) = (\<lambda>v. \<chi> x. 0)"
      apply(rule bounded_linear_Blinfun_apply)
      done
    then have b3:"bounded_linear (blinfun_apply (Blinfun (\<lambda> (v::vec). \<chi> x. 0)))"
      using b1
      by (simp add: blinfun.bounded_linear_right)
    show ?thesis
      by(auto simp add:b2)
    qed
    by (simp add: blinfun.bounded_linear_right)
  apply clarify[1]
       apply (simp add: T_def C_def)[1]
       apply(rule Valid_basic_sp1)
      prefer 2
  subgoal unfolding entails_def
    by auto
     prefer 2
     apply(rule Valid_weaken_pre)
  prefer 2
     apply(rule Valid_strengthen_post)
       prefer 2
       apply(rule Valid_interrupt_in_not[where ss= "ss(C := C_upd ent (ss C))" and p="\<lambda> t. ss(T:= ss T + t, C:= C_upd ent (ss C) + t)" and aa= "Task RUNNING eone tp" and P="\<lambda>(a,s) t. inv_s' s \<and> P (Task RUNNING ent tp, ss)  t"])
  subgoal by auto
  unfolding T_def C_def
  apply auto[1]
       apply(rule Valid_basic_sp1)
      prefer 2
  subgoal unfolding entails_def by auto
  subgoal
    unfolding entails_def
    apply (rule allI)+
    apply(rule impI)
    subgoal for s tr
      apply(cases s)
      subgoal for a sss
        apply simp
        apply(erule disjE)
        subgoal apply(rule disjI1)
          apply(rule exI[where x=0])
          apply clarify
          apply(rule conjI) subgoal by auto
          apply(rule conjI) subgoal unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def by auto
          apply(rule conjI) subgoal unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def by auto
          subgoal for v
            apply simp
            apply(rule exI[where x=v])
            unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def by auto
          done
        subgoal apply(rule disjI2)
          apply simp
          apply(rule conjI) subgoal unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def by auto
          apply(rule conjI) subgoal unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def by auto
          unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def
          apply(subgoal_tac"(min (9 / 200 - ss CHR ''t'') (2 / 100 - C_upd ent (ss CHR ''c''))) = 0")
          subgoal by (auto simp add: emp_assn_def)
          by auto
        done
      done
    done
  subgoal
    unfolding entails_def
    apply (rule allI)+
    apply(rule impI)
    subgoal for s tr
      apply(cases s)
      subgoal for a sss
        apply simp
        apply(erule disjE)
        subgoal apply(rule disjI1)
          apply auto
          subgoal for tt vv
            apply(rule exI[where x=tt])
            apply auto
            apply(rule exI[where x=vv])
            apply auto
            unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def
            by auto
          done
        subgoal apply(rule disjI2)
          unfolding pure_assn_def join_assn_def conj_assn_def inv_s'_def T_def C_def F_def
          apply auto
          subgoal
           apply(cases "(9 / 200 - ss CHR ''t'') \<le>(2 / 100 - C_upd ent (ss CHR ''c''))")
            by auto
          subgoal
           apply(cases "(9 / 200 - ss CHR ''t'') \<le>(2 / 100 - C_upd ent (ss CHR ''c''))")
            by auto
          done
        done
      done
    done
   apply(rule Valid_cond_sp)
    apply simp
    apply(rule Valid_echoice[where R="\<lambda> s tr.(inv_s' (snd s) \<and> s =
          (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Outrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (free_ch 2) 0 ({free_ch 2},{preempt_ch 2}))
         tr)
             \<or> (\<exists> v. (inv_s' (snd s) \<and> s =
          (Task WAIT eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)), F := v)) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Inrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (preempt_ch 2) v ({free_ch 2},{preempt_ch 2}))
         tr))"])
  subgoal for i
    apply(cases i)
    subgoal
      apply simp
      apply(rule exI[where x = "\<lambda> s tr.(inv_s' (snd s) \<and> s =
          (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Outrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (free_ch 2) 0 ({free_ch 2},{preempt_ch 2}))
         tr)"])
      apply(rule conjI)
      subgoal
        apply(rule Valid_strengthen_post)
         prefer 2
         apply(rule Valid_basic_sp1)
        unfolding entails_def
        by auto
      subgoal unfolding entails_def
        apply (auto simp add:T_def C_def join_assn_def)
        subgoal for tr1 tr2
          apply(rule exI[where x= tr1])
          apply auto
          apply(rule exI[where x= tr2])
          apply auto
          apply rule
          done
        subgoal for d tr1 tr2
          apply(rule exI[where x= tr1])
          apply auto
          apply(rule exI[where x= tr2])
          apply auto
          apply rule
          by auto
        done
      done
    subgoal for i'
      apply simp
      apply(rule exI[where x="\<lambda> s tr.(\<exists> v. (inv_s' (snd s) \<and> s =
          (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)), F := v)) \<and>
                   ((P (Task RUNNING ent tp, ss)) @\<^sub>t
         Wait\<^sub>t (min (0.045 - ss T) (0.02 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState
                (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>)))
          ({}, {preempt_ch 2}) @\<^sub>t
             Inrdy\<^sub>t (Task RUNNING eone tp, ss
         (T := ss T + min (0.045 - ss T) (0.02 - C_upd ent (ss C)),
          C := C_upd ent (ss C) +
               min (0.045 - ss T) (0.02 - C_upd ent (ss C)))) (preempt_ch 2) v ({free_ch 2},{preempt_ch 2}))
         tr))"])
      apply(rule conjI)
      subgoal
        apply(rule Valid_ex_pre)
        subgoal for v
          apply(rule Valid_strengthen_post)
         prefer 2
         apply(rule Valid_basic_sp1)
        unfolding entails_def
        by auto
      done
    subgoal unfolding entails_def
      apply (auto simp add:T_def C_def F_def join_assn_def inv_s'_def)
      subgoal for tr1 tr2 v
        apply(rule exI[where x= v])
        apply auto
        apply(rule exI[where x= tr1])
        apply auto
        apply(rule exI[where x= tr2])
        apply auto
        apply rule
        done
      subgoal for d tr1 tr2 v
        apply(rule exI[where x= v])
        apply auto
        apply(rule exI[where x= tr1])
        apply auto
        apply(rule exI[where x= tr2])
        apply auto
        apply rule
        by auto
      done
    done
  done
  apply(rule Valid_skip)
  apply(rule allI)+
  apply(rule impI)
  apply(erule disjE)
  subgoal by auto
  apply(erule disjE)
  subgoal by auto
  apply(erule disjE)
  subgoal for s tr
    by (auto simp add:T_def C_def )
  subgoal for s tr
    by auto
  done

lemma Valid_T2_rep:
  "\<Turnstile> {\<lambda>s t. s = (Task st ent tp,ss) \<and> inv_s' (snd s) \<and> emp\<^sub>t t}
                      Rep T2
      {\<lambda>s t. inv_s' (snd s) \<and> (\<exists>n. (emp\<^sub>t @\<^sub>t T2_tr n (Task st ent tp,ss)) t)}"
  apply(rule Valid_rep')
  subgoal for n p
    apply(induction n arbitrary:p st ent tp ss)
    subgoal for p
      apply auto
      apply(rule Valid_strengthen_post)
       prefer 2
       apply(rule Valid_skip)
      unfolding entails_def by auto
    subgoal premises pre for n p st ent tp ss
      apply auto
      apply(cases st)
      subgoal
        apply simp
        apply(rule Valid_seq)
         apply(rule T2_Valid_WAIT)
        apply(rule Valid_strengthen_post)
         prefer 2
         apply(rule pre)
        unfolding entails_def by (auto simp add:join_assoc)
      subgoal
        apply simp
        apply(rule Valid_seq)
         apply(rule T2_Valid_READY)
        apply(rule Valid_pre_or)
        subgoal
          thm pre
          apply auto
          apply(rule Valid_weaken_pre[where P' = "\<lambda>s tr. \<exists>tt v . s = (Task RUNNING ent tp, ss(T := ss T + tt, F := v)) \<and> inv_s' (snd s) \<and>
               (((\<up>(0 \<le> tt \<and> tt \<le> 9 / 200 - ss T) \<and>\<^sub>t p @\<^sub>t Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                         Waitin\<^sub>t tt (\<lambda>t. EState (Task READY ent tp, ss(T := ss T + t)))
                          (run_ch 2) v ({}, {run_ch 2}))
                         tr)"])
          subgoal unfolding entails_def
            by(auto simp add: pure_assn_def conj_assn_def)
          apply(rule Valid_ex_pre)+
          apply(rule Valid_strengthen_post)
           prefer 2
           apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn)
          unfolding disj_assn_def
          apply(rule disjI1)
          apply(auto simp add: ex_assn_def pure_assn_def conj_assn_def join_assn_def)
          subgoal for tt v b tr2 tr1b tr2a tr2b
            apply(rule exI[where x="tr1b"])
            apply auto
            apply(rule exI[where x=v])
            apply(rule exI[where x=tt])
            by auto
          done
        apply(rule Valid_pre_or)
        subgoal
        apply(rule Valid_weaken_pre[where P'="\<lambda>s tr.
                s = (Task WAIT ent tp, ss(T := 45 / 10 ^ 3)) \<and> inv_s' (snd s) \<and>
               ((p @\<^sub>t Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                Wait\<^sub>t (9 / 200 - ss T)
                 (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>))) ({}, {run_ch 2}) @\<^sub>t
                Outrdy\<^sub>t ((Task READY ent tp, ss(T := 45 / 10 ^ 3))) (exit_ch 2) 0 ({exit_ch 2},{run_ch 2}))
                tr"])
        subgoal unfolding entails_def by auto
        apply(rule Valid_strengthen_post)
           prefer 2
           apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn)
          unfolding disj_assn_def
          apply(rule disjI2)
          by(auto simp add: join_assoc)
        subgoal
          apply(rule Valid_ex_pre)
          subgoal for v
          apply(rule Valid_weaken_pre[where P'="\<lambda>s tr.
                s = (Task RUNNING ent tp, ss(T := 45 / 10 ^ 3,F:=v)) \<and> inv_s' (snd s) \<and>
               ((p @\<^sub>t Out\<^sub>t (EState (Task READY ent tp, ss)) (req_ch 2) tp) @\<^sub>t
                Wait\<^sub>t (9 / 200 - ss T)
                 (\<lambda>\<tau>. EState (Task READY ent tp, ss(T := ss T + \<tau>))) ({}, {run_ch 2}) @\<^sub>t
                Inrdy\<^sub>t ((Task READY ent tp, ss(T := 45 / 10 ^ 3))) (run_ch 2) v ({exit_ch 2},{run_ch 2}))
                tr"])
        subgoal unfolding entails_def by auto
        apply(rule Valid_strengthen_post)
           prefer 2
         apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn ex_assn_def)
          unfolding disj_assn_def
          apply(rule disjI2)+
          apply (auto simp add: join_assoc join_assn_def)
          subgoal for b tr2 tr1b tr2b tr1c tr2c
            apply(rule exI[where x= tr1b])
            apply auto
            apply(rule exI[where x= tr2b])
            apply auto
            apply(rule exI[where x= tr1c])
            apply auto
            done
          done
        done
      done
        subgoal
          apply simp
          apply(rule Valid_seq)
           apply(rule T2_Valid_RUNNING)
          apply(rule Valid_pre_or)
        subgoal
          thm pre
          apply auto
          apply(rule Valid_weaken_pre[where P' = "\<lambda>s tr. \<exists>tt v . s = (Task READY eone tp, ss
                         (CHR ''t'' := ss CHR ''t'' + tt,CHR ''c'' := C_upd ent (ss CHR ''c'') + tt, F := v)) \<and> inv_s' (snd s) \<and>
               ((\<up>(0 \<le> tt \<and> tt \<le> 9 / 200 - ss T \<and> tt \<le> 2 / 100 - C_upd ent (ss C))
                       \<and>\<^sub>t p @\<^sub>t Waitin\<^sub>t tt
                          (\<lambda>t. EState
                                (Task RUNNING eone tp, ss
                                 (CHR ''t'' := ss CHR ''t'' + t,
                                  CHR ''c'' := C_upd ent (ss CHR ''c'') + t)))
                          (preempt_ch 2) v ({}, {preempt_ch 2}))
                         tr)"])
          subgoal unfolding entails_def
            by(auto simp add: pure_assn_def conj_assn_def)
          apply(rule Valid_ex_pre)+
          apply(rule Valid_strengthen_post)
           prefer 2
           apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn)
          unfolding disj_assn_def
          apply(rule disjI1)
          apply(auto simp add: ex_assn_def pure_assn_def conj_assn_def join_assn_def T_def C_def)
          subgoal for tt v b tr1a tr2 tr2a
            apply(rule exI[where x="tr1a"])
            by auto
          done
        apply(rule Valid_pre_or)
        subgoal
        apply(rule Valid_weaken_pre[where P'="\<lambda>s tr.
                s = (Task WAIT eone tp, ss
                (T := ss T + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)),
                 C := C_upd ent (ss C) +
                      min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)))) \<and> inv_s' (snd s) \<and>
               ((p @\<^sub>t Wait\<^sub>t (min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>))) ({}, {preempt_ch 2}) @\<^sub>t
         Outrdy\<^sub>t ((Task RUNNING eone tp, ss(T := ss T + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)),
              C := C_upd ent (ss C) + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)))))(free_ch 2) 0 ({free_ch 2}, {preempt_ch 2}))
                tr)"])
        subgoal unfolding entails_def by auto
        apply(rule Valid_strengthen_post)
           prefer 2
           apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn)
          unfolding disj_assn_def
          apply(rule disjI2)
          by(auto simp add: join_assoc)
        subgoal
          apply(rule Valid_ex_pre)
          subgoal for v
            apply(rule Valid_weaken_pre[where P'="\<lambda>s tr.
                s = (Task WAIT eone tp, ss
                (T := ss T + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)),
                 C := C_upd ent (ss C) +
                      min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)),F:=v)) \<and> inv_s' (snd s) \<and>
               ((p @\<^sub>t Wait\<^sub>t (min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)))
          (\<lambda>\<tau>. EState (Task RUNNING eone tp, ss(T := ss T + \<tau>, C := C_upd ent (ss C) + \<tau>))) ({}, {preempt_ch 2}) @\<^sub>t
         Inrdy\<^sub>t ((Task RUNNING eone tp, ss(T := ss T + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)),
              C := C_upd ent (ss C) + min (45 / 10 ^ 3 - ss T) (2 / 10\<^sup>2 - C_upd ent (ss C)))))(preempt_ch 2) v ({free_ch 2}, {preempt_ch 2}))
                tr)"])
        subgoal unfolding entails_def by auto
        apply(rule Valid_strengthen_post)
           prefer 2
           apply(rule pre)
          unfolding entails_def
          apply (auto simp add: join_disj_assn)
          unfolding disj_assn_def
          apply(rule disjI2)
          apply(rule disjI2)
          apply(auto simp add: join_assoc ex_assn_def join_assn_def)
          subgoal for b tr1a tr2 tr1b tr2b
            apply(rule exI[where x = tr1a])
            apply auto
            apply(rule exI[where x = tr1b])
            by auto
        done
      done
    done
  done
  done
  done

end


theory Privacy_Notions_2 imports
CryptHOL.CryptHOL
begin
(*NB: the message type must have a size function avaliavle,  can make it more general than bitstrings atm but
for now we leave it like this. Do not think making it more general will effect the proofs.*)

(*Atm we are assuming the batch queries are only (r_0,r_1) where r_0 and r_1 are both batches, not tuples of batches*)

sledgehammer_params[timeout = 1000]

type_synonym ('sender', 'receiver', 'aux') communication = "'sender' \<times> 'receiver' \<times> bool list \<times> 'aux'"

type_synonym ('sender', 'receiver', 'aux') batch = "('sender', 'receiver', 'aux') communication list"

type_synonym ('sender', 'receiver', 'aux', 'adversary_observations') protocol_model
                = "('sender', 'receiver', 'aux') batch \<Rightarrow> 'adversary_observations'"

type_synonym ('sender', 'receiver', 'aux') scenerio = "('sender', 'receiver', 'aux') batch list"

type_synonym ('sender', 'receiver', 'aux') challenge
              = "('sender', 'receiver', 'aux') scenerio \<times> ('sender', 'receiver', 'aux') scenerio"

locale simple_game =
  fixes protocol_model :: "('sender, 'receiver, 'aux) batch \<Rightarrow> 'adversary_observations spmf"
    and checks_batch :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  assumes lossless_prot_model: "\<forall> batch. lossless_spmf (protocol_model batch)"
begin

primrec simple_game ::
          "((('sender, 'receiver, 'aux) batch \<times> ('sender, 'receiver, 'aux) batch) \<times> 'state) spmf
              \<times> ('adversary_observations \<Rightarrow> 'state \<Rightarrow> bool spmf) \<Rightarrow> bool spmf"
  where "simple_game (\1, \2) = do {
    b \<leftarrow> coin_spmf;
    ((r0,r1), \<sigma>) \<leftarrow> \1;
    _ :: unit \<leftarrow> assert_spmf (checks_batch r0 r1);
    c \<leftarrow> protocol_model (if b then r1 else r0);
    b' \<leftarrow> \2 c \<sigma>;
    return_spmf (b = b')}"

definition "advantage \ = spmf (simple_game \) True - 1/2"

(*primrec simple_game ::
          "('aux_info \<Rightarrow> ((('sender, 'receiver, 'aux) batch \<times> ('sender, 'receiver, 'aux) batch) \<times> 'state) spmf )
              \<times> ('adversary_observations \<Rightarrow> 'state \<Rightarrow> bool spmf) \<Rightarrow> 'aux_info  \<Rightarrow> bool spmf"
  where "simple_game (\1, \2) aux = do {
    b \<leftarrow> coin_spmf;
    ((r0,r1), \<sigma>) \<leftarrow> \1 aux;
    _ :: unit \<leftarrow> assert_spmf (checks_batch r0 r1);
    c \<leftarrow> protocol_model (if b then r1 else r0);
    b' \<leftarrow> \2 c \<sigma>;
    return_spmf (b = b')}"

definition "advantage \ aux = spmf (simple_game \ aux) True - 1/2"*)

end

locale reductions = simple_game protocol_model
  for protocol_model :: "('sender, 'receiver, 'aux) batch \<Rightarrow> 'adversary_observations spmf" +
  assumes lossless_prot_model: "\<forall> batch. lossless_spmf (protocol_model batch)"
begin

(*TODO: look at the definitions of L_b and L_b', think they need changing slightly, think this may be okay*)

definition user_messages :: "('sender, 'receiver, 'aux) batch \<Rightarrow> 'sender \<Rightarrow> bool list set"
  where "user_messages b u \<equiv> {m. \<exists> com \<in> set b. fst com = u \<and> fst (snd (snd com)) = m}"

lemma assumes "b = [(s0,r0,m0,a0), (s1,r1,m1,a1)]" and "s0 \<noteq> u2 \<and> s1 \<noteq> u2"
  shows "user_messages b u2 = {}"
  by(auto simp add: user_messages_def assms)

definition L_b :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> ('sender \<times> bool list set) set"
  where "L_b S i \<equiv> {(user,M). \<exists> com \<in> set (nth S i). fst com = user \<and> M = user_messages (nth S i) user}"

lemma assumes "S = [[(s0,r0,m0,a0), (s1,r1,m1,a1)], [(s3,r3,m3,a3), (s4,r4,m4,a4)]]"
  and "s0 \<noteq> s1"
  shows "L_b S 0 = {(s0,{m0}), (s1,{m1})}"
  apply(auto simp add: L_b_def assms user_messages_def)
  using assms by auto

definition receiver_messages :: "('sender, 'receiver, 'aux) batch \<Rightarrow> 'receiver \<Rightarrow> bool list set"
  where "receiver_messages b r \<equiv> {m. \<exists> com \<in> set b. fst (snd com) = r \<and> fst (snd (snd com)) = m}"

definition L_b' :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> ('receiver \<times> bool list set) set"
  where "L_b' S i \<equiv> {(receiver,M). \<exists> com \<in> set (nth S i). fst (snd com) = receiver
                       \<and> M = receiver_messages (nth S i) receiver}"

(*definition L_b :: "bool \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender \<times> bool list set) set"
  where "L_b b batch0 batch1 \<equiv> {(s, M). \<forall> m \<in> M. \<exists> batch \<in> set (if b then batch1 else batch0). fst batch = s \<and> fst (snd (snd batch)) = m}"

definition L_b' :: "bool \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> ('receiver \<times> bool list set) set"
  where "L_b' b batch0 batch1 \<equiv> {(s, M). \<forall> m \<in> M. \<exists> batch \<in> set (if b then batch1 else batch0). fst (snd batch) = s \<and> fst (snd (snd batch)) = m}"*)

definition U_b :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> 'sender set"
  where "U_b S i = {u. \<forall> M. (u,M) \<in> L_b S i}"

definition U_b' :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> 'receiver set"
  where "U_b' S i = {u. \<forall> M. (u,M) \<in> L_b' S i}"

definition Q_b :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> ('sender \<times> nat) set"
  where "Q_b S i = {(u,n). \<forall> M. (u,M) \<in> L_b S i \<and> (\<forall> m \<in> M. length m = n)}"

definition Q_b' :: "('sender, 'receiver, 'aux) scenerio \<Rightarrow> nat \<Rightarrow> ('receiver \<times> nat) set"
  where "Q_b' S i = {(u,n). \<forall> M. (u,M) \<in> L_b' S i \<and> (\<forall> m \<in> M. length m = n)}"

definition U :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "U C k \<equiv> (U_b (fst C) k  = U_b (snd C) k)"

definition U' :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "U' C k \<equiv> (U_b' (fst C) k  = U_b' (snd C) k)"

definition Q :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "Q C k \<equiv> (Q_b (fst C) k = Q_b (snd C) k)"

definition Q' :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "Q' C k \<equiv> (Q_b' (fst C) k = Q_b' (snd C) k)"

definition U_card :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "U_card C k \<equiv> (card (U_b (fst C) k) = card (U_b (snd C) k))"

definition U_card' :: "('sender, 'receiver, 'aux) challenge \<Rightarrow> nat \<Rightarrow> bool"
  where "U_card' C k \<equiv> (card (U_b' (fst C) k) = card (U_b' (snd C) k))"

definition M_card :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "M_card r0 r1 \<equiv> (\<forall> (s0,r0,m0,aux0) \<in> List.list.set r0. \<forall> (s1,r1,m1,aux1) \<in> List.list.set r1. size m0 = size m1)"

definition ES :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "ES r0 r1 \<equiv> (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                fst (snd com0) = fst (snd com1) \<and> fst (snd (snd com0)) = fst (snd (snd com1))
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

definition ER :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "ER r0 r1 = (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                fst com0 = fst com1 \<and> fst (snd (snd com0)) = fst (snd (snd com1))
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

definition EM :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "EM r0 r1 = (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                fst com0 = fst com1 \<and> fst (snd com0) = fst (snd com1)
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

definition ESM :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "ESM r0 r1 = (\<forall> (s0,r0,m0,aux0) \<in> List.list.set r0. \<forall> (s1,r1,m1,aux1) \<in> List.list.set r1. r0 = r1 \<and> aux0 = aux1)"

definition ERM :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "ERM r0 r1 = (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                           fst com0 = fst com1 \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

definition ESR :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "ESR r0 r1 \<equiv> (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                  fst (snd (snd com0)) = fst (snd (snd com1))
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

definition checks_batch_O where "checks_batch_O r0 r1 = True"

definition  checks_batch_RO :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO r0 r1 = ER r0 r1"

definition  checks_batch_SO :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO r0 r1 = ES r0 r1"

definition  checks_batch_SO_cardU :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO_cardU r0 r1 = (ES r0 r1 \<and> U_card r0 r1)"

definition  checks_batch_RO_cardU' :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO_cardU' r0 r1 = (ER r0 r1 \<and> U_card' r0 r1)"

definition  checks_batch_SML :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SML r0 r1 = (ES r0 r1 \<and> Q r0 r1)"

definition  checks_batch_RML :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RML r0 r1 = (ER r0 r1 \<and> Q' r0 r1)"

definition  checks_batch_SFL :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SFL r0 r1 = (ES r0 r1 \<and> U r0 r1)"

definition  checks_batch_RFL :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RFL r0 r1 = (ER r0 r1 \<and> U' r0 r1)"

definition  checks_batch_SOMO :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SOMO r0 r1 \<equiv> (ESM r0 r1)"

definition  checks_batch_ROMO :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_ROMO r0 r1 \<equiv> (ERM r0 r1)"

definition  checks_batch_SOMO_M :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SOMO_M r0 r1 \<equiv> (ESM r0 r1 \<and> M_card r0 r1)"

definition  checks_batch_ROMO_M :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_ROMO_M r0 r1 \<equiv> (ESM r0 r1 \<and> M_card r0 r1)"

definition  checks_batch_SO_RO :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO_RO r0 r1 = ES r0 r1"

definition checks_batch_RO_brSO_U_cardbr :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO_brSO_U_cardbr r0 r1 = (U_card r0 r1)"

definition checks_batch_SO_brRO_U_card'br :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO_brRO_U_card'br r0 r1 = (U_card' r0 r1)"

definition checks_batch_SO_brRFLbr :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO_brRFLbr r0 r1 = (U' r0 r1)"

definition checks_batch_RO_brSFLbr :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO_brSFLbr r0 r1 = (U r0 r1)"

definition checks_batch_SO_brRMLbr :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_SO_brRMLbr r0 r1 = (Q' r0 r1)"

definition checks_batch_RO_brSMLbr :: "('sender, 'receiver, 'aux) batch \<Rightarrow> ('sender, 'receiver, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO_brSMLbr r0 r1 = (Q r0 r1)"

lemma Q_imp_U:
  assumes "Q batch0 batch1"
  shows "U batch0 batch1"
  using assms by(simp add: Q_def U_def Q_b_def U_b_def; blast)

sublocale O: simple_game protocol_model checks_batch_O
  by(simp add: simple_game_axioms)

sublocale RO: simple_game protocol_model checks_batch_RO
  by(simp add: simple_game_axioms)

sublocale SO: simple_game protocol_model checks_batch_SO
  by(simp add: simple_game_axioms)

sublocale SO_cardU: simple_game protocol_model checks_batch_SO_cardU
  by(simp add: simple_game_axioms)

sublocale SFL: simple_game protocol_model checks_batch_SFL
  by(simp add: simple_game_axioms)

sublocale SML: simple_game protocol_model checks_batch_SML
  by(simp add: simple_game_axioms)

sublocale SOMO_M: simple_game protocol_model checks_batch_SOMO_M
  by(simp add: simple_game_axioms)

sublocale SOMO: simple_game protocol_model checks_batch_SOMO
  by(simp add: simple_game_axioms)

sublocale RO_brSMLbr: simple_game protocol_model checks_batch_RO_brSMLbr
  by(simp add: simple_game_axioms)

sublocale SO_brRMLbr: simple_game protocol_model checks_batch_SO_brRMLbr
  by(simp add: simple_game_axioms)

sublocale RO_brSFLbr: simple_game protocol_model checks_batch_RO_brSFLbr
  by(simp add: simple_game_axioms)

sublocale SO_brRFLbr: simple_game protocol_model checks_batch_SO_brRFLbr
  by(simp add: simple_game_axioms)

sublocale SO_brRO_U_card'br: simple_game protocol_model checks_batch_SO_brRO_U_card'br
  by(simp add: simple_game_axioms)

sublocale RO_brSO_U_cardbr: simple_game protocol_model checks_batch_RO_brSO_U_cardbr
  by(simp add: simple_game_axioms)

lemma ESM_imp_L_b'_True_eq_False:
  assumes "(\<forall> (s0,r0,m0,aux0) \<in> List.list.set batch0. \<forall> (s1,r1,m1,aux1) \<in> List.list.set batch1. r0 = r1 \<and> aux0 = aux1)"
  shows "L_b' True batch0 batch1 = L_b' False batch0 batch1"
  using assms L_b'_def oops
lemma ESM_imp_Q_b'_unfold:
  assumes "(\<forall> (s0,r0,m0,aux0) \<in> List.list.set batch0. \<forall> (s1,r1,m1,aux1) \<in> List.list.set batch1. r0 = r1 \<and> aux0 = aux1)"
  shows "Q_b' True batch0 batch1 = Q_b' False batch0 batch1"
  using ESM_imp_L_b'_True_eq_False Q_b'_def assms by simp
(*proof
  show "Q_b' True batch0 batch1 \<subseteq> Q_b' False batch0 batch1"
  proof
    fix x
    assume asm: "x \<in> Q_b' True batch0 batch1"
    then obtain u M where uM: "(u,M) = x"
      using Q_b'_def by auto
    hence "(u,M) \<in> Q_b' True batch0 batch1"
      using asm by simp
    hence "(u,M) \<in> {(u,n). \<exists> M. (u,M) \<in> L_b' True batch0 batch1 \<and> card M = n}"
      using Q_b'_def by simp
    hence "(u,M) \<in> {(u,n). \<exists> M. (u,M) \<in> L_b' False batch0 batch1 \<and> card M = n}"
      using ESM_imp_L_b'_True_eq_False assms by simp
    thus "x \<in> Q_b' False batch0 batch1"
      by (simp add: uM Q_b'_def)
  qed
next
  show "Q_b' False batch0 batch1 \<subseteq> Q_b' True batch0 batch1"
    sorry
qed*)

lemma Q'_imp_ESM: assumes "ESM r0 r1" shows "Q' r0 r1"
using ESM_imp_Q_b'_unfold assms ESM_def Q'_def by simp

lemma SO_brRMLbr_imp_SOMO: shows "SOMO.advantage \ \<le> SO_brRMLbr.advantage \"
proof-
  have "spmf (SO_brRMLbr.simple_game \) True \<ge> spmf (SOMO.simple_game \) True"
    apply(simp add: SOMO.simple_game_def SO_brRMLbr.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: checks_batch_SOMO_def checks_batch_SO_brRMLbr_def assert_spmf_def Q'_imp_ESM)
  thus ?thesis by (simp add: SOMO.advantage_def SO_brRMLbr.advantage_def)
qed

lemma SOMO_imp_SOMO_M: shows "SOMO.advantage \ \<ge> SOMO_M.advantage \"
proof-
  have "spmf (SOMO_M.simple_game \) True \<le> spmf (SOMO.simple_game \) True"
    apply(simp add: SOMO.simple_game_def SOMO_M.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SOMO_def checks_batch_SOMO_M_def ESM_def ES_def M_card_def)
  thus ?thesis by (simp add: SOMO.advantage_def SOMO_M.advantage_def)
qed

lemma SOMO_M_imp_SO: shows "SO.advantage \ \<le> SOMO_M.advantage \"
proof-
  have "spmf (SOMO_M.simple_game \) True \<ge> spmf (SO.simple_game \) True"
    apply(simp add: SO.simple_game_def SOMO_M.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SO_def checks_batch_SOMO_M_def ESM_def ES_def M_card_def)
  thus ?thesis by (simp add: SO.advantage_def SOMO_M.advantage_def)
qed

lemma SO_imp_SO_cardU: shows "SO_cardU.advantage \ \<le> SO.advantage \"
proof-
  have "spmf (SO.simple_game \) True \<ge> spmf (SO_cardU.simple_game \) True"
    apply(simp add: SO.simple_game_def SO_cardU.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SO_def checks_batch_SO_cardU_def)
  thus ?thesis by (simp add: SO.advantage_def SO_cardU.advantage_def)
qed

lemma SO_cardU_imp_SFL: shows "SO_cardU.advantage \ \<ge> SFL.advantage \"
proof-
  have "spmf (SFL.simple_game \) True \<le> spmf (SO_cardU.simple_game \) True"
    apply(simp add: SFL.simple_game_def SO_cardU.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SFL_def checks_batch_SO_cardU_def U_card_def U_def)
  thus ?thesis by (simp add: SFL.advantage_def SO_cardU.advantage_def)
qed

lemma SFL_imp_SML: shows "SML.advantage \ \<le> SFL.advantage \"
proof-
  have "spmf (SFL.simple_game \) True \<ge> spmf (SML.simple_game \) True"
    apply(simp add: SFL.simple_game_def SML.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SFL_def checks_batch_SML_def Q_def U_def U_b_def Q_b_def)
  thus ?thesis by (simp add: SFL.advantage_def SML.advantage_def)
qed

lemma O_imp_RO: shows "O.advantage \ \<ge> RO.advantage \"
proof-
  have "spmf (O.simple_game \) True \<ge> spmf (RO.simple_game \) True"
    apply(simp add: O.simple_game_def RO.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def  lossless_prot_model checks_batch_RO_def checks_batch_O_def)
  thus ?thesis by (simp add: O.advantage_def RO.advantage_def)
qed

lemma O_imp_SO_brRO_U_card'br: shows "O.advantage \ \<ge> SO_brRO_U_card'br.advantage \"
proof-
  have "spmf (O.simple_game \) True \<ge> spmf (SO_brRO_U_card'br.simple_game \) True"
    apply(simp add: O.simple_game_def SO_brRO_U_card'br.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def  lossless_prot_model checks_batch_RO_def checks_batch_O_def)
  thus ?thesis by (simp add: O.advantage_def SO_brRO_U_card'br.advantage_def)
qed

lemma SO_brRO_U_card'br_imp_SO_brRFLbr: shows "SO_brRFLbr.advantage \ \<le> SO_brRO_U_card'br.advantage \"
proof-
  have "spmf (SO_brRFLbr.simple_game \) True \<le> spmf (SO_brRO_U_card'br.simple_game \) True"
    apply(simp add: SO_brRFLbr.simple_game_def SO_brRO_U_card'br.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def  checks_batch_SO_brRO_U_card'br_def checks_batch_SO_brRFLbr_def U'_def U_card'_def)
  thus ?thesis by (simp add: SO_brRFLbr.advantage_def SO_brRO_U_card'br.advantage_def)
qed

lemma SO_brRFLbr_imp_SO_brRMLbr: shows "SO_brRFLbr.advantage \ \<ge> SO_brRMLbr.advantage \"
proof-
  have "spmf (SO_brRFLbr.simple_game \) True \<ge> spmf (SO_brRMLbr.simple_game \) True"
    apply(simp add: SO_brRFLbr.simple_game_def SO_brRMLbr.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def checks_batch_SO_brRMLbr_def checks_batch_SO_brRFLbr_def U_b'_def U'_def Q'_def Q_b'_def)
  thus ?thesis by (simp add: SO_brRFLbr.advantage_def SO_brRMLbr.advantage_def)
qed

lemma O_imp_SO: shows "O.advantage \ \<ge> SO.advantage \"
proof-
  have "spmf (O.simple_game \) True \<ge> spmf (SO.simple_game \) True"
    apply(simp add: O.simple_game_def SO.simple_game_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(auto simp add: assert_spmf_def  lossless_prot_model checks_batch_SO_def checks_batch_O_def)
  thus ?thesis by (simp add: O.advantage_def SO.advantage_def)
qed

end

locale simple_game_O =
  fixes protocol_model :: "('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> 'adversary_observations spmf"
begin

(*test proof, not in proper locale form. Have not worked out which is best yet*)

fun checks_batch_O where "checks_batch_O r0 r1 = True"

fun  checks_batch_RO :: "('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> ('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> bool"
  where "checks_batch_RO r0 r1 = (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                fst com0 = fst com1 \<and> fst (snd (snd com0)) = fst (snd (snd com1))
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

primrec simple_game_O ::
          "((('sender, 'receiver, bool list, 'aux) batch \<times> ('sender, 'receiver, bool list, 'aux) batch) \<times> 'state) spmf
              \<times> ('adversary_observations \<Rightarrow> 'state \<Rightarrow> bool spmf) \<Rightarrow> bool spmf"
  where "simple_game_O (\1, \2) = do {
    b \<leftarrow> coin_spmf;
    ((r0,r1), \<sigma>) \<leftarrow> \1;
    _ :: unit \<leftarrow> assert_spmf (checks_batch_O r0 r1);
    c \<leftarrow> protocol_model (if b then r1 else r0);
    b' \<leftarrow> \2 c \<sigma>;
    return_spmf (b = b')}"

primrec simple_game_RO ::
          "((('sender, 'receiver, bool list, 'aux) batch \<times> ('sender, 'receiver, bool list, 'aux) batch) \<times> 'state) spmf
              \<times> ('adversary_observations \<Rightarrow> 'state \<Rightarrow> bool spmf) \<Rightarrow> bool spmf"
  where "simple_game_RO (\1, \2) = do {
    b \<leftarrow> coin_spmf;
    ((r0,r1), \<sigma>) \<leftarrow> \1;
    _ :: unit \<leftarrow> assert_spmf (checks_batch_RO r0 r1);
    c \<leftarrow> protocol_model (if b then r1 else r0);
    b' \<leftarrow> \2 c \<sigma>;
    return_spmf (b = b')}"

definition "advantage_O \ = spmf (simple_game_O \) True - 1/2"

definition "advantage_RO \ = spmf (simple_game_RO \) True - 1/2"

lemma
  assumes "spmf (simple_game_O \) True \<ge> 1/2"
    and "spmf (simple_game_RO \) True > 1/2"
  shows
    "advantage_O \ \<ge> advantage_RO \"
proof-
  have "spmf (simple_game_O \) True \<ge> spmf (simple_game_RO \) True"
    apply(simp add: simple_game_O_def simple_game_RO_def split_def)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(simp add: assert_spmf_def)
  thus ?thesis
    using assms by (simp add: simple_game_O.advantage_O_def simple_game_O.advantage_RO_def)
qed

end

locale simple_game_RO =
  fixes protocol_model :: "('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> 'adversary_observations spmf"
begin
(*everything same except receivers is the same*)

lemma
  "fst (a1,a2,a3,a4) = a1"
  "fst (snd (a1,a2,a3,a4)) = a2"
  "fst (snd (snd (a1,a2,a3,a4))) = a3"
  "snd (snd (snd (a1,a2,a3,a4))) = a4"
  by auto

fun  checks_batch :: "('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> ('sender, 'receiver, bool list, 'aux) batch \<Rightarrow> bool"
  where "checks_batch r0 r1 = (\<forall> com0 \<in> List.list.set r0. \<forall> com1 \<in> List.list.set r1.
                                fst com0 = fst com1 \<and> fst (snd (snd com0)) = fst (snd (snd com1))
                                  \<and> snd (snd (snd com0)) = snd (snd (snd com1)))"

sublocale simple_game_R0: simple_game protocol_model checks_batch .