subsection \<open>IR Graph Type\<close>

theory IRGraph
  imports
    IRNodeHierarchy
    Stamp
    "HOL-Library.FSet"
    "HOL.Relation"
begin

text \<open>This theory defines the main Graal data structure - an entire IR Graph.\<close>

text \<open>
IRGraph is defined as a partial map with a finite domain.
The finite domain is required to be able to generate code and produce an interpreter.
\<close>
typedef IRGraph = "{g :: ID \<rightharpoonup> (IRNode \<times> Stamp) . finite (dom g)}"
proof -
  have "finite(dom(Map.empty)) \<and> ran Map.empty = {}" by auto
  then show ?thesis
    by fastforce
qed

setup_lifting type_definition_IRGraph

lift_definition ids :: "IRGraph \<Rightarrow> ID set"
  is "\<lambda>g. {nid \<in> dom g . \<nexists>s. g nid = (Some (NoNode, s))}" .

fun with_default :: "'c \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> (('a \<rightharpoonup> 'b) \<Rightarrow> 'a \<Rightarrow> 'c)" where
  "with_default def conv = (\<lambda>m k.
    (case m k of None \<Rightarrow> def | Some v \<Rightarrow> conv v))"

lift_definition kind :: "IRGraph \<Rightarrow> (ID \<Rightarrow> IRNode)"
  is "with_default NoNode fst" .

lift_definition stamp :: "IRGraph \<Rightarrow> ID \<Rightarrow> Stamp"
  is "with_default IllegalStamp snd" .

lift_definition add_node :: "ID \<Rightarrow> (IRNode \<times> Stamp) \<Rightarrow> IRGraph \<Rightarrow> IRGraph"
  is "\<lambda>nid k g. if fst k = NoNode then g else g(nid \<mapsto> k)" by simp

lift_definition remove_node :: "ID \<Rightarrow> IRGraph \<Rightarrow> IRGraph"
  is "\<lambda>nid g. g(nid := None)" by simp

lift_definition replace_node :: "ID \<Rightarrow> (IRNode \<times> Stamp) \<Rightarrow> IRGraph \<Rightarrow> IRGraph"
  is "\<lambda>nid k g. if fst k = NoNode then g else g(nid \<mapsto> k)" by simp

lift_definition as_list :: "IRGraph \<Rightarrow> (ID \<times> IRNode \<times> Stamp) list"
  is "\<lambda>g. map (\<lambda>k. (k, the (g k))) (sorted_list_of_set (dom g))" .

fun no_node :: "(ID \<times> (IRNode \<times> Stamp)) list \<Rightarrow> (ID \<times> (IRNode \<times> Stamp)) list" where
  "no_node g = filter (\<lambda>n. fst (snd n) \<noteq> NoNode) g"

lift_definition irgraph :: "(ID \<times> (IRNode \<times> Stamp)) list \<Rightarrow> IRGraph"
  is "map_of \<circ> no_node"
  by (simp add: finite_dom_map_of)

definition as_set :: "IRGraph \<Rightarrow> (ID \<times> (IRNode \<times> Stamp)) set" where
  "as_set g = {(n, kind g n, stamp g n) | n . n \<in> ids g}"

definition true_ids :: "IRGraph \<Rightarrow> ID set" where
  "true_ids g = ids g - {n \<in> ids g. \<exists>n' . kind g n = RefNode n'}"

definition domain_subtraction :: "'a set \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('a \<times> 'b) set"
  (infix "\<unlhd>" 30) where
  "domain_subtraction s r = {(x, y) . (x, y) \<in> r \<and> x \<notin> s}"

notation (latex)
  domain_subtraction ("_ \<^latex>\<open>$\\ndres$\<close> _")

(* Theories are required for code generation to work *)
code_datatype irgraph

fun filter_none where
  "filter_none g = {nid \<in> dom g . \<nexists>s. g nid = (Some (NoNode, s))}"

lemma no_node_clears:
  "res = no_node xs \<longrightarrow> (\<forall>x \<in> set res. fst (snd x) \<noteq> NoNode)"
  by simp

lemma dom_eq:
  assumes "\<forall>x \<in> set xs. fst (snd x) \<noteq> NoNode"
  shows "filter_none (map_of xs) = dom (map_of xs)"
  unfolding filter_none.simps using assms map_of_SomeD
  by fastforce

lemma fil_eq:
  "filter_none (map_of (no_node xs)) = set (map fst (no_node xs))"
  using no_node_clears
  by (metis dom_eq dom_map_of_conv_image_fst list.set_map)

lemma irgraph[code]: "ids (irgraph m) = set (map fst (no_node m))"
  unfolding irgraph_def ids_def using fil_eq
  by (smt Rep_IRGraph comp_apply eq_onp_same_args filter_none.simps ids.abs_eq ids_def irgraph.abs_eq irgraph.rep_eq irgraph_def mem_Collect_eq)

\<comment> \<open>Get the inputs set of a given node ID\<close>
fun inputs :: "IRGraph \<Rightarrow> ID \<Rightarrow> ID set" where
  "inputs g nid = set (inputs_of (kind g nid))"
\<comment> \<open>Get the successor set of a given node ID\<close>
fun succ :: "IRGraph \<Rightarrow> ID \<Rightarrow> ID set" where
  "succ g nid = set (successors_of (kind g nid))"
\<comment> \<open>Gives a relation between node IDs - between a node and its input nodes\<close>
fun input_edges :: "IRGraph \<Rightarrow> ID rel" where
  "input_edges g = (\<Union> i \<in> ids g. {(i,j)|j. j \<in> (inputs g i)})"
\<comment> \<open>Find all the nodes in the graph that have nid as an input - the usages of nid\<close>
fun usages :: "IRGraph \<Rightarrow> ID \<Rightarrow> ID set" where
  "usages g nid = {i. i \<in> ids g \<and> nid \<in> inputs g i}"
fun successor_edges :: "IRGraph \<Rightarrow> ID rel" where
  "successor_edges g = (\<Union> i \<in> ids g. {(i,j)|j . j \<in> (succ  g i)})"
fun predecessors :: "IRGraph \<Rightarrow> ID \<Rightarrow> ID set" where
  "predecessors g nid = {i. i \<in> ids g \<and> nid \<in> succ g i}"
fun nodes_of :: "IRGraph \<Rightarrow> (IRNode \<Rightarrow> bool) \<Rightarrow> ID set" where
  "nodes_of g sel = {nid \<in> ids g . sel (kind g nid)}"
fun edge :: "(IRNode \<Rightarrow> 'a) \<Rightarrow> ID \<Rightarrow> IRGraph \<Rightarrow> 'a" where
  "edge sel nid g = sel (kind g nid)"

fun filtered_inputs :: "IRGraph \<Rightarrow> ID \<Rightarrow> (IRNode \<Rightarrow> bool) \<Rightarrow> ID list" where
  "filtered_inputs g nid f = filter (f \<circ> (kind g)) (inputs_of (kind g nid))"
fun filtered_successors :: "IRGraph \<Rightarrow> ID \<Rightarrow> (IRNode \<Rightarrow> bool) \<Rightarrow> ID list" where
  "filtered_successors g nid f = filter (f \<circ> (kind g)) (successors_of (kind g nid))"
fun filtered_usages :: "IRGraph \<Rightarrow> ID \<Rightarrow> (IRNode \<Rightarrow> bool) \<Rightarrow> ID set" where
  "filtered_usages g nid f = {n \<in> (usages g nid). f (kind g n)}"

fun is_empty :: "IRGraph \<Rightarrow> bool" where
  "is_empty g = (ids g = {})"

fun any_usage :: "IRGraph \<Rightarrow> ID \<Rightarrow> ID" where
  "any_usage g nid = hd (sorted_list_of_set (usages g nid))"

lemma ids_some[simp]: "x \<in> ids g \<longleftrightarrow> kind g x \<noteq> NoNode"
proof -
  have that: "x \<in> ids g \<longrightarrow> kind g x \<noteq> NoNode"
    using ids.rep_eq kind.rep_eq by force
  have "kind g x \<noteq> NoNode \<longrightarrow> x \<in> ids g"
    unfolding with_default.simps kind_def ids_def
    by (cases "Rep_IRGraph g x = None"; auto)
  from this that show ?thesis by auto
qed

lemma not_in_g:
  assumes "nid \<notin> ids g"
  shows "kind g nid = NoNode"
  using assms ids_some by blast

lemma valid_creation[simp]:
  "finite (dom g) \<longleftrightarrow> Rep_IRGraph (Abs_IRGraph g) = g"
  using Abs_IRGraph_inverse by (metis Rep_IRGraph mem_Collect_eq)

lemma [simp]: "finite (ids (irgraph g))"
  by (simp add: finite_dom_map_of)

lemma [simp]: "finite (dom g) \<longrightarrow> ids (Abs_IRGraph g) = {nid \<in> dom g . \<nexists>s. g nid = Some (NoNode, s)}"
  using ids.rep_eq by simp

lemma [simp]: "finite (dom g) \<longrightarrow> kind (Abs_IRGraph g) = (\<lambda>x . (case g x of None \<Rightarrow> NoNode | Some n \<Rightarrow> fst n))"
  by (simp add: kind.rep_eq)

lemma [simp]: "finite (dom g) \<longrightarrow> stamp (Abs_IRGraph g) = (\<lambda>x . (case g x of None \<Rightarrow> IllegalStamp | Some n \<Rightarrow> snd n))"
  using stamp.abs_eq stamp.rep_eq by auto

lemma [simp]: "ids (irgraph g) = set (map fst (no_node g))"
  using irgraph by auto

lemma [simp]: "kind (irgraph g) = (\<lambda>nid. (case (map_of (no_node g)) nid of None \<Rightarrow> NoNode | Some n \<Rightarrow> fst n))"
  using irgraph.rep_eq kind.transfer kind.rep_eq by auto

lemma [simp]: "stamp (irgraph g) = (\<lambda>nid. (case (map_of (no_node g)) nid of None \<Rightarrow> IllegalStamp | Some n \<Rightarrow> snd n))"
  using irgraph.rep_eq stamp.transfer stamp.rep_eq by auto

lemma map_of_upd: "(map_of g)(k \<mapsto> v) = (map_of ((k, v) # g))"
  by simp

(* this proof should be simplier *)
lemma [code]: "replace_node nid k (irgraph g) = (irgraph ( ((nid, k) # g)))"
proof (cases "fst k = NoNode")
  case True
  then show ?thesis
    by (metis (mono_tags, lifting) Rep_IRGraph_inject filter.simps(2) irgraph.abs_eq no_node.simps replace_node.rep_eq snd_conv)
next
  case False
  then show ?thesis unfolding irgraph_def replace_node_def no_node.simps
    by (smt (verit, best) Rep_IRGraph comp_apply eq_onp_same_args filter.simps(2) id_def irgraph.rep_eq map_fun_apply map_of_upd mem_Collect_eq no_node.elims replace_node.abs_eq replace_node_def snd_eqD)
qed

lemma [code]: "add_node nid k (irgraph g) = (irgraph (((nid, k) # g)))"
  by (smt (z3) Rep_IRGraph_inject add_node.rep_eq filter.simps(2) irgraph.rep_eq map_of_upd no_node.simps snd_conv)

lemma add_node_lookup:
  "gup = add_node nid (k, s) g \<longrightarrow>
    (if k \<noteq> NoNode then kind gup nid = k \<and> stamp gup nid = s else kind gup nid = kind g nid)"
proof (cases "k = NoNode")
  case True
  then show ?thesis
    by (simp add: add_node.rep_eq kind.rep_eq)
next
  case False
  then show ?thesis
    by (simp add: kind.rep_eq add_node.rep_eq stamp.rep_eq)
qed

lemma remove_node_lookup:
  "gup = remove_node nid g \<longrightarrow> kind gup nid = NoNode \<and> stamp gup nid = IllegalStamp"
  by (simp add: kind.rep_eq remove_node.rep_eq stamp.rep_eq)

lemma replace_node_lookup[simp]:
  "gup = replace_node nid (k, s) g \<and> k \<noteq> NoNode \<longrightarrow> kind gup nid = k \<and> stamp gup nid = s"
  by (simp add: replace_node.rep_eq kind.rep_eq stamp.rep_eq)

lemma replace_node_unchanged:
  "gup = replace_node nid (k, s) g \<longrightarrow> (\<forall> n \<in> (ids g - {nid}) . n \<in> ids g \<and> n \<in> ids gup \<and> kind g n = kind gup n)"
  by (simp add: kind.rep_eq replace_node.rep_eq)

subsubsection "Example Graphs"
text "Example 1: empty graph (just a start and end node)"
definition start_end_graph:: IRGraph where
  "start_end_graph = irgraph [(0, StartNode None 1, VoidStamp), (1, ReturnNode None None, VoidStamp)]"

text \<open>Example 2:
  public static int sq(int x) { return x * x; }

             [1 P(0)]
               \ /
  [0 Start]   [4 *]
       |      /
       V     /
      [5 Return]
\<close>
definition eg2_sq :: "IRGraph" where
  "eg2_sq = irgraph [
    (0, StartNode None 5, VoidStamp),
    (1, ParameterNode 0, default_stamp),
    (4, MulNode 1 1, default_stamp),
    (5, ReturnNode (Some 4) None, default_stamp)
   ]"

(* TODO: to include the float type (used by stamps) we need
         a code equation for float_of but it is not clear how
         to implement this correctly
lemma[code]: "float_of n = 0"
*)

(* Test the code generation. *)
value "input_edges eg2_sq"
value "usages eg2_sq 1"

end


theory escape_Injective
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

datatype Token = A | B | C | D | ESC | P | Q | R

fun isSpecial :: "Token => bool" where
"isSpecial ESC = True"
| "isSpecial P = True"
| "isSpecial Q = True"
| "isSpecial R = True"
| "isSpecial x = False"

fun code :: "Token => Token" where
"code ESC = ESC"
| "code P = A"
| "code Q = B"
| "code R = C"
| "code x = x"

fun escape :: "Token list => Token list" where
"escape (Nil2) = Nil2"
| "escape (Cons2 y xs) =
     (if isSpecial y then Cons2 ESC (Cons2 (code y) (escape xs)) else
        Cons2 y (escape xs))"

(*hipster isSpecial code escape *)

hipster isSpecial code escape
lemma lemma_a [thy_expl]: "code (code x1) = code x1"
by (hipster_induct_schemes isSpecial.simps code.simps escape.simps)

fun eqEsc :: "Token list => Token list \<Rightarrow> bool" where
"eqEsc xs ys = (xs = ys)"

hipster_cond isSpecial code  escape isSpecial

fun isNil :: "Token list \<Rightarrow> bool" where
"isNil Nil2 = True"
| "isNil _ = False"

hipster_cond isNil escape isSpecial
lemma lemma_aa [thy_expl]: "isNil (escape x5) = isNil x5"
by (hipster_induct_schemes isNil.simps escape.simps isSpecial.simps)

lemma lemma_ab [thy_expl]: "isNil x3 \<Longrightarrow> escape x3 = x3"
by (hipster_induct_schemes isNil.simps escape.simps isSpecial.simps)

lemma unknown [thy_expl]: "isNil y \<and> isNil x \<Longrightarrow> x = y"
by (hipster_induct_schemes isNil.simps escape.simps isSpecial.simps list.exhaust)

hipster_cond isSpecial isNil escape code isSpecial

theorem x0 :"
     ((escape xs) = (escape ys)) ==> (xs = ys)"
     (*apply(hipster_induct_schemes escape.simps isSpecial.simps code.simps Token.exhaust list.exhaust)*)

     apply(induction xs arbitrary: ys rule:escape.induct)
     apply(simp_all)
     apply(metis isNil.simps escape.simps thy_expl)
     apply(metis isNil.simps escape.simps escape.simps isSpecial.simps thy_expl)

     (*
     apply(metis thy_expl escape.simps isSpecial.simps code.simps list.exhaust Token.exhaust)*)
     (*apply(hipster_induct_schemes escape.simps isSpecial.simps code.simps Token.exhaust list.exhaust)*)
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


(* The value setup for post confidentiality *)
theory Post_Value_Setup
imports Post_Intro
begin

text \<open>The ID of the confidential post:\<close>

consts PID :: postID

subsection\<open>Preliminaries\<close>

(*
(* two posts equal everywhere but w.r.t. their content: *)
fun eqButT :: "post \<Rightarrow> post \<Rightarrow> bool" where
"eqButT ntc ntc1 =
 (titlePost ntc = titlePost ntc1 \<and>
  imgPost ntc = imgPost ntc1 \<and>
  visPost ntc = visPost ntc1)"

lemma eqButT_eq[simp,intro!]: "eqButT pap pap"
by(cases pap) auto

lemma eqButT_sym:
assumes "eqButT pap pap1"
shows "eqButT pap1 pap"
apply(cases pap, cases pap1)
using assms by auto

lemma eqButT_trans:
assumes "eqButT pap pap1" and "eqButT pap1 pap2"
shows "eqButT pap pap2"
apply(cases pap, cases pap1, cases pap2)
using assms by auto
*)

(* Auxiliary notion: two functions are equal everywhere but on PID *)
definition eeqButPID where
"eeqButPID ntcs ntcs1 \<equiv>
 \<forall> pid. pid \<noteq> PID \<longrightarrow>  ntcs pid = ntcs1 pid"

(* \<forall> pid. if pid = PID then eqButT (ntcs PID) (ntcs1 PID) else ntcs pid = ntcs1 pid *)

lemmas eeqButPID_intro = eeqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_eeq[simp,intro!]: "eeqButPID ntcs ntcs"
unfolding eeqButPID_def by auto

lemma eeqButPID_sym:
assumes "eeqButPID ntcs ntcs1" shows "eeqButPID ntcs1 ntcs"
using assms unfolding eeqButPID_def by auto

lemma eeqButPID_trans:
assumes "eeqButPID ntcs ntcs1" and "eeqButPID ntcs1 ntcs2" shows "eeqButPID ntcs ntcs2"
using assms unfolding eeqButPID_def by (auto split: if_splits)

lemma eeqButPID_cong:
assumes "eeqButPID ntcs ntcs1"
and "PID = PID \<Longrightarrow> eqButT uu uu1"
and "pid \<noteq> PID \<Longrightarrow> uu = uu1"
shows "eeqButPID (ntcs (pid := uu)) (ntcs1(pid := uu1))"
using assms unfolding eeqButPID_def by (auto split: if_splits)

(* lemma eeqButPID_eqButT:
"eeqButPID ntcs ntcs1 \<Longrightarrow> eqButT (ntcs PID) (ntcs1 PID)"
unfolding eeqButPID_def by (auto split: if_splits)
*)

lemma eeqButPID_not_PID:
"\<lbrakk>eeqButPID ntcs ntcs1; pid \<noteq> PID\<rbrakk> \<Longrightarrow> ntcs pid = ntcs1 pid"
unfolding eeqButPID_def by (auto split: if_splits)

(*
lemma eeqButPID_postSelectors:
"eeqButPID ntcs ntcs1 \<Longrightarrow>
 visPost (ntcs pid) = visPost (ntcs1 pid)"
  unfolding eeqButPID_def sledgehammer  by (metis eqButT.simps)
*)

lemma eeqButPID_toEq:
assumes "eeqButPID ntcs ntcs1"
shows "ntcs (PID := pst) = ntcs1 (PID := pst)"
using eeqButPID_not_PID[OF assms] by auto

lemma eeqButPID_update_post:
assumes "eeqButPID ntcs ntcs1"
shows "eeqButPID (ntcs (pid := ntc)) (ntcs1 (pid := ntc))"
using eeqButPID_not_PID[OF assms]
using assms unfolding eeqButPID_def by auto

(* The notion of two states being equal everywhere but on the content of
   the post associated to a given PID: *)
definition eqButPID :: "state \<Rightarrow> state \<Rightarrow> bool" where
"eqButPID s s1 \<equiv>
 admin s = admin s1 \<and>

 pendingUReqs s = pendingUReqs s1 \<and> userReq s = userReq s1 \<and>
 userIDs s = userIDs s1 \<and> user s = user s1 \<and> pass s = pass s1 \<and>

 pendingFReqs s = pendingFReqs s1 \<and> friendReq s = friendReq s1 \<and> friendIDs s = friendIDs s1 \<and>

 postIDs s = postIDs s1 \<and> admin s = admin s1 \<and>
 eeqButPID (post s) (post s1) \<and>
 owner s = owner s1 \<and>
 vis s = vis s1"

lemmas eqButPID_intro = eqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButPID_refl[simp,intro!]: "eqButPID s s"
unfolding eqButPID_def by auto

lemma eqButPID_sym:
assumes "eqButPID s s1" shows "eqButPID s1 s"
using assms eeqButPID_sym unfolding eqButPID_def by auto

lemma eqButPID_trans:
assumes "eqButPID s s1" and "eqButPID s1 s2" shows "eqButPID s s2"
using assms eeqButPID_trans unfolding eqButPID_def
by simp blast

(* Implications from eqButPID, including w.r.t. auxiliary operations: *)
lemma eqButPID_stateSelectors:
"eqButPID s s1 \<Longrightarrow>
 admin s = admin s1 \<and>

 pendingUReqs s = pendingUReqs s1 \<and> userReq s = userReq s1 \<and>
 userIDs s = userIDs s1 \<and> user s = user s1 \<and> pass s = pass s1 \<and>

 pendingFReqs s = pendingFReqs s1 \<and> friendReq s = friendReq s1 \<and> friendIDs s = friendIDs s1 \<and>

 postIDs s = postIDs s1 \<and> admin s = admin s1 \<and>
 eeqButPID (post s) (post s1) \<and>
 owner s = owner s1 \<and>
 vis s = vis s1 \<and>

 IDsOK s = IDsOK s1"
unfolding eqButPID_def IDsOK_def[abs_def] by auto

(* lemma eqButPID_eqButT:
"eqButPID s s1 \<Longrightarrow> eqButT (post s PID) (post s1 PID)"
unfolding eqButPID_def using eeqButPID_eqButT by auto *)

lemma eqButPID_not_PID:
"eqButPID s s1 \<Longrightarrow> pid \<noteq> PID \<Longrightarrow> post s pid = post s1 pid"
unfolding eqButPID_def using eeqButPID_not_PID by auto

lemma eqButPID_actions:
assumes "eqButPID s s1"
shows "listPosts s uid p = listPosts s1 uid p"
using eqButPID_stateSelectors[OF assms]
by (auto simp: l_defs intro!: arg_cong2[of _ _ _ _ cmap])

lemma eqButPID_setPost:
assumes "eqButPID s s1"
shows "(post s)(PID := pst) = (post s1)(PID := pst)"
using assms unfolding eqButPID_def using eeqButPID_toEq by auto

lemma eqButPID_update_post:
assumes "eqButPID s s1"
shows "eeqButPID ((post s) (pid := ntc)) ((post s1) (pid := ntc))"
using assms unfolding eqButPID_def using eeqButPID_update_post by auto

lemma eqButPID_cong[simp, intro]:
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>admin := uu1\<rparr>) (s1 \<lparr>admin := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingUReqs := uu1\<rparr>) (s1 \<lparr>pendingUReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>userReq := uu1\<rparr>) (s1 \<lparr>userReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>userIDs := uu1\<rparr>) (s1 \<lparr>userIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>user := uu1\<rparr>) (s1 \<lparr>user := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pass := uu1\<rparr>) (s1 \<lparr>pass := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>postIDs := uu1\<rparr>) (s1 \<lparr>postIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>owner := uu1\<rparr>) (s1 \<lparr>owner := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> eeqButPID uu1 uu2 \<Longrightarrow> eqButPID (s \<lparr>post := uu1\<rparr>) (s1 \<lparr>post := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>vis := uu1\<rparr>) (s1 \<lparr>vis := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingFReqs := uu1\<rparr>) (s1 \<lparr>pendingFReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>friendReq := uu1\<rparr>) (s1 \<lparr>friendReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>friendIDs := uu1\<rparr>) (s1 \<lparr>friendIDs := uu2\<rparr>)"

unfolding eqButPID_def by auto

subsection\<open>Value Setup\<close>

datatype "value" =
  TVal post \<comment> \<open>updated content of the confidential post\<close>
| OVal bool \<comment> \<open>updated dynamic declassification trigger condition\<close>

text \<open>Openness of the access window to the confidential information in a given state,
i.e.~the dynamic declassification trigger condition:\<close>

definition openToUIDs where
"openToUIDs s \<equiv>
 \<exists> uid \<in> UIDs.
   uid \<in>\<in> userIDs s \<and>
   (uid = owner s PID \<or> uid \<in>\<in> friendIDs s (owner s PID) \<or>
    vis s PID = PublicV)"

definition "open" where "open s \<equiv> PID \<in>\<in> postIDs s \<and> openToUIDs s"

lemmas open_defs = openToUIDs_def open_def

lemma eqButPID_openToUIDs:
assumes "eqButPID s s1"
shows "openToUIDs s \<longleftrightarrow> openToUIDs s1"
using eqButPID_stateSelectors[OF assms]
unfolding openToUIDs_def by auto

lemma eqButPID_open:
assumes "eqButPID s s1"
shows "open s \<longleftrightarrow> open s1"
using assms eqButPID_openToUIDs eqButPID_stateSelectors
unfolding open_def by auto

lemma not_open_eqButPID:
assumes 1: "\<not> open s" and 2: "eqButPID s s1"
shows "\<not> open s1"
using 1 unfolding eqButPID_open[OF 2] .

fun \<phi> :: "(state,act,out) trans \<Rightarrow> bool" where
"\<phi> (Trans _ (Uact (uPost uid p pid pst)) ou _) = (pid = PID \<and> ou = outOK)"
|
"\<phi> (Trans s _ _ s') = (open s \<noteq> open s')"

lemma \<phi>_def2:
  assumes "step s a = (ou,s')"
  shows
    "\<phi> (Trans s a ou s') \<longleftrightarrow>
     (\<exists>uid p pst. a = Uact (uPost uid p PID pst) \<and> ou = outOK) \<or>
      open s \<noteq> open s'"
proof (cases a)
  case (Uact ua)
  then show ?thesis
    using assms
    by (cases ua, auto simp: u_defs open_defs)
qed auto

fun f :: "(state,act,out) trans \<Rightarrow> value" where
"f (Trans s (Uact (uPost uid p pid pst)) _ s') =
 (if pid = PID then TVal pst else OVal (open s'))"
|
"f (Trans s _ _ s') = OVal (open s')"

lemma Uact_uPost_step_eqButPID:
assumes a: "a = Uact (uPost uid p PID pst)"
and "step s a = (ou,s')"
shows "eqButPID s s'"
using assms unfolding eqButPID_def eeqButPID_def
by (auto simp: u_defs split: if_splits)

(* Key lemma: *)
lemma eqButPID_step:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqButPID s' s1'"
proof -
  note [simp] = all_defs
                eeqButPID_def
  note [intro!] = eqButPID_intro
  note * =
    step step1 ss1
    eqButPID_stateSelectors[OF ss1]
    eqButPID_setPost[OF ss1] eqButPID_update_post[OF ss1]
  then show ?thesis
  proof (cases a)
    case (Sact x1)
    then show ?thesis using * by (cases x1) auto
  next
    case (Cact x2)
    then show ?thesis using * by (cases x2) auto
  next
    case (Dact x3)
    then show ?thesis using * by (cases x3) auto
  next
    case (Uact x4)
    show ?thesis
    proof (cases x4)
      case (uUser x11 x12 x13 x14 x15)
      then show ?thesis using Uact * by auto
    next
      case (uPost x31 x32 x33 x34)
      then show ?thesis using Uact * by (cases "x33 = PID") auto
    next
      case (uVisPost x51 x52 x53 x54)
      then show ?thesis using Uact * by (cases "x53 = PID") auto
    qed
  qed auto
qed

lemma eqButPID_step_\<phi>_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and \<phi>: "\<phi> (Trans s a ou s')"
shows "\<phi> (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 \<phi> eqButPID_open[OF ss1] eqButPID_open[OF s's1']
  using eqButPID_stateSelectors[OF ss1]
  unfolding \<phi>_def2[OF step] \<phi>_def2[OF step1]
  by (auto simp: u_defs)
qed

(* Key lemma: *)
lemma eqButPID_step_\<phi>:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "\<phi> (Trans s a ou s') = \<phi> (Trans s1 a ou1 s1')"
by (metis eqButPID_step_\<phi>_imp eqButPID_sym assms)

end


section\<open>Transitive set models of ZF\<close>
text\<open>This theory defines the locale \<^term>\<open>M_ZF_trans\<close> for
transitive models of ZF, and the associated \<^term>\<open>forcing_data\<close>
 that adds a forcing notion\<close>
theory Forcing_Data
  imports
    Forcing_Notions
    Interface

begin

lemma Transset_M :
  "Transset(M) \<Longrightarrow>  y\<in>x \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M"
  by (simp add: Transset_def,auto)

locale M_ZF =
  fixes M
  assumes
    upair_ax:         "upair_ax(##M)"
    and Union_ax:         "Union_ax(##M)"
    and power_ax:         "power_ax(##M)"
    and extensionality:   "extensionality(##M)"
    and foundation_ax:    "foundation_ax(##M)"
    and infinity_ax:      "infinity_ax(##M)"
    and separation_ax:    "\<phi>\<in>formula \<Longrightarrow> env\<in>list(M) \<Longrightarrow> arity(\<phi>) \<le> 1 #+ length(env) \<Longrightarrow>
                    separation(##M,\<lambda>x. sats(M,\<phi>,[x] @ env))"
    and replacement_ax:   "\<phi>\<in>formula \<Longrightarrow> env\<in>list(M) \<Longrightarrow> arity(\<phi>) \<le> 2 #+ length(env) \<Longrightarrow>
                    strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,[x,y] @ env))"

locale M_ctm = M_ZF +
  fixes enum
  assumes M_countable:      "enum\<in>bij(nat,M)"
    and trans_M:          "Transset(M)"

begin
interpretation intf: M_ZF_trans "M"
  using M_ZF_trans.intro
    trans_M upair_ax Union_ax power_ax extensionality
    foundation_ax infinity_ax separation_ax[simplified]
    replacement_ax[simplified]
  by simp

lemmas transitivity = Transset_intf[OF trans_M]

lemma zero_in_M:  "0 \<in> M"
  by (rule intf.zero_in_M)

lemma tuples_in_M: "A\<in>M \<Longrightarrow> B\<in>M \<Longrightarrow> \<langle>A,B\<rangle>\<in>M"
  by (simp flip:setclass_iff)

lemma nat_in_M : "nat \<in> M"
  by (rule intf.nat_in_M)

lemma n_in_M : "n\<in>nat \<Longrightarrow> n\<in>M"
  using nat_in_M transitivity by simp

lemma mtriv: "M_trivial(##M)"
  by (rule intf.mtriv)

lemma mtrans: "M_trans(##M)"
  by (rule intf.mtrans)

lemma mbasic: "M_basic(##M)"
  by (rule intf.mbasic)

lemma mtrancl: "M_trancl(##M)"
  by (rule intf.mtrancl)

lemma mdatatypes: "M_datatypes(##M)"
  by (rule intf.mdatatypes)

lemma meclose: "M_eclose(##M)"
  by (rule intf.meclose)

lemma meclose_pow: "M_eclose_pow(##M)"
  by (rule intf.meclose_pow)

end (* M_ctm *)

(* M_ctm interface *)
sublocale M_ctm \<subseteq> M_trivial "##M"
  by  (rule mtriv)

sublocale M_ctm \<subseteq> M_trans "##M"
  by  (rule mtrans)

sublocale M_ctm \<subseteq> M_basic "##M"
  by  (rule mbasic)

sublocale M_ctm \<subseteq> M_trancl "##M"
  by  (rule mtrancl)

sublocale M_ctm \<subseteq> M_datatypes "##M"
  by  (rule mdatatypes)

sublocale M_ctm \<subseteq> M_eclose "##M"
  by  (rule meclose)

sublocale M_ctm \<subseteq> M_eclose_pow "##M"
  by  (rule meclose_pow)

(* end interface *)

context M_ctm
begin

subsection\<open>\<^term>\<open>Collects\<close> in $M$\<close>
lemma Collect_in_M_0p :
  assumes
    Qfm : "Q_fm \<in> formula" and
    Qarty : "arity(Q_fm) = 1" and
    Qsats : "\<And>x. x\<in>M \<Longrightarrow> sats(M,Q_fm,[x]) \<longleftrightarrow> is_Q(##M,x)" and
    Qabs  : "\<And>x. x\<in>M \<Longrightarrow> is_Q(##M,x) \<longleftrightarrow> Q(x)" and
    "A\<in>M"
  shows
    "Collect(A,Q)\<in>M"
proof -
  have "z\<in>A \<Longrightarrow> z\<in>M" for z
    using \<open>A\<in>M\<close> transitivity[of z A] by simp
  then
  have 1:"Collect(A,is_Q(##M)) = Collect(A,Q)"
    using Qabs Collect_cong[of "A" "A" "is_Q(##M)" "Q"] by simp
  have "separation(##M,is_Q(##M))"
    using separation_ax Qsats Qarty Qfm
      separation_cong[of "##M" "\<lambda>y. sats(M,Q_fm,[y])" "is_Q(##M)"]
    by simp
  then
  have "Collect(A,is_Q(##M))\<in>M"
    using separation_closed \<open>A\<in>M\<close> by simp
  then
  show ?thesis using 1 by simp
qed

lemma Collect_in_M_2p :
  assumes
    Qfm : "Q_fm \<in> formula" and
    Qarty : "arity(Q_fm) = 3" and
    params_M : "y\<in>M" "z\<in>M" and
    Qsats : "\<And>x. x\<in>M \<Longrightarrow> sats(M,Q_fm,[x,y,z]) \<longleftrightarrow> is_Q(##M,x,y,z)" and
    Qabs  : "\<And>x. x\<in>M \<Longrightarrow> is_Q(##M,x,y,z) \<longleftrightarrow> Q(x,y,z)" and
    "A\<in>M"
  shows
    "Collect(A,\<lambda>x. Q(x,y,z))\<in>M"
proof -
  have "z\<in>A \<Longrightarrow> z\<in>M" for z
    using \<open>A\<in>M\<close> transitivity[of z A] by simp
  then
  have 1:"Collect(A,\<lambda>x. is_Q(##M,x,y,z)) = Collect(A,\<lambda>x. Q(x,y,z))"
    using Qabs Collect_cong[of "A" "A" "\<lambda>x. is_Q(##M,x,y,z)" "\<lambda>x. Q(x,y,z)"] by simp
  have "separation(##M,\<lambda>x. is_Q(##M,x,y,z))"
    using separation_ax Qsats Qarty Qfm params_M
      separation_cong[of "##M" "\<lambda>x. sats(M,Q_fm,[x,y,z])" "\<lambda>x. is_Q(##M,x,y,z)"]
    by simp
  then
  have "Collect(A,\<lambda>x. is_Q(##M,x,y,z))\<in>M"
    using separation_closed \<open>A\<in>M\<close> by simp
  then
  show ?thesis using 1 by simp
qed

lemma Collect_in_M_4p :
  assumes
    Qfm : "Q_fm \<in> formula" and
    Qarty : "arity(Q_fm) = 5" and
    params_M : "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" and
    Qsats : "\<And>x. x\<in>M \<Longrightarrow> sats(M,Q_fm,[x,a1,a2,a3,a4]) \<longleftrightarrow> is_Q(##M,x,a1,a2,a3,a4)" and
    Qabs  : "\<And>x. x\<in>M \<Longrightarrow> is_Q(##M,x,a1,a2,a3,a4) \<longleftrightarrow> Q(x,a1,a2,a3,a4)" and
    "A\<in>M"
  shows
    "Collect(A,\<lambda>x. Q(x,a1,a2,a3,a4))\<in>M"
proof -
  have "z\<in>A \<Longrightarrow> z\<in>M" for z
    using \<open>A\<in>M\<close> transitivity[of z A] by simp
  then
  have 1:"Collect(A,\<lambda>x. is_Q(##M,x,a1,a2,a3,a4)) = Collect(A,\<lambda>x. Q(x,a1,a2,a3,a4))"
    using Qabs Collect_cong[of "A" "A" "\<lambda>x. is_Q(##M,x,a1,a2,a3,a4)" "\<lambda>x. Q(x,a1,a2,a3,a4)"]
    by simp
  have "separation(##M,\<lambda>x. is_Q(##M,x,a1,a2,a3,a4))"
    using separation_ax Qsats Qarty Qfm params_M
      separation_cong[of "##M" "\<lambda>x. sats(M,Q_fm,[x,a1,a2,a3,a4])"
        "\<lambda>x. is_Q(##M,x,a1,a2,a3,a4)"]
    by simp
  then
  have "Collect(A,\<lambda>x. is_Q(##M,x,a1,a2,a3,a4))\<in>M"
    using separation_closed \<open>A\<in>M\<close> by simp
  then
  show ?thesis using 1 by simp
qed

lemma Repl_in_M :
  assumes
    f_fm:  "f_fm \<in> formula" and
    f_ar:  "arity(f_fm)\<le> 2 #+ length(env)" and
    fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> sats(M,f_fm,[x,y]@env) \<longleftrightarrow> is_f(x,y)" and
    fabs:  "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
    fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M"  and
    "A\<in>M" "env\<in>list(M)"
  shows "{f(x). x\<in>A}\<in>M"
proof -
  have "strong_replacement(##M, \<lambda>x y. sats(M,f_fm,[x,y]@env))"
    using replacement_ax f_fm f_ar \<open>env\<in>list(M)\<close> by simp
  then
  have "strong_replacement(##M, \<lambda>x y. y = f(x))"
    using fsats fabs
      strong_replacement_cong[of "##M" "\<lambda>x y. sats(M,f_fm,[x,y]@env)" "\<lambda>x y. y = f(x)"]
    by simp
  then
  have "{ y . x\<in>A , y = f(x) } \<in> M"
    using \<open>A\<in>M\<close> fclosed strong_replacement_closed by simp
  moreover
  have "{f(x). x\<in>A} = { y . x\<in>A , y = f(x) }"
    by auto
  ultimately show ?thesis by simp
qed

end (* M_ctm *)

subsection\<open>A forcing locale and generic filters\<close>
locale forcing_data = forcing_notion + M_ctm +
  assumes P_in_M:           "P \<in> M"
    and leq_in_M:         "leq \<in> M"

begin

lemma transD : "Transset(M) \<Longrightarrow> y \<in> M \<Longrightarrow> y \<subseteq> M"
  by (unfold Transset_def, blast)

(* P \<subseteq> M *)
lemmas P_sub_M = transD[OF trans_M P_in_M]

definition
  M_generic :: "i\<Rightarrow>o" where
  "M_generic(G) \<equiv> filter(G) \<and> (\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"

lemma M_genericD [dest]: "M_generic(G) \<Longrightarrow> x\<in>G \<Longrightarrow> x\<in>P"
  unfolding M_generic_def by (blast dest:filterD)

lemma M_generic_leqD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>P \<Longrightarrow> p\<preceq>q \<Longrightarrow> q\<in>G"
  unfolding M_generic_def by (blast dest:filter_leqD)

lemma M_generic_compatD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> r\<in>G \<Longrightarrow> \<exists>q\<in>G. q\<preceq>p \<and> q\<preceq>r"
  unfolding M_generic_def by (blast dest:low_bound_filter)

lemma M_generic_denseD [dest]: "M_generic(G) \<Longrightarrow> dense(D) \<Longrightarrow> D\<subseteq>P \<Longrightarrow> D\<in>M \<Longrightarrow> \<exists>q\<in>G. q\<in>D"
  unfolding M_generic_def by blast

lemma G_nonempty: "M_generic(G) \<Longrightarrow> G\<noteq>0"
proof -
  have "P\<subseteq>P" ..
  assume
    "M_generic(G)"
  with P_in_M P_dense \<open>P\<subseteq>P\<close> show
    "G \<noteq> 0"
    unfolding M_generic_def by auto
qed

lemma one_in_G :
  assumes "M_generic(G)"
  shows  "one \<in> G"
proof -
  from assms have "G\<subseteq>P"
    unfolding M_generic_def and filter_def by simp
  from \<open>M_generic(G)\<close> have "increasing(G)"
    unfolding M_generic_def and filter_def by simp
  with \<open>G\<subseteq>P\<close> and \<open>M_generic(G)\<close>
  show ?thesis
    using G_nonempty and one_in_P and one_max
    unfolding increasing_def by blast
qed

lemma G_subset_M: "M_generic(G) \<Longrightarrow> G \<subseteq> M"
  using transitivity[OF _ P_in_M] by auto

declare iff_trans [trans]

lemma generic_filter_existence:
  "p\<in>P \<Longrightarrow> \<exists>G. p\<in>G \<and> M_generic(G)"
proof -
  assume "p\<in>P"
  let ?D="\<lambda>n\<in>nat. (if (enum`n\<subseteq>P \<and> dense(enum`n))  then enum`n else P)"
  have "\<forall>n\<in>nat. ?D`n \<in> Pow(P)"
    by auto
  then
  have "?D:nat\<rightarrow>Pow(P)"
    using lam_type by auto
  have Eq4: "\<forall>n\<in>nat. dense(?D`n)"
  proof(intro ballI)
    fix n
    assume "n\<in>nat"
    then
    have "dense(?D`n) \<longleftrightarrow> dense(if enum`n \<subseteq> P \<and> dense(enum`n) then enum`n else P)"
      by simp
    also
    have "... \<longleftrightarrow>  (\<not>(enum`n \<subseteq> P \<and> dense(enum`n)) \<longrightarrow> dense(P)) "
      using split_if by simp
    finally
    show "dense(?D`n)"
      using P_dense \<open>n\<in>nat\<close> by auto
  qed
  from \<open>?D\<in>_\<close> and Eq4
  interpret cg: countable_generic P leq one ?D
    by (unfold_locales, auto)
  from \<open>p\<in>P\<close>
  obtain G where Eq6: "p\<in>G \<and> filter(G) \<and> (\<forall>n\<in>nat.(?D`n)\<inter>G\<noteq>0)"
    using cg.countable_rasiowa_sikorski[where M="\<lambda>_. M"]  P_sub_M
      M_countable[THEN bij_is_fun] M_countable[THEN bij_is_surj, THEN surj_range]
    unfolding cg.D_generic_def by blast
  then
  have Eq7: "(\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
  proof (intro ballI impI)
    fix D
    assume "D\<in>M" and Eq9: "D \<subseteq> P \<and> dense(D) "
    have "\<forall>y\<in>M. \<exists>x\<in>nat. enum`x= y"
      using M_countable and  bij_is_surj unfolding surj_def by (simp)
    with \<open>D\<in>M\<close> obtain n where Eq10: "n\<in>nat \<and> enum`n = D"
      by auto
    with Eq9 and if_P
    have "?D`n = D" by (simp)
    with Eq6 and Eq10
    show "D\<inter>G\<noteq>0" by auto
  qed
  with Eq6
  show ?thesis unfolding M_generic_def by auto
qed

(* Compatibility lemmas *)
lemma compat_in_abs :
  assumes
    "A\<in>M" "r\<in>M" "p\<in>M" "q\<in>M"
  shows
    "is_compat_in(##M,A,r,p,q) \<longleftrightarrow> compat_in(A,r,p,q)"
proof -
  have "d\<in>A \<Longrightarrow> d\<in>M" for d
    using transitivity \<open>A\<in>M\<close> by simp
  moreover from this
  have "d\<in>A \<Longrightarrow> \<langle>d, t\<rangle> \<in> M" if "t\<in>M" for t d
    using that pair_in_M_iff by simp
  ultimately
  show ?thesis
    unfolding is_compat_in_def compat_in_def
    using assms pair_in_M_iff transitivity by auto
qed

definition
  compat_in_fm :: "[i,i,i,i] \<Rightarrow> i" where
  "compat_in_fm(A,r,p,q) \<equiv>
    Exists(And(Member(0,succ(A)),Exists(And(pair_fm(1,p#+2,0),
                                        And(Member(0,r#+2),
                                 Exists(And(pair_fm(2,q#+3,0),Member(0,r#+3))))))))"

lemma compat_in_fm_type[TC] :
  "\<lbrakk> A\<in>nat;r\<in>nat;p\<in>nat;q\<in>nat\<rbrakk> \<Longrightarrow> compat_in_fm(A,r,p,q)\<in>formula"
  unfolding compat_in_fm_def by simp

lemma sats_compat_in_fm:
  assumes
    "A\<in>nat" "r\<in>nat"  "p\<in>nat" "q\<in>nat" "env\<in>list(M)"
  shows
    "sats(M,compat_in_fm(A,r,p,q),env) \<longleftrightarrow>
            is_compat_in(##M,nth(A, env),nth(r, env),nth(p, env),nth(q, env))"
  unfolding compat_in_fm_def is_compat_in_def using assms by simp

end (* forcing_data *)

end


theory Prelude_List_E2
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"ga_selector_pre\", \"ga_injective_suc\", \"ga_disjoint_0_suc\",
     \"ga_selector_undef_pre_0\", \"X1_def_Nat\", \"X2_def_Nat\",
     \"X3_def_Nat\", \"X4_def_Nat\", \"X5_def_Nat\", \"X6_def_Nat\",
     \"X7_def_Nat\", \"X8_def_Nat\", \"X9_def_Nat\", \"decimal_def\",
     \"ga_comm___XPlus__\", \"ga_assoc___XPlus__\",
     \"ga_right_unit___XPlus__\", \"ga_left_unit___XPlus__\",
     \"ga_left_comm___XPlus__\", \"ga_comm___Xx__\",
     \"ga_assoc___Xx__\", \"ga_right_unit___Xx__\",
     \"ga_left_unit___Xx__\", \"ga_left_comm___Xx__\", \"ga_comm_min\",
     \"ga_assoc_min\", \"ga_left_comm_min\", \"ga_comm_max\",
     \"ga_assoc_max\", \"ga_right_unit_max\", \"ga_left_unit_max\",
     \"ga_left_comm_max\", \"leq_def1_Nat\", \"leq_def2_Nat\",
     \"leq_def3_Nat\", \"geq_def_Nat\", \"less_def_Nat\",
     \"greater_def_Nat\", \"even_0_Nat\", \"even_suc_Nat\",
     \"odd_def_Nat\", \"factorial_0\", \"factorial_suc\", \"add_0_Nat\",
     \"add_suc_Nat\", \"mult_0_Nat\", \"mult_suc_Nat\", \"power_0_Nat\",
     \"power_suc_Nat\", \"min_def_Nat\", \"max_def_Nat\",
     \"subTotal_def1_Nat\", \"subTotal_def2_Nat\", \"sub_dom_Nat\",
     \"sub_def_Nat\", \"divide_dom_Nat\", \"divide_0_Nat\",
     \"divide_Pos_Nat\", \"div_dom_Nat\", \"div_Nat\", \"mod_dom_Nat\",
     \"mod_Nat\", \"distr1_Nat\", \"distr2_Nat\", \"min_0\",
     \"div_mod_Nat\", \"power_Nat\", \"equality_Int\", \"NatToInt\",
     \"IntToNat\", \"ga_comm___XPlus___1\", \"ga_assoc___XPlus___1\",
     \"ga_right_unit___XPlus___1\", \"ga_left_unit___XPlus___1\",
     \"ga_left_comm___XPlus___1\", \"ga_comm___Xx___1\",
     \"ga_assoc___Xx___1\", \"ga_right_unit___Xx___1\",
     \"ga_left_unit___Xx___1\", \"ga_left_comm___Xx___1\",
     \"ga_comm_min_1\", \"ga_comm_max_1\", \"ga_assoc_min_1\",
     \"ga_assoc_max_1\", \"ga_left_comm_min_1\", \"ga_left_comm_max_1\",
     \"geq_def_Int\", \"less_def_Int\", \"greater_def_Int\",
     \"even_def_Int\", \"odd_def_Int\", \"odd_alt_Int\",
     \"neg_def_Int\", \"sign_def_Int\", \"abs_def_Int\",
     \"add_def_Int\", \"mult_def_Int\", \"sub_def_Int\",
     \"min_def_Int\", \"max_def_Int\", \"power_neg1_Int\",
     \"power_others_Int\", \"divide_dom2_Int\", \"divide_alt_Int\",
     \"divide_Int\", \"div_dom_Int\", \"div_Int\", \"quot_dom_Int\",
     \"quot_neg_Int\", \"quot_nonneg_Int\", \"rem_dom_Int\",
     \"quot_rem_Int\", \"rem_nonneg_Int\", \"mod_dom_Int\", \"mod_Int\",
     \"distr1_Int\", \"distr2_Int\", \"Int_Nat_sub_compat\",
     \"abs_decomp_Int\", \"mod_abs_Int\", \"div_mod_Int\",
     \"quot_abs_Int\", \"rem_abs_Int\", \"quot_rem_Int_1\",
     \"power_Int\", \"NotFalse\", \"NotTrue\", \"AndFalse\",
     \"AndTrue\", \"AndSym\", \"OrDef\", \"OtherwiseDef\",
     \"NotFalse1\", \"NotTrue1\", \"notNot1\", \"notNot2\", \"Comp\",
     \"EqualTDef\", \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\",
     \"DiffDef\", \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\",
     \"TE2\", \"TE3\", \"TE4\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\",
     \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\", \"IUE1\", \"IUE2\",
     \"IOE01\", \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\",
     \"IOE07\", \"IOE08\", \"IOE09\", \"LeIrreflexivity\",
     \"LeTAsymmetry\", \"LeTTransitive\", \"LeTTotal\", \"GeDef\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"LeqDef\", \"LeqReflexivity\", \"LeqTTransitive\",
     \"LeqTTotal\", \"GeqDef\", \"GeqReflexivity\", \"GeqTTransitive\",
     \"GeqTTotal\", \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\",
     \"EqFOrdRel\", \"EqTOrdTSubstE\", \"EqTOrdFSubstE\",
     \"EqTOrdTSubstD\", \"EqTOrdFSubstD\", \"LeTGeTRel\", \"LeFGeFRel\",
     \"LeqTGetTRel\", \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\",
     \"GeqTLeqTRel\", \"GeqFLeqFRel\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\",
     \"TO3\", \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IOO13\", \"IOO14\",
     \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\", \"IOO20\",
     \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\", \"IOO26\",
     \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\", \"IOO32\",
     \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\", \"IBO9\",
     \"IBO10\", \"IBO11\", \"IBO12\", \"IUO01\", \"IUO02\", \"IUO03\",
     \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"LengthNil\",
     \"LengthCons\", \"NotDefHead\", \"HeadDef\", \"NotDefTail\",
     \"TailDef\", \"FoldrNil\", \"FoldrCons\", \"FoldlNil\",
     \"FoldlCons\", \"MapNil\", \"MapCons\", \"XPlusXPlusNil\",
     \"XPlusXPlusCons\", \"FilterNil\", \"FilterConsT\",
     \"FilterConsF\", \"ZipNil\", \"ZipConsNil\", \"ZipConsCons\",
     \"UnzipNil\", \"UnzipCons\", \"FoldlDecomp\", \"MapDecomp\",
     \"MapFunctor\", \"FilterProm\", \"ZipSpec\"]"

typedecl Unit
typedecl X_Int

datatype Nat = X0X2 ("0''''") | X_suc "Nat" ("suc/'(_')" [3] 999)
datatype Bool = X_False ("False''") | X_True ("True''")
datatype Ordering = EQ | GT | LT
datatype 'a List = X_Cons 'a "'a List" | X_Nil ("Nil''")

consts
IntToNat__X :: "X_Int => Nat partial" ("(IntToNat/ _)" [56] 56)
NatToInt__X :: "Nat => X_Int" ("(NatToInt/ _)" [56] 56)
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X0X1 :: "X_Int" ("0''")
X1X1 :: "X_Int" ("1''")
X1X2 :: "Nat" ("1''''")
X2X1 :: "X_Int" ("2''")
X2X2 :: "Nat" ("2''''")
X3X1 :: "X_Int" ("3''")
X3X2 :: "Nat" ("3''''")
X4X1 :: "X_Int" ("4''")
X4X2 :: "Nat" ("4''''")
X5X1 :: "X_Int" ("5''")
X5X2 :: "Nat" ("5''''")
X6X1 :: "X_Int" ("6''")
X6X2 :: "Nat" ("6''''")
X7X1 :: "X_Int" ("7''")
X7X2 :: "Nat" ("7''''")
X8X1 :: "X_Int" ("8''")
X8X2 :: "Nat" ("8''''")
X9X1 :: "X_Int" ("9''")
X9X2 :: "Nat" ("9''''")
XMinus__X :: "X_Int => X_Int" ("(-''/ _)" [56] 56)
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XAtXAt__X :: "Nat => Nat => Nat" ("(_/ @@/ _)" [54,54] 52)
X__XCaret__XX1 :: "X_Int => Nat => X_Int" ("(_/ ^''/ _)" [54,54] 52)
X__XCaret__XX2 :: "Nat => Nat => Nat" ("(_/ ^''''/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XExclam :: "Nat => Nat" ("(_/ !'')" [58] 58)
X__XGtXEq__XX1 :: "X_Int => X_Int => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGtXEq__XX2 :: "Nat => Nat => bool" ("(_/ >=''''/ _)" [44,44] 42)
X__XGtXEq__XX3 :: "'a => 'a => Bool" ("(_/ >='_3/ _)" [54,54] 52)
X__XGt__XX1 :: "X_Int => X_Int => bool" ("(_/ >''/ _)" [44,44] 42)
X__XGt__XX2 :: "Nat => Nat => bool" ("(_/ >''''/ _)" [44,44] 42)
X__XGt__XX3 :: "'a => 'a => Bool" ("(_/ >'_3/ _)" [54,54] 52)
X__XLtXEq__XX1 :: "X_Int => X_Int => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLtXEq__XX2 :: "Nat => Nat => bool" ("(_/ <=''''/ _)" [44,44] 42)
X__XLtXEq__XX3 :: "'a => 'a => Bool" ("(_/ <='_3/ _)" [54,54] 52)
X__XLt__XX1 :: "X_Int => X_Int => bool" ("(_/ <''/ _)" [44,44] 42)
X__XLt__XX2 :: "Nat => Nat => bool" ("(_/ <''''/ _)" [44,44] 42)
X__XLt__XX3 :: "'a => 'a => Bool" ("(_/ <'_3/ _)" [54,54] 52)
X__XMinusXExclam__X :: "Nat => Nat => Nat" ("(_/ -!/ _)" [54,54] 52)
X__XMinusXQuest__X :: "Nat => Nat => Nat partial" ("(_/ -?/ _)" [54,54] 52)
X__XMinus__XX1 :: "X_Int => X_Int => X_Int" ("(_/ -''/ _)" [54,54] 52)
X__XMinus__XX2 :: "Nat => Nat => X_Int" ("(_/ -''''/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List => 'a List => 'a List" ("(_/ ++''/ _)" [54,54] 52)
X__XPlus__XX1 :: "X_Int => X_Int => X_Int" ("(_/ +''/ _)" [54,54] 52)
X__XPlus__XX2 :: "Nat => Nat => Nat" ("(_/ +''''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XSlashXQuest__XX1 :: "X_Int => X_Int => X_Int partial" ("(_/ '/?''/ _)" [54,54] 52)
X__XSlashXQuest__XX2 :: "Nat => Nat => Nat partial" ("(_/ '/?''''/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__Xx__XX1 :: "X_Int => X_Int => X_Int" ("(_/ *''/ _)" [54,54] 52)
X__Xx__XX2 :: "Nat => Nat => Nat" ("(_/ *''''/ _)" [54,54] 52)
X__div__XX1 :: "X_Int => X_Int => X_Int partial" ("(_/ div''/ _)" [54,54] 52)
X__div__XX2 :: "Nat => Nat => Nat partial" ("(_/ div''''/ _)" [54,54] 52)
X__mod__XX1 :: "X_Int => X_Int => Nat partial" ("(_/ mod''/ _)" [54,54] 52)
X__mod__XX2 :: "Nat => Nat => Nat partial" ("(_/ mod''''/ _)" [54,54] 52)
X__o__X :: "('b => 'c) * ('a => 'b) => 'a => 'c"
X__quot__X :: "X_Int => X_Int => X_Int partial" ("(_/ quot/ _)" [54,54] 52)
X__rem__X :: "X_Int => X_Int => X_Int partial" ("(_/ rem/ _)" [54,54] 52)
X_abs :: "X_Int => Nat" ("abs''/'(_')" [3] 999)
X_evenX1 :: "X_Int => bool" ("even''/'(_')" [3] 999)
X_evenX2 :: "Nat => bool" ("even''''/'(_')" [3] 999)
X_filter :: "('a => Bool) => 'a List => 'a List" ("filter''/'(_,/ _')" [3,3] 999)
X_foldl :: "('a * 'b => 'a) => 'a => 'b List => 'a" ("foldl''/'(_,/ _,/ _')" [3,3,3] 999)
X_foldr :: "('a * 'b => 'b) => 'b => 'a List => 'b" ("foldr''/'(_,/ _,/ _')" [3,3,3] 999)
X_head :: "'a List => 'a partial" ("head/'(_')" [3] 999)
X_length :: "'a List => X_Int" ("length''/'(_')" [3] 999)
X_map :: "('a => 'b) => 'a List => 'b List" ("map''/'(_,/ _')" [3,3] 999)
X_maxX1 :: "X_Int => X_Int => X_Int" ("max''/'(_,/ _')" [3,3] 999)
X_maxX2 :: "Nat => Nat => Nat" ("max''''/'(_,/ _')" [3,3] 999)
X_maxX3 :: "'a => 'a => 'a"
X_minX1 :: "X_Int => X_Int => X_Int" ("min''/'(_,/ _')" [3,3] 999)
X_minX2 :: "Nat => Nat => Nat" ("min''''/'(_,/ _')" [3,3] 999)
X_minX3 :: "'a => 'a => 'a"
X_oddX1 :: "X_Int => bool" ("odd''/'(_')" [3] 999)
X_oddX2 :: "Nat => bool" ("odd''''/'(_')" [3] 999)
X_pre :: "Nat => Nat partial" ("pre/'(_')" [3] 999)
X_sign :: "X_Int => X_Int" ("sign/'(_')" [3] 999)
X_tail :: "'a List => 'a List partial" ("tail/'(_')" [3] 999)
X_unzip :: "('a * 'b) List => 'a List * 'b List" ("unzip/'(_')" [3] 999)
X_zip :: "'a List => 'b List => ('a * 'b) List" ("zip''/'(_,/ _')" [3,3] 999)
compare :: "'a => 'a => Ordering"
otherwiseH :: "Bool"

axioms
ga_selector_pre [rule_format] :
"ALL XX1. pre(suc(XX1)) = makePartial XX1"

ga_injective_suc [rule_format] :
"ALL XX1. ALL Y1. suc(XX1) = suc(Y1) = (XX1 = Y1)"

ga_disjoint_0_suc [rule_format] : "ALL Y1. ~ 0'' = suc(Y1)"

ga_selector_undef_pre_0 [rule_format] : "~ defOp (pre(0''))"

X1_def_Nat [rule_format] : "1'' = suc(0'')"

X2_def_Nat [rule_format] : "2'' = suc(1'')"

X3_def_Nat [rule_format] : "3'' = suc(2'')"

X4_def_Nat [rule_format] : "4'' = suc(3'')"

X5_def_Nat [rule_format] : "5'' = suc(4'')"

X6_def_Nat [rule_format] : "6'' = suc(5'')"

X7_def_Nat [rule_format] : "7'' = suc(6'')"

X8_def_Nat [rule_format] : "8'' = suc(7'')"

X9_def_Nat [rule_format] : "9'' = suc(8'')"

decimal_def [rule_format] :
"ALL m. ALL X_n. m @@ X_n = (m *'' suc(9'')) +'' X_n"

ga_comm___XPlus__ [rule_format] : "ALL x. ALL y. x +'' y = y +'' x"

ga_assoc___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. (x +'' y) +'' z = x +'' (y +'' z)"

ga_right_unit___XPlus__ [rule_format] : "ALL x. x +'' 0'' = x"

ga_left_unit___XPlus__ [rule_format] : "ALL x. 0'' +'' x = x"

ga_left_comm___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. x +'' (y +'' z) = y +'' (x +'' z)"

ga_comm___Xx__ [rule_format] : "ALL x. ALL y. x *'' y = y *'' x"

ga_assoc___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. (x *'' y) *'' z = x *'' (y *'' z)"

ga_right_unit___Xx__ [rule_format] : "ALL x. x *'' 1'' = x"

ga_left_unit___Xx__ [rule_format] : "ALL x. 1'' *'' x = x"

ga_left_comm___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. x *'' (y *'' z) = y *'' (x *'' z)"

ga_comm_min [rule_format] :
"ALL x. ALL y. min''(x, y) = min''(y, x)"

ga_assoc_min [rule_format] :
"ALL x.
 ALL y. ALL z. min''(min''(x, y), z) = min''(x, min''(y, z))"

ga_left_comm_min [rule_format] :
"ALL x.
 ALL y. ALL z. min''(x, min''(y, z)) = min''(y, min''(x, z))"

ga_comm_max [rule_format] :
"ALL x. ALL y. max''(x, y) = max''(y, x)"

ga_assoc_max [rule_format] :
"ALL x.
 ALL y. ALL z. max''(max''(x, y), z) = max''(x, max''(y, z))"

ga_right_unit_max [rule_format] : "ALL x. max''(x, 0'') = x"

ga_left_unit_max [rule_format] : "ALL x. max''(0'', x) = x"

ga_left_comm_max [rule_format] :
"ALL x.
 ALL y. ALL z. max''(x, max''(y, z)) = max''(y, max''(x, z))"

leq_def1_Nat [rule_format] : "ALL X_n. 0'' <='' X_n"

leq_def2_Nat [rule_format] : "ALL X_n. ~ suc(X_n) <='' 0''"

leq_def3_Nat [rule_format] :
"ALL m. ALL X_n. (suc(m) <='' suc(X_n)) = (m <='' X_n)"

geq_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >='' X_n) = (X_n <='' m)"

less_def_Nat [rule_format] :
"ALL m. ALL X_n. (m <'' X_n) = (m <='' X_n & ~ m = X_n)"

greater_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >'' X_n) = (X_n <'' m)"

even_0_Nat [rule_format] : "even''(0'')"

even_suc_Nat [rule_format] : "ALL m. even''(suc(m)) = odd''(m)"

odd_def_Nat [rule_format] : "ALL m. odd''(m) = (~ even''(m))"

factorial_0 [rule_format] : "0'' !' = 1''"

factorial_suc [rule_format] :
"ALL X_n. suc(X_n) !' = suc(X_n) *'' X_n !'"

add_0_Nat [rule_format] : "ALL m. 0'' +'' m = m"

add_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) +'' m = suc(X_n +'' m)"

mult_0_Nat [rule_format] : "ALL m. 0'' *'' m = 0''"

mult_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) *'' m = (X_n *'' m) +'' m"

power_0_Nat [rule_format] : "ALL m. m ^'' 0'' = 1''"

power_suc_Nat [rule_format] :
"ALL m. ALL X_n. m ^'' suc(X_n) = m *'' (m ^'' X_n)"

min_def_Nat [rule_format] :
"ALL m. ALL X_n. min''(m, X_n) = (if m <='' X_n then m else X_n)"

max_def_Nat [rule_format] :
"ALL m. ALL X_n. max''(m, X_n) = (if m <='' X_n then X_n else m)"

subTotal_def1_Nat [rule_format] :
"ALL m. ALL X_n. m >'' X_n --> X_n -! m = 0''"

subTotal_def2_Nat [rule_format] :
"ALL m. ALL X_n. m <='' X_n --> makePartial (X_n -! m) = X_n -? m"

sub_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m -? X_n) = (m >='' X_n)"

sub_def_Nat [rule_format] :
"ALL m. ALL X_n. ALL r. m -? X_n = makePartial r = (m = r +'' X_n)"

divide_dom_Nat [rule_format] :
"ALL m.
 ALL X_n.
 defOp (m /?'' X_n) = (~ X_n = 0'' & m mod'' X_n = makePartial 0'')"

divide_0_Nat [rule_format] : "ALL m. ~ defOp (m /?'' 0'')"

divide_Pos_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 X_n >'' 0'' --> m /?'' X_n = makePartial r = (m = r *'' X_n)"

div_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m div'' X_n) = (~ X_n = 0'')"

div_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div'' X_n = makePartial r =
 (EX s. m = (X_n *'' r) +'' s & s <'' X_n)"

mod_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m mod'' X_n) = (~ X_n = 0'')"

mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m mod'' X_n = makePartial s =
 (EX r. m = (X_n *'' r) +'' s & s <'' X_n)"

distr1_Nat [rule_format] :
"ALL r. ALL s. ALL t. (r +'' s) *'' t = (r *'' t) +'' (s *'' t)"

distr2_Nat [rule_format] :
"ALL r. ALL s. ALL t. t *'' (r +'' s) = (t *'' r) +'' (t *'' s)"

min_0 [rule_format] : "ALL m. min''(m, 0'') = 0''"

div_mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0'' -->
 makePartial m =
 (let (Xb5, Xc0) =
      let (Xb4, Xc3) = m div'' X_n
      in if Xb4 then makePartial (Xc3 *'' X_n) else noneOp
  in if Xb5
        then let (Xb2, Xc1) = m mod'' X_n
             in if Xb2 then makePartial (Xc0 +'' Xc1) else noneOp
        else noneOp)"

power_Nat [rule_format] :
"ALL m. ALL r. ALL s. m ^'' (r +'' s) = (m ^'' r) *'' (m ^'' s)"

equality_Int [rule_format] :
"ALL a.
 ALL b. ALL c. ALL d. a -'' b = c -'' d = (a +'' d = c +'' b)"

NatToInt [rule_format] : "ALL a. NatToInt a = a -'' 0''"

IntToNat [rule_format] :
"ALL a. ALL b. IntToNat (a -'' b) = makePartial (a -! b)"

ga_comm___XPlus___1 [rule_format] : "ALL x. ALL y. x +' y = y +' x"

ga_assoc___XPlus___1 [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) +' z = x +' (y +' z)"

ga_right_unit___XPlus___1 [rule_format] : "ALL x. x +' 0' = x"

ga_left_unit___XPlus___1 [rule_format] : "ALL x. 0' +' x = x"

ga_left_comm___XPlus___1 [rule_format] :
"ALL x. ALL y. ALL z. x +' (y +' z) = y +' (x +' z)"

ga_comm___Xx___1 [rule_format] : "ALL x. ALL y. x *' y = y *' x"

ga_assoc___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. (x *' y) *' z = x *' (y *' z)"

ga_right_unit___Xx___1 [rule_format] : "ALL x. x *' 1' = x"

ga_left_unit___Xx___1 [rule_format] : "ALL x. 1' *' x = x"

ga_left_comm___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. x *' (y *' z) = y *' (x *' z)"

ga_comm_min_1 [rule_format] :
"ALL x. ALL y. min'(x, y) = min'(y, x)"

ga_comm_max_1 [rule_format] :
"ALL x. ALL y. max'(x, y) = max'(y, x)"

ga_assoc_min_1 [rule_format] :
"ALL x. ALL y. ALL z. min'(min'(x, y), z) = min'(x, min'(y, z))"

ga_assoc_max_1 [rule_format] :
"ALL x. ALL y. ALL z. max'(max'(x, y), z) = max'(x, max'(y, z))"

ga_left_comm_min_1 [rule_format] :
"ALL x. ALL y. ALL z. min'(x, min'(y, z)) = min'(y, min'(x, z))"

ga_left_comm_max_1 [rule_format] :
"ALL x. ALL y. ALL z. max'(x, max'(y, z)) = max'(y, max'(x, z))"

geq_def_Int [rule_format] :
"ALL m. ALL X_n. (m >=' X_n) = (X_n <=' m)"

less_def_Int [rule_format] :
"ALL m. ALL X_n. (m <' X_n) = (m <=' X_n & ~ m = X_n)"

greater_def_Int [rule_format] :
"ALL m. ALL X_n. (m >' X_n) = (X_n <' m)"

even_def_Int [rule_format] : "ALL m. even'(m) = even''(abs'(m))"

odd_def_Int [rule_format] : "ALL m. odd'(m) = (~ even'(m))"

odd_alt_Int [rule_format] : "ALL m. odd'(m) = odd''(abs'(m))"

neg_def_Int [rule_format] : "ALL a. ALL b. -' (a -'' b) = b -'' a"

sign_def_Int [rule_format] :
"ALL m.
 sign(m) = (if m = 0' then 0' else if m >' 0' then 1' else -' 1')"

abs_def_Int [rule_format] :
"ALL m.
 makePartial (abs'(m)) =
 (if m <' 0' then IntToNat -' m else IntToNat m)"

add_def_Int [rule_format] :
"ALL a.
 ALL b.
 ALL c. ALL d. (a -'' b) +' (c -'' d) = (a +'' c) -'' (b +'' d)"

mult_def_Int [rule_format] :
"ALL a.
 ALL b.
 ALL c.
 ALL d.
 (a -'' b) *' (c -'' d) =
 ((a *'' c) +'' (b *'' d)) -'' ((b *'' c) +'' (a *'' d))"

sub_def_Int [rule_format] :
"ALL m. ALL X_n. m -' X_n = m +' -' X_n"

min_def_Int [rule_format] :
"ALL m. ALL X_n. min'(m, X_n) = (if m <=' X_n then m else X_n)"

max_def_Int [rule_format] :
"ALL m. ALL X_n. max'(m, X_n) = (if m <=' X_n then X_n else m)"

power_neg1_Int [rule_format] :
"ALL a. -' 1' ^' a = (if even''(a) then 1' else -' 1')"

power_others_Int [rule_format] :
"ALL m.
 ALL a.
 ~ m = -' 1' --> m ^' a = (sign(m) ^' a) *' (NatToInt abs'(m) ^' a)"

divide_dom2_Int [rule_format] :
"ALL m.
 ALL X_n. defOp (m /?' X_n) = (m mod' X_n = makePartial 0'')"

divide_alt_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r. m /?' X_n = makePartial r = (~ X_n = 0' & X_n *' r = m)"

divide_Int [rule_format] :
"ALL m.
 ALL X_n.
 m /?' X_n =
 (let (Xb1, Xc0) = NatToInt abs'(m) /?' NatToInt abs'(X_n)
  in if Xb1 then makePartial ((sign(m) *' sign(X_n)) *' Xc0)
        else noneOp)"

div_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m div' X_n) = (~ X_n = 0')"

div_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div' X_n = makePartial r =
 (EX a. m = (X_n *' r) +' NatToInt a & a <'' abs'(X_n))"

quot_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m quot X_n) = (~ X_n = 0')"

quot_neg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m <' 0' -->
 m quot X_n = makePartial r =
 (EX s.
  m = (X_n *' r) +' s & 0' >=' s & s >' -' NatToInt abs'(X_n))"

quot_nonneg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m >=' 0' -->
 m quot X_n = makePartial r =
 (EX s. m = (X_n *' r) +' s & 0' <=' s & s <' NatToInt abs'(X_n))"

rem_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m rem X_n) = (~ X_n = 0')"

quot_rem_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m <' 0' -->
 m rem X_n = makePartial s =
 (EX r.
  m = (X_n *' r) +' s & 0' >=' s & s >' -' NatToInt abs'(X_n))"

rem_nonneg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m >=' 0' -->
 m rem X_n = makePartial s =
 (EX r. m = (X_n *' r) +' s & 0' <=' s & s <' NatToInt abs'(X_n))"

mod_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m mod' X_n) = (~ X_n = 0')"

mod_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL a.
 m mod' X_n = makePartial a =
 (EX r. m = (X_n *' r) +' NatToInt a & a <'' abs'(X_n))"

distr1_Int [rule_format] :
"ALL r. ALL s. ALL t. (r +' s) *' t = (r *' t) +' (s *' t)"

distr2_Int [rule_format] :
"ALL r. ALL s. ALL t. t *' (r +' s) = (t *' r) +' (t *' s)"

Int_Nat_sub_compat [rule_format] :
"ALL a. ALL b. defOp (a -? b) --> a -? b = IntToNat (a -'' b)"

abs_decomp_Int [rule_format] :
"ALL m. m = sign(m) *' NatToInt abs'(m)"

mod_abs_Int [rule_format] :
"ALL m. ALL X_n. m mod' X_n = m mod' NatToInt abs'(X_n)"

div_mod_Int [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0' -->
 makePartial m =
 (let (Xb7, Xc0) =
      let (Xb6, Xc5) = m div' X_n
      in if Xb6 then makePartial (Xc5 *' X_n) else noneOp
  in if Xb7
        then let (Xb4, Xc1) =
                 let (Xb3, Xc2) = m mod' X_n
                 in if Xb3 then makePartial (NatToInt Xc2) else noneOp
             in if Xb4 then makePartial (Xc0 +' Xc1) else noneOp
        else noneOp)"

quot_abs_Int [rule_format] :
"ALL m.
 ALL X_n.
 (let (Xb3, Xc0) =
      let (Xb2, Xc1) = m quot X_n
      in if Xb2 then makePartial (abs'(Xc1)) else noneOp
  in if Xb3 then makePartial (NatToInt Xc0) else noneOp) =
 NatToInt abs'(m) quot NatToInt abs'(X_n)"

rem_abs_Int [rule_format] :
"ALL m.
 ALL X_n.
 (let (Xb3, Xc0) =
      let (Xb2, Xc1) = m rem X_n
      in if Xb2 then makePartial (abs'(Xc1)) else noneOp
  in if Xb3 then makePartial (NatToInt Xc0) else noneOp) =
 NatToInt abs'(m) rem NatToInt abs'(X_n)"

quot_rem_Int_1 [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0' -->
 makePartial m =
 (let (Xb5, Xc0) =
      let (Xb4, Xc3) = m quot X_n
      in if Xb4 then makePartial (Xc3 *' X_n) else noneOp
  in if Xb5
        then let (Xb2, Xc1) = m rem X_n
             in if Xb2 then makePartial (Xc0 +' Xc1) else noneOp
        else noneOp)"

power_Int [rule_format] :
"ALL m. ALL a. ALL b. m ^' (a +'' b) = (m ^' a) *' (m ^' b)"

NotFalse [rule_format] : "Not' False' = True'"

NotTrue [rule_format] : "Not' True' = False'"

AndFalse [rule_format] : "ALL x. False' && x = False'"

AndTrue [rule_format] : "ALL x. True' && x = x"

AndSym [rule_format] : "ALL x. ALL y. x && y = y && x"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH = True'"

NotFalse1 [rule_format] : "ALL x. Not' x = True' = (x = False')"

NotTrue1 [rule_format] : "ALL x. Not' x = False' = (x = True')"

notNot1 [rule_format] : "ALL x. (~ x = True') = (Not' x = True')"

notNot2 [rule_format] : "ALL x. (~ x = False') = (Not' x = False')"

Comp [rule_format] :
"ALL f.
 ALL g. makePartial o X__o__X (f, g) = makePartial o (% x. f (g x))"

EqualTDef [rule_format] : "ALL x. ALL y. x = y --> x ==' y = True'"

EqualSymDef [rule_format] : "ALL x. ALL y. x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL x. x ==' x = True'"

EqualTransT [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y ==' z = True' --> x ==' z = True'"

DiffDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffSymDef [rule_format] : "ALL x. ALL y. x /= y = y /= x"

DiffTDef [rule_format] :
"ALL x. ALL y. x /= y = True' = (Not' (x ==' y) = True')"

DiffFDef [rule_format] :
"ALL x. ALL y. x /= y = False' = (x ==' y = True')"

TE1 [rule_format] : "ALL x. ALL y. x ==' y = False' --> ~ x = y"

TE2 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = True' = (x ==' y = False')"

TE3 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = False' = (x ==' y = True')"

TE4 [rule_format] :
"ALL x. ALL y. (~ x ==' y = True') = (x ==' y = False')"

IBE1 [rule_format] : "True' ==' True' = True'"

IBE2 [rule_format] : "False' ==' False' = True'"

IBE3 [rule_format] : "False' ==' True' = False'"

IBE4 [rule_format] : "True' ==' False' = False'"

IBE5 [rule_format] : "True' /= False' = True'"

IBE6 [rule_format] : "False' /= True' = True'"

IBE7 [rule_format] : "Not' (True' ==' False') = True'"

IBE8 [rule_format] : "Not' Not' (True' ==' False') = False'"

IUE1 [rule_format] : "() ==' () = True'"

IUE2 [rule_format] : "() /= () = False'"

IOE01 [rule_format] : "LT ==' LT = True'"

IOE02 [rule_format] : "EQ ==' EQ = True'"

IOE03 [rule_format] : "GT ==' GT = True'"

IOE04 [rule_format] : "LT ==' EQ = False'"

IOE05 [rule_format] : "LT ==' GT = False'"

IOE06 [rule_format] : "EQ ==' GT = False'"

IOE07 [rule_format] : "LT /= EQ = True'"

IOE08 [rule_format] : "LT /= GT = True'"

IOE09 [rule_format] : "EQ /= GT = True'"

LeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x <_3 y = False'"

LeTAsymmetry [rule_format] :
"ALL x. ALL y. x <_3 y = True' --> y <_3 x = False'"

LeTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. x <_3 y = True' & y <_3 z = True' --> x <_3 z = True'"

LeTTotal [rule_format] :
"ALL x.
 ALL y. (x <_3 y = True' | y <_3 x = True') | x ==' y = True'"

GeDef [rule_format] : "ALL x. ALL y. x >_3 y = y <_3 x"

GeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x >_3 y = False'"

GeTAsymmetry [rule_format] :
"ALL x. ALL y. x >_3 y = True' --> y >_3 x = False'"

GeTTransitive [rule_format] :
"ALL x.
 ALL y. ALL z. (x >_3 y) && (y >_3 z) = True' --> x >_3 z = True'"

GeTTotal [rule_format] :
"ALL x. ALL y. ((x >_3 y) || (y >_3 x)) || (x ==' y) = True'"

LeqDef [rule_format] :
"ALL x. ALL y. x <=_3 y = (x <_3 y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL x. x <=_3 x = True'"

LeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. (x <=_3 y) && (y <=_3 z) = True' --> x <=_3 z = True'"

LeqTTotal [rule_format] :
"ALL x. ALL y. (x <=_3 y) && (y <=_3 x) = x ==' y"

GeqDef [rule_format] :
"ALL x. ALL y. x >=_3 y = (x >_3 y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL x. x >=_3 x = True'"

GeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. (x >=_3 y) && (y >=_3 z) = True' --> x >=_3 z = True'"

GeqTTotal [rule_format] :
"ALL x. ALL y. (x >=_3 y) && (y >=_3 x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <_3 y = False' & x >_3 y = False')"

EqFSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <_3 y = True' | x >_3 y = True')"

EqTOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <=_3 y = True' & x >=_3 y = True')"

EqFOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <=_3 y = True' | x >=_3 y = True')"

EqTOrdTSubstE [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y <_3 z = True' --> x <_3 z = True'"

EqTOrdFSubstE [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y <_3 z = False' --> x <_3 z = False'"

EqTOrdTSubstD [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & z <_3 y = True' --> z <_3 x = True'"

EqTOrdFSubstD [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & z <_3 y = False' --> z <_3 x = False'"

LeTGeTRel [rule_format] :
"ALL x. ALL y. x <_3 y = True' = (y >_3 x = True')"

LeFGeFRel [rule_format] :
"ALL x. ALL y. x <_3 y = False' = (y >_3 x = False')"

LeqTGetTRel [rule_format] :
"ALL x. ALL y. x <=_3 y = True' = (y >=_3 x = True')"

LeqFGetFRel [rule_format] :
"ALL x. ALL y. x <=_3 y = False' = (y >=_3 x = False')"

GeTLeTRel [rule_format] :
"ALL x. ALL y. x >_3 y = True' = (y <_3 x = True')"

GeFLeFRel [rule_format] :
"ALL x. ALL y. x >_3 y = False' = (y <_3 x = False')"

GeqTLeqTRel [rule_format] :
"ALL x. ALL y. x >=_3 y = True' = (y <=_3 x = True')"

GeqFLeqFRel [rule_format] :
"ALL x. ALL y. x >=_3 y = False' = (y <=_3 x = False')"

LeTGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <_3 y = True' = (x >_3 y = False' & x ==' y = False')"

LeFGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <_3 y = False' = (x >_3 y = True' | x ==' y = True')"

LeqTGeFRel [rule_format] :
"ALL x. ALL y. x <=_3 y = True' = (x >_3 y = False')"

LeqFGeTRel [rule_format] :
"ALL x. ALL y. x <=_3 y = False' = (x >_3 y = True')"

GeTLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >_3 y = True' = (x <_3 y = False' & x ==' y = False')"

GeFLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >_3 y = False' = (x <_3 y = True' | x ==' y = True')"

GeqTLeFRel [rule_format] :
"ALL x. ALL y. x >=_3 y = True' = (x <_3 y = False')"

GeqFLeTRel [rule_format] :
"ALL x. ALL y. x >=_3 y = False' = (x <_3 y = True')"

LeqTLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <=_3 y = True' = (x <_3 y = True' | x ==' y = True')"

LeqFLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <=_3 y = False' = (x <_3 y = False' & x ==' y = False')"

GeqTGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >=_3 y = True' = (x >_3 y = True' | x ==' y = True')"

GeqFGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >=_3 y = False' = (x >_3 y = False' & x ==' y = False')"

LeTGeqFRel [rule_format] :
"ALL x. ALL y. x <_3 y = True' = (x >=_3 y = False')"

GeTLeqFRel [rule_format] :
"ALL x. ALL y. x >_3 y = True' = (x <=_3 y = False')"

LeLeqDiff [rule_format] :
"ALL x. ALL y. x <_3 y = (x <=_3 y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL x. ALL y. compare x y ==' LT = x <_3 y"

CmpEQDef [rule_format] :
"ALL x. ALL y. compare x y ==' EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL x. ALL y. compare x y ==' GT = x >_3 y"

MaxYDef [rule_format] :
"ALL x. ALL y. X_maxX3 x y ==' y = x <=_3 y"

MaxXDef [rule_format] :
"ALL x. ALL y. X_maxX3 x y ==' x = y <=_3 x"

MinXDef [rule_format] :
"ALL x. ALL y. X_minX3 x y ==' x = x <=_3 y"

MinYDef [rule_format] :
"ALL x. ALL y. X_minX3 x y ==' y = y <=_3 x"

MaxSym [rule_format] :
"ALL x. ALL y. X_maxX3 x y ==' y = X_maxX3 y x ==' y"

MinSym [rule_format] :
"ALL x. ALL y. X_minX3 x y ==' y = X_minX3 y x ==' y"

TO1 [rule_format] :
"ALL x.
 ALL y. (x ==' y = True' | x <_3 y = True') = (x <=_3 y = True')"

TO2 [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x <_3 y = False'"

TO3 [rule_format] :
"ALL x.
 ALL y. Not' Not' (x <_3 y) = True' | Not' (x <_3 y) = True'"

TO4 [rule_format] :
"ALL x. ALL y. x <_3 y = True' --> Not' (x ==' y) = True'"

TO5 [rule_format] :
"ALL w.
 ALL x.
 ALL y.
 ALL z.
 (x <_3 y = True' & y <_3 z = True') & z <_3 w = True' -->
 x <_3 w = True'"

TO6 [rule_format] :
"ALL x. ALL z. z <_3 x = True' --> Not' (x <_3 z) = True'"

TO7 [rule_format] :
"ALL x. ALL y. x <_3 y = True' = (y >_3 x = True')"

IOO13 [rule_format] : "LT <_3 EQ = True'"

IOO14 [rule_format] : "EQ <_3 GT = True'"

IOO15 [rule_format] : "LT <_3 GT = True'"

IOO16 [rule_format] : "LT <=_3 EQ = True'"

IOO17 [rule_format] : "EQ <=_3 GT = True'"

IOO18 [rule_format] : "LT <=_3 GT = True'"

IOO19 [rule_format] : "EQ >=_3 LT = True'"

IOO20 [rule_format] : "GT >=_3 EQ = True'"

IOO21 [rule_format] : "GT >=_3 LT = True'"

IOO22 [rule_format] : "EQ >_3 LT = True'"

IOO23 [rule_format] : "GT >_3 EQ = True'"

IOO24 [rule_format] : "GT >_3 LT = True'"

IOO25 [rule_format] : "X_maxX3 LT EQ ==' EQ = True'"

IOO26 [rule_format] : "X_maxX3 EQ GT ==' GT = True'"

IOO27 [rule_format] : "X_maxX3 LT GT ==' GT = True'"

IOO28 [rule_format] : "X_minX3 LT EQ ==' LT = True'"

IOO29 [rule_format] : "X_minX3 EQ GT ==' EQ = True'"

IOO30 [rule_format] : "X_minX3 LT GT ==' LT = True'"

IOO31 [rule_format] : "compare LT LT ==' EQ = True'"

IOO32 [rule_format] : "compare EQ EQ ==' EQ = True'"

IOO33 [rule_format] : "compare GT GT ==' EQ = True'"

IBO5 [rule_format] : "False' <_3 True' = True'"

IBO6 [rule_format] : "False' >=_3 True' = False'"

IBO7 [rule_format] : "True' >=_3 False' = True'"

IBO8 [rule_format] : "True' <_3 False' = False'"

IBO9 [rule_format] : "X_maxX3 False' True' ==' True' = True'"

IBO10 [rule_format] : "X_minX3 False' True' ==' False' = True'"

IBO11 [rule_format] : "compare True' True' ==' EQ = True'"

IBO12 [rule_format] : "compare False' False' ==' EQ = True'"

IUO01 [rule_format] : "() <=_3 () = True'"

IUO02 [rule_format] : "() <_3 () = False'"

IUO03 [rule_format] : "() >=_3 () = True'"

IUO04 [rule_format] : "() >_3 () = False'"

IUO05 [rule_format] : "X_maxX3 () () ==' () = True'"

IUO06 [rule_format] : "X_minX3 () () ==' () = True'"

IUO07 [rule_format] : "compare () () ==' EQ = True'"

LengthNil [rule_format] : "length'(Nil') = 0'"

LengthCons [rule_format] :
"ALL x. ALL xs. length'(X_Cons x xs) = length'(xs) +' 1'"

NotDefHead [rule_format] : "~ defOp (head(Nil'))"

HeadDef [rule_format] :
"ALL x. ALL xs. head(X_Cons x xs) = makePartial x"

NotDefTail [rule_format] : "~ defOp (tail(Nil'))"

TailDef [rule_format] :
"ALL x. ALL xs. tail(X_Cons x xs) = makePartial xs"

FoldrNil [rule_format] : "ALL f. ALL s. foldr'(f, s, Nil') = s"

FoldrCons [rule_format] :
"ALL f.
 ALL s.
 ALL x. ALL xs. foldr'(f, s, X_Cons x xs) = f (x, foldr'(f, s, xs))"

FoldlNil [rule_format] : "ALL g. ALL t. foldl'(g, t, Nil') = t"

FoldlCons [rule_format] :
"ALL g.
 ALL t.
 ALL z. ALL zs. foldl'(g, t, X_Cons z zs) = foldl'(g, g (t, z), zs)"

MapNil [rule_format] : "ALL h. map'(h, Nil') = Nil'"

MapCons [rule_format] :
"ALL h.
 ALL x. ALL xs. map'(h, X_Cons x xs) = X_Cons (h x) (map'(h, xs))"

XPlusXPlusNil [rule_format] : "ALL l. Nil' ++' l = l"

XPlusXPlusCons [rule_format] :
"ALL l. ALL x. ALL xs. X_Cons x xs ++' l = X_Cons x (xs ++' l)"

FilterNil [rule_format] : "ALL p. filter'(p, Nil') = Nil'"

FilterConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' -->
 filter'(p, X_Cons x xs) = X_Cons x (filter'(p, xs))"

FilterConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs. p x = False' --> filter'(p, X_Cons x xs) = filter'(p, xs)"

ZipNil [rule_format] : "ALL l. zip'(Nil', l) = Nil'"

ZipConsNil [rule_format] :
"ALL l. ALL x. ALL xs. l = Nil' --> zip'(X_Cons x xs, l) = Nil'"

ZipConsCons [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 l = X_Cons y ys -->
 zip'(X_Cons x xs, l) = X_Cons (x, y) (zip'(xs, ys))"

UnzipNil [rule_format] : "unzip(Nil') = (Nil', Nil')"

UnzipCons [rule_format] :
"ALL ps.
 ALL x.
 ALL z.
 unzip(X_Cons (x, z) ps) =
 (let (ys, zs) = unzip(ps) in (X_Cons x ys, X_Cons z zs))"

declare ga_selector_pre [simp]
declare ga_selector_undef_pre_0 [simp]
declare ga_comm___XPlus__ [simp]
declare ga_assoc___XPlus__ [simp]
declare ga_right_unit___XPlus__ [simp]
declare ga_left_unit___XPlus__ [simp]
declare ga_left_comm___XPlus__ [simp]
declare ga_comm___Xx__ [simp]
declare ga_assoc___Xx__ [simp]
declare ga_right_unit___Xx__ [simp]
declare ga_left_unit___Xx__ [simp]
declare ga_left_comm___Xx__ [simp]
declare ga_comm_min [simp]
declare ga_assoc_min [simp]
declare ga_left_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_max [simp]
declare ga_right_unit_max [simp]
declare ga_left_unit_max [simp]
declare ga_left_comm_max [simp]
declare leq_def1_Nat [simp]
declare leq_def2_Nat [simp]
declare leq_def3_Nat [simp]
declare even_0_Nat [simp]
declare even_suc_Nat [simp]
declare factorial_0 [simp]
declare add_0_Nat [simp]
declare mult_0_Nat [simp]
declare power_0_Nat [simp]
declare subTotal_def1_Nat [simp]
declare subTotal_def2_Nat [simp]
declare sub_dom_Nat [simp]
declare divide_0_Nat [simp]
declare min_0 [simp]
declare ga_comm___XPlus___1 [simp]
declare ga_assoc___XPlus___1 [simp]
declare ga_right_unit___XPlus___1 [simp]
declare ga_left_unit___XPlus___1 [simp]
declare ga_left_comm___XPlus___1 [simp]
declare ga_comm___Xx___1 [simp]
declare ga_assoc___Xx___1 [simp]
declare ga_right_unit___Xx___1 [simp]
declare ga_left_unit___Xx___1 [simp]
declare ga_left_comm___Xx___1 [simp]
declare ga_comm_min_1 [simp]
declare ga_comm_max_1 [simp]
declare ga_assoc_min_1 [simp]
declare ga_assoc_max_1 [simp]
declare ga_left_comm_min_1 [simp]
declare ga_left_comm_max_1 [simp]
declare neg_def_Int [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare EqualReflex [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare LengthNil [simp]
declare NotDefHead [simp]
declare HeadDef [simp]
declare NotDefTail [simp]
declare TailDef [simp]
declare FoldrNil [simp]
declare FoldlNil [simp]
declare MapNil [simp]
declare XPlusXPlusNil [simp]
declare FilterNil [simp]
declare FilterConsF [simp]
declare ZipNil [simp]

theorem FoldlDecomp :
"ALL e.
 ALL i.
 ALL xs.
 ALL zs. foldl'(i, e, xs ++' zs) = foldl'(i, foldl'(i, e, xs), zs)"
oops

ML "Header.record \"FoldlDecomp\""

theorem MapDecomp :
"ALL f.
 ALL xs. ALL zs. map'(f, xs ++' zs) = map'(f, xs) ++' map'(f, zs)"
apply(auto)
apply(induct_tac xs)
apply(auto)
oops

ML "Header.record \"MapDecomp\""

theorem MapFunctor :
"ALL f.
 ALL g. ALL xs. map'(X__o__X (g, f), xs) = map'(g, map'(f, xs))"
apply(auto)
apply(induct_tac xs)
apply(auto)
apply(simp add:  MapNil MapCons Comp)
apply(simp only: Comp)

using X1_def_Nat X2_def_Nat X3_def_Nat X4_def_Nat X5_def_Nat
      X6_def_Nat X7_def_Nat X8_def_Nat X9_def_Nat decimal_def
by auto

ML "Header.record \"MapFunctor\""

theorem FilterProm :
"ALL f.
 ALL p.
 ALL xs.
 filter'(p, map'(f, xs)) = map'(f, filter'(X__o__X (p, f), xs))"
using X1_def_Nat X2_def_Nat X3_def_Nat X4_def_Nat X5_def_Nat
      X6_def_Nat X7_def_Nat X8_def_Nat X9_def_Nat decimal_def
by auto

ML "Header.record \"FilterProm\""

theorem ZipSpec :
"ALL xs.
 ALL ys.
 length'(xs) = length'(ys) --> unzip(zip'(xs, ys)) = (xs, ys)"
using X1_def_Nat X2_def_Nat X3_def_Nat X4_def_Nat X5_def_Nat
      X6_def_Nat X7_def_Nat X8_def_Nat X9_def_Nat decimal_def
by auto

ML "Header.record \"ZipSpec\""

end


(*
This file is a part of IsarMathLib -
a library of formalized mathematics for Isabelle/Isar.

Copyright (C) 2008  Slawomir Kolodynski

This program is free software; Redistribution and use in source and binary forms,
with or without modification, are permitted provided that the
following conditions are met:

1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

section \<open>Functions with finite support\<close>

theory FinSupp_ZF imports Finite_ZF Group_ZF_2

begin

text\<open>Functions with finite support are those functions
  valued in a monoid that are equal to the neutral element everywhere except
  a finite number of points. They form a submonoid of the space of all
  functions valued in the monoid with the natural pointwise operation
  (or a subgroup if functions are valued in a group).
  Polynomials can be viewed as ring valued sequences that have
  finite support.\<close>

subsection\<open>Functions with finite support\<close>

text\<open>In this section we provide the definition and set up notation for
  formalizing the notion of finitely supported functions.\<close>

text\<open>Support of a function is the subset of its domain where the values
  are not zero.\<close>

definition
  "Supp(f,G,A) \<equiv> {x \<in> domain(f). f`(x) \<noteq> TheNeutralElement(G,A)}"

text\<open>A finitely supported function is such that its support
  is in the finite powerset of its domain.\<close>

definition
  "FinSupp(X,G,A) \<equiv> {f \<in> X\<rightarrow>G. Supp(f,G,A) \<in> FinPow(X)}"

text\<open>We will use the additive notation writing about finitely
  supported functions. In the \<open>finsupp\<close> context defined below
  we assume that $(M,A)$ is a monoid and $X$ is some arbitrary
  set. We denote \<open>\<A>\<close> to be the pointwise operation
  on $M$-valued functions on $X$ corresponding to the monoid
  operation $A$, (denoted as \<open>\<ra>\<close>). \<open>\<zero>\<close>
  is the neutral element of the monoid.\<close>

locale finsupp =
  fixes M A
  assumes monoidAsssum: "IsAmonoid(M,A)"

  fixes monoper (infixl "\<ra>" 70)
  defines monoper_def[simp]: "a \<ra> b \<equiv> A`\<langle>a,b\<rangle>"

  fixes X

  fixes finsupp ("\<M>")
  defines finsupp_def[simp]: "\<M> \<equiv> FinSupp(X,M,A)"

  fixes pointewiseoper ("\<A>")
  defines pointewiseoper_def[simp]:
  "\<A> \<equiv> A {lifted to function space over} X"

  fixes funoper (infixl "\<oplus>" 70)
  defines funoper_def[simp]: "a \<oplus> b \<equiv> \<A>`\<langle>a,b\<rangle>"

  fixes neut ("\<zero>")
  defines neut_def[simp]: "\<zero> \<equiv> TheNeutralElement(M,A)"

  fixes supp
  defines supp_def[simp]: "supp(f) \<equiv> Supp(f,M,A)"

text\<open>We can use theorems proven in the \<open>monoid0\<close> context.\<close>

lemma (in finsupp) monoid0_valid: shows "monoid0(M,A)"
  using monoidAsssum monoid0_def by simp

subsection\<open>Finitely supported functions valued in a monoid\<close>

text\<open>We show in \<open>Group_ZF_2\<close> that if
  $(M,A)$ is a monoid, and $X$ is
  an arbitrary set, then the space of functions
  $X\rightarrow M$ with the natural pointwise
  operation is also a monoid.
  In this section we show that the set of
  finitely supported funtions is a a sub-monoid of that monoid.
\<close>

text\<open>The sum of monoid valued functions is a monoid valued function.\<close>

lemma (in finsupp) lifted_op_closed:
  assumes "f:X \<rightarrow>M"  "g:X \<rightarrow>M"
  shows "f\<oplus>g : X\<rightarrow>M"
proof -
  have "\<A> : (X\<rightarrow>M)\<times>(X\<rightarrow>M)\<rightarrow>(X\<rightarrow>M)"
    using monoid0_valid monoid0.Group_ZF_2_1_L0A
    by simp
  with assms show "f\<oplus>g : X\<rightarrow>M" by simp
qed

text\<open>What is the value of a sum of monoid-valued functions?\<close>

lemma (in finsupp) finsupp_sum_val:
  assumes "f:X \<rightarrow>M"  "g:X \<rightarrow>M" and "x \<in> X"
  shows "(f\<oplus>g)`(x) = f`(x) \<ra> g`(x)"
  using assms monoid0_valid monoid0.lifted_val
  by simp

text\<open>The support of the sum of functions is contained in the union of
  supports.\<close>

lemma (in finsupp) supp_sum_union: assumes "f:X \<rightarrow>M"  "g:X \<rightarrow>M"
  shows "supp(f\<oplus>g) \<subseteq> supp(f) \<union> supp(g)"
proof -
  { fix x assume "x \<in> supp(f\<oplus>g)"
    from assms have  "f\<oplus>g : X\<rightarrow>M" using lifted_op_closed
      by simp
    with assms \<open>x \<in> supp(f\<oplus>g)\<close> have
      "x\<in>X" and "f`(x) \<ra> g`(x) \<noteq> \<zero>"
      using func1_1_L1 Supp_def finsupp_sum_val by auto
    with assms have "x \<in> (supp(f) \<union> supp(g))"
      using monoid0_valid monoid0.sum_nonzero_elmnt_nonzero
	func1_1_L1 Supp_def by simp
  } thus ?thesis by auto
qed

text\<open>The sum of finitely supported functions is
  finitely supported.\<close>

lemma (in finsupp) sum_finsupp:
  assumes "f \<in> \<M>"  "g \<in> \<M>"
  shows "f\<oplus>g \<in>\<M> "
proof -
  from assms have
    I: "f: X\<rightarrow>M"  "g: X\<rightarrow>M" and
    "supp(f) \<in> FinPow(X)" "supp(g) \<in> FinPow(X)"
    using FinSupp_def by auto
  then have
    "supp(f) \<union> supp(g) \<in>  FinPow(X)" and
    "supp(f\<oplus>g) \<subseteq> supp(f) \<union> supp(g)"
    using union_finpow supp_sum_union by auto
  then have "supp(f\<oplus>g) \<in>  FinPow(X)"
    by (rule subset_finpow)
  with I show "f\<oplus>g \<in> \<M>"
    using lifted_op_closed FinSupp_def by simp
qed

text\<open>The neutral element of the lifted (pointwise)
  operation is the function equal zero everywhere.
  In the next lemma we show that this is a finitely
  supported function.\<close>

lemma (in finsupp) const_zero_fin_supp:
  shows "TheNeutralElement(X\<rightarrow>M, \<A>) \<in> \<M>"
  using  monoidAsssum Group_ZF_2_1_L2
    monoid0_valid monoid0.unit_is_neutral
    func1_3_L1 func1_3_L2 func1_1_L1
    Supp_def empty_in_finpow FinSupp_def
  by simp

text\<open>Finitely supported functions form a submonoid
  of all functions with pointwise operation.\<close>

theorem (in finsupp) fin_supp_monoid:
  shows "IsAmonoid(\<M>,restrict(\<A>,\<M>\<times>\<M>))"
proof -
  have "monoid0(X\<rightarrow>M,\<A>)"
    using monoid0_valid monoid0.Group_ZF_2_1_T1
      monoid0_def by simp
  moreover have
    "\<M> {is closed under} \<A>"
    "\<M> \<subseteq> (X\<rightarrow>M)"
    "TheNeutralElement(X\<rightarrow>M, \<A>) \<in> \<M>"
    using sum_finsupp IsOpClosed_def FinSupp_def
      const_zero_fin_supp by auto
  ultimately show ?thesis
    using monoid0.group0_1_T1 by simp
qed

subsection\<open>Group valued finitely supported functions\<close>

text\<open>Similarly as in the monoid case the group valued
  finitely supported functions form a subgroup
  of all functions valued in that group.\<close>

text\<open>We will reuse the notation defined in the
  \<open>finsupp\<close> context, just adding an assumption
  about that the existence of the right inverse with
  a notation for it.\<close>

locale finsupp1 = finsupp +
  assumes rinverse: "\<forall>x\<in>M. \<exists>y\<in>M. x \<ra> y = \<zero>"

  fixes inv ("\<rm> _" 89)
  defines inv_def[simp]: "(\<rm>a) \<equiv> GroupInv(M,A)`(a)"

text\<open>With this additional assumption $(M,A)$ becomes a group
  and we can use theorems proven in ine \<open>group0\<close> context.\<close>

lemma (in finsupp1) group0_valid: shows
  "IsAgroup(M,A)" and "group0(M,A)"
  using monoidAsssum rinverse
    IsAgroup_def group0_def by auto

text\<open>Recall from \<open>Group_ZF_2\<close> that the function space
  of $G$ valued functions is also a group.\<close>

lemma (in finsupp1) fungroup0_valid: shows
  "IsAgroup(X\<rightarrow>M,\<A>)" and "group0(X\<rightarrow>M,\<A>)"
  using group0_valid group0.Group_ZF_2_1_T2
    group0_def by auto

text\<open>A function has the same support as its negative.\<close>

lemma (in finsupp1) finsupp_neg: assumes A1: "f: X\<rightarrow>M"
  shows "supp(f) = supp(GroupInv(X\<rightarrow>M,\<A>)`(f))"
proof -
  let ?g = "GroupInv(X\<rightarrow>M,\<A>)`(f)"
  from A1 have I: "?g : X\<rightarrow>M"
    using fungroup0_valid group0.inverse_in_group
    by simp
  have "supp(?g) \<subseteq> supp(f)"
  proof -
    { fix x assume "x \<in> supp(?g)"
      with I have "x\<in>X" and "?g`(x) \<noteq> \<zero>"
	using func1_1_L1 Supp_def by auto
      with A1 have "x \<in> supp(f)"
	using group0_valid group0.lift_gr_inv_val
	  group0.group0_2_L8C func1_1_L1 Supp_def
	by simp
    } thus "supp(?g) \<subseteq> supp(f)" by auto
  qed
  moreover from A1 I have "supp(f) \<subseteq> supp(?g)"
    using func1_1_L1 Supp_def group0_valid
      group0.group0_2_L8B group0.lift_gr_inv_val
    by auto
  ultimately show ?thesis by auto
qed

text\<open>The negative of a function with a finite support
  is a function with a finite support.\<close>

lemma (in finsupp1) finsupp_neg_finsupp: assumes A1: "f \<in> \<M>"
  shows "GroupInv(X\<rightarrow>M,\<A>)`(f) \<in> \<M>"
proof -
  let ?g = "GroupInv(X\<rightarrow>M,\<A>)`(f)"
  from A1 have I: "f: X\<rightarrow>M"  "supp(f) \<in> FinPow(X)"
    using FinSupp_def func1_1_L1 by auto
  then have "?g \<in> X\<rightarrow>M" using
    fungroup0_valid group0.inverse_in_group by simp
  moreover from I have "supp(?g) \<in> FinPow(X)"
    using finsupp_neg by simp
  ultimately show ?thesis using FinSupp_def
    by simp
qed

text\<open>Finitely supported functions form a subgroup
  with pointwise addition of group-valued functions.
\<close>

theorem (in finsupp1) fin_sup_group:
  shows "IsAsubgroup(\<M>,\<A>)"
proof -
  have
    "\<M> \<noteq> 0" and
    "\<M> \<subseteq> X\<rightarrow>M" and
    "\<M> {is closed under} \<A>" and
    "\<forall>f\<in>\<M>. GroupInv(X\<rightarrow>M,\<A>)`(f) \<in> \<M>"
    using const_zero_fin_supp FinSupp_def
      sum_finsupp IsOpClosed_def finsupp_neg_finsupp
    by auto
  then show "IsAsubgroup(\<M>,\<A>)"
    using fungroup0_valid group0.group0_3_T3
    by simp
qed

end


theory Cluster
  imports "Containers.Mapping_Impl"
begin

lemma these_Un[simp]: "Option.these (A \<union> B) = Option.these A \<union> Option.these B"
  by (auto simp: Option.these_def)

lemma these_insert[simp]: "Option.these (insert x A) = (case x of Some a \<Rightarrow> insert a | None \<Rightarrow> id) (Option.these A)"
  by (auto simp: Option.these_def split: option.splits) force

lemma these_image_Un[simp]: "Option.these (f ` (A \<union> B)) = Option.these (f ` A) \<union> Option.these (f ` B)"
  by (auto simp: Option.these_def)

lemma these_imageI: "f x = Some y \<Longrightarrow> x \<in> X \<Longrightarrow> y \<in> Option.these (f ` X)"
  by (force simp: Option.these_def)

lift_definition cluster :: "('b \<Rightarrow> 'a option) \<Rightarrow> 'b set \<Rightarrow> ('a, 'b set) mapping" is
  "\<lambda>f Y x. if Some x \<in> f ` Y then Some {y \<in> Y. f y = Some x} else None" .

context ord
begin

definition add_to_rbt :: "'a \<times> 'b \<Rightarrow> ('a, 'b set) rbt \<Rightarrow> ('a, 'b set) rbt" where
  "add_to_rbt = (\<lambda>(a, b) t. case rbt_lookup t a of Some X \<Rightarrow> rbt_insert a (insert b X) t | None \<Rightarrow> rbt_insert a {b} t)"

abbreviation "add_option_to_rbt f \<equiv> (\<lambda>b _ t. case f b of Some a \<Rightarrow> add_to_rbt (a, b) t | None \<Rightarrow> t)"

definition cluster_rbt :: "('b \<Rightarrow> 'a option) \<Rightarrow> ('b, unit) rbt \<Rightarrow> ('a, 'b set) rbt" where
  "cluster_rbt f t = RBT_Impl.fold (add_option_to_rbt f) t RBT_Impl.Empty"

end

context linorder
begin

lemma is_rbt_add_to_rbt: "is_rbt t \<Longrightarrow> is_rbt (add_to_rbt ab t)"
  by (auto simp: add_to_rbt_def split: prod.splits option.splits)

lemma is_rbt_fold_add_to_rbt: "is_rbt t' \<Longrightarrow>
  is_rbt (RBT_Impl.fold (add_option_to_rbt f) t t')"
  by (induction t arbitrary: t') (auto 0 0 simp: is_rbt_add_to_rbt split: option.splits)

lemma is_rbt_cluster_rbt: "is_rbt (cluster_rbt f t)"
  using is_rbt_fold_add_to_rbt Empty_is_rbt
  by (fastforce simp: cluster_rbt_def)

lemma rbt_insert_entries_None: "is_rbt t \<Longrightarrow> rbt_lookup t k = None \<Longrightarrow>
  set (RBT_Impl.entries (rbt_insert k v t)) = insert (k, v) (set (RBT_Impl.entries t))"
  by (auto simp: rbt_lookup_in_tree[symmetric] rbt_lookup_rbt_insert split: if_splits)

lemma rbt_insert_entries_Some: "is_rbt t \<Longrightarrow> rbt_lookup t k = Some v' \<Longrightarrow>
  set (RBT_Impl.entries (rbt_insert k v t)) = insert (k, v) (set (RBT_Impl.entries t) - {(k, v')})"
  by (auto simp: rbt_lookup_in_tree[symmetric] rbt_lookup_rbt_insert split: if_splits)

lemma keys_add_to_rbt: "is_rbt t \<Longrightarrow> set (RBT_Impl.keys (add_to_rbt (a, b) t)) = insert a (set (RBT_Impl.keys t))"
  by (auto simp: add_to_rbt_def RBT_Impl.keys_def rbt_insert_entries_None rbt_insert_entries_Some split: option.splits)

lemma keys_fold_add_to_rbt: "is_rbt t' \<Longrightarrow> set (RBT_Impl.keys (RBT_Impl.fold (add_option_to_rbt f) t t')) =
  Option.these (f ` set (RBT_Impl.keys t)) \<union> set (RBT_Impl.keys t')"
proof (induction t arbitrary: t')
  case (Branch col t1 k v t2)
  have valid: "is_rbt (RBT_Impl.fold (add_option_to_rbt f) t1 t')"
    using Branch(3)
    by (auto intro: is_rbt_fold_add_to_rbt)
  show ?case
  proof (cases "f k")
    case None
    show ?thesis
      by (auto simp: None Branch(2)[OF valid] Branch(1)[OF Branch(3)])
  next
    case (Some a)
    have valid': "is_rbt (add_to_rbt (a, k) (RBT_Impl.fold (add_option_to_rbt f) t1 t'))"
      by (auto intro: is_rbt_add_to_rbt[OF valid])
    show ?thesis
      by (auto simp: Some Branch(2)[OF valid'] keys_add_to_rbt[OF valid] Branch(1)[OF Branch(3)])
  qed
qed auto

lemma rbt_lookup_add_to_rbt: "is_rbt t \<Longrightarrow> rbt_lookup (add_to_rbt (a, b) t) x = (if a = x then Some (case rbt_lookup t x of None \<Rightarrow> {b} | Some Y \<Rightarrow> insert b Y) else rbt_lookup t x)"
  by (auto simp: add_to_rbt_def rbt_lookup_rbt_insert split: option.splits)

lemma rbt_lookup_fold_add_to_rbt: "is_rbt t' \<Longrightarrow> rbt_lookup (RBT_Impl.fold (add_option_to_rbt f) t t') x =
    (if x \<in> Option.these (f ` set (RBT_Impl.keys t)) \<union> set (RBT_Impl.keys t') then Some ({y \<in> set (RBT_Impl.keys t). f y = Some x}
    \<union> (case rbt_lookup t' x of None \<Rightarrow> {} | Some Y \<Rightarrow> Y)) else None)"
proof (induction t arbitrary: t')
  case Empty
  then show ?case
    using rbt_lookup_iff_keys(2,3)[OF is_rbt_rbt_sorted]
    by (fastforce split: option.splits)
next
  case (Branch col t1 k v t2)
  have valid: "is_rbt (RBT_Impl.fold (add_option_to_rbt f) t1 t')"
    using Branch(3)
    by (auto intro: is_rbt_fold_add_to_rbt)
  show ?case
  proof (cases "f k")
    case None
    have fold_set: "x \<in> Option.these (f ` set (RBT_Impl.keys t2)) \<union> ((Option.these (f ` set (RBT_Impl.keys t1)) \<union> set (RBT_Impl.keys t'))) \<longleftrightarrow>
      x \<in> Option.these (f ` set (RBT_Impl.keys (Branch col t1 k v t2))) \<union> set (RBT_Impl.keys t')"
      by (auto simp: None)
    show ?thesis
      unfolding fold_simps comp_def None option.case(1) Branch(2)[OF valid] keys_add_to_rbt[OF valid] keys_fold_add_to_rbt[OF Branch(3)]
        rbt_lookup_add_to_rbt[OF valid] Branch(1)[OF Branch(3)] fold_set
      using rbt_lookup_iff_keys(2,3)[OF is_rbt_rbt_sorted[OF Branch(3)]]
      by (auto simp: None split: option.splits) (auto dest: these_imageI)
  next
    case (Some a)
    have valid': "is_rbt (add_to_rbt (a, k) (RBT_Impl.fold (add_option_to_rbt f) t1 t'))"
      by (auto intro: is_rbt_add_to_rbt[OF valid])
    have fold_set: "x \<in> Option.these (f ` set (RBT_Impl.keys t2)) \<union> (insert a (Option.these (f ` set (RBT_Impl.keys t1)) \<union> set (RBT_Impl.keys t'))) \<longleftrightarrow>
    x \<in> Option.these (f ` set (RBT_Impl.keys (Branch col t1 k v t2))) \<union> set (RBT_Impl.keys t')"
      by (auto simp: Some)
    have F1: "(case if P then Some X else None of None \<Rightarrow> {k} | Some Y \<Rightarrow> insert k Y) =
    (if P then (insert k X) else {k})" for P X
      by auto
    have F2: "(case if a = x then Some X else if P then Some Y else None of None \<Rightarrow> {} | Some Y \<Rightarrow> Y) =
    (if a = x then X else if P then Y else {})"
      for P X and Y :: "'b set"
      by auto
    show ?thesis
      unfolding fold_simps comp_def Some option.case(2) Branch(2)[OF valid'] keys_add_to_rbt[OF valid] keys_fold_add_to_rbt[OF Branch(3)]
        rbt_lookup_add_to_rbt[OF valid] Branch(1)[OF Branch(3)] fold_set F1 F2
      using rbt_lookup_iff_keys(2,3)[OF is_rbt_rbt_sorted[OF Branch(3)]]
      by (auto simp: Some split: option.splits) (auto dest: these_imageI) (* slow *)
  qed
qed

end

context
  fixes c :: "'a comparator"
begin

definition add_to_rbt_comp :: "'a \<times> 'b \<Rightarrow> ('a, 'b set) rbt \<Rightarrow> ('a, 'b set) rbt" where
  "add_to_rbt_comp = (\<lambda>(a, b) t. case rbt_comp_lookup c t a of None \<Rightarrow> rbt_comp_insert c a {b} t
  | Some X \<Rightarrow> rbt_comp_insert c a (insert b X) t)"

abbreviation "add_option_to_rbt_comp f \<equiv> (\<lambda>b _ t. case f b of Some a \<Rightarrow> add_to_rbt_comp (a, b) t | None \<Rightarrow> t)"

definition cluster_rbt_comp :: "('b \<Rightarrow> 'a option) \<Rightarrow> ('b, unit) rbt \<Rightarrow> ('a, 'b set) rbt" where
  "cluster_rbt_comp f t = RBT_Impl.fold (add_option_to_rbt_comp f) t RBT_Impl.Empty"

context
  assumes c: "comparator c"
begin

lemma add_to_rbt_comp: "add_to_rbt_comp = ord.add_to_rbt (lt_of_comp c)"
  unfolding add_to_rbt_comp_def ord.add_to_rbt_def rbt_comp_lookup[OF c] rbt_comp_insert[OF c]
  by simp

lemma cluster_rbt_comp: "cluster_rbt_comp = ord.cluster_rbt (lt_of_comp c)"
  unfolding cluster_rbt_comp_def ord.cluster_rbt_def add_to_rbt_comp
  by simp

end

end

lift_definition mapping_of_cluster :: "('b \<Rightarrow> 'a :: ccompare option) \<Rightarrow> ('b, unit) rbt \<Rightarrow> ('a, 'b set) mapping_rbt" is
  "cluster_rbt_comp ccomp"
  using linorder.is_rbt_fold_add_to_rbt[OF comparator.linorder[OF ID_ccompare'] ord.Empty_is_rbt]
  by (fastforce simp: cluster_rbt_comp[OF ID_ccompare'] ord.cluster_rbt_def)

lemma cluster_code[code]:
  fixes f :: "'b :: ccompare \<Rightarrow> 'a :: ccompare option" and t :: "('b, unit) mapping_rbt"
  shows "cluster f (RBT_set t) = (case ID CCOMPARE('a) of None \<Rightarrow>
    Code.abort (STR ''cluster: ccompare = None'') (\<lambda>_. cluster f (RBT_set t))
    | Some c \<Rightarrow> (case ID CCOMPARE('b) of None \<Rightarrow>
    Code.abort (STR ''cluster: ccompare = None'') (\<lambda>_. cluster f (RBT_set t))
    | Some c' \<Rightarrow> (RBT_Mapping (mapping_of_cluster f (RBT_Mapping2.impl_of t)))))"
proof -
  {
    fix c c'
    assume assms: "ID ccompare = (Some c :: 'a comparator option)" "ID ccompare = (Some c' :: 'b comparator option)"
    have c_def: "c = ccomp"
      using assms(1)
      by auto
    have c'_def: "c' = ccomp"
      using assms(2)
      by auto
    have c: "comparator (ccomp :: 'a comparator)"
      using ID_ccompare'[OF assms(1)]
      by (auto simp: c_def)
    have c': "comparator (ccomp :: 'b comparator)"
      using ID_ccompare'[OF assms(2)]
      by (auto simp: c'_def)
    note c_class = comparator.linorder[OF c]
    note c'_class = comparator.linorder[OF c']
    have rbt_lookup_cluster: "ord.rbt_lookup cless (cluster_rbt_comp ccomp f t) =
      (\<lambda>x. if x \<in> Option.these (f ` (set (RBT_Impl.keys t))) then Some {y \<in> (set (RBT_Impl.keys t)). f y = Some x} else None)"
      if "ord.is_rbt cless (t :: ('b, unit) rbt) \<or> ID ccompare = (None :: 'b comparator option)" for t
    proof -
      have is_rbt_t: "ord.is_rbt cless t"
        using assms that
        by auto
      show ?thesis
        unfolding cluster_rbt_comp[OF c] ord.cluster_rbt_def linorder.rbt_lookup_fold_add_to_rbt[OF c_class ord.Empty_is_rbt]
        by (auto simp: ord.rbt_lookup.simps split: option.splits)
    qed
    have dom_ord_rbt_lookup: "ord.is_rbt cless t \<Longrightarrow> dom (ord.rbt_lookup cless t) = set (RBT_Impl.keys t)" for t :: "('b, unit) rbt"
      using linorder.rbt_lookup_keys[OF c'_class] ord.is_rbt_def
      by auto
    have "cluster f (Collect (RBT_Set2.member t)) = Mapping (RBT_Mapping2.lookup (mapping_of_cluster f (mapping_rbt.impl_of t)))"
      using assms(2)[unfolded c'_def]
      by (transfer fixing: f) (auto simp: in_these_eq rbt_comp_lookup[OF c] rbt_comp_lookup[OF c'] rbt_lookup_cluster dom_ord_rbt_lookup)
  }
  then show ?thesis
    unfolding RBT_set_def
    by (auto split: option.splits)
qed

end