/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default

universes u w u_1

namespace Mathlib

def buffer (α : Type u) :=
  sigma fun (n : ℕ) => array n α

def mk_buffer {α : Type u} : buffer α :=
  sigma.mk 0 (d_array.mk fun (i : fin 0) => fin.elim0 i)

def array.to_buffer {α : Type u} {n : ℕ} (a : array n α) : buffer α :=
  sigma.mk n a

namespace buffer

def nil {α : Type u} : buffer α :=
  mk_buffer

def size {α : Type u} (b : buffer α) : ℕ :=
  sigma.fst b

def to_array {α : Type u} (b : buffer α) : array (size b) α :=
  sigma.snd b

def push_back {α : Type u} : buffer α → α → buffer α :=
  sorry

def pop_back {α : Type u} : buffer α → buffer α :=
  sorry

def read {α : Type u} (b : buffer α) : fin (size b) → α :=
  sorry

def write {α : Type u} (b : buffer α) : fin (size b) → α → buffer α :=
  sorry

def read' {α : Type u} [Inhabited α] : buffer α → ℕ → α :=
  sorry

def write' {α : Type u} : buffer α → ℕ → α → buffer α :=
  sorry

theorem read_eq_read' {α : Type u} [Inhabited α] (b : buffer α) (i : ℕ) (h : i < size b) : read b { val := i, property := h } = read' b i := sorry

theorem write_eq_write' {α : Type u} (b : buffer α) (i : ℕ) (h : i < size b) (v : α) : write b { val := i, property := h } v = write' b i v := sorry

def to_list {α : Type u} (b : buffer α) : List α :=
  array.to_list (to_array b)

protected def to_string (b : buffer char) : string :=
  list.as_string (array.to_list (to_array b))

def append_list {α : Type u} : buffer α → List α → buffer α :=
  sorry

def append_string (b : buffer char) (s : string) : buffer char :=
  append_list b (string.to_list s)

theorem lt_aux_1 {a : ℕ} {b : ℕ} {c : ℕ} (h : a + c < b) : a < b :=
  lt_of_le_of_lt (nat.le_add_right a c) h

theorem lt_aux_2 {n : ℕ} (h : n > 0) : n - 1 < n :=
  (fun (h₁ : 1 > 0) => nat.sub_lt h h₁) (of_as_true trivial)

theorem lt_aux_3 {n : ℕ} {i : ℕ} (h : i + 1 < n) : n - bit0 1 - i < n := sorry

def append_array {α : Type u} {n : ℕ} (nz : n > 0) : buffer α → array n α → (i : ℕ) → i < n → buffer α :=
  sorry

protected def append {α : Type u} : buffer α → buffer α → buffer α :=
  sorry

def iterate {α : Type u} {β : Type w} (b : buffer α) : β → (fin (size b) → α → β → β) → β :=
  sorry

def foreach {α : Type u} (b : buffer α) : (fin (size b) → α → α) → buffer α :=
  sorry

/-- Monadically map a function over the buffer. -/
def mmap {α : Type u} {β : Type w} {m : Type w → Type u_1} [Monad m] (b : buffer α) (f : α → m β) : m (buffer β) :=
  do
    let b' ← array.mmap (sigma.snd b) f
    return (array.to_buffer b')

/-- Map a function over the buffer. -/
def map {α : Type u} {β : Type w} : buffer α → (α → β) → buffer β :=
  sorry

def foldl {α : Type u} {β : Type w} : buffer α → β → (α → β → β) → β :=
  sorry

def rev_iterate {α : Type u} {β : Type w} (b : buffer α) : β → (fin (size b) → α → β → β) → β :=
  sorry

def take {α : Type u} (b : buffer α) (n : ℕ) : buffer α :=
  dite (n ≤ size b) (fun (h : n ≤ size b) => sigma.mk n (array.take (to_array b) n h)) fun (h : ¬n ≤ size b) => b

def take_right {α : Type u} (b : buffer α) (n : ℕ) : buffer α :=
  dite (n ≤ size b) (fun (h : n ≤ size b) => sigma.mk n (array.take_right (to_array b) n h)) fun (h : ¬n ≤ size b) => b

def drop {α : Type u} (b : buffer α) (n : ℕ) : buffer α :=
  dite (n ≤ size b) (fun (h : n ≤ size b) => sigma.mk (size b - n) (array.drop (to_array b) n h))
    fun (h : ¬n ≤ size b) => b

def reverse {α : Type u} (b : buffer α) : buffer α :=
  sigma.mk (size b) (array.reverse (to_array b))

protected def mem {α : Type u} (v : α) (a : buffer α) :=
  ∃ (i : fin (size a)), read a i = v

protected instance has_mem {α : Type u} : has_mem α (buffer α) :=
  has_mem.mk buffer.mem

protected instance has_append {α : Type u} : Append (buffer α) :=
  { append := buffer.append }

protected instance has_repr {α : Type u} [has_repr α] : has_repr (buffer α) :=
  has_repr.mk (repr ∘ to_list)

end buffer

def list.to_buffer {α : Type u} (l : List α) : buffer α :=
  buffer.append_list mk_buffer l

def char_buffer :=
  buffer char

/-- Convert a format object into a character buffer with the provided
    formatting options. -/
def string.to_char_buffer (s : string) : char_buffer :=
  buffer.append_string buffer.nil s


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.meta.tactic
import Mathlib.Lean3Lib.init.meta.format
import Mathlib.Lean3Lib.init.function

universes l

namespace Mathlib

/-- This is a kind attached to an argument of a congruence lemma that tells the simplifier how to fill it in.
- `fixed`: It is a parameter for the congruence lemma, the parameter occurs in the left and right hand sides.
  For example the α in the congruence generated from `f: Π {α : Type} α → α`.
- `fixed_no_param`: It is not a parameter for the congruence lemma, the lemma was specialized for this parameter.
  This only happens if the parameter is a subsingleton/proposition, and other parameters depend on it.
- `eq`: The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `(eq_i : a_i = b_i)`.
  `a_i` and `b_i` represent the left and right hand sides, and `eq_i` is a proof for their equality.
  For example the second argument in `f: Π {α : Type}, α → α`.
- `cast`: corresponds to arguments that are subsingletons/propositions.
  For example the `p` in the congruence generated from `f : Π (x y : ℕ) (p: x < y), ℕ`.
- `heq` The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `(eq_i : a_i == b_i)`.
   `a_i` and `b_i` represent the left and right hand sides, and eq_i is a proof for their heterogeneous equality.
-/
inductive congr_arg_kind where
| fixed : congr_arg_kind
| fixed_no_param : congr_arg_kind
| eq : congr_arg_kind
| cast : congr_arg_kind
| heq : congr_arg_kind

namespace congr_arg_kind

def to_string : congr_arg_kind → string := sorry

protected instance has_repr : has_repr congr_arg_kind := has_repr.mk to_string

end Mathlib


import tactic.tcache

set_option trace.cache true

namespace charlie

theorem lol : 1 + 2 = 3 := by c begin
  simp
end

end charlie


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import for_mathlib.idempotents.functor_extension2
import category_theory.natural_isomorphism

import category_theory.functor.fully_faithful

open category_theory.category
open category_theory.idempotents
open category_theory.idempotents.karoubi

namespace category_theory

namespace idempotents

variables {C D : Type*} [category C] [category D]

@[simps]
def whiskering_left_to_karoubi_hom_equiv
  (F G : karoubi C ⥤ D) : (F ⟶ G) ≃ (to_karoubi _ ⋙ F ⟶ to_karoubi _ ⋙ G) :=
{ to_fun := λ φ,
  { app := λ X, φ.app ((to_karoubi C).obj X),
    naturality' := λ X Y f, by simp only [nat_trans.naturality, functor.comp_map], },
  inv_fun := λ ψ,
  { app := λ P, F.map (decomp_id_i P) ≫ (ψ.app P.X) ≫ G.map (decomp_id_p P),
    naturality' := λ P Q f, by {
      slice_lhs 1 2 { rw [← F.map_comp], },
      slice_rhs 3 4 { rw [← G.map_comp], },
      rw [decomp_id_i_naturality, decomp_id_p_naturality,
        F.map_comp, G.map_comp],
      slice_lhs 2 3 { erw ψ.naturality, },
      simp only [assoc],
      refl, }, },
  left_inv := λ φ, by { ext P, exact (nat_trans_eq φ P).symm, },
  right_inv := λ ψ, begin
    ext X,
    dsimp,
    erw [decomp_id_i_to_karoubi, decomp_id_p_to_karoubi,
      F.map_id, G.map_id, comp_id, id_comp],
  end }

lemma whiskering_left_to_karoubi_hom_inv_fun_comp
  {F G H : karoubi C ⥤ D} (φ : to_karoubi _ ⋙ F ⟶ to_karoubi _ ⋙ G)
  (ψ : to_karoubi _ ⋙ G ⟶ to_karoubi _ ⋙  H) :
  (whiskering_left_to_karoubi_hom_equiv F H).inv_fun (φ ≫ ψ) =
  (whiskering_left_to_karoubi_hom_equiv F G).inv_fun φ ≫
  (whiskering_left_to_karoubi_hom_equiv G H).inv_fun ψ :=
begin
  ext P,
  dsimp,
  slice_rhs 3 4 { rw [← G.map_comp, ← decomp_p], },
  erw ψ.naturality P.p,
  slice_rhs 4 5 { erw [← H.map_comp], },
  simp only [assoc],
  congr,
  ext,
  simp only [decomp_id_p_f, comp_f, to_karoubi_map_f, P.idem],
end

lemma whiskering_left_to_karoubi_hom_inv_fun_id
  {F : karoubi C ⥤ D} :
  (whiskering_left_to_karoubi_hom_equiv F F).inv_fun (𝟙 _) = 𝟙 _ :=
begin
  ext P,
  simp only [whiskering_left_to_karoubi_hom_equiv_symm_apply_app, nat_trans.id_app, equiv.inv_fun_as_coe],
  erw [id_comp, ← F.map_comp, ← decomp_id, F.map_id],
end

@[simps]
def whiskering_left_to_karoubi_iso_equiv
  (F G : karoubi C ⥤ D) : (F ≅ G) ≃ (to_karoubi _ ⋙ F ≅ to_karoubi _ ⋙ G) :=
{ to_fun := λ φ,
  { hom := (whiskering_left_to_karoubi_hom_equiv F G).to_fun φ.hom,
    inv := (whiskering_left_to_karoubi_hom_equiv G F).to_fun φ.inv, },
  inv_fun := λ ψ,
  { hom := (whiskering_left_to_karoubi_hom_equiv F G).inv_fun ψ.hom,
    inv := (whiskering_left_to_karoubi_hom_equiv G F).inv_fun ψ.inv,
    hom_inv_id' := by rw [← whiskering_left_to_karoubi_hom_inv_fun_comp, iso.hom_inv_id, whiskering_left_to_karoubi_hom_inv_fun_id],
    inv_hom_id' := by rw [← whiskering_left_to_karoubi_hom_inv_fun_comp, iso.inv_hom_id, whiskering_left_to_karoubi_hom_inv_fun_id], },
  left_inv := λ φ, by { ext P, simp only [equiv.to_fun_as_coe, equiv.symm_apply_apply,
    equiv.inv_fun_as_coe], },
  right_inv := λ ψ, by { ext X, simp only [equiv.to_fun_as_coe, equiv.apply_symm_apply,
    equiv.inv_fun_as_coe], } }

lemma karoubi_universal₁_inverse_preimage (F G : karoubi C ⥤ karoubi D)
  (φ : ((karoubi_universal₁ C D).inverse).obj F ⟶ ((karoubi_universal₁ C D).inverse).obj G) :
  (karoubi_universal₁ C D).inverse.preimage φ = (whiskering_left_to_karoubi_hom_equiv F G).inv_fun φ :=
begin
  apply functor.map_injective (((whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C))),
  erw functor.image_preimage,
  ext1, ext1 X,
  dsimp [decomp_id_i, decomp_id_p],
  erw [F.map_id, G.map_id, id_comp, comp_id],
end

--lemma karoubi_universal'_inverse_preimage_iso (F G : karoubi C ⥤ karoubi D)
--  (e : ((karoubi_universal' C D).inverse).obj F ≅ ((karoubi_universal' C D).inverse).obj G) :
--  preimage_iso e = (whiskering_left_to_karoubi_iso_equiv F G).inv_fun e :=
--by { ext1, exact karoubi_universal'_inverse_preimage F G e.hom, }

lemma whiskering_left_to_karoubi_hom_equiv_inv_fun_compat {F G : karoubi C ⥤ D}
  (ψ : to_karoubi _ ⋙ F ⟶ to_karoubi _ ⋙ G) (X : C) :
  ((whiskering_left_to_karoubi_hom_equiv _ _).inv_fun ψ).app ((to_karoubi _).obj X) = ψ.app X :=
congr_app ((whiskering_left_to_karoubi_hom_equiv _ _).right_inv ψ) X

end idempotents

end category_theory


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.monotonicity.basic
import Mathlib.control.traversable.default
import Mathlib.control.traversable.derive
import Mathlib.Lean3Lib.data.dlist
import Mathlib.PostPort

universes u v u_1 u_2 l

namespace Mathlib

namespace tactic.interactive

/--
`(prefix,left,right,suffix) ← match_assoc unif l r` finds the
longest prefix and suffix common to `l` and `r` and
returns them along with the differences  -/
def apply_rel {α : Sort u} (R : α → α → Sort v) {x : α} {y : α} (x' : α) (y' : α) (h : R x y)
    (hx : x = x') (hy : y = y') : R x' y' :=
  eq.mpr sorry (eq.mpr sorry h)

/-- tactic-facing function, similar to `interactive.tactic.generalize` with the
exception that meta variables -/
def list.minimum_on {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) : List α → List α :=
  sorry

/--
- `mono` applies a monotonicity rule.
- `mono*` applies monotonicity rules repetitively.
- `mono with x ≤ y` or `mono with [0 ≤ x,0 ≤ y]` creates an assertion for the listed
  propositions. Those help to select the right monotonicity rule.
- `mono left` or `mono right` is useful when proving strict orderings:
   for `x + y < w + z` could be broken down into either
    - left:  `x ≤ w` and `y < z` or
    - right: `x < w` and `y ≤ z`
- `mono using [rule1,rule2]` calls `simp [rule1,rule2]` before applying mono.
- The general syntax is `mono '*'? ('with' hyp | 'with' [hyp1,hyp2])? ('using' [hyp1,hyp2])? mono_cfg?

To use it, first import `tactic.monotonicity`.

Here is an example of mono:

```lean
example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y) :
  (k + 3 + x) - y ≤ (k + 4 + x) - z :=
begin
  mono, -- unfold `(-)`, apply add_le_add
  { -- ⊢ k + 3 + x ≤ k + 4 + x
    mono, -- apply add_le_add, refl
    -- ⊢ k + 3 ≤ k + 4
    mono },
  { -- ⊢ -y ≤ -z
    mono /- apply neg_le_neg -/ }
end
```

More succinctly, we can prove the same goal as:

```lean
example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y) :
  (k + 3 + x) - y ≤ (k + 4 + x) - z :=
by mono*
```

-/
/--
transforms a goal of the form `f x ≼ f y` into `x ≤ y` using lemmas
marked as `monotonic`.

Special care is taken when `f` is the repeated application of an
associative operator and if the operator is commutative
-/
/-- (repeat_until_or_at_most n t u): repeat tactic `t` at most n times or until u succeeds -/
inductive rep_arity where
| one : rep_arity
| exactly : ℕ → rep_arity
| many : rep_arity

/--

`ac_mono` reduces the `f x ⊑ f y`, for some relation `⊑` and a
monotonic function `f` to `x ≺ y`.

`ac_mono*` unwraps monotonic functions until it can't.

`ac_mono^k`, for some literal number `k` applies monotonicity `k`
times.

`ac_mono h`, with `h` a hypothesis, unwraps monotonic functions and
uses `h` to solve the remaining goal. Can be combined with `*` or `^k`:
`ac_mono* h`

`ac_mono : p` asserts `p` and uses it to discharge the goal result
unwrapping a series of monotonic functions. Can be combined with * or
^k: `ac_mono* : p`

In the case where `f` is an associative or commutative operator,
`ac_mono` will consider any possible permutation of its arguments and
use the one the minimizes the difference between the left-hand side
and the right-hand side.

To use it, first import `tactic.monotonicity`.

`ac_mono` can be used as follows:

```lean
example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y) :
  (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  -- ⊢ (m + x + n) * z ≤ z * (y + n + m)
  ac_mono,
  -- ⊢ m + x + n ≤ y + n + m
  ac_mono,
end
```

As with `mono*`, `ac_mono*` solves the goal in one go and so does
`ac_mono* h₁`. The latter syntax becomes especially interesting in the
following example:

```lean
example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : m + x + n ≤ y + n + m) :
  (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by ac_mono* h₁.
```

By giving `ac_mono` the assumption `h₁`, we are asking `ac_refl` to
stop earlier than it would normally would.
-/
/-
TODO(Simon): with `ac_mono h` and `ac_mono : p` split the remaining
  gaol if the provided rule does not solve it completely.
-/

end Mathlib


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

The writer monad transformer for passing immutable state.
-/
import algebra.group.defs
import logic.equiv.defs

universes u v w u₀ u₁ v₀ v₁

structure writer_t (ω : Type u) (m : Type u → Type v) (α : Type u) : Type (max u v) :=
(run : m (α × ω))

@[reducible] def writer (ω : Type u) := writer_t ω id

attribute [pp_using_anonymous_constructor] writer_t

namespace writer_t
section
  variable  {ω : Type u}
  variable  {m : Type u → Type v}
  variable  [monad m]
  variables {α β : Type u}
  open function

  @[ext]
  protected

  @[inline] protected def tell (w : ω) : writer_t ω m punit :=
  ⟨pure (punit.star, w)⟩

  @[inline] protected def listen : writer_t ω m α → writer_t ω m (α × ω)
  | ⟨ cmd ⟩ := ⟨ (λ x : α × ω, ((x.1,x.2),x.2)) <$> cmd ⟩

  @[inline] protected def pass : writer_t ω m (α × (ω → ω)) → writer_t ω m α
  | ⟨ cmd ⟩ := ⟨ uncurry (uncurry $ λ x (f : ω → ω) w, (x,f w)) <$> cmd ⟩

  @[inline] protected def pure [has_one ω] (a : α) : writer_t ω m α :=
  ⟨ pure (a,1) ⟩

  @[inline] protected def bind [has_mul ω] (x : writer_t ω m α) (f : α → writer_t ω m β) :
    writer_t ω m β :=
  ⟨ do x  ← x.run,
       x' ← (f x.1).run,
       pure (x'.1,x.2 * x'.2) ⟩

  instance [has_one ω] [has_mul ω] : monad (writer_t ω m) :=
  { pure := λ α, writer_t.pure, bind := λ α β, writer_t.bind }

  instance [monoid ω] [is_lawful_monad m] : is_lawful_monad (writer_t ω m) :=
  { id_map := by { intros, cases x, simp [(<$>),writer_t.bind,writer_t.pure] },
    pure_bind := by { intros, simp [has_pure.pure,writer_t.pure,(>>=),writer_t.bind], ext; refl },
    bind_assoc := by { intros, simp [(>>=),writer_t.bind,mul_assoc] with functor_norm } }

  @[inline] protected def lift [has_one ω] (a : m α) : writer_t ω m α :=
  ⟨ flip prod.mk 1 <$> a ⟩

  instance (m) [monad m] [has_one ω] : has_monad_lift m (writer_t ω m) :=
  ⟨ λ α, writer_t.lift  ⟩

  @[inline] protected def monad_map {m m'} [monad m] [monad m'] {α} (f : Π {α}, m α → m' α) :
    writer_t ω m α → writer_t ω m' α :=
  λ x, ⟨ f x.run ⟩

  instance (m m') [monad m] [monad m'] : monad_functor m m' (writer_t ω m) (writer_t ω m') :=
  ⟨@writer_t.monad_map ω m m' _ _⟩

  @[inline] protected def adapt {ω' : Type u} {α : Type u} (f : ω → ω') :
    writer_t ω m α → writer_t ω' m α :=
  λ x, ⟨prod.map id f <$> x.run⟩

  instance (ε) [has_one ω] [monad m] [monad_except ε m] : monad_except ε (writer_t ω m) :=
  { throw := λ α, writer_t.lift ∘ throw,
    catch := λ α x c, ⟨catch x.run (λ e, (c e).run)⟩ }
end
end writer_t

/--
An implementation of [MonadReader](
https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Reader-Class.html#t:MonadReader).
It does not contain `local` because this function cannot be lifted using `monad_lift`.
Instead, the `monad_reader_adapter` class provides the more general `adapt_reader` function.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader (ρ : out_param (Type u)) (n : Type u → Type u) :=
(lift {α : Type u} : (∀ {m : Type u → Type u} [monad m], reader_t ρ m α) → n α)
```
-/
class monad_writer (ω : out_param (Type u)) (m : Type u → Type v) :=
(tell (w : ω) : m punit)
(listen {α} : m α → m (α × ω))
(pass {α : Type u} : m (α × (ω → ω)) → m α)

export monad_writer

instance {ω : Type u} {m : Type u → Type v} [monad m] : monad_writer ω (writer_t ω m) :=
{ tell := writer_t.tell,
  listen := λ α, writer_t.listen,
  pass := λ α, writer_t.pass }

instance {ω ρ : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (reader_t ρ m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ λ r, listen (cmd r) ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ λ r, pass (cmd r) ⟩ }

def swap_right {α β γ} : (α × β) × γ → (α × γ) × β
| ⟨⟨x,y⟩,z⟩ := ((x,z),y)

instance {ω σ : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (state_t σ m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ λ r, swap_right <$> listen (cmd r) ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ λ r, pass (swap_right <$> cmd r) ⟩ }
open function

def except_t.pass_aux {ε α ω} : except ε (α × (ω → ω)) → except ε α × (ω → ω)
| (except.error a) := (except.error a,id)
| (except.ok (x,y)) := (except.ok x,y)

instance {ω ε : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (except_t ε m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ uncurry (λ x y, flip prod.mk y <$> x) <$> listen cmd ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ pass (except_t.pass_aux <$> cmd) ⟩ }

def option_t.pass_aux {α ω} : option (α × (ω → ω)) → option α × (ω → ω)
| none := (none ,id)
| (some (x,y)) := (some x,y)

instance {ω : Type u} {m : Type u → Type v} [monad m] [monad_writer ω m] :
  monad_writer ω (option_t m) :=
{ tell := λ x, monad_lift (tell x : m punit),
  listen := λ α ⟨ cmd ⟩, ⟨ uncurry (λ x y, flip prod.mk y <$> x) <$> listen cmd ⟩,
  pass := λ α ⟨ cmd ⟩, ⟨ pass (option_t.pass_aux <$> cmd) ⟩ }

/-- Adapt a monad stack, changing the type of its top-most environment.

This class is comparable to
[Control.Lens.Magnify](https://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Zoom.html#t:Magnify),
but does not use lenses (why would it), and is derived automatically for any transformer
implementing `monad_functor`.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader_functor (ρ ρ' : out_param (Type u)) (n n' : Type u → Type u) :=
(map {α : Type u} :
  (∀ {m : Type u → Type u} [monad m], reader_t ρ m α → reader_t ρ' m α) → n α → n' α)
```
-/
class monad_writer_adapter (ω ω' : out_param (Type u)) (m m' : Type u → Type v) :=
(adapt_writer {α : Type u} : (ω → ω') → m α → m' α)
export monad_writer_adapter (adapt_writer)

section
variables {ω ω' : Type u} {m m' : Type u → Type v}

/-- Transitivity.

This instance generates the type-class problem with a metavariable argument (which is why this
is marked as `[nolint dangerous_instance]`).
Currently that is not a problem, as there are almost no instances of `monad_functor` or
`monad_writer_adapter`.

see Note [lower instance priority] -/
@[nolint dangerous_instance, priority 100]
instance monad_writer_adapter_trans {n n' : Type u → Type v} [monad_writer_adapter ω ω' m m']
  [monad_functor m m' n n'] : monad_writer_adapter ω ω' n n' :=
⟨λ α f, monad_map (λ α, (adapt_writer f : m α → m' α))⟩

instance [monad m] : monad_writer_adapter ω ω' (writer_t ω m) (writer_t ω' m) :=
⟨λ α, writer_t.adapt⟩
end

instance (ω : Type u) (m out) [monad_run out m] : monad_run (λ α, out (α × ω)) (writer_t ω m) :=
⟨λ α x, run $ x.run ⟩

/-- reduce the equivalence between two writer monads to the equivalence between
their underlying monad -/
def writer_t.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
  {α₁ ω₁ : Type u₀} {α₂ ω₂ : Type u₁} (F : (m₁ (α₁ × ω₁)) ≃ (m₂ (α₂ × ω₂))) :
  writer_t ω₁ m₁ α₁ ≃ writer_t ω₂ m₂ α₂ :=
{ to_fun := λ ⟨f⟩, ⟨F f⟩,
  inv_fun := λ ⟨f⟩, ⟨F.symm f⟩,
  left_inv := λ ⟨f⟩, congr_arg writer_t.mk $ F.left_inv _,
  right_inv := λ ⟨f⟩, congr_arg writer_t.mk $ F.right_inv _ }


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import algebra.group.pi
import group_theory.group_action.defs

/-!
# Pi instances for multiplicative actions

This file defines instances for mul_action and related structures on Pi types.

## See also

* `group_theory.group_action.prod`
* `group_theory.group_action.sigma`
* `group_theory.group_action.sum`
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi

@[to_additive pi.has_vadd]
instance has_smul {α : Type*} [Π i, has_smul α $ f i] :
  has_smul α (Π i : I, f i) :=
⟨λ s x, λ i, s • (x i)⟩

@[to_additive]
lemma smul_def {α : Type*} [Π i, has_smul α $ f i] (s : α) : s • x = λ i, s • x i := rfl
@[simp, to_additive]
lemma smul_apply {α : Type*} [Π i, has_smul α $ f i] (s : α) : (s • x) i = s • x i := rfl

@[to_additive pi.has_vadd']
instance has_smul' {g : I → Type*} [Π i, has_smul (f i) (g i)] :
  has_smul (Π i, f i) (Π i : I, g i) :=
⟨λ s x, λ i, (s i) • (x i)⟩

@[simp, to_additive]
lemma smul_apply' {g : I → Type*} [∀ i, has_smul (f i) (g i)] (s : Π i, f i) (x : Π i, g i) :
  (s • x) i = s i • x i :=
rfl
instance is_scalar_tower {α β : Type*}
  [has_smul α β] [Π i, has_smul β $ f i] [Π i, has_smul α $ f i]
  [Π i, is_scalar_tower α β (f i)] : is_scalar_tower α β (Π i : I, f i) :=
⟨λ x y z, funext $ λ i, smul_assoc x y (z i)⟩

instance is_scalar_tower' {g : I → Type*} {α : Type*}
  [Π i, has_smul α $ f i] [Π i, has_smul (f i) (g i)] [Π i, has_smul α $ g i]
  [Π i, is_scalar_tower α (f i) (g i)] : is_scalar_tower α (Π i : I, f i) (Π i : I, g i) :=
⟨λ x y z, funext $ λ i, smul_assoc x (y i) (z i)⟩

instance is_scalar_tower'' {g : I → Type*} {h : I → Type*}
  [Π i, has_smul (f i) (g i)] [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
  [Π i, is_scalar_tower (f i) (g i) (h i)] : is_scalar_tower (Π i, f i) (Π i, g i) (Π i, h i) :=
⟨λ x y z, funext $ λ i, smul_assoc (x i) (y i) (z i)⟩

@[to_additive]
instance smul_comm_class {α β : Type*}
  [Π i, has_smul α $ f i] [Π i, has_smul β $ f i] [∀ i, smul_comm_class α β (f i)] :
  smul_comm_class α β (Π i : I, f i) :=
⟨λ x y z, funext $ λ i, smul_comm x y (z i)⟩

@[to_additive]
instance smul_comm_class' {g : I → Type*} {α : Type*}
  [Π i, has_smul α $ g i] [Π i, has_smul (f i) (g i)] [∀ i, smul_comm_class α (f i) (g i)] :
  smul_comm_class α (Π i : I, f i) (Π i : I, g i) :=
⟨λ x y z, funext $ λ i, smul_comm x (y i) (z i)⟩

@[to_additive]
instance smul_comm_class'' {g : I → Type*} {h : I → Type*}
  [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
  [∀ i, smul_comm_class (f i) (g i) (h i)] : smul_comm_class (Π i, f i) (Π i, g i) (Π i, h i) :=
⟨λ x y z, funext $ λ i, smul_comm (x i) (y i) (z i)⟩

instance {α : Type*} [Π i, has_smul α $ f i] [Π i, has_smul αᵐᵒᵖ $ f i]
  [∀ i, is_central_scalar α (f i)] : is_central_scalar α (Π i, f i) :=
⟨λ r m, funext $ λ i, op_smul_eq_smul _ _⟩

/-- If `f i` has a faithful scalar action for a given `i`, then so does `Π i, f i`. This is
not an instance as `i` cannot be inferred. -/
@[to_additive pi.has_faithful_vadd_at]
lemma has_faithful_smul_at {α : Type*}
  [Π i, has_smul α $ f i] [Π i, nonempty (f i)] (i : I) [has_faithful_smul α (f i)] :
  has_faithful_smul α (Π i, f i) :=
⟨λ x y h, eq_of_smul_eq_smul $ λ a : f i, begin
  classical,
  have := congr_fun (h $ function.update (λ j, classical.choice (‹Π i, nonempty (f i)› j)) i a) i,
  simpa using this,
end⟩

@[to_additive pi.has_faithful_vadd]
instance has_faithful_smul {α : Type*}
  [nonempty I] [Π i, has_smul α $ f i] [Π i, nonempty (f i)] [Π i, has_faithful_smul α (f i)] :
  has_faithful_smul α (Π i, f i) :=
let ⟨i⟩ := ‹nonempty I› in has_faithful_smul_at i

@[to_additive]
instance mul_action (α) {m : monoid α} [Π i, mul_action α $ f i] :
  @mul_action α (Π i : I, f i) m :=
{ smul := (•),
  mul_smul := λ r s f, funext $ λ i, mul_smul _ _ _,
  one_smul := λ f, funext $ λ i, one_smul α _ }

@[to_additive]
instance mul_action' {g : I → Type*} {m : Π i, monoid (f i)} [Π i, mul_action (f i) (g i)] :
  @mul_action (Π i, f i) (Π i : I, g i) (@pi.monoid I f m) :=
{ smul := (•),
  mul_smul := λ r s f, funext $ λ i, mul_smul _ _ _,
  one_smul := λ f, funext $ λ i, one_smul _ _ }

instance distrib_mul_action (α) {m : monoid α} {n : ∀ i, add_monoid $ f i}
  [∀ i, distrib_mul_action α $ f i] :
  @distrib_mul_action α (Π i : I, f i) m (@pi.add_monoid I f n) :=
{ smul_zero := λ c, funext $ λ i, smul_zero _,
  smul_add := λ c f g, funext $ λ i, smul_add _ _ _,
  ..pi.mul_action _ }

instance distrib_mul_action' {g : I → Type*} {m : Π i, monoid (f i)} {n : Π i, add_monoid $ g i}
  [Π i, distrib_mul_action (f i) (g i)] :
  @distrib_mul_action (Π i, f i) (Π i : I, g i) (@pi.monoid I f m) (@pi.add_monoid I g n) :=
{ smul_add := by { intros, ext x, apply smul_add },
  smul_zero := by { intros, ext x, apply smul_zero } }

lemma single_smul {α} [monoid α] [Π i, add_monoid $ f i]
  [Π i, distrib_mul_action α $ f i] [decidable_eq I] (i : I) (r : α) (x : f i) :
  single i (r • x) = r • single i x :=
single_op (λ i : I, ((•) r : f i → f i)) (λ j, smul_zero _) _ _

/-- A version of `pi.single_smul` for non-dependent functions. It is useful in cases Lean fails
to apply `pi.single_smul`. -/
lemma single_smul' {α β} [monoid α] [add_monoid β]
  [distrib_mul_action α β] [decidable_eq I] (i : I) (r : α) (x : β) :
  single i (r • x) = r • single i x :=
single_smul i r x

lemma single_smul₀ {g : I → Type*} [Π i, monoid_with_zero (f i)] [Π i, add_monoid (g i)]
  [Π i, distrib_mul_action (f i) (g i)] [decidable_eq I] (i : I) (r : f i) (x : g i) :
  single i (r • x) = single i r • single i x :=
single_op₂ (λ i : I, ((•) : f i → g i → g i)) (λ j, smul_zero _) _ _ _

instance mul_distrib_mul_action (α) {m : monoid α} {n : Π i, monoid $ f i}
  [Π i, mul_distrib_mul_action α $ f i] :
  @mul_distrib_mul_action α (Π i : I, f i) m (@pi.monoid I f n) :=
{ smul_one := λ c, funext $ λ i, smul_one _,
  smul_mul := λ c f g, funext $ λ i, smul_mul' _ _ _,
  ..pi.mul_action _ }

instance mul_distrib_mul_action' {g : I → Type*} {m : Π i, monoid (f i)} {n : Π i, monoid $ g i}
  [Π i, mul_distrib_mul_action (f i) (g i)] :
  @mul_distrib_mul_action (Π i, f i) (Π i : I, g i) (@pi.monoid I f m) (@pi.monoid I g n) :=
{ smul_mul := by { intros, ext x, apply smul_mul' },
  smul_one := by { intros, ext x, apply smul_one } }

end pi

namespace function

/-- Non-dependent version of `pi.has_smul`. Lean gets confused by the dependent instance if this
is not present. -/
@[to_additive]
instance has_smul {ι R M : Type*} [has_smul R M] :
  has_smul R (ι → M) :=
pi.has_smul

/-- Non-dependent version of `pi.smul_comm_class`. Lean gets confused by the dependent instance if
this is not present. -/
@[to_additive]
instance smul_comm_class {ι α β M : Type*}
  [has_smul α M] [has_smul β M] [smul_comm_class α β M] :
  smul_comm_class α β (ι → M) :=
pi.smul_comm_class

@[to_additive]
lemma update_smul {α : Type*} [Π i, has_smul α (f i)] [decidable_eq I]
  (c : α) (f₁ : Π i, f i) (i : I) (x₁ : f i) :
  update (c • f₁) i (c • x₁) = c • update f₁ i x₁ :=
funext $ λ j, (apply_update (λ i, (•) c) f₁ i x₁ j).symm

end function

namespace set

@[to_additive]
lemma piecewise_smul {α : Type*} [Π i, has_smul α (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (c : α) (f₁ g₁ : Π i, f i) :
  s.piecewise (c • f₁) (c • g₁) = c • s.piecewise f₁ g₁ :=
s.piecewise_op _ _ (λ _, (•) c)

end set

section extend

@[to_additive] lemma function.extend_smul {R α β γ : Type*} [has_smul R γ]
  (r : R) (f : α → β) (g : α → γ) (e : β → γ) :
  function.extend f (r • g) (r • e) = r • function.extend f g e :=
funext $ λ _, by convert (apply_dite ((•) r) _ _ _).symm

end extend


/-
Copyright (c) 2020 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.string.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Parsers

`parser α` is the type that describes a computation that can ingest a `char_buffer`
and output, if successful, a term of type `α`.
This file expands on the definitions in the core library, proving that all the core library
parsers are `valid`. There are also lemmas on the composability of parsers.

## Main definitions

* `parse_result.pos` : The position of a `char_buffer` at which a `parser α` has finished.
* `parser.valid` : The property that a parser only moves forward within a buffer,
  in both cases of success or failure.

## Implementation details

Lemmas about how parsers are valid are in the `valid` namespace. That allows using projection
notation for shorter term proofs that are parallel to the definitions of the parsers in structure.

-/

/--
For some `parse_result α`, give the position at which the result was provided, in either the
`done` or the `fail` case.
-/
@[simp] def parse_result.pos {α : Type} : parse_result α → ℕ :=
  sorry

namespace parser

/--
A `parser α` is defined to be `valid` if the result `p cb n` it gives,
for some `cb : char_buffer` and `n : ℕ`, (whether `done` or `fail`),
is always at a `parse_result.pos` that is at least `n`. Additionally, if the position of the result
of the parser was within the size of the `cb`, then the input to the parser must have been within
`cb.size` too.
-/
def valid {α : Type} (p : parser α) :=
  ∀ (cb : char_buffer) (n : ℕ),
    n ≤ parse_result.pos (p cb n) ∧ (parse_result.pos (p cb n) ≤ buffer.size cb → n ≤ buffer.size cb)

theorem fail_iff {α : Type} (p : parser α) (cb : char_buffer) (n : ℕ) : (∀ (pos' : ℕ) (result : α), p cb n ≠ parse_result.done pos' result) ↔
  ∃ (pos' : ℕ), ∃ (err : dlist string), p cb n = parse_result.fail pos' err := sorry

theorem success_iff {α : Type} (p : parser α) (cb : char_buffer) (n : ℕ) : (∀ (pos' : ℕ) (err : dlist string), p cb n ≠ parse_result.fail pos' err) ↔
  ∃ (pos' : ℕ), ∃ (result : α), p cb n = parse_result.done pos' result := sorry

theorem decorate_errors_fail {α : Type} {msgs : thunk (List string)} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} (h : p cb n = parse_result.fail n' err) : decorate_errors msgs p cb n = parse_result.fail n (dlist.lazy_of_list fun (_ : Unit) => msgs Unit.unit) := sorry

theorem decorate_errors_success {α : Type} {msgs : thunk (List string)} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} (h : p cb n = parse_result.done n' a) : decorate_errors msgs p cb n = parse_result.done n' a := sorry

theorem decorate_error_fail {α : Type} {msg : thunk string} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} (h : p cb n = parse_result.fail n' err) : decorate_error msg p cb n = parse_result.fail n (dlist.lazy_of_list fun (_ : Unit) => [msg Unit.unit]) :=
  decorate_errors_fail h

theorem decorate_error_success {α : Type} {msg : thunk string} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} (h : p cb n = parse_result.done n' a) : decorate_error msg p cb n = parse_result.done n' a :=
  decorate_errors_success h

@[simp] theorem decorate_errors_eq_done {α : Type} {msgs : thunk (List string)} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} : decorate_errors msgs p cb n = parse_result.done n' a ↔ p cb n = parse_result.done n' a := sorry

@[simp] theorem decorate_error_eq_done {α : Type} {msg : thunk string} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} : decorate_error msg p cb n = parse_result.done n' a ↔ p cb n = parse_result.done n' a :=
  decorate_errors_eq_done

@[simp] theorem decorate_errors_eq_fail {α : Type} {msgs : thunk (List string)} {p : parser α} {cb : char_buffer} {n : ℕ} {err : dlist string} : decorate_errors msgs p cb n = parse_result.fail n err ↔
  (err = dlist.lazy_of_list fun (_ : Unit) => msgs Unit.unit) ∧
    ∃ (np : ℕ), ∃ (err' : dlist string), p cb n = parse_result.fail np err' := sorry

@[simp] theorem decorate_error_eq_fail {α : Type} {msg : thunk string} {p : parser α} {cb : char_buffer} {n : ℕ} {err : dlist string} : decorate_error msg p cb n = parse_result.fail n err ↔
  (err = dlist.lazy_of_list fun (_ : Unit) => [msg Unit.unit]) ∧
    ∃ (np : ℕ), ∃ (err' : dlist string), p cb n = parse_result.fail np err' :=
  decorate_errors_eq_fail

@[simp] theorem return_eq_pure {α : Type} {a : α} : return a = pure a :=
  rfl

theorem pure_eq_done {α : Type} {a : α} : pure a = fun (_x : char_buffer) (n : ℕ) => parse_result.done n a :=
  rfl

@[simp] theorem pure_ne_fail {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {a : α} : pure a cb n ≠ parse_result.fail n' err := sorry

@[simp] theorem bind_eq_bind {α : Type} {β : Type} {p : parser α} (f : α → parser β) : parser.bind p f = p >>= f :=
  rfl

@[simp] theorem bind_eq_done {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → parser β} : bind p f cb n = parse_result.done n' b ↔
  ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ f a cb np = parse_result.done n' b := sorry

@[simp] theorem bind_eq_fail {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {f : α → parser β} : bind p f cb n = parse_result.fail n' err ↔
  p cb n = parse_result.fail n' err ∨
    ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ f a cb np = parse_result.fail n' err := sorry

@[simp] theorem and_then_eq_bind {α : Type} {β : Type} {m : Type → Type} [Monad m] (a : m α) (b : m β) : a >> b =
  do
    a
    b :=
  rfl

theorem and_then_fail {α : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} : has_bind.and_then p (return Unit.unit) cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err := sorry

theorem and_then_success {α : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} : has_bind.and_then p (return Unit.unit) cb n = parse_result.done n' Unit.unit ↔
  ∃ (a : α), p cb n = parse_result.done n' a := sorry

@[simp] theorem map_eq_done {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β} : Functor.map f p cb n = parse_result.done n' b ↔ ∃ (a : α), p cb n = parse_result.done n' a ∧ f a = b := sorry

@[simp] theorem map_eq_fail {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {f : α → β} : Functor.map f p cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err := sorry

@[simp] theorem map_const_eq_done {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {b' : β} : Functor.mapConst b p cb n = parse_result.done n' b' ↔ ∃ (a : α), p cb n = parse_result.done n' a ∧ b = b' := sorry

@[simp] theorem map_const_eq_fail {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {b : β} : Functor.mapConst b p cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err := sorry

theorem map_const_rev_eq_done {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {b' : β} : functor.map_const_rev p b cb n = parse_result.done n' b' ↔ ∃ (a : α), p cb n = parse_result.done n' a ∧ b = b' :=
  map_const_eq_done

theorem map_rev_const_eq_fail {α : Type} {β : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {b : β} : functor.map_const_rev p b cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err :=
  map_const_eq_fail

@[simp] theorem orelse_eq_orelse {α : Type} {p : parser α} {q : parser α} : parser.orelse p q = (p <|> q) :=
  rfl

@[simp] theorem orelse_eq_done {α : Type} {p : parser α} {q : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} : has_orelse.orelse p q cb n = parse_result.done n' a ↔
  p cb n = parse_result.done n' a ∨
    q cb n = parse_result.done n' a ∧ ∃ (err : dlist string), p cb n = parse_result.fail n err := sorry

@[simp] theorem orelse_eq_fail_eq {α : Type} {p : parser α} {q : parser α} {cb : char_buffer} {n : ℕ} {err : dlist string} : has_orelse.orelse p q cb n = parse_result.fail n err ↔
  (p cb n = parse_result.fail n err ∧
      ∃ (nq : ℕ), ∃ (errq : dlist string), n < nq ∧ q cb n = parse_result.fail nq errq) ∨
    ∃ (errp : dlist string),
      ∃ (errq : dlist string),
        p cb n = parse_result.fail n errp ∧ q cb n = parse_result.fail n errq ∧ errp ++ errq = err := sorry

theorem orelse_eq_fail_invalid_lt {α : Type} {p : parser α} {q : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} (hn : n' < n) : has_orelse.orelse p q cb n = parse_result.fail n' err ↔
  p cb n = parse_result.fail n' err ∨
    q cb n = parse_result.fail n' err ∧ ∃ (errp : dlist string), p cb n = parse_result.fail n errp := sorry

theorem orelse_eq_fail_of_valid_ne {α : Type} {p : parser α} {q : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} (hv : valid q) (hn : n ≠ n') : has_orelse.orelse p q cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err := sorry

@[simp] theorem failure_eq_failure {α : Type} : parser.failure = failure :=
  rfl

@[simp] theorem failure_def {α : Type} {cb : char_buffer} {n : ℕ} : failure cb n = parse_result.fail n dlist.empty :=
  rfl

theorem not_failure_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} : ¬failure cb n = parse_result.done n' a := sorry

theorem failure_eq_fail {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} : failure cb n = parse_result.fail n' err ↔ n = n' ∧ err = dlist.empty := sorry

theorem seq_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : parser (α → β)} {p : parser α} : Seq.seq f p cb n = parse_result.done n' b ↔
  ∃ (nf : ℕ), ∃ (f' : α → β), ∃ (a : α), f cb n = parse_result.done nf f' ∧ p cb nf = parse_result.done n' a ∧ f' a = b := sorry

theorem seq_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {f : parser (α → β)} {p : parser α} : Seq.seq f p cb n = parse_result.fail n' err ↔
  f cb n = parse_result.fail n' err ∨
    ∃ (nf : ℕ), ∃ (f' : α → β), f cb n = parse_result.done nf f' ∧ p cb nf = parse_result.fail n' err := sorry

theorem seq_left_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} {p : parser α} {q : parser β} : SeqLeft.seqLeft p q cb n = parse_result.done n' a ↔
  ∃ (np : ℕ), ∃ (b : β), p cb n = parse_result.done np a ∧ q cb np = parse_result.done n' b := sorry

theorem seq_left_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {p : parser α} {q : parser β} : SeqLeft.seqLeft p q cb n = parse_result.fail n' err ↔
  p cb n = parse_result.fail n' err ∨
    ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ q cb np = parse_result.fail n' err := sorry

theorem seq_right_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {p : parser α} {q : parser β} : SeqRight.seqRight p q cb n = parse_result.done n' b ↔
  ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ q cb np = parse_result.done n' b := sorry

theorem seq_right_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {p : parser α} {q : parser β} : SeqRight.seqRight p q cb n = parse_result.fail n' err ↔
  p cb n = parse_result.fail n' err ∨
    ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ q cb np = parse_result.fail n' err := sorry

theorem mmap_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {f : α → parser β} {a : α} {l : List α} {b : β} {l' : List β} : mmap f (a :: l) cb n = parse_result.done n' (b :: l') ↔
  ∃ (np : ℕ), f a cb n = parse_result.done np b ∧ mmap f l cb np = parse_result.done n' l' := sorry

theorem mmap'_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {f : α → parser β} {a : α} {l : List α} : mmap' f (a :: l) cb n = parse_result.done n' Unit.unit ↔
  ∃ (np : ℕ), ∃ (b : β), f a cb n = parse_result.done np b ∧ mmap' f l cb np = parse_result.done n' Unit.unit := sorry

theorem guard_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : Prop} [Decidable p] : guard p cb n = parse_result.done n' Unit.unit ↔ p ∧ n = n' := sorry

theorem guard_eq_fail {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {p : Prop} [Decidable p] : guard p cb n = parse_result.fail n' err ↔ ¬p ∧ n = n' ∧ err = dlist.empty := sorry

namespace valid

theorem mono_done {α : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} (hp : valid p) (h : p cb n = parse_result.done n' a) : n ≤ n' := sorry

theorem mono_fail {α : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} (hp : valid p) (h : p cb n = parse_result.fail n' err) : n ≤ n' := sorry

theorem pure {α : Type} {a : α} : valid (pure a) := sorry

@[simp] theorem bind {α : Type} {β : Type} {p : parser α} {f : α → parser β} (hp : valid p) (hf : ∀ (a : α), valid (f a)) : valid (p >>= f) := sorry

theorem and_then {α : Type} {β : Type} {p : parser α} {q : parser β} (hp : valid p) (hq : valid q) : valid (p >> q) :=
  bind hp fun (_x : α) => hq

@[simp] theorem map {α : Type} {β : Type} {p : parser α} (hp : valid p) {f : α → β} : valid (f <$> p) :=
  bind hp fun (_x : α) => pure

@[simp] theorem seq {α : Type} {β : Type} {p : parser α} {f : parser (α → β)} (hf : valid f) (hp : valid p) : valid (f <*> p) :=
  bind hf fun (_x : α → β) => map hp

@[simp] theorem mmap {α : Type} {β : Type} {l : List α} {f : α → parser β} (h : ∀ (a : α), a ∈ l → valid (f a)) : valid (mmap f l) := sorry

@[simp] theorem mmap' {α : Type} {β : Type} {l : List α} {f : α → parser β} (h : ∀ (a : α), a ∈ l → valid (f a)) : valid (mmap' f l) := sorry

@[simp] theorem failure {α : Type} : valid failure := sorry

@[simp] theorem guard {p : Prop} [Decidable p] : valid (guard p) := sorry

@[simp] theorem orelse {α : Type} {p : parser α} {q : parser α} (hp : valid p) (hq : valid q) : valid (p <|> q) := sorry

@[simp] theorem decorate_errors {α : Type} {msgs : thunk (List string)} {p : parser α} (hp : valid p) : valid (decorate_errors msgs p) := sorry

@[simp] theorem decorate_error {α : Type} {msg : thunk string} {p : parser α} (hp : valid p) : valid (decorate_error msg p) :=
  decorate_errors hp

@[simp] theorem any_char : valid any_char := sorry

@[simp] theorem sat {p : char → Prop} [decidable_pred p] : valid (sat p) := sorry

@[simp] theorem eps : valid eps :=
  pure

theorem ch {c : char} : valid (ch c) :=
  decorate_error (and_then sat eps)

theorem char_buf {s : char_buffer} : valid (char_buf s) :=
  decorate_error (mmap' fun (_x : char) (_x_1 : _x ∈ buffer.to_list s) => ch)

theorem one_of {cs : List char} : valid (one_of cs) :=
  decorate_errors sat

theorem one_of' {cs : List char} : valid (one_of' cs) :=
  and_then one_of eps

theorem str {s : string} : valid (str s) :=
  decorate_error (mmap' fun (_x : char) (_x_1 : _x ∈ string.to_list s) => ch)

theorem remaining : valid remaining :=
  fun (_x : char_buffer) (_x_1 : ℕ) =>
    { left := le_refl _x_1, right := fun (h : parse_result.pos (remaining _x _x_1) ≤ buffer.size _x) => h }

theorem eof : valid eof :=
  decorate_error (bind remaining fun (_x : ℕ) => guard)

theorem foldr_core_zero {α : Type} {β : Type} {p : parser α} {f : α → β → β} {b : β} : valid (foldr_core f p b 0) :=
  failure

theorem foldr_core {α : Type} {β : Type} {p : parser α} {f : α → β → β} {b : β} (hp : valid p) {reps : ℕ} : valid (foldr_core f p b reps) := sorry

theorem foldr {α : Type} {β : Type} {p : parser α} {b : β} {f : α → β → β} (hp : valid p) : valid (foldr f p b) :=
  fun (_x : char_buffer) (_x_1 : ℕ) => foldr_core hp _x _x_1

theorem foldl_core_zero {α : Type} {β : Type} {p : parser α} {f : β → α → β} {b : β} : valid (foldl_core f b p 0) :=
  failure

theorem foldl_core {α : Type} {β : Type} {f : α → β → α} {p : parser β} (hp : valid p) {a : α} {reps : ℕ} : valid (foldl_core f a p reps) := sorry

theorem foldl {α : Type} {β : Type} {a : α} {f : α → β → α} {p : parser β} (hp : valid p) : valid (foldl f a p) :=
  fun (_x : char_buffer) (_x_1 : ℕ) => foldl_core hp _x _x_1

theorem many {α : Type} {p : parser α} (hp : valid p) : valid (many p) :=
  foldr hp

theorem many_char {p : parser char} (hp : valid p) : valid (many_char p) :=
  map (many hp)

theorem many' {α : Type} {p : parser α} (hp : valid p) : valid (many' p) :=
  and_then (many hp) eps

theorem many1 {α : Type} {p : parser α} (hp : valid p) : valid (many1 p) :=
  seq (map hp) (many hp)

theorem many_char1 {p : parser char} (hp : valid p) : valid (many_char1 p) :=
  map (many1 hp)

theorem sep_by1 {α : Type} {p : parser α} {sep : parser Unit} (hp : valid p) (hs : valid sep) : valid (sep_by1 sep p) :=
  seq (map hp) (many (and_then hs hp))

theorem sep_by {α : Type} {p : parser α} {sep : parser Unit} (hp : valid p) (hs : valid sep) : valid (sep_by sep p) :=
  orelse (sep_by1 hp hs) pure

theorem fix_core {α : Type} {F : parser α → parser α} (hF : ∀ (p : parser α), valid p → valid (F p)) (max_depth : ℕ) : valid (fix_core F max_depth) := sorry

theorem digit : valid digit :=
  decorate_error (bind sat fun (_x : char) => pure)

theorem nat : valid nat :=
  decorate_error (bind (many1 digit) fun (_x : List ℕ) => pure)

theorem fix {α : Type} {F : parser α → parser α} (hF : ∀ (p : parser α), valid p → valid (F p)) : valid (fix F) :=
  fun (_x : char_buffer) (_x_1 : ℕ) => fix_core hF (buffer.size _x - _x_1 + 1) _x _x_1

end valid

@[simp] theorem orelse_pure_eq_fail {α : Type} {p : parser α} {cb : char_buffer} {n : ℕ} {n' : ℕ} {err : dlist string} {a : α} : has_orelse.orelse p (pure a) cb n = parse_result.fail n' err ↔ p cb n = parse_result.fail n' err ∧ n ≠ n' := sorry

theorem any_char_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {c : char} : any_char cb n = parse_result.done n' c ↔ n' = n + 1 ∧ buffer.read cb { val := n, property := hn } = c := sorry

theorem sat_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {c : char} {p : char → Prop} [decidable_pred p] : sat p cb n = parse_result.done n' c ↔ p c ∧ n' = n + 1 ∧ buffer.read cb { val := n, property := hn } = c := sorry

theorem eps_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} : eps cb n = parse_result.done n' Unit.unit ↔ n = n' := sorry

theorem ch_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {c : char} : ch c cb n = parse_result.done n' Unit.unit ↔ n' = n + 1 ∧ buffer.read cb { val := n, property := hn } = c := sorry

-- TODO: add char_buf_eq_done, needs lemmas about matching buffers

theorem one_of_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {c : char} {cs : List char} : one_of cs cb n = parse_result.done n' c ↔ c ∈ cs ∧ n' = n + 1 ∧ buffer.read cb { val := n, property := hn } = c := sorry

theorem one_of'_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {cs : List char} : one_of' cs cb n = parse_result.done n' Unit.unit ↔ buffer.read cb { val := n, property := hn } ∈ cs ∧ n' = n + 1 := sorry

theorem remaining_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} {r : ℕ} : remaining cb n = parse_result.done n' r ↔ n = n' ∧ buffer.size cb - n = r := sorry

theorem eof_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} : eof cb n = parse_result.done n' Unit.unit ↔ n = n' ∧ buffer.size cb ≤ n := sorry

@[simp] theorem foldr_core_zero_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {b' : β} : foldr_core f p b 0 cb n ≠ parse_result.done n' b' := sorry

theorem foldr_core_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {reps : ℕ} {b' : β} : foldr_core f p b (reps + 1) cb n = parse_result.done n' b' ↔
  (∃ (np : ℕ),
      ∃ (a : α),
        ∃ (xs : β),
          p cb n = parse_result.done np a ∧ foldr_core f p b reps cb np = parse_result.done n' xs ∧ f a xs = b') ∨
    n = n' ∧
      b = b' ∧
        ∃ (err : dlist string),
          p cb n = parse_result.fail n err ∨
            ∃ (np : ℕ),
              ∃ (a : α), p cb n = parse_result.done np a ∧ foldr_core f p b reps cb np = parse_result.fail n err := sorry

@[simp] theorem foldr_core_zero_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {err : dlist string} : foldr_core f p b 0 cb n = parse_result.fail n' err ↔ n = n' ∧ err = dlist.empty := sorry

theorem foldr_core_succ_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {reps : ℕ} {err : dlist string} : foldr_core f p b (reps + 1) cb n = parse_result.fail n' err ↔
  n ≠ n' ∧
    (p cb n = parse_result.fail n' err ∨
      ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ foldr_core f p b reps cb np = parse_result.fail n' err) := sorry

theorem foldr_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {b' : β} : foldr f p b cb n = parse_result.done n' b' ↔
  (∃ (np : ℕ),
      ∃ (a : α),
        ∃ (x : β),
          p cb n = parse_result.done np a ∧
            foldr_core f p b (buffer.size cb - n) cb np = parse_result.done n' x ∧ f a x = b') ∨
    n = n' ∧
      b = b' ∧
        ∃ (err : dlist string),
          p cb n = parse_result.fail n err ∨
            ∃ (np : ℕ),
              ∃ (x : α),
                p cb n = parse_result.done np x ∧ foldr_core f p b (buffer.size cb - n) cb np = parse_result.fail n err := sorry

theorem foldr_eq_fail_of_valid_at_end {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {err : dlist string} (hp : valid p) (hc : buffer.size cb ≤ n) : foldr f p b cb n = parse_result.fail n' err ↔
  n < n' ∧ (p cb n = parse_result.fail n' err ∨ ∃ (a : α), p cb n = parse_result.done n' a ∧ err = dlist.empty) := sorry

theorem foldr_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : α → β → β} {p : parser α} {err : dlist string} : foldr f p b cb n = parse_result.fail n' err ↔
  n ≠ n' ∧
    (p cb n = parse_result.fail n' err ∨
      ∃ (np : ℕ),
        ∃ (a : α),
          p cb n = parse_result.done np a ∧ foldr_core f p b (buffer.size cb - n) cb np = parse_result.fail n' err) := sorry

@[simp] theorem foldl_core_zero_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {b' : β} : foldl_core f b p 0 cb n = parse_result.done n' b' ↔ False := sorry

theorem foldl_core_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {reps : ℕ} {b' : β} : foldl_core f b p (reps + 1) cb n = parse_result.done n' b' ↔
  (∃ (np : ℕ),
      ∃ (a : α), p cb n = parse_result.done np a ∧ foldl_core f (f b a) p reps cb np = parse_result.done n' b') ∨
    n = n' ∧
      b = b' ∧
        ∃ (err : dlist string),
          p cb n = parse_result.fail n err ∨
            ∃ (np : ℕ),
              ∃ (a : α), p cb n = parse_result.done np a ∧ foldl_core f (f b a) p reps cb np = parse_result.fail n err := sorry

@[simp] theorem foldl_core_zero_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {err : dlist string} : foldl_core f b p 0 cb n = parse_result.fail n' err ↔ n = n' ∧ err = dlist.empty := sorry

theorem foldl_core_succ_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {reps : ℕ} {err : dlist string} : foldl_core f b p (reps + 1) cb n = parse_result.fail n' err ↔
  n ≠ n' ∧
    (p cb n = parse_result.fail n' err ∨
      ∃ (np : ℕ),
        ∃ (a : α), p cb n = parse_result.done np a ∧ foldl_core f (f b a) p reps cb np = parse_result.fail n' err) := sorry

theorem foldl_eq_done {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {b' : β} : foldl f b p cb n = parse_result.done n' b' ↔
  (∃ (np : ℕ),
      ∃ (a : α),
        p cb n = parse_result.done np a ∧ foldl_core f (f b a) p (buffer.size cb - n) cb np = parse_result.done n' b') ∨
    n = n' ∧
      b = b' ∧
        ∃ (err : dlist string),
          p cb n = parse_result.fail n err ∨
            ∃ (np : ℕ),
              ∃ (a : α),
                p cb n = parse_result.done np a ∧
                  foldl_core f (f b a) p (buffer.size cb - n) cb np = parse_result.fail n err := sorry

theorem foldl_eq_fail {α : Type} {β : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {b : β} {f : β → α → β} {p : parser α} {err : dlist string} : foldl f b p cb n = parse_result.fail n' err ↔
  n ≠ n' ∧
    (p cb n = parse_result.fail n' err ∨
      ∃ (np : ℕ),
        ∃ (a : α),
          p cb n = parse_result.done np a ∧
            foldl_core f (f b a) p (buffer.size cb - n) cb np = parse_result.fail n' err) := sorry

theorem many_eq_done_nil {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} : many p cb n = parse_result.done n' [] ↔
  n = n' ∧
    ∃ (err : dlist string),
      p cb n = parse_result.fail n err ∨
        ∃ (np : ℕ),
          ∃ (a : α),
            p cb n = parse_result.done np a ∧
              foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.fail n err := sorry

theorem many_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} {x : α} {xs : List α} : many p cb n = parse_result.done n' (x :: xs) ↔
  ∃ (np : ℕ),
    p cb n = parse_result.done np x ∧ foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.done n' xs := sorry

theorem many_eq_fail {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} {err : dlist string} : many p cb n = parse_result.fail n' err ↔
  n ≠ n' ∧
    (p cb n = parse_result.fail n' err ∨
      ∃ (np : ℕ),
        ∃ (a : α),
          p cb n = parse_result.done np a ∧
            foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.fail n' err) := sorry

theorem many_char_eq_done_empty {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser char} : many_char p cb n = parse_result.done n' string.empty ↔
  n = n' ∧
    ∃ (err : dlist string),
      p cb n = parse_result.fail n err ∨
        ∃ (np : ℕ),
          ∃ (c : char),
            p cb n = parse_result.done np c ∧
              foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.fail n err := sorry

theorem many_char_eq_done_not_empty {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser char} {s : string} (h : s ≠ string.empty) : many_char p cb n = parse_result.done n' s ↔
  ∃ (np : ℕ),
    p cb n = parse_result.done np (string.head s) ∧
      foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.done n' (string.to_list (string.popn s 1)) := sorry

theorem many_char_eq_many_of_to_list {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser char} {s : string} : many_char p cb n = parse_result.done n' s ↔ many p cb n = parse_result.done n' (string.to_list s) := sorry

theorem many'_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} : many' p cb n = parse_result.done n' Unit.unit ↔
  many p cb n = parse_result.done n' [] ∨
    ∃ (np : ℕ),
      ∃ (a : α),
        ∃ (l : List α),
          many p cb n = parse_result.done n' (a :: l) ∧
            p cb n = parse_result.done np a ∧
              foldr_core List.cons p [] (buffer.size cb - n) cb np = parse_result.done n' l := sorry

@[simp] theorem many1_ne_done_nil {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} : many1 p cb n ≠ parse_result.done n' [] := sorry

theorem many1_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} {p : parser α} {l : List α} : many1 p cb n = parse_result.done n' (a :: l) ↔
  ∃ (np : ℕ), p cb n = parse_result.done np a ∧ many p cb np = parse_result.done n' l := sorry

theorem many1_eq_fail {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser α} {err : dlist string} : many1 p cb n = parse_result.fail n' err ↔
  p cb n = parse_result.fail n' err ∨
    ∃ (np : ℕ), ∃ (a : α), p cb n = parse_result.done np a ∧ many p cb np = parse_result.fail n' err := sorry

@[simp] theorem many_char1_ne_empty {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser char} : many_char1 p cb n ≠ parse_result.done n' string.empty := sorry

theorem many_char1_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} {p : parser char} {s : string} (h : s ≠ string.empty) : many_char1 p cb n = parse_result.done n' s ↔
  ∃ (np : ℕ), p cb n = parse_result.done np (string.head s) ∧ many_char p cb np = parse_result.done n' (string.popn s 1) := sorry

@[simp] theorem sep_by1_ne_done_nil {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {sep : parser Unit} {p : parser α} : sep_by1 sep p cb n ≠ parse_result.done n' [] := sorry

theorem sep_by1_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} {sep : parser Unit} {p : parser α} {l : List α} : sep_by1 sep p cb n = parse_result.done n' (a :: l) ↔
  ∃ (np : ℕ), p cb n = parse_result.done np a ∧ many (sep >> p) cb np = parse_result.done n' l := sorry

theorem sep_by_eq_done_nil {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {sep : parser Unit} {p : parser α} : sep_by sep p cb n = parse_result.done n' [] ↔
  n = n' ∧ ∃ (err : dlist string), sep_by1 sep p cb n = parse_result.fail n err := sorry

@[simp] theorem fix_core_ne_done_zero {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} {F : parser α → parser α} : fix_core F 0 cb n ≠ parse_result.done n' a := sorry

theorem fix_core_eq_done {α : Type} {cb : char_buffer} {n : ℕ} {n' : ℕ} {a : α} {F : parser α → parser α} {max_depth : ℕ} : fix_core F (max_depth + 1) cb n = parse_result.done n' a ↔ F (fix_core F max_depth) cb n = parse_result.done n' a := sorry

theorem digit_eq_done {cb : char_buffer} {n : ℕ} {n' : ℕ} (hn : n < buffer.size cb) {k : ℕ} : digit cb n = parse_result.done n' k ↔
  n' = n + 1 ∧
    k ≤ bit1 (bit0 (bit0 1)) ∧
      char.to_nat (buffer.read cb { val := n, property := hn }) -
            char.to_nat (char.of_nat (bit0 (bit0 (bit0 (bit0 (bit1 1)))))) =
          k ∧
        char.of_nat (bit0 (bit0 (bit0 (bit0 (bit1 1))))) ≤ buffer.read cb { val := n, property := hn } ∧
          buffer.read cb { val := n, property := hn } ≤ char.of_nat (bit1 (bit0 (bit0 (bit1 (bit1 1))))) := sorry


import tactic --hide

/-Lemma
If $P,Q$ are logical statements with respective proofs $p,q$, then $Q$ is true.
-/
lemma example_two (P Q : Prop) (p : P) (q : Q) : Q :=
begin
  exact q,

end


/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Tactic.Rewrite
import Lean.Elab.PreDefinition.Basic
import Lean.Elab.PreDefinition.Eqns

namespace Lean.Elab.WF
open Meta
open Eqns

structure EqnInfo extends EqnInfoCore where
  declNames      : Array Name
  declNameNonRec : Name
  deriving Inhabited

private partial def deltaLHSUntilFix (mvarId : MVarId) : MetaM MVarId := withMVarContext mvarId do
  let target ← getMVarType' mvarId
  let some (_, lhs, rhs) := target.eq? | throwTacticEx `deltaLHSUntilFix mvarId "equality expected"
  if lhs.isAppOf ``WellFounded.fix then
    return mvarId
  else
    deltaLHSUntilFix (← deltaLHS mvarId)

private def rwFixEq (mvarId : MVarId) : MetaM MVarId := withMVarContext mvarId do
  let target ← getMVarType' mvarId
  let some (_, lhs, rhs) := target.eq? | unreachable!
  let h := mkAppN (mkConst ``WellFounded.fix_eq lhs.getAppFn.constLevels!) lhs.getAppArgs
  let r ← rewrite mvarId target h
  replaceTargetEq mvarId r.eNew r.eqProof

private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
  trace[Elab.definition.wf.eqns] "proving: {type}"
  withNewMCtxDepth do
    let main ← mkFreshExprSyntheticOpaqueMVar type
    let (_, mvarId) ← intros main.mvarId!
    go (← rwFixEq (← deltaLHSUntilFix mvarId))
    instantiateMVars main
where
  go (mvarId : MVarId) : MetaM Unit := do
    trace[Elab.definition.wf.eqns] "step\n{MessageData.ofGoal mvarId}"
    if (← tryURefl mvarId) then
      return ()
    else if (← tryContradiction mvarId) then
      return ()
    else if let some mvarId ← simpMatch? mvarId then
      go mvarId
    else if let some mvarId ← simpIf? mvarId then
      go mvarId
    else if let some mvarId ← whnfReducibleLHS? mvarId then
      go mvarId
    else if let some mvarIds ← casesOnStuckLHS? mvarId then
      mvarIds.forM go
    else
      throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"

def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
  withOptions (tactic.hygienic.set . false) do
  let baseName := mkPrivateName (← getEnv) declName
  let eqnTypes ← withNewMCtxDepth <| lambdaTelescope info.value fun xs body => do
    let us := info.levelParams.map mkLevelParam
    let target ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
    let goal ← mkFreshExprSyntheticOpaqueMVar target
    mkEqnTypes info.declNames goal.mvarId!
  let mut thmNames := #[]
  for i in [: eqnTypes.size] do
    let type := eqnTypes[i]
    trace[Elab.definition.wf.eqns] "{eqnTypes[i]}"
    let name := baseName ++ (`_eq).appendIndexAfter (i+1)
    thmNames := thmNames.push name
    let value ← mkProof declName type
    addDecl <| Declaration.thmDecl {
      name, type, value
      levelParams := info.levelParams
    }
  return thmNames

builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension `wfEqInfo

def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) : CoreM Unit := do
  let declNames := preDefs.map (·.declName)
  modifyEnv fun env =>
    preDefs.foldl (init := env) fun env preDef =>
      eqnInfoExt.insert env preDef.declName { preDef with declNames, declNameNonRec }

def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
  let env ← getEnv
  if let some eqs := eqnsExt.getState env |>.map.find? declName then
    return some eqs
  else if let some info := eqnInfoExt.find? env declName then
    let eqs ← mkEqns declName info
    modifyEnv fun env => eqnsExt.modifyState env fun s => { s with map := s.map.insert declName eqs }
    return some eqs
  else
    return none

def getUnfoldFor? (declName : Name) : MetaM (Option Name) := do
  let env ← getEnv
  Eqns.getUnfoldFor? declName fun _ => eqnInfoExt.find? env declName |>.map (·.toEqnInfoCore)

builtin_initialize
  registerGetEqnsFn getEqnsFor?
  registerGetUnfoldEqnFn getUnfoldFor?
  registerTraceClass `Elab.definition.wf.eqns

end Lean.Elab.WF


import Lean
import Duper.TPTPParser.SyntaxDecl

open Lean
open Lean.Parser
open TSyntax.Compat

namespace TPTP

def explicitBinder : Parser := Term.explicitBinder false

axiom iota : Type
private axiom iotaInhabited : iota
noncomputable instance : Inhabited iota := ⟨iotaInhabited⟩

def processThfDefinedType (ty : Syntax) : MacroM Syntax := do
  match ty with
  | `(defined_type|🍉$id) =>
    match id.getId with
    | `i => `(TPTP.iota)
    | `o => `(Prop)
    | `tType => `(Type)
    | _ => Macro.throwError s!"Unsupported thf_defined_type: {ty}"
  | _ => Macro.throwError s!"{ty} is not a defined type"

def processThfDefinedTerm (term : Syntax) : MacroM Syntax := do
  match term with
  | `(defined_term|🍉$id) =>
    match id.getId with
    | `true => `(True)
    | `false => `(False)
    | _ => Macro.throwError s!"Unsupported thf_defined_term: {term}"
  | _ => Macro.throwError s!"{term} is not a defined term"

partial def processThfAtomicType (stx : Syntax) : MacroM Syntax := do
  match stx with
  | `(thf_type| $ty:thf_atomic_type) => processThfAtomicType ty
  | `(thf_atomic_type| $ty:ident) => pure ty
  | `(thf_atomic_type| $ty:defined_type) => processThfDefinedType ty
  | `(thf_atomic_type| $f:ident $args:thf_type_arguments) => do
    let ts ←
      pure $ ← ((@Syntax.SepArray.mk "," args.raw[1].getArgs) : Array Syntax).mapM
                fun arg => processThfAtomicType arg
    let ts := mkNode ``many ts
    let ts := mkNode ``Term.app #[f, ts]
    `($ts)
  | _ => Macro.throwError s!"Unsupported thf_atomic_type: {stx}"

/-- In addition to returning the syntax that corresponds to the type of `stx`, if the
    type of `stx` is `Type` or has the form `A → B → ... → Type`, then we also return
    an Array containing the stx for `A`, `B`, etc. (in reverse order. So `A → B → Type` would
    have the stx array #[B, A]) This is so that we can add the appropriate `Inhabited` constraints
    to the newly declared type. -/
partial def processThfType (stx : Syntax) : MacroM (Syntax × Option (Array Syntax)) := do
  match stx with
  | `(thf_type| ( $t:thf_type ) ) => processThfType t
  | `(thf_type| $ty:thf_atomic_type) =>
    let res ← processThfAtomicType ty
    let typeStx ← `(Type)
    if res == typeStx then return (res, some #[])
    else return (res, none)
  | `(thf_type| $arg:thf_type > $ret:thf_type) =>
    -- Although the current parser syntax has thf_type > thf_type, this pattern should
    -- only appear in TPTP files when both arg and ret are of the category thf_atomic_type
    let (ret, stxListOpt) ← processThfType ret
    let (arg, _) ← processThfType arg
    let res ← `($arg → $ret)
    match stxListOpt with
    | none => return (res, none)
    | some stxList => return (res, some (stxList.push arg))
  | `(thf_type| ( $args:thf_xprod_args ) > $ret:thf_atomic_type) =>
    let ret ← processThfAtomicType ret
    let args : Array Syntax := @Syntax.SepArray.mk "*" args.raw[0].getArgs
    let args ← args.mapM (fun a => processThfAtomicType a)
    let res ← args.foldrM (fun (a acc : Syntax) => `($a → $acc)) ret
    let typeStx ← `(Type)
    if ret == typeStx then return (res, some args.reverse)
    else return (res, none)
  | `(thf_type| $q:th1_quantifier [ $vs,* ] : $ty) =>
    let (ty, _) ← processThfType ty
    let vs : Array Syntax := vs
    let res ← vs.foldrM
      fun v acc => do
        let (v, v_ty) ← match v with
        | `(thf_variable| $v:ident) =>
          -- throw Error?
          pure (v, (← `(_) : Syntax))
        | `(thf_variable| $v:ident : $v_ty:thf_type) =>
          pure (v, (← processThfType v_ty).1)
        | _ => Macro.throwError s!"Unsupported thf_variable: {v} when trying to process a tf1_quantified_type"
        match q.raw[0].getKind with
        | Name.str _ "!>" => `(∀ ($v : $v_ty), $acc)
        | _ => Macro.throwError s!"Unsupported th1_quantifier: {q.raw[0].getKind}"
      ty
    return (res, none)
  | _ => Macro.throwError s!"Unsupported thf_type: {stx}"

partial def processThfTerm (stx : Syntax) (is_untyped : Bool) : MacroM Syntax := do
  match stx with
  | `(thf_term| $d:defined_term) => processThfDefinedTerm d
  | `(thf_term| ( $t:thf_term ) ) => processThfTerm t is_untyped
  | `(thf_term| ~ $t:thf_term ) =>
    let t ← processThfTerm t is_untyped
    `(¬ $t)
  | `(thf_term| $t₁:thf_term @ $t₂:thf_term) => do
    let t₁ ← processThfTerm t₁ is_untyped
    let t₂ ← processThfTerm t₂ is_untyped
    `(($t₁ $t₂))
  | `(thf_term| $t₁:thf_term $conn:bexpOp $t₂:thf_term ) => do
    let t₁ ← processThfTerm t₁ is_untyped
    let t₂ ← processThfTerm t₂ is_untyped
    match conn.raw[0].getKind with
    | Name.str _ "&" => `($t₁ ∧ $t₂)
    | Name.str _ "=>" => `($t₁ → $t₂)
    | Name.str _ "|"=> `($t₁ ∨ $t₂)
    | Name.str _ "<=>" => `($t₁ ↔ $t₂)
    | Name.str _ "<~>" => `(¬ ($t₁ ↔ $t₂))
    | Name.str _ "~|" => `(¬ ($t₁ ∨ $t₂))
    | Name.str _ "~&" => `(¬ ($t₁ ∧ $t₂))
    | _ => Macro.throwError s!"Unsupported bexpOp: {conn.raw[0].getKind}"
  | `(thf_term| $t₁:thf_term $conn:eqOp $t₂:thf_term ) => do
    let t₁ ← processThfTerm t₁ is_untyped
    let t₂ ← processThfTerm t₂ is_untyped
    match conn.raw[0].getKind with
    | Name.str _ "=" => `($t₁ = $t₂)
    | Name.str _ "!=" => `($t₁ ≠ $t₂)
    | _ => Macro.throwError s!"Unsupported eqOp: {conn.raw[0].getKind}"
  | `(thf_term| $f:ident $args:thf_arguments ?) => do
    let ts : Array Syntax ← match args with
    | some args =>
      ((@Syntax.SepArray.mk "," args.raw[1].getArgs) : Array Syntax).mapM
          fun arg => processThfTerm arg is_untyped
    | none => pure #[]
    let ts := mkNode ``many ts
    let ts := mkNode ``Term.app #[f, ts]
    `($ts)
  | `(thf_term| $q:quantifier [ $vs,* ] : $body) => do
    let body ← processThfTerm body is_untyped
    let vs : Array Syntax := vs
    vs.foldrM
      fun v acc => do
        let (v, ty) ← match v with
        | `(thf_variable| $v:ident) =>
          if is_untyped then
            let iotaTypeSyntax ← `(TPTP.iota)
            pure (v, iotaTypeSyntax.raw)
          else
            -- throw Error?
            pure (v, (← `(_) : Syntax))
        | `(thf_variable| $v:ident : $ty:thf_type) =>
          pure (v, (← processThfType ty).1)
        | _ => Macro.throwError s!"Unsupported thf_variable: {v}"
        match q.raw[0].getKind with
        | Name.str _ "!" => `(∀ ($v : $ty), $acc)
        | Name.str _ "?" => `(Exists fun ($v : $ty) => $acc)
        | Name.str _ "^" => `(fun ($v : $ty) => $acc)
        | _ => Macro.throwError s!"Unsupported quantifier: {q.raw[0].getKind}"
      body
  | _ => Macro.throwError s!"Unsupported thf_term: {stx}"

/-- Determines whether an identifier is a variable by checking whether the first character is capital -/
def isVar (stx : TSyntax `ident) : MacroM Bool := do
  match stx with
  | Syntax.ident _ rawVal _ _ => return (rawVal.get 0).isUpper
  | _ => Macro.throwError "Non-ident passed into isVar"

/-- Given a piece of syntax, returns the list of variables that appear in said syntax. This function
    may return lists in which the same variable appears multiple times. -/
partial def getVarsHelper (stx : Syntax) : MacroM (List (TSyntax `ident)) := do
  match stx with
  | `(thf_term| ( $t:thf_term )) => getVarsHelper t
  | `(thf_term| ~ $t:thf_term ) => getVarsHelper t
  | `(thf_term| $t1:thf_term $conn:bexpOp $t2:thf_term ) =>
    return (← getVarsHelper t1).append (← getVarsHelper t2)
  | `(thf_term| $t1:thf_term $conn:eqOp $t2:thf_term ) =>
    return (← getVarsHelper t1).append (← getVarsHelper t2)
  | `(thf_term| $f:ident $args:thf_arguments ?) =>
    match args with
    | none =>
      if (← isVar f) then return [f]
      else return []
    | some args =>
      let args := ((@Syntax.SepArray.mk "," args.raw[1].getArgs) : Array Syntax)
      let argsVars ← args.mapM (fun arg => getVarsHelper arg)
      let argsVars := argsVars.foldl
        (fun acc varList => varList.append acc) []
      if (← isVar f) then return f :: argsVars
      else return argsVars
  | _ => Macro.throwError s!"Unsupported cnf term: {stx}"

/-- Given a piece of syntax, returns the list of variables that appear in said syntax. This function is needed
    because cnf clauses are implicitly universally quantified (but Lean requires that we explicitly universally
    quantify the variables). This function is only intended to be called on cnf clauses. -/
def getVars (stx : Syntax) : MacroM (List (TSyntax `ident)) := do
  let varsWithDuplicates ← getVarsHelper stx
  let vars := varsWithDuplicates.foldl
    (fun acc var => if acc.contains var then acc else var :: acc) []
  return vars

partial def processCnfTerm (stx : Syntax) : MacroM Syntax := do
  let vars ← getVars stx
  let iotaTypeSyntax ← `(TPTP.iota)
  let unquantifiedRes ← processThfTerm stx true
  let quantifiedRes ← vars.foldlM
    (fun acc (var : TSyntax `ident) => `(∀ ($var : $iotaTypeSyntax), $acc)) unquantifiedRes
  return quantifiedRes

/-- Note: This function is only meant to be used for fof/cnf formats (tff files declare their own symbols).

    Returns a list in which each element is `(explicitBinder| ($name : $ty)) where $name is a symbol that
    appears in stx (and isn't a variable) and $ty is the type of said symbol.

    In fof/cnf formats, the only base types are Prop and `iota. All symbols therefore must be of type Prop, type
    `iota, or functions that output Prop or iota. Which of these is the case can be determined by the position
    of the symbol in the overall formula.

    The topType argument is used to keep track of what the overall type of stx is supposed to be. -/
partial def getNonVarSymbols (acc : HashMap String (TSyntax `TPTP.explicitBinder)) (topType : TSyntax `thf_type)
  (stx : Syntax) : MacroM (HashMap String (TSyntax `TPTP.explicitBinder)) := do
  match stx with
  | `(thf_term|🍉$id:ident) => return acc
  | `(thf_term| ( $t:thf_term )) => getNonVarSymbols acc topType t
  | `(thf_term| ~ $t:thf_term ) =>
    if topType != (← `(Prop)) then Macro.throwError s!"Error: cnf/fof term: {stx} is supposed to have type {topType}"
    else getNonVarSymbols acc (← `(Prop)) t
  | `(thf_term| $t1:thf_term $conn:bexpOp $t2:thf_term ) =>
    if topType != (← `(Prop)) then Macro.throwError s!"Error: cnf/fof term: {stx} is supposed to have type {topType}"
    else
      match conn.raw[0].getKind with
      | Name.str _ "&" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "=>" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "|" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "<=>" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "<~>" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "~|" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | Name.str _ "~&" => getNonVarSymbols (← getNonVarSymbols acc (← `(Prop)) t1) (← `(Prop)) t2
      | _ => Macro.throwError s!"Unsupported bexpOp: {conn.raw[0].getKind}"
  | `(thf_term| $t1:thf_term $conn:eqOp $t2:thf_term ) =>
    if topType != (← `(Prop)) then Macro.throwError s!"Error: cnf/fof term: {stx} is supposed to have type {topType}"
    else
      match conn.raw[0].getKind with
      | Name.str _ "=" => getNonVarSymbols (← getNonVarSymbols acc (← `(TPTP.iota)) t1) (← `(TPTP.iota)) t2
      | Name.str _ "!=" => getNonVarSymbols (← getNonVarSymbols acc (← `(TPTP.iota)) t1) (← `(TPTP.iota)) t2
      | _ => Macro.throwError s!"Unsupported eqOp: {conn.raw[0].getKind}"
  | `(thf_term| $f:ident $args:thf_arguments ?) =>
    if (← isVar f) then
      if let some _ := args then
        Macro.throwError s!"Variable used as function in cnf/fof term: {stx}"
      else
        return acc
    match args with
    | none =>
      let s := f.getId.getString!
      let binder ← `(explicitBinder| ($f : $topType))
      return acc.insert s binder
    | some args =>
      let args := ((@Syntax.SepArray.mk "," args.raw[1].getArgs) : Array Syntax)
      let iotaTypeSyntax ← `(TPTP.iota)
      let fType ← args.foldlM (fun (acc _ : Syntax) => do
        `($iotaTypeSyntax → $acc)) topType
      let acc ← args.foldlM (fun acc arg => do
        getNonVarSymbols acc (← `(TPTP.iota)) arg) acc
      let s := f.getId.getString!
      let binder ← `(explicitBinder| ($f : $fType))
      return acc.insert s binder
  | `(thf_term| $q:quantifier [ $vs,* ] : $body) =>
    if topType != (← `(Prop)) then Macro.throwError s!"Error: cnf/fof term: {stx} is supposed to have type {topType}"
    else getNonVarSymbols acc (← `(Prop)) body
  | _ => Macro.throwError s!"Unsupported cnf/fof term: {stx}"

macro "BEGIN_TPTP" name:ident s:TPTP_file "END_TPTP" proof:term : command => do
  let mut symtab : HashMap String (TSyntax `TPTP.explicitBinder) := HashMap.empty
  let sargs := s.raw[0].getArgs
  for input in sargs do
    match input with
    | `(TPTP_input| tff($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      pure () -- Only need to retrieve symbols from cnf and fof files
    | `(TPTP_input| tff($n:ident,type,$name:ident : $ty:thf_type $annotation:annotation ?).) =>
      pure () -- Only need to retrieve symbols from cnf and fof files
    | `(TPTP_input| thf($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      pure ()
    | `(TPTP_input| thf($n:ident,type,$name:ident : $ty:thf_type $annotation:annotation ?).) =>
      pure () -- Only need to retrieve symbols from cnf and fof files
    | `(TPTP_input| cnf($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      symtab ← getNonVarSymbols symtab (← `(Prop)) term
    | `(TPTP_input| fof($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      symtab ← getNonVarSymbols symtab (← `(Prop)) term
    | _ => Macro.throwError s!"Unsupported TPTP_input: {input}"
  -- Perform a foldl so that we only have one binder for each symbol
  let nonVarSymbols := (symtab.toList).foldl
    (fun acc (_, binder) =>
      if List.contains acc binder then acc
      else binder :: acc) []
  let mut hyps : Array (TSyntax `TPTP.explicitBinder) := #[]
  for input in sargs do
    match input with
    | `(TPTP_input| tff($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      let term ← processThfTerm term false
      let name := (mkIdent $ name.getId.appendBefore "h")
      if role.getId == `conjecture then
        hyps := hyps.push (← `(explicitBinder| ($name : ¬ $term)))
      else
        hyps := hyps.push (← `(explicitBinder| ($name : $term)))
    | `(TPTP_input| tff($n:ident,type,$name:ident : $ty:thf_type $annotation:annotation ?).) =>
      let (ty, stxArrOpt) ← processThfType ty
      hyps := hyps.push (← `(explicitBinder| ($name : $ty)))
      match stxArrOpt with
      | none => continue
      | some stxArr =>
        let typeArgName := `typeArg
        let mut counter := 0
        let mut nameApp ← `($name)
        let mut typeArgs : Array Ident := #[]
        for _ in stxArr do
          let typeArg := mkIdent $ typeArgName.appendAfter (toString counter)
          nameApp ← `($nameApp $typeArg)
          counter := counter + 1
          typeArgs := typeArgs.push typeArg
        let mut quantifiedNameApp ← `(Inhabited $nameApp)
        for (stx, typeArg) in stxArr.zip typeArgs.reverse do
          quantifiedNameApp ← `(∀ $typeArg : $stx, $quantifiedNameApp)
        hyps := hyps.push (← `(explicitBinder| (_ : $quantifiedNameApp)))
    | `(TPTP_input| thf($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      let term ← processThfTerm term false
      let name := (mkIdent $ name.getId.appendBefore "h")
      if role.getId == `conjecture then
        hyps := hyps.push (← `(explicitBinder| ($name : ¬ $term)))
      else
        hyps := hyps.push (← `(explicitBinder| ($name : $term)))
    | `(TPTP_input| thf($n:ident,type,$name:ident : $ty:thf_type $annotation:annotation ?).) =>
      let (ty, stxArrOpt) ← processThfType ty
      hyps := hyps.push (← `(explicitBinder| ($name : $ty)))
      match stxArrOpt with
      | none => continue
      | some stxArr =>
        let typeArgName := `typeArg
        let mut counter := 0
        let mut nameApp ← `($name)
        let mut typeArgs : Array Ident := #[]
        for _ in stxArr do
          let typeArg := mkIdent $ typeArgName.appendAfter (toString counter)
          nameApp ← `($nameApp $typeArg)
          counter := counter + 1
          typeArgs := typeArgs.push typeArg
        let mut quantifiedNameApp ← `(Inhabited $nameApp)
        for (stx, typeArg) in stxArr.zip typeArgs.reverse do
          quantifiedNameApp ← `(∀ $typeArg : $stx, $quantifiedNameApp)
        hyps := hyps.push (← `(explicitBinder| (_ : $quantifiedNameApp)))
    | `(TPTP_input| cnf($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      let term ← processCnfTerm term
      let name := (mkIdent $ name.getId.appendBefore "h")
      if role.getId == `conjecture then
        hyps := hyps.push (← `(explicitBinder| ($name : ¬ $term)))
      else
        hyps := hyps.push (← `(explicitBinder| ($name : $term)))
    | `(TPTP_input| fof($name:ident,$role,$term:thf_term $annotation:annotation ?).) =>
      -- Although tff differs from fof, I think that processThfTerm will do what we want for fof terms
      let term ← processThfTerm term true
      let name := (mkIdent $ name.getId.appendBefore "h")
      if role.getId == `conjecture then
        hyps := hyps.push (← `(explicitBinder| ($name : ¬ $term)))
      else
        hyps := hyps.push (← `(explicitBinder| ($name : $term)))
    | _ => Macro.throwError s!"Unsupported TPTP_input: {input}"
  let hypall := mkNode ``many (nonVarSymbols.toArray.append hyps)
  let spec ← `(Term.typeSpec| : False)
  let sig := mkNode ``Command.declSig #[hypall,spec]
  `(theorem $name $sig := $proof)


import MLIR.Semantics.Fitree
import MLIR.Semantics.Semantics
import MLIR.Semantics.SSAEnv
import MLIR.Semantics.UB
import MLIR.Util.Metagen
import MLIR.AST
import MLIR.EDSL
import Mathlib.Data.List.Dedup
open MLIR.AST

/-
### Dialect: `scf`
-/

instance scf: Dialect Void Void (fun _x => Unit) where
  name := "scf"
  iα := inferInstance
  iε := inferInstance

-- Operations of `scf` that unfold into regions need to expose these regions
-- | run a loop, decrementing i from n to -
-- | ix := lo + (n - i) * step
def run_loop_bounded_stepped_go [Monad m] (n: Nat) (i: Nat) (lo: Int) (step: Int)
  (accum: a) (eff: Int -> a -> m a): m a := do
   let ix : Int := lo + (n - i) * step
   let accum <- eff ix accum
   match i with
   | .zero => return accum
   | .succ i' => run_loop_bounded_stepped_go n i' lo step accum eff

-- | TODO: make this model the `yield` as well.
def run_loop_bounded_stepped [Monad m] (n: Nat) (lo: Int) (step: Int) (accum: a) (eff: Int -> a -> m a): m a :=
  run_loop_bounded_stepped_go n n lo step accum eff

-- | TODO: make this model the `yield` as well.
def run_loop_bounded
  (n: Nat)
  (ix: Int)
  (start: TypedArgs Δ)
  (rgn: TypedArgs Δ → OpM Δ (TypedArgs Δ)): OpM Δ (TypedArgs Δ):= do
  match n with
  | 0 => return start
  | .succ n' => do
    let (_: TypedArgs Δ) <- rgn [⟨MLIRType.index, ix⟩]
    run_loop_bounded n' (ix + 1) ([]) rgn

-- | TODO: refactor to (1) an effect, (2) an interpretation
-- | TODO: use the return type of Scf.For. For now, just do unit.
def scf_semantics_op: IOp Δ → OpM Δ (TypedArgs Δ)
  | IOp.mk "scf.if" _ [⟨.i1, b⟩]  [rthen, relse] _ => do
      (if b = 1 then rthen else relse) []
  | IOp.mk "scf.for" _ [⟨.index, lo⟩, ⟨.index, hi⟩, ⟨.index, step⟩] [body] _ => do
    let nsteps : Int := (hi - lo) / step
    let _  ← run_loop_bounded_stepped
      (a := TypedArgs Δ)
      (n := nsteps.toNat)
      (lo := lo)
      (step := step)
      (accum := default)
      (eff := (fun i _ => body [⟨.index, i⟩]))
    return []
  | IOp.mk "scf.for'" _ [⟨.index, lo⟩, ⟨.index, hi⟩] [body] _ => do
      run_loop_bounded (n := (hi - lo).toNat) (ix := lo) [] body
  | IOp.mk "scf.yield" _ vs [] _ =>
      return vs
  | IOp.mk "scf.assert" _ [⟨.i1, arg⟩] [] attrs =>
    if arg  == 0 then
      let err := match attrs.find "msg" with -- TODO: convert this to a pattern match.
          | .some (.str str) => str
          | _ => ""
      OpM.Error s!"{err}: {arg} <assert failed>"
    else return [] -- success
  | IOp.mk "scf.execute_region" _ args  [rgn] _ => do
      rgn args
  | IOp.mk name .. => OpM.Unhandled ("scf unhandled: " ++ name)

instance: Semantics scf where
  semantics_op := scf_semantics_op

/-
### Theorems
-/

namespace SCF.IF
-- Proof that `scf.if` with a fixed condition simplifies to its "then" or
-- "else" region depending on the value

def LHS (r₁ r₂: Region scf): Region scf := [mlir_region|
{
  "scf.if" (%b) ($(r₁), $(r₂)) : (i1) -> ()
}]

def INPUT (b: Bool): SSAEnv scf :=
  SSAEnv.set "b" MLIRType.i1 (if b then 1 else 0) SSAEnv.empty

-- Pure unfolding-style proof
theorem equivalent (b: Bool):
    run ⟦LHS r₁ r₂⟧ (INPUT b) =
    run (TopM.scoped (denoteRegion
          (Δ := scf)
          (rgn := if b then r₁ else r₂)
          (args := []))) (INPUT b) := by
    simp[LHS];
    simp[run_denoteRegion];
    simp[run_bind_success];
    rw[run_seq];
    simp[run_denoteTypedArgs_nil];
    simp [run_denoteOps_singleton];
    simp[run_denoteOp];
    simp[run_bind];
    simp[run_denoteOp];
    simp[run_denoteOpArgs_cons_];
    simp[run_bind];
    simp[INPUT];
    rw[run_TopM_get_];
    simp[SSAEnv.get_set_eq];
    simp[run_denoteOpArgs_nil];
    simp[run_pure];
    simp[INPUT];
    simp[TopM.mapDenoteRegion]; -- TODO: make run version of this
    save
    simp[OpM.denoteRegions] -- TODO: make run version
    simp[Semantics.semantics_op]; -- TODO: make run version
    simp[scf_semantics_op]; -- SLOW
    save
    -- VERY SLOW
    cases b <;> simp;
    case false => {
      rw[OpM_toTopM_denoteRegion]; -- TODO: make run version
      simp[TopM.denoteRegionsByIx]; -- TODO: make run version
    }
    case true => {
      -- TODO, FIXME, BUG: lean does not unfold the definition in the
      -- 'true' branch, while it does on the 'false' branch.
      -- This seems to be a tactic bug, because even after
      -- 'sorry'ing, we still get an error.
      sorry
      /-
      rw[OpM_toTopM_denoteRegion];
      simp[TopM.denoteRegionsByIx];
      -/
    }
    -- | but having this sorry here fixes the 'case true' error,
    -- even though lean knows that this tactic in unreachable:
    --   'this tactic is never executed [linter.unreachableTactic]'
    sorry

end SCF.IF

namespace SCF.FOR_PEELING
def LHS (r: Region scf): Region scf := [mlir_region|
{
  "scf.for'" (%c0, %cn_plus_1) ($(r)) : (index, index) -> ()
}]
def RHS  (r: Region scf): Region scf := [mlir_region|
{
  "scf.execute_region" (%c0) ($(r)) : (index) -> ()
  "scf.for'" (%c1, %cn_plus_1) ($(r)) : (index, index) -> ()
}]
def INPUT (n: Nat): SSAEnv scf :=
  SSAEnv.set "cn" .index n
    (SSAEnv.set "cn_plus_1" .index (n + 1)
      (SSAEnv.set "c0" .index 0
        (SSAEnv.set "c1" .index 1 SSAEnv.empty)))
/-
SSAEnv.One [
  ⟨"cn", .index, n⟩,
  ⟨"cn_plus_1", .index, n + 1⟩,
  ⟨"c0", .index, 0⟩,
  ⟨"c1", .index, 1⟩]
-/

 -- The main requirement for this theorem is that `r` satisfies SSA invariants,
-- ie. values available before it runs are unchanged by its execution. Here we
-- assume something quite a bit stronger, to simplify the proof of the actual
-- property, which is that a read can commute with running the region.

theorem CORRECT_r (n:Nat) (r: Region scf) args:
    (run (denoteRegion scf r args) (INPUT n)) = .ok ([], INPUT n) := by
   sorry

/-
theorem CORRECT_r_commute_run_interpRegion_SSAEnvE_get [S: Semantics scf]
  (CORRECT_r: (run (denoteRegion scf r args) (INPUT n)) = .ok (.Ret [], INPUT n))
  (name: SSAVal) (τ: MLIRType scf) (v: MLIRType.eval τ)
  (ENV: SSAEnv.get name τ (INPUT n) = some v)
  (k: BlockResult scf → τ.eval → Fitree (SSAEnvE scf +' UBE) R):
  run (Fitree.bind
    (interpRegion scf [denoteRegion scf r] _ (Sum.inl <| RegionE.RunRegion 0 args))
    (fun discr =>
      Fitree.Vis (Sum.inl <| SSAEnvE.Get τ name) fun v => k discr v)) (INPUT n) =
  run (Fitree.Vis (Sum.inl <| SSAEnvE.Get τ name) fun v =>
    (Fitree.bind (interpRegion scf [denoteRegion scf r] _ (Sum.inl <| RegionE.RunRegion 0 args))
    (fun discr => k discr v))) (INPUT n) := by
  simp [run_bind, interpRegion, List.get!]
  simp [CORRECT_r]
  simp [run_SSAEnvE_get _ _ _ _ _ ENV]
  simp [run_bind, CORRECT_r]
-/
private theorem identity₁ (n: Nat):
    Int.toNat (Int.ofNat n + 1 - 0) = n + 1 := by
  sorry

set_option maxHeartbeats 999999999 in
-- Pretty slow due to simplifying scf_semantics_op
-- which contains a large match
theorem equivalent (n: Nat) (r: Region scf):
    (run ⟦LHS r⟧ (INPUT n)) =
    (run ⟦RHS r⟧ (INPUT n)) := by {
   simp[LHS, RHS];
   simp[run_denoteRegion];
   simp[run_bind];
   simp[run_denoteTypedArgs_nil];
   simp[run_denoteOps_singleton];
   simp[run_denoteOp];
   simp[run_bind];
   simp[INPUT];
   simp[run_denoteOpArgs_cons_];
   simp[run_bind];
   rw[run_TopM_get_];
   rw[SSAEnv.get_set_ne_val];
   rw[SSAEnv.get_set_ne_val];
   rw[SSAEnv.get_set_eq_val] <;> simp;
   simp[run_denoteOpArgs_cons_];
   simp[run_bind];
   rw[run_TopM_get_];
   rw[SSAEnv.get_set_ne_val];
   rw[SSAEnv.get_set_eq_val] <;> simp;
   simp[run_denoteOpArgs_nil];
   simp[run_pure];
   simp[TopM.mapDenoteRegion]; -- TODO: make a 'run' version of this.
   simp[Semantics.semantics_op, scf_semantics_op]; -- SLOW :(
   simp[OpM.denoteRegions];
   apply Eq.symm;
   simp[run_denoteOps_cons];
   simp[run_bind];
   simp[run_denoteOps_singleton];
   simp[run_denoteOp];
   simp[run_bind];
   simp[run_denoteOpArgs_cons_];
   simp[run_bind];
   rw[run_TopM_get_];
   rw[SSAEnv.get_set_ne_val];
   rw[SSAEnv.get_set_ne_val];
   rw[SSAEnv.get_set_eq_val];
   simp;
   simp[run_denoteOpArgs_nil];
   simp[run_pure];
   simp[TopM_mapDenoteRegion_cons];
   simp[TopM_mapDenoteRegion_nil];
   simp[Semantics.semantics_op, scf_semantics_op];
   simp[OpM_denoteRegions_cons];
   save
   -- tactic 'simp' failed, nested error:
   -- (deterministic) timeout at 'whnf', maximum number of heartbeats (200000)
   -- has been reached (use 'set_option maxHeartbeats <num>' to set the limit)
   simp[OpM_denoteRegions_nil];
   simp[run_OpM_toTopM_denoteRegion];
   simp[run_TopM_denoteRegionsByIx_cons];
   sorry
   sorry
   simp; simp; simp; simp;
}

  /-
  simp [LHS, RHS]
  simp [denoteTypedArgs, denoteOps, denoteOp]
  simp [denoteOpBase, Semantics.semantics_op, scf_semantics_op]; simp_itree
  -/
  /-
  -- simp [denoteRegions]
  rw [run_SSAEnvE_get "c0" .index 0]
  rw [run_SSAEnvE_get "cn_plus_1" .index (n+1)]
  rw [run_SSAEnvE_get "c0" .index 0]
  have h := CORRECT_r n r [⟨.index, 0⟩]
  rw [CORRECT_r_commute_run_interpRegion_SSAEnvE_get h "c1" .index 1]
  rw [run_SSAEnvE_get "c1" .index 1]
  rw [CORRECT_r_commute_run_interpRegion_SSAEnvE_get h "cn_plus_1" .index (n+1)]
  rw [run_SSAEnvE_get "cn_plus_1" .index (n+1)]
  rw [identity₁]
  simp [(by sorry: (Int.ofNat n + 1 - 1).toNat = n)]
  simp [peel_run_loop_bounded, Fitree.interp_bind]
  simp [(by sorry: (0:Int) + (1:Int) = (1:Int))]
  all_goals simp [INPUT, cast_eq]
  -/
end SCF.FOR_PEELING

namespace SCF.FOR_FUSION
def LHS (r: Region scf): Region scf := [mlir_region|
{
  "scf.for'" (%c0, %cn) ($(r)) : (index, index) -> ()
  "scf.for'" (%cn, %cn_plus_m) ($(r)) : (index, index) -> ()
}]
def RHS (r: Region scf): Region scf := [mlir_region|
{
  "scf.for'" (%c0, %cn_plus_m) ($(r)) : (index, index) -> ()
}]
def INPUT (n m: Nat): SSAEnv scf := SSAEnv.One [
  ⟨"cn", .index, n⟩,
  ⟨"cn_plus_m", .index, n + m⟩,
  ⟨"c0", .index, 0⟩]

/- theorem interp_region_of_run_loop_bounded
  (r: Region scf) (n: Nat)
  (rhs: Fitree (SSAEnvE scf +' Semantics.E scf +' UBE) (BlockResult scf)):
    Fitree.interp (interpRegion scf (denoteRegions scf [r]))
      (run_loop_bounded n 0 (BlockResult.Ret [])) = rhs := by {
    induction n;
    case zero => {
      simp [run_loop_bounded];
      sorry
    }
    case succ n' => {
      simp [run_loop_bounded];
      simp [Fitree.interp];
      sorry
    }
   } -/
/-
theorem equivalent (n m: Nat) (r: Region scf):
    (run ⟦LHS r⟧ (INPUT n m)) =
    (run ⟦RHS r⟧ (INPUT n m)) := by
  simp [LHS, RHS, INPUT]
  simp [denoteRegion, denoteOps, denoteOp, denoteOpBase]
  simp_itree
  simp [Semantics.semantics_op, scf_semantics_op]
  simp [run];
  simp [StateT.run];
  simp [Except.bind];
  simp [denoteTypedArgs];
  simp [pure];
  simp [StateT.pure];
  simp [pure];
  simp [Except.pure];
  simp [List.mapM, List.mapM.loop];
  simp [bind, StateT.bind, Except.bind, TopM.get];
  sorry
  -- At this point we need something similar to CORRECT_r_* above.
  -- simp [run_denoteOp_interp_region]
  -- all_goals simp [INPUT, cast_eq]
-/
end SCF.FOR_FUSION


import tactic --hide

/-Lemma
False implies false.
-/
lemma false_imp_false : false → false :=
begin
  intro f,
  exact f,

end


import tactic

namespace blueprint

lemma first_test (h : false) : true :=
begin
  tauto,
end

lemma second_test (h : false) : true :=
begin
  tauto,
end

end blueprint


example (h : 0 = 1) : False := by
  first | trace_state; fail | contradiction

example (h : 0 = 1) : False := by
  first | trace "first branch"; fail | contradiction