/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.monad.basic
import Mathlib.control.monad.cont
import Mathlib.control.monad.writer
import Mathlib.data.equiv.basic
import Mathlib.tactic.interactive
import Mathlib.PostPort

universes u₀ u₁ v₀ v₁ l u_1 u_2 u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# Universe lifting for type families

Some functors such as `option` and `list` are universe polymorphic. Unlike
type polymorphism where `option α` is a function application and reasoning and
generalizations that apply to functions can be used, `option.{u}` and `option.{v}`
are not one function applied to two universe names but one polymorphic definition
instantiated twice. This means that whatever works on `option.{u}` is hard
to transport over to `option.{v}`. `uliftable` is an attempt at improving the situation.

`uliftable option.{u} option.{v}` gives us a generic and composable way to use
`option.{u}` in a context that requires `option.{v}`. It is often used in tandem with
`ulift` but the two are purposefully decoupled.

## Main definitions
  * `uliftable` class

## Tags

universe polymorphism functor

-/

/-- Given a universe polymorphic type family `M.{u} : Type u₁ → Type
u₂`, this class convert between instantiations, from
`M.{u} : Type u₁ → Type u₂` to `M.{v} : Type v₁ → Type v₂` and back -/
class uliftable (f : Type u₀ → Type u₁) (g : Type v₀ → Type v₁)
where
  congr : {α : Type u₀} → {β : Type v₀} → α ≃ β → f α ≃ g β

namespace uliftable

/-- The most common practical use `uliftable` (together with `up`), this function takes
`x : M.{u} α` and lifts it to M.{max u v} (ulift.{v} α) -/
def up {f : Type u₀ → Type u₁} {g : Type (max u₀ v₀) → Type v₁} [uliftable f g] {α : Type u₀} : f α → g (ulift α) :=
  equiv.to_fun (congr f g (equiv.symm equiv.ulift))

/-- The most common practical use of `uliftable` (together with `up`), this function takes
`x : M.{max u v} (ulift.{v} α)` and lowers it to `M.{u} α` -/
def down {f : Type u₀ → Type u₁} {g : Type (max u₀ v₀) → Type v₁} [uliftable f g] {α : Type u₀} : g (ulift α) → f α :=
  equiv.inv_fun (congr f g (equiv.symm equiv.ulift))

/-- convenient shortcut to avoid manipulating `ulift` -/
def adapt_up (F : Type v₀ → Type v₁) (G : Type (max v₀ u₀) → Type u₁) [uliftable F G] [Monad G] {α : Type v₀} {β : Type (max v₀ u₀)} (x : F α) (f : α → G β) : G β :=
  up x >>= f ∘ ulift.down

/-- convenient shortcut to avoid manipulating `ulift` -/
def adapt_down {F : Type (max u₀ v₀) → Type u₁} {G : Type v₀ → Type v₁} [L : uliftable G F] [Monad F] {α : Type (max u₀ v₀)} {β : Type v₀} (x : F α) (f : α → G β) : G β :=
  down (x >>= up ∘ f)

/-- map function that moves up universes -/
def up_map {F : Type u₀ → Type u₁} {G : Type (max u₀ v₀) → Type v₁} [inst : uliftable F G] [Functor G] {α : Type u₀} {β : Type (max u₀ v₀)} (f : α → β) (x : F α) : G β :=
  (f ∘ ulift.down) <$> up x

/-- map function that moves down universes -/
def down_map {F : Type (max u₀ v₀) → Type u₁} {G : Type → Type v₁} [inst : uliftable G F] [Functor F] {α : Type (max u₀ v₀)} {β : Type} (f : α → β) (x : F α) : G β :=
  down ((ulift.up ∘ f) <$> x)

@[simp] theorem up_down {f : Type u₀ → Type u₁} {g : Type (max u₀ v₀) → Type v₁} [uliftable f g] {α : Type u₀} (x : g (ulift α)) : up (down x) = x :=
  equiv.right_inv (congr f g (equiv.symm equiv.ulift)) x

@[simp] theorem down_up {f : Type u₀ → Type u₁} {g : Type (max u₀ v₀) → Type v₁} [uliftable f g] {α : Type u₀} (x : f α) : down (up x) = x :=
  equiv.left_inv (congr f g (equiv.symm equiv.ulift)) x

end uliftable

protected instance id.uliftable : uliftable id id :=
  uliftable.mk fun (α : Type u_1) (β : Type u_2) (F : α ≃ β) => F

/-- for specific state types, this function helps to create a uliftable instance -/
def state_t.uliftable' {s : Type u₀} {s' : Type u₁} {m : Type u₀ → Type v₀} {m' : Type u₁ → Type v₁} [uliftable m m'] (F : s ≃ s') : uliftable (state_t s m) (state_t s' m') :=
  uliftable.mk
    fun (α : Type u₀) (β : Type u₁) (G : α ≃ β) =>
      state_t.equiv (equiv.Pi_congr F fun (_x : s) => uliftable.congr m m' (equiv.prod_congr G F))

protected instance state_t.uliftable {s : Type u_1} {m : Type u_1 → Type u_2} {m' : Type (max u_1 u_3) → Type u_4} [uliftable m m'] : uliftable (state_t s m) (state_t (ulift s) m') :=
  state_t.uliftable' (equiv.symm equiv.ulift)

/-- for specific reader monads, this function helps to create a uliftable instance -/
def reader_t.uliftable' {s : Type u_1} {s' : Type u_2} {m : Type u_1 → Type u_3} {m' : Type u_2 → Type u_4} [uliftable m m'] (F : s ≃ s') : uliftable (reader_t s m) (reader_t s' m') :=
  uliftable.mk
    fun (α : Type u_1) (β : Type u_2) (G : α ≃ β) =>
      reader_t.equiv (equiv.Pi_congr F fun (_x : s) => uliftable.congr m m' G)

protected instance reader_t.uliftable {s : Type u_1} {m : Type u_1 → Type u_2} {m' : Type (max u_1 u_3) → Type u_4} [uliftable m m'] : uliftable (reader_t s m) (reader_t (ulift s) m') :=
  reader_t.uliftable' (equiv.symm equiv.ulift)

/-- for specific continuation passing monads, this function helps to create a uliftable instance -/
def cont_t.uliftable' {r : Type u_1} {r' : Type u_2} {m : Type u_1 → Type u_3} {m' : Type u_2 → Type u_4} [uliftable m m'] (F : r ≃ r') : uliftable (cont_t r m) (cont_t r' m') :=
  uliftable.mk fun (α : Type u_1) (β : Type u_2) => cont_t.equiv (uliftable.congr m m' F)

protected instance cont_t.uliftable {s : Type u_1} {m : Type u_1 → Type u_2} {m' : Type (max u_1 u_3) → Type u_4} [uliftable m m'] : uliftable (cont_t s m) (cont_t (ulift s) m') :=
  cont_t.uliftable' (equiv.symm equiv.ulift)

/-- for specific writer monads, this function helps to create a uliftable instance -/
def writer_t.uliftable' {w : Type (max u_1 u_2)} {w' : Type (max u_3 u_4)} {m : Type (max u_1 u_2) → Type u_5} {m' : Type (max u_3 u_4) → Type u_6} [uliftable m m'] (F : w ≃ w') : uliftable (writer_t w m) (writer_t w' m') :=
  uliftable.mk
    fun (α : Type (max u_1 u_2)) (β : Type (max u_3 u_4)) (G : α ≃ β) =>
      writer_t.equiv (uliftable.congr m m' (equiv.prod_congr G F))

protected instance writer_t.uliftable {s : Type (max u_1 u_2)} {m : Type (max u_1 u_2) → Type u_3} {m' : Type (max (max u_1 u_2) u_4) → Type u_5} [uliftable m m'] : uliftable (writer_t s m) (writer_t (ulift s) m') :=
  writer_t.uliftable' (equiv.symm equiv.ulift)


def f : Prop → Prop := id

class Foo (foo : Prop → Prop) where
  l : x → foo x

instance : Foo f where
  l := by simp_all [f]

theorem test' (h : x = True) : f x := by
  have _ := True
  apply Foo.l  -- `?foo ?x =?= [mdata noImplicitLambda:1 f x]`
  simp [h]


/-
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


import smt2
import .test_tactics

lemma false_should_fail : false :=
by must_fail z3


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


import declaration_with_docstring
import fixed_prompts
import querying

/-- A list of declarations from `mathlib` with docstrings similar to the given sentence. -/
meta def similar_prompts (s : string) (n : nat) : io (list declaration_with_docstring) := do
  sim_stmts ← get_similarity_prompts s n,
  sim_prompts ← sim_stmts.mmap $ λ j, io.of_except (declaration_with_docstring.from_json j),
  return sim_prompts.reverse

/-- The declarations available in the context. -/
meta def context_prompts : io (list declaration_with_docstring) :=
  io.run_tactic declaration_with_docstring.module_decls

/-- Build a prompt consisting of docstrings and theorem statements for querying Codex. -/
def build_prompt (decls : list declaration_with_docstring) : string :=
  decls.foldr (λ d prompt, d.to_full_string ++ "\n\n" ++ prompt) string.empty

/-- Produce Lean translations of a statement by querying Codex with a custom prompt -/
meta def get_translations (stmt : string)
    (use_fixed := tt)
    (n_sim := 15)
    (use_ctx := tt)
    (temp := 6)
    (n := 7)
    (prompt_suffix := "theorem") : io (string × list string) := do
  let fix_prompts := if use_fixed then fixed_prompts else [],
  sim_prompts ← similar_prompts stmt n_sim,
  ctx_prompts ← if use_ctx then context_prompts else pure [],
  let all_prompts := sim_prompts ++ ctx_prompts,
  let main_prompt := (build_prompt all_prompts) ++ sformat!"/-- {stmt} -/\n" ++ prompt_suffix,

  translations ← completion_request.get_codex_completions {prompt := main_prompt, temperature := temp, n := n},
  return $ (main_prompt, translations.map (λ t, prompt_suffix ++ t))

/-- Post-process the Codex completions by converting to `declaration_with_docstring` and typechecking. -/
meta def process_translations (stmt : string)
    (use_fixed := tt)
    (n_sim := 15)
    (use_ctx := tt)
    (temp := 6)
    (n := 7)
    (completion_prefix := "theorem") : tactic (list declaration_with_docstring × list declaration_with_docstring) := do
  (_, translations) ← tactic.unsafe_run_io $ get_translations stmt use_fixed n_sim use_ctx temp n completion_prefix,
  let translation_decls := translations.erase_dups.map $ λ t, declaration_with_docstring.from_string t stmt,
  (typecorrect_translations, failed_translations) ← translation_decls.split_with $
      (functor.map option.is_some) ∘ declaration_with_docstring.validate,
  return (typecorrect_translations, failed_translations)


/-
## 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) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Eqns
import Lean.Meta.Tactic.Split
import Lean.Meta.Tactic.Simp.Main
import Lean.Meta.Tactic.Apply
import Lean.Elab.PreDefinition.Basic
import Lean.Elab.PreDefinition.Eqns
import Lean.Elab.PreDefinition.Structural.Basic

namespace Lean.Elab
open Meta
open Eqns

namespace Structural

structure EqnInfo extends EqnInfoCore where
  recArgPos   : Nat
  deriving Inhabited

private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
  trace[Elab.definition.structural.eqns] "proving: {type}"
  withNewMCtxDepth do
    let main ← mkFreshExprSyntheticOpaqueMVar type
    let (_, mvarId) ← intros main.mvarId!
    unless (← tryURefl mvarId) do -- catch easy cases
      go (← deltaLHS mvarId)
    instantiateMVars main
where
  go (mvarId : MVarId) : MetaM Unit := do
    trace[Elab.definition.structural.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 match (← simpTargetStar mvarId {}) with
      | TacticResultCNM.closed => return ()
      | TacticResultCNM.modified mvarId => go mvarId
      | TacticResultCNM.noChange =>
        if let some mvarId ← deltaRHS? mvarId declName then
          go mvarId
        else if let some mvarIds ← casesOnStuckLHS? mvarId then
          mvarIds.forM go
        else if let some mvarIds ← splitTarget? mvarId then
          mvarIds.forM go
        else
          throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"

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

builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension `structEqInfo

def registerEqnsInfo (preDef : PreDefinition) (recArgPos : Nat) : CoreM Unit := do
  modifyEnv fun env => eqnInfoExt.insert env preDef.declName { preDef with recArgPos }

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 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.structural.eqns

end Structural
end Lean.Elab


import init.meta.tactic
import system.io
import assignment

open tactic

meta def in_import (env : environment) (n : name) (path : string) : bool :=
(env.decl_olean n = path) && env.contains n && (n ∉ [``quot, ``quot.mk, ``quot.lift, ``quot.ind])

meta def exact_list : list name → tactic unit
| [] := failed
| (H :: Hs) := do
                  e ← mk_const H,
                  exact e <|> exact_list Hs

meta def check_solutions : tactic unit :=
do env <- get_env,
   let decls := env.fold [] list.cons,
   cwd ← unsafe_run_io io.env.get_cwd,
   let names := decls.map declaration.to_name,
   let assignment_names := names.filter
     (λ x, in_import env x (cwd ++ "/src/assignment.lean") && not x.is_internal),
   exact_list assignment_names

theorem check_problem1 : ∀ (x : Type), x = x :=
begin
  check_solutions,
end

#print "Problem 1"
#print axioms check_problem1
#print "---"

theorem check_problem2 : 0 = 1 :=
begin
  check_solutions,
end

#print "Problem 2"
#print axioms check_problem2
#print "---"

theorem check_problem3 : ℕ × ℕ × ℕ :=
begin
  check_solutions,
end

#print "Problem 3"
#print axioms check_problem3
#print "---"

theorem check_problem4 : bool :=
begin
  check_solutions,
end

#print "Problem 4"
#print axioms check_problem4
#print "---"


/-
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


import Lean
open Lean Elab Tactic

macro "obviously1" : tactic => `(tactic| exact sorryAx _)

theorem result1 : False := by obviously1

elab "obviously2" : tactic =>
  liftMetaTactic1 fun mvarId => mvarId.admit *> pure none

theorem result2 : False := by obviously2

def x : Bool := 0

theorem result3 : False := by obviously2

theorem result4 : False := by -- Does not generate a `sorry` warning because there is an error
  let x : Bool := 0
  obviously2


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

import AesopTest.RuleSets0

set_option aesop.check.all true

@[aesop safe (rule_sets [test_A])]
inductive A : Prop where
| intro

@[aesop safe (rule_sets [test_B])]
inductive B : Prop where
| intro

@[aesop safe]
inductive C : Prop where
| intro

inductive D : Prop where
| intro

example : A := by
  fail_if_success aesop (options := { terminal := true })
  aesop (rule_sets [test_A])

example : B := by
  aesop (rule_sets [test_A, test_B])

example : C := by
  fail_if_success aesop (rule_sets [-default]) (options := { terminal := true })
  aesop

attribute [aesop safe (rule_sets [test_C])] C

-- Removing the attribute removes all rules associated with C from all rule
-- sets.
attribute [-aesop] C

example : C := by
  fail_if_success aesop (rule_sets [test_C]) (options := { terminal := true })
  aesop (add safe C)

@[aesop norm simp]
theorem ad : D ↔ A :=
  ⟨λ _ => A.intro, λ _ => D.intro⟩

example : D := by
  aesop (rule_sets [test_A])

attribute [-aesop] ad

example : D := by
  fail_if_success aesop (rule_sets [test_A]) (options := { terminal := true })
  aesop (add norm ad) (rule_sets [test_A])

-- Rules can also be local.

inductive E : Prop where
  | intro

section

attribute [local aesop safe] E

example : E := by
  aesop

end

example : E := by
  fail_if_success aesop (options := { terminal := true })
  constructor

-- Rules can also be scoped.

namespace EScope

attribute [scoped aesop safe] E

example : E := by
  aesop

end EScope

example : E := by
  fail_if_success aesop (options := { terminal := true })
  open EScope in aesop


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

namespace Std.Tactic.Ext
open Lean Meta

/-- `declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`. -/
syntax "declare_ext_theorems_for" ident prio ? : command

/-- Information about an extensionality theorem, stored in the environment extension. -/
structure ExtTheorem where
  /-- Declaration name of the extensionality theorem. -/
  declName : Name
  /-- Priority of the extensionality theorem. -/
  priority : Nat
  /-- Key in the discrimination tree. -/
  keys : Array (DiscrTree.Key true)
  deriving Inhabited, Repr, BEq, Hashable

/-- The environment extension to track `@[ext]` lemmas. -/
initialize extExtension :
    SimpleScopedEnvExtension ExtTheorem (DiscrTree ExtTheorem true) ←
  registerSimpleScopedEnvExtension {
    addEntry := fun dt thm => dt.insertCore thm.keys thm
    initial := {}
  }

/-- Get the list of `@[ext]` lemmas corresponding to the key `ty`. -/
@[inline] def getExtLemmas (ty : Expr) : MetaM (Array ExtTheorem) :=
  return (← (extExtension.getState (← getEnv)).getMatch ty)
    |>.insertionSort fun a b => a.priority > b.priority

/-- Registers an extensionality lemma.

When `@[ext]` is applied to a structure,
it generates `.ext` and `.ext_iff` theorems
and registers them for the `ext` tactic.

When `@[ext]` is applied to a theorem,
the theorem is registered for the `ext` tactic.

You can use `@[ext 9000]` to specify a priority for the attribute. -/
syntax (name := ext) "ext" prio ? : attr

initialize registerBuiltinAttribute {
  name := `ext
  descr := "Marks a lemma as extensionality lemma"
  add := fun declName stx kind => do
    let `(attr| ext $[$prio]?) := stx | throwError "unexpected @[ext] attribute {stx}"
    if isStructure (← getEnv) declName then
      liftCommandElabM <| Elab.Command.elabCommand <|
        ← `(declare_ext_theorems_for $(mkCIdentFrom stx declName) $[$prio]?)
    else MetaM.run' do
      let declTy := (← getConstInfo declName).type
      let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy
      let failNotEq := throwError
        "@[ext] attribute only applies to structures or lemmas proving x = y, got {declTy}"
      let some (ty, lhs, rhs) := declTy.eq? | failNotEq
      unless lhs.isMVar && rhs.isMVar do failNotEq
      let keys ← withReducible <| DiscrTree.mkPath ty
      let priority ← liftCommandElabM do Elab.liftMacroM do
        evalPrio (prio.getD (← `(prio| default)))
      extExtension.add {declName, keys, priority} kind
}


/-
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) 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

end Mathlib


example : (2:int)-(3:int)=(-1:int) :=
begin
trivial
end


import Preloaded Solution

theorem submission : SUBMISSION := immediate
#print axioms submission


/-
Copyright (c) 2021 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg, Asta Halkjær From
-/

import Aesop.Index
import Aesop.Rule.Basic
import Aesop.Percent
import Aesop.Util

namespace Aesop

open Lean
open Lean.Meta

/-! ### Normalisation Rules -/

structure NormRuleInfo where
  penalty : Int
  deriving Inhabited

instance : Ord NormRuleInfo where
  compare i j := compare i.penalty j.penalty

instance : LT NormRuleInfo :=
  ltOfOrd

instance : LE NormRuleInfo :=
  leOfOrd

abbrev NormRule := Rule NormRuleInfo

instance : ToString NormRule where
  toString r := s!"[{r.extra.penalty}] {r.name}"

def defaultNormPenalty : Int := 1

/-! ### Safe and Almost Safe Rules -/

inductive Safety
  | safe
  | almostSafe
  deriving Inhabited

namespace Safety

instance : ToString Safety where
  toString
    | safe => "safe"
    | almostSafe => "almostSafe"

end Safety

structure SafeRuleInfo where
  penalty : Int
  safety : Safety
  deriving Inhabited

instance : Ord SafeRuleInfo where
  compare i j := compare i.penalty j.penalty

instance : LT SafeRuleInfo :=
  ltOfOrd

instance : LE SafeRuleInfo :=
  leOfOrd

abbrev SafeRule := Rule SafeRuleInfo

instance : ToString SafeRule where
  toString r := s!"[{r.extra.penalty}/{r.extra.safety}] {r.name}"

def defaultSafePenalty : Int := 1

/-! ### Unsafe Rules -/

structure UnsafeRuleInfo where
  successProbability : Percent
  deriving Inhabited

instance : Ord UnsafeRuleInfo where
  compare i j := compare j.successProbability i.successProbability
  -- NOTE: Rule with greater success probabilities are considered smaller.
  -- This is because we take 'small' to mean 'high priority'.

instance : LT UnsafeRuleInfo :=
  ltOfOrd

instance : LE UnsafeRuleInfo :=
  leOfOrd

abbrev UnsafeRule := Rule UnsafeRuleInfo

instance : ToString UnsafeRule where
  toString r := s!"[{r.extra.successProbability.toHumanString}] {r.name}"

def defaultSuccessProbability : Percent := .fifty

/-! ### Regular Rules -/

inductive RegularRule
  | safe (r : SafeRule)
  | «unsafe» (r : UnsafeRule)
  deriving Inhabited, BEq

namespace RegularRule

instance : ToFormat RegularRule where
  format
    | safe r => format r
    | «unsafe» r => format r

def successProbability : RegularRule → Percent
  | safe _ => Percent.hundred
  | «unsafe» r => r.extra.successProbability

def isSafe : RegularRule → Bool
  | safe _ => true
  | «unsafe» _ => false

def isUnsafe : RegularRule → Bool
  | safe _ => false
  | «unsafe» _ => true

@[inline]
def withRule (f : ∀ {α}, Rule α → β) : RegularRule → β
  | safe r => f r
  | «unsafe» r => f r

def name (r : RegularRule) : RuleName :=
  r.withRule (·.name)

def indexingMode (r : RegularRule) : IndexingMode :=
  r.withRule (·.indexingMode)

def tac (r : RegularRule) : RuleTacDescr :=
  r.withRule (·.tac)

end RegularRule

/-! ### Normalisation Simp Rules -/

-- A global rule for the norm simplifier. Each `SimpEntry` represents a member
-- of the simp set, e.g. a declaration whose type is an equality or a smart
-- unfolding theorem for a declaration.
structure NormSimpRule where
  name : RuleName
  entries : Array SimpEntry
  deriving Inhabited

namespace NormSimpRule

instance : BEq NormSimpRule where
  beq r s := r.name == s.name

instance : Hashable NormSimpRule where
  hash r := hash r.name

end NormSimpRule

-- A local rule for the norm simplifier. This is a propositional hypothesis,
-- represented by its user name. When we run the simplifier, we add this
-- hypothesis to the simp set. This must be done for each goal individually
-- since the `FVarId` of the hypothesis is not guaranteed to be stable.
structure LocalNormSimpRule where
  fvarUserName : Name
  deriving Inhabited

namespace LocalNormSimpRule

instance : BEq NormSimpRule where
  beq r s := r.name == s.name

instance : Hashable NormSimpRule where
  hash r := hash r.name

def name (r : LocalNormSimpRule) : RuleName :=
  { name := r.fvarUserName, scope := .local, builder := .simp, phase := .norm }

end LocalNormSimpRule

structure UnfoldRule where
  decl : Name
  unfoldThm? : Option Name
  deriving Inhabited

namespace UnfoldRule

instance : BEq UnfoldRule where
  beq r s := r.decl == s.decl

instance : Hashable UnfoldRule where
  hash r := hash r.decl

def name (r : UnfoldRule) : RuleName :=
  { name := r.decl, builder := .unfold, phase := .norm, scope := .global }

end Aesop.UnfoldRule


/-
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.
-/