section \<open>CONS is a proper subset of LIM\label{s:cons_lim}\<close>

theory CONS_LIM
  imports Inductive_Inference_Basics
begin

text \<open>That there are classes in @{term "LIM - CONS"} was noted by
Barzdin~\cite{b-iiafp-74,b-iiafp-77} and Blum and Blum~\cite{bb-tmtii-75}. It
was proven by Wiehagen~\cite{w-lerfss-76} (see also Wiehagen and
Zeugmann~\cite{wz-idmowle-94}). The proof uses this class:\<close>

definition U_LIMCONS :: "partial1 set" ("U\<^bsub>LIM-CONS\<^esub>") where
  "U\<^bsub>LIM-CONS\<^esub> \<equiv> {vs @ [j] \<odot> p| vs j p. j \<ge> 2 \<and> p \<in> \<R>\<^sub>0\<^sub>1 \<and> \<phi> j = vs @ [j] \<odot> p}"

text \<open>Every function in @{term "U\<^bsub>LIM-CONS\<^esub>"} carries a Gödel number
greater or equal two of itself, after which only zeros and ones occur.
Thus, a strategy that always outputs the rightmost value greater or equal two
in the given prefix will converge to this Gödel number.

The next function searches an encoded list for the rightmost element
greater or equal two.\<close>

definition rmge2 :: partial1 where
  "rmge2 e \<equiv>
    if \<forall>i<e_length e. e_nth e i < 2 then Some 0
    else Some (e_nth e (GREATEST i. i < e_length e \<and> e_nth e i \<ge> 2))"

lemma rmge2:
  assumes "xs = list_decode e"
  shows "rmge2 e =
   (if \<forall>i<length xs. xs ! i < 2 then Some 0
    else Some (xs ! (GREATEST i. i < length xs \<and> xs ! i \<ge> 2)))"
proof -
  have "(i < e_length e \<and> e_nth e i \<ge> 2) = (i < length xs \<and> xs ! i \<ge> 2)" for i
    using assms by simp
  then have "(GREATEST i. i < e_length e \<and> e_nth e i \<ge> 2) =
      (GREATEST i. i < length xs \<and> xs ! i \<ge> 2)"
    by simp
  moreover have "(\<forall>i<length xs. xs ! i < 2) = (\<forall>i<e_length e. e_nth e i < 2)"
    using assms by simp
  moreover have "(GREATEST i. i < length xs \<and> xs ! i \<ge> 2) < length xs" (is "Greatest ?P < _")
      if "\<not> (\<forall>i<length xs. xs ! i < 2)"
    using that GreatestI_ex_nat[of ?P] le_less_linear order.asym by blast
  ultimately show ?thesis using rmge2_def assms by auto
qed

lemma rmge2_init:
  "rmge2 (f \<triangleright> n) =
   (if \<forall>i<Suc n. the (f i) < 2 then Some 0
    else Some (the (f (GREATEST i. i < Suc n \<and> the (f i) \<ge> 2))))"
proof -
  let ?xs = "prefix f n"
  have "f \<triangleright> n = list_encode ?xs" by (simp add: init_def)
  moreover have "(\<forall>i<Suc n. the (f i) < 2) = (\<forall>i<length ?xs. ?xs ! i < 2)"
    by simp
  moreover have "(GREATEST i. i < Suc n \<and> the (f i) \<ge> 2) =
      (GREATEST i. i < length ?xs \<and> ?xs ! i \<ge> 2)"
    using length_prefix[of f n] prefix_nth[of _ n f] by metis
  moreover have "(GREATEST i. i < Suc n \<and> the (f i) \<ge> 2) < Suc n"
      if "\<not> (\<forall>i<Suc n. the (f i) < 2)"
    using that GreatestI_ex_nat[of "\<lambda>i. i<Suc n \<and> the (f i) \<ge> 2" n] by fastforce
  ultimately show ?thesis using rmge2 by auto
qed

corollary rmge2_init_total:
  assumes "total1 f"
  shows "rmge2 (f \<triangleright> n) =
   (if \<forall>i<Suc n. the (f i) < 2 then Some 0
    else f (GREATEST i. i < Suc n \<and> the (f i) \<ge> 2))"
  using assms total1_def rmge2_init by auto

lemma rmge2_in_R1: "rmge2 \<in> \<R>"
proof -
  define g where
    "g = Cn 3 r_ifle [r_constn 2 2, Cn 3 r_nth [Id 3 2, Id 3 0], Cn 3 r_nth [Id 3 2, Id 3 0], Id 3 1]"
  then have "recfn 3 g" by simp
  then have g: "eval g [j, r, e] \<down>= (if 2 \<le> e_nth e j then e_nth e j else r)" for j r e
    using g_def by simp

  let ?h = "Pr 1 Z g"
  have "recfn 2 ?h"
    by (simp add: \<open>recfn 3 g\<close>)
  have h: "eval ?h [j, e] =
   (if \<forall>i<j. e_nth e i < 2 then Some 0
    else Some (e_nth e (GREATEST i. i < j \<and> e_nth e i \<ge> 2)))" for j e
  proof (induction j)
    case 0
    then show ?case using \<open>recfn 2 ?h\<close> by auto
  next
    case (Suc j)
    then have "eval ?h [Suc j, e] = eval g [j, the (eval ?h [j, e]), e]"
      using \<open>recfn 2 ?h\<close> by auto
    then have *: "eval ?h [Suc j, e] \<down>=
      (if 2 \<le> e_nth e j then e_nth e j
       else if \<forall>i<j. e_nth e i < 2 then 0
            else (e_nth e (GREATEST i. i < j \<and> e_nth e i \<ge> 2)))"
      using g Suc by auto
    show ?case
    proof (cases "\<forall>i<Suc j. e_nth e i < 2")
      case True
      then show ?thesis using * by auto
    next
      case ex: False
      show ?thesis
      proof (cases "2 \<le> e_nth e j")
        case True
        then have "eval ?h [Suc j, e] \<down>= e_nth e j"
          using * by simp
        moreover have "(GREATEST i. i < Suc j \<and> e_nth e i \<ge> 2) = j"
          using ex True Greatest_equality[of "\<lambda>i.  i < Suc j \<and> e_nth e i \<ge> 2"]
          by simp
        ultimately show ?thesis using ex by auto
      next
        case False
        then have "\<exists>i<j. e_nth e i \<ge> 2"
          using ex leI less_Suc_eq by blast
        with * have "eval ?h [Suc j, e] \<down>= e_nth e (GREATEST i. i < j \<and> e_nth e i \<ge> 2)"
          using False by (smt leD)
        moreover have "(GREATEST i. i < Suc j \<and> e_nth e i \<ge> 2) =
            (GREATEST i. i < j \<and> e_nth e i \<ge> 2)"
          using False ex by (metis less_SucI less_Suc_eq less_antisym numeral_2_eq_2)
        ultimately show ?thesis using ex by metis
      qed
    qed
  qed

  let ?hh = "Cn 1 ?h [Cn 1 r_length [Id 1 0], Id 1 0]"
  have "recfn 1 ?hh"
    using \<open>recfn 2 ?h\<close> by simp
  with h have hh: "eval ?hh [e] \<down>=
    (if \<forall>i<e_length e. e_nth e i < 2 then 0
     else e_nth e (GREATEST i. i < e_length e \<and> e_nth e i \<ge> 2))" for e
    by auto
  then have "eval ?hh [e] = rmge2 e" for e
    unfolding rmge2_def by auto
  moreover have "total ?hh"
    using hh totalI1 \<open>recfn 1 ?hh\<close> by simp
  ultimately show ?thesis using \<open>recfn 1 ?hh\<close> by blast
qed

text \<open>The first part of the main result is that @{term "U\<^bsub>LIM-CONS\<^esub> \<in> LIM"}.\<close>

lemma U_LIMCONS_in_Lim: "U\<^bsub>LIM-CONS\<^esub> \<in> LIM"
proof -
  have "U\<^bsub>LIM-CONS\<^esub> \<subseteq> \<R>"
    unfolding U_LIMCONS_def using prepend_in_R1 RPred1_subseteq_R1 by blast
  have "learn_lim \<phi> U\<^bsub>LIM-CONS\<^esub> rmge2"
  proof (rule learn_limI)
    show "environment \<phi> U\<^bsub>LIM-CONS\<^esub> rmge2"
      using \<open>U_LIMCONS \<subseteq> \<R>\<close> phi_in_P2 rmge2_def rmge2_in_R1 by simp
    show "\<exists>i. \<phi> i = f \<and> (\<forall>\<^sup>\<infinity>n. rmge2 (f \<triangleright> n) \<down>= i)" if "f \<in> U\<^bsub>LIM-CONS\<^esub>" for f
    proof -
      from that obtain vs j p where
        j: "j \<ge> 2"
        and p: "p \<in> \<R>\<^sub>0\<^sub>1"
        and s: "\<phi> j = vs @ [j] \<odot> p"
        and f: "f = vs @ [j] \<odot> p"
        unfolding U_LIMCONS_def by auto
      then have "\<phi> j = f" by simp
      from that have "total1 f"
        using \<open>U\<^bsub>LIM-CONS\<^esub> \<subseteq> \<R>\<close> R1_imp_total1 total1_def by auto
      define n\<^sub>0 where "n\<^sub>0 = length vs"
      have f_gr_n0: "f n \<down>= 0 \<or> f n \<down>= 1" if "n > n\<^sub>0" for n
      proof -
        have "f n = p (n - n\<^sub>0 - 1)"
          using that n\<^sub>0_def f by simp
        with RPred1_def p show ?thesis by auto
      qed
      have "rmge2 (f \<triangleright> n) \<down>= j" if "n \<ge> n\<^sub>0" for n
      proof -
        have n0_greatest: "(GREATEST i. i < Suc n \<and> the (f i) \<ge> 2) = n\<^sub>0"
        proof (rule Greatest_equality)
          show "n\<^sub>0 < Suc n \<and> the (f n\<^sub>0) \<ge> 2"
            using n\<^sub>0_def f that j by simp
          show "\<And>y. y < Suc n \<and> the (f y) \<ge> 2 \<Longrightarrow> y \<le> n\<^sub>0"
          proof -
            fix y assume "y < Suc n \<and> 2 \<le> the (f y)"
            moreover have "p \<in> \<R> \<and> (\<forall>n. p n \<down>= 0 \<or> p n \<down>= 1)"
              using RPred1_def p by blast
            ultimately show "y \<le> n\<^sub>0"
              using f_gr_n0
              by (metis Suc_1 Suc_n_not_le_n Zero_neq_Suc le_less_linear le_zero_eq option.sel)
          qed
        qed
        have "f n\<^sub>0 \<down>= j"
          using n\<^sub>0_def f by simp
        then have "\<not> (\<forall>i<Suc n. the (f i) < 2)"
          using j that less_Suc_eq_le by auto
        then have "rmge2 (f \<triangleright> n) = f (GREATEST i. i < Suc n \<and> the (f i) \<ge> 2)"
          using rmge2_init_total \<open>total1 f\<close> by auto
        with n0_greatest \<open>f n\<^sub>0 \<down>= j\<close> show ?thesis by simp
      qed
      with \<open>\<phi> j = f\<close> show ?thesis by auto
    qed
  qed
  then show ?thesis using Lim_def by auto
qed

text \<open>The class @{term "U_LIMCONS"} is \emph{prefix-complete}, which
means that every non-empty list is the prefix of some function in @{term
"U_LIMCONS"}. To show this we use an auxiliary lemma: For every $f \in
\mathcal{R}$ and $k \in \mathbb{N}$ the value of $f$ at $k$ can be replaced
by a Gödel number of the function resulting from the replacement.\<close>

lemma goedel_at:
  fixes m :: nat and k :: nat
  assumes "f \<in> \<R>"
  shows "\<exists>n\<ge>m. \<phi> n = (\<lambda>x. if x = k then Some n else f x)"
proof -
  define psi :: "partial1 \<Rightarrow> nat \<Rightarrow> partial2" where
    "psi = (\<lambda>f k i x. (if x = k then Some i else f x))"
  have "psi f k \<in> \<R>\<^sup>2"
  proof -
    obtain r where r: "recfn 1 r" "total r" "eval r [x] = f x" for x
      using assms by auto
    define r_psi where
      "r_psi = Cn 2 r_ifeq [Id 2 1, r_dummy 1 (r_const k), Id 2 0, Cn 2 r [Id 2 1]]"
    show ?thesis
    proof (rule R2I[of r_psi])
      from r_psi_def show "recfn 2 r_psi"
        using r(1) by simp
      have "eval r_psi [i, x] = (if x = k then Some i else f x)" for i x
      proof -
        have "eval (Cn 2 r [Id 2 1]) [i, x] = f x"
          using r by simp
        then have "eval r_psi [i, x] = eval r_ifeq [x, k, i, the (f x)]"
          unfolding r_psi_def using \<open>recfn 2 r_psi\<close> r R1_imp_total1[OF assms]
          by simp
        then show ?thesis using assms by simp
      qed
      then show "\<And>x y. eval r_psi [x, y] = psi f k x y"
        unfolding psi_def by simp
      then show "total r_psi"
        using totalI2[of r_psi] \<open>recfn 2 r_psi\<close> assms psi_def by fastforce
    qed
  qed
  then obtain n where "n \<ge> m" "\<phi> n = psi f k n"
    using assms kleene_fixed_point[of "psi f k" m] by auto
  then show ?thesis unfolding psi_def by auto
qed

lemma U_LIMCONS_prefix_complete:
  assumes "length vs > 0"
  shows "\<exists>f\<in>U\<^bsub>LIM-CONS\<^esub>. prefix f (length vs - 1) = vs"
proof -
  let ?p = "\<lambda>_. Some 0"
  let ?f = "vs @ [0] \<odot> ?p"
  have "?f \<in> \<R>"
    using prepend_in_R1 RPred1_subseteq_R1 const0_in_RPred1 by blast
  with goedel_at[of ?f 2 "length vs"] obtain j where
    j: "j \<ge> 2" "\<phi> j = (\<lambda>x. if x = length vs then Some j else ?f x)" (is "_ = ?g")
    by auto
  moreover have g: "?g x = (vs @ [j] \<odot> ?p) x" for x
    by (simp add: nth_append)
  ultimately have "?g \<in> U\<^bsub>LIM-CONS\<^esub>"
    unfolding U_LIMCONS_def using const0_in_RPred1 by fastforce
  moreover have "prefix ?g (length vs - 1) = vs"
    using g assms prefixI prepend_associative by auto
  ultimately show ?thesis by auto
qed

text \<open>Roughly speaking, a strategy learning a prefix-complete class
must be total because it must be defined for every prefix in
the class. Technically, however, the empty list is not a prefix, and thus a
strategy may diverge on input 0. We can work around this by
showing that if there is a strategy learning a prefix-complete class then
there is also a total strategy learning this class. We need the result only
for consistent learning.\<close>

lemma U_prefix_complete_imp_total_strategy:
  assumes "\<And>vs. length vs > 0 \<Longrightarrow> \<exists>f\<in>U. prefix f (length vs - 1) = vs"
    and "learn_cons \<psi> U s"
  shows "\<exists>t. total1 t \<and> learn_cons \<psi> U t"
proof -
  define t where "t = (\<lambda>e. if e = 0 then Some 0 else s e)"
  have "s e \<down>" if "e > 0" for e
  proof -
    from that have "list_decode e \<noteq> []" (is "?vs \<noteq> _")
      using list_encode_0 list_encode_decode by (metis less_imp_neq)
    then have "length ?vs > 0" by simp
    with assms(1) obtain f where f: "f \<in> U" "prefix f (length ?vs - 1) = ?vs"
      by auto
    with learn_cons_def learn_limE have "s (f \<triangleright> (length ?vs - 1)) \<down>"
      using assms(2) by auto
    then show "s e \<down>"
      using f(2) init_def by auto
  qed
  then have "total1 t"
    using t_def by auto
  have "t \<in> \<P>"
  proof -
    from assms(2) have "s \<in> \<P>"
      using learn_consE by simp
    then obtain rs where rs: "recfn 1 rs" "eval rs [x] = s x" for x
      by auto
    define rt where "rt = Cn 1 (r_lifz Z rs) [Id 1 0, Id 1 0]"
    then have "recfn 1 rt"
      using rs by auto
    moreover have "eval rt [x] = t x" for x
      using rs rt_def t_def by simp
    ultimately show ?thesis by blast
  qed
  have "s (f \<triangleright> n) = t (f \<triangleright> n)" if "f \<in> U" for f n
    unfolding t_def by (simp add: init_neq_zero)
  then have "learn_cons \<psi> U t"
    using \<open>t \<in> \<P>\<close> assms(2) learn_consE[of \<psi> U s] learn_consI[of \<psi> U t] by simp
  with \<open>total1 t\<close> show ?thesis by auto
qed

text \<open>The proof of @{prop "U\<^bsub>LIM-CONS\<^esub> \<notin> CONS"} is by contradiction.
Assume there is a consistent learning strategy $S$. By the previous
lemma $S$ can be assumed to be total. Moreover it outputs a consistent
hypothesis for every prefix. Thus for every $e \in \mathbb{N}^+$, $S(e) \neq
S(e0)$ or $S(e) \neq S(e1)$ because $S(e)$ cannot be consistent with both
$e0$ and $e1$. We use this property of $S$ to construct a function in @{term
"U\<^bsub>LIM-CONS\<^esub>"} for which $S$ fails as a learning strategy. To
this end we define a numbering $\psi \in \mathcal{R}^2$ with $\psi_i(0) = i$
and
\[
\psi_i(x + 1) = \left\{\begin{array}{ll}
    0 & \mbox{if } S(\psi_i^x0) \neq S(\psi_i^x),\\
    1 & \mbox{otherwise}.
\end{array}\right.
\]
This numbering is recursive because $S$ is total. The ``otherwise'' case is
equivalent to $S(\psi_i^x1) \neq S(\psi_i^x)$ because $S(\psi_i^x)$ cannot be
consistent with both $\psi_i^x0$ and $\psi_i^x1$. Therefore every prefix
$\psi_i^x$ is extended in such a way that $S$ changes its hypothesis. Hence
$S$ does not learn $\psi_i$ in the limit. Kleene's fixed-point theorem
ensures that for some $j \geq 2$, $\varphi_j = \psi_j$. This $\psi_j$ is the
sought function in @{term "U\<^bsub>LIM-CONS\<^esub>"}.

The following locale formalizes the construction of $\psi$ for a total
strategy $S$.\<close>

locale cons_lim =
  fixes s :: partial1
  assumes s_in_R1: "s \<in> \<R>"
begin

text \<open>A @{typ recf} computing the strategy:\<close>

definition r_s :: recf where
  "r_s \<equiv> SOME r_s. recfn 1 r_s \<and>  total r_s \<and> s = (\<lambda>x. eval r_s [x])"

lemma r_s_recfn [simp]: "recfn 1 r_s"
  and r_s_total [simp]: "\<And>x. eval r_s [x] \<down>"
  and eval_r_s: "s = (\<lambda>x. eval r_s [x])"
  using r_s_def R1_SOME[OF s_in_R1, of r_s] by simp_all

text \<open>The next function represents the prefixes of $\psi_i$.\<close>

fun prefixes :: "nat \<Rightarrow> nat \<Rightarrow> nat list" where
  "prefixes i 0 = [i]"
| "prefixes i (Suc x) = (prefixes i x) @
    [if s (e_snoc (list_encode (prefixes i x)) 0) = s (list_encode (prefixes i x))
     then 1 else 0]"

definition "r_prefixes_aux \<equiv>
  Cn 3 r_ifeq
   [Cn 3 r_s [Cn 3 r_snoc [Id 3 1, r_constn 2 0]],
    Cn 3 r_s [Id 3 1],
    Cn 3 r_snoc [Id 3 1, r_constn 2 1],
    Cn 3 r_snoc [Id 3 1, r_constn 2 0]]"

lemma r_prefixes_aux_recfn: "recfn 3 r_prefixes_aux"
  unfolding r_prefixes_aux_def by simp

definition "r_prefixes \<equiv> r_swap (Pr 1 r_singleton_encode r_prefixes_aux)"

lemma r_prefixes: "eval r_prefixes [i, n] \<down>= list_encode (prefixes i n)"
proof -
  let ?h = "Pr 1 r_singleton_encode r_prefixes_aux"
  have "eval ?h [n, i] \<down>= list_encode (prefixes i n)"
  proof (induction n)
    case 0
    then show ?case
      using r_prefixes_def r_prefixes_aux_recfn r_singleton_encode by simp
  next
    case (Suc n)
    then show ?case
      using r_prefixes_aux_recfn r_prefixes_aux eval_r_s
      by auto metis+
  qed
  moreover have "eval ?h [n, i] = eval r_prefixes [i, n]" for i n
    unfolding r_prefixes_def by (simp add: r_prefixes_aux_recfn)
  ultimately show ?thesis by simp
qed

lemma prefixes_neq_nil: "length (prefixes i x) > 0"
  by (induction x) auto

text \<open>The actual numbering can then be defined via @{term prefixes}.\<close>

definition psi :: "partial2" ("\<psi>") where
  "\<psi> i x \<equiv> Some (last (prefixes i x))"

lemma psi_in_R2: "\<psi> \<in> \<R>\<^sup>2"
proof
  define r_psi where "r_psi \<equiv> Cn 2 r_last [r_prefixes]"
  have "recfn 2 r_psi"
    unfolding r_psi_def by (simp add: r_prefixes_recfn)
  then have "eval r_psi [i, n] \<down>= last (prefixes i n)" for n i
    unfolding r_psi_def using r_prefixes r_prefixes_recfn prefixes_neq_nil by simp
  then have "(\<lambda>i x. Some (last (prefixes i x))) \<in> \<P>\<^sup>2"
    using \<open>recfn 2 r_psi\<close> P2I[of "r_psi"] by simp
  with psi_def show "\<psi> \<in> \<P>\<^sup>2" by presburger
  moreover show "total2 psi"
    unfolding psi_def by auto
qed

lemma psi_0_or_1:
  assumes "n > 0"
  shows "\<psi> i n \<down>= 0 \<or> \<psi> i n \<down>= 1"
proof -
  from assms obtain m where "n = Suc m"
    using gr0_implies_Suc by blast
  then have "last (prefixes i (Suc m)) = 0 \<or> last (prefixes i (Suc m)) = 1"
    by simp
  then show ?thesis using \<open>n = Suc m\<close> psi_def by simp
qed

text \<open>The function @{term "prefixes"} does indeed provide the prefixes
for @{term "\<psi>"}.\<close>

lemma psi_init: "(\<psi> i) \<triangleright> x = list_encode (prefixes i x)"
proof -
  have "prefix (\<psi> i) x = prefixes i x"
    unfolding psi_def
    by (induction x) (simp_all add: prefix_0 prefix_Suc)
  with init_def show ?thesis by simp
qed

text \<open>One of the functions $\psi_i$ is in @{term "U\<^bsub>LIM-CONS\<^esub>"}.\<close>

lemma ex_psi_in_U: "\<exists>j. \<psi> j \<in> U\<^bsub>LIM-CONS\<^esub>"
proof -
  obtain j where j: "j \<ge> 2" "\<psi> j = \<phi> j"
    using kleene_fixed_point[of \<psi>] psi_in_R2 R2_imp_P2 by metis
  then have "\<psi> j \<in> \<P>" by (simp add: phi_in_P2)
  define p where "p = (\<lambda>x. \<psi> j (x + 1))"
  have "p \<in> \<R>\<^sub>0\<^sub>1"
  proof -
    from p_def \<open>\<psi> j \<in> \<P>\<close> skip_P1 have "p \<in> \<P>" by blast
    from psi_in_R2 have "total1 (\<psi> j)" by simp
    with p_def have "total1 p"
      by (simp add: total1_def)
    with psi_0_or_1 have "p n \<down>= 0 \<or> p n \<down>= 1" for n
      using psi_def p_def by simp
    then show ?thesis
      by (simp add: RPred1_def P1_total_imp_R1 \<open>p \<in> \<P>\<close> \<open>total1 p\<close>)
  qed
  moreover have "\<psi> j = [j] \<odot> p"
  proof
    fix x
    show "\<psi> j x = ([j] \<odot> p) x"
    proof (cases "x = 0")
      case True
      then show ?thesis using psi_def psi_def prepend_at_less by simp
    next
      case False
      then show ?thesis using p_def by simp
    qed
  qed
  ultimately have "\<psi> j \<in> U\<^bsub>LIM-CONS\<^esub>"
    using j U_LIMCONS_def by (metis (mono_tags, lifting) append_Nil mem_Collect_eq)
  then show ?thesis by auto
qed

text \<open>The strategy fails to learn @{term U_LIMCONS} because it changes
its hypothesis all the time on functions $\psi_j \in V_0$.\<close>

lemma U_LIMCONS_not_learn_cons: "\<not> learn_cons \<phi> U\<^bsub>LIM-CONS\<^esub> s"
proof
  assume learn: "learn_cons \<phi> U\<^bsub>LIM-CONS\<^esub> s"
  have "s (list_encode (vs @ [0])) \<noteq> s (list_encode (vs @ [1]))" for vs
  proof -
    obtain f\<^sub>0 where f0: "f\<^sub>0 \<in> U\<^bsub>LIM-CONS\<^esub>" "prefix f\<^sub>0 (length vs) = vs @ [0]"
      using U_LIMCONS_prefix_complete[of "vs @ [0]"] by auto
    obtain f\<^sub>1 where f1: "f\<^sub>1 \<in> U\<^bsub>LIM-CONS\<^esub>" "prefix f\<^sub>1 (length vs) = vs @ [1]"
      using U_LIMCONS_prefix_complete[of "vs @ [1]"] by auto
    have "f\<^sub>0 (length vs) \<noteq> f\<^sub>1 (length vs)"
      using f0 f1 by (metis lessI nth_append_length prefix_nth zero_neq_one)
    moreover have "\<phi> (the (s (f\<^sub>0 \<triangleright> length vs))) (length vs) = f\<^sub>0 (length vs)"
      using learn_consE(3)[of \<phi> U_LIMCONS s, OF learn, of f\<^sub>0 "length vs", OF f0(1)]
      by simp
    moreover have "\<phi> (the (s (f\<^sub>1 \<triangleright> length vs))) (length vs) = f\<^sub>1 (length vs)"
      using learn_consE(3)[of \<phi> U_LIMCONS s, OF learn, of f\<^sub>1 "length vs", OF f1(1)]
      by simp
    ultimately have "the (s (f\<^sub>0 \<triangleright> length vs)) \<noteq> the (s (f\<^sub>1 \<triangleright> length vs))"
      by auto
    then have "s (f\<^sub>0 \<triangleright> length vs) \<noteq> s (f\<^sub>1 \<triangleright> length vs)"
      by auto
    with f0(2) f1(2) show ?thesis by (simp add: init_def)
  qed
  then have "s (list_encode (vs @ [0])) \<noteq> s (list_encode vs) \<or>
      s (list_encode (vs @ [1])) \<noteq> s (list_encode vs)"
      for vs
    by metis
  then have "s (list_encode (prefixes i (Suc x))) \<noteq> s (list_encode (prefixes i x))" for i x
    by simp
  then have "\<not> learn_lim \<phi> {\<psi> i} s" for i
    using psi_def psi_init always_hyp_change_not_Lim by simp
  then have "\<not> learn_lim \<phi> U_LIMCONS s"
    using ex_psi_in_U learn_lim_closed_subseteq by blast
  then show False
    using learn learn_cons_def by simp
qed

end

text \<open>With the locale we can now show the second part of the main
result:\<close>

lemma U_LIMCONS_not_in_CONS: "U\<^bsub>LIM-CONS\<^esub> \<notin> CONS"
proof
  assume "U\<^bsub>LIM-CONS\<^esub> \<in> CONS"
  then have "U\<^bsub>LIM-CONS\<^esub> \<in> CONS_wrt \<phi>"
    by (simp add: CONS_wrt_phi_eq_CONS)
  then obtain almost_s where "learn_cons \<phi> U\<^bsub>LIM-CONS\<^esub> almost_s"
    using CONS_wrt_def by auto
  then obtain s where s: "total1 s" "learn_cons \<phi> U\<^bsub>LIM-CONS\<^esub> s"
    using U_LIMCONS_prefix_complete U_prefix_complete_imp_total_strategy by blast
  then have "s \<in> \<R>"
    using learn_consE(1) P1_total_imp_R1 by blast
  with cons_lim_def interpret cons_lim s by simp
  show False
    using s(2) U_LIMCONS_not_learn_cons by simp
qed

text \<open>The main result of this section:\<close>

theorem CONS_subset_Lim: "CONS \<subset> LIM"
  using U_LIMCONS_in_Lim U_LIMCONS_not_in_CONS CONS_subseteq_Lim by auto

end


(*  Title:      ZF/Constructible/Rank.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
*)

section \<open>Absoluteness for Order Types, Rank Functions and Well-Founded
         Relations\<close>

theory Rank imports WF_absolute begin

subsection \<open>Order Types: A Direct Construction by Replacement\<close>

locale M_ordertype = M_basic +
assumes well_ord_iso_separation:
     "[| M(A); M(f); M(r) |]
      ==> separation (M, \<lambda>x. x\<in>A \<longrightarrow> (\<exists>y[M]. (\<exists>p[M].
                     fun_apply(M,f,x,y) & pair(M,y,x,p) & p \<in> r)))"
  and obase_separation:
     \<comment>\<open>part of the order type formalization\<close>
     "[| M(A); M(r) |]
      ==> separation(M, \<lambda>a. \<exists>x[M]. \<exists>g[M]. \<exists>mx[M]. \<exists>par[M].
             ordinal(M,x) & membership(M,x,mx) & pred_set(M,A,a,r,par) &
             order_isomorphism(M,par,r,x,mx,g))"
  and obase_equals_separation:
     "[| M(A); M(r) |]
      ==> separation (M, \<lambda>x. x\<in>A \<longrightarrow> ~(\<exists>y[M]. \<exists>g[M].
                              ordinal(M,y) & (\<exists>my[M]. \<exists>pxr[M].
                              membership(M,y,my) & pred_set(M,A,x,r,pxr) &
                              order_isomorphism(M,pxr,r,y,my,g))))"
  and omap_replacement:
     "[| M(A); M(r) |]
      ==> strong_replacement(M,
             \<lambda>a z. \<exists>x[M]. \<exists>g[M]. \<exists>mx[M]. \<exists>par[M].
             ordinal(M,x) & pair(M,a,x,z) & membership(M,x,mx) &
             pred_set(M,A,a,r,par) & order_isomorphism(M,par,r,x,mx,g))"

text\<open>Inductive argument for Kunen's Lemma I 6.1, etc.
      Simple proof from Halmos, page 72\<close>
lemma  (in M_ordertype) wellordered_iso_subset_lemma:
     "[| wellordered(M,A,r);  f \<in> ord_iso(A,r, A',r);  A'<= A;  y \<in> A;
       M(A);  M(f);  M(r) |] ==> ~ <f`y, y> \<in> r"
apply (unfold wellordered_def ord_iso_def)
apply (elim conjE CollectE)
apply (erule wellfounded_on_induct, assumption+)
 apply (insert well_ord_iso_separation [of A f r])
 apply (simp, clarify)
apply (drule_tac a = x in bij_is_fun [THEN apply_type], assumption, blast)
done

text\<open>Kunen's Lemma I 6.1, page 14:
      there's no order-isomorphism to an initial segment of a well-ordering\<close>
lemma (in M_ordertype) wellordered_iso_predD:
     "[| wellordered(M,A,r);  f \<in> ord_iso(A, r, Order.pred(A,x,r), r);
       M(A);  M(f);  M(r) |] ==> x \<notin> A"
apply (rule notI)
apply (frule wellordered_iso_subset_lemma, assumption)
apply (auto elim: predE)
(*Now we know  ~ (f`x < x) *)
apply (drule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], assumption)
(*Now we also know f`x  \<in> pred(A,x,r);  contradiction! *)
apply (simp add: Order.pred_def)
done

lemma (in M_ordertype) wellordered_iso_pred_eq_lemma:
     "[| f \<in> \<langle>Order.pred(A,y,r), r\<rangle> \<cong> \<langle>Order.pred(A,x,r), r\<rangle>;
       wellordered(M,A,r); x\<in>A; y\<in>A; M(A); M(f); M(r) |] ==> <x,y> \<notin> r"
apply (frule wellordered_is_trans_on, assumption)
apply (rule notI)
apply (drule_tac x2=y and x=x and r2=r in
         wellordered_subset [OF _ pred_subset, THEN wellordered_iso_predD])
apply (simp add: trans_pred_pred_eq)
apply (blast intro: predI dest: transM)+
done

text\<open>Simple consequence of Lemma 6.1\<close>
lemma (in M_ordertype) wellordered_iso_pred_eq:
     "[| wellordered(M,A,r);
       f \<in> ord_iso(Order.pred(A,a,r), r, Order.pred(A,c,r), r);
       M(A);  M(f);  M(r);  a\<in>A;  c\<in>A |] ==> a=c"
apply (frule wellordered_is_trans_on, assumption)
apply (frule wellordered_is_linear, assumption)
apply (erule_tac x=a and y=c in linearE, auto)
apply (drule ord_iso_sym)
(*two symmetric cases*)
apply (blast dest: wellordered_iso_pred_eq_lemma)+
done

text\<open>Following Kunen's Theorem I 7.6, page 17.  Note that this material is
not required elsewhere.\<close>

text\<open>Can't use \<open>well_ord_iso_preserving\<close> because it needs the
strong premise @{term "well_ord(A,r)"}\<close>
lemma (in M_ordertype) ord_iso_pred_imp_lt:
     "[| f \<in> ord_iso(Order.pred(A,x,r), r, i, Memrel(i));
         g \<in> ord_iso(Order.pred(A,y,r), r, j, Memrel(j));
         wellordered(M,A,r);  x \<in> A;  y \<in> A; M(A); M(r); M(f); M(g); M(j);
         Ord(i); Ord(j); \<langle>x,y\<rangle> \<in> r |]
      ==> i < j"
apply (frule wellordered_is_trans_on, assumption)
apply (frule_tac y=y in transM, assumption)
apply (rule_tac i=i and j=j in Ord_linear_lt, auto)
txt\<open>case @{term "i=j"} yields a contradiction\<close>
 apply (rule_tac x1=x and A1="Order.pred(A,y,r)" in
          wellordered_iso_predD [THEN notE])
   apply (blast intro: wellordered_subset [OF _ pred_subset])
  apply (simp add: trans_pred_pred_eq)
  apply (blast intro: Ord_iso_implies_eq ord_iso_sym ord_iso_trans)
 apply (simp_all add: pred_iff pred_closed converse_closed comp_closed)
txt\<open>case @{term "j<i"} also yields a contradiction\<close>
apply (frule restrict_ord_iso2, assumption+)
apply (frule ord_iso_sym [THEN ord_iso_is_bij, THEN bij_is_fun])
apply (frule apply_type, blast intro: ltD)
  \<comment>\<open>thus @{term "converse(f)`j \<in> Order.pred(A,x,r)"}\<close>
apply (simp add: pred_iff)
apply (subgoal_tac
       "\<exists>h[M]. h \<in> ord_iso(Order.pred(A,y,r), r,
                               Order.pred(A, converse(f)`j, r), r)")
 apply (clarify, frule wellordered_iso_pred_eq, assumption+)
 apply (blast dest: wellordered_asym)
apply (intro rexI)
 apply (blast intro: Ord_iso_implies_eq ord_iso_sym ord_iso_trans)+
done

lemma ord_iso_converse1:
     "[| f: ord_iso(A,r,B,s);  <b, f`a>: s;  a:A;  b:B |]
      ==> <converse(f) ` b, a> \<in> r"
apply (frule ord_iso_converse, assumption+)
apply (blast intro: ord_iso_is_bij [THEN bij_is_fun, THEN apply_funtype])
apply (simp add: left_inverse_bij [OF ord_iso_is_bij])
done

definition
  obase :: "[i=>o,i,i] => i" where
       \<comment>\<open>the domain of \<open>om\<close>, eventually shown to equal \<open>A\<close>\<close>
   "obase(M,A,r) == {a\<in>A. \<exists>x[M]. \<exists>g[M]. Ord(x) &
                          g \<in> ord_iso(Order.pred(A,a,r),r,x,Memrel(x))}"

definition
  omap :: "[i=>o,i,i,i] => o" where
    \<comment>\<open>the function that maps wosets to order types\<close>
   "omap(M,A,r,f) ==
        \<forall>z[M].
         z \<in> f \<longleftrightarrow> (\<exists>a\<in>A. \<exists>x[M]. \<exists>g[M]. z = <a,x> & Ord(x) &
                        g \<in> ord_iso(Order.pred(A,a,r),r,x,Memrel(x)))"

definition
  otype :: "[i=>o,i,i,i] => o" where \<comment>\<open>the order types themselves\<close>
   "otype(M,A,r,i) == \<exists>f[M]. omap(M,A,r,f) & is_range(M,f,i)"

text\<open>Can also be proved with the premise @{term "M(z)"} instead of
      @{term "M(f)"}, but that version is less useful.  This lemma
      is also more useful than the definition, \<open>omap_def\<close>.\<close>
lemma (in M_ordertype) omap_iff:
     "[| omap(M,A,r,f); M(A); M(f) |]
      ==> z \<in> f \<longleftrightarrow>
          (\<exists>a\<in>A. \<exists>x[M]. \<exists>g[M]. z = <a,x> & Ord(x) &
                                g \<in> ord_iso(Order.pred(A,a,r),r,x,Memrel(x)))"
apply (simp add: omap_def Memrel_closed pred_closed)
apply (rule iffI)
 apply (drule_tac [2] x=z in rspec)
 apply (drule_tac x=z in rspec)
 apply (blast dest: transM)+
done

lemma (in M_ordertype) omap_unique:
     "[| omap(M,A,r,f); omap(M,A,r,f'); M(A); M(r); M(f); M(f') |] ==> f' = f"
apply (rule equality_iffI)
apply (simp add: omap_iff)
done

lemma (in M_ordertype) omap_yields_Ord:
     "[| omap(M,A,r,f); \<langle>a,x\<rangle> \<in> f; M(a); M(x) |]  ==> Ord(x)"
  by (simp add: omap_def)

lemma (in M_ordertype) otype_iff:
     "[| otype(M,A,r,i); M(A); M(r); M(i) |]
      ==> x \<in> i \<longleftrightarrow>
          (M(x) & Ord(x) &
           (\<exists>a\<in>A. \<exists>g[M]. g \<in> ord_iso(Order.pred(A,a,r),r,x,Memrel(x))))"
apply (auto simp add: omap_iff otype_def)
 apply (blast intro: transM)
apply (rule rangeI)
apply (frule transM, assumption)
apply (simp add: omap_iff, blast)
done

lemma (in M_ordertype) otype_eq_range:
     "[| omap(M,A,r,f); otype(M,A,r,i); M(A); M(r); M(f); M(i) |]
      ==> i = range(f)"
apply (auto simp add: otype_def omap_iff)
apply (blast dest: omap_unique)
done

lemma (in M_ordertype) Ord_otype:
     "[| otype(M,A,r,i); trans[A](r); M(A); M(r); M(i) |] ==> Ord(i)"
apply (rule OrdI)
prefer 2
    apply (simp add: Ord_def otype_def omap_def)
    apply clarify
    apply (frule pair_components_in_M, assumption)
    apply blast
apply (auto simp add: Transset_def otype_iff)
  apply (blast intro: transM)
 apply (blast intro: Ord_in_Ord)
apply (rename_tac y a g)
apply (frule ord_iso_sym [THEN ord_iso_is_bij, THEN bij_is_fun,
                          THEN apply_funtype],  assumption)
apply (rule_tac x="converse(g)`y" in bexI)
 apply (frule_tac a="converse(g) ` y" in ord_iso_restrict_pred, assumption)
apply (safe elim!: predE)
apply (blast intro: restrict_ord_iso ord_iso_sym ltI dest: transM)
done

lemma (in M_ordertype) domain_omap:
     "[| omap(M,A,r,f);  M(A); M(r); M(B); M(f) |]
      ==> domain(f) = obase(M,A,r)"
apply (simp add: domain_closed obase_def)
apply (rule equality_iffI)
apply (simp add: domain_iff omap_iff, blast)
done

lemma (in M_ordertype) omap_subset:
     "[| omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(B); M(i) |] ==> f \<subseteq> obase(M,A,r) * i"
apply clarify
apply (simp add: omap_iff obase_def)
apply (force simp add: otype_iff)
done

lemma (in M_ordertype) omap_funtype:
     "[| omap(M,A,r,f); otype(M,A,r,i);
         M(A); M(r); M(f); M(i) |] ==> f \<in> obase(M,A,r) -> i"
apply (simp add: domain_omap omap_subset Pi_iff function_def omap_iff)
apply (blast intro: Ord_iso_implies_eq ord_iso_sym ord_iso_trans)
done

lemma (in M_ordertype) wellordered_omap_bij:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(i) |] ==> f \<in> bij(obase(M,A,r),i)"
apply (insert omap_funtype [of A r f i])
apply (auto simp add: bij_def inj_def)
prefer 2  apply (blast intro: fun_is_surj dest: otype_eq_range)
apply (frule_tac a=w in apply_Pair, assumption)
apply (frule_tac a=x in apply_Pair, assumption)
apply (simp add: omap_iff)
apply (blast intro: wellordered_iso_pred_eq ord_iso_sym ord_iso_trans)
done

text\<open>This is not the final result: we must show @{term "oB(A,r) = A"}\<close>
lemma (in M_ordertype) omap_ord_iso:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(i) |] ==> f \<in> ord_iso(obase(M,A,r),r,i,Memrel(i))"
apply (rule ord_isoI)
 apply (erule wellordered_omap_bij, assumption+)
apply (insert omap_funtype [of A r f i], simp)
apply (frule_tac a=x in apply_Pair, assumption)
apply (frule_tac a=y in apply_Pair, assumption)
apply (auto simp add: omap_iff)
 txt\<open>direction 1: assuming @{term "\<langle>x,y\<rangle> \<in> r"}\<close>
 apply (blast intro: ltD ord_iso_pred_imp_lt)
 txt\<open>direction 2: proving @{term "\<langle>x,y\<rangle> \<in> r"} using linearity of @{term r}\<close>
apply (rename_tac x y g ga)
apply (frule wellordered_is_linear, assumption,
       erule_tac x=x and y=y in linearE, assumption+)
txt\<open>the case @{term "x=y"} leads to immediate contradiction\<close>
apply (blast elim: mem_irrefl)
txt\<open>the case @{term "\<langle>y,x\<rangle> \<in> r"}: handle like the opposite direction\<close>
apply (blast dest: ord_iso_pred_imp_lt ltD elim: mem_asym)
done

lemma (in M_ordertype) Ord_omap_image_pred:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(i); b \<in> A |] ==> Ord(f `` Order.pred(A,b,r))"
apply (frule wellordered_is_trans_on, assumption)
apply (rule OrdI)
        prefer 2 apply (simp add: image_iff omap_iff Ord_def, blast)
txt\<open>Hard part is to show that the image is a transitive set.\<close>
apply (simp add: Transset_def, clarify)
apply (simp add: image_iff pred_iff apply_iff [OF omap_funtype [of A r f i]])
apply (rename_tac c j, clarify)
apply (frule omap_funtype [of A r f, THEN apply_funtype], assumption+)
apply (subgoal_tac "j \<in> i")
        prefer 2 apply (blast intro: Ord_trans Ord_otype)
apply (subgoal_tac "converse(f) ` j \<in> obase(M,A,r)")
        prefer 2
        apply (blast dest: wellordered_omap_bij [THEN bij_converse_bij,
                                      THEN bij_is_fun, THEN apply_funtype])
apply (rule_tac x="converse(f) ` j" in bexI)
 apply (simp add: right_inverse_bij [OF wellordered_omap_bij])
apply (intro predI conjI)
 apply (erule_tac b=c in trans_onD)
 apply (rule ord_iso_converse1 [OF omap_ord_iso [of A r f i]])
apply (auto simp add: obase_def)
done

lemma (in M_ordertype) restrict_omap_ord_iso:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       D \<subseteq> obase(M,A,r); M(A); M(r); M(f); M(i) |]
      ==> restrict(f,D) \<in> (\<langle>D,r\<rangle> \<cong> \<langle>f``D, Memrel(f``D)\<rangle>)"
apply (frule ord_iso_restrict_image [OF omap_ord_iso [of A r f i]],
       assumption+)
apply (drule ord_iso_sym [THEN subset_ord_iso_Memrel])
apply (blast dest: subsetD [OF omap_subset])
apply (drule ord_iso_sym, simp)
done

lemma (in M_ordertype) obase_equals:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(i) |] ==> obase(M,A,r) = A"
apply (rule equalityI, force simp add: obase_def, clarify)
apply (unfold obase_def, simp)
apply (frule wellordered_is_wellfounded_on, assumption)
apply (erule wellfounded_on_induct, assumption+)
 apply (frule obase_equals_separation [of A r], assumption)
 apply (simp, clarify)
apply (rename_tac b)
apply (subgoal_tac "Order.pred(A,b,r) \<subseteq> obase(M,A,r)")
 apply (blast intro!: restrict_omap_ord_iso Ord_omap_image_pred)
apply (force simp add: pred_iff obase_def)
done

text\<open>Main result: @{term om} gives the order-isomorphism
      @{term "\<langle>A,r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"}\<close>
theorem (in M_ordertype) omap_ord_iso_otype:
     "[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
       M(A); M(r); M(f); M(i) |] ==> f \<in> ord_iso(A, r, i, Memrel(i))"
apply (frule omap_ord_iso, assumption+)
apply (simp add: obase_equals)
done

lemma (in M_ordertype) obase_exists:
     "[| M(A); M(r) |] ==> M(obase(M,A,r))"
apply (simp add: obase_def)
apply (insert obase_separation [of A r])
apply (simp add: separation_def)
done

lemma (in M_ordertype) omap_exists:
     "[| M(A); M(r) |] ==> \<exists>z[M]. omap(M,A,r,z)"
apply (simp add: omap_def)
apply (insert omap_replacement [of A r])
apply (simp add: strong_replacement_def)
apply (drule_tac x="obase(M,A,r)" in rspec)
 apply (simp add: obase_exists)
apply (simp add: Memrel_closed pred_closed obase_def)
apply (erule impE)
 apply (clarsimp simp add: univalent_def)
 apply (blast intro: Ord_iso_implies_eq ord_iso_sym ord_iso_trans, clarify)
apply (rule_tac x=Y in rexI)
apply (simp add: Memrel_closed pred_closed obase_def, blast, assumption)
done

declare rall_simps [simp] rex_simps [simp]

lemma (in M_ordertype) otype_exists:
     "[| wellordered(M,A,r); M(A); M(r) |] ==> \<exists>i[M]. otype(M,A,r,i)"
apply (insert omap_exists [of A r])
apply (simp add: otype_def, safe)
apply (rule_tac x="range(x)" in rexI)
apply blast+
done

lemma (in M_ordertype) ordertype_exists:
     "[| wellordered(M,A,r); M(A); M(r) |]
      ==> \<exists>f[M]. (\<exists>i[M]. Ord(i) & f \<in> ord_iso(A, r, i, Memrel(i)))"
apply (insert obase_exists [of A r] omap_exists [of A r] otype_exists [of A r], simp, clarify)
apply (rename_tac i)
apply (subgoal_tac "Ord(i)", blast intro: omap_ord_iso_otype)
apply (rule Ord_otype)
    apply (force simp add: otype_def range_closed)
   apply (simp_all add: wellordered_is_trans_on)
done

lemma (in M_ordertype) relativized_imp_well_ord:
     "[| wellordered(M,A,r); M(A); M(r) |] ==> well_ord(A,r)"
apply (insert ordertype_exists [of A r], simp)
apply (blast intro: well_ord_ord_iso well_ord_Memrel)
done

subsection \<open>Kunen's theorem 5.4, page 127\<close>

text\<open>(a) The notion of Wellordering is absolute\<close>
theorem (in M_ordertype) well_ord_abs [simp]:
     "[| M(A); M(r) |] ==> wellordered(M,A,r) \<longleftrightarrow> well_ord(A,r)"
by (blast intro: well_ord_imp_relativized relativized_imp_well_ord)

text\<open>(b) Order types are absolute\<close>
theorem (in M_ordertype)
     "[| wellordered(M,A,r); f \<in> ord_iso(A, r, i, Memrel(i));
       M(A); M(r); M(f); M(i); Ord(i) |] ==> i = ordertype(A,r)"
by (blast intro: Ord_ordertype relativized_imp_well_ord ordertype_ord_iso
                 Ord_iso_implies_eq ord_iso_sym ord_iso_trans)

subsection\<open>Ordinal Arithmetic: Two Examples of Recursion\<close>

text\<open>Note: the remainder of this theory is not needed elsewhere.\<close>

subsubsection\<open>Ordinal Addition\<close>

(*FIXME: update to use new techniques!!*)
 (*This expresses ordinal addition in the language of ZF.  It also
   provides an abbreviation that can be used in the instance of strong
   replacement below.  Here j is used to define the relation, namely
   Memrel(succ(j)), while x determines the domain of f.*)
definition
  is_oadd_fun :: "[i=>o,i,i,i,i] => o" where
    "is_oadd_fun(M,i,j,x,f) ==
       (\<forall>sj msj. M(sj) \<longrightarrow> M(msj) \<longrightarrow>
                 successor(M,j,sj) \<longrightarrow> membership(M,sj,msj) \<longrightarrow>
                 M_is_recfun(M,
                     %x g y. \<exists>gx[M]. image(M,g,x,gx) & union(M,i,gx,y),
                     msj, x, f))"

definition
  is_oadd :: "[i=>o,i,i,i] => o" where
    "is_oadd(M,i,j,k) ==
        (~ ordinal(M,i) & ~ ordinal(M,j) & k=0) |
        (~ ordinal(M,i) & ordinal(M,j) & k=j) |
        (ordinal(M,i) & ~ ordinal(M,j) & k=i) |
        (ordinal(M,i) & ordinal(M,j) &
         (\<exists>f fj sj. M(f) & M(fj) & M(sj) &
                    successor(M,j,sj) & is_oadd_fun(M,i,sj,sj,f) &
                    fun_apply(M,f,j,fj) & fj = k))"

definition
 (*NEEDS RELATIVIZATION*)
  omult_eqns :: "[i,i,i,i] => o" where
    "omult_eqns(i,x,g,z) ==
            Ord(x) &
            (x=0 \<longrightarrow> z=0) &
            (\<forall>j. x = succ(j) \<longrightarrow> z = g`j ++ i) &
            (Limit(x) \<longrightarrow> z = \<Union>(g``x))"

definition
  is_omult_fun :: "[i=>o,i,i,i] => o" where
    "is_omult_fun(M,i,j,f) ==
            (\<exists>df. M(df) & is_function(M,f) &
                  is_domain(M,f,df) & subset(M, j, df)) &
            (\<forall>x\<in>j. omult_eqns(i,x,f,f`x))"

definition
  is_omult :: "[i=>o,i,i,i] => o" where
    "is_omult(M,i,j,k) ==
        \<exists>f fj sj. M(f) & M(fj) & M(sj) &
                  successor(M,j,sj) & is_omult_fun(M,i,sj,f) &
                  fun_apply(M,f,j,fj) & fj = k"

locale M_ord_arith = M_ordertype +
  assumes oadd_strong_replacement:
   "[| M(i); M(j) |] ==>
    strong_replacement(M,
         \<lambda>x z. \<exists>y[M]. pair(M,x,y,z) &
                  (\<exists>f[M]. \<exists>fx[M]. is_oadd_fun(M,i,j,x,f) &
                           image(M,f,x,fx) & y = i \<union> fx))"

 and omult_strong_replacement':
   "[| M(i); M(j) |] ==>
    strong_replacement(M,
         \<lambda>x z. \<exists>y[M]. z = <x,y> &
             (\<exists>g[M]. is_recfun(Memrel(succ(j)),x,%x g. THE z. omult_eqns(i,x,g,z),g) &
             y = (THE z. omult_eqns(i, x, g, z))))"

text\<open>\<open>is_oadd_fun\<close>: Relating the pure "language of set theory" to Isabelle/ZF\<close>
lemma (in M_ord_arith) is_oadd_fun_iff:
   "[| a\<le>j; M(i); M(j); M(a); M(f) |]
    ==> is_oadd_fun(M,i,j,a,f) \<longleftrightarrow>
        f \<in> a \<rightarrow> range(f) & (\<forall>x. M(x) \<longrightarrow> x < a \<longrightarrow> f`x = i \<union> f``x)"
apply (frule lt_Ord)
apply (simp add: is_oadd_fun_def Memrel_closed Un_closed
             relation2_def is_recfun_abs [of "%x g. i \<union> g``x"]
             image_closed is_recfun_iff_equation
             Ball_def lt_trans [OF ltI, of _ a] lt_Memrel)
apply (simp add: lt_def)
apply (blast dest: transM)
done

lemma (in M_ord_arith) oadd_strong_replacement':
    "[| M(i); M(j) |] ==>
     strong_replacement(M,
            \<lambda>x z. \<exists>y[M]. z = <x,y> &
                  (\<exists>g[M]. is_recfun(Memrel(succ(j)),x,%x g. i \<union> g``x,g) &
                  y = i \<union> g``x))"
apply (insert oadd_strong_replacement [of i j])
apply (simp add: is_oadd_fun_def relation2_def
                 is_recfun_abs [of "%x g. i \<union> g``x"])
done

lemma (in M_ord_arith) exists_oadd:
    "[| Ord(j);  M(i);  M(j) |]
     ==> \<exists>f[M]. is_recfun(Memrel(succ(j)), j, %x g. i \<union> g``x, f)"
apply (rule wf_exists_is_recfun [OF wf_Memrel trans_Memrel])
    apply (simp_all add: Memrel_type oadd_strong_replacement')
done

lemma (in M_ord_arith) exists_oadd_fun:
    "[| Ord(j);  M(i);  M(j) |] ==> \<exists>f[M]. is_oadd_fun(M,i,succ(j),succ(j),f)"
apply (rule exists_oadd [THEN rexE])
apply (erule Ord_succ, assumption, simp)
apply (rename_tac f)
apply (frule is_recfun_type)
apply (rule_tac x=f in rexI)
 apply (simp add: fun_is_function domain_of_fun lt_Memrel apply_recfun lt_def
                  is_oadd_fun_iff Ord_trans [OF _ succI1], assumption)
done

lemma (in M_ord_arith) is_oadd_fun_apply:
    "[| x < j; M(i); M(j); M(f); is_oadd_fun(M,i,j,j,f) |]
     ==> f`x = i \<union> (\<Union>k\<in>x. {f ` k})"
apply (simp add: is_oadd_fun_iff lt_Ord2, clarify)
apply (frule lt_closed, simp)
apply (frule leI [THEN le_imp_subset])
apply (simp add: image_fun, blast)
done

lemma (in M_ord_arith) is_oadd_fun_iff_oadd [rule_format]:
    "[| is_oadd_fun(M,i,J,J,f); M(i); M(J); M(f); Ord(i); Ord(j) |]
     ==> j<J \<longrightarrow> f`j = i++j"
apply (erule_tac i=j in trans_induct, clarify)
apply (subgoal_tac "\<forall>k\<in>x. k<J")
 apply (simp (no_asm_simp) add: is_oadd_def oadd_unfold is_oadd_fun_apply)
apply (blast intro: lt_trans ltI lt_Ord)
done

lemma (in M_ord_arith) Ord_oadd_abs:
    "[| M(i); M(j); M(k); Ord(i); Ord(j) |] ==> is_oadd(M,i,j,k) \<longleftrightarrow> k = i++j"
apply (simp add: is_oadd_def is_oadd_fun_iff_oadd)
apply (frule exists_oadd_fun [of j i], blast+)
done

lemma (in M_ord_arith) oadd_abs:
    "[| M(i); M(j); M(k) |] ==> is_oadd(M,i,j,k) \<longleftrightarrow> k = i++j"
apply (case_tac "Ord(i) & Ord(j)")
 apply (simp add: Ord_oadd_abs)
apply (auto simp add: is_oadd_def oadd_eq_if_raw_oadd)
done

lemma (in M_ord_arith) oadd_closed [intro,simp]:
    "[| M(i); M(j) |] ==> M(i++j)"
apply (simp add: oadd_eq_if_raw_oadd, clarify)
apply (simp add: raw_oadd_eq_oadd)
apply (frule exists_oadd_fun [of j i], auto)
apply (simp add: apply_closed is_oadd_fun_iff_oadd [symmetric])
done

subsubsection\<open>Ordinal Multiplication\<close>

lemma omult_eqns_unique:
     "[| omult_eqns(i,x,g,z); omult_eqns(i,x,g,z') |] ==> z=z'"
apply (simp add: omult_eqns_def, clarify)
apply (erule Ord_cases, simp_all)
done

lemma omult_eqns_0: "omult_eqns(i,0,g,z) \<longleftrightarrow> z=0"
by (simp add: omult_eqns_def)

lemma the_omult_eqns_0: "(THE z. omult_eqns(i,0,g,z)) = 0"
by (simp add: omult_eqns_0)

lemma omult_eqns_succ: "omult_eqns(i,succ(j),g,z) \<longleftrightarrow> Ord(j) & z = g`j ++ i"
by (simp add: omult_eqns_def)

lemma the_omult_eqns_succ:
     "Ord(j) ==> (THE z. omult_eqns(i,succ(j),g,z)) = g`j ++ i"
by (simp add: omult_eqns_succ)

lemma omult_eqns_Limit:
     "Limit(x) ==> omult_eqns(i,x,g,z) \<longleftrightarrow> z = \<Union>(g``x)"
apply (simp add: omult_eqns_def)
apply (blast intro: Limit_is_Ord)
done

lemma the_omult_eqns_Limit:
     "Limit(x) ==> (THE z. omult_eqns(i,x,g,z)) = \<Union>(g``x)"
by (simp add: omult_eqns_Limit)

lemma omult_eqns_Not: "~ Ord(x) ==> ~ omult_eqns(i,x,g,z)"
by (simp add: omult_eqns_def)

lemma (in M_ord_arith) the_omult_eqns_closed:
    "[| M(i); M(x); M(g); function(g) |]
     ==> M(THE z. omult_eqns(i, x, g, z))"
apply (case_tac "Ord(x)")
 prefer 2 apply (simp add: omult_eqns_Not) \<comment>\<open>trivial, non-Ord case\<close>
apply (erule Ord_cases)
  apply (simp add: omult_eqns_0)
 apply (simp add: omult_eqns_succ apply_closed oadd_closed)
apply (simp add: omult_eqns_Limit)
done

lemma (in M_ord_arith) exists_omult:
    "[| Ord(j);  M(i);  M(j) |]
     ==> \<exists>f[M]. is_recfun(Memrel(succ(j)), j, %x g. THE z. omult_eqns(i,x,g,z), f)"
apply (rule wf_exists_is_recfun [OF wf_Memrel trans_Memrel])
    apply (simp_all add: Memrel_type omult_strong_replacement')
apply (blast intro: the_omult_eqns_closed)
done

lemma (in M_ord_arith) exists_omult_fun:
    "[| Ord(j);  M(i);  M(j) |] ==> \<exists>f[M]. is_omult_fun(M,i,succ(j),f)"
apply (rule exists_omult [THEN rexE])
apply (erule Ord_succ, assumption, simp)
apply (rename_tac f)
apply (frule is_recfun_type)
apply (rule_tac x=f in rexI)
apply (simp add: fun_is_function domain_of_fun lt_Memrel apply_recfun lt_def
                 is_omult_fun_def Ord_trans [OF _ succI1])
 apply (force dest: Ord_in_Ord'
              simp add: omult_eqns_def the_omult_eqns_0 the_omult_eqns_succ
                        the_omult_eqns_Limit, assumption)
done

lemma (in M_ord_arith) is_omult_fun_apply_0:
    "[| 0 < j; is_omult_fun(M,i,j,f) |] ==> f`0 = 0"
by (simp add: is_omult_fun_def omult_eqns_def lt_def ball_conj_distrib)

lemma (in M_ord_arith) is_omult_fun_apply_succ:
    "[| succ(x) < j; is_omult_fun(M,i,j,f) |] ==> f`succ(x) = f`x ++ i"
by (simp add: is_omult_fun_def omult_eqns_def lt_def, blast)

lemma (in M_ord_arith) is_omult_fun_apply_Limit:
    "[| x < j; Limit(x); M(j); M(f); is_omult_fun(M,i,j,f) |]
     ==> f ` x = (\<Union>y\<in>x. f`y)"
apply (simp add: is_omult_fun_def omult_eqns_def domain_closed lt_def, clarify)
apply (drule subset_trans [OF OrdmemD], assumption+)
apply (simp add: ball_conj_distrib omult_Limit image_function)
done

lemma (in M_ord_arith) is_omult_fun_eq_omult:
    "[| is_omult_fun(M,i,J,f); M(J); M(f); Ord(i); Ord(j) |]
     ==> j<J \<longrightarrow> f`j = i**j"
apply (erule_tac i=j in trans_induct3)
apply (safe del: impCE)
  apply (simp add: is_omult_fun_apply_0)
 apply (subgoal_tac "x<J")
  apply (simp add: is_omult_fun_apply_succ omult_succ)
 apply (blast intro: lt_trans)
apply (subgoal_tac "\<forall>k\<in>x. k<J")
 apply (simp add: is_omult_fun_apply_Limit omult_Limit)
apply (blast intro: lt_trans ltI lt_Ord)
done

lemma (in M_ord_arith) omult_abs:
    "[| M(i); M(j); M(k); Ord(i); Ord(j) |] ==> is_omult(M,i,j,k) \<longleftrightarrow> k = i**j"
apply (simp add: is_omult_def is_omult_fun_eq_omult)
apply (frule exists_omult_fun [of j i], blast+)
done

subsection \<open>Absoluteness of Well-Founded Relations\<close>

text\<open>Relativized to @{term M}: Every well-founded relation is a subset of some
inverse image of an ordinal.  Key step is the construction (in @{term M}) of a
rank function.\<close>

locale M_wfrank = M_trancl +
  assumes wfrank_separation:
     "M(r) ==>
      separation (M, \<lambda>x.
         \<forall>rplus[M]. tran_closure(M,r,rplus) \<longrightarrow>
         ~ (\<exists>f[M]. M_is_recfun(M, %x f y. is_range(M,f,y), rplus, x, f)))"
 and wfrank_strong_replacement:
     "M(r) ==>
      strong_replacement(M, \<lambda>x z.
         \<forall>rplus[M]. tran_closure(M,r,rplus) \<longrightarrow>
         (\<exists>y[M]. \<exists>f[M]. pair(M,x,y,z)  &
                        M_is_recfun(M, %x f y. is_range(M,f,y), rplus, x, f) &
                        is_range(M,f,y)))"
 and Ord_wfrank_separation:
     "M(r) ==>
      separation (M, \<lambda>x.
         \<forall>rplus[M]. tran_closure(M,r,rplus) \<longrightarrow>
          ~ (\<forall>f[M]. \<forall>rangef[M].
             is_range(M,f,rangef) \<longrightarrow>
             M_is_recfun(M, \<lambda>x f y. is_range(M,f,y), rplus, x, f) \<longrightarrow>
             ordinal(M,rangef)))"

text\<open>Proving that the relativized instances of Separation or Replacement
agree with the "real" ones.\<close>

lemma (in M_wfrank) wfrank_separation':
     "M(r) ==>
      separation
           (M, \<lambda>x. ~ (\<exists>f[M]. is_recfun(r^+, x, %x f. range(f), f)))"
apply (insert wfrank_separation [of r])
apply (simp add: relation2_def is_recfun_abs [of "%x. range"])
done

lemma (in M_wfrank) wfrank_strong_replacement':
     "M(r) ==>
      strong_replacement(M, \<lambda>x z. \<exists>y[M]. \<exists>f[M].
                  pair(M,x,y,z) & is_recfun(r^+, x, %x f. range(f), f) &
                  y = range(f))"
apply (insert wfrank_strong_replacement [of r])
apply (simp add: relation2_def is_recfun_abs [of "%x. range"])
done

lemma (in M_wfrank) Ord_wfrank_separation':
     "M(r) ==>
      separation (M, \<lambda>x.
         ~ (\<forall>f[M]. is_recfun(r^+, x, \<lambda>x. range, f) \<longrightarrow> Ord(range(f))))"
apply (insert Ord_wfrank_separation [of r])
apply (simp add: relation2_def is_recfun_abs [of "%x. range"])
done

text\<open>This function, defined using replacement, is a rank function for
well-founded relations within the class M.\<close>
definition
  wellfoundedrank :: "[i=>o,i,i] => i" where
    "wellfoundedrank(M,r,A) ==
        {p. x\<in>A, \<exists>y[M]. \<exists>f[M].
                       p = <x,y> & is_recfun(r^+, x, %x f. range(f), f) &
                       y = range(f)}"

lemma (in M_wfrank) exists_wfrank:
    "[| wellfounded(M,r); M(a); M(r) |]
     ==> \<exists>f[M]. is_recfun(r^+, a, %x f. range(f), f)"
apply (rule wellfounded_exists_is_recfun)
      apply (blast intro: wellfounded_trancl)
     apply (rule trans_trancl)
    apply (erule wfrank_separation')
   apply (erule wfrank_strong_replacement')
apply (simp_all add: trancl_subset_times)
done

lemma (in M_wfrank) M_wellfoundedrank:
    "[| wellfounded(M,r); M(r); M(A) |] ==> M(wellfoundedrank(M,r,A))"
apply (insert wfrank_strong_replacement' [of r])
apply (simp add: wellfoundedrank_def)
apply (rule strong_replacement_closed)
   apply assumption+
 apply (rule univalent_is_recfun)
   apply (blast intro: wellfounded_trancl)
  apply (rule trans_trancl)
 apply (simp add: trancl_subset_times)
apply (blast dest: transM)
done

lemma (in M_wfrank) Ord_wfrank_range [rule_format]:
    "[| wellfounded(M,r); a\<in>A; M(r); M(A) |]
     ==> \<forall>f[M]. is_recfun(r^+, a, %x f. range(f), f) \<longrightarrow> Ord(range(f))"
apply (drule wellfounded_trancl, assumption)
apply (rule wellfounded_induct, assumption, erule (1) transM)
  apply simp
 apply (blast intro: Ord_wfrank_separation', clarify)
txt\<open>The reasoning in both cases is that we get @{term y} such that
   @{term "\<langle>y, x\<rangle> \<in> r^+"}.  We find that
   @{term "f`y = restrict(f, r^+ -`` {y})"}.\<close>
apply (rule OrdI [OF _ Ord_is_Transset])
 txt\<open>An ordinal is a transitive set...\<close>
 apply (simp add: Transset_def)
 apply clarify
 apply (frule apply_recfun2, assumption)
 apply (force simp add: restrict_iff)
txt\<open>...of ordinals.  This second case requires the induction hyp.\<close>
apply clarify
apply (rename_tac i y)
apply (frule apply_recfun2, assumption)
apply (frule is_recfun_imp_in_r, assumption)
apply (frule is_recfun_restrict)
    (*simp_all won't work*)
    apply (simp add: trans_trancl trancl_subset_times)+
apply (drule spec [THEN mp], assumption)
apply (subgoal_tac "M(restrict(f, r^+ -`` {y}))")
 apply (drule_tac x="restrict(f, r^+ -`` {y})" in rspec)
apply assumption
 apply (simp add: function_apply_equality [OF _ is_recfun_imp_function])
apply (blast dest: pair_components_in_M)
done

lemma (in M_wfrank) Ord_range_wellfoundedrank:
    "[| wellfounded(M,r); r \<subseteq> A*A;  M(r); M(A) |]
     ==> Ord (range(wellfoundedrank(M,r,A)))"
apply (frule wellfounded_trancl, assumption)
apply (frule trancl_subset_times)
apply (simp add: wellfoundedrank_def)
apply (rule OrdI [OF _ Ord_is_Transset])
 prefer 2
 txt\<open>by our previous result the range consists of ordinals.\<close>
 apply (blast intro: Ord_wfrank_range)
txt\<open>We still must show that the range is a transitive set.\<close>
apply (simp add: Transset_def, clarify, simp)
apply (rename_tac x i f u)
apply (frule is_recfun_imp_in_r, assumption)
apply (subgoal_tac "M(u) & M(i) & M(x)")
 prefer 2 apply (blast dest: transM, clarify)
apply (rule_tac a=u in rangeI)
apply (rule_tac x=u in ReplaceI)
  apply simp
  apply (rule_tac x="restrict(f, r^+ -`` {u})" in rexI)
   apply (blast intro: is_recfun_restrict trans_trancl dest: apply_recfun2)
  apply simp
apply blast
txt\<open>Unicity requirement of Replacement\<close>
apply clarify
apply (frule apply_recfun2, assumption)
apply (simp add: trans_trancl is_recfun_cut)
done

lemma (in M_wfrank) function_wellfoundedrank:
    "[| wellfounded(M,r); M(r); M(A)|]
     ==> function(wellfoundedrank(M,r,A))"
apply (simp add: wellfoundedrank_def function_def, clarify)
txt\<open>Uniqueness: repeated below!\<close>
apply (drule is_recfun_functional, assumption)
     apply (blast intro: wellfounded_trancl)
    apply (simp_all add: trancl_subset_times trans_trancl)
done

lemma (in M_wfrank) domain_wellfoundedrank:
    "[| wellfounded(M,r); M(r); M(A)|]
     ==> domain(wellfoundedrank(M,r,A)) = A"
apply (simp add: wellfoundedrank_def function_def)
apply (rule equalityI, auto)
apply (frule transM, assumption)
apply (frule_tac a=x in exists_wfrank, assumption+, clarify)
apply (rule_tac b="range(f)" in domainI)
apply (rule_tac x=x in ReplaceI)
  apply simp
  apply (rule_tac x=f in rexI, blast, simp_all)
txt\<open>Uniqueness (for Replacement): repeated above!\<close>
apply clarify
apply (drule is_recfun_functional, assumption)
    apply (blast intro: wellfounded_trancl)
    apply (simp_all add: trancl_subset_times trans_trancl)
done

lemma (in M_wfrank) wellfoundedrank_type:
    "[| wellfounded(M,r);  M(r); M(A)|]
     ==> wellfoundedrank(M,r,A) \<in> A -> range(wellfoundedrank(M,r,A))"
apply (frule function_wellfoundedrank [of r A], assumption+)
apply (frule function_imp_Pi)
 apply (simp add: wellfoundedrank_def relation_def)
 apply blast
apply (simp add: domain_wellfoundedrank)
done

lemma (in M_wfrank) Ord_wellfoundedrank:
    "[| wellfounded(M,r); a \<in> A; r \<subseteq> A*A;  M(r); M(A) |]
     ==> Ord(wellfoundedrank(M,r,A) ` a)"
by (blast intro: apply_funtype [OF wellfoundedrank_type]
                 Ord_in_Ord [OF Ord_range_wellfoundedrank])

lemma (in M_wfrank) wellfoundedrank_eq:
     "[| is_recfun(r^+, a, %x. range, f);
         wellfounded(M,r);  a \<in> A; M(f); M(r); M(A)|]
      ==> wellfoundedrank(M,r,A) ` a = range(f)"
apply (rule apply_equality)
 prefer 2 apply (blast intro: wellfoundedrank_type)
apply (simp add: wellfoundedrank_def)
apply (rule ReplaceI)
  apply (rule_tac x="range(f)" in rexI)
  apply blast
 apply simp_all
txt\<open>Unicity requirement of Replacement\<close>
apply clarify
apply (drule is_recfun_functional, assumption)
    apply (blast intro: wellfounded_trancl)
    apply (simp_all add: trancl_subset_times trans_trancl)
done

lemma (in M_wfrank) wellfoundedrank_lt:
     "[| <a,b> \<in> r;
         wellfounded(M,r); r \<subseteq> A*A;  M(r); M(A)|]
      ==> wellfoundedrank(M,r,A) ` a < wellfoundedrank(M,r,A) ` b"
apply (frule wellfounded_trancl, assumption)
apply (subgoal_tac "a\<in>A & b\<in>A")
 prefer 2 apply blast
apply (simp add: lt_def Ord_wellfoundedrank, clarify)
apply (frule exists_wfrank [of concl: _ b], erule (1) transM, assumption)
apply clarify
apply (rename_tac fb)
apply (frule is_recfun_restrict [of concl: "r^+" a])
    apply (rule trans_trancl, assumption)
   apply (simp_all add: r_into_trancl trancl_subset_times)
txt\<open>Still the same goal, but with new \<open>is_recfun\<close> assumptions.\<close>
apply (simp add: wellfoundedrank_eq)
apply (frule_tac a=a in wellfoundedrank_eq, assumption+)
   apply (simp_all add: transM [of a])
txt\<open>We have used equations for wellfoundedrank and now must use some
    for  \<open>is_recfun\<close>.\<close>
apply (rule_tac a=a in rangeI)
apply (simp add: is_recfun_type [THEN apply_iff] vimage_singleton_iff
                 r_into_trancl apply_recfun r_into_trancl)
done

lemma (in M_wfrank) wellfounded_imp_subset_rvimage:
     "[|wellfounded(M,r); r \<subseteq> A*A; M(r); M(A)|]
      ==> \<exists>i f. Ord(i) & r \<subseteq> rvimage(A, f, Memrel(i))"
apply (rule_tac x="range(wellfoundedrank(M,r,A))" in exI)
apply (rule_tac x="wellfoundedrank(M,r,A)" in exI)
apply (simp add: Ord_range_wellfoundedrank, clarify)
apply (frule subsetD, assumption, clarify)
apply (simp add: rvimage_iff wellfoundedrank_lt [THEN ltD])
apply (blast intro: apply_rangeI wellfoundedrank_type)
done

lemma (in M_wfrank) wellfounded_imp_wf:
     "[|wellfounded(M,r); relation(r); M(r)|] ==> wf(r)"
by (blast dest!: relation_field_times_field wellfounded_imp_subset_rvimage
          intro: wf_rvimage_Ord [THEN wf_subset])

lemma (in M_wfrank) wellfounded_on_imp_wf_on:
     "[|wellfounded_on(M,A,r); relation(r); M(r); M(A)|] ==> wf[A](r)"
apply (simp add: wellfounded_on_iff_wellfounded wf_on_def)
apply (rule wellfounded_imp_wf)
apply (simp_all add: relation_def)
done

theorem (in M_wfrank) wf_abs:
     "[|relation(r); M(r)|] ==> wellfounded(M,r) \<longleftrightarrow> wf(r)"
by (blast intro: wellfounded_imp_wf wf_imp_relativized)

theorem (in M_wfrank) wf_on_abs:
     "[|relation(r); M(r); M(A)|] ==> wellfounded_on(M,A,r) \<longleftrightarrow> wf[A](r)"
by (blast intro: wellfounded_on_imp_wf_on wf_on_imp_relativized)

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Basic Order Properties\<close>
theory Transport_Compositions_Generic_Order_Base
  imports
   Transport_Compositions_Generic_Base
begin

context transport_comp
begin

interpretation flip1 : galois R1 L1 r1 l1 .

subparagraph \<open>Reflexivity\<close>

lemma reflexive_on_in_dom_leftI:
  assumes galois_prop: "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and in_dom_L1_le: "in_dom (\<le>\<^bsub>L1\<^esub>) \<le> in_codom (\<le>\<^bsub>L1\<^esub>)"
  and refl_R1: "reflexive_on (in_dom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and refl_L2: "reflexive_on (in_dom (\<le>\<^bsub>L2\<^esub>)) (\<le>\<^bsub>L2\<^esub>)"
  and mono_in_dom_l1: "([in_dom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>L2\<^esub>)) l1"
  shows "reflexive_on (in_dom (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
proof (rule reflexive_onI)
  fix x assume "in_dom (\<le>\<^bsub>L\<^esub>) x"
  then obtain x' where "x \<le>\<^bsub>L\<^esub> x'" "in_dom (\<le>\<^bsub>L1\<^esub>) x" by blast
  show "x \<le>\<^bsub>L\<^esub> x"
  proof (rule left_relI)
    from refl_R1 have "l1 x \<le>\<^bsub>R1\<^esub> l1 x"
    proof (rule reflexive_onD)
      from \<open>x \<le>\<^bsub>L\<^esub> x'\<close> galois_prop show "in_dom (\<le>\<^bsub>R1\<^esub>) (l1 x)"
        by (blast elim: t1.half_galois_prop_left_GaloisE)
    qed
    then show "x \<^bsub>L1\<^esub>\<lessapprox> l1 x"
    proof (intro t1.GaloisI)
      from galois_prop \<open>in_dom (\<le>\<^bsub>L1\<^esub>) x\<close> \<open>l1 x \<le>\<^bsub>R1\<^esub> l1 x\<close> show "x \<le>\<^bsub>L1\<^esub> r1 (l1 x)"
        by blast
    qed blast
    from refl_L2 show "l1 x \<le>\<^bsub>L2\<^esub> l1 x"
    proof (rule reflexive_onD)
      from mono_in_dom_l1 \<open>x \<le>\<^bsub>L\<^esub> x'\<close> show "in_dom (\<le>\<^bsub>L2\<^esub>) (l1 x)" by blast
    qed
    from \<open>l1 x \<le>\<^bsub>R1\<^esub> l1 x\<close> show "l1 x \<^bsub>R1\<^esub>\<lessapprox> x"
    proof (intro flip1.GaloisI)
      from \<open>in_dom (\<le>\<^bsub>L1\<^esub>) x\<close> in_dom_L1_le show "in_codom (\<le>\<^bsub>L1\<^esub>) x" by blast
    qed
  qed
qed

lemma reflexive_on_in_codom_leftI:
  assumes L1_r1_l1I: "\<And>x. in_dom (\<le>\<^bsub>L1\<^esub>) x \<Longrightarrow> l1 x \<le>\<^bsub>R1\<^esub> l1 x \<Longrightarrow> x \<le>\<^bsub>L1\<^esub> r1 (l1 x)"
  and in_codom_L1_le: "in_codom (\<le>\<^bsub>L1\<^esub>) \<le> in_dom (\<le>\<^bsub>L1\<^esub>)"
  and refl_R1: "reflexive_on (in_codom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and refl_L2: "reflexive_on (in_codom (\<le>\<^bsub>L2\<^esub>)) (\<le>\<^bsub>L2\<^esub>)"
  and mono_in_codom_l1: "([in_codom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>L2\<^esub>)) l1"
  shows "reflexive_on (in_codom (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
proof (rule reflexive_onI)
  fix x assume "in_codom (\<le>\<^bsub>L\<^esub>) x"
  then obtain x' where "x' \<le>\<^bsub>L\<^esub> x" "in_codom (\<le>\<^bsub>L1\<^esub>) x" "in_codom (\<le>\<^bsub>R1\<^esub>) (l1 x)"
    by blast
  show "x \<le>\<^bsub>L\<^esub> x"
  proof (rule left_relI)
    from refl_R1 \<open>in_codom (\<le>\<^bsub>R1\<^esub>) (l1 x)\<close> have "l1 x \<le>\<^bsub>R1\<^esub> l1 x" by blast
    show "x \<^bsub>L1\<^esub>\<lessapprox> l1 x"
    proof (rule t1.GaloisI)
      from in_codom_L1_le \<open>in_codom (\<le>\<^bsub>L1\<^esub>) x\<close> have "in_dom (\<le>\<^bsub>L1\<^esub>) x" by blast
      with \<open>l1 x \<le>\<^bsub>R1\<^esub> l1 x\<close> show "x \<le>\<^bsub>L1\<^esub> r1 (l1 x)" by (intro L1_r1_l1I)
    qed fact
    from refl_L2 show "l1 x \<le>\<^bsub>L2\<^esub> l1 x"
    proof (rule reflexive_onD)
      from mono_in_codom_l1 \<open>x' \<le>\<^bsub>L\<^esub> x\<close> show "in_codom (\<le>\<^bsub>L2\<^esub>) (l1 x)" by blast
    qed
    show "l1 x \<^bsub>R1\<^esub>\<lessapprox> x" by (rule flip1.GaloisI) fact+
  qed
qed

corollary reflexive_on_in_field_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>L2\<^esub>)) (\<le>\<^bsub>L2\<^esub>)"
  and "([in_field (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_field (\<le>\<^bsub>L2\<^esub>)) l1"
  shows "reflexive_on (in_field (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
proof -
  from assms have "reflexive_on (in_dom (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
    by (intro reflexive_on_in_dom_leftI)
    (auto 0 4 intro: reflexive_on_if_le_pred_if_reflexive_on in_field_if_in_dom)
  moreover from assms have "reflexive_on (in_codom (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
    by (intro reflexive_on_in_codom_leftI)
    (auto 0 4 intro: reflexive_on_if_le_pred_if_reflexive_on in_field_if_in_codom)
  ultimately show ?thesis by (auto iff: in_field_iff_in_dom_or_in_codom)
qed

subparagraph \<open>Transitivity\<close>

text\<open>There are many similar proofs for transitivity. They slightly differ in
their assumptions, particularly which of @{term "(\<le>\<^bsub>R1\<^esub>)"} and @{term "(\<le>\<^bsub>L2\<^esub>)"} has
to be transitive and the order of commutativity for the relations.

In the following, we just give two of them that suffice for many purposes.\<close>

lemma transitive_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and trans_L2: "transitive (\<le>\<^bsub>L2\<^esub>)"
  and R1_L2_R1_le: "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>))"
  shows "transitive (\<le>\<^bsub>L\<^esub>)"
proof (rule transitiveI)
  fix x1 x2 x3 assume "x1 \<le>\<^bsub>L\<^esub> x2" "x2 \<le>\<^bsub>L\<^esub> x3"
  from \<open>x1 \<le>\<^bsub>L\<^esub> x2\<close> obtain y1 y2 where "x1 \<^bsub>L1\<^esub>\<lessapprox> y1" "y1 \<le>\<^bsub>L2\<^esub> y2" "y2 \<le>\<^bsub>R1\<^esub> l1 x2"
    by blast
  from \<open>x2 \<le>\<^bsub>L\<^esub> x3\<close> \<open>((\<le>\<^bsub>L1\<^esub>) \<^sub>h\<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1\<close> obtain y3 y4 where
    "l1 x2 \<le>\<^bsub>R1\<^esub> y3" "y3 \<le>\<^bsub>L2\<^esub> y4" "y4 \<le>\<^bsub>R1\<^esub> l1 x3" "in_codom (\<le>\<^bsub>L1\<^esub>) x3" by blast
  with R1_L2_R1_le have "((\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) (l1 x2) (l1 x3)" by blast
  then obtain y where "l1 x2 \<le>\<^bsub>L2\<^esub> y" "y \<le>\<^bsub>R1\<^esub> l1 x3" by blast
  with \<open>y2 \<le>\<^bsub>R1\<^esub> l1 x2\<close> R1_L2_R1_le have "((\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) y2 (l1 x3)" by blast
  then obtain y' where "y2 \<le>\<^bsub>L2\<^esub> y'" "y' \<le>\<^bsub>R1\<^esub> l1 x3" by blast
  with \<open>y1 \<le>\<^bsub>L2\<^esub> y2\<close> have "y1 \<le>\<^bsub>L2\<^esub> y'" using trans_L2 by blast
  show "x1 \<le>\<^bsub>L\<^esub> x3"
  proof (rule left_relI)
    show "x1 \<^bsub>L1\<^esub>\<lessapprox> y1" "y1 \<le>\<^bsub>L2\<^esub> y'" by fact+
    show "y' \<^bsub>R1\<^esub>\<lessapprox> x3" by (rule flip1.GaloisI) fact+
  qed
qed

lemma transitive_leftI':
  assumes galois_prop: "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and trans_L2: "transitive (\<le>\<^bsub>L2\<^esub>)"
  and R1_L2_R1_le: "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>))"
  shows "transitive (\<le>\<^bsub>L\<^esub>)"
proof (rule transitiveI)
  fix x1 x2 x3 assume "x1 \<le>\<^bsub>L\<^esub> x2" "x2 \<le>\<^bsub>L\<^esub> x3"
  from \<open>x1 \<le>\<^bsub>L\<^esub> x2\<close> galois_prop obtain y1 y2 where
    "in_dom (\<le>\<^bsub>L1\<^esub>) x1" "l1 x1 \<le>\<^bsub>R1\<^esub> y1" "y1 \<le>\<^bsub>L2\<^esub> y2" "y2 \<le>\<^bsub>R1\<^esub> l1 x2" by blast
  with R1_L2_R1_le have "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>)) (l1 x1) (l1 x2)" by blast
  then obtain y where "l1 x1 \<le>\<^bsub>R1\<^esub> y" "y \<le>\<^bsub>L2\<^esub> l1 x2" by blast
  moreover from \<open>x2 \<le>\<^bsub>L\<^esub> x3\<close> galois_prop obtain y3 y4 where
    "l1 x2 \<le>\<^bsub>R1\<^esub> y3" "y3 \<le>\<^bsub>L2\<^esub> y4" "y4 \<^bsub>R1\<^esub>\<lessapprox> x3" by blast
  moreover note R1_L2_R1_le
  ultimately have "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>)) (l1 x1) y3" by blast
  then obtain y' where "l1 x1 \<le>\<^bsub>R1\<^esub> y'" "y' \<le>\<^bsub>L2\<^esub> y3" by blast
  with \<open>y3 \<le>\<^bsub>L2\<^esub> y4\<close> have "y' \<le>\<^bsub>L2\<^esub> y4" using trans_L2 by blast
  show "x1 \<le>\<^bsub>L\<^esub> x3"
  proof (rule left_relI)
    from \<open>in_dom (\<le>\<^bsub>L1\<^esub>) x1\<close> \<open>l1 x1 \<le>\<^bsub>R1\<^esub> y'\<close> galois_prop show "x1 \<^bsub>L1\<^esub>\<lessapprox> y'"
      by (intro t1.Galois_if_left_right_rel_if_in_dom_if_half_galois_prop_right)
      auto
    show "y' \<le>\<^bsub>L2\<^esub> y4" by fact
    from \<open>y' \<le>\<^bsub>L2\<^esub> y4\<close> \<open>y4 \<^bsub>R1\<^esub>\<lessapprox> x3\<close> show "y4 \<^bsub>R1\<^esub>\<lessapprox> x3" by blast
  qed
qed

subparagraph \<open>Preorders\<close>

lemma preorder_on_in_field_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "preorder_on (in_field (\<le>\<^bsub>L2\<^esub>)) (\<le>\<^bsub>L2\<^esub>)"
  and mono_in_codom_l1: "([in_codom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>L2\<^esub>)) l1"
  and R1_L2_R1_le: "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>))"
  shows "preorder_on (in_field (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
proof -
  have "([in_field (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_field (\<le>\<^bsub>L2\<^esub>)) l1"
  proof -
    from \<open>((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1\<close> R1_L2_R1_le
      have "([in_dom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>L2\<^esub>)) l1"
      by (intro mono_in_dom_left_rel_left1_if_in_dom_rel_comp_le
        in_dom_right1_left2_right1_le_if_right1_left2_right1_le)
      auto
    with mono_in_codom_l1 show ?thesis by (intro dep_mono_wrt_predI) blast
  qed
  with assms show ?thesis by (intro preorder_onI)
    (auto intro: reflexive_on_in_field_leftI transitive_leftI)
qed

lemma preorder_on_in_field_leftI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "preorder_on (in_field (\<le>\<^bsub>L2\<^esub>)) (\<le>\<^bsub>L2\<^esub>)"
  and mono_in_dom_l1: "([in_dom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>L2\<^esub>)) l1"
  and R1_L2_R1_le: "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>))"
  shows "preorder_on (in_field (\<le>\<^bsub>L\<^esub>)) (\<le>\<^bsub>L\<^esub>)"
proof -
  have "([in_field (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_field (\<le>\<^bsub>L2\<^esub>)) l1"
  proof -
    from \<open>((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1\<close> R1_L2_R1_le
      have "([in_codom (\<le>\<^bsub>L\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>L2\<^esub>)) l1"
      by (intro mono_in_codom_left_rel_left1_if_in_codom_rel_comp_le
        in_codom_right1_left2_right1_le_if_right1_left2_right1_le)
      auto
    with mono_in_dom_l1 show ?thesis by (intro dep_mono_wrt_predI) blast
  qed
  with assms show ?thesis by (intro preorder_onI)
    (auto intro: reflexive_on_in_field_leftI transitive_leftI')
qed

subparagraph \<open>Symmetry\<close>

lemma symmetric_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "symmetric (\<le>\<^bsub>R1\<^esub>)"
  and "symmetric (\<le>\<^bsub>L2\<^esub>)"
  shows "symmetric (\<le>\<^bsub>L\<^esub>)"
proof -
  from assms have "(\<greaterapprox>\<^bsub>R1\<^esub>) = (\<^bsub>L1\<^esub>\<lessapprox>)" by (intro
    t1.inv_flip_Galois_eq_Galois_if_symmetric_if_in_codom_eq_in_dom_if_galois_prop)
  moreover then have "(\<^bsub>R1\<^esub>\<lessapprox>) = (\<greaterapprox>\<^bsub>L1\<^esub>)"
    by (subst rel_inv_eq_iff_eq[symmetric]) simp
  ultimately show ?thesis using assms unfolding left_rel_eq_comp
    by (subst symmetric_iff_rel_inv_eq_self) (simp add: rel_comp_assoc)
qed

lemma partial_equivalence_rel_leftI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "symmetric (\<le>\<^bsub>R1\<^esub>)"
  and "partial_equivalence_rel (\<le>\<^bsub>L2\<^esub>)"
  and "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>))"
  shows "partial_equivalence_rel (\<le>\<^bsub>L\<^esub>)"
  using assms by (intro partial_equivalence_relI transitive_leftI symmetric_leftI)
  auto

lemma partial_equivalence_rel_leftI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "in_codom (\<le>\<^bsub>L1\<^esub>) = in_dom (\<le>\<^bsub>L1\<^esub>)"
  and "symmetric (\<le>\<^bsub>R1\<^esub>)"
  and "partial_equivalence_rel (\<le>\<^bsub>L2\<^esub>)"
  and "((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>) \<circ>\<circ> (\<le>\<^bsub>R1\<^esub>)) \<le> ((\<le>\<^bsub>R1\<^esub>) \<circ>\<circ> (\<le>\<^bsub>L2\<^esub>))"
  shows "partial_equivalence_rel (\<le>\<^bsub>L\<^esub>)"
  using assms by (intro partial_equivalence_relI transitive_leftI' symmetric_leftI)
  auto

end

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory WordPolish
imports WordAbstract
begin

(* Depending on the platform, these names don't necessarily correspond to
   the C types of the same names. But by this point, we're sufficiently
   abstract that it doesn't really matter. *)

definition [simplified]: "LONG_MAX \<equiv> (2 :: int) ^ 63 - 1"
definition [simplified]: "LONG_MIN \<equiv> - ((2 :: int) ^ 63)"
definition [simplified]: "ULONG_MAX \<equiv> (2 :: nat) ^ 64 - 1"

definition [simplified]: "INT_MAX \<equiv> (2 :: int) ^ 31 - 1"
definition [simplified]: "INT_MIN \<equiv> - ((2 :: int) ^ 31)"
definition [simplified]: "UINT_MAX \<equiv> (2 :: nat) ^ 32 - 1"

definition [simplified]: "SHORT_MAX \<equiv> (2 :: int) ^ 15 - 1"
definition [simplified]: "SHORT_MIN \<equiv> - ((2 :: int) ^ 15)"
definition [simplified]: "USHORT_MAX \<equiv> (2 :: nat) ^ 16 - 1"

definition [simplified]: "CHAR_MAX \<equiv> (2 :: int) ^ 7 - 1"
definition [simplified]: "CHAR_MIN \<equiv> - ((2 :: int) ^ 7)"
definition [simplified]: "UCHAR_MAX \<equiv> (2 :: nat) ^ 8 - 1"

(* These are added to the Polish simps after translation *)
lemma WORD_MAX_simps:
   "WORD_MAX TYPE(64) = LONG_MAX"
   "WORD_MAX TYPE(32) = INT_MAX"
   "WORD_MAX TYPE(16) = SHORT_MAX"
   "WORD_MAX TYPE(8) = CHAR_MAX"
  by (auto simp: LONG_MAX_def INT_MAX_def SHORT_MAX_def CHAR_MAX_def WORD_MAX_def)

lemma WORD_MIN_simps:
   "WORD_MIN TYPE(64) = LONG_MIN"
   "WORD_MIN TYPE(32) = INT_MIN"
   "WORD_MIN TYPE(16) = SHORT_MIN"
   "WORD_MIN TYPE(8) = CHAR_MIN"
  by (auto simp: LONG_MIN_def INT_MIN_def SHORT_MIN_def CHAR_MIN_def WORD_MIN_def)

lemma UWORD_MAX_simps:
   "UWORD_MAX TYPE(64) = ULONG_MAX"
   "UWORD_MAX TYPE(32) = UINT_MAX"
   "UWORD_MAX TYPE(16) = USHORT_MAX"
   "UWORD_MAX TYPE(8) = UCHAR_MAX"
  by (auto simp: ULONG_MAX_def UINT_MAX_def USHORT_MAX_def UCHAR_MAX_def UWORD_MAX_def)

lemma MIN_MAX_lemmas_schema:
  "sint (s::'a::len signed word) \<le> WORD_MAX TYPE('a)"
  "WORD_MIN TYPE('a) \<le> sint (s::'a::len signed word)"
  "unat (u::'a::len word) \<le> UWORD_MAX TYPE('a)"
  "\<not> (sint (s::'a::len signed word) > WORD_MAX TYPE('a))"
  "\<not> (WORD_MIN TYPE('a) > sint (s::'a::len signed word))"
  "\<not> (unat (u::'a::len word) > UWORD_MAX TYPE('a))"
  "WORD_MIN TYPE('a) \<le> WORD_MAX TYPE('a)"
  "0 \<le> WORD_MAX TYPE('a)"
  "WORD_MIN TYPE('a) \<le> 0"
  unfolding WORD_MAX_def WORD_MIN_def UWORD_MAX_def
  using unat_lt2p[where x=u] less_eq_Suc_le
        sint_range_size [where w=s, simplified word_size, simplified]
  by auto

lemmas MIN_MAX_lemmas_pre =
  MIN_MAX_lemmas_schema[where 'a=64]
  MIN_MAX_lemmas_schema[where 'a=32]
  MIN_MAX_lemmas_schema[where 'a=16]
  MIN_MAX_lemmas_schema[where 'a=8]

lemmas INT_MIN_MAX_lemmas [simp] =
  MIN_MAX_lemmas_pre[unfolded WORD_MAX_simps WORD_MIN_simps UWORD_MAX_simps]

end