\<^marker>\<open>creator Florian Keßler\<close>

section "IMP-- to SAS++ Correctness"

theory IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness
  imports IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction SAS_Plus_Plus
begin

text \<open> We show correctness for the IMP-- to SAS++ reduction. \<close>

lemma sas_plus_state_to_imp_minus_of_effect:
  assumes "op \<in> set (com_to_operators c1)"
  shows "sas_plus_state_to_imp_minus (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))
  = (pc_to_com (effect_of op),
  snd (sas_plus_state_to_imp_minus (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))))"
proof -
  have "fst (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) = pc_to_com (effect_of op)"
    using assms by(auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def
                   com_to_operators_variables_distinct)
  moreover have "snd (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) a = (is ++ ((\<lambda>x. (case x of
      EV y \<Rightarrow> Some y | _ \<Rightarrow> None)) \<circ>\<^sub>m (map_of (effect_of op)) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a"
    for a using assms
    by(auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def
      option.case_eq_if map_comp_def map_add_def com_to_operators_variables_distinct
      split: domain_element.splits)
  moreover then have "snd (sas_plus_state_to_imp_minus
    (imp_minus_state_to_sas_plus (c, is) ++ map_of (effect_of op))) = (is
   ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None)) \<circ>\<^sub>m (map_of (effect_of op)) \<circ>\<^sub>m (\<lambda>x. Some (VN x))))"
    by auto
  ultimately show ?thesis using assms by (metis prod.collapse)
qed

lemma imp_minus_state_to_sas_plus_update_PC[simp]:
  "(imp_minus_state_to_sas_plus (c1, is1))(PC \<mapsto> PCV c2)
  = imp_minus_state_to_sas_plus (c2, is1)"
  by(auto simp: imp_minus_state_to_sas_plus_def option.case_eq_if)

lemma sas_plus_state_to_imp_minus_of_lambda_PC[simp]: "sas_plus_state_to_imp_minus
  (\<lambda>a. if a = PC then Some (PCV c1)
       else ss a)
  = (c1, snd (sas_plus_state_to_imp_minus ss))"
  by (auto simp: imp_minus_state_to_sas_plus_def sas_plus_state_to_imp_minus_def map_comp_def)

lemma sas_plus_state_to_imp_minus_of_PC_updated[simp]:
  "sas_plus_state_to_imp_minus (ss(PC \<mapsto> PCV c))
  = (c, snd (sas_plus_state_to_imp_minus ss))"
  by (auto simp: sas_plus_state_to_imp_minus_def map_comp_def)

lemma imp_minus_state_to_sas_plus_VN_eq_Some_Iff[simp]:
  "(imp_minus_state_to_sas_plus (c, s) (VN x) = Some y)
  \<longleftrightarrow> ((map_option EV (s x)) = Some y)"
  by (simp add: imp_minus_state_to_sas_plus_def map_comp_Some_iff)

lemma imp_minus_state_to_sas_plus_add_effect:
  assumes "op \<in> set (com_to_operators c)"
  shows "imp_minus_state_to_sas_plus (c1, is) ++ map_of (effect_of op)
      = imp_minus_state_to_sas_plus (pc_to_com (effect_of op), is) ++ map_of (effect_of op)"
  using assms com_to_operators_variables_distinct
  by(auto simp: map_add_def imp_minus_state_to_sas_plus_def fun_eq_iff split: option.splits)

lemma imp_minus_state_to_sas_plus_of_effect:
  assumes "op \<in> set (com_to_operators cB)"
  shows "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2) =
    imp_minus_state_to_sas_plus (c2, s')) \<longleftrightarrow> ((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
proof
  assume *: "(imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)
    = imp_minus_state_to_sas_plus (c2, s')"
  have "\<forall>a. (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a = s' a"
  proof(rule ccontr)
    assume "\<not>(\<forall>a. (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
      \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a = s' a)"
    then obtain a where "(s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
      \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) a \<noteq> s' a" by auto
    then have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)) (VN a)
      \<noteq> imp_minus_state_to_sas_plus (c2, s') (VN a)"
      by(auto simp: imp_minus_state_to_sas_plus_def map_comp_def map_add_def domD domIff
            split: option.splits)
    then show "False" using * by auto
  qed
  then show "((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')" by auto
next
  assume *: "((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
  then have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)) a
      = imp_minus_state_to_sas_plus (c2, s') a" for a
    using assms by(cases a) (auto simp: com_to_operators_variables_distinct
        imp_minus_state_to_sas_plus_def map_comp_def map_add_def option.case_eq_if
        split: option.splits domain_element.splits)
  then show "(imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))(PC \<mapsto> PCV c2)
    = imp_minus_state_to_sas_plus (c2, s')" by auto
qed

lemma imp_minus_state_to_sas_plus_of_effect':
  assumes "op \<in> set (com_to_operators cB)"
  shows "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op)) =
    imp_minus_state_to_sas_plus (c2, s')) \<longleftrightarrow> ((pc_to_com (effect_of op) = c2) \<and>
  (s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
proof -
  have "imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op) =
    ((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))
    (PC \<mapsto> PCV (pc_to_com (effect_of op))))"
    using assms com_to_operators_variables_distinct by auto
  moreover have "((imp_minus_state_to_sas_plus (c1, s) ++ map_of (effect_of op))
  (PC \<mapsto> PCV (pc_to_com (effect_of op))) =
    imp_minus_state_to_sas_plus ((pc_to_com (effect_of op)), s'))
    \<longleftrightarrow> ((s ++ ((\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None))
    \<circ>\<^sub>m map_of (effect_of op) \<circ>\<^sub>m (\<lambda>x. Some (VN x)))) = s')"
    using assms imp_minus_state_to_sas_plus_of_effect by blast
  ultimately show ?thesis using assms imp_minus_state_to_sas_plus_def map_upd_eqD1
    by (metis domain_element.inject fst_conv)
qed

lemma updated_state_is_sane:
  assumes "op \<in> set (com_to_operators c)"
    "sane_sas_plus_state ss1"
  shows "sane_sas_plus_state (ss1 \<then>\<^sub>+ op)"
proof -
  have "\<exists>x. (VN v, EV x) \<in> set (effect_of op) \<or> map_of (effect_of op) (VN v) = None" for v
    using assms variables_in_effect by simp
  then show ?thesis using assms
    apply(auto simp: sane_sas_plus_state_def com_to_operators_variables_distinct
        map_add_Some_iff)
    using in_set_effect by blast
qed

lemma imp_minus_state_to_sas_plus_update_VN[simp]: "(\<lambda>a. if a = PC then Some (PCV c2)
   else (imp_minus_state_to_sas_plus (c1, is1)(VN x \<mapsto> EV y)) a)
    = imp_minus_state_to_sas_plus (c2, is1(x \<mapsto> y))"
proof -
  have "(if a = PC then Some (PCV c2) else ((imp_minus_state_to_sas_plus (c1, is1)(VN x \<mapsto> EV y)) a))
    = (imp_minus_state_to_sas_plus (c2, is1(x \<mapsto> y))) a" for a
    by (auto simp: imp_minus_state_to_sas_plus_def map_comp_def split: variable.splits)
  then show ?thesis by auto
qed

lemma VN_PC_map_le_iff[simp]: "[VN v \<mapsto> y, PC \<mapsto> x] \<subseteq>\<^sub>m (imp_minus_state_to_sas_plus (c1, is))
  = (x = PCV c1 \<and> map_option EV (is v) = Some y)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def option.case_eq_if map_comp_def)

lemma operator_with_PC_updated_applicable_iff[simp]: "op \<in> set (com_to_operators c1) \<Longrightarrow>
  map_of (precondition_of op)(PC \<mapsto> PCV c2) \<subseteq>\<^sub>m imp_minus_state_to_sas_plus (c2, s)
  \<longleftrightarrow>  map_of (precondition_of op) \<subseteq>\<^sub>m imp_minus_state_to_sas_plus (c1, s)"
  by(auto simp: imp_minus_state_to_sas_plus_def map_le_def)

lemma applicable_in_imp_minus_then[simp]:
  "is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is))
  \<lparr>precondition_of = [(PC, x), (VN v, y)], effect_of = effect\<rparr>
  \<longleftrightarrow> (x = PCV c1 \<and> map_option EV (is v) = Some y)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def option.case_eq_if map_comp_def)

lemma PC_map_le_iff[simp]: "[PC \<mapsto> x] \<subseteq>\<^sub>m (imp_minus_state_to_sas_plus (c1, is))
  = (x = PCV c1)"
  by (auto simp: map_le_def imp_minus_state_to_sas_plus_def)

lemma map_of_list_update: "distinct (map fst l) \<Longrightarrow> length l > 0 \<Longrightarrow> fst (l ! 0) = x  \<Longrightarrow> z \<noteq> x
  \<Longrightarrow> map_of (list_update l 0 (x, y)) z = map_of l z"
  by (induction l) auto

lemma map_of_update_PC_in_effect_of_op[simp]: assumes "op \<in> set (com_to_operators c)"
  shows "map_of (list_update (effect_of op) 0 (PC, y)) = (map_of (effect_of op))(PC \<mapsto> y)"
proof -
  have "map_of (list_update (effect_of op) 0 (PC, y)) x = ((map_of (effect_of op))(PC \<mapsto> y)) x" for x
    using assms com_to_operators_variables_distinct effect_nonempty
      map_of_list_update[where ?l = "effect_of op"]
    by (auto)
      (metis effect_nonempty fst_of_effect map_of_eq_Some_iff set_update_memI update_preserve_distinct)
  then show ?thesis by auto
qed

lemma map_of_update_PC_in_precondition_of_op[simp]: assumes "op \<in> set (com_to_operators c)"
  shows "map_of (list_update (precondition_of op) 0 (PC, y)) = (map_of (precondition_of op))(PC \<mapsto> y)"
proof -
  have "map_of (list_update (precondition_of op) 0 (PC, y)) x = ((map_of (precondition_of op))(PC \<mapsto> y)) x" for x
    using assms com_to_operators_variables_distinct precondition_nonempty
      map_of_list_update[where ?l = "precondition_of op"]
    by (auto)
     (metis precondition_nonempty fst_of_precondition map_of_eq_Some_iff set_update_memI update_preserve_distinct)
  then show ?thesis by auto
qed

lemma pc_of_op:
  assumes "op \<in> set (com_to_operators c2)"
    "ss2 = imp_minus_state_to_sas_plus (c1, is)"
    "ss1 \<then>\<^sub>+ op = ss2"
  shows "pc_to_com (effect_of op) = c1"
proof -
  have "(ss1 \<then>\<^sub>+ op) PC = Some (PCV c1)" using assms by simp
  then show ?thesis using assms com_to_operators_variables_distinct by auto
qed

lemma effect_in_updated[simp]:
  assumes "op' \<in> set (com_to_operators c)"
    "map_of (precondition_of op') = (map_of (precondition_of op))(PC \<mapsto> PCV c)"
    "map_of (effect_of op') = (map_of (effect_of op))(PC \<mapsto> PCV (pc_to_com (effect_of op')))"
    "s \<then>\<^sub>+ op = s'"
  shows "s(PC \<mapsto> PCV c) \<then>\<^sub>+ op' = s'(PC \<mapsto> PCV (pc_to_com (effect_of op')))"
proof -
  have "(s(PC \<mapsto> PCV c)  \<then>\<^sub>+ op') x = (s'(PC \<mapsto> PCV (pc_to_com (effect_of op')))) x" for x
    using assms PC_in_effect_precondition com_to_operators_variables_distinct apply auto
    by (metis fun_upd_other map_add_def)
  then show ?thesis by auto
qed

lemma applicable_in_PC_updated: "m \<subseteq>\<^sub>m s(PC \<mapsto> y) \<Longrightarrow> s PC = Some x \<Longrightarrow> m(PC \<mapsto> x) \<subseteq>\<^sub>m s"
  by (simp add: map_le_def)

text \<open> We first show that every operation in SAS++ corresponds to a single step in IMP-- \<close>

lemma sas_plus_plus_to_imp_minus_minus_single_step:
  "op \<in> set (com_to_operators c1)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c) \<Longrightarrow> t > 0
  \<Longrightarrow> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op
  \<Longrightarrow> (c1, is1) \<rightarrow>
  sas_plus_state_to_imp_minus ((imp_minus_state_to_sas_plus (c1, is1)) \<then>\<^sub>+ op)"
proof (induction c1 arbitrary: op is1)
  case (Seq cA cB)
  have "cA = SKIP \<or> cA \<noteq> SKIP" by auto
  then show ?case using Seq
  proof (elim disjE)
    assume "cA \<noteq> SKIP"
    then obtain op' where op'_def: "op' \<in> set (com_to_operators cA)"
      "op = (let c1' = pc_to_com (effect_of op') in
      \<lparr> precondition_of = list_update (precondition_of op') 0 (PC, PCV (cA ;; cB)),
        effect_of = list_update (effect_of op') 0 (PC, PCV (c1' ;; cB))\<rparr>)" using Seq by auto
    let ?c1' = "pc_to_com (effect_of op')"
    let ?ss1' = "(imp_minus_state_to_sas_plus ((cA ;; cB), is1))(PC \<mapsto> PCV cA)"
    let ?ss2' = "((imp_minus_state_to_sas_plus ((cA ;; cB), is1)) \<then>\<^sub>+ op)(PC \<mapsto> PCV ?c1')"
    have "cA \<in> set (enumerate_subprograms c)"
      using \<open>cA;;cB \<in> set (enumerate_subprograms c)\<close> c_in_all_subprograms_c
      by (force intro!: enumerate_subprograms_transitive[where ?c2.0 = "cA;; cB"])
    then have "(cA, is1) \<rightarrow> sas_plus_state_to_imp_minus ?ss2'"
      using \<open>0 < t\<close> op'_def Seq  imp_minus_state_to_sas_plus_add_effect[where ?c1.0="cA;; cB"]
      imp_minus_state_to_sas_plus_add_effect[where ?c1.0="cA"]
      by(auto simp: com_to_operators_variables_distinct fun_upd_idem)
    then show ?thesis using op'_def by auto
  qed auto
qed(auto simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff)

text \<open> Next, we show that a plan in SAS++ corresponds to executing several steps in IMP-- \<close>

lemma sas_plus_plus_to_imp_minus_minus_aux:
  "set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
  \<Longrightarrow> sane_sas_plus_state ss1
  \<Longrightarrow> execute_serial_plan_sas_plus ss1 ops = ss2
  \<Longrightarrow> (\<exists>t'. t' \<le> length ops
    \<and> sas_plus_state_to_imp_minus ss1 \<rightarrow>\<^bsup>t'\<^esup> sas_plus_state_to_imp_minus ss2)"
proof (induction ops arbitrary: ss1)
  case (Cons op ops)
  let ?c1 = "fst (sas_plus_state_to_imp_minus ss1)"
  let ?is1 = "snd (sas_plus_state_to_imp_minus ss1)"
  let ?ss1' = "ss1 \<then>\<^sub>+ op"
  have "is_operator_applicable_in ss1 op \<or> \<not>(is_operator_applicable_in ss1 op)" by auto
  then show ?case using Cons
  proof (elim disjE)
    assume a: "is_operator_applicable_in ss1 op"
    then have op_in_cto_c1: "op \<in> set (com_to_operators ?c1)" using Cons by auto
    moreover then have "?c1 \<in> set (enumerate_subprograms c)" using Cons a
      apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def coms_to_operators_def)
      by (metis PC_of_precondition domain_element.simps op_in_cto_c1)
    ultimately have c1_to_c1': "(?c1, ?is1) \<rightarrow> sas_plus_state_to_imp_minus
      (imp_minus_state_to_sas_plus (?c1, ?is1) \<then>\<^sub>+ op)"
      apply(rule sas_plus_plus_to_imp_minus_minus_single_step)
      using Cons a op_in_cto_c1 by auto
    moreover then have "execute_serial_plan_sas_plus ?ss1' ops = ss2"
      and "sane_sas_plus_state ?ss1'"
      using Cons a op_in_cto_c1 updated_state_is_sane by auto
    ultimately have "\<exists>t'. t' \<le> length ops \<and> sas_plus_state_to_imp_minus ?ss1'
      \<rightarrow>\<^bsup>t'\<^esup> sas_plus_state_to_imp_minus ss2"
      using Cons by(auto)
    moreover have "imp_minus_state_to_sas_plus (?c1, ?is1) \<then>\<^sub>+ op = ?ss1'" using Cons by auto
    ultimately show ?case using c1_to_c1' by auto
  qed auto
qed auto

lemma all_zero_than_zero_map_le: "\<forall>b\<in>set bs. s b = Some Zero
  \<Longrightarrow> map_of (map (\<lambda>v. (v, Zero)) (remdups bs)) \<subseteq>\<^sub>m s"
  apply(induction bs)
  by(auto simp: map_le_def)

text \<open> For the other direction, we again first show that a single step in IMP-- always
      corresponds to applying one operation in SAS++ \<close>

lemma imp_minus_minus_to_sas_plus_plus_single_step:
   "(c1, is1) \<rightarrow> (c2, is2)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom is1 = set (enumerate_variables c)
  \<Longrightarrow> (\<exists>op \<in> set (com_to_operators c1).
      execute_operator_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) op
        =  imp_minus_state_to_sas_plus (c2, is2)
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op)"
proof (induction c1 is1 c2 is2 rule: small_step_induct)
  case (Assign x a s)
  thus ?case by auto
next
  case (Seq2 c\<^sub>1 s c\<^sub>1' s' c\<^sub>2)
  have "c\<^sub>1 \<in> set (enumerate_subprograms (c\<^sub>1 ;; c\<^sub>2))" using c_in_all_subprograms_c by auto
  then have "c\<^sub>1 \<in> set (enumerate_subprograms c)" using Seq2 enumerate_subprograms_transitive by blast
  then obtain op' where op'_def: "op' \<in> set (com_to_operators c\<^sub>1) \<and>
    execute_operator_sas_plus (imp_minus_state_to_sas_plus (c\<^sub>1, s)) op'
        =  imp_minus_state_to_sas_plus (c\<^sub>1', s')
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c\<^sub>1, s)) op'"
    using Seq2 by fastforce
  let ?op = "\<lparr> precondition_of = list_update (precondition_of op') 0 (PC, PCV (c\<^sub>1 ;; c\<^sub>2)),
        effect_of = list_update (effect_of op') 0 (PC, PCV (c\<^sub>1' ;; c\<^sub>2))\<rparr>"
  have "?op \<in> set (com_to_operators (c\<^sub>1 ;; c\<^sub>2))"
    and "execute_operator_sas_plus (imp_minus_state_to_sas_plus ((c\<^sub>1 ;; c\<^sub>2), s)) ?op
        = imp_minus_state_to_sas_plus ((c\<^sub>1' ;; c\<^sub>2), s')"
    and "is_operator_applicable_in (imp_minus_state_to_sas_plus ((c\<^sub>1 ;; c\<^sub>2), s)) ?op"
    using Seq2 op'_def imp_minus_state_to_sas_plus_of_effect imp_minus_state_to_sas_plus_of_effect'
    by auto
  then show ?case using Seq2 by blast
next
  case (IfTrue bs s c\<^sub>1 c\<^sub>2)
  have "set bs \<subseteq> set (enumerate_variables c)"
    using IfTrue enumerate_subprograms_enumerate_variables by fastforce
  hence "\<forall>b \<in> set bs. \<exists>y. s b = Some y" using \<open>dom s = set (enumerate_variables c)\<close> by auto
  then show ?case using IfTrue by (auto simp: Let_def)
next
  case (IfFalse bs s c\<^sub>1 c\<^sub>2)
  hence "set bs \<subseteq> set (enumerate_variables c)"
    using enumerate_subprograms_enumerate_variables by fastforce
  thus ?case using IfFalse
    by(auto simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
next
  case (WhileTrue bs s c1)
  hence "set bs \<subseteq> set (enumerate_variables c)"
    using  enumerate_subprograms_enumerate_variables by fastforce
  then show ?case using WhileTrue
    by(force simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
next
  case (WhileFalse bs s c1)
   hence "set bs \<subseteq> set (enumerate_variables c)"
    using  enumerate_subprograms_enumerate_variables by fastforce
  then show ?case using WhileFalse
    by(force simp: Let_def map_leq_imp_minus_state_to_sas_plus_iff all_zero_than_zero_map_le)
qed auto

text \<open> Next, we show that taking multiple steps in IMP-- corresponds to executing multiple
      operations in SAS++ \<close>

lemma imp_minus_minus_to_sas_plus_plus_aux:
   "(c1, is1) \<rightarrow>\<^bsup>t\<^esup> (c2, is2)
  \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom is1 = set (enumerate_variables c)
  \<Longrightarrow> (\<exists>ops. set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ops = t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) ops)
        = imp_minus_state_to_sas_plus (c2, is2))"
proof (induction t arbitrary: c1 is1)
  case (Suc t)
  obtain c1' is1' where c1'_def: "(c1, is1) \<rightarrow> (c1', is1')
    \<and> (c1', is1') \<rightarrow>\<^bsup>t\<^esup> (c2, is2)" using Suc by auto
  then obtain op where op_def: "op \<in> set (com_to_operators c1)
    \<and> execute_operator_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) op
        =  imp_minus_state_to_sas_plus (c1', is1')
    \<and> is_operator_applicable_in (imp_minus_state_to_sas_plus (c1, is1)) op"
    using imp_minus_minus_to_sas_plus_plus_single_step Suc by metis
  then have "dom is1' = set (enumerate_variables c)"
    using c1'_def Suc step_doesnt_add_variables
     apply (auto simp: domIff)
    by (metis domD domIff option.simps(3) step_doesnt_add_variables)+
  moreover have "c1' \<in> set (enumerate_subprograms c)" using c1'_def enumerate_subprograms_transitive
    enumerate_subprograms_complete_step
    using Suc.prems by blast+
  ultimately obtain ops where ops_def: "set ops \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ops = t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1', is1')) ops)
        = imp_minus_state_to_sas_plus (c2, is2)"
    using Suc c1'_def Suc_lessD by blast
  let ?ops' = "op # ops"
  have "set ?ops' \<subseteq> set ((imp_minus_minus_to_sas_plus c I G)\<^sub>\<O>\<^sub>+)
     \<and> length ?ops' = Suc t
     \<and> (execute_serial_plan_sas_plus (imp_minus_state_to_sas_plus (c1, is1)) ?ops')
        = imp_minus_state_to_sas_plus (c2, is2)"
    using Suc c1'_def op_def ops_def
    by (auto simp: imp_minus_minus_to_sas_plus_def Let_def coms_to_operators_def)
  then show ?case by blast
qed auto

text \<open> In the previous correctness lemmas, we formulated the statements as to permit arbitrary
       initial and final states that could occur sometime during the execution. We now proceed
       to reformulate them in simpler terms, using the initial initial and final states as specified
       in the SAS++ problem translated from IMP--. \<close>

lemma imp_minus_minus_to_sas_plus_plus:
  assumes "(c, is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, is2)"
   "dom is1 = set (enumerate_variables c)"
   "I \<subseteq>\<^sub>m is1"
   "G \<subseteq>\<^sub>m is2"
   "t \<le> t'"
  shows "(\<exists>plan.
     is_serial_solution_for_problem_sas_plus_plus (imp_minus_minus_to_sas_plus c I G) plan
     \<and> length plan \<le> t')"
proof -
  let ?\<Psi> = "imp_minus_minus_to_sas_plus c I G"
  let ?I' = "imp_minus_state_to_sas_plus (c, is1)"
  obtain plan where plan_def: "set plan \<subseteq> set ((?\<Psi>)\<^sub>\<O>\<^sub>+)
     \<and> length plan = t
     \<and> (execute_serial_plan_sas_plus ?I' plan)
        = imp_minus_state_to_sas_plus (SKIP, is2)"
    using imp_minus_minus_to_sas_plus_plus_aux[OF assms(1)] assms c_in_all_subprograms_c by blast
  moreover then have "(?\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_serial_plan_sas_plus ?I' plan"
    and "dom ?I' = set (((?\<Psi>))\<^sub>\<V>\<^sub>+)"
    and "(\<forall> v \<in> set ((?\<Psi>)\<^sub>\<V>\<^sub>+). the (?I' v) \<in> range_of' ?\<Psi> v)"
    and "((?\<Psi>)\<^sub>I\<^sub>+) \<subseteq>\<^sub>m ?I'"
    using assms plan_def c_in_all_subprograms_c
    apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def
        range_of'_def imp_minus_state_to_sas_plus_def map_comp_def map_le_def)
        apply (auto split: option.splits variable.splits)
    by (metis domIff option.distinct option.inject)+
  ultimately have "is_serial_solution_for_problem_sas_plus_plus ?\<Psi> plan"
    using assms
    by(auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def list_all_def ListMem_iff)
  then show ?thesis using plan_def \<open>t \<le> t'\<close>
    by blast
qed

lemma sas_plus_plus_to_imp_minus_minus:
  assumes "is_serial_solution_for_problem_sas_plus_plus (imp_minus_minus_to_sas_plus c I G) plan"
    "EV ` (ran I) \<subseteq> set domain"
    "EV ` (ran G) \<subseteq> set domain"
  shows "\<exists>is1 is2 t. (I|` set (enumerate_variables c)) \<subseteq>\<^sub>m is1 \<and> dom is1 = set (enumerate_variables c)
    \<and> (G|` set (enumerate_variables c)) \<subseteq>\<^sub>m is2 \<and> t \<le> length plan
    \<and> (c, is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, is2)"
proof -
  let ?\<Psi> = "imp_minus_minus_to_sas_plus c I G"
  obtain I' where I'_def: "((?\<Psi>)\<^sub>I\<^sub>+) \<subseteq>\<^sub>m I' \<and> dom I' = set ((?\<Psi>)\<^sub>\<V>\<^sub>+)
        \<and> (\<forall>v \<in> set ((?\<Psi>)\<^sub>\<V>\<^sub>+). the (I' v) \<in> range_of' ?\<Psi> v)
        \<and> ((?\<Psi>)\<^sub>G\<^sub>+) \<subseteq>\<^sub>m execute_serial_plan_sas_plus I' plan"
    using assms by (auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def)
  let ?ss2 = "execute_serial_plan_sas_plus I' plan"
  let ?is1 = "snd (sas_plus_state_to_imp_minus I')"
  let ?is2 = "snd (sas_plus_state_to_imp_minus ?ss2)"
  have "\<forall>v\<in>set (enumerate_variables c). (\<exists>y \<in> set domain. I' (VN v) = Some y)" using I'_def
    apply (auto simp: imp_minus_minus_to_sas_plus_def Let_def range_of'_def)
    by (metis domIff image_insert insertI1 insertI2 mk_disjoint_insert option.collapse)
  then have "sane_sas_plus_state I'" using I'_def assms
    apply (auto simp: sane_sas_plus_state_def imp_minus_minus_to_sas_plus_def Let_def map_le_def
         range_of'_def)
    by (metis domIff insertI1 option.collapse)
  then obtain t where t_def: "t \<le> length plan \<and> sas_plus_state_to_imp_minus I'
    \<rightarrow>\<^bsup>t\<^esup> sas_plus_state_to_imp_minus ?ss2"
    apply - apply(rule exE[OF sas_plus_plus_to_imp_minus_minus_aux[where ?ops=plan]])
    using assms I'_def
    by(auto simp: is_serial_solution_for_problem_sas_plus_plus_def Let_def list_all_def ListMem_iff)

  moreover have "fst (sas_plus_state_to_imp_minus I') = c"
    and "fst (sas_plus_state_to_imp_minus ?ss2) = SKIP"
    using assms I'_def apply(auto simp: imp_minus_minus_to_sas_plus_def Let_def
         sas_plus_state_to_imp_minus_def map_le_def imp_minus_state_to_sas_plus_def
        sane_sas_plus_state_def)
    by (metis (no_types, lifting) domain_element.inject domain_element.simps option.sel
        option.inject variable.simps)+
  ultimately have "((c, ?is1) \<rightarrow>\<^bsup>t\<^esup> (SKIP, ?is2))"
    using I'_def by (metis prod.collapse)
  moreover have "(I|` set (enumerate_variables c)) \<subseteq>\<^sub>m ?is1"
    "(G|` set (enumerate_variables c)) \<subseteq>\<^sub>m ?is2"
    using assms(2) I'_def
    by (auto simp: imp_minus_minus_to_sas_plus_def imp_minus_state_to_sas_plus_map_le_then Let_def
        range_of'_def)
  moreover have "dom ?is1 = set (enumerate_variables c)"
    using \<open>sane_sas_plus_state I'\<close> I'_def by(auto simp: imp_minus_minus_to_sas_plus_def
        dom_snd_sas_plus_state_to_imp_minus Let_def)
  ultimately show ?thesis using I'_def t_def by auto
qed

end


theory HEAP01ReifyProofs
imports HEAP01ReifyLemmas
begin

(*========================================================================*)
section {* Refinement L0-L1 proof *}
(*========================================================================*)

(* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
subsubsection {* Adequacy proof *}
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(*
lemma "F0_inv f0 \<Longrightarrow> \<exists> f1  . F1_inv f1 \<and> f0 = retr0 f1"
unfolding retr0_def F1_inv_def F0_inv_def
thm finite_induct[of f0 "(\<lambda> x . \<exists> f1  . F1_inv f1 \<and> x = retr0 f1)"]
apply (rule finite_induct)
apply simp
apply (rule_tac x=empty in exI)
apply (metis l_nat1_map_empty l_disjoint_empty l_finite_empty l_locs_empty_iff l_sep_empty)
apply (elim conjE exE)
apply simp
apply (rule_tac x=f1 in exI)
apply simp
oops

lemma "F0_inv f0 \<Longrightarrow> \<exists> f1  . F1_inv f1 \<and> f0 = retr0 f1"
unfolding retr0_def F1_inv_def F0_inv_def
apply (rule exI)
apply (intro conjI)
prefer 5
unfolding locs_def
apply (simp_all)
apply (rule finite_map_upd_induct)
oops
*)

(*
lemma r_l01_retr_adequacy:
   "PO_l01_adequacy"
unfolding PO_l01_adequacy_def F0_inv_def
apply auto -- this doesn't allow me to call the inductive rule, why? TODO: Ask Iain?
*)

theorem r_l01_retr_adequacy:
   "PO_l01_adequacy"
unfolding PO_l01_adequacy_def F0_inv_def
find_theorems simp:"\<exists>! _ . _" intro --"ex1I isn't quite right"
apply (intro allI impI ex_ex1I)
defer
apply (metis F1_inv_def l_locs_ext retr0_def)
apply (induct_tac rule: contig_nonabut_finite_set_induct) (* Aha! Needs to be induct_tac because of the \<And> f0 ! *)
apply assumption
apply (rule_tac x=empty in exI)
apply (rule conjI)
apply (metis l_locs_empty_iff retr0_def)
apply (metis l_F1_inv_empty)
apply (elim conjE exE)
  (*apply (rule_tac x="f1(Min(F') \<mapsto> card F')" in exI)*)
apply (rule_tac x="f1 \<union>m [Min F' \<mapsto> card F']" in exI)
apply (subgoal_tac "Min F' \<notin> dom f1")
  defer
  apply (metis l_disjoint_retr0_not_in_dom f_F1_inv_nat1_map)

  (* choice of witness *)
  apply (rule conjI)
  unfolding retr0_def
  apply (subst l_locs_munion_iff)
    apply (metis f_F1_inv_nat1_map)
    apply (metis l_nat1_map_singleton l_nat1_card)
    find_theorems "locs [_ \<mapsto> _]"
    apply simp
    apply (subst l_locs_singleton_iff)
      apply (metis l_nat1_card)
    thm b_contiguous_locs_off_iff
    apply (simp add: b_contiguous_locs_off_iff)

  (* invariant over chosen witness *)
  apply (rule l_F1_inv_singleton_upd)
    apply (simp add: card_gt_0_iff)
    apply simp
    apply simp
    apply (simp add: b_contiguous_locs_off_iff retr0_def l_disjoint_comm)
    apply (frule_tac[!] f_F1_inv_nat1_map)

    unfolding sep0_def
    apply (rule ballI)
    apply simp

    unfolding contiguous_def
    apply (frule_tac f=f1 and x=l in f_nat1_map_nat1_elem,simp)
    apply (erule_tac[!] exE)+
    apply (erule_tac[!] conjE)
    apply (rule notI)
    find_theorems simp:"disjoint _ _"
    apply (simp_all add: l_locs_of_min l_locs_of_card)

    unfolding non_abutting_def
    find_theorems "_ \<in> dom _ \<Longrightarrow> _ \<in> locs _"
    apply (frule_tac x=l and f=f1 in f_in_dom_locs,simp)
    apply (erule_tac x=m in ballE)
    apply (erule_tac x="l+ ((the (f1 l)))" in ballE)
    apply (simp_all add: l_locs_of_itself)

    apply (frule_tac f=f1 and x=l in f_nat1_map_nat1_elem,simp)

    defer
    apply (rule notI)
    apply (frule_tac x="m+l" and f=f1 in f_in_dom_locs,simp)
    apply (erule_tac)
    find_theorems "(_ + _) \<notin> dom _"
    apply (subst l_disjoint_mapupd_keep_sep)
      apply simp
      apply (simp add: f_F1_inv_disjoint)
    find_theorems name:ind name:Nat
    apply (erule_tac n="the(f l)" in nat_induct)
    apply simp
    find_theorems "_ \<in> locs_of _ _"

    apply simp_all
    apply (erule disjE)

    unfolding disjoint_def
    find_theorems "locs_of _ _ \<inter> locs _"
    apply (simp add: k_inter_locs_iff f_F1_inv_nat1_map)
    apply (erule_tac x=l in ballE,simp_all)
    apply (simp add: disjoint_iff_not_equal)
    (*
    find_theorems "the(_ ) > 0"
    apply (frule f_F1_inv_nat1_map)
    apply (frule_tac f=f1 and x=l in f_nat1_map_nat1_elem)
    apply (simp add: b_locs_of_as_set_interval)
    *)
    apply (erule_tac x=m in ballE)
    apply (erule_tac x=l in ballE)
    apply simp_all
    apply (rule notI)
    apply simp
    apply (elim notE)

    find_theorems "locs_of _ _ = _"
    apply (frule f_F1_inv_sep)
    unfolding sep_def
    apply (erule_tac x=l in ballE)
    apply simp_all

    (* see IJW sep_non_abutt and its uses *)

    (* abuttiness goal is the last one to go... argh *)
oops

(* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
subsubsection {* Pre/post refinement proof *}
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(* see IJWv2 widen pre *)
lemma r_free01_widen_pre:
  "PO_l01_new_widen_pre"

unfolding PO_l01_new_widen_pre_def new1_pre_def new0_pre_def is_block_def retr0_def
apply safe
apply (rename_tac k)
find_theorems simp:"_ \<subseteq> _"
apply (simp add: subset_eq)
apply (erule_tac x=k in ballE)
apply (simp_all add: l_locs_of_itself)
apply (frule f_F1_inv_nat1_map)
find_theorems simp:"_ \<in> locs _"
apply (simp add: k_in_locs_iff)
apply (erule bexE)
apply (case_tac "k \<noteq> y")
apply (case_tac "k \<in> dom f1")
apply (rule_tac x=k in bexI,simp_all)
unfolding locs_of_def
apply (simp add: f_nat1_map_nat1_elem)

apply (rule_tac x=y in bexI,simp_all)
nitpick
(* IJWs *)
apply (rule_tac x=k in bexI)
apply (rule locs_subset_free1_map)
apply simp
apply (simp add: nat1)
apply (simp only: inv)
apply simp

(* Leos *)
apply (elim exE conjE)
find_theorems simp:"_ \<subseteq> _"
apply (simp add: subset_eq)
find_theorems "_ \<in> locs _"
apply (simp add: k_in_locs_iff f_F1_inv_nat1_map)
apply (erule_tac x=l in allE)
apply (elim impE)
apply simp
apply (elim bexE)
apply (frule f_F1_inv_nat1_map)
apply (frule f_nat1_map_nat1_elem)
apply simp
apply (rule_tac x=y in bexI)
apply simp_all
unfolding locs_of_def
apply simp
apply (erule conjE)
nitpick
oops

lemma r_free01_narrow_post:
  "F1_inv f1 \<Longrightarrow> F1_inv f1' \<Longrightarrow> nat1 s1 \<Longrightarrow> new0_pre (retr0 f1) s1 \<Longrightarrow>
      new1_post f1 s1 f1' r \<Longrightarrow> new0_post (retr0 f1) s1 (retr0 f1') r"
sorry
(* see IJWv2 narrow post *)

end


subsection \<open>1-out-of-4 OT to GMW\<close>

text\<open>We prove security for the gates of the GMW protocol in the semi honest model. We assume security on
1-out-of-4 OT.\<close>

theory GMW imports
  Semi_Honest
begin
(*TODO: secret sharing scheme stuff got taken out*)
datatype gmw_outputs = Q bool

datatype inputs_ot12 = M2 "(bool \<times> bool)" | C1 bool

datatype outputs_ot = P bool | U unit

fun K where "K (P x) = Q x"

fun xor :: "outputs_ot \<Rightarrow> outputs_ot \<Rightarrow> bool"
  where "xor (P a) (P b) = a \<oplus> b"

fun f_ot12 :: "inputs_ot12 list \<Rightarrow> (outputs_ot list)"
  where "f_ot12 [M2 (m0,m1), C1 \<sigma>] =  [U (), if \<sigma> then (P m1) else (P m0)]"

fun valid_inputs_ot12 :: "inputs_ot12 list \<Rightarrow> bool"
  where "valid_inputs_ot12 [M2 (b0, b1), C1 \<sigma>] = True"

datatype inputs_ot14 = M4 "(bool \<times> bool \<times> bool \<times> bool)" | C2 "(bool \<times> bool)"

fun f_ot14 :: "inputs_ot14 list \<Rightarrow> (outputs_ot list)"
  where "f_ot14 [M4 (m00, m01, m10, m11), C2 (c0,c1)]
              = ([U (), if c0 then (if c1 then P (m11) else (P m10)) else (if c1 then (P m01) else (P m00))])"

fun valid_inputs_ot14 :: "inputs_ot14 list \<Rightarrow> bool"
  where "valid_inputs_ot14 [M4 (m00, m01, m10, m11), C2 (c0,c1)] = True"

type_synonym share_1 = bool
type_synonym share_2 = bool

type_synonym shares_1 = "bool list"
type_synonym shares_2 = "bool list"

type_synonym share_wire = "(share_1 \<times> share_2)"

type_synonym gmw_inputs = "share_wire"

type_synonym input1 = "bool \<times> bool \<times> bool \<times> bool"
type_synonym input2 = "bool \<times> bool"
type_synonym 'ot12_view1' view1 = "(inputs_ot14 \<times> (bool \<times> bool \<times> bool \<times> bool \<times> bool \<times> bool) \<times> 'ot12_view1' \<times> 'ot12_view1' \<times> 'ot12_view1')"
type_synonym 'ot12_view2' view2 = "(inputs_ot14 \<times> (bool \<times> bool \<times> bool \<times> bool) \<times> 'ot12_view2' \<times> 'ot12_view2' \<times> 'ot12_view2')"

locale gmw =   ot14: semi_honest_det_correctness f_ot14 protocol_ot14 valid_inputs_ot14
  + ot14_1: semi_honest_det_security f_ot14 protocol_ot14 valid_inputs_ot14 0 R1_OT14 S1_OT14
  + ot14_2: semi_honest_det_security f_ot14 protocol_ot14 valid_inputs_ot14 1 R2_OT14 S2_OT14
  for R1_OT14 :: "inputs_ot14 list \<Rightarrow> 'ot14_view1 spmf"
    and S1_OT14
    and R2_OT14 :: "inputs_ot14 list \<Rightarrow> 'ot14_view2 spmf"
    and  S2_OT14 protocol_ot14
    +
  fixes ot14_adv_P1 :: real
  assumes ot14_advantage_P1: "ot14_1.advantage [M4 (m00, m01, m10, m11), C2 (c0,c1)] D \<le> ot14_adv_P1"
    and ot14_perfect_security_P2: "ot14_2.perfect_security [M4 (m00, m01, m10, m11), C2 (c0,c1)]"
    and ot14_correct: "ot14.correctness [M4 (m00, m01, m10, m11), C2 (c0,c1)]"
begin

lemma ot14_correct_unfold: "\<forall> c0 c1 m00 m01 m10 m11. protocol_ot14 [M4 (m00, m01, m10, m11), C2 (c0,c1)] =  return_spmf (f_ot14 [M4 (m00, m01, m10, m11), C2 (c0,c1)])"
  using ot14_correct unfolding ot14.correctness_def by auto

lemma inf_th_14_OT_P4: "ot14_2.real_view [M4 (m00, m01, m10, m11), C2 (c0,c1)] = (return_spmf (f_ot14 [M4 (m00, m01, m10, m11), C2 (c0,c1)]) \<bind> (\<lambda> outputs_ot. ot14_2.ideal_view (C2 (c0,c1)) (nth outputs_ot 1)))"
  using ot14_perfect_security_P2[unfolded ot14_2.perfect_security_def] by auto

lemma ass_adv_14_OT: "\<bar>spmf (bind_spmf (ot14_1.ideal_view (M4 (m00, m01, m10, m11)) (U())) (\<lambda> view. (D view))) True -
                    spmf (bind_spmf (ot14_1.real_view [M4 (m00, m01, m10, m11), C2 (c0,c1)]) (\<lambda> view. (D view))) True \<bar> \<le> ot14_adv_P1"
  using ot14_advantage_P1 unfolding ot14_1.advantage_def
  by (simp add: abs_minus_commute)

text \<open>The sharing scheme\<close>

definition share :: "bool \<Rightarrow> share_wire spmf"
  where "share x = do {
    a\<^sub>1 \<leftarrow> coin_spmf;
    let b\<^sub>1 = x \<oplus> a\<^sub>1;
    return_spmf (a\<^sub>1, b\<^sub>1)}"

lemma lossless_share [simp]: "lossless_spmf (share x)"
  by(simp add: share_def)

definition reconstruct :: "(share_1 \<times> share_2) \<Rightarrow> bool spmf"
  where "reconstruct shares = do {
    let (a,b) = shares;
    return_spmf (a \<oplus> b)}"

lemma lossless_reconstruct [simp]: "lossless_spmf (reconstruct s)"
  by(simp add: reconstruct_def split_def)

lemma reconstruct_share : "(bind_spmf (share x) reconstruct) = (return_spmf x)"
proof-
  have "y = (y = x) = x" for y by auto
  thus ?thesis
    by(auto simp add: share_def reconstruct_def bind_spmf_const eq_commute)
qed

lemma "(reconstruct (s1,s2) \<bind> (\<lambda> rec. share rec \<bind> (\<lambda> shares. reconstruct shares))) = return_spmf (s1 \<oplus> s2)"
  apply(simp add: reconstruct_share reconstruct_def share_def)
  apply(cases s1; cases s2) by(auto simp add: bind_spmf_const)

definition xor_evaluate ::  "bool \<Rightarrow> bool \<Rightarrow> bool spmf"
  where "xor_evaluate A B = return_spmf (A \<oplus> B)"

fun xor_funct :: "share_wire list \<Rightarrow> bool list"
  where "xor_funct [A,B] = do {
    let (a1, b1) = A;
    let (a2, b2) = B;
    [a1 \<oplus> a2, b1 \<oplus> b2]}"

fun xor_protocol :: "share_wire list \<Rightarrow> bool list spmf"
  where "xor_protocol [A,B] = do {
    let (a1, b1) = A;
    let (a2, b2) = B;
    return_spmf ([a1 \<oplus> a2, b1 \<oplus> b2])}"

fun valid_inptuts_xor where "valid_inptuts_xor [(a1, b1),(a2,b2)] = True"

lemma share_xor_reconstruct:
  shows "share x \<bind> (\<lambda> w1. share y \<bind> (\<lambda> w2. xor_protocol [w1, w2]
              \<bind> (\<lambda> outputs. reconstruct (nth outputs 0, nth outputs 1)))) = xor_evaluate x y"
proof-
  have "(ya = (\<not> yb)) = ((x = (\<not> ya)) = (y = (\<not> yb))) = (x = (\<not> y))" for ya yb
    by auto
  then show ?thesis
    by(simp add: share_def reconstruct_def xor_evaluate_def bind_spmf_const)
qed

fun R1_xor :: "share_wire list \<Rightarrow> (bool \<times> bool) spmf"
  where "R1_xor [A, B] = return_spmf A"

definition S1_xor :: "share_wire \<Rightarrow> bool \<Rightarrow> (bool \<times> bool) spmf"
  where "S1_xor A out  = return_spmf A"

fun  R2_xor :: "share_wire list \<Rightarrow> (bool \<times> bool) spmf"
  where "R2_xor [A, B] = return_spmf B"

definition S2_xor :: "share_wire \<Rightarrow> bool \<Rightarrow> (bool \<times> bool) spmf"
  where "S2_xor B out  = return_spmf B"

lemma lossless_S2_xor: "lossless_spmf (S2_xor A out)"
  by(simp add: S2_xor_def)

sublocale gmw_xor_correct: semi_honest_det_correctness xor_funct xor_protocol valid_inptuts_xor .

theorem correct_xor: "gmw_xor_correct.correctness [A,B]"
  unfolding gmw_xor_correct.correctness_def
  by (simp add: split_def)

sublocale gmw_xor_1: semi_honest_det_security xor_funct xor_protocol valid_inptuts_xor 0 R1_xor S1_xor .

sublocale gmw_xor_2: semi_honest_det_security xor_funct xor_protocol valid_inptuts_xor 1 R2_xor S2_xor .

lemma "gmw_xor_1.perfect_security [s1, s2]"
  using gmw_xor_1.perfect_security_def
  by (simp add: S1_xor_def gmw_xor_1.ideal_view_def gmw_xor_1.real_view_def)

lemma "gmw_xor_2.perfect_security [s1, s2]"
  using gmw_xor_2.perfect_security_def[of "[s1, s2]"]
  by (auto simp add: split_def S2_xor_def gmw_xor_2.ideal_view_def gmw_xor_2.real_view_def semi_honest_det_security.real_view_def)

fun and_funct :: "share_wire list \<Rightarrow> (gmw_outputs list) spmf"
  where "and_funct [A, B] = do {
    let (a1, a2) = A;
    let (b1,b2) = B;
    \<sigma> \<leftarrow> coin_spmf;
    return_spmf ([Q \<sigma>, Q(\<sigma> \<oplus> ((a1 \<oplus> b1) \<and> (a2 \<oplus> b2)))])}"

fun valid_inputs_and where "valid_inputs_and [A, B] = True"

definition and_evaluate :: "bool \<Rightarrow> bool \<Rightarrow> bool spmf"
  where "and_evaluate A B  = return_spmf (A \<and> B)"

fun and_protocol :: "share_wire list \<Rightarrow> (gmw_outputs list) spmf"
  where "and_protocol [A, B] = do {
    let (a1, b1) = A;
    let (a2,b2) = B;
    \<sigma> :: bool \<leftarrow> coin_spmf;
    let s0 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (b1 \<oplus> False));
    let s1 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (b1 \<oplus> True));
    let s2 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (b1 \<oplus> False));
    let s3 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (b1 \<oplus> True));
    outputs :: outputs_ot list \<leftarrow> protocol_ot14 [M4 (s0,s1,s2,s3), C2 (a2,b2)];
    return_spmf ([Q \<sigma>, K (nth outputs 1)])}"

lemma and_correct: "and_protocol [(a1, b1), (a2,b2)] = and_funct [(a1, b1), (a2,b2)]"
  apply(auto simp add: ot14_correct)
  by(cases b2 ; cases b1; cases a1; cases a2; auto simp add:  ot14_correct_unfold)

fun  and_R1 :: "gmw_inputs list \<Rightarrow> (( bool \<times> 'ot14_view1)) spmf"
  where "and_R1 [A, B] = do {
    let (a1, a2) = A;
    let (b1,b2) = B;
    \<sigma> \<leftarrow> coin_spmf;
    let s0 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False));
    let s1 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True));
    let s2 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False));
    let s3 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True));
    V :: 'ot14_view1 \<leftarrow> R1_OT14 [M4 (s0,s1,s2,s3), C2 (b1,b2)];
    return_spmf ((\<sigma>, V))}"

fun and_outputs_1 :: "gmw_inputs list \<Rightarrow> (bool \<times> 'ot14_view1) \<Rightarrow> (gmw_outputs list) spmf"
  where "and_outputs_1 [A, B] view = do {
            let (\<sigma>, v) = view;
            let (a1, a2) = A;
            let (b1,b2) = B;
            let s0 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False));
            let s1 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True));
            let s2 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False));
            let s3 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True));
            outputs :: outputs_ot list \<leftarrow> protocol_ot14 [M4 (s0,s1,s2,s3), C2 (b1,b2)];
            return_spmf ([Q \<sigma>, K (nth outputs 1)])}"

fun and_outputs_2 :: "gmw_inputs list \<Rightarrow> ('ot14_view2 \<times> bool) \<Rightarrow> (gmw_outputs list) spmf"
  where "and_outputs_2 [A, B] view = do {
            let (v, s) = view;
            let (a1, a2) = A;
            let (b1,b2) = B;
            let \<sigma> = s \<oplus> ((a1 \<oplus> b1) \<and> (a2 \<oplus> b2));
            return_spmf ([Q \<sigma>, Q s])}"

fun S1_and :: "gmw_inputs \<Rightarrow> gmw_outputs \<Rightarrow> ((bool \<times> 'ot14_view1)) spmf"
  where "S1_and A (Q \<sigma>) = do {
    let (a1,a2) = A;
    let s0 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False));
    let s1 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True));
    let s2 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False));
    let s3 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True));
    V \<leftarrow> S1_OT14 (M4 (s0,s1,s2,s3)) (U ());
    return_spmf (\<sigma>, V)}"

sublocale gmw_and_1: semi_honest_prob 0 and_funct and_outputs_1 and_R1 S1_and valid_inputs_and  .

lemma sec_ex_P1_and:
  shows "\<exists> (A :: (inputs_ot14 \<times> 'ot14_view1) \<Rightarrow> bool \<Rightarrow> bool spmf).
          \<bar>spmf ((gmw_and_1.real_view [(a1,a2),(b1,b2)]) \<bind> D) True - spmf ((gmw_and_1.ideal_view [(a1,a2),(b1,b2)]
            \<bind> (D :: ((bool \<times> bool) \<times> (bool \<times> 'ot14_view1) \<times> gmw_outputs list) \<Rightarrow> bool spmf))) True\<bar> =
              \<bar>spmf (coin_spmf \<bind> (\<lambda> \<sigma> :: bool. ot14_1.real_view [(M4 ((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True))))), (C2 (b1, b2))]
                    \<bind> (\<lambda> view. A view \<sigma>))) True - spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.ideal_view (M4((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True))))) (U ())
                \<bind>  (\<lambda> view. A view \<sigma>))) True \<bar>"
  including monad_normalisation
proof-
  define A' :: "((inputs_ot14 \<times> 'ot14_view1)) \<Rightarrow> bool \<Rightarrow> bool spmf"
    where "A' == \<lambda> (inputs, view) \<sigma>.  (D ((a1,a2), (\<sigma>, view), [Q \<sigma>, Q (\<sigma> \<oplus> ((a1 \<oplus> b1) \<and> (a2 \<oplus> b2)))]))"
  have "\<bar>spmf ((gmw_and_1.real_view [(a1,a2),(b1,b2)]) \<bind> (D)) True - spmf ((gmw_and_1.ideal_view [(a1,a2),(b1,b2)]
          \<bind> (D))) True\<bar> =
              \<bar>spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.real_view [M4((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True)))), C2 (b1, b2)]
                  \<bind> (\<lambda> view. A' view \<sigma>))) True - spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.ideal_view ((M4 ((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True)))))) (U ())
                \<bind>  (\<lambda> view. A' view \<sigma>))) True\<bar>"
    by(auto simp add: ot14_1.real_view_def ot14_1.ideal_view_def semi_honest_prob.ideal_view_def gmw_and_1.real_view_def  A'_def   Let_def split_def ot14_correct_unfold ; cases a1; cases a2; cases b1; cases b2; auto)
    then show ?thesis by auto
qed

lemma bound_14_OT:
  "\<bar>spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.real_view [M4 ((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True)))), C2 (b1, b2)]
              \<bind> (\<lambda> view. A view \<sigma>))) True - spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.ideal_view (M4 ((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True))))) (U ())
        \<bind>  (\<lambda> view. (A :: (inputs_ot14 \<times> 'ot14_view1) \<Rightarrow> bool \<Rightarrow> bool spmf) view \<sigma>))) True\<bar> \<le> ot14_adv_P1"
  (is "?lhs \<le> ot14_adv_P1")
proof-
  have int1: "integrable (measure_spmf coin_spmf) (\<lambda>x. spmf (ot14_1.ideal_view (M4 (x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> True), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> True))) (U ()) \<bind> (\<lambda>view. A view x)) True)"
    and int2: "integrable (measure_spmf coin_spmf) (\<lambda>x. spmf (ot14_1.real_view [M4 (x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> True), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> True)), C2 (b1, b2)] \<bind> (\<lambda>view. A view x)) True)"
    by(rule measure_spmf.integrable_const_bound[where B=1]; simp add: pmf_le_1)+
  have "?lhs = \<bar>LINT x|measure_spmf coin_spmf.
        spmf (ot14_1.ideal_view (M4 (x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> True), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> True))) (U ()) \<bind> (\<lambda>view. A view x)) True -
        spmf (ot14_1.real_view [(M4 (x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> False \<and> a2 \<oplus> True), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> False), x \<oplus> (a1 \<oplus> True \<and> a2 \<oplus> True))), C2 (b1, b2)] \<bind> (\<lambda>view. A view x)) True\<bar>"
    apply(subst (1 2) spmf_bind) using int1 int2 by simp
  also have "... \<le> LINT x|measure_spmf coin_spmf. \<bar>spmf (ot14_1.ideal_view (M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2))) (U ()) \<bind> (\<lambda>view. A view x)) True
                - spmf (ot14_1.real_view [M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2)), C2 (b1, b2)] \<bind> (\<lambda>view. A view x)) True\<bar>"
    by(rule integral_abs_bound[THEN order_trans]; simp add: split_beta)
  ultimately have "?lhs \<le> LINT x|measure_spmf coin_spmf. \<bar>spmf (ot14_1.ideal_view (M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2))) (U ()) \<bind> (\<lambda>view. A view x)) True
                - spmf (ot14_1.real_view [M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2)), C2 (b1, b2)] \<bind> (\<lambda>view. A view x)) True\<bar>"
    by simp
  also have "LINT x|measure_spmf coin_spmf. \<bar>spmf (ot14_1.ideal_view (M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2))) (U ()) \<bind> (\<lambda>view. A view x)) True
                - spmf (ot14_1.real_view [M4 (x = (a1 \<longrightarrow> \<not> a2), x = (a1 \<longrightarrow> a2), x = (a1 \<or> \<not> a2), x = (a1 \<or> a2)), C2 (b1, b2)] \<bind> (\<lambda>view. A view x)) True\<bar> \<le> ot14_adv_P1"
    apply(rule integral_mono[THEN order_trans])
       apply(rule measure_spmf.integrable_const_bound[where B=2])
        apply clarsimp
        apply(rule abs_triangle_ineq4[THEN order_trans])
        apply(cases a1) apply(cases a2)
    subgoal for M
      using pmf_le_1[of "ot14_1.real_view [M4 (\<not> M, M, M, M), C2 (b1,b2)] \<bind>  (\<lambda> view. A view M)" "Some True"]
        pmf_le_1[of "ot14_1.ideal_view (M4 (\<not> M, M, M, M)) (U ()) \<bind>  (\<lambda> view. A view M)" "Some True"]
      by simp
    subgoal for M
      using pmf_le_1[of "ot14_1.real_view [M4 (M, \<not> M, M, M), C2 (b1,b2)] \<bind>  (\<lambda> view. A view M)" "Some True"]
        pmf_le_1[of "ot14_1.ideal_view (M4 (M, \<not> M, M, M)) (U ()) \<bind>  (\<lambda> view. A view M)" "Some True"]
      by simp
        apply(cases a2) apply(auto)
    subgoal for M
      using pmf_le_1[of "ot14_1.real_view [M4 (M, M, \<not> M, M), C2 (b1,b2)] \<bind>  (\<lambda> view. A view M)" "Some True"]
        pmf_le_1[of "ot14_1.ideal_view (M4 (M, M, \<not> M, M)) (U ()) \<bind>  (\<lambda> view. A view M)" "Some True"]
      by(simp)
    subgoal for M
      using pmf_le_1[of "ot14_1.real_view [M4 (M, M, M, \<not> M), C2 (b1,b2)] \<bind>  (\<lambda> view. A view M)" "Some True"]
        pmf_le_1[of "ot14_1.ideal_view (M4 (M, M, M, \<not> M)) (U ()) \<bind>  (\<lambda> view. A view M)" "Some True"]
      by(simp)
    using ass_adv_14_OT by fast
  ultimately show ?thesis by simp
qed

lemma and_advantage_P1:
  shows "gmw_and_1.advantage [(a1,a2),(b1,b2)] D \<le> ot14_adv_P1"
proof-
  obtain A :: "(inputs_ot14 \<times> 'ot14_view1) \<Rightarrow> bool \<Rightarrow> bool spmf" where "\<bar>spmf ((gmw_and_1.real_view [(a1,a2),(b1,b2)]) \<bind> D) True - spmf ((gmw_and_1.ideal_view [(a1,a2),(b1,b2)]
            \<bind> (D :: ((bool \<times> bool) \<times> (bool \<times> 'ot14_view1) \<times> gmw_outputs list) \<Rightarrow> bool spmf))) True\<bar> =
              \<bar>spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.real_view [(M4 ((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True))))), (C2 (b1, b2))]
                    \<bind> (\<lambda> view. A view \<sigma>))) True - spmf (coin_spmf \<bind> (\<lambda> \<sigma>. ot14_1.ideal_view (M4((\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False))), (\<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True))))) (U ())
                \<bind>  (\<lambda> view. A view \<sigma>))) True\<bar>"
    using sec_ex_P1_and by blast
  thus ?thesis
  unfolding gmw_and_1.advantage_def gmw_and_1.real_view_def gmw_and_1.ideal_view_def using sec_ex_P1_and bound_14_OT by auto
qed

fun and_R2 :: "gmw_inputs list \<Rightarrow> ('ot14_view2 \<times> bool) spmf"
  where "and_R2 [A, B] = do {
    let (a1, a2) = A;
    let (c0,c1) = B;
    \<sigma> \<leftarrow> coin_spmf;
    let m00 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> False));
    let m01 = \<sigma> \<oplus> ((a1 \<oplus> False) \<and> (a2 \<oplus> True));
    let m10 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> False));
    let m11 = \<sigma> \<oplus> ((a1 \<oplus> True) \<and> (a2 \<oplus> True));
    V :: 'ot14_view2 \<leftarrow> R2_OT14 [M4 (m00,m01,m10,m11), C2 B];
    let s = (if c0 then (if c1 then (m11) else (m10)) else (if c1 then (m01) else (m00)));
    return_spmf (V, s)}"

fun S2_and :: "gmw_inputs \<Rightarrow> gmw_outputs \<Rightarrow> ('ot14_view2 \<times> bool) spmf"
  where "S2_and B (Q s2) =  do {
    let (b1,b2) = B;
    V :: 'ot14_view2 \<leftarrow> S2_OT14 (C2 B) (P s2);
    return_spmf (V, s2)}"

sublocale gmw_and_2: semi_honest_prob 1 and_funct and_outputs_2 and_R2 S2_and valid_inputs_and .

lemma 1: " R2_OT14 [M4 (m00, m01, m10, m11), C2 (c0, c1)]
              = return_spmf (f_ot14 [M4 (m00, m01, m10, m11), C2 (c0, c1)])
                  \<bind> (\<lambda> outputs. S2_OT14 (C2 (c0, c1)) (outputs ! 1))"
  using ot14_perfect_security_P2[of m00 m01 m10  m11 c0 c1]
 using ot14_2.views_equal_all by auto

lemma and_perfect_security_P2:
  shows "gmw_and_2.perfect_security [(a1,a2),(b1,b2)]"
  unfolding gmw_and_2.perfect_security_def gmw_and_2.real_view_def gmw_and_2.ideal_view_def
  apply(auto simp add: Let_def)
  apply(intro bind_spmf_cong[OF refl]; clarsimp?)+ using 1
  by(cases b1;cases b2; cases a1; cases a2; auto)

end

locale gmw_asym =
  fixes R1_OT14 :: "nat \<Rightarrow> inputs_ot14 list \<Rightarrow> 'ot14_view1 spmf"
    and S1_OT14 :: "nat \<Rightarrow> inputs_ot14 \<Rightarrow> outputs_ot \<Rightarrow> 'ot14_view1 spmf"
    and R2_OT14 :: "nat \<Rightarrow> inputs_ot14 list \<Rightarrow> 'ot14_view2 spmf"
    and S2_OT14 :: "nat \<Rightarrow> inputs_ot14 \<Rightarrow> outputs_ot \<Rightarrow> 'ot14_view2 spmf"
    and protocol_ot14 :: "nat \<Rightarrow> inputs_ot14 list \<Rightarrow> outputs_ot list spmf"
    and ot14_adv_P1 :: "nat \<Rightarrow> real"
  assumes gmw: "\<And> (n::nat). gmw (R1_OT14 n) (S1_OT14 n) (R2_OT14 n) (S2_OT14 n) (protocol_ot14 n) (ot14_adv_P1 n)"
begin

sublocale gmw "(R1_OT14 n)" "(S1_OT14 n)" "(R2_OT14 n)" "(S2_OT14 n)" "(protocol_ot14 n)" "(ot14_adv_P1 n)"
  by (simp add: gmw)

lemma "gmw_xor_1.perfect_security [s1, s2]"
  unfolding gmw_xor_1.perfect_security_def gmw_xor_1.real_view_def gmw_xor_1.ideal_view_def
  by(auto simp add: split_def S1_xor_def)

lemma "gmw_xor_2.perfect_security [s1, s2]"
  unfolding gmw_xor_2.perfect_security_def gmw_xor_2.real_view_def gmw_xor_2.ideal_view_def
  by(auto simp add: split_def S2_xor_def)

lemma and_advantage_P1:
  assumes "negligible (\<lambda> n. ot14_adv_P1 n)"
  shows "negligible (\<lambda>n.  gmw_and_1.advantage n [(a1,a2),(b1,b2)] D)"
proof-
  have "gmw_and_1.advantage n [(a1,a2),(b1,b2)] D \<le> ot14_adv_P1 n"
    for n
    by (simp add: and_advantage_P1)
  thus ?thesis
    using assms gmw_and_1.advantage_def negligible_le by auto
qed

lemma "gmw_and_2.perfect_security n [(a1,a2),(b1,b2)]"
  by(rule and_perfect_security_P2)

end

end