/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.strong_epi
import category_theory.limits.shapes.equalizers

/-!
# Definitions and basic properties of regular monomorphisms and epimorphisms.

A regular monomorphism is a morphism that is the equalizer of some parallel pair.

We give the constructions
* `split_mono → regular_mono` and
* `regular_mono → mono`
as well as the dual constructions for regular epimorphisms. Additionally, we give the
construction
* `regular_epi ⟶ strong_epi`.

-/

noncomputable theory

namespace category_theory
open category_theory.limits

universes v₁ u₁ u₂

variables {C : Type u₁} [category.{v₁} C]

variables {X Y : C}

/-- A regular monomorphism is a morphism which is the equalizer of some parallel pair. -/
class regular_mono (f : X ⟶ Y) :=
(Z : C)
(left right : Y ⟶ Z)
(w : f ≫ left = f ≫ right)
(is_limit : is_limit (fork.of_ι f w))

attribute [reassoc] regular_mono.w

/-- Every regular monomorphism is a monomorphism. -/
@[priority 100]
instance regular_mono.mono (f : X ⟶ Y) [regular_mono f] : mono f :=
mono_of_is_limit_parallel_pair regular_mono.is_limit

instance equalizer_regular (g h : X ⟶ Y) [has_limit (parallel_pair g h)] :
  regular_mono (equalizer.ι g h) :=
{ Z := Y,
  left := g,
  right := h,
  w := equalizer.condition g h,
  is_limit := fork.is_limit.mk _ (λ s, limit.lift _ s) (by simp) (λ s m w, by { ext1, simp [←w] }) }

/-- Every split monomorphism is a regular monomorphism. -/
@[priority 100]
instance regular_mono.of_split_mono (f : X ⟶ Y) [split_mono f] : regular_mono f :=
{ Z     := Y,
  left  := 𝟙 Y,
  right := retraction f ≫ f,
  w     := by tidy,
  is_limit := split_mono_equalizes f }

/-- If `f` is a regular mono, then any map `k : W ⟶ Y` equalizing `regular_mono.left` and
    `regular_mono.right` induces a morphism `l : W ⟶ X` such that `l ≫ f = k`. -/
def regular_mono.lift' {W : C} (f : X ⟶ Y) [regular_mono f] (k : W ⟶ Y)
  (h : k ≫ (regular_mono.left : Y ⟶ @regular_mono.Z _ _ _ _ f _) = k ≫ regular_mono.right) :
  {l : W ⟶ X // l ≫ f = k} :=
fork.is_limit.lift' regular_mono.is_limit _ h

/--
The second leg of a pullback cone is a regular monomorphism if the right component is too.

See also `pullback.snd_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_fst_of_regular` for the flipped version.
-/
def regular_of_is_pullback_snd_of_regular {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S}
  {k : R ⟶ S} [hr : regular_mono h] (comm : f ≫ h = g ≫ k)
  (t : is_limit (pullback_cone.mk _ _ comm)) :
regular_mono g :=
{ Z := hr.Z,
  left := k ≫ hr.left,
  right := k ≫ hr.right,
  w := by rw [← reassoc_of comm, ← reassoc_of comm, hr.w],
  is_limit :=
  begin
    apply fork.is_limit.mk' _ _,
    intro s,
    have l₁ : (fork.ι s ≫ k) ≫ regular_mono.left = (fork.ι s ≫ k) ≫ regular_mono.right,
      rw [category.assoc, s.condition, category.assoc],
    obtain ⟨l, hl⟩ := fork.is_limit.lift' hr.is_limit _ l₁,
    obtain ⟨p, hp₁, hp₂⟩ := pullback_cone.is_limit.lift' t _ _ hl,
    refine ⟨p, hp₂, _⟩,
    intros m w,
    have z : m ≫ g = p ≫ g := w.trans hp₂.symm,
    apply t.hom_ext,
    apply (pullback_cone.mk f g comm).equalizer_ext,
    { erw [← cancel_mono h, category.assoc, category.assoc, comm, reassoc_of z] },
    { exact z },
  end }

/--
The first leg of a pullback cone is a regular monomorphism if the left component is too.

See also `pullback.fst_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_snd_of_regular` for the flipped version.
-/
def regular_of_is_pullback_fst_of_regular {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S}
  {k : R ⟶ S} [hr : regular_mono k] (comm : f ≫ h = g ≫ k)
  (t : is_limit (pullback_cone.mk _ _ comm)) :
regular_mono f :=
regular_of_is_pullback_snd_of_regular comm.symm (pullback_cone.flip_is_limit t)

/-- A regular monomorphism is an isomorphism if it is an epimorphism. -/
lemma is_iso_of_regular_mono_of_epi (f : X ⟶ Y) [regular_mono f] [e : epi f] : is_iso f :=
@is_iso_limit_cone_parallel_pair_of_epi _ _ _ _ _ _ _ regular_mono.is_limit e

/-- A regular epimorphism is a morphism which is the coequalizer of some parallel pair. -/
class regular_epi (f : X ⟶ Y) :=
(W : C)
(left right : W ⟶ X)
(w : left ≫ f = right ≫ f)
(is_colimit : is_colimit (cofork.of_π f w))

attribute [reassoc] regular_epi.w

/-- Every regular epimorphism is an epimorphism. -/
@[priority 100]
instance regular_epi.epi (f : X ⟶ Y) [regular_epi f] : epi f :=
epi_of_is_colimit_parallel_pair regular_epi.is_colimit

instance coequalizer_regular (g h : X ⟶ Y) [has_colimit (parallel_pair g h)] :
  regular_epi (coequalizer.π g h) :=
{ W := X,
  left := g,
  right := h,
  w := coequalizer.condition g h,
  is_colimit := cofork.is_colimit.mk _ (λ s, colimit.desc _ s) (by simp)
    (λ s m w, by { ext1, simp [←w] }) }

/-- Every split epimorphism is a regular epimorphism. -/
@[priority 100]
instance regular_epi.of_split_epi (f : X ⟶ Y) [split_epi f] : regular_epi f :=
{ W     := X,
  left  := 𝟙 X,
  right := f ≫ section_ f,
  w     := by tidy,
  is_colimit := split_epi_coequalizes f }

/-- If `f` is a regular epi, then every morphism `k : X ⟶ W` coequalizing `regular_epi.left` and
    `regular_epi.right` induces `l : Y ⟶ W` such that `f ≫ l = k`. -/
def regular_epi.desc' {W : C} (f : X ⟶ Y) [regular_epi f] (k : X ⟶ W)
  (h : (regular_epi.left : regular_epi.W f ⟶ X) ≫ k = regular_epi.right ≫ k) :
  {l : Y ⟶ W // f ≫ l = k} :=
cofork.is_colimit.desc' (regular_epi.is_colimit) _ h

/--
The second leg of a pushout cocone is a regular epimorphism if the right component is too.

See also `pushout.snd_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_fst_of_regular` for the flipped version.
-/
def regular_of_is_pushout_snd_of_regular
  {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S}
  [gr : regular_epi g] (comm : f ≫ h = g ≫ k) (t : is_colimit (pushout_cocone.mk _ _ comm)) :
regular_epi h :=
{ W := gr.W,
  left := gr.left ≫ f,
  right := gr.right ≫ f,
  w := by rw [category.assoc, category.assoc, comm, reassoc_of gr.w],
  is_colimit :=
  begin
    apply cofork.is_colimit.mk' _ _,
    intro s,
    have l₁ : gr.left ≫ f ≫ s.π = gr.right ≫ f ≫ s.π,
      rw [← category.assoc, ← category.assoc, s.condition],
    obtain ⟨l, hl⟩ := cofork.is_colimit.desc' gr.is_colimit (f ≫ cofork.π s) l₁,
    obtain ⟨p, hp₁, hp₂⟩ := pushout_cocone.is_colimit.desc' t _ _ hl.symm,
    refine ⟨p, hp₁, _⟩,
    intros m w,
    have z := w.trans hp₁.symm,
    apply t.hom_ext,
    apply (pushout_cocone.mk _ _ comm).coequalizer_ext,
    { exact z },
    { erw [← cancel_epi g, ← reassoc_of comm, ← reassoc_of comm, z], refl },
  end }

/--
The first leg of a pushout cocone is a regular epimorphism if the left component is too.

See also `pushout.fst_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_snd_of_regular` for the flipped version.
-/
def regular_of_is_pushout_fst_of_regular
  {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S}
  [fr : regular_epi f] (comm : f ≫ h = g ≫ k) (t : is_colimit (pushout_cocone.mk _ _ comm)) :
regular_epi k :=
regular_of_is_pushout_snd_of_regular comm.symm (pushout_cocone.flip_is_colimit t)

/-- A regular epimorphism is an isomorphism if it is a monomorphism. -/
lemma is_iso_of_regular_epi_of_mono (f : X ⟶ Y) [regular_epi f] [m : mono f] : is_iso f :=
@is_iso_limit_cocone_parallel_pair_of_epi _ _ _ _ _ _ _ regular_epi.is_colimit m

@[priority 100]
instance strong_epi_of_regular_epi (f : X ⟶ Y) [regular_epi f] : strong_epi f :=
{ epi := by apply_instance,
  has_lift :=
  begin
    introsI,
    have : (regular_epi.left : regular_epi.W f ⟶ X) ≫ u = regular_epi.right ≫ u,
    { apply (cancel_mono z).1,
      simp only [category.assoc, h, regular_epi.w_assoc] },
    obtain ⟨t, ht⟩ := regular_epi.desc' f u this,
    exact arrow.has_lift.mk ⟨t, ht, (cancel_epi f).1
      (by simp only [←category.assoc, ht, ←h, arrow.mk_hom, arrow.hom_mk'_right])⟩,
  end }

end category_theory


inductive Foo: List α → Type _
  | mk (l): Foo l

def Foo.length: Foo l → Nat
  | mk l => l.length

variable {α : Type u} {Γ Γ': List α} {p: Foo Γ} {h: Γ = Γ'}

theorem eq_rec_length : (h ▸ p).length = p.length := by
  cases h; rfl

example : (h ▸ p).length = p.length :=
  eq_rec_length

example : (h ▸ p).length = p.length := by
  simp only [eq_rec_length]

example : (h ▸ p).length = p.length := by
  rw [eq_rec_length]

example : (h ▸ p).length = p.length := by
  subst h; rfl

example : (h ▸ p).length = p.length :=
  match h with
  | rfl => rfl

example : (h ▸ p).length = p.length :=
  let (rfl) := h; rfl


/-
## Finite interaction trees

The semantics framework for this project is extremely inspired by the Vellvm
project [1] and is essentially centered around interaction trees and monadic
transformers.

Interactions trees are a particular instance of the freer monad; essentially,
an ITree is a program that can have side effets through *interactions*, and
these interactions can either be interpreted into the program or kept as
observable side-effects.

When giving semantics to a program, one usually starts with a rather simple
ITree where most of the complex features of the language (memory, I/O,
exceptions, randomness, non-determinism, etc) are hidden behind interactions.
The interactions are then interpreted, which consists of (1) enriching the
program's environment by a monadic transformation, and (2) replacing the
interaction with an actual implementation.

This approach allows monadic domains to be used while keeping each family of
interactions separate. This is relevant for Vellvm as LLVM IR has many complex
features, and even more relevant for MLIR since each dialect can bring more
interactions and environment transforms and all of them have to be studied and
defined independently.

The datatype of interaction trees normally has built-in non-termination by
being defined coinductively. Support for coinduction is still limited in Lean4,
so we currently use a finite version of ITrees (hence called Fitree) which can
only model programs that always terminate.

[1]: https://github.com/vellvm/vellvm
-/

import MLIRSemantics.SimpItree

/- Extendable effect families -/

section events
universe u v

def pto (E: Type → Type u) (F: Type → Type v) :=
  ∀ T, E T → F T
def psum (E: Type → Type u) (F: Type → Type v) :=
  fun T => E T ⊕ F T
inductive PVoid: Type -> Type u

infixr:40 " ~> " => pto
infixr:60 " +' " => psum

class Member (E: Type → Type u) (F: Type → Type v) where
  inject : E ~> F

instance {E}: Member E E where
  inject := (fun _ => id)

instance {E F G} [Member E F]: Member E (F +' G) where
  inject T := Sum.inl ∘ Member.inject T

instance {E F G} [Member E G]: Member E (F +' G) where
  inject T := Sum.inr ∘ Member.inject T

-- Effects can now be put in context automatically by typeclass resolution
example (E: Type → Type u):
  Member E E := inferInstance
example (E: Type → Type u) (F: Type → Type v):
  Member E (E +' F) := inferInstance
example (E: Type → Type u) (F: Type → Type v):
  Member E (F +' (F +' E)) := inferInstance

@[simp_itree]
def case_ (h1: E ~> G) (h2: F ~> G): E +' F ~> G :=
  fun R ef => match ef with
  | Sum.inl e => h1 R e
  | Sum.inr f => h2 R f

end events

/- Examples of interactions -/

inductive StateE {S: Type}: Type → Type where
  | Read: Unit → StateE S
  | Write: S → StateE Unit

inductive WriteE {W: Type}: Type → Type where
  | Tell: W → WriteE Unit

/- The monadic domain; essentially finite Interaction Trees -/

section fitree
universe u v

inductive Fitree (E: Type → Type u) (R: Type) where
  | Ret (r: R): Fitree E R
  | Vis {T: Type} (e: E T) (k: T → Fitree E R): Fitree E R

@[simp_itree]
def Fitree.ret {E R}: R → Fitree E R :=
  Fitree.Ret

@[simp_itree]
def Fitree.trigger {E: Type → Type u} {F: Type → Type v} {T} [Member E F]
    (e: E T): Fitree F T :=
  Fitree.Vis (Member.inject _ e) Fitree.ret

@[simp_itree]
def Fitree.bind {E R T} (t: Fitree E T) (k: T → Fitree E R) :=
  match t with
  | Ret r => k r
  | Vis e k' => Vis e (fun r => bind (k' r) k)

instance {E}: Monad (Fitree E) where
  pure := Fitree.ret
  bind := Fitree.bind

-- Interpretation into the monad of finite ITrees
@[simp_itree]
def interp {M} [Monad M] {E} (h: E ~> M):
    forall ⦃R⦄, Fitree E R → M R :=
  fun _ t =>
    match t with
    | Fitree.Ret r => pure r
    | Fitree.Vis e k => bind (h _ e) (fun t => interp h (k t))

-- Interpretation into the state monad
@[simp_itree]
def interp_state {M S} [Monad M] {E} (h: E ~> StateT S M):
    forall ⦃R⦄, Fitree E R → StateT S M R :=
  interp h

-- Since we only use finite ITrees, we can actually run them when they're
-- fully interpreted (which leaves only the Ret constructor)
def Fitree.run {R}: Fitree PVoid R → R
  | Ret r => r
  | Vis e k => nomatch e

end fitree

/- Predicates to reason about the absence of events -/

inductive Fitree.no_event_l {E F R}: Fitree (E +' F) R → Prop :=
  | Ret r: no_event_l (Ret r)
  | Vis f k: (∀ t, no_event_l (k t)) → no_event_l (Vis (Sum.inr f) k)

-- TODO: Tactic to automate the proof of no_event_l

/- Rewriting tactic simp_itree -/

open Lean Elab.Tactic Parser.Tactic

def toSimpLemma (name : Name) : Syntax :=
  mkNode `Lean.Parser.Tactic.simpLemma
    #[mkNullNode, mkNullNode, mkIdent name]

elab "simp_itree" : tactic => do
  -- TODO: Also handle .lemmaNames, not just unfolding!
  let lemmas := (← SimpItreeExtension.getTheorems).toUnfold.fold
    (init := #[]) (fun acc n => acc.push (toSimpLemma n))
  evalTactic $ ← `(tactic|simp [$lemmas.reverse,*,
    Member.inject, StateT.bind, StateT.pure, bind, pure, cast_eq])


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

General utility functions for buffers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.buffer
import Mathlib.data.array.lemmas
import Mathlib.control.traversable.instances
import Mathlib.PostPort

universes u_1

namespace Mathlib

namespace buffer

protected instance inhabited {α : Type u_1} : Inhabited (buffer α) := { default := nil }

theorem ext {α : Type u_1} {b₁ : buffer α} {b₂ : buffer α} : to_list b₁ = to_list b₂ → b₁ = b₂ :=
  sorry

protected instance decidable_eq (α : Type u_1) [DecidableEq α] : DecidableEq (buffer α) :=
  id
    fun (_v : buffer α) =>
      sigma.cases_on _v
        fun (fst : ℕ) (snd : array fst α) (w : buffer α) =>
          sigma.cases_on w
            fun (w_fst : ℕ) (w_snd : array w_fst α) =>
              decidable.by_cases
                (fun (ᾰ : fst = w_fst) =>
                  Eq._oldrec
                    (fun (w_snd : array fst α) =>
                      decidable.by_cases (fun (ᾰ : snd = w_snd) => Eq._oldrec (is_true sorry) ᾰ)
                        fun (ᾰ : ¬snd = w_snd) => isFalse sorry)
                    ᾰ w_snd)
                fun (ᾰ : ¬fst = w_fst) => isFalse sorry

@[simp] theorem to_list_append_list {α : Type u_1} {xs : List α} {b : buffer α} :
    to_list (append_list b xs) = to_list b ++ xs :=
  sorry

@[simp] theorem append_list_mk_buffer {α : Type u_1} {xs : List α} :
    append_list mk_buffer xs = array.to_buffer (list.to_array xs) :=
  sorry

/-- The natural equivalence between lists and buffers, using
`list.to_buffer` and `buffer.to_list`. -/
def list_equiv_buffer (α : Type u_1) : List α ≃ buffer α :=
  equiv.mk list.to_buffer to_list sorry sorry

protected instance traversable : traversable buffer := equiv.traversable list_equiv_buffer

protected instance is_lawful_traversable : is_lawful_traversable buffer :=
  equiv.is_lawful_traversable list_equiv_buffer

end Mathlib


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

General utility functions for buffers.

! This file was ported from Lean 3 source module data.buffer.basic
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Array.Lemmas
import Mathbin.Control.Traversable.Instances

namespace Buffer

open Function

variable {α : Type _} {xs : List α}

instance : Inhabited (Buffer α) :=
  ⟨nil⟩

@[ext]
theorem ext : ∀ {b₁ b₂ : Buffer α}, toList b₁ = toList b₂ → b₁ = b₂
  | ⟨n₁, a₁⟩, ⟨n₂, a₂⟩, h => by
    simp [to_list, to_array] at h
    have e : n₁ = n₂ := by rw [← Array'.toList_length a₁, ← Array'.toList_length a₂, h]
    subst e
    have h : HEq a₁ a₂.to_list.to_array := h ▸ a₁.to_list_to_array.symm
    rw [eq_of_hEq (h.trans a₂.to_list_to_array)]
#align buffer.ext Buffer.ext

theorem ext_iff {b₁ b₂ : Buffer α} : b₁ = b₂ ↔ toList b₁ = toList b₂ :=
  ⟨fun h => h ▸ rfl, ext⟩
#align buffer.ext_iff Buffer.ext_iff

theorem size_eq_zero_iff {b : Buffer α} : b.size = 0 ↔ b = nil :=
  by
  rcases b with ⟨_ | n, ⟨a⟩⟩
  · simp only [size, nil, mkBuffer, true_and_iff, true_iff_iff, eq_self_iff_true, heq_iff_eq,
      Sigma.mk.inj_iff]
    ext i
    exact Fin.elim0 i
  · simp [size, nil, mkBuffer, Nat.succ_ne_zero]
#align buffer.size_eq_zero_iff Buffer.size_eq_zero_iff

@[simp]
theorem size_nil : (@nil α).size = 0 := by rw [size_eq_zero_iff]
#align buffer.size_nil Buffer.size_nil

@[simp]
theorem toList_nil : toList (@nil α) = [] :=
  rfl
#align buffer.to_list_nil Buffer.toList_nil

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.mk_dec_eq_instance -/
instance (α) [DecidableEq α] : DecidableEq (Buffer α) := by
  run_tac
    tactic.mk_dec_eq_instance

@[simp]
theorem toList_appendList {b : Buffer α} : toList (appendList b xs) = toList b ++ xs := by
  induction xs generalizing b <;> simp! [*] <;> cases b <;> simp! [to_list, to_array]
#align buffer.to_list_append_list Buffer.toList_appendList

@[simp]
theorem appendList_mkBuffer : appendList mkBuffer xs = Array'.toBuffer (List.toArray xs) := by
  ext x : 1 <;> simp [Array'.toBuffer, to_list, to_list_append_list] <;> induction xs <;> [rfl,
        skip] <;>
      simp [to_array] <;>
    rfl
#align buffer.append_list_mk_buffer Buffer.appendList_mkBuffer

@[simp]
theorem toBuffer_toList (b : Buffer α) : b.toList.toBuffer = b :=
  by
  cases b
  rw [to_list, to_array, List.toBuffer, append_list_mk_buffer]
  congr
  · simpa
  · apply Array'.toList_toArray
#align buffer.to_buffer_to_list Buffer.toBuffer_toList

@[simp]
theorem toList_toBuffer (l : List α) : l.toBuffer.toList = l :=
  by
  cases l
  · rfl
  · rw [List.toBuffer, to_list_append_list]
    rfl
#align buffer.to_list_to_buffer Buffer.toList_toBuffer

@[simp]
theorem toList_toArray (b : Buffer α) : b.toArray.toList = b.toList :=
  by
  cases b
  simp [to_list]
#align buffer.to_list_to_array Buffer.toList_toArray

@[simp]
theorem appendList_nil (b : Buffer α) : b.appendList [] = b :=
  rfl
#align buffer.append_list_nil Buffer.appendList_nil

theorem toBuffer_cons (c : α) (l : List α) : (c :: l).toBuffer = [c].toBuffer.appendList l :=
  by
  induction' l with hd tl hl
  · simp
  · apply ext
    simp [hl]
#align buffer.to_buffer_cons Buffer.toBuffer_cons

@[simp]
theorem size_pushBack (b : Buffer α) (a : α) : (b.pushBack a).size = b.size + 1 :=
  by
  cases b
  simp [size, push_back]
#align buffer.size_push_back Buffer.size_pushBack

@[simp]
theorem size_appendList (b : Buffer α) (l : List α) : (b.appendList l).size = b.size + l.length :=
  by
  induction' l with hd tl hl generalizing b
  · simp
  · simp [append_list, hl, add_comm, add_assoc]
#align buffer.size_append_list Buffer.size_appendList

@[simp]
theorem size_toBuffer (l : List α) : l.toBuffer.size = l.length :=
  by
  induction' l with hd tl hl
  · simpa
  · rw [to_buffer_cons]
    have : [hd].toBuffer.size = 1 := rfl
    simp [add_comm, this]
#align buffer.size_to_buffer Buffer.size_toBuffer

@[simp]
theorem length_toList (b : Buffer α) : b.toList.length = b.size := by
  rw [← to_buffer_to_list b, to_list_to_buffer, size_to_buffer]
#align buffer.length_to_list Buffer.length_toList

theorem size_singleton (a : α) : [a].toBuffer.size = 1 :=
  rfl
#align buffer.size_singleton Buffer.size_singleton

theorem read_pushBack_left (b : Buffer α) (a : α) {i : ℕ} (h : i < b.size) :
    (b.pushBack a).read
        ⟨i, by
          convert Nat.lt_succ_of_lt h
          simp⟩ =
      b.read ⟨i, h⟩ :=
  by
  cases b
  convert Array'.read_pushBack_left _
  simp
#align buffer.read_push_back_left Buffer.read_pushBack_left

@[simp]
theorem read_pushBack_right (b : Buffer α) (a : α) : (b.pushBack a).read ⟨b.size, by simp⟩ = a :=
  by
  cases b
  convert Array'.read_pushBack_right
#align buffer.read_push_back_right Buffer.read_pushBack_right

theorem read_appendList_left' (b : Buffer α) (l : List α) {i : ℕ} (h : i < (b.appendList l).size)
    (h' : i < b.size) : (b.appendList l).read ⟨i, h⟩ = b.read ⟨i, h'⟩ :=
  by
  induction' l with hd tl hl generalizing b
  · rfl
  · have hb : i < ((b.push_back hd).appendList tl).size := by convert h using 1
    have hb' : i < (b.push_back hd).size :=
      by
      convert Nat.lt_succ_of_lt h'
      simp
    have : (append_list b (hd :: tl)).read ⟨i, h⟩ = read ((push_back b hd).appendList tl) ⟨i, hb⟩ :=
      rfl
    simp [this, hl _ hb hb', read_push_back_left _ _ h']
#align buffer.read_append_list_left' Buffer.read_appendList_left'

theorem read_appendList_left (b : Buffer α) (l : List α) {i : ℕ} (h : i < b.size) :
    (b.appendList l).read ⟨i, by simpa using Nat.lt_add_right _ _ _ h⟩ = b.read ⟨i, h⟩ :=
  read_appendList_left' b l _ h
#align buffer.read_append_list_left Buffer.read_appendList_left

@[simp]
theorem read_appendList_right (b : Buffer α) (l : List α) {i : ℕ} (h : i < l.length) :
    (b.appendList l).read ⟨b.size + i, by simp [h]⟩ = l.nthLe i h :=
  by
  induction' l with hd tl hl generalizing b i
  · exact absurd i.zero_le (not_le_of_lt h)
  · convert_to((b.push_back hd).appendList tl).read _ = _
    cases i
    · convert read_append_list_left _ _ _ <;> simp
    · rw [List.length, Nat.succ_lt_succ_iff] at h
      have : b.size + i.succ = (b.push_back hd).size + i := by
        simp [add_comm, add_left_comm, Nat.succ_eq_add_one]
      convert hl (b.push_back hd) h using 1
      simpa [Nat.add_succ, Nat.succ_add]
#align buffer.read_append_list_right Buffer.read_appendList_right

theorem read_to_buffer' (l : List α) {i : ℕ} (h : i < l.toBuffer.size) (h' : i < l.length) :
    l.toBuffer.read ⟨i, h⟩ = l.nthLe i h' :=
  by
  cases' l with hd tl
  · simpa using h'
  · have hi : i < ([hd].toBuffer.appendList tl).size := by simpa [add_comm] using h
    convert_to([hd].toBuffer.appendList tl).read ⟨i, hi⟩ = _
    cases i
    · convert read_append_list_left _ _ _
      simp
    · rw [List.nthLe]
      convert read_append_list_right _ _ _
      simp [Nat.succ_eq_add_one, add_comm]
#align buffer.read_to_buffer' Buffer.read_to_buffer'

@[simp]
theorem read_toBuffer (l : List α) (i) :
    l.toBuffer.read i =
      l.nthLe i
        (by
          convert i.property
          simp) :=
  by
  convert read_to_buffer' _ _ _
  · simp
  · simpa using i.property
#align buffer.read_to_buffer Buffer.read_toBuffer

theorem nthLe_to_list' (b : Buffer α) {i : ℕ} (h h') : b.toList.nthLe i h = b.read ⟨i, h'⟩ :=
  by
  have : b.to_list.to_buffer.read ⟨i, by simpa using h'⟩ = b.read ⟨i, h'⟩ := by
    congr 1 <;> simp [Fin.heq_ext_iff]
  simp [← this]
#align buffer.nth_le_to_list' Buffer.nthLe_to_list'

theorem nthLe_toList (b : Buffer α) {i : ℕ} (h) :
    b.toList.nthLe i h = b.read ⟨i, by simpa using h⟩ :=
  nthLe_to_list' _ _ _
#align buffer.nth_le_to_list Buffer.nthLe_toList

theorem read_eq_nthLe_toList (b : Buffer α) (i) : b.read i = b.toList.nthLe i (by simp) := by
  simp [nth_le_to_list]
#align buffer.read_eq_nth_le_to_list Buffer.read_eq_nthLe_toList

theorem read_singleton (c : α) : [c].toBuffer.read ⟨0, by simp⟩ = c := by simp
#align buffer.read_singleton Buffer.read_singleton

/-- The natural equivalence between lists and buffers, using
`list.to_buffer` and `buffer.to_list`. -/
def listEquivBuffer (α : Type _) : List α ≃ Buffer α := by
  refine'
      { toFun := List.toBuffer
        invFun := Buffer.toList.. } <;>
    simp [left_inverse, Function.RightInverse]
#align buffer.list_equiv_buffer Buffer.listEquivBuffer

instance : Traversable Buffer :=
  Equiv.traversable listEquivBuffer

instance : IsLawfulTraversable Buffer :=
  Equiv.isLawfulTraversable listEquivBuffer

/-- A convenience wrapper around `read` that just fails if the index is out of bounds.
-/
unsafe def read_t (b : Buffer α) (i : ℕ) : tactic α :=
  if h : i < b.size then return <| b.read (Fin.mk i h) else tactic.fail "invalid buffer access"
#align buffer.read_t buffer.read_t

end Buffer


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import tactic.doc_commands

open interactive
open interactive.types

namespace tactic
namespace interactive
open expr lean.parser

local postfix (name := parser.optional) `?`:9001 := optional

/--
This is a "finishing" tactic modification of `simp`. It has two forms.

* `simpa [rules, ...] using e` will simplify the goal and the type of
  `e` using `rules`, then try to close the goal using `e`.

  Simplifying the type of `e` makes it more likely to match the goal
  (which has also been simplified). This construction also tends to be
  more robust under changes to the simp lemma set.

* `simpa [rules, ...]` will simplify the goal and the type of a
  hypothesis `this` if present in the context, then try to close the goal using
  the `assumption` tactic. -/
meta def simpa (use_iota_eqn : parse $ (tk "!")?) (trace_lemmas : parse $ (tk "?")?)
  (no_dflt : parse only_flag) (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
  (tgt : parse (tk "using" *> texpr)?) (cfg : simp_config_ext := {}) : tactic unit :=
let simp_at lc (close_tac : tactic unit) := focus1 $
  simp use_iota_eqn trace_lemmas no_dflt hs attr_names (loc.ns lc)
    {fail_if_unchanged := ff, ..cfg} >>
  (((close_tac <|> trivial) >> done) <|> fail "simpa failed") in
match tgt with
| none := get_local `this >> simp_at [some `this, none] assumption <|> simp_at [none] assumption
| some e := focus1 $ do
  e ← i_to_expr e <|> do
  { ty ← target,
    -- for positional error messages, we don't care about the result
    e ← i_to_expr_strict ``(%%e : %%ty),
    pty ← pp ty, ptgt ← pp e,
    -- Fail deliberately, to advise regarding `simp; exact` usage
    fail ("simpa failed, 'using' expression type not directly " ++
      "inferrable. Try:\n\nsimpa ... using\nshow " ++
      to_fmt pty ++ ",\nfrom " ++ ptgt : format) },
  match e with
  | local_const _ lc _ _ := simp_at [some lc, none] (get_local lc >>= tactic.exact)
  | e := do
    t ← infer_type e,
    assertv `this t e,
    simp_at [some `this, none] (get_local `this >>= tactic.exact),
    all_goals (try apply_instance)
  end
end

add_tactic_doc
{ name       := "simpa",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.simpa],
  tags       := ["simplification"] }

end interactive
end tactic


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Jannis Limperg

Facts about `ulift` and `plift`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.PostPort

universes u v u_1 u_2 u_3

namespace Mathlib

namespace plift

/-- Functorial action. -/
@[simp] protected def map {α : Sort u} {β : Sort v} (f : α → β) : plift α → plift β :=
  sorry

/-- Embedding of pure values. -/
@[simp] protected def pure {α : Sort u} : α → plift α :=
  up

/-- Applicative sequencing. -/
@[simp] protected def seq {α : Sort u} {β : Sort v} : plift (α → β) → plift α → plift β :=
  sorry

/-- Monadic bind. -/
@[simp] protected def bind {α : Sort u} {β : Sort v} : plift α → (α → plift β) → plift β :=
  sorry

protected instance monad : Monad plift :=
  { toApplicative :=
      { toFunctor := { map := plift.map, mapConst := fun (α β : Type u_1) => plift.map ∘ function.const β },
        toPure := { pure := plift.pure }, toSeq := { seq := plift.seq },
        toSeqLeft :=
          { seqLeft := fun (α β : Type u_1) (a : plift α) (b : plift β) => plift.seq (plift.map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : plift α) (b : plift β) => plift.seq (plift.map (function.const α id) a) b } },
    toBind := { bind := plift.bind } }

protected instance is_lawful_functor : is_lawful_functor plift :=
  is_lawful_functor.mk (fun (α : Type u_1) (_x : plift α) => sorry)
    fun (α β γ : Type u_1) (g : α → β) (h : β → γ) (_x : plift α) => sorry

protected instance is_lawful_applicative : is_lawful_applicative plift :=
  is_lawful_applicative.mk (fun (α β : Type u_1) (g : α → β) (_x : plift α) => sorry)
    (fun (α β : Type u_1) (g : α → β) (x : α) => rfl) (fun (α β : Type u_1) (_x : plift (α → β)) => sorry)
    fun (α β γ : Type u_1) (_x : plift α) => sorry

protected instance is_lawful_monad : is_lawful_monad plift :=
  is_lawful_monad.mk (fun (α β : Type u_1) (x : α) (f : α → plift β) => rfl)
    fun (α β γ : Type u_1) (_x : plift α) => sorry

@[simp] theorem rec.constant {α : Sort u} {β : Type v} (b : β) : (plift.rec fun (_x : α) => b) = fun (_x : plift α) => b :=
  funext fun (x : plift α) => cases_on x fun (a : α) => Eq.refl (plift.rec (fun (_x : α) => b) (up a))

end plift

namespace ulift

/-- Functorial action. -/
@[simp] protected def map {α : Type u} {β : Type v} (f : α → β) : ulift α → ulift β :=
  sorry

/-- Embedding of pure values. -/
@[simp] protected def pure {α : Type u} : α → ulift α :=
  up

/-- Applicative sequencing. -/
@[simp] protected def seq {α : Type u} {β : Type v} : ulift (α → β) → ulift α → ulift β :=
  sorry

/-- Monadic bind. -/
@[simp] protected def bind {α : Type u} {β : Type v} : ulift α → (α → ulift β) → ulift β :=
  sorry

-- The `up ∘ down` gives us more universe polymorphism than simply `f a`.

protected instance monad : Monad ulift :=
  { toApplicative :=
      { toFunctor := { map := ulift.map, mapConst := fun (α β : Type u_1) => ulift.map ∘ function.const β },
        toPure := { pure := ulift.pure }, toSeq := { seq := ulift.seq },
        toSeqLeft :=
          { seqLeft := fun (α β : Type u_1) (a : ulift α) (b : ulift β) => ulift.seq (ulift.map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : ulift α) (b : ulift β) => ulift.seq (ulift.map (function.const α id) a) b } },
    toBind := { bind := ulift.bind } }

protected instance is_lawful_functor : is_lawful_functor ulift :=
  is_lawful_functor.mk (fun (α : Type u_1) (_x : ulift α) => sorry)
    fun (α β γ : Type u_1) (g : α → β) (h : β → γ) (_x : ulift α) => sorry

protected instance is_lawful_applicative : is_lawful_applicative ulift :=
  is_lawful_applicative.mk (fun (α β : Type u_1) (g : α → β) (_x : ulift α) => sorry)
    (fun (α β : Type u_1) (g : α → β) (x : α) => rfl) (fun (α β : Type u_1) (_x : ulift (α → β)) => sorry)
    fun (α β γ : Type u_1) (_x : ulift α) => sorry

protected instance is_lawful_monad : is_lawful_monad ulift :=
  is_lawful_monad.mk
    (fun (α β : Type u_1) (x : α) (f : α → ulift β) =>
      id (cases_on (f x) fun (down : β) => Eq.refl (up (down (up down)))))
    fun (α β γ : Type u_1) (_x : ulift α) => sorry

@[simp] theorem rec.constant {α : Type u} {β : Sort v} (b : β) : (ulift.rec fun (_x : α) => b) = fun (_x : ulift α) => b :=
  funext fun (x : ulift α) => cases_on x fun (a : α) => Eq.refl (ulift.rec (fun (_x : α) => b) (up a))


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jeremy Avigad, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rel
import Mathlib.PostPort

universes u l u_1 u_2 u_3

namespace Mathlib

/-- `roption α` is the type of "partial values" of type `α`. It
  is similar to `option α` except the domain condition can be an
  arbitrary proposition, not necessarily decidable. -/
structure roption (α : Type u)
where
  dom : Prop
  get : dom → α

namespace roption

/-- Convert an `roption α` with a decidable domain to an option -/
def to_option {α : Type u_1} (o : roption α) [Decidable (dom o)] : Option α :=
  dite (dom o) (fun (h : dom o) => some (get o h)) fun (h : ¬dom o) => none

/-- `roption` extensionality -/
theorem ext' {α : Type u_1} {o : roption α} {p : roption α} (H1 : dom o ↔ dom p) (H2 : ∀ (h₁ : dom o) (h₂ : dom p), get o h₁ = get p h₂) : o = p := sorry

/-- `roption` eta expansion -/
@[simp] theorem eta {α : Type u_1} (o : roption α) : (mk (dom o) fun (h : dom o) => get o h) = o := sorry

/-- `a ∈ o` means that `o` is defined and equal to `a` -/
protected def mem {α : Type u_1} (a : α) (o : roption α) :=
  ∃ (h : dom o), get o h = a

protected instance has_mem {α : Type u_1} : has_mem α (roption α) :=
  has_mem.mk roption.mem

theorem mem_eq {α : Type u_1} (a : α) (o : roption α) : a ∈ o = ∃ (h : dom o), get o h = a :=
  rfl

theorem dom_iff_mem {α : Type u_1} {o : roption α} : dom o ↔ ∃ (y : α), y ∈ o := sorry

theorem get_mem {α : Type u_1} {o : roption α} (h : dom o) : get o h ∈ o :=
  Exists.intro h rfl

/-- `roption` extensionality -/
theorem ext {α : Type u_1} {o : roption α} {p : roption α} (H : ∀ (a : α), a ∈ o ↔ a ∈ p) : o = p := sorry

/-- The `none` value in `roption` has a `false` domain and an empty function. -/
def none {α : Type u_1} : roption α :=
  mk False False._oldrec

protected instance inhabited {α : Type u_1} : Inhabited (roption α) :=
  { default := none }

@[simp] theorem not_mem_none {α : Type u_1} (a : α) : ¬a ∈ none :=
  fun (h : a ∈ none) => Exists.fst h

/-- The `some a` value in `roption` has a `true` domain and the
  function returns `a`. -/
def some {α : Type u_1} (a : α) : roption α :=
  mk True fun (_x : True) => a

theorem mem_unique {α : Type u_1} : relator.left_unique has_mem.mem := sorry

theorem get_eq_of_mem {α : Type u_1} {o : roption α} {a : α} (h : a ∈ o) (h' : dom o) : get o h' = a :=
  mem_unique (Exists.intro h' rfl) h

@[simp] theorem get_some {α : Type u_1} {a : α} (ha : dom (some a)) : get (some a) ha = a :=
  rfl

theorem mem_some {α : Type u_1} (a : α) : a ∈ some a :=
  Exists.intro trivial rfl

@[simp] theorem mem_some_iff {α : Type u_1} {a : α} {b : α} : b ∈ some a ↔ b = a := sorry

theorem eq_some_iff {α : Type u_1} {a : α} {o : roption α} : o = some a ↔ a ∈ o := sorry

theorem eq_none_iff {α : Type u_1} {o : roption α} : o = none ↔ ∀ (a : α), ¬a ∈ o := sorry

theorem eq_none_iff' {α : Type u_1} {o : roption α} : o = none ↔ ¬dom o :=
  { mp := fun (e : o = none) => Eq.symm e ▸ id,
    mpr := fun (h : ¬dom o) => iff.mpr eq_none_iff fun (a : α) (h' : a ∈ o) => h (Exists.fst h') }

theorem some_ne_none {α : Type u_1} (x : α) : some x ≠ none :=
  id fun (h : some x = none) => id (eq.mpr (id (Eq._oldrec (Eq.refl (dom none)) (Eq.symm h))) trivial)

theorem ne_none_iff {α : Type u_1} {o : roption α} : o ≠ none ↔ ∃ (x : α), o = some x := sorry

theorem eq_none_or_eq_some {α : Type u_1} (o : roption α) : o = none ∨ ∃ (x : α), o = some x := sorry

@[simp] theorem some_inj {α : Type u_1} {a : α} {b : α} : some a = some b ↔ a = b :=
  function.injective.eq_iff fun (a b : α) (h : some a = some b) => congr_fun (eq_of_heq (and.right (mk.inj h))) trivial

@[simp] theorem some_get {α : Type u_1} {a : roption α} (ha : dom a) : some (get a ha) = a :=
  Eq.symm (iff.mpr eq_some_iff (Exists.intro ha rfl))

theorem get_eq_iff_eq_some {α : Type u_1} {a : roption α} {ha : dom a} {b : α} : get a ha = b ↔ a = some b := sorry

protected instance none_decidable {α : Type u_1} : Decidable (dom none) :=
  decidable.false

protected instance some_decidable {α : Type u_1} (a : α) : Decidable (dom (some a)) :=
  decidable.true

def get_or_else {α : Type u_1} (a : roption α) [Decidable (dom a)] (d : α) : α :=
  dite (dom a) (fun (ha : dom a) => get a ha) fun (ha : ¬dom a) => d

@[simp] theorem get_or_else_none {α : Type u_1} (d : α) : get_or_else none d = d :=
  dif_neg id

@[simp] theorem get_or_else_some {α : Type u_1} (a : α) (d : α) : get_or_else (some a) d = a :=
  dif_pos trivial

@[simp] theorem mem_to_option {α : Type u_1} {o : roption α} [Decidable (dom o)] {a : α} : a ∈ to_option o ↔ a ∈ o := sorry

/-- Convert an `option α` into an `roption α` -/
def of_option {α : Type u_1} : Option α → roption α :=
  sorry

@[simp] theorem mem_of_option {α : Type u_1} {a : α} {o : Option α} : a ∈ of_option o ↔ a ∈ o := sorry

@[simp] theorem of_option_dom {α : Type u_1} (o : Option α) : dom (of_option o) ↔ ↥(option.is_some o) := sorry

theorem of_option_eq_get {α : Type u_1} (o : Option α) : of_option o = mk (↥(option.is_some o)) option.get := sorry

protected instance has_coe {α : Type u_1} : has_coe (Option α) (roption α) :=
  has_coe.mk of_option

@[simp] theorem mem_coe {α : Type u_1} {a : α} {o : Option α} : a ∈ ↑o ↔ a ∈ o :=
  mem_of_option

@[simp] theorem coe_none {α : Type u_1} : ↑none = none :=
  rfl

@[simp] theorem coe_some {α : Type u_1} (a : α) : ↑(some a) = some a :=
  rfl

protected theorem induction_on {α : Type u_1} {P : roption α → Prop} (a : roption α) (hnone : P none) (hsome : ∀ (a : α), P (some a)) : P a :=
  or.elim (classical.em (dom a)) (fun (h : dom a) => some_get h ▸ hsome (get a h))
    fun (h : ¬dom a) => Eq.symm (iff.mpr eq_none_iff' h) ▸ hnone

protected instance of_option_decidable {α : Type u_1} (o : Option α) : Decidable (dom (of_option o)) :=
  sorry

@[simp] theorem to_of_option {α : Type u_1} (o : Option α) : to_option (of_option o) = o :=
  option.cases_on o (Eq.refl (to_option (of_option none))) fun (o : α) => Eq.refl (to_option (of_option (some o)))

@[simp] theorem of_to_option {α : Type u_1} (o : roption α) [Decidable (dom o)] : of_option (to_option o) = o :=
  ext fun (a : α) => iff.trans mem_of_option mem_to_option

def equiv_option {α : Type u_1} : roption α ≃ Option α :=
  equiv.mk (fun (o : roption α) => to_option o) of_option sorry sorry

protected instance order_bot {α : Type u_1} : order_bot (roption α) :=
  order_bot.mk none (fun (x y : roption α) => ∀ (i : α), i ∈ x → i ∈ y)
    (partial_order.lt._default fun (x y : roption α) => ∀ (i : α), i ∈ x → i ∈ y) sorry sorry sorry sorry

protected instance preorder {α : Type u_1} : preorder (roption α) :=
  partial_order.to_preorder (roption α)

theorem le_total_of_le_of_le {α : Type u_1} {x : roption α} {y : roption α} (z : roption α) (hx : x ≤ z) (hy : y ≤ z) : x ≤ y ∨ y ≤ x := sorry

/-- `assert p f` is a bind-like operation which appends an additional condition
  `p` to the domain and uses `f` to produce the value. -/
def assert {α : Type u_1} (p : Prop) (f : p → roption α) : roption α :=
  mk (∃ (h : p), dom (f h)) fun (ha : ∃ (h : p), dom (f h)) => get (f sorry) sorry

/-- The bind operation has value `g (f.get)`, and is defined when all the
  parts are defined. -/
protected def bind {α : Type u_1} {β : Type u_2} (f : roption α) (g : α → roption β) : roption β :=
  assert (dom f) fun (b : dom f) => g (get f b)

/-- The map operation for `roption` just maps the value and maintains the same domain. -/
def map {α : Type u_1} {β : Type u_2} (f : α → β) (o : roption α) : roption β :=
  mk (dom o) (f ∘ get o)

theorem mem_map {α : Type u_1} {β : Type u_2} (f : α → β) {o : roption α} {a : α} : a ∈ o → f a ∈ map f o := sorry

@[simp] theorem mem_map_iff {α : Type u_1} {β : Type u_2} (f : α → β) {o : roption α} {b : β} : b ∈ map f o ↔ ∃ (a : α), ∃ (H : a ∈ o), f a = b := sorry

@[simp] theorem map_none {α : Type u_1} {β : Type u_2} (f : α → β) : map f none = none := sorry

@[simp] theorem map_some {α : Type u_1} {β : Type u_2} (f : α → β) (a : α) : map f (some a) = some (f a) :=
  iff.mpr eq_some_iff (mem_map f (mem_some a))

theorem mem_assert {α : Type u_1} {p : Prop} {f : p → roption α} {a : α} (h : p) : a ∈ f h → a ∈ assert p f := sorry

@[simp] theorem mem_assert_iff {α : Type u_1} {p : Prop} {f : p → roption α} {a : α} : a ∈ assert p f ↔ ∃ (h : p), a ∈ f h := sorry

theorem assert_pos {α : Type u_1} {p : Prop} {f : p → roption α} (h : p) : assert p f = f h := sorry

theorem assert_neg {α : Type u_1} {p : Prop} {f : p → roption α} (h : ¬p) : assert p f = none := sorry

theorem mem_bind {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} {a : α} {b : β} : a ∈ f → b ∈ g a → b ∈ roption.bind f g := sorry

@[simp] theorem mem_bind_iff {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} {b : β} : b ∈ roption.bind f g ↔ ∃ (a : α), ∃ (H : a ∈ f), b ∈ g a := sorry

@[simp] theorem bind_none {α : Type u_1} {β : Type u_2} (f : α → roption β) : roption.bind none f = none := sorry

@[simp] theorem bind_some {α : Type u_1} {β : Type u_2} (a : α) (f : α → roption β) : roption.bind (some a) f = f a := sorry

theorem bind_some_eq_map {α : Type u_1} {β : Type u_2} (f : α → β) (x : roption α) : roption.bind x (some ∘ f) = map f x := sorry

theorem bind_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : roption α) (g : α → roption β) (k : β → roption γ) : roption.bind (roption.bind f g) k = roption.bind f fun (x : α) => roption.bind (g x) k := sorry

@[simp] theorem bind_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → β) (x : roption α) (g : β → roption γ) : roption.bind (map f x) g = roption.bind x fun (y : α) => g (f y) := sorry

@[simp] theorem map_bind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → roption β) (x : roption α) (g : β → γ) : map g (roption.bind x f) = roption.bind x fun (y : α) => map g (f y) := sorry

theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (g : β → γ) (f : α → β) (o : roption α) : map g (map f o) = map (g ∘ f) o := sorry

protected instance monad : Monad roption :=
  { toApplicative :=
      { toFunctor := { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β },
        toPure := { pure := some },
        toSeq :=
          { seq :=
              fun (α β : Type u_1) (f : roption (α → β)) (x : roption α) => roption.bind f fun (_x : α → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : roption α) (b : roption β) =>
                (fun (α β : Type u_1) (f : roption (α → β)) (x : roption α) =>
                    roption.bind f fun (_x : α → β) => map _x x)
                  β α (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : roption α) (b : roption β) =>
                (fun (α β : Type u_1) (f : roption (α → β)) (x : roption α) =>
                    roption.bind f fun (_x : α → β) => map _x x)
                  β β (map (function.const α id) a) b } },
    toBind := { bind := roption.bind } }

protected instance is_lawful_monad : is_lawful_monad roption :=
  is_lawful_monad.mk bind_some bind_assoc

theorem map_id' {α : Type u_1} {f : α → α} (H : ∀ (x : α), f x = x) (o : roption α) : map f o = o :=
  eq.mpr (id (Eq._oldrec (Eq.refl (map f o = o)) ((fun (this : f = id) => this) (funext H)))) (id_map o)

@[simp] theorem bind_some_right {α : Type u_1} (x : roption α) : roption.bind x some = x := sorry

@[simp] theorem pure_eq_some {α : Type u_1} (a : α) : pure a = some a :=
  rfl

@[simp] theorem ret_eq_some {α : Type u_1} (a : α) : return a = some a :=
  rfl

@[simp] theorem map_eq_map {α : Type u_1} {β : Type u_1} (f : α → β) (o : roption α) : f <$> o = map f o :=
  rfl

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

theorem bind_le {β : Type u_2} {α : Type u_2} (x : roption α) (f : α → roption β) (y : roption β) : x >>= f ≤ y ↔ ∀ (a : α), a ∈ x → f a ≤ y := sorry

protected instance monad_fail : monad_fail roption :=
  monad_fail.mk fun (_x : Type u_1) (_x_1 : string) => none

/- `restrict p o h` replaces the domain of `o` with `p`, and is well defined when
  `p` implies `o` is defined. -/

def restrict {α : Type u_1} (p : Prop) (o : roption α) : (p → dom o) → roption α :=
  sorry

@[simp] theorem mem_restrict {α : Type u_1} (p : Prop) (o : roption α) (h : p → dom o) (a : α) : a ∈ restrict p o h ↔ p ∧ a ∈ o := sorry

/-- `unwrap o` gets the value at `o`, ignoring the condition.
  (This function is unsound.) -/
theorem assert_defined {α : Type u_1} {p : Prop} {f : p → roption α} (h : p) : dom (f h) → dom (assert p f) :=
  exists.intro

theorem bind_defined {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} (h : dom f) : dom (g (get f h)) → dom (roption.bind f g) :=
  assert_defined

@[simp] theorem bind_dom {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} : dom (roption.bind f g) ↔ ∃ (h : dom f), dom (g (get f h)) :=
  iff.rfl

end roption

/-- `pfun α β`, or `α →. β`, is the type of partial functions from
  `α` to `β`. It is defined as `α → roption β`. -/
def pfun (α : Type u_1) (β : Type u_2) :=
  α → roption β

infixr:25 " →. " => Mathlib.pfun

namespace pfun

protected instance inhabited {α : Type u_1} {β : Type u_2} : Inhabited (α →. β) :=
  { default := fun (a : α) => roption.none }

/-- The domain of a partial function -/
def dom {α : Type u_1} {β : Type u_2} (f : α →. β) : set α :=
  set_of fun (a : α) => roption.dom (f a)

theorem mem_dom {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) : x ∈ dom f ↔ ∃ (y : β), y ∈ f x := sorry

theorem dom_eq {α : Type u_1} {β : Type u_2} (f : α →. β) : dom f = set_of fun (x : α) => ∃ (y : β), y ∈ f x :=
  set.ext (mem_dom f)

/-- Evaluate a partial function -/
def fn {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) (h : dom f x) : β :=
  roption.get (f x) h

/-- Evaluate a partial function to return an `option` -/
def eval_opt {α : Type u_1} {β : Type u_2} (f : α →. β) [D : decidable_pred (dom f)] (x : α) : Option β :=
  roption.to_option (f x)

/-- Partial function extensionality -/
theorem ext' {α : Type u_1} {β : Type u_2} {f : α →. β} {g : α →. β} (H1 : ∀ (a : α), a ∈ dom f ↔ a ∈ dom g) (H2 : ∀ (a : α) (p : dom f a) (q : dom g a), fn f a p = fn g a q) : f = g :=
  funext fun (a : α) => roption.ext' (H1 a) (H2 a)

theorem ext {α : Type u_1} {β : Type u_2} {f : α →. β} {g : α →. β} (H : ∀ (a : α) (b : β), b ∈ f a ↔ b ∈ g a) : f = g :=
  funext fun (a : α) => roption.ext (H a)

/-- Turn a partial function into a function out of a subtype -/
def as_subtype {α : Type u_1} {β : Type u_2} (f : α →. β) (s : ↥(dom f)) : β :=
  fn f ↑s sorry

/-- The set of partial functions `α →. β` is equivalent to
the set of pairs `(p : α → Prop, f : subtype p → β)`. -/
def equiv_subtype {α : Type u_1} {β : Type u_2} : (α →. β) ≃ sigma fun (p : α → Prop) => Subtype p → β :=
  equiv.mk (fun (f : α →. β) => sigma.mk (fun (a : α) => roption.dom (f a)) (as_subtype f))
    (fun (f : sigma fun (p : α → Prop) => Subtype p → β) (x : α) =>
      roption.mk (sigma.fst f x) fun (h : sigma.fst f x) => sigma.snd f { val := x, property := h })
    sorry sorry

theorem as_subtype_eq_of_mem {α : Type u_1} {β : Type u_2} {f : α →. β} {x : α} {y : β} (fxy : y ∈ f x) (domx : x ∈ dom f) : as_subtype f { val := x, property := domx } = y :=
  roption.mem_unique (roption.get_mem (as_subtype._proof_1 f { val := x, property := domx })) fxy

/-- Turn a total function into a partial function -/
protected def lift {α : Type u_1} {β : Type u_2} (f : α → β) : α →. β :=
  fun (a : α) => roption.some (f a)

protected instance has_coe {α : Type u_1} {β : Type u_2} : has_coe (α → β) (α →. β) :=
  has_coe.mk pfun.lift

@[simp] theorem lift_eq_coe {α : Type u_1} {β : Type u_2} (f : α → β) : pfun.lift f = ↑f :=
  rfl

@[simp] theorem coe_val {α : Type u_1} {β : Type u_2} (f : α → β) (a : α) : coe f a = roption.some (f a) :=
  rfl

/-- The graph of a partial function is the set of pairs
  `(x, f x)` where `x` is in the domain of `f`. -/
def graph {α : Type u_1} {β : Type u_2} (f : α →. β) : set (α × β) :=
  set_of fun (p : α × β) => prod.snd p ∈ f (prod.fst p)

def graph' {α : Type u_1} {β : Type u_2} (f : α →. β) : rel α β :=
  fun (x : α) (y : β) => y ∈ f x

/-- The range of a partial function is the set of values
  `f x` where `x` is in the domain of `f`. -/
def ran {α : Type u_1} {β : Type u_2} (f : α →. β) : set β :=
  set_of fun (b : β) => ∃ (a : α), b ∈ f a

/-- Restrict a partial function to a smaller domain. -/
def restrict {α : Type u_1} {β : Type u_2} (f : α →. β) {p : set α} (H : p ⊆ dom f) : α →. β :=
  fun (x : α) => roption.restrict (x ∈ p) (f x) H

@[simp] theorem mem_restrict {α : Type u_1} {β : Type u_2} {f : α →. β} {s : set α} (h : s ⊆ dom f) (a : α) (b : β) : b ∈ restrict f h a ↔ a ∈ s ∧ b ∈ f a := sorry

def res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) : α →. β :=
  restrict (pfun.lift f) (set.subset_univ s)

theorem mem_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (a : α) (b : β) : b ∈ res f s a ↔ a ∈ s ∧ f a = b := sorry

theorem res_univ {α : Type u_1} {β : Type u_2} (f : α → β) : res f set.univ = ↑f :=
  rfl

theorem dom_iff_graph {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) : x ∈ dom f ↔ ∃ (y : β), (x, y) ∈ graph f :=
  roption.dom_iff_mem

theorem lift_graph {α : Type u_1} {β : Type u_2} {f : α → β} {a : α} {b : β} : (a, b) ∈ graph ↑f ↔ f a = b := sorry

/-- The monad `pure` function, the total constant `x` function -/
protected def pure {α : Type u_1} {β : Type u_2} (x : β) : α →. β :=
  fun (_x : α) => roption.some x

/-- The monad `bind` function, pointwise `roption.bind` -/
def bind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α →. β) (g : β → α →. γ) : α →. γ :=
  fun (a : α) => roption.bind (f a) fun (b : β) => g b a

/-- The monad `map` function, pointwise `roption.map` -/
def map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : β → γ) (g : α →. β) : α →. γ :=
  fun (a : α) => roption.map f (g a)

protected instance monad {α : Type u_1} : Monad (pfun α) :=
  { toApplicative :=
      { toFunctor := { map := map, mapConst := fun (α_1 β : Type u_2) => map ∘ function.const β },
        toPure := { pure := pfun.pure },
        toSeq :=
          { seq := fun (α_1 β : Type u_2) (f : α →. α_1 → β) (x : α →. α_1) => bind f fun (_x : α_1 → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α_1 β : Type u_2) (a : α →. α_1) (b : α →. β) =>
                (fun (α_2 β : Type u_2) (f : α →. α_2 → β) (x : α →. α_2) => bind f fun (_x : α_2 → β) => map _x x) β α_1
                  (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α_1 β : Type u_2) (a : α →. α_1) (b : α →. β) =>
                (fun (α_2 β : Type u_2) (f : α →. α_2 → β) (x : α →. α_2) => bind f fun (_x : α_2 → β) => map _x x) β β
                  (map (function.const α_1 id) a) b } },
    toBind := { bind := bind } }

protected instance is_lawful_monad {α : Type u_1} : is_lawful_monad (pfun α) :=
  is_lawful_monad.mk (fun (β γ : Type u_2) (x : β) (f : β → α →. γ) => funext fun (a : α) => roption.bind_some a (f x))
    fun (β γ δ : Type u_2) (f : α →. β) (g : β → α →. γ) (k : γ → α →. δ) =>
      funext fun (a : α) => roption.bind_assoc (f a) (fun (b : β) => g b a) fun (b : γ) => k b a

theorem pure_defined {α : Type u_1} {β : Type u_2} (p : set α) (x : β) : p ⊆ dom (pfun.pure x) :=
  set.subset_univ p

theorem bind_defined {α : Type u_1} {β : Type u_2} {γ : Type u_2} (p : set α) {f : α →. β} {g : β → α →. γ} (H1 : p ⊆ dom f) (H2 : ∀ (x : β), p ⊆ dom (g x)) : p ⊆ dom (f >>= g) :=
  fun (a : α) (ha : a ∈ p) => Exists.intro (H1 ha) (H2 (roption.get (f a) (H1 ha)) ha)

def fix {α : Type u_1} {β : Type u_2} (f : α →. β ⊕ α) : α →. β :=
  fun (a : α) =>
    roption.assert (acc (fun (x y : α) => sum.inr x ∈ f y) a)
      fun (h : acc (fun (x y : α) => sum.inr x ∈ f y) a) =>
        well_founded.fix_F
          (fun (a : α) (IH : (y : α) → sum.inr y ∈ f a → roption β) =>
            roption.assert (roption.dom (f a))
              fun (hf : roption.dom (f a)) =>
                (fun (_x : β ⊕ α) (e : roption.get (f a) hf = _x) =>
                    sum.cases_on _x (fun (b : β) (e : roption.get (f a) hf = sum.inl b) => roption.some b)
                      (fun (a' : α) (e : roption.get (f a) hf = sum.inr a') => IH a' sorry) e)
                  (roption.get (f a) hf) sorry)
          a h

theorem dom_of_mem_fix {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {a : α} {b : β} (h : b ∈ fix f a) : roption.dom (f a) := sorry

theorem mem_fix_iff {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {a : α} {b : β} : b ∈ fix f a ↔ sum.inl b ∈ f a ∨ ∃ (a' : α), sum.inr a' ∈ f a ∧ b ∈ fix f a' := sorry

def fix_induction {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {b : β} {C : α → Sort u_3} {a : α} (h : b ∈ fix f a) (H : (a : α) → b ∈ fix f a → ((a' : α) → b ∈ fix f a' → sum.inr a' ∈ f a → C a') → C a) : C a := sorry

end pfun

namespace pfun

def image {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) : set β :=
  rel.image (graph' f) s

theorem image_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) : image f s = set_of fun (y : β) => ∃ (x : α), ∃ (H : x ∈ s), y ∈ f x :=
  rfl

theorem mem_image {α : Type u_1} {β : Type u_2} (f : α →. β) (y : β) (s : set α) : y ∈ image f s ↔ ∃ (x : α), ∃ (H : x ∈ s), y ∈ f x :=
  iff.rfl

theorem image_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set α} {t : set α} (h : s ⊆ t) : image f s ⊆ image f t :=
  rel.image_mono (graph' f) h

theorem image_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) (t : set α) : image f (s ∩ t) ⊆ image f s ∩ image f t :=
  rel.image_inter (graph' f) s t

theorem image_union {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) (t : set α) : image f (s ∪ t) = image f s ∪ image f t :=
  rel.image_union (graph' f) s t

def preimage {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : set α :=
  rel.preimage (fun (x : α) (y : β) => y ∈ f x) s

theorem preimage_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : preimage f s = set_of fun (x : α) => ∃ (y : β), ∃ (H : y ∈ s), y ∈ f x :=
  rfl

theorem mem_preimage {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (x : α) : x ∈ preimage f s ↔ ∃ (y : β), ∃ (H : y ∈ s), y ∈ f x :=
  iff.rfl

theorem preimage_subset_dom {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : preimage f s ⊆ dom f := sorry

theorem preimage_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set β} {t : set β} (h : s ⊆ t) : preimage f s ⊆ preimage f t :=
  rel.preimage_mono (fun (x : α) (y : β) => y ∈ f x) h

theorem preimage_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) : preimage f (s ∩ t) ⊆ preimage f s ∩ preimage f t :=
  rel.preimage_inter (fun (x : α) (y : β) => y ∈ f x) s t

theorem preimage_union {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) : preimage f (s ∪ t) = preimage f s ∪ preimage f t :=
  rel.preimage_union (fun (x : α) (y : β) => y ∈ f x) s t

theorem preimage_univ {α : Type u_1} {β : Type u_2} (f : α →. β) : preimage f set.univ = dom f := sorry

def core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : set α :=
  rel.core (graph' f) s

theorem core_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : core f s = set_of fun (x : α) => ∀ (y : β), y ∈ f x → y ∈ s :=
  rfl

theorem mem_core {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) (s : set β) : x ∈ core f s ↔ ∀ (y : β), y ∈ f x → y ∈ s :=
  iff.rfl

theorem compl_dom_subset_core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : dom fᶜ ⊆ core f s :=
  fun (x : α) (hx : x ∈ (dom fᶜ)) (y : β) (fxy : graph' f x y) => absurd (iff.mpr (mem_dom f x) (Exists.intro y fxy)) hx

theorem core_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set β} {t : set β} (h : s ⊆ t) : core f s ⊆ core f t :=
  rel.core_mono (graph' f) h

theorem core_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) : core f (s ∩ t) = core f s ∩ core f t :=
  rel.core_inter (graph' f) s t

theorem mem_core_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (t : set β) (x : α) : x ∈ core (res f s) t ↔ x ∈ s → f x ∈ t := sorry

theorem core_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (t : set β) : core (res f s) t = sᶜ ∪ f ⁻¹' t := sorry

theorem core_restrict {α : Type u_1} {β : Type u_2} (f : α → β) (s : set β) : core (↑f) s = f ⁻¹' s := sorry

theorem preimage_subset_core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : preimage f s ⊆ core f s := sorry

theorem preimage_eq {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : preimage f s = core f s ∩ dom f := sorry

theorem core_eq {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : core f s = preimage f s ∪ (dom fᶜ) := sorry

theorem preimage_as_subtype {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : as_subtype f ⁻¹' s = subtype.val ⁻¹' preimage f s := sorry


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.rewrite_search.explain
import Mathlib.tactic.rewrite_search.discovery
import Mathlib.tactic.rewrite_search.search
import Mathlib.PostPort

namespace Mathlib

/-!
# `rewrite_search`: solving goals by searching for a series of rewrites.

`rewrite_search` is a tactic for solving equalities or iff statements by searching for a
sequence of rewrite tactic applications.

## Algorithm sketch

The fundamental data structure behind the search algorithm is a graph of expressions. Each
vertex represents one expression, and an edge in the graph represents a way to rewrite one
expression into another with a single application of a rewrite tactic. Thus, a path in the
graph represents a way to rewrite one expression into another with multiple applications of
a rewrite tactic.

The graph starts out with two vertices, one for the left hand side of the equality, and one
for the right hand side of the equality. The basic loop of the algorithm is to repeatedly add
edges to the graph by taking vertices in the graph and applying a possible rewrite to them.
Through this process, the graph is made up of two connected components; one component contains
expressions that are equivalent to the left hand side, and one component contains expressions
that are equivalent to the right hand side. The algorithm completes when we discover an
edge that connects the two components, creating a path of rewrites that connects the
left hand side and right hand side of the graph. For more detail, see Keeley's report at
https://hoek.io/res/2018.s2.lean.report.pdf, although note that the edit distance mechanism
described is currently not implemented, only plain breadth-first search.

This algorithm is generally superior to one that only expands nodes starting from a single
side, because it is replacing one tree of depth `2d` with two trees of depth `d`. This is
a quadratic speedup for regular trees; our trees aren't regular but it's still probably
a much better algorithm. We can only use this specific algorithm for rewrite-type tactics,
though, not general sequences of tactics, because it relies on the fact that any rewrite
can be reversed.

## File structure

* `discovery.lean` contains the logic for figuring out which rewrite rules to consider.
* `search.lean` contains the graph algorithms to find a successful sequence of tactics.
* `explain.lean` generates concise Lean code to run a tactic, from the autogenerated sequence
  of tactics.
* `frontend.lean` contains the user-facing interface to the `rewrite_search` tactics.
* `types.lean` contains data structures shared across multiple of these components.
-/

namespace tactic.interactive

/--
Parse a specification for a single rewrite rule.
The name of a lemma indicates using it as a rewrite. Prepending a "←" reverses the direction.
-/
/--
Search for a chain of rewrites to prove an equation or iff statement.

Collects rewrite rules, runs a graph search to find a chain of rewrites to prove the
current target, and generates a string explanation for it.

Takes an optional list of rewrite rules specified in the same way as the `rw` tactic accepts.
-/


/-
# Tactics

Tactics are Lean programs that manipulate a custom state. All tactics are, in
the end, of type `TacticM Unit`. This has the type:

```lean
-- from Lean/Elab/Tactic/Basic.lean
TacticM = ReaderT Context $ StateRefT State TermElabM
```

But before demonstrating how to use `TacticM`, we shall explore macro-based
tactics.

## Tactics by Macro Expansion

Just like many other parts of the Lean 4 infrastructure, tactics too can be
declared by lightweight macro expansion.

For example, we build an example of a `custom_sorry_macro` that elaborates into
a `sorry`. We write this as a macro expansion, which expands the piece of syntax
`custom_sorry_macro` into the piece of syntax `sorry`:
-/

import Lean.Elab.Tactic

macro "custom_sorry_macro" : tactic => `(tactic| sorry)

example : 1 = 42 := by
  custom_sorry_macro

/-
### Implementing `trivial`: Extensible Tactics by Macro Expansion

As more complex examples, we can write a tactic such as `custom_tactic`, which
is initially completely unimplemented, and can be extended with more tactics.
We start by simply declaring the tactic with no implementation:
-/

syntax "custom_tactic" : tactic

example : 42 = 42 := by
  custom_tactic
-- tactic 'tacticCustom_tactic' has not been implemented
  sorry

/-
We will now add the `rfl` tactic into `custom_tactic`, which will allow us to
prove the previous theorem
-/

macro_rules
| `(tactic| custom_tactic) => `(tactic| rfl)

example : 42 = 42 := by
   custom_tactic
-- Goals accomplished 🎉

/-
We can now try a harder problem, that cannot be immediately dispatched by `rfl`:
-/

example : 43 = 43 ∧ 42 = 42:= by
  custom_tactic
-- tactic 'rfl' failed, equality expected
--   43 = 43 ∧ 42 = 42
-- ⊢ 43 = 43 ∧ 42 = 42

/-
We extend the `custom_tactic` tactic with a tactic that tries to break `And`
down with `apply And.intro`, and then (recursively (!)) applies `custom_tactic`
to the two cases with `(<;> trivial)` to solve the generated subcases `43 = 43`,
`42 = 42`.
-/

macro_rules
| `(tactic| custom_tactic) => `(tactic| apply And.intro <;> custom_tactic)

/-
The above declaration uses `<;>` which is a *tactic combinator*. Here, `a <;> b`
means "run tactic `a`, and apply "b" to each goal produced by `a`". Thus,
`And.intro <;> custom_tactic` means "run `And.intro`, and then run
`custom_tactic` on each goal". We test it out on our previous theorem and see
that we dispatch the theorem.
-/

example : 43 = 43 ∧ 42 = 42 := by
  custom_tactic
-- Goals accomplished 🎉

/-
In summary, we declared an extensible tactic called `custom_tactic`. It
initially had no elaboration at all. We added the `rfl` as an elaboration of
`custom_tactic`, which allowed it to solve the goal `42 = 42`. We then tried a
harder theorem, `43 = 43 ∧ 42 = 42` which `custom_tactic` was unable to solve.
We were then able to enrich `custom_tactic` to split "and" with `And.intro`, and
also *recursively* call `custom_tactic` in the two subcases.

### Implementing `<;>`: Tactic Combinators by Macro Expansion

Recall that in the previous section, we said that `a <;> b` meant "run `a`, and
then run `b` for all goals". In fact, `<;>` itself is a tactic macro. In this
section, we will implement the syntax `a and_then b` which will stand for
"run `a`, and then run `b` for all goals".
-/

-- 1. We declare the syntax `and_then`
syntax tactic " and_then " tactic : tactic

-- 2. We write the expander that expands the tactic
--    into running `a`, and then running `b` on all goals produced by `a`.
macro_rules
| `(tactic| $a:tactic and_then $b:tactic) =>
    `(tactic| $a:tactic; all_goals $b:tactic)

-- 3. We test this tactic.
theorem test_and_then: 1 = 1 ∧ 2 = 2 := by
  apply And.intro and_then rfl

#print test_and_then
-- theorem test_and_then : 1 = 1 ∧ 2 = 2 :=
-- { left := Eq.refl 1, right := Eq.refl 2 }

/-
## Exploring `TacticM`

### The simplest tactic: `sorry`

In this section, we wish to write a tactic that fills the proof with sorry:

```lean
example : 1 = 2 := by
  custom_sorry
```

We begin by declaring such a tactic:
-/

elab "custom_sorry_0" : tactic => do
  return

example : 1 = 2 := by
  custom_sorry_0
-- unsolved goals: ⊢ 1 = 2

/-
This defines a syntax extension to Lean, where we are naming the piece of syntax
`custom_sorry_0` as living in `tactic` syntax category. This informs the
elaborator that, in the context of elaborating `tactic`s, the piece of syntax
`custom_sorry_0` must be elaborated as what we write to the right-hand-side of
the `=>` (the actual implementation of the tactic).

Next, we write a term in `TacticM Unit` to fill in the goal with `sorryAx α`,
which can synthesize an artificial term of type `α`. To do this, we first access
the goal with `Lean.Elab.Tactic.getMainGoal : Tactic MVarId`, which returns the
main goal, represented as a metavariable. Recall that under
types-as-propositions, the type of our goal must be the proposition that `1 = 2`.
We check this by printing the type of `goal`.

But first we need to start our tactic with `Lean.Elab.Tactic.withMainContext`,
which computes in `TacticM` with an updated context.
-/

elab "custom_sorry_1" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goal ← Lean.Elab.Tactic.getMainGoal
    let goalDecl ← goal.getDecl
    let goalType := goalDecl.type
    dbg_trace f!"goal type: {goalType}"

example : 1 = 2 := by
  custom_sorry_1
-- goal type: Eq.{1} Nat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))
-- unsolved goals: ⊢ 1 = 2

/-
To `sorry` the goal, we can use the helper `Lean.Elab.admitGoal`:
-/

elab "custom_sorry_2" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goal ← Lean.Elab.Tactic.getMainGoal
    Lean.Elab.admitGoal goal

theorem test_custom_sorry : 1 = 2 := by
  custom_sorry_2

#print test_custom_sorry
-- theorem test_custom_sorry : 1 = 2 :=
-- sorryAx (1 = 2) true

/-
And we no longer have the error `unsolved goals: ⊢ 1 = 2`.

### The `custom_assump` tactic: Accessing Hypotheses

In this section, we will learn how to access the hypotheses to prove a goal. In
particular, we shall attempt to implement a tactic `custom_assump`, which looks
for an exact match of the goal among the hypotheses, and solves the theorem if
possible.

In the example below, we expect `custom_assump` to use `(H2 : 2 = 2)` to solve
the goal `(2 = 2)`:

```lean
theorem assump_correct (H1 : 1 = 1) (H2 : 2 = 2) : 2 = 2 := by
  custom_assump

#print assump_correct
-- theorem assump_correct : 1 = 1 → 2 = 2 → 2 = 2 :=
-- fun H1 H2 => H2
```

When we do not have a matching hypothesis to the goal, we expect the tactic
`custom_assump` to throw an error, telling us that we cannot find a hypothesis
of the type we are looking for:

```lean
theorem assump_wrong (H1 : 1 = 1) : 2 = 2 := by
  custom_assump

#print assump_wrong
-- tactic 'custom_assump' failed, unable to find matching hypothesis of type (2 = 2)
-- H1 : 1 = 1
-- ⊢ 2 = 2
```

We begin by accessing the goal and the type of the goal so we know what we
are trying to prove. The `goal` variable will soon be used to help us create
error messages.
-/

elab "custom_assump_0" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goalType ← Lean.Elab.Tactic.getMainTarget
    dbg_trace f!"goal type: {goalType}"

example (H1 : 1 = 1) (H2 : 2 = 2): 2 = 2 := by
  custom_assump_0
-- goal type: Eq.{1} Nat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))
-- unsolved goals
-- H1 : 1 = 1
-- H2 : 2 = 2
-- ⊢ 2 = 2

example (H1 : 1 = 1): 2 = 2 := by
  custom_assump_0
-- goal type: Eq.{1} Nat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))
-- unsolved goals
-- H1 : 1 = 1
-- ⊢ 2 = 2

/-
Next, we access the list of hypotheses, which are stored in a data structure
called `LocalContext`. This is accessed via `Lean.MonadLCtx.getLCtx`. The
`LocalContext` contains `LocalDeclaration`s, from which we can extract
information such as the name that is given to declarations (`.userName`), the
expression of the declaration (`.toExpr`). Let's write a tactic called
`list_local_decls` that prints the local declarations:
-/

elab "list_local_decls_1" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let ctx ← Lean.MonadLCtx.getLCtx -- get the local context.
    ctx.forM fun decl: Lean.LocalDecl => do
      let declExpr := decl.toExpr -- Find the expression of the declaration.
      let declName := decl.userName -- Find the name of the declaration.
      dbg_trace f!"+ local decl: name: {declName} | expr: {declExpr}"

example (H1 : 1 = 1) (H2 : 2 = 2): 1 = 1 := by
  list_local_decls_1
-- + local decl: name: test_list_local_decls_1 | expr: _uniq.3339
-- + local decl: name: H1 | expr: _uniq.3340
-- + local decl: name: H2 | expr: _uniq.3341
  rfl

/-
Recall that we are looking for a local declaration that has the same type as the
hypothesis. We get the type of `LocalDecl` by calling
`Lean.Meta.inferType` on the local declaration's expression.
-/

elab "list_local_decls_2" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let ctx ← Lean.MonadLCtx.getLCtx -- get the local context.
    ctx.forM fun decl: Lean.LocalDecl => do
      let declExpr := decl.toExpr -- Find the expression of the declaration.
      let declName := decl.userName -- Find the name of the declaration.
      let declType ← Lean.Meta.inferType declExpr -- **NEW:** Find the type.
      dbg_trace f!"+ local decl: name: {declName} | expr: {declExpr} | type: {declType}"

example (H1 : 1 = 1) (H2 : 2 = 2): 1 = 1 := by
  list_local_decls_2
  -- + local decl: name: test_list_local_decls_2 | expr: _uniq.4263 | type: (Eq.{1} Nat ...)
  -- + local decl: name: H1 | expr: _uniq.4264 | type: Eq.{1} Nat ...)
  -- + local decl: name: H2 | expr: _uniq.4265 | type: Eq.{1} Nat ...)
  rfl

/-
We check if the type of the `LocalDecl` is equal to the goal type with
`Lean.Meta.isExprDefEq`. See that we check if the types are equal at `eq?`, and
we print that `H1` has the same type as the goal
(`local decl[EQUAL? true]: name: H1`), and we print that `H2` does not have the
same type (`local decl[EQUAL? false]: name: H2 `):
-/

elab "list_local_decls_3" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goalType ← Lean.Elab.Tactic.getMainTarget
    let ctx ← Lean.MonadLCtx.getLCtx -- get the local context.
    ctx.forM fun decl: Lean.LocalDecl => do
      let declExpr := decl.toExpr -- Find the expression of the declaration.
      let declName := decl.userName -- Find the name of the declaration.
      let declType ← Lean.Meta.inferType declExpr -- Find the type.
      let eq? ← Lean.Meta.isExprDefEq declType goalType -- **NEW** Check if type equals goal type.
      dbg_trace f!"+ local decl[EQUAL? {eq?}]: name: {declName}"

example (H1 : 1 = 1) (H2 : 2 = 2): 1 = 1 := by
  list_local_decls_3
-- + local decl[EQUAL? false]: name: test_list_local_decls_3
-- + local decl[EQUAL? true]: name: H1
-- + local decl[EQUAL? false]: name: H2
  rfl

/-
Finally, we put all of these parts together to write a tactic that loops over
all declarations and finds one with the correct type. We loop over declarations
with `lctx.findDeclM?`. We infer the type of declarations with
`Lean.Meta.inferType`. We check that the declaration has the same type as the
goal with `Lean.Meta.isExprDefEq`:
-/

elab "custom_assump_1" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goalType ← Lean.Elab.Tactic.getMainTarget
    let lctx ← Lean.MonadLCtx.getLCtx
    -- Iterate over the local declarations...
    let option_matching_expr ← lctx.findDeclM? fun ldecl: Lean.LocalDecl => do
      let declExpr := ldecl.toExpr -- Find the expression of the declaration.
      let declType ← Lean.Meta.inferType declExpr -- Find the type.
      if (← Lean.Meta.isExprDefEq declType goalType) -- Check if type equals goal type.
      then return some declExpr -- If equal, success!
      else return none          -- Not found.
    dbg_trace f!"matching_expr: {option_matching_expr}"

example (H1 : 1 = 1) (H2 : 2 = 2) : 2 = 2 := by
  custom_assump_1
-- matching_expr: some _uniq.6241
  rfl

example (H1 : 1 = 1) : 2 = 2 := by
  custom_assump_1
-- matching_expr: none
  rfl

/-
Now that we are able to find the matching expression, we need to close the
theorem by using the match. We do this with `Lean.Elab.Tactic.closeMainGoal`.
When we do not have a matching expression, we throw an error with
`Lean.Meta.throwTacticEx`, which allows us to report an error corresponding to a
given goal. When throwing this error, we format the error using `m!"..."` which
builds a `MessageData`. This provides nicer error messages than using `f!"..."`
which builds a `Format`. This is because `MessageData` also runs *delaboration*,
which allows it to convert raw Lean terms like
`(Eq.{1} Nat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))`
into readable strings like`(2 = 2)`. The full code listing given below shows how
to do this:
-/

elab "custom_assump_2" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goal ← Lean.Elab.Tactic.getMainGoal
    let goalType ← Lean.Elab.Tactic.getMainTarget
    let ctx ← Lean.MonadLCtx.getLCtx
    let option_matching_expr ← ctx.findDeclM? fun decl: Lean.LocalDecl => do
      let declExpr := decl.toExpr
      let declType ← Lean.Meta.inferType declExpr
      if ← Lean.Meta.isExprDefEq declType goalType
        then return Option.some declExpr
        else return Option.none
    match option_matching_expr with
    | some e => Lean.Elab.Tactic.closeMainGoal e
    | none =>
      Lean.Meta.throwTacticEx `custom_assump_2 goal
        (m!"unable to find matching hypothesis of type ({goalType})")

example (H1 : 1 = 1) (H2 : 2 = 2) : 2 = 2 := by
  custom_assump_2

example (H1 : 1 = 1): 2 = 2 := by
  custom_assump_2
-- tactic 'custom_assump_2' failed, unable to find matching hypothesis of type (2 = 2)
-- H1 : 1 = 1
-- ⊢ 2 = 2

/-
### Tweaking the context

Until now, we've only performed read-like operations with the context. But what
if we want to change it? In this section we will see how to change the order of
goals and how to add content to it (new hypotheses).

Then, after elaborating our terms, we will need to use the helper function
`Lean.Elab.Tactic.liftMetaTactic`, which allows us to run computations in
`MetaM` while also giving us the goal `MVarId` for us to play with. In the end
of our computation, `liftMetaTactic` expects us to return a `List MVarId` as the
resulting list of goals.

The only substantial difference between `custom_let` and `custom_have` is that
the former uses `Lean.MVarId.define` and the later uses `Lean.MVarId.assert`:
-/

open Lean.Elab.Tactic in
elab "custom_let " n:ident " : " t:term " := " v:term : tactic =>
  withMainContext do
    let t ← elabTerm t none
    let v ← elabTermEnsuringType v t
    liftMetaTactic fun mvarId => do
      let mvarIdNew ← mvarId.define n.getId t v
      let (_, mvarIdNew) ← mvarIdNew.intro1P
      return [mvarIdNew]

open Lean.Elab.Tactic in
elab "custom_have " n:ident " : " t:term " := " v:term : tactic =>
  withMainContext do
    let t ← elabTerm t none
    let v ← elabTermEnsuringType v t
    liftMetaTactic fun mvarId => do
      let mvarIdNew ← mvarId.assert n.getId t v
      let (_, mvarIdNew) ← mvarIdNew.intro1P
      return [mvarIdNew]

theorem test_faq_have : True := by
  custom_let n : Nat := 5
  custom_have h : n = n := rfl
-- n : Nat := 5
-- h : n = n
-- ⊢ True
  trivial

/-
### "Getting" and "Setting" the list of goals

To illustrate these, let's build a tactic that can reverse the list of goals.
We can use `Lean.Elab.Tactic.getGoals` and `Lean.Elab.Tactic.setGoals`:
-/

elab "reverse_goals" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goals : List Lean.MVarId ← Lean.Elab.Tactic.getGoals
    Lean.Elab.Tactic.setGoals goals.reverse

theorem test_reverse_goals : (1 = 2 ∧ 3 = 4) ∧ 5 = 6 := by
  constructor
  constructor
-- case left.left
-- ⊢ 1 = 2
-- case left.right
-- ⊢ 3 = 4
-- case right
-- ⊢ 5 = 6
  reverse_goals
-- case right
-- ⊢ 5 = 6
-- case left.right
-- ⊢ 3 = 4
-- case left.left
-- ⊢ 1 = 2

/-
## FAQ

In this section, we collect common patterns that are used during writing tactics,
to make it easy to find common patterns.

**Q: How do I use goals?**

A: Goals are represented as metavariables. The module `Lean.Elab.Tactic.Basic`
has many functions to add new goals, switch goals, etc.

**Q: How do I get the main goal?**

A: Use `Lean.Elab.Tactic.getMainGoal`.
-/

elab "faq_main_goal" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goal ← Lean.Elab.Tactic.getMainGoal
    dbg_trace f!"goal: {goal.name}"

example : 1 = 1 := by
  faq_main_goal
-- goal: _uniq.9298
  rfl

/-
**Q: How do I get the list of goals?**

A: Use `getGoals`.
-/

elab "faq_get_goals" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goals ← Lean.Elab.Tactic.getGoals
    goals.forM $ fun goal => do
      let goalType ← goal.getType
      dbg_trace f!"goal: {goal.name} | type: {goalType}"

example (b : Bool) : b = true := by
  cases b
  faq_get_goals
-- goal: _uniq.10067 | type: Eq.{1} Bool Bool.false Bool.true
-- goal: _uniq.10078 | type: Eq.{1} Bool Bool.true Bool.true
  sorry
  rfl

/-
**Q: How do I get the current hypotheses for a goal?**

A: Use `Lean.MonadLCtx.getLCtx` which provides the local context, and then
iterate on the `LocalDeclaration`s of the `LocalContext` with accessors such as
`foldlM` and `forM`.
-/

elab "faq_get_hypotheses" : tactic =>
  Lean.Elab.Tactic.withMainContext do
  let ctx ← Lean.MonadLCtx.getLCtx -- get the local context.
  ctx.forM (fun (decl : Lean.LocalDecl) => do
    let declExpr := decl.toExpr -- Find the expression of the declaration.
    let declType := decl.type -- Find the type of the declaration.
    let declName := decl.userName -- Find the name of the declaration.
    dbg_trace f!" local decl: name: {declName} | expr: {declExpr} | type: {declType}"
  )

example (H1 : 1 = 1) (H2 : 2 = 2): 3 = 3 := by
  faq_get_hypotheses
  -- local decl: name: _example | expr: _uniq.10814 | type: ...
  -- local decl: name: H1 | expr: _uniq.10815 | type: ...
  -- local decl: name: H2 | expr: _uniq.10816 | type: ...
  rfl

/-
**Q: How do I evaluate a tactic?**

A: Use `Lean.Elab.Tactic.evalTactic: Syntax → TacticM Unit` which evaluates a
given tactic syntax. One can create tactic syntax using the macro
`` `(tactic| ⋯)``.

For example, one could call `try rfl` with the piece of code:

```lean
Lean.Elab.Tactic.evalTactic (← `(tactic| try rfl))
```

**Q: How do I check if two expressions are equal?**

A: Use `Lean.Meta.isExprDefEq <expr-1> <expr-2>`.
-/

#check Lean.Meta.isExprDefEq
-- Lean.Meta.isExprDefEq : Lean.Expr → Lean.Expr → Lean.MetaM Bool

/-
**Q: How do I throw an error from a tactic?**

A: Use `throwTacticEx <tactic-name> <goal-mvar> <error>`.
-/

elab "faq_throw_error" : tactic =>
  Lean.Elab.Tactic.withMainContext do
    let goal ← Lean.Elab.Tactic.getMainGoal
    Lean.Meta.throwTacticEx `faq_throw_error goal "throwing an error at the current goal"

example (b : Bool): b = true := by
  cases b;
  faq_throw_error
  -- case true
  -- ⊢ true = true
  -- tactic 'faq_throw_error' failed, throwing an error at the current goal
  -- case false
  -- ⊢ false = true

/-
**Q: What is the difference between `Lean.Elab.Tactic.*` and `Lean.Meta.Tactic.*`?**

A: `Lean.Meta.Tactic.*` contains low level code that uses the `Meta` monad to
implement basic features such as rewriting. `Lean.Elab.Tactic.*` contains
high-level code that connects the low level development in `Lean.Meta` to the
tactic infrastructure and the parsing front-end.
-/


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.l1_space
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Density of simple functions

Show that each Borel measurable function can be approximated,
both pointwise and in `L¹` norm, by a sequence of simple functions.

## Main definitions

* `measure_theory.simple_func.nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ ℕ`: the `simple_func` sending
  each `x : α` to the point `e k` which is the nearest to `x` among `e 0`, ..., `e N`.
* `measure_theory.simple_func.approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α)
  (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) : β →ₛ α` : a simple function that takes values in `s`
  and approximates `f`. If `f x ∈ s`, then `measure_theory.simple_func.approx_on f hf s y₀ h₀ n x`
  tends to `f x` as `n` tends to `∞`. If `α` is a `normed_group`, `f x - y₀`
  is `measure_theory.integrable`, and `f x ∈ s` for a.e. `x`, then
  `simple_func.approx_on f hf s y₀ h₀ n` tends to `f` in `L₁`. The main use case is `s = univ`,
  `y₀ = 0`.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
-/

namespace measure_theory

namespace simple_func

/-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
`nearest_pt_ind e N x` returns the least of their indexes. -/
def nearest_pt_ind {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α]
    (e : ℕ → α) : ℕ → simple_func α ℕ :=
  sorry

/-- `nearest_pt e N x` is the nearest point to `x` among the points `e 0`, ..., `e N`. If more than
one point are at the same distance from `x`, then `nearest_pt e N x` returns the point with the
least possible index. -/
def nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α]
    (e : ℕ → α) (N : ℕ) : simple_func α α :=
  map e (nearest_pt_ind e N)

@[simp] theorem nearest_pt_ind_zero {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] (e : ℕ → α) : nearest_pt_ind e 0 = const α 0 :=
  rfl

@[simp] theorem nearest_pt_zero {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] (e : ℕ → α) : nearest_pt e 0 = const α (e 0) :=
  rfl

theorem nearest_pt_ind_succ {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) :
    coe_fn (nearest_pt_ind e (N + 1)) x =
        ite (∀ (k : ℕ), k ≤ N → edist (e (N + 1)) x < edist (e k) x) (N + 1)
          (coe_fn (nearest_pt_ind e N) x) :=
  sorry

theorem nearest_pt_ind_le {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) : coe_fn (nearest_pt_ind e N) x ≤ N :=
  sorry

theorem edist_nearest_pt_le {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] (e : ℕ → α) (x : α) {k : ℕ} {N : ℕ} (hk : k ≤ N) :
    edist (coe_fn (nearest_pt e N) x) x ≤ edist (e k) x :=
  sorry

theorem tendsto_nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] {e : ℕ → α} {x : α} (hx : x ∈ closure (set.range e)) :
    filter.tendsto (fun (N : ℕ) => coe_fn (nearest_pt e N) x) filter.at_top (nhds x) :=
  sorry

/-- Approximate a measurable function by a sequence of simple functions `F n` such that
`F n x ∈ s`. -/
def approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] (f : β → α) (hf : measurable f) (s : set α)
    (y₀ : α) (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) : simple_func β α :=
  comp (nearest_pt (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n) f hf

@[simp] theorem approx_on_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α}
    {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) :
    coe_fn (approx_on f hf s y₀ h₀ 0) x = y₀ :=
  rfl

theorem approx_on_mem {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α}
    {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) (x : β) :
    coe_fn (approx_on f hf s y₀ h₀ n) x ∈ s :=
  (fun (n_1 : ℕ) =>
      nat.cases_on n_1 h₀ fun (n : ℕ) => subtype.mem (topological_space.dense_seq (↥s) n))
    (coe_fn
      (nearest_pt_ind (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n)
      (f x))

@[simp] theorem approx_on_comp {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {γ : Type u_3} [measurable_space γ] {f : β → α}
    (hf : measurable f) {g : γ → β} (hg : measurable g) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [topological_space.separable_space ↥s] (n : ℕ) :
    approx_on (f ∘ g) (measurable.comp hf hg) s y₀ h₀ n = comp (approx_on f hf s y₀ h₀ n) g hg :=
  rfl

theorem tendsto_approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α}
    {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {x : β} (hx : f x ∈ closure s) :
    filter.tendsto (fun (n : ℕ) => coe_fn (approx_on f hf s y₀ h₀ n) x) filter.at_top
        (nhds (f x)) :=
  sorry

theorem edist_approx_on_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α}
    {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) :
    edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x) ≤ edist y₀ (f x) :=
  id
    (edist_nearest_pt_le (Nat.rec y₀ fun (n : ℕ) (ih : α) => ↑(topological_space.dense_seq (↥s) n))
      (f x) (zero_le n))

theorem edist_approx_on_y0_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α]
    [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α}
    {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) :
    edist y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) ≤ edist y₀ (f x) + edist y₀ (f x) :=
  le_trans (edist_triangle_right y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
    (add_le_add_left (edist_approx_on_le hf h₀ x n) (edist y₀ (f x)))

theorem norm_approx_on_zero_le {β : Type u_2} {E : Type u_4} [measurable_space β]
    [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f)
    {s : set E} (h₀ : 0 ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) :
    norm (coe_fn (approx_on f hf s 0 h₀ n) x) ≤ norm (f x) + norm (f x) :=
  sorry

theorem tendsto_approx_on_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β]
    [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f)
    {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {μ : measure β}
    (hμ : filter.eventually (fun (x : β) => f x ∈ closure s) (measure.ae μ))
    (hi : has_finite_integral fun (x : β) => f x - y₀) :
    filter.tendsto
        (fun (n : ℕ) =>
          lintegral μ fun (x : β) => edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
        filter.at_top (nhds 0) :=
  sorry

theorem integrable_approx_on {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E]
    [normed_group E] [borel_space E] {f : β → E} {μ : measure β} (fmeas : measurable f)
    (hf : integrable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s]
    (hi₀ : integrable fun (x : β) => y₀) (n : ℕ) : integrable ⇑(approx_on f fmeas s y₀ h₀ n) :=
  sorry

theorem tendsto_approx_on_univ_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β]
    [measurable_space E] [normed_group E] [opens_measurable_space E]
    [topological_space.second_countable_topology E] {f : β → E} {μ : measure β}
    (fmeas : measurable f) (hf : integrable f) :
    filter.tendsto
        (fun (n : ℕ) =>
          lintegral μ
            fun (x : β) => edist (coe_fn (approx_on f fmeas set.univ 0 trivial n) x) (f x))
        filter.at_top (nhds 0) :=
  sorry

theorem integrable_approx_on_univ {β : Type u_2} {E : Type u_4} [measurable_space β]
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {f : β → E} {μ : measure β}
    (fmeas : measurable f) (hf : integrable f) (n : ℕ) :
    integrable ⇑(approx_on f fmeas set.univ 0 trivial n) :=
  integrable_approx_on fmeas hf trivial (integrable_zero β E μ) n

theorem tendsto_approx_on_univ_l1 {β : Type u_2} {E : Type u_4} [measurable_space β]
    [measurable_space E] [normed_group E] [borel_space E]
    [topological_space.second_countable_topology E] {f : β → E} {μ : measure β}
    (fmeas : measurable f) (hf : integrable f) :
    filter.tendsto
        (fun (n : ℕ) =>
          l1.of_fun (⇑(approx_on f fmeas set.univ 0 trivial n))
            (integrable_approx_on_univ fmeas hf n))
        filter.at_top (nhds (l1.of_fun f hf)) :=
  iff.mpr tendsto_iff_edist_tendsto_0 (tendsto_approx_on_univ_l1_edist fmeas hf)

end Mathlib