import Runtime.Execution.Next
import Runtime.Execution.Apply
import Runtime.Execution.Propagate
import Runtime.Execution.Triggers

namespace Execution.Executable
open Network Graph Class

def fire (exec : Executable net) {reactor : ReactorId net} (reaction : Reaction reactor.class) :=
  reaction.val.run {
    ports          := exec.reactionInputs reactor     |>.restrict
    actions        := exec.interface reactor .actions |>.restrict
    state          := reaction.eqState  ▸ exec.interface reactor .state
    params         := reaction.eqParams ▸ exec.interface reactor .params
    tag            := exec.tag
    physicalOffset := exec.physicalOffset
  }

def fireToIO (exec : Executable net) {reactor : ReactorId net} (reaction : Reaction reactor.class) :=
  toIO <| exec.fire reaction
where
  toIO {α} {kind : Reaction.Kind} : (kind.monad α) → IO α :=
    match kind with | .pure => pure | .impure => id

-- Advances the given executable to the state given by `next`.
-- This includes:
-- * advancing the tag
-- * dequeueing events for that tag
-- * clearing all ports
-- * setting actions' values for the given tag
def advance (exec : Executable net) (next : Next net) : Executable net := { exec with
  tag := next.tag
  queue := next.queue
  toPropagate := #[]
  reactors := fun id => { exec.reactors id with
    timer := next.timers exec id
    interface := fun
      | .inputs  => next.inputs id
      | .actions => next.actions id
      | .outputs => Interface?.empty
      | _        => exec.interface id _
  }
}

theorem advance_tag_strictly_increasing (exec : Executable net) :
  (Next.for exec = some next) → exec.tag < (exec.advance next).tag :=
  Next.for_tag_strictly_monotonic exec

def shutdown (exec : Executable net) (h : exec.state = .shutdownPending) : Executable net :=
  match hn : Next.for exec  with
  | some next => { exec.advance next with state := .shuttingDown }
  | none => by have h' := Next.for_isSome_if_shutdownPending h; simp [hn] at h'

-- TODO: Once Lean has universe polymorphic IO:
-- * factor out a `runInst` function for the instantaneous execution
-- * factor out a `runTimed` function for everything currently happening in the `none` branch
-- Then you can actually prove theorems about these functions.
partial def run (exec : Executable net) (topo : Array (ReactionId net)) (reactionIdx : Nat) : IO Unit := do
  match topo[reactionIdx]? with
  -- This branch is entered whenever we've completed an instantaneous execution.
  | none =>
    match h : exec.state with
    -- The instantaneous execution where the `.shutdown` trigger is active
    -- has already been executed, so we terminate execution.
    | .shuttingDown => return
    -- The last instantaneous execution contained a shutdown request,
    -- so the next instantaneous execution performs shutdown.
    | .shutdownPending => exec.shutdown h |>.run topo 0
    -- Case 1:
    -- We've reached starvation (there are no more events to be processed),
    -- so the next instantaneous execution performs shutdown.
    -- Case 2:
    -- Execution continues normally at the tag of the next event.
    | .executing =>
      match Next.for exec with
      | none =>
        let exec := { exec with state := .shutdownPending }
        exec.shutdown rfl |>.run topo 0
      | some next =>
        let exec := exec.advance next
        IO.sleepUntil exec.absoluteTime
        exec.run topo 0
  -- This branch is entered whenever we're within an instantaneous execution.
  | some reactionId =>
    let reaction := reactionId.reaction
    let mut exec := exec
    if Triggers exec reaction then
      exec := (← exec.fireToIO reaction)
        |> ReactionOutput.fromRaw
        |> exec.apply
        |>.propagate reactionId
    exec.run topo (reactionIdx + 1)

end Execution.Executable


import util.tactic
import util.io
import all

section main

section

namespace io
namespace fs

def put_str_ln_flush (h : handle) (s : string) : io unit :=
put_str h s *> put_str h "\n" *> flush h

end fs
end io

setup_tactic_parser

-- Expected file format:
-- <decl>, <import> ... <import>, <open> ... <open>

meta def parse_decl_and_metadata (input : string) : tactic (name × list name × list name) := do
 flip lean.parser.run_with_input input $ do
  name ← ident,
  tk ",",
  imports ← many ident,
  tk ",",
  opens ← many ident,
  pure (name, imports, opens)

end

def for_ {m α β} [monad m] (xs : list α) (body : α → m β) := list.mmap' body xs

meta def main_aux (names_file : string) (dest : string) : io unit := do {
  nm_strs ← (io.mk_file_handle names_file io.mode.read >>= λ f,
    (string.split (λ c, c = '\n') <$> buffer.to_string <$> io.fs.read_to_end f)),

  let nm_strs := nm_strs.filter (λ x : string, x.length > 0),
  nms : list (name × list name × list name) ← io.run_tactic'' $ nm_strs.mmap parse_decl_and_metadata,
  dest_handle ← io.mk_file_handle dest io.mode.write,

  io.run_tactic'' $ do {
    env ← tactic.get_env,
    for_ (nm_strs.zip nms) $ λ ⟨nm_str, ⟨nm, imports, open_ns⟩⟩, tactic.try $ do {
      decl ← env.get nm,
      if decl.is_theorem then do {
        tactic.trace format! "[filter_defs] KEEPING {nm.to_string}",
        tactic.unsafe_run_io $ io.fs.put_str_ln_flush dest_handle nm_str
      } else do {
        tactic.trace format! "[filter_defs] DISCARDING {nm.to_string}",
        pure ()
      }
    }
  }
}

meta def main : io unit := do {
  io.put_str_ln' "ENTERING",
  args ← io.cmdline_args,
  names_file ← args.nth_except 0 "names_file",
  dest ← args.nth_except 1 "dest",
  main_aux names_file dest
}

end main


example : True := by
  skip
    skip --< should complain about misleading indentation
  trivial

macro "frobnicate" : tactic => `(tactic| skip)

example : True := by
  conv =>
    skip
    frobnicate --< should not parse frobnicate as a tactic
  trivial

-- check error message without default handler for conv tactics
declare_syntax_cat item
syntax "valid_item" : item
macro "block" "=>" sepByIndentSemicolon(item) : tactic => `(tactic| skip)

example : True := by
  block =>
    valid_item
    frobnicate --< should not parse frobnicate as a tactic


import theology.natural.god
open set topological_space classical
set_option pp.generalized_field_notation true
local attribute [instance] prop_decidable

namespace ontology

variables {ω : ontology} (c : ω.cause)

lemma eps_stronger : c.eps ⇒ c.epcs ∩ c.epsc :=
  begin
    intros w hw,
    constructor,
      rintro ⟨e, he₁, he₂⟩,
      refine ⟨e.exists, e.existential, he₂, _⟩,
      refine ⟨_,hw e he₁ he₂⟩,
      simp [nbe] at he₁,
      exact ⟨e.possible, he₁⟩,
    intros h₁ e h₂ su h₃ h₄ h₅ h₆,
    apply h₂; try{assumption},
    refine ⟨h₄,_⟩,
    let s : ω.entity := ⟨su, h₅, nonempty_of_mem h₆⟩,
    apply hw s,
      simp [nbe],
      exact h₄.2,
    simpa [su],
  end

theorem aquinas_second (h' : c.entitative) : c.epcs ∩ c.epsc ∩ c.epc ∩ (c.epp (λe, c.csubstratum e)) ⇒ c.first_cause ω.nbe :=
  begin
    rintro w ⟨⟨⟨h₁, h₂⟩, pc⟩, pp⟩,
    by_cases h : ∃ e : ω.entity, e.contingent ∧ e.exists w, swap,
      exact c.first_cause_of_nocontingent h,
    specialize h₁ h, clear h,
    specialize h₂ h₁ univ, clear h₁,
    suffices c₀ : ∀ (su : event ω), cause.csubstratum c su →
                 su ≠ univ → event.existential su →
                 event.occurs su w → cause.causes c univ su w,
      specialize h₂ c₀,
      simp [cause.first_cause, nbe],
      refine ⟨by simp [univ],_⟩,
      unfold_coes, simp,
      intros e h₃ h₄,
      replace h₄ := ne.symm h₄,
      apply h₂; try{assumption},
        exact ⟨e.possible, h₄⟩,
      exact e.existential,
    clear h₂,
    intros ee h₃ h₄ h₅ h₆,
    let e : ω.entity := ⟨ee, h₅, nonempty_of_mem h₆⟩,
    have c₁ := pc e (by simpa [nbe]) h₆,
    have c₂ := pp e h₃ c₁,
    obtain ⟨ge, hg, cg⟩ := c₂,
    replace h₃ := h₃.2,
    specialize h₃ ge cg,
    convert cg,
    replace cg := h' (nonempty_of_mem ⟨ee, cg⟩),
    symmetry,
    by_contradiction h,
    let g : ω.entity := ⟨ge, cg, nonempty_of_mem h₃⟩,
    specialize pc g (by simpa [nbe]) h₃,
    unfold_coes at pc, simp [g] at pc,
    contradiction,
  end

theorem leibniz_second : (c.epcs (@entity.contingent ω) univ) ∩ (c.epsc univ) ∩ c.epsr ∩ (c.epp' (λe, c.csubstratum e)) ⇒ c.first_cause ω.nbe :=
  begin
    rintro w ⟨⟨⟨h₁, h₂⟩, psr⟩, pp⟩,
    by_cases h : ∃ e : ω.entity, e.contingent ∧ e.exists w, swap,
      exact c.first_cause_of_nocontingent h,
    specialize h₁ h, clear h,
    specialize h₂ h₁ univ, clear h₁,
    suffices c₀ : ∀ (su : event ω), cause.csubstratum c su →
                 su ≠ univ → univ su →
                 event.occurs su w → cause.causes c univ su w,
      specialize h₂ c₀,
      simp [cause.first_cause, nbe],
      refine ⟨by simp [univ],_⟩,
      unfold_coes, simp,
      intros e h₃ h₄,
      replace h₄ := ne.symm h₄,
      apply h₂; try{assumption},
        exact ⟨e.possible, h₄⟩,
      trivial,
    clear h₂,
    intros ee h₃ h₄ h₅ h₆,
    have c₁ := psr ee ⟨nonempty_of_mem h₆,h₄⟩ h₆,
    have c₂ := pp ee h₃ c₁,
    obtain ⟨g, hg, cg⟩ := c₂,
    replace h₃ := h₃.2,
    specialize h₃ g cg,
    convert cg,
    symmetry,
    by_contradiction h,
    specialize psr g ⟨nonempty_of_mem h₃,h⟩ h₃,
    obtain ⟨absurdity, insanity⟩ := psr,
    replace insanity := c.caused_causes insanity,
    contradiction,
  end

-- And of course we can get `dscotus` out of these proofs:
theorem scotus_second (h' : c.entitative) : ⋄(c.epcs ∩ c.epsc ∩ c.epc ∩ (c.epp (λe, c.csubstratum e))) → c.dscotus :=
  c.scotus_theorem $ aquinas_second c @h'

theorem scotus_second_psr : ⋄((c.epcs (@entity.contingent ω) univ) ∩ (c.epsc univ) ∩ c.epsr ∩ (c.epp' (λe, c.csubstratum e))) → c.dscotus :=
  c.scotus_theorem $ leibniz_second c

-- theorem material_substratum : ∀ {c' : ω.cause} (mc : c'.mcause), c.pcem mc ∩ mc.pis c ⇒ c.epcs (@entity.contingent ω) univ :=
--   begin
--     rintros c' mc w ⟨hw₁,hw₂⟩ ⟨e,he₁,he₂⟩,
--     by_cases h : mc.immaterial e w,
--       specialize hw₂ e h,
--       refine ⟨e, by trivial, _⟩,
--       refine ⟨he₂, _, hw₂⟩,
--       unfold_coes,
--       simp [nbe] at he₁,
--       exact ⟨e.possible, he₁⟩,
--     simp [cause.mcause.immaterial] at h,
--     replace h : ¬c'.uncaused e.exists w,
--       by_contradiction h₀,
--       apply h,
--       exact ⟨he₂,h₀⟩,
--     simp [cause.uncaused, cause.caused] at h,
--     simp [has_neg.neg, compl, set_of, has_mem.mem, set.mem] at h,
--     obtain ⟨m, hm⟩ := h,
--     replace hm := c'.caused_causes hm,
--     specialize hw₁ e hm,
--     obtain ⟨f, hf₁, hf₂, h⟩ := hw₁,

    -- use f.continues,
    -- push_neg at h,

    -- unfold_coes at h,
    -- simp [set_of] at h,

  -- end

theorem leibniz_BCCF (h : c.conjunctive₁') : c.epsr ∩ c.epss ⇒ c.first_cause ω.nbe :=
  begin
    rintros w ⟨psr, pss⟩,
    by_cases c₀ : ∀ w', w' = w,
      exact c.first_cause_of_parmenides c₀,
    push_neg at c₀,
    replace c₀ : ({w} : ω.event).contingent,
      simp [ext_iff], exact c₀,
    have c₁ := psr {w} c₀ (by simp),
    obtain ⟨g, hg⟩ := c₁,
    specialize pss g hg,
    have c₂ : c.causes univ {w} w,
      convert hg,
      symmetry,
      by_contradiction cg,
      have c₃ : {w} = g ∩ {w},
        ext w', simp,
        exact ⟨λh, ⟨by convert pss, h⟩, and.right⟩,
      rw c₃ at hg,
      have c₄ := h g g {w} ⟨nonempty_of_mem pss,cg⟩ c₀ hg,
      replace c₄ := nonempty_of_mem c₄.1,
      have c₅ := c.irreflexive g,
      contradiction,
    clear psr pss hg g,
    simp [cause.first_cause, nbe],
    refine ⟨by simp [univ],_⟩,
    unfold_coes, simp,
    intros e h₃ h₄,
    replace h₄ := ne.symm h₄,
    specialize h univ e {w} ⟨nonempty_of_mem h₃,h₄⟩ c₀,
    unfold_coes at h,
    specialize @h w _, swap,
      have c₃ : {w} = e.exists ∩ {w},
        ext w', simp,
        exact ⟨λh, ⟨by convert h₃, h⟩, and.right⟩,
      rw ←c₃,
      exact c₂,
    exact h.1,
  end

theorem scotus_leibniz_BCCF (h : c.conjunctive₁') : ⋄(c.epsr ∩ c.epss) → c.dscotus :=
  c.scotus_theorem $ leibniz_BCCF c h

theorem atheological_hylemorphism : (∃ c : ω.cause, ⋄(c.uhylemorphism ∩ ω.nonparmenidean)) → ω.atheism :=
  begin
    rintros ⟨c, ⟨w, ⟨⟨hc,hw⟩, nparm⟩⟩⟩,
    obtain ⟨e, ⟨he₁,he₂⟩⟩ := nparm,
    have c₀ : (∃ s : ω.substance, s.contingent ∧ s.exists w) ∨ ω.atheism,
      by_cases h₀ : e.perfect, swap,
        let a : ω.accident := ⟨e, h₀⟩,
        by_cases h₁ : a.owner.necessary,
          right,
          simp [accident.owner, nb] at h₁,
          intro theism,
          simp [ontology.theism, ext_iff] at theism,
          apply theism,
          refine ⟨a, _⟩,
          simp [accident.inheres, entity.subsists, nb],
          exact h₁,
        left,
        use a.owner,
        refine ⟨h₁,_⟩,
        have c₀ := a.inh_owner,
        replace c₀ := entails_of_inheres c₀,
        exact c₀ he₂,
      left,
      refine ⟨⟨e,h₀⟩,_,he₂⟩,
      simp [nb, -entity_ext_iff],
      exact he₁,
    cases c₀, swap, assumption,
    obtain ⟨s, h₁, h₂⟩ := c₀,
    have c₁ := hw s ⟨s.perfect,_⟩ h₂, swap,
      simp [nb] at h₁,
      unfold_coes, intro h,
      specialize h₁ _,swap,
        apply substance_ext,
        simp at h, exact h,
      contradiction,
    have c₂ := hc.axiom₈,
    simp [cause.pp, ext_iff] at c₂,
    replace c₁ := @c₂ w s (by trivial) c₁,
    clear c₂,
    obtain ⟨m, h₃, h₄⟩ := c₁,
    have c₁ := hc.axiom₀ ⟨w, nonempty_of_mem h₄⟩,
    let es : ω.entity := ⟨m, c₁.1.1, c₁.1.2⟩,
    let ms : ω.substance := ⟨es,c₁.2⟩,
    have c₂ : ms.necessary,
      by_contradiction contra,
      simp [nb, ms, -entity_ext_iff] at contra,
      specialize hw es ⟨ms.perfect, contra⟩,
      unfold_coes at hw,
      simp [es] at hw,
      suffices : c.caused m w,
        contradiction,
      apply hw,
      exact hc.axiom₃ ⟨s, h₄⟩,
    simp [ms,nb] at c₂,
    rw c₂ at h₄,
    replace h₄ : w ∈ c.is_cause ω.nbe.exists := ⟨s, h₄⟩,
    replace h₄ := nonempty_of_mem h₄,
    replace h₄ := hc.axiom₅ ω.nbe h₄,
    simp [atheism, theism, nb, ext_iff, accident.inheres],
    simp [-entity_ext_iff] at h₄,
    obtain ⟨e, h₄, h₅⟩ := h₄,
    let a : ω.accident, refine ⟨e, _⟩,
      exact imperfect_of_subsists_other h₄ h₅,
    exact ⟨a, h₄⟩,
  end

theorem theological_hylemorphism : ∀ (c' : ω.cause) (mc : c'.mcause), -c'.uhylemorphism ∩ mc.pis c ⇒ c.epcs :=
  begin
    rintros c' mc w ⟨h₁, h₂⟩,
    simp [cause.uhylemorphism, mc, cause.epc] at h₁,
    simp [set_of, has_mem.mem, set.mem] at h₁,
    obtain ⟨e, h₁, h₃, h₄, h₅⟩ := h₁,
    have c : mc.immaterial e w := ⟨h₄, h₅⟩,
    specialize h₂ e c,
    intro aux, clear aux,
    refine ⟨e.exists, e.existential, h₄, ⟨_,h₂⟩⟩,
    simp [nbe] at h₃,
    exact ⟨e.possible, h₃⟩,
  end

-- The argument from consubstantial causation.
theorem consub_cosmo : c.consubstantial → ⋄(c.epsr ∩ c.uncaused ω.nbe) → ω.theism :=
  begin
    simp [set.nonempty, cause.epsr],
    intros h w psr unc,
    dunfold theism substance.simple entity.simple,
    -- suppose God had an accident
    simp [substance.accidents, ext_iff, set.nonempty],
    intro a,
    by_contradiction contra,
    -- then He should also have an accident 'a'
    -- in the world w in which psr is valid
    have : ω.nb.composite := ⟨a, contra⟩,
    clear contra a,
    obtain ⟨a, contra, h₁⟩ := nb_acc_actual this w, clear this,
    simp [substance.accidents] at contra,
    -- this accident has a cause in w, call it 's'.
    have : a.exists.contingent,
      refine ⟨a.possible, _⟩,
      have := a.contingent,
      simp [entity.contingent, nbe] at this,
      simpa [event.necessary],
    obtain ⟨s, hs⟩ := psr a this h₁, clear this,
    -- But this cause would in a sense have to be a
    -- cause of something that is going on in the necessary
    -- being.
    have c₁ : c.causes s ω.nbe.exists w,
        refine h s a hs ω.nbe _ (by simp [nbe]),
        simp [has_equiv.equiv, entity.cosubstantial],
        exact ⟨ω.nbe, self_subsist.mp ω.nb.perfect, contra⟩,
    -- However the necessary being admits no causes.
    simp [cause.uncaused, cause.caused] at unc,
    apply unc s, assumption,
    -- Therefore the necessary being
    -- is what we call God (E.Q.D.D.).
  end

variable (ω)

/-- "It is contingent that there contingent things. "-/
def contingency_contingent : Prop := (∃ e : ω.entity, e.contingent) ∧ (Sup $ @entity.contingent ω).contingent

/-- It is it enough for it it to be contingent that there are
    contingent entities for we to get full blown classical theism
    without any extra auxiliary assumptions. -/
theorem ctheism_of_contingency : ω.contingency_contingent → ω.ctheism :=
  begin
    rintros ⟨h₁, h₂⟩,
    have c : set.nonempty entity.contingent := h₁,
    simp [Sup, c, entity_Sup, nbe, ext_iff] at h₂,
    -- clear c h₁,
    obtain ⟨w, hw⟩ := h₂,
    replace hw : ∀ e : ω.entity, e.exists w → e.necessary,
      intro e,
      simp [has_Sup.Sup, c, entity_Sup] at hw,
      specialize hw e,
      contrapose,
      exact hw,
    use w, intros e₁ e₂ h₃ h₄,
    have c₁ := hw e₁ h₃,
    have c₂ := hw e₂ h₄,
    clear hw h₃ h₄,
    simp [entity.necessary] at *,
    rw c₁, rw c₂,
  end

/-! # Aquinas's fourth way.

    The following proof is the best interpretation I could give of Aquinas's fourth way.
    However, admittedly, two additional assumptions,
    though probably acceptable to Saint Thomas,
    were not present in the original argument.
    The first could probably be replaced by any other premisse from which it
    were possible to prove that if the necessary being's degree of perfection does
    not vary across possible worlds then it can possibly exist alone or,
    for a weaker `ω.theism` argument, that it is simple.
    This premisse seemed intuitive enough for its intended application.
    The second might be even harder to replace, but it is even more
    intuitive. Please verify the formal definitions of all referenced
    concepts and lemmas before proposing an objection.

    The original text of the Summa Theologica reads:

      "**Quarta via** sumitur ex gradibus qui in rebus inveniuntur.
       Invenitur enim in rebus aliquid magis et minus bonum,
       et verum, et nobile, et sic de aliis huiusmodi.
       Sed magis et minus dicuntur de diversis secundum
       quod appropinquant diversimode ad aliquid quod maxime est,
       sicut magis calidum est, quod magis appropinquat maxime calido.
       Est igitur aliquid quod est verissimum, et optimum, et nobilissimum,
       et per consequens maxime ens, nam quae sunt maxime vera, sunt maxime entia,
       ut dicitur II Metaphys. Quod autem dicitur maxime tale in aliquo genere,
       est causa omnium quae sunt illius generis, sicut ignis, qui est maxime
       calidus, est causa omnium calidorum, ut in eodem libro dicitur.
       Ergo est aliquid quod omnibus entibus est causa esse, et bonitatis,
       et cuiuslibet perfectionis, et hoc dicimus Deum."

       Reference: (https://www.corpusthomisticum.org/sth1002.html)
                  accessed in Jan 9, 2021.

    A translation reads:

      "The **fourth way** is taken from the gradation to be found in things.
      Among beings [rebus] there are some more and some less good, true, noble and the like.
      But "more" and "less" are predicated of different things, according as they
      resemble in their different ways something which is the maximum, as a thing is
      said to be hotter according as it more nearly resembles that which is hottest;
      so that there is something which is truest, something best, something noblest and,
      consequently, something which is uttermost being; for those things that are greatest
      in truth are greatest in being, as it is written in Metaph. ii.
      Now the maximum in any genus is the cause of all in that genus;
      as fire, which is the maximum heat, is the cause of all hot things.
      Therefore there must also be something which is to all beings the cause of their being, goodness,
      and every other perfection; and this we call God."

      Reference: (https://www.newadvent.org/summa/1002.htm#article3)
                 accessed in Jan 9, 2021.

    My formalization depends on the following
    assumptions and lemmas:

    0. (Analytical Premisse) There is a necessary being (`ω.nbe`), though it might in principle be a mere abstraction
        of the collection or multitude of all possible things/contingent things, i.e. the universe/cosmos.

        0.1. Notice that the conclusion `ω.ctheism` is incompatible with it being a mere
            abstraction, and with it being the universe. See god.lean for details.
        0.2. Indeed, to say that God exists (`ω.theism`) is to say that the necessary being cannot be construed
            as a well-behaved materialistic universe, as the material universe has accidents. While
            to say that God has the attributes classically ascribed to Him (`ω.ctheism`) is to
            say that the necessary being cannot *in any way* be construed as the universe,
            or as any collection of things, and that it cannot be taken to be a mere abstraction,
            *no matter one's underlying intensional position on which entities are real*, provide only it is a consistent
            position.
        0.3. The necessary being is unique up to existential equivalence (i.e. *qua* extensional entity)
            (`nbe_unique`).

    1. (Premisse) There are degrees of perfection, or greatness of being, in things (`b : ω.being`).

    2. (Premisse) If `e₁ ⇒ e₂` but not `e₂ ⇒ e₁`,
        then `e₂` is strictly more perfect than `e₁` (`b.axiom₂`).

    3. (Minor Syllogistic Premisse) Some possible entity possibly attains the greatest
        conceivable degree of perfection (`b.ecaused`).

        3.1. We believe that in the original argument the notion of an **exemplary cause** is used
             to justify this premisse. Refer to the section "*The Intuition behind exemplary causes*"
             in essence.lean for details.
        3.2. Supposing it were false, the necessary being could get arbitrarily close to the greatest
            conceivable degree of perfection, but never be able to reach it (`nbe_mperfectible`, `b.axiom₃`).
            This would be very strange, for at some possible world the difference between attaining and not
            attaining the greatest possible perfection would be negligible; e.g. there would
            be a possible world in which the necessary being would be 99.999999% perfect, but it
            would never be 100%.
        3.3. Alternatively we could also prove this premisse using `ecaused_of_phappy_and_wholesome` from:
            3.3.1. It is possible for some possible entity to attain the
                    greatest degree of perfection **that it can have** (`b.wholesome`).
            3.3.2. No entity which attains the greatest degree of perfection that it can have, in a world `w`,
                    can entail the existence (`⇒`) of an entity which does not attain the greatest degree
                    of perfection that it can have, at `w` (`b.phappy`).

    4. (Theorem) If **(3)** and **(2)**, then the necessary being can possibly attain
        the greatest conceivable degree of perfection (`exemplar_nbe_of_ecaused`).

        4.1.1. For mere convenience we don't use `exemplar_nbe_of_ecaused` directly
              in our proof, but both `abs_exemplary_intro` and `nbe_eq1_of_abs_exemplary` instead.
        4.1.2. These lemmas have a dependency on `exemplar_nbe_of_ecaused`.
        4.1.3. `nbe_eq1_of_abs_exemplary` also depends on `b.axiom₃`, but this axiom is a mere
              convenience (allowing us to hardcode the number `1` in the proof)
              and could be completely removed without prejudice to the proof.

    5. (Major Syllogistic Premisse) It is *de re* necessary, (or essential) for an entity
        to attain the greatest conceivable degree of perfection (if it is possible for it to do so).
        I.e. "x attains the greatest conceivable degree of perfection"
        is a *de re* necessary predicate (`b.eexemplary`).

    6. (Theorem) If **(5)**, then the necessary being necessarily attains the
        greatest conceivable degree of perfection (`b.absolutely_exemplary`).

    Given **(6)** we can already conclude that the necessary being is maximally perfect (`entity.mperfect`),
    and that is probably the only conclusion that the original 4th way of Aquinas could manage to extract
    on its own without further assumptions. However, in order to prove the stronger result `ω.ctheism`,
    which is what Aquinas would ultimately have wanted to prove, further premisses are needed. In
    a sense, the proof of `ω.ctheism` from **(6)** via additional premisses is a way to resolve
    the so called "gap problem" of proving the classical properties of God from the god-like entity
    obtained at the end of a typical proof of the existence of God. In Aquina's Summa Theologica,
    this is done along the 26 first questions of the *prima pars*. For the purpose of solving this
    problem, we then further introduce the following 2 assumptions:

    7. (Premisse) The multitude, collection, or whole of things (substances) of a given
       kind varies in perfection across possible worlds in proportion to the number of
       entities of that kind which exists in each respective world (`b.composable`).

       7.1. Strictly larger sets are strictly more perfect than the strictly smaller sets.
       7.2. Collections are strictly more perfect than their proper parts,
            though it may or may not be the case that they are more perfect
            than the *sum* of the perfections of their parts.
            We are not here committed to either.

    8. (Premisse) Given any possible world `w`,
        there must be some world `w'` which is either strictly"larger" (`>`) than `w`,
        or strictly "smaller" (`<`) than `w` (`ω.viable`).

        8.1. What `w < w'` means is that every entity which exists at `w` also exists at `w'`, but not vice-versa.
        8.2. See the definition of `ω.viable`, as well as the definitions of `specialization_order`
             and `specialization` (currently defined) at alexandroff.lean for further
             details on what "larger" and "smaller" mean.

    Since premisses **(1)**, **(3)**, **(5)** and **(7)** depend on an instance of `ω.being`,
    we pack them all together into the `ω.participated : Prop` definition. It turns
    out that it suffices to assume that it is logically consistent for there to be
    a `b : ω.being` with the aforementioned properties to prove `ω.ctheism`.
    The definition `ω.participated` can then reduce to our 4 premisses as the
    following example shows:

    example : ω.participated = ∃ b : ω.being, b.composable ∧ b.ecaused ∧ b.eexemplary :=
      by simp [participated, being.participated]

    Finally, we allow the proof to explain itself:

-/

-- WORK IN PROGRESS. ALMOST DONE.
-- MOST OF IT TYPE CHECKS AND CAN BE PROFITABLY READ.
-- INCOMPLETE PARTS ARE EXPLICIT.
-- UNCOMMENT `ω.participated` IN `god.lean` AND THIS TO FOLLOW THE ARGUMENT.
-- /-- Aquinas's fourth way. -/
-- theorem aquinas_fourth : ω.participated → ω.viable → ω.ctheism :=
--   begin
--     intros participated viable,
--     obtain ⟨b, comp, h₁, h₂⟩ := participated,
--     obtain ⟨viable⟩ := viable,
--     -- the following step already concludes the proof that
--     -- the necessary being is maximally perfect (`entity.absolutely_exemplary`)
--     -- which is what the original
--     -- argument probably sough to show.
--     -- check the lemma for the proof.
--     have he := abs_exemplary_intro h₁ h₂,
--     clear h₁ h₂,
--     -- for simplicity, we ditch the "absolutely examplary/maximally perfect" conclusion
--     -- and work with the hardcoded number `1`.
--     replace he := nbe_eq1_of_abs_exemplary he,
--     dunfold ctheism,
--     -- suppose the classical theistic God doesn't exist.
--     by_contradiction c,
--     push_neg at c,
--     -- then in any possible world there must be
--     -- something contingent
--     replace c : ∀ w, ∃ e : ω.entity, e.contingent ∧ e.exists w,
--       intro w,
--       specialize c w,
--       obtain ⟨e₁,e₂,he₁,he₂,neq⟩ := c,
--       dunfold entity.contingent,
--       simp [nbe],
--       by_cases h : e₁.necessary;
--       simp [nbe] at h, swap,
--         exact ⟨e₁,h, he₁⟩,
--       rw ←h,
--       replace neq := ne.symm neq,
--       simp [entity_ext_iff] at neq,
--       exact ⟨e₂, neq, he₂⟩,
--     -- it then also follows that the necessary being
--     -- can be expressed as the supremum of the set of all
--     -- contingent things. I.e. the necessary being's
--     -- existence is logically equivalent to "there exists something contingent",
--     -- so it can be thought of as the collection
--     -- of contingent things, or "the universe".
--     replace c : ω.nbe = Sup entity.contingent := sorry,
--     -- we can then specialize the compositionality of being
--     -- to the set of contingent entities and to the necessary being:
--     specialize comp (set_of $ @entity.contingent ω) ω.nbe,
--     -- We derive an auxiliary result before proceeding,
--     -- this was needed for purely bureocratic reasons.
--     have c' : ω.nbe ∉ (set_of $ @entity.contingent ω),
--       simp [set_of, has_mem.mem, set.mem],
--     -- We analyse the consequences of this for a single
--     -- possible world `w`:
--     obtain ⟨w⟩ := ω.wne,
--     -- because the ontology is viable, this world could be
--     -- made larger or smaller by some world `w'`.
--     -- This generates 2 proof goals for us corresponding to the
--     -- "larger" and "smaller" cases, respectively:
--     specialize viable w,
--     obtain ⟨w', ⟨hw'₁, hw'₂⟩|⟨hw'₁, hw'₂⟩⟩ := viable;
--     push_neg at hw'₂; simp [specialization] at hw'₂;
--     obtain ⟨s, open_s, hs₁, hs₂⟩ := hw'₂,
--     -- we then seek to prove that the degree of perfection of the
--     -- necessary being varies across worlds.
--     -- for the case w < w':
--       specialize comp w w',
--       swap,
--     -- for the case w' < w:
--     specialize comp w' w,
--     all_goals {
--       specialize comp c' c,
--       specialize comp _, swap,
--         constructor,
--           rintros e ⟨he₁,he₂⟩,
--           simp [world.entities] at he₁,
--           specialize hw'₁ e.exists e.existential he₁,
--           exact ⟨hw'₁, he₂⟩,
--         simp [world.entities, has_subset.subset, set.subset],
--         have ps : ⋄s,
--           simp [has_diamond.diamond],
--           exact nonempty_of_mem hs₁,
--         let es : ω.entity := ⟨s, open_s, ps⟩,
--         use es,
--         constructor, simp [es, hs₁],
--         constructor, swap, simp [es, hs₂],
--         simp [ontology.nbe, es],
--         intro h, simp [ext_iff] at h,
--     },
--     specialize h w', contradiction,
--     swap,
--     specialize h w, contradiction,
--     -- finished specializing comp.
--     -- We have shown roughly that the perfection
--     -- of the necessary being varies across worlds,
--     -- now we need to show that, because the necessary
--     -- being is maximally perfect, this is impossible
--     all_goals {
--       have h := he w,
--       have h' := he w',
--       clear he,
--       rw h at comp,
--       rw h' at comp,
--       norm_num at comp,
--     },
--   end

-- WORK IN PROGRESS
-- /-- Using `being.axiom₄` we can also show
--     composability + viability → nogap₂.
--     meaning classical theism follows from these assumptions under
--     the further assumption of theism. -/
-- theorem aquinas_fourth_nogap₂ : ω.composable → ω.viable → ω.nogap₂ := sorry

end ontology


import GameServer.HashMapExtension
import GameServer.SingleValPersistentEnvExtension

/-! # Environment extensions

The game framework stores almost all its game building data in environment extensions
defined in this file. MAyn of them are `SimplePersistentEnvExtension` but we also
use `HashMapExtension` and `SingleValPersistentEnvExtension`
-/

open Lean

/-! ## Messages -/

structure GoalMessageEntry where
  ctx_size : Nat
  normalized_goal : Expr
  intro_nb : Nat
  message : String
  deriving Repr

/-! ## Tactic documentation -/

structure TacticDocEntry where
  name : Name
  content : String
  deriving ToJson, Repr

/-- Environment extension for tactic documentation. -/
initialize tacticDocExt : SimplePersistentEnvExtension TacticDocEntry (Array TacticDocEntry) ←
  registerSimplePersistentEnvExtension {
    name := `tactic_doc
    addEntryFn := Array.push
    addImportedFn := Array.concatMap id
  }

open Elab Command in
/-- Print a registered tactic doc for debugging purposes. -/
elab "#print_tactic_doc" : command => do
  for entry in tacticDocExt.getState (← getEnv) do
    dbg_trace "{entry.name} : {entry.content}"

structure TacticSetEntry where
  name : Name
  tactics : Array TacticDocEntry
  deriving ToJson, Repr

/-- Environment extension for tactic sets. -/
initialize tacticSetExt : SimplePersistentEnvExtension TacticSetEntry (Array TacticSetEntry) ←
  registerSimplePersistentEnvExtension {
    name := `tactic_set
    addEntryFn := Array.push
    addImportedFn := Array.concatMap id
  }

open Elab Command in
/-- Print all registered tactic sets for debugging purposes. -/
elab "#print_tactic_set" : command => do
  for entry in tacticSetExt.getState (← getEnv) do
    dbg_trace "{entry.name} : {entry.tactics.map TacticDocEntry.name}"

/-! ## Lemma documentation -/

structure LemmaDocEntry where
  name : Name
  userName : Name
  category : String
  content : String
  deriving ToJson, Repr

/-- Environment extension for lemma documentation. -/
initialize lemmaDocExt : SimplePersistentEnvExtension LemmaDocEntry (Array LemmaDocEntry) ←
  registerSimplePersistentEnvExtension {
    name := `lemma_doc
    addEntryFn := Array.push
    addImportedFn := Array.concatMap id
  }

open Elab Command in
/-- Print a lemma doc for debugging purposes. -/
elab "#print_lemma_doc" : command => do
  for entry in lemmaDocExt.getState (← getEnv) do
    dbg_trace "{entry.userName} ({entry.name}) in {entry.category}: {entry.content}"

structure LemmaSetEntry where
  name : Name
  title : String
  lemmas : Array LemmaDocEntry
  deriving ToJson, Repr

/-- Environment extension for lemma sets. -/
initialize lemmaSetExt : SimplePersistentEnvExtension LemmaSetEntry (Array LemmaSetEntry) ←
  registerSimplePersistentEnvExtension {
    name := `lemma_set
    addEntryFn := Array.push
    addImportedFn := Array.concatMap id
  }

open Elab Command in
/-- Print all registered lemma sets for debugging purposes. -/
elab "#print_lemma_set" : command => do
  for entry in lemmaSetExt.getState (← getEnv) do
    dbg_trace "{entry.name} : {entry.lemmas.map LemmaDocEntry.name}"

/-! ## Game -/

structure Game where
  name : Name
  title : String := ""
  introduction : String := ""
  conclusion : String := ""
  authors : List String := []
  nb_levels : Nat := 0
  deriving Repr, Inhabited, ToJson

initialize gameExt : SingleValPersistentEnvExtension Game ← registerSingleValPersistentEnvExtension `gameExt Game

/-! ## Levels -/

/- Register a (non-persistent) environment extension to hold the current level number. -/
initialize curLevelExt : EnvExtension Nat ← registerEnvExtension (pure 0)

variable {m: Type → Type} [Monad m] [MonadEnv m]

def setCurLevelIdx (lvl : Nat) :  m Unit :=
  modifyEnv (curLevelExt.setState · lvl)

def getCurLevelIdx :  m Nat := do
  return curLevelExt.getState (← getEnv)

structure GameLevel where
  index: Nat
  title: String := default
  introduction: String := default
  conclusion: String := default
  tactics: Array TacticDocEntry := default
  lemmas: Array LemmaDocEntry := default
  messages: Array GoalMessageEntry := default
  goal : Expr := default
  intro_nb : Nat := default
  deriving Inhabited, Repr

initialize levelsExt : HashMapExtension Nat GameLevel ← mkHashMapExtension `levels Nat GameLevel

def getCurLevel [MonadError m] :  m GameLevel := do
  let idx ← getCurLevelIdx
  match (← levelsExt.find? idx) with
  | some level => return level
  | none => throwError "Couldn't find level {idx}"


example : True := by rw (config := non / sense) []


/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Ebner
-/
import Lean

open Lean Parser.Term Macro

/-
This adds support for structure instance spread syntax.

```lean
instance : Foo α where
  __ := instSomething -- include fields from `instSomething`

example : Foo α := {
  __ := instSomething -- include fields from `instSomething`
}
```
-/

macro_rules
| `({ $[$srcs,* with]? $[$fields $[,]?]* $[: $ty?]? }) => do
    let mut spreads := #[]
    let mut newFields := #[]

    for field in fields do
      match field with
        | `(structInstField| $name:ident := $arg) =>
          if name.getId.eraseMacroScopes == `__ then do
            spreads := spreads.push arg
          else
            newFields := newFields.push field
        | `(structInstFieldAbbrev| $name:ident) =>
          newFields := newFields.push field
        | _ =>
          throwUnsupported

    if spreads.isEmpty then throwUnsupported

    let srcs := (srcs.map (·.1)).getD #[] ++ spreads
    `({ $srcs,* with $[$newFields,]* $[: $ty?]? })


import evaluation
import utils

namespace fairseq

section fairseq_api

meta structure CompletionRequest : Type :=
(prompt : string)
(max_tokens : int := 16)
(temperature : native.float := 1.0)
(nbest : int := 1)
(beam: int := 10)

meta def default_partial_req : CompletionRequest :=
{
  prompt := "",
  max_tokens := 6000,
  temperature := (1.0 : native.float),
  nbest := 1,
  beam := 10,
}

/-- this is responsible for validating parameters,
   e.g. ensuring floats are between 0 and 1 -/
meta instance : has_to_tactic_json CompletionRequest :=
let validate_max_tokens : int → bool := λ n, n ≤ 10000 in
let validate_float_frac : native.float → bool := λ k, 0 ≤ k ∧ k ≤ 1 in
let validate_and_return {α} (pred : α → bool) : α → tactic α := λ a, ((guard $ pred a) *> pure a <|> tactic.fail "VALIDATE_AND_RETURN FAILED") in
let validate_optional_and_return {α} (pred : α → bool) : option α → tactic (option α) := λ x, do {
  match x with
  | (some val) := some <$> validate_and_return pred val
  | none := pure none
  end
} in
let fn : CompletionRequest → tactic json := λ req, match req with
| ⟨prompt, max_tokens, temperature, nbest, beam⟩ := do
  max_tokens ← validate_and_return validate_max_tokens max_tokens,
  temperature ← validate_and_return validate_float_frac temperature,
  nbest ← validate_and_return (λ x, 0 ≤ x ∧ x ≤ (50 : int)) /- don't go overboard with the candidates -/ nbest,
  beam ← validate_and_return (λ x, 0 ≤ x ∧ x ≤ (50 : int)) /- don't go overboard with the candidates -/ beam,

  let pre_kvs : list (string × option json) := [
    ("prompt", json.of_string prompt),
    ("max_tokens", json.of_int max_tokens),
    ("temperature", json.of_float temperature),
    ("nbest", json.of_int nbest),
    ("beam", json.of_int beam)
  ],

  pure $ json.object $ pre_kvs.filter_map (λ ⟨k,mv⟩, prod.mk k <$> mv)
end
in ⟨fn⟩

meta def ENTRY_PT : string := "/Users/Yuhuai/Documents/research/scatter_transformer_fairseq/fairseq_cli/query.py"
meta def MODEL_PATH : string := "/Users/Yuhuai/Documents/research/scatter_transformer_fairseq/lean_multigoal_checkpoints/checkpoint_best.pt"
meta def DATA_PATH : string := "/Users/Yuhuai/Documents/research/scatter_transformer_fairseq/datasets/LeanMultiGoalStepSPBPE4000Bin"

meta def CompletionRequest.to_cmd (entry_pt: string) (model_path : string) (data_path : string)  : CompletionRequest → io (io.process.spawn_args)
| req@⟨prompt, max_tokens, temperature, nbest, beam⟩ := do
serialized_req ← io.run_tactic' $ has_to_tactic_json.to_tactic_json req,
pure {
  cmd := "python",
  args := [
      entry_pt
      , data_path
      , "--path"
      , model_path
      , "--sentencepiece-model"
      , data_path ++ "/model_4000_bpe.model"
      , "--json-msg"
      , json.unparse serialized_req
    ]
}

meta def serialize_ts
  (req : CompletionRequest)
  : tactic_state → tactic CompletionRequest := λ ts, do {
  ts_str ← postprocess_tactic_state ts, -- this function is responsible for replacing newlines with tabs and removing the "k goals" line
  let prompt : string :=
  ts_str,
  eval_trace format!"\n \n \n PROMPT: {prompt} \n \n \n ",
  pure {
    prompt := prompt,
    ..req}
}

meta def fairseq_api (entry_pt : string) (model_path : string) (data_path : string) : ModelAPI CompletionRequest :=

let get_predictions (response_msg : json) : option json :=
(lift_option $ do
    { (json.array choices) ← response_msg.lookup "choices" | none,
      /- `choices` is a list of {text: ..., index: ..., logprobs: ..., finish_reason: ...}-/
      texts ← choices.mmap (λ choice, choice.lookup "text"),
      pure texts
  }) in

let fn : CompletionRequest → io json := λ req, do {
  proc_cmds ← req.to_cmd entry_pt model_path data_path,
  response_raw ← io.cmd proc_cmds,
  io.put_str_ln' format!"RAW RESPONSE: {response_raw}",
  response_msg ← (lift_option $ json.parse response_raw) | io.fail' format!"[fairseq_api] JSON PARSE FAILED {response_raw}",
  (do predictions ← lift_option (get_predictions response_msg) | io.fail' format!"[fairseq_api] UNEXPECTED RESPONSE MSG: {response_msg}",
  io.put_str_ln' format!"PREDICTIONS: {predictions}",
  pure predictions) <|> pure (json.array $ [json.of_string $ format.to_string $ format!"ERROR {response_msg}"])
} in ⟨fn⟩

end fairseq_api

section fairseq_greedy_proof_search

meta def fairseq_greedy_proof_search_core
  (partial_req : fairseq.CompletionRequest)
  (entry_pt : string)
  (model_path : string)
  (data_path : string)
  (fuel := 5)
  : state_t GreedyProofSearchState tactic unit :=
greedy_proof_search_core
  (fairseq_api entry_pt model_path data_path)
    (fairseq.serialize_ts partial_req)
      (λ  msg n, run_best_beam_candidate (unwrap_lm_response $ some "[fairseq_greedy_proof_search_core]") msg n)
        (fuel)

meta def fairseq_greedy_proof_search
  (partial_req : fairseq.CompletionRequest)
  (entry_pt : string)
  (model_path : string)
  (data_path : string)
  (fuel := 5)
  (verbose := ff)
  : tactic unit :=
greedy_proof_search
  (fairseq_api entry_pt model_path data_path)
    (fairseq.serialize_ts partial_req)
      (λ  msg n, run_best_beam_candidate (unwrap_lm_response $ some "[fairseq_greedy_proof_search]") msg n)
        (fuel)
          (verbose)

end fairseq_greedy_proof_search

section test

-- example : true :=
-- begin
--   trythis "asdf",
--   sorry -- try using fairseq_greedy_proof_search here
-- end

-- example : true :=
-- begin
--   fairseq_greedy_proof_search {temperature :=1.0, nbest:=1, beam:=10, ..fairseq_api.default_partial_req}
--     fairseq_api.ENTRY_PT
--       fairseq_api.MODEL_PATH
--         fairseq_api.DATA_PATH,
-- end

-- open nat
-- example (n : ℕ) (m : ℕ) : nat.succ (n + m) = (nat.succ n + m) :=
-- begin
--   -- fairseq_greedy_proof_search {temperature :=0.7, nbest:=10, beam:=10, ..fairseq_api.default_partial_req}
--   --   fairseq_api.ENTRY_PT
--   --     fairseq_api.MODEL_PATH
--   --       fairseq_api.DATA_PATH,
-- end

-- #eval fairseq_api.CompletionRequest.to_cmd  {prompt := "true", nbest := 10, ..fairseq_api.default_partial_req} >>= io.cmd >>=io.put_str_ln
-- #eval fairseq_api.CompletionRequest.to_cmd  fairseq_api.default_partial_req >>= io.cmd >>= io.put_str_ln
-- #eval io.cmd {cmd:="echo", args:=["hello"]} >>= io.put_str_ln
-- #eval fairseq_api.serialize_ts fairseq_api.default_partial_req
end test

end fairseq


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module tactic.squeeze
! leanprover-community/mathlib commit dff8393cf1d1fc152d148e13fe57452fc37d4852
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Traversable.Basic
import Mathbin.Tactic.Simpa

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
private unsafe def loc.to_string_aux : Option Name → String
  | none => "⊢"
  | some x => toString x
#align loc.to_string_aux loc.to_string_aux

/-- pretty print a `loc` -/
unsafe def loc.to_string : Loc → String
  | loc.ns [] => ""
  | loc.ns [none] => ""
  | loc.ns ls => String.join <| List.intersperse " " (" at" :: ls.map loc.to_string_aux)
  | loc.wildcard => " at *"
#align loc.to_string loc.to_string

/-- shift `pos` `n` columns to the left -/
unsafe def pos.move_left (p : Pos) (n : ℕ) : Pos
    where
  line := p.line
  column := p.column - n
#align pos.move_left pos.move_left

namespace Tactic

deriving instance DecidableEq for simp_arg_type

/-- Turn a `simp_arg_type` into a string. -/
unsafe instance simp_arg_type.has_to_string : ToString simp_arg_type :=
  ⟨fun a =>
    match a with
    | simp_arg_type.all_hyps => "*"
    | simp_arg_type.except n => "-" ++ toString n
    | simp_arg_type.expr e => toString e
    | simp_arg_type.symm_expr e => "←" ++ toString e⟩
#align tactic.simp_arg_type.has_to_string tactic.simp_arg_type.has_to_string

open List

/-- parse structure instance of the shape `{ field1 := value1, .. , field2 := value2 }` -/
unsafe def struct_inst : lean.parser pexpr :=
  with_desc "cfg" do
    tk "{"
    let ls ←
      sep_by (skip_info (tk ","))
          (Sum.inl <$> (tk ".." *> texpr) <|> Sum.inr <$> (Prod.mk <$> ident <* tk ":=" <*> texpr))
    tk "}"
    let (srcs, fields) := partitionMap id ls
    let (names, values) := unzip fields
    pure <|
        pexpr.mk_structure_instance
          { field_names := names
            field_values := values
            sources := srcs }
#align tactic.struct_inst tactic.struct_inst

/-- pretty print structure instance -/
unsafe def struct.to_tactic_format (e : pexpr) : tactic format := do
  let r ← e.get_structure_instance_info
  let fs ←
    zipWithM
        (fun n v => do
          let v ← to_expr v >>= pp
          pure <| f! "{n } := {v}")
        r.field_names r.field_values
  let ss := r.sources.map fun s => f! " .. {s}"
  let x : format := format.join <| List.intersperse ", " (fs ++ ss)
  pure f! " \{{x}}}"
#align tactic.struct.to_tactic_format tactic.struct.to_tactic_format

/-- Attribute containing a table that accumulates multiple `squeeze_simp` suggestions -/
@[user_attribute]
private unsafe def squeeze_loc_attr :
    user_attribute Unit (Option (List (Pos × String × List simp_arg_type × String)))
    where
  Name := `_squeeze_loc
  parser := fail "this attribute should not be used"
  descr := "table to accumulate multiple `squeeze_simp` suggestions"
#align tactic.squeeze_loc_attr tactic.squeeze_loc_attr

/-- dummy declaration used as target of `squeeze_loc` attribute -/
def squeezeLocAttrCarrier :=
  ()
#align tactic.squeeze_loc_attr_carrier Tactic.squeezeLocAttrCarrier

run_cmd
  squeeze_loc_attr.Set `` squeeze_loc_attr_carrier none true

/-- Format a list of arguments for use with `simp` and friends. This omits the
list entirely if it is empty.

Patch: `pp` was changed to `to_string` because it was getting rid of prefixes
that would be necessary for some disambiguations. -/
unsafe def render_simp_arg_list : List simp_arg_type → format
  | [] => ""
  | args => (· ++ ·) " " <| to_line_wrap_format <| args.map toString
#align tactic.render_simp_arg_list tactic.render_simp_arg_list

/-- Emit a suggestion to the user. If inside a `squeeze_scope` block,
the suggestions emitted through `mk_suggestion` will be aggregated so that
every tactic that makes a suggestion can consider multiple execution of the
same invocation.
If `at_pos` is true, make the suggestion at `p` instead of the current position. -/
unsafe def mk_suggestion (p : Pos) (pre post : String) (args : List simp_arg_type)
    (at_pos := false) : tactic Unit := do
  let xs ← squeeze_loc_attr.get_param `` squeeze_loc_attr_carrier
  match xs with
    | none => do
      let args := render_simp_arg_list args
      if at_pos then
          @scopeTrace _ p p fun _ => _root_.trace (s! "{pre }{args }{post}") (pure () : tactic Unit)
        else trace s! "{pre }{args }{post}"
    | some xs => do
      squeeze_loc_attr `` squeeze_loc_attr_carrier ((p, pre, args, post) :: xs) ff
#align tactic.mk_suggestion tactic.mk_suggestion

/-- translate a `pexpr` into a `simp` configuration -/
unsafe def parse_config : Option pexpr → tactic (simp_config_ext × format)
  | none => pure ({ }, "")
  | some cfg => do
    let e ← to_expr ``(($(cfg) : simp_config_ext))
    let fmt ← has_to_tactic_format.to_tactic_format cfg
    Prod.mk <$> eval_expr simp_config_ext e <*> struct.to_tactic_format cfg
#align tactic.parse_config tactic.parse_config

/-- translate a `pexpr` into a `dsimp` configuration -/
unsafe def parse_dsimp_config : Option pexpr → tactic (DsimpConfig × format)
  | none => pure ({ }, "")
  | some cfg => do
    let e ← to_expr ``(($(cfg) : simp_config_ext))
    let fmt ← has_to_tactic_format.to_tactic_format cfg
    Prod.mk <$> eval_expr dsimp_config e <*> struct.to_tactic_format cfg
#align tactic.parse_dsimp_config tactic.parse_dsimp_config

/-- `same_result proof tac` runs tactic `tac` and checks if the proof
produced by `tac` is equivalent to `proof`. -/
unsafe def same_result (pr : proof_state) (tac : tactic Unit) : tactic Bool := do
  let s ← get_proof_state_after tac
  pure <| some pr = s
#align tactic.same_result tactic.same_result

/-- Consumes the first list of `simp` arguments, accumulating required arguments
on the second one and unnecessary arguments on the third one.
-/
private unsafe def filter_simp_set_aux (tac : Bool → List simp_arg_type → tactic Unit)
    (args : List simp_arg_type) (pr : proof_state) :
    List simp_arg_type →
      List simp_arg_type → List simp_arg_type → tactic (List simp_arg_type × List simp_arg_type)
  | [], ys, ds => pure (ys, ds)
  | x :: xs, ys, ds => do
    let b ← same_result pr (tac true (args ++ xs ++ ys))
    if b then filter_simp_set_aux xs ys (ds x) else filter_simp_set_aux xs (ys x) ds
#align tactic.filter_simp_set_aux tactic.filter_simp_set_aux

initialize
  registerTraceClass.1 `squeeze.deleted

/-- `filter_simp_set g call_simp user_args simp_args` returns `args'` such that, when calling
`call_simp tt /- only -/ args'` on the goal `g` (`g` is a meta var) we end up in the same
state as if we had called `call_simp ff (user_args ++ simp_args)` and removing any one
element of `args'` changes the resulting proof.
-/
unsafe def filter_simp_set (tac : Bool → List simp_arg_type → tactic Unit)
    (user_args simp_args : List simp_arg_type) : tactic (List simp_arg_type) := do
  let some s ← get_proof_state_after (tac false (user_args ++ simp_args))
  let (simp_args', _) ← filter_simp_set_aux tac user_args s simp_args [] []
  let (user_args', ds) ← filter_simp_set_aux tac simp_args' s user_args [] []
  when (is_trace_enabled_for `squeeze.deleted = tt ∧ ¬ds)
      (← do
        dbg_trace "deleting provided arguments {← ds}")
  pure (user_args' ++ simp_args')
#align tactic.filter_simp_set tactic.filter_simp_set

/-- make a `simp_arg_type` that references the name given as an argument -/
unsafe def name.to_simp_args (n : Name) : simp_arg_type :=
  simp_arg_type.expr <| @expr.local_const false n n default pexpr.mk_placeholder
#align tactic.name.to_simp_args tactic.name.to_simp_args

/-- If the `name` is (likely) to be overloaded, then prepend a `_root_` on it. The `expr` of an
overloaded name is constructed using `expr.macro`; this is how we guess whether it's overloaded. -/
unsafe def prepend_root_if_needed (n : Name) : tactic Name := do
  let x ← resolve_name' n
  return <|
      match x with
      | expr.macro _ _ => `_root_ ++ n
      | _ => n
#align tactic.prepend_root_if_needed tactic.prepend_root_if_needed

/-- tactic combinator to create a `simp`-like tactic that minimizes its
argument list.

 * `slow`: adds all rfl-lemmas from the environment to the initial list (this is a slower but more
           accurate strategy)
 * `no_dflt`: did the user use the `only` keyword?
 * `args`:    list of `simp` arguments
 * `tac`:     how to invoke the underlying `simp` tactic
-/
unsafe def squeeze_simp_core (slow no_dflt : Bool) (args : List simp_arg_type)
    (tac : ∀ (no_dflt : Bool) (args : List simp_arg_type), tactic Unit)
    (mk_suggestion : List simp_arg_type → tactic Unit) : tactic Unit := do
  let v ← target >>= mk_meta_var
  let args ←
    if slow then do
        let simp_set ← attribute.get_instances `simp
        let simp_set ← simp_set.filterM <| has_attribute' `_refl_lemma
        let simp_set ← simp_set.mapM <| resolve_name' >=> pure ∘ simp_arg_type.expr
        pure <| args ++ simp_set
      else pure args
  let g ←
    retrieve do
        let g ← main_goal
        tac no_dflt args
        instantiate_mvars g
  let vs := g.list_constant'
  let vs ← vs.filterM is_simp_lemma
  let vs ← vs.mapM strip_prefix
  let vs ← vs.mapM prepend_root_if_needed
  with_local_goals' [v] (filter_simp_set tac args <| vs name.to_simp_args) >>= mk_suggestion
  tac no_dflt args
#align tactic.squeeze_simp_core tactic.squeeze_simp_core

namespace Interactive

/-- combinator meant to aggregate the suggestions issued by multiple calls
of `squeeze_simp` (due, for instance, to `;`).

Can be used as:

```lean
example {α β} (xs ys : list α) (f : α → β) :
  (xs ++ ys.tail).map f = xs.map f ∧ (xs.tail.map f).length = xs.length :=
begin
  have : xs = ys, admit,
  squeeze_scope
  { split; squeeze_simp,
    -- `squeeze_simp` is run twice, the first one requires
    -- `list.map_append` and the second one
    -- `[list.length_map, list.length_tail]`
    -- prints only one message and combine the suggestions:
    -- > Try this: simp only [list.length_map, list.length_tail, list.map_append]
    squeeze_simp [this]
    -- `squeeze_simp` is run only once
    -- prints:
    -- > Try this: simp only [this] },
end
```

-/
unsafe def squeeze_scope (tac : itactic) : tactic Unit := do
  let none ← squeeze_loc_attr.get_param `` squeeze_loc_attr_carrier |
    pure ()
  squeeze_loc_attr `` squeeze_loc_attr_carrier (some []) ff
  finally tac do
      let some xs ← squeeze_loc_attr `` squeeze_loc_attr_carrier |
        fail "invalid state"
      let m := native.rb_lmap.of_list xs
      squeeze_loc_attr `` squeeze_loc_attr_carrier none ff
      m fun ⟨p, suggs⟩ => do
          let ⟨pre, _, post⟩ := suggs
          let suggs : List (List simp_arg_type) := suggs <| Prod.fst ∘ Prod.snd
          mk_suggestion p pre post (suggs List.union []) tt
          pure ()
#align tactic.interactive.squeeze_scope tactic.interactive.squeeze_scope

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `squeeze_simp`, `squeeze_simpa` and `squeeze_dsimp` perform the same
task with the difference that `squeeze_simp` relates to `simp` while
`squeeze_simpa` relates to `simpa` and `squeeze_dsimp` relates to
`dsimp`. The following applies to `squeeze_simp`, `squeeze_simpa` and
`squeeze_dsimp`.

`squeeze_simp` behaves like `simp` (including all its arguments)
and prints a `simp only` invocation to skip the search through the
`simp` lemma list.

For instance, the following is easily solved with `simp`:

```lean
example : 0 + 1 = 1 + 0 := by simp
```

To guide the proof search and speed it up, we may replace `simp`
with `squeeze_simp`:

```lean
example : 0 + 1 = 1 + 0 := by squeeze_simp
-- prints:
-- Try this: simp only [add_zero, eq_self_iff_true, zero_add]
```

`squeeze_simp` suggests a replacement which we can use instead of
`squeeze_simp`.

```lean
example : 0 + 1 = 1 + 0 := by simp only [add_zero, eq_self_iff_true, zero_add]
```

`squeeze_simp only` prints nothing as it already skips the `simp` list.

This tactic is useful for speeding up the compilation of a complete file.
Steps:

   1. search and replace ` simp` with ` squeeze_simp` (the space helps avoid the
      replacement of `simp` in `@[simp]`) throughout the file.
   2. Starting at the beginning of the file, go to each printout in turn, copy
      the suggestion in place of `squeeze_simp`.
   3. after all the suggestions were applied, search and replace `squeeze_simp` with
      `simp` to remove the occurrences of `squeeze_simp` that did not produce a suggestion.

Known limitation(s):
  * in cases where `squeeze_simp` is used after a `;` (e.g. `cases x; squeeze_simp`),
    `squeeze_simp` will produce as many suggestions as the number of goals it is applied to.
    It is likely that none of the suggestion is a good replacement but they can all be
    combined by concatenating their list of lemmas. `squeeze_scope` can be used to
    combine the suggestions: `by squeeze_scope { cases x; squeeze_simp }`
  * sometimes, `simp` lemmas are also `_refl_lemma` and they can be used without appearing in the
    resulting proof. `squeeze_simp` won't know to try that lemma unless it is called as
    `squeeze_simp?`
-/
unsafe def squeeze_simp (key : parse cur_pos) (slow_and_accurate : parse (parser.optional (tk "?")))
    (use_iota_eqn : parse (parser.optional (tk "!"))) (no_dflt : parse only_flag)
    (hs : parse simp_arg_list) (attr_names : parse with_ident_list) (locat : parse location)
    (cfg : parse (parser.optional struct_inst)) : tactic Unit := do
  let (cfg', c) ← parse_config cfg
  squeeze_simp_core slow_and_accurate no_dflt hs
      (fun l_no_dft l_args => simp use_iota_eqn none l_no_dft l_args attr_names locat cfg')
      fun args =>
      let use_iota_eqn := if use_iota_eqn then "!" else ""
      let attrs :=
        if attr_names then ""
        else String.join (List.intersperse " " (" with" :: attr_names toString))
      let loc := loc.to_string locat
      mk_suggestion (key 1) (s! "Try this: simp{use_iota_eqn} only") (s! "{attrs }{loc }{c}") args
#align tactic.interactive.squeeze_simp tactic.interactive.squeeze_simp

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- see `squeeze_simp` -/
unsafe def squeeze_simpa (key : parse cur_pos)
    (slow_and_accurate : parse (parser.optional (tk "?")))
    (use_iota_eqn : parse (parser.optional (tk "!"))) (no_dflt : parse only_flag)
    (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
    (tgt : parse (parser.optional (tk "using" *> texpr)))
    (cfg : parse (parser.optional struct_inst)) : tactic Unit := do
  let (cfg', c) ← parse_config cfg
  let tgt' ←
    traverse
        (fun t => do
          let t ← to_expr t >>= pp
          pure f! " using {t}")
        tgt
  squeeze_simp_core slow_and_accurate no_dflt hs
      (fun l_no_dft l_args => simpa use_iota_eqn none l_no_dft l_args attr_names tgt cfg')
      fun args =>
      let use_iota_eqn := if use_iota_eqn then "!" else ""
      let attrs :=
        if attr_names then ""
        else String.join (List.intersperse " " (" with" :: attr_names toString))
      let tgt' := tgt' ""
      mk_suggestion (key 1) (s! "Try this: simpa{use_iota_eqn} only") (s! "{attrs }{tgt' }{c}") args
#align tactic.interactive.squeeze_simpa tactic.interactive.squeeze_simpa

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `squeeze_dsimp` behaves like `dsimp` (including all its arguments)
and prints a `dsimp only` invocation to skip the search through the
`simp` lemma list. See the doc string of `squeeze_simp` for examples.
 -/
unsafe def squeeze_dsimp (key : parse cur_pos)
    (slow_and_accurate : parse (parser.optional (tk "?")))
    (use_iota_eqn : parse (parser.optional (tk "!"))) (no_dflt : parse only_flag)
    (hs : parse simp_arg_list) (attr_names : parse with_ident_list) (locat : parse location)
    (cfg : parse (parser.optional struct_inst)) : tactic Unit := do
  let (cfg', c) ← parse_dsimp_config cfg
  squeeze_simp_core slow_and_accurate no_dflt hs
      (fun l_no_dft l_args => dsimp l_no_dft l_args attr_names locat cfg') fun args =>
      let use_iota_eqn := if use_iota_eqn then "!" else ""
      let attrs :=
        if attr_names then ""
        else String.join (List.intersperse " " (" with" :: attr_names toString))
      let loc := loc.to_string locat
      mk_suggestion (key 1) (s! "Try this: dsimp{use_iota_eqn} only") (s! "{attrs }{loc }{c}") args
#align tactic.interactive.squeeze_dsimp tactic.interactive.squeeze_dsimp

end Interactive

end Tactic

open Tactic.Interactive

add_tactic_doc
  { Name := "squeeze_simp / squeeze_simpa / squeeze_dsimp / squeeze_scope"
    category := DocCategory.tactic
    declNames := [`` squeeze_simp, `` squeeze_dsimp, `` squeeze_simpa, `` squeeze_scope]
    tags := ["simplification", "Try this"]
    inheritDescriptionFrom := `` squeeze_simp }


/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
import Lean

/-!
# Macro for spread syntax (`__ := instSomething`) in structures.
-/

open Lean Parser.Term Macro

/-
This adds support for structure instance spread syntax.

```lean
instance : Foo α where
  __ := instSomething -- include fields from `instSomething`

example : Foo α := {
  __ := instSomething -- include fields from `instSomething`
}
```
-/

macro_rules
| `({ $[$srcs,* with]? $[$fields],* $[: $ty?]? }) => do
    let mut spreads := #[]
    let mut newFields := #[]

    for field in fields do
      match field.1 with
        | `(structInstField| $name:ident := $arg) =>
          if name.getId.eraseMacroScopes == `__ then do
            spreads := spreads.push arg
          else
            newFields := newFields.push field
        | `(structInstFieldAbbrev| $_:ident) =>
          newFields := newFields.push field
        | _ =>
          throwUnsupported

    if spreads.isEmpty then throwUnsupported

    let srcs := (srcs.map (·.getElems)).getD {} ++ spreads
    `({ $srcs,* with $[$newFields],* $[: $ty?]? })


import Std
import LeanSAT

def IO.asTaskTimeout (time : Nat) (t : IO α) : IO (Except Unit α) :=
  show IO _ from do
  let task : Task (Except IO.Error (Except Unit α)) ←
    IO.asTask (do
      let a ← t
      return .ok a)
  let sleep : Task (Except IO.Error (Except Unit α)) ←
    IO.asTask (do
      IO.sleep time.toUInt32
      return .error ())
  let res ← IO.waitAny [task, sleep]
  let res ← IO.ofExcept res
  return res

def Log (m) [Monad m] [MonadLiftT IO m] (α) := IO.FS.Handle → m α

namespace Log
variable {m} [Monad m] [MonadLiftT IO m]

instance : Monad (Log m) where
  pure a := fun _ => pure a
  bind la f := fun logfile =>
    bind (la logfile) (fun a => f a logfile)

instance : MonadLift m (Log m) where
  monadLift ma := fun _ => ma

private def write (type : String) (s : String) : Log m Unit :=
  fun logfile => do
  let time ← (IO.monoMsNow : IO _)
  let ms := toString <| time % 1000
  logfile.putStrLn s!"[{time / 1000}.{"".pushn '0' (3-ms.length) ++ ms}] {type}: {s}"
  logfile.flush

def info : String → Log m Unit := write "INFO"
def warn : String → Log m Unit := write "WARN"
def error : String → Log m Unit := write "ERROR"

def run (logfile : IO.FS.Handle) (la : Log m α) : m α := la logfile
def getHandle : Log m IO.FS.Handle := λ path => pure path

instance [Monad m] [Monad n] [MonadLift m n] : MonadLift (Log m) (Log n) where
  monadLift mla := fun handle => liftM <| Log.run handle mla

instance [Monad m] [ForIn m ρ α] : ForIn (Log m) ρ α where
  forIn r acc f := fun handle => ForIn.forIn r acc (f · · handle)

end Log

def LeanSAT.Encode.EncCNF.State.cleanup : State → State × (Var → Var)
| {nextVar, clauses, names, varCtx} =>
  let usedVars :=
    clauses.foldl
      (fun set clause =>
        clause.lits.foldl
          (fun set lit =>
            set.insert lit.var ())
          set)
      (Std.HashMap.empty)

  let (varRemap, namesRemap, nextVarRemap) := Id.run do
    let mut varRemap : Std.HashMap Var Var := .empty
    let mut namesRemap : Std.HashMap Var String := .empty
    let mut nextVarRemap := 0
    for i in [0:nextVar] do
      if usedVars.contains i then
        varRemap := varRemap.insert i nextVarRemap
        if names.contains i then
          namesRemap := namesRemap.insert nextVarRemap (names.find! i)
        nextVarRemap := nextVarRemap.succ
    return (varRemap, namesRemap, nextVarRemap)

  let clausesRemap := clauses.map (⟨·.lits.map (fun
    | .pos v => .pos <| varRemap.find! v
    | .neg v => .neg <| varRemap.find! v
    )⟩)

  ( { nextVar := nextVarRemap
      names := namesRemap
      clauses := clausesRemap
      varCtx := varCtx}
  , varRemap.find! )

def List.pmap {p : α → Prop} (f : ∀ a, p a → β) : ∀ l : List α, (∀ a ∈ l, p a) → List β
  | [], _ => []
  | a :: l, H => f a (H a (List.Mem.head _)) :: pmap f l (fun a h => H a (List.Mem.tail _ h))

def List.attach (l : List α) : List { x // x ∈ l } :=
  pmap Subtype.mk l fun _ => id

@[simp] theorem List.length_pmap : List.length (List.pmap f L h) = List.length L := by
  induction L with
  | nil => simp [pmap]
  | cons x xs ih => simp [pmap, ih]

def RandomM (τ) := ∀ g, RandomGen g → StateM g τ

namespace RandomM

instance [RandomGen g] : Monad RandomM where
  pure a    := λ _ _ => pure a
  bind r f  := λ G R => bind (r G R) (fun a => f a G R)

def run [R : RandomGen G] (g : G) (r : RandomM τ) : τ × G :=
  StateT.run (r G R) g

instance : MonadLift RandomM IO where
  monadLift r := do
    let gen ← IO.stdGenRef.get
    let (res, seed) := run gen r
    IO.stdGenRef.set seed
    return res

@[inline]
def randIndep (p1 : RandomM α) : RandomM α :=
  λ _ R r => let (r1,r2) := RandomGen.split r
             let (a,_) := p1 _ R r1
             (a,r2)

@[inline]
def randFin (n : Nat) (hn : n > 0 := by trivial) : RandomM (Fin n) :=
  λ G R g =>
    let (res, g) := @randNat G R g 0 n.pred
    if h : res < n then
      (⟨res, h⟩, g)
    else
      have : Inhabited (Fin n × G) := ⟨⟨⟨0,hn⟩, g⟩⟩
      panic! s!"randFin wrong: n={n}, res={res}"

/- Generate a random permutation of the list.
Implementation is quadratic in length of L. -/
def randPerm (L : List α) : RandomM (List α) :=
  randPermTR L [] 0
where randPermTR (L acc n) := do
  match L with
  | [] => return acc
  | x::xs =>
    let idx ← RandomM.randFin (n+1) (Nat.zero_lt_succ _)
    let acc' := acc.insertNth idx x
    randPermTR xs acc' (n+1)

end RandomM

def List.parMap (jobs : List α) (f : α → IO β) : IO (List β) := do
  let tasks ← jobs.mapM (IO.asTask <| f ·)
  let res ← IO.mapTasks (·.mapM IO.ofExcept) tasks
  return ← IO.ofExcept res.get

def List.removeOne : List α → List (α × List α)
| [] => []
| x::xs => (x,xs) :: (xs.removeOne.map (fun (x',xs') => (x', x::xs')))

def List.removeOne' : (L : List α) → List (α × { L' : List α // L'.length < L.length })
| [] => []
| x::xs => (x,⟨xs, by simp⟩) :: (xs.removeOne'.map (fun (x',⟨xs',h⟩) => (x', ⟨x::xs', Nat.succ_lt_succ h⟩)))

def List.minBy [LT β] [DecidableRel (@LT.lt β _)] (f : α → β) (L : List α) : Option α :=
  L.foldl (fun o a =>
    let b := f a
    match o with
    | none => some (a, f a)
    | some (a',b') =>
      if b < b' then
        some (a,b)
      else
        some (a',b')) none
  |>.map (·.1)

def List.maxBy [LT β] [DecidableRel (@LT.lt β _)] (f : α → β) (L : List α) : Option α :=
  L.foldl (fun o a =>
    let b := f a
    match o with
    | none => some (a, b)
    | some (a',b') =>
      if b < b' then
        some (a',b')
      else
        some (a,b)) none
  |>.map (·.1)

@[simp]
theorem List.maxBy_eq_none [LT β] [DecidableRel (@LT.lt β _)] : List.maxBy (β := β) f L = none ↔ L = [] := by
  simp [List.maxBy]
  cases L <;> simp
  next hd tl =>
  induction tl generalizing hd
  . simp
  . simp; split <;> simp [*]

def List.maxByMap [LT β] [DecidableRel (@LT.lt β _)] (f : α → α' × β) (L : List α) : Option (α × α') :=
  L.foldl (fun o a =>
    let b := f a
    match o with
    | none => some (a, b)
    | some (a',b') =>
      if b.2 < b'.2 then
        some (a',b')
      else
        some (a,b)) none
  |>.map (fun (a,a',_) => (a,a'))

@[simp]
theorem List.maxByMap_eq_none [LT β] [DecidableRel (@LT.lt β _)] : List.maxByMap (β := β) f L = none ↔ L = [] := by
  simp [List.maxByMap]
  cases L <;> simp
  next hd tl =>
  induction tl generalizing hd
  . simp
  . simp; split <;> simp [*]

@[simp]
theorem List.maxByMap_nil [LT β] [DecidableRel (@LT.lt β _)] : List.maxByMap (β := β) f [] = none := by
  simp [List.maxByMap]

@[simp]
theorem List.isSome_maxByMap [LT β] [DecidableRel (@LT.lt β _)] : Option.isSome (List.maxByMap (β := β) f L) = !L.isEmpty := by
  apply Eq.symm; unfold Option.isSome
  split <;> cases L <;> simp [isEmpty] at *

theorem List.fins.finsAux_eq_append : List.fins.finsAux n i h acc = List.fins.finsAux n i h [] ++ acc := by
  induction i generalizing acc with
  | zero => unfold finsAux; simp
  | succ i ih =>
    unfold finsAux; rw [ih]; conv => rhs; rw [ih]
    simp

theorem List.fins_succ (n : Nat) : List.fins n.succ = 0 :: (List.fins n |>.map (·.succ)) := by
  unfold fins
  suffices ∀ i (h : i ≤ n),
    fins.finsAux (Nat.succ n) (Nat.succ i) (Nat.succ_le_succ h) []
    = 0 :: (fins.finsAux n i h [] |>.map (·.succ))
    from this n (Nat.le_refl _)
  intro i h
  induction i with
  | zero =>
    unfold fins.finsAux; unfold fins.finsAux; rfl
  | succ i ih =>
    conv => lhs; unfold fins.finsAux; rw [fins.finsAux_eq_append]
    conv => rhs; unfold fins.finsAux; rw [fins.finsAux_eq_append]
    rw [ih]
    simp [Fin.succ]
    apply Nat.le_of_lt h


import ..flocq

/- Architecture-dependent parameters for x86 in 32-bit mode -/

namespace archi
open flocq

def ptr64 : bool := ff

def big_endian : bool := ff

def align_int64 := 4
def align_float64 := 4

def splitlong := bnot ptr64

lemma splitlong_ptr32 : splitlong = tt → ptr64 = ff := λ_, rfl

def default_pl_64 : bool × nan_pl 53 :=
(ff, word.repr (2^51))

def choose_binop_pl_64 (s1 : bool) (pl1 : nan_pl 53) (s2 : bool) (pl2 : nan_pl 53) : bool :=
ff /- always choose first NaN -/

def default_pl_32 : bool × nan_pl 24 :=
(ff,  word.repr (2^22))

def choose_binop_pl_32 (s1 : bool) (pl1 : nan_pl 24) (s2 : bool) (pl2 : nan_pl 24) : bool :=
ff /- always choose first NaN -/

def float_of_single_preserves_sNaN := ff

end archi