subsection \<open> Local Variables \<close>

theory local_var
  imports "UTP.utp"
begin

utp_lit_vars

text \<open> State space of global variables. \<close>

alphabet global = x :: int  y :: int

abbreviation swap :: "global hrel" where
"swap \<equiv> var z :: int in all\<^sub>L \<bullet> z := x ;; x := y ;; y := &z"

lemma swap_wp: "swap wp (x = Y \<and> y = X) = \<^U>(y = Y \<and> x = X)"
  by (simp add: vblock_def wp usubst unrest)

lemma swap_hoare: "\<^bold>{x = X \<and> y = Y\<^bold>} swap \<^bold>{x = Y \<and> y = X\<^bold>}" by (rel_auto)

lemma swap_alt_def: "swap = (x, y) := (y, x)" by (rel_auto)

end


(*  Title:       Clausal Calculi
    Author:      Jasmin Blanchette <j.c.blanchette at vu.nl>, 2020
*)

section \<open>Clausal Calculi\<close>

theory Clausal_Calculus
  imports
    Ordered_Resolution_Prover.Unordered_Ground_Resolution
    Soundness
    Standard_Redundancy_Criterion
begin

text \<open>Various results about consequence relations, counterexample-reducing inference systems, and
the standard redundancy criteria are specialized and customized for clauses as opposed to arbitrary
formulas.\<close>

subsection \<open>Setup\<close>

text \<open>To avoid confusion, we use the symbol \<open>\<TTurnstile>\<close> (with or without subscripts) for the ``models''
and entailment relations on clauses and \<open>\<Turnstile>\<close> for the abstract concept of consequence.\<close>

abbreviation true_lit_thick :: "'a interp \<Rightarrow> 'a literal \<Rightarrow> bool" (infix "\<TTurnstile>l" 50) where
  "I \<TTurnstile>l L \<equiv> I \<Turnstile>l L"

abbreviation true_cls_thick :: "'a interp \<Rightarrow> 'a clause \<Rightarrow> bool" (infix "\<TTurnstile>" 50) where
  "I \<TTurnstile> C \<equiv> I \<Turnstile> C"

abbreviation true_clss_thick :: "'a interp \<Rightarrow> 'a clause set \<Rightarrow> bool" (infix "\<TTurnstile>s" 50) where
  "I \<TTurnstile>s \<C> \<equiv> I \<Turnstile>s \<C>"

abbreviation true_cls_mset_thick :: "'a interp \<Rightarrow> 'a clause multiset \<Rightarrow> bool" (infix "\<TTurnstile>m" 50) where
  "I \<TTurnstile>m \<C> \<equiv> I \<Turnstile>m \<C>"

no_notation true_lit (infix "\<Turnstile>l" 50)
no_notation true_cls (infix "\<Turnstile>" 50)
no_notation true_clss (infix "\<Turnstile>s" 50)
no_notation true_cls_mset (infix "\<Turnstile>m" 50)

subsection \<open>Consequence Relation\<close>

abbreviation entails_clss :: "'a clause set \<Rightarrow> 'a clause set \<Rightarrow> bool" (infix "\<TTurnstile>e" 50) where
  "N1 \<TTurnstile>e N2 \<equiv> \<forall>I. I \<TTurnstile>s N1 \<longrightarrow> I \<TTurnstile>s N2"

lemma entails_iff_unsatisfiable_single:
  "CC \<TTurnstile>e {E} \<longleftrightarrow> \<not> satisfiable (CC \<union> {{#- L#} |L. L \<in># E})" (is "_ \<longleftrightarrow> _ (_ \<union> ?NegD)")
proof
  assume c_ent_e: "CC \<TTurnstile>e {E}"
  have "\<not> I \<TTurnstile>s CC \<union> ?NegD" for I
    using c_ent_e[rule_format, of I]
    unfolding true_clss_def true_cls_def true_lit_def if_distribR if_bool_eq_conj
    by (fastforce simp: ball_Un is_pos_neg_not_is_pos)
  then show "\<not> satisfiable (CC \<union> ?NegD)"
    by auto
next
  assume "\<not> satisfiable (CC \<union> ?NegD)"
  then have "\<not> I \<TTurnstile>s CC \<union> ?NegD" for I
    by auto
  then show "CC \<TTurnstile>e {E}"
    unfolding true_clss_def true_cls_def true_lit_def if_distribR if_bool_eq_conj
    by (fastforce simp: ball_Un is_pos_neg_not_is_pos)
qed

lemma entails_iff_unsatisfiable:
  "CC \<TTurnstile>e EE \<longleftrightarrow> (\<forall>E \<in> EE. \<not> satisfiable (CC \<union> {{#- L#} |L. L \<in># E}))" (is "?lhs = ?rhs")
proof -
  have "?lhs \<longleftrightarrow> (\<forall>E \<in> EE. CC \<TTurnstile>e {E})"
    unfolding true_clss_def by auto
  also have "... \<longleftrightarrow> ?rhs"
    unfolding entails_iff_unsatisfiable_single by auto
  finally show ?thesis
    .
qed

interpretation consequence_relation "{{#}}" "(\<TTurnstile>e)"
proof
  fix N2 N1 :: "'a clause set"
  assume "\<forall>C \<in> N2. N1 \<TTurnstile>e {C}"
  then show "N1 \<TTurnstile>e N2"
    unfolding true_clss_singleton by (simp add: true_clss_def)
qed (auto intro: true_clss_mono)

interpretation concl_compact_consequence_relation "{{#}} :: ('a :: wellorder) clause set" "(\<TTurnstile>e)"
proof
  fix CC EE :: "'a clause set"
  assume
    fin_e: "finite EE" and
    c_ent_e: "CC \<TTurnstile>e EE"

  have "\<forall>E \<in> EE. \<not> satisfiable (CC \<union> {{#- L#} |L. L \<in># E})"
    using c_ent_e[unfolded entails_iff_unsatisfiable] .
  then have "\<forall>E \<in> EE. \<exists>DD \<subseteq> CC \<union> {{#- L#} |L. L \<in># E}. finite DD \<and> \<not> satisfiable DD"
    by (subst (asm) clausal_logic_compact)
  then obtain DD_of where
    d_of: "\<forall>E \<in> EE. DD_of E \<subseteq> CC \<union> {{#- L#} |L. L \<in># E} \<and> finite (DD_of E)
      \<and> \<not> satisfiable (DD_of E)"
    by moura

  define CC' where
    "CC' = (\<Union>E \<in> EE. DD_of E - {{#- L#} |L. L \<in># E})"

  have "CC' \<subseteq> CC"
    unfolding CC'_def using d_of by auto
  moreover have c'_fin: "finite CC'"
    unfolding CC'_def using d_of fin_e by blast
  moreover have "CC' \<TTurnstile>e EE"
    unfolding entails_iff_unsatisfiable
  proof
    fix E
    assume e_in: "E \<in> EE"

    have "DD_of E \<subseteq> CC' \<union> {{#- L#} |L. L \<in># E}"
      using e_in d_of unfolding CC'_def by auto
    moreover have "\<not> satisfiable (DD_of E)"
      using e_in d_of by auto
    ultimately show "\<not> satisfiable (CC' \<union> {{#- L#} |L. L \<in># E})"
      by (rule unsatisfiable_mono[of "DD_of E"])
  qed
  ultimately show "\<exists>CC' \<subseteq> CC. finite CC' \<and> CC' \<TTurnstile>e EE"
    by blast
qed

subsection \<open>Counterexample-Reducing Inference Systems\<close>

definition clss_of_interp :: "'a set \<Rightarrow> 'a literal multiset set" where
  "clss_of_interp I = {{#(if A \<in> I then Pos else Neg) A#} |A. True}"

lemma true_clss_of_interp_iff_equal[simp]: "J \<TTurnstile>s clss_of_interp I \<longleftrightarrow> J = I"
  unfolding clss_of_interp_def true_clss_def true_cls_def true_lit_def by force

lemma entails_iff_models[simp]: "clss_of_interp I \<TTurnstile>e CC \<longleftrightarrow> I \<TTurnstile>s CC"
  by simp

locale clausal_counterex_reducing_inference_system = inference_system Inf
  for Inf :: "('a :: wellorder) clause inference set" +
  fixes J_of :: "'a clause set \<Rightarrow> 'a interp"
  assumes clausal_Inf_counterex_reducing:
    "{#} \<notin> N \<Longrightarrow> D \<in> N \<Longrightarrow> \<not> J_of N \<TTurnstile> D \<Longrightarrow> (\<And>C. C \<in> N \<Longrightarrow> \<not> J_of N \<TTurnstile> C \<Longrightarrow> D \<le> C) \<Longrightarrow>
     \<exists>\<iota> \<in> Inf. prems_of \<iota> \<noteq> [] \<and> main_prem_of \<iota> = D \<and> set (side_prems_of \<iota>) \<subseteq> N \<and>
       J_of N \<TTurnstile>s set (side_prems_of \<iota>) \<and> \<not> J_of N \<TTurnstile> concl_of \<iota> \<and> concl_of \<iota> < D"
begin

abbreviation I_of :: "'a clause set \<Rightarrow> 'a clause set" where
  "I_of N \<equiv> clss_of_interp (J_of N)"

lemma Inf_counterex_reducing:
  assumes
    bot_ni_n: "N \<inter> {{#}} = {}" and
    d_in_n: "D \<in> N" and
    n_ent_d: "\<not> I_of N \<TTurnstile>e {D}" and
    d_min: "\<And>C. C \<in> N \<Longrightarrow> \<not> I_of N \<TTurnstile>e {C} \<Longrightarrow> D \<le> C"
  shows "\<exists>\<iota> \<in> Inf. prems_of \<iota> \<noteq> [] \<and> main_prem_of \<iota> = D \<and> set (side_prems_of \<iota>) \<subseteq> N
    \<and> I_of N \<TTurnstile>e set (side_prems_of \<iota>) \<and> \<not> I_of N \<TTurnstile>e {concl_of \<iota>} \<and> concl_of \<iota> < D"
  using bot_ni_n clausal_Inf_counterex_reducing d_in_n d_min n_ent_d by auto

sublocale counterex_reducing_inference_system "{{#}}" "(\<TTurnstile>e)" Inf I_of
  "(<) :: 'a clause \<Rightarrow> 'a clause \<Rightarrow> bool"
  using Inf_counterex_reducing
  by unfold_locales (simp_all add: less_eq_multiset_def)

end

subsection \<open>Counterexample-Reducing Calculi Equipped with a Standard Redundancy Criterion\<close>

locale clausal_counterex_reducing_calculus_with_standard_redundancy =
  calculus_with_standard_redundancy Inf "{{#}}" "(\<TTurnstile>e)" "(<) :: 'a clause \<Rightarrow> 'a clause \<Rightarrow> bool" +
  clausal_counterex_reducing_inference_system Inf J_of
  for
    Inf :: "('a :: wellorder) clause inference set" and
    J_of :: "'a clause set \<Rightarrow> 'a set"
begin

sublocale counterex_reducing_calculus_with_standard_inferance_redundancy "{{#}}" Inf "(\<TTurnstile>e)" Red_I
  Red_F I_of "(<) :: 'a clause \<Rightarrow> 'a clause \<Rightarrow> bool"
proof unfold_locales
  fix C D :: "'a clause"
  show "C \<noteq> D \<Longrightarrow> C < D \<or> D < C"
    by fastforce
qed

lemma clausal_saturated_model: "saturated N \<Longrightarrow> {#} \<notin> N \<Longrightarrow> J_of N \<TTurnstile>s N"
  by (simp add: saturated_model[simplified])

corollary clausal_saturated_complete: "saturated N \<Longrightarrow> (\<forall>I. \<not> I \<TTurnstile>s N) \<Longrightarrow> {#} \<in> N"
  using clausal_saturated_model by blast

end

end


theory FmapUtils
  imports "HOL-Library.Finite_Map" FactoredSystemLib
begin

\<comment> \<open>TODO
  A lemma 'fmrestrict\_set\_twice\_eq'
    'fmrestrict\_set ?vs (fmrestrict\_set ?vs ?f) = fmrestrict\_set ?vs ?f'
to replace the recurring proofs steps using 'by (simp add: fmfilter\_alt\_defs(4))' would make sense.\<close>

\<comment> \<open>NOTE hide the '++' operator from 'Map' to prevent warnings.\<close>
hide_const (open) Map.map_add
no_notation Map.map_add (infixl "++" 100)

\<comment> \<open>TODO more explicit proof.\<close>
lemma IN_FDOM_DRESTRICT_DIFF:
  fixes vs v f
  assumes "\<not>(v \<in> vs)" "fmdom' f \<subseteq> fdom" "v \<in> fmdom' f"
  shows "v \<in> fmdom' (fmrestrict_set (fdom - vs) f)"
  using assms
  by (metis DiffI Int_def Int_iff Set.filter_def fmdom'_filter fmfilter_alt_defs(4) inf.order_iff)

lemma disj_dom_drest_fupdate_eq: "
  disjnt (fmdom' x) vs \<Longrightarrow> (fmrestrict_set vs s = fmrestrict_set vs (x ++ s))
"
proof -
  fix vs s x
  assume P: "disjnt (fmdom' x) vs"
  moreover have 1: "\<forall>x''. (x'' \<in> vs) \<longrightarrow> (fmlookup (x ++ s) x'' = fmlookup s  x'')"
    by (metis calculation disjnt_iff fmap_add_ltr_def fmdom'_notD fmdom_notI fmlookup_add)
  moreover
  {
    fix x''
    have "fmlookup (fmrestrict_set vs s) x'' = fmlookup (fmrestrict_set vs (x ++ s)) x''"
      apply(cases "x'' \<notin> fmdom' x")
       apply(cases "x'' \<notin> vs")
        apply(auto simp add: "1")
      done
  }
  ultimately show "(fmrestrict_set vs s = fmrestrict_set vs (x ++ s))"
    using fmap_ext by blast
qed

\<comment> \<open>TODO refactor into 'FmapUtils.thy'.\<close>
lemma graph_plan_card_state_set:
  fixes PROB vs
  assumes "finite vs"
  shows "card (fmdom' (fmrestrict_set vs s)) \<le> card vs"
proof -
  let ?vs' = "fmdom' (fmrestrict_set vs s)"
  have "?vs' \<subseteq> vs"
    using fmdom'_restrict_set
    by metis
  moreover have "card ?vs' \<le> card vs"
    using assms calculation card_mono
    by blast
  ultimately show ?thesis by blast
qed

lemma exec_drest_5:
  fixes x vs
  assumes "fmdom' x \<subseteq> vs"
  shows "(fmrestrict_set vs x = x)"
proof -
  \<comment> \<open>TODO refactor and make into ISAR proof.\<close>
  {
    fix v
    have "fmlookup (fmrestrict_set vs x) v = fmlookup x v"
      apply(cases "v \<in> fmdom' x")
      subgoal using assms by auto
      subgoal by (simp add: fmdom'_notD)
      done
    then have "fmlookup (fmrestrict_set vs x) v = fmlookup x v"
      by fast
  }
  moreover have "fmlookup (fmrestrict_set vs x) = fmlookup x"
    using calculation fmap_ext
    by auto
  ultimately show ?thesis
    using fmlookup_inject
    by blast
qed

lemma graph_plan_lemma_5:
  fixes s s' vs
  assumes "(fmrestrict_set (fmdom' s - vs) s = fmrestrict_set (fmdom' s' - vs) s')"
    "(fmrestrict_set vs s = fmrestrict_set vs s')"
  shows "(s = s')"
proof -
  have "\<forall>x. fmlookup s x = fmlookup s' x"
    using assms(1, 2) fmdom'_notD fminusI fmlookup_restrict_set Diff_iff
    by metis
  then show ?thesis using fmap_ext
    by blast
qed

lemma drest_smap_drest_smap_drest:
  fixes x s vs
  shows "fmrestrict_set vs x \<subseteq>\<^sub>f s \<longleftrightarrow> fmrestrict_set vs x \<subseteq>\<^sub>f fmrestrict_set vs s"
proof -
  \<comment> \<open>TODO this could be refactored into standalone lemma since it's very common in proofs.\<close>
  have 1: "fmlookup (fmrestrict_set vs s) \<subseteq>\<^sub>m fmlookup s"
    by (metis fmdom'.rep_eq fmdom'_notI fmlookup_restrict_set map_le_def)
  moreover
  {
    assume P1: "fmrestrict_set vs x \<subseteq>\<^sub>f s"
    moreover have 2: "fmlookup (fmrestrict_set vs x) \<subseteq>\<^sub>m fmlookup s"
      using P1 fmsubset.rep_eq by blast
    {
      fix v
      assume "v \<in> fmdom' (fmrestrict_set vs x)"
      then have "fmlookup (fmrestrict_set vs x) v = fmlookup (fmrestrict_set vs s) v"
        by (metis (full_types) "2" domIff fmdom'_notI fmlookup_restrict_set map_le_def)
    }
    ultimately have "fmrestrict_set vs x \<subseteq>\<^sub>f fmrestrict_set vs s"
      unfolding fmsubset.rep_eq
      by (simp add: map_le_def)
  }
  moreover
  {
    assume P2: "fmrestrict_set vs x \<subseteq>\<^sub>f fmrestrict_set vs s"
    moreover have "fmrestrict_set vs s \<subseteq>\<^sub>f s"
      using 1 fmsubset.rep_eq
      by blast
    ultimately have "fmrestrict_set vs x \<subseteq>\<^sub>f s"
      using fmsubset.rep_eq map_le_trans
      by blast
  }
  ultimately show ?thesis by blast
qed

lemma sat_precond_as_proj_1:
  fixes s s' vs x
  assumes "fmrestrict_set vs s = fmrestrict_set vs s'"
  shows "fmrestrict_set vs x \<subseteq>\<^sub>f s \<longleftrightarrow> fmrestrict_set vs x \<subseteq>\<^sub>f s'"
  using assms drest_smap_drest_smap_drest
  by metis

lemma sat_precond_as_proj_4:
  fixes fm1 fm2 vs
  assumes "fm2 \<subseteq>\<^sub>f fm1"
  shows "(fmrestrict_set vs fm2 \<subseteq>\<^sub>f fm1)"
  using assms fmpred_restrict_set fmsubset_alt_def
  by metis

lemma sublist_as_proj_eq_as_1:
  fixes x s vs
  assumes "(x \<subseteq>\<^sub>f fmrestrict_set vs s)"
  shows "(x \<subseteq>\<^sub>f s)"
  using assms
  by (meson fmsubset.rep_eq fmsubset_alt_def fmsubset_pred drest_smap_drest_smap_drest map_le_refl)

lemma limited_dom_neq_restricted_neq:
  assumes "fmdom' f1 \<subseteq> vs" "f1 ++ f2 \<noteq> f2"
  shows "fmrestrict_set vs (f1 ++ f2) \<noteq> fmrestrict_set vs f2"
proof -
  {
    assume C: "fmrestrict_set vs (f1 ++ f2) = fmrestrict_set vs f2"
    then have "\<forall>x \<in> fmdom' (fmrestrict_set vs (f1 ++ f2)).
      fmlookup (fmrestrict_set vs (f1 ++ f2)) x
      = fmlookup (fmrestrict_set vs f2) x"
      by simp
    obtain v where a: "v \<in> fmdom' f1" "fmlookup (f1 ++ f2) v \<noteq> fmlookup f2 v"
      using assms(2)
      by (metis fmap_add_ltr_def fmap_ext fmdom'_notD fmdom_notI fmlookup_add)
    then have b: "v \<in> vs"
      using assms(1)
      by blast
    moreover {
      have "fmdom' (fmrestrict_set vs (f1 ++ f2)) = vs \<inter> fmdom' (f1 ++ f2)"
        by (simp add: fmdom'_alt_def fmfilter_alt_defs(4))
      then have "v \<in> fmdom' (fmrestrict_set vs (f1 ++ f2))"
        using C a b
        by fastforce
    }
    then have False
      by (metis C a(2) calculation fmlookup_restrict_set)
  }
  then show ?thesis
    by auto
qed

lemma fmlookup_fmrestrict_set_dom: "\<And>vs s. dom (fmlookup (fmrestrict_set vs s)) = vs \<inter> (fmdom' s)"
by (auto simp add: fmdom'_restrict_set_precise)

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsubsection \<open>Galois Connection\<close>
theory Transport_Functions_Galois_Connection
  imports
    Transport_Functions_Galois_Property
    Transport_Functions_Monotone
begin

paragraph \<open>Dependent Function Relator\<close>

context transport_Dep_Fun_Rel
begin

subparagraph \<open>Lemmas for Monotone Function Relator\<close>

lemma galois_connection_left_right_if_galois_connection_mono_2_assms_leftI:
  assumes galois_conn1: "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_R1: "reflexive_on (in_codom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and R2_le1: "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and mono_l2_2: "([x' \<Colon> in_codom (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>L2 x1 (r1 x')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x'\<^esub>)) l2"
  shows "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x2')\<^esub>)"
  and "\<And>x. x \<le>\<^bsub>L1\<^esub> x \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x) (l1 x)\<^esub>)) (l2\<^bsub>(l1 x) x\<^esub>) (l2\<^bsub>(l1 x) (\<eta>\<^sub>1 x)\<^esub>)"
proof -
  show "([in_codom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x2')\<^esub>)"
    if "x1' \<le>\<^bsub>R1\<^esub> x2'" for x1' x2'
  proof -
    from galois_conn1 \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> have "r1 x1' \<le>\<^bsub>L1\<^esub> r1 x2'" "r1 x2' \<^bsub>L1\<^esub>\<lessapprox> x2'"
      using refl_R1 by (auto intro: t1.right_Galois_if_reflexive_onI)
    with mono_l2_2 show ?thesis using R2_le1 \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> by fastforce
  qed
  show "([in_dom (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x) (l1 x)\<^esub>)) (l2\<^bsub>(l1 x) x\<^esub>) (l2\<^bsub>(l1 x) (\<eta>\<^sub>1 x)\<^esub>)"
    if "x \<le>\<^bsub>L1\<^esub> x" for x
  proof -
    from galois_conn1 \<open>x \<le>\<^bsub>L1\<^esub> x\<close> have "x \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x" "\<eta>\<^sub>1 x \<^bsub>L1\<^esub>\<lessapprox> l1 x"
      by (auto intro!: t1.right_Galois_if_right_relI
        t1.rel_unit_if_left_rel_if_half_galois_prop_right_if_mono_wrt_rel
          [unfolded t1.unit_eq])
    with mono_l2_2 show ?thesis by fastforce
  qed
qed

lemma galois_connection_left_right_if_galois_connection_mono_assms_leftI:
  assumes galois_conn1: "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_R1: "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and R2_le1: "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and mono_l2: "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  shows "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x1' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
  and "([x' \<Colon> in_codom (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>L2 x1 (r1 x')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x'\<^esub>)) l2"
proof -
  show "([in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x1' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
    if "x1' \<le>\<^bsub>R1\<^esub> x2'" for x1' x2'
  proof -
    from galois_conn1 \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> have "r1 x1' \<le>\<^bsub>L1\<^esub> r1 x1'" "r1 x1' \<^bsub>L1\<^esub>\<lessapprox> x1'"
      using refl_R1 by blast+
    with mono_l2 show ?thesis using \<open>x1' \<le>\<^bsub>R1\<^esub> x2'\<close> R2_le1 by (auto 9 0)
  qed
  from mono_l2 show "([x' \<Colon> in_codom (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>L2 x1 (r1 x')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x'\<^esub>)) l2" using refl_R1 by blast
qed

text \<open>In theory, the following lemmas can be obtained by taking the flipped,
inverse interpretation of the locale; however, rewriting the assumptions is more
involved than simply copying and adapting above proofs.\<close>

lemma galois_connection_left_right_if_galois_connection_mono_2_assms_rightI:
  assumes galois_conn1: "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_dom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and L2_le2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and mono_r2_2: "([x \<Colon> in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>R2 (l1 x) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x2')\<^esub>)) r2"
  shows "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x1)\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
  and "\<And>x'. x' \<le>\<^bsub>R1\<^esub> x' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 (r1 x') (r1 x')\<^esub>)) (r2\<^bsub>(r1 x') (\<epsilon>\<^sub>1 x')\<^esub>) (r2\<^bsub>(r1 x') x'\<^esub>)"
proof -
  show "([in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x1)\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
    if "x1 \<le>\<^bsub>L1\<^esub> x2" for x1 x2
  proof -
    from galois_conn1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x1 \<^bsub>L1\<^esub>\<lessapprox> l1 x1" "l1 x1 \<le>\<^bsub>R1\<^esub> l1 x2"
      using refl_L1 by (auto intro!: t1.Galois_left_if_reflexive_on_if_half_galois_prop_rightI)
    with mono_r2_2 show ?thesis using L2_le2 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> by (auto 9 0)
  qed
  show "([in_codom (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 (r1 x') (r1 x')\<^esub>)) (r2\<^bsub>(r1 x') (\<epsilon>\<^sub>1 x')\<^esub>) (r2\<^bsub>(r1 x') x'\<^esub>)"
    if "x' \<le>\<^bsub>R1\<^esub> x'" for x'
  proof -
    from galois_conn1 \<open>x' \<le>\<^bsub>R1\<^esub> x'\<close> have "r1 x' \<^bsub>L1\<^esub>\<lessapprox> \<epsilon>\<^sub>1 x'" "\<epsilon>\<^sub>1 x' \<le>\<^bsub>R1\<^esub> x'"
      by (auto intro!: t1.Galois_left_if_left_relI
        t1.counit_rel_if_right_rel_if_half_galois_prop_left_if_mono_wrt_rel
          [unfolded t1.counit_eq])
    with mono_r2_2 show ?thesis by fastforce
  qed
qed

lemma galois_connection_left_right_if_galois_connection_mono_assms_rightI:
  assumes galois_conn1: "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and refl_L1: "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and L2_le2: "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and mono_r2: "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  shows "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
  and "([x \<Colon> in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>R2 (l1 x) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x2')\<^esub>)) r2"
proof -
  show "([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
    if "x1 \<le>\<^bsub>L1\<^esub> x2" for x1 x2
  proof -
    from galois_conn1 \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> have "x2 \<^bsub>L1\<^esub>\<lessapprox> l1 x2" "l1 x2 \<le>\<^bsub>R1\<^esub> l1 x2"
      using refl_L1 by (blast intro: t1.Galois_left_if_reflexive_on_if_half_galois_prop_rightI)+
    with mono_r2 show ?thesis using \<open>x1 \<le>\<^bsub>L1\<^esub> x2\<close> L2_le2 by fastforce
  qed
  from mono_r2 show "([x \<Colon> in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>R2 (l1 x) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x2')\<^esub>)) r2" using refl_L1 by blast
qed

end

paragraph \<open>Monotone Dependent Function Relator\<close>

context transport_Mono_Dep_Fun_Rel
begin

interpretation flip : transport_Mono_Dep_Fun_Rel R1 L1 r1 l1 R2 L2 r2 l2 .

lemma galois_connection_left_rightI:
  assumes "(tdfr.L \<Rrightarrow>\<^sub>m tdfr.R) l" and "(tdfr.R \<Rrightarrow>\<^sub>m tdfr.L) r"
  and "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_dom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<unlhd> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x2 x2\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x. x \<le>\<^bsub>L1\<^esub> x \<Longrightarrow> (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>) \<le> (\<le>\<^bsub>L2 x x\<^esub>)"
  and "\<And>x'. x' \<le>\<^bsub>R1\<^esub> x' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>) \<le> (\<le>\<^bsub>R2 x' x'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 x1' x1'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x. x \<le>\<^bsub>L1\<^esub> x \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x) (l1 x)\<^esub>)) (l2\<^bsub>(l1 x) x\<^esub>) (l2\<^bsub>(l1 x) (\<eta>\<^sub>1 x)\<^esub>)"
  and "\<And>x'. x' \<le>\<^bsub>R1\<^esub> x' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 (r1 x') (r1 x')\<^esub>)) (r2\<^bsub>(r1 x') (\<epsilon>\<^sub>1 x')\<^esub>) (r2\<^bsub>(r1 x') x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms
  by (intro galois_connectionI galois_prop_left_rightI' mono_wrt_rel_leftI
    flip.mono_wrt_rel_leftI)
  auto

lemma galois_connection_left_rightI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_dom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ((\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> ((\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<unlhd> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x2 x2\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 x1' x1'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x1' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x2')\<^esub>)"
  and "\<And>x. x \<le>\<^bsub>L1\<^esub> x \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x) (l1 x)\<^esub>)) (l2\<^bsub>(l1 x) x\<^esub>) (l2\<^bsub>(l1 x) (\<eta>\<^sub>1 x)\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x1)\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
  and "\<And>x'. x' \<le>\<^bsub>R1\<^esub> x' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 (r1 x') (r1 x')\<^esub>)) (r2\<^bsub>(r1 x') (\<epsilon>\<^sub>1 x')\<^esub>) (r2\<^bsub>(r1 x') x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms
  by (intro galois_connection_left_rightI tdfr.mono_wrt_rel_left_if_transitiveI
    tdfr.mono_wrt_rel_right_if_transitiveI)
  auto

lemma galois_connection_left_right_if_galois_connectionI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_dom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<stileturn> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x2 x2\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 x1' x1'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x1' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x2' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x2')\<^esub>)"
  and "\<And>x. x \<le>\<^bsub>L1\<^esub> x \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 x (\<eta>\<^sub>1 x)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x) (l1 x)\<^esub>)) (l2\<^bsub>(l1 x) x\<^esub>) (l2\<^bsub>(l1 x) (\<eta>\<^sub>1 x)\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x1)\<^esub>) (r2\<^bsub>x1 (l1 x2)\<^esub>)"
  and "\<And>x'. x' \<le>\<^bsub>R1\<^esub> x' \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x') x'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 (r1 x') (r1 x')\<^esub>)) (r2\<^bsub>(r1 x') (\<epsilon>\<^sub>1 x')\<^esub>) (r2\<^bsub>(r1 x') x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms
  by (intro galois_connection_left_rightI'
    tdfr.mono_wrt_rel_left2_if_mono_wrt_rel_left2_if_GaloisI
    tdfr.mono_wrt_rel_right2_if_mono_wrt_rel_right2_if_GaloisI)
  (auto 7 0)

corollary galois_connection_left_right_if_galois_connectionI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow>
    ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<stileturn> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x2 x2\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 x1' x1'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow>
    ([in_dom (\<le>\<^bsub>L2 (r1 x1') (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 x1' x2'\<^esub>)) (l2\<^bsub>x1' (r1 x1')\<^esub>) (l2\<^bsub>x2' (r1 x1')\<^esub>)"
  and "([x' \<Colon> in_codom (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>L2 x1 (r1 x')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x'\<^esub>)) l2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow>
    ([in_codom (\<le>\<^bsub>R2 (l1 x1) (l1 x2)\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 x2\<^esub>)) (r2\<^bsub>x1 (l1 x2)\<^esub>) (r2\<^bsub>x2 (l1 x2)\<^esub>)"
  and "([x \<Colon> in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>\<^sub>m
    [in_field (\<le>\<^bsub>R2 (l1 x) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (intro galois_connection_left_right_if_galois_connectionI
    tdfr.galois_connection_left_right_if_galois_connection_mono_2_assms_leftI
    tdfr.galois_connection_left_right_if_galois_connection_mono_2_assms_rightI)
  (auto intro: reflexive_on_if_le_pred_if_reflexive_on
    in_field_if_in_dom in_field_if_in_codom)

corollary galois_connection_left_right_if_mono_if_galois_connectionI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<stileturn> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x2 x2\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> (\<le>\<^bsub>L2 x1 (\<eta>\<^sub>1 x2)\<^esub>) \<le> (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 (\<epsilon>\<^sub>1 x1') x2'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> (\<le>\<^bsub>R2 x1' x1'\<^esub>) \<le> (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (intro galois_connection_left_right_if_galois_connectionI'
    tdfr.galois_connection_left_right_if_galois_connection_mono_assms_leftI
    tdfr.galois_connection_left_right_if_galois_connection_mono_assms_rightI)
  auto

corollary galois_connection_left_right_if_mono_if_galois_connectionI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_field (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_field (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "\<And>x x'. x \<^bsub>L1\<^esub>\<lessapprox> x' \<Longrightarrow> ((\<le>\<^bsub>L2 x (r1 x')\<^esub>) \<stileturn> (\<le>\<^bsub>R2 (l1 x) x'\<^esub>)) (l2\<^bsub>x' x\<^esub>) (r2\<^bsub>x x'\<^esub>)"
  and "([_ x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x3 x4 \<Colon> (\<le>\<^bsub>L1\<^esub>) | (x2 \<le>\<^bsub>L1\<^esub> x3 \<and> x4 \<le>\<^bsub>L1\<^esub> \<eta>\<^sub>1 x3)] \<Rrightarrow> (\<ge>)) L2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | \<epsilon>\<^sub>1 x2' \<le>\<^bsub>R1\<^esub> x1'] \<Rrightarrow>\<^sub>m [x3' _ \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2' \<le>\<^bsub>R1\<^esub> x3'] \<Rrightarrow> (\<le>)) R2"
  and "([x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>)] \<Rrightarrow>\<^sub>m [x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)) l2"
  and "([x1 x2 \<Colon> (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m [x1' x2' \<Colon> (\<le>\<^bsub>R1\<^esub>) | x2 \<^bsub>L1\<^esub>\<lessapprox> x1'] \<Rrightarrow>
    [in_field (\<le>\<^bsub>R2 (l1 x1) x2'\<^esub>)] \<Rrightarrow> (\<le>\<^bsub>L2 x1 (r1 x2')\<^esub>)) r2"
  and "\<And>x1 x2. x1 \<le>\<^bsub>L1\<^esub> x2 \<Longrightarrow> transitive (\<le>\<^bsub>L2 x1 x2\<^esub>)"
  and "\<And>x1' x2'. x1' \<le>\<^bsub>R1\<^esub> x2' \<Longrightarrow> transitive (\<le>\<^bsub>R2 x1' x2'\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (intro galois_connection_left_right_if_mono_if_galois_connectionI
    tdfr.left_rel_right_iff_left_right_rel_if_galois_prop_le_assms_leftI
    tdfr.left_rel_right_iff_left_right_rel_if_galois_prop_le_assms_rightI)
  auto

end

paragraph \<open>Monotone Function Relator\<close>

context transport_Mono_Fun_Rel
begin

interpretation flip : transport_Mono_Fun_Rel R1 L1 r1 l1 R2 L2 r2 l2 .

lemma galois_connection_left_rightI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<stileturn> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "reflexive_on (in_codom (\<le>\<^bsub>L1\<^esub>)) (\<le>\<^bsub>L1\<^esub>)"
  and "reflexive_on (in_dom (\<le>\<^bsub>R1\<^esub>)) (\<le>\<^bsub>R1\<^esub>)"
  and "((\<le>\<^bsub>L2\<^esub>) \<stileturn> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and "transitive (\<le>\<^bsub>L2\<^esub>)"
  and "transitive (\<le>\<^bsub>R2\<^esub>)"
  shows "((\<le>\<^bsub>L\<^esub>) \<stileturn> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (intro tpdfr.galois_connectionI galois_prop_left_rightI
    mono_wrt_rel_leftI flip.mono_wrt_rel_leftI)
  auto

end

end


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

ML "Header.initialize
    [\"NotFalse\", \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\",
     \"OrDef\", \"OtherwiseDef\", \"NotFalse1\", \"NotTrue1\",
     \"notNot1\", \"notNot2\", \"EqualTDef\", \"EqualSymDef\",
     \"EqualReflex\", \"EqualTransT\", \"DiffDef\", \"DiffSymDef\",
     \"DiffTDef\", \"DiffFDef\", \"TE1\", \"TE2\", \"TE3\", \"TE4\",
     \"IUE1\", \"IUE2\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\",
     \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\", \"IOE04\", \"IOE05\",
     \"IOE06\", \"LeIrreflexivity\", \"LeTTransitive\", \"LeTTotal\",
     \"GeDef\", \"LeqDef\", \"GeqDef\", \"EqTSOrdRel\", \"EqFSOrdRel\",
     \"EqTOrdRel\", \"EqFOrdRel\", \"EqTOrdTSubstE\", \"EqTOrdFSubstE\",
     \"EqTOrdTSubstD\", \"EqTOrdFSubstD\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\",
     \"MaxYDef\", \"MaxXDef\", \"MinXDef\", \"MinYDef\", \"IOO13\",
     \"IOO14\", \"IOO15\", \"IBO5\", \"IOE01\", \"IOE02\", \"IOE03\",
     \"IOE07\", \"IOE08\", \"IOE09\", \"LeTAsymmetry\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"LeqReflexivity\", \"LeqTTransitive\",
     \"LeqTTotal\", \"GeqReflexivity\", \"GeqTTransitive\",
     \"GeqTTotal\", \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\",
     \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\",
     \"GeqFLeqFRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\", \"TO3\", \"TO4\",
     \"TO5\", \"TO6\", \"TO7\", \"IUO01\", \"IUO02\", \"IUO03\",
     \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"IOO16\", \"IOO17\",
     \"IOO18\", \"IOO19\", \"IOO20\", \"IOO21\", \"IOO22\", \"IOO23\",
     \"IOO24\", \"IOO25\", \"IOO26\", \"IOO27\", \"IOO28\", \"IOO29\",
     \"IOO30\", \"IOO31\", \"IOO32\", \"IOO33\", \"IBO6\", \"IBO7\",
     \"IBO8\", \"IBO9\", \"IBO10\", \"IBO11\", \"IBO12\"]"

typedecl Bool
typedecl Unit
typedecl X_Nat

datatype Ordering = EQ | GT | LT

consts
Not__X :: "bool => bool" ("(Not''/ _)" [56] 56)
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a partial => 'a partial => bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a partial => 'a partial => bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a partial => 'a partial => bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a partial => 'a partial => bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a partial => 'a partial => bool" ("(_/ <''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a partial => 'a partial => bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
X_max :: "'a partial => 'a partial => 'a partial"
X_min :: "'a partial => 'a partial => 'a partial"
compare :: "'a partial => 'a partial => Ordering partial"
otherwiseH :: "bool"

axioms
NotFalse [rule_format] : "Not' False"

NotTrue [rule_format] : "~ Not' True"

AndFalse [rule_format] : "ALL x. ~ False && x"

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

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

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

OtherwiseDef [rule_format] : "otherwiseH"

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

NotTrue1 [rule_format] : "ALL x. ~ Not' x = x"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IUE2 [rule_format] : "~ makePartial () /= makePartial ()"

IBE1 [rule_format] : "makePartial () ==' makePartial ()"

IBE2 [rule_format] : "undefinedOp ==' undefinedOp"

IBE3 [rule_format] : "~ undefinedOp ==' makePartial ()"

IBE4 [rule_format] : "~ makePartial () ==' undefinedOp"

IBE5 [rule_format] : "makePartial () /= undefinedOp"

IBE6 [rule_format] : "undefinedOp /= makePartial ()"

IBE7 [rule_format] : "Not' (makePartial () ==' undefinedOp)"

IBE8 [rule_format] : "~ Not' Not' (makePartial () ==' undefinedOp)"

IOE04 [rule_format] : "~ makePartial LT ==' makePartial EQ"

IOE05 [rule_format] : "~ makePartial LT ==' makePartial GT"

IOE06 [rule_format] : "~ makePartial EQ ==' makePartial GT"

LeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y --> ~ x <' y"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IOO13 [rule_format] : "makePartial LT <' makePartial EQ"

IOO14 [rule_format] : "makePartial EQ <' makePartial GT"

IOO15 [rule_format] : "makePartial LT <' makePartial GT"

IBO5 [rule_format] : "undefinedOp <' makePartial ()"

declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]
declare NotTrue1 [simp]
declare EqualReflex [simp]
declare IUE1 [simp]
declare IUE2 [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare LeIrreflexivity [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IBO5 [simp]

theorem IOE01 : "makePartial LT ==' makePartial LT"
by (auto)

ML "Header.record \"IOE01\""

theorem IOE02 : "makePartial EQ ==' makePartial EQ"
by (auto)

ML "Header.record \"IOE02\""

theorem IOE03 : "makePartial GT ==' makePartial GT"
by (auto)

ML "Header.record \"IOE03\""

theorem IOE07 : "makePartial LT /= makePartial EQ"
apply(simp add: DiffDef)
done

ML "Header.record \"IOE07\""

theorem IOE08 : "makePartial LT /= makePartial GT"
apply(simp add: DiffDef)
done

ML "Header.record \"IOE08\""

theorem IOE09 : "makePartial EQ /= makePartial GT"
apply(simp add: DiffDef)
done

ML "Header.record \"IOE09\""

lemma LeIrreflContra : "ALL x. x <' x ==> False"
by auto

theorem LeTAsymmetry : "ALL x. ALL y. x <' y --> ~ y <' x"
sorry

ML "Header.record \"LeTAsymmetry\""

theorem GeIrreflexivity : "ALL x. ALL y. x ==' y --> ~ x >' y"
apply (auto)
apply(simp add: GeDef)
apply(simp add: EqualSymDef LeIrreflexivity)
done

ML "Header.record \"GeIrreflexivity\""

theorem GeTAsymmetry : "ALL x. ALL y. x >' y --> ~ y >' x"
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeTAsymmetry)
done

ML "Header.record \"GeTAsymmetry\""

theorem GeTTransitive :
"ALL x. ALL y. ALL z. (x >' y) && (y >' z) --> x >' z"
apply(auto)
apply(simp add: GeDef)
thm LeTTransitive
apply(rule_tac x="(ab, bb)" and y="(aa, ba)" and z="(a,b)" in  LeTTransitive)
apply(auto)
apply(case_tac  "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac  "(aa, ba) <' (a, b)")
by(auto)

ML "Header.record \"GeTTransitive\""

theorem GeTTotal :
"ALL x. ALL y. ((x >' y) || (y >' x)) || (x ==' y)"
apply(auto)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeFGeTEqTRel)
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeTAsymmetry)
apply(simp add: EqualSymDef)
done

ML "Header.record \"GeTTotal\""

theorem LeqReflexivity : "ALL x. x <=' x"
apply(auto)
apply(simp add: LeqDef)
apply(simp add: OrDef)
done

ML "Header.record \"LeqReflexivity\""

lemma EqualL1 [rule_format]:
"ALL a b ab bb.
 ((a, b) ==' (ab, bb)) & ~ ((a, b) ==' (ab, bb)) \<longrightarrow> False"
by(auto)

lemma EqualL2 [rule_format]:
"ALL a b aa ab ba bb.
((a, b) ==' (aa, ba)) & ((aa, ba) ==' (ab, bb)) \<longrightarrow> ~ ((a, b) ==' (ab, bb)) \<longrightarrow> False"
apply(simp add: EqualL1)
apply(auto)
apply(rule EqualTransT)
by(auto)

lemma EqualL3 [rule_format]:
"ALL a b aa ab ba bb.
~ ((a, b) ==' (aa, ba)) | ~ ((aa, ba) ==' (ab, bb)) | ~ ((a, b) ==' (ab, bb)) \<longrightarrow> False \<longrightarrow> False"
by(auto)

lemma Le1E [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ((a, b) <' (ab, bb)) \<longrightarrow> ((aa, ba) <' (ab, bb))"
apply (auto)
apply(rule EqTOrdTSubstE)
by(auto)

lemma Le2 [rule_format]:
"ALL a b aa ab ba bb.
((a, b) <' (aa, ba)) \<longrightarrow> ~ ((a, b) <' (aa, ba)) \<longrightarrow> False"
by auto

lemma Le3E [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ((a, b) <' (ab, bb)) \<longrightarrow> ~ ((aa, ba) <' (ab, bb)) \<longrightarrow> False"
apply (auto)
apply(rule EqTOrdTSubstE)
by(auto)

lemma Le3D [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ((ab, bb) <' (a, b)) \<longrightarrow> ~ ((ab, bb) <' (aa, ba)) \<longrightarrow> False"
apply (auto)
apply(rule EqTOrdTSubstD)
apply(auto)
done

lemma Le4E [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ~ ((a, b) <' (ab, bb)) \<longrightarrow> ~ ((aa, ba) <' (ab, bb))"
apply (auto)
apply(rule Le3E)
apply(auto)
apply(simp add: EqualSymDef)
done

lemma Le4D [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ~ ((ab, bb) <' (a, b)) \<longrightarrow> ~ ((ab, bb) <' (aa, ba))"
apply (auto)
apply(rule Le3D)
apply(auto)
apply(simp add: EqualSymDef)
done

lemma Le5 [rule_format]:
"ALL a b aa ab ba bb.
~ ((a, b) <' (aa, ba)) \<longrightarrow> ((a, b) <' (aa, ba)) \<longrightarrow> False"
by auto

lemma Le6E [rule_format]:
"ALL a b aa ab ba bb.
((aa, ba) ==' (a, b)) & ~ ((a, b) <' (ab, bb)) \<longrightarrow> ((aa, ba) <' (ab, bb)) \<longrightarrow> False"
apply (auto)
apply(rule Le5)
apply(rule EqTOrdFSubstE)
apply(auto)
done

lemma Le7 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) <' (aa, ba) & ~ (a, b) <' (aa, ba) \<longrightarrow> False"
by auto

lemma Le8 [rule_format]:
"ALL a b aa ab ba bb.
(ab, bb) ==' (aa, ba) & (a, b) <' (aa, ba) \<longrightarrow> (a, b) <' (ab, bb)"
apply auto
apply(rule EqTOrdTSubstD)
apply(rule conjI)
by(auto)

lemma Le9 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) <' (aa, ba) & (aa, ba) ==' (ab, bb) \<longrightarrow> ~ (a, b) <' (ab, bb) \<longrightarrow> False"
apply auto
apply(rule Le8)
apply(auto)
apply (simp add: EqualSymDef)
done

lemma Le10 [rule_format]:
"ALL a b aa ab ba bb.
(aa, ba) <' (ab, bb) & (a, b) ==' (aa, ba) \<longrightarrow> ~ (a, b) <' (ab, bb) \<longrightarrow> False"
apply auto
apply(rule EqTOrdTSubstE)
apply(rule conjI)
by(auto)

lemma Le11 [rule_format]:
"ALL a b aa ab ba bb.
(ab, bb) <' (aa, ba) & (aa, ba) <' (a, b) \<longrightarrow> ~ (ab, bb) <' (a, b) \<longrightarrow> False"
apply(auto)
apply(rule LeTTransitive)
apply(auto)
done

lemma Le12 [rule_format]:
"ALL a b aa ab ba bb.
(aa, ba) <' (a, b) & (aa, ba) ==' (ab, bb) \<longrightarrow> ~ (ab, bb) <' (a, b) \<longrightarrow> False"
apply(auto)
apply(rule EqTOrdTSubstE)
apply(rule conjI)
apply(auto)
apply(simp add: EqualSymDef)
done

lemma Le13 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) <' (ab, bb) & (ab, bb) <' (aa, ba) \<longrightarrow> ~ (a, b) <' (aa, ba) \<longrightarrow> False"
apply(auto)
apply(rule LeTTransitive)
apply(rule conjI)
apply(auto)
done

lemma Le14 [rule_format]:
"ALL a b aa ab ba bb.
~ (a, b) <' (a, b)"
by(auto)

lemma Le15 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) <' (ab, bb) & (ab, bb) <' (aa, ba) \<longrightarrow> (a, b) <' (aa, ba) & (aa, ba) <' (a, b) \<longrightarrow> False"
apply(auto)
apply(simp add: LeTAsymmetry)
done

lemma Le16 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) ==' (aa, ba) & (ab, bb) <' (aa, ba) \<longrightarrow> (ab, bb) <' (a, b) & ~ (ab, bb) <' (a, b) \<longrightarrow> False"
by(auto)

lemma Le17 [rule_format]:
"ALL a b aa ab ba bb.
(ab, bb) <' (aa, ba) & (a, b) ==' (aa, ba) \<longrightarrow> (ab, bb) <' (a, b)"
apply(auto)
apply(rule EqTOrdTSubstD)
apply(rule conjI)
apply(auto)
done

lemma Le18 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) <' (ab, bb) & ~ (a, b) <' (ab, bb) \<longrightarrow> False"
by(auto)

lemma Le19 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) ==' (aa, ba) & (aa, ba) <' (ab, bb) \<longrightarrow> ~ (a, b) <' (ab, bb) \<longrightarrow> False"
apply(auto)
apply(rule EqTOrdTSubstE)
apply(auto)
done

lemma Le20 [rule_format]:
"ALL a b aa ab ba bb.
(a, b) ==' (aa, ba) & (ab, bb) <' (aa, ba) \<longrightarrow> ~ (ab, bb) <' (a, b) \<longrightarrow> False"
apply(auto)
apply(rule EqTOrdTSubstD)
apply(auto)
done

theorem LeqTTransitive :
"ALL x. ALL y. ALL z. (x <=' y) && (y <=' z) --> x <=' z"
apply(auto)
apply(simp add: LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
(*Here we needed the first aux lemma*)
apply(rule Le18)
apply(rule conjI)
apply(rule LeTTransitive)
apply(auto)
apply(case_tac "(aa, ba) ==' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(rule Le9)
apply(rule conjI)
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(rule Le19)
apply(auto)
apply(case_tac "(aa, ba) ==' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) <' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(rule EqualL2)
by(auto)

ML "Header.record \"LeqTTransitive\""

theorem LeqTTotal :
"ALL x. ALL y. (x <=' y) && (y <=' x) = x ==' y"
apply(auto)
apply(simp add: LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(simp add: LeTAsymmetry)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeqDef)
apply(simp add: OrDef)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef EqualL1)
done

ML "Header.record \"LeqTTotal\""

theorem GeqReflexivity : "ALL x. x >=' x"
apply(auto)
apply(simp add: GeqDef)
apply(simp add: OrDef)
apply(simp add: AndSym)
done

ML "Header.record \"GeqReflexivity\""

theorem GeqTTransitive :
"ALL x. ALL y. ALL z. (x >=' y) && (y >=' z) --> x >=' z"
apply(auto)
apply(simp add: GeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
(*Here we needed the first aux lemma*)
apply(simp add: GeDef)
apply(rule Le18)
apply(rule conjI)
apply(rule LeTTransitive)
apply(auto)
apply(case_tac "(aa, ba) ==' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(simp add: GeDef)
apply(rule Le10)
apply(rule conjI)
apply(simp add: EqualSymDef)+
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(simp add: GeDef)
apply(rule Le20)
apply(rule conjI)
apply(simp add: EqualSymDef)+
apply(case_tac "(aa, ba) ==' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) >' (ab, bb)")
apply(auto)
apply(case_tac "(a, b) ==' (ab, bb)")
apply(auto)
apply(rule EqualL2)
by(auto)

ML "Header.record \"GeqTTransitive\""

theorem GeqTTotal :
"ALL x. ALL y. (x >=' y) && (y >=' x) = x ==' y"
apply(auto)
apply(simp add: GeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeTAsymmetry)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef EqualL1)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef EqualL1)
done

ML "Header.record \"GeqTTotal\""

theorem LeTGeTRel : "ALL x. ALL y. x <' y = y >' x"
apply(auto)
apply(simp add: GeDef)+
done

ML "Header.record \"LeTGeTRel\""

theorem LeFGeFRel : "ALL x. ALL y. (~ x <' y) = (~ y >' x)"
apply(auto)
apply(simp add: GeDef)+
done

ML "Header.record \"LeFGeFRel\""

theorem LeqTGetTRel : "ALL x. ALL y. x <=' y = y >=' x"
apply(auto)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: GeDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef)
done

ML "Header.record \"LeqTGetTRel\""

theorem LeqFGetFRel : "ALL x. ALL y. (~ x <=' y) = (~ y >=' x)"
apply(auto)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(aa, ba) >' (a, b)")
apply(auto)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef)
done

ML "Header.record \"LeqFGetFRel\""

theorem GeTLeTRel : "ALL x. ALL y. x >' y = y <' x"
apply(auto)
apply(simp add: GeDef)+
done

ML "Header.record \"GeTLeTRel\""

theorem GeFLeFRel : "ALL x. ALL y. (~ x >' y) = (~ y <' x)"
apply(auto)
apply(simp add: GeDef)+
done

ML "Header.record \"GeFLeFRel\""

theorem GeqTLeqTRel : "ALL x. ALL y. x >=' y = y <=' x"
apply(auto)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef)
done

ML "Header.record \"GeqTLeqTRel\""

theorem GeqFLeqFRel : "ALL x. ALL y. (~ x >=' y) = (~ y <=' x)"
apply(auto)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(aa, ba) <' (a, b)")
apply(auto)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(case_tac "(aa, ba) ==' (a, b)")
apply(auto)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef)
done

ML "Header.record \"GeqFLeqFRel\""

theorem LeqTGeFRel : "ALL x. ALL y. x <=' y = (~ x >' y)"
apply(auto)
apply(simp add: GeqDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: EqualSymDef)
apply(simp add: GeDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeTAsymmetry)
apply(simp add: GeDef)
done

ML "Header.record \"LeqTGeFRel\""

theorem LeqFGeTRel : "ALL x. ALL y. (~ x <=' y) = x >' y"
apply(auto)
apply(simp add: GeDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(simp add: GeDef)
apply(simp add: GeDef LeqDef)
apply(simp add: OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(simp add: LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef LeTAsymmetry)
done

ML "Header.record \"LeqFGeTRel\""

theorem GeTLeFEqFRel :
"ALL x. ALL y. x >' y = (~ x <' y & ~ x ==' y)"
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(simp add: GeDef)
apply(simp add: EqualSymDef LeTAsymmetry)
apply(simp add: EqFSOrdRel)
done

ML "Header.record \"GeTLeFEqFRel\""

theorem GeFLeTEqTRel :
"ALL x. ALL y. (~ x >' y) = (x <' y | x ==' y)"
apply(auto)
apply(simp add: LeTGeFEqFRel)
apply(simp add: GeDef LeTAsymmetry)
apply(simp add: GeDef)
apply(simp add: EqualSymDef)
done

ML "Header.record \"GeFLeTEqTRel\""

theorem GeqTLeFRel : "ALL x. ALL y. x >=' y = (~ x <' y)"
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(simp add: GeDef LeTAsymmetry)
done

ML "Header.record \"GeqTLeFRel\""

theorem GeqFLeTRel : "ALL x. ALL y. (~ x >=' y) = x <' y"
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(simp add: GeDef LeTAsymmetry)
apply(rule disjE)
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
by(auto)

ML "Header.record \"GeqFLeTRel\""

theorem LeqTLeTEqTRel :
"ALL x. ALL y. x <=' y = (x <' y | x ==' y)"
apply(auto)
apply(simp add: LeqDef OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(simp add: LeqDef OrDef LeTAsymmetry)+
done

ML "Header.record \"LeqTLeTEqTRel\""

theorem LeqFLeFEqFRel :
"ALL x. ALL y. (~ x <=' y) = (~ x <' y & ~ x ==' y)"
apply(auto)
apply(simp add: LeqDef OrDef)+
done

ML "Header.record \"LeqFLeFEqFRel\""

theorem GeqTGeTEqTRel :
"ALL x. ALL y. x >=' y = (x >' y | x ==' y)"
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeqDef OrDef)+
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
done

ML "Header.record \"GeqTGeTEqTRel\""

theorem GeqFGeFEqFRel :
"ALL x. ALL y. (~ x >=' y) = (~ x >' y & ~ x ==' y)"
apply(auto)
apply(simp add: GeqDef OrDef)+
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeqDef OrDef)+
done

ML "Header.record \"GeqFGeFEqFRel\""

theorem LeTGeqFRel : "ALL x. ALL y. x <' y = (~ x >=' y)"
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(simp add: GeDef LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeqDef OrDef)
apply(case_tac "(a, b) >' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(simp add: GeDef LeTAsymmetry)
apply(rule disjE)
by(auto)

ML "Header.record \"LeTGeqFRel\""

theorem GeTLeqFRel : "ALL x. ALL y. x >' y = (~ x <=' y)"
apply(auto)
apply(simp add: GeDef LeqDef OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(simp add: LeTAsymmetry)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: EqualSymDef)
apply(simp add: LeqDef OrDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: GeDef)
apply(simp add: LeFGeTEqTRel)
apply(simp add: EqFSOrdRel)
apply(simp add: GeDef LeTAsymmetry)
done

ML "Header.record \"GeTLeqFRel\""

theorem LeLeqDiff : "ALL x. ALL y. x <' y = (x <=' y) && (x /= y)"
apply(auto)
apply(simp add: LeqDef OrDef)
apply(simp add: DiffDef)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
apply(simp add: LeqDef OrDef)
apply(simp add: DiffDef)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
done

ML "Header.record \"LeLeqDiff\""

theorem MaxSym : "ALL x. ALL y. X_max x y ==' y = X_max y x ==' y"
by (auto)

ML "Header.record \"MaxSym\""

theorem MinSym : "ALL x. ALL y. X_min x y ==' y = X_min y x ==' y"
by (auto)

ML "Header.record \"MinSym\""

theorem TO1 : "ALL x. ALL y. (x ==' y | x <' y) = x <=' y"
apply(auto)
apply(simp add: LeqDef OrDef)+
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
done

ML "Header.record \"TO1\""

theorem TO2 : "ALL x. ALL y. x ==' y --> ~ x <' y"
by (auto)

ML "Header.record \"TO2\""

theorem TO3 : "ALL x. ALL y. Not' Not' (x <' y) | Not' (x <' y)"
by (auto)

ML "Header.record \"TO3\""

theorem TO4 : "ALL x. ALL y. x <' y --> Not' (x ==' y)"
apply(auto)
apply(case_tac "(a, b) ==' (aa, ba)")
apply(auto)
done

ML "Header.record \"TO4\""

theorem TO5 :
"ALL w. ALL x. ALL y. ALL z. (x <' y & y <' z) & z <' w --> x <' w"
apply(auto)
apply(rule_tac y="(ab, bb)" in LeTTransitive)
apply(auto)
apply(rule_tac y="(ac, bc)" in LeTTransitive)
by auto

ML "Header.record \"TO5\""

theorem TO6 : "ALL x. ALL z. z <' x --> Not' (x <' z)"
apply(auto)
apply(case_tac "(a, b) <' (aa, ba)")
apply(auto)
apply(simp add: LeTAsymmetry)
done

ML "Header.record \"TO6\""

theorem TO7 : "ALL x. ALL y. x <' y = y >' x"
apply(auto)
apply(simp add: GeDef)+
done

ML "Header.record \"TO7\""

theorem IUO01 : "makePartial () <=' makePartial ()"
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IUO01\""

theorem IUO02 : "~ makePartial () <' makePartial ()"
by (auto)

ML "Header.record \"IUO02\""

theorem IUO03 : "makePartial () >=' makePartial ()"
apply(simp add: GeqDef OrDef)
apply(case_tac "makePartial () >' makePartial ()")
apply(auto)
done

ML "Header.record \"IUO03\""

theorem IUO04 : "~ makePartial () >' makePartial ()"
apply(simp add: GeDef)
done

ML "Header.record \"IUO04\""

theorem IUO05 :
"X_max (makePartial ()) (makePartial ()) ==' makePartial ()"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IUO05\""

theorem IUO06 :
"X_min (makePartial ()) (makePartial ()) ==' makePartial ()"
apply(simp add: MinXDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IUO06\""

theorem IUO07 :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"
by (auto)

ML "Header.record \"IUO07\""

theorem IOO16 : "makePartial LT <=' makePartial EQ"
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO16\""

theorem IOO17 : "makePartial EQ <=' makePartial GT"
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO17\""

theorem IOO18 : "makePartial LT <=' makePartial GT"
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO18\""

theorem IOO19 : "makePartial EQ >=' makePartial LT"
apply(simp add: GeqDef OrDef GeDef)
done

ML "Header.record \"IOO19\""

theorem IOO20 : "makePartial GT >=' makePartial EQ"
apply(simp add: GeqDef OrDef GeDef)
done

ML "Header.record \"IOO20\""

theorem IOO21 : "makePartial GT >=' makePartial LT"
apply(simp add: GeqDef OrDef GeDef)
done

ML "Header.record \"IOO21\""

theorem IOO22 : "makePartial EQ >' makePartial LT"
apply(simp add: GeDef OrDef)
done

ML "Header.record \"IOO22\""

theorem IOO23 : "makePartial GT >' makePartial EQ"
apply(simp add: GeDef OrDef)
done

ML "Header.record \"IOO23\""

theorem IOO24 : "makePartial GT >' makePartial LT"
apply(simp add: GeDef OrDef)
done

ML "Header.record \"IOO24\""

theorem IOO25 :
"X_max (makePartial LT) (makePartial EQ) ==' makePartial EQ"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO25\""

theorem IOO26 :
"X_max (makePartial EQ) (makePartial GT) ==' makePartial GT"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO26\""

theorem IOO27 :
"X_max (makePartial LT) (makePartial GT) ==' makePartial GT"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO27\""

theorem IOO28 :
"X_min (makePartial LT) (makePartial EQ) ==' makePartial LT"
apply(simp add: MinXDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO28\""

theorem IOO29 :
"X_min (makePartial EQ) (makePartial GT) ==' makePartial EQ"
apply(simp add: MinXDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO29\""

theorem IOO30 :
"X_min (makePartial LT) (makePartial GT) ==' makePartial LT"
apply(simp add: MinXDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IOO30\""

theorem IOO31 :
"compare (makePartial LT) (makePartial LT) ==' makePartial EQ"
by (auto)

ML "Header.record \"IOO31\""

theorem IOO32 :
"compare (makePartial EQ) (makePartial EQ) ==' makePartial EQ"
by (auto)

ML "Header.record \"IOO32\""

theorem IOO33 :
"compare (makePartial GT) (makePartial GT) ==' makePartial EQ"
by (auto)

ML "Header.record \"IOO33\""

theorem IBO6 : "~ undefinedOp >=' makePartial ()"
apply(simp add: GeqDef OrDef GeDef)
apply (case_tac "makePartial () <' undefinedOp")
apply(auto)
apply(simp add: LeTGeFEqFRel)
apply(simp add: GeDef)
done

ML "Header.record \"IBO6\""

theorem IBO7 : "makePartial () >=' undefinedOp"
apply(simp add: GeqDef OrDef GeDef)
done

ML "Header.record \"IBO7\""

theorem IBO8 : "~ makePartial () <' undefinedOp"
apply(simp add: LeFGeTEqTRel)
apply(simp add: GeDef)
done

ML "Header.record \"IBO8\""

theorem IBO9 :
"X_max undefinedOp (makePartial ()) ==' makePartial ()"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IBO9\""

theorem IBO10 :
"X_min undefinedOp (makePartial ()) ==' undefinedOp"
apply(simp add: MaxYDef)
apply(simp add: LeqDef OrDef)
done

ML "Header.record \"IBO10\""

theorem IBO11 :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"
by (auto)

ML "Header.record \"IBO11\""

theorem IBO12 :
"compare undefinedOp undefinedOp ==' makePartial EQ"
by (auto)

ML "Header.record \"IBO12\""

end


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

section \<open>The Axiom of Choice Holds in L!\<close>

theory AC_in_L imports Formula Separation begin

subsection\<open>Extending a Wellordering over a List -- Lexicographic Power\<close>

text\<open>This could be moved into a library.\<close>

consts
  rlist   :: "[i,i]\<Rightarrow>i"

inductive
  domains "rlist(A,r)" \<subseteq> "list(A) * list(A)"
  intros
    shorterI:
      "\<lbrakk>length(l') < length(l); l' \<in> list(A); l \<in> list(A)\<rbrakk>
       \<Longrightarrow> <l', l> \<in> rlist(A,r)"

    sameI:
      "\<lbrakk><l',l> \<in> rlist(A,r); a \<in> A\<rbrakk>
       \<Longrightarrow> <Cons(a,l'), Cons(a,l)> \<in> rlist(A,r)"

    diffI:
      "\<lbrakk>length(l') = length(l); <a',a> \<in> r;
          l' \<in> list(A); l \<in> list(A); a' \<in> A; a \<in> A\<rbrakk>
       \<Longrightarrow> <Cons(a',l'), Cons(a,l)> \<in> rlist(A,r)"
  type_intros list.intros

subsubsection\<open>Type checking\<close>

lemmas rlist_type = rlist.dom_subset

lemmas field_rlist = rlist_type [THEN field_rel_subset]

subsubsection\<open>Linearity\<close>

lemma rlist_Nil_Cons [intro]:
    "\<lbrakk>a \<in> A; l \<in> list(A)\<rbrakk> \<Longrightarrow> <[], Cons(a,l)> \<in> rlist(A, r)"
by (simp add: shorterI)

lemma linear_rlist:
  assumes r: "linear(A,r)" shows "linear(list(A),rlist(A,r))"
proof -
  { fix xs ys
    have "xs \<in> list(A) \<Longrightarrow> ys \<in> list(A) \<Longrightarrow> \<langle>xs,ys\<rangle> \<in> rlist(A,r) \<or> xs = ys \<or> \<langle>ys,xs\<rangle> \<in> rlist(A, r) "
    proof (induct xs arbitrary: ys rule: list.induct)
      case Nil
      thus ?case by (induct ys rule: list.induct) (auto simp add: shorterI)
    next
      case (Cons x xs)
      { fix y ys
        assume "y \<in> A" and "ys \<in> list(A)"
        with Cons
        have "\<langle>Cons(x,xs),Cons(y,ys)\<rangle> \<in> rlist(A,r) \<or> x=y \<and> xs = ys \<or> \<langle>Cons(y,ys), Cons(x,xs)\<rangle> \<in> rlist(A,r)"
          apply (rule_tac i = "length(xs)" and j = "length(ys)" in Ord_linear_lt)
          apply (simp_all add: shorterI)
          apply (rule linearE [OF r, of x y])
          apply (auto simp add: diffI intro: sameI)
          done
      }
      note yConsCase = this
      show ?case using \<open>ys \<in> list(A)\<close>
        by (cases rule: list.cases) (simp_all add: Cons rlist_Nil_Cons yConsCase)
    qed
  }
  thus ?thesis by (simp add: linear_def)
qed

subsubsection\<open>Well-foundedness\<close>

text\<open>Nothing preceeds Nil in this ordering.\<close>
inductive_cases rlist_NilE: " <l,[]> \<in> rlist(A,r)"

inductive_cases rlist_ConsE: " <l', Cons(x,l)> \<in> rlist(A,r)"

lemma not_rlist_Nil [simp]: " <l,[]> \<notin> rlist(A,r)"
by (blast intro: elim: rlist_NilE)

lemma rlist_imp_length_le: "<l',l> \<in> rlist(A,r) \<Longrightarrow> length(l') \<le> length(l)"
apply (erule rlist.induct)
apply (simp_all add: leI)
done

lemma wf_on_rlist_n:
  "\<lbrakk>n \<in> nat; wf[A](r)\<rbrakk> \<Longrightarrow> wf[{l \<in> list(A). length(l) = n}](rlist(A,r))"
apply (induct_tac n)
 apply (rule wf_onI2, simp)
apply (rule wf_onI2, clarify)
apply (erule_tac a=y in list.cases, clarify)
 apply (simp (no_asm_use))
apply clarify
apply (simp (no_asm_use))
apply (subgoal_tac "\<forall>l2 \<in> list(A). length(l2) = x \<longrightarrow> Cons(a,l2) \<in> B", blast)
apply (erule_tac a=a in wf_on_induct, assumption)
apply (rule ballI)
apply (rule impI)
apply (erule_tac a=l2 in wf_on_induct, blast, clarify)
apply (rename_tac a' l2 l')
apply (drule_tac x="Cons(a',l')" in bspec, typecheck)
apply simp
apply (erule mp, clarify)
apply (erule rlist_ConsE, auto)
done

lemma list_eq_UN_length: "list(A) = (\<Union>n\<in>nat. {l \<in> list(A). length(l) = n})"
by (blast intro: length_type)

lemma wf_on_rlist: "wf[A](r) \<Longrightarrow> wf[list(A)](rlist(A,r))"
apply (subst list_eq_UN_length)
apply (rule wf_on_Union)
  apply (rule wf_imp_wf_on [OF wf_Memrel [of nat]])
 apply (simp add: wf_on_rlist_n)
apply (frule rlist_type [THEN subsetD])
apply (simp add: length_type)
apply (drule rlist_imp_length_le)
apply (erule leE)
apply (simp_all add: lt_def)
done

lemma wf_rlist: "wf(r) \<Longrightarrow> wf(rlist(field(r),r))"
apply (simp add: wf_iff_wf_on_field)
apply (rule wf_on_subset_A [OF _ field_rlist])
apply (blast intro: wf_on_rlist)
done

lemma well_ord_rlist:
     "well_ord(A,r) \<Longrightarrow> well_ord(list(A), rlist(A,r))"
apply (rule well_ordI)
apply (simp add: well_ord_def wf_on_rlist)
apply (simp add: well_ord_def tot_ord_def linear_rlist)
done

subsection\<open>An Injection from Formulas into the Natural Numbers\<close>

text\<open>There is a well-known bijection between \<^term>\<open>nat*nat\<close> and \<^term>\<open>nat\<close> given by the expression f(m,n) = triangle(m+n) + m, where triangle(k)
enumerates the triangular numbers and can be defined by triangle(0)=0,
triangle(succ(k)) = succ(k + triangle(k)).  Some small amount of effort is
needed to show that f is a bijection.  We already know that such a bijection exists by the theorem \<open>well_ord_InfCard_square_eq\<close>:
@{thm[display] well_ord_InfCard_square_eq[no_vars]}

However, this result merely states that there is a bijection between the two
sets.  It provides no means of naming a specific bijection.  Therefore, we
conduct the proofs under the assumption that a bijection exists.  The simplest
way to organize this is to use a locale.\<close>

text\<open>Locale for any arbitrary injection between \<^term>\<open>nat*nat\<close>
      and \<^term>\<open>nat\<close>\<close>
locale Nat_Times_Nat =
  fixes fn
  assumes fn_inj: "fn \<in> inj(nat*nat, nat)"

consts   enum :: "[i,i]\<Rightarrow>i"
primrec
  "enum(f, Member(x,y)) = f ` <0, f ` \<langle>x,y\<rangle>>"
  "enum(f, Equal(x,y)) = f ` <1, f ` \<langle>x,y\<rangle>>"
  "enum(f, Nand(p,q)) = f ` <2, f ` <enum(f,p), enum(f,q)>>"
  "enum(f, Forall(p)) = f ` <succ(2), enum(f,p)>"

lemma (in Nat_Times_Nat) fn_type [TC,simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> fn`\<langle>x,y\<rangle> \<in> nat"
by (blast intro: inj_is_fun [OF fn_inj] apply_funtype)

lemma (in Nat_Times_Nat) fn_iff:
    "\<lbrakk>x \<in> nat; y \<in> nat; u \<in> nat; v \<in> nat\<rbrakk>
     \<Longrightarrow> (fn`\<langle>x,y\<rangle> = fn`\<langle>u,v\<rangle>) \<longleftrightarrow> (x=u \<and> y=v)"
by (blast dest: inj_apply_equality [OF fn_inj])

lemma (in Nat_Times_Nat) enum_type [TC,simp]:
    "p \<in> formula \<Longrightarrow> enum(fn,p) \<in> nat"
by (induct_tac p, simp_all)

lemma (in Nat_Times_Nat) enum_inject [rule_format]:
    "p \<in> formula \<Longrightarrow> \<forall>q\<in>formula. enum(fn,p) = enum(fn,q) \<longrightarrow> p=q"
apply (induct_tac p, simp_all)
   apply (rule ballI)
   apply (erule formula.cases)
   apply (simp_all add: fn_iff)
  apply (rule ballI)
  apply (erule formula.cases)
  apply (simp_all add: fn_iff)
 apply (rule ballI)
 apply (erule_tac a=qa in formula.cases)
 apply (simp_all add: fn_iff)
 apply blast
apply (rule ballI)
apply (erule_tac a=q in formula.cases)
apply (simp_all add: fn_iff, blast)
done

lemma (in Nat_Times_Nat) inj_formula_nat:
    "(\<lambda>p \<in> formula. enum(fn,p)) \<in> inj(formula, nat)"
apply (simp add: inj_def lam_type)
apply (blast intro: enum_inject)
done

lemma (in Nat_Times_Nat) well_ord_formula:
    "well_ord(formula, measure(formula, enum(fn)))"
apply (rule well_ord_measure, simp)
apply (blast intro: enum_inject)
done

lemmas nat_times_nat_lepoll_nat =
    InfCard_nat [THEN InfCard_square_eqpoll, THEN eqpoll_imp_lepoll]

text\<open>Not needed--but interesting?\<close>
theorem formula_lepoll_nat: "formula \<lesssim> nat"
apply (insert nat_times_nat_lepoll_nat)
  unfolding lepoll_def
apply (blast intro: Nat_Times_Nat.inj_formula_nat Nat_Times_Nat.intro)
done

subsection\<open>Defining the Wellordering on \<^term>\<open>DPow(A)\<close>\<close>

text\<open>The objective is to build a wellordering on \<^term>\<open>DPow(A)\<close> from a
given one on \<^term>\<open>A\<close>.  We first introduce wellorderings for environments,
which are lists built over \<^term>\<open>A\<close>.  We combine it with the enumeration of
formulas.  The order type of the resulting wellordering gives us a map from
(environment, formula) pairs into the ordinals.  For each member of \<^term>\<open>DPow(A)\<close>, we take the minimum such ordinal.\<close>

definition
  env_form_r :: "[i,i,i]\<Rightarrow>i" where
    \<comment> \<open>wellordering on (environment, formula) pairs\<close>
   "env_form_r(f,r,A) \<equiv>
      rmult(list(A), rlist(A, r),
            formula, measure(formula, enum(f)))"

definition
  env_form_map :: "[i,i,i,i]\<Rightarrow>i" where
    \<comment> \<open>map from (environment, formula) pairs to ordinals\<close>
   "env_form_map(f,r,A,z)
      \<equiv> ordermap(list(A) * formula, env_form_r(f,r,A)) ` z"

definition
  DPow_ord :: "[i,i,i,i,i]\<Rightarrow>o" where
    \<comment> \<open>predicate that holds if \<^term>\<open>k\<close> is a valid index for \<^term>\<open>X\<close>\<close>
   "DPow_ord(f,r,A,X,k) \<equiv>
           \<exists>env \<in> list(A). \<exists>p \<in> formula.
             arity(p) \<le> succ(length(env)) \<and>
             X = {x\<in>A. sats(A, p, Cons(x,env))} \<and>
             env_form_map(f,r,A,\<langle>env,p\<rangle>) = k"

definition
  DPow_least :: "[i,i,i,i]\<Rightarrow>i" where
    \<comment> \<open>function yielding the smallest index for \<^term>\<open>X\<close>\<close>
   "DPow_least(f,r,A,X) \<equiv> \<mu> k. DPow_ord(f,r,A,X,k)"

definition
  DPow_r :: "[i,i,i]\<Rightarrow>i" where
    \<comment> \<open>a wellordering on \<^term>\<open>DPow(A)\<close>\<close>
   "DPow_r(f,r,A) \<equiv> measure(DPow(A), DPow_least(f,r,A))"

lemma (in Nat_Times_Nat) well_ord_env_form_r:
    "well_ord(A,r)
     \<Longrightarrow> well_ord(list(A) * formula, env_form_r(fn,r,A))"
by (simp add: env_form_r_def well_ord_rmult well_ord_rlist well_ord_formula)

lemma (in Nat_Times_Nat) Ord_env_form_map:
    "\<lbrakk>well_ord(A,r); z \<in> list(A) * formula\<rbrakk>
     \<Longrightarrow> Ord(env_form_map(fn,r,A,z))"
by (simp add: env_form_map_def Ord_ordermap well_ord_env_form_r)

lemma DPow_imp_ex_DPow_ord:
    "X \<in> DPow(A) \<Longrightarrow> \<exists>k. DPow_ord(fn,r,A,X,k)"
apply (simp add: DPow_ord_def)
apply (blast dest!: DPowD)
done

lemma (in Nat_Times_Nat) DPow_ord_imp_Ord:
     "\<lbrakk>DPow_ord(fn,r,A,X,k); well_ord(A,r)\<rbrakk> \<Longrightarrow> Ord(k)"
apply (simp add: DPow_ord_def, clarify)
apply (simp add: Ord_env_form_map)
done

lemma (in Nat_Times_Nat) DPow_imp_DPow_least:
    "\<lbrakk>X \<in> DPow(A); well_ord(A,r)\<rbrakk>
     \<Longrightarrow> DPow_ord(fn, r, A, X, DPow_least(fn,r,A,X))"
apply (simp add: DPow_least_def)
apply (blast dest: DPow_imp_ex_DPow_ord intro: DPow_ord_imp_Ord LeastI)
done

lemma (in Nat_Times_Nat) env_form_map_inject:
    "\<lbrakk>env_form_map(fn,r,A,u) = env_form_map(fn,r,A,v); well_ord(A,r);
       u \<in> list(A) * formula;  v \<in> list(A) * formula\<rbrakk>
     \<Longrightarrow> u=v"
apply (simp add: env_form_map_def)
apply (rule inj_apply_equality [OF bij_is_inj, OF ordermap_bij,
                                OF well_ord_env_form_r], assumption+)
done

lemma (in Nat_Times_Nat) DPow_ord_unique:
    "\<lbrakk>DPow_ord(fn,r,A,X,k); DPow_ord(fn,r,A,Y,k); well_ord(A,r)\<rbrakk>
     \<Longrightarrow> X=Y"
apply (simp add: DPow_ord_def, clarify)
apply (drule env_form_map_inject, auto)
done

lemma (in Nat_Times_Nat) well_ord_DPow_r:
    "well_ord(A,r) \<Longrightarrow> well_ord(DPow(A), DPow_r(fn,r,A))"
apply (simp add: DPow_r_def)
apply (rule well_ord_measure)
 apply (simp add: DPow_least_def)
apply (drule DPow_imp_DPow_least, assumption)+
apply simp
apply (blast intro: DPow_ord_unique)
done

lemma (in Nat_Times_Nat) DPow_r_type:
    "DPow_r(fn,r,A) \<subseteq> DPow(A) * DPow(A)"
by (simp add: DPow_r_def measure_def, blast)

subsection\<open>Limit Construction for Well-Orderings\<close>

text\<open>Now we work towards the transfinite definition of wellorderings for
\<^term>\<open>Lset(i)\<close>.  We assume as an inductive hypothesis that there is a family
of wellorderings for smaller ordinals.\<close>

definition
  rlimit :: "[i,i\<Rightarrow>i]\<Rightarrow>i" where
  \<comment> \<open>Expresses the wellordering at limit ordinals.  The conditional
      lets us remove the premise \<^term>\<open>Limit(i)\<close> from some theorems.\<close>
    "rlimit(i,r) \<equiv>
       if Limit(i) then
         {z: Lset(i) * Lset(i).
          \<exists>x' x. z = <x',x> \<and>
                 (lrank(x') < lrank(x) |
                  (lrank(x') = lrank(x) \<and> <x',x> \<in> r(succ(lrank(x)))))}
       else 0"

definition
  Lset_new :: "i\<Rightarrow>i" where
  \<comment> \<open>This constant denotes the set of elements introduced at level
      \<^term>\<open>succ(i)\<close>\<close>
    "Lset_new(i) \<equiv> {x \<in> Lset(succ(i)). lrank(x) = i}"

lemma Limit_Lset_eq2:
    "Limit(i) \<Longrightarrow> Lset(i) = (\<Union>j\<in>i. Lset_new(j))"
apply (simp add: Limit_Lset_eq)
apply (rule equalityI)
 apply safe
 apply (subgoal_tac "Ord(y)")
  prefer 2 apply (blast intro: Ord_in_Ord Limit_is_Ord)
 apply (simp_all add: Limit_is_Ord Lset_iff_lrank_lt Lset_new_def
                      Ord_mem_iff_lt)
 apply (blast intro: lt_trans)
apply (rule_tac x = "succ(lrank(x))" in bexI)
 apply (simp)
apply (blast intro: Limit_has_succ ltD)
done

lemma wf_on_Lset:
    "wf[Lset(succ(j))](r(succ(j))) \<Longrightarrow> wf[Lset_new(j)](rlimit(i,r))"
apply (simp add: wf_on_def Lset_new_def)
apply (erule wf_subset)
apply (simp add: rlimit_def, force)
done

lemma wf_on_rlimit:
    "(\<forall>j<i. wf[Lset(j)](r(j))) \<Longrightarrow> wf[Lset(i)](rlimit(i,r))"
apply (case_tac "Limit(i)")
 prefer 2
 apply (simp add: rlimit_def wf_on_any_0)
apply (simp add: Limit_Lset_eq2)
apply (rule wf_on_Union)
  apply (rule wf_imp_wf_on [OF wf_Memrel [of i]])
 apply (blast intro: wf_on_Lset Limit_has_succ Limit_is_Ord ltI)
apply (force simp add: rlimit_def Limit_is_Ord Lset_iff_lrank_lt Lset_new_def
                       Ord_mem_iff_lt)
done

lemma linear_rlimit:
    "\<lbrakk>Limit(i); \<forall>j<i. linear(Lset(j), r(j))\<rbrakk>
     \<Longrightarrow> linear(Lset(i), rlimit(i,r))"
apply (frule Limit_is_Ord)
apply (simp add: Limit_Lset_eq2 Lset_new_def)
apply (simp add: linear_def rlimit_def Ball_def lt_Ord Lset_iff_lrank_lt)
apply (simp add: ltI, clarify)
apply (rename_tac u v)
apply (rule_tac i="lrank(u)" and j="lrank(v)" in Ord_linear_lt, simp_all)
apply (drule_tac x="succ(lrank(u) \<union> lrank(v))" in ospec)
 apply (simp add: ltI)
apply (drule_tac x=u in spec, simp)
apply (drule_tac x=v in spec, simp)
done

lemma well_ord_rlimit:
    "\<lbrakk>Limit(i); \<forall>j<i. well_ord(Lset(j), r(j))\<rbrakk>
     \<Longrightarrow> well_ord(Lset(i), rlimit(i,r))"
by (blast intro: well_ordI wf_on_rlimit well_ord_is_wf
                           linear_rlimit well_ord_is_linear)

lemma rlimit_cong:
     "(\<And>j. j<i \<Longrightarrow> r'(j) = r(j)) \<Longrightarrow> rlimit(i,r) = rlimit(i,r')"
apply (simp add: rlimit_def, clarify)
apply (rule refl iff_refl Collect_cong ex_cong conj_cong)+
apply (simp add: Limit_is_Ord Lset_lrank_lt)
done

subsection\<open>Transfinite Definition of the Wellordering on \<^term>\<open>L\<close>\<close>

definition
  L_r :: "[i, i] \<Rightarrow> i" where
  "L_r(f) \<equiv> \<lambda>i.
      transrec3(i, 0, \<lambda>x r. DPow_r(f, r, Lset(x)),
                \<lambda>x r. rlimit(x, \<lambda>y. r`y))"

subsubsection\<open>The Corresponding Recursion Equations\<close>

lemma [simp]: "L_r(f, succ(i)) = DPow_r(f, L_r(f,i), Lset(i))"
by (simp add: L_r_def)

text\<open>The limit case is non-trivial because of the distinction between
object-level and meta-level abstraction.\<close>
lemma [simp]: "Limit(i) \<Longrightarrow> L_r(f,i) = rlimit(i, L_r(f))"
by (simp cong: rlimit_cong add: transrec3_Limit L_r_def ltD)

lemma (in Nat_Times_Nat) L_r_type:
    "Ord(i) \<Longrightarrow> L_r(fn,i) \<subseteq> Lset(i) * Lset(i)"
apply (induct i rule: trans_induct3)
  apply (simp_all add: Lset_succ DPow_r_type well_ord_DPow_r rlimit_def
                       Transset_subset_DPow [OF Transset_Lset], blast)
done

lemma (in Nat_Times_Nat) well_ord_L_r:
    "Ord(i) \<Longrightarrow> well_ord(Lset(i), L_r(fn,i))"
apply (induct i rule: trans_induct3)
apply (simp_all add: well_ord0 Lset_succ L_r_type well_ord_DPow_r
                     well_ord_rlimit ltD)
done

lemma well_ord_L_r:
    "Ord(i) \<Longrightarrow> \<exists>r. well_ord(Lset(i), r)"
apply (insert nat_times_nat_lepoll_nat)
  unfolding lepoll_def
apply (blast intro: Nat_Times_Nat.well_ord_L_r Nat_Times_Nat.intro)
done

text\<open>Every constructible set is well-ordered! Therefore the Wellordering Theorem and
      the Axiom of Choice hold in \<^term>\<open>L\<close>!\<close>
theorem L_implies_AC: assumes x: "L(x)" shows "\<exists>r. well_ord(x,r)"
  using Transset_Lset x
apply (simp add: Transset_def L_def)
apply (blast dest!: well_ord_L_r intro: well_ord_subset)
done

interpretation L: M_basic L by (rule M_basic_L)

theorem "\<forall>x[L]. \<exists>r. wellordered(L,x,r)"
proof
  fix x
  assume "L(x)"
  then obtain r where "well_ord(x,r)"
    by (blast dest: L_implies_AC)
  thus "\<exists>r. wellordered(L,x,r)"
    by (blast intro: L.well_ord_imp_relativized)
qed

text\<open>In order to prove \<^term>\<open> \<exists>r[L]. wellordered(L,x,r)\<close>, it's necessary to know
that \<^term>\<open>r\<close> is actually constructible. It follows from the assumption ``\<^term>\<open>V\<close> equals \<^term>\<open>L''\<close>,
but this reasoning doesn't appear to work in Isabelle.\<close>

end