section {* Correctness of Type Checker *}

theory Wasm_Checker_Properties imports Wasm_Checker Wasm_Properties begin

subsection {* Soundness *}

lemma b_e_check_single_type_sound:
  assumes "type_update (Type x1) (to_ct_list t_in) (Type t_out) = Type x2"
          "c_types_agree (Type x2) tm"
          "\<C> \<turnstile> [e] : (t_in _> t_out)"
  shows "\<exists>tn. c_types_agree (Type x1) tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
  using assms(2) b_e_typing.weakening[OF assms(3)] type_update_type[OF assms(1)]
  by auto

lemma b_e_check_single_top_sound:
  assumes "type_update (TopType x1) (to_ct_list t_in) (Type t_out) = TopType x2"
          "c_types_agree (TopType x2) tm"
          "\<C> \<turnstile> [e] : (t_in _> t_out)"
  shows "\<exists>tn. c_types_agree (TopType x1) tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
proof -
  obtain t_ag where t_ag_def:"ct_suffix (to_ct_list t_out) x2"
                             "tm = t_ag @ t_out"
                             "c_types_agree (TopType x1) (t_ag @ t_in)"
    using type_update_top_top[OF assms(1,2)]
    by fastforce
  hence "\<C> \<turnstile> [e] : (t_ag@t_in _> t_ag@t_out)"
    using b_e_typing.weakening[OF assms(3)]
    by fastforce
  thus ?thesis
    using t_ag_def
    by fastforce
qed

lemma b_e_check_single_top_not_bot_sound:
  assumes "type_update ts (to_ct_list t_in) (TopType []) = ts'"
          "ts \<noteq> Bot"
          "ts' \<noteq> Bot"
  shows "\<exists>tn. c_types_agree ts tn \<and> suffix t_in tn"
proof (cases ts)
  case (TopType x1)
  then obtain t_int where "consume (TopType x1) (to_ct_list t_in) = t_int" "t_int \<noteq> Bot"
    using assms(1,2,3)
    by fastforce
  thus ?thesis
    using TopType ct_suffix_ct_list_compat_exists ct_suffix_ts_conv_suffix
    unfolding consume.simps
    by (metis append_Nil c_types_agree.simps(2) ct_suffix_def)
next
  case (Type x2)
  then obtain t_int where "consume (Type x2) (to_ct_list t_in) = t_int" "t_int \<noteq> Bot"
    using assms(1,2,3)
    by fastforce
  thus ?thesis
    using c_types_agree_id Type consume_type suffixI ct_suffix_ts_conv_suffix
    by fastforce
next
  case Bot
  thus ?thesis
    using assms(2)
    by simp
qed

lemma b_e_check_single_type_not_bot_sound:
  assumes "type_update ts (to_ct_list t_in) (Type t_out) = ts'"
          "ts \<noteq> Bot"
          "ts' \<noteq> Bot"
          "c_types_agree ts' tm"
          "\<C> \<turnstile> [e] : (t_in _> t_out)"
  shows "\<exists>tn. c_types_agree ts tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
  using assms b_e_check_single_type_sound
proof (cases ts)
  case (TopType x1)
  then obtain x1' where x_def:"TopType x1' = ts'"
    using assms
    by (simp, metis (full_types) produce.simps(1) produce.simps(6))
  thus ?thesis
    using assms b_e_check_single_top_sound TopType
    by fastforce
next
  case (Type x2)
  then obtain x2' where x_def:"Type x2' = ts'"
    using assms
    by (simp, metis (full_types) produce.simps(2) produce.simps(6))
  thus ?thesis
    using assms b_e_check_single_type_sound Type
    by fastforce
next
  case Bot
  thus ?thesis
    using assms(2)
    by simp
qed

lemma b_e_check_single_sound_unop_testop_cvtop:
  assumes "check_single \<C> e tn' = tm'"
          "(e = (Unop t uw) \<and> unop_t_agree op t)
           \<or> (e = (Testop t uv) \<and> is_int_t t)
           \<or> (e = (Cvtop t1 Convert t sx) \<and> convert_cond t1 t sx)
           \<or> (e = (Cvtop t1 Reinterpret t sx) \<and> ((t1 \<noteq> t) \<and> t_length t1 = t_length t \<and> sx = None))"
          "c_types_agree tm' tm"
          "tn' \<noteq> Bot"
          "tm' \<noteq> Bot"
 shows "\<exists>tn. c_types_agree tn' tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
proof -
  have "(e = (Cvtop t1 Convert t sx) \<Longrightarrow> convert_cond t1 t sx)"
    using assms(2)
    by simp
  have 1:"type_update tn' (to_ct_list [t]) (Type [arity_1_result e]) = tm'"
    using assms arity_1_result_def
    unfolding to_ct_list_def
    apply (simp del: convert_cond.simps)
    apply fastforce
    done
  have "\<C> \<turnstile> [e] : ([t] _> [arity_1_result e])"
    using assms(2) b_e_typing.intros(2,3,6,9,10)
    unfolding arity_1_result_def
    apply simp
    apply (metis (no_types, lifting) assms(1,5) b_e.simps(801,803,805) b_e_typing.reinterpret b_e_typing.testop check_single.simps(2))
    done
  thus ?thesis
    using b_e_check_single_type_not_bot_sound[OF 1 assms(4,5,3)]
    by fastforce
qed

lemma b_e_check_single_sound_binop_relop:
  assumes "check_single \<C> e tn' = tm'"
          "((e = Binop t iop \<and> binop_t_agree op t)
            \<or> (e = Relop t irop \<and> relop_t_agree irop t))"
          "c_types_agree tm' tm"
          "tn' \<noteq> Bot"
          "tm' \<noteq> Bot"
 shows "\<exists>tn. c_types_agree tn' tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
proof -
  have "type_update tn' (to_ct_list [t,t]) (Type [arity_2_result e]) = tm'"
    using assms arity_2_result_def
    unfolding to_ct_list_def
    by auto
  moreover
  have "\<C> \<turnstile> [e] : ([t,t] _> [arity_2_result e])"
    using assms(2) b_e_typing.intros(4,5,7,8)
    unfolding arity_2_result_def
    by (metis (no_types) assms(1,2,5) b_e.simps(802,804) b_e_typing.relop binop check_single.simps(3))
  ultimately
  show ?thesis
    using b_e_check_single_type_not_bot_sound[OF _ assms(4,5,3)]
    by fastforce
qed

lemma b_e_type_checker_sound:
  assumes "b_e_type_checker \<C> es (tn _> tm)"
  shows "\<C> \<turnstile> es : (tn _> tm)"
proof -
  fix e tn'
  have "b_e_type_checker \<C> es (tn _> tm) \<Longrightarrow>
          \<C> \<turnstile> es : (tn _> tm)"
  and "\<And>tm' tm.
       check \<C> es tn' = tm' \<Longrightarrow>
       c_types_agree tm' tm \<Longrightarrow>
         \<exists>tn. c_types_agree tn' tn \<and> \<C> \<turnstile> es : (tn _> tm)"
  and "\<And>tm' tm.
       check_single \<C> e tn' = tm' \<Longrightarrow>
       c_types_agree tm' tm \<Longrightarrow>
       tn' \<noteq> Bot \<Longrightarrow>
       tm' \<noteq> Bot \<Longrightarrow>
         \<exists>tn. c_types_agree tn' tn \<and> \<C> \<turnstile> [e] : (tn _> tm)"
  proof (induction rule: b_e_type_checker_check_check_single.induct)
    case (1 \<C> es tn' tm)
    thus ?case
      by simp
  next
    case (2 \<C> es' ts)
    show ?case
    proof (cases es')
      case Nil
      thus ?thesis
        using 2(5,6)
        by (simp add: b_e_type_empty)
    next
      case (Cons e es)
        thus ?thesis
        proof (cases ts)
        case (TopType x1)
        have check_expand:"check \<C> es (check_single \<C> e ts) = tm'"
          using 2(5,6) TopType Cons
          by simp
        obtain ts' where ts'_def:"check_single \<C> e ts = ts'"
          by blast
        obtain t_int where t_int_def:"\<C> \<turnstile> es : (t_int _> tm)"
                                     "c_types_agree ts' t_int"
          using 2(2)[OF Cons TopType check_expand 2(6)] ts'_def
          by blast
        obtain t_int' where "c_types_agree ts t_int'" "\<C> \<turnstile> [e] : (t_int' _> t_int)"
          using 2(1)[OF Cons _ ts'_def] TopType c_types_agree.simps(3) t_int_def(2)
          by blast
        thus ?thesis
          using t_int_def(1) b_e_type_comp_conc Cons
          by fastforce
      next
        case (Type x2)
        have check_expand:"check \<C> es (check_single \<C> e ts) = tm'"
          using 2(5,6) Type Cons
          by simp
        obtain ts' where ts'_def:"check_single \<C> e ts = ts'"
          by blast
        obtain t_int where t_int_def:"\<C> \<turnstile> es : (t_int _> tm)"
                                     "c_types_agree ts' t_int"
          using 2(4)[OF Cons Type check_expand 2(6)] ts'_def
          by blast
        obtain t_int' where "c_types_agree ts t_int'" "\<C> \<turnstile> [e] : (t_int' _> t_int)"
          using 2(3)[OF Cons _ ts'_def] Type c_types_agree.simps(3) t_int_def(2)
          by blast
        thus ?thesis
          using t_int_def(1) b_e_type_comp_conc Cons
          by fastforce
      next
        case Bot
        then show ?thesis
          using 2(5,6) Cons
          by auto
      qed
    qed
  next
    case (3 \<C> v ts)
    hence "type_update ts [] (Type [typeof v]) = tm'"
      by simp
    moreover
    have "\<C> \<turnstile> [C v] : ([] _> [typeof v])"
      using b_e_typing.intros(1)
      by blast
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 3(3,4,2)]
      by (metis list.simps(8) to_ct_list_def)
  next
    case (4 \<C> t op ts)
    hence "unop_t_agree op t"
      by (simp, meson)
    thus ?case
      using b_e_check_single_sound_unop_testop_cvtop 4
      by fastforce
  next
    case (5 \<C> t op ts)
    hence "binop_t_agree op t"
      by (simp, meson)
    thus ?case
      using b_e_check_single_sound_binop_relop 5
      by fastforce
  next
    case (6 \<C> t op ts)
    hence "is_int_t t"
      by (simp, meson)
    thus ?case
      using b_e_check_single_sound_unop_testop_cvtop 6
      by fastforce
  next
    case (7 \<C> t op ts)
    hence "relop_t_agree op t"
      by (simp, meson)
    thus ?case
      using b_e_check_single_sound_binop_relop 7
      by fastforce
  next
    case (8 \<C> t1 t2 sx ts)
    hence "convert_cond t1 t2 sx"
      by (simp del: convert_cond.simps, meson)
    thus ?case
      using b_e_check_single_sound_unop_testop_cvtop 8
      by fastforce
  next
    case (9 \<C> t1 t2 sx ts)
    hence "t1 \<noteq> t2 \<and>  t_length t1 = t_length t2 \<and> sx = None"
      by (simp, presburger)
    thus ?case
      using b_e_check_single_sound_unop_testop_cvtop 9
      by fastforce
  next
    case (10 \<C> ts)
    thus ?case
      using b_e_typing.intros(8) c_types_agree_not_bot_exists
      by blast
  next
    case (11 \<C> ts)
    thus ?case
      using b_e_typing.intros(9,32)
      by fastforce
  next
    case (12 \<C> ts)
    thus ?case
    proof (cases ts)
      case (TopType x1)
      thus ?thesis
        proof (cases x1 rule: List.rev_cases)
          case Nil
          have "\<C> \<turnstile> [Drop] : (tm@[T_i32] _> tm)"
            using b_e_typing.intros(10,32)
            by fastforce
          thus ?thesis
            using c_types_agree_top1 Nil TopType
            by fastforce
        next
          case (snoc ys y)
            hence temp1:"(consume (TopType (ys@[y])) [TAny]) = tm'"
              using 12 TopType type_update_empty
              by (metis check_single.simps(10))
            hence temp2:"c_types_agree (TopType ys) tm"
              using consume_top_geq[OF temp1] 12(2,3,4)
              by (metis Suc_leI add_diff_cancel_right' append_eq_conv_conj consume.simps(2)
                        ct_suffix_def length_Cons length_append list.size(3) trans_le_add2
                        zero_less_Suc)
            obtain t where "ct_list_compat [y] (to_ct_list [t])"
              using ct_list_compat_exists
              unfolding ct_list_compat_def to_ct_list_def list_all2_map2
              by (metis list_all2_Cons1 list_all2_Nil)
            hence "c_types_agree ts (tm@[t])"
              using temp2 ct_suffix_extend_ct_list_compat snoc TopType
              by (simp add: to_ct_list_def)
            thus ?thesis
              using b_e_typing.intros(10,32)
              by fastforce
        qed
    next
      case (Type x2)
      thus ?thesis
      proof (cases x2 rule: List.rev_cases)
        case Nil
        hence "(consume (Type []) [TAny]) = tm'"
          using 12 Type type_update_empty
          by fastforce
        thus ?thesis
          using 12(4) ct_list_compat_def ct_suffix_def to_ct_list_def
          by simp
      next
        case (snoc ys y)
            hence temp1:"(consume (Type (ys@[y])) [TAny]) = tm'"
              using 12 Type type_update_empty
              by (metis check_single.simps(10))
            hence temp2:"c_types_agree (Type ys) tm"
              using 12(2,3,4) ct_suffix_def
              by (simp, metis One_nat_def butlast_conv_take butlast_snoc c_types_agree.simps(1)
                              length_Cons list.size(3))
            obtain t where "ct_list_compat [TSome y] (to_ct_list [t])"
              using ct_list_compat_exists
              unfolding ct_list_compat_def to_ct_list_def list_all2_map2
              by (metis list_all2_Cons1 list_all2_Nil)
            hence "c_types_agree ts (tm@[t])"
              using temp2 ct_suffix_extend_ct_list_compat snoc Type
              by (simp add: ct_list_compat_def to_ct_list_def)
            thus ?thesis
              using b_e_typing.intros(10,32)
              by fastforce
      qed
    qed simp
  next
    case (13 \<C> ts)
    thus ?case
    proof (cases ts)
      case (TopType x1)
      consider
          (1) "length x1 = 0"
        | (2) "length x1 = 1"
        | (3) "length x1 = 2"
        | (4) "length x1 \<ge> 3"
        by linarith
      thus ?thesis
      proof (cases)
        case 1
        hence "tm' = TopType [TAny]"
          using TopType 13
          by simp
        then obtain t'' tm'' where tm_def:"tm = tm''@[t'']"
          using 13(2) ct_suffix_def
          by (simp, metis Nil_is_append_conv append_butlast_last_id checker_type.inject(1)
                          ct_prefixI ct_prefix_nil(2) produce.simps(1) produce_nil)
        have "\<C> \<turnstile> [Select] : ([t'',t'',T_i32] _> [t''])"
          using b_e_typing.intros(11)
          by blast
        thus ?thesis
          using TopType 13 1 tm_def b_e_typing.intros(32) c_types_agree.simps(2) c_types_agree_top1
          by fastforce
      next
        case 2
        have "type_update_select (TopType x1) = tm'"
          using 13 TopType
          unfolding check_single.simps
          by simp
        hence x1_def:"ct_list_compat x1 [TSome T_i32]" "tm' = TopType [TAny]"
          using type_update_select_length1[OF _ 2 13(4)]
          by simp_all
        then obtain t'' tm'' where tm_def:"tm = tm''@[t'']"
          using 13(2) ct_suffix_def
          by (metis Nil_is_append_conv append_butlast_last_id c_types_agree.simps(2) ct_prefixI
                    ct_prefix_nil(2) list.simps(8) to_ct_list_def)
        have "c_types_agree (TopType x1) ((tm''@[t'',t''])@[T_i32])"
          using x1_def(1)
          by (metis c_types_agree_top2 list.simps(8,9) to_ct_list_def)
        thus ?thesis
          using TopType b_e_typing.intros(11,32) tm_def
          by auto
      next
        case 3
        have "type_update_select (TopType x1) = tm'"
          using 13 TopType
          unfolding check_single.simps
          by simp
        then obtain ct1 ct2 where x1_def:"x1 = [ct1, ct2]"
                                         "ct_compat ct2 (TSome T_i32)"
                                         "tm' = TopType [ct1]"
          using type_update_select_length2[OF _ 3 13(4)]
          by blast
        then obtain t'' tm'' where tm_def:"tm = tm''@[t'']"
                                          "ct_list_compat [ct1] [(TSome t'')]"
          using 13(2) c_types_agree_imp_ct_list_compat[of "[ct1]" tm]
          by (metis append_Nil2 append_butlast_last_id append_eq_append_conv_if append_eq_conv_conj
                    ct_list_compat_length diff_Suc_1 length_Cons length_butlast length_map
                    list.simps(8,9) list.size(3) nat.distinct(2) to_ct_list_def)
        hence "ct_list_compat x1 (to_ct_list [ t'', T_i32])"
          using x1_def(1,2)
          unfolding ct_list_compat_def to_ct_list_def
          by fastforce
        hence "c_types_agree (TopType x1) ((tm''@[t''])@[t'',T_i32])"
          using c_types_agree_top2
          by blast
        thus ?thesis
          using TopType b_e_typing.intros(11,32) tm_def
          by auto
      next
        case 4
        then obtain nat where nat_def:"length x1 = Suc (Suc (Suc nat))"
          by (metis add_eq_if diff_Suc_1 le_Suc_ex numeral_3_eq_3 nat.distinct(2))
        hence tm'_def:"type_update_select (TopType x1) = tm'"
          using 13 TopType
          by simp
        then obtain tm_int where "(select_return_top x1
                                    (x1 ! (length x1 - 2))
                                    (x1 ! (length x1 - 3))) = tm_int"
                                 "tm_int \<noteq> Bot"
          using nat_def 13(4)
          unfolding type_update_select.simps
          by fastforce
        then obtain x2 where x2_def:"(select_return_top x1
                                       (x1 ! (length x1 - 2))
                                       (x1 ! (length x1 - 3))) = TopType x2"
          using select_return_top_exists
          by fastforce
        have "ct_suffix x1 [TAny, TAny, TSome T_i32] \<or> ct_suffix [TAny, TAny, TSome T_i32] x1"
          using tm'_def nat_def 13(4)
          by (simp, metis (full_types) produce.simps(6))
        hence tm'_eq:"tm' = TopType x2"
          using tm'_def nat_def 13(4) x2_def
          by force
        then obtain cts' ct1 ct2 ct3 where cts'_def:"x1 = cts'@[ct1, ct2, ct3]"
                                                    "ct_compat ct3 (TSome T_i32)"
          using type_update_select_length3 tm'_def 4
          by blast
        then obtain c' cm' where tm_def:"tm = cm'@[c']"
                                        "ct_suffix cts' (to_ct_list cm')"
                                        "ct_compat (x1 ! (length x1 - 2)) (TSome c')"
                                        "ct_compat (x1 ! (length x1 - 3)) (TSome c')"
          using select_return_top_ct_compat[OF x2_def 4] tm'_eq 4 13(2)
          by fastforce
        then obtain as bs where cm'_def:"cm' = as@bs"
                                        "ct_list_compat (to_ct_list bs) cts'"
          using ct_list_compat_cons_ct_list1 ct_list_compat_ts_conv_eq
          by (metis ct_suffix_def to_ct_list_append(2))
        hence "ct_compat ct1 (TSome c')"
              "ct_compat ct2 (TSome c')"
          using cts'_def tm_def
          apply simp_all
          apply (metis append.assoc append_Cons append_Nil length_append_singleton nth_append_length)
          done
        hence "c_types_agree ts (cm'@[c',c',T_i32])"
          using c_types_agree_top2[of _ _ as] cm'_def(1) TopType
                ct_list_compat_concat[OF ct_list_compat_commute[OF cm'_def(2)]] cts'_def
          unfolding to_ct_list_def ct_list_compat_def
          by fastforce
        thus ?thesis
          using b_e_typing.intros(11,32) tm_def
          by auto
      qed
    next
      (* TODO: refactor *)
      case (Type x2)
      hence x2_cond:"(length x2 \<ge> 3 \<and> (x2!(length x2-2)) = (x2!(length x2-3)))"
        using 13
        by (simp, meson)
      hence tm'_def:"consume (Type x2) [TAny, TSome T_i32] = tm'"
        using 13 Type
        by simp
      obtain ts' ts'' where cts_def:"x2 = ts'@ ts''" "length ts'' = 3"
        using x2_cond
        by (metis append_take_drop_id diff_diff_cancel length_drop)
      then obtain t1 ts''2 where "ts'' = t1#ts''2" "length ts''2 = Suc (Suc 0)"
        using List.length_Suc_conv[of ts' "Suc (Suc 0)"]
        by (metis length_Suc_conv numeral_3_eq_3)
      then obtain t2 t3 where "ts'' = [t1,t2,t3]"
        using List.length_Suc_conv[of ts''2 "Suc 0"]
        by (metis length_0_conv length_Suc_conv)
      hence cts_def2:"x2 = ts'@ [t1,t2,t3]"
        using cts_def
        by simp
      have ts'_suffix:"ct_suffix [TAny, TSome T_i32] (to_ct_list (ts' @ [t1, t2, t3]))"
        using tm'_def 13(4)
        by (simp, metis cts_def2)
      hence tm'_def:"tm' = Type (ts'@[t1])"
        using tm'_def 13(4) cts_def2
        by simp
      obtain as bs where "(to_ct_list (ts' @ [t1])) @ (to_ct_list ([t2, t3])) = as@bs"
                         "ct_list_compat bs [TAny, TSome T_i32]"
        using ts'_suffix
        unfolding ct_suffix_def to_ct_list_def
        by fastforce
      hence "t3 = T_i32"
        unfolding to_ct_list_def ct_list_compat_def
        by (metis (no_types, lifting) Nil_is_map_conv append_eq_append_conv ct_compat.simps(1)
                  length_Cons list.sel(1,3) list.simps(9) list_all2_Cons2 list_all2_lengthD)
      moreover
      have "t1 = t2"
        using x2_cond cts_def2
        by (simp, metis append.left_neutral append_Cons append_assoc length_append_singleton
                        nth_append_length)
      ultimately
      have "c_types_agree (Type x2) ((ts'@[t1,t1])@[T_i32])"
        using cts_def2
        by simp
      thus ?thesis
        using b_e_typing.intros(11,32) Type tm'_def 13(2)
        by fastforce
    qed simp
  next
    case (14 \<C> tn'' tm'' es ts)
    hence "type_update ts (to_ct_list tn'') (Type tm'') = tm'"
      by auto
    moreover
    have "(b_e_type_checker (\<C>\<lparr>label := ([tm''] @ (label \<C>))\<rparr>) es (tn'' _> tm''))"
      using 14
      by (simp, meson)
    hence "\<C> \<turnstile> [Block (tn'' _> tm'') es] : (tn'' _> tm'')"
      using b_e_typing.intros(12)[OF _ 14(1)]
      by blast
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 14(4,5,3)]
      by blast
  next
    case (15 \<C> tn'' tm'' es ts)
    hence "type_update ts (to_ct_list tn'') (Type tm'') = tm'"
      by auto
    moreover
    have "(b_e_type_checker (\<C>\<lparr>label := ([tn''] @ (label \<C>))\<rparr>) es (tn'' _> tm''))"
      using 15
      by (simp, meson)
    hence "\<C> \<turnstile> [Loop (tn'' _> tm'') es] : (tn'' _> tm'')"
      using b_e_typing.intros(13)[OF _ 15(1)]
      by blast
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 15(4,5,3)]
      by blast
  next
    case (16 \<C> tn'' tm'' es1 es2 ts)
    hence "type_update ts (to_ct_list (tn''@[T_i32])) (Type tm'') = tm'"
      by auto
    moreover
    have "(b_e_type_checker (\<C>\<lparr>label := ([tm''] @ (label \<C>))\<rparr>) es1 (tn'' _> tm''))"
         "(b_e_type_checker (\<C>\<lparr>label := ([tm''] @ (label \<C>))\<rparr>) es2 (tn'' _> tm''))"
      using 16
      by (simp, meson)+
    hence "\<C> \<turnstile> [If (tn'' _> tm'') es1 es2] : (tn''@[T_i32] _> tm'')"
      using b_e_typing.intros(14)[OF _ 16(1,2)]
      by blast
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 16(5,6,4)]
      by blast
  next
    case (17 \<C> i ts)
    hence "type_update ts (to_ct_list ((label \<C>)!i)) (TopType []) = tm'"
      by auto
    moreover
    have "i < length (label \<C>)"
      using 17
      by (simp, meson)
    ultimately
    show ?case
      using b_e_check_single_top_not_bot_sound[OF _ 17(3,4)]
            b_e_typing.intros(15)
            b_e_typing.intros(32)
      by (metis suffix_def)
  next
    case (18 \<C> i ts)
    hence "type_update ts (to_ct_list ((label \<C>)!i @ [T_i32])) (Type ((label \<C>)!i)) = tm'"
      by auto
    moreover
    have "i < length (label \<C>)"
      using 18
      by (simp, meson)
    hence "\<C> \<turnstile> [Br_if i] : ((label \<C>)!i @ [T_i32] _> (label \<C>)!i)"
      using b_e_typing.intros(16)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 18(3,4,2)]
      by fastforce
  next
    case (19 \<C> "is" i ts)
    then obtain tls where tls_def:"(same_lab (is@[i]) (label \<C>)) = Some tls"
      by fastforce
    hence "type_update ts (to_ct_list (tls @ [T_i32])) (TopType []) = tm'"
      using 19
      by simp
    thus ?case
      using b_e_check_single_top_not_bot_sound[OF _ 19(3,4)]
            b_e_typing.intros(17)[OF same_lab_conv_list_all[OF tls_def]]
            b_e_typing.intros(32)
      by (metis suffix_def)
  next
    case (20 \<C> ts)
    then obtain ts_r where "(return \<C>) = Some ts_r"
      by fastforce
    moreover
    hence "type_update ts (to_ct_list ts_r) (TopType []) = tm'"
      using 20
      by simp
    ultimately
    show ?case
      using b_e_check_single_top_not_bot_sound[OF _ 20(3,4)]
            b_e_typing.intros(18,32)
      by (metis suffix_def)
  next
    case (21 \<C> i ts)
    obtain tn'' tm'' where func_def:"(func_t \<C>)!i = (tn'' _> tm'')"
      using tf.exhaust
      by blast
    hence "type_update ts (to_ct_list tn'') (Type tm'') = tm'"
      using 21
      by auto
    moreover
    have "i < length (func_t \<C>)"
      using 21
      by (simp, meson)
    hence "\<C> \<turnstile> [Call i] : (tn'' _> tm'')"
      using b_e_typing.intros(19) func_def
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 21(3,4,2)]
      by fastforce
  next
    case (22 \<C> i ts)
    obtain tn'' tm'' where type_def:"(types_t \<C>)!i = (tn'' _> tm'')"
      using tf.exhaust
      by blast
    hence "type_update ts (to_ct_list (tn''@[T_i32])) (Type tm'') = tm'"
      using 22
      by auto
    moreover
    have "length (table \<C>) \<ge> 1  \<and> i < length (types_t \<C>)"
      using 22
      by (simp, meson)
    hence "\<C> \<turnstile> [Call_indirect i] : (tn''@[T_i32] _> tm'')"
      using b_e_typing.intros(20) type_def
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 22(3,4,2)]
      by fastforce
  next
    case (23 \<C> i ts)
    hence "type_update ts [] (Type [(local \<C>)!i]) = tm'"
      by auto
    moreover
    have "i < length (local \<C>)"
      using 23
      by (simp, meson)
    hence "\<C> \<turnstile> [Get_local i] : ([] _> [(local \<C>)!i])"
      using b_e_typing.intros(21)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 23(3,4,2)]
      unfolding to_ct_list_def
      by (metis list.map_disc_iff)
  next
    case (24 \<C> i ts)
    hence "type_update ts (to_ct_list [(local \<C>)!i]) (Type []) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "i < length (local \<C>)"
      using 24
      by (simp, meson)
    hence "\<C> \<turnstile> [Set_local i] : ([(local \<C>)!i] _> [])"
      using b_e_typing.intros(22)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 24(3,4,2)]
      by fastforce
  next
    case (25 \<C> i ts)
    hence "type_update ts (to_ct_list [(local \<C>)!i]) (Type [(local \<C>)!i]) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "i < length (local \<C>)"
      using 25
      by (simp, meson)
    hence "\<C> \<turnstile> [Tee_local i] : ([(local \<C>)!i] _> [(local \<C>)!i])"
      using b_e_typing.intros(23)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 25(3,4,2)]
      by fastforce
  next
    case (26 \<C> i ts)
    hence "type_update ts [] (Type [tg_t ((global \<C>)!i)]) = tm'"
      by auto
    moreover
    have "i < length (global \<C>)"
      using 26
      by (simp, meson)
    hence "\<C> \<turnstile> [Get_global i] : ([] _> [tg_t ((global \<C>)!i)])"
      using b_e_typing.intros(24)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 26(3,4,2)]
      unfolding to_ct_list_def
      by (metis list.map_disc_iff)
  next
    case (27 \<C> i ts)
    hence "type_update ts (to_ct_list [tg_t ((global \<C>)!i)]) (Type []) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "i < length (global \<C>) \<and> is_mut (global \<C> ! i)"
      using 27
      by (simp, meson)
    then obtain t where "(global \<C> ! i) = \<lparr>tg_mut = T_mut, tg_t = t\<rparr>" "i < length (global \<C>)"
      unfolding is_mut_def
      by (cases "global \<C> ! i", auto)
    hence "\<C> \<turnstile> [Set_global i] : ([tg_t (global \<C> ! i)] _> [])"
      using b_e_typing.intros(25)[of i \<C> "tg_t (global \<C> ! i)"]
      unfolding is_mut_def tg_t_def
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 27(3,4,2)]
      by fastforce
  next
    case (28 \<C> t tp_sx a off ts)
    hence "type_update ts (to_ct_list [T_i32]) (Type [t]) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "length (memory \<C>) \<ge> 1  \<and> load_store_t_bounds a (option_projl tp_sx) t"
      using 28
      by (simp, meson)
    hence "\<C> \<turnstile> [Load t tp_sx a off] : ([T_i32] _> [t])"
      using b_e_typing.intros(26)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 28(3,4,2)]
      by fastforce
  next
    case (29 \<C> t tp a off ts)
    hence "type_update ts (to_ct_list [T_i32,t]) (Type []) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "length (memory \<C>) \<ge> 1  \<and> load_store_t_bounds a tp t"
      using 29
      by (simp, meson)
    hence "\<C> \<turnstile> [Store t tp a off] : ([T_i32,t] _> [])"
      using b_e_typing.intros(27)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 29(3,4,2)]
      by fastforce
  next
    case (30 \<C> ts)
    hence "type_update ts [] (Type [T_i32]) = tm'"
      by auto
    moreover
    have "length (memory \<C>) \<ge> 1 "
      using 30
      by (simp, meson)
    hence "\<C> \<turnstile> [Current_memory] : ([] _> [T_i32])"
      using b_e_typing.intros(28)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 30(3,4,2)]
      unfolding to_ct_list_def
      by (metis list.map_disc_iff)
  next
    case (31 \<C> ts)
    hence "type_update ts (to_ct_list [T_i32]) (Type [T_i32]) = tm'"
      unfolding to_ct_list_def
      by auto
    moreover
    have "length (memory \<C>) \<ge> 1 "
      using 31
      by (simp, meson)
    hence "\<C> \<turnstile> [Grow_memory] : ([T_i32] _> [T_i32])"
      using b_e_typing.intros(29)
      by fastforce
    ultimately
    show ?case
      using b_e_check_single_type_not_bot_sound[OF _ 31(3,4,2)]
      by fastforce
  qed
  thus ?thesis
    using assms
    by simp
qed

subsection {* Completeness *}

lemma check_single_imp:
  assumes "check_single \<C> e ctn = ctm"
          "ctm \<noteq> Bot"
  shows "check_single \<C> e = id
         \<or> check_single \<C> e = (\<lambda>ctn. type_update_select ctn)
         \<or> (\<exists>cons prods. (check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)))"
  using assms
  apply (cases rule: check_single.cases[of "(\<C>, e, ctn)"])
  apply (fastforce split: if_splits option.splits tf.splits)+
  done

lemma check_equiv_fold:
  "check \<C> es ts = foldl (\<lambda> ts e. (case ts of Bot \<Rightarrow> Bot | _ \<Rightarrow> check_single \<C> e ts)) ts es"
proof (induction es arbitrary: ts)
  case Nil
  thus ?case
    by simp
next
  case (Cons e es)
  obtain ts' where ts'_def:"check \<C> (e # es) ts = ts'"
    by blast
  show ?case
  proof (cases "ts = Bot")
    case True
    thus ?thesis
      using ts'_def
      by (induction es, simp_all)
  next
    case False
    thus ?thesis
      using ts'_def Cons
      by (cases ts, simp_all)
  qed
qed

lemma check_neq_bot_snoc:
  assumes "check \<C> (es@[e]) ts \<noteq> Bot"
  shows "check \<C> es ts \<noteq> Bot"
  using assms
proof (induction es arbitrary: ts)
  case Nil
  thus ?case
    by (cases ts, simp_all)
next
  case (Cons a es)
  thus ?case
    by (cases ts, simp_all)
qed

lemma check_unfold_snoc:
  assumes "check \<C> es ts \<noteq> Bot"
  shows "check \<C> (es@[e]) ts = check_single \<C> e (check \<C> es ts)"
proof -
  obtain f where f_def:"f = (\<lambda> e ts. (case ts of Bot \<Rightarrow> Bot | _ \<Rightarrow> check_single \<C> e ts))"
    by blast
  have f_simp:"\<And>ts. ts \<noteq> Bot \<Longrightarrow> (f e ts = check_single \<C> e ts)"
  proof -
    fix ts
    show "ts \<noteq> Bot \<Longrightarrow> (f e ts = check_single \<C> e ts)"
      using f_def
      by (cases ts, simp_all)
  qed
  have "check \<C> (es@[e]) ts = foldl (\<lambda> ts e. (case ts of Bot \<Rightarrow> Bot | _ \<Rightarrow> check_single \<C> e ts)) ts (es@[e])"
    using check_equiv_fold
    by simp
  also
  have "... = foldr (\<lambda> e ts. (case ts of Bot \<Rightarrow> Bot | _ \<Rightarrow> check_single \<C> e ts)) (rev (es@[e])) ts"
    using foldl_conv_foldr
    by fastforce
  also
  have "... = f e (foldr (\<lambda> e ts. (case ts of Bot \<Rightarrow> Bot | _ \<Rightarrow> check_single \<C> e ts)) (rev es) ts)"
    using f_def
    by simp
  also
  have "... = f e (check \<C> es ts)"
    using foldr_conv_foldl[of _ "(rev es)" ts] rev_rev_ident[of es] check_equiv_fold
    by simp
  also
  have "... = check_single \<C> e (check \<C> es ts)"
    using assms f_simp
    by simp
  finally
  show ?thesis .
qed

lemma check_single_imp_weakening:
  assumes "check_single \<C> e (Type t1s) = ctm"
          "ctm \<noteq> Bot"
          "c_types_agree ctn t1s"
          "c_types_agree ctm t2s"
  shows "\<exists>ctm'. check_single \<C> e ctn = ctm' \<and> c_types_agree ctm' t2s"
proof -
  consider (1) "check_single \<C> e = id"
         | (2) "check_single \<C> e = (\<lambda>ctn. type_update_select ctn)"
         | (3) "(\<exists>cons prods. (check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)))"
    using check_single_imp assms
    by blast
  thus ?thesis
  proof (cases)
    case 1
    thus ?thesis
      using assms(1,3,4)
      by fastforce
  next
    (* TODO: better proof *)
    case 2
    note outer_2 = 2
    hence t1s_cond:"(length t1s \<ge> 3 \<and> (t1s!(length t1s-2)) = (t1s!(length t1s-3)))"
      using assms(1,2)
      by (simp, meson)
    hence ctm_def:"ctm = consume (Type t1s) [TAny, TSome T_i32]"
      using assms(1,2) 2
      by simp
    then obtain c_t where c_t_def:"ctm = Type c_t"
      using assms(2)
      by (meson consume.simps(1))
    hence t2s_eq:"t2s = c_t"
      using assms(4)
      by simp
    hence t2s_len:"length t2s > 0"
      using t1s_cond ctm_def c_t_def assms(2)
      by (metis Suc_leI Suc_n_not_le_n checker_type.inject(2) consume.simps(1)
                diff_is_0_eq dual_order.trans length_0_conv length_Cons length_greater_0_conv
                nat.simps(3) numeral_3_eq_3 take_eq_Nil)
    have t1s_suffix_full:"ct_suffix [TAny, TSome T_i32] (to_ct_list t1s)"
      using assms(2) ctm_def ct_suffix_less
      by (metis consume.simps(1))
    hence t1s_suffix:"ct_suffix [TSome T_i32] (to_ct_list t1s)"
      using assms(2) ctm_def ct_suffix_less
      by (metis append_butlast_last_id last.simps list.distinct(1))
    obtain t t1s' where t1s_suffix2:"t1s = t1s'@[t,t,T_i32]"
      using type_update_select_type_length3 assms(1) c_t_def outer_2
      by fastforce
    hence t2s_def:"t2s = t1s'@[t]"
      using ctm_def c_t_def t2s_eq t1s_suffix assms(2) t1s_suffix_full
      by simp
    show ?thesis
      using assms(1,3,4)
    proof (cases ctn)
      case (TopType x1)
      consider
          (1) "length x1 = 0"
        | (2) "length x1 = 1"
        | (3) "length x1 = 2"
        | (4) "length x1 \<ge> 3"
        by linarith
      thus ?thesis
      proof (cases)
        case 1
        hence "check_single \<C> e ctn = TopType [TAny]"
          using 2 TopType
          by simp
        thus ?thesis
          using ct_suffix_singleton to_ct_list_def t2s_len
          by auto
      next
        case 2
        hence "ct_suffix [TSome T_i32] x1"
          using assms(3) TopType ct_suffix_imp_ct_list_compat ct_suffix_shared t1s_suffix
          by (metis One_nat_def append_Nil c_types_agree.simps(2) ct_list_compat_commute ct_suffix_def
                    diff_self_eq_0 drop_0 length_Cons list.size(3))
        hence "check_single \<C> e ctn = TopType [TAny]"
          using outer_2 TopType 2
          by simp
        thus ?thesis
          using t2s_len ct_suffix_singleton
          by (simp add: to_ct_list_def)
      next
        case 3
        have "ct_list_compat (to_ct_list t1s) (to_ct_list (t1s' @ [t, t, T_i32]))"
          using t1s_suffix2
          by (simp add: ct_list_compat_ts_conv_eq)
        hence temp1:"to_ct_list t1s = (to_ct_list (t1s' @ [t])) @ (to_ct_list [t, T_i32])"
          using t1s_suffix2 to_ct_list_def
          by simp
        hence "ct_suffix (to_ct_list [t, T_i32]) (to_ct_list t1s)"
          using ct_suffix_def[of "(to_ct_list [t, T_i32])" "(to_ct_list t1s)"]
          by (simp add: ct_suffix_cons_it)
        hence "ct_suffix (to_ct_list [t, T_i32]) x1"
          using assms(3) TopType 3
          by (simp, metis temp1 append_Nil ct_suffix_cons2 ct_suffix_def length_Cons length_map
                          list.size(3) numeral_2_eq_2 to_ct_list_def)
        hence temp3:"ct_list_compat (to_ct_list [t, T_i32]) x1"
          using 3 ct_suffix_imp_ct_list_compat
          unfolding to_ct_list_def
          by (metis Suc_leI ct_list_compat_commute diff_is_0_eq drop_0 length_Cons length_map lessI
                    list.size(3) numeral_2_eq_2)
        hence temp4:"ct_suffix [TSome T_i32] x1"
          using ct_suffix_less[of "[TSome t]" "[TSome T_i32]" x1]
                ct_suffix_extend_ct_list_compat[of "[]" "[]"] ct_suffix_nil
          unfolding to_ct_list_def
          by fastforce
        hence "ct_suffix (take 1 x1) (to_ct_list [t])"
          using temp3 ct_suffix_nil ct_list_compat_commute ct_suffix_extend_ct_list_compat[of "[]" "[]" "(take 1 x1)" "(to_ct_list [t])"]
          unfolding to_ct_list_def
          by (simp, metis butlast.simps(2) butlast_conv_take ct_list_compat_take diff_Suc_1 length_Cons
                          list.distinct(1) list.size(3))
        thus ?thesis
          using TopType 2 3 ct_suffix_nil temp3 temp4 t2s_def to_ct_list_def
          apply (simp, safe)
          apply (metis append.assoc ct_suffix_def)
          done
      next
        case 4
        then obtain nat where nat_def:"length x1 = Suc (Suc (Suc nat))"
          by (metis add_eq_if diff_Suc_1 le_Suc_ex numeral_3_eq_3 nat.distinct(2))
        obtain x1' x x' x'' where x1_split:"x1 = x1'@[x,x',x'']"
        proof -
          assume local_assms:"(\<And>x1' x x' x''. x1 = x1' @ [x, x', x''] \<Longrightarrow> thesis)"
          obtain x1' x1'' where tn_split:"x1 = x1'@x1''"
                               "length x1'' = 3"
            using 4
            by (metis append_take_drop_id diff_diff_cancel length_drop)
          then obtain x x1''2 where "x1'' = x#x1''2" "length x1''2 = Suc (Suc 0)"
            by (metis length_Suc_conv numeral_3_eq_3)
          then obtain x' x'' where tn''_def:"x1''= [x,x',x'']"
            using List.length_Suc_conv[of x1''2 "Suc 0"]
            by (metis length_0_conv length_Suc_conv)
          thus ?thesis
            using tn_split local_assms
            by simp
        qed
        hence a:"ct_suffix (x1'@[x,x',x'']) (to_ct_list (t1s' @ [t, t, T_i32]))"
          using t1s_suffix2 assms(3) TopType
          by simp
        hence b:"ct_suffix (x1'@[x,x']) (to_ct_list (t1s' @ [t, t])) \<and> (ct_compat x'' (TSome T_i32))"
          using to_ct_list_def ct_suffix_unfold_one[of "(x1'@[x,x'])" "x''" "to_ct_list (t1s' @ [t, t])"]
          by fastforce
        hence c:"ct_suffix (x1'@[x]) (to_ct_list (t1s' @ [t])) \<and> (ct_compat x' (TSome t))"
          using to_ct_list_def ct_suffix_unfold_one[of "(x1'@[x])" "x'" "to_ct_list (t1s' @ [t])"]
          by fastforce
        hence d:"ct_suffix x1' (to_ct_list t1s') \<and> (ct_compat x (TSome t))"
          using to_ct_list_def ct_suffix_unfold_one[of "(x1')" "x" "to_ct_list (t1s')"]
          by fastforce
        have "(take (length x1 - 3) x1) = x1'"
          using x1_split
          by simp
        have x'_ind:"(x1!(length x1-2)) = x'"
          using x1_split List.nth_append_length[of "x1' @ [x]"]
          by simp
        have x_ind:"(x1!(length x1-3)) = x"
          using x1_split
          by simp
        have "ct_suffix [TSome T_i32] x1"
          using b x1_split ct_suffix_def ct_list_compat_def ct_suffixI[of x1 "x1' @ [x, x']"]
          by simp
        hence "check_single \<C> e (TopType x1) = (select_return_top x1 (x1!(length x1-2)) (x1!(length x1-3)))"
          using type_update_select_conv_select_return_top[OF _ 4]
          unfolding 2
          by blast
        moreover
        have "... = (TopType (x1'@[x])) \<or> ... = (TopType (x1'@[x']))"
          apply (cases x; cases x')
          using x1_split 4 nat_def 2 x_ind x'_ind c d
          by simp_all
        moreover
        have "ct_suffix (x1'@[x]) (to_ct_list t2s)"
          by (simp add: c t2s_def)
        moreover
        have "ct_suffix (x1'@[x']) (to_ct_list t2s)"
          using ct_suffix_unfold_one[symmetric, of x' "(TSome t)" x1' "(to_ct_list t1s')"] c d
                t2s_def
          unfolding to_ct_list_def
          by fastforce
        ultimately
        show ?thesis
          using TopType
          by auto
      qed
    qed simp_all
  next
    case 3
    then obtain cons prods where c_s_def:"check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)"
      by blast
    hence ctm_def:"ctm = type_update (Type t1s) cons prods"
      using assms(1)
      by fastforce
    hence cons_suffix:"ct_suffix cons (to_ct_list t1s)"
      using assms
      by (simp, metis (full_types) produce.simps(6))
    hence t_int_def:"consume (Type t1s) cons = (Type (take (length t1s - length cons) t1s))"
      using ctm_def
      by simp
    hence ctm_def2:"ctm = produce (Type (take (length t1s - length cons) t1s)) prods"
      using ctm_def
      by simp
    show ?thesis
    proof (cases ctn)
      case (TopType x1)
      hence "ct_suffix x1 (to_ct_list t1s)"
        using assms(3)
        by simp
      thus ?thesis
        using assms(2) ctm_def2
      proof (cases prods)
        case (TopType x1)
        thus ?thesis
          using consume_c_types_agree[OF t_int_def assms(3)] ctm_def2 assms(4) c_s_def
          by (metis c_types_agree.elims(2) produce.simps(3,4) type_update.simps)
      next
        case (Type x2)
        hence ctm_def3:"ctm = Type ((take (length t1s - length cons) t1s)@ x2)"
          using ctm_def2
          by simp
        have "ct_suffix x1 cons \<or> ct_suffix cons x1"
          using ct_suffix_shared assms(3) TopType cons_suffix
          by auto
        thus ?thesis
        proof (rule disjE)
          assume "ct_suffix x1 cons"
          hence "consume (TopType x1) cons = TopType []"
            by (simp add: ct_suffix_length)
          hence "check_single \<C> e ctn = TopType (to_ct_list x2)"
            using c_s_def TopType Type
            by simp
          thus ?thesis
            using TopType ctm_def3 assms(4) c_types_agree_top2 ct_list_compat_refl
            by auto
        next
          assume "ct_suffix cons x1"
          hence 4:"consume (TopType x1) cons = TopType (take (length x1 - length cons ) x1)"
            by (simp add: ct_suffix_length)
          hence 3:"check_single \<C> e ctn = TopType ((take (length x1 - length cons ) x1) @ to_ct_list x2)"
            using c_s_def TopType Type
            by simp
          have "((take (length t1s - length cons ) t1s) @  x2) = t2s"
            using assms(4) ctm_def3
            by simp
          have "c_types_agree (TopType (take (length x1 - length cons ) x1)) (take (length t1s - length cons) t1s)"
            using consume_c_types_agree[OF t_int_def assms(3)] 4 TopType
            by simp
          hence "c_types_agree (TopType (take (length x1 - length cons ) x1 @ to_ct_list x2)) (take (length t1s - length cons) t1s @ x2)"
            unfolding c_types_agree.simps to_ct_list_def
            by (simp add: ct_suffix_cons2 ct_suffix_cons_it ct_suffix_extend_ct_list_compat)
          thus ?thesis
            using ctm_def3 assms 3
            by simp
        qed
      qed simp
    next
      case (Type x2)
      thus ?thesis
        using assms
        by simp
    next
      case Bot
      thus ?thesis
        using assms
        by simp
    qed
  qed
qed

lemma b_e_type_checker_compose:
  assumes "b_e_type_checker \<C> es (t1s _> t2s)"
          "b_e_type_checker \<C> [e] (t2s _> t3s)"
  shows "b_e_type_checker \<C> (es @ [e]) (t1s _> t3s)"
proof -
  have "c_types_agree (check_single \<C> e (Type t2s)) t3s"
    using assms(2)
    by simp
  then obtain ctm where ctm_def:"check_single \<C> e (Type t2s) = ctm"
                                "c_types_agree ctm t3s"
                                "ctm \<noteq> Bot"
    by fastforce
  have "c_types_agree (check \<C> es (Type t1s)) t2s"
    using assms(1)
    by simp
  then obtain ctn where ctn_def:"check \<C> es (Type t1s) = ctn"
                                "c_types_agree ctn t2s"
                                "ctn \<noteq> Bot"
    by fastforce
  thus ?thesis
    using check_single_imp_weakening[OF ctm_def(1,3) ctn_def(2) ctm_def(2)]
          check_unfold_snoc[of \<C> es "(Type t1s)" e]
    by simp
qed

lemma b_e_check_single_type_type:
  assumes "check_single \<C> e xs = (Type tm)"
  shows "\<exists>tn. xs = (Type tn)"
proof -
  consider (1) "check_single \<C> e = id"
         | (2) "check_single \<C> e = (\<lambda>ctn. type_update_select ctn)"
         | (3) "(\<exists>cons prods. (check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)))"
    using check_single_imp assms
    by blast
  thus ?thesis
  proof (cases)
    case 1
    thus ?thesis
      using assms
      by simp
  next
    case 2
    note outer_2 = 2
    thus ?thesis
      using assms
    proof (cases xs)
      case (TopType x1)
      consider
          (1) "length x1 = 0"
        | (2) "length x1 = Suc 0"
        | (3) "length x1 = Suc (Suc 0)"
        | (4) "length x1 \<ge> 3"
        by linarith
      thus ?thesis
      proof cases
        case 1
        thus ?thesis
          using assms 2 TopType
          by simp
      next
        case 2
        thus ?thesis
          using assms outer_2 TopType produce_type_type
          by fastforce
      next
        case 3
        thus ?thesis
          using assms 2 TopType
          by (simp, metis checker_type.distinct(1) checker_type.distinct(5))
      next
        case 4
        then obtain nat where nat_def:"length x1 = Suc (Suc (Suc nat))"
          by (metis add_eq_if diff_Suc_1 le_Suc_ex numeral_3_eq_3 nat.distinct(2))
        thus ?thesis
          using assms 2 TopType
        proof -
          {
            assume a1: "produce (if ct_suffix [TAny, TAny, TSome T_i32] x1 then TopType (take (length x1 - length [TAny, TAny, TSome T_i32]) x1) else if ct_suffix x1 [TAny, TAny, TSome T_i32] then TopType [] else Bot) (select_return_top x1 (x1 ! Suc nat) (x1 ! nat)) = Type tm"
            obtain tts :: "checker_type \<Rightarrow> t list" where
              f2: "\<forall>c. (\<forall>ca ts. produce c ca \<noteq> Type ts) \<or> c = Type (tts c)"
              using produce_type_type by moura
            then have f3: "\<And>ts. \<not> ct_suffix [TAny, TAny, TSome T_i32] x1 \<or> Type tm \<noteq> Type ts"
              using a1 by fastforce
            then have "\<And>ts. \<not> ct_suffix x1 [TAny, TAny, TSome T_i32] \<or> Type tm \<noteq> Type ts"
              using f2 a1 by fastforce
            then have False
              using f3 a1 by fastforce
          }
          thus ?thesis
            using assms 2 TopType nat_def
            by simp
        qed
      qed
    qed simp_all
  next
    case 3
    then obtain cons prods where check_def:"check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)"
      by blast
    hence "produce (consume xs cons) prods = (Type tm)"
      using assms(1)
      by simp
    thus ?thesis
      using assms check_def consume_type_type produce_type_type
      by blast
  qed
qed

lemma b_e_check_single_weaken_type:
  assumes "check_single \<C> e (Type tn) = (Type tm)"
  shows "check_single \<C> e (Type (ts@tn)) = Type (ts@tm)"
proof -
  consider (1) "check_single \<C> e = id"
         | (2) "check_single \<C> e = (\<lambda>ctn. type_update_select ctn)"
         | (3) "(\<exists>cons prods. (check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)))"
    using check_single_imp assms
    by blast
  thus ?thesis
  proof (cases)
    case 1
    thus ?thesis
      using assms(1)
      by simp
  next
    case 2
    hence cond:"(length tn \<ge> 3 \<and> (tn!(length tn-2)) = (tn!(length tn-3)))"
      using assms
      by (simp, metis checker_type.distinct(5))
    hence "consume (Type tn) [TAny, TSome T_i32] = (Type tm)"
      using assms 2
      by simp
    hence "consume (Type (ts@tn)) [TAny, TSome T_i32] = (Type (ts@tm))"
      using consume_weaken_type
      by blast
    moreover
    have "(length (ts@tn) \<ge> 3 \<and> ((ts@tn)!(length (ts@tn)-2)) = ((ts@tn)!(length (ts@tn)-3)))"
      using cond
      by (simp, metis add.commute add_leE nth_append_length_plus numeral_Bit1 numeral_One
                      one_add_one ordered_cancel_comm_monoid_diff_class.diff_add_assoc2)
    ultimately
    show ?thesis
      using 2
      by simp
  next
    case 3
    then obtain cons prods where check_def:"check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)"
      by blast
    hence "produce (consume (Type tn) cons) prods = (Type tm)"
      using assms(1)
      by simp
    then obtain t_int where t_int_def:"consume (Type tn) cons = (Type t_int)"
      by (metis consume.simps(1) produce.simps(6))
    thus ?thesis
      using assms(1) check_def
            consume_weaken_type[OF t_int_def, of ts]
            produce_weaken_type[of t_int prods tm ts]
      by simp
  qed
qed

lemma b_e_check_single_weaken_top:
  assumes "check_single \<C> e (Type tn) = TopType tm"
  shows "check_single \<C> e (Type (ts@tn)) = TopType tm"
proof -
  consider (1) "check_single \<C> e = id"
         | (2) "check_single \<C> e = (\<lambda>ctn. type_update_select ctn)"
         | (3) "(\<exists>cons prods. (check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)))"
    using check_single_imp assms
    by blast
  thus ?thesis
  proof (cases)
    case 1
    thus ?thesis
      using assms
      by simp
  next
    case 2
    thus ?thesis
      using assms
      by (simp, metis checker_type.distinct(1) checker_type.distinct(3) consume.simps(1))
  next
    case 3
    then obtain cons prods where check_def:"check_single \<C> e = (\<lambda>ctn. type_update ctn cons prods)"
      by blast
    hence "produce (consume (Type tn) cons) prods = (TopType tm)"
      using assms(1)
      by simp
    moreover
    then obtain t_int where t_int_def:"consume (Type tn) cons = (Type t_int)"
      by (metis checker_type.distinct(3) consume.simps(1) produce.simps(6))
    ultimately
    show ?thesis
      using check_def consume_weaken_type
      by (cases prods, auto)
  qed
qed

lemma b_e_check_weaken_type:
  assumes "check \<C> es (Type tn) = (Type tm)"
  shows "check \<C> es (Type (ts@tn)) = (Type (ts@tm))"
  using assms
proof (induction es arbitrary: tn tm rule: List.rev_induct)
  case Nil
  thus ?case
    by simp
next
  case (snoc e es)
  hence "check_single \<C> e (check \<C> es (Type tn)) = Type tm"
    using check_unfold_snoc[OF check_neq_bot_snoc]
    by (metis checker_type.distinct(5))
  thus ?case
    using b_e_check_single_weaken_type b_e_check_single_type_type snoc
    by (metis check_unfold_snoc checker_type.distinct(5))
qed

lemma check_bot: "check \<C> es Bot = Bot"
  by (simp add: list.case_eq_if)

lemma b_e_check_weaken_top:
  assumes "check \<C> es (Type tn) = (TopType tm)"
  shows "check \<C> es (Type (ts@tn)) = (TopType tm)"
  using assms
proof (induction es arbitrary: tn tm)
  case Nil
  thus ?case
    by simp
next
  case (Cons e es)
  show ?case
  proof (cases "(check_single \<C> e (Type tn))")
    case (TopType x1)
    hence "check_single \<C> e (Type (ts@tn)) = TopType x1"
      using b_e_check_single_weaken_top
      by blast
    thus ?thesis
      using TopType Cons
      by simp
  next
    case (Type x2)
    hence "check_single \<C> e (Type (ts@tn)) = Type (ts@x2)"
      using b_e_check_single_weaken_type
      by blast
    thus ?thesis
      using Cons Type
      by fastforce
  next
    case Bot
    thus ?thesis
      using check_bot Cons
      by simp
  qed

qed

lemma b_e_type_checker_weaken:
  assumes "b_e_type_checker \<C> es (t1s _> t2s)"
  shows "b_e_type_checker \<C> es (ts@t1s _> ts@t2s)"
proof -
  have "c_types_agree (check \<C> es (Type t1s)) t2s"
    using assms(1)
    by simp
  then obtain ctn where ctn_def:"check \<C> es (Type t1s) = ctn"
                                "c_types_agree ctn t2s"
                                "ctn \<noteq> Bot"
    by fastforce
  show ?thesis
  proof (cases ctn)
    case (TopType x1)
    thus ?thesis
      using ctn_def(1,2) b_e_check_weaken_top[of \<C> es t1s x1 ts]
      by (metis append_assoc b_e_type_checker.simps c_types_agree_imp_ct_list_compat c_types_agree_top2)
  next
    case (Type x2)
    thus ?thesis
      using ctn_def(1,2) b_e_check_weaken_type[of \<C> es t1s x2 ts]
      by simp
  next
    case Bot
    thus ?thesis
      using ctn_def(3)
      by simp
  qed
qed

lemma b_e_type_checker_complete:
  assumes "\<C> \<turnstile> es : (tn _> tm)"
  shows "b_e_type_checker \<C> es (tn _> tm)"
  using assms
proof (induction es "(tn _> tm)" arbitrary: tn tm rule: b_e_typing.induct)
  case (select \<C> t)
  have "ct_list_compat [TAny, TSome T_i32] [TSome t, TSome T_i32]"
    by (simp add: to_ct_list_def ct_list_compat_def)
  thus ?case
    using ct_suffix_extend_ct_list_compat[OF ct_suffix_nil[of "[TSome t]"]] to_ct_list_def
    by auto
next
  case (br_table \<C> ts "is" i t1s t2s)
  show ?case
    using list_all_conv_same_lab[OF br_table]
    by (auto simp add: to_ct_list_def ct_suffix_nil ct_suffix_cons_it)
next
  case (set_global i \<C> t)
  thus ?case
    using to_ct_list_def ct_suffix_refl is_mut_def tg_t_def
    by auto
next
  case (composition \<C> es t1s t2s e t3s)
  thus ?case
    using b_e_type_checker_compose
    by simp
next
  case (weakening \<C> es t1s t2s ts)
  thus ?case
    using b_e_type_checker_weaken
    by simp
qed (auto simp add: to_ct_list_def ct_suffix_refl ct_suffix_nil ct_suffix_cons_it
                    ct_suffix_singleton_any)

theorem b_e_typing_equiv_b_e_type_checker:
  shows "(\<C> \<turnstile> es : tf) = (b_e_type_checker \<C> es tf)"
  using b_e_type_checker_sound b_e_type_checker_complete
  by (metis tf.exhaust)

end


(*  Title:      HOL/Auth/n_mutualEx_lemma_inv__1_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

theory n_mutualEx_lemma_inv__1_on_rules imports n_mutualEx_lemma_on_inv__1
begin
section{*All lemmas on causal relation between inv__1*}
lemma lemma_inv__1_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)"
  shows "invHoldForRule Interp s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule Interp s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__1) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)"
      have "invHoldForRule Interp s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_CritVsinv__1) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)"
      have "invHoldForRule Interp s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_ExitVsinv__1) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)"
      have "invHoldForRule Interp s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_IdleVsinv__1) done
    }

  ultimately show "invHoldForRule Interp s f r (invariants N)"
  by satx
qed

end


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

  Project: IsaNet

  Author:  Tobias Klenze, ETH Zurich <tobias.klenze@inf.ethz.ch>
  Version: JCSPaper.1.0
  Isabelle Version: Isabelle2021-1

  Copyright (c) 2022 Tobias Klenze
  Licence: Mozilla Public License 2.0 (MPL) / BSD-3-Clause (dual license)

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

section \<open>EPIC Level 1 in the Strong Attacker Model\<close>
theory EPIC_L1_SA
  imports
    "../Parametrized_Dataplane_3_directed"
    "../infrastructure/Keys"
begin

type_synonym EPIC_HF = "(unit, msgterm) HF"
type_synonym UINFO = "nat"

locale epic_l1_defs = network_assums_direct _ _ _ auth_seg0
  for auth_seg0 :: "(msgterm \<times> ahi list) set" +
  fixes no_oracle :: "msgterm \<Rightarrow> UINFO \<Rightarrow> bool"
begin

(******************************************************************************)
subsection \<open>Hop validation check and extract functions\<close>
(******************************************************************************)

text\<open>The predicate @{term "hf_valid"} is given to the concrete parametrized model as a parameter.
It ensures the authenticity of the hop authenticator in the hop field. The predicate takes an authenticated
info field (in this model always a numeric value, hence the matching on Num ts), an unauthenticated
info field uinfo, the hop field to be validated and in some cases the next hop field.

We distinguish if there is a next hop field (this yields the two cases below). If there is not, then
the hop authenticator @{text "\<sigma>"} simply consists of a MAC over the authenticated info field and the local
routing information of the hop, using the key of the hop to which the hop field belongs. If on the
other hand, there is a subsequent hop field, then the uhi field of that hop field is also included
in the MAC computation.

The hop authenticator @{text "\<sigma>"} is used to compute both the hop validation field and the uhi field.
The first is computed as a MAC over the path origin (pair of absolute timestamp ts and the relative
timestamp given in uinfo), using the hop authenticator as a key to the MAC. The hop authenticator
is not secret, and any end host can use it to create a valid hvf. The uhi field, according to the
protocol description, is @{text "\<sigma>"} shortened to a few bytes. We model this as applying the hash on @{text "\<sigma>"}.

The predicate @{term "hf_valid"} checks if the hop authenticator, hvf and uhi field are computed
correctly.\<close>
fun hf_valid :: "msgterm \<Rightarrow> UINFO
    \<Rightarrow> EPIC_HF
    \<Rightarrow> EPIC_HF option \<Rightarrow> bool" where
  "hf_valid (Num ts) uinfo \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> (Some \<lparr>AHI = ahi2, UHI = uhi2, HVF = x2\<rparr>) \<longleftrightarrow>
    (\<exists>\<sigma> upif downif. \<sigma> = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif, uhi2]) \<and>
          ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and> uhi = Hash \<sigma> \<and> x = Mac[\<sigma>] \<langle>Num ts, Num uinfo\<rangle>)"
| "hf_valid (Num ts) uinfo \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> None \<longleftrightarrow>
    (\<exists>\<sigma> upif downif. \<sigma> = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif]) \<and>
          ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and> uhi = Hash \<sigma> \<and> x = Mac[\<sigma>] \<langle>Num ts, Num uinfo\<rangle>)"
| "hf_valid _ _ _ _ = False"

definition upd_uinfo :: "nat \<Rightarrow> EPIC_HF \<Rightarrow> nat" where
  "upd_uinfo uinfo hf \<equiv> uinfo"

text\<open>We can extract the entire path from the uhi field, since it includes the hop authenticator,
which includes the local forwarding information as well as, recursively, all upstream hop
authenticators and their hop information.
However, the parametrized model defines the extract function to operate on the hop validation field,
not the uhi field. We therefore define a separate function that extracts the path from a hvf.
We can do so, as both hvf and uhi contain the hop authenticator.
Internally, that function uses @{term "extrUhi"}.\<close>
fun extrUhi :: "msgterm \<Rightarrow> ahi list" where
  "extrUhi (Hash (Mac[macKey asid] (L [ts, upif, downif, uhi2])))
 = \<lparr>UpIF = term2if upif, DownIF = term2if downif, ASID = asid\<rparr> # extrUhi uhi2"
| "extrUhi (Hash (Mac[macKey asid] (L [ts, upif, downif])))
 = [\<lparr>UpIF = term2if upif, DownIF = term2if downif, ASID = asid\<rparr>]"
| "extrUhi _ = []"

text\<open>This function extracts from a hop validation field (HVF hf) the entire path.\<close>
fun extr :: "msgterm \<Rightarrow> ahi list" where
  "extr (Mac[\<sigma>] _) = extrUhi (Hash \<sigma>)"
   | "extr _ = []"

text\<open>Extract the authenticated info field from a hop validation field.\<close>
fun extr_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "extr_ainfo (Mac[_] \<langle>Num ts, _\<rangle>) = Num ts"
| "extr_ainfo _ = \<epsilon>"

abbreviation term_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "term_ainfo \<equiv> id"

text\<open>When observing a hop field, an attacker learns the HVF and the UHI. The AHI only contains
public information that are not terms.\<close>
fun terms_hf :: "EPIC_HF \<Rightarrow> msgterm set" where
  "terms_hf hf = {HVF hf, UHI hf}"

abbreviation terms_uinfo :: "UINFO \<Rightarrow> msgterm set" where
  "terms_uinfo x \<equiv> {}"

text\<open>An authenticated info field is always a number (corresponding to a timestamp). The
     unauthenticated info field is as well a number, representing combination of timestamp offset
     and SRC address.\<close>
definition auth_restrict where
  "auth_restrict ainfo uinfo l \<equiv> (\<exists>ts. ainfo = Num ts)"

text\<open>We now define useful properties of the above definition.\<close>
lemma hf_valid_invert:
  "hf_valid tsn uinfo hf mo \<longleftrightarrow>
   ((\<exists>ahi ahi2 \<sigma> ts upif downif asid x upif2 downif2 asid2 uhi uhi2 x2.
     hf = \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> \<and>
     ASID ahi = asid \<and> ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and>
     mo = Some \<lparr>AHI = ahi2, UHI = uhi2, HVF = x2\<rparr> \<and>
     ASID ahi2 = asid2 \<and> ASIF (DownIF ahi2) downif2 \<and> ASIF (UpIF ahi2) upif2 \<and>
     \<sigma> = Mac[macKey asid] (L [tsn, upif, downif, uhi2]) \<and>
     tsn = Num ts \<and>
     uhi = Hash \<sigma> \<and>
     x = Mac[\<sigma>] \<langle>tsn, Num uinfo\<rangle>)
 \<or> (\<exists>ahi \<sigma> ts upif downif asid uhi x.
     hf = \<lparr>AHI = ahi, UHI = uhi, HVF = x\<rparr> \<and>
     ASID ahi = asid \<and> ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and>
     mo = None \<and>
     \<sigma> = Mac[macKey asid] (L [tsn, upif, downif]) \<and>
     tsn = Num ts \<and>
     uhi = Hash \<sigma> \<and>
     x = Mac[\<sigma>] \<langle>tsn, Num uinfo\<rangle>)
    )"
  apply(auto elim!: hf_valid.elims) using option.exhaust ASIF.simps by metis+

lemma hf_valid_auth_restrict[dest]: "hf_valid ainfo uinfo hf z \<Longrightarrow> auth_restrict ainfo uinfo l"
  by(auto simp add: hf_valid_invert auth_restrict_def)

lemma auth_restrict_ainfo[dest]: "auth_restrict ainfo uinfo l \<Longrightarrow> \<exists>ts. ainfo = Num ts"
  by(auto simp add: auth_restrict_def)

lemma info_hvf:
  assumes "hf_valid ainfo uinfo m z" "HVF m = Mac[\<sigma>] \<langle>ainfo', Num uinfo'\<rangle> \<or> hf_valid ainfo' uinfo' m z'"
  shows "uinfo = uinfo'" "ainfo' = ainfo"
  using assms by(auto simp add: hf_valid_invert)

(******************************************************************************)
subsection\<open>Definitions and properties of the added intruder knowledge\<close>
(******************************************************************************)
text\<open>Here we define two sets which are added to the intruder knowledge: @{text "ik_add"}, which contains hop
authenticators. And @{text "ik_oracle"}, which contains the oracle's output to the strong attacker.\<close>
print_locale dataplane_3_directed_defs
sublocale dataplane_3_directed_defs _ _ _ auth_seg0 hf_valid auth_restrict extr extr_ainfo term_ainfo
                 terms_hf terms_uinfo upd_uinfo no_oracle
  by unfold_locales

abbreviation is_oracle where "is_oracle ainfo t \<equiv> \<not> no_oracle ainfo t "

declare TWu.holds_set_list[dest]
declare TWu.holds_takeW_is_identity[simp]
declare parts_singleton[dest]

text\<open>This additional Intruder Knowledge allows us to model the attacker's access not only to the
hop validation fields and segment identifiers of authorized segments (which are already given in
@{text "ik_hfs"}), but to the underlying hop authenticators that are used to create them.\<close>

definition ik_add :: "msgterm set" where
  "ik_add \<equiv> { \<sigma> | ainfo uinfo l hf \<sigma>.
                 (ainfo::msgterm, l::(EPIC_HF list)) \<in>
                 ((local.auth_seg2 uinfo)::((msgterm \<times> EPIC_HF list) set))
                  \<and> hf \<in> set l \<and> HVF hf = Mac[\<sigma>] \<langle>ainfo, Num uinfo\<rangle> }"

lemma ik_addI:
  "\<lbrakk>(ainfo, l) \<in> local.auth_seg2 uinfo; hf \<in> set l; HVF hf = Mac[\<sigma>] \<langle>ainfo, Num uinfo\<rangle>\<rbrakk> \<Longrightarrow> \<sigma> \<in> ik_add"
  by(auto simp add: ik_add_def)

lemma ik_add_form: "t \<in> local.ik_add \<Longrightarrow> \<exists> asid l . t = Mac[macKey asid] l"
(*  using [[unify_trace_failure]]*)
  by(auto simp add: ik_add_def auth_seg2_def dest!: TWu.holds_set_list)
    (auto simp add: hf_valid_invert)

lemma parts_ik_add[simp]: "parts ik_add = ik_add"
  by (auto intro!: parts_Hash dest: ik_add_form)

text\<open>This is the oracle output provided to the adversary. Only those hop validation fields and
segment identifiers whose path origin (combination of ainfo uinfo) is not contained in
@{term "no_oracle"} appears here.\<close>
definition ik_oracle :: "msgterm set" where
  "ik_oracle = {t | t ainfo hf l uinfo . hf \<in> set l \<and> hfs_valid_None ainfo uinfo l \<and>
                    is_oracle ainfo uinfo \<and> (\<forall>uinfo' . (ainfo, l) \<notin> auth_seg2 uinfo') \<and>
                   (t = HVF hf \<or> t = UHI hf) }"

lemma ik_oracle_parts_form:
"t \<in> ik_oracle \<Longrightarrow>
  (\<exists> asid l ainfo uinfo . t = Mac[Mac[macKey asid] l] \<langle>ainfo, uinfo\<rangle>) \<or>
  (\<exists> asid l . t = Hash (Mac[macKey asid] l))"
  by(auto simp add: ik_oracle_def hf_valid_invert dest!: TWu.holds_set_list)

lemma parts_ik_oracle[simp]: "parts ik_oracle = ik_oracle"
  by (auto intro!: parts_Hash dest: ik_oracle_parts_form)

lemma ik_oracle_simp: "t \<in> ik_oracle \<longleftrightarrow>
      (\<exists>ainfo hf l uinfo. hf \<in> set l \<and> hfs_valid_None ainfo uinfo l \<and> is_oracle ainfo uinfo
                       \<and> (\<forall>uinfo'. (ainfo, l) \<notin> auth_seg2 uinfo') \<and> (t = HVF hf \<or> t = UHI hf))"
  by(rule iffI, frule ik_oracle_parts_form)
    (auto simp add: ik_oracle_def hf_valid_invert)

(******************************************************************************)
subsection\<open>Properties of the intruder knowledge, including @{text "ik_add"} and  @{text "ik_oracle"}\<close>
(******************************************************************************)
text\<open>We now instantiate the parametrized model's definition of the intruder knowledge, using the
definitions of @{text "ik_add"} and  @{text "ik_oracle"} from above. We then prove the properties
that we need to instantiate the @{text "dataplane_3_directed"} locale.\<close>
sublocale
  dataplane_3_directed_ik_defs _ _ _ auth_seg0 terms_uinfo no_oracle hf_valid auth_restrict extr extr_ainfo term_ainfo
                  terms_hf upd_uinfo ik_add ik_oracle
  by unfold_locales

lemma ik_hfs_form: "t \<in> parts ik_hfs \<Longrightarrow> \<exists> t' . t = Hash t'"
  by(auto 3 4 simp add: auth_seg2_def hf_valid_invert)

declare ik_hfs_def[simp del]

lemma parts_ik_hfs[simp]: "parts ik_hfs = ik_hfs"
  by (auto intro!: parts_Hash ik_hfs_form)

text\<open>This lemma allows us not only to expand the definition of @{term "ik_hfs"}, but also
to obtain useful properties, such as a term being a Hash, and it being part of a valid hop field.\<close>
lemma ik_hfs_simp:
  "t \<in> ik_hfs \<longleftrightarrow> (\<exists>t' . t = Hash t') \<and> (\<exists>hf . (t = HVF hf \<or> t = UHI hf)
                    \<and> (\<exists>hfs. hf \<in> set hfs \<and> (\<exists>ainfo uinfo . (ainfo, hfs) \<in> auth_seg2 uinfo
                    \<and> (\<exists>nxt. hf_valid ainfo uinfo hf nxt))))" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume asm: "?lhs"
  then obtain ainfo uinfo hf hfs where
    dfs: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo" "t = HVF hf \<or> t = UHI hf"
    by(auto simp add: ik_hfs_def)
  then have "hfs_valid_None ainfo uinfo hfs"  "(ainfo, AHIS hfs) \<in> auth_seg0"
    by(auto simp add: auth_seg2_def)
  then show "?rhs" using asm dfs
    using upd_uinfo_def
    by (auto 3 4 simp add: auth_seg2_def intro!: ik_hfs_form exI[of _ hf] exI[of _ hfs]
                     dest: TWu.holds_set_list_no_update)
qed(auto simp add: ik_hfs_def)

(******************************************************************************)
subsubsection \<open>Properties of Intruder Knowledge\<close>
(******************************************************************************)
lemma auth_ainfo[dest]: "\<lbrakk>(ainfo, hfs) \<in> auth_seg2 uinfo\<rbrakk> \<Longrightarrow> \<exists> ts . ainfo = Num ts"
  by(auto simp add: auth_seg2_def)

text \<open>There are no ciphertexts (or signatures) in @{term "parts ik"}. Thus, @{term "analz ik"}
and @{term "parts ik"} are identical.\<close>
lemma analz_parts_ik[simp]: "analz ik = parts ik"
  apply(rule no_crypt_analz_is_parts)
  by(auto simp add: ik_def auth_seg2_def auth_restrict_def ik_hfs_simp)
    (auto simp add: ik_add_def ik_oracle_def auth_seg2_def hf_valid_invert hfs_valid_prefix_generic_def
          dest!: TWu.holds_set_list)

lemma parts_ik[simp]: "parts ik = ik"
  by(auto 3 4 simp add: ik_def auth_seg2_def auth_restrict_def dest!: parts_singleton_set)

lemma key_ik_bad: "Key (macK asid) \<in> ik \<Longrightarrow> asid \<in> bad"
  by(auto simp add: ik_def hf_valid_invert ik_oracle_simp)
    (auto 3 4 simp add: auth_seg2_def ik_hfs_simp ik_add_def hf_valid_invert)

(******************************************************************************)
subsubsection\<open>Hop authenticators are agnostic to uinfo field\<close>
(******************************************************************************)
text\<open>Those hop validation fields contained in @{term "auth_seg2"} or that can be generated from the hop
authenticators in @{text "ik_add"} have the property that they are agnostic about the uinfo field. If a
hop validation field is contained in @{term "auth_seg2"} (resp. derivable from @{text "ik_add"}),
then a field with a different uinfo is also contained (resp. derivable).
To show this, we first define a function that updates uinfo in a hop validation field.\<close>
fun uinfo_change_hf :: "UINFO \<Rightarrow> EPIC_HF \<Rightarrow> EPIC_HF" where
  "uinfo_change_hf new_uinfo hf =
    (case HVF hf of Mac[\<sigma>] \<langle>ainfo, uinfo\<rangle> \<Rightarrow> hf\<lparr>HVF := Mac[\<sigma>] \<langle>ainfo, Num new_uinfo\<rangle>\<rparr> | _ \<Rightarrow> hf)"

fun uinfo_change :: "UINFO \<Rightarrow> EPIC_HF list \<Rightarrow> EPIC_HF list" where
  "uinfo_change new_uinfo hfs = map (uinfo_change_hf new_uinfo) hfs"

lemma uinfo_change_valid:
  "hfs_valid ainfo uinfo l nxt \<Longrightarrow> hfs_valid ainfo new_uinfo (uinfo_change new_uinfo l) nxt"
  apply(induction l nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
  apply auto
  subgoal for info x y ys nxt
    by(cases "map (uinfo_change_hf new_uinfo) ys")
      (cases info, auto 3 4 simp add: TWu.holds_split_tail hf_valid_invert upd_uinfo_def)+
  by(auto 3 4 simp add: TWu.holds_split_tail hf_valid_invert TWu.holds.simps upd_uinfo_def)

lemma uinfo_change_hf_AHI: "AHI (uinfo_change_hf new_uinfo hf) = AHI hf"
  apply(cases "HVF hf") apply auto
  subgoal for x apply(cases x) apply auto
    subgoal for x1 x2 apply(cases x2) by auto
    done
  done

lemma uinfo_change_hf_AHIS[simp]: "AHIS (map (uinfo_change_hf new_uinfo) l) = AHIS l"
  apply(induction l) using uinfo_change_hf_AHI by auto

lemma uinfo_change_auth_seg2:
  assumes "hf_valid ainfo uinfo m z" "\<sigma> = Mac[Key (macK asid)] j"
          "HVF m = Mac[\<sigma>] \<langle>ainfo, Num uinfo'\<rangle>" "\<sigma> \<in> ik_add" "no_oracle ainfo uinfo"
  shows "\<exists>hfs. m \<in> set hfs \<and> (\<exists>uinfo''. (ainfo, hfs) \<in> auth_seg2 uinfo'')"
proof-
  from assms(4) obtain ainfo_add uinfo_add l_add hf_add where
    "(ainfo_add, l_add) \<in> auth_seg2 uinfo_add" "hf_add \<in> set l_add" "HVF hf_add = Mac[\<sigma>] \<langle>ainfo_add, Num uinfo_add\<rangle>"
    by(auto simp add: ik_add_def)
  then have add: "m \<in> set (uinfo_change uinfo l_add)" "(ainfo_add, (uinfo_change uinfo l_add)) \<in> auth_seg2 uinfo"
    using assms(1-3,5) apply(auto simp add: auth_seg2_def simp del: AHIS_def)
       apply(auto simp add: hf_valid_invert intro!: image_eqI dest!: TWu.holds_set_list)[1]
       apply(auto simp add: auth_restrict_def intro!: exI elim: ahi_eq dest: uinfo_change_valid simp del: AHIS_def)
    by(auto simp add: hf_valid_invert upd_uinfo_def dest!: TWu.holds_set_list_no_update)
  then have "ainfo_add = ainfo"
    using assms(1) by(auto simp add: auth_seg2_def dest!: TWu.holds_set_list dest: info_hvf)
  then show ?thesis using add by fastforce
qed

lemma MAC_synth_oracle:
  assumes "hf_valid ainfo uinfo m z" "HVF m \<in> ik_oracle"
  shows "is_oracle ainfo uinfo"
  using assms
  by(auto simp add: ik_oracle_def assms(1) hf_valid_invert upd_uinfo_def
             dest!: TWu.holds_set_list_no_update)

lemma ik_oracle_is_oracle:
  "\<lbrakk>Mac[\<sigma>] \<langle>ainfo, Num uinfo\<rangle> \<in> ik_oracle\<rbrakk> \<Longrightarrow> is_oracle ainfo uinfo"
  by (auto simp add: ik_oracle_def dest: info_hvf)
     (auto dest!: TWu.holds_set_list_no_update simp add: hf_valid_invert upd_uinfo_def)

lemma MAC_synth_helper:
"\<lbrakk>hf_valid ainfo uinfo m z; no_oracle ainfo uinfo;
  HVF m = Mac[\<sigma>] \<langle>ainfo, Num uinfo\<rangle>; \<sigma> = Mac[Key (macK asid)] j; \<sigma> \<in> ik \<or> HVF m \<in> ik\<rbrakk>
       \<Longrightarrow> \<exists>hfs. m \<in> set hfs \<and> (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
  apply(auto simp add: ik_def ik_hfs_simp
                 dest: MAC_synth_oracle ik_add_form ik_oracle_parts_form[simplified])
  prefer 3 subgoal by(auto elim!: uinfo_change_auth_seg2)
  prefer 3 subgoal by(auto elim!: uinfo_change_auth_seg2 intro: ik_addI dest: info_hvf HOL.sym)
  by(auto simp add: hf_valid_invert)

text\<open>This definition helps with the limiting the number of cases generated. We don't require it,
but it is convenient. Given a hop validation field and an asid, return if the hvf has the expected
format.\<close>
definition mac_format :: "msgterm \<Rightarrow> as \<Rightarrow> bool" where
  "mac_format m asid \<equiv> \<exists> j ts uinfo . m = Mac[Mac[macKey asid] j] \<langle>Num ts, uinfo\<rangle>"

text\<open>If a valid hop field is derivable by the attacker, but does not belong to the attacker, and is
over a path origin that does not belong to an oracle query, then the hop field is already
contained in the set of authorized segments.\<close>
lemma MAC_synth:
  assumes "hf_valid ainfo uinfo m z" "HVF m \<in> synth ik" "mac_format (HVF m) asid"
    "asid \<notin> bad" "no_oracle ainfo uinfo"
  shows "\<exists>hfs . m \<in> set hfs \<and> (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
  using assms
  apply(auto simp add: mac_format_def elim!: MAC_synth_helper dest!: key_ik_bad)
  apply(auto simp add: ik_def ik_hfs_simp dest: ik_add_form dest!: ik_oracle_parts_form) (* takes a few seconds *)
  using assms(1) by(auto dest: info_hvf simp add: hf_valid_invert)

(******************************************************************************)
subsection\<open>Direct proof goals for interpretation of @{text "dataplane_3_directed"}\<close>
(******************************************************************************)

lemma COND_honest_hf_analz:
  assumes "ASID (AHI hf) \<notin> bad" "hf_valid ainfo uinfo hf nxt" "terms_hf hf \<subseteq> synth (analz ik)"
    "no_oracle ainfo uinfo"
    shows "terms_hf hf \<subseteq> analz ik"
proof-
  let ?asid = "ASID (AHI hf)"
  from assms(3) have hf_synth_ik: "HVF hf \<in> synth ik" "UHI hf \<in> synth ik" by auto
  from assms(2) have "mac_format (HVF hf) ?asid"
    by(auto simp add: mac_format_def hf_valid_invert)
  then obtain hfs uinfo where "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo"
    using assms(1,2,4) hf_synth_ik by(auto dest!: MAC_synth)
  then have "HVF hf \<in> ik" "UHI hf \<in> ik"
    using assms(2)
    by(auto simp add: ik_hfs_def intro!: ik_ik_hfs intro!: exI)
  then show ?thesis by auto
qed

lemma COND_terms_hf:
  assumes "hf_valid ainfo uinfo hf z" and "HVF hf \<in> ik" and "no_oracle ainfo uinfo"
  shows "\<exists>hfs. hf \<in> set hfs \<and> (\<exists>uinfo . (ainfo, hfs) \<in> auth_seg2 uinfo)"
proof-
  obtain hfs ainfo where hfs_def: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo"
  using assms by(auto 3 4 simp add: hf_valid_invert ik_hfs_simp ik_def dest: ahi_eq
                             dest!: ik_oracle_is_oracle ik_add_form)
  then obtain hfs ainfo where hfs_def: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo" by auto
  show ?thesis
    using hfs_def apply (auto simp add: auth_seg2_def dest!: TWu.holds_set_list)
    using hfs_def assms(1) by (auto simp add: auth_seg2_def dest: info_hvf)
qed

lemma COND_extr_prefix_path:
  "\<lbrakk>hfs_valid ainfo uinfo l nxt; nxt = None\<rbrakk> \<Longrightarrow> prefix (extr_from_hd l) (AHIS l)"
  by(induction l nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
    (auto simp add: upd_uinfo_def TWu.holds_split_tail TWu.holds.simps(1) hf_valid_invert,
     auto split: list.split_asm simp add: hf_valid_invert intro!: ahi_eq elim: ASIF.elims)

lemma COND_path_prefix_extr:
  "prefix (AHIS (hfs_valid_prefix ainfo uinfo l nxt))
          (extr_from_hd l)"
  apply(induction l nxt rule: TWu.takeW.induct[where ?Pa="hf_valid ainfo",where ?upd=upd_uinfo])
  by(auto simp add: upd_uinfo_def TWu.takeW_split_tail TWu.takeW.simps(1))
    (auto 3 4 simp add: hf_valid_invert intro!: ahi_eq elim: ASIF.elims)

lemma COND_hf_valid_uinfo:
  "\<lbrakk>hf_valid ainfo uinfo hf nxt; hf_valid ainfo' uinfo' hf nxt'\<rbrakk> \<Longrightarrow> uinfo' = uinfo"
  by(auto dest: info_hvf)

lemma COND_upd_uinfo_ik:
    "\<lbrakk>terms_uinfo uinfo \<subseteq> synth (analz ik); terms_hf hf \<subseteq> synth (analz ik)\<rbrakk>
    \<Longrightarrow> terms_uinfo (upd_uinfo uinfo hf) \<subseteq> synth (analz ik)"
  by (auto simp add: upd_uinfo_def)

lemma COND_upd_uinfo_no_oracle:
  "no_oracle ainfo uinfo \<Longrightarrow> no_oracle ainfo (upd_uinfo uinfo fld)"
  by (auto simp add: upd_uinfo_def)

lemma COND_auth_restrict_upd:
      "auth_restrict ainfo uinfo (x#y#hfs)
   \<Longrightarrow> auth_restrict ainfo (upd_uinfo uinfo y) (y#hfs)"
  by (auto simp add: auth_restrict_def upd_uinfo_def)

(******************************************************************************)
subsection\<open>Instantiation of @{text "dataplane_3_directed"} locale\<close>
(******************************************************************************)
print_locale dataplane_3_directed
sublocale
  dataplane_3_directed _ _ _ auth_seg0 terms_uinfo terms_hf hf_valid auth_restrict extr extr_ainfo term_ainfo
            upd_uinfo ik_add
            ik_oracle no_oracle
  apply unfold_locales
  using COND_terms_hf COND_honest_hf_analz COND_extr_prefix_path
  COND_path_prefix_extr COND_hf_valid_uinfo COND_upd_uinfo_ik COND_upd_uinfo_no_oracle
  COND_auth_restrict_upd by auto

end
end


theory Matching
imports Semantics
begin

subsection\<open>Boolean Matcher Algebra\<close>

lemma MatchOr: "matches \<gamma> (MatchOr m1 m2) p \<longleftrightarrow> matches \<gamma> m1 p \<or> matches \<gamma> m2 p"
  by(simp add: MatchOr_def)

lemma opt_MatchAny_match_expr_correct: "matches \<gamma> (opt_MatchAny_match_expr m) = matches \<gamma> m"
 proof -
  have "matches \<gamma> (opt_MatchAny_match_expr_once m) = matches \<gamma> m" for m
   apply(simp add: fun_eq_iff)
   by(induction m rule: opt_MatchAny_match_expr_once.induct) (simp_all)
   thus ?thesis
    apply(simp add: opt_MatchAny_match_expr_def)
    apply(rule repeat_stabilize_induct)
     by(simp)+
 qed

lemma matcheq_matchAny: "\<not> has_primitive m \<Longrightarrow> matcheq_matchAny m \<longleftrightarrow> matches \<gamma> m p"
  by(induction m) simp_all

lemma matcheq_matchNone: "\<not> has_primitive m \<Longrightarrow> matcheq_matchNone m \<longleftrightarrow> \<not> matches \<gamma> m p"
  by(auto dest: matcheq_matchAny matachAny_matchNone)

lemma matcheq_matchNone_not_matches: "matcheq_matchNone m \<Longrightarrow> \<not> matches \<gamma> m p"
  by(induction m rule: matcheq_matchNone.induct) auto

text\<open>Lemmas about matching in the @{const iptables_bigstep} semantics.\<close>

lemma matches_rule_iptables_bigstep:
  assumes "matches \<gamma> m p \<longleftrightarrow> matches \<gamma> m' p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a], s\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow>?r")
proof -
  {
    fix m m'
    assume "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m a], s\<rangle> \<Rightarrow> t" "matches \<gamma> m p \<longleftrightarrow> matches \<gamma> m' p"
    hence "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a], s\<rangle> \<Rightarrow> t"
      by (induction "[Rule  m a]" s t rule: iptables_bigstep_induct)
         (auto intro: iptables_bigstep.intros simp: Cons_eq_append_conv dest: skipD)
  }
  with assms show ?thesis by blast
qed

lemma matches_rule_and_simp_help:
  assumes "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m m') a'], Undecided\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a'], Undecided\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow>?r")
proof
  assume ?l thus ?r
    by (induction "[Rule (MatchAnd m m') a']" Undecided t rule: iptables_bigstep_induct)
       (auto intro: iptables_bigstep.intros simp: assms Cons_eq_append_conv dest: skipD)
next
  assume ?r thus ?l
    by (induction "[Rule m' a']" Undecided t rule: iptables_bigstep_induct)
       (auto intro: iptables_bigstep.intros simp: assms Cons_eq_append_conv dest: skipD)
qed

lemma matches_MatchNot_simp:
  assumes "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchNot m) a], Undecided\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[], Undecided\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow> ?r")
proof
  assume ?l thus ?r
    by (induction "[Rule (MatchNot m) a]" "Undecided" t rule: iptables_bigstep_induct)
       (auto intro: iptables_bigstep.intros simp: assms Cons_eq_append_conv dest: skipD)
next
  assume ?r
  hence "t = Undecided"
    by (metis skipD)
  with assms show ?l
    by (fastforce intro: nomatch)
qed

lemma matches_MatchNotAnd_simp:
  assumes "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd (MatchNot m) m') a], Undecided\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[], Undecided\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow> ?r")
proof
  assume ?l thus ?r
    by (induction "[Rule (MatchAnd (MatchNot m) m') a]" "Undecided" t rule: iptables_bigstep_induct)
       (auto intro: iptables_bigstep.intros simp add: assms Cons_eq_append_conv dest: skipD)
next
  assume ?r
  hence "t = Undecided"
    by (metis skipD)
  with assms show ?l
    by (fastforce intro: nomatch)
qed

lemma matches_rule_and_simp:
  assumes "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m m') a'], s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a'], s\<rangle> \<Rightarrow> t"
proof (cases s)
  case Undecided
  with assms show ?thesis
    by (simp add: matches_rule_and_simp_help)
next
  case Decision
  thus ?thesis by (metis decision decisionD)
qed

lemma iptables_bigstep_MatchAnd_comm:
  "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m1 m2) a], s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m2 m1) a], s\<rangle> \<Rightarrow> t"
proof -
  { fix m1 m2
    have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m1 m2) a], s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m2 m1) a], s\<rangle> \<Rightarrow> t"
      proof (induction "[Rule (MatchAnd m1 m2) a]" s t rule: iptables_bigstep_induct)
        case Seq thus ?case
          by (metis Nil_is_append_conv append_Nil butlast_append butlast_snoc seq)
      qed (auto intro: iptables_bigstep.intros)
  }
  thus ?thesis by blast
qed

subsection\<open>Add match\<close>

definition add_match :: "'a match_expr \<Rightarrow> 'a rule list \<Rightarrow> 'a rule list" where
  "add_match m rs = map (\<lambda>r. case r of Rule m' a' \<Rightarrow> Rule (MatchAnd m m') a') rs"

lemma add_match_split: "add_match m (rs1@rs2) = add_match m rs1 @ add_match m rs2"
  unfolding add_match_def
  by (fact map_append)

lemma add_match_split_fst: "add_match m (Rule m' a' # rs) = Rule (MatchAnd m m') a' # add_match m rs"
  unfolding add_match_def
  by simp

lemma add_match_distrib:
  "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m1 (add_match m2 rs), s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m2 (add_match m1 rs), s\<rangle> \<Rightarrow> t"
proof -
  {
    fix m1 m2
    have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m1 (add_match m2 rs), s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m2 (add_match m1 rs), s\<rangle> \<Rightarrow> t"
      proof (induction rs arbitrary: s)
        case Nil thus ?case by (simp add: add_match_def)
        next
        case (Cons r rs)
        from Cons obtain m a where r: "r = Rule m a" by (cases r) simp
        with Cons.prems obtain ti where 1: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m1 (MatchAnd m2 m)) a], s\<rangle> \<Rightarrow> ti" and 2: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m1 (add_match m2 rs), ti\<rangle> \<Rightarrow> t"
          apply(simp add: add_match_split_fst)
          apply(erule seqE_cons)
          by simp
        from 1 r have base: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m2 (MatchAnd m1 m)) a], s\<rangle> \<Rightarrow> ti"
           by (metis matches.simps(1) matches_rule_iptables_bigstep)
        from 2 Cons.IH have IH: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m2 (add_match m1 rs), ti\<rangle> \<Rightarrow> t" by simp
        from base IH seq'_cons have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule (MatchAnd m2 (MatchAnd m1 m)) a # add_match m2 (add_match m1 rs), s\<rangle> \<Rightarrow> t" by fast
        thus ?case using r by(simp add: add_match_split_fst[symmetric])
      qed
  }
  thus ?thesis by blast
qed

lemma add_match_split_fst': "add_match m (a # rs) = add_match m [a] @ add_match m rs"
  by (simp add: add_match_split[symmetric])

lemma matches_add_match_simp:
  assumes m: "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow> ?r")
  proof
    assume ?l with m show ?r
      proof (induction rs)
        case Nil
        thus ?case
          unfolding add_match_def by simp
      next
        case (Cons r rs)
        hence IH: "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t" by(simp add: add_match_split_fst)
        obtain m' a where r: "r = Rule m' a" by (cases r)
        with Cons.prems(2) obtain ti where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m m') a], s\<rangle> \<Rightarrow> ti" and "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, ti\<rangle> \<Rightarrow> t"
          by(auto elim:seqE_cons simp add: add_match_split_fst)
        with Cons.prems(1) IH have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a], s\<rangle> \<Rightarrow> ti" by(simp add: matches_rule_and_simp)
        with \<open>\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, ti\<rangle> \<Rightarrow> t\<close> IH r show ?case by(metis decision state.exhaust iptables_bigstep_deterministic seq_cons)
      qed
  next
    assume ?r with m show ?l
      proof (induction rs)
        case Nil
        thus ?case
          unfolding add_match_def by simp
      next
        case (Cons r rs)
        hence IH: " \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, s\<rangle> \<Rightarrow> t" by(simp add: add_match_split_fst)
        obtain m' a where r: "r = Rule m' a" by (cases r)
        with Cons.prems(2) obtain ti where "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule m' a], s\<rangle> \<Rightarrow> ti" and "\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, ti\<rangle> \<Rightarrow> t"
          by(auto elim:seqE_cons simp add: add_match_split_fst)
        with Cons.prems(1) IH have "\<Gamma>,\<gamma>,p\<turnstile> \<langle>[Rule (MatchAnd m m') a], s\<rangle> \<Rightarrow> ti" by(simp add: matches_rule_and_simp)
        with \<open>\<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, ti\<rangle> \<Rightarrow> t\<close> IH r show ?case
          apply(simp add: add_match_split_fst)
          by(metis decision state.exhaust iptables_bigstep_deterministic seq_cons)
      qed
  qed

lemma matches_add_match_MatchNot_simp:
  assumes m: "matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match (MatchNot m) rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[], s\<rangle> \<Rightarrow> t" (is "?l s \<longleftrightarrow> ?r s")
  proof (cases s)
    case Undecided
    have "?l Undecided \<longleftrightarrow> ?r Undecided"
      proof
        assume "?l Undecided" with m show "?r Undecided"
          proof (induction rs)
            case Nil
            thus ?case
              unfolding add_match_def by simp
          next
            case (Cons r rs)
            thus ?case
              by (cases r) (metis matches_MatchNotAnd_simp skipD seqE_cons add_match_split_fst)
          qed
      next
        assume "?r Undecided" with m show "?l Undecided"
          proof (induction rs)
            case Nil
            thus ?case
              unfolding add_match_def by simp
          next
            case (Cons r rs)
            thus ?case
              by (cases r) (metis matches_MatchNotAnd_simp skipD seq'_cons add_match_split_fst)
          qed
      qed
    with Undecided show ?thesis by fast
  next
    case (Decision d)
    thus ?thesis
      by(metis decision decisionD)
  qed

lemma not_matches_add_match_simp:
  assumes "\<not> matches \<gamma> m p"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, Undecided\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>[], Undecided\<rangle> \<Rightarrow> t"
  proof(induction rs)
    case Nil
    thus ?case
      unfolding add_match_def by simp
  next
    case (Cons r rs)
    thus ?case
      by (cases r) (metis assms add_match_split_fst matches.simps(1) nomatch seq'_cons nomatchD seqE_cons)
  qed

lemma iptables_bigstep_add_match_notnot_simp:
  "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match (MatchNot (MatchNot m)) rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m rs, s\<rangle> \<Rightarrow> t"
  proof(induction rs)
    case Nil
    thus ?case
      unfolding add_match_def by simp
  next
    case (Cons r rs)
    thus ?case
      by (cases r)
         (metis decision decisionD state.exhaust matches.simps(2) matches_add_match_simp not_matches_add_match_simp)
  qed

lemma add_match_match_not_cases:
  "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match (MatchNot m) rs, Undecided\<rangle> \<Rightarrow> Undecided \<Longrightarrow> matches \<gamma> m p \<or> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, Undecided\<rangle> \<Rightarrow> Undecided"
  by (metis matches.simps(2) matches_add_match_simp)

lemma not_matches_add_matchNot_simp:
  "\<not> matches \<gamma> m p \<Longrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match (MatchNot m) rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
  by (simp add: matches_add_match_simp)

lemma iptables_bigstep_add_match_and:
  "\<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match m1 (add_match m2 rs), s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>add_match (MatchAnd m1 m2) rs, s\<rangle> \<Rightarrow> t"
  proof(induction rs arbitrary: s t)
    case Nil
    thus ?case
      unfolding add_match_def by simp
  next
    case(Cons r rs)
    show ?case
    proof (cases r, simp only: add_match_split_fst)
      fix m a
      show "\<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule (MatchAnd m1 (MatchAnd m2 m)) a # add_match m1 (add_match m2 rs), s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>Rule (MatchAnd (MatchAnd m1 m2) m) a # add_match (MatchAnd m1 m2) rs, s\<rangle> \<Rightarrow> t" (is "?l \<longleftrightarrow> ?r")
      proof
        assume ?l with Cons.IH show ?r
          apply -
          apply(erule seqE_cons)
          apply(case_tac s)
          apply(case_tac ti)
          apply (metis matches.simps(1) matches_rule_and_simp matches_rule_and_simp_help nomatch seq'_cons)
          apply (metis add_match_split_fst matches.simps(1) matches_add_match_simp not_matches_add_match_simp seq_cons)
          apply (metis decision decisionD)
          done
      next
        assume ?r with Cons.IH show ?l
          apply -
          apply(erule seqE_cons)
          apply(case_tac s)
          apply(case_tac ti)
          apply (metis matches.simps(1) matches_rule_and_simp matches_rule_and_simp_help nomatch seq'_cons)
          apply (metis add_match_split_fst matches.simps(1) matches_add_match_simp not_matches_add_match_simp seq_cons)
          apply (metis decision decisionD)
          done
        qed
    qed
  qed

lemma optimize_matches_option_generic:
  assumes "\<forall> r \<in> set rs. P (get_match r)"
      and "(\<And>m m'. P m \<Longrightarrow> f m = Some m' \<Longrightarrow> matches \<gamma> m' p = matches \<gamma> m p)"
      and "(\<And>m. P m \<Longrightarrow> f m = None \<Longrightarrow> \<not> matches \<gamma> m p)"
  shows "\<Gamma>,\<gamma>,p\<turnstile> \<langle>optimize_matches_option f rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
      (is "?lhs \<longleftrightarrow> ?rhs")
  proof
    assume ?rhs
    from this assms show ?lhs
    apply(induction rs s t rule: iptables_bigstep_induct)
    apply(auto simp: optimize_matches_option_append intro: iptables_bigstep.intros split: option.split)
    done
  next
    assume ?lhs
    from this assms show ?rhs
    apply(induction f rs arbitrary: s rule: optimize_matches_option.induct)
     apply(simp; fail)
    apply(simp split: option.split_asm)
     apply(subgoal_tac "\<not> matches \<gamma> m p")
     prefer 2 apply blast
    apply (metis decision nomatch seq'_cons state.exhaust)
    apply(erule seqE_cons)
    apply(rule_tac t=ti in seq'_cons)
     apply (meson matches_rule_iptables_bigstep)
    by blast
  qed

lemma optimize_matches_generic: "\<forall> r \<in> set rs. P (get_match r) \<Longrightarrow>
      (\<And>m. P m \<Longrightarrow> matches \<gamma> (f m) p = matches \<gamma> m p) \<Longrightarrow>
      \<Gamma>,\<gamma>,p\<turnstile> \<langle>optimize_matches f rs, s\<rangle> \<Rightarrow> t \<longleftrightarrow> \<Gamma>,\<gamma>,p\<turnstile> \<langle>rs, s\<rangle> \<Rightarrow> t"
  unfolding optimize_matches_def
  apply(rule optimize_matches_option_generic)
    apply(simp; fail)
   apply(simp split: if_split_asm)
   apply blast
  apply(simp split: if_split_asm)
  using matcheq_matchNone_not_matches by fast
end