theory Reverse
imports "~/verification/mainline/l4v/tools/autocorres/AutoCorres"
begin

install_C_file "reverse.c"
autocorres "reverse.c"

locale ref =
  fixes
    get :: "'ref \<Rightarrow> 'state \<Rightarrow> 'val" and
    set :: "'ref \<Rightarrow> 'val \<Rightarrow> 'state \<Rightarrow> 'state" and
    ok  :: "'ref \<Rightarrow> 'state \<Rightarrow> bool"
  assumes
    ok_pres [simp]: "\<And> p q r s. ok p s \<Longrightarrow> ok p (set q r s)" and
    set_dup [simp]: "\<And> p v w s. ok p s \<Longrightarrow> set p v (set p w s) = set p v s" and
    get_set [simp]: "\<And> p v s. ok p s \<Longrightarrow> get p (set p v s) = v" and
    set_get [simp]: "\<And> p s. ok p s \<Longrightarrow> set p (get p s) s = s" and
    get_com: "\<And> p q v s. ok p s \<Longrightarrow> ok p s \<Longrightarrow> p \<noteq> q \<Longrightarrow> get p (set q v s) = get p s" and
    set_com: "\<And> p q v w s. ok p s \<Longrightarrow> ok q s \<Longrightarrow> p \<noteq> q \<Longrightarrow> set p v (set q w s) = set q w (set p v s)"

locale ptr_chain = ref get_next set_next ok
  for
    get_next :: "'ptr \<Rightarrow> 'state \<Rightarrow> 'ptr" and
    set_next :: "'ptr \<Rightarrow> 'ptr \<Rightarrow> 'state \<Rightarrow> 'state" and
    ok :: "'ptr \<Rightarrow> 'state \<Rightarrow> bool" +
  fixes
    null :: "'ptr"
  assumes
    ok_not_null [simp]: "\<not> ok null s"

context ptr_chain begin

primrec list_eq :: "'state \<Rightarrow> 'ptr \<Rightarrow> 'ptr list \<Rightarrow> bool" where
  "list_eq s p [] = (p = null)" |
  "list_eq s p (q # r) = (ok p s \<and> p = q \<and> list_eq s (get_next p s) r)"

primrec list_rev :: "'ptr \<Rightarrow> 'ptr list \<Rightarrow> 'state \<Rightarrow> 'state" where
  "list_rev e (p # ps) = list_rev p ps \<circ> set_next p e" |
  "list_rev e [] = id"

primrec rev_invariant :: "'state \<Rightarrow> 'ptr list \<Rightarrow> 'ptr \<times> 'ptr \<Rightarrow> 'state \<Rightarrow> bool" where
  "rev_invariant i ps (p,r) s =
    (\<exists> ps' rs.
      distinct ps \<and>
      ps = rev rs @ ps' \<and>
      s = list_rev null (rev rs) i \<and>
      list_eq s p ps' \<and>
      list_eq s r rs)"

fun rev_measure :: "('ptr \<times> 'ptr) \<times> 'state \<Rightarrow> nat" where
  "rev_measure ((p,r),s) = length (The (list_eq s p))"

lemma list_eq_unique: "list_eq s p ps \<Longrightarrow> list_eq s p qs \<Longrightarrow> ps = qs"
  by (induction ps arbitrary: p qs; case_tac qs; fastforce)

lemma list_get_eq [simp]: "list_eq s p ps \<Longrightarrow> The (list_eq s p) = ps"
  using list_eq_unique by blast

lemma list_eq_null [dest]: "list_eq s null ps \<Longrightarrow> ps = []"
  by (cases ps) auto

lemma list_eq_not_null_valid: "p \<noteq> null \<Longrightarrow> list_eq s p ps \<Longrightarrow> ok p s"
  by (cases ps) auto

lemma list_eq_up: "ok q s \<Longrightarrow> q \<notin> set ps \<Longrightarrow> list_eq s p ps \<Longrightarrow> list_eq (set_next q r s) p ps"
  by (induction ps arbitrary: p) (auto simp: get_com)

lemma list_eq_app: "list_eq s p (ps @ q # qs) \<Longrightarrow> list_eq s q (q # qs)"
  by (induction ps arbitrary: p) auto

lemma list_eq_distinct: "list_eq s p ps \<Longrightarrow> distinct ps"
  proof (induction ps arbitrary: s p)
    case (Cons p' ps)
    hence Cons':
      "list_eq s p (p # ps)"
      "distinct ps"
      "p' = p"
      "ok p s"
      by auto
    {
      assume P: "p \<in> set ps"
      obtain h t where S: "ps = h @ p # t" using split_list[OF P] by blast
      hence T: "list_eq s p (p # t)" using Cons' list_eq_app by simp
      have False using list_eq_unique[OF Cons'(1) T] S by simp
    }
    thus ?case using Cons' by auto
  qed auto

lemma list_eq_next:
  "p \<noteq> null \<Longrightarrow> ps = p' # ps' \<Longrightarrow> list_eq s p ps \<Longrightarrow> list_eq (set_next p q s) (get_next p s) ps'"
  by (frule list_eq_distinct, cases ps) (auto simp: list_eq_up)

lemma list_rev_app: "list_rev e (ps @ q # qs) = list_rev q qs \<circ> list_rev e (ps @ [q])"
  by (induction ps arbitrary: e) auto

lemma list_rev_snoc:
  "list_eq s' r rs \<Longrightarrow> set_next p r (list_rev null (rev rs) s) = list_rev null (rev rs @ [p]) s"
  by (cases rs; clarsimp simp: list_rev_app[where qs="[p]"])

end

context reverse begin

definition get_next_node :: "node_C ptr \<Rightarrow> lifted_globals \<Rightarrow> node_C ptr" where
  "get_next_node p s \<equiv> next_C (heap_node_C s p)"

definition set_next_node :: "node_C ptr \<Rightarrow> node_C ptr \<Rightarrow> lifted_globals \<Rightarrow> lifted_globals" where
  "set_next_node p q \<equiv> heap_node_C_update (\<lambda>h. h (p := next_C_update (\<lambda>_. q) (h p)))"

abbreviation ok_node_ptr :: "node_C ptr \<Rightarrow> lifted_globals \<Rightarrow> bool" where
  "ok_node_ptr p s \<equiv> p \<noteq> NULL \<and> is_valid_node_C s p"

sublocale node_ptr_chain?: ptr_chain get_next_node set_next_node ok_node_ptr NULL
  unfolding get_next_node_def[abs_def] set_next_node_def[abs_def]
  by unfold_locales (auto simp: fun_upd_twist fun_upd_other fun_upd_same)

lemma reverse'_correct:
  "\<lbrace> \<lambda> s. s = i \<and> list_eq s p ps \<rbrace>
    reverse' p
   \<lbrace> \<lambda> r s. s = list_rev NULL ps i \<and> list_eq s r (rev ps) \<rbrace>!"
  unfolding
    reverse'_def
    get_next_node_def[symmetric] set_next_node_def[symmetric]
    whileLoop_add_inv[where I="rev_invariant i ps" and M="rev_measure"]
  apply (wp; clarsimp)
  subgoal for p r ps' rs
   apply (cases ps'; clarsimp simp: list_get_eq[OF list_eq_next[where ps=ps']])
   subgoal for ps''
    apply (rule exI[where x=ps''])
    apply (rule exI[where x="p # rs"])
    apply (auto simp: list_eq_next list_eq_up)
    by (simp add: list_rev_snoc)
   done
  subgoal by auto
  subgoal by (intro conjI exI) (auto simp: list_eq_distinct)
  done

lemma reverse_simpl_correct:
  assumes
    "\<And> s. lift_global_heap (globals s) = i \<and> list_eq (lift_global_heap (globals s)) p ps \<Longrightarrow> list_' s = p"
  shows
    "\<Gamma>, \<Theta> \<turnstile>\<^sub>t\<^bsub>/F\<^esub>
       {s. lift_global_heap (globals s) = i \<and> list_eq (lift_global_heap (globals s)) p ps}
         Call reverse_'proc
       {s. lift_global_heap (globals s) = list_rev NULL ps i \<and> list_eq (lift_global_heap (globals s)) (ret__ptr_to_struct_node_C_' s) (rev ps)}, E"
  apply (rule hoaret_from_ac_corres[OF reverse'_ac_corres validE_NF_liftE[OF reverse'_correct], simplified])
  by (metis (full_types) assms myvars.simps(4) state.simps(1))

end

end


theory Push_State
  imports Main
begin

chapter \<open>Push State\<close>

text \<open>
This describes a structured state which supports stack-like operations
for joining and splitting states.

It is intended that this is used to support notions of capturing and
scoped state.
\<close>

class state =
  fixes push :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes push_inj: "push m s = push m' s' \<Longrightarrow> (m = m' \<and> s = s')"

context state
begin

section \<open>Operations on predicates and relations\<close>

definition pop
  where "pop A \<equiv> THE C. \<exists>B. A = push C B"

lemma push_inj_eq:
  "(push m s = push m' s') = (m = m' \<and> s = s')"
  by rule (auto dest: push_inj)

lemma pop_push [simp]:
  "pop (push a b) = a"
  unfolding pop_def push_inj_eq by auto

definition pushpred :: "'a \<Rightarrow> 'a set \<Rightarrow> 'a set" where
"pushpred s P = {push m s |m. m \<in> P}"

definition poppred :: "'a set \<Rightarrow> 'a set" where
"poppred P = {pop m |m. m \<in> P}"

definition poppred' :: "'a \<Rightarrow> 'a set \<Rightarrow> 'a set" where
"poppred' s P = {m |m. push m s \<in> P}"

(* rarely used except in specific proof steps which require
showing something is inside a pushrelAll or similar. *)
definition pushpredAll :: "'a set \<Rightarrow> 'a set" where
"pushpredAll P \<equiv> {push m s |m s. m \<in> P}"

definition poprel :: "'a rel \<Rightarrow> 'a rel" where
"poprel b = {(pop m,pop m') |m m'. (m,m') \<in> b}"

definition poprel' :: "'a \<Rightarrow> 'a \<Rightarrow> 'a rel \<Rightarrow> 'a rel" where
"poprel' s s' R = {(m,m') |m m'. (push m s,push m' s') \<in> R}"

definition pushrel :: "'a \<Rightarrow> 'a \<Rightarrow> 'a rel \<Rightarrow> 'a rel" where
"pushrel s s' b = {(push m s,push m' s') |m m'. (m,m') \<in> b}"

definition pushrelSame :: "'a rel \<Rightarrow> 'a rel" where
"pushrelSame R = {(push m s, push m' s) |m m' s. (m,m') \<in> R}"

definition pushrelAll :: "'a rel \<Rightarrow> 'a rel" where
"pushrelAll G = {(push m s, push m' s') |m m' s s'. (m,m') \<in> G}"

abbreviation poppable :: "'a \<Rightarrow> 'a set \<Rightarrow> bool" where
"poppable s P \<equiv> (P = pushpred s (poppred P))"

section \<open>Introduction/elimination rules for the definitions\<close>

lemma pushpred_inI [intro]:
  assumes "p \<in> P" "m = push p s"
  shows "m \<in> pushpred s P"
using assms
unfolding pushpred_def by auto

lemma pushpred_inE:
  assumes "m \<in> pushpred s P"
  obtains p s where "p \<in> P" "m = push p s"
using assms
unfolding pushpred_def by auto

lemma pushrelSame_inE [elim]:
  assumes "(p,p') \<in> pushrelSame R"
  obtains m m' s where "p = push m s" "p' = push m' s" "(m,m') \<in> R"
using assms pushrelSame_def by auto

lemma pushrelSame_inI [intro]:
  assumes "p = push m s" "p' = push m' s" "(m,m') \<in> R"
  shows "(p,p') \<in> pushrelSame R"
using assms pushrelSame_def by auto

lemma poppable_inE:
  assumes "p \<in> P" "poppable s P"
  obtains m where "p = push m s"
using assms unfolding poppred_def pushpred_def by auto

text \<open>TRICKY! Extracting local states from a given state.\<close>
text \<open>Obtains the set of states which were pushed onto a given set.\<close>
definition pushed where
"pushed P \<equiv> {s |s m. m \<in> P \<and> push (pop m) s = m}"

lemma pushed_inE [elim]:
  assumes "s \<in> pushed P"
  obtains p where "p \<in> P" "push (pop p) s = p"
using assms unfolding pushed_def by auto

(*
lemma pushed_set_supset: "P \<subseteq> (\<Union>s \<in> pushed P. pushpred s (poppred' s P))"
unfolding pushed_def pushpred_def poppred'_def
by auto (metis push_pop) *)

lemma push_poppred_subset: "pushpred s (poppred' s P) \<subseteq> P"
unfolding pushpred_def poppred'_def
by auto

(*
lemma pushed_empty: "pushed P = {} \<Longrightarrow> P = {}"
unfolding pushed_def
using push_pop by fastforce *)

section \<open>Lemmas for push/pop on predicates/relations\<close>

lemma poppred'_subset: "poppred' s P \<subseteq> poppred P"
unfolding poppred'_def poppred_def
by force

lemma poprel'_subset: "poprel' s s' R \<subseteq> poprel R"
unfolding poprel_def poprel'_def
by force

subsection \<open>Introduction of pushes\<close>

text \<open>These allow introducing pushes when given arbitrary predicates.\<close>

subsection \<open>Inverses\<close>

lemma push_poprelAll [simp]: "pushrelAll (poprel G) = G"
unfolding poprel_def pushrelAll_def
oops

lemma pop_pushrelAll [simp]: "poprel (pushrelAll G) = G"
unfolding poprel_def pushrelAll_def
by (auto, metis pop_push)

lemma pop_pushrelSame [simp]: "poprel (pushrelSame G) = G"
unfolding poprel_def pushrelSame_def
by (auto, metis pop_push)

text \<open>Pop a previously pushed predicate or relation.\<close>

lemma pop_pushpred [simp]: "poppred (pushpred s P) = P"
unfolding poppred_def pushpred_def by force

lemma pop_pushpredAll [simp]: "poppred (pushpredAll P) = P"
unfolding poppred_def pushpredAll_def by force

lemma pop_pushrel [simp]: "poprel (pushrel s s' R) = R"
unfolding poprel_def pushrel_def by force

text \<open>These push after pop lemmas are *suspicious*...\<close>

lemma push_poprel [simp]: "pushrel s s' (poprel R) = R"
unfolding poprel_def pushrel_def
oops

subsection \<open>Monotonicity\<close>

lemma pushpred_mono [simp]: "P \<subseteq> P' \<Longrightarrow> pushpred s P \<subseteq> pushpred s P'"
unfolding pushpred_def by auto

lemma poppred_mono [simp]: "P \<subseteq> P' \<Longrightarrow> poppred P \<subseteq> poppred P'"
unfolding poppred_def by auto

lemma poppred'_mono: "P \<subseteq> P' \<Longrightarrow> poppred' s P \<subseteq> poppred' s P'"
unfolding poppred'_def by auto

lemma pushpredAll_mono [simp]: "P \<subseteq> P' \<Longrightarrow> pushpredAll P \<subseteq> pushpredAll P'"
unfolding pushpredAll_def by auto

lemma poprel_mono [simp]: "G \<subseteq> G' \<Longrightarrow> poprel G \<subseteq> poprel G'"
unfolding poprel_def pushrelAll_def by auto

lemma poprel'_mono [simp]: "G \<subseteq> G' \<Longrightarrow> poprel' s s' G \<subseteq> poprel' s s' G'"
unfolding poprel'_def pushrelAll_def by auto

lemma pushrel_mono [simp]: "G \<subseteq> G' \<Longrightarrow> pushrel s s' G \<subseteq> pushrel s s' G'"
unfolding pushrel_def by auto

lemma pushrelSame_mono [simp]: "G \<subseteq> G' \<Longrightarrow> pushrelSame G \<subseteq> pushrelSame G'"
unfolding pushrelSame_def by auto

lemma pushrelAll_mono [simp]: "G \<subseteq> G' \<Longrightarrow> pushrelAll G \<subseteq> pushrelAll G'"
unfolding pushrelAll_def by auto

lemma pushrelAll_eq: "(pushrelAll G \<subseteq> pushrelAll G') = (G \<subseteq> G')"
using poprel_mono pop_pushrelAll pushrelAll_mono
by metis

subsection \<open>Relation composition\<close>

lemma poprel_relcomp: "poprel (G O G') \<subseteq> poprel G O poprel G'"
unfolding poprel_def
by auto

lemma pushrelAll_relcomp [simp]: "pushrelAll (G O G') = pushrelAll G O pushrelAll G'"
unfolding pushrelAll_def
by (auto, blast, metis pop_push relcomp.relcompI)

subsubsection \<open>Special cases for popping a relational composition of pushes\<close>

lemma poprel_relcomp_pushrel1: "poprel (pushrel s s' G O pushrelSame G') = G O G'"
unfolding poprel_def pushrel_def pushrelSame_def
by auto (metis pop_push relcomp.simps, force)

lemma poprel_relcomp_pushrel2: "poprel (pushrel s s' G O pushrelAll G') = G O G'"
unfolding poprel_def pushrel_def pushrelAll_def
by auto (metis pop_push relcomp.simps, force)

lemma poprel_relcomp_pushrelSame: "poprel (pushrelSame G O pushrelSame G') = G O G'"
unfolding poprel_def pushrelSame_def
by auto (metis pop_push relcomp.simps, force)

lemma poprel_relcomp_pushrelAll: "poprel (pushrelAll G O pushrelAll G') = G O G'"
unfolding poprel_def pushrelAll_def
by auto (metis pop_push relcomp.simps, force)

lemma poprel_relcomp_pushpred: "poprel (Id_on (pushpred s P) O pushrel s s' P') = Id_on P O P'"
unfolding poprel_def pushpred_def pushrel_def
by auto (metis Id_on_iff pop_push relcompI, force)

lemma pushrel_relcomp_id: "pushrel s s' (Id_on P O P') = Id_on (pushpred s P) O pushrel s s' P'"
unfolding pushrel_def pushpred_def
by auto (metis Id_onI pop_push relcompI)

(*
lemma pushpredAll_poppred_supset: "P \<subseteq> pushpredAll (poppred P)"
unfolding pushpredAll_def poppred_def
by clarsimp (metis push_pop)

lemma pushrelAll_poprel_supset: "G \<subseteq> pushrelAll (poprel G)"
unfolding pushrelAll_def poprel_def
by clarsimp (metis push_pop) *)

lemma pushrel_in_pushrelAll: "pushrel s s' G \<subseteq> pushrelAll G"
unfolding pushrel_def pushrelAll_def by fast

lemma pushrelSame_in_pushrelAll: "pushrelSame G \<subseteq> pushrelAll G"
unfolding pushrelSame_def pushrelAll_def by fast

(* unlikely to hold, after popping more relations will link up. *)
(*lemma "poprel (Id_on P) O poprel P' \<subseteq> poprel (Id_on P O P')"
proof (rule subrelI)
  fix m m' assume mm': "(m,m') \<in> poprel (Id_on P) O poprel P'"
  hence "m \<in> poppred P" unfolding poprel_def poppred_def by auto
  have "(m,m') \<in> poprel P'" using mm' unfolding poprel_def by auto

  show "(m,m') \<in> poprel (Id_on P O P')" oops
oops *)

text \<open>If P is contained in a pushed set, popping then pushing again is the identity.\<close>
lemma pushpred_poppable: "P \<subseteq> pushpred s P' \<Longrightarrow> P = pushpred s (poppred P)"
unfolding pushpred_def poppred_def
by force

subsection \<open>Intersection\<close>

lemma pushpred_inter [simp]: "pushpred s (P \<inter> P') = pushpred s P \<inter> pushpred s P'"
unfolding pushpred_def
by (auto, metis pop_push)

lemma poppred_inter [simp]: "poppred (P \<inter> P') \<subseteq> poppred P \<inter> poppred P'"
unfolding poppred_def
by auto

lemma poppred_inter2: "poppred (pushpred s P \<inter> pushpred s P') = P \<inter> P'"
unfolding poppred_def pushpred_def
by (auto, (metis pop_push)+)

lemma pushrel_inter [simp]: "pushrel s s' (G \<inter> G') = pushrel s s' G \<inter> pushrel s s' G'"
unfolding pushrel_def
by (auto, metis pop_push)

lemma pushrelSame_inter [simp]: "pushrelSame (G \<inter> G') = pushrelSame G \<inter> pushrelSame G'"
unfolding pushrelSame_def
by (auto, metis pop_push)

lemma pushrelAll_inter [simp]: "pushrelAll (G \<inter> G') = pushrelAll G \<inter> pushrelAll G'"
unfolding pushrelAll_def
by (auto, metis pop_push)

lemma pushpredAll_inter: "pushpredAll (P \<inter> P') = pushpredAll P \<inter> pushpredAll P'"
unfolding pushpredAll_def
by auto (metis local.pop_push)

text \<open>Special case where we intersect a narrowed push with a more general push.\<close>
lemma pushpred_inter_pushpredAll: "pushpred s P \<inter> pushpredAll P' = pushpred s (P \<inter> P')"
unfolding pushpred_def pushpredAll_def
by (auto, metis pop_push)

subsection \<open>Union\<close>

lemma pushpred_union: "pushpred s (P \<union> P') = pushpred s P \<union> pushpred s P'"
unfolding pushpred_def by auto

subsection \<open>Image of relations\<close>

lemma pushpred_relimage: "pushpred s (R `` P) = pushrelSame R `` pushpred s P"
unfolding pushpred_def pushrelSame_def
by (auto, insert push_inj, blast)

lemma pushpredAll_relimage: "pushpredAll (R `` P) = pushrelAll R `` pushpredAll P"
unfolding pushpredAll_def pushrelAll_def
by (auto, insert push_inj, blast+)

subsection \<open>Empty set\<close>

lemma pushpred_empty [simp]: "pushpred s {} = {}"
unfolding pushpred_def by simp

lemma poppred_empty [simp]: "poppred {} = {}"
unfolding poppred_def by simp

lemma poprel_empty [simp]: "poprel {} = {}"
unfolding poprel_def by simp

lemma pushrel_empty [simp]: "pushrel s s' {} = {}"
unfolding pushrel_def by simp

lemma pushrelSame_empty [simp]: "pushrelSame {} = {}"
unfolding pushrelSame_def by simp

lemma pushrelAll_empty [simp]: "pushrelAll {} = {}"
unfolding pushrelAll_def by simp

lemma poppable_empty [simp]: "poppable s {}"
by simp

subsection \<open>Correspondences between predicates and Id_on.\<close>

(*
lemma Id_in_pushrelAll_poppred: "Id_on G \<subseteq> pushrelAll (Id_on (poppred G))"
using pushpredAll_poppred_supset subsetD
unfolding pushrelAll_def pushpredAll_def
by fast *)

lemma poppred_eq_poprel: "Id_on (poppred a) = poprel (Id_on a)"
unfolding poppred_def poprel_def by auto

lemma poppred_in_poprel: "m \<in> poppred G \<Longrightarrow> (m,m) \<in> poprel (Id_on G)"
using poppred_eq_poprel by fast

subsection \<open>Other\<close>

lemma pushrelSame_in_eq: "((push m s, push m' s) \<in> pushrelSame R) = ((m,m') \<in> R)"
unfolding pushrelSame_def
by (auto, metis local.pop_push)

lemma domain_pushrel: "Domain (pushrel s s' R) = pushpred s (Domain R)"
unfolding pushrel_def pushpred_def
by auto

(* lemma "(pushrelSame R)\<^sup>* = pushrelSame (R\<^sup>* )"
proof (intro antisym subrelI, goal_cases)
  case (1 p p')
  then obtain m m' s where mm': "p = push m s" "p' = push m' s"
    apply (induct, auto)
    by (metis push_pop, metis push_inj pushrelSame_inE)
  show ?case using 1
  proof (induct)
    case base
    have "(m,m) \<in> R\<^sup>*" by simp
    then show ?case using mm' by (simp add: pushrelSame_in_eq)
    case (step y z)
    then show ?case unfolding pushrelSame_def apply auto
    by (metis (no_types, lifting) local.push_inj rtrancl.rtrancl_into_rtrancl)
  qed
next
  case (2 p p')
  then obtain m m' s where mm': "p = push m s" "p' = push m' s" "(m,m') \<in> R\<^sup>*"
    by (rule pushrelSame_inE)
  with mm'(3) show ?case
  proof (induct)
    case base
    then show ?case
  next
    case (step y z)
    then show ?case
  qed
qed *)

end

text \<open>
Image through transitive closure + reflexive on set is the original set.
Used for stabilise proofs. Also note similarities with the linked lemma
which applies to the builtin rtrancl.
\<close>
thm Transitive_Closure.Image_closed_trancl
lemma Image_closed_trancl':
  assumes "R `` P \<subseteq> P"
  shows "P \<union> R\<^sup>+ `` P = P"
proof -
  have "m' \<in> P" if "(m, m') \<in> R\<^sup>+" "m \<in> P" for m m'
    using that assms by induct auto
  thus ?thesis by auto
qed

lemma pushrelSame_trancl: "(pushrelSame R)\<^sup>+ = pushrelSame (R\<^sup>+)"
proof (intro antisym subrelI, goal_cases)
  case (1 p p')
  then show ?case
  proof (induct)
    case (base p') thus ?case by auto
  next
    case (step p' p'')
    obtain m m' s where mm':
      "p = push m s" "p' = push m' s" "(m,m') \<in> R\<^sup>+"
      using step by auto
    obtain m'2 m'' s2 where
      "p' = push m'2 s2" "p'' = push m'' s2" "(m'2,m'') \<in> R"
      using step by auto
    hence m'': "p'' = push m'' s" "(m',m'') \<in> R"
      using mm' push_inj by auto
    hence "(m,m'') \<in> R\<^sup>+" using mm' by simp
    thus ?case using mm' m'' by auto
  qed
next
  case (2 p p'')
  then obtain m m'' s where
    "(m,m'') \<in> R\<^sup>+" "p = push m s" "p'' = push m'' s"
    by auto
  then show ?case
  proof (induct arbitrary: p p'' s)
    case (base m'') thus ?case by auto
  next
    case (step m' m'')
    hence "(push m s, push m' s) \<in> (pushrelSame R)\<^sup>+"
      "(push m' s, push m'' s) \<in> pushrelSame R" by auto
    thus ?case using step(4,5) by simp
  qed
qed

(*
lemma push_pop_one: "\<exists>!s. push (pop m) s = m"
using push_pop push_inj
by metis
*)

lemma "poppable s P \<Longrightarrow> pushed P \<subseteq> {s}"
proof
  assume poppable: "poppable s P"
  fix x assume "x \<in> pushed P"
  then obtain p where p: "p \<in> P" "p = push (pop p) x" by auto
  then obtain m where m: "p = push m s" using poppable poppable_inE by blast
  have "x = s" using p m push_inj by metis
  thus "x \<in> {s}" by simp
qed

(*
lemma "pushed P \<subseteq> {s} \<Longrightarrow> poppable s P"
proof -
  assume "pushed P \<subseteq> {s}"
  then consider "pushed P = {}" | "pushed P = {s}" by auto
  thus ?thesis
  proof (cases)
    case 1
    thus ?thesis using pushed_empty[of P] by simp
  next
    case 2
    then show ?thesis
    proof (intro antisym, goal_cases)
      case 1
      then have "P \<subseteq> pushpred s (poppred' s P)"
        using pushed_set_supset by force
      then show ?case using pushpred_mono[OF poppred'_subset] by fast
    next
      case 2
      then show ?case unfolding pushed_def pushpred_def poppred_def
        by clarsimp (metis (mono_tags, lifting) mem_Collect_eq push_pop singleton_iff)
    qed
  qed
qed*)

abbreviation (input) uncapBeh where
"uncapBeh s B \<equiv> pushrel s B"

abbreviation (input) capGuar where
"capGuar G \<equiv> poprel G"

abbreviation (input) uncapGuar where
"uncapGuar G \<equiv> pushrelAll G"

abbreviation (input) uncapPred where
"uncapPred s P \<equiv> pushpred s P"

abbreviation (input) capPred where
"capPred P \<equiv> poppred P"

abbreviation (input) uncapRely where
"uncapRely R \<equiv> pushrelSame R"

end


section \<open>Mixed Integer Solutions\<close>

text \<open>We prove that if an integral system of linear inequalities
$Ax \leq b \wedge A'x < b'$ has a (mixed)integer solution, then there is also
a small (mixed)integer solution, where the numbers are bounded by
$(n+1) * db\, m\, n$ where $n$ is the number of variables, $m$ is a bound on
the absolute values of numbers occurring in $A,A',b,b'$, and
$db\,m\,n$ is a bound on determinants for matrices of size $n$ with values of at most $m$.\<close>

theory Mixed_Integer_Solutions
  imports Decomposition_Theorem
begin

definition less_vec :: "'a vec \<Rightarrow> ('a :: ord) vec \<Rightarrow> bool" (infix "<\<^sub>v" 50) where
  "v <\<^sub>v w = (dim_vec v = dim_vec w \<and> (\<forall> i < dim_vec w. v $ i < w $ i))"

lemma less_vecD: assumes "v <\<^sub>v w" and "w \<in> carrier_vec n"
  shows "i < n \<Longrightarrow> v $ i < w $ i"
  using assms unfolding less_vec_def by auto

lemma less_vecI: assumes "v \<in> carrier_vec n" "w \<in> carrier_vec n"
  "\<And> i. i < n \<Longrightarrow> v $ i < w $ i"
shows "v <\<^sub>v w"
  using assms unfolding less_vec_def by auto

lemma less_vec_lesseq_vec: "v <\<^sub>v (w :: 'a :: preorder vec) \<Longrightarrow> v \<le> w"
  unfolding less_vec_def less_eq_vec_def
  by (auto simp: less_le_not_le)

lemma floor_of_int_eq[simp]: "x \<in> \<int> \<Longrightarrow> of_int \<lfloor>x\<rfloor> = x"
  by (metis Ints_cases of_int_floor_cancel)

locale gram_schmidt_floor = gram_schmidt n f_ty
  for n :: nat and f_ty :: "'a :: {floor_ceiling,
    trivial_conjugatable_linordered_field} itself"
begin

text \<open>We get rid of the max-1 operation, by showing that a smaller value of Bnd
  can only occur in very special cases where the theorem is trivially satisfied.\<close>

lemma small_mixed_integer_solution: fixes A\<^sub>1 :: "'a mat"
  assumes db: "is_det_bound db"
    and A1: "A\<^sub>1 \<in> carrier_mat nr\<^sub>1 n"
    and A2: "A\<^sub>2 \<in> carrier_mat nr\<^sub>2 n"
    and b1: "b\<^sub>1 \<in> carrier_vec nr\<^sub>1"
    and b2: "b\<^sub>2 \<in> carrier_vec nr\<^sub>2"
    and A1Bnd: "A\<^sub>1 \<in> \<int>\<^sub>m \<inter> Bounded_mat (of_int Bnd)"
    and b1Bnd: "b\<^sub>1 \<in> \<int>\<^sub>v \<inter> Bounded_vec (of_int Bnd)"
    and A2Bnd: "A\<^sub>2 \<in> \<int>\<^sub>m \<inter> Bounded_mat (of_int Bnd)"
    and b2Bnd: "b\<^sub>2 \<in> \<int>\<^sub>v \<inter> Bounded_vec (of_int Bnd)"
    and x: "x \<in> carrier_vec n"
    and xI: "x \<in> indexed_Ints_vec I"
    and sol_nonstrict: "A\<^sub>1 *\<^sub>v x \<le> b\<^sub>1"
    and sol_strict: "A\<^sub>2 *\<^sub>v x <\<^sub>v b\<^sub>2"
    and non_degenerate: "nr\<^sub>1 \<noteq> 0 \<or> nr\<^sub>2 \<noteq> 0 \<or> Bnd \<ge> 0"
  shows "\<exists> x.
  x \<in> carrier_vec n \<and>
  x \<in> indexed_Ints_vec I \<and>
  A\<^sub>1 *\<^sub>v x \<le> b\<^sub>1 \<and>
  A\<^sub>2 *\<^sub>v x <\<^sub>v b\<^sub>2 \<and>
  x \<in> Bounded_vec (of_int (int (n+1) * db n Bnd))"
proof (cases "Bnd \<ge> 1")
  case True
  hence "max 1 Bnd = Bnd" by auto
  with small_mixed_integer_solution_main[OF assms(1-13)] True show ?thesis by auto
next
  case trivial: False
  let ?oi = "of_int :: int \<Rightarrow> 'a"
  show ?thesis
  proof (cases "n = 0")
    case True
    with x have "x \<in> Bounded_vec b" for b unfolding Bounded_vec_def by auto
    with xI x sol_nonstrict sol_strict show ?thesis by blast
  next
    case n: False
    {
      fix A nr
      assume A: "A \<in> carrier_mat nr n" and Bnd: "A \<in> \<int>\<^sub>m \<inter> Bounded_mat (?oi Bnd)"
      {
        fix i j
        assume "i < nr" "j < n"
        with Bnd A have *: "A $$ (i,j) \<in> \<int>" "abs (A $$ (i,j)) \<le> ?oi Bnd"
          unfolding Bounded_mat_def Ints_mat_def by auto
        from Ints_nonzero_abs_less1[OF *(1)] *(2) trivial
        have "A $$ (i,j) = 0"
          by (meson add_le_less_mono int_one_le_iff_zero_less less_add_same_cancel2 of_int_0_less_iff zero_less_abs_iff)
        with *(2) have "Bnd \<ge> 0" "A $$ (i,j) = 0" by auto
      } note main = this
      have A0: "A = 0\<^sub>m nr n"
        by (intro eq_matI, insert main A, auto)
      have "nr \<noteq> 0 \<Longrightarrow> Bnd \<ge> 0" using main[of 0 0] n by auto
      note A0 this
    } note main = this
    from main[OF A1 A1Bnd] have A1: "A\<^sub>1 = 0\<^sub>m nr\<^sub>1 n" and nr1: "nr\<^sub>1 \<noteq> 0 \<Longrightarrow> Bnd \<ge> 0"
      by auto
    from main[OF A2 A2Bnd] have A2: "A\<^sub>2 = 0\<^sub>m nr\<^sub>2 n" and nr2: "nr\<^sub>2 \<noteq> 0 \<Longrightarrow> Bnd \<ge> 0"
      by auto
    let ?x = "0\<^sub>v n"
    show ?thesis
    proof (intro exI[of _ ?x] conjI)
      show "A\<^sub>1 *\<^sub>v ?x \<le> b\<^sub>1" using sol_nonstrict x unfolding A1 by auto
      show "A\<^sub>2 *\<^sub>v ?x <\<^sub>v b\<^sub>2" using sol_strict x unfolding A2 by auto
      show "?x \<in> carrier_vec n" by auto
      show "?x \<in> indexed_Ints_vec I" unfolding indexed_Ints_vec_def by auto
      from nr1 nr2 non_degenerate have Bnd: "Bnd \<ge> 0" by auto
      from is_det_bound_ge_zero[OF db Bnd] have "db n Bnd \<ge> 0" .
      hence "?oi (of_nat (n + 1) * db n Bnd) \<ge> 0" by simp
      thus "?x \<in> Bounded_vec (?oi (of_nat (n + 1) * db n Bnd))" by (auto simp: Bounded_vec_def)
    qed
  qed
qed

lemmas small_mixed_integer_solution_hadamard =
  small_mixed_integer_solution[OF det_bound_hadamard, unfolded det_bound_hadamard_def of_int_mult of_int_of_nat_eq]

lemma Bounded_vec_of_int: assumes "v \<in> Bounded_vec bnd"
  shows "(map_vec of_int v :: 'a vec) \<in> \<int>\<^sub>v \<inter> Bounded_vec (of_int bnd)"
  using assms
  apply (simp add: Ints_vec_vec_set Bounded_vec_vec_set Ints_def)
  apply (intro conjI, force)
  apply (clarsimp)
  subgoal for x apply (elim ballE[of _ _ x], auto)
    by (metis of_int_abs of_int_le_iff)
  done

lemma Bounded_mat_of_int: assumes "A \<in> Bounded_mat bnd"
  shows "(map_mat of_int A :: 'a mat) \<in> \<int>\<^sub>m \<inter> Bounded_mat (of_int bnd)"
  using assms
  apply (simp add: Ints_mat_elements_mat Bounded_mat_elements_mat Ints_def)
  apply (intro conjI, force)
  apply (clarsimp)
  subgoal for x apply (elim ballE[of _ _ x], auto)
    by (metis of_int_abs of_int_le_iff)
  done

lemma small_mixed_integer_solution_int_mat: fixes x :: "'a vec"
  assumes db: "is_det_bound db"
    and A1: "A\<^sub>1 \<in> carrier_mat nr\<^sub>1 n"
    and A2: "A\<^sub>2 \<in> carrier_mat nr\<^sub>2 n"
    and b1: "b\<^sub>1 \<in> carrier_vec nr\<^sub>1"
    and b2: "b\<^sub>2 \<in> carrier_vec nr\<^sub>2"
    and A1Bnd: "A\<^sub>1 \<in> Bounded_mat Bnd"
    and b1Bnd: "b\<^sub>1 \<in> Bounded_vec Bnd"
    and A2Bnd: "A\<^sub>2 \<in> Bounded_mat Bnd"
    and b2Bnd: "b\<^sub>2 \<in> Bounded_vec Bnd"
    and x: "x \<in> carrier_vec n"
    and xI: "x \<in> indexed_Ints_vec I"
    and sol_nonstrict: "map_mat of_int A\<^sub>1 *\<^sub>v x \<le> map_vec of_int b\<^sub>1"
    and sol_strict: "map_mat of_int A\<^sub>2 *\<^sub>v x <\<^sub>v map_vec of_int b\<^sub>2"
    and non_degenerate: "nr\<^sub>1 \<noteq> 0 \<or> nr\<^sub>2 \<noteq> 0 \<or> Bnd \<ge> 0"
  shows "\<exists> x :: 'a vec.
  x \<in> carrier_vec n \<and>
  x \<in> indexed_Ints_vec I \<and>
  map_mat of_int A\<^sub>1 *\<^sub>v x \<le> map_vec of_int b\<^sub>1 \<and>
  map_mat of_int A\<^sub>2 *\<^sub>v x <\<^sub>v map_vec of_int b\<^sub>2 \<and>
  x \<in> Bounded_vec (of_int (of_nat (n+1) * db n Bnd))"
proof -
  let ?oi = "of_int :: int \<Rightarrow> 'a"
  let ?A1 = "map_mat ?oi A\<^sub>1"
  let ?A2 = "map_mat ?oi A\<^sub>2"
  let ?b1 = "map_vec ?oi b\<^sub>1"
  let ?b2 = "map_vec ?oi b\<^sub>2"
  let ?Bnd = "?oi Bnd"
  from A1 have A1': "?A1 \<in> carrier_mat nr\<^sub>1 n" by auto
  from A2 have A2': "?A2 \<in> carrier_mat nr\<^sub>2 n" by auto
  from b1 have b1': "?b1 \<in> carrier_vec nr\<^sub>1" by auto
  from b2 have b2': "?b2 \<in> carrier_vec nr\<^sub>2" by auto
  from small_mixed_integer_solution[OF db A1' A2' b1' b2'
     Bounded_mat_of_int[OF A1Bnd] Bounded_vec_of_int[OF b1Bnd]
     Bounded_mat_of_int[OF A2Bnd] Bounded_vec_of_int[OF b2Bnd]
     x xI sol_nonstrict sol_strict non_degenerate]
  show ?thesis .
qed

lemmas small_mixed_integer_solution_int_mat_hadamard =
  small_mixed_integer_solution_int_mat[OF det_bound_hadamard, unfolded det_bound_hadamard_def of_int_mult of_int_of_nat_eq]

end

lemma of_int_hom_le: "(of_int_hom.vec_hom v :: 'a :: linordered_field vec) \<le> of_int_hom.vec_hom w \<longleftrightarrow> v \<le> w"
  unfolding less_eq_vec_def by auto

lemma of_int_hom_less: "(of_int_hom.vec_hom v :: 'a :: linordered_field vec) <\<^sub>v of_int_hom.vec_hom w \<longleftrightarrow> v <\<^sub>v w"
  unfolding less_vec_def by auto

lemma Ints_vec_to_int_vec: assumes "v \<in> \<int>\<^sub>v"
  shows "\<exists> w. v = map_vec of_int w"
proof -
  have "\<forall> i. \<exists> x. i < dim_vec v \<longrightarrow> v $ i = of_int x"
    using assms unfolding Ints_vec_def Ints_def by auto
  from choice[OF this] obtain x where "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = of_int (x i)"
    by auto
  thus ?thesis
    by (intro exI[of _ "vec (dim_vec v) x"], auto)
qed

lemma small_integer_solution: fixes A\<^sub>1 :: "int mat"
  assumes db: "is_det_bound db"
    and A1: "A\<^sub>1 \<in> carrier_mat nr\<^sub>1 n"
    and A2: "A\<^sub>2 \<in> carrier_mat nr\<^sub>2 n"
    and b1: "b\<^sub>1 \<in> carrier_vec nr\<^sub>1"
    and b2: "b\<^sub>2 \<in> carrier_vec nr\<^sub>2"
    and A1Bnd: "A\<^sub>1 \<in> Bounded_mat Bnd"
    and b1Bnd: "b\<^sub>1 \<in> Bounded_vec Bnd"
    and A2Bnd: "A\<^sub>2 \<in> Bounded_mat Bnd"
    and b2Bnd: "b\<^sub>2 \<in> Bounded_vec Bnd"
    and x: "x \<in> carrier_vec n"
    and sol_nonstrict: "A\<^sub>1 *\<^sub>v x \<le> b\<^sub>1"
    and sol_strict: "A\<^sub>2 *\<^sub>v x <\<^sub>v b\<^sub>2"
    and non_degenerate: "nr\<^sub>1 \<noteq> 0 \<or> nr\<^sub>2 \<noteq> 0 \<or> Bnd \<ge> 0"
  shows "\<exists> x.
    x \<in> carrier_vec n \<and>
    A\<^sub>1 *\<^sub>v x \<le> b\<^sub>1 \<and>
    A\<^sub>2 *\<^sub>v x <\<^sub>v b\<^sub>2 \<and>
    x \<in> Bounded_vec (of_nat (n+1) * db n Bnd)"
proof -
  let ?oi = rat_of_int
  let ?x = "map_vec ?oi x"
  let ?oiM = "map_mat ?oi"
  let ?oiv = "map_vec ?oi"
  from x have xx: "?x \<in> carrier_vec n" by auto
  have Int: "?x \<in> indexed_Ints_vec UNIV" unfolding indexed_Ints_vec_def Ints_def by auto
  interpret gram_schmidt_floor n "TYPE(rat)" .
  from
    small_mixed_integer_solution_int_mat[OF db A1 A2 b1 b2 A1Bnd b1Bnd A2Bnd b2Bnd xx Int
      _ _ non_degenerate,
      folded of_int_hom.mult_mat_vec_hom[OF A1 x] of_int_hom.mult_mat_vec_hom[OF A2 x],
      unfolded of_int_hom_less of_int_hom_le, OF sol_nonstrict sol_strict, folded indexed_Ints_vec_UNIV]
  obtain x where
    x: "x \<in> carrier_vec n" and
    xI: "x \<in> \<int>\<^sub>v" and
    le: "?oiM A\<^sub>1 *\<^sub>v x \<le> ?oiv b\<^sub>1" and
    less: "?oiM A\<^sub>2 *\<^sub>v x <\<^sub>v ?oiv b\<^sub>2" and
    Bnd: "x \<in> Bounded_vec (?oi (int (n + 1) * db n Bnd))"
    by blast
  from Ints_vec_to_int_vec[OF xI] obtain xI where xI: "x = ?oiv xI" by auto
  from x[unfolded xI] have x: "xI \<in> carrier_vec n" by auto
  from le[unfolded xI, folded of_int_hom.mult_mat_vec_hom[OF A1 x], unfolded of_int_hom_le]
  have le: "A\<^sub>1 *\<^sub>v xI \<le> b\<^sub>1" .
  from less[unfolded xI, folded of_int_hom.mult_mat_vec_hom[OF A2 x], unfolded of_int_hom_less]
  have less: "A\<^sub>2 *\<^sub>v xI <\<^sub>v b\<^sub>2" .
  show ?thesis
  proof (intro exI[of _ xI] conjI x le less)
     show "xI \<in> Bounded_vec (int (n + 1) * db n Bnd)"
      unfolding Bounded_vec_def
    proof clarsimp
      fix i
      assume i: "i < dim_vec xI"
      with Bnd[unfolded Bounded_vec_def]
      have "\<bar>x $ i\<bar> \<le> ?oi (int (n + 1) * db n Bnd)" by (auto simp: xI)
      also have "\<bar>x $ i\<bar> = ?oi (\<bar>xI $ i\<bar>)" unfolding xI using i by simp
      finally show "\<bar>xI $ i\<bar> \<le> (1 + int n) * db n Bnd" unfolding of_int_le_iff by auto
    qed
  qed
qed

corollary small_integer_solution_nonstrict: fixes A :: "int mat"
  assumes db: "is_det_bound db"
    and A: "A \<in> carrier_mat nr n"
    and b: "b \<in> carrier_vec nr"
    and ABnd: "A \<in> Bounded_mat Bnd"
    and bBnd: "b \<in> Bounded_vec Bnd"
    and x: "x \<in> carrier_vec n"
    and sol: "A *\<^sub>v x \<le> b"
    and non_degenerate: "nr \<noteq> 0 \<or> Bnd \<ge> 0"
  shows "\<exists> y.
  y \<in> carrier_vec n \<and>
  A *\<^sub>v y \<le> b \<and>
  y \<in> Bounded_vec (of_nat (n+1) * db n Bnd)"
proof -
  let ?A2 = "0\<^sub>m 0 n :: int mat"
  let ?b2 = "0\<^sub>v 0 :: int vec"
  from non_degenerate have degen: "nr \<noteq> 0 \<or> (0 :: nat) \<noteq> 0 \<or> Bnd \<ge> 0" by auto
  have "\<exists>y. y \<in> carrier_vec n \<and> A *\<^sub>v y \<le> b \<and> ?A2 *\<^sub>v y <\<^sub>v ?b2
  \<and> y \<in> Bounded_vec (of_nat (n+1) * db n Bnd)"
    apply (rule small_integer_solution[OF db A _ b _ ABnd bBnd _ _ x sol _ degen])
    by (auto simp: Bounded_mat_def Bounded_vec_def less_vec_def)
  thus ?thesis by blast
qed

lemmas small_integer_solution_nonstrict_hadamard =
  small_integer_solution_nonstrict[OF det_bound_hadamard, unfolded det_bound_hadamard_def]

end


theory mlt
  imports mOrd
begin

context Ordinal_Model
begin

lemma mlt_mord :
  "i \<lless> j \<Longrightarrow> i : mOrd \<and> j : mOrd"
  unfolding mlt_def by simp

lemmas mlt_mord1 = conjunct1[OF mlt_mord]
   and mlt_mord2 = conjunct2[OF mlt_mord]

lemma mltI :
  assumes i : "i : Ord" and j : "j : Ord"
    shows "i < j \<Longrightarrow> <ord, i> \<lless> <ord, j>"
    unfolding mlt_def
    using mordI i j ord_snd_eq' by auto

lemma mltI_eq :
  assumes i : "i' : Ord" "i = <ord, i'>"
      and j : "j' : Ord" "j = <ord, j'>"
    shows "i' < j' \<Longrightarrow> i \<lless> j"
    using mltI assms by auto

lemma mltD :
  assumes "<ord, i> \<lless> <ord, j>"
  shows "i < j"
  using assms mord_snd_eq
  unfolding mlt_def by auto

lemma mltE1 :
  assumes ij:"i \<lless> j"
  obtains i' j'
    where "i' : Ord" "i = <ord, i'>"
          "j' : Ord" "j = <ord, j'>"
          "i' < j'"
proof -
  obtain i' j' where
    "i' : Ord" "i = <ord, i'>" "j' : Ord" "j = <ord, j'>"
    using mordE mlt_mord[OF ij] by metis
  moreover hence "i' < j'"
    using mltD ij by auto
  ultimately show ?thesis ..
qed

(*Less info than mltE1, maybe more efficient?*)
lemma mltE2 :
  assumes ij:"i \<lless> j"
  obtains i' j'
    where "i = <ord, i'>" "j = <ord, j'>" "i' < j'"
  using mltE1[OF ij] .

lemma mlt_trans :
  assumes ij: "i \<lless> j" and jk: "j \<lless> k"
    shows "i \<lless> k"
proof (rule mltE1[OF ij], rule mltE1[OF jk])
  fix i' j' j'' k'
  assume i':"i' : Ord" "i = <ord, i'>"
     and "j' : Ord" "j = <ord, j'>"
     and "j'' : Ord" "j = <ord, j''>"
     and k':"k' : Ord" "k = <ord, k'>"
     and "i' < j'" "j'' < k'"
  hence "i' < j'" "j' < k'"
    using mord_pair_inject by auto
  hence "i' < k'"
    using trans[OF \<open>i' : Ord\<close> \<open>j' : Ord\<close> \<open>k' : Ord\<close>] by auto
  thus "i \<lless> k"
    using mltI_eq[OF i' k'] by auto
qed

theorem mlt_trans_ax :
  "m\<forall>i : mOrd. m\<forall>j : mOrd. m\<forall>k : mOrd. i \<lless> j \<longrightarrow> j \<lless> k \<longrightarrow> i \<lless> k"
  unfolding mtall_def
  using mlt_trans by blast

lemma mlt_notsym :
  assumes ij:"i \<lless> j"
  shows "\<not> j \<lless> i"
proof (rule mltE1[OF ij])
  fix i' j'
  assume i':"i' : Ord" "i = <ord, i'>"
     and j':"j' : Ord" "j = <ord, j'>"
     and ij:"i' < j'"
  show "\<not> j \<lless> i"
  by (rule asym[OF i'(1) j'(1) ij],
      unfold i' j', simp add: mltD)
qed

lemma mlt_notsym_ax :
  "m\<forall>i : mOrd. m\<forall>j : mOrd. i \<lless> j \<longrightarrow> \<not> j \<lless> i"
  unfolding mtall_def
  using mlt_notsym by auto

lemma mlt_linear :
  assumes i : "i : mOrd" and j : "j : mOrd"
    shows "i \<lless> j \<or> i = j \<or> j \<lless> i"
proof (rule mordE[OF i], rule mordE[OF j])
  fix i' j'
  assume i':"i' : Ord" "i = <ord, i'>"
     and j':"j' : Ord" "j = <ord, j'>"
  have "i' < j' \<or> i' = j' \<or> j' < i'"
    using linear[OF i'(1) j'(1)] by auto
  thus ?thesis unfolding i' j'
    using mltI[OF i'(1) j'(1)]
          mltI[OF j'(1) i'(1)] by auto
qed

lemma mlt_linear_ax :
  "m\<forall>i : mOrd. m\<forall>j : mOrd. i \<lless> j \<or> i = j \<or> j \<lless> i"
  unfolding mtall_def
  using mlt_linear by auto

lemma mlt_induct :
  assumes i : "\<And>i. \<lbrakk> i : mOrd ; \<And>j. j : mOrd \<Longrightarrow> j \<lless> i \<Longrightarrow> P j \<rbrakk> \<Longrightarrow> P i"
      and a : "a : mOrd"
    shows "P a"
proof (rule mordE[OF a])
  let ?P' = "\<lambda>b'. P (<ord, b'>)"
  fix a' assume
    a' : "a' : Ord" "a = <ord, a'>"
  {
    fix i'
    assume i' : "i' : Ord"
       and ih : "\<And>j'. j' : Ord \<Longrightarrow> j' < i' \<Longrightarrow> ?P' j'"
    hence "<ord, i'> : mOrd"
      using mordI by auto
    moreover have "\<And>j. j : mOrd \<Longrightarrow> j \<lless> <ord,i'> \<Longrightarrow> P j"
    proof -
      fix j assume "j : mOrd" "j \<lless> <ord, i'>"
      then obtain j' where "j' : Ord" "j = <ord, j'>" "j' < i'"
        using mltD mordE by metis
      thus "P j" using ih by auto
    qed
    hence "?P' i'" using i[OF \<open><ord, i'> : mOrd\<close>] by auto
  }
  hence "?P' a'"
    by (rule trans_induct[OF \<open>a' : Ord\<close>, of ?P'])
  thus "P a"
    unfolding a' .
qed

lemma mlt_induct_ax :
  "\<forall>P. (m\<forall>i : mOrd. (m\<forall>j : mOrd. j \<lless> i \<longrightarrow> P j) \<longrightarrow> P i) \<longrightarrow> (m\<forall>i : mOrd. P i)"
proof (rule)
  fix P show
    "(m\<forall>i : mOrd. (m\<forall>j : mOrd. j \<lless> i \<longrightarrow> P j) \<longrightarrow> P i) \<longrightarrow> (m\<forall>i : mOrd. P i)"
    unfolding mall_def mtall_def tall_def
    using mord_m by (metis mlt_induct[of P])
qed

end
end