/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.basic
import Mathlib.data.sigma.basic
import Mathlib.algebra.group.defs
import Mathlib.PostPort

universes u_1 u_2 l u v u_3 w x u_4

namespace Mathlib

/-!
# Injective functions
-/

namespace function

/-- `α ↪ β` is a bundled injective function. -/
structure embedding (α : Sort u_1) (β : Sort u_2) where
  to_fun : α → β
  inj' : injective to_fun

infixr:25 " ↪ " => Mathlib.function.embedding

protected instance embedding.has_coe_to_fun {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) :=
  has_coe_to_fun.mk (fun (x : α ↪ β) => α → β) embedding.to_fun

end function

/-- Convert an `α ≃ β` to `α ↪ β`. -/
@[simp] theorem equiv.to_embedding_apply {α : Sort u} {β : Sort v} (f : α ≃ β) :
    ∀ (ᾰ : α), coe_fn (equiv.to_embedding f) ᾰ = coe_fn f ᾰ :=
  fun (ᾰ : α) => Eq.refl (coe_fn (equiv.to_embedding f) ᾰ)

namespace function

namespace embedding

theorem ext {α : Sort u_1} {β : Sort u_2} {f : α ↪ β} {g : α ↪ β}
    (h : ∀ (x : α), coe_fn f x = coe_fn g x) : f = g :=
  sorry

theorem ext_iff {α : Sort u_1} {β : Sort u_2} {f : α ↪ β} {g : α ↪ β} :
    (∀ (x : α), coe_fn f x = coe_fn g x) ↔ f = g :=
  sorry

@[simp] theorem to_fun_eq_coe {α : Sort u_1} {β : Sort u_2} (f : α ↪ β) : to_fun f = ⇑f := rfl

@[simp] theorem coe_fn_mk {α : Sort u_1} {β : Sort u_2} (f : α → β) (i : injective f) :
    ⇑(mk f i) = f :=
  rfl

theorem injective {α : Sort u_1} {β : Sort u_2} (f : α ↪ β) : injective ⇑f := inj' f

@[simp] theorem refl_apply (α : Sort u_1) (a : α) : coe_fn (embedding.refl α) a = a := Eq.refl a

@[simp] theorem trans_apply {α : Sort u_1} {β : Sort u_2} {γ : Sort u_3} (f : α ↪ β) (g : β ↪ γ) :
    ∀ (ᾰ : α), coe_fn (embedding.trans f g) ᾰ = coe_fn g (coe_fn f ᾰ) :=
  fun (ᾰ : α) => Eq.refl (coe_fn g (coe_fn f ᾰ))

@[simp] theorem equiv_to_embedding_trans_symm_to_embedding {α : Sort u_1} {β : Sort u_2}
    (e : α ≃ β) :
    embedding.trans (equiv.to_embedding e) (equiv.to_embedding (equiv.symm e)) = embedding.refl α :=
  sorry

@[simp] theorem equiv_symm_to_embedding_trans_to_embedding {α : Sort u_1} {β : Sort u_2}
    (e : α ≃ β) :
    embedding.trans (equiv.to_embedding (equiv.symm e)) (equiv.to_embedding e) = embedding.refl β :=
  sorry

protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x} (e₁ : α ≃ β) (e₂ : γ ≃ δ)
    (f : α ↪ γ) : β ↪ δ :=
  embedding.trans (equiv.to_embedding (equiv.symm e₁)) (embedding.trans f (equiv.to_embedding e₂))

/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
protected def of_surjective {α : Sort u_1} {β : Sort u_2} (f : β → α) (hf : surjective f) : α ↪ β :=
  mk (surj_inv hf) (injective_surj_inv hf)

/-- Convert a surjective `embedding` to an `equiv` -/
protected def equiv_of_surjective {α : Sort u_1} {β : Type u_2} (f : α ↪ β) (hf : surjective ⇑f) :
    α ≃ β :=
  equiv.of_bijective ⇑f sorry

protected def of_not_nonempty {α : Sort u_1} {β : Sort u_2} (hα : ¬Nonempty α) : α ↪ β :=
  mk (fun (a : α) => false.elim sorry) sorry

/-- Change the value of an embedding `f` at one point. If the prescribed image
is already occupied by some `f a'`, then swap the values at these two points. -/
def set_value {α : Sort u_1} {β : Sort u_2} (f : α ↪ β) (a : α) (b : β)
    [(a' : α) → Decidable (a' = a)] [(a' : α) → Decidable (coe_fn f a' = b)] : α ↪ β :=
  mk (fun (a' : α) => ite (a' = a) b (ite (coe_fn f a' = b) (coe_fn f a) (coe_fn f a'))) sorry

theorem set_value_eq {α : Sort u_1} {β : Sort u_2} (f : α ↪ β) (a : α) (b : β)
    [(a' : α) → Decidable (a' = a)] [(a' : α) → Decidable (coe_fn f a' = b)] :
    coe_fn (set_value f a b) a = b :=
  sorry

/-- Embedding into `option` -/
protected def some {α : Type u_1} : α ↪ Option α := mk some (option.some_injective α)

/-- Embedding of a `subtype`. -/
def subtype {α : Sort u_1} (p : α → Prop) : Subtype p ↪ α := mk coe sorry

@[simp] theorem coe_subtype {α : Sort u_1} (p : α → Prop) : ⇑(subtype p) = coe := rfl

/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
def punit {β : Sort u_1} (b : β) : PUnit ↪ β := mk (fun (_x : PUnit) => b) sorry

/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
def sectl (α : Type u_1) {β : Type u_2} (b : β) : α ↪ α × β := mk (fun (a : α) => (a, b)) sorry

/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
def sectr {α : Type u_1} (a : α) (β : Type u_2) : β ↪ α × β := mk (fun (b : β) => (a, b)) sorry

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α : Sort u_1} {β : Type u_2} (p : set β) (f : α ↪ β)
    (H : ∀ (a : α), coe_fn f a ∈ p) : α ↪ ↥p :=
  mk (fun (a : α) => { val := coe_fn f a, property := H a }) sorry

@[simp] theorem cod_restrict_apply {α : Sort u_1} {β : Type u_2} (p : set β) (f : α ↪ β)
    (H : ∀ (a : α), coe_fn f a ∈ p) (a : α) :
    coe_fn (cod_restrict p f H) a = { val := coe_fn f a, property := H a } :=
  rfl

/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
def prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
    α × γ ↪ β × δ :=
  mk (prod.map ⇑e₁ ⇑e₂) sorry

@[simp] theorem coe_prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    (e₁ : α ↪ β) (e₂ : γ ↪ δ) : ⇑(prod_map e₁ e₂) = prod.map ⇑e₁ ⇑e₂ :=
  rfl

/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
def sum_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
    α ⊕ γ ↪ β ⊕ δ :=
  mk (sum.map ⇑e₁ ⇑e₂) sorry

@[simp] theorem coe_sum_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (e₁ : α ↪ β)
    (e₂ : γ ↪ δ) : ⇑(sum_map e₁ e₂) = sum.map ⇑e₁ ⇑e₂ :=
  rfl

/-- The embedding of `α` into the sum `α ⊕ β`. -/
@[simp] theorem inl_apply {α : Type u_1} {β : Type u_2} (val : α) : coe_fn inl val = sum.inl val :=
  Eq.refl (coe_fn inl val)

/-- The embedding of `β` into the sum `α ⊕ β`. -/
@[simp] theorem inr_apply {α : Type u_1} {β : Type u_2} (val : β) : coe_fn inr val = sum.inr val :=
  Eq.refl (coe_fn inr val)

/-- `sigma.mk` as an `function.embedding`. -/
@[simp] theorem sigma_mk_apply {α : Type u_1} {β : α → Type u_3} (a : α) (snd : β a) :
    coe_fn (sigma_mk a) snd = sigma.mk a snd :=
  Eq.refl (coe_fn (sigma_mk a) snd)

/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
of embeddings, then `sigma.map f g` is an embedding. -/
@[simp] theorem sigma_map_apply {α : Type u_1} {α' : Type u_2} {β : α → Type u_3}
    {β' : α' → Type u_4} (f : α ↪ α') (g : (a : α) → β a ↪ β' (coe_fn f a))
    (x : sigma fun (a : α) => β a) :
    coe_fn (sigma_map f g) x = sigma.map (⇑f) (fun (a : α) => ⇑(g a)) x :=
  Eq.refl (coe_fn (sigma_map f g) x)

def Pi_congr_right {α : Sort u_1} {β : α → Sort u_2} {γ : α → Sort u_3} (e : (a : α) → β a ↪ γ a) :
    ((a : α) → β a) ↪ (a : α) → γ a :=
  mk (fun (f : (a : α) → β a) (a : α) => coe_fn (e a) (f a)) sorry

def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w} (e : α ↪ β) : (γ → α) ↪ γ → β :=
  Pi_congr_right fun (_x : γ) => e

def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w} [Inhabited γ] (e : α ↪ β) :
    (α → γ) ↪ β → γ :=
  let f' : (α → γ) → β → γ :=
    fun (f : α → γ) (b : β) =>
      dite (∃ (c : α), coe_fn e c = b) (fun (h : ∃ (c : α), coe_fn e c = b) => f (classical.some h))
        fun (h : ¬∃ (c : α), coe_fn e c = b) => Inhabited.default;
  mk f' sorry

protected def subtype_map {α : Sort u_1} {β : Sort u_2} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
    (h : ∀ {x : α}, p x → q (coe_fn f x)) :
    (Subtype fun (x : α) => p x) ↪ Subtype fun (y : β) => q y :=
  mk (subtype.map (⇑f) h) sorry

/-- `set.image` as an embedding `set α ↪ set β`. -/
protected def image {α : Type u_1} {β : Type u_2} (f : α ↪ β) : set α ↪ set β :=
  mk (set.image ⇑f) sorry

theorem swap_apply {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] (f : α ↪ β) (x : α)
    (y : α) (z : α) :
    coe_fn (equiv.swap (coe_fn f x) (coe_fn f y)) (coe_fn f z) =
        coe_fn f (coe_fn (equiv.swap x y) z) :=
  injective.swap_apply (injective f) x y z

theorem swap_comp {α : Type u_1} {β : Type u_2} [DecidableEq α] [DecidableEq β] (f : α ↪ β) (x : α)
    (y : α) : ⇑(equiv.swap (coe_fn f x) (coe_fn f y)) ∘ ⇑f = ⇑f ∘ ⇑(equiv.swap x y) :=
  injective.swap_comp (injective f) x y

end embedding

end function

namespace equiv

@[simp] theorem refl_to_embedding {α : Type u_1} :
    equiv.to_embedding (equiv.refl α) = function.embedding.refl α :=
  rfl

@[simp] theorem trans_to_embedding {α : Type u_1} {β : Type u_2} {γ : Type u_3} (e : α ≃ β)
    (f : β ≃ γ) :
    equiv.to_embedding (equiv.trans e f) =
        function.embedding.trans (equiv.to_embedding e) (equiv.to_embedding f) :=
  rfl

end equiv

namespace set

/-- The injection map is an embedding between subsets. -/
def embedding_of_subset {α : Type u_1} (s : set α) (t : set α) (h : s ⊆ t) : ↥s ↪ ↥t :=
  function.embedding.mk (fun (x : ↥s) => { val := subtype.val x, property := sorry }) sorry

end set

-- TODO: these two definitions probably belong somewhere else, so that we can remove the

-- `algebra.group.defs` import.

/--
The embedding of a left cancellative semigroup into itself
by left multiplication by a fixed element.
 -/
@[simp] theorem add_left_embedding_apply {G : Type u} [add_left_cancel_semigroup G] (g : G)
    (h : G) : coe_fn (add_left_embedding g) h = g + h :=
  Eq.refl (coe_fn (add_left_embedding g) h)

/--
The embedding of a right cancellative semigroup into itself
by right multiplication by a fixed element.
 -/
def mul_right_embedding {G : Type u} [right_cancel_semigroup G] (g : G) : G ↪ G :=
  function.embedding.mk (fun (h : G) => h * g) (mul_left_injective g)

end Mathlib


/-
Copyright (c) 2019 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.computability.halting
import Mathlib.PostPort

universes u_1 u_2 u_3 u v

namespace Mathlib

/-!
# Strong reducibility and degrees.

This file defines the notions of computable many-one reduction and one-one
reduction between sets, and shows that the corresponding degrees form a
semilattice.

## Notations

This file uses the local notation `⊕'` for `sum.elim` to denote the disjoint union of two degrees.

## References

* [Robert Soare, *Recursively enumerable sets and degrees*][soare1987]

## Tags

computability, reducibility, reduction
-/

/--
`p` is many-one reducible to `q` if there is a computable function translating questions about `p`
to questions about `q`.
-/
def many_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop)
    (q : β → Prop) :=
  ∃ (f : α → β), computable f ∧ ∀ (a : α), p a ↔ q (f a)

infixl:1000 " ≤₀ " => Mathlib.many_one_reducible

theorem many_one_reducible.mk {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {f : α → β} (q : β → Prop) (h : computable f) : (fun (a : α) => q (f a)) ≤₀ q :=
  Exists.intro f { left := h, right := fun (a : α) => iff.rfl }

theorem many_one_reducible_refl {α : Type u_1} [primcodable α] (p : α → Prop) : p ≤₀ p := sorry

theorem many_one_reducible.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    p ≤₀ q → q ≤₀ r → p ≤₀ r :=
  sorry

theorem reflexive_many_one_reducible {α : Type u_1} [primcodable α] :
    reflexive many_one_reducible :=
  many_one_reducible_refl

theorem transitive_many_one_reducible {α : Type u_1} [primcodable α] :
    transitive many_one_reducible :=
  fun (p q r : α → Prop) => many_one_reducible.trans

/--
`p` is one-one reducible to `q` if there is an injective computable function translating questions
about `p` to questions about `q`.
-/
def one_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop)
    (q : β → Prop) :=
  ∃ (f : α → β), computable f ∧ function.injective f ∧ ∀ (a : α), p a ↔ q (f a)

infixl:1000 " ≤₁ " => Mathlib.one_one_reducible

theorem one_one_reducible.mk {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {f : α → β} (q : β → Prop) (h : computable f) (i : function.injective f) :
    (fun (a : α) => q (f a)) ≤₁ q :=
  Exists.intro f { left := h, right := { left := i, right := fun (a : α) => iff.rfl } }

theorem one_one_reducible_refl {α : Type u_1} [primcodable α] (p : α → Prop) : p ≤₁ p := sorry

theorem one_one_reducible.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    p ≤₁ q → q ≤₁ r → p ≤₁ r :=
  sorry

theorem one_one_reducible.to_many_one {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → Prop} {q : β → Prop} : p ≤₁ q → p ≤₀ q :=
  sorry

theorem one_one_reducible.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {e : α ≃ β} (q : β → Prop) (h : computable ⇑e) : (q ∘ ⇑e) ≤₁ q :=
  one_one_reducible.mk q h (equiv.injective e)

theorem one_one_reducible.of_equiv_symm {α : Type u_1} {β : Type u_2} [primcodable α]
    [primcodable β] {e : α ≃ β} (q : β → Prop) (h : computable ⇑(equiv.symm e)) : q ≤₁ (q ∘ ⇑e) :=
  sorry

theorem reflexive_one_one_reducible {α : Type u_1} [primcodable α] : reflexive one_one_reducible :=
  one_one_reducible_refl

theorem transitive_one_one_reducible {α : Type u_1} [primcodable α] :
    transitive one_one_reducible :=
  fun (p q r : α → Prop) => one_one_reducible.trans

namespace computable_pred

theorem computable_of_many_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α]
    [primcodable β] {p : α → Prop} {q : β → Prop} (h₁ : p ≤₀ q) (h₂ : computable_pred q) :
    computable_pred p :=
  sorry

theorem computable_of_one_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α]
    [primcodable β] {p : α → Prop} {q : β → Prop} (h : p ≤₁ q) :
    computable_pred q → computable_pred p :=
  computable_of_many_one_reducible (one_one_reducible.to_many_one h)

end computable_pred

/-- `p` and `q` are many-one equivalent if each one is many-one reducible to the other. -/
def many_one_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop)
    (q : β → Prop) :=
  p ≤₀ q ∧ q ≤₀ p

/-- `p` and `q` are one-one equivalent if each one is one-one reducible to the other. -/
def one_one_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop)
    (q : β → Prop) :=
  p ≤₁ q ∧ q ≤₁ p

theorem many_one_equiv_refl {α : Type u_1} [primcodable α] (p : α → Prop) : many_one_equiv p p :=
  { left := many_one_reducible_refl p, right := many_one_reducible_refl p }

theorem many_one_equiv.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → Prop} {q : β → Prop} : many_one_equiv p q → many_one_equiv q p :=
  and.swap

theorem many_one_equiv.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    many_one_equiv p q → many_one_equiv q r → many_one_equiv p r :=
  sorry

theorem equivalence_of_many_one_equiv {α : Type u_1} [primcodable α] : equivalence many_one_equiv :=
  { left := many_one_equiv_refl,
    right :=
      { left := fun (x y : α → Prop) => many_one_equiv.symm,
        right := fun (x y z : α → Prop) => many_one_equiv.trans } }

theorem one_one_equiv_refl {α : Type u_1} [primcodable α] (p : α → Prop) : one_one_equiv p p :=
  { left := one_one_reducible_refl p, right := one_one_reducible_refl p }

theorem one_one_equiv.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → Prop} {q : β → Prop} : one_one_equiv p q → one_one_equiv q p :=
  and.swap

theorem one_one_equiv.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    one_one_equiv p q → one_one_equiv q r → one_one_equiv p r :=
  sorry

theorem equivalence_of_one_one_equiv {α : Type u_1} [primcodable α] : equivalence one_one_equiv :=
  { left := one_one_equiv_refl,
    right :=
      { left := fun (x y : α → Prop) => one_one_equiv.symm,
        right := fun (x y z : α → Prop) => one_one_equiv.trans } }

theorem one_one_equiv.to_many_one {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → Prop} {q : β → Prop} : one_one_equiv p q → many_one_equiv p q :=
  sorry

/-- a computable bijection -/
def equiv.computable {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (e : α ≃ β) :=
  computable ⇑e ∧ computable ⇑(equiv.symm e)

theorem equiv.computable.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {e : α ≃ β} : equiv.computable e → equiv.computable (equiv.symm e) :=
  and.swap

theorem equiv.computable.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {e₁ : α ≃ β} {e₂ : β ≃ γ} :
    equiv.computable e₁ → equiv.computable e₂ → equiv.computable (equiv.trans e₁ e₂) :=
  sorry

theorem computable.eqv (α : Type u_1) [denumerable α] : equiv.computable (denumerable.eqv α) :=
  { left := computable.encode, right := computable.of_nat α }

theorem computable.equiv₂ (α : Type u_1) (β : Type u_2) [denumerable α] [denumerable β] :
    equiv.computable (denumerable.equiv₂ α β) :=
  equiv.computable.trans (computable.eqv α) (equiv.computable.symm (computable.eqv β))

theorem one_one_equiv.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {e : α ≃ β} (h : equiv.computable e) {p : β → Prop} : one_one_equiv (p ∘ ⇑e) p :=
  { left := one_one_reducible.of_equiv p (and.left h),
    right := one_one_reducible.of_equiv_symm p (and.right h) }

theorem many_one_equiv.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {e : α ≃ β} (h : equiv.computable e) {p : β → Prop} : many_one_equiv (p ∘ ⇑e) p :=
  one_one_equiv.to_many_one (one_one_equiv.of_equiv h)

theorem many_one_equiv.le_congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : many_one_equiv p q) : p ≤₀ r ↔ q ≤₀ r :=
  { mp := many_one_reducible.trans (and.right h), mpr := many_one_reducible.trans (and.left h) }

theorem many_one_equiv.le_congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : many_one_equiv q r) : p ≤₀ q ↔ p ≤₀ r :=
  { mp := fun (h' : p ≤₀ q) => many_one_reducible.trans h' (and.left h),
    mpr := fun (h' : p ≤₀ r) => many_one_reducible.trans h' (and.right h) }

theorem one_one_equiv.le_congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : one_one_equiv p q) : p ≤₁ r ↔ q ≤₁ r :=
  { mp := one_one_reducible.trans (and.right h), mpr := one_one_reducible.trans (and.left h) }

theorem one_one_equiv.le_congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : one_one_equiv q r) : p ≤₁ q ↔ p ≤₁ r :=
  { mp := fun (h' : p ≤₁ q) => one_one_reducible.trans h' (and.left h),
    mpr := fun (h' : p ≤₁ r) => one_one_reducible.trans h' (and.right h) }

theorem many_one_equiv.congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : many_one_equiv p q) : many_one_equiv p r ↔ many_one_equiv q r :=
  and_congr (many_one_equiv.le_congr_left h) (many_one_equiv.le_congr_right h)

theorem many_one_equiv.congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : many_one_equiv q r) : many_one_equiv p q ↔ many_one_equiv p r :=
  and_congr (many_one_equiv.le_congr_right h) (many_one_equiv.le_congr_left h)

theorem one_one_equiv.congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : one_one_equiv p q) : one_one_equiv p r ↔ one_one_equiv q r :=
  and_congr (one_one_equiv.le_congr_left h) (one_one_equiv.le_congr_right h)

theorem one_one_equiv.congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop}
    (h : one_one_equiv q r) : one_one_equiv p q ↔ one_one_equiv p r :=
  and_congr (one_one_equiv.le_congr_right h) (one_one_equiv.le_congr_left h)

@[simp] theorem ulower.down_computable {α : Type u_1} [primcodable α] :
    equiv.computable (ulower.equiv α) :=
  { left := primrec.to_comp primrec.ulower_down, right := primrec.to_comp primrec.ulower_up }

theorem many_one_equiv_up {α : Type u_1} [primcodable α] {p : α → Prop} :
    many_one_equiv (p ∘ ulower.up) p :=
  many_one_equiv.of_equiv (equiv.computable.symm ulower.down_computable)

theorem one_one_reducible.disjoin_left {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → Prop} {q : β → Prop} : p ≤₁ sum.elim p q :=
  Exists.intro sum.inl
    { left := computable.sum_inl,
      right :=
        { left := fun (x y : α) => iff.mp sum.inl.inj_iff, right := fun (a : α) => iff.rfl } }

theorem one_one_reducible.disjoin_right {α : Type u_1} {β : Type u_2} [primcodable α]
    [primcodable β] {p : α → Prop} {q : β → Prop} : q ≤₁ sum.elim p q :=
  Exists.intro sum.inr
    { left := computable.sum_inr,
      right :=
        { left := fun (x y : β) => iff.mp sum.inr.inj_iff, right := fun (a : β) => iff.rfl } }

theorem disjoin_many_one_reducible {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    p ≤₀ r → q ≤₀ r → sum.elim p q ≤₀ r :=
  sorry

theorem disjoin_le {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β]
    [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} :
    sum.elim p q ≤₀ r ↔ p ≤₀ r ∧ q ≤₀ r :=
  sorry

/--
Computable and injective mapping of predicates to sets of natural numbers.
-/
def to_nat {α : Type u} [primcodable α] [Inhabited α] (p : set α) : set ℕ :=
  set_of fun (n : ℕ) => p (option.get_or_else (encodable.decode α n) Inhabited.default)

@[simp] theorem to_nat_many_one_reducible {α : Type u} [primcodable α] [Inhabited α] {p : set α} :
    to_nat p ≤₀ p :=
  Exists.intro (fun (n : ℕ) => option.get_or_else (encodable.decode α n) Inhabited.default)
    { left := computable.option_get_or_else computable.decode (computable.const Inhabited.default),
      right := fun (_x : ℕ) => iff.rfl }

@[simp] theorem many_one_reducible_to_nat {α : Type u} [primcodable α] [Inhabited α] {p : set α} :
    p ≤₀ to_nat p :=
  sorry

@[simp] theorem many_one_reducible_to_nat_to_nat {α : Type u} [primcodable α] [Inhabited α]
    {β : Type v} [primcodable β] [Inhabited β] {p : set α} {q : set β} :
    to_nat p ≤₀ to_nat q ↔ p ≤₀ q :=
  sorry

@[simp] theorem to_nat_many_one_equiv {α : Type u} [primcodable α] [Inhabited α] {p : set α} :
    many_one_equiv (to_nat p) p :=
  sorry

@[simp] theorem many_one_equiv_to_nat {α : Type u} [primcodable α] [Inhabited α] {β : Type v}
    [primcodable β] [Inhabited β] (p : set α) (q : set β) :
    many_one_equiv (to_nat p) (to_nat q) ↔ many_one_equiv p q :=
  sorry

/-- A many-one degree is an equivalence class of sets up to many-one equivalence. -/
def many_one_degree := quotient (setoid.mk many_one_equiv sorry)

namespace many_one_degree

/-- The many-one degree of a set on a primcodable type. -/
def of {α : Type u} [primcodable α] [Inhabited α] (p : α → Prop) : many_one_degree :=
  quotient.mk' (to_nat p)

protected theorem ind_on {C : many_one_degree → Prop} (d : many_one_degree)
    (h : ∀ (p : set ℕ), C (of p)) : C d :=
  quotient.induction_on' d h

/--
Lifts a function on sets of natural numbers to many-one degrees.
-/
protected def lift_on {φ : Sort u_1} (d : many_one_degree) (f : set ℕ → φ)
    (h : ∀ (p q : ℕ → Prop), many_one_equiv p q → f p = f q) : φ :=
  quotient.lift_on' d f h

@[simp] protected theorem lift_on_eq {φ : Sort u_1} (p : set ℕ) (f : set ℕ → φ)
    (h : ∀ (p q : ℕ → Prop), many_one_equiv p q → f p = f q) :
    many_one_degree.lift_on (of p) f h = f p :=
  rfl

/--
Lifts a binary function on sets of natural numbers to many-one degrees.
-/
@[simp] protected def lift_on₂ {φ : Sort u_1} (d₁ : many_one_degree) (d₂ : many_one_degree)
    (f : set ℕ → set ℕ → φ)
    (h :
      ∀ (p₁ p₂ q₁ q₂ : ℕ → Prop), many_one_equiv p₁ p₂ → many_one_equiv q₁ q₂ → f p₁ q₁ = f p₂ q₂) :
    φ :=
  many_one_degree.lift_on d₁ (fun (p : set ℕ) => many_one_degree.lift_on d₂ (f p) sorry) sorry

@[simp] protected theorem lift_on₂_eq {φ : Sort u_1} (p : set ℕ) (q : set ℕ) (f : set ℕ → set ℕ → φ)
    (h :
      ∀ (p₁ p₂ q₁ q₂ : ℕ → Prop), many_one_equiv p₁ p₂ → many_one_equiv q₁ q₂ → f p₁ q₁ = f p₂ q₂) :
    many_one_degree.lift_on₂ (of p) (of q) f h = f p q :=
  rfl

@[simp] theorem of_eq_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β]
    [Inhabited β] {p : α → Prop} {q : β → Prop} : of p = of q ↔ many_one_equiv p q :=
  sorry

protected instance inhabited : Inhabited many_one_degree := { default := of ∅ }

/--
For many-one degrees `d₁` and `d₂`, `d₁ ≤ d₂` if the sets in `d₁` are many-one reducible to the
sets in `d₂`.
-/
protected instance has_le : HasLessEq many_one_degree :=
  { LessEq :=
      fun (d₁ d₂ : many_one_degree) => many_one_degree.lift_on₂ d₁ d₂ many_one_reducible sorry }

@[simp] theorem of_le_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β]
    [Inhabited β] {p : α → Prop} {q : β → Prop} : of p ≤ of q ↔ p ≤₀ q :=
  many_one_reducible_to_nat_to_nat

protected instance partial_order : partial_order many_one_degree :=
  partial_order.mk LessEq (preorder.lt._default LessEq) le_refl sorry sorry

/-- The join of two degrees, induced by the disjoint union of two underlying sets. -/
protected instance has_add : Add many_one_degree :=
  { add :=
      fun (d₁ d₂ : many_one_degree) =>
        many_one_degree.lift_on₂ d₁ d₂ (fun (a b : set ℕ) => of (sum.elim a b)) sorry }

@[simp] theorem add_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β]
    [Inhabited β] (p : set α) (q : set β) : of (sum.elim p q) = of p + of q :=
  sorry

@[simp] protected theorem add_le {d₁ : many_one_degree} {d₂ : many_one_degree}
    {d₃ : many_one_degree} : d₁ + d₂ ≤ d₃ ↔ d₁ ≤ d₃ ∧ d₂ ≤ d₃ :=
  sorry

@[simp] protected theorem le_add_left (d₁ : many_one_degree) (d₂ : many_one_degree) :
    d₁ ≤ d₁ + d₂ :=
  and.left (iff.mp many_one_degree.add_le (le_refl (d₁ + d₂)))

@[simp] protected theorem le_add_right (d₁ : many_one_degree) (d₂ : many_one_degree) :
    d₂ ≤ d₁ + d₂ :=
  and.right (iff.mp many_one_degree.add_le (le_refl (d₁ + d₂)))

protected instance semilattice_sup : semilattice_sup many_one_degree :=
  semilattice_sup.mk Add.add partial_order.le partial_order.lt partial_order.le_refl
    partial_order.le_trans partial_order.le_antisymm many_one_degree.le_add_left
    many_one_degree.le_add_right sorry

end Mathlib


/-
Copyright (c) 2019 Lucas Allen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen and Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mllist
import Mathlib.tactic.solve_by_elim
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# `suggest` and `library_search`

`suggest` and `library_search` are a pair of tactics for applying lemmas from the library to the
current goal.

* `suggest` prints a list of `exact ...` or `refine ...` statements, which may produce new goals
* `library_search` prints a single `exact ...` which closes the goal, or fails
-/

namespace tactic

namespace suggest

/-- Map a name (typically a head symbol) to a "canonical" definitional synonym.
Given a name `n`, we want a name `n'` such that a sufficiently applied
expression with head symbol `n` is always definitionally equal to an expression
with head symbol `n'`.
Thus, we can search through all lemmas with a result type of `n'`
to solve a goal with head symbol `n`.

For example, `>` is mapped to `<` because `a > b` is definitionally equal to `b < a`,
and `not` is mapped to `false` because `¬ a` is definitionally equal to `p → false`
The default is that the original argument is returned, so `<` is just mapped to `<`.

`normalize_synonym` is called for every lemma in the library, so it needs to be fast.
-/
-- TODO this is a hack; if you suspect more cases here would help, please report them

/--
Compute the head symbol of an expression, then normalise synonyms.

This is only used when analysing the goal, so it is okay to do more expensive analysis here.
-/
-- We may want to tweak this further?

-- We first have a various "customisations":

--   Because in `ℕ` `a.succ ≤ b` is definitionally `a < b`,

--   we add some special cases to allow looking for `<` lemmas even when the goal has a `≤`.

--   Note we only do this in the `ℕ` case, for performance.

-- And then the generic cases:

/--
A declaration can match the head symbol of the current goal in four possible ways:
* `ex`  : an exact match
* `mp`  : the declaration returns an `iff`, and the right hand side matches the goal
* `mpr` : the declaration returns an `iff`, and the left hand side matches the goal
* `both`: the declaration returns an `iff`, and the both sides match the goal
-/
inductive head_symbol_match where
| ex : head_symbol_match
| mp : head_symbol_match
| mpr : head_symbol_match
| both : head_symbol_match

/-- a textual representation of a `head_symbol_match`, for trace debugging. -/
def head_symbol_match.to_string : head_symbol_match → string := sorry

/-- Determine if, and in which way, a given expression matches the specified head symbol. -/
/-- A package of `declaration` metadata, including the way in which its type matches the head symbol
which we are searching for. -/
/--
Generate a `decl_data` from the given declaration if
it matches the head symbol `hs` for the current goal.
-/
-- We used to check here for private declarations, or declarations with certain suffixes.

-- It turns out `apply` is so fast, it's better to just try them all.

/-- Retrieve all library definitions with a given head symbol. -/
/--
We unpack any element of a list of `decl_data` corresponding to an `↔` statement that could apply
in both directions into two separate elements.

This ensures that both directions can be independently returned by `suggest`,
and avoids a problem where the application of one direction prevents
the application of the other direction. (See `exp_le_exp` in the tests.)
-/
/--
Apply the lemma `e`, then attempt to close all goals using
`solve_by_elim opt`, failing if `close_goals = tt`
and there are any goals remaining.

Returns the number of subgoals which were closed using `solve_by_elim`.
-/
-- Implementation note: as this is used by both `library_search` and `suggest`,

-- we first run `solve_by_elim` separately on the independent goals,

-- whether or not `close_goals` is set,

-- and then run `solve_by_elim { all_goals := tt }`,

-- requiring that it succeeds if `close_goals = tt`.

/--
Apply the declaration `d` (or the forward and backward implications separately, if it is an `iff`),
and then attempt to solve the subgoal using `apply_and_solve`.

Returns the number of subgoals successfully closed.
-/
/-- An `application` records the result of a successful application of a library lemma. -/
end suggest

-- Call `apply_declaration`, then prepare the tactic script and

-- count the number of local hypotheses used.

-- (This tactic block is only executed when we evaluate the mllist,

-- so we need to do the `focus1` here.)

-- implementation note: we produce a `tactic (mllist tactic application)` first,

-- because it's easier to work in the tactic monad, but in a moment we squash this

-- down to an `mllist tactic application`.

/--
The core `suggest` tactic.
It attempts to apply a declaration from the library,
then solve new goals using `solve_by_elim`.

It returns a list of `application`s consisting of fields:
* `state`, a tactic state resulting from the successful application of a declaration from
  the library,
* `script`, a string of the form `Try this: refine ...` or `Try this: exact ...` which will
  reproduce that tactic state,
* `decl`, an `option declaration` indicating the declaration that was applied
  (or none, if `solve_by_elim` succeeded),
* `num_goals`, the number of remaining goals, and
* `hyps_used`, the number of local hypotheses used in the solution.
-/
/--
See `suggest_core`.

Returns a list of at most `limit` `application`s,
sorted by number of goals, and then (reverse) number of hypotheses used.
-/
/--
Returns a list of at most `limit` strings, of the form `Try this: exact ...` or
`Try this: refine ...`, which make progress on the current goal using a declaration
from the library.
-/
/--
Returns a string of the form `Try this: exact ...`, which closes the current goal.
-/
namespace interactive

/--
`suggest` tries to apply suitable theorems/defs from the library, and generates
a list of `exact ...` or `refine ...` scripts that could be used at this step.
It leaves the tactic state unchanged. It is intended as a complement of the search
function in your editor, the `#find` tactic, and `library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num`
(or less, if all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.
For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that
`suggest` might miss some results if `num` is not large enough. However, because
`suggest` uses monadic lazy lists, smaller values of `num` run faster than larger values.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  suggest [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `suggest with attr` to include all lemmas with the attribute `attr`.
-/
/--
`suggest` lists possible usages of the `refine` tactic and leaves the tactic state unchanged.
It is intended as a complement of the search function in your editor, the `#find` tactic, and
`library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num` (or less, if
all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.

For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that `suggest`
might miss some results if `num` is not large enough. However, because `suggest` uses monadic
lazy lists, smaller values of `num` run faster than larger values.

An example of `suggest` in action,

```lean
example (n : nat) : n < n + 1 :=
begin suggest, sorry end
```

prints the list,

```lean
Try this: exact nat.lt.base n
Try this: exact nat.lt_succ_self n
Try this: refine not_le.mp _
Try this: refine gt_iff_lt.mp _
Try this: refine nat.lt.step _
Try this: refine lt_of_not_ge _
...
```
-/
-- Turn off `Try this: exact ...` trace message for `library_search`

/--
`library_search` is a tactic to identify existing lemmas in the library. It tries to close the
current goal by applying a lemma from the library, then discharging any new goals using
`solve_by_elim`.

If it succeeds, it prints a trace message `exact ...` which can replace the invocation
of `library_search`.

Typical usage is:
```lean
example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by library_search -- Try this: exact nat.mul_sub_left_distrib n m k
```

By default `library_search` only unfolds `reducible` definitions
when attempting to match lemmas against the goal.
Previously, it would unfold most definitions, sometimes giving surprising answers, or slow answers.
The old behaviour is still available via `library_search!`.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `library_search with attr` to include all lemmas with the attribute `attr`.
-/
end interactive

/-- Invoking the hole command `library_search` ("Use `library_search` to complete the goal") calls
the tactic `library_search` to produce a proof term with the type of the hole.

Running it on

```lean
example : 0 < 1 :=
{!!}
```

produces

```lean
example : 0 < 1 :=
nat.one_pos
```
-/
end Mathlib


/-
Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Simon Hudon, Scott Morrison, Keeley Hoek, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.string.defs
import Mathlib.tactic.derive_inhabited
import Mathlib.PostPort

namespace Mathlib

/-!
# Additional operations on expr and related types

This file defines basic operations on the types expr, name, declaration, level, environment.

This file is mostly for non-tactics. Tactics should generally be placed in `tactic.core`.

## Tags

expr, name, declaration, level, environment, meta, metaprogramming, tactic
-/

namespace binder_info

/-! ### Declarations about `binder_info` -/

protected instance inhabited : Inhabited binder_info := { default := default }

/-- The brackets corresponding to a given binder_info. -/
def brackets : binder_info → string × string := sorry

end binder_info

namespace name

/-! ### Declarations about `name` -/

/-- Find the largest prefix `n` of a `name` such that `f n ≠ none`, then replace this prefix
with the value of `f n`. -/
def map_prefix (f : name → Option name) : name → name := sorry

/-- If `nm` is a simple name (having only one string component) starting with `_`, then
`deinternalize_field nm` removes the underscore. Otherwise, it does nothing. -/
/-- `get_nth_prefix nm n` removes the last `n` components from `nm` -/
/-- Auxilliary definition for `pop_nth_prefix` -/
/-- Pops the top `n` prefixes from the given name. -/
/-- Pop the prefix of a name -/
/-- Auxilliary definition for `from_components` -/
/-- Build a name from components. For example `from_components ["foo","bar"]` becomes
  ``` `foo.bar``` -/
def from_components : List string → name := from_components_aux anonymous

/-- `name`s can contain numeral pieces, which are not legal names
  when typed/passed directly to the parser. We turn an arbitrary
  name into a legal identifier name by turning the numbers to strings. -/
/-- Append a string to the last component of a name -/
def append_suffix : name → string → name := sorry

/-- The first component of a name, turning a number to a string -/
/-- Tests whether the first component of a name is `"_private"` -/
/-- Get the last component of a name, and convert it to a string. -/
/-- Returns the number of characters used to print all the string components of a name,
  including periods between name segments. Ignores numerical parts of a name. -/
/-- Checks whether `nm` has a prefix (including itself) such that P is true -/
def has_prefix (P : name → Bool) : name → Bool := sorry

/-- Appends `'` to the end of a name. -/
/-- `last_string n` returns the rightmost component of `n`, ignoring numeral components.
For example, ``last_string `a.b.c.33`` will return `` `c ``. -/
def last_string : name → string := sorry

/--
Constructs a (non-simple) name from a string.

Example: ``name.from_string "foo.bar" = `foo.bar``
-/
/--
In surface Lean, we can write anonymous Π binders (i.e. binders where the
argument is not named) using the function arrow notation:

```lean
inductive test : Type
| intro : unit → test
```

After elaboration, however, every binder must have a name, so Lean generates
one. In the example, the binder in the type of `intro` is anonymous, so Lean
gives it the name `ᾰ`:

```lean
test.intro : ∀ (ᾰ : unit), test
```

When there are multiple anonymous binders, they are named `ᾰ_1`, `ᾰ_2` etc.

Thus, when we want to know whether the user named a binder, we can check whether
the name follows this scheme. Note, however, that this is not reliable. When the
user writes (for whatever reason)

```lean
inductive test : Type
| intro : ∀ (ᾰ : unit), test
```

we cannot tell that the binder was, in fact, named.

The function `name.is_likely_generated_binder_name` checks if
a name is of the form `ᾰ`, `ᾰ_1`, etc.
-/
/--
Check whether a simple name was likely generated by Lean to name an anonymous
binder. Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
/--
Check whether a name was likely generated by Lean to name an anonymous binder.
Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
end name

namespace level

/-! ### Declarations about `level` -/

/-- Tests whether a universe level is non-zero for all assignments of its variables -/
/--
`l.fold_mvar f` folds a function `f : name → α → α`
over each `n : name` appearing in a `level.mvar n` in `l`.
-/
end level

/-! ### Declarations about `binder` -/

/-- The type of binders containing a name, the binding info and the binding type -/
namespace binder

/-- Turn a binder into a string. Uses expr.to_string for the type. -/
end binder

/-!
### Converting between expressions and numerals

There are a number of ways to convert between expressions and numerals, depending on the input and
output types and whether you want to infer the necessary type classes.

See also the tactics `expr.of_nat`, `expr.of_int`, `expr.of_rat`.
-/

/--
`nat.mk_numeral n` embeds `n` as a numeral expression inside a type with 0, 1, and +.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`: expressions of the type `has_zero %%type`, etc.
 -/
/--
`int.mk_numeral z` embeds `z` as a numeral expression inside a type with 0, 1, +, and -.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`, `has_neg`: expressions of the type `has_zero %%type`, etc.
 -/
/--
`nat.to_pexpr n` creates a `pexpr` that will evaluate to `n`.
The `pexpr` does not hold any typing information:
`to_expr ``((%%(nat.to_pexpr 5) : ℤ))` will create a native integer numeral `(5 : ℤ)`.
-/
namespace expr

/--
Turns an expression into a natural number, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero`, `nat.zero`, and `nat.succ`.
-/
/--
Turns an expression into a integer, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero` and a optionally a single `has_neg.neg` as head.
-/
/--
`is_num_eq n1 n2` returns true if `n1` and `n2` are both numerals with the same numeral structure,
ignoring differences in type and type class arguments.
-/
end expr

/-! ### Declarations about `expr` -/

namespace expr

/-- List of names removed by `clean`. All these names must resolve to functions defeq `id`. -/
/-- Clean an expression by removing `id`s listed in `clean_ids`. -/
/-- `replace_with e s s'` replaces ocurrences of `s` with `s'` in `e`. -/
/-- Apply a function to each constant (inductive type, defined function etc) in an expression. -/
/-- Match a variable. -/
/-- Match a sort. -/
/-- Match a constant. -/
/-- Match a metavariable. -/
/-- Match a local constant. -/
/-- Match an application. -/
/-- Match an abstraction. -/
/-- Match a Π type. -/
/-- Match a let. -/
/-- Match a macro. -/
/-- Tests whether an expression is a meta-variable. -/
/-- Tests whether an expression is a sort. -/
/-- Get the universe levels of a `const` expression -/
/--
Replace any metavariables in the expression with underscores, in preparation for printing
`refine ...` statements.
-/
/-- If `e` is a local constant, `to_implicit_local_const e` changes the binder info of `e` to
 `implicit`. See also `to_implicit_binder`, which also changes lambdas and pis. -/
/-- If `e` is a local constant, lamda, or pi expression, `to_implicit_binder e` changes the binder
info of `e` to `implicit`. See also `to_implicit_local_const`, which only changes local constants. -/
/-- Returns a list of all local constants in an expression (without duplicates). -/
/-- Returns the set of all local constants in an expression. -/
/-- Returns the unique names of all local constants in an expression. -/
/-- Returns a name_set of all constants in an expression. -/
/-- Returns a list of all meta-variables in an expression (without duplicates). -/
/-- Returns the set of all meta-variables in an expression. -/
/-- Returns a list of all universe meta-variables in an expression (without duplicates). -/
/--
Test `t` contains the specified subexpression `e`, or a metavariable.
This represents the notion that `e` "may occur" in `t`,
possibly after subsequent unification.
-/
-- We can't use `t.has_meta_var` here, as that detects universe metavariables, too.

/-- Returns a name_set of all constants in an expression starting with a certain prefix. -/
/-- Returns true if `e` contains a name `n` where `p n` is true.
  Returns `true` if `p name.anonymous` is true. -/
/--
Returns true if `e` contains a `sorry`.
-/
/--
`app_symbol_in e l` returns true iff `e` is an application of a constant whose name is in `l`.
-/
/-- `get_simp_args e` returns the arguments of `e` that simp can reach via congruence lemmas. -/
-- `mk_specialized_congr_lemma_simp` throws an assertion violation if its argument is not an app

/-- Simplifies the expression `t` with the specified options.
  The result is `(new_e, pr)` with the new expression `new_e` and a proof
  `pr : e = new_e`. -/
/-- Definitionally simplifies the expression `t` with the specified options.
  The result is the simplified expression. -/
/-- Get the names of the bound variables by a sequence of pis or lambdas. -/
/-- head-reduce a single let expression -/
/-- head-reduce all let expressions -/
/-- Instantiate lambdas in the second argument by expressions from the first. -/
/-- Repeatedly apply `expr.subst`. -/
/-- `instantiate_lambdas_or_apps es e` instantiates lambdas in `e` by expressions from `es`.
If the length of `es` is larger than the number of lambdas in `e`,
then the term is applied to the remaining terms.
Also reduces head let-expressions in `e`, including those after instantiating all lambdas.

This is very similar to `expr.substs`, but this also reduces head let-expressions. -/
/--
Some declarations work with open expressions, i.e. an expr that has free variables.
end Mathlib


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

Instances of `traversable` for types from the core library
-/

import category.traversable.basic category.basic category.functor category.applicative
import data.list.basic data.set.lattice

universes u v

section option

open functor

variables {F G : Type u → Type u}
variables [applicative F] [applicative G]
variables [is_lawful_applicative F] [is_lawful_applicative G]

lemma option.id_traverse {α} (x : option α) : option.traverse id.mk x = x :=
by cases x; refl

lemma option.comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : option α) :
  option.traverse (comp.mk ∘ (<$>) f ∘ g) x =
  comp.mk (option.traverse f <$> option.traverse g x) :=
by cases x; simp! with functor_norm; refl

lemma option.traverse_eq_map_id {α β} (f : α → β) (x : option α) :
  traverse (id.mk ∘ f) x = id.mk (f <$> x) :=
by cases x; refl

variable (η : applicative_transformation F G)

lemma option.naturality {α β} (f : α → F β) (x : option α) :
  η (option.traverse f x) = option.traverse (@η _ ∘ f) x :=
by cases x with x; simp! [*] with functor_norm

end option

instance : is_lawful_traversable option :=
{ id_traverse := @option.id_traverse,
  comp_traverse := @option.comp_traverse,
  traverse_eq_map_id := @option.traverse_eq_map_id,
  naturality := @option.naturality }

namespace list

variables {F G : Type u → Type u}
variables [applicative F] [applicative G]

section
variables [is_lawful_applicative F] [is_lawful_applicative G]

open applicative functor
open list (cons)

protected lemma id_traverse {α} (xs : list α) :
  list.traverse id.mk xs = xs :=
by induction xs; simp! * with functor_norm; refl

protected lemma comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : list α) :
  list.traverse (comp.mk ∘ (<$>) f ∘ g) x =
  comp.mk (list.traverse f <$> list.traverse g x) :=
by induction x; simp! * with functor_norm; refl

protected lemma traverse_eq_map_id {α β} (f : α → β) (x : list α) :
  list.traverse (id.mk ∘ f) x = id.mk (f <$> x) :=
by induction x; simp! * with functor_norm; refl

variable (η : applicative_transformation F G)

protected lemma naturality {α β} (f : α → F β) (x : list α) :
  η (list.traverse f x) = list.traverse (@η _ ∘ f) x :=
by induction x; simp! * with functor_norm
open nat

instance : is_lawful_traversable list :=
{ id_traverse := @list.id_traverse,
  comp_traverse := @list.comp_traverse,
  traverse_eq_map_id := @list.traverse_eq_map_id,
  naturality := @list.naturality }
end

section traverse
variables {α' β' : Type u} (f : α' → F β')

@[simp] lemma traverse_nil : traverse f ([] : list α') = (pure [] : F (list β')) := rfl

@[simp] lemma traverse_cons (a : α') (l : list α') :
  traverse f (a :: l) = (::) <$> f a <*> traverse f l := rfl

variables [is_lawful_applicative F]

@[simp] lemma traverse_append :
  ∀ (as bs : list α'), traverse f (as ++ bs) = (++) <$> traverse f as <*> traverse f bs
| [] bs :=
  have has_append.append ([] : list β') = id, by funext; refl,
  by simp [this] with functor_norm
| (a :: as) bs := by simp [traverse_append as bs] with functor_norm; congr

lemma mem_traverse {f : α' → set β'} :
  ∀(l : list α') (n : list β'), n ∈ traverse f l ↔ forall₂ (λb a, b ∈ f a) n l
| []      []      := by simp
| (a::as) []      := by simp; exact assume h, match h with end
| []      (b::bs) := by simp
| (a::as) (b::bs) :=
  suffices (b :: bs : list β') ∈ traverse f (a :: as) ↔ b ∈ f a ∧ bs ∈ traverse f as,
    by simpa [mem_traverse as bs],
  iff.intro
    (assume ⟨_, ⟨b, hb, rfl⟩, _, hl, rfl⟩, ⟨hb, hl⟩)
    (assume ⟨hb, hl⟩, ⟨_, ⟨b, hb, rfl⟩, _, hl, rfl⟩)

end traverse

end list

namespace sum

section traverse
variables {σ : Type u}
variables {F G : Type u → Type u}
variables [applicative F] [applicative G]

open applicative functor
open list (cons)

variables [is_lawful_applicative F] [is_lawful_applicative G]

protected lemma id_traverse {σ α} (x : σ ⊕ α) : sum.traverse id.mk x = x :=
by cases x; refl

protected lemma comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : σ ⊕ α) :
  sum.traverse (comp.mk ∘ (<$>) f ∘ g) x =
  comp.mk (sum.traverse f <$> sum.traverse g x) :=
by cases x; simp! [sum.traverse,map_id] with functor_norm; refl

protected lemma traverse_eq_map_id {α β} (f : α → β) (x : σ ⊕ α) :
  sum.traverse (id.mk ∘ f) x = id.mk (f <$> x) :=
by induction x; simp! * with functor_norm; refl

protected lemma map_traverse {α β γ} (g : α → G β) (f : β → γ) (x : σ ⊕ α) :
  (<$>) f <$> sum.traverse g x = sum.traverse ((<$>) f ∘ g) x :=
by cases x; simp [sum.traverse, id_map] with functor_norm; congr; refl

protected lemma traverse_map {α β γ : Type u} (g : α → β) (f : β → G γ) (x : σ ⊕ α) :
  sum.traverse f (g <$> x) = sum.traverse (f ∘ g) x :=
by cases x; simp [sum.traverse, id_map] with functor_norm; refl

variable (η : applicative_transformation F G)

protected lemma naturality {α β} (f : α → F β) (x : σ ⊕ α) :
  η (sum.traverse f x) = sum.traverse (@η _ ∘ f) x :=
by cases x; simp! [sum.traverse] with functor_norm

end traverse

instance {σ : Type u} : is_lawful_traversable.{u} (sum σ) :=
{ id_traverse := @sum.id_traverse σ,
  comp_traverse := @sum.comp_traverse σ,
  traverse_eq_map_id := @sum.traverse_eq_map_id σ,
  naturality := @sum.naturality σ }

end sum


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

! This file was ported from Lean 3 source module data.fun_like.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Function.Basic
import Mathbin.Tactic.Lint.Default
import Mathbin.Tactic.NormCast

/-!
# Typeclass for a type `F` with an injective map to `A → B`

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This typeclass is primarily for use by homomorphisms like `monoid_hom` and `linear_map`.

## Basic usage of `fun_like`

A typical type of morphisms should be declared as:
```
structure my_hom (A B : Type*) [my_class A] [my_class B] :=
(to_fun : A → B)
(map_op' : ∀ {x y : A}, to_fun (my_class.op x y) = my_class.op (to_fun x) (to_fun y))

namespace my_hom

variables (A B : Type*) [my_class A] [my_class B]

-- This instance is optional if you follow the "morphism class" design below:
instance : fun_like (my_hom A B) A (λ _, B) :=
{ coe := my_hom.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr' }

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance : has_coe_to_fun (my_hom A B) (λ _, A → B) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : my_hom A B} : f.to_fun = (f : A → B) := rfl

@[ext] theorem ext {f g : my_hom A B} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

/-- Copy of a `my_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : my_hom A B) (f' : A → B) (h : f' = ⇑f) : my_hom A B :=
{ to_fun := f',
  map_op' := h.symm ▸ f.map_op' }

end my_hom
```

This file will then provide a `has_coe_to_fun` instance and various
extensionality and simp lemmas.

## Morphism classes extending `fun_like`

The `fun_like` design provides further benefits if you put in a bit more work.
The first step is to extend `fun_like` to create a class of those types satisfying
the axioms of your new type of morphisms.
Continuing the example above:

```
section
set_option old_structure_cmd true

/-- `my_hom_class F A B` states that `F` is a type of `my_class.op`-preserving morphisms.
You should extend this class when you extend `my_hom`. -/
class my_hom_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B]
  extends fun_like F A (λ _, B) :=
(map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y))

end
@[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_hom_class F A B]
  (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) :=
my_hom_class.map_op

-- You can replace `my_hom.fun_like` with the below instance:
instance : my_hom_class (my_hom A B) A B :=
{ coe := my_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := my_hom.map_op' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

The second step is to add instances of your new `my_hom_class` for all types extending `my_hom`.
Typically, you can just declare a new class analogous to `my_hom_class`:

```
structure cooler_hom (A B : Type*) [cool_class A] [cool_class B]
  extends my_hom A B :=
(map_cool' : to_fun cool_class.cool = cool_class.cool)

section
set_option old_structure_cmd true

class cooler_hom_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B]
  extends my_hom_class F A B :=
(map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool)

end

@[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_hom_class F A B]
  (f : F) : f cool_class.cool = cool_class.cool :=
my_hom_class.map_op

-- You can also replace `my_hom.fun_like` with the below instance:
instance : cool_hom_class (cool_hom A B) A B :=
{ coe := cool_hom.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_op := cool_hom.map_op',
  map_cool := cool_hom.map_cool' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

Then any declaration taking a specific type of morphisms as parameter can instead take the
class you just defined:
```
-- Compare with: lemma do_something (f : my_hom A B) : sorry := sorry
lemma do_something {F : Type*} [my_hom_class F A B] (f : F) : sorry := sorry
```

This means anything set up for `my_hom`s will automatically work for `cool_hom_class`es,
and defining `cool_hom_class` only takes a constant amount of effort,
instead of linearly increasing the work per `my_hom`-related declaration.

-/

-- This instance should have low priority, to ensure we follow the chain
-- `fun_like → has_coe_to_fun`
attribute [instance] coeFnTrans

/- warning: fun_like -> FunLike is a dubious translation:
lean 3 declaration is
  Sort.{u1} -> (forall (α : outParam.{succ u2} Sort.{u2}), (outParam.{max u2 (succ u3)} (α -> Sort.{u3})) -> Sort.{max 1 (imax u1 u2 u3)})
but is expected to have type
  Sort.{u1} -> (forall (α : outParam.{succ u2} Sort.{u2}), (outParam.{max u2 (succ u3)} (α -> Sort.{u3})) -> Sort.{max (max (max 1 u1) u2) u3})
Case conversion may be inaccurate. Consider using '#align fun_like FunLikeₓ'. -/
/-- The class `fun_like F α β` expresses that terms of type `F` have an
injective coercion to functions from `α` to `β`.

This typeclass is used in the definition of the homomorphism typeclasses,
such as `zero_hom_class`, `mul_hom_class`, `monoid_hom_class`, ....
-/
class FunLike (F : Sort _) (α : outParam (Sort _)) (β : outParam <| α → Sort _) where
  coe : F → ∀ a : α, β a
  coe_injective' : Function.Injective coe
#align fun_like FunLike

section Dependent

/-! ### `fun_like F α β` where `β` depends on `a : α` -/

variable (F α : Sort _) (β : α → Sort _)

namespace FunLike

variable {F α β} [i : FunLike F α β]

include i

-- Give this a priority between `coe_fn_trans` and the default priority
-- `α` and `β` are out_params, so this instance should not be dangerous
@[nolint dangerous_instance]
instance (priority := 100) : CoeFun F fun _ => ∀ a : α, β a where coe := FunLike.coe

/- warning: fun_like.coe_eq_coe_fn -> FunLike.coe_eq_coe_fn is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β], Eq.{imax u1 u2 u3} (F -> (forall (a : α), β a)) (FunLike.coe.{u1, u2, u3} F α (fun (a : α) => β a) i) (coeFn.{u1, imax u2 u3} F (fun (ᾰ : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : α -> Sort.{u1}} [i : FunLike.{u3, u2, u1} F α β], Eq.{imax u3 u2 u1} (F -> (forall (a : α), β a)) (FunLike.coe.{u3, u2, u1} F α β i) (fun (f : F) => FunLike.coe.{u3, u2, u1} F α (fun (a : α) => β a) i f)
Case conversion may be inaccurate. Consider using '#align fun_like.coe_eq_coe_fn FunLike.coe_eq_coe_fnₓ'. -/
@[simp]
theorem coe_eq_coe_fn : (FunLike.coe : F → ∀ a : α, β a) = coeFn :=
  rfl
#align fun_like.coe_eq_coe_fn FunLike.coe_eq_coe_fn

/- warning: fun_like.coe_injective -> FunLike.coe_injective is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β], Function.Injective.{u1, imax u2 u3} F (forall (a : α), β a) (coeFn.{u1, imax u2 u3} F (fun (ᾰ : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : α -> Sort.{u1}} [i : FunLike.{u3, u2, u1} F α β], Function.Injective.{u3, imax u2 u1} F (forall (a : α), β a) (fun (f : F) => FunLike.coe.{u3, u2, u1} F α (fun (a : α) => β a) i f)
Case conversion may be inaccurate. Consider using '#align fun_like.coe_injective FunLike.coe_injectiveₓ'. -/
theorem coe_injective : Function.Injective (coeFn : F → ∀ a : α, β a) :=
  FunLike.coe_injective'
#align fun_like.coe_injective FunLike.coe_injective

/- warning: fun_like.coe_fn_eq -> FunLike.coe_fn_eq is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, Iff (Eq.{imax u2 u3} ((fun (_x : F) => forall (a : α), β a) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g)) (Eq.{u1} F f g)
but is expected to have type
  forall {F : Sort.{u1}} {α : Sort.{u3}} {β : α -> Sort.{u2}} [i : FunLike.{u1, u3, u2} F α β] {f : F} {g : F}, Iff (Eq.{imax u3 u2} (forall (a : α), β a) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => β _x) i f) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => β _x) i g)) (Eq.{u1} F f g)
Case conversion may be inaccurate. Consider using '#align fun_like.coe_fn_eq FunLike.coe_fn_eqₓ'. -/
@[simp, norm_cast]
theorem coe_fn_eq {f g : F} : (f : ∀ a : α, β a) = (g : ∀ a : α, β a) ↔ f = g :=
  ⟨fun h => @coe_injective _ _ _ i _ _ h, fun h => by cases h <;> rfl⟩
#align fun_like.coe_fn_eq FunLike.coe_fn_eq

/- warning: fun_like.ext' -> FunLike.ext' is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, (Eq.{imax u2 u3} ((fun (_x : F) => forall (a : α), β a) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g)) -> (Eq.{u1} F f g)
but is expected to have type
  forall {F : Sort.{u1}} {α : Sort.{u3}} {β : α -> Sort.{u2}} [i : FunLike.{u1, u3, u2} F α β] {f : F} {g : F}, (Eq.{imax u3 u2} (forall (a : α), β a) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => β _x) i f) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => β _x) i g)) -> (Eq.{u1} F f g)
Case conversion may be inaccurate. Consider using '#align fun_like.ext' FunLike.ext'ₓ'. -/
theorem ext' {f g : F} (h : (f : ∀ a : α, β a) = (g : ∀ a : α, β a)) : f = g :=
  coe_injective h
#align fun_like.ext' FunLike.ext'

/- warning: fun_like.ext'_iff -> FunLike.ext'_iff is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, Iff (Eq.{u1} F f g) (Eq.{imax u2 u3} ((fun (_x : F) => forall (a : α), β a) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : α -> Sort.{u1}} [i : FunLike.{u3, u2, u1} F α β] {f : F} {g : F}, Iff (Eq.{u3} F f g) (Eq.{imax u2 u1} (forall (a : α), β a) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i f) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i g))
Case conversion may be inaccurate. Consider using '#align fun_like.ext'_iff FunLike.ext'_iffₓ'. -/
theorem ext'_iff {f g : F} : f = g ↔ (f : ∀ a : α, β a) = (g : ∀ a : α, β a) :=
  coe_fn_eq.symm
#align fun_like.ext'_iff FunLike.ext'_iff

/- warning: fun_like.ext -> FunLike.ext is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] (f : F) (g : F), (forall (x : α), Eq.{u3} (β x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g x)) -> (Eq.{u1} F f g)
but is expected to have type
  forall {F : Sort.{u2}} {α : Sort.{u1}} {β : α -> Sort.{u3}} [i : FunLike.{u2, u1, u3} F α β] (f : F) (g : F), (forall (x : α), Eq.{u3} (β x) (FunLike.coe.{u2, u1, u3} F α (fun (_x : α) => β _x) i f x) (FunLike.coe.{u2, u1, u3} F α (fun (_x : α) => β _x) i g x)) -> (Eq.{u2} F f g)
Case conversion may be inaccurate. Consider using '#align fun_like.ext FunLike.extₓ'. -/
theorem ext (f g : F) (h : ∀ x : α, f x = g x) : f = g :=
  coe_injective (funext h)
#align fun_like.ext FunLike.ext

/- warning: fun_like.ext_iff -> FunLike.ext_iff is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, Iff (Eq.{u1} F f g) (forall (x : α), Eq.{u3} (β x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g x))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u1}} {β : α -> Sort.{u2}} [i : FunLike.{u3, u1, u2} F α β] {f : F} {g : F}, Iff (Eq.{u3} F f g) (forall (x : α), Eq.{u2} (β x) (FunLike.coe.{u3, u1, u2} F α (fun (_x : α) => β _x) i f x) (FunLike.coe.{u3, u1, u2} F α (fun (_x : α) => β _x) i g x))
Case conversion may be inaccurate. Consider using '#align fun_like.ext_iff FunLike.ext_iffₓ'. -/
theorem ext_iff {f g : F} : f = g ↔ ∀ x, f x = g x :=
  coe_fn_eq.symm.trans Function.funext_iff
#align fun_like.ext_iff FunLike.ext_iff

/- warning: fun_like.congr_fun -> FunLike.congr_fun is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, (Eq.{u1} F f g) -> (forall (x : α), Eq.{u3} (β x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g x))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u1}} {β : α -> Sort.{u2}} [i : FunLike.{u3, u1, u2} F α β] {f : F} {g : F}, (Eq.{u3} F f g) -> (forall (x : α), Eq.{u2} (β x) (FunLike.coe.{u3, u1, u2} F α (fun (_x : α) => β _x) i f x) (FunLike.coe.{u3, u1, u2} F α (fun (_x : α) => β _x) i g x))
Case conversion may be inaccurate. Consider using '#align fun_like.congr_fun FunLike.congr_funₓ'. -/
protected theorem congr_fun {f g : F} (h₁ : f = g) (x : α) : f x = g x :=
  congr_fun (congr_arg _ h₁) x
#align fun_like.congr_fun FunLike.congr_fun

/- warning: fun_like.ne_iff -> FunLike.ne_iff is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, Iff (Ne.{u1} F f g) (Exists.{u2} α (fun (a : α) => Ne.{u3} (β a) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f a) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g a)))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : α -> Sort.{u1}} [i : FunLike.{u3, u2, u1} F α β] {f : F} {g : F}, Iff (Ne.{u3} F f g) (Exists.{u2} α (fun (a : α) => Ne.{u1} (β a) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i f a) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i g a)))
Case conversion may be inaccurate. Consider using '#align fun_like.ne_iff FunLike.ne_iffₓ'. -/
theorem ne_iff {f g : F} : f ≠ g ↔ ∃ a, f a ≠ g a :=
  ext_iff.Not.trans not_forall
#align fun_like.ne_iff FunLike.ne_iff

/- warning: fun_like.exists_ne -> FunLike.exists_ne is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] {f : F} {g : F}, (Ne.{u1} F f g) -> (Exists.{u2} α (fun (x : α) => Ne.{u3} (β x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => forall (a : α), β a) (FunLike.hasCoeToFun.{u1, u2, u3} F α β i) g x)))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : α -> Sort.{u1}} [i : FunLike.{u3, u2, u1} F α β] {f : F} {g : F}, (Ne.{u3} F f g) -> (Exists.{u2} α (fun (x : α) => Ne.{u1} (β x) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i f x) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => β _x) i g x)))
Case conversion may be inaccurate. Consider using '#align fun_like.exists_ne FunLike.exists_neₓ'. -/
theorem exists_ne {f g : F} (h : f ≠ g) : ∃ x, f x ≠ g x :=
  ne_iff.mp h
#align fun_like.exists_ne FunLike.exists_ne

/- warning: fun_like.subsingleton_cod -> FunLike.subsingleton_cod is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : α -> Sort.{u3}} [i : FunLike.{u1, u2, u3} F α β] [_inst_1 : forall (a : α), Subsingleton.{u3} (β a)], Subsingleton.{u1} F
but is expected to have type
  forall {F : Sort.{u1}} {α : Sort.{u3}} {β : α -> Sort.{u2}} [i : FunLike.{u1, u3, u2} F α β] [_inst_1 : forall (a : α), Subsingleton.{u2} (β a)], Subsingleton.{u1} F
Case conversion may be inaccurate. Consider using '#align fun_like.subsingleton_cod FunLike.subsingleton_codₓ'. -/
/-- This is not an instance to avoid slowing down every single `subsingleton` typeclass search.-/
theorem subsingleton_cod [∀ a, Subsingleton (β a)] : Subsingleton F :=
  ⟨fun f g => coe_injective <| Subsingleton.elim _ _⟩
#align fun_like.subsingleton_cod FunLike.subsingleton_cod

end FunLike

end Dependent

section NonDependent

/-! ### `fun_like F α (λ _, β)` where `β` does not depend on `a : α` -/

variable {F α β : Sort _} [i : FunLike F α fun _ => β]

include i

namespace FunLike

/- warning: fun_like.congr -> FunLike.congr is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : Sort.{u3}} [i : FunLike.{u1, u2, u3} F α (fun (_x : α) => β)] {f : F} {g : F} {x : α} {y : α}, (Eq.{u1} F f g) -> (Eq.{u2} α x y) -> (Eq.{u3} β (coeFn.{u1, imax u2 u3} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{u1, u2, u3} F α (fun (_x : α) => β) i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{u1, u2, u3} F α (fun (_x : α) => β) i) g y))
but is expected to have type
  forall {F : Sort.{u3}} {α : Sort.{u2}} {β : Sort.{u1}} [i : FunLike.{u3, u2, u1} F α (fun (_x : α) => β)] {f : F} {g : F} {x : α} {y : α}, (Eq.{u3} F f g) -> (Eq.{u2} α x y) -> (Eq.{u1} ((fun (x._@.Mathlib.Data.FunLike.Basic._hyg.614 : α) => β) x) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Basic._hyg.614 : α) => β) _x) i f x) (FunLike.coe.{u3, u2, u1} F α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Basic._hyg.614 : α) => β) _x) i g y))
Case conversion may be inaccurate. Consider using '#align fun_like.congr FunLike.congrₓ'. -/
protected theorem congr {f g : F} {x y : α} (h₁ : f = g) (h₂ : x = y) : f x = g y :=
  congr (congr_arg _ h₁) h₂
#align fun_like.congr FunLike.congr

/- warning: fun_like.congr_arg -> FunLike.congr_arg is a dubious translation:
lean 3 declaration is
  forall {F : Sort.{u1}} {α : Sort.{u2}} {β : Sort.{u3}} [i : FunLike.{u1, u2, u3} F α (fun (_x : α) => β)] (f : F) {x : α} {y : α}, (Eq.{u2} α x y) -> (Eq.{u3} β (coeFn.{u1, imax u2 u3} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{u1, u2, u3} F α (fun (_x : α) => β) i) f x) (coeFn.{u1, imax u2 u3} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{u1, u2, u3} F α (fun (_x : α) => β) i) f y))
but is expected to have type
  forall {F : Sort.{u1}} {α : Sort.{u3}} {β : Sort.{u2}} [i : FunLike.{u1, u3, u2} F α (fun (_x : α) => β)] (f : F) {x : α} {y : α}, (Eq.{u3} α x y) -> (Eq.{u2} ((fun (x._@.Mathlib.Data.FunLike.Basic._hyg.657 : α) => β) x) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Basic._hyg.657 : α) => β) _x) i f x) (FunLike.coe.{u1, u3, u2} F α (fun (_x : α) => (fun (x._@.Mathlib.Data.FunLike.Basic._hyg.657 : α) => β) _x) i f y))
Case conversion may be inaccurate. Consider using '#align fun_like.congr_arg FunLike.congr_argₓ'. -/
protected theorem congr_arg (f : F) {x y : α} (h₂ : x = y) : f x = f y :=
  congr_arg _ h₂
#align fun_like.congr_arg FunLike.congr_arg

end FunLike

end NonDependent


example : List (Unit -> Nat) :=
  let g := [by exact fun _ => 0]; g

example : List (Unit -> Nat) :=
  let g := [fun _ => 0]; g


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

This file defines an alias command, which can be used to create copies
of a theorem or definition with different names.

Syntax:

/ -- doc string - /
alias my_theorem ← alias1 alias2 ...

This produces defs or theorems of the form:

/ -- doc string - /
@[alias] theorem alias1 : <type of my_theorem> := my_theorem

/ -- doc string - /
@[alias] theorem alias2 : <type of my_theorem> := my_theorem

Iff alias syntax:

alias A_iff_B ↔ B_of_A A_of_B
alias A_iff_B ↔ ..

This gets an existing biconditional theorem A_iff_B and produces
the one-way implications B_of_A and A_of_B (with no change in
implicit arguments). A blank _ can be used to avoid generating one direction.
The .. notation attempts to generate the 'of'-names automatically when the
input theorem has the form A_iff_B or A_iff_B_left etc.

-/
import data.buffer.parser meta.coinductive_predicates

open lean.parser tactic interactive parser

namespace tactic.alias

@[user_attribute] meta def alias_attr : user_attribute :=
{ name := `alias, descr := "This definition is an alias of another." }

meta def alias_direct (d : declaration) (doc : string) (al : name) : tactic unit :=
do updateex_env $ λ env,
  env.add (match d.to_definition with
  | declaration.defn n ls t _ _ _ :=
    declaration.defn al ls t (expr.const n (level.param <$> ls))
      reducibility_hints.abbrev tt
  | declaration.thm n ls t _ :=
    declaration.thm al ls t $ task.pure $ expr.const n (level.param <$> ls)
  | _ := undefined
  end),
  alias_attr.set al () tt,
  add_doc_string al doc

meta def mk_iff_mp_app (iffmp : name) : expr → (nat → expr) → tactic expr
| (expr.pi n bi e t) f := expr.lam n bi e <$> mk_iff_mp_app t (λ n, f (n+1) (expr.var n))
| `(%%a ↔ %%b) f := pure $ @expr.const tt iffmp [] a b (f 0)
| _ f := fail "Target theorem must have the form `Π x y z, a ↔ b`"

meta def alias_iff (d : declaration) (doc : string) (al : name) (iffmp : name) : tactic unit :=
(if al = `_ then skip else get_decl al >> skip) <|> do
  let ls := d.univ_params,
  let t := d.type,
  v ← mk_iff_mp_app iffmp t (λ_, expr.const d.to_name (level.param <$> ls)),
  t' ← infer_type v,
  updateex_env $ λ env, env.add (declaration.thm al ls t' $ task.pure v),
  alias_attr.set al () tt,
  add_doc_string al doc

meta def make_left_right : name → tactic (name × name)
| (name.mk_string s p) := do
  let buf : char_buffer := s.to_char_buffer,
  sum.inr parts ← pure $ run (sep_by1 (ch '_') (many_char (sat (≠ '_')))) s.to_char_buffer,
  (left, _::right) ← pure $ parts.span (≠ "iff"),
  let pfx (a b : string) := a.to_list.is_prefix_of b.to_list,
  (suffix', right') ← pure $ right.reverse.span (λ s, pfx "left" s ∨ pfx "right" s),
  let right := right'.reverse,
  let suffix := suffix'.reverse,
  pure (p <.> "_".intercalate (right ++ "of" :: left ++ suffix),
        p <.> "_".intercalate (left ++ "of" :: right ++ suffix))
| _ := failed

@[user_command] meta def alias_cmd (meta_info : decl_meta_info)
  (_ : parse $ tk "alias") : lean.parser unit :=
do old ← ident,
  d ← (do old ← resolve_constant old, get_decl old) <|>
    fail ("declaration " ++ to_string old ++ " not found"),
  let doc := λ al : name, meta_info.doc_string.get_or_else $
    "**Alias** of `" ++ to_string old ++ "`.",
  do {
    tk "←" <|> tk "<-",
    aliases ← many ident,
    ↑(aliases.mmap' $ λ al, alias_direct d (doc al) al) } <|>
  do {
    tk "↔" <|> tk "<->",
    (left, right) ←
      mcond ((tk "." *> tk "." >> pure tt) <|> pure ff)
        (make_left_right old <|> fail "invalid name for automatic name generation")
        (prod.mk <$> types.ident_ <*> types.ident_),
    alias_iff d (doc left) left `iff.mp,
    alias_iff d (doc right) right `iff.mpr }

meta def get_lambda_body : expr → expr
| (expr.lam _ _ _ b) := get_lambda_body b
| a                  := a

meta def get_alias_target (n : name) : tactic (option name) :=
do attr ← try_core (has_attribute `alias n),
  option.cases_on attr (pure none) $ λ_, do
  d ← get_decl n,
  let (head, args) := (get_lambda_body d.value).get_app_fn_args,
  let head := if head.is_constant_of `iff.mp ∨ head.is_constant_of `iff.mpr then
    expr.get_app_fn (head.ith_arg 2)
  else head,
  guardb $ head.is_constant,
  pure $ head.const_name

end tactic.alias


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

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

/-!
# solve_by_elim

A depth-first search backwards reasoner.

`solve_by_elim` takes a list of lemmas, and repeating tries to `apply` these against
the goals, recursively acting on any generated subgoals.

It accepts a variety of configuration options described below, enabling
* backtracking across multiple goals,
* pruning the search tree, and
* invoking other tactics before or after trying to apply lemmas.

At present it has no "premise selection", and simply tries the supplied lemmas in order
at each step of the search.
-/

namespace Tactic

namespace SolveByElim

/-- `mk_assumption_set` builds a collection of lemmas for use in
the backtracking search in `solve_by_elim`.

* By default, it includes all local hypotheses, along with `rfl`, `trivial`, `congr_fun` and
  `congr_arg`.
* The flag `no_dflt` removes these.
* The argument `hs` is a list of `simp_arg_type`s,
  and can be used to add, or remove, lemmas or expressions from the set.
* The argument `attr : list name` adds all lemmas tagged with one of a specified list of attributes.

`mk_assumption_set` returns not a `list expr`, but a `list (tactic expr) × tactic (list expr)`.
There are two separate problems that need to be solved.

### Relevant local hypotheses

`solve_by_elim*` works with multiple goals,
and we need to use separate sets of local hypotheses for each goal.
The second component of the returned value provides these local hypotheses.
(Essentially using `local_context`, along with some filtering to remove hypotheses
that have been explicitly removed via `only` or `[-h]`.)

### Stuck metavariables

Lemmas with implicit arguments would be filled in with metavariables if we created the
`expr` objects immediately, so instead we return thunks that generate the expressions
on demand. This is the first component, with type `list (tactic expr)`.

As an example, we have `def rfl : ∀ {α : Sort u} {a : α}, a = a`, which on elaboration will become
`@rfl ?m_1 ?m_2`.

Because `solve_by_elim` works by repeated application of lemmas against subgoals,
the first time such a lemma is successfully applied,
those metavariables will be unified, and thereafter have fixed values.
This would make it impossible to apply the lemma
a second time with different values of the metavariables.

See https://github.com/leanprover-community/mathlib/issues/2269

As an optimisation, after we build the list of `tactic expr`s, we actually run them, and replace any
that do not in fact produce metavariables with a simple `return` tactic.
-/
unsafe def mk_assumption_set (no_dflt : Bool) (hs : List simp_arg_type) (attr : List Name) :
    tactic (List (tactic expr) × tactic (List expr)) :=
  -- We lock the tactic state so that any spurious goals generated during
    -- elaboration of pre-expressions are discarded
    lock_tactic_state
    do
    let-- `hs` are expressions specified explicitly,
      -- `hex` are exceptions (specified via `solve_by_elim [-h]`) referring to local hypotheses,
      -- `gex` are the other exceptions
      (hs, gex, hex, all_hyps)
      ← decode_simp_arg_list hs
    let-- Recall, per the discussion above, we produce `tactic expr` thunks rather than actual `expr`s.
    -- Note that while we evaluate these thunks on two occasions below while preparing the list,
    -- this is a one-time cost during `mk_assumption_set`, rather than a cost proportional to the
    -- length of the search `solve_by_elim` executes.
    hs := hs.map fun h => i_to_expr_for_apply h
    let l ← attr.mapM fun a => attribute.get_instances a
    let l := l.join
    let m := l.map fun h => mk_const h
    let hs ←
      (-- In order to remove the expressions we need to evaluate the thunks.
              hs ++
              m).filterM
          fun h => do
          let h ← h
          return <| expr.const_name h ∉ gex
    let hs :=
      if no_dflt then hs
      else ([`rfl, `trivial, `congr_fun, `congr_arg].map fun n => mk_const n) ++ hs
    let locals : tactic (List expr) :=
      if ¬no_dflt ∨ all_hyps then do
        let ctx ← local_context
        -- Remove local exceptions specified in `hex`:
            return <|
            ctx fun h : expr => h ∉ hex
      else return []
    let hs
      ←-- Finally, run all of the tactics: any that return an expression without metavariables can safely
            -- be replaced by a `return` tactic.
            hs.mapM
          fun h : tactic expr => do
          let e ← h
          if e then return h else return (return e)
    return (hs, locals)
#align tactic.solve_by_elim.mk_assumption_set tactic.solve_by_elim.mk_assumption_set

/-- Configuration options for `solve_by_elim`.

* `accept : list expr → tactic unit` determines whether the current branch should be explored.
   At each step, before the lemmas are applied,
   `accept` is passed the proof terms for the original goals,
   as reported by `get_goals` when `solve_by_elim` started.
   These proof terms may be metavariables (if no progress has been made on that goal)
   or may contain metavariables at some leaf nodes
   (if the goal has been partially solved by previous `apply` steps).
   If the `accept` tactic fails `solve_by_elim` aborts searching this branch and backtracks.
   By default `accept := λ _, skip` always succeeds.
   (There is an example usage in `tests/solve_by_elim.lean`.)
* `pre_apply : tactic unit` specifies an additional tactic to run before each round of `apply`.
* `discharger : tactic unit` specifies an additional tactic to apply on subgoals
  for which no lemma applies.
  If that tactic succeeds, `solve_by_elim` will continue applying lemmas on resulting goals.
-/
unsafe structure basic_opt extends apply_any_opt where
  accept : List expr → tactic Unit := fun _ => skip
  pre_apply : tactic Unit := skip
  discharger : tactic Unit := failed
  max_depth : ℕ := 3
#align tactic.solve_by_elim.basic_opt tactic.solve_by_elim.basic_opt

initialize
  registerTraceClass.1 `solve_by_elim

-- trace attempted lemmas
/-- A helper function for trace messages, prepending '....' depending on the current search depth.
-/
unsafe def solve_by_elim_trace (n : ℕ) (f : format) : tactic Unit :=
  trace_if_enabled `solve_by_elim
    ((f!"[solve_by_elim {(List.replicate (n + 1) '.').asString} ") ++ f ++ "]")
#align tactic.solve_by_elim.solve_by_elim_trace tactic.solve_by_elim.solve_by_elim_trace

/-- A helper function to generate trace messages on successful applications. -/
unsafe def on_success (g : format) (n : ℕ) (e : expr) : tactic Unit := do
  let pp ← pp e
  solve_by_elim_trace n f! "✅ `{pp }` solves `⊢ {g}`"
#align tactic.solve_by_elim.on_success tactic.solve_by_elim.on_success

/-- A helper function to generate trace messages on unsuccessful applications. -/
unsafe def on_failure (g : format) (n : ℕ) : tactic Unit :=
  solve_by_elim_trace n f! "❌ failed to solve `⊢ {g}`"
#align tactic.solve_by_elim.on_failure tactic.solve_by_elim.on_failure

/-- A helper function to generate the tactic that print trace messages.
This function exists to ensure the target is pretty printed only as necessary.
-/
unsafe def trace_hooks (n : ℕ) : tactic ((expr → tactic Unit) × tactic Unit) :=
  if is_trace_enabled_for `solve_by_elim then do
    let g ← target >>= pp
    return (on_success g n, on_failure g n)
  else return (fun _ => skip, skip)
#align tactic.solve_by_elim.trace_hooks tactic.solve_by_elim.trace_hooks

/-- The internal implementation of `solve_by_elim`, with a limiting counter.
-/
unsafe def solve_by_elim_aux (opt : basic_opt) (original_goals : List expr)
    (lemmas : List (tactic expr)) (ctx : tactic (List expr)) : ℕ → tactic Unit
  | n => do
    -- First, check that progress so far is `accept`able.
        lock_tactic_state
        (original_goals instantiate_mvars >>= opt)
    -- Then check if we've finished.
          done >>
          solve_by_elim_trace (opt - n) "success!" <|>
        do
        -- Otherwise, if there's more time left,
              guard
              (n > 0) <|>
            solve_by_elim_trace opt "🛑 aborting, hit depth limit" >> failed
        -- run the `pre_apply` tactic, then
          opt
        let-- try either applying a lemma and recursing,
          (on_success, on_failure)
          ← trace_hooks (opt - n)
        let ctx_lemmas ← ctx
        apply_any_thunk (lemmas ++ ctx_lemmas return) opt (solve_by_elim_aux (n - 1)) on_success
              on_failure <|>-- or if that doesn't work, run the discharger and recurse.
              opt >>
              solve_by_elim_aux (n - 1)
#align tactic.solve_by_elim.solve_by_elim_aux tactic.solve_by_elim.solve_by_elim_aux

/-- Arguments for `solve_by_elim`:
* By default `solve_by_elim` operates only on the first goal,
  but with `backtrack_all_goals := true`, it operates on all goals at once,
  backtracking across goals as needed,
  and only succeeds if it discharges all goals.
* `lemmas` specifies the list of lemmas to use in the backtracking search.
  If `none`, `solve_by_elim` uses the local hypotheses,
  along with `rfl`, `trivial`, `congr_arg`, and `congr_fun`.
* `lemma_thunks` provides the lemmas as a list of `tactic expr`,
  which are used to regenerate the `expr` objects to avoid binding metavariables.
  It should not usually be specified by the user.
  (If both `lemmas` and `lemma_thunks` are specified, only `lemma_thunks` is used.)
* `ctx_thunk` is for internal use only: it returns the local hypotheses which will be used.
* `max_depth` bounds the depth of the search.
-/
unsafe structure opt extends basic_opt where
  backtrack_all_goals : Bool := false
  lemmas : Option (List expr) := none
  lemma_thunks : Option (List (tactic expr)) := lemmas.map fun l => l.map return
  ctx_thunk : tactic (List expr) := local_context
#align tactic.solve_by_elim.opt tactic.solve_by_elim.opt

/-- If no lemmas have been specified, generate the default set
(local hypotheses, along with `rfl`, `trivial`, `congr_arg`, and `congr_fun`).
-/
unsafe def opt.get_lemma_thunks (opt : opt) : tactic (List (tactic expr) × tactic (List expr)) :=
  match opt.lemma_thunks with
  | none => mk_assumption_set false [] []
  | some lemma_thunks => return (lemma_thunks, opt.ctx_thunk)
#align tactic.solve_by_elim.opt.get_lemma_thunks tactic.solve_by_elim.opt.get_lemma_thunks

end SolveByElim

open SolveByElim

/-- `solve_by_elim` repeatedly tries `apply`ing a lemma
from the list of assumptions (passed via the `opt` argument),
recursively operating on any generated subgoals, backtracking as necessary.

`solve_by_elim` succeeds only if it discharges the goal.
(By default, `solve_by_elim` focuses on the first goal, and only attempts to solve that.
With the option `backtrack_all_goals := tt`,
it attempts to solve all goals, and only succeeds if it does so.
With `backtrack_all_goals := tt`, `solve_by_elim` will backtrack a solution it has found for
one goal if it then can't discharge other goals.)

If passed an empty list of assumptions, `solve_by_elim` builds a default set
as per the interactive tactic, using the `local_context` along with
`rfl`, `trivial`, `congr_arg`, and `congr_fun`.

To pass a particular list of assumptions, use the `lemmas` field
in the configuration argument. This expects an
`option (list expr)`. In certain situations it may be necessary to instead use the
`lemma_thunks` field, which expects a `option (list (tactic expr))`.
This allows for regenerating metavariables
for each application, which might otherwise get stuck.

See also the simpler tactic `apply_rules`, which does not perform backtracking.
-/
unsafe def solve_by_elim (opt : opt := { }) : tactic Unit := do
  tactic.fail_if_no_goals
  let (lemmas, ctx_lemmas) ← opt.get_lemma_thunks
  (if opt then id else focus1) do
      let gs ← get_goals
      solve_by_elim_aux opt gs lemmas ctx_lemmas opt <|>
          fail
            ("`solve_by_elim` failed.\n" ++ "Try `solve_by_elim { max_depth := N }` for `N > " ++
                  toString opt ++
                "`\n" ++
              "or use `set_option trace.solve_by_elim true` to view the search.")
#align tactic.solve_by_elim tactic.solve_by_elim

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
namespace Interactive

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `apply_assumption` looks for an assumption of the form `... → ∀ _, ... → head`
where `head` matches the current goal.

If this fails, `apply_assumption` will call `symmetry` and try again.

If this also fails, `apply_assumption` will call `exfalso` and try again,
so that if there is an assumption of the form `P → ¬ Q`, the new tactic state
will have two goals, `P` and `Q`.

Optional arguments:
- `lemmas`: a list of expressions to apply, instead of the local constants
- `tac`: a tactic to run on each subgoal after applying an assumption; if
  this tactic fails, the corresponding assumption will be rejected and
  the next one will be attempted.
-/
unsafe def apply_assumption (lemmas : parse (parser.optional pexpr_list))
    (opt : apply_any_opt := { }) (tac : tactic Unit := skip) : tactic Unit := do
  let lemmas ←
    match lemmas with
      | none => local_context
      | some lemmas => lemmas.mapM to_expr
  tactic.apply_any lemmas opt tac
#align tactic.interactive.apply_assumption tactic.interactive.apply_assumption

add_tactic_doc
  { Name := "apply_assumption"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.apply_assumption]
    tags := ["context management", "lemma application"] }

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- `solve_by_elim` calls `apply` on the main goal to find an assumption whose head matches
and then repeatedly calls `apply` on the generated subgoals until no subgoals remain,
performing at most `max_depth` recursive steps.

`solve_by_elim` discharges the current goal or fails.

`solve_by_elim` performs back-tracking if subgoals can not be solved.

By default, the assumptions passed to `apply` are the local context, `rfl`, `trivial`,
`congr_fun` and `congr_arg`.

The assumptions can be modified with similar syntax as for `simp`:
* `solve_by_elim [h₁, h₂, ..., hᵣ]` also applies the named lemmas.
* `solve_by_elim with attr₁ ... attrᵣ` also applies all lemmas tagged with the specified attributes.
* `solve_by_elim only [h₁, h₂, ..., hᵣ]` does not include the local context,
  `rfl`, `trivial`, `congr_fun`, or `congr_arg` unless they are explicitly included.
* `solve_by_elim [-id_1, ... -id_n]` uses the default assumptions, removing the specified ones.

`solve_by_elim*` tries to solve all goals together, using backtracking if a solution for one goal
makes other goals impossible.

optional arguments passed via a configuration argument as `solve_by_elim { ... }`
- max_depth: number of attempts at discharging generated sub-goals
- discharger: a subsidiary tactic to try at each step when no lemmas apply
  (e.g. `cc` may be helpful).
- pre_apply: a subsidiary tactic to run at each step before applying lemmas (e.g. `intros`).
- accept: a subsidiary tactic `list expr → tactic unit` that at each step,
    before any lemmas are applied, is passed the original proof terms
    as reported by `get_goals` when `solve_by_elim` started
    (but which may by now have been partially solved by previous `apply` steps).
    If the `accept` tactic fails,
    `solve_by_elim` will abort searching the current branch and backtrack.
    This may be used to filter results, either at every step of the search,
    or filtering complete results
    (by testing for the absence of metavariables, and then the filtering condition).
-/
unsafe def solve_by_elim (all_goals : parse <| parser.optional (tk "*")) (no_dflt : parse only_flag)
    (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
    (opt : solve_by_elim.opt := { }) : tactic Unit := do
  let (lemma_thunks, ctx_thunk) ← mk_assumption_set no_dflt hs attr_names
  tactic.solve_by_elim
      { opt with
        backtrack_all_goals := all_goals ∨ opt
        lemma_thunks := some lemma_thunks
        ctx_thunk }
#align tactic.interactive.solve_by_elim tactic.interactive.solve_by_elim

add_tactic_doc
  { Name := "solve_by_elim"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.solve_by_elim]
    tags := ["search"] }

end Interactive

end Tactic


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.Control.Basic
import Init.Coe

namespace Option

def toMonad [Monad m] [Alternative m] : Option α → m α
  | none     => failure
  | some a   => pure a

@[inline] def toBool : Option α → Bool
  | some _ => true
  | none   => false

@[inline] def isSome : Option α → Bool
  | some _ => true
  | none   => false

@[inline] def isNone : Option α → Bool
  | some _ => false
  | none   => true

@[inline] def isEqSome [BEq α] : Option α → α → Bool
  | some a, b => a == b
  | none,   _ => false

@[inline] protected def bind : Option α → (α → Option β) → Option β
  | none,   _ => none
  | some a, b => b a

@[inline] protected def mapM [Monad m] (f : α → m β) (o : Option α) : m (Option β) := do
  if let some a := o then
    return some (← f a)
  else
    return none

theorem map_id : (Option.map id : Option α → Option α) = id :=
  funext (fun o => match o with | none => rfl | some _ => rfl)

@[always_inline, inline] protected def filter (p : α → Bool) : Option α → Option α
  | some a => if p a then some a else none
  | none   => none

@[always_inline, inline] protected def all (p : α → Bool) : Option α → Bool
  | some a => p a
  | none   => true

@[always_inline, inline] protected def any (p : α → Bool) : Option α → Bool
  | some a => p a
  | none   => false

@[always_inline, macro_inline] protected def orElse : Option α → (Unit → Option α) → Option α
  | some a, _ => some a
  | none,   b => b ()

instance : OrElse (Option α) where
  orElse := Option.orElse

@[inline] protected def lt (r : α → α → Prop) : Option α → Option α → Prop
  | none, some _     => True
  | some x,   some y => r x y
  | _, _             => False

instance (r : α → α → Prop) [s : DecidableRel r] : DecidableRel (Option.lt r)
  | none,   some _ => isTrue  trivial
  | some x, some y => s x y
  | some _, none   => isFalse not_false
  | none,   none   => isFalse not_false

/-- Take a pair of options and if they are both `some`, apply the given fn to produce an output.
Otherwise act like `orElse`. -/
def merge (fn : α → α → α) : Option α → Option α → Option α
  | none  , none   => none
  | some x, none   => some x
  | none  , some y => some y
  | some x, some y => some <| fn x y

end Option

deriving instance DecidableEq for Option
deriving instance BEq for Option

instance [LT α] : LT (Option α) where
  lt := Option.lt (· < ·)

@[always_inline]
instance : Functor Option where
  map := Option.map

@[always_inline]
instance : Monad Option where
  pure := Option.some
  bind := Option.bind

@[always_inline]
instance : Alternative Option where
  failure := Option.none
  orElse  := Option.orElse

def liftOption [Alternative m] : Option α → m α
  | some a => pure a
  | none   => failure

@[always_inline, inline] protected def Option.tryCatch (x : Option α) (handle : Unit → Option α) : Option α :=
  match x with
  | some _ => x
  | none => handle ()

instance : MonadExceptOf Unit Option where
  throw    := fun _ => Option.none
  tryCatch := Option.tryCatch


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl, Reid Barton, Sean Leather
-/
import tactic.lint

/-!
# Bundled types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

`bundled c` provides a uniform structure for bundling a type equipped with a type class.

We provide `category` instances for these in `category_theory/unbundled_hom.lean`
(for categories with unbundled homs, e.g. topological spaces)
and in `category_theory/bundled_hom.lean` (for categories with bundled homs, e.g. monoids).
-/

universes u v

namespace category_theory
variables {c d : Type u → Type v} {α : Type u}

/-- `bundled` is a type bundled with a type class instance for that type. Only
the type class is exposed as a parameter. -/
@[nolint has_nonempty_instance]
structure bundled (c : Type u → Type v) : Type (max (u+1) v) :=
(α : Type u)
(str : c α . tactic.apply_instance)

namespace bundled

/-- A generic function for lifting a type equipped with an instance to a bundled object. -/
-- Usually explicit instances will provide their own version of this, e.g. `Mon.of` and `Top.of`.
def of {c : Type u → Type v} (α : Type u) [str : c α] : bundled c := ⟨α, str⟩

instance : has_coe_to_sort (bundled c) (Type u) := ⟨bundled.α⟩

@[simp] lemma coe_mk (α) (str) : (@bundled.mk c α str : Type u) = α := rfl

/-
`bundled.map` is reducible so that, if we define a category

  def Ring : Type (u+1) := induced_category SemiRing (bundled.map @ring.to_semiring)

instance search is able to "see" that a morphism R ⟶ S in Ring is really
a (semi)ring homomorphism from R.α to S.α, and not merely from
`(bundled.map @ring.to_semiring R).α` to `(bundled.map @ring.to_semiring S).α`.
-/
/-- Map over the bundled structure -/
@[reducible] def map (f : Π {α}, c α → d α) (b : bundled c) : bundled d :=
⟨b, f b.str⟩

end bundled

end category_theory