-- author: Ben Sherman
import .action
       galois.tactic
       galois.option
       galois.temporal.temporal

universes u v

namespace network

structure incoming_items :=
  (messages : list (socket × message_t))

def lookup_updatef {A : Type u} [decidable_eq A] {B : A → Type v}
  (a : A) (f : B a → B a) (m : ∀ a, B a) (x : A) : B x
:= if H : a = x
  then eq.rec_on H (f (m a))
  else m x

def lookup_update {A : Type u} [decidable_eq A] {B : A → Type v}
  (a : A) (b : B a) : (∀ a, B a) → (∀ a, B a)
:= lookup_updatef a (λ _, b)

lemma lookup_update_refl {A : Type u} [decidable_eq A] {B : A → Type v}
  {a : A} {b : B a} {f : ∀ a, B a} :
  lookup_update a b f a = b
:= begin
unfold lookup_update lookup_updatef,
rw (dif_pos (eq.refl a)),
end

lemma lookup_update_different {A : Type u} [decidable_eq A] {B : A → Type v}
  {a a' : A} {b : B a} {f : ∀ a, B a} (H : a ≠ a') :
  lookup_update a b f a' = f a'
:= begin
unfold lookup_update lookup_updatef,
rw (dif_neg H),
end

@[reducible]
def global_state_t := ip → incoming_items

def initial_incoming_items : incoming_items
  := { messages := [] }

def poll_label.to_poll_result
  (ports : list port) (sockets : list socket) (bound : time)
  (incoming : incoming_items)
  : poll_label → option (poll_result ports sockets bound)
| poll_label.timeout := some poll_result.timeout
| (poll_label.receive elapsed rn mess) := do
  plift.up (and.intro H H') ← option.precondition (elapsed < bound ∧ 0 < elapsed),
  idx ← list.check_member_st (λ p : socket × message_t, p.snd = mess) incoming.messages,
  sockidx ← list.check_member idx.to_member.value.fst sockets, --any other checks necessary?
  some (poll_result.message ⟨ elapsed, H ⟩ sockidx mess H')

def agent_label.to_dlabel
  (incoming : incoming_items) {ag : agent}
: ∀ (a_next : act ag.state_type), agent_label → option (dlabel a_next)
| (act.poll ports sockets bound cont) (agent_label.mk plabel ms) := do
   r ← plabel.to_poll_result ports sockets bound incoming,
   guard ((cont r).fst = ms),
   some (dlabel.poll ports sockets bound cont r)

def add_message (rn : remote_name) (m : message_t) (a_ip : ip)
  : global_state_t → global_state_t :=
  lookup_updatef a_ip (λ i : incoming_items, {i with messages := (rn, m) :: i.messages })

def dlabel_to_label {A} : ∀ {a_next : act A}, dlabel a_next → agent_label
| (act.poll ports sockets bound cont) (dlabel.poll ._ ._ ._ ._ r) :=
  agent_label.mk r.to_label ((cont r).fst)

section
parameter {agents : map ip agent}

structure system_state : Type 1 :=
  (local_state : ∀ a : agents.member, a.value.state_type)
  (global_state : global_state_t)

structure sys_dlabel (st : system_state) :=
  (ag : agents.member)
  (label : dlabel (ag.value.loop (st.local_state ag)))

section
parameters (a_ip : ip) (ag : agent) (incoming : incoming_items)

def apply_message_updates (ms : list (socket × message_t))
   (updatef : global_state_t → global_state_t)
  : global_state_t → global_state_t
  := let fs := (list.map (λ p : socket × message_t, let (sock, mess) := p in
      add_message (a_ip, sock.snd) mess sock.fst) ms) in
     list.foldr function.comp updatef fs

def next_agent_state_poll_dlabel {A : Type} {ports : list port} {sockets : list socket}
  {bound : time} (cont : poll_result ports sockets bound → A)
  : poll_result ports sockets bound
  → option (global_state_t → global_state_t)
| poll_result.timeout := some id
| (poll_result.message elapsed_fin sock mess H) := do
    midx ← incoming.messages.check_member (sock.value, mess),
    some (lookup_updatef a_ip (λ inc, {inc with messages := list.remove_member _ midx}))

def next_agent_state_from_dlabel
  : ∀ {a_next : act ag.state_type} (la : dlabel a_next)
  , option (ag.state_type × (global_state_t → global_state_t))
| (act.poll ports sockets bound cont) (dlabel.poll ._ ._ ._ ._ r) := do
    updatef ← next_agent_state_poll_dlabel cont r,
    let (ms, new_state) := cont r,
    some (new_state, apply_message_updates ms updatef)

end

def next_state_from_dlabel (system : system_state)
  : sys_dlabel system → option system_state
| (sys_dlabel.mk ag aupdate) :=
  option.bind (next_agent_state_from_dlabel ag.key ag.value
     (system.global_state ag.key) aupdate)
     $ λ p, let (new_state, updatef) := p in
   some  { local_state  := lookup_update ag new_state system.local_state
        , global_state := updatef system.global_state }

open temporal

-- Our labeled transition system
def LTSd (s : system_state) (l : sys_dlabel s) (s' : system_state) : Prop :=
  next_state_from_dlabel s l = some s'

def TR := trace (sigma sys_dlabel)
def TP := tProp (sigma sys_dlabel)

/--
Apply a function (usually a predicate) to the label of a state-label pair
-/
def inLabel {S} {L} {B} (f : L → B) (x : sigma (λ _ : S, L)) : B := f x.snd
/--
If we apply a decidable prop to the label, that application is decidable
-/
instance inLabel_decidable {S L} {P : L → Prop} [decP : decidable_pred P] :
  decidable_pred (@inLabel S L _ P) :=
begin
intros x, apply decP,
end

lemma inLabel_mono {S} {L} : subset.monotone (@inLabel S L Prop)
:= begin
intros P Q PQ x Hx, apply PQ, apply Hx
end

end

end network


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((((a3).write i3 (v1)).write i1 (v1)).read i3) ≠ (v1) → False := by
  arr


import smt2

lemma true_is_true : true :=
begin
    z3 "true.log"
end


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((((a3).write i2 (v1)).write i3 (v1)).read i2) ≠ (v1) → False := by
  arr


/-
For a given agent, we define a labeled transition system
where everything else occuring on the network may be completely arbitrary
-/
import .action
       galois.option
       galois.network.network_implementation
       galois.temporal.LTS

namespace network
namespace loc

def next_agent_state_from_dlabel {A} {a_next : act A} (la : dlabel a_next)
  : A
  := la.cont_result.snd

def sends_message_st (P : socket → message_t → Prop) (l : agent_label) : Prop
  := l.messages.Exists (λ x, P x.fst x.snd)

def sends_message_std (P : socket → message_t → Prop) {ag : agent}
  (a_next : act ag.state_type) (la : dlabel a_next) : Prop
  := la.messages.Exists (λ x, P x.fst x.snd)

section
parameters {ag : agent}

def inLabeld (P : ∀ (a_next : act ag.state_type), dlabel a_next → Prop)
  (x : sigma (λ s : ag.state_type, dlabel (ag.loop s))) : Prop
:= begin
induction x, apply P; assumption
end

instance sends_message_st_decidable (P : socket → message_t → Prop)
  [decP : ∀ x y, decidable (P x y)] : decidable_pred (sends_message_st P)
:= begin
intros x, unfold sends_message_st,
apply list.Exists_decidable,
end

end

def LTSd (ag : agent) (s l s') := @next_agent_state_from_dlabel ag.state_type (ag.loop s) l = s'

end loc

open temporal

def sys_dlabel_to_local {agents : map ip agent}
 (ag : agents.member) (s : @system_state agents) :
  sys_dlabel s → option (dlabel (ag.value.loop (s.local_state ag)))
| (sys_dlabel.mk ag' aupdate) := do
  plift.up H ← option.precondition (ag' = ag),
  some (eq.rec_on H aupdate)

universes u

lemma next_state_local
  (agents : map ip agent)
  (ag : mapd.member agents)
  (incoming : incoming_items)
  (a_next : act ag.value.state_type)
  (label : dlabel a_next)
  (new_state : (ag.value).state_type)
  (updatef : global_state_t → global_state_t)
  (Hx1 : next_agent_state_from_dlabel (ag.key) (ag.value) incoming label = some (new_state, updatef))
: loc.next_agent_state_from_dlabel label = new_state
:= begin
induction label, dsimp [loc.next_agent_state_from_dlabel, dlabel.cont_result],
dsimp [next_agent_state_from_dlabel] at Hx1,
apply_in Hx1 option.bind_some',
induction Hx1 with updatef H,
induction H with H1 H2,
dsimp [next_agent_state_from_dlabel] at H2,
generalize Hx : cont r = x, rw Hx at H2,
clear Hx, induction x, dsimp,
dsimp [next_agent_state_from_dlabel] at H2,
injection H2 with H, clear H2, injection H with H1 H2
end

def refinesd
  {agents : map ip agent}
  (ag : agents.member)
 : Refinement (@LTSd agents) (SkipLTS (loc.LTSd ag.value))
:= { S_refine := λ s, s.local_state ag
   , L_refine := sys_dlabel_to_local ag
   , refines := begin
   intros s l s' H,
   unfold LTSd at H, induction l,
   simp only [next_state_from_dlabel] at H,
   simp only [sys_dlabel_to_local],
   rename ag_1 ag',
   apply_in H option.bind_some',
   induction H with Hx Hx', induction Hx' with Hx1 Hx2,
   induction Hx with new_state updatef,
   dsimp [next_state_from_dlabel] at Hx2,
   injection Hx2 with Hx2', clear Hx2,
   subst s', dsimp,
   apply (if Hag : ag' = ag then _ else _),
   { -- I go!
     rw (option.precondition_true_bind Hag),
     dsimp [sys_dlabel_to_local], induction Hag,
     dsimp, unfold SkipLTS,
     unfold loc.LTSd,
     rw lookup_update_refl,
     generalize Hls : (ag'.value).loop (s.local_state ag') = ls,
     rw Hls at label, rename label label',
     apply next_state_local, assumption,
   },
   { --Someone else goes
   rw (option.precondition_false Hag),
   dsimp [has_bind.bind, option.bind],
   dsimp [SkipLTS],
   rw (lookup_update_different Hag),
   },
   end
   }
end network


import Structure.Generic.Axioms.Universes
import Structure.Generic.Axioms.AbstractFunctors

import mathlib4_experiments.Data.Equiv.Basic

set_option autoBoundImplicitLocal false
--set_option pp.universes true

universes u v

class HasExternalEquivalences (U : Universe.{u}) (V : Universe.{v})
                              [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U] : Type (max u v) where
(IsEquiv {α : U} {β : V} : (α ⟶' β) → (β ⟶' α) → Sort (max u v))

structure BundledEquivalence {U : Universe.{u}} {V : Universe.{v}}
                             [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U]
                             [h : HasExternalEquivalences U V]
                             (α : U) (β : V) : Sort (max 1 u v) where
(toFun   : α ⟶' β)
(invFun  : β ⟶' α)
(isEquiv : h.IsEquiv toFun invFun)

namespace BundledEquivalence

  infix:20 " ⟷' " => BundledEquivalence

  variable {U V : Universe} [hUV : HasExternalFunctors U V] [hVU : HasExternalFunctors V U]
           [h : HasExternalEquivalences U V]

  def mkEquiv {α : U} {β : V} {to : α ⟶' β} {inv : β ⟶' α} (he : h.IsEquiv to inv) : α ⟷' β :=
  ⟨to, inv, he⟩

end BundledEquivalence

class HasInternalEquivalences (U : Universe.{u}) [h : HasInternalFunctors U] extends HasExternalEquivalences U U : Type u where
(Equiv                          : U → U → U)
(equivEquiv           (α β : U) : ⌈Equiv α β⌉ ≃ (α ⟷' β))
(equivElimToFunIsFun  (α β : U) : h.IsFun (λ E : Equiv α β => HasInternalFunctors.fromBundled ((equivEquiv α β).toFun E).toFun))
(equivElimInvFunIsFun (α β : U) : h.IsFun (λ E : Equiv α β => HasInternalFunctors.fromBundled ((equivEquiv α β).toFun E).invFun))

namespace HasInternalEquivalences

  infix:20 " ⟷ " => HasInternalEquivalences.Equiv

  variable {U : Universe} [HasInternalFunctors U] [h : HasInternalEquivalences U]

  def toBundled   {α β : U} (E : α ⟷  β) : α ⟷' β := (h.equivEquiv α β).toFun  E
  def fromBundled {α β : U} (E : α ⟷' β) : α ⟷  β := (h.equivEquiv α β).invFun E

  @[simp] theorem fromToBundled {α β : U} (E : α ⟷  β) : fromBundled (toBundled E) = E :=
  (h.equivEquiv α β).leftInv  E
  @[simp] theorem toFromBundled {α β : U} (E : α ⟷' β) : toBundled (fromBundled E) = E :=
  (h.equivEquiv α β).rightInv E

  def to  {α β : U} (E : α ⟷ β) (a : α) : β := (toBundled E).toFun  a
  def inv {α β : U} (E : α ⟷ β) (b : β) : α := (toBundled E).invFun b

  def toFun  {α β : U} (E : α ⟷ β) : α ⟶ β := HasInternalFunctors.fromBundled (toBundled E).toFun
  def invFun {α β : U} (E : α ⟷ β) : β ⟶ α := HasInternalFunctors.fromBundled (toBundled E).invFun

  @[simp] theorem toFun.eff  {α β : U} (E : α ⟷ β) (a : α) : (toFun  E) a = to  E a :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invFun.eff {α β : U} (E : α ⟷ β) (b : β) : (invFun E) b = inv E b :=
  by apply HasInternalFunctors.fromBundled.eff

  def toFunFun'  (α β : U) : (α ⟷ β) ⟶' (α ⟶ β) := BundledFunctor.mkFun (h.equivElimToFunIsFun  α β)
  def invFunFun' (α β : U) : (α ⟷ β) ⟶' (β ⟶ α) := BundledFunctor.mkFun (h.equivElimInvFunIsFun α β)
  def toFunFun   (α β : U) : (α ⟷ β) ⟶  (α ⟶ β) := HasInternalFunctors.fromBundled (toFunFun'  α β)
  def invFunFun  (α β : U) : (α ⟷ β) ⟶  (β ⟶ α) := HasInternalFunctors.fromBundled (invFunFun' α β)

  @[simp] theorem toFunFun.eff  {α β : U} (E : α ⟷ β) : (toFunFun  α β) E = toFun  E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invFunFun.eff {α β : U} (E : α ⟷ β) : (invFunFun α β) E = invFun E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem toFunFun.effEff  {α β : U} (E : α ⟷ β) (a : α) : ((toFunFun  α β) E) a = to  E a :=
  by simp
  @[simp] theorem invFunFun.effEff {α β : U} (E : α ⟷ β) (b : β) : ((invFunFun α β) E) b = inv E b :=
  by simp

  @[simp] theorem toFun.bundledEq  {α β : U} (E : α ⟷ β) : HasInternalFunctors.toBundled (toFun E)  = (toBundled E).toFun :=
  HasInternalFunctors.toFromBundled (toBundled E).toFun
  @[simp] theorem invFun.bundledEq {α β : U} (E : α ⟷ β) : HasInternalFunctors.toBundled (invFun E) = (toBundled E).invFun :=
  HasInternalFunctors.toFromBundled (toBundled E).invFun

  def isEquiv {α β : U} (E : α ⟷ β) : h.IsEquiv (toBundled E).toFun (toBundled E).invFun :=
  (toBundled E).isEquiv

  def isEquiv' {α β : U} (E : α ⟷ β) :
    h.IsEquiv (HasInternalFunctors.toBundled (toFun E)) (HasInternalFunctors.toBundled (invFun E)) :=
  by simp; apply isEquiv

  @[simp] theorem fromBundled.to.coe'  {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).toFun  = E.toFun  :=
  congrArg BundledEquivalence.toFun  (toFromBundled E)
  @[simp] theorem fromBundled.inv.coe' {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).invFun = E.invFun :=
  congrArg BundledEquivalence.invFun (toFromBundled E)
  @[simp] theorem fromBundled.to.coe  {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).toFun.f  = E.toFun.f  :=
  congrArg BundledFunctor.f (fromBundled.to.coe'  E)
  @[simp] theorem fromBundled.inv.coe {α β : U} (E : α ⟷' β) : (toBundled (fromBundled E)).invFun.f = E.invFun.f :=
  congrArg BundledFunctor.f (fromBundled.inv.coe' E)
  @[simp] theorem fromBundled.to.eff  {α β : U} (E : α ⟷' β) (a : α) : to  (fromBundled E) a = E.toFun  a :=
  congrFun (fromBundled.to.coe  E) a
  @[simp] theorem fromBundled.inv.eff {α β : U} (E : α ⟷' β) (b : β) : inv (fromBundled E) b = E.invFun b :=
  congrFun (fromBundled.inv.coe E) b

  def mkEquiv {α β : U} {to : α ⟶' β} {inv : β ⟶' α} (he : h.IsEquiv to inv) : α ⟷ β :=
  fromBundled (BundledEquivalence.mkEquiv he)

end HasInternalEquivalences

class HasIdEquiv (U : Universe) [HasExternalFunctors U U] [HasIdFun U] [h : HasExternalEquivalences U U] where
(idIsEquiv (α : U) : h.IsEquiv (HasIdFun.idFun' α) (HasIdFun.idFun' α))

namespace HasIdEquiv

  variable {U : Universe} [HasExternalFunctors U U] [HasIdFun U] [HasExternalEquivalences U U] [h : HasIdEquiv U]

  def idEquiv' (α : U) : α ⟷' α := BundledEquivalence.mkEquiv (h.idIsEquiv α)

end HasIdEquiv

class HasCompEquiv (U V W : Universe)
                   [HasExternalFunctors U V] [HasExternalFunctors V W] [HasExternalFunctors U W]
                   [HasExternalFunctors V U] [HasExternalFunctors W V] [HasExternalFunctors W U]
                   [HasCompFun U V W] [HasCompFun W V U]
                   [HasExternalEquivalences U V] [HasExternalEquivalences V W] [h : HasExternalEquivalences U W] where
(compIsEquiv {α : U} {β : V} {γ : W} (E : α ⟷' β) (F : β ⟷' γ) : h.IsEquiv (F.toFun ⊙' E.toFun) (E.invFun ⊙' F.invFun))

namespace HasCompEquiv

  variable {U V W : Universe} [HasExternalFunctors U V] [HasExternalFunctors V W] [HasExternalFunctors U W]
           [HasExternalFunctors V U] [HasExternalFunctors W V] [HasExternalFunctors W U]
           [HasCompFun U V W] [HasCompFun W V U]
           [HasExternalEquivalences U V] [HasExternalEquivalences V W] [HasExternalEquivalences U W]
           [h : HasCompEquiv U V W]

  def compEquiv' {α : U} {β : V} {γ : W} (E : α ⟷' β) (F : β ⟷' γ) : α ⟷' γ := BundledEquivalence.mkEquiv (h.compIsEquiv E F)

end HasCompEquiv

class HasInvEquiv (U V : Universe) [HasExternalFunctors U V] [HasExternalFunctors V U]
                  [HasExternalEquivalences U V] [h : HasExternalEquivalences V U] where
(invIsEquiv {α : U} {β : V} (E : α ⟷' β) : h.IsEquiv E.invFun E.toFun)

namespace HasInvEquiv

  variable {U V : Universe} [HasExternalFunctors U V] [HasExternalFunctors V U]
           [HasExternalEquivalences U V] [HasExternalEquivalences V U] [h : HasInvEquiv U V]

  def invEquiv' {α : U} {β : V} (E : α ⟷' β) : β ⟷' α := BundledEquivalence.mkEquiv (h.invIsEquiv E)

end HasInvEquiv

class HasEquivOp (U : Universe.{u}) [h : HasInternalFunctors U] [HasLinearFunOp U] extends
  HasInternalEquivalences U, HasIdEquiv U, HasCompEquiv U U U, HasInvEquiv U U : Type u where
(compEquivIsFun    {α β : U} (E : α ⟷' β) (γ : U) : h.IsFun (λ F : β ⟷ γ => HasInternalEquivalences.mkEquiv (compIsEquiv E (HasInternalEquivalences.toBundled F))))
(compEquivFunIsFun (α β γ : U)                    : h.IsFun (λ E : α ⟷ β => HasInternalFunctors.mkFun (compEquivIsFun (HasInternalEquivalences.toBundled E) γ)))
(invEquivIsFun     (α β : U)                      : h.IsFun (λ E : α ⟷ β => HasInternalEquivalences.mkEquiv (invIsEquiv (HasInternalEquivalences.toBundled E))))
(invEquivIsEquiv   (α β : U)                      : IsEquiv (BundledFunctor.mkFun (invEquivIsFun α β)) (BundledFunctor.mkFun (invEquivIsFun β α)))

namespace HasEquivOp

  variable {U : Universe.{u}} [HasInternalFunctors U] [HasLinearFunOp U] [h : HasEquivOp U]

  def idEquiv' (α : U) : α ⟷' α := HasIdEquiv.idEquiv' α
  def idEquiv  (α : U) : α ⟷  α := HasInternalEquivalences.fromBundled (idEquiv' α)

  @[simp] theorem idEquiv.to.eff  (α : U) (a : α) : HasInternalEquivalences.to  (idEquiv α) a = a :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem idEquiv.inv.eff (α : U) (a : α) : HasInternalEquivalences.inv (idEquiv α) a = a :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def compEquiv' {α β γ : U} (E : α ⟷' β) (F : β ⟷' γ) : α ⟷' γ := HasCompEquiv.compEquiv' E F
  def compEquiv  {α β γ : U} (E : α ⟷  β) (F : β ⟷  γ) : α ⟷  γ :=
  HasInternalEquivalences.fromBundled (compEquiv' (HasInternalEquivalences.toBundled E) (HasInternalEquivalences.toBundled F))

  @[simp] theorem compEquiv.to.eff  {α β γ : U} (E : α ⟷ β) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  (compEquiv E F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem compEquiv.inv.eff {α β γ : U} (E : α ⟷ β) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv (compEquiv E F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def compEquivFun' {α β : U} (E : α ⟷' β) (γ : U) : (β ⟷ γ) ⟶' (α ⟷ γ) := BundledFunctor.mkFun (h.compEquivIsFun E γ)
  def compEquivFun  {α β : U} (E : α ⟷  β) (γ : U) : (β ⟷ γ) ⟶  (α ⟷ γ) :=
  HasInternalFunctors.fromBundled (compEquivFun' (HasInternalEquivalences.toBundled E) γ)

  @[simp] theorem compEquivFun.eff {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) : (compEquivFun E γ) F = compEquiv E F :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem compEquivFun.to.effEff  {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  ((compEquivFun E γ) F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) :=
  by simp
  @[simp] theorem compEquivFun.inv.effEff {α β : U} (E : α ⟷ β) (γ : U) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv ((compEquivFun E γ) F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) :=
  by simp

  def compEquivFunFun' (α β γ : U) : (α ⟷ β) ⟶' (β ⟷ γ) ⟶ (α ⟷ γ) := BundledFunctor.mkFun (h.compEquivFunIsFun α β γ)
  def compEquivFunFun  (α β γ : U) : (α ⟷ β) ⟶  (β ⟷ γ) ⟶ (α ⟷ γ) := HasInternalFunctors.fromBundled (compEquivFunFun' α β γ)

  @[simp] theorem compEquivFunFun.eff (α β γ : U) (E : α ⟷ β) : (compEquivFunFun α β γ) E = compEquivFun E γ :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem compEquivFunFun.effEff (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) : ((compEquivFunFun α β γ) E) F = compEquiv E F :=
  by simp
  @[simp] theorem compEquivFunFun.to.effEffEff  (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) (a : α) :
    HasInternalEquivalences.to  (((compEquivFunFun α β γ) E) F) a = HasInternalEquivalences.to  F (HasInternalEquivalences.to  E a) := by simp
  @[simp] theorem compEquivFunFun.inv.effEffEff (α β γ : U) (E : α ⟷ β) (F : β ⟷ γ) (c : γ) :
    HasInternalEquivalences.inv (((compEquivFunFun α β γ) E) F) c = HasInternalEquivalences.inv E (HasInternalEquivalences.inv F c) := by simp

  def invEquiv' {α β : U} (E : α ⟷' β) : β ⟷' α := HasInvEquiv.invEquiv' E
  def invEquiv  {α β : U} (E : α ⟷  β) : β ⟷  α :=
  HasInternalEquivalences.fromBundled (invEquiv' (HasInternalEquivalences.toBundled E))

  @[simp] theorem invEquiv.to.eff  {α β : U} (E : α ⟷ β) (b : β) : HasInternalEquivalences.to  (invEquiv E) b = HasInternalEquivalences.inv E b :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem invEquiv.inv.eff {α β : U} (E : α ⟷ β) (a : α) : HasInternalEquivalences.inv (invEquiv E) a = HasInternalEquivalences.to  E a :=
  by apply HasInternalEquivalences.fromBundled.inv.eff

  def invEquivFun' (α β : U) : (α ⟷ β) ⟶' (β ⟷ α) := BundledFunctor.mkFun (h.invEquivIsFun α β)
  def invEquivFun  (α β : U) : (α ⟷ β) ⟶  (β ⟷ α) := HasInternalFunctors.fromBundled (invEquivFun' α β)

  @[simp] theorem invEquivFun.eff (α β : U) (E : α ⟷ β) : (invEquivFun α β) E = invEquiv E :=
  by apply HasInternalFunctors.fromBundled.eff
  @[simp] theorem invEquivFun.to.effEff  (α β : U) (E : α ⟷ β) (b : β) :
    HasInternalEquivalences.to  ((invEquivFun α β) E) b = HasInternalEquivalences.inv E b := by simp
  @[simp] theorem invEquivFun.inv.effEff (α β : U) (E : α ⟷ β) (a : α) :
    HasInternalEquivalences.inv ((invEquivFun α β) E) a = HasInternalEquivalences.to  E a := by simp

  def invEquivEquiv' (α β : U) : (α ⟷ β) ⟷' (β ⟷ α) := BundledEquivalence.mkEquiv (h.invEquivIsEquiv α β)
  def invEquivEquiv  (α β : U) : (α ⟷ β) ⟷  (β ⟷ α) := HasInternalEquivalences.fromBundled (invEquivEquiv' α β)

  @[simp] theorem invEquivEquiv.to.eff  (α β : U) (E : α ⟷ β) : HasInternalEquivalences.to  (invEquivEquiv α β) E = invEquiv E :=
  by apply HasInternalEquivalences.fromBundled.to.eff
  @[simp] theorem invEquivEquiv.inv.eff (α β : U) (E : β ⟷ α) : HasInternalEquivalences.inv (invEquivEquiv α β) E = invEquiv E :=
  by apply HasInternalEquivalences.fromBundled.inv.eff
  @[simp] theorem invEquivEquiv.to.to.effEff   (α β : U) (E : α ⟷ β) (b : β) :
    HasInternalEquivalences.to  (HasInternalEquivalences.to  (invEquivEquiv α β) E) b = HasInternalEquivalences.inv E b := by simp
  @[simp] theorem invEquivEquiv.to.inv.effEff  (α β : U) (E : α ⟷ β) (a : α) :
    HasInternalEquivalences.inv (HasInternalEquivalences.to  (invEquivEquiv α β) E) a = HasInternalEquivalences.to  E a := by simp
  @[simp] theorem invEquivEquiv.inv.to.effEff  (α β : U) (E : β ⟷ α) (a : α) :
    HasInternalEquivalences.to  (HasInternalEquivalences.inv (invEquivEquiv α β) E) a = HasInternalEquivalences.inv E a := by simp
  @[simp] theorem invEquivEquiv.inv.inv.effEff (α β : U) (E : β ⟷ α) (b : β) :
    HasInternalEquivalences.inv (HasInternalEquivalences.inv (invEquivEquiv α β) E) b = HasInternalEquivalences.to  E b := by simp

end HasEquivOp


@[simp] lemma to_bool_true_eq_tt (h : decidable true) : @to_bool true h = tt :=
decidable.cases_on h (λ h, false.elim (iff.mp not_true h)) (λ _, rfl)

@[simp] lemma to_bool_false_eq_ff (h : decidable false) : @to_bool false h = ff :=
decidable.cases_on h (λ h, rfl) (λ h, false.elim h)


definition {u v} transport {A : Type u} { P : A → Type v} {x y : A} (p : x = y)
(u : P x) : P y :=
by induction p; exact u

definition {u v w} apdt011
  {A : Type u} {Z : Type w}
  {B : A → Type v}
  (f : Πa, B a → Z)
  {a a' : A}
  {b : B a}
  {b' : B a'}
  (Ha : a = a')
  (Hb : transport Ha b = b')
      : f a b = f a' b' :=
by cases Ha; cases Hb; reflexivity

set_option trace.check true

-- set_option pp.implicit true

-- @NaturalTransformation.components ?M_1 ?M_2 ?M_3 ?M_4 :
--   @NaturalTransformation ?M_1 ?M_2 ?M_3 ?M_4 → Π (X : ?M_1.Obj), ?M_2.Hom (⇑?M_3 X) (⇑?M_4 X)

-- α === Type (max u v)
-- a === (@NaturalTransformation (C × C) C (@MonoidalStructure.tensor C m)
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))))
-- T === (λ (_x : Type (max u v)), _x)
-- t : T a == a
-- t === (@vertical_composition_of_NaturalTransformations (C × C) C (@MonoidalStructure.tensor C m)
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--           (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--           (@isomorphism.Isomorphism.morphism (FunctorCategory (C × C) C) (@MonoidalStructure.tensor C m)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--              (@braided_monoidal_category.Symmetry.braiding C m β))
--           (@whisker_on_left (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--              (@isomorphism.Isomorphism.morphism (FunctorCategory (C × C) C) (@MonoidalStructure.tensor C m)
--                 (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--                 (@braided_monoidal_category.Symmetry.braiding C m β))))
-- b === (@NaturalTransformation (C × C) C (@MonoidalStructure.tensor C m) (@MonoidalStructure.tensor C m))
-- e : a = b

-- @eq.rec α a T t b e : T b
-- T b == b

-- now we want to apply
--   f === @NaturalTransformation.components (C × C) C (@MonoidalStructure.tensor C m) (@MonoidalStructure.tensor C m)
-- to @eq.rec α a T b e.
-- actually, we're going to need to think of this as applying
--   f' === @NaturalTransformation.components (C × C) C (@MonoidalStructure.tensor C m)
--      : Π (F : Functor (C × C) C), NaturalTransformation m.tensor F → Π (x : (C × C).Obj), C.Hom (m.tensor x) (F x)
-- and here we may as well introduce S : Functor (C × C) C → Type as S F = Π (x : (C × C).Obj), C.Hom (m.tensor x) (F x),
-- and then write f' : Π (F : Functor (C × C) C), NaturalTransformation m.tensor F → S F
--
-- Thus we want to start with f' (@MonoidalStructure.tensor C m) (@eq.rec α a T t b e) : S (@MonoidalStructure.tensor C m)
-- and by application of the lemma we're designing obtain ...?
--   f' (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--      a
-- Now this thing is of type S (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C)
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
-- which is no good, so we're going to have to transport it through the type family S. But where do we obtain our
-- path/equation to transport along? Somehow we take e : a = b, and think of that actually as e : R a' = R b' ... nope.

-------------

-- 20170508
--
-- (@NaturalTransformation.components (C × C) C
--        (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
--        (@MonoidalStructure.tensor C m)
--        (@eq.rec (Functor (C × C) C)
--           (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--           (@NaturalTransformation (C × C) C
--              (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m)))
--           (t : NaturalTransformation (switch tensor) (id tensor))
--           (@MonoidalStructure.tensor C m)
--           (FunctorComposition.left_identity (C × C) C (@MonoidalStructure.tensor C m)))
--        X)

-- S = (@NaturalTransformation (C × C) C
-- f = @NaturalTransformation.components (C × C) C
-- f : Π a a' : A, Π t : S a a', Z a a'

-- Z a a' = Π X : (C × C).Obj, C.Hom (a X) (a' X)

-- a  = (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
-- a' = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))

-- A = (Functor (C × C) C)
-- a a' : A

-- b = (@MonoidalStructure.tensor C m)
-- b : A

-- p : a' = b

-- t : S a a'

-- (@eq.rec A a' (S a) t b p) : S a b
-- f a b (@eq.rec A a' (S a) t b p) : Z a b
-- f a a' t : Z a a'
-- (@eq.rec A a' (Z a) (f a a' t) b p) : Z a b

lemma {u1 u2 u3 u4} v2 { α : Type u1 } { β : Type u2 } { S : α → β → Type u3 } { Z : α → β → Type u4 } { a : α } { b : β } { t : S a b } { b' : β } { p : b = b' } ( f : Π ( c : α ) ( d : β ) , S c d → Z c d ):
  f a b' (@eq.rec β b (S a) t b' p) = (@eq.rec β b (Z a) (f a b t) b' p) :=
begin
induction p, reflexivity
end

lemma {u1 u2 u3} v1 { β : Type u1 } { S : β → Type u2 } { Z : β → Type u3 } { b : β } { t : S b } { b' : β } { p : b = b' } ( f : Π d : β, S d → Z d ) :
  f b' (@eq.rec β b S t b' p) = (@eq.rec β b Z (f b t) b' p) :=
begin
induction p, reflexivity
end

      --  (@NaturalTransformation.components (C × C) C
      --     (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
      --     (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
      --     (@eq.rec (Functor (C × C) (C × C))
      --        (@FunctorComposition (C × C) (C × C) (C × C) (SwitchProductCategory C C) (SwitchProductCategory C C))
      --        (λ (a : Functor (C × C) (C × C)),
      --           @NaturalTransformation (C × C) C
      --             (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
      --             (@FunctorComposition (C × C) (C × C) C a (@MonoidalStructure.tensor C m)))
      --        (t : NaturalTransformation (switch tensor) (switch switch tensor))
      --        (IdentityFunctor (C × C))
      --        (switch_twice_is_the_identity C C)))

-- f  = @NaturalTransformation.components (C × C) C
-- α  = Functor (C × C) C
-- a  : α
-- a  = (@FunctorComposition (C × C) (C × C) C (SwitchProductCategory C C) (@MonoidalStructure.tensor C m))
-- β  = Functor (C × C) C
-- f  : Π (a : α) (b : β), S a b → Z a b
-- γ  = (Functor (C × C) (C × C)
-- g  = switch switch
-- g' = id
-- p  : g = g'
-- R  : γ → β
--    = λ g, (g tensor)
-- S  = λ a b, NaturalTransformation a b
--
-- f a (R g') (@eq.rec γ g (S a) t g' p)

-- c' = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
-- c'' = (@FunctorComposition (C × C) (C × C) C (@FunctorComposition (C × C) (C × C) (C × C) (SwitchProductCategory C C) (SwitchProductCategory C C)) (@MonoidalStructure.tensor C m))
-- eq.rec ... : NaturalTransformation c c'
-- γ = (Functor (C × C) (C × C)
-- g = switch switch
-- S = Π (a : α) (g : γ), NaturalTransformation a (R g)
-- t : NaturalTransformation a (R g)
-- t : S a g
-- g' = Identity (C × C)
-- p : g = g'

-- c' = R g'
-- c'' = R g
-- R = Π g : γ, (g tensor)
-- R : γ → β

-- f a c' t' : Z a c'

-- f a (R g') (@eq.rec γ g S t g' p)
-- f a (@eq.rec γ g R c'' g' p) (@eq.rec γ g S t g' p)
-- @eq.rec γ g (Z a (R g)) (f a (R g) t) g' p
-- @eq.rec γ g (Z a ???) (f a (@eq.rec γ g' R c' g (eq.symm p)) t) g' p

lemma {u1 u2 u3 u4 u5} w
  { α : Type u1 } { β : Type u2 } { γ : Type u3 }
  { S : α → β → Type u4 }
  { Z : α → β → Type u5 }
  { a : α } { g : γ } ( R : γ → β ) { t : S a (R g) } { g' : γ } { p : g = g' } ( f : Π (a : α) (b : β), S a b → Z a b ):
  f a (R g') (@eq.rec γ g (λ g, S a (R g)) t g' p)
    =
  @eq.rec γ g (λ g, Z a (R g)) (f a (R g) t) g' p
    := begin induction p, reflexivity end

--
-- (@eq.rec (Functor (C × C) C)
--                 (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--                 (λ (G : Functor (C × C) C),
--                    Π (X : (C × C).Obj),
--                      C.Hom
--                        (@Functor.onObjects (C × C) C
--                           (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                              (@MonoidalStructure.tensor C m))
--                           X)
--                        (@Functor.onObjects (C × C) C G X))
--                 (λ (X : (C × C).Obj),
--                    C.identity
--                      (@Functor.onObjects (C × C) C
--                         (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                            (@MonoidalStructure.tensor C m))
--                         X))
--                 (@MonoidalStructure.tensor C m)
--                 (@squared_Braiding._proof_3 C m)
--                 X)
lemma {u1 u2 u3} b { α : Type u1 } { a : α } { β : Type u2 } { Z : α → β → Type u3 } { t : Π (b : β), Z a b } { a' : α } { p : a = a' }
  : @eq.rec α a _ t a' p = λ b : β, @eq.rec α a (λ _a, Z _a b) (t b) a' p :=
begin
  induction p,
  reflexivity
end

--  (@eq.rec (Functor (C × C) C)
--                 (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
--                 (λ (_a : Functor (C × C) C),
--                    C.Hom
--                      (@Functor.onObjects (C × C) C
--                         (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                            (@MonoidalStructure.tensor C m))
--                         (X_1, X_2))
--                      (@Functor.onObjects (C × C) C _a (X_1, X_2)))
--                 (C.identity
--                    (@Functor.onObjects (C × C) C
--                       (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C))
--                          (@MonoidalStructure.tensor C m))
--                       (X_1, X_2)))
--                 (@MonoidalStructure.tensor C m)
--                 (@squared_Braiding._proof_3 C m))
-- α = (Functor (C × C) C)
-- a = (@FunctorComposition (C × C) (C × C) C (IdentityFunctor (C × C)) (@MonoidalStructure.tensor C m))
-- f = C.identity
--   : Π X : C.Obj, C.Hom X X
-- r = @Functor.onObjects (C × C) C
-- x : (C × C).Obj
-- r a x : C.Obj
-- t = f (r a x)
--   : C.Hom (r a x) (r a x)

lemma {u1 u2 u3 u4} pull_function_out
  { α : Type u1 } { a : α } { β : Type u2 } { Z : β → Type u3 } { γ : Type u4 } { r : Π a : α, γ → β } { x : γ } { a' : α } { p : a = a' } ( f : Π (b : β), Z b ) :
  @eq.rec α a _ (f (r a x)) a' p = f (r a' x) :=
begin
induction p, reflexivity
end

-- This seems sensible, but applies too often.
lemma {u} bar { α : Type u } { a : α } { b : α } ( p : a = b ) : @eq.rec α a (λ b: α, b = a) (eq.refl a) b p = eq.symm p :=
begin
  cases p,
  reflexivity
end

lemma {u} foo { α : Type u } { a b : α } { p : a = b } : eq.symm (eq.symm p) = p := by reflexivity

@[simp] lemma {u v w} function_of_eq.rec { α : Type u } { a : α } { T : α → Type v } { S : α → Type w } ( t : T a ) { b : α } ( e : a = b ) ( f : Π { c : α }, T c → S c ) :
  @f b ( @eq.rec α a T t b e ) = @eq.rec α a S (@f a t) b e :=
begin
  cases e,
  reflexivity
end
@[simp] lemma {u v w} function_of_eq.drec { α : Type u } { a : α } { T : Π b : α, a = b → Type v } { S : Π b : α, a = b → Type v } ( t : T a (eq.refl a)) { b : α } ( e : a = b ) ( f : Π { c : α } { p : a = c }, T c p → S c p ) :
  f ( @eq.drec α a T t b e ) = @eq.drec α a S (f t) b e :=
begin
  cases e,
  reflexivity
end

lemma z {A : Type} { X : A } : (eq.mpr (propext (eq_self_iff_true X)) trivial) = rfl :=
begin
  -- unfold trivial,
  reflexivity
end


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (((a3).write i2 ((a3).read i3)).read i3) ≠ ((a3).read i3) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a2).write i3 (v1)).write i2 (v1)).read i3) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a2).write i2 (v1)).write i3 (v1)).read i2) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a3).write i1 (v1)).write i3 (v1)).read i1) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v3) ≠ ((((a2).write i3 (v3)).write i1 (v3)).read i3) → False := by
  arr


import cfr

example (a b : rat) : (¬ a < b) ∧ (¬ b < a) → a = b := by exact eq_of_incomp

def dice := list.to_buffer [1,2,3,4,5,6]
def claims := list.to_buffer [(1,2), (1,3), (1,4), (1,5), (1,6), (1,1), (2,2), (2,3), (2,4), (2,5), (2,6), (2,1)]
def AllowedClaim := {i // ∃ v, claims.read i = v}
instance : has_lt AllowedClaim := ⟨ fun a b, a.val < b.val ⟩
instance AllowedClaim_decidable_rel : decidable_rel ((<) : AllowedClaim → AllowedClaim → Prop) := infer_instance

inductive Action
| Claim (claim : AllowedClaim) : Action
| Dudo : Action

def Action.show : Action → string
| (Action.Claim ⟨ i, _⟩ ) := "Claim " ++ has_repr.repr (claims.read i)
| Action.Dudo := "Dudo"

instance : has_repr Action := ⟨ Action.show ⟩

def actions.begin := claims.attach_index
def actions.later := (actions.begin.iterate buffer.nil (fun i x s, s.push_back $ Action.Claim x)).push_back Action.Dudo

def Die := {die // die ∈ dice}
instance : has_lt Die := ⟨ fun a b, a.val < b.val ⟩
instance Die_decidable_rel : decidable_rel ((<) : Die → Die → Prop) := infer_instance

@[derive has_lt] def History := Die × list AllowedClaim
instance History_decidable_rel : decidable_rel ((<) : History → History → Prop) := infer_instance

def ℍ𝔸 : History → Type*
    | (die, []) := AllowedClaim
    | (die, _) := Action

def ha : HistoryToActions History ℍ𝔸
    | (_, []) := ⟨ actions.begin.1, actions.begin.read ⟩
    | (_, x :: xs) :=
        -- TODO: The way buffer.drop behaves on out of bounds is wonky. Replace it.
        let v := actions.later.drop (x.1 + 1) in ⟨ v.1, v.read ⟩

structure Particle (α : Type*) := mk ::
    (state : α)
    (probability : ℚ)
    (is_updateable : bool)

namespace game
def state := state (Infosets ha)
def read_dice (i : fin dice.1) : Die := ⟨ dice.read i, ⟨ i, rfl ⟩ ⟩

def chance (one : Particle unit) (next : Particle Die → state rat) : state rat :=
    chance_uniform ha ⟨ dice.1, read_dice ⟩ one.probability
        (fun dice prob, next {state:=dice, probability:=prob*one.probability, ..one})

def response (one two : Particle Die) (h : list AllowedClaim)
        (next : ℍ𝔸 ⟨ one.state, h ⟩ → Particle Die → state rat)
        : state rat :=
    response ha one.is_updateable one.probability two.probability ⟨ one.state, h ⟩
        (fun action prob, next action {probability:=prob, ..one})

def terminal := terminal ha

meta def dudo.main : Particle Die → Particle Die → list AllowedClaim → state rat
    | one two [] := response one two [] (fun action one, dudo.main two one [action])
    | one two h@(⟨i, _⟩ :: _) :=
        response one two h $ fun action one,
            match action with
            | Action.Dudo :=
                let (number, rank) := claims.read i in
                let check_guess (s x : nat) := if x = 1 ∨ x = rank then s+1 else s in
                let dice_guessed := check_guess (check_guess 0 one.state.val) two.state.val in
                terminal $ if dice_guessed < number then 1.0 else -1.0
            | Action.Claim claim := dudo.main two one (claim :: h)
            end

meta def dudo.initial (one : Particle unit) (two : Particle unit) : state rat :=
    chance one $ fun one,
        chance two $ fun two,
            dudo.main one two []

meta def train (num_iterations : nat): rat × Infosets ha :=
    let particle : Particle unit := {state:=(), probability:=1, is_updateable:=ff} in
    let particle_tt : Particle unit := {is_updateable:=tt, ..particle} in
    @nat.foldl.fin (fun i, rat × Infosets ha)
        num_iterations (0, buffer.nil)
        (fun i ⟨ util, infosets ⟩,
            let (util, infosets) := (dudo.initial {is_updateable:=tt, ..particle} particle).run infosets in
            let (util', infosets) := (dudo.initial particle {is_updateable:=tt, ..particle}).run infosets in
            ((util + util') / 2, infosets)
            )

end game


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v2) ≠ ((((a1).write i2 (v2)).write i3 (v2)).read i2) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((((a1).write i1 (v3)).write i3 (v3)).read i1) ≠ (v3) → False := by
  arr


import Mathlib.Data.Nat.Basic
import Mathlib.Data.Char
import Mathlib.Data.UInt

namespace Nat

/- Up -/

/-- A well-ordered relation for "upwards" induction on the natural numbers up to some bound `ub`. -/
def Up (ub a i : ℕ) := i < a ∧ i < ub

lemma Up.next {ub i} (h : i < ub) : Up ub (i+1) i := ⟨Nat.lt_succ_self _, h⟩

lemma Up.WF (ub) : WellFounded (Up ub) :=
  Subrelation.wf (h₂ := (measure (ub - .)).wf) fun ⟨ia, iu⟩ ↦ Nat.sub_lt_sub_left iu ia

/-- A well-ordered relation for "upwards" induction on the natural numbers up to some bound `ub`. -/
def upRel (ub : ℕ) : WellFoundedRelation Nat := ⟨Up ub, Up.WF ub⟩

end Nat

/-- A terminal byte slice, a suffix of a byte array. -/
structure ByteSliceT := (arr : ByteArray) (off : Nat)

namespace ByteSliceT

/-- The number of elements in the byte slice. -/
@[inline] def size (self : ByteSliceT) : Nat := self.arr.size - self.off

/-- Index into a byte slice. The `getOp` function allows the use of the `buf[i]` notation. -/
@[inline] def getOp (self : ByteSliceT) (idx : Nat) : UInt8 := self.arr.get! (self.off + idx)

end ByteSliceT

/-- Convert a byte array into a terminal slice. -/
def ByteArray.toSliceT (arr : ByteArray) : ByteSliceT := ⟨arr, 0⟩

/-- A byte slice, given by a backing byte array, and an offset and length. -/
structure ByteSlice := (arr : ByteArray) (off len : Nat)

namespace ByteSlice

/-- Convert a byte slice into an array, by copying the data if necessary. -/
def toArray : ByteSlice → ByteArray
| ⟨arr, off, len⟩ => arr.extract off len

/-- Index into a byte slice. The `getOp` function allows the use of the `buf[i]` notation. -/
@[inline] def getOp (self : ByteSlice) (idx : Nat) : UInt8 := self.arr.get! (self.off + idx)

/-- The inner loop of the `forIn` implementation for byte slices. -/
def forIn.loop [Monad m] (f : UInt8 → β → m (ForInStep β))
  (arr : ByteArray) (off _end : Nat) (i : Nat) (b : β) : m β :=
  if h : i < _end then do
    match ← f (arr.get! i) b with
    | ForInStep.done b => pure b
    | ForInStep.yield b => have := Nat.Up.next h; loop f arr off _end (i+1) b
  else pure b
termination_by _ => _end - i

instance : ForIn m ByteSlice UInt8 :=
  ⟨fun ⟨arr, off, len⟩ b f ↦ forIn.loop f arr off (off + len) off b⟩

end ByteSlice

/-- Convert a terminal byte slice into a regular byte slice. -/
def ByteSliceT.toSlice : ByteSliceT → ByteSlice
| ⟨arr, off⟩ => ⟨arr, off, arr.size - off⟩

/-- Convert a byte array into a byte slice. -/
def ByteArray.toSlice (arr : ByteArray) : ByteSlice := ⟨arr, 0, arr.size⟩

/-- Convert a string of assumed-ASCII characters into a byte array.
(If any characters are non-ASCII they will be reduced modulo 256.) -/
def String.toAsciiByteArray (s : String) : ByteArray :=
  let rec loop (p : Pos) (out : ByteArray) : ByteArray :=
    if h : s.atEnd p then out else
    let c := s.get p
    have : utf8ByteSize s - (next s p).byteIdx < utf8ByteSize s - p.byteIdx :=
      Nat.sub_lt_sub_left (Nat.lt_of_not_le <| mt decide_eq_true h)
        (Nat.lt_add_of_pos_right (String.csize_pos _))
    loop (s.next p) (out.push c.toUInt8)
  loop 0 ByteArray.empty
termination_by _ => utf8ByteSize s - p.byteIdx

/-- Convert a byte slice into a string. This does not handle non-ASCII characters correctly:
every byte will become a unicode character with codepoint < 256. -/
def ByteSlice.toString (bs : ByteSlice) : String := Id.run do
  let mut s := ""
  for c in bs do s := s.push c.toChar
  s

instance : ToString ByteSlice where
  toString bs := Id.run do
    let mut s := ""
    for c in bs do s := s.push c.toChar
    s


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  sorry,
end

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A := λ n : ℕ, ∃ (x1 : F.Model.sort 1) (x2 : F.Model.sort 1) (xs : fin n → F.Model.sort 1),
      ∀ (x : fin n), x1 ≠ x2 ∧ x1 ≠ xs x ∧ ∀ (x y : fin n), x ≠ y → xs x ≠ xs y,
  have hA : ∀ (n : ℕ), A n, from sorry,
  let Gamma := F.axioms ∪ { A n | n : ℕ},
  have hGamma : ∀ (n : ℕ), ∃ (m : F.Model), (F.Model.satisfies m) Gamma, from sorry,
  have h1 : F.Model.satisfies (F.Model.compact_closure Gamma), from sorry,
  have h2 : ∀ (n : ℕ), F.Model.satisfies (F.Model.compact_closure Gamma) (A n), from sorry,
  have h3 : infinite (F.Model.compact_closure Gamma), from sorry,
  show ∃ (M : F.Model), infinite M, from sorry,
end

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  assume L : first_order.language,
  assume F : L.Theory,
  assume h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,

  let Γ : set L.formula := sorry,
  have h1 : ∀ s : set L.formula, finite s → (∃ (m : F.Model), s ⊆ m) → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h2 : ∀ s : set L.formula, finite s → (∃ (m : F.Model), s ⊆ m), from sorry,
  have h3 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h4 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h5 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h6 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h7 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h8 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h9 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h10 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h11 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h12 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h13 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h14 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h15 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h16 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h17 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h18 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h19 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h20 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h21 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h22 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h23 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h24 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h25 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h26 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h27 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h28 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h29 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h30 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h31 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h32 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h33 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h34 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h35 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h36 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h37 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h38 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h39 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h40 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h41 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h42 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h43 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h44 : ∀ s : set L.formula, finite s → s ⊆
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h2 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h3 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h4 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h5 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h6 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h7 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h8 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h9 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h10 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h11 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h12 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h13 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h14 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h15 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h16 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h17 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h18 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h19 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h20 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h21 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h22 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h23 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h24 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h25 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h26 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h27 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h28 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h29 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h30 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h31 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h32 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h33 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h34 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h35 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h36 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h37 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h38 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h39 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h40 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h41 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h42 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h43 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h44 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h45 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h46 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h47 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h48 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h49 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h50 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h51 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h52 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h53 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h54 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∃ (x : ℕ) (m : F.Model) [mfin : fintype m], x = fintype.card m, from sorry,
  have h2 : ∃ (m : F.Model) [mfin : fintype m], 1 ≤ @fintype.card m mfin, from sorry,
  have h3 : ∃ (m : F.Model) [mfin : fintype m], 2 ≤ @fintype.card m mfin, from sorry,
  have h4 : ∃ (m : F.Model) [mfin : fintype m], 3 ≤ @fintype.card m mfin, from sorry,

  have h5 : ∃ (m : F.Model) [mfin : fintype m], 4 ≤ @fintype.card m mfin, from sorry,
  have h6 : ∃ (m : F.Model) [mfin : fintype m], 5 ≤ @fintype.card m mfin, from sorry,
  have h7 : ∃ (m : F.Model) [mfin : fintype m], 6 ≤ @fintype.card m mfin, from sorry,
  have h8 : ∃ (m : F.Model) [mfin : fintype m], 7 ≤ @fintype.card m mfin, from sorry,
  have h9 : ∃ (m : F.Model) [mfin : fintype m], 8 ≤ @fintype.card m mfin, from sorry,

  have h10 : ∃ (m : F.Model) [mfin : fintype m], 9 ≤ @fintype.card m mfin, from sorry,
  have h11 : ∃ (m : F.Model) [mfin : fintype m], 10 ≤ @fintype.card m mfin, from sorry,
  have h12 : ∃ (m : F.Model) [mfin : fintype m], 11 ≤ @fintype.card m mfin, from sorry,
  have h13 : ∃ (m : F.Model) [mfin : fintype m], 12 ≤ @fintype.card m mfin, from sorry,
  have h14 : ∃ (m : F.Model) [mfin : fintype m], 13 ≤ @fintype.card m mfin, from sorry,

  have h15 : ∃ (m : F.Model) [mfin : fintype m], 14 ≤ @fintype.card m mfin, from sorry,
  have h16 : ∃ (m : F.Model) [mfin : fintype m], 15 ≤ @fintype.card m mfin, from sorry,
  have h17 : ∃ (m : F.Model) [mfin : fintype m], 16 ≤ @fintype.card m mfin, from sorry,
  have h18 : ∃ (m : F.Model) [mfin : fintype m], 17 ≤ @fintype.card m mfin, from sorry,
  have h19 : ∃ (m : F.Model) [mfin : fintype m], 18 ≤ @fintype.card m mfin, from sorry,

  have h20 : ∃ (m : F.Model) [mfin : fintype m], 19 ≤ @fintype.card m mfin, from sorry,
  have h21 : ∃ (m : F.Model) [mfin : fintype m], 20 ≤ @fintype.card m mfin, from sorry,
  have h22 : ∃ (m : F.Model) [mfin : fintype m], 21 ≤ @fintype.card m mfin, from sorry,
  have h23 : ∃ (m : F.Model) [mfin : fintype m], 22 ≤ @fintype.card m mfin, from sorry,
  have h24 : ∃ (m : F.Model) [mfin : fintype m], 23 ≤ @fintype.card m mfin, from sorry,

  have h25 : ∃ (m : F.Model) [mfin : fintype m], 24 ≤ @fintype.card m mfin, from sorry,
  have h26 : ∃ (m : F.Model) [mfin : fintype m], 25 ≤ @fintype.card m mfin, from sorry,
  have h27 : ∃ (m : F.Model) [mfin : fintype m], 26 ≤ @fintype.card m mfin, from sorry,
  have h28 : ∃ (m : F.Model) [mfin : fintype m], 27 ≤ @fintype.card m mfin, from sorry,
  have h29 : ∃ (m : F.Model) [mfin : fintype m], 28 ≤ @fintype.card m mfin, from sorry,

  have h30 : ∃ (m : F.Model) [mfin : fintype m], 29 ≤ @fintype.card m mfin, from sorry,
  have h31 : ∃ (m : F.Model) [mfin : fintype m], 30 ≤ @fintype.card m mfin, from sorry,
  have h32 : ∃ (m : F.Model) [mfin : fintype m], 31 ≤ @fintype.card m mfin, from sorry,
  have h33 : ∃ (m : F.Model) [mfin : fintype m], 32 ≤ @fintype.card m mfin, from sorry,
  have h34 : ∃ (m : F.Model) [mfin : fintype m], 33 ≤ @fintype.card m mfin, from sorry,

  have h35 : ∃ (m : F.Model) [mfin : fintype m], 34 ≤ @fintype.card m mfin, from sorry,
  have h36 : ∃ (m : F.Model) [mfin : fintype m], 35 ≤ @fintype.card m mfin, from sorry,
  have h37 : ∃ (m : F.Model) [mfin : fintype m], 36 ≤ @fintype.card m mfin, from sorry,
  have h38 : ∃ (m : F.Model) [mfin : fintype m], 37 ≤ @fintype.card m mfin, from sorry,
  have h39 : ∃ (m : F.Model) [mfin : fintype m], 38 ≤ @fintype.card m mfin, from sorry,

  have h40 : ∃ (m : F.Model) [mfin : fintype m], 39 ≤ @fintype.card m mfin, from sorry,
  have h41 : ∃ (m : F.Model) [mfin : fintype m], 40 ≤ @fintype.card m mfin, from sorry,
  have h42 : ∃ (m : F.Model) [mfin : fintype m], 41 ≤ @fintype.card m mfin, from sorry,
  have h43 : ∃ (m : F.Model) [mfin : fintype m], 42 ≤ @fintype.card m mfin, from sorry,
  have h44 : ∃ (m : F.Model) [mfin : fintype m], 43 ≤ @fintype.card m mfin, from sorry,

  have h45 : ∃ (m : F.Model) [mfin : fintype m], 44 ≤ @fintype.card m mfin, from sorry,
  have h46 : ∃ (m : F.Model) [mfin : fintype m], 45 ≤ @fintype.card m mfin, from sorry,
  have h47 : ∃ (m : F.Model) [mfin : fintype m], 46 ≤ @fintype.card m mfin, from sorry,
  have h48 : ∃ (m : F.Model) [mfin : fintype m], 47 ≤ @fintype.card m mfin, from sorry,
  have h49 : ∃ (m : F.Model) [mfin : fintype m], 48 ≤ @fintype.card m mfin, from sorry,

  have h50 : ∃ (m : F.Model) [mfin : fintype m], 49 ≤ @fintype.card m mfin, from sorry,
  have h51 : ∃ (m : F.Model) [mfin : fintype m], 50 ≤ @fintype.card m mfin, from sorry,
  have h52
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  assume (n : ℕ),
  let A : L.Theory := F.union (L.Theory.of (L.model_of_nat n)),
  have h1 : ∀ (s : finset F.Model), (∀ (m : F.Model) (H : m ∈ s), m.satisfies A) → ∃ (M : F.Model), M.satisfies A, from sorry,
  have h2 : ∀ (s : finset F.Model), (∀ (m : F.Model) (H : m ∈ s), m.satisfies A) → ∃ (M : F.Model), M.satisfies A ∧ infinite M, from sorry,
  have h3 : ∃ (M : F.Model), M.satisfies A ∧ infinite M, from sorry,
  show ∃ (M : F.Model), infinite M, from sorry,
end

--OUTPUT 7
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  sorry,
end

--OUTPUT 8
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (A : F.Model), n ≤ fintype.card A, from sorry,
  have h2 : ∀ n : ℕ, F.Formula.Existential n ∈ F.Theory.satisfiable, from sorry,
  have h3 : ∀ n : ℕ, F.Formula.ForAll n ∈ F.Theory.satisfiable, from sorry,
  have h4 : ∀ n : ℕ, ∃ (A : F.Model), F.Formula.ForAll n ∈ F.Model.satisfy A, from sorry,

  have h5 : ∀ n : ℕ,  F.Formula.ForAll (n + 1), from sorry,
  have h6 : ∀ n : ℕ,  F.Formula.ForAll (n + 2), from sorry,

  have h7 : ∀ n : ℕ,  F.Formula.ForAll (n + 3), from sorry,

  have h8 : ∀ n : ℕ,  F.Formula.ForAll (n + 4), from sorry,
  have h9 : ∀ n : ℕ,  F.Formula.ForAll (n + 5), from sorry,

  have h10 : ∀ n : ℕ,  F.Formula.ForAll (n + 6), from sorry,

  have h11 : ∀ n : ℕ,  F.Formula.ForAll (n + 7), from sorry,
  have h12 : ∀ n : ℕ,  F.Formula.ForAll (n + 8), from sorry,

  have h13 : ∀ n : ℕ,  F.Formula.ForAll (n + 9), from sorry,
  have h14 : ∀ n : ℕ,  F.Formula.ForAll (n + 10), from sorry,

  have h15 : ∀ n : ℕ,  F.Formula.ForAll (n + 11), from sorry,
  have h16 : ∀ n : ℕ,  F.Formula.ForAll (n + 12), from sorry,

  have h17 : ∀ n : ℕ,  F.Formula.ForAll (n + 13), from sorry,
  have h18 : ∀ n : ℕ,  F.Formula.ForAll (n + 14), from sorry,

  have h19 : ∀ n : ℕ,  F.Formula.ForAll (n + 15), from sorry,
  have h20 : ∀ n : ℕ,  F.Formula.ForAll (n + 16), from sorry,

  have h21 : ∀ n : ℕ,  F.Formula.ForAll (n + 17), from sorry,
  have h22 : ∀ n : ℕ,  F.Formula.ForAll (n + 18), from sorry,

  have h23 : ∀ n : ℕ,  F.Formula.ForAll (n + 19), from sorry,
  have h24 : ∀ n : ℕ,  F.Formula.ForAll (n + 20), from sorry,

  have h25 : ∀ n : ℕ,  F.Formula.ForAll (n + 21), from sorry,
  have h26 : ∀ n : ℕ,  F.Formula.ForAll (n + 22), from sorry,

  have h27 : ∀ n : ℕ,  F.Formula.ForAll (n + 23), from sorry,
  have h28 : ∀ n : ℕ,  F.Formula.ForAll (n + 24), from sorry,

  have h29 : ∀ n : ℕ,  F.Formula.ForAll (n + 25), from sorry,
  have h30 : ∀ n : ℕ,  F.Formula.ForAll (n + 26), from sorry,

  have h31 : ∀ n : ℕ,  F.Formula.ForAll (n + 27), from sorry,
  have h32 : ∀ n : ℕ,  F.Formula.ForAll (n + 28), from sorry,

  have h33 : ∀ n : ℕ,  F.Formula.ForAll (n + 29), from sorry,
  have h34 : ∀ n : ℕ,  F.Formula.ForAll (n + 30), from sorry,

  have h35 : ∀ n : ℕ,  F.Formula.ForAll (n + 31), from sorry,
  have h36 : ∀ n : ℕ,  F.Formula.ForAll (n + 32), from sorry,

  have h37 : ∀ n : ℕ,  F.Formula.ForAll (n + 33), from sorry,
  have h38 : ∀ n : ℕ,  F.Formula.ForAll (n + 34), from sorry,

  have h39 : ∀ n : ℕ,  F.Formula.ForAll (n + 35), from sorry,
  have h40 : ∀ n : ℕ,  F.Formula.ForAll (n + 36), from sorry,

  have h41 : ∀ n : ℕ,  F.Formula.ForAll (n + 37), from sorry,
  have h42 : ∀ n : ℕ,  F.Formula.ForAll (n + 38), from sorry,

  have h43 : ∀ n : ℕ,  F.Formula.ForAll (n + 39), from sorry,
  have h44 : ∀ n : ℕ,  F.Formula.ForAll (n + 40), from sorry,

  have h45 : ∀ n : ℕ,  F.Formula.ForAll (n + 41), from sorry,
  have h46 : ∀ n : ℕ,  F.Formula.ForAll (n + 42), from sorry,

  have h47 : ∀ n : ℕ,  F.Formula.ForAll (n + 43), from sorry,
  have h48 : ∀ n : ℕ,  F.Formula.ForAll (n + 44), from sorry,

  have h49 : ∀ n : ℕ,  F.Formula.ForAll (n + 45), from sorry,
  have h50 : ∀ n : ℕ,  F.Formula.ForAll (n + 46), from sorry,

  have h51 : ∀ n : ℕ,  F.Formula.ForAll (n + 47), from sorry,
  have h52 : ∀ n : ℕ,  F.Formula.ForAll (n + 48), from sorry,

  have h53 : ∀ n : ℕ,  F.Formula.ForAll (n + 49), from sorry,
  have h54 : ∀ n : ℕ,  F.Formula.ForAll (n + 50), from sorry,

  have h55 : ∀ n : ℕ,  F.Formula.ForAll (n + 51), from sorry,
  have h56 : ∀ n : ℕ,  F.Formula.ForAll (n + 52), from sorry,

  have h57 : ∀ n : ℕ,  F.Formula.ForAll (n + 53), from sorry,
  have h58 : ∀ n : ℕ,  F.Formula.ForAll (n + 54), from sorry,

  have h59 : ∀ n : ℕ,  F.Formula.ForAll (n + 55), from sorry,
  have h60 : ∀ n : ℕ,  F.Formula.ForAll (n + 56), from sorry,

  have h61 : ∀ n : ℕ,  F.Formula.ForAll (n + 57), from sorry,
  have h62 : ∀ n : ℕ,  F.Formula.ForAll (n + 58), from sorry,

  have h63 : ∀ n : ℕ,  F.Formula.ForAll (n + 59), from sorry,
  have h64 : ∀ n : ℕ,  F.Formula.ForAll (n + 60), from sorry,

  have h65 : ∀ n : ℕ,  F.Formula.ForAll (n + 61), from sorry,
  have h66 : ∀ n : ℕ,
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/