(*  Title:      HOL/BNF_Fixpoint_Base.thy
    Author:     Lorenz Panny, TU Muenchen
    Author:     Dmitriy Traytel, TU Muenchen
    Author:     Jasmin Blanchette, TU Muenchen
    Author:     Martin Desharnais, TU Muenchen
    Copyright   2012, 2013, 2014

Shared fixpoint operations on bounded natural functors.
*)

section \<open>Shared Fixpoint Operations on Bounded Natural Functors\<close>

theory BNF_Fixpoint_Base
imports BNF_Composition Basic_BNFs
begin

lemma conj_imp_eq_imp_imp: "(P \<and> Q \<Longrightarrow> PROP R) \<equiv> (P \<Longrightarrow> Q \<Longrightarrow> PROP R)"
  by standard simp_all

lemma predicate2D_conj: "P \<le> Q \<and> R \<Longrightarrow> R \<and> (P x y \<longrightarrow> Q x y)"
  by blast

lemma eq_sym_Unity_conv: "(x = (() = ())) = x"
  by blast

lemma case_unit_Unity: "(case u of () \<Rightarrow> f) = f"
  by (cases u) (hypsubst, rule unit.case)

lemma case_prod_Pair_iden: "(case p of (x, y) \<Rightarrow> (x, y)) = p"
  by simp

lemma unit_all_impI: "(P () \<Longrightarrow> Q ()) \<Longrightarrow> \<forall>x. P x \<longrightarrow> Q x"
  by simp

lemma pointfree_idE: "f \<circ> g = id \<Longrightarrow> f (g x) = x"
  unfolding comp_def fun_eq_iff by simp

lemma o_bij:
  assumes gf: "g \<circ> f = id" and fg: "f \<circ> g = id"
  shows "bij f"
unfolding bij_def inj_on_def surj_def proof safe
  fix a1 a2 assume "f a1 = f a2"
  hence "g ( f a1) = g (f a2)" by simp
  thus "a1 = a2" using gf unfolding fun_eq_iff by simp
next
  fix b
  have "b = f (g b)"
  using fg unfolding fun_eq_iff by simp
  thus "EX a. b = f a" by blast
qed

lemma case_sum_step:
  "case_sum (case_sum f' g') g (Inl p) = case_sum f' g' p"
  "case_sum f (case_sum f' g') (Inr p) = case_sum f' g' p"
  by auto

lemma obj_one_pointE: "\<forall>x. s = x \<longrightarrow> P \<Longrightarrow> P"
  by blast

lemma type_copy_obj_one_point_absE:
  assumes "type_definition Rep Abs UNIV" "\<forall>x. s = Abs x \<longrightarrow> P" shows P
  using type_definition.Rep_inverse[OF assms(1)]
  by (intro mp[OF spec[OF assms(2), of "Rep s"]]) simp

lemma obj_sumE_f:
  assumes "\<forall>x. s = f (Inl x) \<longrightarrow> P" "\<forall>x. s = f (Inr x) \<longrightarrow> P"
  shows "\<forall>x. s = f x \<longrightarrow> P"
proof
  fix x from assms show "s = f x \<longrightarrow> P" by (cases x) auto
qed

lemma case_sum_if:
  "case_sum f g (if p then Inl x else Inr y) = (if p then f x else g y)"
  by simp

lemma prod_set_simps[simp]:
  "fsts (x, y) = {x}"
  "snds (x, y) = {y}"
  unfolding prod_set_defs by simp+

lemma sum_set_simps[simp]:
  "setl (Inl x) = {x}"
  "setl (Inr x) = {}"
  "setr (Inl x) = {}"
  "setr (Inr x) = {x}"
  unfolding sum_set_defs by simp+

lemma Inl_Inr_False: "(Inl x = Inr y) = False"
  by simp

lemma Inr_Inl_False: "(Inr x = Inl y) = False"
  by simp

lemma spec2: "\<forall>x y. P x y \<Longrightarrow> P x y"
  by blast

lemma rewriteR_comp_comp: "\<lbrakk>g \<circ> h = r\<rbrakk> \<Longrightarrow> f \<circ> g \<circ> h = f \<circ> r"
  unfolding comp_def fun_eq_iff by auto

lemma rewriteR_comp_comp2: "\<lbrakk>g \<circ> h = r1 \<circ> r2; f \<circ> r1 = l\<rbrakk> \<Longrightarrow> f \<circ> g \<circ> h = l \<circ> r2"
  unfolding comp_def fun_eq_iff by auto

lemma rewriteL_comp_comp: "\<lbrakk>f \<circ> g = l\<rbrakk> \<Longrightarrow> f \<circ> (g \<circ> h) = l \<circ> h"
  unfolding comp_def fun_eq_iff by auto

lemma rewriteL_comp_comp2: "\<lbrakk>f \<circ> g = l1 \<circ> l2; l2 \<circ> h = r\<rbrakk> \<Longrightarrow> f \<circ> (g \<circ> h) = l1 \<circ> r"
  unfolding comp_def fun_eq_iff by auto

lemma convol_o: "\<langle>f, g\<rangle> \<circ> h = \<langle>f \<circ> h, g \<circ> h\<rangle>"
  unfolding convol_def by auto

lemma map_prod_o_convol: "map_prod h1 h2 \<circ> \<langle>f, g\<rangle> = \<langle>h1 \<circ> f, h2 \<circ> g\<rangle>"
  unfolding convol_def by auto

lemma map_prod_o_convol_id: "(map_prod f id \<circ> \<langle>id, g\<rangle>) x = \<langle>id \<circ> f, g\<rangle> x"
  unfolding map_prod_o_convol id_comp comp_id ..

lemma o_case_sum: "h \<circ> case_sum f g = case_sum (h \<circ> f) (h \<circ> g)"
  unfolding comp_def by (auto split: sum.splits)

lemma case_sum_o_map_sum: "case_sum f g \<circ> map_sum h1 h2 = case_sum (f \<circ> h1) (g \<circ> h2)"
  unfolding comp_def by (auto split: sum.splits)

lemma case_sum_o_map_sum_id: "(case_sum id g \<circ> map_sum f id) x = case_sum (f \<circ> id) g x"
  unfolding case_sum_o_map_sum id_comp comp_id ..

lemma rel_fun_def_butlast:
  "rel_fun R (rel_fun S T) f g = (\<forall>x y. R x y \<longrightarrow> (rel_fun S T) (f x) (g y))"
  unfolding rel_fun_def ..

lemma subst_eq_imp: "(\<forall>a b. a = b \<longrightarrow> P a b) \<equiv> (\<forall>a. P a a)"
  by auto

lemma eq_subset: "op = \<le> (\<lambda>a b. P a b \<or> a = b)"
  by auto

lemma eq_le_Grp_id_iff: "(op = \<le> Grp (Collect R) id) = (All R)"
  unfolding Grp_def id_apply by blast

lemma Grp_id_mono_subst: "(\<And>x y. Grp P id x y \<Longrightarrow> Grp Q id (f x) (f y)) \<equiv>
   (\<And>x. x \<in> P \<Longrightarrow> f x \<in> Q)"
  unfolding Grp_def by rule auto

lemma vimage2p_mono: "vimage2p f g R x y \<Longrightarrow> R \<le> S \<Longrightarrow> vimage2p f g S x y"
  unfolding vimage2p_def by blast

lemma vimage2p_refl: "(\<And>x. R x x) \<Longrightarrow> vimage2p f f R x x"
  unfolding vimage2p_def by auto

lemma
  assumes "type_definition Rep Abs UNIV"
  shows type_copy_Rep_o_Abs: "Rep \<circ> Abs = id" and type_copy_Abs_o_Rep: "Abs \<circ> Rep = id"
  unfolding fun_eq_iff comp_apply id_apply
    type_definition.Abs_inverse[OF assms UNIV_I] type_definition.Rep_inverse[OF assms] by simp_all

lemma type_copy_map_comp0_undo:
  assumes "type_definition Rep Abs UNIV"
          "type_definition Rep' Abs' UNIV"
          "type_definition Rep'' Abs'' UNIV"
  shows "Abs' \<circ> M \<circ> Rep'' = (Abs' \<circ> M1 \<circ> Rep) \<circ> (Abs \<circ> M2 \<circ> Rep'') \<Longrightarrow> M1 \<circ> M2 = M"
  by (rule sym) (auto simp: fun_eq_iff type_definition.Abs_inject[OF assms(2) UNIV_I UNIV_I]
    type_definition.Abs_inverse[OF assms(1) UNIV_I]
    type_definition.Abs_inverse[OF assms(3) UNIV_I] dest: spec[of _ "Abs'' x" for x])

lemma vimage2p_id: "vimage2p id id R = R"
  unfolding vimage2p_def by auto

lemma vimage2p_comp: "vimage2p (f1 \<circ> f2) (g1 \<circ> g2) = vimage2p f2 g2 \<circ> vimage2p f1 g1"
  unfolding fun_eq_iff vimage2p_def o_apply by simp

lemma vimage2p_rel_fun: "rel_fun (vimage2p f g R) R f g"
  unfolding rel_fun_def vimage2p_def by auto

lemma fun_cong_unused_0: "f = (\<lambda>x. g) \<Longrightarrow> f (\<lambda>x. 0) = g"
  by (erule arg_cong)

lemma inj_on_convol_ident: "inj_on (\<lambda>x. (x, f x)) X"
  unfolding inj_on_def by simp

lemma map_sum_if_distrib_then:
  "\<And>f g e x y. map_sum f g (if e then Inl x else y) = (if e then Inl (f x) else map_sum f g y)"
  "\<And>f g e x y. map_sum f g (if e then Inr x else y) = (if e then Inr (g x) else map_sum f g y)"
  by simp_all

lemma map_sum_if_distrib_else:
  "\<And>f g e x y. map_sum f g (if e then x else Inl y) = (if e then map_sum f g x else Inl (f y))"
  "\<And>f g e x y. map_sum f g (if e then x else Inr y) = (if e then map_sum f g x else Inr (g y))"
  by simp_all

lemma case_prod_app: "case_prod f x y = case_prod (\<lambda>l r. f l r y) x"
  by (case_tac x) simp

lemma case_sum_map_sum: "case_sum l r (map_sum f g x) = case_sum (l \<circ> f) (r \<circ> g) x"
  by (case_tac x) simp+

lemma case_sum_transfer:
  "rel_fun (rel_fun R T) (rel_fun (rel_fun S T) (rel_fun (rel_sum R S) T)) case_sum case_sum"
  unfolding rel_fun_def by (auto split: sum.splits)

lemma case_prod_map_prod: "case_prod h (map_prod f g x) = case_prod (\<lambda>l r. h (f l) (g r)) x"
  by (case_tac x) simp+

lemma case_prod_o_map_prod: "case_prod f \<circ> map_prod g1 g2 = case_prod (\<lambda>l r. f (g1 l) (g2 r))"
  unfolding comp_def by auto

lemma case_prod_transfer:
  "(rel_fun (rel_fun A (rel_fun B C)) (rel_fun (rel_prod A B) C)) case_prod case_prod"
  unfolding rel_fun_def by simp

lemma eq_ifI: "(P \<longrightarrow> t = u1) \<Longrightarrow> (\<not> P \<longrightarrow> t = u2) \<Longrightarrow> t = (if P then u1 else u2)"
  by simp

lemma comp_transfer:
  "rel_fun (rel_fun B C) (rel_fun (rel_fun A B) (rel_fun A C)) (op \<circ>) (op \<circ>)"
  unfolding rel_fun_def by simp

lemma If_transfer: "rel_fun (op =) (rel_fun A (rel_fun A A)) If If"
  unfolding rel_fun_def by simp

lemma Abs_transfer:
  assumes type_copy1: "type_definition Rep1 Abs1 UNIV"
  assumes type_copy2: "type_definition Rep2 Abs2 UNIV"
  shows "rel_fun R (vimage2p Rep1 Rep2 R) Abs1 Abs2"
  unfolding vimage2p_def rel_fun_def
    type_definition.Abs_inverse[OF type_copy1 UNIV_I]
    type_definition.Abs_inverse[OF type_copy2 UNIV_I] by simp

lemma Inl_transfer:
  "rel_fun S (rel_sum S T) Inl Inl"
  by auto

lemma Inr_transfer:
  "rel_fun T (rel_sum S T) Inr Inr"
  by auto

lemma Pair_transfer: "rel_fun A (rel_fun B (rel_prod A B)) Pair Pair"
  unfolding rel_fun_def by simp

lemma eq_onp_live_step: "x = y \<Longrightarrow> eq_onp P a a \<and> x \<longleftrightarrow> P a \<and> y"
  by (simp only: eq_onp_same_args)

lemma top_conj: "top x \<and> P \<longleftrightarrow> P" "P \<and> top x \<longleftrightarrow> P"
  by blast+

lemma fst_convol': "fst (\<langle>f, g\<rangle> x) = f x"
  using fst_convol unfolding convol_def by simp

lemma snd_convol': "snd (\<langle>f, g\<rangle> x) = g x"
  using snd_convol unfolding convol_def by simp

lemma convol_expand_snd: "fst o f = g \<Longrightarrow> \<langle>g, snd o f\<rangle> = f"
  unfolding convol_def by auto

lemma convol_expand_snd':
  assumes "(fst o f = g)"
  shows "h = snd o f \<longleftrightarrow> \<langle>g, h\<rangle> = f"
proof -
  from assms have *: "\<langle>g, snd o f\<rangle> = f" by (rule convol_expand_snd)
  then have "h = snd o f \<longleftrightarrow> h = snd o \<langle>g, snd o f\<rangle>" by simp
  moreover have "\<dots> \<longleftrightarrow> h = snd o f" by (simp add: snd_convol)
  moreover have "\<dots> \<longleftrightarrow> \<langle>g, h\<rangle> = f" by (subst (2) *[symmetric]) (auto simp: convol_def fun_eq_iff)
  ultimately show ?thesis by simp
qed

lemma case_sum_expand_Inr_pointfree: "f o Inl = g \<Longrightarrow> case_sum g (f o Inr) = f"
  by (auto split: sum.splits)

lemma case_sum_expand_Inr': "f o Inl = g \<Longrightarrow> h = f o Inr \<longleftrightarrow> case_sum g h = f"
  by (rule iffI) (auto simp add: fun_eq_iff split: sum.splits)

lemma case_sum_expand_Inr: "f o Inl = g \<Longrightarrow> f x = case_sum g (f o Inr) x"
  by (auto split: sum.splits)

lemma id_transfer: "rel_fun A A id id"
  unfolding rel_fun_def by simp

lemma fst_transfer: "rel_fun (rel_prod A B) A fst fst"
  unfolding rel_fun_def by simp

lemma snd_transfer: "rel_fun (rel_prod A B) B snd snd"
  unfolding rel_fun_def by simp

lemma convol_transfer:
  "rel_fun (rel_fun R S) (rel_fun (rel_fun R T) (rel_fun R (rel_prod S T))) BNF_Def.convol BNF_Def.convol"
  unfolding rel_fun_def convol_def by auto

lemma Let_const: "Let x (\<lambda>_. c) = c"
  unfolding Let_def ..

ML_file "Tools/BNF/bnf_fp_util_tactics.ML"
ML_file "Tools/BNF/bnf_fp_util.ML"
ML_file "Tools/BNF/bnf_fp_def_sugar_tactics.ML"
ML_file "Tools/BNF/bnf_fp_def_sugar.ML"
ML_file "Tools/BNF/bnf_fp_n2m_tactics.ML"
ML_file "Tools/BNF/bnf_fp_n2m.ML"
ML_file "Tools/BNF/bnf_fp_n2m_sugar.ML"

end


section \<open>Implicit Arguments Tests\<close>
theory Implicit_Arguments_Tests
imports "Soft_Types.Soft_Types_HOL"
begin

declare [[trace_soft_types]]

subsection \<open>Example: Implicit arguments for list operations\<close>

text \<open>This example is similar to the one in \<^file>\<open>./Elaboration_Tests.thy\<close>,
but this time the set arguments are hidden from the syntax.\<close>

typedecl set
(*TODO: does not work in experiment environment*)
axiomatization Set :: "set type"
  and Element :: "set \<Rightarrow> set type"
  and list :: "set \<Rightarrow> set"
  and nil :: "set \<Rightarrow> set"
  and cons :: "set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> set"
  and append :: "set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> set"
  where nil_type [type implicit: 1]: "nil : (A : Set) \<Rightarrow> Element (list A)"
  and cons_type [type implicit: 1]: "cons : (A : Set) \<Rightarrow> Element A \<Rightarrow>
    Element (list A) \<Rightarrow> Element (list A)"
  and append_type [type implicit: 1]: "append : (A : Set) \<Rightarrow> Element (list A) \<Rightarrow>
    Element (list A) \<Rightarrow> Element (list A)"

declare [[auto_elaborate]]

lemma "cons x nil = ys" oops

ML \<open>Elaboration.elaborate_terms \<^context> [
  \<^term>\<open>nil = B\<close>
]\<close>

ML \<open>Elaboration.elaborate_terms \<^context> [
  \<^term>\<open>cons x xs\<close>
]\<close>

lemma
  "append (cons x xs) ys = cons x (append xs ys)"
  "append nil ys = ys"
  oops


theory BinTrees = Main:

use tactics

method_setup circular_coinduction = "build_tactic (circular_coinduction_fun)" "all"
method_setup coinduction = "build_tactic (coinduction_fun)" "rule_tac R=?Rzero in ga_cogenerated, instantiate_tac Rzero %s1.?R,step"
method_setup init = "build_tactic (init_fun)" "(simp|(solve,blast))?,init2_fun?"
method_setup breakup = "build_tactic (breakup_fun)" "simp,((exE|conjE)+)?,disjE"
method_setup solve= "build_tactic (solve_fun 1)" "((exE|conjE|conjI)+)?,(simp)?,((exE|conjE|conjI)+)?,(simp)?"
method_setup step = "build_tactic (step_fun)" "((disjI2)+)?,inst r (rcs union (trans r))"
method_setup close= "build_tactic (close_fun)" "((disjI1|disjI2)+)?,((exE|conjE)+)?,force_solve|solve,disji1+,blast"
method_setup close_or_step= "build_tactic (close_or_step_fun)" "close|(solve,(close|(step,solve?,disjI2?,solve?,xy_exi?,solve,close?),((disjI1+)?,blast,close)?))"
method_setup force_finish = "build_tactic (force_finish_fun)" "inst r false,solve1"

typedecl "BinTree"
typedecl "Elem"
consts
"cons" :: "BinTree => Elem => BinTree => BinTree"
"left" :: "BinTree => BinTree"
"mirror" :: "BinTree => BinTree"
"node" :: "BinTree => Elem"
"right" :: "BinTree => BinTree"

consts
  BinRelImage :: "('a => 'b) => ('a => 'a => bool) => ('b => 'b => bool)"
  Trans_BinTree :: "('a => 'a => bool) => ('b => 'b => bool)"
  union :: "('a => 'a => bool)  => ('a => 'a => bool) => ('a => 'a => bool)" (infixl 20)
defs
  BinRelImage_def [simp] : "BinRelImage f R == %x y . EX u v . R u v & x = f u & y = f v"
  Trans_BinTree_def [simp] : "Trans_BinTree R == (BinRelImage left R) union (BinRelImage right R)"
  union_def [simp] : "R union S == % x y . R x y | S x y"

axioms
mirror_left [simp]: "!! bt1 :: BinTree . (left (mirror bt1)) = (mirror (right bt1))"
mirror_node [simp]: "!! bt1 :: BinTree . (node (mirror bt1)) = (node bt1)"
mirror_right [simp]: "!! bt1 :: BinTree . (right (mirror bt1)) = (mirror (left bt1))"
ga_cogenerated_BinTree: "!! R :: BinTree => BinTree => bool . !! u :: BinTree .
!! v :: BinTree . ! x :: BinTree . ! y :: BinTree . ((R x) y) --> (((R (left x))
 (left y)) & (node x) = (node y) & ((R (right x)) (right y))) ==> ((R u) v) ==>
u = v"
ga_selector_left: "!! X1 :: BinTree . !! X2 :: Elem . !! X3 :: BinTree . (left ((cons X1 X2) X3)) = X1"
ga_selector_node: "!! X1 :: BinTree . !! X2 :: Elem . !! X3 :: BinTree . (node ((cons X1 X2) X3)) = X2"
ga_selector_right: "!! X1 :: BinTree . !! X2 :: Elem . !! X3 :: BinTree . (right ((cons X1 X2) X3)) = X3"

theorem BinTree_Mirror: "!! bt :: BinTree . (mirror (mirror bt)) = bt"
apply(circular_coinduction)
(*
apply(coinduction)
apply(init)

apply(breakup)

apply(close_or_step)

apply(finish)
*)
done


theory Semantics_OpenFlow
imports List_Group Sort_Descending
  "../IP_Addresses/IPv4"
  "OpenFlow_Helpers"
begin

datatype 'a flowtable_behavior = Action 'a | NoAction | Undefined

definition "option_to_ftb b \<equiv> case b of Some a \<Rightarrow> Action a | None \<Rightarrow> NoAction"
definition "ftb_to_option b \<equiv> case b of Action a \<Rightarrow> Some a | NoAction \<Rightarrow> None"

(*section\<open>OpenFlow\<close>*)

(*https://www.opennetworking.org/images/stories/downloads/sdn-resources/onf-specifications/openflow/openflow-switch-v1.5.0.pdf*)

(*"OpenFlow packets are received on an ingress port [...]. The packet ingress port is a property of the packet
throughout the OpenFlow pipeline and represents the OpenFlow port on which the packet was received
into the OpenFlow switch."
*)

(* "Packet forwarded to non-existent ports are just dropped"*)

(*we do not support egress tables (those are optional in the standard).
  we only support flow table 0 (ingress table).
  Essentially, this means, we only support one flow table and no pipelining.
  This corresponds to OpenFlow 1.0.0
*)

(*priority \<times> Match Fields \<times> instructions
 not modeled: counters, timeouts, cookie ("Not used when processing packets"), flags,
     instructions (only an output list of egress ports will be modeled)
*)

datatype ('m, 'a) flow_entry_match = OFEntry (ofe_prio: "16 word") (ofe_fields: "'m set") (ofe_action: 'a)

(* why is there curry *)
find_consts "(('a \<times> 'b) \<Rightarrow> 'c) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'c"
(* but no "uncurry" *)
find_consts "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a \<times> 'b) \<Rightarrow> 'c"
(* Anyway, we want this to easily construct OFEntrys from tuples *)
definition "split3 f p \<equiv> case p of (a,b,c) \<Rightarrow> f a b c"
find_consts "('a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'd) \<Rightarrow> ('a \<times> 'b \<times> 'c) \<Rightarrow> 'd"

(*
"If there are multiple matching flow entries with the same highest priority, the selected flow entry is explicitly undefined."
OFP 1.0.0 also stated that non-wildcarded matches implicitly have the highest priority (which is gone in 1.5).
*)
(*Defined None \<longleftrightarrow> No match
  Defined (Some a) \<longleftrightarrow> Match and instruction is a
  Undefined \<longleftrightarrow> Undefined*)

type_synonym ('m, 'a) flowtable = "(('m, 'a) flow_entry_match) list"
type_synonym ('m, 'p) field_matcher = "('m set \<Rightarrow> 'p \<Rightarrow> bool)"

definition OF_same_priority_match2 :: "('m, 'p) field_matcher \<Rightarrow> ('m, 'a) flowtable \<Rightarrow> 'p \<Rightarrow> 'a flowtable_behavior" where
  "OF_same_priority_match2 \<gamma> flow_entries packet \<equiv> let s =
  	{ofe_action f|f. f \<in> set flow_entries \<and> \<gamma> (ofe_fields f) packet \<and>
  	  (\<forall>fo \<in> set flow_entries. ofe_prio fo > ofe_prio f \<longrightarrow> \<not>\<gamma> (ofe_fields fo) packet)} in
  	case card s of 0       \<Rightarrow> NoAction
                 | (Suc 0) \<Rightarrow> Action (the_elem s)
                 | _       \<Rightarrow> Undefined"

(* are there any overlaping rules? *)
definition "check_no_overlap \<gamma> ft = (\<forall>a \<in> set ft. \<forall>b \<in> set ft. \<forall>p \<in> UNIV. (ofe_prio a = ofe_prio b \<and> \<gamma> (ofe_fields a) p \<and> a \<noteq> b) \<longrightarrow> \<not>\<gamma> (ofe_fields b) p)"
definition "check_no_overlap2 \<gamma> ft = (\<forall>a \<in> set ft. \<forall>b \<in> set ft. (a \<noteq> b \<and> ofe_prio a = ofe_prio b) \<longrightarrow> \<not>(\<exists>p \<in> UNIV. \<gamma> (ofe_fields a) p \<and> \<gamma> (ofe_fields b) p))"
lemma check_no_overlap_alt: "check_no_overlap \<gamma> ft = check_no_overlap2 \<gamma> ft"
	unfolding check_no_overlap2_def check_no_overlap_def
	by blast

(* If there are no overlapping rules, our match should check out. *)
lemma no_overlap_not_unefined: "check_no_overlap \<gamma> ft \<Longrightarrow> OF_same_priority_match2 \<gamma> ft p \<noteq> Undefined"
proof
  assume goal1: "check_no_overlap \<gamma> ft" "OF_same_priority_match2 \<gamma> ft p = Undefined"
	let ?as = "{f. f \<in> set ft \<and> \<gamma> (ofe_fields f) p \<and> (\<forall>fo \<in> set ft. ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}"
	have fin: "finite ?as" by simp
	note goal1(2)[unfolded OF_same_priority_match2_def]
	then have "2 \<le> card (ofe_action ` ?as)" unfolding f_Img_ex_set
		unfolding Let_def
		by(cases "card (ofe_action ` ?as)", simp) (rename_tac nat1, case_tac nat1, simp add: image_Collect, presburger)
	then have "2 \<le> card ?as" using card_image_le[OF fin, of ofe_action] by linarith
	then obtain a b where ab: "a \<noteq> b" "a \<in> ?as" "b \<in> ?as" using card2_eI by blast
	then have ab2: "a \<in> set ft" "\<gamma> (ofe_fields a) p" "(\<forall>fo\<in>set ft. ofe_prio a < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)"
	               "b \<in> set ft" "\<gamma> (ofe_fields b) p" "(\<forall>fo\<in>set ft. ofe_prio b < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)" by simp_all
	then have "ofe_prio a = ofe_prio b"
		by fastforce
	note goal1(1)[unfolded check_no_overlap_def] ab2(1) ab2(4) this ab2(2) ab(1) ab2(5)
	then show False by blast
qed

fun OF_match_linear :: "('m, 'p) field_matcher \<Rightarrow> ('m, 'a) flowtable \<Rightarrow> 'p \<Rightarrow> 'a flowtable_behavior" where
"OF_match_linear _ [] _ = NoAction" |
"OF_match_linear \<gamma> (a#as) p = (if \<gamma> (ofe_fields a) p then Action (ofe_action a) else OF_match_linear \<gamma> as p)"

lemma OF_match_linear_ne_Undefined: "OF_match_linear \<gamma> ft p \<noteq> Undefined"
	by(induction ft) auto

lemma OF_match_linear_append: "OF_match_linear \<gamma> (a @ b) p = (case OF_match_linear \<gamma> a p of NoAction \<Rightarrow> OF_match_linear \<gamma> b p | x \<Rightarrow> x)"
by(induction a) simp_all
lemma OF_match_linear_match_allsameaction: "\<lbrakk>gr \<in> set oms; \<gamma> gr p = True\<rbrakk>
       \<Longrightarrow> OF_match_linear \<gamma> (map (\<lambda>x. split3 OFEntry (pri, x, act)) oms) p = Action act"
by(induction oms) (auto simp add: split3_def)
lemma OF_lm_noa_none_iff: "OF_match_linear \<gamma> ft p = NoAction \<longleftrightarrow> (\<forall>e\<in>set ft. \<not> \<gamma> (ofe_fields e) p)"
	by(induction ft) (simp_all split: if_splits)

lemma set_eq_rule: "(\<And>x. x \<in> a \<Longrightarrow> x \<in> b) \<Longrightarrow> (\<And>x. x \<in> b \<Longrightarrow> x \<in> a) \<Longrightarrow> a = b" by(rule antisym[OF subsetI subsetI])

lemma unmatching_insert_agnostic: "\<not> \<gamma> (ofe_fields a) p \<Longrightarrow> OF_same_priority_match2 \<gamma> (a # ft) p = OF_same_priority_match2 \<gamma> ft p"
proof -
	let ?as = "{f. f \<in> set ft \<and> \<gamma> (ofe_fields f) p \<and> (\<forall>fo \<in> set ft. ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}"
	let ?aas = "{f |f. f \<in> set (a # ft) \<and> \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}"
	assume nm: "\<not> \<gamma> (ofe_fields a) p"
	have aa: "?aas = ?as"
	proof(rule set_eq_rule)
	  fix x
		assume "x \<in> {f |f. f \<in> set (a # ft) \<and> \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}"
		hence as: "x \<in> set (a # ft) \<and> \<gamma> (ofe_fields x) p \<and> (\<forall>fo\<in>set (a # ft). ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)" by simp
		with nm have "x \<in> set ft" by fastforce
		moreover from as have "(\<forall>fo\<in>set ft. ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)" by simp
		ultimately show "x \<in> {f \<in> set ft. \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set ft. ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}" using as by force
	next
	  fix x
		assume "x \<in> {f \<in> set ft. \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set ft. ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}"
		hence as: "x \<in> set ft" "\<gamma> (ofe_fields x) p" "(\<forall>fo\<in>set ft. ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)" by simp_all
		from as(1) have "x \<in> set (a # ft)" by simp
		moreover from as(3) have "(\<forall>fo\<in>set (a # ft). ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)" using nm by simp
		ultimately show "x \<in> {f |f. f \<in> set (a # ft) \<and> \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)}" using as(2) by blast
	qed
	note uf = arg_cong[OF aa, of "op ` ofe_action", unfolded image_Collect]
	show ?thesis unfolding OF_same_priority_match2_def using uf by presburger
qed

lemma OF_match_eq: "sorted_descending (map ofe_prio ft) \<Longrightarrow> check_no_overlap \<gamma> ft \<Longrightarrow>
	OF_same_priority_match2 \<gamma> ft p = OF_match_linear \<gamma> ft p"
proof(induction "ft")
	case (Cons a ft)
	have 1: "sorted_descending (map ofe_prio ft)" using Cons(2) by simp
	have 2: "check_no_overlap \<gamma> ft" using Cons(3) unfolding check_no_overlap_def using set_subset_Cons by fast
	note mIH = Cons(1)[OF 1 2]
	show ?case (is ?kees)
	proof(cases "\<gamma> (ofe_fields a) p")
		case False thus ?kees
			by(simp only: OF_match_linear.simps if_False mIH[symmetric] unmatching_insert_agnostic[of \<gamma>, OF False])
	next
		note sorted_descending_split[OF Cons(2)]
		then obtain m n where mn: "a # ft = m @ n" "\<forall>e\<in>set m. ofe_prio a = ofe_prio e" "\<forall>e\<in>set n. ofe_prio e < ofe_prio a"
			unfolding list.sel by blast
		hence aem: "a \<in> set m"
			by (metis UnE less_imp_neq list.set_intros(1) set_append)
		have mover: "check_no_overlap \<gamma> m" using Cons(3) unfolding check_no_overlap_def
			by (metis Un_iff mn(1) set_append)
		let ?fc = "(\<lambda>s.
			{f. f \<in> set s \<and> \<gamma> (ofe_fields f) p \<and>
			(\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)})"
		case True
		have "?fc (m @ n) = ?fc m \<union> ?fc n" by auto
		moreover have "?fc n = {}"
		proof(rule set_eq_rule, rule ccontr, goal_cases)
			case (1 x)
			hence g1: "x \<in> set n" "\<gamma> (ofe_fields x) p"
				"(\<forall>fo\<in>set m. ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)"
				"(\<forall>fo\<in>set n. ofe_prio x < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)"
				unfolding mn(1) by(simp_all)
			from g1(1) mn(3) have le: "ofe_prio x < ofe_prio a" by simp
			note le g1(3) aem True
			then show False by blast
		qed simp
		ultimately have cc: "?fc (m @ n) = ?fc m" by blast
		have cm: "?fc m = {a}" (* using Cons(3) *)
		proof -
			have "\<forall>f \<in> set m. (\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)"
				by (metis UnE less_asym mn set_append)
			hence 1: "?fc m = {f \<in> set m. \<gamma> (ofe_fields f) p}" by blast
			show "{f \<in> set m. \<gamma> (ofe_fields f) p \<and> (\<forall>fo\<in>set (a # ft). ofe_prio f < ofe_prio fo \<longrightarrow> \<not> \<gamma> (ofe_fields fo) p)} = {a} " unfolding 1
			proof(rule set_eq_rule, goal_cases fwd bwd)
				case (bwd x)
				have "a \<in> {f \<in> set m. \<gamma> (ofe_fields f) p}" using True aem by simp
				thus ?case using bwd by simp
			next
				case (fwd x) show ?case proof(rule ccontr)
					assume "x \<notin> {a}" hence ne: "x \<noteq> a" by simp
					from fwd have 1: "x \<in> set m" "\<gamma> (ofe_fields x) p" by simp_all
					have 2: "ofe_prio x = ofe_prio a" using 1(1) mn(2) by simp
					show False using 1 ne mover aem True 2 unfolding check_no_overlap_def by blast
				qed
			qed
		qed
		show ?kees
			unfolding mn(1)
			unfolding OF_same_priority_match2_def
			unfolding f_Img_ex_set
			unfolding cc[unfolded mn(1)]
			unfolding cm[unfolded mn(1)]
			unfolding Let_def
			by(simp only: mn(1)[symmetric] OF_match_linear.simps True if_True, simp)
		qed
qed (simp add: OF_same_priority_match2_def)

lemma overlap_sort_invar[simp]: "check_no_overlap \<gamma> (sort_descending_key k ft) = check_no_overlap \<gamma> ft"
	unfolding check_no_overlap_def
	unfolding sort_descending_set_inv
	..

lemma OF_match_eq2:
  assumes "check_no_overlap \<gamma> ft"
  shows "OF_same_priority_match2 \<gamma> ft p = OF_match_linear \<gamma> (sort_descending_key ofe_prio ft) p"
proof -
	have "sorted_descending (map ofe_prio (sort_descending_key ofe_prio ft))" by (simp add: sorted_descending_sort_descending_key)
	note ceq = OF_match_eq[OF this, unfolded overlap_sort_invar, OF \<open>check_no_overlap \<gamma> ft\<close>, symmetric]
	show ?thesis
		unfolding ceq
		unfolding OF_same_priority_match2_def
		unfolding sort_descending_set_inv
		..
qed

(* Just me, thinking about some alternate ways of writing this down. *)
lemma prio_match_matcher_alt: "{f. f \<in> set flow_entries \<and> \<gamma> (ofe_fields f) packet \<and>
  	  (\<forall>fo \<in> set flow_entries. ofe_prio fo > ofe_prio f \<longrightarrow> \<not>\<gamma> (ofe_fields fo) packet)}
  	  = (
  	  let matching = {f. f \<in> set flow_entries \<and> \<gamma> (ofe_fields f) packet}
  	  in {f. f \<in> matching \<and> (\<forall>fo \<in> matching. ofe_prio fo \<le> ofe_prio f)}
  	  )"
by(auto simp add: Let_def)
lemma prio_match_matcher_alt2: "(
  	  let matching = {f. f \<in> set flow_entries \<and> \<gamma> (ofe_fields f) packet}
  	  in {f. f \<in> matching \<and> (\<forall>fo \<in> matching. ofe_prio fo \<le> ofe_prio f)}
  	  ) = set (
  	  let matching = filter (\<lambda>f. \<gamma> (ofe_fields f) packet) flow_entries
  	  in filter (\<lambda>f. \<forall>fo \<in> set matching. ofe_prio fo \<le> ofe_prio f) matching
  	  )"
by(auto simp add: Let_def)

definition OF_priority_match where
  "OF_priority_match \<gamma> flow_entries packet \<equiv>
  let m  = filter (\<lambda>f. \<gamma> (ofe_fields f) packet) flow_entries;
  	  m' = filter (\<lambda>f. \<forall>fo \<in> set m. ofe_prio fo \<le> ofe_prio f) m in
  	case m' of []  \<Rightarrow> NoAction
             | [s] \<Rightarrow> Action (ofe_action s)
             |  _  \<Rightarrow> Undefined"

definition OF_priority_match_ana where
  "OF_priority_match_ana \<gamma> flow_entries packet \<equiv>
  let m  = filter (\<lambda>f. \<gamma> (ofe_fields f) packet) flow_entries;
  	  m' = filter (\<lambda>f. \<forall>fo \<in> set m. ofe_prio fo \<le> ofe_prio f) m in
  	case m' of []  \<Rightarrow> NoAction
             | [s] \<Rightarrow> Action s
             |  _  \<Rightarrow> Undefined"

lemma filter_singleton: "[x\<leftarrow>s. f x] = [y] \<Longrightarrow> f y \<and> y \<in> set s" by (metis filter_eq_Cons_iff in_set_conv_decomp)

lemma OF_spm3_get_fe: "OF_priority_match \<gamma> ft p = Action a \<Longrightarrow> \<exists>fe. ofe_action fe = a \<and> fe \<in> set ft \<and> OF_priority_match_ana \<gamma> ft p = Action fe"
	unfolding OF_priority_match_def OF_priority_match_ana_def
	by(clarsimp split: flowtable_behavior.splits list.splits) (drule filter_singleton; simp)

fun no_overlaps where
"no_overlaps _ [] = True" |
"no_overlaps \<gamma> (a#as) = (no_overlaps \<gamma> as \<and> (
	\<forall>b \<in> set as. ofe_prio a = ofe_prio b \<longrightarrow> \<not>(\<exists>p \<in> UNIV. \<gamma> (ofe_fields a) p \<and> \<gamma> (ofe_fields b) p)))"

lemma no_overlap_ConsI: "check_no_overlap2 \<gamma> (x#xs) \<Longrightarrow> check_no_overlap2 \<gamma> xs"
	unfolding check_no_overlap2_def by simp

lemma no_overlapsI: "check_no_overlap \<gamma> t \<Longrightarrow> distinct t \<Longrightarrow> no_overlaps \<gamma> t"
unfolding check_no_overlap_alt
proof(induction t)
	case (Cons a t)
	from no_overlap_ConsI[OF Cons(2)] Cons(3,1)
	have "no_overlaps \<gamma> t" by simp
	thus ?case using Cons(2,3) unfolding check_no_overlap2_def by auto
qed (simp add: check_no_overlap2_def)

lemma check_no_overlapI: "no_overlaps \<gamma> t \<Longrightarrow> check_no_overlap \<gamma> t"
unfolding check_no_overlap_alt
proof(induction t)
	case (Cons a t)
	from Cons(1)[OF conjunct1[OF Cons(2)[unfolded no_overlaps.simps]]]
	show ?case
		using conjunct2[OF Cons(2)[unfolded no_overlaps.simps]]
		unfolding check_no_overlap2_def
		by auto
qed (simp add: check_no_overlap2_def)

lemma "(\<And>e p. e \<in> set t \<Longrightarrow> \<not>\<gamma> (ofe_fields e) p) \<Longrightarrow> no_overlaps \<gamma> t"
	by(induction t) simp_all
lemma no_overlaps_append: "no_overlaps \<gamma> (x @ y) \<Longrightarrow> no_overlaps \<gamma> y"
	by(induction x) simp_all
lemma no_overlaps_ne1: "no_overlaps \<gamma> (x @ a # y @ b # z) \<Longrightarrow> ((\<exists>p. \<gamma> (ofe_fields a) p) \<or> (\<exists>p. \<gamma> (ofe_fields b) p)) \<Longrightarrow> a \<noteq> b"
proof (rule notI, goal_cases contr)
	case contr
	from contr(1) no_overlaps_append have "no_overlaps \<gamma> (a # y @ b # z)" by blast
	note this[unfolded no_overlaps.simps]
	with contr(3) have "\<not> (\<exists>p\<in>UNIV. \<gamma> (ofe_fields a) p \<and> \<gamma> (ofe_fields b) p)" by simp
	with contr(2) show False unfolding contr(3) by simp
qed

lemma no_overlaps_defeq: "no_overlaps \<gamma> fe \<Longrightarrow> OF_same_priority_match2 \<gamma> fe p = OF_priority_match \<gamma> fe p"
	unfolding OF_same_priority_match2_def OF_priority_match_def
	unfolding f_Img_ex_set
	unfolding prio_match_matcher_alt
	unfolding prio_match_matcher_alt2
proof (goal_cases uf)
	case uf
	let ?m' = "let m = [f\<leftarrow>fe . \<gamma> (ofe_fields f) p] in [f\<leftarrow>m . \<forall>fo\<in>set m. ofe_prio fo \<le> ofe_prio f]"
	let ?s = "ofe_action ` set ?m'"
	from uf show ?case
	proof(cases ?m')
		case Nil
		moreover then have "card ?s = 0" by force
		ultimately show ?thesis by(simp add: Let_def)
	next
		case (Cons a as)
		have "as = []"
		proof(rule ccontr)
			assume "as \<noteq> []"
			then obtain b bs where bbs: "as = b # bs" by (meson neq_Nil_conv)
			 note no = Cons[unfolded Let_def filter_filter]
			have f1: "a \<in> set ?m'" "b \<in> set ?m'" unfolding bbs local.Cons by simp_all
			hence "ofe_prio a = ofe_prio b" by (simp add: antisym)
			moreover have ms: "\<gamma> (ofe_fields a) p" "\<gamma> (ofe_fields b) p" using no[symmetric] unfolding bbs by(blast dest: Cons_eq_filterD)+
			moreover have abis: "a \<in> set fe" "b \<in> set fe" using f1 by auto
			moreover have "a \<noteq> b" proof(cases "\<exists>x y z. fe = x @ a # y @ b # z")
				case True
				then obtain x y z where xyz: "fe = x @ a # y @ b # z" by blast
				from no_overlaps_ne1 ms(1) uf[unfolded xyz]
				show ?thesis by blast
			next
				case False
				then obtain x y z where xyz: "fe = x @ b # y @ a # z"
					using no unfolding bbs
					by (metis (no_types, lifting) Cons_eq_filterD)
				from no_overlaps_ne1 ms(1) uf[unfolded xyz]
				show ?thesis by blast
			qed
			ultimately show False using check_no_overlapI[OF uf, unfolded check_no_overlap_def] by blast
		qed
		then have oe: "a # as = [a]" by simp
		show ?thesis using Cons[unfolded oe] by force
	qed
qed
(* the above lemma used to be this, but it's slightly weaker than I wanted. *)
lemma "distinct fe \<Longrightarrow> check_no_overlap \<gamma> fe \<Longrightarrow> OF_same_priority_match2 \<gamma> fe p = OF_priority_match \<gamma> fe p"
	by(rule no_overlaps_defeq) (drule (2) no_overlapsI)

theorem OF_eq:
	assumes no: "no_overlaps \<gamma> f"
	    and so: "sorted_descending (map ofe_prio f)"
	shows "OF_match_linear \<gamma> f p = OF_priority_match \<gamma> f p"
	unfolding no_overlaps_defeq[symmetric,OF no] OF_match_eq[OF so check_no_overlapI[OF no]]
	..

corollary OF_eq_sort:
	assumes no: "no_overlaps \<gamma> f"
	shows "OF_priority_match \<gamma> f p = OF_match_linear \<gamma> (sort_descending_key ofe_prio f) p"
	using OF_match_eq2 check_no_overlapI no no_overlaps_defeq by fastforce

lemma OF_lm_noa_none: "OF_match_linear \<gamma> ft p = NoAction \<Longrightarrow> \<forall>e\<in>set ft. \<not> \<gamma> (ofe_fields e) p"
	by(induction ft) (simp_all split: if_splits)

(* this should be provable without the overlaps assumption, but that's quite a bit harder. *)
lemma OF_spm3_noa_none:
	assumes no: "no_overlaps \<gamma> ft"
	shows "OF_priority_match \<gamma> ft p = NoAction \<Longrightarrow> \<forall>e \<in> set ft. \<not>\<gamma> (ofe_fields e) p"
unfolding OF_eq_sort[OF no] by(drule OF_lm_noa_none) simp

(* repetition of the lemma for definition 2 for definition 3 *)
lemma no_overlaps_not_unefined: "no_overlaps \<gamma> ft \<Longrightarrow> OF_priority_match \<gamma> ft p \<noteq> Undefined"
	using check_no_overlapI no_overlap_not_unefined no_overlaps_defeq by fastforce

end