/-
Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Simon Hudon, Scott Morrison, Keeley Hoek, Robert Y. Lewis, Floris van Doorn
-/
import data.string.defs
import tactic.derive_inhabited
/-!
# Additional operations on expr and related types

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

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

## Tags

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

open tactic

attribute [derive has_reflect, derive decidable_eq] binder_info congr_arg_kind

@[priority 100] meta instance has_reflect.has_to_pexpr {α} [has_reflect α] : has_to_pexpr α :=
⟨λ b, pexpr.of_expr (reflect b)⟩

namespace binder_info

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

instance : inhabited binder_info := ⟨ binder_info.default ⟩

/-- The brackets corresponding to a given binder_info. -/
def brackets : binder_info → string × string
| binder_info.implicit        := ("{", "}")
| binder_info.strict_implicit := ("{{", "}}")
| binder_info.inst_implicit   := ("[", "]")
| _                           := ("(", ")")

end binder_info

namespace name

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

/-- Find the largest prefix `n` of a `name` such that `f n ≠ none`, then replace this prefix
with the value of `f n`. -/
def map_prefix (f : name → option name) : name → name
| anonymous := anonymous
| (mk_string s n') := (f (mk_string s n')).get_or_else (mk_string s $ map_prefix n')
| (mk_numeral d n') := (f (mk_numeral d n')).get_or_else (mk_numeral d $ map_prefix n')

/-- If `nm` is a simple name (having only one string component) starting with `_`, then
`deinternalize_field nm` removes the underscore. Otherwise, it does nothing. -/
meta def deinternalize_field : name → name
| (mk_string s name.anonymous) :=
  let i := s.mk_iterator in
  if i.curr = '_' then i.next.next_to_string else s
| n := n

/-- `get_nth_prefix nm n` removes the last `n` components from `nm` -/
meta def get_nth_prefix : name → ℕ → name
| nm 0 := nm
| nm (n + 1) := get_nth_prefix nm.get_prefix n

/-- Auxiliary definition for `pop_nth_prefix` -/
private meta def pop_nth_prefix_aux : name → ℕ → name × ℕ
| anonymous n := (anonymous, 1)
| nm n := let (pfx, height) := pop_nth_prefix_aux nm.get_prefix n in
          if height ≤ n then (anonymous, height + 1)
          else (nm.update_prefix pfx, height + 1)

/-- Pops the top `n` prefixes from the given name. -/
meta def pop_nth_prefix (nm : name) (n : ℕ) : name :=
prod.fst $ pop_nth_prefix_aux nm n

/-- Pop the prefix of a name -/
meta def pop_prefix (n : name) : name :=
pop_nth_prefix n 1

/-- Auxiliary definition for `from_components` -/
private def from_components_aux : name → list string → name
| n [] := n
| n (s :: rest) := from_components_aux (name.mk_string s n) rest

/-- Build a name from components. For example `from_components ["foo","bar"]` becomes
  ``` `foo.bar``` -/
def from_components : list string → name :=
from_components_aux name.anonymous

/-- `name`s can contain numeral pieces, which are not legal names
  when typed/passed directly to the parser. We turn an arbitrary
  name into a legal identifier name by turning the numbers to strings. -/
meta def sanitize_name : name → name
| name.anonymous := name.anonymous
| (name.mk_string s p) := name.mk_string s $ sanitize_name p
| (name.mk_numeral s p) := name.mk_string sformat!"n{s}" $ sanitize_name p

/-- Append a string to the last component of a name. -/
def append_suffix : name → string → name
| (mk_string s n) s' := mk_string (s ++ s') n
| n _ := n

/-- Update the last component of a name. -/
def update_last (f : string → string) : name → name
| (mk_string s n) := mk_string (f s) n
| n := n

/-- `append_to_last nm s is_prefix` adds `s` to the last component of `nm`,
  either as prefix or as suffix (specified by `is_prefix`), separated by `_`.
  Used by `simps_add_projections`. -/
def append_to_last (nm : name) (s : string) (is_prefix : bool) : name :=
nm.update_last $ λ s', if is_prefix then s ++ "_" ++ s' else s' ++ "_" ++ s

/-- The first component of a name, turning a number to a string -/
meta def head : name → string
| (mk_string s anonymous) := s
| (mk_string s p)         := head p
| (mk_numeral n p)        := head p
| anonymous               := "[anonymous]"

/-- Tests whether the first component of a name is `"_private"` -/
meta def is_private (n : name) : bool :=
n.head = "_private"

/-- Get the last component of a name, and convert it to a string. -/
meta def last : name → string
| (mk_string s _)  := s
| (mk_numeral n _) := repr n
| anonymous        := "[anonymous]"

/-- Returns the number of characters used to print all the string components of a name,
  including periods between name segments. Ignores numerical parts of a name. -/
meta def length : name → ℕ
| (mk_string s anonymous) := s.length
| (mk_string s p)         := s.length + 1 + p.length
| (mk_numeral n p)        := p.length
| anonymous               := "[anonymous]".length

/-- Checks whether `nm` has a prefix (including itself) such that P is true -/
def has_prefix (P : name → bool) : name → bool
| anonymous := ff
| (mk_string s nm)  := P (mk_string s nm) ∨ has_prefix nm
| (mk_numeral s nm) := P (mk_numeral s nm) ∨ has_prefix nm

/-- Appends `'` to the end of a name. -/
meta def add_prime : name → name
| (name.mk_string s p) := name.mk_string (s ++ "'") p
| n := (name.mk_string "x'" n)

/-- `last_string n` returns the rightmost component of `n`, ignoring numeral components.
For example, ``last_string `a.b.c.33`` will return `` `c ``. -/
def last_string : name → string
| anonymous        := "[anonymous]"
| (mk_string s _)  := s
| (mk_numeral _ n) := last_string n

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

Example: ``name.from_string "foo.bar" = `foo.bar``
-/
meta def from_string (s : string) : name :=
from_components $ s.split (= '.')

/--
In surface Lean, we can write anonymous Π binders (i.e. binders where the
argument is not named) using the function arrow notation:

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

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

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

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

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

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

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

The function `name.is_likely_generated_binder_name` checks if
a name is of the form `ᾰ`, `ᾰ_1`, etc.
-/
library_note "likely generated binder names"

/--
Check whether a simple name was likely generated by Lean to name an anonymous
binder. Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
meta def is_likely_generated_binder_simple_name : string → bool
| "ᾰ" := tt
| n :=
  match n.get_rest "ᾰ_" with
  | none := ff
  | some suffix := suffix.is_nat
  end

/--
Check whether a name was likely generated by Lean to name an anonymous binder.
Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
meta def is_likely_generated_binder_name (n : name) : bool :=
match n with
| mk_string s anonymous := is_likely_generated_binder_simple_name s
| _ := ff
end

end name

namespace level

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

/-- Tests whether a universe level is non-zero for all assignments of its variables -/
meta def nonzero : level → bool
| (succ _) := tt
| (max l₁ l₂) := l₁.nonzero || l₂.nonzero
| (imax _ l₂) := l₂.nonzero
| _ := ff

/--
`l.fold_mvar f` folds a function `f : name → α → α`
over each `n : name` appearing in a `level.mvar n` in `l`.
-/
meta def fold_mvar {α} : level → (name → α → α) → α → α
| zero f := id
| (succ a) f := fold_mvar a f
| (param a) f := id
| (mvar a) f := f a
| (max a b) f := fold_mvar a f ∘ fold_mvar b f
| (imax a b) f := fold_mvar a f ∘ fold_mvar b f

/--
`l.params` is the set of parameters occuring in `l`.
For example if `l = max 1 (max (u+1) (max v w))` then `l.params = {u, v, w}`.
-/
protected meta def params (u : level) : name_set :=
u.fold mk_name_set $ λ v l,
  match v with
  | (param nm) := l.insert nm
  | _ := l
  end

end level

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

/-- The type of binders containing a name, the binding info and the binding type -/
@[derive decidable_eq, derive inhabited]
meta structure binder :=
  (name : name)
  (info : binder_info)
  (type : expr)

namespace binder
/-- Turn a binder into a string. Uses expr.to_string for the type. -/
protected meta def to_string (b : binder) : string :=
let (l, r) := b.info.brackets in
l ++ b.name.to_string ++ " : " ++ b.type.to_string ++ r

meta instance : has_to_string binder := ⟨ binder.to_string ⟩
meta instance : has_to_format binder := ⟨ λ b, b.to_string ⟩
meta instance : has_to_tactic_format binder :=
⟨ λ b, let (l, r) := b.info.brackets in
  (λ e, l ++ b.name.to_string ++ " : " ++ e ++ r) <$> pp b.type ⟩

end binder

/-!
### Converting between expressions and numerals

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

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

/--
`nat.mk_numeral n` embeds `n` as a numeral expression inside a type with 0, 1, and +.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`: expressions of the type `has_zero %%type`, etc.
 -/
meta def nat.mk_numeral (type has_zero has_one has_add : expr) : ℕ → expr :=
let z : expr := `(@has_zero.zero.{0} %%type %%has_zero),
    o : expr := `(@has_one.one.{0} %%type %%has_one) in
nat.binary_rec z
  (λ b n e, if n = 0 then o else
    if b then `(@bit1.{0} %%type %%has_one %%has_add %%e)
    else `(@bit0.{0} %%type %%has_add %%e))

/--
`int.mk_numeral z` embeds `z` as a numeral expression inside a type with 0, 1, +, and -.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`, `has_neg`: expressions of the type `has_zero %%type`, etc.
 -/
meta def int.mk_numeral (type has_zero has_one has_add has_neg : expr) : ℤ → expr
| (int.of_nat n) := n.mk_numeral type has_zero has_one has_add
| -[1+n] := let ne := (n+1).mk_numeral type has_zero has_one has_add in
            `(@has_neg.neg.{0} %%type %%has_neg %%ne)

/--
`nat.to_pexpr n` creates a `pexpr` that will evaluate to `n`.
The `pexpr` does not hold any typing information:
`to_expr ``((%%(nat.to_pexpr 5) : ℤ))` will create a native integer numeral `(5 : ℤ)`.
-/
meta def nat.to_pexpr : ℕ → pexpr
| 0 := ``(0)
| 1 := ``(1)
| n := if n % 2 = 0 then ``(bit0 %%(nat.to_pexpr (n/2))) else ``(bit1 %%(nat.to_pexpr (n/2)))
namespace expr

/--
Turns an expression into a natural number, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero`, `nat.zero`, and `nat.succ`.
-/
protected meta def to_nat : expr → option ℕ
| `(has_zero.zero) := some 0
| `(has_one.one) := some 1
| `(bit0 %%e) := bit0 <$> e.to_nat
| `(bit1 %%e) := bit1 <$> e.to_nat
| `(nat.succ %%e) := (+1) <$> e.to_nat
| `(nat.zero) := some 0
| _ := none

/--
Turns an expression into a integer, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero` and a optionally a single `has_neg.neg` as head.
-/
protected meta def to_int : expr → option ℤ
| `(has_neg.neg %%e) := do n ← e.to_nat, some (-n)
| e                  := coe <$> e.to_nat

/--
Turns an expression into a list, assuming it is only built up from `list.nil` and `list.cons`.
-/
protected meta def to_list {α} (f : expr → option α) : expr → option (list α)
| `(list.nil)          := some []
| `(list.cons %%x %%l) := list.cons <$> f x <*> l.to_list
| _                    := none

/--
`is_num_eq n1 n2` returns true if `n1` and `n2` are both numerals with the same numeral structure,
ignoring differences in type and type class arguments.
-/
meta def is_num_eq : expr → expr → bool
| `(@has_zero.zero _ _) `(@has_zero.zero _ _) := tt
| `(@has_one.one _ _) `(@has_one.one _ _) := tt
| `(bit0 %%a) `(bit0 %%b) := a.is_num_eq b
| `(bit1 %%a) `(bit1 %%b) := a.is_num_eq b
| `(-%%a) `(-%%b) := a.is_num_eq b
| `(%%a/%%a') `(%%b/%%b') :=  a.is_num_eq b
| _ _ := ff

end expr

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

namespace expr

/-- List of names removed by `clean`. All these names must resolve to functions defeq `id`. -/
meta def clean_ids : list name :=
[``id, ``id_rhs, ``id_delta, ``hidden]

/-- Clean an expression by removing `id`s listed in `clean_ids`. -/
meta def clean (e : expr) : expr :=
e.replace (λ e n,
     match e with
     | (app (app (const n _) _) e') :=
       if n ∈ clean_ids then some e' else none
     | (app (lam _ _ _ (var 0)) e') := some e'
     | _ := none
     end)

/-- `replace_with e s s'` replaces ocurrences of `s` with `s'` in `e`. -/
meta def replace_with (e : expr) (s : expr) (s' : expr) : expr :=
e.replace $ λc d, if c = s then some (s'.lift_vars 0 d) else none

/-- Implementation of `expr.mreplace`. -/
meta def mreplace_aux {m : Type* → Type*} [monad m] (R : expr → nat → m (option expr)) :
  expr → ℕ → m expr
| (app f x) n := option.mget_or_else (R (app f x) n)
  (do Rf ← mreplace_aux f n, Rx ← mreplace_aux x n, return $ app Rf Rx)
| (lam nm bi ty bd) n := option.mget_or_else (R (lam nm bi ty bd) n)
  (do Rty ← mreplace_aux ty n, Rbd ← mreplace_aux bd (n+1), return $ lam nm bi Rty Rbd)
| (pi nm bi ty bd) n := option.mget_or_else (R (pi nm bi ty bd) n)
  (do Rty ← mreplace_aux ty n, Rbd ← mreplace_aux bd (n+1), return $ pi nm bi Rty Rbd)
| (elet nm ty a b) n := option.mget_or_else (R (elet nm ty a b) n)
  (do Rty ← mreplace_aux ty n,
    Ra ← mreplace_aux a n,
    Rb ← mreplace_aux b n,
    return $ elet nm Rty Ra Rb)
| (macro c es) n := option.mget_or_else (R (macro c es) n) $
    macro c <$> es.mmap (λ e, mreplace_aux e n)
| e n := option.mget_or_else (R e n) (return e)

/--
Monadic analogue of `expr.replace`.

The `mreplace R e` visits each subexpression `s` of `e`, and is called with `R s n`, where
`n` is the number of binders above `e`.
If `R s n` fails, the whole replacement fails.
If `R s n` returns `some t`, `s` is replaced with `t` (and `mreplace` does not visit
its subexpressions).
If `R s n` return `none`, then `mreplace` continues visiting subexpressions of `s`.

WARNING: This function performs exponentially worse on large terms than `expr.replace`,
if a subexpression occurs more than once in an expression, `expr.replace` visits them only once,
but this function will visit every occurence of it. Do not use this on large expressions.
-/
meta def mreplace {m : Type* → Type*} [monad m] (R : expr → nat → m (option expr)) (e : expr) :
  m expr :=
mreplace_aux R e 0

/-- Match a variable. -/
meta def match_var {elab} : expr elab → option ℕ
| (var n) := some n
| _ := none

/-- Match a sort. -/
meta def match_sort {elab} : expr elab → option level
| (sort u) := some u
| _ := none

/-- Match a constant. -/
meta def match_const {elab} : expr elab → option (name × list level)
| (const n lvls) := some (n, lvls)
| _ := none

/-- Match a metavariable. -/
meta def match_mvar {elab} : expr elab →
  option (name × name × expr elab)
| (mvar unique pretty type) := some (unique, pretty, type)
| _ := none

/-- Match a local constant. -/
meta def match_local_const {elab} : expr elab →
  option (name × name × binder_info × expr elab)
| (local_const unique pretty bi type) := some (unique, pretty, bi, type)
| _ := none

/-- Match an application. -/
meta def match_app {elab} : expr elab → option (expr elab × expr elab)
| (app t u) := some (t, u)
| _ := none

/-- Match an application of `coe_fn`. -/
meta def match_app_coe_fn : expr → option (expr × expr × expr × expr × expr)
| (app `(@coe_fn %%α %%β %%inst %%fexpr) x) := some (α, β, inst, fexpr, x)
| _ := none

/-- Match an abstraction. -/
meta def match_lam {elab} : expr elab →
  option (name × binder_info × expr elab × expr elab)
| (lam var_name bi type body) := some (var_name, bi, type, body)
| _ := none

/-- Match a Π type. -/
meta def match_pi {elab} : expr elab →
  option (name × binder_info × expr elab × expr elab)
| (pi var_name bi type body) := some (var_name, bi, type, body)
| _ := none

/-- Match a let. -/
meta def match_elet {elab} : expr elab →
  option (name × expr elab × expr elab × expr elab)
| (elet var_name type assignment body) := some (var_name, type, assignment, body)
| _ := none

/-- Match a macro. -/
meta def match_macro {elab} : expr elab →
  option (macro_def × list (expr elab))
| (macro df args) := some (df, args)
| _ := none

/-- Tests whether an expression is a meta-variable. -/
meta def is_mvar : expr → bool
| (mvar _ _ _) := tt
| _            := ff

/-- Tests whether an expression is a sort. -/
meta def is_sort : expr → bool
| (sort _) := tt
| e         := ff

/-- Get the universe levels of a `const` expression -/
meta def univ_levels : expr → list level
| (const n ls) := ls
| _            := []

/--
Replace any metavariables in the expression with underscores, in preparation for printing
`refine ...` statements.
-/
meta def replace_mvars (e : expr) : expr :=
e.replace (λ e' _, if e'.is_mvar then some (unchecked_cast pexpr.mk_placeholder) else none)

/-- If `e` is a local constant, `to_implicit_local_const e` changes the binder info of `e` to
 `implicit`. See also `to_implicit_binder`, which also changes lambdas and pis. -/
meta def to_implicit_local_const : expr → expr
| (expr.local_const uniq n bi t) := expr.local_const uniq n binder_info.implicit t
| e := e

/-- If `e` is a local constant, lamda, or pi expression, `to_implicit_binder e` changes the binder
info of `e` to `implicit`. See also `to_implicit_local_const`, which only changes local constants.
-/
meta def to_implicit_binder : expr → expr
| (local_const n₁ n₂ _ d) := local_const n₁ n₂ binder_info.implicit d
| (lam n _ d b) := lam n binder_info.implicit d b
| (pi n _ d b) := pi n binder_info.implicit d b
| e  := e

/-- Returns a list of all local constants in an expression (without duplicates). -/
meta def list_local_consts (e : expr) : list expr :=
e.fold [] (λ e' _ es, if e'.is_local_constant then insert e' es else es)

/-- Returns the set of all local constants in an expression. -/
meta def list_local_consts' (e : expr) : expr_set :=
e.fold mk_expr_set (λ e' _ es, if e'.is_local_constant then es.insert e' else es)

/-- Returns the unique names of all local constants in an expression. -/
meta def list_local_const_unique_names (e : expr) : name_set :=
e.fold mk_name_set
  (λ e' _ es, if e'.is_local_constant then es.insert e'.local_uniq_name else es)

/-- Returns a name_set of all constants in an expression. -/
meta def list_constant (e : expr) : name_set :=
e.fold mk_name_set (λ e' _ es, if e'.is_constant then es.insert e'.const_name else es)

/-- Returns a list of all meta-variables in an expression (without duplicates). -/
meta def list_meta_vars (e : expr) : list expr :=
e.fold [] (λ e' _ es, if e'.is_mvar then insert e' es else es)

/-- Returns the set of all meta-variables in an expression. -/
meta def list_meta_vars' (e : expr) : expr_set :=
e.fold mk_expr_set (λ e' _ es, if e'.is_mvar then es.insert e' else es)

/-- Returns a list of all universe meta-variables in an expression (without duplicates). -/
meta def list_univ_meta_vars (e : expr) : list name :=
native.rb_set.to_list $ e.fold native.mk_rb_set $ λ e' i s,
match e' with
| (sort u) := u.fold_mvar (flip native.rb_set.insert) s
| (const _ ls) := ls.foldl (λ s' l, l.fold_mvar (flip native.rb_set.insert) s') s
| _ := s
end

/--
Test `t` contains the specified subexpression `e`, or a metavariable.
This represents the notion that `e` "may occur" in `t`,
possibly after subsequent unification.
-/
meta def contains_expr_or_mvar (t : expr) (e : expr) : bool :=
-- We can't use `t.has_meta_var` here, as that detects universe metavariables, too.
¬ t.list_meta_vars.empty ∨ e.occurs t

/-- Returns a name_set of all constants in an expression starting with a certain prefix. -/
meta def list_names_with_prefix (pre : name) (e : expr) : name_set :=
e.fold mk_name_set $ λ e' _ l,
  match e' with
  | expr.const n _ := if n.get_prefix = pre then l.insert n else l
  | _ := l
  end

/-- Returns true if `e` contains a name `n` where `p n` is true.
  Returns `true` if `p name.anonymous` is true. -/
meta def contains_constant (e : expr) (p : name → Prop) [decidable_pred p] : bool :=
e.fold ff (λ e' _ b, if p (e'.const_name) then tt else b)

/--
Returns true if `e` contains a `sorry`.
See also `name.contains_sorry`.
-/
meta def contains_sorry (e : expr) : bool :=
e.fold ff (λ e' _ b, if (is_sorry e').is_some then tt else b)

/--
`app_symbol_in e l` returns true iff `e` is an application of a constant whose name is in `l`.
-/
meta def app_symbol_in (e : expr) (l : list name) : bool :=
match e.get_app_fn with
| (expr.const n _) := n ∈ l
| _ := ff
end

/-- `get_simp_args e` returns the arguments of `e` that simp can reach via congruence lemmas. -/
meta def get_simp_args (e : expr) : tactic (list expr) :=
-- `mk_specialized_congr_lemma_simp` throws an assertion violation if its argument is not an app
if ¬ e.is_app then pure [] else do
cgr ← mk_specialized_congr_lemma_simp e,
pure $ do
  (arg_kind, arg) ← cgr.arg_kinds.zip e.get_app_args,
  guard $ arg_kind = congr_arg_kind.eq,
  pure arg

/-- Simplifies the expression `t` with the specified options.
  The result is `(new_e, pr)` with the new expression `new_e` and a proof
  `pr : e = new_e`. -/
meta def simp (t : expr)
  (cfg : simp_config := {}) (discharger : tactic unit := failed)
  (no_defaults := ff) (attr_names : list name := []) (hs : list simp_arg_type := []) :
  tactic (expr × expr × name_set) :=
do (s, to_unfold) ← mk_simp_set no_defaults attr_names hs,
   simplify s to_unfold t cfg `eq discharger

/-- Definitionally simplifies the expression `t` with the specified options.
  The result is the simplified expression. -/
meta def dsimp (t : expr)
  (cfg : dsimp_config := {})
  (no_defaults := ff) (attr_names : list name := []) (hs : list simp_arg_type := []) :
  tactic expr :=
do (s, to_unfold) ← mk_simp_set no_defaults attr_names hs,
   s.dsimplify to_unfold t cfg

/-- Get the names of the bound variables by a sequence of pis or lambdas. -/
meta def binding_names : expr → list name
| (pi n _ _ e)  := n :: e.binding_names
| (lam n _ _ e) := n :: e.binding_names
| e             := []

/-- head-reduce a single let expression -/
meta def reduce_let : expr → expr
| (elet _ _ v b) := b.instantiate_var v
| e              := e

/-- head-reduce all let expressions -/
meta def reduce_lets : expr → expr
| (elet _ _ v b) := reduce_lets $ b.instantiate_var v
| e              := e

/-- Instantiate lambdas in the second argument by expressions from the first. -/
meta def instantiate_lambdas : list expr → expr → expr
| (e'::es) (lam n bi t e) := instantiate_lambdas es (e.instantiate_var e')
| _        e              := e

/-- Repeatedly apply `expr.subst`. -/
meta def substs : expr → list expr → expr | e es := es.foldl expr.subst e

/-- `instantiate_lambdas_or_apps es e` instantiates lambdas in `e` by expressions from `es`.
If the length of `es` is larger than the number of lambdas in `e`,
then the term is applied to the remaining terms.
Also reduces head let-expressions in `e`, including those after instantiating all lambdas.

This is very similar to `expr.substs`, but this also reduces head let-expressions. -/
meta def instantiate_lambdas_or_apps : list expr → expr → expr
| (v::es) (lam n bi t b) := instantiate_lambdas_or_apps es $ b.instantiate_var v
| es      (elet _ _ v b) := instantiate_lambdas_or_apps es $ b.instantiate_var v
| es      e              := mk_app e es

/--
Some declarations work with open expressions, i.e. an expr that has free variables.
Terms will free variables are not well-typed, and one should not use them in tactics like
`infer_type` or `unify`. You can still do syntactic analysis/manipulation on them.
The reason for working with open types is for performance: instantiating variables requires
iterating through the expression. In one performance test `pi_binders` was more than 6x
quicker than `mk_local_pis` (when applied to the type of all imported declarations 100x).
-/
library_note "open expressions"

/-- Get the codomain/target of a pi-type.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  See note [open expressions]. -/
meta def pi_codomain : expr → expr
| (pi n bi d b) := pi_codomain b
| e             := e

/-- Get the body/value of a lambda-expression.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  See note [open expressions]. -/
meta def lambda_body : expr → expr
| (lam n bi d b) := lambda_body b
| e             := e

/-- Auxiliary defintion for `pi_binders`.
  See note [open expressions]. -/
meta def pi_binders_aux : list binder → expr → list binder × expr
| es (pi n bi d b) := pi_binders_aux (⟨n, bi, d⟩::es) b
| es e             := (es, e)

/-- Get the binders and codomain of a pi-type.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  The.tactic `get_pi_binders` in `tactic.core` does the same, but also instantiates the
  free variables.
  See note [open expressions]. -/
meta def pi_binders (e : expr) : list binder × expr :=
let (es, e) := pi_binders_aux [] e in (es.reverse, e)

/-- Auxiliary defintion for `get_app_fn_args`. -/
meta def get_app_fn_args_aux : list expr → expr → expr × list expr
| r (app f a) := get_app_fn_args_aux (a::r) f
| r e         := (e, r)

/-- A combination of `get_app_fn` and `get_app_args`: lists both the
  function and its arguments of an application -/
meta def get_app_fn_args : expr → expr × list expr :=
get_app_fn_args_aux []

/-- `drop_pis es e` instantiates the pis in `e` with the expressions from `es`. -/
meta def drop_pis : list expr → expr → tactic expr
| (v :: vs) (pi n bi d b) := do
  t ← infer_type v,
  guard (t =ₐ d),
  drop_pis vs (b.instantiate_var v)
| [] e := return e
| _  _ := failed

/-- `instantiate_pis es e` instantiates the pis in `e` with the expressions from `es`.
  Does not check whether the result remains type-correct. -/
meta def instantiate_pis : list expr → expr → expr
| (v :: vs) (pi n bi d b) := instantiate_pis vs (b.instantiate_var v)
| _ e := e

/-- `mk_op_lst op empty [x1, x2, ...]` is defined as `op x1 (op x2 ...)`.
  Returns `empty` if the list is empty. -/
meta def mk_op_lst (op : expr) (empty : expr) : list expr → expr
| []        := empty
| [e]       := e
| (e :: es) := op e $ mk_op_lst es

/-- `mk_and_lst [x1, x2, ...]` is defined as `x1 ∧ (x2 ∧ ...)`, or `true` if the list is empty. -/
meta def mk_and_lst : list expr → expr := mk_op_lst `(and) `(true)

/-- `mk_or_lst [x1, x2, ...]` is defined as `x1 ∨ (x2 ∨ ...)`, or `false` if the list is empty. -/
meta def mk_or_lst : list expr → expr := mk_op_lst `(or) `(false)

/-- `local_binding_info e` returns the binding info of `e` if `e` is a local constant.
Otherwise returns `binder_info.default`. -/
meta def local_binding_info : expr → binder_info
| (expr.local_const _ _ bi _) := bi
| _ := binder_info.default

/-- `is_default_local e` tests whether `e` is a local constant with binder info
`binder_info.default` -/
meta def is_default_local : expr → bool
| (expr.local_const _ _ binder_info.default _) := tt
| _ := ff

/-- `has_local_constant e l` checks whether local constant `l` occurs in expression `e` -/
meta def has_local_constant (e l : expr) : bool :=
e.has_local_in $ mk_name_set.insert l.local_uniq_name

/-- Turns a local constant into a binder -/
meta def to_binder : expr → binder
| (local_const _ nm bi t) := ⟨nm, bi, t⟩
| _                       := default binder

/-- Strip-away the context-dependent unique id for the given local const and return: its friendly
`name`, its `binder_info`, and its `type : expr`. -/
meta def get_local_const_kind : expr → name × binder_info × expr
| (expr.local_const _ n bi e) := (n, bi, e)
| _ := (name.anonymous, binder_info.default, expr.const name.anonymous [])

/-- `local_const_set_type e t` sets the type of `e` to `t`, if `e` is a `local_const`. -/
meta def local_const_set_type {elab : bool} : expr elab → expr elab → expr elab
| (expr.local_const x n bi t) new_t := expr.local_const x n bi new_t
| e                           new_t := e

/-- `unsafe_cast e` freely changes the `elab : bool` parameter of the passed `expr`. Mainly used to
access core `expr` manipulation functions for `pexpr`-based use, but which are restricted to
`expr tt` at the site of definition unnecessarily.

DANGER: Unless you know exactly what you are doing, this is probably not the function you are
looking for. For `pexpr → expr` see `tactic.to_expr`. For `expr → pexpr` see `to_pexpr`. -/
meta def unsafe_cast {elab₁ elab₂ : bool} : expr elab₁ → expr elab₂ := unchecked_cast

/-- `replace_subexprs e mappings` takes an `e : expr` and interprets a `list (expr × expr)` as
a collection of rules for variable replacements. A pair `(f, t)` encodes a rule which says "whenever
`f` is encountered in `e` verbatim, replace it with `t`". -/
meta def replace_subexprs {elab : bool} (e : expr elab) (mappings : list (expr × expr)) :
  expr elab :=
unsafe_cast $ e.unsafe_cast.replace $ λ e n,
  (mappings.filter $ λ ent : expr × expr, ent.1 = e).head'.map prod.snd

/-- `is_implicitly_included_variable e vs` accepts `e`, an `expr.local_const`, and a list `vs` of
    other `expr.local_const`s. It determines whether `e` should be considered "available in context"
    as a variable by virtue of the fact that the variables `vs` have been deemed such.

    For example, given `variables (n : ℕ) [prime n] [ih : even n]`, a reference to `n` implies that
    the typeclass instance `prime n` should be included, but `ih : even n` should not.

    DANGER: It is possible that for `f : expr` another `expr.local_const`, we have
    `is_implicitly_included_variable f vs = ff` but
    `is_implicitly_included_variable f (e :: vs) = tt`. This means that one usually wants to
    iteratively add a list of local constants (usually, the `variables` declared in the local scope)
    which satisfy `is_implicitly_included_variable` to an initial `vs`, repeating if any variables
    were added in a particular iteration. The function `all_implicitly_included_variables` below
    implements this behaviour.

    Note that if `e ∈ vs` then `is_implicitly_included_variable e vs = tt`. -/
meta def is_implicitly_included_variable (e : expr) (vs : list expr) : bool :=
if ¬(e.local_pp_name.to_string.starts_with "_") then
  e ∈ vs
else e.local_type.fold tt $ λ se _ b,
  if ¬b then ff
  else if ¬se.is_local_constant then tt
  else se ∈ vs

/-- Private work function for `all_implicitly_included_variables`, performing the actual series of
    iterations, tracking with a boolean whether any updates occured this iteration. -/
private meta def all_implicitly_included_variables_aux
  : list expr → list expr → list expr → bool → list expr
| []          vs rs tt := all_implicitly_included_variables_aux rs vs [] ff
| []          vs rs ff := vs
| (e :: rest) vs rs b :=
  let (vs, rs, b) :=
    if e.is_implicitly_included_variable vs then (e :: vs, rs, tt) else (vs, e :: rs, b) in
  all_implicitly_included_variables_aux rest vs rs b

/-- `all_implicitly_included_variables es vs` accepts `es`, a list of `expr.local_const`, and `vs`,
    another such list. It returns a list of all variables `e` in `es` or `vs` for which an inclusion
    of the variables in `vs` into the local context implies that `e` should also be included. See
    `is_implicitly_included_variable e vs` for the details.

    In particular, those elements of `vs` are included automatically. -/
meta def all_implicitly_included_variables (es vs : list expr) : list expr :=
all_implicitly_included_variables_aux es vs [] ff

/-- Infer the type of an application of the form `f x1 x2 ... xn`, where `f` is an identifier.
This also works if `x1, ... xn` contain free variables. -/
protected meta def simple_infer_type (env : environment) (e : expr) : exceptional expr := do
(@const tt n ls, es) ← return e.get_app_fn_args |
  exceptional.fail "expression is not a constant applied to arguments",
d ← env.get n,
return $ (d.type.instantiate_pis es).instantiate_univ_params $ d.univ_params.zip ls

/-- Auxilliary function for `head_eta_expand`. -/
meta def head_eta_expand_aux : ℕ → expr → expr → expr
| (n+1) e (pi x bi d b) :=
  lam x bi d $ head_eta_expand_aux n e b
| _ e _ := e

/-- `head_eta_expand n e t` eta-expands `e` `n` times, with the binders info and domains obtained
  by its type `t`. -/
meta def head_eta_expand (n : ℕ) (e t : expr) : expr :=
((e.lift_vars 0 n).mk_app $ (list.range n).reverse.map var).head_eta_expand_aux n t

/-- `e.eta_expand env dict` eta-expands all expressions that have as head a constant `n` in
`dict`. They are expanded until they are applied to one more argument than the maximum in
`dict.find n`. -/
protected meta def eta_expand (env : environment) (dict : name_map $ list ℕ) : expr → expr
| e := e.replace $ λ e _, do
  let (e0, es) := e.get_app_fn_args,
  let ns := (dict.find e0.const_name).iget,
  guard (bnot ns.empty),
  let e' := e0.mk_app $ es.map eta_expand,
  let needed_n := ns.foldr max 0 + 1,
  if needed_n ≤ es.length then some e'
  else do
    e'_type ← (e'.simple_infer_type env).to_option,
    some $ head_eta_expand (needed_n - es.length) e' e'_type

/--
`e.apply_replacement_fun f test` applies `f` to each identifier
(inductive type, defined function etc) in an expression, unless
* The identifier occurs in an application with first argument `arg`; and
* `test arg` is false.
However, if `f` is in the dictionary `relevant`, then the argument `relevant.find f`
is tested, instead of the first argument.

Reorder contains the information about what arguments to reorder:
e.g. `g x₁ x₂ x₃ ... xₙ` becomes `g x₂ x₁ x₃ ... xₙ` if `reorder.find g = some [1]`.
We assume that all functions where we want to reorder arguments are fully applied.
This can be done by applying `expr.eta_expand` first.
-/
protected meta def apply_replacement_fun (f : name → name) (test : expr → bool)
  (relevant : name_map ℕ) (reorder : name_map $ list ℕ) : expr → expr
| e := e.replace $ λ e _,
  match e with
  | const n ls := some $ const (f n) $
      -- if the first two arguments are reordered, we also reorder the first two universe parameters
      if 1 ∈ (reorder.find n).iget then ls.inth 1::ls.head::ls.drop 2 else ls
  | app g x :=
    let f := g.get_app_fn,
        nm := f.const_name,
        n_args := g.get_app_num_args in -- this might be inefficient
    if n_args ∈ (reorder.find nm).iget ∧ test g.get_app_args.head then
    -- interchange `x` and the last argument of `g`
    some $ apply_replacement_fun g.app_fn (apply_replacement_fun x) $
      apply_replacement_fun g.app_arg else
    if n_args = (relevant.find nm).lhoare 0 ∧ f.is_constant ∧ ¬ test x then
      some $ (f.mk_app $ g.get_app_args.map apply_replacement_fun) (apply_replacement_fun x) else
      none
  | _ := none
  end

end expr

/-! ### Declarations about `environment` -/

namespace environment

/-- Tests whether `n` is a structure. -/
meta def is_structure (env : environment) (n : name) : bool :=
(env.structure_fields n).is_some

/-- Get the full names of all projections of the structure `n`. Returns `none` if `n` is not a
  structure. -/
meta def structure_fields_full (env : environment) (n : name) : option (list name) :=
(env.structure_fields n).map (list.map $ λ n', n ++ n')

/-- Tests whether `nm` is a generalized inductive type that is not a normal inductive type.
  Note that `is_ginductive` returns `tt` even on regular inductive types.
  This returns `tt` if `nm` is (part of a) mutually defined inductive type or a nested inductive
  type. -/
meta def is_ginductive' (e : environment) (nm : name) : bool :=
e.is_ginductive nm ∧ ¬ e.is_inductive nm

/-- For all declarations `d` where `f d = some x` this adds `x` to the returned list.  -/
meta def decl_filter_map {α : Type} (e : environment) (f : declaration → option α) : list α :=
  e.fold [] $ λ d l, match f d with
                     | some r := r :: l
                     | none := l
                     end

/-- Maps `f` to all declarations in the environment. -/
meta def decl_map {α : Type} (e : environment) (f : declaration → α) : list α :=
  e.decl_filter_map $ λ d, some (f d)

/-- Lists all declarations in the environment -/
meta def get_decls (e : environment) : list declaration :=
  e.decl_map id

/-- Lists all trusted (non-meta) declarations in the environment -/
meta def get_trusted_decls (e : environment) : list declaration :=
  e.decl_filter_map (λ d, if d.is_trusted then some d else none)

/-- Lists the name of all declarations in the environment -/
meta def get_decl_names (e : environment) : list name :=
  e.decl_map declaration.to_name

/-- Fold a monad over all declarations in the environment. -/
meta def mfold {α : Type} {m : Type → Type} [monad m] (e : environment) (x : α)
  (fn : declaration → α → m α) : m α :=
e.fold (return x) (λ d t, t >>= fn d)

/-- Filters all declarations in the environment. -/
meta def filter (e : environment) (test : declaration → bool) : list declaration :=
e.fold [] $ λ d ds, if test d then d::ds else ds

/-- Filters all declarations in the environment. -/
meta def mfilter (e : environment) (test : declaration → tactic bool) : tactic (list declaration) :=
e.mfold [] $ λ d ds, do b ← test d, return $ if b then d::ds else ds

/-- Checks whether `s` is a prefix of the file where `n` is declared.
  This is used to check whether `n` is declared in mathlib, where `s` is the mathlib directory. -/
meta def is_prefix_of_file (e : environment) (s : string) (n : name) : bool :=
s.is_prefix_of $ (e.decl_olean n).get_or_else ""

end environment

/-!
### `is_eta_expansion`

 In this section we define the tactic `is_eta_expansion` which checks whether an expression
  is an eta-expansion of a structure. (not to be confused with eta-expanion for `λ`).

-/

namespace expr

/-- `is_eta_expansion_of args univs l` checks whether for all elements `(nm, pr)` in `l` we have
  `pr = nm.{univs} args`.
  Used in `is_eta_expansion`, where `l` consists of the projections and the fields of the value we
  want to eta-reduce. -/
meta def is_eta_expansion_of (args : list expr) (univs : list level) (l : list (name × expr)) :
  bool :=
l.all $ λ⟨proj, val⟩, val = (const proj univs).mk_app args

/-- `is_eta_expansion_test l` checks whether there is a list of expresions `args` such that for all
  elements `(nm, pr)` in `l` we have `pr = nm args`. If so, returns the last element of `args`.
  Used in `is_eta_expansion`, where `l` consists of the projections and the fields of the value we
  want to eta-reduce. -/
meta def is_eta_expansion_test : list (name × expr) → option expr
| []              := none
| (⟨proj, val⟩::l) :=
  match val.get_app_fn with
  | (const nm univs : expr) :=
    if nm = proj then
      let args := val.get_app_args in
      let e := args.ilast in
      if is_eta_expansion_of args univs l then some e else none
    else
      none
  | _                       := none
  end

/-- `is_eta_expansion_aux val l` checks whether `val` can be eta-reduced to an expression `e`.
  Here `l` is intended to consists of the projections and the fields of `val`.
  This tactic calls `is_eta_expansion_test l`, but first removes all proofs from the list `l` and
  afterward checks whether the resulting expression `e` unifies with `val`.
  This last check is necessary, because `val` and `e` might have different types. -/
meta def is_eta_expansion_aux (val : expr) (l : list (name × expr)) : tactic (option expr) :=
do l' ← l.mfilter (λ⟨proj, val⟩, bnot <$> is_proof val),
  match is_eta_expansion_test l' with
  | some e := option.map (λ _, e) <$> try_core (unify e val)
  | none   := return none
  end

/-- `is_eta_expansion val` checks whether there is an expression `e` such that `val` is the
  eta-expansion of `e`.
  With eta-expansion we here mean the eta-expansion of a structure, not of a function.
  For example, the eta-expansion of `x : α × β` is `⟨x.1, x.2⟩`.
  This assumes that `val` is a fully-applied application of the constructor of a structure.

  This is useful to reduce expressions generated by the notation
    `{ field_1 := _, ..other_structure }`
  If `other_structure` is itself a field of the structure, then the elaborator will insert an
  eta-expanded version of `other_structure`. -/
meta def is_eta_expansion (val : expr) : tactic (option expr) := do
  e ← get_env,
  type ← infer_type val,
  projs ← e.structure_fields_full type.get_app_fn.const_name,
  let args := (val.get_app_args).drop type.get_app_args.length,
  is_eta_expansion_aux val (projs.zip args)

end expr

/-! ### Declarations about `declaration` -/

namespace declaration

/--
`declaration.update_with_fun f test tgt decl`
sets the name of the given `decl : declaration` to `tgt`, and applies both `expr.eta_expand` and
`expr.apply_replacement_fun` to the value and type of `decl`.
-/
protected meta def update_with_fun (env : environment) (f : name → name) (test : expr → bool)
  (relevant : name_map ℕ) (reorder : name_map $ list ℕ) (tgt : name) (decl : declaration) :
  declaration :=
let decl := decl.update_name $ tgt in
let decl := decl.update_type $
  (decl.type.eta_expand env reorder).apply_replacement_fun f test relevant reorder in
decl.update_value $
  (decl.value.eta_expand env reorder).apply_replacement_fun f test relevant reorder

/-- Checks whether the declaration is declared in the current file.
  This is a simple wrapper around `environment.in_current_file`
  Use `environment.in_current_file` instead if performance matters. -/
meta def in_current_file (d : declaration) : tactic bool :=
do e ← get_env, return $ e.in_current_file d.to_name

/-- Checks whether a declaration is a theorem -/
meta def is_theorem : declaration → bool
| (thm _ _ _ _) := tt
| _             := ff

/-- Checks whether a declaration is a constant -/
meta def is_constant : declaration → bool
| (cnst _ _ _ _) := tt
| _              := ff

/-- Checks whether a declaration is a axiom -/
meta def is_axiom : declaration → bool
| (ax _ _ _) := tt
| _          := ff

/-- Checks whether a declaration is automatically generated in the environment.
  There is no cheap way to check whether a declaration in the namespace of a generalized
  inductive type is automatically generated, so for now we say that all of them are automatically
  generated. -/
meta def is_auto_generated (e : environment) (d : declaration) : bool :=
e.is_constructor d.to_name ∨
(e.is_projection d.to_name).is_some ∨
(e.is_constructor d.to_name.get_prefix ∧
  d.to_name.last ∈ ["inj", "inj_eq", "sizeof_spec", "inj_arrow"]) ∨
(e.is_inductive d.to_name.get_prefix ∧
  d.to_name.last ∈ ["below", "binduction_on", "brec_on", "cases_on", "dcases_on", "drec_on", "drec",
  "rec", "rec_on", "no_confusion", "no_confusion_type", "sizeof", "ibelow", "has_sizeof_inst"]) ∨
d.to_name.has_prefix (λ nm, e.is_ginductive' nm)

/--
Returns true iff `d` is an automatically-generated or internal declaration.
-/
meta def is_auto_or_internal (env : environment) (d : declaration) : bool :=
d.to_name.is_internal || d.is_auto_generated env

/-- Returns the list of universe levels of a declaration. -/
meta def univ_levels (d : declaration) : list level :=
d.univ_params.map level.param

/-- Returns the `reducibility_hints` field of a `defn`, and `reducibility_hints.opaque` otherwise -/
protected meta def reducibility_hints : declaration → reducibility_hints
| (declaration.defn _ _ _ _ red _) := red
| _ := _root_.reducibility_hints.opaque

/-- formats the arguments of a `declaration.thm` -/
private meta def print_thm (nm : name) (tp : expr) (body : task expr) : tactic format :=
do tp ← pp tp, body ← pp body.get,
   return $ "<theorem " ++ to_fmt nm ++ " : " ++ tp ++ " := " ++ body ++ ">"

/-- formats the arguments of a `declaration.defn` -/
private meta def print_defn (nm : name) (tp : expr) (body : expr) (is_trusted : bool) :
  tactic format :=
do tp ← pp tp, body ← pp body,
   return $ "<" ++ (if is_trusted then "def " else "meta def ") ++ to_fmt nm ++ " : " ++ tp ++
     " := " ++ body ++ ">"

/-- formats the arguments of a `declaration.cnst` -/
private meta def print_cnst (nm : name) (tp : expr) (is_trusted : bool) : tactic format :=
do tp ← pp tp,
   return $ "<" ++ (if is_trusted then "constant " else "meta constant ") ++ to_fmt nm ++ " : "
     ++ tp ++ ">"

/-- formats the arguments of a `declaration.ax` -/
private meta def print_ax (nm : name) (tp : expr) : tactic format :=
do tp ← pp tp,
   return $ "<axiom " ++ to_fmt nm ++ " : " ++ tp ++ ">"

/-- pretty-prints a `declaration` object. -/
meta def to_tactic_format : declaration → tactic format
| (declaration.thm nm _ tp bd) := print_thm nm tp bd
| (declaration.defn nm _ tp bd _ is_trusted) := print_defn nm tp bd is_trusted
| (declaration.cnst nm _ tp is_trusted) := print_cnst nm tp is_trusted
| (declaration.ax nm _ tp) := print_ax nm tp

meta instance : has_to_tactic_format declaration :=
⟨to_tactic_format⟩

end declaration

meta instance pexpr.decidable_eq {elab} : decidable_eq (expr elab) :=
unchecked_cast
expr.has_decidable_eq


import fo.basic
import tactic

open signature

def signature.substitution.domain {σ : signature} (ν : σ.substitution) :=
  subtype {v : σ.var | ν v ≠ (term.var v)}

@[simp]
def signature.substitution.is_ground {σ : signature} (ν : σ.substitution) :=
  ∀ v, (ν v).is_ground

def signature.ground_substitution (σ : signature) : Type :=
  subtype {ν : σ.substitution | ν.is_ground}

def signature.variable_renaming (σ : signature) (r : σ.var → σ.var) (h : function.bijective r) : σ.substitution :=
  (λ v, term.var (r v))

def signature.substitution.free {σ : signature} : σ.substitution → σ.var → σ.substitution :=
  (λ ν v v',
      if (v = v') then
        term.var v
      else
        (ν v)
  )

@[reducible]
def signature.term.substitute {σ : signature} : σ.term → σ.substitution → σ.term
  | (term.var v) ν := (ν v)
  | (term.func f ts) ν := term.func f (λ i, (ts i).substitute ν)

@[reducible]
instance signature.subst_term {σ : signature} : σ.substitutable σ.term :=
  {substitute := signature.term.substitute}

@[reducible]
def signature.substitution.substitute {σ : signature} (ρ ν : σ.substitution) : σ.substitution :=
  (λ v : σ.var, (ρ v) ↓ ν)

@[reducible]
instance signature.subst_substitution {σ : signature} : σ.substitutable σ.substitution :=
  {
    substitute := signature.substitution.substitute
  }

@[reducible]
def signature.var.occurrs {σ : signature} : σ.var → σ.term → Prop
  | v (term.var v') := v = v'
  | v (term.func f ts) := ∃ i, v.occurrs (ts i)

def signature.var.is_bound {σ : signature} (v : σ.var) (φ : σ.formula) : Prop :=
  ¬φ.is_free v

@[simp]
def signature.formula.substitute {σ : signature} : σ.formula → σ.substitution → σ.formula
  | (formula.neg φ) ν := φ.substitute ν
  | (formula.conj hn Φ) ν := formula.conj hn (λ i, (Φ i).substitute ν)
  | (formula.disj hn Φ) ν := formula.disj hn (λ i, (Φ i).substitute ν)
  | (formula.fall x φ) ν := formula.fall x (φ.substitute (ν.free x))
  | (formula.xist x φ) ν := formula.xist x (φ.substitute (ν.free x))
  | (formula.rel r ts) ν := formula.rel r (λ i, (ts i).substitute ν)
  | φ ν := φ

@[reducible]
instance signature.sub_formula {σ : signature} : σ.substitutable σ.formula :=
  {
    substitute := signature.formula.substitute
  }

def signature.term.contains {σ : signature} : σ.term → σ.var → Prop
  | (term.var v') v := v' = v
  | (term.func f ts) v := ∃ i, (ts i).contains v

@[reducible]
def signature.formula.contains {σ : signature} : σ.formula → σ.var → Prop
  | (formula.neg φ) v := φ.contains v
  | (formula.conj hn Φ) v := ∃ i, (Φ i).contains v
  | (formula.disj hn Φ) v := ∃ i, (Φ i).contains v
  | (formula.fall x φ) v := φ.contains v
  | (formula.xist x φ) v := φ.contains v
  | (formula.rel r ts) v := (∃ i, v.occurrs (ts i))
  | φ v := false

@[reducible]
def signature.substitution.is_free {σ : signature} : σ.substitution → σ.formula → Prop
  | ν (formula.neg φ) := ν.is_free φ
  | ν (formula.conj hn Φ) := ∀ i, ν.is_free (Φ i)
  | ν (formula.disj hn Φ) := ∀ i, ν.is_free (Φ i)
  | ν (formula.fall x φ) := (∀ v : σ.var, (φ.contains v → φ.is_free v → ¬(ν v).contains x)) ∧ ν.is_free φ
  | ν (formula.xist x φ) := (∀ v : σ.var, (φ.contains v → φ.is_free v → ¬(ν v).contains x)) ∧ ν.is_free φ
  | ν φ := true

@[reducible]
def signature.substitution.is_free1 {σ : signature} (ν : σ.substitution) (φ : σ.formula) : Prop :=
  ∀ (v : σ.var), (φ.is_free v) → ∀ (v' : σ.var), v'.occurrs (ν v) → φ.is_free v'

def signature.substitution.compose {σ : signature} (ν₁ : σ.substitution) (ν₂ : σ.substitution) : σ.substitution :=
  (λ v, (ν₁ v).substitute ν₂)

def signature.substitution.id {σ : signature} : σ.substitution :=
  (λ v, term.var v)

def signature.id_subst (σ : signature) : σ.substitution :=
  (λ v : σ.var, term.var v)

def subid {σ : signature} : σ.substitution :=
  (λ v : σ.var, term.var v)

lemma signature.term.term_eq_term_subst_id {σ : signature} : ∀ t : σ.term, t ↓ σ.id_subst = t :=
  begin
    intro t,
    induction t with v f ts,
    simp,
    refl,
    simp [signature.term.substitute],
    dsimp at t_ih,
    ext i,
    exact (t_ih i),
  end

def signature.term.more_general {σ : signature} (t₁ t₂ : σ.term) : Prop :=
  ∃ (ν : σ.substitution), t₁ ↓ ν = t₂

section more_general_preorder

  variable σ : signature
  variable t : σ.term
  variable ν₁ : σ.substitution
  variable ν₂ : σ.substitution

  lemma signature.compose_sub : ((t ↓ ν₁) ↓ ν₂) = t ↓ (ν₁ ↓ ν₂) :=
    begin
      induction t with v f ts ih,
      simp,
      dsimp at ih,
      simp [signature.term.substitute],
      ext i,
      exact ih i,
    end

  lemma refl_more_general : (reflexive (@signature.term.more_general σ)) :=
    begin
      intro t,
      existsi signature.substitution.id,
      exact signature.term.term_eq_term_subst_id t,
    end

  lemma trans_more_general : (transitive (@signature.term.more_general σ)) :=
    begin
      intros x y z hxy hyz,
      cases hxy with νx hνx,
      cases hyz with νy hνy,
      rw [← hνy, ← hνx],
      use (νx ↓ νy),
      rw signature.compose_sub,
    end

end more_general_preorder

section

  variable σ : signature
  variable t : σ.term
  variable φ : σ.formula
  variable ν₁ : σ.substitution
  variable ν₂ : σ.substitution

  lemma signature.compose_free (h : ν₁.is_free φ) : ∀ v, (φ ↓ (ν₁.free v ↓ ν₂.free v)) = (φ ↓ (ν₁ ↓ ν₂).free v) :=
    begin
      sorry,
    end

  lemma signature.sub_free_eq_imp_sub_eq (h : ν₁.is_free φ) : ∀ v, (φ ↓ ν₁) ↓ ν₂ = φ ↓ (ν₁ ↓ ν₂) → (φ ↓ ν₁.free v ↓ ν₂.free v) = (φ ↓ (ν₁.free v ↓ ν₂.free v)) :=
    begin
      intro v,
      intro h',
      induction φ,
      simp,
      simp,
      simp,
      {
        exact (φ_ih h) h',
      },
      {
        simp [signature.formula.substitute],
        ext j,
        simp [signature.substitution.is_free] at h,
        simp at h',
        dsimp at φ_ih,
        exact φ_ih i (h j) (h' j),
      }
      sorry,
      sorry,
      sorry,
      sorry,
      sorry,
      sorry,
    end

  theorem signature.compose_sub_formula1 (h : ν₁.is_free φ) : (φ ↓ ν₁) ↓ ν₂ = φ ↓ (ν₁ ↓ ν₂) :=
    begin
      induction φ,
      refl,refl,
      {
        simp [signature.formula.substitute],
        exact φ_ih h,
      },
      {
        simp [signature.formula.substitute],
        ext i,
        dsimp at *,
        have h' := φ_ih i,
        simp [signature.substitution.is_free] at h,
        exact h' (h i),
      },
      {
        simp [signature.formula.substitute],
        ext i,
        dsimp at *,
        have h' := φ_ih i,
        simp [signature.substitution.is_free] at h,
        exact h' (h i),
      },
      {
        simp [signature.formula.substitute],
        simp [signature.substitution.is_free] at h,
        have h' := signature.compose_free σ φ_f ν₁ ν₂ (h.right) φ_v,
        simp [signature.formula.substitute] at h',
        rw ← h',
        apply signature.sub_free_eq_imp_sub_eq,
        exact h.right,
        exact φ_ih h.right,
      },
      {
        simp [signature.formula.substitute],
        simp [signature.substitution.is_free] at h,
        have h' := signature.compose_free σ φ_f ν₁ ν₂ (h.right) φ_v,
        simp [signature.formula.substitute] at h',
        rw ← h',
        apply signature.sub_free_eq_imp_sub_eq,
        exact h.right,
        exact φ_ih h.right,
      },
      {
        simp [signature.formula.substitute],
        ext i,
        exact signature.compose_sub σ (φ_ts i) _ _,
      },
    end

end

def signature.term.equivalent {σ : signature} (t₁ t₂ : σ.term) : Prop :=
  t₁.more_general t₂ ∧ t₂.more_general t₁

lemma signature.term.refl_equivalent {σ : signature} : reflexive (@signature.term.equivalent σ) :=
  begin
    intro t,
    use σ.id_subst,
    rw signature.term.term_eq_term_subst_id,
    use σ.id_subst,
    rw signature.term.term_eq_term_subst_id,
  end

lemma signature.term.trans_equivalent {σ : signature} : transitive (@signature.term.equivalent σ) :=
  begin
    intros x y z hxy hyz,
    split,
    {
      cases hxy.left with νxy h₁,
      cases hyz.left with νyz h₂,
      use (νxy ↓ νyz),
      rw ← signature.compose_sub,
      rw [h₁, h₂],
    },
    {
      cases hxy.right with νxy h₁,
      cases hyz.right with νyz h₂,
      use (νyz ↓ νxy),
      rw ← signature.compose_sub,
      rw [h₂, h₁],
    }
  end

lemma signature.term.symm_equivalent {σ : signature} : symmetric (@signature.term.equivalent σ) :=
  begin
    intros x y hxy,
    split,
    exact hxy.right,
    exact hxy.left,
  end

lemma signature.term.equiv_equivalent {σ : signature} : equivalence (@signature.term.equivalent σ) :=
  begin
    split,
    exact signature.term.refl_equivalent,
    split,
    exact signature.term.symm_equivalent,
    exact signature.term.trans_equivalent,
  end

instance signature.equiv_setoid (σ : signature) : setoid σ.term :=
  {
    r := signature.term.equivalent,
    iseqv := signature.term.equiv_equivalent,
  }

@[reducible]
def signature.term_equiv (σ : signature) := quotient σ.equiv_setoid

example (σ : signature) (t : σ.term) : ⟦t⟧ = quotient.mk t :=
  begin
    refl,
  end

lemma signature.term.substitution_is_well_defined {σ : signature} (ν : σ.substitution) (t₁ t₂ : σ.term)  (h : t₁ ≈ t₂) : ⟦t₁ ↓ ν⟧ = ⟦t₂ ↓ ν⟧ :=
  begin
    apply quotient.sound,
    cases h,
    split,
    cases h_left with ν_left hν_left,
    cases h_right with ν_right hν_right,
    sorry, sorry,
  end

def signature.term_equiv.substitute {σ : signature} (ν : σ.substitution) : σ.term_equiv → σ.term_equiv :=
  quotient.lift (λ (t : σ.term) , ⟦t ↓ ν⟧) (signature.term.substitution_is_well_defined ν)

@[reducible]
instance signature.subst_term_equiv (σ : signature) : σ.substitutable σ.term_equiv :=
  {
    substitute := (λ t ν, signature.term_equiv.substitute ν t)
  }


inductive AltCore (α : Type)
  | default (val : α)
  | alt (name : String) (val : α)

inductive Code where
  | cases (alt: AltCore Code)
  | return (id : Nat)

abbrev Alt := AltCore Code

def AltCore.getCode : Alt → Code
  | .default c => c
  | .alt _ c => c

def AltCore.update (alt : Alt) (c : Code) : Alt :=
  match alt with
  | .default _ => if true then alt else .default c
  | .alt n _ => if true then alt else .alt n c

example (alt : Alt) : Code :=
  alt.getCode

def Alt.getCode' : Alt → Code
  | .default c => c
  | .alt _ c => c

example (alt : Alt) : Code :=
  if true then .return 1 else alt.getCode'

example (alt : Alt) : Code :=
  if true then alt.getCode' else .return 0


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.fin
import Mathlib.category_theory.concrete_category.bundled
import Mathlib.category_theory.concrete_category.default
import Mathlib.category_theory.full_subcategory
import Mathlib.category_theory.skeletal
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# The category of finite types.

We define the category of finite types, denoted `Fintype` as
(bundled) types with a `fintype` instance.

We also define `Fintype.skeleton`, the standard skeleton of `Fintype` whose objects are `fin n`
for `n : ℕ`. We prove that the obvious inclusion functor `Fintype.skeleton ⥤ Fintype` is an
equivalence of categories in `Fintype.skeleton.equivalence`.
We prove that `Fintype.skeleton` is a skeleton of `Fintype` in `Fintype.is_skeleton`.
-/

/-- The category of finite types. -/
def Fintype := category_theory.bundled fintype

namespace Fintype

/-- Construct a bundled `Fintype` from the underlying type and typeclass. -/
def of (X : Type u_1) [fintype X] : Fintype := category_theory.bundled.of X

protected instance inhabited : Inhabited Fintype := { default := category_theory.bundled.mk pempty }

protected instance fintype {X : Fintype} : fintype ↥X := category_theory.bundled.str X

protected instance category_theory.category : category_theory.category Fintype :=
  category_theory.induced_category.category category_theory.bundled.α

/-- The fully faithful embedding of `Fintype` into the category of types. -/
@[simp] theorem incl_map (x : category_theory.induced_category (Type u_1) category_theory.bundled.α)
    (y : category_theory.induced_category (Type u_1) category_theory.bundled.α) (f : x ⟶ y) :
    ∀ (ᾰ : category_theory.bundled.α x), category_theory.functor.map incl f ᾰ = f ᾰ :=
  fun (ᾰ : category_theory.bundled.α x) => Eq.refl (f ᾰ)

protected instance category_theory.concrete_category : category_theory.concrete_category Fintype :=
  category_theory.concrete_category.mk incl

/--
The "standard" skeleton for `Fintype`. This is the full subcategory of `Fintype` spanned by objects
of the form `fin n` for `n : ℕ`. We parameterize the objects of `Fintype.skeleton` directly as `ℕ`,
as the type `fin m ≃ fin n` is nonempty if and only if `n = m`.
-/
def skeleton := ℕ

namespace skeleton

/-- Given any natural number `n`, this creates the associated object of `Fintype.skeleton`. -/
def mk : ℕ → skeleton := id

protected instance inhabited : Inhabited skeleton := { default := mk 0 }

/-- Given any object of `Fintype.skeleton`, this returns the associated natural number. -/
def to_nat : skeleton → ℕ := id

protected instance category_theory.category : category_theory.category skeleton :=
  category_theory.category.mk

theorem is_skeletal : category_theory.skeletal skeleton := sorry

/-- The canonical fully faithful embedding of `Fintype.skeleton` into `Fintype`. -/
def incl : skeleton ⥤ Fintype :=
  category_theory.functor.mk (fun (X : skeleton) => of (fin X))
    fun (_x _x_1 : skeleton) (f : _x ⟶ _x_1) => f

protected instance incl.category_theory.full : category_theory.full incl :=
  category_theory.full.mk
    fun (_x _x_1 : skeleton)
      (f : category_theory.functor.obj incl _x ⟶ category_theory.functor.obj incl _x_1) => f

protected instance incl.category_theory.faithful : category_theory.faithful incl :=
  category_theory.faithful.mk

protected instance incl.category_theory.ess_surj : category_theory.ess_surj incl :=
  category_theory.ess_surj.mk
    fun (X : Fintype) =>
      let F : ↥X ≃ fin (fintype.card ↥X) := trunc.out (fintype.equiv_fin ↥X);
      Exists.intro (fintype.card ↥X) (Nonempty.intro (category_theory.iso.mk ⇑(equiv.symm F) ⇑F))

protected instance incl.category_theory.is_equivalence : category_theory.is_equivalence incl :=
  category_theory.equivalence.equivalence_of_fully_faithfully_ess_surj incl

/-- The equivalence between `Fintype.skeleton` and `Fintype`. -/
def equivalence : skeleton ≌ Fintype := category_theory.functor.as_equivalence incl

@[simp] theorem incl_mk_nat_card (n : ℕ) :
    fintype.card ↥(category_theory.functor.obj incl (mk n)) = n :=
  finset.card_fin n

end skeleton

/-- `Fintype.skeleton` is a skeleton of `Fintype`. -/
def is_skeleton : category_theory.is_skeleton_of Fintype skeleton skeleton.incl :=
  category_theory.is_skeleton_of.mk skeleton.is_skeletal
    skeleton.incl.category_theory.is_equivalence

end Mathlib


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

! This file was ported from Lean 3 source module init.meta.simp_tactic
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! 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.Attribute
import Leanbin.Init.Meta.ConstructorTactic
import Leanbin.Init.Meta.RelationTactics
import Leanbin.Init.Meta.Occurrences
import Leanbin.Init.Data.Option.Basic

open Tactic

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

def Simp.defaultMaxSteps :=
  10000000
#align simp.default_max_steps Simp.defaultMaxSteps

/-- Prefix the given `attr_name` with `"simp_attr"`. -/
unsafe axiom mk_simp_attr_decl_name (attr_name : Name) : Name
#align mk_simp_attr_decl_name mk_simp_attr_decl_name

/-- Simp lemmas are used by the "simplifier" family of tactics.
`simp_lemmas` is essentially a pair of tables `rb_map (expr_type × name) (priority_list simp_lemma)`.
One of the tables is for congruences and one is for everything else.
An individual simp lemma is:
- A kind which can be `Refl`, `Simp` or `Congr`.
- A pair of `expr`s `l ~> r`. The rb map is indexed by the name of `get_app_fn(l)`.
- A proof that `l = r` or `l ↔ r`.
- A list of the metavariables that must be filled before the proof can be applied.
- A priority number
-/
unsafe axiom simp_lemmas : Type
#align simp_lemmas simp_lemmas

/-- Make a new table of simp lemmas -/
unsafe axiom simp_lemmas.mk : simp_lemmas
#align simp_lemmas.mk simp_lemmas.mk

/-- Merge the simp_lemma tables. -/
unsafe axiom simp_lemmas.join : simp_lemmas → simp_lemmas → simp_lemmas
#align simp_lemmas.join simp_lemmas.join

/-- Remove the given lemmas from the table. Use the names of the lemmas. -/
unsafe axiom simp_lemmas.erase : simp_lemmas → List Name → simp_lemmas
#align simp_lemmas.erase simp_lemmas.erase

/-- Remove all simp lemmas from the table. -/
unsafe axiom simp_lemmas.erase_simp_lemmas : simp_lemmas → simp_lemmas
#align simp_lemmas.erase_simp_lemmas simp_lemmas.erase_simp_lemmas

/-- Makes the default simp_lemmas table which is composed of all lemmas tagged with `simp`. -/
unsafe axiom simp_lemmas.mk_default : tactic simp_lemmas
#align simp_lemmas.mk_default simp_lemmas.mk_default

/--
Add a simplification lemma by an expression `p`. Some conditions on `p` must hold for it to be added, see list below.
If your lemma is not being added, you can see the reasons by setting `set_option trace.simp_lemmas true`.

- `p` must have the type `Π (h₁ : _) ... (hₙ : _), LHS ~ RHS` for some reflexive, transitive relation (usually `=`).
- Any of the hypotheses `hᵢ` should either be present in `LHS` or otherwise a `Prop` or a typeclass instance.
- `LHS` should not occur within `RHS`.
- `LHS` should not occur within a hypothesis `hᵢ`.

 -/
unsafe axiom simp_lemmas.add (s : simp_lemmas) (e : expr) (symm : Bool := False) :
    tactic simp_lemmas
#align simp_lemmas.add simp_lemmas.add

/--
Add a simplification lemma by it's declaration name. See `simp_lemmas.add` for more information.-/
unsafe axiom simp_lemmas.add_simp (s : simp_lemmas) (id : Name) (symm : Bool := False) :
    tactic simp_lemmas
#align simp_lemmas.add_simp simp_lemmas.add_simp

/-- Adds a congruence simp lemma to simp_lemmas.
A congruence simp lemma is a lemma that breaks the simplification down into separate problems.
For example, to simplify `a ∧ b` to `c ∧ d`, we should try to simp `a` to `c` and `b` to `d`.
For examples of congruence simp lemmas look for lemmas with the `@[congr]` attribute.
```lean
lemma if_simp_congr ... (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) : ite b x y = ite c u v := ...
lemma imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) := ...
lemma and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∧ b) ↔ (c ∧ d) := ...
```
-/
unsafe axiom simp_lemmas.add_congr : simp_lemmas → Name → tactic simp_lemmas
#align simp_lemmas.add_congr simp_lemmas.add_congr

/-- Add expressions to a set of simp lemmas using `simp_lemmas.add`.

  This is the new version of `simp_lemmas.append`,
  which also allows you to set the `symm` flag.
-/
unsafe def simp_lemmas.append_with_symm (s : simp_lemmas) (hs : List (expr × Bool)) :
    tactic simp_lemmas :=
  hs.foldlM (fun s h => simp_lemmas.add s h.fst h.snd) s
#align simp_lemmas.append_with_symm simp_lemmas.append_with_symm

/-- Add expressions to a set of simp lemmas using `simp_lemmas.add`.

  This is the backwards-compatibility version of `simp_lemmas.append_with_symm`,
  and sets all `symm` flags to `ff`.
-/
unsafe def simp_lemmas.append (s : simp_lemmas) (hs : List expr) : tactic simp_lemmas :=
  hs.foldlM (fun s h => simp_lemmas.add s h false) s
#align simp_lemmas.append simp_lemmas.append

/-- `simp_lemmas.rewrite s e prove R` apply a simplification lemma from 's'

   - 'e'     is the expression to be "simplified"
   - 'prove' is used to discharge proof obligations.
   - 'r'     is the equivalence relation being used (e.g., 'eq', 'iff')
   - 'md'    is the transparency; how aggresively should the simplifier perform reductions.

   Result (new_e, pr) is the new expression 'new_e' and a proof (pr : e R new_e) -/
unsafe axiom simp_lemmas.rewrite (s : simp_lemmas) (e : expr) (prove : tactic Unit := failed)
    (r : Name := `eq) (md := reducible) : tactic (expr × expr)
#align simp_lemmas.rewrite simp_lemmas.rewrite

unsafe axiom simp_lemmas.rewrites (s : simp_lemmas) (e : expr) (prove : tactic Unit := failed)
    (r : Name := `eq) (md := reducible) : tactic <| List (expr × expr)
#align simp_lemmas.rewrites simp_lemmas.rewrites

/-- `simp_lemmas.drewrite s e` tries to rewrite 'e' using only refl lemmas in 's' -/
unsafe axiom simp_lemmas.drewrite (s : simp_lemmas) (e : expr) (md := reducible) : tactic expr
#align simp_lemmas.drewrite simp_lemmas.drewrite

unsafe axiom is_valid_simp_lemma_cnst : Name → tactic Bool
#align is_valid_simp_lemma_cnst is_valid_simp_lemma_cnst

unsafe axiom is_valid_simp_lemma : expr → tactic Bool
#align is_valid_simp_lemma is_valid_simp_lemma

unsafe axiom simp_lemmas.pp : simp_lemmas → tactic format
#align simp_lemmas.pp simp_lemmas.pp

unsafe instance : has_to_tactic_format simp_lemmas :=
  ⟨simp_lemmas.pp⟩

namespace Tactic

-- Remark: `transform` should not change the target.
/-- Revert a local constant, change its type using `transform`.  -/
unsafe def revert_and_transform (transform : expr → tactic expr) (h : expr) : tactic Unit := do
  let num_reverted : ℕ ← revert h
  let t ← target
  match t with
    | expr.pi n bi d b => do
      let h_simp ← transform d
      unsafe_change <| expr.pi n bi h_simp b
    | expr.elet n g e f => do
      let h_simp ← transform g
      unsafe_change <| expr.elet n h_simp e f
    | _ => fail "reverting hypothesis created neither a pi nor an elet expr (unreachable?)"
  intron num_reverted
#align tactic.revert_and_transform tactic.revert_and_transform

/--
`get_eqn_lemmas_for deps d` returns the automatically generated equational lemmas for definition d.
   If deps is tt, then lemmas for automatically generated auxiliary declarations used to define d are also included. -/
unsafe def get_eqn_lemmas_for (deps : Bool) (d : Name) : tactic (List Name) := do
  let env ← get_env
  pure <| if deps then env d else env d
#align tactic.get_eqn_lemmas_for tactic.get_eqn_lemmas_for

structure DsimpConfig where
  md := reducible
  -- reduction mode: how aggressively constants are replaced with their definitions.
  maxSteps : Nat := Simp.defaultMaxSteps
  -- The maximum number of steps allowed before failing.
  canonizeInstances : Bool := true
  -- See the documentation in `src/library/defeq_canonizer.h`
  singlePass : Bool := false
  -- Visit each subterm no more than once.
  failIfUnchanged := true
  -- Don't throw if dsimp didn't do anything.
  eta := true
  -- allow eta-equivalence: `(λ x, F $ x) ↝ F`
  zeta : Bool := true
  -- do zeta-reductions: `let x : a := b in c ↝ c[x/b]`.
  beta : Bool := true
  -- do beta-reductions: `(λ x, E) $ (y) ↝ E[x/y]`.
  proj : Bool := true
  -- reduce projections: `⟨a,b⟩.1 ↝ a`.
  iota : Bool := true
  -- reduce recursors for inductive datatypes: eg `nat.rec_on (succ n) Z R ↝ R n $ nat.rec_on n Z R`
  unfoldReducible := false
  -- if tt, definitions with `reducible` transparency will be unfolded (delta-reduced)
  memoize := true
#align tactic.dsimp_config Tactic.DsimpConfig

-- Perform caching of dsimps of subterms.
end Tactic

/--
(Definitional) Simplify the given expression using *only* reflexivity equality lemmas from the given set of lemmas.
   The resulting expression is definitionally equal to the input.

   The list `u` contains defintions to be delta-reduced, and projections to be reduced.-/
unsafe axiom simp_lemmas.dsimplify (s : simp_lemmas) (u : List Name := []) (e : expr)
    (cfg : Tactic.DsimpConfig := { }) : tactic expr
#align simp_lemmas.dsimplify simp_lemmas.dsimplify

namespace Tactic

/-- Remark: the configuration parameters `cfg.md` and `cfg.eta` are ignored by this tactic. -/
unsafe axiom dsimplify_core
    -- The user state type.
    {α : Type}
    -- Initial user data
    (a : α)
    /- (pre a e) is invoked before visiting the children of subterm 'e',
         if it succeeds the result (new_a, new_e, flag) where
           - 'new_a' is the new value for the user data
           - 'new_e' is a new expression that must be definitionally equal to 'e',
           - 'flag'  if tt 'new_e' children should be visited, and 'post' invoked. -/
    (pre : α → expr → tactic (α × expr × Bool))
    /- (post a e) is invoked after visiting the children of subterm 'e',
         The output is similar to (pre a e), but the 'flag' indicates whether
         the new expression should be revisited or not. -/
    (post : α → expr → tactic (α × expr × Bool))
    (e : expr) (cfg : DsimpConfig := { }) : tactic (α × expr)
#align tactic.dsimplify_core tactic.dsimplify_core

unsafe def dsimplify (pre : expr → tactic (expr × Bool)) (post : expr → tactic (expr × Bool)) :
    expr → tactic expr := fun e => do
  let (a, new_e) ←
    dsimplify_core ()
        (fun u e => do
          let r ← pre e
          return (u, r))
        (fun u e => do
          let r ← post e
          return (u, r))
        e
  return new_e
#align tactic.dsimplify tactic.dsimplify

unsafe def get_simp_lemmas_or_default : Option simp_lemmas → tactic simp_lemmas
  | none => simp_lemmas.mk_default
  | some s => return s
#align tactic.get_simp_lemmas_or_default tactic.get_simp_lemmas_or_default

unsafe def dsimp_target (s : Option simp_lemmas := none) (u : List Name := [])
    (cfg : DsimpConfig := { }) : tactic Unit := do
  let s ← get_simp_lemmas_or_default s
  let t ← target >>= instantiate_mvars
  s u t cfg >>= unsafe_change
#align tactic.dsimp_target tactic.dsimp_target

unsafe def dsimp_hyp (h : expr) (s : Option simp_lemmas := none) (u : List Name := [])
    (cfg : DsimpConfig := { }) : tactic Unit := do
  let s ← get_simp_lemmas_or_default s
  revert_and_transform (fun e => s u e cfg) h
#align tactic.dsimp_hyp tactic.dsimp_hyp

/- Remark: we use transparency.instances by default to make sure that we
   can unfold projections of type classes. Example:

          (@has_add.add nat nat.has_add a b)
-/
/-- Tries to unfold `e` if it is a constant or a constant application.
    Remark: this is not a recursive procedure. -/
unsafe axiom dunfold_head (e : expr) (md := Transparency.instances) : tactic expr
#align tactic.dunfold_head tactic.dunfold_head

structure DunfoldConfig extends DsimpConfig where
  md := Transparency.instances
#align tactic.dunfold_config Tactic.DunfoldConfig

/-! Remark: in principle, dunfold can be implemented on top of dsimp. We don't do it for
   performance reasons. -/

unsafe axiom dunfold (cs : List Name) (e : expr) (cfg : DunfoldConfig := { }) : tactic expr
#align tactic.dunfold tactic.dunfold

unsafe def dunfold_target (cs : List Name) (cfg : DunfoldConfig := { }) : tactic Unit := do
  let t ← target
  dunfold cs t cfg >>= unsafe_change
#align tactic.dunfold_target tactic.dunfold_target

unsafe def dunfold_hyp (cs : List Name) (h : expr) (cfg : DunfoldConfig := { }) : tactic Unit :=
  revert_and_transform (fun e => dunfold cs e cfg) h
#align tactic.dunfold_hyp tactic.dunfold_hyp

structure DeltaConfig where
  maxSteps := Simp.defaultMaxSteps
  visitInstances := true
#align tactic.delta_config Tactic.DeltaConfig

private unsafe def is_delta_target (e : expr) (cs : List Name) : Bool :=
  cs.any fun c =>
    if e.is_app_of c then true
    else-- Exact match
      let f := e.get_app_fn
      -- f is an auxiliary constant generated when compiling c
            f.is_constant &&
          f.const_name.is_internal &&
        f.const_name.getPrefix = c
#align tactic.is_delta_target tactic.is_delta_target

/-- Delta reduce the given constant names -/
unsafe def delta (cs : List Name) (e : expr) (cfg : DeltaConfig := { }) : tactic expr :=
  let unfold (u : Unit) (e : expr) : tactic (Unit × expr × Bool) := do
    guard (is_delta_target e cs)
    let expr.const f_name f_lvls ← return e.get_app_fn
    let env ← get_env
    let decl ← env.get f_name
    let new_f ← decl.instantiate_value_univ_params f_lvls
    let new_e ← head_beta (expr.mk_app new_f e.get_app_args)
    return (u, new_e, tt)
  do
  let (c, new_e) ←
    dsimplify_core () (fun c e => failed) unfold e
        { maxSteps := cfg.maxSteps
          canonizeInstances := cfg.visitInstances }
  return new_e
#align tactic.delta tactic.delta

unsafe def delta_target (cs : List Name) (cfg : DeltaConfig := { }) : tactic Unit := do
  let t ← target
  delta cs t cfg >>= unsafe_change
#align tactic.delta_target tactic.delta_target

unsafe def delta_hyp (cs : List Name) (h : expr) (cfg : DeltaConfig := { }) : tactic Unit :=
  revert_and_transform (fun e => delta cs e cfg) h
#align tactic.delta_hyp tactic.delta_hyp

structure UnfoldProjConfig extends DsimpConfig where
  md := Transparency.instances
#align tactic.unfold_proj_config Tactic.UnfoldProjConfig

/-- If `e` is a projection application, try to unfold it, otherwise fail. -/
unsafe axiom unfold_proj (e : expr) (md := Transparency.instances) : tactic expr
#align tactic.unfold_proj tactic.unfold_proj

unsafe def unfold_projs (e : expr) (cfg : UnfoldProjConfig := { }) : tactic expr :=
  let unfold (changed : Bool) (e : expr) : tactic (Bool × expr × Bool) := do
    let new_e ← unfold_proj e cfg.md
    return (tt, new_e, tt)
  do
  let (tt, new_e) ← dsimplify_core false (fun c e => failed) unfold e cfg.toDsimpConfig |
    fail "no projections to unfold"
  return new_e
#align tactic.unfold_projs tactic.unfold_projs

unsafe def unfold_projs_target (cfg : UnfoldProjConfig := { }) : tactic Unit := do
  let t ← target
  unfold_projs t cfg >>= unsafe_change
#align tactic.unfold_projs_target tactic.unfold_projs_target

unsafe def unfold_projs_hyp (h : expr) (cfg : UnfoldProjConfig := { }) : tactic Unit :=
  revert_and_transform (fun e => unfold_projs e cfg) h
#align tactic.unfold_projs_hyp tactic.unfold_projs_hyp

structure SimpConfig where
  maxSteps : Nat := Simp.defaultMaxSteps
  contextual : Bool := false
  liftEq : Bool := true
  canonizeInstances : Bool := true
  canonizeProofs : Bool := false
  useAxioms : Bool := true
  zeta : Bool := true
  beta : Bool := true
  eta : Bool := true
  proj : Bool := true
  -- reduce projections
  iota : Bool := true
  iotaEqn : Bool := false
  -- reduce using all equation lemmas generated by equation/pattern-matching compiler
  constructorEq : Bool := true
  singlePass : Bool := false
  failIfUnchanged := true
  memoize := true
  traceLemmas := false
#align tactic.simp_config Tactic.SimpConfig

/-- `simplify s e cfg r prove` simplify `e` using `s` using bottom-up traversal.
  `discharger` is a tactic for dischaging new subgoals created by the simplifier.
   If it fails, the simplifier tries to discharge the subgoal by simplifying it to `true`.

   The parameter `to_unfold` specifies definitions that should be delta-reduced,
   and projection applications that should be unfolded.
-/
unsafe axiom simplify (s : simp_lemmas) (to_unfold : List Name := []) (e : expr)
    (cfg : SimpConfig := { }) (r : Name := `eq) (discharger : tactic Unit := failed) :
    tactic (expr × expr × name_set)
#align tactic.simplify tactic.simplify

unsafe def simp_target (s : simp_lemmas) (to_unfold : List Name := []) (cfg : SimpConfig := { })
    (discharger : tactic Unit := failed) : tactic name_set := do
  let t ← target >>= instantiate_mvars
  let (new_t, pr, lms) ← simplify s to_unfold t cfg `eq discharger
  replace_target new_t pr `` id_tag.simp
  return lms
#align tactic.simp_target tactic.simp_target

unsafe def simp_hyp (s : simp_lemmas) (to_unfold : List Name := []) (h : expr)
    (cfg : SimpConfig := { }) (discharger : tactic Unit := failed) : tactic (expr × name_set) := do
  when (expr.is_local_constant h = ff)
      (fail "tactic simp_at failed, the given expression is not a hypothesis")
  let htype ← infer_type h
  let (h_new_type, pr, lms) ← simplify s to_unfold htype cfg `eq discharger
  let new_hyp ← replace_hyp h h_new_type pr `` id_tag.simp
  return (new_hyp, lms)
#align tactic.simp_hyp tactic.simp_hyp

/-- `ext_simplify_core a c s discharger pre post r e`:

- `a : α` - initial user data
- `c : simp_config` - simp configuration options
- `s : simp_lemmas` - the set of simp_lemmas to use. Remark: the simplification lemmas are not applied automatically like in the simplify tactic. The caller must use them at pre/post.
- `discharger : α → tactic α` - tactic for dischaging hypothesis in conditional rewriting rules. The argument 'α' is the current user data.
- `pre a s r p e` is invoked before visiting the children of subterm 'e'.
  + arguments:
    - `a` is the current user data
    - `s` is the updated set of lemmas if 'contextual' is `tt`,
    - `r` is the simplification relation being used,
    - `p` is the "parent" expression (if there is one).
    - `e` is the current subexpression in question.
  + if it succeeds the result is `(new_a, new_e, new_pr, flag)` where
    - `new_a` is the new value for the user data
    - `new_e` is a new expression s.t. `r e new_e`
    - `new_pr` is a proof for `r e new_e`, If it is none, the proof is assumed to be by reflexivity
    - `flag`  if tt `new_e` children should be visited, and `post` invoked.
- `(post a s r p e)` is invoked after visiting the children of subterm `e`,
  The output is similar to `(pre a r s p e)`, but the 'flag' indicates whether the new expression should be revisited or not.
- `r` is the simplification relation. Usually `=` or `↔`.
- `e` is the input expression to be simplified.

The method returns `(a,e,pr)` where

 - `a` is the final user data
 - `e` is the new expression
 - `pr` is the proof that the given expression equals the input expression.

Note that `ext_simplify_core` will succeed even if `pre` and `post` fail, as failures are used to indicate that the method should move on to the next subterm.
If it is desirable to propagate errors from `pre`, they can be propagated through the "user data".
An easy way to do this is to call `tactic.capture (do ...)` in the parts of `pre`/`post` where errors matter, and then use `tactic.unwrap a` on the result.

Additionally, `ext_simplify_core` does not propagate changes made to the tactic state by `pre` and `post.
If it is desirable to propagate changes to the tactic state in addition to errors, use `tactic.resume` instead of `tactic.unwrap`.
-/
unsafe axiom ext_simplify_core {α : Type} (a : α) (c : SimpConfig) (s : simp_lemmas)
    (discharger : α → tactic α)
    (pre : α → simp_lemmas → Name → Option expr → expr → tactic (α × expr × Option expr × Bool))
    (post : α → simp_lemmas → Name → Option expr → expr → tactic (α × expr × Option expr × Bool))
    (r : Name) : expr → tactic (α × expr × expr)
#align tactic.ext_simplify_core tactic.ext_simplify_core

private unsafe def is_equation : expr → Bool
  | expr.pi n bi d b => is_equation b
  | e =>
    match expr.is_eq e with
    | some a => true
    | none => false
#align tactic.is_equation tactic.is_equation

unsafe def collect_ctx_simps : tactic (List expr) :=
  local_context
#align tactic.collect_ctx_simps tactic.collect_ctx_simps

section SimpIntros

unsafe def intro1_aux : Bool → List Name → tactic expr
  | ff, _ => intro1
  | tt, n :: ns => intro n
  | _, _ => failed
#align tactic.intro1_aux tactic.intro1_aux

structure SimpIntrosConfig extends SimpConfig where
  useHyps := false
#align tactic.simp_intros_config Tactic.SimpIntrosConfig

unsafe def simp_intros_aux (cfg : SimpConfig) (use_hyps : Bool) (to_unfold : List Name) :
    simp_lemmas → Bool → List Name → tactic simp_lemmas
  | S, tt, [] => try (simp_target S to_unfold cfg) >> return S
  | S, use_ns, ns => do
    let t ← target
    if t `not 1 then intro1_aux use_ns ns >> simp_intros_aux S use_ns ns
      else
        if t then
          (do
              let d ← return t
              let (new_d, h_d_eq_new_d, lms) ← simplify S to_unfold d cfg
              let h_d ← intro1_aux use_ns ns
              let h_new_d ← mk_eq_mp h_d_eq_new_d h_d
              assertv_core h_d new_d h_new_d
              clear h_d
              let h_new ← intro1
              let new_S ←
                if use_hyps then condM (is_prop new_d) (S h_new ff) (return S) else return S
              simp_intros_aux new_S use_ns
                  ns) <|>-- failed to simplify... we just introduce and continue
                intro1_aux
                use_ns ns >>
              simp_intros_aux S use_ns ns
        else
          if t || t then intro1_aux use_ns ns >> simp_intros_aux S use_ns ns
          else do
            let new_t ← whnf t reducible
            if new_t then unsafe_change new_t >> simp_intros_aux S use_ns ns
              else
                try (simp_target S to_unfold cfg) >>
                  condM (expr.is_pi <$> target) (simp_intros_aux S use_ns ns)
                    (if use_ns ∧ ¬ns then failed else return S)
#align tactic.simp_intros_aux tactic.simp_intros_aux

unsafe def simp_intros (s : simp_lemmas) (to_unfold : List Name := []) (ids : List Name := [])
    (cfg : SimpIntrosConfig := { }) : tactic Unit :=
  step <| simp_intros_aux cfg.toSimpConfig cfg.useHyps to_unfold s (not ids.Empty) ids
#align tactic.simp_intros tactic.simp_intros

end SimpIntros

unsafe def mk_eq_simp_ext (simp_ext : expr → tactic (expr × expr)) : tactic Unit := do
  let (lhs, rhs) ← target >>= match_eq
  let (new_rhs, HEq) ← simp_ext lhs
  unify rhs new_rhs
  exact HEq
#align tactic.mk_eq_simp_ext tactic.mk_eq_simp_ext

/-! Simp attribute support -/

unsafe def to_simp_lemmas : simp_lemmas → List Name → tactic simp_lemmas
  | S, [] => return S
  | S, n :: ns => do
    let S' ← has_attribute `congr n >> S.add_congr n <|> S.add_simp n false
    to_simp_lemmas S' ns
#align tactic.to_simp_lemmas tactic.to_simp_lemmas

unsafe def mk_simp_attr (attr_name : Name) (attr_deps : List Name := []) : Tactic := do
  let t := q(user_attribute simp_lemmas)
  let v :=
    q(({  Name := attr_name
          descr := "simplifier attribute"
          cache_cfg :=
            { mk_cache := fun ns => do
                let s ← tactic.to_simp_lemmas simp_lemmas.mk ns
                let s ←
                  attr_deps.foldlM
                      (fun s attr_name => do
                        let ns ← attribute.get_instances attr_name
                        to_simp_lemmas s ns)
                      s
                return s
              dependencies := `reducibility :: attr_deps } } :
        user_attribute simp_lemmas))
  let n := mk_simp_attr_decl_name attr_name
  add_decl (declaration.defn n [] t v ReducibilityHints.abbrev ff)
  attribute.register n
#align tactic.mk_simp_attr tactic.mk_simp_attr

/-- ### Example usage:
```lean
-- make a new simp attribute called "my_reduction"
run_cmd mk_simp_attr `my_reduction
-- Add "my_reduction" attributes to these if-reductions
attribute [my_reduction] if_pos if_neg dif_pos dif_neg

-- will return the simp_lemmas with the `my_reduction` attribute.
#eval get_user_simp_lemmas `my_reduction

```
 -/
unsafe def get_user_simp_lemmas (attr_name : Name) : tactic simp_lemmas :=
  if attr_name = `default then simp_lemmas.mk_default
  else get_attribute_cache_dyn (mk_simp_attr_decl_name attr_name)
#align tactic.get_user_simp_lemmas tactic.get_user_simp_lemmas

unsafe def join_user_simp_lemmas_core : simp_lemmas → List Name → tactic simp_lemmas
  | S, [] => return S
  | S, attr_name :: R => do
    let S' ← get_user_simp_lemmas attr_name
    join_user_simp_lemmas_core (S S') R
#align tactic.join_user_simp_lemmas_core tactic.join_user_simp_lemmas_core

unsafe def join_user_simp_lemmas (no_dflt : Bool) (attrs : List Name) : tactic simp_lemmas := do
  let s ← simp_lemmas.mk_default
  let s := if no_dflt then s.erase_simp_lemmas else s
  join_user_simp_lemmas_core s attrs
#align tactic.join_user_simp_lemmas tactic.join_user_simp_lemmas

unsafe def simplify_top_down {α} (a : α) (pre : α → expr → tactic (α × expr × expr)) (e : expr)
    (cfg : SimpConfig := { }) : tactic (α × expr × expr) :=
  ext_simplify_core a cfg simp_lemmas.mk (fun _ => failed)
    (fun a _ _ _ e => do
      let (new_a, new_e, pr) ← pre a e
      guard ¬new_e == e
      return (new_a, new_e, some pr, tt))
    (fun _ _ _ _ _ => failed) `eq e
#align tactic.simplify_top_down tactic.simplify_top_down

unsafe def simp_top_down (pre : expr → tactic (expr × expr)) (cfg : SimpConfig := { }) :
    tactic Unit := do
  let t ← target
  let (_, new_target, pr) ←
    simplify_top_down ()
        (fun _ e => do
          let (new_e, pr) ← pre e
          return ((), new_e, pr))
        t cfg
  replace_target new_target pr `` id_tag.simp
#align tactic.simp_top_down tactic.simp_top_down

unsafe def simplify_bottom_up {α} (a : α) (post : α → expr → tactic (α × expr × expr)) (e : expr)
    (cfg : SimpConfig := { }) : tactic (α × expr × expr) :=
  ext_simplify_core a cfg simp_lemmas.mk (fun _ => failed) (fun _ _ _ _ _ => failed)
    (fun a _ _ _ e => do
      let (new_a, new_e, pr) ← post a e
      guard ¬new_e == e
      return (new_a, new_e, some pr, tt))
    `eq e
#align tactic.simplify_bottom_up tactic.simplify_bottom_up

unsafe def simp_bottom_up (post : expr → tactic (expr × expr)) (cfg : SimpConfig := { }) :
    tactic Unit := do
  let t ← target
  let (_, new_target, pr) ←
    simplify_bottom_up ()
        (fun _ e => do
          let (new_e, pr) ← post e
          return ((), new_e, pr))
        t cfg
  replace_target new_target pr `` id_tag.simp
#align tactic.simp_bottom_up tactic.simp_bottom_up

private unsafe def remove_deps (s : name_set) (h : expr) : name_set :=
  if s.Empty then s
  else h.fold s fun e o s => if e.is_local_constant then s.eraseₓ e.local_uniq_name else s
#align tactic.remove_deps tactic.remove_deps

/-- Return the list of hypothesis that are propositions and do not have
   forward dependencies. -/
unsafe def non_dep_prop_hyps : tactic (List expr) := do
  let ctx ← local_context
  let s ←
    ctx.foldlM
        (fun s h => do
          let h_type ← infer_type h
          let s := remove_deps s h_type
          let h_val ← head_zeta h
          let s := if h_val == h then s else remove_deps s h_val
          condM (is_prop h_type) (return <| s h) (return s))
        mk_name_set
  let t ← target
  let s := remove_deps s t
  return <| ctx fun h => s h
#align tactic.non_dep_prop_hyps tactic.non_dep_prop_hyps

section SimpAll

unsafe structure simp_all_entry where
  h : expr
  -- hypothesis
  new_type : expr
  -- new type
  pr : Option expr
  -- proof that type of h is equal to new_type
  s : simp_lemmas
#align tactic.simp_all_entry tactic.simp_all_entry

-- simplification lemmas for simplifying new_type
private unsafe def update_simp_lemmas (es : List simp_all_entry) (h : expr) :
    tactic (List simp_all_entry) :=
  es.mapM fun e => do
    let new_s ← e.s.add h false
    return { e with s := new_s }
#align tactic.update_simp_lemmas tactic.update_simp_lemmas

/-- Helper tactic for `init`.
   Remark: the following tactic is quadratic on the length of list expr (the list of non dependent propositions).
   We can make it more efficient as soon as we have an efficient simp_lemmas.erase. -/
private unsafe def init_aux :
    List expr → simp_lemmas → List simp_all_entry → tactic (simp_lemmas × List simp_all_entry)
  | [], s, r => return (s, r)
  | h :: hs, s, r => do
    let new_r ← update_simp_lemmas r h
    let new_s ← s.add h false
    let h_type ← infer_type h
    init_aux hs new_s (⟨h, h_type, none, s⟩ :: new_r)
#align tactic.init_aux tactic.init_aux

private unsafe def init (s : simp_lemmas) (hs : List expr) :
    tactic (simp_lemmas × List simp_all_entry) :=
  init_aux hs s []
#align tactic.init tactic.init

private unsafe def add_new_hyps (es : List simp_all_entry) : tactic Unit :=
  es.mapM' fun e =>
    match e.pr with
    | none => return ()
    | some pr => assert e.h.local_pp_name e.new_type >> mk_eq_mp pr e.h >>= exact
#align tactic.add_new_hyps tactic.add_new_hyps

private unsafe def clear_old_hyps (es : List simp_all_entry) : tactic Unit :=
  es.mapM' fun e => when (e.pr ≠ none) (try (clear e.h))
#align tactic.clear_old_hyps tactic.clear_old_hyps

private unsafe def join_pr : Option expr → expr → tactic expr
  | none, pr₂ => return pr₂
  | some pr₁, pr₂ => mk_eq_trans pr₁ pr₂
#align tactic.join_pr tactic.join_pr

private unsafe def loop (cfg : SimpConfig) (discharger : tactic Unit) (to_unfold : List Name) :
    List simp_all_entry → List simp_all_entry → simp_lemmas → Bool → tactic name_set
  | [], r, s, m =>
    if m then loop r [] s false
    else do
      add_new_hyps r
      let (lms, target_changed) ←
        (simp_target s to_unfold cfg discharger >>= fun ns => return (ns, true)) <|>
            return (mk_name_set, false)
      guard (cfg = ff ∨ target_changed ∨ r fun e => e ≠ none) <|>
          fail "simp_all tactic failed to simplify"
      clear_old_hyps r
      return lms
  | e :: es, r, s, m => do
    let ⟨h, h_type, h_pr, s'⟩ := e
    let (new_h_type, new_pr, lms) ←
      simplify s' to_unfold h_type { cfg with failIfUnchanged := false } `eq discharger
    if h_type == new_h_type then do
        let new_lms ← loop es (e :: r) s m
        return (new_lms lms fun n ns => name_set.insert ns n)
      else do
        let new_pr ← join_pr h_pr new_pr
        let new_fact_pr ← mk_eq_mp new_pr h
        if new_h_type = q(False) then do
            let tgt ← target
            to_expr ``(@False.ndrec $(tgt) $(new_fact_pr)) >>= exact
            return mk_name_set
          else do
            let h0_type ← infer_type h
            let new_fact_pr := mk_tagged_proof new_h_type new_fact_pr `` id_tag.simp
            let new_es ← update_simp_lemmas es new_fact_pr
            let new_r ← update_simp_lemmas r new_fact_pr
            let new_r :=
              { e with
                  new_type := new_h_type
                  pr := new_pr } ::
                new_r
            let new_s ← s new_fact_pr ff
            let new_lms ← loop new_es new_r new_s tt
            return (new_lms lms fun n ns => name_set.insert ns n)
#align tactic.loop tactic.loop

unsafe def simp_all (s : simp_lemmas) (to_unfold : List Name) (cfg : SimpConfig := { })
    (discharger : tactic Unit := failed) : tactic name_set := do
  let hs ← non_dep_prop_hyps
  let (s, es) ← init s hs
  loop cfg discharger to_unfold es [] s ff
#align tactic.simp_all tactic.simp_all

end SimpAll

/-! debugging support for algebraic normalizer -/

unsafe axiom trace_algebra_info : expr → tactic Unit
#align tactic.trace_algebra_info tactic.trace_algebra_info

end Tactic

export Tactic (mk_simp_attr)

run_cmd
  mk_simp_attr `norm [`simp]


/-
Copyright (c) 2019 Bruno Bentzen. All rights reserved.
Released under the Apache License 2.0 (see "License");
Author: Bruno Bentzen
-/

import ..core.interval

open interval

-- degeneracy maps (weakening) for types and terms

example {A : Type} : I → Type := λ _, A

example {A : Type} (a : A) : (I → A) := λ _, a


namespace Ex

class Get (Cont : Type u) (Idx : Type v) (Elem : outParam (Type w)) where
  get (xs : Cont) (i : Idx) : Elem

export Get (get)

instance [Inhabited α] : Get (Array α) Nat α where
  get xs i := xs.get! i

example (as : Array (Nat × Bool)) : Bool :=
  (get as 0).2

example (as : Array (Nat × Bool)) : Bool :=
  let r1 (as : _) := (get as 0).2
  r1 as

end Ex


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.ScopedEnvExtension
import Lean.Util.Recognizers
import Lean.Util.ReplaceExpr

namespace Lean.Compiler
namespace CSimp

structure Entry where
  fromDeclName : Name
  toDeclName   : Name
  deriving Inhabited

abbrev State := SMap Name Name

builtin_initialize ext : SimpleScopedEnvExtension Entry State ←
  registerSimpleScopedEnvExtension {
    name           := `csimp
    initial        := {}
    addEntry       := fun s { fromDeclName, toDeclName } => s.insert fromDeclName toDeclName
    finalizeImport := fun s => s.switch
  }

private def isConstantReplacement? (declName : Name) : CoreM (Option Entry) := do
  let info ← getConstInfo declName
  match info.type.eq? with
  | some (_, Expr.const fromDeclName us .., Expr.const toDeclName vs ..) =>
    if us == vs then
      return some { fromDeclName, toDeclName }
    else
      return none
  | _ => return none

def add (declName : Name) (kind : AttributeKind) : CoreM Unit := do
  if let some entry ← isConstantReplacement? declName then
    ext.add entry kind
  else
    throwError "invalid 'csimp' theorem, only constant replacement theorems (e.g., `@f = @g`) are currently supported."

builtin_initialize
  registerBuiltinAttribute {
    name  := `csimp
    descr := "simplification theorem for the compiler"
    add   := fun declName stx attrKind => do
      Attribute.Builtin.ensureNoArgs stx
      discard <| add declName attrKind
  }

@[export lean_csimp_replace_constants]
def replaceConstants (env : Environment) (e : Expr) : Expr :=
  let map := ext.getState env
  e.replace fun e =>
    if e.isConst then
      match map.find? e.constName! with
      | some declNameNew => some (mkConst declNameNew e.constLevels!)
      | none => none
    else
      none

end CSimp
end Lean.Compiler