(*  Title:      HOL/Datatype_Examples/TreeFsetI.thy
    Author:     Dmitriy Traytel, TU Muenchen
    Author:     Andrei Popescu, TU Muenchen
    Copyright   2012

Finitely branching possibly infinite trees, with sets of children.
*)

section \<open>Finitely Branching Possibly Infinite Trees, with Sets of Children\<close>

theory TreeFsetI
imports "HOL-Library.FSet"
begin

codatatype 'a treeFsetI = Tree (lab: 'a) (sub: "'a treeFsetI fset")

(* tree map (contrived example): *)
primcorec tmap where
"lab (tmap f t) = f (lab t)" |
"sub (tmap f t) = fimage (tmap f) (sub t)"

lemma "tmap (f o g) x = tmap f (tmap g x)"
  by (coinduction arbitrary: x) (auto simp: rel_fset_alt)

end


theory Interpretation_in_nested_targets
  imports MainRLT
begin

locale injection =
  fixes f :: \<open>'a \<Rightarrow> 'b\<close>
  assumes eqI: \<open>f x = f y \<Longrightarrow> x = y\<close>
begin

lemma eq_iff:
  \<open>x = y \<longleftrightarrow> f x = f y\<close>
  by (auto intro: eqI)

lemma inv_apply:
  \<open>inv f (f x) = x\<close>
  by (rule inv_f_f) (simp add: eqI injI)

end

context
  fixes f :: \<open>'a::linorder \<Rightarrow> 'b::linorder\<close>
  assumes \<open>strict_mono f\<close>
begin

global_interpretation strict_mono: injection f
  by standard (simp add: \<open>strict_mono f\<close> strict_mono_eq)

thm strict_mono.eq_iff
thm strict_mono.inv_apply

end

thm strict_mono.eq_iff
thm strict_mono.inv_apply

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_nat_boring_gt_trans
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun lt :: "Nat => Nat => bool" where
"lt x (Z) = False"
| "lt (Z) (S z) = True"
| "lt (S n) (S z) = lt n z"

fun gt :: "Nat => Nat => bool" where
"gt x y = lt y x"

theorem property0 :
  "((gt x y) ==> ((gt y z) ==> (gt x z)))"
  oops

end


theory Refinement_MMU_ASIDs

imports  Update_Root_Tag_Ref

begin

datatype mem_op_typ = translate     vaddr
                | memread       "vaddr \<times> nat"
                | memwrite      "bool list \<times> vaddr \<times> nat"

datatype mmu_op_typ = root_update  paddr
                    | asid_update  asid
                    | flush_addr        flush_type
                    | flush_asid        asid_flush_type

datatype res_typ = PA paddr
                 | BL "bool list"
                 | UT unit

fun
  mem_op :: "mem_op_typ \<Rightarrow> 'a::mmu_extended state_scheme \<Rightarrow> _"
  where
  "mem_op (translate va) s             = (PA (fst (mmu_translate va s)),            snd (mmu_translate va s))"
| "mem_op (memread (va, sz)) s         = (BL (fst (mmu_read_size (va, sz) s)),      snd (mmu_read_size (va, sz) s))"
| "mem_op (memwrite (bl, va, sz)) s    = (UT (fst (mmu_write_size (bl, va, sz) s)), snd (mmu_write_size (bl, va, sz) s))"

fun
  mmu_op :: "mmu_op_typ \<Rightarrow> 'a::mmu_extended state_scheme \<Rightarrow> _"
  where
  "mmu_op (root_update rt) s    = ((), snd (update_TTBR0 rt s))"
| "mmu_op (asid_update a) s     = ((), snd (update_ASID a s))"
| "mmu_op (flush_addr f) s      = ((), snd (flush f s))"
| "mmu_op (flush_asid f) s      = ((), snd (flush_with_ASID f s))"

thm mmu_write_non_det_det_refine
thm mmu_read_non_det_det_refine

fun
  consistent_det :: "mem_op_typ \<Rightarrow> 'a::mmu_extended det_tlb_state_scheme \<Rightarrow> bool"
where
  "consistent_det (translate va) s             =  consistent (typ_det_tlb s) va"
| "consistent_det (memread (va, sz)) s         =  consistent ( typ_det_tlb s) va"
| "consistent_det (memwrite (bl, va, sz)) s    =  consistent ( typ_det_tlb s) va"

lemma  addr_trans_det:
  "\<lbrakk> mmu_translate va s = (pa, s');  mmu_translate va t = (pa', t');
consistent (typ_det_tlb t) va; tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)  \<rbrakk> \<Longrightarrow>
      pa' = pa \<and> tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t')"
  using mmu_translate_non_det_det_refine [simplified split_def Let_def, rotated 2]  by force

lemma read_trans_det:
  "\<lbrakk>mmu_read_size (va, sz) s = (val, s');  mmu_read_size (va, sz) t = (val', t'); consistent (typ_det_tlb t) va;
              tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)\<rbrakk> \<Longrightarrow>
                     val' = val \<and> tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t') "
  using mmu_read_non_det_det_refine by blast

lemma mem_refine_det:
    "\<lbrakk> mem_op f s = (res, s') ; mem_op f t = (res', t');
          consistent_det f t ; tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t) \<rbrakk> \<Longrightarrow>
                 res' = res \<and> tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t')"
  apply (cases f; clarsimp)
    apply (rename_tac va)
    apply (rule_tac va = va and s = s and t = t in  addr_trans_det; clarsimp?)
   apply (rename_tac va sz)
   apply (rule_tac read_trans_det; force?)
  apply (rename_tac bl va sz)
  apply (rule_tac val = bl and va = va and sz = sz and s = s and t = t in mmu_write_non_det_det_refine; force?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by (metis eq_snd_iff old.unit.exhaust)

lemma mmu_refine_det:
    "\<lbrakk> mmu_op f s = ((), s') ; mmu_op f t = ((), t');
           tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t) \<rbrakk> \<Longrightarrow>
               tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t')"
  apply (cases f; clarsimp)
     apply (rename_tac rt)
     apply (rule_tac r = rt and s = s and t= t in update_root_non_det_det_refine;  clarsimp simp: eq_snd_iff)
    apply (rename_tac a)
    apply (rule_tac a = a and s = s and t= t in update_asid_non_det_det_refine;  clarsimp simp: eq_snd_iff)
   apply (rename_tac ft)
   apply (rule_tac f = ft and s = s and t= t in flush_non_det_det_refine;  clarsimp simp: eq_snd_iff)
  apply (rename_tac ft)
  by (rule_tac f = ft and s = s and t= t in flush_with_asid_non_det_det_refine;  clarsimp simp: eq_snd_iff)

fun
  consistent_sat :: "mem_op_typ \<Rightarrow> 'a::mmu_extended sat_tlb_state_scheme \<Rightarrow> bool"
where
  "consistent_sat (translate va) s             =  consistent ( typ_sat_tlb s) va"
| "consistent_sat (memread (va, sz)) s         =  consistent ( typ_sat_tlb s) va"
| "consistent_sat (memwrite (bl, va, sz)) s    =  consistent ( typ_sat_tlb s) va"

lemma  addr_trans_sat:
  "\<lbrakk> mmu_translate va s = (pa, s');  mmu_translate va t = (pa', t');
consistent (typ_sat_tlb t) va; tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)  \<rbrakk> \<Longrightarrow>
      pa' = pa \<and> tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t')"
  using mmu_translate_det_sat_refine [simplified split_def Let_def, rotated 2]  by force

lemma read_trans_sat:
  "\<lbrakk>mmu_read_size (va, sz) s = (val, s');  mmu_read_size (va, sz) t = (val', t'); consistent (typ_sat_tlb t) va;
              tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)\<rbrakk> \<Longrightarrow>
                     val' = val \<and> tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t') "
  using mmu_read_non_det_sat_refine by blast

lemma mem_refine_sat:
    "\<lbrakk> mem_op f s = (res, s') ; mem_op f t = (res', t');
          consistent_sat f t ; tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t) \<rbrakk> \<Longrightarrow>
                 res' = res \<and> tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t')"
  apply (cases f; clarsimp)
    apply (rename_tac va)
    apply (rule_tac va = va and s = s and t = t in  addr_trans_sat; clarsimp?)
   apply (rename_tac va sz)
   apply (rule_tac read_trans_sat; force?)
  apply (rename_tac bl va sz)
  apply (rule_tac val = bl and va = va and sz = sz and s = s and t = t in mmu_write_det_sat_refine; force?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by (metis eq_snd_iff old.unit.exhaust)

lemma mmu_refine_sat:
    "\<lbrakk> mmu_op f s = ((), s') ; mmu_op f t = ((), t');
           tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t) \<rbrakk> \<Longrightarrow>
               tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t')"
  apply (cases f; clarsimp)
     apply (rename_tac rt)
     apply (rule_tac r = rt and s = s and t= t in update_root_det_sat_refine;  clarsimp simp: eq_snd_iff)
    apply (rename_tac a)
    apply (rule_tac a = a and s = s and t= t in update_asid_det_sat_refine;  clarsimp simp: eq_snd_iff)
   apply (rename_tac ft)
   apply (rule_tac f = ft and s = s and t= t in flush_det_sat_refine;  clarsimp simp: eq_snd_iff)
  apply (rename_tac ft)
  by (rule_tac f = ft and s = s and t= t in flush_with_asid_det_sat_refine;  clarsimp simp: eq_snd_iff)

fun
  consistent_set :: "mem_op_typ \<Rightarrow> _"
where
  "consistent_set (translate va) s             =  (va \<notin> iset(set_tlb s))"
| "consistent_set (memread (va, sz)) s         =  (va \<notin> iset(set_tlb s))"
| "consistent_set (memwrite (bl, va, sz)) s    =  (va \<notin> iset(set_tlb s))"

lemma  addr_trans_set:
  "\<lbrakk> mmu_translate va s = (pa, s');  mmu_translate va t = (pa', t');
    va \<notin> iset(set_tlb t); tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)  \<rbrakk> \<Longrightarrow>
      pa' = pa \<and> tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t')"
  using mmu_translate_sat_incon_refine [simplified split_def Let_def, rotated 2]  apply auto by blast+

lemma read_trans_set:
  "\<lbrakk>mmu_read_size (va, sz) s = (val, s');  mmu_read_size (va, sz) t = (val', t'); va \<notin> iset(set_tlb t);
              tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)\<rbrakk> \<Longrightarrow>
                     val' = val \<and> tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t') "
  using mmu_read_sat_incon_refine by blast

lemma mem_refine_set:
    "\<lbrakk> mem_op f s = (res, s') ; mem_op f t = (res', t');
          consistent_set f t ; tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                 res' = res \<and> tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t')"
  apply (cases f; clarsimp)
    apply (rename_tac va)
    apply (rule_tac va = va and s = s and t = t in  addr_trans_set; clarsimp?)
   apply (rename_tac va sz)
   apply (rule_tac read_trans_set; force?)
  apply (rename_tac bl va sz)
  apply (rule_tac val = bl and va = va and sz = sz and s = s and t = t in mmu_write_sat_incon_refine; force?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by (metis eq_snd_iff old.unit.exhaust)

lemma mmu_refine_set:
    "\<lbrakk> mmu_op f s = ((), s') ; mmu_op f t = ((), t');
           tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
               tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t')"
  apply (cases f; clarsimp)
     apply (rename_tac rt)
     apply (rule_tac r = rt and s = s and t= t in update_root_sat_incon_refine';  clarsimp simp: eq_snd_iff)
    apply (rename_tac a)
    apply (rule_tac a = a and s = s and t= t in update_asid_sat_set'_refine;  clarsimp simp: eq_snd_iff)
   apply (rename_tac ft)
   apply (rule_tac f = ft and s = s and t= t in flush_sat_incon_refine;  clarsimp simp: eq_snd_iff)
  apply (rename_tac ft)
  by (rule_tac f = ft and s = s and t= t in flush_with_asid_sat_incon_refine;  clarsimp simp: eq_snd_iff)

definition
  tlb_rel :: "(asid \<times> asid tlb_entry set)  state_scheme  \<Rightarrow>  (asid \<times> set_tlb) state_scheme  \<Rightarrow> bool"
where
  "tlb_rel r t \<equiv> \<exists>(s:: unit det_tlb_state_scheme) (s':: unit sat_tlb_state_scheme).
                    tlb_rel_det r (typ_det_tlb s) \<and> tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb s') \<and>
                           tlb_rel_abs (typ_sat_tlb s') t"

lemmas  abc =  mmu_translate_det_sat_refine [simplified split_def Let_def, rotated 2]
lemmas  abc' =  mmu_translate_non_det_det_refine [simplified split_def Let_def, rotated 2]

lemma address_refinement:
  "\<lbrakk> mmu_translate va r = (pa, r');  mmu_translate va t = (pa', t') ;
           va \<notin> iset(set_tlb t) ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               pa = pa' \<and>   tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s' and pa = "fst(mmu_translate va s')" and s' = "snd(mmu_translate va s')" in
      mmu_translate_sat_incon_refine [rotated]; clarsimp?)
  apply (frule_tac va = va and pa =  "fst(mmu_translate va s)" and s' = "snd(mmu_translate va s)"in  abc; clarsimp?)
  using tlb_rel_abs_consistent' apply force
  apply (frule_tac va = va and pa =  "fst(mmu_translate va r)" and s' = "snd(mmu_translate va r)"in  abc'; clarsimp?)
  prefer 2
  apply force
  apply (clarsimp simp: fst_def snd_def)
  apply (case_tac "mmu_translate va s'", simp)
  apply (case_tac " mmu_translate va s", simp)
  apply (clarsimp simp:   det_tlb_more det_tlb_truncate fst_conv mmu_det_eq_asid_root_mem mmu_sat_eq_asid_root_mem sat_tlb_more sat_tlb_truncate snd_conv tlb_rel_abs_consistent'
   tlb_rel_sat_consistent tlb_rel_sat_def typ_det_prim_parameter typ_det_tlb_def typ_sat_prim_parameter typ_sat_tlb_def)
(* update this later *)
proof -
  fix s :: det_tlb_state and s' :: sat_tlb_state and b :: sat_tlb_state and ba :: det_tlb_state
  assume "tlb_rel_det (typ_non_det_tlb r) (state.extend (state.truncate s) (det_asid ba, det_tlb s))"
  assume a1: "consistent0 (lookup'' (sat_tlb b) (sat_asid b)) (pt_walk (sat_asid b) (MEM b) (TTBR0 b)) va"
assume a2: "mmu_translate va s' = (pa', b)"
assume a3: "mmu_translate va s = (pa', ba)"
  assume a4: "state.truncate (state.extend (state.truncate s) (det_asid ba, det_tlb s)) = state.truncate (state.extend (state.truncate s') (sat_asid b, sat_tlb s'))"
  assume a5: "fst (state.more (state.extend (state.truncate s) (det_asid ba, det_tlb s))) = fst (state.more (state.extend (state.truncate s') (sat_asid b, sat_tlb s')))"
  assume a6: "fst (state.more (state.extend (state.truncate ba) (det_asid ba, det_tlb ba))) = fst (state.more (state.extend (state.truncate b) (sat_asid b, sat_tlb b)))"
  assume a7: "snd (state.more (state.extend (state.truncate s) (det_asid ba, det_tlb s))) \<subseteq> snd (state.more (state.extend (state.truncate s') (sat_asid b, sat_tlb s')))"
  assume a8: "saturated (state.extend (state.truncate s') (sat_asid b, sat_tlb s'))"
  have f9: "fst (state.more (typ_det_tlb ba)) = fst (state.more (typ_sat_tlb b))"
    using a6 by (simp add: typ_det_tlb_def typ_sat_tlb_def)
  have f10: "sat_asid b = sat_asid s'"
    using a2 by (simp add: mmu_sat_eq_asid_root_mem)
  have f11: "det_asid ba = det_asid s"
using a3 by (simp add: mmu_det_eq_asid_root_mem)
  have f12: "TTBR0 ba = TTBR0 s"
    using a3 by (simp add: mmu_det_eq_asid_root_mem)
  have f13: "MEM ba = MEM s"
    using a3 by (metis (no_types) mmu_det_eq_asid_root_mem)
  have f14: "state.more (typ_sat_tlb s') = (sat_asid b, sat_tlb s')"
using f10 by simp
  then have f15: "state.extend (state.truncate s') (state.more (typ_sat_tlb s')) = typ_sat_tlb s'"
    using f10 by (simp add: typ_sat_tlb_def)
  then have f16: "state.more (typ_sat_tlb b) = state.more (typ_sat_tlb s')"
    using f14 a8 a2 by (metis (no_types) mmu_translate_saturated_tlb_unchange sat_tlb_more)
  have f17: "fst (state.more (typ_det_tlb ba)) = fst (state.more (typ_det_tlb s))"
    using f15 f14 f11 f9 a5 by simp
  have f18: "det_asid ba = fst (state.more (typ_det_tlb s))"
    using f11 by simp
  then have f19: "det_asid ba = fst (state.more (typ_det_tlb ba))"
    using f17 by presburger
  then have "tlb_rel_det (typ_det_tlb s) (typ_sat_tlb s')"
    using f18 f15 f14 f11 f9 a7 a4 by (simp add: tlb_rel_det_def typ_det_tlb_def)
  then show "consistent0 (lookup'' (det_tlb s) (det_asid ba)) (pt_walk (det_asid ba) (MEM ba) (TTBR0 ba)) va"
    using f19 f16 f13 f12 f11 a2 a1 by (metis det_tlb_more mmu_sat_eq_asid_root_mem old.prod.inject prod.exhaust_sel sat_tlb_more tlb_rel_det_consistent typ_det_prim_parameter typ_sat_prim_parameter)
qed

lemma read_refinement:
  "\<lbrakk> mmu_read_size (va, sz) r = (val, r');  mmu_read_size (va, sz) t = (val', t');
           va \<notin> iset(set_tlb t) ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               val = val' \<and>  tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s' and val = "fst(mmu_read_size (va, sz) s')" and s' = "snd(mmu_read_size (va, sz) s')" in
      mmu_read_sat_incon_refine [rotated]; clarsimp?)
  apply (frule_tac va = va and sz= sz and val =  "fst(mmu_read_size (va, sz)s)" and s' = "snd(mmu_read_size (va, sz) s)" and
      val' =  "fst(mmu_read_size (va, sz)s')"  and t' = "snd(mmu_read_size (va, sz) s')" in  mmu_read_non_det_sat_refine [rotated 2]; clarsimp?)
  using tlb_rel_abs_consistent' apply force

  apply (frule_tac va = va and sz= sz and val =  "fst(mmu_read_size (va, sz)r)" and s' = "snd(mmu_read_size (va, sz) r)" and
      val' =  "fst(mmu_read_size (va, sz)s)"  and t' = "snd(mmu_read_size (va, sz) s)" in  mmu_read_non_det_det_refine [rotated 2]; clarsimp?)
  using tlb_rel_abs_consistent' tlb_rel_sat_consistent apply fastforce
   apply (metis (no_types) prod.collapse)
  by force

lemma write_refinement:
  "\<lbrakk> mmu_write_size (val,va, sz) r = ((), r');  mmu_write_size (val,va, sz)  t = ((), t');
            va \<notin> iset(set_tlb t) ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                              tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s' and s' = "snd(mmu_write_size (val,va, sz) s')" in
      mmu_write_sat_incon_refine [rotated]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac va = va and sz= sz  and s' = "snd(mmu_write_size (val,va, sz)  s)" and t' = "snd(mmu_write_size (val,va, sz)  s')" and val = val in
      mmu_write_det_sat_refine [rotated]; clarsimp?)
  using tlb_rel_abs_consistent' apply force
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac va = va and sz= sz and val =  val and s' = "snd(mmu_write_size (val,va, sz) r)" and
      t' = "snd(mmu_write_size (val,va, sz) s)" in  mmu_write_non_det_det_refine [rotated]; clarsimp?)
  using tlb_rel_abs_consistent' tlb_rel_sat_consistent apply fastforce
   apply (metis eq_snd_iff old.unit.exhaust)
  by force

lemma mem_refine:
    "\<lbrakk> mem_op f r = (res, r') ; mem_op f t = (res', t');
          consistent_set f t ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                 res = res' \<and> tlb_rel (typ_non_det_tlb r') (typ_set_tlb t')"
  apply (cases f; clarsimp)
    apply (rename_tac va)
    apply (rule_tac  va = va and  r = r and t = t in address_refinement; force?)
   apply (rename_tac va sz)
   apply (rule_tac read_refinement; force?)
  apply (rename_tac bl va sz)
  apply (rule_tac val = bl and va = va and sz = sz and r = r and t = t in write_refinement; force?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by (metis eq_snd_iff old.unit.exhaust)

lemma root_refinement:
  "\<lbrakk> update_TTBR0 rt r = ((), r');  update_TTBR0 rt t = ((), t') ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s'  and s' = "snd (update_TTBR0 rt s')"  in update_root_sat_incon_refine' [rotated]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  r = rt and s' ="snd ( update_TTBR0 rt s) " and t' = "snd (update_TTBR0 rt s')" in update_root_det_sat_refine [rotated 2]; clarsimp?)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  r = rt and s' ="snd ( update_TTBR0 rt r) " and t' = "snd (update_TTBR0 rt s)" in update_root_non_det_det_refine [rotated 2]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by force

lemma asid_refinement:
  "\<lbrakk> update_ASID a r = ((), r');  update_ASID a t = ((), t') ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s'  and s' = "snd (update_ASID a s')"  in update_asid_sat_set'_refine [rotated]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  a = a and s' ="snd ( update_ASID a s) " and t' = "snd (update_ASID a s')" in update_asid_det_sat_refine [rotated 2]; clarsimp?)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  a = a and s' ="snd ( update_ASID a r) " and t' = "snd (update_ASID a s)" in update_asid_non_det_det_refine [rotated 2]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by force

lemma flush_refinement:
  "\<lbrakk> flush f r = ((), r');  flush f t = ((), t') ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s'  and s' = "snd (flush f s')"  in flush_sat_incon_refine [rotated]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac f= f and s' ="snd ( flush f s) " and t' = "snd (flush f s')" in flush_det_sat_refine [rotated 2]; clarsimp?)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  f = f and s' ="snd ( flush f r) " and t' = "snd (flush f s)" in flush_non_det_det_refine [rotated 2]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by force

lemma flush_asid_refinement:
  "\<lbrakk> flush_with_ASID f r = ((), r');  flush_with_ASID f t = ((), t') ; tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                               tlb_rel  (typ_non_det_tlb r') (typ_set_tlb t') "
  apply (clarsimp simp: tlb_rel_def)
  apply (frule_tac s = s'  and s' = "snd (flush_with_ASID f s')"  in flush_with_asid_sat_incon_refine [rotated]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac f= f and s' ="snd ( flush_with_ASID f s) " and t' = "snd (flush_with_ASID f s')" in flush_with_asid_det_sat_refine [rotated 2]; clarsimp?)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (frule_tac  f = f and s' ="snd ( flush_with_ASID f r) " and t' = "snd (flush_with_ASID f s)" in flush_with_asid_non_det_det_refine [rotated 2]; clarsimp?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by force

lemma mmu_refine:
    "\<lbrakk> mmu_op f r = ((), r') ; mmu_op f t = ((), t');
         tlb_rel (typ_non_det_tlb r) (typ_set_tlb t) \<rbrakk> \<Longrightarrow>
                  tlb_rel (typ_non_det_tlb r') (typ_set_tlb t')"
  apply (cases f; clarsimp)
     apply (rename_tac rt)
     apply (rule_tac  rt = rt and  r = r and t = t in root_refinement; force?)
      apply (metis eq_snd_iff old.unit.exhaust)
     apply (metis eq_snd_iff old.unit.exhaust)
    apply (rename_tac a)
    apply (rule_tac  a = a and  r = r and t = t in asid_refinement; force?)
     apply (metis eq_snd_iff old.unit.exhaust)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (rename_tac ft)
   apply (rule_tac f = ft in flush_refinement; force?)
    apply (metis eq_snd_iff old.unit.exhaust)
   apply (metis eq_snd_iff old.unit.exhaust)
  apply (rename_tac ft)
  apply (rule_tac f = ft in flush_asid_refinement; force?)
   apply (metis eq_snd_iff old.unit.exhaust)
  by (metis eq_snd_iff old.unit.exhaust)

end


(* Copyright 2021 (C) Mihails Milehins *)

section\<open>Smallness for natural transformations of semifunctors\<close>
theory CZH_SMC_Small_NTSMCF
  imports
    CZH_DG_Small_TDGHM
    CZH_SMC_Small_Semifunctor
    CZH_SMC_NTSMCF
begin

subsection\<open>Natural transformation of semifunctors with tiny maps\<close>

subsubsection\<open>Definition and elementary properties\<close>

locale is_tm_ntsmcf = is_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
  assumes tm_ntsmcf_is_tm_tdghm[slicing_intros]: "ntsmcf_tdghm \<NN> :
    smcf_dghm \<FF> \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>m smcf_dghm \<GG> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"

syntax "_is_tm_ntsmcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m _ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<index> _)\<close> [51, 51, 51, 51, 51] 51)
translations "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
  "CONST is_tm_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

abbreviation all_tm_ntsmcfs :: "V \<Rightarrow> V"
  where "all_tm_ntsmcfs \<alpha> \<equiv>
    set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation tm_ntsmcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "tm_ntsmcfs \<alpha> \<AA> \<BB> \<equiv>
    set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation these_tm_ntsmcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "these_tm_ntsmcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv>
    set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"

lemma (in is_tm_ntsmcf) tm_ntsmcf_is_tm_tdghm':
  assumes "\<alpha>' = \<alpha>"
    and "\<FF>' = smcf_dghm \<FF>"
    and "\<GG>' = smcf_dghm \<GG>"
    and "\<AA>' = smc_dg \<AA>"
    and "\<BB>' = smc_dg \<BB>"
  shows "ntsmcf_tdghm \<NN> :
    \<FF>' \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule tm_ntsmcf_is_tm_tdghm)

lemmas [slicing_intros] = is_tm_ntsmcf.tm_ntsmcf_is_tm_tdghm'

text\<open>Rules.\<close>

lemma (in is_tm_ntsmcf) is_tm_ntsmcf_axioms'[smc_small_cs_intros]:
  assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
  shows "\<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>'"
  unfolding assms by (rule is_tm_ntsmcf_axioms)

mk_ide rf is_tm_ntsmcf_def[unfolded is_tm_ntsmcf_axioms_def]
  |intro is_tm_ntsmcfI|
  |dest is_tm_ntsmcfD[dest]|
  |elim is_tm_ntsmcfE[elim]|

lemmas [smc_small_cs_intros] = is_tm_ntsmcfD(1)

text\<open>Slicing.\<close>

context is_tm_ntsmcf
begin

interpretation tdghm: is_tm_tdghm
  \<alpha> \<open>smc_dg \<AA>\<close> \<open>smc_dg \<BB>\<close> \<open>smcf_dghm \<FF>\<close> \<open>smcf_dghm \<GG>\<close> \<open>ntsmcf_tdghm \<NN>\<close>
  by (rule tm_ntsmcf_is_tm_tdghm)

lemmas_with [unfolded slicing_simps]:
  tm_ntsmcf_NTMap_in_Vset = tdghm.tm_tdghm_NTMap_in_Vset

end

text\<open>Elementary properties.\<close>

sublocale is_tm_ntsmcf \<subseteq> NTDom: is_tm_semifunctor \<alpha> \<AA> \<BB> \<FF>
  using tm_ntsmcf_is_tm_tdghm
  by (intro is_tm_semifunctorI) (auto simp: smc_cs_intros)

sublocale is_tm_ntsmcf \<subseteq> NTCod: is_tm_semifunctor \<alpha> \<AA> \<BB> \<GG>
  using tm_ntsmcf_is_tm_tdghm
  by (intro is_tm_semifunctorI) (auto simp: smc_cs_intros)

text\<open>Further rules.\<close>

lemma is_tm_ntsmcfI':
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
proof-
  interpret is_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
  interpret \<FF>: is_tm_semifunctor \<alpha> \<AA> \<BB> \<FF> by (rule assms(2))
  interpret \<GG>: is_tm_semifunctor \<alpha> \<AA> \<BB> \<GG> by (rule assms(3))
  show ?thesis
  proof(intro is_tm_ntsmcfI)
    show "ntsmcf_tdghm \<NN> :
      smcf_dghm \<FF> \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>m smcf_dghm \<GG> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"
      by (intro is_tm_tdghmI) (auto simp: slicing_intros)
  qed (auto simp: assms(2,3) vfsequence_axioms smc_cs_intros)
qed

lemma is_tm_ntsmcfD':
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
proof-
  interpret is_tm_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
  show "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    by (auto simp: smc_small_cs_intros)
qed

lemmas [smc_small_cs_intros] = is_tm_ntsmcfD'(2,3)

text\<open>Size.\<close>

lemma small_all_tm_ntsmcfs[simp]:
  "small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
proof(rule down)
  show "{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
    elts (set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
  proof
    (
      simp only: elts_of_set small_all_ntsmcfs if_True,
      rule subsetI,
      unfold mem_Collect_eq
    )
    fix \<NN> assume "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    then obtain \<FF> \<GG> \<AA> \<BB> where "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
      by clarsimp
    then interpret is_tm_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> .
    have "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by (auto simp: smc_cs_intros)
    then show "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
  qed
qed

lemma small_tm_ntsmcfs[simp]:
  "small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
  by
    (
      rule
        down[
          of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
          ]
    )
    auto

lemma small_these_tm_ntsmcfs[simp]:
  "small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}"
  by
    (
      rule
        down[
          of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
          ]
    )
    auto

text\<open>Further elementary results.\<close>

lemma these_tm_ntsmcfs_iff(*not simp*):
  "\<NN> \<in>\<^sub>\<circ> these_tm_ntsmcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow>
    \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  by auto

subsubsection\<open>
Opposite natural transformation of semifunctors with tiny maps
\<close>

lemma (in is_tm_ntsmcf) is_tm_ntsmcf_op: "op_ntsmcf \<NN> :
  op_smcf \<GG> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
  by (intro is_tm_ntsmcfI')
    (cs_concl cs_shallow cs_intro: smc_cs_intros smc_op_intros)+

lemma (in is_tm_ntsmcf) is_tm_ntsmcf_op'[smc_op_intros]:
  assumes "\<GG>' = op_smcf \<GG>"
    and "\<FF>' = op_smcf \<FF>"
    and "\<AA>' = op_smc \<AA>"
    and "\<BB>' = op_smc \<BB>"
  shows "op_ntsmcf \<NN> : \<GG>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>'"
  unfolding assms by (rule is_tm_ntsmcf_op)

lemmas is_tm_ntsmcf_op[smc_op_intros] = is_tm_ntsmcf.is_tm_ntsmcf_op'

subsubsection\<open>
Vertical composition of natural transformations of
semifunctors with tiny maps
\<close>

lemma ntsmcf_vcomp_is_tm_ntsmcf[smc_small_cs_intros]:
  assumes "\<MM> : \<GG> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
proof-
  interpret \<MM>: is_tm_ntsmcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
  interpret \<NN>: is_tm_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
  show ?thesis
    by (rule is_tm_ntsmcfI') (auto intro: smc_cs_intros smc_small_cs_intros)
qed

subsubsection\<open>
Composition of a natural transformation of semifunctors and a semifunctor
\<close>

lemma ntsmcf_smcf_comp_is_tm_ntsmcf:
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH> : \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
proof-
  interpret \<NN>: is_tm_ntsmcf \<alpha> \<BB> \<CC> \<FF> \<GG> \<NN> by (rule assms(1))
  interpret \<HH>: is_tm_semifunctor \<alpha> \<AA> \<BB> \<HH> by (rule assms(2))
  from assms show ?thesis
    by (intro is_tm_ntsmcfI)
      (
        cs_concl
          cs_simp: slicing_commute[symmetric]
          cs_intro: smc_cs_intros dg_small_cs_intros slicing_intros
      )+
qed

lemma ntsmcf_smcf_comp_is_tm_ntsmcf'[smc_small_cs_intros]:
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
    and "\<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF>' = \<FF> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH>"
    and "\<GG>' = \<GG> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH>"
  shows "\<NN> \<circ>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<HH> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
  using assms(1,2) unfolding assms(3,4) by (rule ntsmcf_smcf_comp_is_tm_ntsmcf)

subsubsection\<open>
Composition of a semifunctor and a natural transformation of semifunctors
\<close>

lemma smcf_ntsmcf_comp_is_tm_ntsmcf:
  assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>" and "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN> : \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
proof-
  interpret \<HH>: is_tm_semifunctor \<alpha> \<BB> \<CC> \<HH> by (rule assms(1))
  interpret \<NN>: is_tm_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
  from assms show ?thesis
    by (intro is_tm_ntsmcfI)
      (
        cs_concl
          cs_simp: slicing_commute[symmetric]
          cs_intro: smc_cs_intros dg_small_cs_intros slicing_intros
      )+
qed

lemma smcf_ntsmcf_comp_is_tm_ntsmcf'[smc_small_cs_intros]:
  assumes "\<HH> : \<BB> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
    and "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF>' = \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<FF>"
    and "\<GG>' = \<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG>"
  shows "\<HH> \<circ>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>-\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN> : \<FF>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>m \<GG>' : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>m\<^bsub>\<alpha>\<^esub> \<CC>"
  using assms(1,2) unfolding assms(3,4) by (rule smcf_ntsmcf_comp_is_tm_ntsmcf)

subsection\<open>Tiny natural transformation of semifunctors\<close>

subsubsection\<open>Definition and elementary properties\<close>

locale is_tiny_ntsmcf = is_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> for \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> +
  assumes tiny_ntsmcf_is_tdghm[slicing_intros]: "ntsmcf_tdghm \<NN> :
    smcf_dghm \<FF> \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y smcf_dghm \<GG> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> smc_dg \<BB>"

syntax "_is_tiny_ntsmcf" :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> bool"
  (\<open>(_ :/ _ \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y _ :/ _ \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<index> _)\<close> [51, 51, 51, 51, 51] 51)
translations "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" \<rightleftharpoons>
  "CONST is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN>"

abbreviation all_tiny_ntsmcfs :: "V \<Rightarrow> V"
  where "all_tiny_ntsmcfs \<alpha> \<equiv>
    set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation tiny_ntsmcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "tiny_ntsmcfs \<alpha> \<AA> \<BB> \<equiv>
    set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

abbreviation these_tiny_ntsmcfs :: "V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V \<Rightarrow> V"
  where "these_tiny_ntsmcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<equiv>
    set {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"

lemma (in is_tiny_ntsmcf) tiny_ntsmcf_is_tdghm':
  assumes "\<alpha>' = \<alpha>"
    and "\<FF>' = smcf_dghm \<FF>"
    and "\<GG>' = smcf_dghm \<GG>"
    and "\<AA>' = smc_dg \<AA>"
    and "\<BB>' = smc_dg \<BB>"
  shows "ntsmcf_tdghm \<NN> : \<FF>' \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG>' : \<AA>' \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>'\<^esub> \<BB>'"
  unfolding assms by (rule tiny_ntsmcf_is_tdghm)

lemmas [slicing_intros] = is_tiny_ntsmcf.tiny_ntsmcf_is_tdghm'

text\<open>Rules.\<close>

lemma (in is_tiny_ntsmcf) is_tiny_ntsmcf_axioms'[smc_small_cs_intros]:
  assumes "\<alpha>' = \<alpha>" and "\<AA>' = \<AA>" and "\<BB>' = \<BB>" and "\<FF>' = \<FF>" and "\<GG>' = \<GG>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  unfolding assms by (rule is_tiny_ntsmcf_axioms)

mk_ide rf is_tiny_ntsmcf_def[unfolded is_tiny_ntsmcf_axioms_def]
  |intro is_tiny_ntsmcfI|
  |dest is_tiny_ntsmcfD[dest]|
  |elim is_tiny_ntsmcfE[elim]|

text\<open>Elementary properties.\<close>

sublocale is_tiny_ntsmcf \<subseteq> NTDom: is_tiny_semifunctor \<alpha> \<AA> \<BB> \<FF>
  using tiny_ntsmcf_is_tdghm
  by (intro is_tiny_semifunctorI) (auto simp: smc_cs_intros)

sublocale is_tiny_ntsmcf \<subseteq> NTCod: is_tiny_semifunctor \<alpha> \<AA> \<BB> \<GG>
  using tiny_ntsmcf_is_tdghm
  by (intro is_tiny_semifunctorI) (auto simp: smc_cs_intros)

sublocale is_tiny_ntsmcf \<subseteq> is_tm_ntsmcf
  by (rule is_tm_ntsmcfI')
    (auto simp: tiny_ntsmcf_is_tdghm smc_small_cs_intros smc_cs_intros)

text\<open>Further rules.\<close>

lemma is_tiny_ntsmcfI':
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  using assms by (auto intro: is_tiny_ntsmcfI)

lemma is_tiny_ntsmcfD':
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
proof-
  interpret is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(1))
  show "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    by
      (
        auto
          simp: is_ntsmcf_axioms
          intro:
            NTDom.is_tiny_semifunctor_axioms
            NTCod.is_tiny_semifunctor_axioms
      )
qed

lemmas [smc_small_cs_intros] = is_tiny_ntsmcfD'(2,3)

lemma is_tiny_ntsmcfE':
  assumes "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  obtains "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  using assms by (auto dest: is_tiny_ntsmcfD'(2,3))

lemma is_tiny_ntsmcf_iff:
  "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<longleftrightarrow>
    (
      \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB> \<and>
      \<FF> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB> \<and>
      \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>
    )"
  using is_tiny_ntsmcfI' is_tiny_ntsmcfD' by (intro iffI) auto

text\<open>Size.\<close>

lemma (in is_tiny_ntsmcf) tiny_ntsmcf_in_Vset: "\<NN> \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  note [smc_cs_intros] =
    tm_ntsmcf_NTMap_in_Vset
    NTDom.tiny_smcf_in_Vset
    NTCod.tiny_smcf_in_Vset
    NTDom.HomDom.tiny_smc_in_Vset
    NTDom.HomCod.tiny_smc_in_Vset
  show ?thesis
    by (subst ntsmcf_def)
      (
        cs_concl cs_shallow
          cs_simp: smc_cs_simps cs_intro: smc_cs_intros V_cs_intros
      )
qed

lemma small_all_tiny_ntsmcfs[simp]:
  "small {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
proof(rule down)
  show "{\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>
    elts (set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>})"
  proof
    (
      simp only: elts_of_set small_all_ntsmcfs if_True,
      rule subsetI,
      unfold mem_Collect_eq
    )
    fix \<NN> assume "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    then obtain \<FF> \<GG> \<AA> \<BB> where "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
      by clarsimp
    then interpret is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> .
    have "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>"
      by (auto intro: smc_cs_intros)
    then show "\<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<alpha>\<^esub> \<BB>" by auto
  qed
qed

lemma small_tiny_ntsmcfs[simp]:
  "small {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
  by
    (
      rule
        down[
          of
            _
            \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
          ]
    )
    auto

lemma small_these_tiny_ntcfs[simp]:
  "small {\<NN>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}"
  by
    (
      rule down[
        of _ \<open>set {\<NN>. \<exists>\<FF> \<GG> \<AA> \<BB>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>}\<close>
        ]
    )
    auto

lemma tiny_ntsmcfs_vsubset_Vset[simp]:
  "set {\<NN>. \<exists>\<FF> \<GG>. \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>} \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  (is \<open>set ?ntsmcfs \<subseteq>\<^sub>\<circ> _\<close>)
proof(cases \<open>tiny_semicategory \<alpha> \<AA> \<and> tiny_semicategory \<alpha> \<BB>\<close>)
  case True
  then have "tiny_semicategory \<alpha> \<AA>" and "tiny_semicategory \<alpha> \<BB>" by auto
  show ?thesis
  proof(rule vsubsetI)
    fix \<NN> assume "\<NN> \<in>\<^sub>\<circ> set ?ntsmcfs"
    then obtain \<FF> \<GG> where "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>" by auto
    then interpret is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> .
    from tiny_ntsmcf_in_Vset show "\<NN> \<in>\<^sub>\<circ> Vset \<alpha>" by simp
  qed
next
  case False
  then have "set ?ntsmcfs = 0"
    unfolding is_tiny_ntsmcf_iff is_tiny_semifunctor_iff by auto
  then show ?thesis by simp
qed

lemma (in is_ntsmcf) ntsmcf_is_tiny_ntsmcf_if_ge_Limit:
  assumes "\<Z> \<beta>" and "\<alpha> \<in>\<^sub>\<circ> \<beta>"
  shows "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> \<BB>"
proof(intro is_tiny_ntsmcfI)
  interpret \<beta>: \<Z> \<beta> by (rule assms(1))
  show "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^bsub>\<beta>\<^esub> \<BB>"
    by (intro ntsmcf_is_ntsmcf_if_ge_Limit)
      (use assms(2) in \<open>cs_concl cs_shallow cs_intro: dg_cs_intros\<close>)+
  show "ntsmcf_tdghm \<NN> :
    smcf_dghm \<FF> \<mapsto>\<^sub>D\<^sub>G\<^sub>H\<^sub>M\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y smcf_dghm \<GG> : smc_dg \<AA> \<mapsto>\<mapsto>\<^sub>D\<^sub>G\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<beta>\<^esub> smc_dg \<BB>"
    by
      (
        rule is_tdghm.tdghm_is_tiny_tdghm_if_ge_Limit,
        rule ntsmcf_is_tdghm;
        intro assms
     )
qed

text\<open>Further elementary results.\<close>

lemma these_tiny_ntsmcfs_iff(*not simp*):
  "\<NN> \<in>\<^sub>\<circ> these_tiny_ntsmcfs \<alpha> \<AA> \<BB> \<FF> \<GG> \<longleftrightarrow>
    \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  by auto

subsubsection\<open>Opposite natural transformation of tiny semifunctors\<close>

lemma (in is_tiny_ntsmcf) is_tm_ntsmcf_op: "op_ntsmcf \<NN> :
  op_smcf \<GG> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y op_smcf \<FF> : op_smc \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> op_smc \<BB>"
  by (intro is_tiny_ntsmcfI')
    (cs_concl cs_shallow cs_intro: smc_cs_intros smc_op_intros)+

lemma (in is_tiny_ntsmcf) is_tiny_ntsmcf_op'[smc_op_intros]:
  assumes "\<GG>' = op_smcf \<GG>"
    and "\<FF>' = op_smcf \<FF>"
    and "\<AA>' = op_smc \<AA>"
    and "\<BB>' = op_smc \<BB>"
  shows "op_ntsmcf \<NN> : \<GG>' \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<FF>' : \<AA>' \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>'"
  unfolding assms by (rule is_tm_ntsmcf_op)

lemmas is_tiny_ntsmcf_op[smc_op_intros] = is_tiny_ntsmcf.is_tiny_ntsmcf_op'

subsubsection\<open>
Vertical composition of tiny natural transformations of
semifunctors
\<close>

lemma ntsmcf_vcomp_is_tiny_ntsmcf[smc_small_cs_intros]:
  assumes "\<MM> : \<GG> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
    and "\<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<GG> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
  shows "\<MM> \<bullet>\<^sub>N\<^sub>T\<^sub>S\<^sub>M\<^sub>C\<^sub>F \<NN> : \<FF> \<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>F\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y \<HH> : \<AA> \<mapsto>\<mapsto>\<^sub>S\<^sub>M\<^sub>C\<^sub>.\<^sub>t\<^sub>i\<^sub>n\<^sub>y\<^bsub>\<alpha>\<^esub> \<BB>"
proof-
  interpret \<MM>: is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<GG> \<HH> \<MM> by (rule assms(1))
  interpret \<NN>: is_tiny_ntsmcf \<alpha> \<AA> \<BB> \<FF> \<GG> \<NN> by (rule assms(2))
  show ?thesis by (rule is_tiny_ntsmcfI') (auto intro: smc_small_cs_intros)
qed

text\<open>\newpage\<close>

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_nat_lt_ne
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun lt :: "Nat => Nat => bool" where
"lt x (Z) = False"
| "lt (Z) (S z) = True"
| "lt (S n) (S z) = lt n z"

theorem property0 :
  "((lt y x) ==> (x ~= y))"
  oops

end


(*  Title:       variants/b_fwdrreps/Loop_Freedom.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Routing graphs and loop freedom"

theory B_Loop_Freedom
imports B_Aodv_Predicates B_Fresher
begin

text \<open>Define the central theorem that relates an invariant over network states to the absence
      of loops in the associate routing graph.\<close>

definition
  rt_graph :: "(ip \<Rightarrow> state) \<Rightarrow> ip \<Rightarrow> ip rel"
where
  "rt_graph \<sigma> = (\<lambda>dip.
     {(ip, ip') | ip ip' dsn dsk hops pre.
        ip \<noteq> dip \<and> rt (\<sigma> ip) dip = Some (dsn, dsk, val, hops, ip', pre)})"

text \<open>Given the state of a network @{term \<sigma>}, a routing graph for a given destination
      ip address @{term dip} abstracts the details of routing tables into nodes
      (ip addresses) and vertices (valid routes between ip addresses).\<close>

lemma rt_graphE [elim]:
    fixes n dip ip ip'
  assumes "(ip, ip') \<in> rt_graph \<sigma> dip"
    shows "ip \<noteq> dip \<and> (\<exists>r. rt (\<sigma> ip) = r
                            \<and> (\<exists>dsn dsk hops pre. r dip = Some (dsn, dsk, val, hops, ip', pre)))"
  using assms unfolding rt_graph_def by auto

lemma rt_graph_vD [dest]:
  "\<And>ip ip' \<sigma> dip. (ip, ip') \<in> rt_graph \<sigma> dip \<Longrightarrow> dip \<in> vD(rt (\<sigma> ip))"
  unfolding rt_graph_def vD_def by auto

lemma rt_graph_vD_trans [dest]:
  "\<And>ip ip' \<sigma> dip. (ip, ip') \<in> (rt_graph \<sigma> dip)\<^sup>+ \<Longrightarrow> dip \<in> vD(rt (\<sigma> ip))"
  by (erule converse_tranclE) auto

lemma rt_graph_not_dip [dest]:
  "\<And>ip ip' \<sigma> dip. (ip, ip') \<in> rt_graph \<sigma> dip \<Longrightarrow> ip \<noteq> dip"
  unfolding rt_graph_def by auto

lemma rt_graph_not_dip_trans [dest]:
  "\<And>ip ip' \<sigma> dip. (ip, ip') \<in> (rt_graph \<sigma> dip)\<^sup>+ \<Longrightarrow> ip \<noteq> dip"
  by (erule converse_tranclE) auto

text "NB: the property below cannot be lifted to the transitive closure"

lemma rt_graph_nhip_is_nhop [dest]:
  "\<And>ip ip' \<sigma> dip. (ip, ip') \<in> rt_graph \<sigma> dip \<Longrightarrow> ip' = the (nhop (rt (\<sigma> ip)) dip)"
  unfolding rt_graph_def by auto

theorem inv_to_loop_freedom:
  assumes "\<forall>i dip. let nhip = the (nhop (rt (\<sigma> i)) dip)
                   in dip \<in> vD (rt (\<sigma> i)) \<inter> vD (rt (\<sigma> nhip)) \<and> nhip \<noteq> dip
                      \<longrightarrow> (rt (\<sigma> i)) \<sqsubset>\<^bsub>dip\<^esub> (rt (\<sigma> nhip))"
    shows "\<forall>dip. irrefl ((rt_graph \<sigma> dip)\<^sup>+)"
  using assms proof (intro allI)
    fix \<sigma> :: "ip \<Rightarrow> state" and dip
    assume inv: "\<forall>ip dip.
                  let nhip = the (nhop (rt (\<sigma> ip)) dip)
                  in dip \<in> vD(rt (\<sigma> ip)) \<inter> vD(rt (\<sigma> nhip)) \<and>
                     nhip \<noteq> dip \<longrightarrow> rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip)"
    { fix ip ip'
      assume "(ip, ip') \<in> (rt_graph \<sigma> dip)\<^sup>+"
         and "dip \<in> vD(rt (\<sigma> ip'))"
         and "ip' \<noteq> dip"
       hence "rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> ip')"
         proof induction
           fix nhip
           assume "(ip, nhip) \<in> rt_graph \<sigma> dip"
              and "dip \<in> vD(rt (\<sigma> nhip))"
              and "nhip \<noteq> dip"
           from \<open>(ip, nhip) \<in> rt_graph \<sigma> dip\<close> have "dip \<in> vD(rt (\<sigma> ip))"
                                               and "nhip = the (nhop (rt (\<sigma> ip)) dip)"
             by auto
           from \<open>dip \<in> vD(rt (\<sigma> ip))\<close> and \<open>dip \<in> vD(rt (\<sigma> nhip))\<close>
             have "dip \<in> vD(rt (\<sigma> ip)) \<inter> vD(rt (\<sigma> nhip))" ..
           with \<open>nhip = the (nhop (rt (\<sigma> ip)) dip)\<close>
                and \<open>nhip \<noteq> dip\<close>
                and inv
             show "rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip)"
             by (clarsimp simp: Let_def)
         next
           fix nhip nhip'
           assume "(ip, nhip) \<in> (rt_graph \<sigma> dip)\<^sup>+"
              and "(nhip, nhip') \<in> rt_graph \<sigma> dip"
              and IH: "\<lbrakk> dip \<in> vD(rt (\<sigma> nhip)); nhip \<noteq> dip \<rbrakk> \<Longrightarrow> rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip)"
              and "dip \<in> vD(rt (\<sigma> nhip'))"
              and "nhip' \<noteq> dip"
           from \<open>(nhip, nhip') \<in> rt_graph \<sigma> dip\<close> have 1: "dip \<in> vD(rt (\<sigma> nhip))"
                                                  and 2: "nhip \<noteq> dip"
                                                  and "nhip' = the (nhop (rt (\<sigma> nhip)) dip)"
             by auto
           from 1 2 have "rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip)" by (rule IH)
           also have "rt (\<sigma> nhip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip')"
             proof -
               from \<open>dip \<in> vD(rt (\<sigma> nhip))\<close> and \<open>dip \<in> vD(rt (\<sigma> nhip'))\<close>
                 have "dip \<in> vD(rt (\<sigma> nhip)) \<inter> vD(rt (\<sigma> nhip'))" ..
               with \<open>nhip' \<noteq> dip\<close>
                    and \<open>nhip' = the (nhop (rt (\<sigma> nhip)) dip)\<close>
                    and inv
                 show "rt (\<sigma> nhip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip')"
                   by (clarsimp simp: Let_def)
             qed
           finally show "rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> nhip')" .
         qed } note fresher = this

    show "irrefl ((rt_graph \<sigma> dip)\<^sup>+)"
    unfolding irrefl_def proof (intro allI notI)
      fix ip
      assume "(ip, ip) \<in> (rt_graph \<sigma> dip)\<^sup>+"
      moreover then have "dip \<in> vD(rt (\<sigma> ip))"
                     and "ip \<noteq> dip"
        by auto
      ultimately have "rt (\<sigma> ip) \<sqsubset>\<^bsub>dip\<^esub> rt (\<sigma> ip)" by (rule fresher)
      thus False by simp
    qed
  qed

end


(*<*)
theory GoedelGod
imports Main

begin
(*>*)

section \<open>Introduction\<close>

 text \<open>Dana Scott's version \cite{ScottNotes} (cf.~Fig.~1)
 of G\"odel's proof of God's existence \cite{GoedelNotes} is
 formalized in quantified modal logic KB (QML KB) within the proof assistant Isabelle/HOL.
 QML KB is  modeled as a fragment of classical higher-order logic (HOL);
 thus, the formalization is essentially a formalization in HOL. The employed embedding
 of QML KB in HOL is adapting the work of Benzm\"uller and Paulson \cite{J23,B9}.
 Note that the QML KB formalization employs quantification over individuals and
 quantification over sets of individuals (properties).

 The gaps in Scott's proof have been automated
 with Sledgehammer \cite{Sledgehammer}, performing remote calls to the higher-order automated
 theorem prover LEO-II \cite{LEO-II}. Sledgehammer suggests the
 Metis \cite{Metis} calls, which result in proofs that are verified by Isabelle/HOL.
 For consistency checking, the model finder Nitpick \cite{Nitpick} has been employed.
 The successfull calls to Sledgehammer
 are deliberately kept as comments in the file for demonstration purposes
 (normally, they are automatically eliminated by Isabelle/HOL).

 Isabelle is described in the textbook by Nipkow,
 Paulson, and Wenzel \cite{Isabelle} and in tutorials available
 at: @{url "http://isabelle.in.tum.de"}.

\subsection{Related Work}

 The formalization presented here is related to the THF \cite{J22} and
 Coq \cite{Coq} formalizations at
 @{url "https://github.com/FormalTheology/GoedelGod/tree/master/Formalizations/"}.

 An older ontological argument by Anselm was formalized in PVS by John Rushby \cite{rushby}.
\<close>

section \<open>An Embedding of QML KB in HOL\<close>

text \<open>The types \<open>i\<close> for possible worlds and $\mu$ for individuals are introduced.\<close>

  typedecl i    \<comment> \<open>the type for possible worlds\<close>
  typedecl \<mu>    \<comment> \<open>the type for indiviuals\<close>

text \<open>Possible worlds are connected by an accessibility relation \<open>r\<close>.\<close>

  consts r :: "i \<Rightarrow> i \<Rightarrow> bool" (infixr "r" 70)    \<comment> \<open>accessibility relation r\<close>

text \<open>QML formulas are translated as HOL terms of type @{typ "i \<Rightarrow> bool"}.
This type is abbreviated as \<open>\<sigma>\<close>.\<close>

  type_synonym \<sigma> = "(i \<Rightarrow> bool)"

text \<open>The classical connectives $\neg, \wedge, \rightarrow$, and $\forall$
(over individuals and over sets of individuals) and $\exists$ (over individuals) are
lifted to type $\sigma$. The lifted connectives are \<open>m\<not>\<close>, \<open>m\<and>\<close>, \<open>m\<rightarrow>\<close>,
\<open>\<forall>\<close>, and \<open>\<exists>\<close> (the latter two are modeled as constant symbols).
Other connectives can be introduced analogously. We exemplarily do this for \<open>m\<or>\<close> ,
\<open>m\<equiv>\<close>, and \<open>mL=\<close> (Leibniz equality on individuals). Moreover, the modal
operators \<open>\<box>\<close> and \<open>\<diamond>\<close>  are introduced. Definitions could be used instead of
abbreviations.\<close>

  abbreviation mnot :: "\<sigma> \<Rightarrow> \<sigma>" ("m\<not>") where "m\<not> \<phi> \<equiv> (\<lambda>w. \<not> \<phi> w)"
  abbreviation mand :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<and>" 65) where "\<phi> m\<and> \<psi> \<equiv> (\<lambda>w. \<phi> w \<and> \<psi> w)"
  abbreviation mor :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<or>" 70) where "\<phi> m\<or> \<psi> \<equiv> (\<lambda>w. \<phi> w \<or> \<psi> w)"
  abbreviation mimplies :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<rightarrow>" 74) where "\<phi> m\<rightarrow> \<psi> \<equiv> (\<lambda>w. \<phi> w \<longrightarrow> \<psi> w)"
  abbreviation mequiv:: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<equiv>" 76) where "\<phi> m\<equiv> \<psi> \<equiv> (\<lambda>w. \<phi> w \<longleftrightarrow> \<psi> w)"
  abbreviation mforall :: "('a \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<forall>") where "\<forall> \<Phi> \<equiv> (\<lambda>w. \<forall>x. \<Phi> x w)"
  abbreviation mexists :: "('a \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<exists>") where "\<exists> \<Phi> \<equiv> (\<lambda>w. \<exists>x. \<Phi> x w)"
  abbreviation mLeibeq :: "\<mu> \<Rightarrow> \<mu> \<Rightarrow> \<sigma>" (infixr "mL=" 90) where "x mL= y \<equiv> \<forall>(\<lambda>\<phi>. (\<phi> x m\<rightarrow> \<phi> y))"
  abbreviation mbox :: "\<sigma> \<Rightarrow> \<sigma>" ("\<box>") where "\<box> \<phi> \<equiv> (\<lambda>w. \<forall>v.  w r v \<longrightarrow> \<phi> v)"
  abbreviation mdia :: "\<sigma> \<Rightarrow> \<sigma>" ("\<diamond>") where "\<diamond> \<phi> \<equiv> (\<lambda>w. \<exists>v. w r v \<and> \<phi> v)"

text \<open>For grounding lifted formulas, the meta-predicate \<open>valid\<close> is introduced.\<close>

  (*<*) no_syntax "_list" :: "args \<Rightarrow> 'a list" ("[(_)]") (*>*)
  abbreviation valid :: "\<sigma> \<Rightarrow> bool" ("[_]") where "[p] \<equiv> \<forall>w. p w"

section \<open>G\"odel's Ontological Argument\<close>

text \<open>Constant symbol \<open>P\<close> (G\"odel's `Positive') is declared.\<close>

  consts P :: "(\<mu> \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>"

text \<open>The meaning of \<open>P\<close> is restricted by axioms \<open>A1(a/b)\<close>: $\all \phi
[P(\neg \phi) \biimp \neg P(\phi)]$ (Either a property or its negation is positive, but not both.)
and \<open>A2\<close>: $\all \phi \all \psi [(P(\phi) \wedge \nec \all x [\phi(x) \imp \psi(x)])
\imp P(\psi)]$ (A property necessarily implied by a positive property is positive).\<close>

  axiomatization where
    A1a: "[\<forall>(\<lambda>\<Phi>. P (\<lambda>x. m\<not> (\<Phi> x)) m\<rightarrow> m\<not> (P \<Phi>))]" and
    A1b: "[\<forall>(\<lambda>\<Phi>. m\<not> (P \<Phi>) m\<rightarrow> P (\<lambda>x. m\<not> (\<Phi> x)))]" and
    A2:  "[\<forall>(\<lambda>\<Phi>. \<forall>(\<lambda>\<Psi>. (P \<Phi> m\<and> \<box> (\<forall>(\<lambda>x. \<Phi> x m\<rightarrow> \<Psi> x))) m\<rightarrow> P \<Psi>))]"

text \<open>We prove theorem T1: $\all \phi [P(\phi) \imp \pos \ex x \phi(x)]$ (Positive
properties are possibly exemplified). T1 is proved directly by Sledgehammer with command \<open>sledgehammer [provers = remote_leo2]\<close>.
Sledgehammer suggests to call Metis with axioms A1a and A2.
Metis sucesfully generates a proof object
that is verified in Isabelle/HOL's kernel.\<close>

  theorem T1: "[\<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<diamond> (\<exists> \<Phi>))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1a A2)

text \<open>Next, the symbol \<open>G\<close> for `God-like'  is introduced and defined
as $G(x) \biimp \forall \phi [P(\phi) \to \phi(x)]$ \\ (A God-like being possesses
all positive properties).\<close>

  definition G :: "\<mu> \<Rightarrow> \<sigma>" where "G = (\<lambda>x. \<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<Phi> x))"

text \<open>Axiom \<open>A3\<close> is added: $P(G)$ (The property of being God-like is positive).
Sledgehammer and Metis then prove corollary \<open>C\<close>: $\pos \ex x G(x)$
(Possibly, God exists).\<close>

  axiomatization where A3:  "[P G]"

  corollary C: "[\<diamond> (\<exists> G)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A3 T1)

text \<open>Axiom \<open>A4\<close> is added: $\all \phi [P(\phi) \to \Box \; P(\phi)]$
(Positive properties are necessarily positive).\<close>

  axiomatization where A4:  "[\<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<box> (P \<Phi>))]"

text \<open>Symbol \<open>ess\<close> for `Essence' is introduced and defined as
$$\ess{\phi}{x} \biimp \phi(x) \wedge \all \psi (\psi(x) \imp \nec \all y (\phi(y)
\imp \psi(y)))$$ (An \emph{essence} of an individual is a property possessed by it and necessarily implying any of its properties).\<close>

  definition ess :: "(\<mu> \<Rightarrow> \<sigma>) \<Rightarrow> \<mu> \<Rightarrow> \<sigma>" (infixr "ess" 85) where
    "\<Phi> ess x = \<Phi> x m\<and> \<forall>(\<lambda>\<Psi>. \<Psi> x m\<rightarrow> \<box> (\<forall>(\<lambda>y. \<Phi> y m\<rightarrow> \<Psi> y)))"

text \<open>Next, Sledgehammer and Metis prove theorem \<open>T2\<close>: $\all x [G(x) \imp \ess{G}{x}]$ \\
(Being God-like is an essence of any God-like being).\<close>

  theorem T2: "[\<forall>(\<lambda>x. G x m\<rightarrow> G ess x)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1b A4 G_def ess_def)

text \<open>Symbol \<open>NE\<close>, for `Necessary Existence', is introduced and
defined as $$\NE(x) \biimp \all \phi [\ess{\phi}{x} \imp \nec \ex y \phi(y)]$$ (Necessary
existence of an individual is the necessary exemplification of all its essences).\<close>

  definition NE :: "\<mu> \<Rightarrow> \<sigma>" where "NE = (\<lambda>x. \<forall>(\<lambda>\<Phi>. \<Phi> ess x m\<rightarrow> \<box> (\<exists> \<Phi>)))"

text \<open>Moreover, axiom \<open>A5\<close> is added: $P(\NE)$ (Necessary existence is a positive
property).\<close>

  axiomatization where A5:  "[P NE]"

text \<open>The \<open>B\<close> axiom (symmetry) for relation r is stated. \<open>B\<close> is needed only
for proving theorem T3 and for corollary C2.\<close>

  axiomatization where sym: "x r y \<longrightarrow> y r x"

text \<open>Finally, Sledgehammer and Metis prove the main theorem \<open>T3\<close>: $\nec \ex x G(x)$ \\
(Necessarily, God exists).\<close>

  theorem T3: "[\<box> (\<exists> G)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A5 C T2 sym G_def NE_def)

text \<open>Surprisingly, the following corollary can be derived even without the \<open>T\<close> axiom
(reflexivity).\<close>

  corollary C2: "[\<exists> G]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis T1 T3 G_def sym)

text \<open>The consistency of the entire theory is confirmed by Nitpick.\<close>

  lemma True nitpick [satisfy, user_axioms, expect = genuine] oops

section \<open>Additional Results on G\"odel's God.\<close>

text \<open>G\"odel's God is flawless: (s)he does not have non-positive properties.\<close>

  theorem Flawlessness: "[\<forall>(\<lambda>\<Phi>. \<forall>(\<lambda>x. (G x m\<rightarrow> (m\<not> (P \<Phi>) m\<rightarrow> m\<not> (\<Phi> x)))))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1b G_def)

text \<open>There is only one God: any two God-like beings are equal.\<close>

  theorem Monotheism: "[\<forall>(\<lambda>x.\<forall>(\<lambda>y. (G x m\<rightarrow> (G y m\<rightarrow> (x mL= y)))))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis Flawlessness G_def)

section \<open>Modal Collapse\<close>

text \<open>G\"odel's axioms have been criticized for entailing the so-called
modal collapse. The prover Satallax \cite{Satallax} confirms this.
However, sledgehammer is not able to determine which axioms,
definitions and previous theorems are used by Satallax;
hence it suggests to call Metis using everything, but this (unsurprinsingly) fails.
Attempting to use `Sledegehammer min' to minimize Sledgehammer's suggestion does not work.
Calling Metis with \<open>T2\<close>, \<open>T3\<close> and \<open>ess_def\<close> also does not work.\<close>

  lemma MC: "[\<forall>(\<lambda>\<Phi>.(\<Phi> m\<rightarrow> (\<box> \<Phi>)))]"
  \<comment> \<open>sledgehammer [provers = remote\_satallax]\<close>
  \<comment> \<open>by (metis T2 T3 ess\_def)\<close>
  oops
(*<*)
end
(*>*)


theory Example_Exp
imports
  "../Numerics/Euler_Affine"
  "../Numerics/Optimize_Float"
begin

subsection {* Example Exponential *}

text {* TODO: why not exp-ivp "lambda x::real. x"? *}

approximate_affine exp_ivp "\<lambda>(x::real, y::real). (x, y)"

lemma exp_ivp_fderiv: "((\<lambda>(x::real, y::real). (x, y)) has_derivative (\<lambda>(a, b) (h\<^sub>1, h\<^sub>2). (h\<^sub>1, h\<^sub>2 + 0 *a*b)) x) (at x within X)"
  by (auto intro!: derivative_eq_intros simp: split_beta id_def)

approximate_affine exp_ivp_d "(\<lambda>(a::real, b::real) (h\<^sub>1::real, h\<^sub>2::real). (h\<^sub>1, h\<^sub>2 + 0 *a*b))"

interpretation exp_ivp!: aform_approximate_ivp
  "uncurry_options exp_ivp"
  "uncurry_options exp_ivp_d"
  "\<lambda>(y\<^sub>1, y\<^sub>2). (y\<^sub>1, y\<^sub>2)"
  "\<lambda>(a, b) (h\<^sub>1, h\<^sub>2). (h\<^sub>1, h\<^sub>2 + 0 *a*b)"
  apply default
  apply (rule exp_ivp[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (rule exp_ivp_fderiv)
  apply (rule exp_ivp_d[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (auto intro!: continuous_intros simp: split_beta)
  done

definition "exp_optns = default_optns
    \<lparr> precision := 40,
      tolerance := FloatR 1 (- 9),
      stepsize  := FloatR 1 (- 6),
      result_fun := ivls_result 23 1,
      iterations := 40,
      widening_mod := 10,
      printing_fun := (\<lambda>_ _ _. ())\<rparr>"

definition "exptest = (\<lambda>_::unit.
  euler_series_result (uncurry_options exp_ivp) (uncurry_options exp_ivp_d) exp_optns
    0 (aform_of_point (1, 1)) (2 ^ 6))"

lemma "exptest () = Some (FloatR 64 (- 6),
       [(FloatR 63 (- 6), (FloatR 5612042 (- 21), FloatR 5612042 (- 21)), (FloatR 5701117 (- 21), FloatR 5701117 (- 21)),
         FloatR 64 (- 6), (FloatR 5700420 (- 21), FloatR 5700420 (- 21)), FloatR 5701117 (- 21), FloatR 5701117 (- 21)),
        (FloatR 62 (- 6), (FloatR 5525039 (- 21), FloatR 5525039 (- 21)), (FloatR 5612723 (- 21), FloatR 5612723 (- 21)),
         FloatR 63 (- 6), (FloatR 5612047 (- 21), FloatR 5612047 (- 21)), FloatR 5612723 (- 21), FloatR 5612723 (- 21)),
        (FloatR 61 (- 6), (FloatR 5439384 (- 21), FloatR 5439384 (- 21)), (FloatR 5525698 (- 21), FloatR 5525698 (- 21)),
         FloatR 62 (- 6), (FloatR 5525044 (- 21), FloatR 5525044 (- 21)), FloatR 5525698 (- 21), FloatR 5525698 (- 21)),
        (FloatR 60 (- 6), (FloatR 5355058 (- 21), FloatR 5355058 (- 21)), (FloatR 5440023 (- 21), FloatR 5440023 (- 21)),
         FloatR 61 (- 6), (FloatR 5439389 (- 21), FloatR 5439389 (- 21)), FloatR 5440023 (- 21), FloatR 5440023 (- 21)),
        (FloatR 59 (- 6), (FloatR 5272039 (- 21), FloatR 5272039 (- 21)), (FloatR 5355677 (- 21), FloatR 5355677 (- 21)),
         FloatR 60 (- 6), (FloatR 5355063 (- 21), FloatR 5355063 (- 21)), FloatR 5355677 (- 21), FloatR 5355677 (- 21)),
        (FloatR 58 (- 6), (FloatR 5190307 (- 21), FloatR 5190307 (- 21)), (FloatR 5272638 (- 21), FloatR 5272638 (- 21)),
         FloatR 59 (- 6), (FloatR 5272044 (- 21), FloatR 5272044 (- 21)), FloatR 5272638 (- 21), FloatR 5272638 (- 21)),
        (FloatR 57 (- 6), (FloatR 5109842 (- 21), FloatR 5109842 (- 21)), (FloatR 5190887 (- 21), FloatR 5190887 (- 21)),
         FloatR 58 (- 6), (FloatR 5190311 (- 21), FloatR 5190311 (- 21)), FloatR 5190887 (- 21), FloatR 5190887 (- 21)),
        (FloatR 56 (- 6), (FloatR 5030624 (- 21), FloatR 5030624 (- 21)), (FloatR 5110403 (- 21), FloatR 5110403 (- 21)),
         FloatR 57 (- 6), (FloatR 5109846 (- 21), FloatR 5109846 (- 21)), FloatR 5110403 (- 21), FloatR 5110403 (- 21)),
        (FloatR 55 (- 6), (FloatR 4952635 (- 21), FloatR 4952635 (- 21)), (FloatR 5031167 (- 21), FloatR 5031167 (- 21)),
         FloatR 56 (- 6), (FloatR 5030629 (- 21), FloatR 5030629 (- 21)), FloatR 5031167 (- 21), FloatR 5031167 (- 21)),
        (FloatR 54 (- 6), (FloatR 4875855 (- 21), FloatR 4875855 (- 21)), (FloatR 4953160 (- 21), FloatR 4953160 (- 21)),
         FloatR 55 (- 6), (FloatR 4952639 (- 21), FloatR 4952639 (- 21)), FloatR 4953160 (- 21), FloatR 4953160 (- 21)),
        (FloatR 53 (- 6), (FloatR 4800265 (- 21), FloatR 4800265 (- 21)), (FloatR 4876362 (- 21), FloatR 4876362 (- 21)),
         FloatR 54 (- 6), (FloatR 4875859 (- 21), FloatR 4875859 (- 21)), FloatR 4876362 (- 21), FloatR 4876362 (- 21)),
        (FloatR 52 (- 6), (FloatR 4725846 (- 21), FloatR 4725846 (- 21)), (FloatR 4800755 (- 21), FloatR 4800755 (- 21)),
         FloatR 53 (- 6), (FloatR 4800268 (- 21), FloatR 4800268 (- 21)), FloatR 4800755 (- 21), FloatR 4800755 (- 21)),
        (FloatR 51 (- 6), (FloatR 4652582 (- 21), FloatR 4652582 (- 21)), (FloatR 4726320 (- 21), FloatR 4726320 (- 21)),
         FloatR 52 (- 6), (FloatR 4725850 (- 21), FloatR 4725850 (- 21)), FloatR 4726320 (- 21), FloatR 4726320 (- 21)),
        (FloatR 50 (- 6), (FloatR 4580453 (- 21), FloatR 4580453 (- 21)), (FloatR 4653039 (- 21), FloatR 4653039 (- 21)),
         FloatR 51 (- 6), (FloatR 4652585 (- 21), FloatR 4652585 (- 21)), FloatR 4653039 (- 21), FloatR 4653039 (- 21)),
        (FloatR 49 (- 6), (FloatR 4509443 (- 21), FloatR 4509443 (- 21)), (FloatR 4580895 (- 21), FloatR 4580895 (- 21)),
         FloatR 50 (- 6), (FloatR 4580457 (- 21), FloatR 4580457 (- 21)), FloatR 4580895 (- 21), FloatR 4580895 (- 21)),
        (FloatR 48 (- 6), (FloatR 4439533 (- 21), FloatR 4439533 (- 21)), (FloatR 4509869 (- 21), FloatR 4509869 (- 21)),
         FloatR 49 (- 6), (FloatR 4509446 (- 21), FloatR 4509446 (- 21)), FloatR 4509869 (- 21), FloatR 4509869 (- 21)),
        (FloatR 47 (- 6), (FloatR 4370707 (- 21), FloatR 4370707 (- 21)), (FloatR 4439944 (- 21), FloatR 4439944 (- 21)),
         FloatR 48 (- 6), (FloatR 4439536 (- 21), FloatR 4439536 (- 21)), FloatR 4439944 (- 21), FloatR 4439944 (- 21)),
        (FloatR 46 (- 6), (FloatR 4302949 (- 21), FloatR 4302949 (- 21)), (FloatR 4371103 (- 21), FloatR 4371103 (- 21)),
         FloatR 47 (- 6), (FloatR 4370711 (- 21), FloatR 4370711 (- 21)), FloatR 4371103 (- 21), FloatR 4371103 (- 21)),
        (FloatR 45 (- 6), (FloatR 4236240 (- 21), FloatR 4236240 (- 21)), (FloatR 4303330 (- 21), FloatR 4303330 (- 21)),
         FloatR 46 (- 6), (FloatR 4302952 (- 21), FloatR 4302952 (- 21)), FloatR 4303330 (- 21), FloatR 4303330 (- 21)),
        (FloatR 44 (- 6), (FloatR 8341133 (- 22), FloatR 8341133 (- 22)), (FloatR 4236608 (- 21), FloatR 4236608 (- 21)),
         FloatR 45 (- 6), (FloatR 4236243 (- 21), FloatR 4236243 (- 21)), FloatR 4236608 (- 21), FloatR 4236608 (- 21)),
        (FloatR 43 (- 6), (FloatR 8211821 (- 22), FloatR 8211821 (- 22)), (FloatR 8341840 (- 22), FloatR 8341840 (- 22)),
         FloatR 44 (- 6), (FloatR 8341138 (- 22), FloatR 8341138 (- 22)), FloatR 8341840 (- 22), FloatR 8341840 (- 22)),
        (FloatR 42 (- 6), (FloatR 8084514 (- 22), FloatR 8084514 (- 22)), (FloatR 8212501 (- 22), FloatR 8212501 (- 22)),
         FloatR 43 (- 6), (FloatR 8211826 (- 22), FloatR 8211826 (- 22)), FloatR 8212501 (- 22), FloatR 8212501 (- 22)),
        (FloatR 41 (- 6), (FloatR 7959180 (- 22), FloatR 7959180 (- 22)), (FloatR 8085167 (- 22), FloatR 8085167 (- 22)),
         FloatR 42 (- 6), (FloatR 8084519 (- 22), FloatR 8084519 (- 22)), FloatR 8085167 (- 22), FloatR 8085167 (- 22)),
        (FloatR 40 (- 6), (FloatR 7835789 (- 22), FloatR 7835789 (- 22)), (FloatR 7959808 (- 22), FloatR 7959808 (- 22)),
         FloatR 41 (- 6), (FloatR 7959185 (- 22), FloatR 7959185 (- 22)), FloatR 7959808 (- 22), FloatR 7959808 (- 22)),
        (FloatR 39 (- 6), (FloatR 7714312 (- 22), FloatR 7714312 (- 22)), (FloatR 7836393 (- 22), FloatR 7836393 (- 22)),
         FloatR 40 (- 6), (FloatR 7835794 (- 22), FloatR 7835794 (- 22)), FloatR 7836393 (- 22), FloatR 7836393 (- 22)),
        (FloatR 38 (- 6), (FloatR 7594717 (- 22), FloatR 7594717 (- 22)), (FloatR 7714891 (- 22), FloatR 7714891 (- 22)),
         FloatR 39 (- 6), (FloatR 7714316 (- 22), FloatR 7714316 (- 22)), FloatR 7714891 (- 22), FloatR 7714891 (- 22)),
        (FloatR 37 (- 6), (FloatR 7476977 (- 22), FloatR 7476977 (- 22)), (FloatR 7595273 (- 22), FloatR 7595273 (- 22)),
         FloatR 38 (- 6), (FloatR 7594722 (- 22), FloatR 7594722 (- 22)), FloatR 7595273 (- 22), FloatR 7595273 (- 22)),
        (FloatR 36 (- 6), (FloatR 7361062 (- 22), FloatR 7361062 (- 22)), (FloatR 7477510 (- 22), FloatR 7477510 (- 22)),
         FloatR 37 (- 6), (FloatR 7476981 (- 22), FloatR 7476981 (- 22)), FloatR 7477510 (- 22), FloatR 7477510 (- 22)),
        (FloatR 35 (- 6), (FloatR 7246944 (- 22), FloatR 7246944 (- 22)), (FloatR 7361572 (- 22), FloatR 7361572 (- 22)),
         FloatR 36 (- 6), (FloatR 7361066 (- 22), FloatR 7361066 (- 22)), FloatR 7361572 (- 22), FloatR 7361572 (- 22)),
        (FloatR 34 (- 6), (FloatR 7134595 (- 22), FloatR 7134595 (- 22)), (FloatR 7247432 (- 22), FloatR 7247432 (- 22)),
         FloatR 35 (- 6), (FloatR 7246948 (- 22), FloatR 7246948 (- 22)), FloatR 7247432 (- 22), FloatR 7247432 (- 22)),
        (FloatR 33 (- 6), (FloatR 7023988 (- 22), FloatR 7023988 (- 22)), (FloatR 7135062 (- 22), FloatR 7135062 (- 22)),
         FloatR 34 (- 6), (FloatR 7134599 (- 22), FloatR 7134599 (- 22)), FloatR 7135062 (- 22), FloatR 7135062 (- 22)),
        (FloatR 32 (- 6), (FloatR 6915095 (- 22), FloatR 6915095 (- 22)), (FloatR 7024434 (- 22), FloatR 7024434 (- 22)),
         FloatR 33 (- 6), (FloatR 7023991 (- 22), FloatR 7023991 (- 22)), FloatR 7024434 (- 22), FloatR 7024434 (- 22)),
        (FloatR 31 (- 6), (FloatR 6807891 (- 22), FloatR 6807891 (- 22)), (FloatR 6915522 (- 22), FloatR 6915522 (- 22)),
         FloatR 32 (- 6), (FloatR 6915099 (- 22), FloatR 6915099 (- 22)), FloatR 6915522 (- 22), FloatR 6915522 (- 22)),
        (FloatR 30 (- 6), (FloatR 6702349 (- 22), FloatR 6702349 (- 22)), (FloatR 6808298 (- 22), FloatR 6808298 (- 22)),
         FloatR 31 (- 6), (FloatR 6807894 (- 22), FloatR 6807894 (- 22)), FloatR 6808298 (- 22), FloatR 6808298 (- 22)),
        (FloatR 29 (- 6), (FloatR 6598443 (- 22), FloatR 6598443 (- 22)), (FloatR 6702736 (- 22), FloatR 6702736 (- 22)),
         FloatR 30 (- 6), (FloatR 6702352 (- 22), FloatR 6702352 (- 22)), FloatR 6702736 (- 22), FloatR 6702736 (- 22)),
        (FloatR 28 (- 6), (FloatR 6496148 (- 22), FloatR 6496148 (- 22)), (FloatR 6598812 (- 22), FloatR 6598812 (- 22)),
         FloatR 29 (- 6), (FloatR 6598446 (- 22), FloatR 6598446 (- 22)), FloatR 6598812 (- 22), FloatR 6598812 (- 22)),
        (FloatR 27 (- 6), (FloatR 6395438 (- 22), FloatR 6395438 (- 22)), (FloatR 6496498 (- 22), FloatR 6496498 (- 22)),
         FloatR 28 (- 6), (FloatR 6496150 (- 22), FloatR 6496150 (- 22)), FloatR 6496498 (- 22), FloatR 6496498 (- 22)),
        (FloatR 26 (- 6), (FloatR 6296290 (- 22), FloatR 6296290 (- 22)), (FloatR 6395771 (- 22), FloatR 6395771 (- 22)),
         FloatR 27 (- 6), (FloatR 6395441 (- 22), FloatR 6395441 (- 22)), FloatR 6395771 (- 22), FloatR 6395771 (- 22)),
        (FloatR 25 (- 6), (FloatR 6198679 (- 22), FloatR 6198679 (- 22)), (FloatR 6296606 (- 22), FloatR 6296606 (- 22)),
         FloatR 26 (- 6), (FloatR 6296293 (- 22), FloatR 6296293 (- 22)), FloatR 6296606 (- 22), FloatR 6296606 (- 22)),
        (FloatR 24 (- 6), (FloatR 6102582 (- 22), FloatR 6102582 (- 22)), (FloatR 6198978 (- 22), FloatR 6198978 (- 22)),
         FloatR 25 (- 6), (FloatR 6198682 (- 22), FloatR 6198682 (- 22)), FloatR 6198978 (- 22), FloatR 6198978 (- 22)),
        (FloatR 23 (- 6), (FloatR 6007974 (- 22), FloatR 6007974 (- 22)), (FloatR 6102864 (- 22), FloatR 6102864 (- 22)),
         FloatR 24 (- 6), (FloatR 6102584 (- 22), FloatR 6102584 (- 22)), FloatR 6102864 (- 22), FloatR 6102864 (- 22)),
        (FloatR 22 (- 6), (FloatR 5914832 (- 22), FloatR 5914832 (- 22)), (FloatR 6008240 (- 22), FloatR 6008240 (- 22)),
         FloatR 23 (- 6), (FloatR 6007976 (- 22), FloatR 6007976 (- 22)), FloatR 6008240 (- 22), FloatR 6008240 (- 22)),
        (FloatR 21 (- 6), (FloatR 5823135 (- 22), FloatR 5823135 (- 22)), (FloatR 5915084 (- 22), FloatR 5915084 (- 22)),
         FloatR 22 (- 6), (FloatR 5914834 (- 22), FloatR 5914834 (- 22)), FloatR 5915084 (- 22), FloatR 5915084 (- 22)),
        (FloatR 20 (- 6), (FloatR 5732860 (- 22), FloatR 5732860 (- 22)), (FloatR 5823371 (- 22), FloatR 5823371 (- 22)),
         FloatR 21 (- 6), (FloatR 5823137 (- 22), FloatR 5823137 (- 22)), FloatR 5823371 (- 22), FloatR 5823371 (- 22)),
        (FloatR 19 (- 6), (FloatR 5643983 (- 22), FloatR 5643983 (- 22)), (FloatR 5733081 (- 22), FloatR 5733081 (- 22)),
         FloatR 20 (- 6), (FloatR 5732861 (- 22), FloatR 5732861 (- 22)), FloatR 5733081 (- 22), FloatR 5733081 (- 22)),
        (FloatR 18 (- 6), (FloatR 5556485 (- 22), FloatR 5556485 (- 22)), (FloatR 5644191 (- 22), FloatR 5644191 (- 22)),
         FloatR 19 (- 6), (FloatR 5643985 (- 22), FloatR 5643985 (- 22)), FloatR 5644191 (- 22), FloatR 5644191 (- 22)),
        (FloatR 17 (- 6), (FloatR 5470343 (- 22), FloatR 5470343 (- 22)), (FloatR 5556678 (- 22), FloatR 5556678 (- 22)),
         FloatR 18 (- 6), (FloatR 5556487 (- 22), FloatR 5556487 (- 22)), FloatR 5556678 (- 22), FloatR 5556678 (- 22)),
        (FloatR 16 (- 6), (FloatR 5385537 (- 22), FloatR 5385537 (- 22)), (FloatR 5470523 (- 22), FloatR 5470523 (- 22)),
         FloatR 17 (- 6), (FloatR 5470345 (- 22), FloatR 5470345 (- 22)), FloatR 5470523 (- 22), FloatR 5470523 (- 22)),
        (FloatR 15 (- 6), (FloatR 5302045 (- 22), FloatR 5302045 (- 22)), (FloatR 5385704 (- 22), FloatR 5385704 (- 22)),
         FloatR 16 (- 6), (FloatR 5385538 (- 22), FloatR 5385538 (- 22)), FloatR 5385704 (- 22), FloatR 5385704 (- 22)),
        (FloatR 14 (- 6), (FloatR 5219848 (- 22), FloatR 5219848 (- 22)), (FloatR 5302199 (- 22), FloatR 5302199 (- 22)),
         FloatR 15 (- 6), (FloatR 5302047 (- 22), FloatR 5302047 (- 22)), FloatR 5302199 (- 22), FloatR 5302199 (- 22)),
        (FloatR 13 (- 6), (FloatR 5138925 (- 22), FloatR 5138925 (- 22)), (FloatR 5219990 (- 22), FloatR 5219990 (- 22)),
         FloatR 14 (- 6), (FloatR 5219849 (- 22), FloatR 5219849 (- 22)), FloatR 5219990 (- 22), FloatR 5219990 (- 22)),
        (FloatR 12 (- 6), (FloatR 5059257 (- 22), FloatR 5059257 (- 22)), (FloatR 5139055 (- 22), FloatR 5139055 (- 22)),
         FloatR 13 (- 6), (FloatR 5138926 (- 22), FloatR 5138926 (- 22)), FloatR 5139055 (- 22), FloatR 5139055 (- 22)),
        (FloatR 11 (- 6), (FloatR 4980823 (- 22), FloatR 4980823 (- 22)), (FloatR 5059375 (- 22), FloatR 5059375 (- 22)),
         FloatR 12 (- 6), (FloatR 5059258 (- 22), FloatR 5059258 (- 22)), FloatR 5059375 (- 22), FloatR 5059375 (- 22)),
        (FloatR 10 (- 6), (FloatR 4903606 (- 22), FloatR 4903606 (- 22)), (FloatR 4980930 (- 22), FloatR 4980930 (- 22)),
         FloatR 11 (- 6), (FloatR 4980824 (- 22), FloatR 4980824 (- 22)), FloatR 4980930 (- 22), FloatR 4980930 (- 22)),
        (FloatR 9 (- 6), (FloatR 4827586 (- 22), FloatR 4827586 (- 22)), (FloatR 4903701 (- 22), FloatR 4903701 (- 22)),
         FloatR 10 (- 6), (FloatR 4903607 (- 22), FloatR 4903607 (- 22)), FloatR 4903701 (- 22), FloatR 4903701 (- 22)),
        (FloatR 8 (- 6), (FloatR 4752744 (- 22), FloatR 4752744 (- 22)), (FloatR 4827670 (- 22), FloatR 4827670 (- 22)),
         FloatR 9 (- 6), (FloatR 4827587 (- 22), FloatR 4827587 (- 22)), FloatR 4827670 (- 22), FloatR 4827670 (- 22)),
        (FloatR 7 (- 6), (FloatR 4679063 (- 22), FloatR 4679063 (- 22)), (FloatR 4752818 (- 22), FloatR 4752818 (- 22)),
         FloatR 8 (- 6), (FloatR 4752745 (- 22), FloatR 4752745 (- 22)), FloatR 4752818 (- 22), FloatR 4752818 (- 22)),
        (FloatR 6 (- 6), (FloatR 4606523 (- 22), FloatR 4606523 (- 22)), (FloatR 4679127 (- 22), FloatR 4679127 (- 22)),
         FloatR 7 (- 6), (FloatR 4679063 (- 22), FloatR 4679063 (- 22)), FloatR 4679127 (- 22), FloatR 4679127 (- 22)),
        (FloatR 5 (- 6), (FloatR 4535109 (- 22), FloatR 4535109 (- 22)), (FloatR 4606578 (- 22), FloatR 4606578 (- 22)),
         FloatR 6 (- 6), (FloatR 4606524 (- 22), FloatR 4606524 (- 22)), FloatR 4606578 (- 22), FloatR 4606578 (- 22)),
        (FloatR 4 (- 6), (FloatR 4464801 (- 22), FloatR 4464801 (- 22)), (FloatR 4535153 (- 22), FloatR 4535153 (- 22)),
         FloatR 5 (- 6), (FloatR 4535109 (- 22), FloatR 4535109 (- 22)), FloatR 4535153 (- 22), FloatR 4535153 (- 22)),
        (FloatR 3 (- 6), (FloatR 4395584 (- 22), FloatR 4395584 (- 22)), (FloatR 4464837 (- 22), FloatR 4464837 (- 22)),
         FloatR 4 (- 6), (FloatR 4464802 (- 22), FloatR 4464802 (- 22)), FloatR 4464837 (- 22), FloatR 4464837 (- 22)),
        (FloatR 2 (- 6), (FloatR 4327439 (- 22), FloatR 4327439 (- 22)), (FloatR 4395610 (- 22), FloatR 4395610 (- 22)),
         FloatR 3 (- 6), (FloatR 4395584 (- 22), FloatR 4395584 (- 22)), FloatR 4395610 (- 22), FloatR 4395610 (- 22)),
        (FloatR 1 (- 6), (FloatR 4260351 (- 22), FloatR 4260351 (- 22)), (FloatR 4327457 (- 22), FloatR 4327457 (- 22)),
         FloatR 2 (- 6), (FloatR 4327440 (- 22), FloatR 4327440 (- 22)), FloatR 4327457 (- 22), FloatR 4327457 (- 22)),
        (FloatR 0 0, (FloatR 4194304 (- 22), FloatR 4194304 (- 22)), (FloatR 4260361 (- 22), FloatR 4260361 (- 22)),
         FloatR 1 (- 6), (FloatR 4260351 (- 22), FloatR 4260351 (- 22)), FloatR 4260361 (- 22), FloatR 4260361 (- 22))])"
  by eval

end


theory MDP_fin
  imports
  "MDP-Rewards.MDP_reward"
begin

locale MDP_on = MDP_act_disc arb_act A K r l
  for
    A and
    K :: "'s ::countable \<times> 'a ::countable \<Rightarrow> 's pmf" and r l arb_act +
  fixes S :: "'s set"
  assumes
    fin_states: "finite S" and
    fin_actions: "\<And>s. finite (A s)" and
    K_closed: "set_pmf (K (s,a)) \<subseteq> S"
begin

lemma \<L>\<^sub>b_indep:
  assumes "\<And>s. s \<in> S \<Longrightarrow> apply_bfun v s = apply_bfun v' s"
    and "s \<in> S"
  shows "\<L>\<^sub>b v s = \<L>\<^sub>b v' s"
proof -
  have "measure_pmf.expectation (K (s, a)) (apply_bfun v) = measure_pmf.expectation (K (s, a)) (apply_bfun v')" for a
    using assms K_closed subsetD
    by (auto intro!: AE_pmfI Bochner_Integration.integral_cong_AE)
  thus ?thesis
    unfolding \<L>\<^sub>b_eq_SUP_L\<^sub>a L\<^sub>a_int by auto
qed

end

locale MDP_nat_type = MDP_act A K
  for A :: "nat \<Rightarrow> nat set" and K +
  assumes A_fin : "\<And>s. finite (A s)"

locale MDP_nat = MDP_nat_type +
  fixes states :: nat
  assumes K_closed: "\<forall>s < states. set_pmf (K (s,a)) \<subseteq> {0..<states}"
  assumes K_closed_compl: "\<forall>s\<ge> states. set_pmf (K (s,a)) \<subseteq> {states..}"
  assumes A_outside: "\<And>s. s \<ge> states \<Longrightarrow> A s = {0}"

locale MDP_nat_disc = MDP_nat arb_act A K states + MDP_act_disc arb_act A K r l
  for A K r l arb_act states +
  assumes reward_zero_outside: "\<forall>s\<ge>states. r (s,a) = 0"
begin
lemma \<L>\<^sub>b_eq_L\<^sub>a_max': "\<L>\<^sub>b v s = (MAX a \<in> A s. L\<^sub>a a v s)"
  unfolding \<L>\<^sub>b_eq_L\<^sub>a_max
  using finite_arg_max_eq_Max[of "A s" "\<lambda>a. L\<^sub>a a v s"] A_ne A_fin
  by auto

abbreviation "state_space \<equiv> {0..<states}"

lemma set_pmf_Xn': "s \<notin> state_space \<Longrightarrow> set_pmf (Xn' p s i) \<subseteq> {states..}"
  using K_closed_compl
  by (induction i arbitrary: p s) (auto dest!: subsetD simp: Suc_Xn' linorder_not_less)

lemma set_pmf_Pn': "s \<notin> state_space \<Longrightarrow> (\<forall>sa \<in> set_pmf (Pn' p s i). fst sa\<notin> state_space)"
  using set_pmf_Xn'[unfolded Xn'_Pn'] by fastforce

lemma reward_Pn'_notin: "s \<notin> state_space \<Longrightarrow> (\<forall>sa \<in> set_pmf (Pn' p s i). r sa = 0)"
  using set_pmf_Pn' reward_zero_outside by (fastforce simp: linorder_not_less)

lemma \<nu>_zero_notin:
  assumes "s \<notin> state_space"
  shows "\<nu> p s = 0"
proof -
  have "\<nu>_fin p n s = 0" for n
    using assms reward_Pn'_notin
    by (auto simp: \<nu>_fin_eq_Pn intro!: sum.neutral integral_eq_zero_AE AE_pmfI)
  thus ?thesis
    unfolding \<nu>_def by auto
qed

lemma \<nu>_opt_zero_notin:
  assumes "s \<notin> state_space"
  shows "\<nu>_opt s = 0"
  unfolding \<nu>_opt_def using assms \<nu>_zero_notin policies_ne by auto

end

end


theory weird_nat_add3_assoc2
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3 :: "Nat => Nat => Nat => Nat" where
"add3 (Z) (Z) z = z"
| "add3 (Z) (S y2) z = S (add3 Z y2 z)"
| "add3 (S x2) y z = S (add3 x2 y z)"

(*hipster add3 *)

theorem x0 :
  "!! (x1 :: Nat) (x2 :: Nat) (x3 :: Nat) (x4 :: Nat) (x5 :: Nat) .
     (add3 (add3 x1 x2 x3) x4 x5) = (add3 x1 (add3 x2 x3 x4) x5)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end