import basic hp.core.source

/-! System for assigning labels to things.
Labels are chosen from hard-coded sets of letters.
Which set is used depends on the type of the thing being labelled.
So for example a group element should be labelled with `g`, `h` etc
but a point in a metric space should be labelled with `x`, `y` etc.

[todo] Allow adding new suggested name lists with attributes.
[todo] I think that a lot of non-humanproof tactics would benefit (in terms of user-friendliness) from
using this kind of labelling system. Perhaps there is some way it can be integrated with Lean.

# Labelling pools

A labelling pool is a dictionary `string ⇀ list string` sending a key string to a set of possible labels.
A labeller is defined by three pools:
- Class pool: sending names of classes `𝒞` to labels for types `α` that are instances of `𝒞`.
  For example a type `_ : Type` implementing `group _` should be labelled `G`.
  If a class has multiple arguments, the first argument is always bound to.
- Element pool: Suppose we have `α : Type` and `[𝒞 α]` for some typeclass `𝒞`, then the element pool contains labels for the elements of `α`.
  For example, `{G : Type} [group G]` causes `_ : G` to be labelled `g` or `h`. While `[metric_space X]` will be labelled `x y : X`
- Type pool: takes the function constant name of a type as the key and returns element names for that type.
  Eg terms of type `set α` will be labelled `A`, `B` etc.

-/
namespace hp

meta def labeller.pool := listdict string string

@[derive_setters]
meta structure labeller :=
-- class pool
(cp : labeller.pool)
-- element pool
(ep : labeller.pool)
-- type pool
(tp : labeller.pool)
(in_play : table name)
(counts : dictd string nat)

namespace labeller

meta instance : has_mem name labeller := ⟨λ n l, n ∈ l.in_play⟩
meta instance {n} {l : labeller} : decidable (n ∈ l) := by apply_instance

/- [todo] user attribute that allows users to add their own  -/

meta def default_labels := ["x", "y", "z", "v", "w", "a", "b", "c"]

meta def default_class_pool : pool :=
listdict.of [
  ("category", ["C", "D", "E"]),
  ("group", ["G", "H"]),
  -- ("point", ["x", "y", "z", "v", "w", "a", "b", "c"]),
  ("has_mem", ["a", "b", "c", "x", "y", "z", "u", "v", "w", "p", "q", "r", "s", "t"]),
  ("metric_space" , ["X", "Y", "Z"])
]

meta def default_element_pool : pool :=
listdict.of [ ("category", ["X","Y","Z"])
            , ("group", ["g", "h", "a", "b", "c", "x", "y", "z"]) ]

/-- pool for converting the head const of the type of an expression to its label -/
meta def default_type_pool : pool :=
listdict.of [ ("", ["x", "y", "z", "a", "b", "c"]) -- default
            , ("→", ["f", "g", "h"])
            , ("sequence" , ["κ", "σ", "τ"])
            , ("set", ["A", "B", "C", "D", "E", "X", "Y", "Z", "U", "V", "W", "P", "Q", "R", "S", "T"])
            , ("fin", ["i", "j", "k", "r", "s", "t"])
            , ("nat", ["n", "m", "p", "q", "i", "j", "r", "t"])
            , ("hom", ["f", "g", "h", "k", "l", "q", "r", "s", "t", "u", "v", "w"])
            -- , ("real", ["x", "y", "z"])
            , ("real", ["ε", "δ", "η", "ζ", "θ", "α", "β", "γ", "ω"])
            , ("Type", ["α", "β", "γ", "δ", "ε"])
            , ("Prop", ["P", "Q", "R"])
]

meta instance : inhabited labeller :=
⟨{ in_play := ∅
, counts := dictd.empty (λ _, 0)
, cp := default_class_pool
, tp := default_type_pool
, ep := default_element_pool
}⟩

meta def to_subscript_digit : nat → string
| 0 := "₀" | 1 := "₁" | 2 := "₂" | 3 := "₃" | 4 := "₄" | 5 := "₅" | 6 := "₆" | 7 := "₇" | 8 := "₈" | 9 := "₉"
| n := "♘"

meta def to_digits_rev : nat → list nat
| 0 := []
| n := (n % 10) :: to_digits_rev (n / 10)

meta def to_subscript : nat → string
| 0 := "₀"
| n := string.join $ list.map to_subscript_digit $ list.reverse $ to_digits_rev $ n

/- Here are the rules for looking up potential label names for a given expression (x : α).
- if `α = f ..xs`, look up `f.last` in `type_pool`
- if `α = Type`, look up "Type" in `type_pool`
- if `α = Prop`, look up "Prop" in `type_pool`
- if `α = expr.pi _ _ _ _`, look up "→" in `type_pool`,
- if `[C α]` for some class `C`, look up `C` in `element_pool`.
- if `[C x]` for some class `C`, look up `C` in `class_pool`.
  Also note that `[C x]` might not be in context yet, so might need to be clever with when labelling occurs.

 -/

variables {m : Type → Type} [monad m] [monad_state labeller m] [has_monad_lift tactic m] {α β : Type}

meta def get_fn_name : expr → string
| (expr.app f _) := get_fn_name f
| (expr.pi _ _ _ _) := "→"
| (expr.sort level.zero) := "Prop"
| (expr.sort _) := "Type"
| (expr.const n _) := n.last
| _ := "none"

meta def is_in_play : name → m bool | n:= do
  labs ← get,
  pure $ n ∈ in_play labs

meta def push_label : name → m unit | n := do
  modify $ labeller.modify_in_play $ insert n

meta def trace_label_state : m unit := do
  labs ← get,
  trace (to_string $ labs.in_play) (pure ()),
  pure ()

meta def select_label : list string → m name
| [] := ⍐ $ tactic.fail "need to select from at least one label"
| ss := do
  labs ← get,

  unused ← pure $ ss.find ((∉ labs) ∘ mk_simple_name),
  match unused with
  | (some h) := do
    n ← pure $ mk_simple_name h,
    push_label n,
    pure n
  | none := do
    ss ← pure $ ss.map (λ x, (x, labs.counts.get x)),
    some (base, i) ← pure $ ss.min_by (int.of_nat ∘ prod.snd),
    n ← pure $ mk_simple_name $ base ++ to_subscript i,
    modify $ labeller.modify_counts $ λ cs, cs.modify (+ 1) base,
    push_label n,
    pure n
  end

meta def label_intro (is_src : bool) : binder → cotelescope → m name
| ⟨n,bi,y⟩ rest := do
  y ← ⍐ $ tactic.instantiate_mvars $ y,
  labs ← get,
  ip ← ⍐ $ tactic.is_prop y,
  if ip then do
    -- if it's a Prop, then make it an H or a T.
    base ← pure $ if is_src then "H" else "T",
    select_label [base]
  else if n ≠ name.anonymous ∧ n ∉ labs then do
    -- if the binder name is not anon and is not in the labeller
    -- then register it as a label and return it.
    push_label n,
    pure n
  else do
    -- instantiate the rest of the cotelescope with a local.
    rest ← pure $ assignable.instantiate_var rest $ expr.local_const n n bi y,

    cls ← pure $ rest.collect $ λ b,
      match b with
      | ⟨_, binder_info.inst_implicit, expr.app (expr.const f _) (expr.local_const un _ _ _)⟩ :=
        if un = n then labs.cp.get f.last else []
      | _ := []
      end,
    -- cs are the typeclasses that the type belongs to
    cs ← ⍐ $ tactic.get_classes y,

    els ← pure $ cs.collect $ λ c, labs.ep.get c.last,
    -- ⍐ $ tactic.trace $ get_fn_name y,
    tls ← pure $ labs.tp.get $ get_fn_name y,
    ns ← pure $ cls ++ els ++ tls,
    ns ← pure $ if ns.empty then default_labels else ns,
    -- ⍐ $ tactic.trace $ ("selecting from names: ", ns),
    select_label ns

meta def label (p: pool) : expr → tactic (list string)
| T := do
  cs ← tactic.get_classes T,
  ts : string ← pure $ match expr.app_fn T with
        | (expr.const f _) := f.head
        | (expr.pi _ _ _ _) := "→"
        | _ := "none"
        end,
  ls ← pure $ cs.collect $ λ c, p.get c.head,
  pure $ match ls with
        | [] := p.get ""
        | ls := ls
        end

-- meta def get_fresh_label (ls : labeller) (type : string) (parent : name) : id (labeller × name) := do
--   -- [todo] also check the local_context.
--   if ¬(name.is_private parent ∨ parent = name.anonymous ∨ table.contains parent ls.in_play) then pure (ls, parent) else do
--   base ← pure $ match parent with
--   | name.anonymous := ""
--   | name.mk_numeral i n := ""
--   | name.mk_string  s n := s
--   end,
--   pool ← pure $ ls.pools.get base,
--   pool ← pure $ if pool.empty then ls.pools.get "" else pool,

--   ls ← pure $ { labeller .
--     in_play := ls.in_play.insert n,
--     counts := ls.counts.modify (+ 1) base,
--     ..ls
--   },
--   pure (ls, n)

open tactic.unsafe

meta def rename_meta : expr → m expr
| m@(expr.mvar un pn _):= do
  -- ⍐ tactic.trace_state,
  y ← ⍐ $ tactic.infer_type m >>= tactic.instantiate_mvars,
  b ← pure $ binder.mk name.anonymous binder_info.default y,
  label ← label_intro ff b [],
  -- ⍐ $ tactic.trace ("rename_meta", un, y, label),
  -- [todo] check if pn is sensible or something like `_mvar_.....`
  ⍐ $ type_context.run $ do
    -- pure (ls, mvar)
    lctx ← type_context.get_context m,
    g ← type_context.mk_mvar label y lctx,
    type_context.assign m g,
    pure g
| _ := ⍐ $ tactic.fail "not an mvar"

meta def type_to_label_type_key : expr → tactic string
| e := pure $ expr.to_string e -- [todo]

-- meta def rename_meta (ls : labeller) (mvar : expr) (parent : name := name.anonymous) : tactic (labeller × expr) := do
--   y ← tactic.infer_type mvar,
--   ip ← tactic.is_prop y,
--   if ip then rename_meta_core ls "target" parent mvar else do
--   type ← type_to_label_type_key y,
--   rename_meta_core ls type parent mvar

-- meta def get_fresh_binder_label (ls : labeller) : binder → tactic (labeller × binder)
-- | ⟨n,bi,y⟩ := do
--   ys ← type_to_label_type_key y,
--   (ls, n) ← pure $ get_fresh_label ls ys n,
--   pure (ls, ⟨n,bi,y⟩)

meta def label_cotelescope : cotelescope → m cotelescope
| [] := pure []
| (b :: rest) := do
  n ← label_intro tt b rest,
  -- ⍐ $ tactic.trace ("relabel", b, n),
  b ← pure $ {name := n, ..b},
  l ← ⍐ $ binder.mk_local b,
  rest ← pure $ @assignable.instantiate_var cotelescope (cotelescope.assignable) rest l,
  -- ⍐ $ tactic.trace (rest.reverse),
  rest ← label_cotelescope (rest),
  rest ← pure $ assignable.abstract_local rest l.local_uniq_name,
  -- ⍐ $ tactic.trace (rest.reverse),
  pure $ b :: rest

meta def label_telescope : telescope → m telescope :=
(pure ∘ list.reverse) >=> label_cotelescope >=> (pure ∘ list.reverse)

meta def free_label  (n : name) : m unit := do
  ls ← get,
  -- put $ ls.modify_in_play (dict.erase n),
  pure ()

meta def relabel_source : source → m source
| src := do
  l ← label_intro tt ⟨src.label, binder_info.default, src.type⟩ [],
  pure {label := l, ..src}

end labeller

end hp


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

General utility functions for buffers.
-/
import data.array.lemmas
import control.traversable.instances

namespace buffer

open function

variables {α : Type*} {xs : list α}

instance : inhabited (buffer α) := ⟨nil⟩

@[ext]
lemma ext : ∀ {b₁ b₂ : buffer α}, to_list b₁ = to_list b₂ → b₁ = b₂
| ⟨n₁, a₁⟩ ⟨n₂, a₂⟩ h := begin
  simp [to_list, to_array] at h,
  have e : n₁ = n₂ :=
    by rw [←array.to_list_length a₁, ←array.to_list_length a₂, h],
  subst e,
  have h : a₁ == a₂.to_list.to_array := h ▸ a₁.to_list_to_array.symm,
  rw eq_of_heq (h.trans a₂.to_list_to_array)
end

lemma ext_iff {b₁ b₂ : buffer α} : b₁ = b₂ ↔ to_list b₁ = to_list b₂ :=
⟨λ h, h ▸ rfl, ext⟩

lemma size_eq_zero_iff {b : buffer α} : b.size = 0 ↔ b = nil :=
begin
  rcases b with ⟨_|n, ⟨a⟩⟩,
  { simp only [size, nil, mk_buffer, true_and, true_iff, eq_self_iff_true, heq_iff_eq,
               sigma.mk.inj_iff],
    ext i,
    exact fin.elim0 i },
  { simp [size, nil, mk_buffer, nat.succ_ne_zero] }
end

@[simp] lemma size_nil : (@nil α).size = 0 :=
by rw size_eq_zero_iff

@[simp] lemma to_list_nil : to_list (@nil α) = [] := rfl

instance (α) [decidable_eq α] : decidable_eq (buffer α) :=
by tactic.mk_dec_eq_instance

@[simp]
lemma to_list_append_list {b : buffer α} :
  to_list (append_list b xs) = to_list b ++ xs :=
by induction xs generalizing b; simp! [*]; cases b; simp! [to_list,to_array]

@[simp]
lemma append_list_mk_buffer  :
  append_list mk_buffer xs = array.to_buffer (list.to_array xs) :=
by ext x : 1; simp [array.to_buffer,to_list,to_list_append_list];
   induction xs; [refl,skip]; simp [to_array]; refl

@[simp] lemma to_buffer_to_list (b : buffer α) : b.to_list.to_buffer = b :=
begin
  cases b,
  rw [to_list, to_array, list.to_buffer, append_list_mk_buffer],
  congr,
  { simpa },
  { apply array.to_list_to_array }
end

@[simp] lemma to_list_to_buffer (l : list α) : l.to_buffer.to_list = l :=
begin
  cases l,
  { refl },
  { rw [list.to_buffer, to_list_append_list],
    refl }
end

@[simp] lemma to_list_to_array (b : buffer α) : b.to_array.to_list = b.to_list :=
by { cases b, simp [to_list] }

@[simp] lemma append_list_nil (b : buffer α) : b.append_list [] = b := rfl

lemma to_buffer_cons (c : α) (l : list α) :
  (c :: l).to_buffer = [c].to_buffer.append_list l :=
begin
  induction l with hd tl hl,
  { simp },
  { apply ext,
    simp [hl] }
end

@[simp] lemma size_push_back (b : buffer α) (a : α) : (b.push_back a).size = b.size + 1 :=
by { cases b, simp [size, push_back] }

@[simp] lemma size_append_list (b : buffer α) (l : list α) :
  (b.append_list l).size = b.size + l.length :=
begin
  induction l with hd tl hl generalizing b,
  { simp },
  { simp [append_list, hl, add_comm, add_assoc] }
end

@[simp] lemma size_to_buffer (l : list α) : l.to_buffer.size = l.length :=
begin
  induction l with hd tl hl,
  { simpa },
  { rw [to_buffer_cons],
    have : [hd].to_buffer.size = 1 := rfl,
    simp [add_comm, this] }
end

@[simp] lemma length_to_list (b : buffer α) : b.to_list.length = b.size :=
by rw [←to_buffer_to_list b, to_list_to_buffer, size_to_buffer]

lemma size_singleton (a : α) : [a].to_buffer.size = 1 := rfl

lemma read_push_back_left (b : buffer α) (a : α) {i : ℕ} (h : i < b.size) :
  (b.push_back a).read ⟨i, by { convert nat.lt_succ_of_lt h, simp }⟩ = b.read ⟨i, h⟩ :=
by { cases b, convert array.read_push_back_left _, simp }

@[simp] lemma read_push_back_right (b : buffer α) (a : α) :
  (b.push_back a).read ⟨b.size, by simp⟩ = a :=
by { cases b, convert array.read_push_back_right }

lemma read_append_list_left' (b : buffer α) (l : list α) {i : ℕ}
  (h : i < (b.append_list l).size) (h' : i < b.size) :
  (b.append_list l).read ⟨i, h⟩ = b.read ⟨i, h'⟩ :=
begin
  induction l with hd tl hl generalizing b,
  { refl },
  { have hb : i < ((b.push_back hd).append_list tl).size := by convert h using 1,
    have hb' : i < (b.push_back hd).size := by { convert nat.lt_succ_of_lt h', simp },
    have : (append_list b (hd :: tl)).read ⟨i, h⟩ =
      read ((push_back b hd).append_list tl) ⟨i, hb⟩ := rfl,
    simp [this, hl _ hb hb', read_push_back_left _ _ h'] }
end

lemma read_append_list_left (b : buffer α) (l : list α) {i : ℕ} (h : i < b.size) :
  (b.append_list l).read ⟨i, by simpa using nat.lt_add_right _ _ _ h⟩ = b.read ⟨i, h⟩ :=
read_append_list_left' b l _ h

@[simp] lemma read_append_list_right (b : buffer α) (l : list α) {i : ℕ} (h : i < l.length) :
  (b.append_list l).read ⟨b.size + i, by simp [h]⟩ = l.nth_le i h :=
begin
  induction l with hd tl hl generalizing b i,
  { exact absurd i.zero_le (not_le_of_lt h) },
  { convert_to ((b.push_back hd).append_list tl).read _ = _,
    cases i,
    { convert read_append_list_left _ _ _;
      simp },
    { rw [list.length, nat.succ_lt_succ_iff] at h,
      have : b.size + i.succ = (b.push_back hd).size + i,
        { simp [add_comm, add_left_comm, nat.succ_eq_add_one] },
      convert hl (b.push_back hd) h using 1,
      simpa [nat.add_succ, nat.succ_add] } }
end

lemma read_to_buffer' (l : list α) {i : ℕ} (h : i < l.to_buffer.size) (h' : i < l.length) :
  l.to_buffer.read ⟨i, h⟩ = l.nth_le i h' :=
begin
  cases l with hd tl,
  { simpa using h' },
  { have hi : i < ([hd].to_buffer.append_list tl).size := by simpa [add_comm] using h,
    convert_to ([hd].to_buffer.append_list tl).read ⟨i, hi⟩ = _,
    cases i,
    { convert read_append_list_left _ _ _,
      simp },
    { rw list.nth_le,
      convert read_append_list_right _ _ _,
      simp [nat.succ_eq_add_one, add_comm] } }
end

@[simp] lemma read_to_buffer (l : list α) (i) :
  l.to_buffer.read i = l.nth_le i (by { convert i.property, simp }) :=
by { convert read_to_buffer' _ _ _, { simp }, { simpa using i.property } }

lemma nth_le_to_list' (b : buffer α) {i : ℕ} (h h') :
  b.to_list.nth_le i h = b.read ⟨i, h'⟩ :=
begin
  have : b.to_list.to_buffer.read ⟨i, (by simpa using h')⟩ = b.read ⟨i, h'⟩,
  { congr' 1; simp [fin.heq_ext_iff] },
  simp [←this]
end

lemma nth_le_to_list (b : buffer α) {i : ℕ} (h) :
  b.to_list.nth_le i h = b.read ⟨i, by simpa using h⟩ :=
nth_le_to_list' _ _ _

lemma read_eq_nth_le_to_list (b : buffer α) (i) :
  b.read i = b.to_list.nth_le i (by simp) :=
by simp [nth_le_to_list]

lemma read_singleton (c : α) : [c].to_buffer.read ⟨0, by simp⟩ = c :=
by simp

/-- The natural equivalence between lists and buffers, using
`list.to_buffer` and `buffer.to_list`. -/
def list_equiv_buffer (α : Type*) : list α ≃ buffer α :=
begin
  refine { to_fun := list.to_buffer, inv_fun := buffer.to_list, .. };
  simp [left_inverse,function.right_inverse]
end

instance : traversable buffer :=
equiv.traversable list_equiv_buffer

instance : is_lawful_traversable buffer :=
equiv.is_lawful_traversable list_equiv_buffer

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

end buffer


import tactic

-- Если вы не работали с монадами и do-блоками раньше, почитайте туториал в интернете
-- `tactic α` - функция, работающие в контексте состояния тактики и возвращает α
-- `tactic unit` - ничего не возвращает (или же возвращает `()`)

open tactic

meta def make_nat : tactic ℕ :=
return 42

-- Как использовать результат работы других тактик внутри do-блока?
-- n ← make_nat

meta def trace_nat : tactic unit :=
do
  n ← make_nat,
  tactic.trace n

-- Как дебагать тактики?
example : false :=
begin
  trace_nat,
  sorry,
end

run_cmd trace_nat

-- Как работать с окружением в тактике?
-- Для первой цели есть функция tactic.target
#check tactic.target

meta def show_goal : tactic unit :=
do
  t ← target,
  trace t
  -- trace $ expr.to_raw_fmt t покажет полную структуру, не pretty printed

example (a b : ℤ) : a^2 + b^2 ≥ 0 :=
begin
  show_goal,
  sorry,
end

-- Для локальных гипотез: функции get_local и local_context
#check get_local
#check tactic.local_context
#check infer_type

meta def inspect_local_one (nm : name) : tactic unit :=
do
  a ← get_local nm,
  trace a,
  trace (expr.to_raw_fmt a),
  a_type ← infer_type a,
  trace a_type,
  trace (expr.to_raw_fmt a_type)

example (A : Type) (b c : A) (h : b = c) : false :=
begin
  inspect_local_one `A,
  inspect_local_one `h,
  sorry,
end

-- Для монадического программирования есть много (хоть и не так богато, как в Haskell) функций
#check list.mmap

meta def inspect_all : tactic unit :=
do
  ctx ← local_context,
  trace ctx,
  ctx_types ← list.mmap (infer_type) ctx,
  trace ctx_types,
  ctx.mmap' (λ e,
              do
                e_type ← infer_type e,
                trace $ (to_string e) ++ " : " ++ (to_string e_type))

example (A : Type) (b c : A) (h : b = c) : false :=
begin
  inspect_all,
  sorry,
end

-- Наконец, реализуем версию тактики `assumption`

meta def assump_one (e : expr) : tactic unit :=
do
  tactic.exact e

meta def assump_list : list expr → tactic unit
| [] := fail "No assumption found!"
| (hd :: tl) := exact hd <|> assump_list tl

meta def assump : tactic unit :=
do
  -- fail "TODO: implement"
  ctx ← local_context,
  assump_list ctx

-- Тест
example {A B C : Prop} (ha : A) (hb : B) (hc : C) : B :=
begin
  assump,
  -- sorry,
end

-- Больше упражнений: https://github.com/leanprover-community/lftcm2020/blob/master/src/exercises_sources/monday/metaprogramming.lean


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

/-!

# Recursive cases (`rcases`) tactic and related tactics

`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to
destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or
`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or
`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples.

Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which
are generated during the execution of `rcases` and represent individual elements destructured from
the input expression). An `rcases` pattern has the following grammar:

* A name like `x`, which names the active hypothesis as `x`.
* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the
  hypothesis).
* A hyphen `-`, which clears the active hypothesis and any dependents.
* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the
  hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa).
* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it
  against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.)
* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series
  of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
  then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
  and so on.
* An alternation pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
  or a nested disjunction like `a ∨ b ∨ c`.

The patterns are fairly liberal about the exact shape of the constructors, and will insert
additional alternation branches and tuple arguments if there are not enough arguments provided, and
reuse the tail for further matches if there are too many arguments provided to alternation and
tuple patterns.

This file also contains the `obtain` and `rintro` tactics, which use the same syntax of `rcases`
patterns but with a slightly different use case:

* `rintro` (or `rintros`) is used like `rintro x ⟨y, z⟩` and is the same as `intros` followed by
  `rcases` on the newly introduced arguments.
* `obtain` is the same as `rcases` but with a syntax styled after `have` rather than `cases`.
  `obtain ⟨hx, hy⟩ | hz := foo` is equivalent to `rcases foo with ⟨hx, hy⟩ | hz`. Unlike `rcases`,
  `obtain` also allows one to omit `:= foo`, although a type must be provided in this case,
  as in `obtain ⟨hx, hy⟩ | hz : a ∧ b ∨ c`, in which case it produces a subgoal for proving
  `a ∧ b ∨ c` in addition to the subgoals `hx : a, hy : b |- goal` and `hz : c |- goal`.

## Tags

rcases, rintro, obtain, destructuring, cases, pattern matching, match
-/

namespace Lean.Parser.Tactic

declare_syntax_cat rcasesPat
syntax rcasesPatMed := sepBy1(rcasesPat, " | ")
syntax rcasesPatLo := rcasesPatMed (" : " term)?
syntax (name := rcasesPat.one) ident : rcasesPat
syntax (name := rcasesPat.ignore) "_" : rcasesPat
syntax (name := rcasesPat.clear) "-" : rcasesPat
syntax (name := rcasesPat.tuple) "⟨" rcasesPatLo,* "⟩" : rcasesPat
syntax (name := rcasesPat.paren) "(" rcasesPatLo ")" : rcasesPat

declare_syntax_cat rintroPat
syntax (name := rintroPat.one) rcasesPat : rintroPat
syntax (name := rintroPat.binder) "(" rintroPat+ (" : " term)? ")" : rintroPat

end Lean.Parser.Tactic

/- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/
local notation "ListΣ" => List

/- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/
local notation "ListΠ" => List

namespace Lean.Meta

/-- Constructs a substitution consisting of `s` followed by `t`.
  This satisfies `(s.append t).apply e = t.apply (s.apply e)` -/
def FVarSubst.append (s t : FVarSubst) : FVarSubst :=
  s.1.foldl (fun s' k v => s'.insert k (t.apply v)) t

namespace RCases

/--
An `rcases` pattern can be one of the following, in a nested combination:

* A name like `foo`
* The special keyword `rfl` (for pattern matching on equality using `subst`)
* A hyphen `-`, which clears the active hypothesis and any dependents.
* A type ascription like `pat : ty` (parentheses are optional)
* A tuple constructor like `⟨p1, p2, p3⟩`
* An alternation / variant pattern `p1 | p2 | p3`

Parentheses can be used for grouping; alternation is higher precedence than type ascription, so
`p1 | p2 | p3 : ty` means `(p1 | p2 | p3) : ty`.

N-ary alternations are treated as a group, so `p1 | p2 | p3` is not the same as `p1 | (p2 | p3)`,
and similarly for tuples. However, note that an n-ary alternation or tuple can match an n-ary
conjunction or disjunction, because if the number of patterns exceeds the number of constructors in
the type being destructed, the extra patterns will match on the last element, meaning that
`p1 | p2 | p3` will act like `p1 | (p2 | p3)` when matching `a1 ∨ a2 ∨ a3`. If matching against a
type with 3 constructors,  `p1 | (p2 | p3)` will act like `p1 | (p2 | p3) | _` instead.
-/
inductive RCasesPatt : Type
| one : Syntax → Name → RCasesPatt
| clear : Syntax → RCasesPatt
| typed : Syntax → RCasesPatt → Syntax → RCasesPatt
| tuple : Syntax → ListΠ RCasesPatt → RCasesPatt
| alts : Syntax → ListΣ RCasesPatt → RCasesPatt
deriving Repr

namespace RCasesPatt

instance : Inhabited RCasesPatt := ⟨RCasesPatt.one Syntax.missing `_⟩

/-- Get the name from a pattern, if provided -/
partial def name? : RCasesPatt → Option Name
| one _ `_    => none
| one _ `rfl  => none
| one _ n     => n
| typed _ p _ => p.name?
| alts _ [p]  => p.name?
| _           => none

/-- Get the syntax node from which this pattern was parsed. Used for error messages -/
def ref : RCasesPatt → Syntax
| one ref _ => ref
| clear ref => ref
| typed ref _ _ => ref
| tuple ref _ => ref
| alts ref _ => ref

/-- Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩`
if `p` is not already a tuple. -/
def asTuple : RCasesPatt → ListΠ RCasesPatt
| tuple _ ps => ps
| p          => [p]

/-- Interpret an rcases pattern as an alternation, where non-alternations are treated as one
alternative. -/
def asAlts : RCasesPatt → ListΣ RCasesPatt
| alts _ ps => ps
| p         => [p]

/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/
def typed? (ref : Syntax) : RCasesPatt → Option Syntax → RCasesPatt
| p, none => p
| p, some ty => typed ref p ty

/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/
def tuple' : ListΠ RCasesPatt → RCasesPatt
| [p] => p
| ps  => tuple (ps.head?.map (·.ref) |>.getD Syntax.missing) ps

/-- Convert a list of patterns to an alternation pattern, but mapping `[p]` to `p` instead of
a unary alternation `|p`. -/
def alts' (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt
| [p] => p
| ps  => alts ref ps

/-- This function is used for producing rcases patterns based on a case tree. Suppose that we have
a list of patterns `ps` that will match correctly against the branches of the case tree for one
constructor. This function will merge tuples at the end of the list, so that `[a, b, ⟨c, d⟩]`
becomes `⟨a, b, c, d⟩` instead of `⟨a, b, ⟨c, d⟩⟩`.

We must be careful to turn `[a, ⟨⟩]` into `⟨a, ⟨⟩⟩` instead of `⟨a⟩` (which will not perform the
nested match). -/
def tuple₁Core : ListΠ RCasesPatt → ListΠ RCasesPatt
| []         => []
| [tuple ref []] => [tuple ref []]
| [tuple _ ps] => ps
| p :: ps    => p :: tuple₁Core ps

/-- This function is used for producing rcases patterns based on a case tree. This is like
`tuple₁Core` but it produces a pattern instead of a tuple pattern list, converting `[n]` to `n`
instead of `⟨n⟩` and `[]` to `_`, and otherwise just converting `[a, b, c]` to `⟨a, b, c⟩`. -/
def tuple₁ : ListΠ RCasesPatt → RCasesPatt
| []      => default
| [one ref n] => one ref n
| ps      => tuple ps.head!.ref $ tuple₁Core ps

/-- This function is used for producing rcases patterns based on a case tree. Here we are given
the list of patterns to apply to each argument of each constructor after the main case, and must
produce a list of alternatives with the same effect. This function calls `tuple₁` to make the
individual alternatives, and handles merging `[a, b, c | d]` to `a | b | c | d` instead of
`a | b | (c | d)`. -/
def alts₁Core : ListΣ (ListΠ RCasesPatt) → ListΣ RCasesPatt
| []          => []
| [[alts _ ps]] => ps
| p :: ps     => tuple₁ p :: alts₁Core ps

/-- This function is used for producing rcases patterns based on a case tree. This is like
`alts₁Core`, but it produces a cases pattern directly instead of a list of alternatives. We
specially translate the empty alternation to `⟨⟩`, and translate `|(a | b)` to `⟨a | b⟩` (because we
don't have any syntax for unary alternation). Otherwise we can use the regular merging of
alternations at the last argument so that `a | b | (c | d)` becomes `a | b | c | d`. -/
def alts₁ (ref : Syntax) : ListΣ (ListΠ RCasesPatt) → RCasesPatt
| [[]]        => tuple Syntax.missing []
| [[alts ref ps]] => tuple ref ps
| ps          => alts' ref $ alts₁Core ps

open MessageData in
partial instance : ToMessageData RCasesPatt := ⟨fmt 0⟩ where
  parenAbove (tgt p : Nat) (m : MessageData) : MessageData :=
    if tgt < p then m.paren else m
  fmt : Nat → RCasesPatt → MessageData
  | _, one _ n => n
  | _, clear _ => "-"
  | p, typed _ pat ty => parenAbove 0 p m!"{fmt 1 pat}: {ty}"
  | _, tuple _ pats => bracket "⟨" (joinSep (pats.map (fmt 0)) ("," ++ Format.line)) "⟩"
  | p, alts _ pats => parenAbove 1 p (joinSep (pats.map (fmt 2)) " | ")

end RCasesPatt

/-- Takes the number of fields of a single constructor and patterns to match its fields against
(not necessarily the same number). The returned lists each contain one element per field of the
constructor. The `name` is the name which will be used in the top-level `cases` tactic, and the
`rcases_patt` is the pattern which the field will be matched against by subsequent `cases`
tactics. -/
def processConstructor (ref : Syntax) : Nat → ListΠ RCasesPatt → ListΠ Name × ListΠ RCasesPatt
| 0,     ps      => ([], [])
| 1,     []      => ([`_], [default])
| 1,     [p]     => ([p.name?.getD `_], [p])
| 1,     ps      => ([`_], [RCasesPatt.tuple ref ps])
| n + 1, p :: ps => let (ns, tl) := processConstructor ref n ps
                    (p.name?.getD `_ :: ns, p :: tl)
| _,     _       => ([], [])

/-- Takes a list of constructor names, and an (alternation) list of patterns, and matches each
pattern against its constructor. It returns the list of names that will be passed to `cases`,
and the list of `(constructor name, patterns)` for each constructor, where `patterns` is the
(conjunctive) list of patterns to apply to each constructor argument. -/
def processConstructors (ref : Syntax) (params : Nat) (altVarNames : Array AltVarNames := #[]) :
  ListΣ Name → ListΣ RCasesPatt → MetaM (Array AltVarNames × ListΣ (Name × ListΠ RCasesPatt))
| [], ps => pure (altVarNames, [])
| c :: cs, ps => do
  let n := FunInfo.getArity $ ← getFunInfo (← mkConstWithLevelParams c)
  let p := ps.headD default
  let t := ps.tailD []
  let (h, t) := match cs, t with
  | [], _ :: _ => ([RCasesPatt.alts ref ps], [])
  | _,  _      => (p.asTuple, t)
  let (ns, ps) := processConstructor p.ref (n - params) h
  let (altVarNames, r)  ← processConstructors ref params (altVarNames.push ⟨true, ns⟩) cs t
  pure (altVarNames, (c, ps) :: r)

open Elab Tactic

-- this belongs in core; it is a variation on subst that passes fvarSubst through
def subst' (mvarId : MVarId) (hFVarId : FVarId)
  (fvarSubst : FVarSubst := {}) : MetaM (FVarSubst × MVarId) := do
  let hLocalDecl ← getLocalDecl hFVarId
  let error {α} _ : MetaM α := throwTacticEx `subst mvarId
    m!"invalid equality proof, it is not of the form (x = t) or (t = x){indentExpr hLocalDecl.type}"
  let some (α, lhs, rhs) ← matchEq? hLocalDecl.type | error ()
  let substReduced (newType : Expr) (symm : Bool) : MetaM (FVarSubst × MVarId) := do
    let mvarId ← assert mvarId hLocalDecl.userName newType (mkFVar hFVarId)
    let (hFVarId', mvarId) ← intro1P mvarId
    let mvarId ← clear mvarId hFVarId
    substCore mvarId hFVarId' (symm := symm) (tryToSkip := true) (fvarSubst := fvarSubst)
  let rhs' ← whnf rhs
  if rhs'.isFVar then
    if rhs != rhs' then
      substReduced (← mkEq lhs rhs') true
    else
      substCore mvarId hFVarId (symm := true) (tryToSkip := true) (fvarSubst := fvarSubst)
  else
    let lhs' ← whnf lhs
    if lhs'.isFVar then
      if lhs != lhs' then
        substReduced (← mkEq lhs' rhs) false
      else
        substCore mvarId hFVarId (symm := false) (tryToSkip := true) (fvarSubst := fvarSubst)
    else error ()

mutual

/-- This will match a pattern `pat` against a local hypothesis `e`.
  * `g`: The initial subgoal
  * `fs`: A running variable substitution, the result of `cases` operations upstream.
    The variable `e` must be run through this map before locating it in the context of `g`,
    and the output variable substitutions will be end extensions of this one.
  * `clears`: The list of variables to clear in all subgoals generated from this point on.
    We defer clear operations because clearing too early can cause `cases` to fail.
    The actual clearing happens in `RCases.finish`.
  * `e`: a local hypothesis, the scrutinee to match against.
  * `a`: opaque "user data" which is passed through all the goal calls at the end.
  * `pat`: the pattern to match against
  * `cont`: A continuation. This is called on every goal generated by the result of the pattern
    match, with updated values for `g` , `fs`, `clears`, and `a`. -/
partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e : FVarId) (a : α)
  (pat : RCasesPatt) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α :=
  let translate e : MetaM _ := do
    let e := fs.get e
    unless e.isFVar do
      throwError "rcases tactic failed: {e} is not a fvar"
    pure e
  withRef pat.ref <| withMVarContext g <| match pat with
  | RCasesPatt.one _ `rfl => do
    let (fs, g) ← subst' g (← translate e).fvarId! fs
    cont g fs clears a
  | RCasesPatt.one _ _ => cont g fs clears a
  | RCasesPatt.clear _ => cont g fs (clears.push e) a
  | RCasesPatt.typed _ pat ty => do
    let expected ← Term.elabType ty
    let e ← translate e
    let etype ← inferType e
    unless ← isDefEq etype expected do
      Term.throwTypeMismatchError "rcases: scrutinee" expected etype e
    let g ← replaceLocalDeclDefEq g e.fvarId! expected
    cont g fs clears a
  | RCasesPatt.alts _ [p] => rcasesCore g fs clears e a p cont
  | _ => do
    let e ← translate e
    let type ← whnfD (← inferType e)
    let failK {α} _ : TermElabM α :=
      throwError "rcases tactic failed: {e} : {type} is not an inductive datatype"
    let (r, subgoals) ← matchConst type.getAppFn failK fun
      | ConstantInfo.quotInfo info, _ => do
        unless info.kind matches QuotKind.type do failK ()
        let pat := pat.asAlts.headD default
        let ([x], ps) := processConstructor pat.ref 1 pat.asTuple | panic! "rcases"
        let (vars, g) ← Meta.revert g (← getFVarsToGeneralize #[e])
        withMVarContext g do
          let elimInfo ← getElimInfo `Quot.ind
          let res ← ElimApp.mkElimApp `Quot.ind elimInfo #[e] (← getMVarTag g)
          let elimArgs := res.elimApp.getAppArgs
          ElimApp.setMotiveArg g elimArgs[elimInfo.motivePos].mvarId! #[e.fvarId!]
          assignExprMVar g res.elimApp
          let #[(n, g)] := res.alts | panic! "rcases"
          let (v, g) ← intro g x
          let (varsOut, g) ← introNP g vars.size
          let fs' := (vars.zip varsOut).foldl (init := fs) fun fs (v, w) => fs.insert v (mkFVar w)
          pure ([(n, ps)], #[⟨⟨g, #[mkFVar v], fs'⟩, n⟩])
      | ConstantInfo.inductInfo info, _ => do
        let (altVarNames, r) ← processConstructors pat.ref info.numParams #[] info.ctors pat.asAlts
        (r, ·) <$> cases g e.fvarId! altVarNames
      | _, _ => failK ()
    (·.2) <$> subgoals.foldlM (init := (r, a)) fun (r, a) ⟨goal, ctorName⟩ => do
      let rec align
      | [] => pure ([], a)
      | (tgt, ps) :: as => do
        if tgt == ctorName then
          let fs := fs.append goal.subst
          (as, ·) <$> rcasesContinue goal.mvarId fs clears a (ps.zip goal.fields.toList) cont
        else
          align as
      align r

/-- This will match a list of patterns against a list of hypotheses `e`. The arguments are similar
to `rcasesCore`, but the patterns and local variables are in `pats`. Because the calls are all
nested in continuations, later arguments can be matched many times, once per goal produced by
earlier arguments. For example `⟨a | b, ⟨c, d⟩⟩` performs the `⟨c, d⟩` match twice, once on the
`a` branch and once on `b`. -/
partial def rcasesContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α)
  (pats : ListΠ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) :
  TermElabM α :=
  match pats with
  | []  => cont g fs clears a
  | ((pat, e) :: ps) => do
    unless e.isFVar do
      throwError "rcases tactic failed: {e} is not a fvar"
    rcasesCore g fs clears e.fvarId! a pat fun g fs clears a =>
      rcasesContinue g fs clears a ps cont

end

/-- Like `tryClearMany`, but also clears dependent hypotheses if possible -/
def tryClearMany' (mvarId : MVarId) (fvarIds : Array FVarId) : MetaM MVarId := do
  let mctx ← getMCtx
  let toErase := (← getMVarDecl mvarId).lctx.foldl (init := fvarIds) fun toErase localDecl =>
    if mctx.findLocalDeclDependsOn localDecl toErase.contains then
      toErase.push localDecl.fvarId
    else toErase
  tryClearMany mvarId toErase

/-- The terminating continuation used in `rcasesCore` and `rcasesContinue`. We specialize the type
`α` to `Array MVarId` to collect the list of goals, and given the list of `clears`, it attempts to
clear them from the goal and adds the goal to the list. -/
def finish (g : MVarId) (fs : FVarSubst) (clears : Array FVarId)
  (gs : Array MVarId) : TermElabM (Array MVarId) := do
  let cs : Array Expr := (clears.map fs.get).filter Expr.isFVar
  gs.push <$> tryClearMany' g (cs.map Expr.fvarId!)

open Elab

/-- Parses a `Syntax` into the `RCasesPatt` type used by the `RCases` tactic. -/
partial def RCasesPatt.parse (stx : Syntax) : MetaM RCasesPatt :=
  match stx with
  | `(Lean.Parser.Tactic.rcasesPatMed| $ps:rcasesPat|*) => do
    pure $ RCasesPatt.alts' stx (← ps.getElems.toList.mapM parse)
  | `(Lean.Parser.Tactic.rcasesPatLo| $pat:rcasesPatMed : $t:term) => do
    pure $ RCasesPatt.typed stx (← parse pat) t
  | `(Lean.Parser.Tactic.rcasesPatLo| $pat:rcasesPatMed) => parse pat
  | `(rcasesPat| _) => pure $ RCasesPatt.one stx `_
  | `(rcasesPat| $h:ident) => pure $ RCasesPatt.one stx h.getId
  | `(rcasesPat| -) => pure $ RCasesPatt.clear stx
  | `(rcasesPat| ⟨$ps,*⟩) => do
    pure $ RCasesPatt.tuple stx (← ps.getElems.toList.mapM parse)
  | `(rcasesPat| ($pat)) => parse pat
  | _ => throwUnsupportedSyntax

-- extracted from elabCasesTargets
def generalizeExceptFVar (mvarId : MVarId) (args : Array GeneralizeArg) : MetaM (Array Expr × MVarId) := do
  let argsToGeneralize := args.filter fun arg => !(arg.expr.isFVar && arg.hName?.isNone)
  let (fvarIdsNew, mvarId) ← generalize mvarId argsToGeneralize
  let mut result := #[]
  let mut j := 0
  for arg in args do
    if arg.expr.isFVar && arg.hName?.isNone then
      result := result.push arg.expr
    else
      result := result.push (mkFVar fvarIdsNew[j])
      j := j+1
  pure (result, mvarId)

/-- Given a list of targets of the form `e` or `h : e`, and a pattern, match all the targets
against the pattern. Returns the list of produced subgoals. -/
def rcases (tgts : Array (Option Name × Syntax))
  (pat : RCasesPatt) (g : MVarId) : TermElabM (List MVarId) := do
  let pats ← match tgts.size with
  | 0 => return [g]
  | 1 => pure [pat]
  | _ => pure (processConstructor pat.ref tgts.size pat.asTuple).2
  let (pats, args) := Array.unzip <|← (tgts.zip pats.toArray).mapM fun ((hName?, tgt), pat) => do
    let (pat, ty) ← match pat with
    | RCasesPatt.typed ref pat ty => pure (pat, some (← withRef ref <| Term.elabType ty))
    | _ => pure (pat, none)
    let expr ← Term.ensureHasType ty (← Term.elabTerm tgt ty)
    pure (pat, { expr, xName? := pat.name?, hName? : GeneralizeArg })
  let (vs, g) ← generalizeExceptFVar g args
  let gs ← rcasesContinue g {} #[] #[] (pats.zip vs).toList finish
  pure gs.toList

/-- The `obtain` tactic in the no-target case. Given a type `T`, create a goal `|- T` and
and pattern match `T` against the given pattern. Returns the list of goals, with the assumed goal
first followed by the goals produced by the pattern match. -/
def obtainNone (pat : RCasesPatt) (ty : Syntax) (g : MVarId) : TermElabM (List MVarId) := do
  let ty ← Term.elabType ty
  let g₁ ← mkFreshExprMVar (some ty)
  let (v, g₂) ← intro1 (← assert g (pat.name?.getD default) ty g₁)
  let gs ← rcasesCore g₂ {} #[] v #[] pat finish
  pure (g₁.mvarId! :: gs.toList)

mutual

partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α)
  (ref pat : Syntax) (ty? : Option Syntax)
  (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do
  match pat with
  | `(rintroPat| $pat:rcasesPat) =>
    let pat := (← RCasesPatt.parse pat).typed? ref ty?
    let (v, g) ← intro g (pat.name?.getD `_)
    rcasesCore g fs clears v a pat cont
  | `(rintroPat| ($(pats)* $[: $ty?]?)) =>
    rintroContinue g fs clears pat pats ty? a cont
  | _ => throwUnsupportedSyntax

partial def rintroContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId)
  (ref : Syntax) (pats : Array Syntax) (ty? : Option Syntax) (a : α)
  (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do
  withMVarContext g do
    let rec loop i g fs clears a := do
      if h : i < pats.size then
        rintroCore g fs clears a ref (pats.get ⟨i, h⟩) ty? (loop (i+1))
      else cont g fs clears a
    loop 0 g fs clears a

end

def rintro (ref : Syntax) (pats : Array Syntax) (ty? : Option Syntax)
  (g : MVarId) : TermElabM (List MVarId) :=
  (·.toList) <$> rintroContinue g {} #[] ref pats ty? #[] finish

end Lean.Meta.RCases

namespace Lean.Parser.Tactic
open Elab Elab.Tactic Meta RCases

elab (name := rcases?) "rcases?" tgts:casesTarget,* num:(" : " num)? : tactic =>
  throwError "unimplemented"

elab (name := rcases) tk:"rcases" tgts:casesTarget,* pat:(" with " rcasesPatLo)? : tactic => do
  let pat ← match pat.getArgs with
  | #[_, pat] => RCasesPatt.parse pat
  | #[] => pure $ RCasesPatt.tuple tk []
  | _ => throwUnsupportedSyntax
  let tgts := tgts.getElems.map fun tgt =>
    (if tgt[0].isNone then none else some tgt[0][0].getId, tgt[1])
  withMainContext do
    replaceMainGoal (← RCases.rcases tgts pat (← getMainGoal))

elab (name := obtain) tk:"obtain"
    pat:(ppSpace rcasesPatMed)? ty:(" : " term)? val:(" := " term,+)? : tactic => do
  let pat ← liftM $ pat.getOptional?.mapM RCasesPatt.parse
  if val.isNone then
    if ty.isNone then throwError
        ("`obtain` requires either an expected type or a value.\n" ++
        "usage: `obtain ⟨patt⟩? : type (:= val)?` or `obtain ⟨patt⟩? (: type)? := val`")
    let pat := pat.getD (RCasesPatt.one tk `this)
    withMainContext do
      replaceMainGoal (← RCases.obtainNone pat ty[1] (← getMainGoal))
  else
    let pat := pat.getD (RCasesPatt.one tk `_)
    let pat := pat.typed? tk $ if ty.isNone then none else some ty[1]
    let tgts := val[1].getSepArgs.map fun val => (none, val)
    withMainContext do
      replaceMainGoal (← RCases.rcases tgts pat (← getMainGoal))

elab (name := rintro?) "rintro?" (" : " num)? : tactic =>
  throwError "unimplemented"

elab (name := rintro) "rintro" pats:(ppSpace colGt rintroPat)+ ty:(" : " term)? : tactic => do
  let ty? := if ty.isNone then none else some ty[1]
  withMainContext do
    replaceMainGoal (← RCases.rintro ty pats.getArgs ty? (← getMainGoal))


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

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

/-!
# Swap bound variable tactic

This files defines a tactic `swap_var` whose main purpose is to be a weaker
version of `wlog` that juggles bound names.

It is a helper around the core tactic `rename`.

* `swap_var old new` renames all names named `old` to `new` and vice versa in the goal
  and all hypotheses.

```lean
example (P Q : Prop) (hp : P) (hq : Q) : P ∧ Q :=
begin
  split,
  work_on_goal 1 { swap_var [P Q] },
  all_goals { exact ‹P› }
end
```

# See also
* `tactic.interactive.rename`
* `tactic.interactive.rename_var`

-/

namespace Tactic.Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
private unsafe def swap_arg_parser : lean.parser (Name × Name) :=
  Prod.mk <$> ident <*> (optional (tk "<->" <|> tk "↔") *> ident)
#align tactic.interactive.swap_arg_parser tactic.interactive.swap_arg_parser

private unsafe def swap_args_parser : lean.parser (List (Name × Name)) :=
  Functor.map (fun x => [x]) swap_arg_parser <|> tk "[" *> sep_by (tk ",") swap_arg_parser <* tk "]"
#align tactic.interactive.swap_args_parser tactic.interactive.swap_args_parser

/-- `swap_var [x y, P ↔ Q]` swaps the names `x` and `y`, `P` and `Q`.
Such a swapping can be used as a weak `wlog` if the tactic proofs use the same names.

```lean
example (P Q : Prop) (hp : P) (hq : Q) : P ∧ Q :=
begin
  split,
  work_on_goal 1 { swap_var [P Q] },
  all_goals { exact ‹P› }
end
```
-/
unsafe def swap_var (renames : parse swap_args_parser) : tactic Unit := do
  renames fun e => do
      let n ← tactic.get_unused_name
      -- how to call `interactive.tactic.rename` here?
          propagate_tags <|
          tactic.rename_many <| native.rb_map.of_list [(e.1, n), (e.2, e.1)]
      propagate_tags <| tactic.rename_many <| native.rb_map.of_list [(n, e.2)]
  pure ()
#align tactic.interactive.swap_var tactic.interactive.swap_var

end Tactic.Interactive

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


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.coherence

/-!
# Monoidal opposites

We write `Cᵐᵒᵖ` for the monoidal opposite of a monoidal category `C`.
-/

universes v₁ v₂ u₁ u₂

variables {C : Type u₁}

namespace category_theory

open category_theory.monoidal_category

/-- A type synonym for the monoidal opposite. Use the notation `Cᴹᵒᵖ`. -/
@[nolint has_nonempty_instance]
def monoidal_opposite (C : Type u₁) := C

namespace monoidal_opposite

notation C `ᴹᵒᵖ`:std.prec.max_plus := monoidal_opposite C

/-- Think of an object of `C` as an object of `Cᴹᵒᵖ`. -/
@[pp_nodot]
def mop (X : C) : Cᴹᵒᵖ := X

/-- Think of an object of `Cᴹᵒᵖ` as an object of `C`. -/
@[pp_nodot]
def unmop (X : Cᴹᵒᵖ) : C := X

lemma op_injective : function.injective (mop : C → Cᴹᵒᵖ) := λ _ _, id
lemma unop_injective : function.injective (unmop : Cᴹᵒᵖ → C) := λ _ _, id

@[simp] lemma op_inj_iff (x y : C) : mop x = mop y ↔ x = y := iff.rfl
@[simp]

attribute [irreducible] monoidal_opposite

@[simp] lemma mop_unmop (X : Cᴹᵒᵖ) : mop (unmop X) = X := rfl
@[simp] lemma unmop_mop (X : C) : unmop (mop X) = X := rfl

instance monoidal_opposite_category [I : category.{v₁} C] : category Cᴹᵒᵖ :=
{ hom := λ X Y, unmop X ⟶ unmop Y,
  id := λ X, 𝟙 (unmop X),
  comp := λ X Y Z f g, f ≫ g, }

end monoidal_opposite

end category_theory

open category_theory
open category_theory.monoidal_opposite

variables [category.{v₁} C]

/-- The monoidal opposite of a morphism `f : X ⟶ Y` is just `f`, thought of as `mop X ⟶ mop Y`. -/
def quiver.hom.mop {X Y : C} (f : X ⟶ Y) : @quiver.hom Cᴹᵒᵖ _ (mop X) (mop Y) := f
/-- We can think of a morphism `f : mop X ⟶ mop Y` as a morphism `X ⟶ Y`. -/
def quiver.hom.unmop {X Y : Cᴹᵒᵖ} (f : X ⟶ Y) : unmop X ⟶ unmop Y := f

namespace category_theory

lemma mop_inj {X Y : C} :
  function.injective (quiver.hom.mop : (X ⟶ Y) → (mop X ⟶ mop Y)) :=
λ _ _ H, congr_arg quiver.hom.unmop H

lemma unmop_inj {X Y : Cᴹᵒᵖ} :
  function.injective (quiver.hom.unmop : (X ⟶ Y) → (unmop X ⟶ unmop Y)) :=
λ _ _ H, congr_arg quiver.hom.mop H

@[simp] lemma unmop_mop {X Y : C} {f : X ⟶ Y} : f.mop.unmop = f := rfl
@[simp] lemma mop_unmop {X Y : Cᴹᵒᵖ} {f : X ⟶ Y} : f.unmop.mop = f := rfl

@[simp] lemma mop_comp {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} :
  (f ≫ g).mop = f.mop ≫ g.mop := rfl
@[simp] lemma mop_id {X : C} : (𝟙 X).mop = 𝟙 (mop X) := rfl

@[simp] lemma unmop_comp {X Y Z : Cᴹᵒᵖ} {f : X ⟶ Y} {g : Y ⟶ Z} :
  (f ≫ g).unmop = f.unmop ≫ g.unmop := rfl
@[simp] lemma unmop_id {X : Cᴹᵒᵖ} : (𝟙 X).unmop = 𝟙 (unmop X) := rfl

@[simp] lemma unmop_id_mop {X : C} : (𝟙 (mop X)).unmop = 𝟙 X := rfl
@[simp] lemma mop_id_unmop {X : Cᴹᵒᵖ} : (𝟙 (unmop X)).mop = 𝟙 X := rfl

namespace iso

variables {X Y : C}

/-- An isomorphism in `C` gives an isomorphism in `Cᴹᵒᵖ`. -/
@[simps]
def mop (f : X ≅ Y) : mop X ≅ mop Y :=
{ hom := f.hom.mop,
  inv := f.inv.mop,
  hom_inv_id' := unmop_inj f.hom_inv_id,
  inv_hom_id' := unmop_inj f.inv_hom_id }

end iso

variables [monoidal_category.{v₁} C]

open opposite monoidal_category

instance monoidal_category_op : monoidal_category Cᵒᵖ :=
{ tensor_obj := λ X Y, op (unop X ⊗ unop Y),
  tensor_hom := λ X₁ Y₁ X₂ Y₂ f g, (f.unop ⊗ g.unop).op,
  tensor_unit := op (𝟙_ C),
  associator := λ X Y Z, (α_ (unop X) (unop Y) (unop Z)).symm.op,
  left_unitor := λ X, (λ_ (unop X)).symm.op,
  right_unitor := λ X, (ρ_ (unop X)).symm.op,
  associator_naturality' := by { intros, apply quiver.hom.unop_inj, simp, },
  left_unitor_naturality' := by { intros, apply quiver.hom.unop_inj, simp, },
  right_unitor_naturality' := by { intros, apply quiver.hom.unop_inj, simp, },
  triangle' := by { intros, apply quiver.hom.unop_inj, coherence, },
  pentagon' := by { intros, apply quiver.hom.unop_inj, coherence, }, }

lemma op_tensor_obj (X Y : Cᵒᵖ) : X ⊗ Y = op (unop X ⊗ unop Y) := rfl
lemma op_tensor_unit : (𝟙_ Cᵒᵖ) = op (𝟙_ C) := rfl

instance monoidal_category_mop : monoidal_category Cᴹᵒᵖ :=
{ tensor_obj := λ X Y, mop (unmop Y ⊗ unmop X),
  tensor_hom := λ X₁ Y₁ X₂ Y₂ f g, (g.unmop ⊗ f.unmop).mop,
  tensor_unit := mop (𝟙_ C),
  associator := λ X Y Z, (α_ (unmop Z) (unmop Y) (unmop X)).symm.mop,
  left_unitor := λ X, (ρ_ (unmop X)).mop,
  right_unitor := λ X, (λ_ (unmop X)).mop,
  associator_naturality' := by { intros, apply unmop_inj, simp, },
  left_unitor_naturality' := by { intros, apply unmop_inj, simp, },
  right_unitor_naturality' := by { intros, apply unmop_inj, simp, },
  triangle' := by { intros, apply unmop_inj, coherence, },
  pentagon' := by { intros, apply unmop_inj, coherence, }, }

lemma mop_tensor_obj (X Y : Cᴹᵒᵖ) : X ⊗ Y = mop (unmop Y ⊗ unmop X) := rfl
lemma mop_tensor_unit : (𝟙_ Cᴹᵒᵖ) = mop (𝟙_ C) := rfl

end category_theory


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

A model of ZFC in Lean.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.basic
import Mathlib.PostPort

universes u u_1 l u_2 u_3 v

namespace Mathlib

/-- The type of `n`-ary functions `α → α → ... → α`. -/
def arity (α : Type u) : ℕ → Type u :=
  sorry

namespace arity

/-- Constant `n`-ary function with value `a`. -/
def const {α : Type u} (a : α) (n : ℕ) : arity α n :=
  sorry

protected instance arity.inhabited {α : Type u_1} {n : ℕ} [Inhabited α] : Inhabited (arity α n) :=
  { default := const Inhabited.default n }

end arity

/-- The type of pre-sets in universe `u`. A pre-set
  is a family of pre-sets indexed by a type in `Type u`.
  The ZFC universe is defined as a quotient of this
  to ensure extensionality. -/
inductive pSet
where
| mk : (α : Type u) → (α → pSet) → pSet

namespace pSet

/-- The underlying type of a pre-set -/
def type : pSet → Type u :=
  sorry

/-- The underlying pre-set family of a pre-set -/
def func (x : pSet) : type x → pSet :=
  sorry

theorem mk_type_func (x : pSet) : mk (type x) (func x) = x :=
  pSet.cases_on x
    fun (x_α : Type u_1) (x_A : x_α → pSet) =>
      idRhs (mk (type (mk x_α x_A)) (func (mk x_α x_A)) = mk (type (mk x_α x_A)) (func (mk x_α x_A))) rfl

/-- Two pre-sets are extensionally equivalent if every
  element of the first family is extensionally equivalent to
  some element of the second family and vice-versa. -/
def equiv (x : pSet) (y : pSet) :=
  pSet.rec (fun (α : Type u_1) (z : α → pSet) (m : α → pSet → Prop) (_x : pSet) => sorry) x y

theorem equiv.refl (x : pSet) : equiv x x :=
  pSet.rec_on x
    fun (α : Type u_1) (A : α → pSet) (IH : ∀ (ᾰ : α), equiv (A ᾰ) (A ᾰ)) =>
      { left := fun (a : α) => Exists.intro a (IH a), right := fun (a : α) => Exists.intro a (IH a) }

theorem equiv.euc {x : pSet} {y : pSet} {z : pSet} : equiv x y → equiv z y → equiv x z := sorry

theorem equiv.symm {x : pSet} {y : pSet} : equiv x y → equiv y x :=
  equiv.euc (equiv.refl y)

theorem equiv.trans {x : pSet} {y : pSet} {z : pSet} (h1 : equiv x y) (h2 : equiv y z) : equiv x z :=
  equiv.euc h1 (equiv.symm h2)

protected instance setoid : setoid pSet :=
  setoid.mk equiv sorry

protected def subset : pSet → pSet → Prop :=
  sorry

protected instance has_subset : has_subset pSet :=
  has_subset.mk pSet.subset

theorem equiv.ext (x : pSet) (y : pSet) : equiv x y ↔ x ⊆ y ∧ y ⊆ x := sorry

theorem subset.congr_left {x : pSet} {y : pSet} {z : pSet} : equiv x y → (x ⊆ z ↔ y ⊆ z) := sorry

theorem subset.congr_right {x : pSet} {y : pSet} {z : pSet} : equiv x y → (z ⊆ x ↔ z ⊆ y) := sorry

/-- `x ∈ y` as pre-sets if `x` is extensionally equivalent to a member
  of the family `y`. -/
def mem : pSet → pSet → Prop :=
  sorry

protected instance has_mem : has_mem pSet pSet :=
  has_mem.mk mem

theorem mem.mk {α : Type u} (A : α → pSet) (a : α) : A a ∈ mk α A :=
  (fun (this : mem (A a) (mk α A)) => this) (Exists.intro a (equiv.refl (A a)))

theorem mem.ext {x : pSet} {y : pSet} : (∀ (w : pSet), w ∈ x ↔ w ∈ y) → equiv x y := sorry

theorem mem.congr_right {x : pSet} {y : pSet} : equiv x y → ∀ {w : pSet}, w ∈ x ↔ w ∈ y := sorry

theorem equiv_iff_mem {x : pSet} {y : pSet} : equiv x y ↔ ∀ {w : pSet}, w ∈ x ↔ w ∈ y := sorry

theorem mem.congr_left {x : pSet} {y : pSet} : equiv x y → ∀ {w : pSet}, x ∈ w ↔ y ∈ w := sorry

/-- Convert a pre-set to a `set` of pre-sets. -/
def to_set (u : pSet) : set pSet :=
  set_of fun (x : pSet) => x ∈ u

/-- Two pre-sets are equivalent iff they have the same members. -/
theorem equiv.eq {x : pSet} {y : pSet} : equiv x y ↔ to_set x = to_set y :=
  iff.trans equiv_iff_mem (iff.symm set.ext_iff)

protected instance set.has_coe : has_coe pSet (set pSet) :=
  has_coe.mk to_set

/-- The empty pre-set -/
protected def empty : pSet :=
  mk (ulift empty) fun (e : ulift empty) => sorry

protected instance has_emptyc : has_emptyc pSet :=
  has_emptyc.mk pSet.empty

protected instance inhabited : Inhabited pSet :=
  { default := ∅ }

theorem mem_empty (x : pSet) : ¬x ∈ ∅ := sorry

/-- Insert an element into a pre-set -/
protected def insert : pSet → pSet → pSet :=
  sorry

protected instance has_insert : has_insert pSet pSet :=
  has_insert.mk pSet.insert

protected instance has_singleton : has_singleton pSet pSet :=
  has_singleton.mk fun (s : pSet) => insert s ∅

protected instance is_lawful_singleton : is_lawful_singleton pSet pSet :=
  is_lawful_singleton.mk fun (_x : pSet) => rfl

/-- The n-th von Neumann ordinal -/
def of_nat : ℕ → pSet :=
  sorry

/-- The von Neumann ordinal ω -/
def omega : pSet :=
  mk (ulift ℕ) fun (n : ulift ℕ) => of_nat (ulift.down n)

/-- The separation operation `{x ∈ a | p x}` -/
protected def sep (p : set pSet) : pSet → pSet :=
  sorry

protected instance has_sep : has_sep pSet pSet :=
  has_sep.mk pSet.sep

/-- The powerset operator -/
def powerset : pSet → pSet :=
  sorry

theorem mem_powerset {x : pSet} {y : pSet} : y ∈ powerset x ↔ y ⊆ x := sorry

/-- The set union operator -/
def Union : pSet → pSet :=
  sorry

theorem mem_Union {x : pSet} {y : pSet} : y ∈ Union x ↔ ∃ (z : pSet), ∃ (_x : z ∈ x), y ∈ z := sorry

/-- The image of a function -/
def image (f : pSet → pSet) : pSet → pSet :=
  sorry

theorem mem_image {f : pSet → pSet} (H : ∀ {x y : pSet}, equiv x y → equiv (f x) (f y)) {x : pSet} {y : pSet} : y ∈ image f x ↔ ∃ (z : pSet), ∃ (H : z ∈ x), equiv y (f z) := sorry

/-- Universe lift operation -/
protected def lift : pSet → pSet :=
  sorry

/-- Embedding of one universe in another -/
def embed : pSet :=
  mk (ulift pSet) fun (_x : ulift pSet) => sorry

theorem lift_mem_embed (x : pSet) : pSet.lift x ∈ embed :=
  Exists.intro (ulift.up x) (equiv.refl (pSet.lift x))

/-- Function equivalence is defined so that `f ~ g` iff
  `∀ x y, x ~ y → f x ~ g y`. This extends to equivalence of n-ary
  functions. -/
def arity.equiv {n : ℕ} : arity pSet n → arity pSet n → Prop :=
  sorry

theorem arity.equiv_const {a : pSet} (n : ℕ) : arity.equiv (arity.const a n) (arity.const a n) := sorry

/-- `resp n` is the collection of n-ary functions on `pSet` that respect
  equivalence, i.e. when the inputs are equivalent the output is as well. -/
def resp (n : ℕ) :=
  Subtype fun (x : arity pSet n) => arity.equiv x x

protected instance resp.inhabited {n : ℕ} : Inhabited (resp n) :=
  { default := { val := arity.const Inhabited.default n, property := sorry } }

def resp.f {n : ℕ} (f : resp (n + 1)) (x : pSet) : resp n :=
  { val := subtype.val f x, property := sorry }

def resp.equiv {n : ℕ} (a : resp n) (b : resp n) :=
  arity.equiv (subtype.val a) (subtype.val b)

theorem resp.refl {n : ℕ} (a : resp n) : resp.equiv a a :=
  subtype.property a

theorem resp.euc {n : ℕ} {a : resp n} {b : resp n} {c : resp n} : resp.equiv a b → resp.equiv c b → resp.equiv a c := sorry

protected instance resp.setoid {n : ℕ} : setoid (resp n) :=
  setoid.mk resp.equiv sorry

end pSet

/-- The ZFC universe of sets consists of the type of pre-sets,
  quotiented by extensional equivalence. -/
def Set :=
  quotient pSet.setoid

namespace pSet

namespace resp

def eval_aux {n : ℕ} : Subtype fun (f : resp n → arity Set n) => ∀ (a b : resp n), equiv a b → f a = f b :=
  sorry

/-- An equivalence-respecting function yields an n-ary Set function. -/
def eval (n : ℕ) : resp n → arity Set n :=
  subtype.val eval_aux

theorem eval_val {n : ℕ} {f : resp (n + 1)} {x : pSet} : eval (n + 1) f (quotient.mk x) = eval n (f f x) :=
  rfl

end resp

/-- A set function is "definable" if it is the image of some n-ary pre-set
  function. This isn't exactly definability, but is useful as a sufficient
  condition for functions that have a computable image. -/
class inductive definable (n : ℕ) : arity Set n → Type (u + 1)
where
| mk : (f : resp n) → definable n (resp.eval n f)

def definable.eq_mk {n : ℕ} (f : resp n) {s : arity Set n} (H : resp.eval n f = s) : definable n s :=
  sorry

def definable.resp {n : ℕ} (s : arity Set n) [definable n s] : resp n :=
  sorry

theorem definable.eq {n : ℕ} (s : arity Set n) [H : definable n s] : resp.eval n (definable.resp s) = s := sorry

end pSet

namespace classical

def all_definable {n : ℕ} (F : arity Set n) : pSet.definable n F :=
  sorry

end classical

namespace Set

def mk : pSet → Set :=
  quotient.mk

@[simp] theorem mk_eq (x : pSet) : quotient.mk x = mk x :=
  rfl

@[simp] theorem eval_mk {n : ℕ} {f : pSet.resp (n + 1)} {x : pSet} : pSet.resp.eval (n + 1) f (mk x) = pSet.resp.eval n (pSet.resp.f f x) :=
  rfl

def mem : Set → Set → Prop :=
  quotient.lift₂ pSet.mem sorry

protected instance has_mem : has_mem Set Set :=
  has_mem.mk mem

/-- Convert a ZFC set into a `set` of sets -/
def to_set (u : Set) : set Set :=
  set_of fun (x : Set) => x ∈ u

protected def subset (x : Set) (y : Set) :=
  ∀ {z : Set}, z ∈ x → z ∈ y

protected instance has_subset : has_subset Set :=
  has_subset.mk Set.subset

theorem subset_def {x : Set} {y : Set} : x ⊆ y ↔ ∀ {z : Set}, z ∈ x → z ∈ y :=
  iff.rfl

theorem subset_iff (x : pSet) (y : pSet) : mk x ⊆ mk y ↔ x ⊆ y := sorry

theorem ext {x : Set} {y : Set} : (∀ (z : Set), z ∈ x ↔ z ∈ y) → x = y :=
  quotient.induction_on₂ x y
    fun (u v : pSet) (h : ∀ (z : Set), z ∈ quotient.mk u ↔ z ∈ quotient.mk v) =>
      quotient.sound (pSet.mem.ext fun (w : pSet) => h (quotient.mk w))

theorem ext_iff {x : Set} {y : Set} : (∀ (z : Set), z ∈ x ↔ z ∈ y) ↔ x = y := sorry

/-- The empty set -/
def empty : Set :=
  mk ∅

protected instance has_emptyc : has_emptyc Set :=
  has_emptyc.mk empty

protected instance inhabited : Inhabited Set :=
  { default := ∅ }

@[simp] theorem mem_empty (x : Set) : ¬x ∈ ∅ :=
  quotient.induction_on x pSet.mem_empty

theorem eq_empty (x : Set) : x = ∅ ↔ ∀ (y : Set), ¬y ∈ x := sorry

/-- `insert x y` is the set `{x} ∪ y` -/
protected def insert : Set → Set → Set :=
  pSet.resp.eval (bit0 1) { val := pSet.insert, property := sorry }

protected instance has_insert : has_insert Set Set :=
  has_insert.mk Set.insert

protected instance has_singleton : has_singleton Set Set :=
  has_singleton.mk fun (x : Set) => insert x ∅

protected instance is_lawful_singleton : is_lawful_singleton Set Set :=
  is_lawful_singleton.mk fun (x : Set) => rfl

@[simp] theorem mem_insert {x : Set} {y : Set} {z : Set} : x ∈ insert y z ↔ x = y ∨ x ∈ z := sorry

@[simp] theorem mem_singleton {x : Set} {y : Set} : x ∈ singleton y ↔ x = y :=
  iff.trans mem_insert
    { mp := fun (o : x = y ∨ x ∈ ∅) => Or._oldrec (fun (h : x = y) => h) (fun (n : x ∈ ∅) => absurd n (mem_empty x)) o,
      mpr := Or.inl }

@[simp] theorem mem_pair {x : Set} {y : Set} {z : Set} : x ∈ insert y (singleton z) ↔ x = y ∨ x = z :=
  iff.trans mem_insert (or_congr iff.rfl mem_singleton)

/-- `omega` is the first infinite von Neumann ordinal -/
def omega : Set :=
  mk pSet.omega

@[simp] theorem omega_zero : ∅ ∈ omega :=
  (fun (this : pSet.mem ∅ pSet.omega) => this) (Exists.intro (ulift.up 0) (pSet.equiv.refl ∅))

@[simp] theorem omega_succ {n : Set} : n ∈ omega → insert n n ∈ omega := sorry

/-- `{x ∈ a | p x}` is the set of elements in `a` satisfying `p` -/
protected def sep (p : Set → Prop) : Set → Set :=
  pSet.resp.eval 1 { val := pSet.sep fun (y : pSet) => p (quotient.mk y), property := sorry }

protected instance has_sep : has_sep Set Set :=
  has_sep.mk Set.sep

@[simp] theorem mem_sep {p : Set → Prop} {x : Set} {y : Set} : y ∈ has_sep.sep (fun (y : Set) => p y) x ↔ y ∈ x ∧ p y := sorry

/-- The powerset operation, the collection of subsets of a set -/
def powerset : Set → Set :=
  pSet.resp.eval 1 { val := pSet.powerset, property := sorry }

@[simp] theorem mem_powerset {x : Set} {y : Set} : y ∈ powerset x ↔ y ⊆ x := sorry

theorem Union_lem {α : Type u} {β : Type u} (A : α → pSet) (B : β → pSet) (αβ : ∀ (a : α), ∃ (b : β), pSet.equiv (A a) (B b)) (a : pSet.type (pSet.Union (pSet.mk α A))) : ∃ (b : pSet.type (pSet.Union (pSet.mk β B))),
  pSet.equiv (pSet.func (pSet.Union (pSet.mk α A)) a) (pSet.func (pSet.Union (pSet.mk β B)) b) := sorry

/-- The union operator, the collection of elements of elements of a set -/
def Union : Set → Set :=
  pSet.resp.eval 1 { val := pSet.Union, property := sorry }

notation:1024 "⋃" => Mathlib.Set.Union

@[simp] theorem mem_Union {x : Set} {y : Set} : y ∈ ⋃ ↔ ∃ (z : Set), ∃ (H : z ∈ x), y ∈ z := sorry

@[simp] theorem Union_singleton {x : Set} : ⋃ = x := sorry

theorem singleton_inj {x : Set} {y : Set} (H : singleton x = singleton y) : x = y :=
  let this : ⋃ = ⋃ := congr_arg ⋃ H;
  eq.mp (Eq._oldrec (Eq.refl (x = ⋃)) Union_singleton) (eq.mp (Eq._oldrec (Eq.refl (⋃ = ⋃)) Union_singleton) this)

/-- The binary union operation -/
protected def union (x : Set) (y : Set) : Set :=
  ⋃

/-- The binary intersection operation -/
protected def inter (x : Set) (y : Set) : Set :=
  has_sep.sep (fun (z : Set) => z ∈ y) x

/-- The set difference operation -/
protected def diff (x : Set) (y : Set) : Set :=
  has_sep.sep (fun (z : Set) => ¬z ∈ y) x

protected instance has_union : has_union Set :=
  has_union.mk Set.union

protected instance has_inter : has_inter Set :=
  has_inter.mk Set.inter

protected instance has_sdiff : has_sdiff Set :=
  has_sdiff.mk Set.diff

@[simp] theorem mem_union {x : Set} {y : Set} {z : Set} : z ∈ x ∪ y ↔ z ∈ x ∨ z ∈ y := sorry

@[simp] theorem mem_inter {x : Set} {y : Set} {z : Set} : z ∈ x ∩ y ↔ z ∈ x ∧ z ∈ y :=
  mem_sep

@[simp] theorem mem_diff {x : Set} {y : Set} {z : Set} : z ∈ x \ y ↔ z ∈ x ∧ ¬z ∈ y :=
  mem_sep

theorem induction_on {p : Set → Prop} (x : Set) (h : ∀ (x : Set), (∀ (y : Set), y ∈ x → p y) → p x) : p x := sorry

theorem regularity (x : Set) (h : x ≠ ∅) : ∃ (y : Set), ∃ (H : y ∈ x), x ∩ y = ∅ := sorry

/-- The image of a (definable) set function -/
def image (f : Set → Set) [H : pSet.definable 1 f] : Set → Set :=
  let r : pSet.resp 1 := pSet.definable.resp f;
  pSet.resp.eval 1 { val := pSet.image (subtype.val r), property := sorry }

theorem image.mk (f : Set → Set) [H : pSet.definable 1 f] (x : Set) {y : Set} (h : y ∈ x) : f y ∈ image f x := sorry

@[simp] theorem mem_image {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} : y ∈ image f x ↔ ∃ (z : Set), ∃ (H : z ∈ x), f z = y := sorry

/-- Kuratowski ordered pair -/
def pair (x : Set) (y : Set) : Set :=
  insert (singleton x) (singleton (insert x (singleton y)))

/-- A subset of pairs `{(a, b) ∈ x × y | p a b}` -/
def pair_sep (p : Set → Set → Prop) (x : Set) (y : Set) : Set :=
  has_sep.sep (fun (z : Set) => ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b ∧ p a b)
    (powerset (powerset (x ∪ y)))

@[simp] theorem mem_pair_sep {p : Set → Set → Prop} {x : Set} {y : Set} {z : Set} : z ∈ pair_sep p x y ↔ ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b ∧ p a b := sorry

theorem pair_inj {x : Set} {y : Set} {x' : Set} {y' : Set} (H : pair x y = pair x' y') : x = x' ∧ y = y' := sorry

/-- The cartesian product, `{(a, b) | a ∈ x, b ∈ y}` -/
def prod : Set → Set → Set :=
  pair_sep fun (a b : Set) => True

@[simp] theorem mem_prod {x : Set} {y : Set} {z : Set} : z ∈ prod x y ↔ ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b := sorry

@[simp] theorem pair_mem_prod {x : Set} {y : Set} {a : Set} {b : Set} : pair a b ∈ prod x y ↔ a ∈ x ∧ b ∈ y := sorry

/-- `is_func x y f` is the assertion `f : x → y` where `f` is a ZFC function
  (a set of ordered pairs) -/
def is_func (x : Set) (y : Set) (f : Set) :=
  f ⊆ prod x y ∧ ∀ (z : Set), z ∈ x → exists_unique fun (w : Set) => pair z w ∈ f

/-- `funs x y` is `y ^ x`, the set of all set functions `x → y` -/
def funs (x : Set) (y : Set) : Set :=
  has_sep.sep (fun (f : Set) => is_func x y f) (powerset (prod x y))

@[simp] theorem mem_funs {x : Set} {y : Set} {f : Set} : f ∈ funs x y ↔ is_func x y f := sorry

-- TODO(Mario): Prove this computably

protected instance map_definable_aux (f : Set → Set) [H : pSet.definable 1 f] : pSet.definable 1 fun (y : Set) => pair y (f y) :=
  classical.all_definable fun (y : Set) => pair y (f y)

/-- Graph of a function: `map f x` is the ZFC function which maps `a ∈ x` to `f a` -/
def map (f : Set → Set) [H : pSet.definable 1 f] : Set → Set :=
  image fun (y : Set) => pair y (f y)

@[simp] theorem mem_map {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} : y ∈ map f x ↔ ∃ (z : Set), ∃ (H : z ∈ x), pair z (f z) = y :=
  mem_image

theorem map_unique {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {z : Set} (zx : z ∈ x) : exists_unique fun (w : Set) => pair z w ∈ map f x := sorry

@[simp] theorem map_is_func {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} : is_func x y (map f x) ↔ ∀ (z : Set), z ∈ x → f z ∈ y := sorry

end Set

def Class :=
  set Set

namespace Class

protected instance has_subset : has_subset Class :=
  has_subset.mk set.subset

protected instance has_sep : has_sep Set Class :=
  has_sep.mk set.sep

protected instance has_emptyc : has_emptyc Class :=
  has_emptyc.mk fun (a : Set) => False

protected instance inhabited : Inhabited Class :=
  { default := ∅ }

protected instance has_insert : has_insert Set Class :=
  has_insert.mk set.insert

protected instance has_union : has_union Class :=
  has_union.mk set.union

protected instance has_inter : has_inter Class :=
  has_inter.mk set.inter

protected instance has_neg : Neg Class :=
  { neg := set.compl }

protected instance has_sdiff : has_sdiff Class :=
  has_sdiff.mk set.diff

/-- Coerce a set into a class -/
def of_Set (x : Set) : Class :=
  set_of fun (y : Set) => y ∈ x

protected instance has_coe : has_coe Set Class :=
  has_coe.mk of_Set

/-- The universal class -/
def univ : Class :=
  set.univ

/-- Assert that `A` is a set satisfying `p` -/
def to_Set (p : Set → Prop) (A : Class) :=
  ∃ (x : Set), ↑x = A ∧ p x

/-- `A ∈ B` if `A` is a set which is a member of `B` -/
protected def mem (A : Class) (B : Class) :=
  to_Set B A

protected instance has_mem : has_mem Class Class :=
  has_mem.mk Class.mem

theorem mem_univ {A : Class} : A ∈ univ ↔ ∃ (x : Set), ↑x = A :=
  exists_congr fun (x : Set) => and_true (↑x = A)

/-- Convert a conglomerate (a collection of classes) into a class -/
def Cong_to_Class (x : set Class) : Class :=
  set_of fun (y : Set) => ↑y ∈ x

/-- Convert a class into a conglomerate (a collection of classes) -/
def Class_to_Cong (x : Class) : set Class :=
  set_of fun (y : Class) => y ∈ x

/-- The power class of a class is the class of all subclasses that are sets -/
def powerset (x : Class) : Class :=
  Cong_to_Class (𝒫 x)

/-- The union of a class is the class of all members of sets in the class -/
def Union (x : Class) : Class :=
  ⋃₀Class_to_Cong x

notation:1024 "⋃" => Mathlib.Class.Union

theorem of_Set.inj {x : Set} {y : Set} (h : ↑x = ↑y) : x = y := sorry

@[simp] theorem to_Set_of_Set (p : Set → Prop) (x : Set) : to_Set p ↑x ↔ p x := sorry

@[simp] theorem mem_hom_left (x : Set) (A : Class) : ↑x ∈ A ↔ A x :=
  to_Set_of_Set (fun (x : Set) => A x) x

@[simp] theorem mem_hom_right (x : Set) (y : Set) : coe y x ↔ x ∈ y :=
  iff.rfl

@[simp] theorem subset_hom (x : Set) (y : Set) : ↑x ⊆ ↑y ↔ x ⊆ y :=
  iff.rfl

@[simp] theorem sep_hom (p : Set → Prop) (x : Set) : ↑(has_sep.sep (fun (y : Set) => p y) x) = has_sep.sep (fun (y : Set) => p y) ↑x :=
  set.ext fun (y : Set) => Set.mem_sep

@[simp] theorem empty_hom : ↑∅ = ∅ :=
  set.ext
    fun (y : Set) => (fun (this : y ∈ ↑∅ ↔ False) => this) (eq.mpr (id (propext (iff_false (y ∈ ↑∅)))) (Set.mem_empty y))

@[simp] theorem insert_hom (x : Set) (y : Set) : insert x ↑y = ↑(insert x y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_insert

@[simp] theorem union_hom (x : Set) (y : Set) : ↑x ∪ ↑y = ↑(x ∪ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_union

@[simp] theorem inter_hom (x : Set) (y : Set) : ↑x ∩ ↑y = ↑(x ∩ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_inter

@[simp] theorem diff_hom (x : Set) (y : Set) : ↑x \ ↑y = ↑(x \ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_diff

@[simp] theorem powerset_hom (x : Set) : powerset ↑x = ↑(Set.powerset x) :=
  set.ext fun (z : Set) => iff.symm Set.mem_powerset

@[simp] theorem Union_hom (x : Set) : ⋃ = ↑⋃ := sorry

/-- The definite description operator, which is {x} if `{a | p a} = {x}`
  and ∅ otherwise -/
def iota (p : Set → Prop) : Class :=
  ⋃

theorem iota_val (p : Set → Prop) (x : Set) (H : ∀ (y : Set), p y ↔ y = x) : iota p = ↑x := sorry

/-- Unlike the other set constructors, the `iota` definite descriptor
  is a set for any set input, but not constructively so, so there is no
  associated `(Set → Prop) → Set` function. -/
theorem iota_ex (p : Set → Prop) : iota p ∈ univ := sorry

/-- Function value -/
def fval (F : Class) (A : Class) : Class :=
  iota fun (y : Set) => to_Set (fun (x : Set) => F (Set.pair x y)) A

infixl:100 "′" => Mathlib.Class.fval

theorem fval_ex (F : Class) (A : Class) : F′A ∈ univ :=
  iota_ex fun (y : Set) => to_Set (fun (x : Set) => F (Set.pair x y)) A

end Class

namespace Set

@[simp] theorem map_fval {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} (h : y ∈ x) : ↑(map f x)′↑y = ↑(f y) := sorry

/-- A choice function on the set of nonempty sets `x` -/
def choice (x : Set) : Set :=
  map (fun (y : Set) => classical.epsilon fun (z : Set) => z ∈ y) x

theorem choice_mem_aux (x : Set) (h : ¬∅ ∈ x) (y : Set) (yx : y ∈ x) : (classical.epsilon fun (z : Set) => z ∈ y) ∈ y := sorry

theorem choice_is_func (x : Set) (h : ¬∅ ∈ x) : is_func x ⋃ (choice x) := sorry

theorem choice_mem (x : Set) (h : ¬∅ ∈ x) (y : Set) (yx : y ∈ x) : ↑(choice x)′↑y ∈ ↑y := sorry


import ircbot.types ircbot.support
open types support

namespace modules.ping_pong

def ping_pong_func (input : irc_text) : list irc_text :=
match input with
| irc_text.parsed_normal
  { object := some ~nick!ident, type := message.privmsg,
    args := [subject], text := "\\ping" } :=
  let new_subject :=
    if subject.front = '#' then subject else nick in
  [privmsg new_subject $ sformat! "{nick}, pong"]
| _ := []
end

/-- For testing: send “pong” after “\ping”. -/
def ping_pong : bot_function :=
  { name := "ping-pong",
    syntax := some "\\ping",
    description := "ping-pong game!",
    func := pure ∘ ping_pong_func }

theorem ping_pong_is_correct_on_channel (nick ident subject: string)
  (on_channel : subject.front = '#') :
  (ping_pong_func $ irc_text.parsed_normal
    { object := some ~nick!ident,
      type := message.privmsg,
      args := [subject],
      text := "\\ping" }) =
  [privmsg subject $ sformat! "{nick}, pong"] := begin
  intros, simp [ping_pong_func], rw [on_channel], trivial
end

theorem ping_pong_is_correct_on_priv (nick ident subject bot_nickname : string)
  (bot_nickname_is_correct : bot_nickname.front ≠ '#')
  (not_on_channel : subject = bot_nickname):
  (ping_pong_func $ irc_text.parsed_normal
    { object := some ~nick!ident,
      type := message.privmsg,
      args := [bot_nickname],
      text := "\\ping" }) =
  [privmsg nick $ sformat! "{nick}, pong"] := begin
  intros, simp [privmsg], simp [ping_pong_func],
  simp [privmsg], simp [bot_nickname_is_correct]
end

end modules.ping_pong


import CodeAction.Interface
import StatementAutoformalisation.Translate
import StatementAutoformalisation.Config.FixedPrompts

namespace Default

def LLMParams : LLM.Params :=
{
  openAIModel := "gpt-3.5-turbo",
  temperature := 8,
  n := 7,
  maxTokens := 300,
  stopTokens := #[":=", "\n\n/-", "\n/-", "/-"],
  systemMessage :=
  "You are a coding assistant who translates from natural language to Lean Theorem Prover code following examples.
   Follow EXACTLY the examples given."
}

def SentenceSimilarityParams : SentenceSimilarity.Params :=
{
  source := "data/prompts.json",
  sentenceTransformersModel := "all-mpnet-base-v2",
  kind := "theorem",
  field := "doc_string",
  nSim := 15
}

def KeywordExtractionParams : KeywordExtraction.Params :=
{
  nKw := 0
}

def PromptParams : Prompt.Params :=
{
  toLLMParams := LLMParams,
  toSentenceSimilarityParams := #[SentenceSimilarityParams],
  toKeywordExtractionParams := #[KeywordExtractionParams],
  fixedPrompts := leanChatPrompts,
  useNames := #[],
  useModules := #[],
  useMainCtx? := false,
  printMessage := DeclarationWithDocstring.toMessage
  mkSuffix := id,
  processCompletion := fun comment completion => s!"{printAsComment comment}\n{completion}"
}

def InterfaceParams : Interface.Params DeclarationWithDocstring :=
{
  title := "Translate comment to Lean theorem statement (with default settings).",
  nearestOccurrence? := nearestComment,
  extractText? := extractCommentText?,
  action := fun stmt =>
    Prompt.typecorrectTranslations ⟨PromptParams, stmt⟩ >>= (pure ·[0]!),
  postProcess := fun _ => DeclarationWithDocstring.toString
}

@[codeActionProvider] def Action := performCodeAction InterfaceParams

end Default


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

import tactic.aesop.rule

namespace tactic
namespace aesop

meta inductive rule_builder_output
| rule (r : rule) (imode : indexing_mode)
| simp_lemmas (s : simp_lemmas)

meta def rule_builder := declaration → tactic rule_builder_output

namespace rule_builder

meta def tac : rule_builder := λ d,
match d.type with
| `(tactic unit) := do
  t ← eval_expr (tactic unit) d.value,
  pure $ rule_builder_output.rule
    { tac := t,
      description := to_fmt d.to_name }
    indexing_mode.unindexed
| _ := fail! "Expected {d.to_name} to have type `tactic unit`."
end

meta def apply_indexing_mode (type : expr) : tactic indexing_mode := do
  head_constant ← type.conclusion_head_constant,
  pure $
    match head_constant with
    | some c := index_target_head c
    | none := unindexed
    end

meta def apply : rule_builder := λ d, do
  imode ← apply_indexing_mode d.type,
  let n := d.to_name,
  pure $ rule_builder_output.rule
    { tac := mk_const n >>= tactic.apply >> skip,
      description := format! "apply {n}"}
    imode

meta def normalization_simp_lemma : rule_builder := λ d, do
  let n := d.to_name,
  s ← simp_lemmas.mk.add_simp n <|> fail!
    "Expected {n} to be a (conditional) equation that can be used as a simp lemma.",
  pure $ rule_builder_output.simp_lemmas s

meta def no_tactic (d : declaration) : tactic unit :=
match d.type with
| `(tactic _) := fail! "To register a tactic as an Aesop rule, it must have type `tactic unit`, but {d.to_name} has type `{d.type}`."
| _ := pure ()
end

meta def normalization_default : rule_builder := λ d,
tac d <|> normalization_simp_lemma d <|>
  fail! "Expected {d.to_name} to have type `tactic unit` or to be suitable as a simp lemma."

meta def safe_default : rule_builder := λ d,
tac d <|> (no_tactic d >> apply d)

meta def unsafe_default : rule_builder :=
safe_default

end rule_builder
end aesop
end tactic


/-
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 was ported from Lean 3 source module tactic.alias
! leanprover-community/mathlib commit c8ab806ef73c20cab1d87b5157e43a82c205f28e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Core

/-!
# The `alias` command

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

Syntax:

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

This produces defs or theorems of the form:

```lean
/-- 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:

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

open Lean.Parser Tactic Interactive

namespace Tactic.Alias

/-- An alias can be in one of three forms -/
unsafe inductive target
  | plain : Name → target
  | forward : Name → target
  | backwards : Name → target
  deriving has_reflect
#align tactic.alias.target tactic.alias.target

/-- The name underlying an alias target -/
unsafe def target.to_name : target → Name
  | target.plain n => n
  | target.forward n => n
  | target.backwards n => n
#align tactic.alias.target.to_name tactic.alias.target.to_name

/-- The docstring for an alias. Used by `alias` _and_ by `to_additive` -/
unsafe def target.to_string : target → String
  | target.plain n => s! "**Alias** of `{n}`."
  | target.forward n => s! "**Alias** of the forward direction of `{n}`."
  | target.backwards n => s! "**Alias** of the reverse direction of `{n}`."
#align tactic.alias.target.to_string tactic.alias.target.to_string

/-- An auxiliary attribute which is placed on definitions created by the `alias` command. -/
@[user_attribute]
unsafe def alias_attr : user_attribute Unit target
    where
  Name := `alias
  descr := "This definition is an alias of another."
  parser := failed
#align tactic.alias.alias_attr tactic.alias.alias_attr

/-- The core tactic which handles `alias d ← al`. Creates an alias `al` for declaration `d`. -/
unsafe def alias_direct (doc : Option String) (d : declaration) (al : Name) : tactic Unit := do
  updateex_env fun env =>
      env
        (match d with
        | declaration.defn n ls t _ _ _ =>
          declaration.defn al ls t (expr.const n (level.param <$> ls)) ReducibilityHints.abbrev tt
        | declaration.thm n ls t _ =>
          declaration.thm al ls t <| task.pure <| expr.const n (level.param <$> ls)
        | _ => undefined)
  let target := target.plain d.to_name
  alias_attr al target tt
  add_doc_string al (doc target)
#align tactic.alias.alias_direct tactic.alias.alias_direct

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Given a proof of `Π x y z, a ↔ b`, produces a proof of `Π x y z, a → b` or `Π x y z, b → a`
      (depending on whether `iffmp` is `iff.mp` or `iff.mpr`). The variable `f` supplies the proof,
      under the specified number of binders. -/
    unsafe
  def
    mk_iff_mp_app
    ( iffmp : Name ) : expr → ( ℕ → expr ) → tactic expr
    |
        expr.pi n bi e t , f
        =>
        expr.lam n bi e <$> mk_iff_mp_app t fun n => f ( n + 1 ) ( expr.var n )
      | q( $ ( a ) ↔ $ ( b ) ) , f => pure <| @ expr.const true iffmp [ ] a b ( f 0 )
      | _ , f => fail "Target theorem must have the form `Π x y z, a ↔ b`"
#align tactic.alias.mk_iff_mp_app tactic.alias.mk_iff_mp_app

/-- The core tactic which handles `alias d ↔ al _` or `alias d ↔ _ al`. `ns` is the current
namespace, and `is_forward` is true if this is the forward implication (the first form). -/
unsafe def alias_iff (doc : Option String) (d : declaration) (ns al : Name) (is_forward : Bool) :
    tactic Unit :=
  if al = `_ then skip
  else
    let al := ns.append_namespace al
    get_decl al >> skip <|> do
      let ls := d.univ_params
      let t := d.type
      let target := if is_forward then target.forward d.to_name else target.backwards d.to_name
      let iffmp := if is_forward then `iff.mp else `iff.mpr
      let v ← mk_iff_mp_app iffmp t fun _ => expr.const d.to_name (level.param <$> ls)
      let t' ← infer_type v
      updateex_env fun env => env (declaration.thm al ls t' <| task.pure v)
      alias_attr al target tt
      add_doc_string al (doc target)
#align tactic.alias.alias_iff tactic.alias.alias_iff

/-- Get the default names for left/right to be used by `alias d ↔ ..`. -/
unsafe def make_left_right : Name → tactic (Name × Name)
  | Name.mk_string s p => do
    let buf : CharBuffer := s.toCharBuffer
    let parts := s.splitOn '_'
    let (left, _ :: right) ← pure <| parts.spanₓ (· ≠ "iff")
    let pfx (a b : String) := a.toList.isPrefixOfₓ b.toList
    let (suffix', right') ← pure <| right.reverse.spanₓ fun s => pfx "left" s ∨ pfx "right" s
    let right := right'.reverse
    let suffix := suffix'.reverse
    pure
        (.str p ("_".intercalate (right ++ "of" :: left ++ suffix)),
          .str p ("_".intercalate (left ++ "of" :: right ++ suffix)))
  | _ => failed
#align tactic.alias.make_left_right tactic.alias.make_left_right

/-- The `alias` command can be used to create copies
of a theorem or definition with different names.

Syntax:

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

This produces defs or theorems of the form:

```lean
/-- 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:

```lean
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.
-/
@[user_command]
unsafe def alias_cmd (meta_info : decl_meta_info) (_ : parse <| tk "alias") : lean.parser Unit := do
  let old ← ident
  let d ←
    (do
          let old ← resolve_constant old
          get_decl old) <|>
        fail ("declaration " ++ toString old ++ " not found")
  let ns ← get_current_namespace
  let doc := meta_info.doc_string
  (do
        tk "←" <|> tk "<-"
        let aliases ← many ident
        ↑(aliases fun al => alias_direct doc d (ns al))) <|>
      do
      tk "↔" <|> tk "<->"
      let (left, right) ←
        condM (tk ".." >> pure tt <|> pure ff)
            (make_left_right old <|> fail "invalid name for automatic name generation")
            (Prod.mk <$> types.ident_ <*> types.ident_)
      alias_iff doc d ns left tt
      alias_iff doc d ns right ff
#align tactic.alias.alias_cmd tactic.alias.alias_cmd

add_tactic_doc
  { Name := "alias"
    category := DocCategory.cmd
    declNames := [`tactic.alias.alias_cmd]
    tags := ["renaming"] }

/-- Given a definition, look up the definition that it is an alias of.
Returns `none` if this defintion is not an alias. -/
unsafe def get_alias_target (n : Name) : tactic (Option target) := do
  let tt ← has_attribute' `alias n |
    pure none
  let v ← alias_attr.get_param n
  pure <| some v
#align tactic.alias.get_alias_target tactic.alias.get_alias_target

end Tactic.Alias


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Converter monad for building simplifiers.

! This file was ported from Lean 3 source module init.meta.converter.conv
! leanprover-community/mathlib commit e83eca1fc5eda5ec3e0926a6913e02d9a574bf9e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Meta.Tactic
import Leanbin.Init.Meta.SimpTactic
import Leanbin.Init.Meta.Interactive
import Leanbin.Init.Meta.CongrLemma
import Leanbin.Init.Meta.MatchTactic

open Tactic

def Tactic.IdTag.conv : Unit :=
  ()
#align tactic.id_tag.conv Tactic.IdTag.conv

universe u

/--
`conv α` is a tactic for discharging goals of the form `lhs ~ rhs` for some relation `~` (usually equality) and fixed lhs, rhs.
Known in the literature as a __conversion__ tactic.
So for example, if one had the lemma `p : x = y`, then the conversion for `p` would be one that solves `p`.
-/
unsafe def conv (α : Type u) :=
  tactic α
#align conv conv

unsafe instance : Monad conv := by dsimp only [conv] <;> infer_instance

unsafe instance : MonadFail conv := by dsimp only [conv] <;> infer_instance

unsafe instance : Alternative conv := by dsimp only [conv] <;> infer_instance

namespace Conv

/--
Applies the conversion `c`. Returns `(rhs,p)` where `p : r lhs rhs`. Throws away the return value of `c`.-/
unsafe def convert (c : conv Unit) (lhs : expr) (rel : Name := `eq) : tactic (expr × expr) := do
  let lhs_type ← infer_type lhs
  let rhs ← mk_meta_var lhs_type
  let new_target ← mk_app Rel [lhs, rhs]
  let new_g ← mk_meta_var new_target
  let gs ← get_goals
  set_goals [new_g]
  c
  try <| any_goals reflexivity
  let n ← num_goals
  when (n ≠ 0) (fail "convert tactic failed, there are unsolved goals")
  set_goals gs
  let rhs ← instantiate_mvars rhs
  let new_g ← instantiate_mvars new_g
  return (rhs, new_g)
#align conv.convert conv.convert

unsafe def lhs : conv expr := do
  let (_, lhs, rhs) ← target_lhs_rhs
  return lhs
#align conv.lhs conv.lhs

unsafe def rhs : conv expr := do
  let (_, lhs, rhs) ← target_lhs_rhs
  return rhs
#align conv.rhs conv.rhs

/-- `⊢ lhs = rhs` ~~> `⊢ lhs' = rhs` using `h : lhs = lhs'`. -/
unsafe def update_lhs (new_lhs : expr) (h : expr) : conv Unit := do
  transitivity
  rhs >>= unify new_lhs
  exact h
  let t ← target >>= instantiate_mvars
  change t
#align conv.update_lhs conv.update_lhs

/-- Change `lhs` to something definitionally equal to it. -/
unsafe def change (new_lhs : expr) : conv Unit := do
  let (r, lhs, rhs) ← target_lhs_rhs
  let new_target ← mk_app r [new_lhs, rhs]
  tactic.change new_target
#align conv.change conv.change

/-- Use reflexivity to prove. -/
unsafe def skip : conv Unit :=
  reflexivity
#align conv.skip conv.skip

/-- Put LHS in WHNF. -/
unsafe def whnf : conv Unit :=
  lhs >>= tactic.whnf >>= change
#align conv.whnf conv.whnf

/-- dsimp the LHS. -/
unsafe def dsimp (s : Option simp_lemmas := none) (u : List Name := []) (cfg : DsimpConfig := { }) :
    conv Unit := do
  let s ←
    match s with
      | some s => return s
      | none => simp_lemmas.mk_default
  let l ← lhs
  s u l cfg >>= change
#align conv.dsimp conv.dsimp

private unsafe def congr_aux : List CongrArgKind → List expr → tactic (List expr × List expr)
  | [], [] => return ([], [])
  | k :: ks, a :: as => do
    let (gs, largs) ← congr_aux ks as
    match k with
      |-- parameter for the congruence lemma
        CongrArgKind.fixed =>
        return <| (gs, a :: largs)
      |-- parameter which is a subsingleton
        CongrArgKind.fixed_no_param =>
        return <| (gs, largs)
      | CongrArgKind.eq => do
        let a_type ← infer_type a
        let rhs ← mk_meta_var a_type
        let g_type ← mk_app `eq [a, rhs]
        let g ← mk_meta_var g_type
        -- proof that `a = rhs`
            return
            (g :: gs, a :: rhs :: g :: largs)
      | CongrArgKind.cast => return <| (gs, a :: largs)
      | _ => fail "congr tactic failed, unsupported congruence lemma"
  | ks, as => fail "congr tactic failed, unsupported congruence lemma"
#align conv.congr_aux conv.congr_aux

/--
Take the target equality `f x y = X` and try to apply the congruence lemma for `f` to it (namely `x = x' → y = y' → f x y = f x' y'`). -/
unsafe def congr : conv Unit := do
  let (r, lhs, rhs) ← target_lhs_rhs
  guard (r = `eq)
  let fn := lhs.get_app_fn
  let args := lhs.get_app_args
  let cgr_lemma ← mk_congr_lemma_simp fn (some args.length)
  let g :: gs ← get_goals
  let (new_gs, lemma_args) ← congr_aux cgr_lemma.arg_kinds args
  let g_val := cgr_lemma.proof.mk_app lemma_args
  unify g g_val
  set_goals <| new_gs ++ gs
  return ()
#align conv.congr conv.congr

/-- Create a conversion from the function extensionality tactic.-/
unsafe def funext : conv Unit :=
  iterate' do
    let (r, lhs, rhs) ← target_lhs_rhs
    guard (r = `eq)
    let expr.lam n _ _ _ ← return lhs
    tactic.applyc `funext
    intro n
    return ()
#align conv.funext conv.funext

end Conv


def f (x : Nat) : IO Nat := do
  IO.println "hello"
  if x > 5 then
    IO.println ("x: " ++ toString x)
    IO.println "done"
  pure (x + 1)

#eval f 2
#eval f 10

def g (x : Nat) : StateT Nat Id Unit := do
  if x > 10 then
    let s ← get
    set (s + x)
  pure ()

theorem ex1 : (g 10).run 1 = ((), 1) :=
rfl

theorem ex2 : (g 20).run 1 = ((), 21) :=
rfl

def h (x : Nat) : StateT Nat Id Unit := do
if x > 10 then {
  let s ← get;
set (s + x) -- we don't need to respect indentation when `{` `}` are used
}
pure ()

theorem ex3 : (h 10).run 1 = ((), 1) :=
rfl

theorem ex4 : (h 20).run 1 = ((), 21) :=
rfl


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.data.repr init.data.prod init.data.sum.basic

universes u v

inductive ordering
| lt | eq | gt

instance : has_repr ordering :=
⟨(λ s, match s with | ordering.lt := "lt" | ordering.eq := "eq" | ordering.gt := "gt" end)⟩

namespace ordering
def swap : ordering → ordering
| lt := gt
| eq := eq
| gt := lt

@[inline] def or_else : ordering → ordering → ordering
| lt _ := lt
| eq o := o
| gt _ := gt

theorem swap_swap : ∀ (o : ordering), o.swap.swap = o
| lt := rfl
| eq := rfl
| gt := rfl
end ordering

def cmp_using {α : Type u} (lt : α → α → Prop) [decidable_rel lt] (a b : α) : ordering :=
if lt a b      then ordering.lt
else if lt b a then ordering.gt
else                ordering.eq

def cmp {α : Type u} [has_lt α] [decidable_rel ((<) : α → α → Prop)] (a b : α) : ordering :=
cmp_using (<) a b

instance : decidable_eq ordering :=
λ a b,
  match a with
  | ordering.lt :=
    match b with
    | ordering.lt := is_true rfl
    | ordering.eq := is_false (λ h, ordering.no_confusion h)
    | ordering.gt := is_false (λ h, ordering.no_confusion h)
    end
  | ordering.eq :=
    match b with
    | ordering.lt := is_false (λ h, ordering.no_confusion h)
    | ordering.eq := is_true rfl
    | ordering.gt := is_false (λ h, ordering.no_confusion h)
    end
  | ordering.gt :=
    match b with
    | ordering.lt := is_false (λ h, ordering.no_confusion h)
    | ordering.eq := is_false (λ h, ordering.no_confusion h)
    | ordering.gt := is_true rfl
    end
  end