/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Fixtures.Termination.Init.Notation
set_option linter.all false -- prevent error messages from runFrontend

namespace Lean.Parser.Tactic
/--
`with_annotate_state stx t` annotates the lexical range of `stx : Syntax` with
the initial and final state of running tactic `t`.
-/
scoped syntax (name := withAnnotateState)
  "with_annotate_state " rawStx ppSpace tactic : tactic

/--
Introduces one or more hypotheses, optionally naming and/or pattern-matching them.
For each hypothesis to be introduced, the remaining main goal's target type must
be a `let` or function type.

* `intro` by itself introduces one anonymous hypothesis, which can be accessed
  by e.g. `assumption`.
* `intro x y` introduces two hypotheses and names them. Individual hypotheses
  can be anonymized via `_`, or matched against a pattern:
  ```lean
  -- ... ⊢ α × β → ...
  intro (a, b)
  -- ..., a : α, b : β ⊢ ...
  ```
* Alternatively, `intro` can be combined with pattern matching much like `fun`:
  ```lean
  intro
  | n + 1, 0 => tac
  | ...
  ```
-/
syntax (name := intro) "intro " notFollowedBy("|") (colGt term:max)* : tactic

/--
`intros x...` behaves like `intro x...`, but then keeps introducing (anonymous)
hypotheses until goal is not of a function type.
-/
syntax (name := intros) "intros " (colGt (ident <|> hole))* : tactic

/--
`rename t => x` renames the most recent hypothesis whose type matches `t`
(which may contain placeholders) to `x`, or fails if no such hypothesis could be found.
-/
syntax (name := rename) "rename " term " => " ident : tactic

/--
`revert x...` is the inverse of `intro x...`: it moves the given hypotheses
into the main goal's target type.
-/
syntax (name := revert) "revert " (colGt term:max)+ : tactic

/--
`clear x...` removes the given hypotheses, or fails if there are remaining
references to a hypothesis.
-/
syntax (name := clear) "clear " (colGt term:max)+ : tactic

/--
`subst x...` substitutes each `x` with `e` in the goal if there is a hypothesis
of type `x = e` or `e = x`.
If `x` is itself a hypothesis of type `y = e` or `e = y`, `y` is substituted instead.
-/
syntax (name := subst) "subst " (colGt term:max)+ : tactic

/--
Applies `subst` to all hypotheses of the form `h : x = t` or `h : t = x`.
-/
syntax (name := substVars) "subst_vars" : tactic

/--
`assumption` tries to solve the main goal using a hypothesis of compatible type, or else fails.
Note also the `‹t›` term notation, which is a shorthand for `show t by assumption`.
-/
syntax (name := assumption) "assumption" : tactic

/--
`contradiction` closes the main goal if its hypotheses are "trivially contradictory".
- Inductive type/family with no applicable constructors
```lean
example (h : False) : p := by contradiction
```
- Injectivity of constructors
```lean
example (h : none = some true) : p := by contradiction  --
```
- Decidable false proposition
```lean
example (h : 2 + 2 = 3) : p := by contradiction
```
- Contradictory hypotheses
```lean
example (h : p) (h' : ¬ p) : q := by contradiction
```
- Other simple contradictions such as
```lean
example (x : Nat) (h : x ≠ x) : p := by contradiction
```
-/
syntax (name := contradiction) "contradiction" : tactic

/--
`apply e` tries to match the current goal against the conclusion of `e`'s type.
If it succeeds, then the tactic returns as many subgoals as the number of premises that
have not been fixed by type inference or type class resolution.
Non-dependent premises are added before dependent ones.

The `apply` tactic uses higher-order pattern matching, type class resolution,
and first-order unification with dependent types.
-/
syntax (name := apply) "apply " term : tactic

/--
`exact e` closes the main goal if its target type matches that of `e`.
-/
syntax (name := exact) "exact " term : tactic

/--
`refine e` behaves like `exact e`, except that named (`?x`) or unnamed (`?_`)
holes in `e` that are not solved by unification with the main goal's target type
are converted into new goals, using the hole's name, if any, as the goal case name.
-/
syntax (name := refine) "refine " term : tactic

/--
`refine' e` behaves like `refine e`, except that unsolved placeholders (`_`)
and implicit parameters are also converted into new goals.
-/
syntax (name := refine') "refine' " term : tactic

/--
If the main goal's target type is an inductive type, `constructor` solves it with
the first matching constructor, or else fails.
-/
syntax (name := constructor) "constructor" : tactic

/--
* `case tag => tac` focuses on the goal with case name `tag` and solves it using `tac`,
  or else fails.
* `case tag x₁ ... xₙ => tac` additionally renames the `n` most recent hypotheses
  with inaccessible names to the given names.
* `case tag₁ | tag₂ => tac` is equivalent to `(case tag₁ => tac); (case tag₂ => tac)`.
-/
syntax (name := case) "case " sepBy1(caseArg, " | ") " => " tacticSeq : tactic

/--
`case'` is similar to the `case tag => tac` tactic, but does not ensure the goal
has been solved after applying `tac`, nor admits the goal if `tac` failed.
Recall that `case` closes the goal using `sorry` when `tac` fails, and
the tactic execution is not interrupted.
-/
syntax (name := case') "case' " sepBy1(caseArg, " | ") " => " tacticSeq : tactic

/--
`next => tac` focuses on the next goal and solves it using `tac`, or else fails.
`next x₁ ... xₙ => tac` additionally renames the `n` most recent hypotheses with
inaccessible names to the given names.
-/
macro "next " args:binderIdent* " => " tac:tacticSeq : tactic => `(tactic| case _ $args* => $tac)

/-- `all_goals tac` runs `tac` on each goal, concatenating the resulting goals, if any. -/
syntax (name := allGoals) "all_goals " tacticSeq : tactic

/--
`any_goals tac` applies the tactic `tac` to every goal, and succeeds if at
least one application succeeds.
-/
syntax (name := anyGoals) "any_goals " tacticSeq : tactic

/--
`focus tac` focuses on the main goal, suppressing all other goals, and runs `tac` on it.
Usually `· tac`, which enforces that the goal is closed by `tac`, should be preferred.
-/
syntax (name := focus) "focus " tacticSeq : tactic

/-- `skip` does nothing. -/
syntax (name := skip) "skip" : tactic

/-- `done` succeeds iff there are no remaining goals. -/
syntax (name := done) "done" : tactic

/-- `trace_state` displays the current state in the info view. -/
syntax (name := traceState) "trace_state" : tactic

/-- `trace msg` displays `msg` in the info view. -/
syntax (name := traceMessage) "trace " str : tactic

/-- `fail_if_success t` fails if the tactic `t` succeeds. -/
syntax (name := failIfSuccess) "fail_if_success " tacticSeq : tactic

/--
`(tacs)` executes a list of tactics in sequence, without requiring that
the goal be closed at the end like `· tacs`. Like `by` itself, the tactics
can be either separated by newlines or `;`.
-/
syntax (name := paren) "(" withoutPosition(tacticSeq) ")" : tactic

/--
`with_reducible tacs` excutes `tacs` using the reducible transparency setting.
In this setting only definitions tagged as `[reducible]` are unfolded.
-/
syntax (name := withReducible) "with_reducible " tacticSeq : tactic

/--
`with_reducible_and_instances tacs` excutes `tacs` using the `.instances` transparency setting.
In this setting only definitions tagged as `[reducible]` or type class instances are unfolded.
-/
syntax (name := withReducibleAndInstances) "with_reducible_and_instances " tacticSeq : tactic

/--
`with_unfolding_all tacs` excutes `tacs` using the `.all` transparency setting.
In this setting all definitions that are not opaque are unfolded.
-/
syntax (name := withUnfoldingAll) "with_unfolding_all " tacticSeq : tactic

/-- `first | tac | ...` runs each `tac` until one succeeds, or else fails. -/
syntax (name := first) "first " withPosition((colGe "|" tacticSeq)+) : tactic

/--
`rotate_left n` rotates goals to the left by `n`. That is, `rotate_left 1`
takes the main goal and puts it to the back of the subgoal list.
If `n` is omitted, it defaults to `1`.
-/
syntax (name := rotateLeft) "rotate_left" (num)? : tactic

/--
Rotate the goals to the right by `n`. That is, take the goal at the back
and push it to the front `n` times. If `n` is omitted, it defaults to `1`.
-/
syntax (name := rotateRight) "rotate_right" (num)? : tactic

/-- `try tac` runs `tac` and succeeds even if `tac` failed. -/
macro "try " t:tacticSeq : tactic => `(tactic| first | $t | skip)

/--
`tac <;> tac'` runs `tac` on the main goal and `tac'` on each produced goal,
concatenating all goals produced by `tac'`.
-/
macro:1 x:tactic tk:" <;> " y:tactic:2 : tactic => `(tactic|
  focus
    $x:tactic
    -- annotate token with state after executing `x`
    with_annotate_state $tk skip
    all_goals $y:tactic)

/-- `eq_refl` is equivalent to `exact rfl`, but has a few optimizations. -/
syntax (name := refl) "eq_refl" : tactic

/--
`rfl` tries to close the current goal using reflexivity.
This is supposed to be an extensible tactic and users can add their own support
for new reflexive relations.
-/
macro "rfl" : tactic => `(tactic| eq_refl)

/--
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
theorems included (relevant for declarations defined by well-founded recursion).
-/
macro "rfl'" : tactic => `(tactic| set_option smartUnfolding false in with_unfolding_all rfl)

/--
`ac_rfl` proves equalities up to application of an associative and commutative operator.
```
instance : IsAssociative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : IsCommutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩

example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by ac_rfl
```
-/
syntax (name := acRfl) "ac_rfl" : tactic

/--
The `sorry` tactic closes the goal using `sorryAx`. This is intended for stubbing out incomplete
parts of a proof while still having a syntactically correct proof skeleton. Lean will give
a warning whenever a proof uses `sorry`, so you aren't likely to miss it, but
you can double check if a theorem depends on `sorry` by using
`#print axioms my_thm` and looking for `sorryAx` in the axiom list.
-/
macro "sorry" : tactic => `(tactic| exact @sorryAx _ false)

/-- `admit` is a shorthand for `exact sorry`. -/
macro "admit" : tactic => `(tactic| exact @sorryAx _ false)

/--
`infer_instance` is an abbreviation for `exact inferInstance`.
It synthesizes a value of any target type by typeclass inference.
-/
macro "infer_instance" : tactic => `(tactic| exact inferInstance)

/-- Optional configuration option for tactics -/
syntax config := atomic(" (" &"config") " := " withoutPosition(term) ")"

/-- The `*` location refers to all hypotheses and the goal. -/
syntax locationWildcard := "*"

/--
A hypothesis location specification consists of 1 or more hypothesis references
and optionally `⊢` denoting the goal.
-/
syntax locationHyp := (colGt term:max)+ patternIgnore("⊢" <|> "|-")?

/--
Location specifications are used by many tactics that can operate on either the
hypotheses or the goal. It can have one of the forms:
* 'empty' is not actually present in this syntax, but most tactics use
  `(location)?` matchers. It means to target the goal only.
* `at h₁ ... hₙ`: target the hypotheses `h₁`, ..., `hₙ`
* `at h₁ h₂ ⊢`: target the hypotheses `h₁` and `h₂`, and the goal
* `at *`: target all hypotheses and the goal
-/
syntax location := withPosition(" at " (locationWildcard <|> locationHyp))

/--
* `change tgt'` will change the goal from `tgt` to `tgt'`,
  assuming these are definitionally equal.
* `change t' at h` will change hypothesis `h : t` to have type `t'`, assuming
  assuming `t` and `t'` are definitionally equal.
-/
syntax (name := change) "change " term (location)? : tactic

/--
* `change a with b` will change occurrences of `a` to `b` in the goal,
  assuming `a` and `b` are are definitionally equal.
* `change a with b at h` similarly changes `a` to `b` in the type of hypothesis `h`.
-/
syntax (name := changeWith) "change " term " with " term (location)? : tactic

/--
If `thm` is a theorem `a = b`, then as a rewrite rule,
* `thm` means to replace `a` with `b`, and
* `← thm` means to replace `b` with `a`.
-/
syntax rwRule    := patternIgnore("← " <|> "<- ")? term
/-- A `rwRuleSeq` is a list of `rwRule` in brackets. -/
syntax rwRuleSeq := " [" withoutPosition(rwRule,*,?) "]"

/--
`rewrite [e]` applies identity `e` as a rewrite rule to the target of the main goal.
If `e` is preceded by left arrow (`←` or `<-`), the rewrite is applied in the reverse direction.
If `e` is a defined constant, then the equational theorems associated with `e` are used.
This provides a convenient way to unfold `e`.
- `rewrite [e₁, ..., eₙ]` applies the given rules sequentially.
- `rewrite [e] at l` rewrites `e` at location(s) `l`, where `l` is either `*` or a
  list of hypotheses in the local context. In the latter case, a turnstile `⊢` or `|-`
  can also be used, to signify the target of the goal.
-/
syntax (name := rewriteSeq) "rewrite" (config)? rwRuleSeq (location)? : tactic

/--
`rw` is like `rewrite`, but also tries to close the goal by "cheap" (reducible) `rfl` afterwards.
-/
macro (name := rwSeq) "rw" c:(config)? s:rwRuleSeq l:(location)? : tactic =>
  match s with
  | `(rwRuleSeq| [$rs,*]%$rbrak) =>
    -- We show the `rfl` state on `]`
    `(tactic| (rewrite $(c)? [$rs,*] $(l)?; with_annotate_state $rbrak (try (with_reducible rfl))))
  | _ => Macro.throwUnsupported

/--
The `injection` tactic is based on the fact that constructors of inductive data
types are injections.
That means that if `c` is a constructor of an inductive datatype, and if `(c t₁)`
and `(c t₂)` are two terms that are equal then  `t₁` and `t₂` are equal too.
If `q` is a proof of a statement of conclusion `t₁ = t₂`, then injection applies
injectivity to derive the equality of all arguments of `t₁` and `t₂` placed in
the same positions. For example, from `(a::b) = (c::d)` we derive `a=c` and `b=d`.
To use this tactic `t₁` and `t₂` should be constructor applications of the same constructor.
Given `h : a::b = c::d`, the tactic `injection h` adds two new hypothesis with types
`a = c` and `b = d` to the main goal.
The tactic `injection h with h₁ h₂` uses the names `h₁` and `h₂` to name the new hypotheses.
-/
syntax (name := injection) "injection " term (" with " (colGt (ident <|> hole))+)? : tactic

/-- `injections` applies `injection` to all hypotheses recursively
(since `injection` can produce new hypotheses). Useful for destructing nested
constructor equalities like `(a::b::c) = (d::e::f)`. -/
-- TODO: add with
syntax (name := injections) "injections" (colGt (ident <|> hole))* : tactic

/--
The discharger clause of `simp` and related tactics.
This is a tactic used to discharge the side conditions on conditional rewrite rules.
-/
syntax discharger := atomic(" (" patternIgnore(&"discharger" <|> &"disch")) " := " withoutPosition(tacticSeq) ")"

/-- Use this rewrite rule before entering the subterms -/
syntax simpPre   := "↓"
/-- Use this rewrite rule after entering the subterms -/
syntax simpPost  := "↑"
/--
A simp lemma specification is:
* optional `↑` or `↓` to specify use before or after entering the subterm
* optional `←` to use the lemma backward
* `thm` for the theorem to rewrite with
-/
syntax simpLemma := (simpPre <|> simpPost)? patternIgnore("← " <|> "<- ")? term
/-- An erasure specification `-thm` says to remove `thm` from the simp set -/
syntax simpErase := "-" term:max
/-- The simp lemma specification `*` means to rewrite with all hypotheses -/
syntax simpStar  := "*"
/--
The `simp` tactic uses lemmas and hypotheses to simplify the main goal target or
non-dependent hypotheses. It has many variants:
- `simp` simplifies the main goal target using lemmas tagged with the attribute `[simp]`.
- `simp [h₁, h₂, ..., hₙ]` simplifies the main goal target using the lemmas tagged
  with the attribute `[simp]` and the given `hᵢ`'s, where the `hᵢ`'s are expressions.
  If an `hᵢ` is a defined constant `f`, then the equational lemmas associated with
  `f` are used. This provides a convenient way to unfold `f`.
- `simp [*]` simplifies the main goal target using the lemmas tagged with the
  attribute `[simp]` and all hypotheses.
- `simp only [h₁, h₂, ..., hₙ]` is like `simp [h₁, h₂, ..., hₙ]` but does not use `[simp]` lemmas.
- `simp [-id₁, ..., -idₙ]` simplifies the main goal target using the lemmas tagged
  with the attribute `[simp]`, but removes the ones named `idᵢ`.
- `simp at h₁ h₂ ... hₙ` simplifies the hypotheses `h₁ : T₁` ... `hₙ : Tₙ`. If
  the target or another hypothesis depends on `hᵢ`, a new simplified hypothesis
  `hᵢ` is introduced, but the old one remains in the local context.
- `simp at *` simplifies all the hypotheses and the target.
- `simp [*] at *` simplifies target and all (propositional) hypotheses using the
  other hypotheses.
-/
syntax (name := simp) "simp" (config)? (discharger)? (&" only")?
  (" [" withoutPosition((simpStar <|> simpErase <|> simpLemma),*) "]")? (location)? : tactic
/--
`simp_all` is a stronger version of `simp [*] at *` where the hypotheses and target
are simplified multiple times until no simplication is applicable.
Only non-dependent propositional hypotheses are considered.
-/
syntax (name := simpAll) "simp_all" (config)? (discharger)? (&" only")?
  (" [" withoutPosition((simpErase <|> simpLemma),*) "]")? : tactic

/--
The `dsimp` tactic is the definitional simplifier. It is similar to `simp` but only
applies theorems that hold by reflexivity. Thus, the result is guaranteed to be
definitionally equal to the input.
-/
syntax (name := dsimp) "dsimp" (config)? (discharger)? (&" only")?
  (" [" withoutPosition((simpErase <|> simpLemma),*) "]")? (location)? : tactic

/--
`delta id1 id2 ...` delta-expands the definitions `id1`, `id2`, ....
This is a low-level tactic, it will expose how recursive definitions have been
compiled by Lean.
-/
syntax (name := delta) "delta " (colGt ident)+ (location)? : tactic

/--
* `unfold id` unfolds definition `id`.
* `unfold id1 id2 ...` is equivalent to `unfold id1; unfold id2; ...`.

For non-recursive definitions, this tactic is identical to `delta`.
For definitions by pattern matching, it uses "equation lemmas" which are
autogenerated for each match arm.
-/
syntax (name := unfold) "unfold " (colGt ident)+ (location)? : tactic

/--
Auxiliary macro for lifting have/suffices/let/...
It makes sure the "continuation" `?_` is the main goal after refining.
-/
macro "refine_lift " e:term : tactic => `(tactic| focus (refine no_implicit_lambda% $e; rotate_right))

/--
`have h : t := e` adds the hypothesis `h : t` to the current goal if `e` a term
of type `t`.
* If `t` is omitted, it will be inferred.
* If `h` is omitted, the name `this` is used.
* The variant `have pattern := e` is equivalent to `match e with | pattern => _`,
  and it is convenient for types that have only one applicable constructor.
  For example, given `h : p ∧ q ∧ r`, `have ⟨h₁, h₂, h₃⟩ := h` produces the
  hypotheses `h₁ : p`, `h₂ : q`, and `h₃ : r`.
-/
macro "have " d:haveDecl : tactic => `(tactic| refine_lift have $d:haveDecl; ?_)

/--
Given a main goal `ctx ⊢ t`, `suffices h : t' from e` replaces the main goal with `ctx ⊢ t'`,
`e` must have type `t` in the context `ctx, h : t'`.

The variant `suffices h : t' by tac` is a shorthand for `suffices h : t' from by tac`.
If `h :` is omitted, the name `this` is used.
 -/
macro "suffices " d:sufficesDecl : tactic => `(tactic| refine_lift suffices $d; ?_)
/--
`let h : t := e` adds the hypothesis `h : t := e` to the current goal if `e` a term of type `t`.
If `t` is omitted, it will be inferred.
The variant `let pattern := e` is equivalent to `match e with | pattern => _`,
and it is convenient for types that have only applicable constructor.
Example: given `h : p ∧ q ∧ r`, `let ⟨h₁, h₂, h₃⟩ := h` produces the hypotheses
`h₁ : p`, `h₂ : q`, and `h₃ : r`.
-/
macro "let " d:letDecl : tactic => `(tactic| refine_lift let $d:letDecl; ?_)
/--
`show t` finds the first goal whose target unifies with `t`. It makes that the main goal,
 performs the unification, and replaces the target with the unified version of `t`.
-/
macro "show " e:term : tactic => `(tactic| refine_lift show $e from ?_) -- TODO: fix, see comment
/-- `let rec f : t := e` adds a recursive definition `f` to the current goal.
The syntax is the same as term-mode `let rec`. -/
syntax (name := letrec) withPosition(atomic("let " &"rec ") letRecDecls) : tactic
macro_rules
  | `(tactic| let rec $d) => `(tactic| refine_lift let rec $d; ?_)

/-- Similar to `refine_lift`, but using `refine'` -/
macro "refine_lift' " e:term : tactic => `(tactic| focus (refine' no_implicit_lambda% $e; rotate_right))
/-- Similar to `have`, but using `refine'` -/
macro "have' " d:haveDecl : tactic => `(tactic| refine_lift' have $d:haveDecl; ?_)
/-- Similar to `have`, but using `refine'` -/
macro (priority := high) "have'" x:ident " := " p:term : tactic => `(tactic| have' $x : _ := $p)
/-- Similar to `let`, but using `refine'` -/
macro "let' " d:letDecl : tactic => `(tactic| refine_lift' let $d:letDecl; ?_)

/--
The left hand side of an induction arm, `| foo a b c` or `| @foo a b c`
where `foo` is a constructor of the inductive type and `a b c` are the arguments
to the contstructor.
-/
syntax inductionAltLHS := "| " (("@"? ident) <|> hole) (ident <|> hole)*
/--
In induction alternative, which can have 1 or more cases on the left
and `_`, `?_`, or a tactic sequence after the `=>`.
-/
syntax inductionAlt  := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> syntheticHole <|> tacticSeq)
/--
After `with`, there is an optional tactic that runs on all branches, and
then a list of alternatives.
-/
syntax inductionAlts := "with " (tactic)? withPosition((colGe inductionAlt)+)

/--
Assuming `x` is a variable in the local context with an inductive type,
`induction x` applies induction on `x` to the main goal,
producing one goal for each constructor of the inductive type,
in which the target is replaced by a general instance of that constructor
and an inductive hypothesis is added for each recursive argument to the constructor.
If the type of an element in the local context depends on `x`,
that element is reverted and reintroduced afterward,
so that the inductive hypothesis incorporates that hypothesis as well.

For example, given `n : Nat` and a goal with a hypothesis `h : P n` and target `Q n`,
`induction n` produces one goal with hypothesis `h : P 0` and target `Q 0`,
and one goal with hypotheses `h : P (Nat.succ a)` and `ih₁ : P a → Q a` and target `Q (Nat.succ a)`.
Here the names `a` and `ih₁` are chosen automatically and are not accessible.
You can use `with` to provide the variables names for each constructor.
- `induction e`, where `e` is an expression instead of a variable,
  generalizes `e` in the goal, and then performs induction on the resulting variable.
- `induction e using r` allows the user to specify the principle of induction that should be used.
  Here `r` should be a theorem whose result type must be of the form `C t`,
  where `C` is a bound variable and `t` is a (possibly empty) sequence of bound variables
- `induction e generalizing z₁ ... zₙ`, where `z₁ ... zₙ` are variables in the local context,
  generalizes over `z₁ ... zₙ` before applying the induction but then introduces them in each goal.
  In other words, the net effect is that each inductive hypothesis is generalized.
- Given `x : Nat`, `induction x with | zero => tac₁ | succ x' ih => tac₂`
  uses tactic `tac₁` for the `zero` case, and `tac₂` for the `succ` case.
-/
syntax (name := induction) "induction " term,+ (" using " ident)?
  ("generalizing " (colGt term:max)+)? (inductionAlts)? : tactic

/-- A `generalize` argument, of the form `term = x` or `h : term = x`. -/
syntax generalizeArg := atomic(ident " : ")? term:51 " = " ident

/--
* `generalize ([h :] e = x),+` replaces all occurrences `e`s in the main goal
  with a fresh hypothesis `x`s. If `h` is given, `h : e = x` is introduced as well.
* `generalize e = x at h₁ ... hₙ` also generalizes occurrences of `e`
  inside `h₁`, ..., `hₙ`.
* `generalize e = x at *` will generalize occurrences of `e` everywhere.
-/
syntax (name := generalize) "generalize " generalizeArg,+ (location)? : tactic

/--
A `cases` argument, of the form `e` or `h : e` (where `h` asserts that
`e = cᵢ a b` for each constructor `cᵢ` of the inductive).
-/
syntax casesTarget := atomic(ident " : ")? term
/--
Assuming `x` is a variable in the local context with an inductive type,
`cases x` splits the main goal, producing one goal for each constructor of the
inductive type, in which the target is replaced by a general instance of that constructor.
If the type of an element in the local context depends on `x`,
that element is reverted and reintroduced afterward,
so that the case split affects that hypothesis as well.
`cases` detects unreachable cases and closes them automatically.

For example, given `n : Nat` and a goal with a hypothesis `h : P n` and target `Q n`,
`cases n` produces one goal with hypothesis `h : P 0` and target `Q 0`,
and one goal with hypothesis `h : P (Nat.succ a)` and target `Q (Nat.succ a)`.
Here the name `a` is chosen automatically and is not accessible.
You can use `with` to provide the variables names for each constructor.
- `cases e`, where `e` is an expression instead of a variable, generalizes `e` in the goal,
  and then cases on the resulting variable.
- Given `as : List α`, `cases as with | nil => tac₁ | cons a as' => tac₂`,
  uses tactic `tac₁` for the `nil` case, and `tac₂` for the `cons` case,
  and `a` and `as'` are used as names for the new variables introduced.
- `cases h : e`, where `e` is a variable or an expression,
  performs cases on `e` as above, but also adds a hypothesis `h : e = ...` to each hypothesis,
  where `...` is the constructor instance for that particular case.
-/
syntax (name := cases) "cases " casesTarget,+ (" using " ident)? (inductionAlts)? : tactic

/-- `rename_i x_1 ... x_n` renames the last `n` inaccessible names using the given names. -/
syntax (name := renameI) "rename_i " (colGt binderIdent)+ : tactic

/--
`repeat tac` applies `tac` to main goal. If the application succeeds,
the tactic is applied recursively to the generated subgoals until it eventually fails.
-/
syntax "repeat " tacticSeq : tactic
macro_rules
  | `(tactic| repeat $seq) => `(tactic| first | ($seq); repeat $seq | skip)

/--
`trivial` tries different simple tactics (e.g., `rfl`, `contradiction`, ...)
to close the current goal.
You can use the command `macro_rules` to extend the set of tactics used. Example:
```
macro_rules | `(tactic| trivial) => `(tactic| simp)
```
-/
syntax "trivial" : tactic

/--
The `split` tactic is useful for breaking nested if-then-else and `match` expressions into separate cases.
For a `match` expression with `n` cases, the `split` tactic generates at most `n` subgoals.

For example, given `n : Nat`, and a target `if n = 0 then Q else R`, `split` will generate
one goal with hypothesis `n = 0` and target `Q`, and a second goal with hypothesis
`¬n = 0` and target `R`.  Note that the introduced hypothesis is unnamed, and is commonly
renamed used the `case` or `next` tactics.

- `split` will split the goal (target).
- `split at h` will split the hypothesis `h`.
-/
syntax (name := split) "split " (colGt term)? (location)? : tactic

/-- `dbg_trace "foo"` prints `foo` when elaborated.
Useful for debugging tactic control flow:
```
example : False ∨ True := by
  first
  | apply Or.inl; trivial; dbg_trace "left"
  | apply Or.inr; trivial; dbg_trace "right"
```
-/
syntax (name := dbgTrace) "dbg_trace " str : tactic

/--
`stop` is a helper tactic for "discarding" the rest of a proof:
it is defined as `repeat sorry`.
It is useful when working on the middle of a complex proofs,
and less messy than commenting the remainder of the proof.
-/
macro "stop" tacticSeq : tactic => `(tactic| repeat sorry)

/--
The tactic `specialize h a₁ ... aₙ` works on local hypothesis `h`.
The premises of this hypothesis, either universal quantifications or
non-dependent implications, are instantiated by concrete terms coming
from arguments `a₁` ... `aₙ`.
The tactic adds a new hypothesis with the same name `h := h a₁ ... aₙ`
and tries to clear the previous one.
-/
syntax (name := specialize) "specialize " term : tactic

macro_rules | `(tactic| trivial) => `(tactic| assumption)
macro_rules | `(tactic| trivial) => `(tactic| rfl)
macro_rules | `(tactic| trivial) => `(tactic| contradiction)
macro_rules | `(tactic| trivial) => `(tactic| decide)
macro_rules | `(tactic| trivial) => `(tactic| apply True.intro)
macro_rules | `(tactic| trivial) => `(tactic| apply And.intro <;> trivial)

/--
`unhygienic tacs` runs `tacs` with name hygiene disabled.
This means that tactics that would normally create inaccessible names will instead
make regular variables. **Warning**: Tactics may change their variable naming
strategies at any time, so code that depends on autogenerated names is brittle.
Users should try not to use `unhygienic` if possible.
```
example : ∀ x : Nat, x = x := by unhygienic
  intro            -- x would normally be intro'd as inaccessible
  exact Eq.refl x  -- refer to x
```
-/
macro "unhygienic " t:tacticSeq : tactic => `(tactic| set_option tactic.hygienic false in $t)

/-- `fail msg` is a tactic that always fails, and produces an error using the given message. -/
syntax (name := fail) "fail " (str)? : tactic

/--
`checkpoint tac` acts the same as `tac`, but it caches the input and output of `tac`,
and if the file is re-elaborated and the input matches, the tactic is not re-run and
its effects are reapplied to the state. This is useful for improving responsiveness
when working on a long tactic proof, by wrapping expensive tactics with `checkpoint`.

See the `save` tactic, which may be more convenient to use.

(TODO: do this automatically and transparently so that users don't have to use
this combinator explicitly.)
-/
syntax (name := checkpoint) "checkpoint " tacticSeq : tactic

/--
`save` is defined to be the same as `skip`, but the elaborator has
special handling for occurrences of `save` in tactic scripts and will transform
`by tac1; save; tac2` to `by (checkpoint tac1); tac2`, meaning that the effect of `tac1`
will be cached and replayed. This is useful for improving responsiveness
when working on a long tactic proof, by using `save` after expensive tactics.

(TODO: do this automatically and transparently so that users don't have to use
this combinator explicitly.)
-/
macro (name := save) "save" : tactic => `(tactic| skip)

/--
The tactic `sleep ms` sleeps for `ms` milliseconds and does nothing.
It is used for debugging purposes only.
-/
syntax (name := sleep) "sleep" num : tactic

/--
`exists e₁, e₂, ...` is shorthand for `refine ⟨e₁, e₂, ...⟩; try trivial`.
It is useful for existential goals.
-/
macro "exists " es:term,+ : tactic =>
  `(tactic| (refine ⟨$es,*, ?_⟩; try trivial))

/--
Apply congruence (recursively) to goals of the form `⊢ f as = f bs` and `⊢ HEq (f as) (f bs)`.
The optional parameter is the depth of the recursive applications.
This is useful when `congr` is too aggressive in breaking down the goal.
For example, given `⊢ f (g (x + y)) = f (g (y + x))`,
`congr` produces the goals `⊢ x = y` and `⊢ y = x`,
while `congr 2` produces the intended `⊢ x + y = y + x`.
-/
syntax (name := congr) "congr " (num)? : tactic

end Tactic

namespace Attr
/--
Theorems tagged with the `simp` attribute are by the simplifier
(i.e., the `simp` tactic, and its variants) to simplify expressions occurring in your goals.
We call theorems tagged with the `simp` attribute "simp theorems" or "simp lemmas".
Lean maintains a database/index containing all active simp theorems.
Here is an example of a simp theorem.
```lean
@[simp] theorem ne_eq (a b : α) : (a ≠ b) = Not (a = b) := rfl
```
This simp theorem instructs the simplifier to replace instances of the term
`a ≠ b` (e.g. `x + 0 ≠ y`) with `Not (a = b)` (e.g., `Not (x + 0 = y)`).
The simplifier applies simp theorems in one direction only:
if `A = B` is a simp theorem, then `simp` replaces `A`s with `B`s,
but it doesn't replace `B`s with `A`s. Hence a simp theorem should have the
property that its right-hand side is "simpler" than its left-hand side.
In particular, `=` and `↔` should not be viewed as symmetric operators in this situation.
The following would be a terrible simp theorem (if it were even allowed):
```lean
@[simp] lemma mul_right_inv_bad (a : G) : 1 = a * a⁻¹ := ...
```
Replacing 1 with a * a⁻¹ is not a sensible default direction to travel.
Even worse would be a theorem that causes expressions to grow without bound,
causing simp to loop forever.

By default the simplifier applies `simp` theorems to an expression `e`
after its sub-expressions have been simplified.
We say it performs a bottom-up simplification.
You can instruct the simplifier to apply a theorem before its sub-expressions
have been simplified by using the modifier `↓`. Here is an example
```lean
@[simp↓] theorem not_and_eq (p q : Prop) : (¬ (p ∧ q)) = (¬p ∨ ¬q) :=
```

When multiple simp theorems are applicable, the simplifier uses the one with highest priority.
If there are several with the same priority, it is uses the "most recent one". Example:
```lean
@[simp high] theorem cond_true (a b : α) : cond true a b = a := rfl
@[simp low+1] theorem or_true (p : Prop) : (p ∨ True) = True :=
  propext <| Iff.intro (fun _ => trivial) (fun _ => Or.inr trivial)
@[simp 100] theorem ite_self {d : Decidable c} (a : α) : ite c a a = a := by
  cases d <;> rfl
```
-/
syntax (name := simp) "simp" (Tactic.simpPre <|> Tactic.simpPost)? (prio)? : attr
end Attr

end Parser
end Lean

/--
`‹t›` resolves to an (arbitrary) hypothesis of type `t`.
It is useful for referring to hypotheses without accessible names.
`t` may contain holes that are solved by unification with the expected type;
in particular, `‹_›` is a shortcut for `by assumption`.
-/
syntax "‹" withoutPosition(term) "›" : term
macro_rules | `(‹$type›) => `((by assumption : $type))

/--
`get_elem_tactic_trivial` is an extensible tactic automatically called
by the notation `arr[i]` to prove any side conditions that arise when
constructing the term (e.g. the index is in bounds of the array).
The default behavior is to just try `trivial` (which handles the case
where `i < arr.size` is in the context) and `simp_arith`
(for doing linear arithmetic in the index).
-/
syntax "get_elem_tactic_trivial" : tactic

macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| trivial)
macro_rules | `(tactic| get_elem_tactic_trivial) => `(tactic| simp (config := { arith := true }); done)

/--
`get_elem_tactic` is the tactic automatically called by the notation `arr[i]`
to prove any side conditions that arise when constructing the term
(e.g. the index is in bounds of the array). It just delegates to
`get_elem_tactic_trivial` and gives a diagnostic error message otherwise;
users are encouraged to extend `get_elem_tactic_trivial` instead of this tactic.
-/
macro "get_elem_tactic" : tactic =>
  `(tactic| first
    | get_elem_tactic_trivial
    | fail "failed to prove index is valid, possible solutions:
  - Use `have`-expressions to prove the index is valid
  - Use `a[i]!` notation instead, runtime check is perfomed, and 'Panic' error message is produced if index is not valid
  - Use `a[i]?` notation instead, result is an `Option` type
  - Use `a[i]'h` notation instead, where `h` is a proof that index is valid"
   )

@[inherit_doc getElem]
syntax:max term noWs "[" withoutPosition(term) "]" : term
macro_rules | `($x[$i]) => `(getElem $x $i (by get_elem_tactic))

@[inherit_doc getElem]
syntax term noWs "[" withoutPosition(term) "]'" term:max : term
macro_rules | `($x[$i]'$h) => `(getElem $x $i $h)


import tools.super
open list

print prefix list.reverse_core

print tactic.interactive.generalize

lemma reverse_reverse_core {α} (xs ys : list α) : reverse_core (reverse_core xs ys) nil = reverse_core ys xs :=
begin generalize ys ys, induction xs, intro, refl, super list.reverse_core.equations._eqn_2 end


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison
import category_theory.tactics.obviously
import category_theory.equivalence

namespace category_theory

universes v₁ v₂ u₁ u₂

structure idempotent (C : Sort u₁) [category.{v₁+1} C] :=
(X : C)
(idem : X ⟶ X)
(w' : idem ≫ idem = idem . obviously)

restate_axiom idempotent.w'
attribute [simp] idempotent.w -- search

variables {C : Sort u₁} [𝒞 : category.{v₁+1} C]
include 𝒞

namespace idempotent

structure morphism (P Q : idempotent.{v₁} C) :=
(hom : P.X ⟶ Q.X)
(left' : P.idem ≫ hom = hom . obviously)
(right' : hom ≫ Q.idem = hom . obviously)

restate_axiom morphism.left'
restate_axiom morphism.right'
attribute [simp] morphism.left morphism.right -- search

@[extensionality] lemma ext {P Q : idempotent C} (f g : morphism P Q) (w : f.hom = g.hom) : f = g :=
begin
  induction f,
  induction g,
  tidy
end

end idempotent

instance idempotent_completion : category.{v₁+1} (idempotent C) :=
{ hom  := idempotent.morphism,
  id   := λ P, ⟨ P.idem ⟩,
  comp := λ _ _ _ f g,
  { hom := f.hom ≫ g.hom,
    left'  := by rw [←category.assoc, idempotent.morphism.left],
    right' := by rw [category.assoc, idempotent.morphism.right] } }

namespace idempotent_completion

@[simp] lemma id_hom (P : idempotent C) : ((𝟙 P) : idempotent.morphism P P).hom = P.idem := rfl
@[simp] lemma comp_hom {P Q R : idempotent C} (f : P ⟶ Q) (g : Q ⟶ R) : (f ≫ g).hom = f.hom ≫ g.hom := rfl

def to_completion (C : Type u₁) [𝒞 : category.{v₁+1} C] : C ⥤ (idempotent.{v₁} C) :=
{ obj := λ P, { X := P, idem := 𝟙 P },
  map := λ _ _ f, { hom := f } }

@[simp] private lemma double_idempotent_morphism_left (P Q : idempotent (idempotent C)) (f : P ⟶ Q)
  : (P.idem).hom ≫ (f.hom).hom = (f.hom).hom := congr_arg idempotent.morphism.hom f.left
@[simp] private lemma double_idempotent_morphism_right (P Q : idempotent (idempotent C)) (f : P ⟶ Q)
  : (f.hom).hom ≫ (Q.idem).hom = (f.hom).hom := congr_arg idempotent.morphism.hom f.right

@[simp] private def idempotent_functor : (idempotent (idempotent C)) ⥤ (idempotent C) :=
{ obj := λ P, ⟨ P.X.X, P.idem.hom, congr_arg idempotent.morphism.hom P.w ⟩,
  map := λ _ _ f, ⟨ f.hom.hom, by obviously ⟩ }.
@[simp] private def idempotent_inverse : (idempotent C) ⥤ (idempotent (idempotent C)) :=
{ obj := λ P, ⟨ P, ⟨ P.idem, by obviously ⟩, by obviously ⟩,
  map := λ _ _ f, ⟨ f, by obviously ⟩ }.

@[simp] lemma idem_hom_idempotent (X : idempotent (idempotent C)) : X.idem.hom ≫ X.idem.hom = X.idem.hom :=
begin
  rw ←comp_hom,
  simp,
end

lemma idempotent_idempotent :
  equivalence (idempotent (idempotent C)) (idempotent C) :=
equivalence.mk idempotent_functor idempotent_inverse
  { hom := { app := λ X, { hom := { hom := X.idem.hom } } },
    inv := { app := λ X, { hom := { hom := X.idem.hom } } } }
  { hom := { app := λ X, { hom := X.idem } },
    inv := { app := λ X, { hom := X.idem } } }

variable {D : Type u₂}
variable [𝒟 : category.{v₂+1} D]
include 𝒟

attribute [search] idempotent.w idempotent.morphism.left idempotent.morphism.right
  idem_hom_idempotent comp_hom id_hom

def extend_to_completion (F : C ⥤ (idempotent D)) : (idempotent C) ⥤ (idempotent D) :=
{ obj := λ P,
  { X := (F.obj P.X).X,
    idem := (F.map P.idem).hom,
    w' := begin rw [←comp_hom, ←functor.map_comp, idempotent.w], end },
  map := λ X Y f, { hom := (F.map f.hom).hom } }

end idempotent_completion
end category_theory


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

namespace Lean.Meta

inductive CongrArgKind where
  | /-- It is a parameter for the congruence theorem, the parameter occurs in the left and right hand sides. -/
    fixed
  | /--
      It is not a parameter for the congruence theorem, the lemma was specialized for this parameter.
      This only happens if the parameter is a subsingleton/proposition, and other parameters depend on it. -/
    fixedNoParam
  | /--
      The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `eq_i : a_i = b_i`.
      `a_i` and `b_i` represent the left and right hand sides, and `eq_i` is a proof for their equality. -/
    eq
  | /--
      The congr-simp theorems contains only one parameter for this kind of argument, and congr theorems contains two.
      They correspond to arguments that are subsingletons/propositions. -/
    cast
  | /--
     The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `eq_i : HEq a_i b_i`.
     `a_i` and `b_i` represent the left and right hand sides, and `eq_i` is a proof for their heterogeneous equality. -/
    heq

structure CongrTheorem where
  type     : Expr
  proof    : Expr
  argKinds : Array CongrArgKind

private def addPrimeToFVarUserNames (ys : Array Expr) (lctx : LocalContext) : LocalContext := do
  let mut lctx := lctx
  for y in ys do
    let decl := lctx.getFVar! y
    lctx := lctx.setUserName decl.fvarId (decl.userName.appendAfter "'")
  return lctx

private def setBinderInfosD (ys : Array Expr) (lctx : LocalContext) : LocalContext := do
  let mut lctx := lctx
  for y in ys do
    let decl := lctx.getFVar! y
    lctx := lctx.setBinderInfo decl.fvarId BinderInfo.default
  return lctx

partial def mkHCongrWithArity (f : Expr) (numArgs : Nat) : MetaM CongrTheorem := do
  let fType ← inferType f
  forallBoundedTelescope fType numArgs fun xs xType =>
  forallBoundedTelescope fType numArgs fun ys yType => do
    if xs.size != numArgs then
      throwError "failed to generate hcongr theorem, insufficient number of arguments"
    else
      let lctx := addPrimeToFVarUserNames ys (← getLCtx) |> setBinderInfosD ys |> setBinderInfosD xs
      withLCtx lctx (← getLocalInstances) do
      withNewEqs xs ys fun eqs argKinds => do
        let mut hs := #[]
        for x in xs, y in ys, eq in eqs do
          hs := hs.push x |>.push y |>.push eq
        let xType := xType.consumeAutoOptParam
        let yType := yType.consumeAutoOptParam
        let resultType ← if xType == yType then mkEq xType yType else mkHEq xType yType
        let congrType ← mkForallFVars hs resultType
        return {
          type  := congrType
          proof := (← mkProof congrType)
          argKinds
        }
where
  withNewEqs {α} (xs ys : Array Expr) (k : Array Expr → Array CongrArgKind → MetaM α) : MetaM α :=
    let rec loop (i : Nat) (eqs : Array Expr) (kinds : Array CongrArgKind) := do
      if  i < xs.size then
        let x := xs[i]
        let y := ys[i]
        let xType := (← inferType x).consumeAutoOptParam
        let yType := (← inferType y).consumeAutoOptParam
        if xType == yType then
          withLocalDeclD ((`e).appendIndexAfter (i+1)) (← mkEq x y) fun h =>
            loop (i+1) (eqs.push h) (kinds.push CongrArgKind.eq)
        else
          withLocalDeclD ((`e).appendIndexAfter (i+1)) (← mkHEq x y) fun h =>
            loop (i+1) (eqs.push h) (kinds.push CongrArgKind.heq)
      else
        k eqs kinds
    loop 0 #[] #[]

  mkProof (type : Expr) : MetaM Expr := do
    if let some (_, lhs, _) := type.eq? then
      mkEqRefl lhs
    else if let some (_, lhs, _, _) := type.heq? then
      mkHEqRefl lhs
    else
      forallBoundedTelescope type (some 1) fun a type =>
      let a := a[0]
      forallBoundedTelescope type (some 1) fun b motive =>
      let b := b[0]
      let type := type.bindingBody!.instantiate1 a
      withLocalDeclD motive.bindingName! motive.bindingDomain! fun eqPr => do
      let type := type.bindingBody!
      let motive := motive.bindingBody!
      let minor ← mkProof type
      let mut major := eqPr
      if (← whnf (← inferType eqPr)).isHEq then
        major ← mkEqOfHEq major
      let motive ← mkLambdaFVars #[b] motive
      mkLambdaFVars #[a, b, eqPr] (← mkEqNDRec motive minor major)

def mkHCongr (f : Expr) : MetaM CongrTheorem := do
  mkHCongrWithArity f (← getFunInfo f).getArity

end Lean.Meta


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import ring_theory.ideal.cotangent
import ring_theory.dedekind_domain.basic
import ring_theory.valuation.valuation_ring
import ring_theory.nakayama
/-!

# Equivalent conditions for DVR

In `discrete_valuation_ring.tfae`, we show that the following are equivalent for a
noetherian local domain `(R, m, k)`:
- `R` is a discrete valuation ring
- `R` is a valuation ring
- `R` is a dedekind domain
- `R` is integrally closed with a unique prime ideal
- `m` is principal
- `dimₖ m/m² = 1`
- Every nonzero ideal is a power of `m`.

-/

variables (R : Type*) [comm_ring R] (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]

open_locale discrete_valuation
open local_ring

open_locale big_operators

lemma exists_maximal_ideal_pow_eq_of_principal [is_noetherian_ring R] [local_ring R] [is_domain R]
  (h : ¬ is_field R) (h' : (maximal_ideal R).is_principal) (I : ideal R) (hI : I ≠ ⊥) :
    ∃ n : ℕ, I = (maximal_ideal R) ^ n :=
begin
  classical,
  unfreezingI { obtain ⟨x, hx : _ = ideal.span _⟩ := h' },
  by_cases hI' : I = ⊤, { use 0, rw [pow_zero, hI', ideal.one_eq_top] },
  have H : ∀ r : R, ¬ (is_unit r) ↔ x ∣ r :=
    λ r, (set_like.ext_iff.mp hx r).trans ideal.mem_span_singleton,
  have : x ≠ 0,
  { rintro rfl,
    apply ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
    simp [hx] },
  have hx' := discrete_valuation_ring.irreducible_of_span_eq_maximal_ideal x this hx,
  have H' : ∀ r : R, r ≠ 0 → r ∈ nonunits R → ∃ (n : ℕ), associated (x ^ n) r,
  { intros r hr₁ hr₂,
    obtain ⟨f, hf₁, rfl, hf₂⟩ := (wf_dvd_monoid.not_unit_iff_exists_factors_eq r hr₁).mp hr₂,
    have : ∀ b ∈ f, associated x b,
    { intros b hb,
      exact irreducible.associated_of_dvd hx' (hf₁ b hb) ((H b).mp (hf₁ b hb).1) },
    clear hr₁ hr₂ hf₁,
    induction f using multiset.induction with fa fs fh,
    { exact (hf₂ rfl).elim },
    rcases eq_or_ne fs ∅ with rfl|hf',
    { use 1,
      rw [pow_one, multiset.prod_cons, multiset.empty_eq_zero, multiset.prod_zero, mul_one],
      exact this _ (multiset.mem_cons_self _ _) },
    { obtain ⟨n, hn⟩ := fh hf' (λ b hb, this _ (multiset.mem_cons_of_mem hb)),
      use n + 1,
      rw [pow_add, multiset.prod_cons, mul_comm, pow_one],
      exact associated.mul_mul (this _ (multiset.mem_cons_self _ _)) hn } },
  have : ∃ n : ℕ, x ^ n ∈ I,
  { obtain ⟨r, hr₁, hr₂⟩ : ∃ r : R, r ∈ I ∧ r ≠ 0,
    { by_contra h, push_neg at h, apply hI, rw eq_bot_iff, exact h },
    obtain ⟨n, u, rfl⟩ := H' r hr₂ (le_maximal_ideal hI' hr₁),
    use n,
    rwa [← I.unit_mul_mem_iff_mem u.is_unit, mul_comm] },
  use nat.find this,
  apply le_antisymm,
  { change ∀ s ∈ I, s ∈ _,
    by_contra hI'',
    push_neg at hI'',
    obtain ⟨s, hs₁, hs₂⟩ := hI'',
    apply hs₂,
    by_cases hs₃ : s = 0, { rw hs₃, exact zero_mem _ },
    obtain ⟨n, u, rfl⟩ := H' s hs₃ (le_maximal_ideal hI' hs₁),
    rw [mul_comm, ideal.unit_mul_mem_iff_mem _ u.is_unit] at ⊢ hs₁,
    apply ideal.pow_le_pow (nat.find_min' this hs₁),
    apply ideal.pow_mem_pow,
    exact (H _).mpr (dvd_refl _) },
  { rw [hx, ideal.span_singleton_pow, ideal.span_le, set.singleton_subset_iff],
    exact nat.find_spec this }
end

lemma maximal_ideal_is_principal_of_is_dedekind_domain
  [local_ring R] [is_domain R] [is_dedekind_domain R] : (maximal_ideal R).is_principal :=
begin
  classical,
  by_cases ne_bot : maximal_ideal R = ⊥,
  { rw ne_bot, apply_instance },
  obtain ⟨a, ha₁, ha₂⟩ : ∃ a ∈ maximal_ideal R, a ≠ (0 : R),
  { by_contra h', push_neg at h', apply ne_bot, rwa eq_bot_iff },
  have hle : ideal.span {a} ≤ maximal_ideal R,
  { rwa [ideal.span_le, set.singleton_subset_iff] },
  have : (ideal.span {a}).radical = maximal_ideal R,
  { rw ideal.radical_eq_Inf,
    apply le_antisymm,
    { exact Inf_le ⟨hle, infer_instance⟩ },
    { refine le_Inf (λ I hI, (eq_maximal_ideal $
        is_dedekind_domain.dimension_le_one _ (λ e, ha₂ _) hI.2).ge),
      rw [← ideal.span_singleton_eq_bot, eq_bot_iff, ← e], exact hI.1 } },
  have : ∃ n, maximal_ideal R ^ n ≤ ideal.span {a},
  { rw ← this, apply ideal.exists_radical_pow_le_of_fg, exact is_noetherian.noetherian _ },
  cases hn : nat.find this,
  { have := nat.find_spec this,
    rw [hn, pow_zero, ideal.one_eq_top] at this,
    exact (ideal.is_maximal.ne_top infer_instance (eq_top_iff.mpr $ this.trans hle)).elim },
  obtain ⟨b, hb₁, hb₂⟩ : ∃ b ∈ maximal_ideal R ^ n, ¬ b ∈ ideal.span {a},
  { by_contra h', push_neg at h', rw nat.find_eq_iff at hn,
    exact hn.2 n n.lt_succ_self (λ x hx, not_not.mp (h' x hx)) },
  have hb₃ : ∀ m ∈ maximal_ideal R, ∃ k : R, k * a = b * m,
  { intros m hm, rw ← ideal.mem_span_singleton', apply nat.find_spec this,
    rw [hn, pow_succ'], exact ideal.mul_mem_mul hb₁ hm },
  have hb₄ : b ≠ 0,
  { rintro rfl, apply hb₂, exact zero_mem _ },
  let K := fraction_ring R,
  let x : K := algebra_map R K b / algebra_map R K a,
  let M := submodule.map (algebra.of_id R K).to_linear_map (maximal_ideal R),
  have ha₃ : algebra_map R K a ≠ 0 := is_fraction_ring.to_map_eq_zero_iff.not.mpr ha₂,
  by_cases hx : ∀ y ∈ M, x * y ∈ M,
  { have := is_integral_of_smul_mem_submodule M _ _ x hx,
    { obtain ⟨y, e⟩ := is_integrally_closed.algebra_map_eq_of_integral this,
      refine (hb₂ (ideal.mem_span_singleton'.mpr ⟨y, _⟩)).elim,
      apply is_fraction_ring.injective R K,
      rw [map_mul, e, div_mul_cancel _ ha₃] },
    { rw submodule.ne_bot_iff, refine ⟨_, ⟨a, ha₁, rfl⟩, _⟩,
      exact is_fraction_ring.to_map_eq_zero_iff.not.mpr ha₂ },
    { apply submodule.fg.map, exact is_noetherian.noetherian _ } },
  { have : (M.map (distrib_mul_action.to_linear_map R K x)).comap
      (algebra.of_id R K).to_linear_map = ⊤,
    { by_contra h, apply hx,
      rintros m' ⟨m, hm, (rfl : algebra_map R K m = m')⟩,
      obtain ⟨k, hk⟩ := hb₃ m hm,
      have hk' : x * algebra_map R K m = algebra_map R K k,
      { rw [← mul_div_right_comm, ← map_mul, ← hk, map_mul, mul_div_cancel _ ha₃] },
      exact ⟨k, le_maximal_ideal h ⟨_, ⟨_, hm, rfl⟩, hk'⟩, hk'.symm⟩ },
    obtain ⟨y, hy₁, hy₂⟩ : ∃ y ∈ maximal_ideal R, b * y = a,
    { rw [ideal.eq_top_iff_one, submodule.mem_comap] at this,
      obtain ⟨_, ⟨y, hy, rfl⟩, hy' : x * algebra_map R K y = algebra_map R K 1⟩ := this,
      rw [map_one, ← mul_div_right_comm, div_eq_one_iff_eq ha₃, ← map_mul] at hy',
      exact ⟨y, hy, is_fraction_ring.injective R K hy'⟩ },
    refine ⟨⟨y, _⟩⟩,
    apply le_antisymm,
    { intros m hm, obtain ⟨k, hk⟩ := hb₃ m hm, rw [← hy₂, mul_comm, mul_assoc] at hk,
      rw [← mul_left_cancel₀ hb₄ hk, mul_comm], exact ideal.mem_span_singleton'.mpr ⟨_, rfl⟩ },
    { rwa [submodule.span_le, set.singleton_subset_iff] } }
end

lemma discrete_valuation_ring.tfae [is_noetherian_ring R] [local_ring R] [is_domain R]
  (h : ¬ is_field R) :
  tfae [discrete_valuation_ring R,
    valuation_ring R,
    is_dedekind_domain R,
    is_integrally_closed R ∧ ∃! P : ideal R, P ≠ ⊥ ∧ P.is_prime,
    (maximal_ideal R).is_principal,
    finite_dimensional.finrank (residue_field R) (cotangent_space R) = 1,
    ∀ I ≠ ⊥, ∃ n : ℕ, I = (maximal_ideal R) ^ n] :=
begin
  have ne_bot := ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
  classical,
  rw finrank_eq_one_iff',
  tfae_have : 1 → 2,
  { introI _, apply_instance },
  tfae_have : 2 → 1,
  { introI _,
    haveI := is_bezout.to_gcd_domain R,
    haveI : unique_factorization_monoid R := ufm_of_gcd_of_wf_dvd_monoid,
    apply discrete_valuation_ring.of_ufd_of_unique_irreducible,
    { obtain ⟨x, hx₁, hx₂⟩ := ring.exists_not_is_unit_of_not_is_field h,
      obtain ⟨p, hp₁, hp₂⟩ := wf_dvd_monoid.exists_irreducible_factor hx₂ hx₁,
      exact ⟨p, hp₁⟩ },
    { exact valuation_ring.unique_irreducible } },
  tfae_have : 1 → 4,
  { introI H,
    exact ⟨infer_instance, ((discrete_valuation_ring.iff_pid_with_one_nonzero_prime R).mp H).2⟩ },
  tfae_have : 4 → 3,
  { rintros ⟨h₁, h₂⟩, exact ⟨infer_instance, λ I hI hI', unique_of_exists_unique h₂
      ⟨ne_bot, infer_instance⟩ ⟨hI, hI'⟩ ▸ maximal_ideal.is_maximal R, h₁⟩ },
  tfae_have : 3 → 5,
  { introI h, exact maximal_ideal_is_principal_of_is_dedekind_domain R },
  tfae_have : 5 → 6,
  { rintro ⟨x, hx⟩,
    have : x ∈ maximal_ideal R := by { rw hx, exact submodule.subset_span (set.mem_singleton x) },
    let x' : maximal_ideal R := ⟨x, this⟩,
    use submodule.quotient.mk x',
    split,
    { intro e,
      rw submodule.quotient.mk_eq_zero at e,
      apply ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
      apply submodule.eq_bot_of_le_smul_of_le_jacobson_bot (maximal_ideal R),
      { exact ⟨{x}, (finset.coe_singleton x).symm ▸ hx.symm⟩ },
      { conv_lhs { rw hx },
        rw submodule.mem_smul_top_iff at e,
        rwa [submodule.span_le, set.singleton_subset_iff] },
      { rw local_ring.jacobson_eq_maximal_ideal (⊥ : ideal R) bot_ne_top, exact le_refl _ } },
    { refine λ w, quotient.induction_on' w $ λ y, _,
      obtain ⟨y, hy⟩ := y,
      rw [hx, submodule.mem_span_singleton] at hy,
      obtain ⟨a, rfl⟩ := hy,
      exact ⟨ideal.quotient.mk _ a, rfl⟩ } },
  tfae_have : 6 → 5,
  { rintro ⟨x, hx, hx'⟩,
    induction x using quotient.induction_on',
    use x,
    apply le_antisymm,
    swap, { rw [submodule.span_le, set.singleton_subset_iff], exact x.prop },
    have h₁ : (ideal.span {x} : ideal R) ⊔ maximal_ideal R ≤
      ideal.span {x} ⊔ (maximal_ideal R) • (maximal_ideal R),
    { refine sup_le le_sup_left _,
      rintros m hm,
      obtain ⟨c, hc⟩ := hx' (submodule.quotient.mk ⟨m, hm⟩),
      induction c using quotient.induction_on',
      rw ← sub_sub_cancel (c * x) m,
      apply sub_mem _ _,
      { apply_instance },
      { refine ideal.mem_sup_left (ideal.mem_span_singleton'.mpr ⟨c, rfl⟩) },
      { have := (submodule.quotient.eq _).mp hc,
        rw [submodule.mem_smul_top_iff] at this,
        exact ideal.mem_sup_right this } },
    have h₂ : maximal_ideal R ≤ (⊥ : ideal R).jacobson,
    { rw local_ring.jacobson_eq_maximal_ideal, exacts [le_refl _, bot_ne_top] },
    have := submodule.smul_sup_eq_smul_sup_of_le_smul_of_le_jacobson
      (is_noetherian.noetherian _) h₂ h₁,
    rw [submodule.bot_smul, sup_bot_eq] at this,
    rw [← sup_eq_left, eq_comm],
    exact le_sup_left.antisymm (h₁.trans $ le_of_eq this) },
  tfae_have : 5 → 7,
  { exact exists_maximal_ideal_pow_eq_of_principal R h },
  tfae_have : 7 → 2,
  { rw valuation_ring.iff_ideal_total,
    intro H,
    constructor,
    intros I J,
    by_cases hI : I = ⊥, { subst hI,  left, exact bot_le },
    by_cases hJ : J = ⊥, { subst hJ, right, exact bot_le },
    obtain ⟨n, rfl⟩ := H I hI,
    obtain ⟨m, rfl⟩ := H J hJ,
    cases le_total m n with h' h',
    {  left, exact ideal.pow_le_pow h' },
    { right, exact ideal.pow_le_pow h' } },
  tfae_finish,
end


import tactic.lint
import algebra.ring.basic

def foo1 (n m : ℕ) : ℕ := n + 1
def foo2 (n m : ℕ) : m = m := by refl
lemma foo3 (n m : ℕ) : ℕ := n - m
lemma foo.foo (n m : ℕ) : n ≥ n := le_refl n
instance bar.bar : has_add ℕ := by apply_instance  -- we don't check the name of instances
lemma foo.bar (ε > 0) : ε = ε := rfl -- >/≥ is allowed in binders (and in fact, in all hypotheses)
-- section
-- local attribute [instance, priority 1001] classical.prop_decidable
-- lemma foo4 : (if 3 = 3 then 1 else 2) = 1 := if_pos (by refl)
-- end

open tactic

meta def fold_over_with_cond {α} (l : list declaration) (tac : declaration → tactic (option α)) :
  tactic (list (declaration × α)) :=
l.mmap_filter $ λ d, option.map (λ x, (d, x)) <$> tac d

run_cmd do
  let t := name × list ℕ,
  e ← get_env,
  let l := e.filter (λ d, e.in_current_file d.to_name ∧ ¬ d.is_auto_or_internal e),
  l2 ← fold_over_with_cond l (return ∘ check_unused_arguments),
  guard $ l2.length = 4,
  let l2 : list t := l2.map $ λ x, ⟨x.1.to_name, x.2⟩,
  guard $ (⟨`foo1, [2]⟩ : t) ∈ l2,
  guard $ (⟨`foo2, [1]⟩ : t) ∈ l2,
  guard $ (⟨`foo.foo, [2]⟩ : t) ∈ l2,
  guard $ (⟨`foo.bar, [2]⟩ : t) ∈ l2,
  l2 ← fold_over_with_cond l linter.def_lemma.test,
  guard $ l2.length = 2,
  let l2 : list (name × _) := l2.map $ λ x, ⟨x.1.to_name, x.2⟩,
  guard $ ∃(x ∈ l2), (x : name × _).1 = `foo2,
  guard $ ∃(x ∈ l2), (x : name × _).1 = `foo3,
  l3 ← fold_over_with_cond l linter.dup_namespace.test,
  guard $ l3.length = 1,
  guard $ ∃(x ∈ l3), (x : declaration × _).1.to_name = `foo.foo,
  l4 ← fold_over_with_cond l linter.ge_or_gt.test,
  guard $ l4.length = 1,
  guard $ ∃(x ∈ l4), (x : declaration × _).1.to_name = `foo.foo,
  -- guard $ ∃(x ∈ l4), (x : declaration × _).1.to_name = `foo4,
  (_, s) ← lint ff,
  guard $ "/- (slow tests skipped) -/\n".is_suffix_of s.to_string,
  (_, s2) ← lint tt,
  guard $ s.to_string ≠ s2.to_string,
  skip

/- check customizability and nolint -/

meta def dummy_check (d : declaration) : tactic (option string) :=
return $ if d.to_name.last = "foo" then some "gotcha!" else none

meta def linter.dummy_linter : linter :=
{ test := dummy_check,
  auto_decls := ff,
  no_errors_found := "found nothing",
  errors_found := "found something" }

@[nolint dummy_linter]
def bar.foo : (if 3 = 3 then 1 else 2) = 1 := if_pos (by refl)

run_cmd do
  (_, s) ← lint tt lint_verbosity.medium [`linter.dummy_linter] tt,
  guard $ "/- found something: -/\n#print foo.foo /- gotcha! -/\n".is_suffix_of s.to_string

def incorrect_type_class_argument_test {α : Type} (x : α) [x = x] [decidable_eq α] [group α] :
  unit := ()

run_cmd do
  d ← get_decl `incorrect_type_class_argument_test,
  x ← linter.incorrect_type_class_argument.test d,
  guard $ x = some "These are not classes. argument 3: [_inst_1 : x = x]"

section
def impossible_instance_test {α β : Type} [add_group α] : has_add α := infer_instance
local attribute [instance] impossible_instance_test
run_cmd do
  d ← get_decl `impossible_instance_test,
  x ← linter.impossible_instance.test d,
  guard $ x = some "Impossible to infer argument 2: {β : Type}"

def dangerous_instance_test {α β γ : Type} [ring α] [add_comm_group β] [has_coe α β]
  [has_inv γ] : has_add β := infer_instance
local attribute [instance] dangerous_instance_test
run_cmd do
  d ← get_decl `dangerous_instance_test,
  x ← linter.dangerous_instance.test d,
  guard $ x = some
    "The following arguments become metavariables. argument 1: {α : Type}, argument 3: {γ : Type}"
end

section
def foo_has_mul {α} [has_mul α] : has_mul α := infer_instance
local attribute [instance, priority 1] foo_has_mul
run_cmd do
  d ← get_decl `has_mul,
  some s ← fails_quickly 20 d,
  guard $ s = "type-class inference timed out"
local attribute [instance, priority 10000] foo_has_mul
run_cmd do
  d ← get_decl `has_mul,
  some s ← fails_quickly 3000 d,
  guard $ "maximum class-instance resolution depth has been reached".is_prefix_of s
end

instance beta_redex_test {α} [monoid α] : (λ (X : Type), has_mul X) α := ⟨(*)⟩
run_cmd do
  d ← get_decl `beta_redex_test,
  x ← linter.instance_priority.test d,
  guard $ x = some "set priority below 1000"

/- test of `apply_to_fresh_variables` -/
run_cmd do
  e ← mk_const `id,
  e2 ← apply_to_fresh_variables e,
  type_check e2,
  `(@id %%α %%a) ← instantiate_mvars e2,
  expr.sort (level.succ $ level.mvar u) ← infer_type α,
  skip


import ..utils.util
import all

section main
open tactic

meta def main : io unit := do {
  args ← io.cmdline_args,
  -- let dest : string := ((args.nth 0).get_or_else "./data/mathlib_decls.log"),
  dest ← args.nth_except 0 "dest",
  let ignore_decls_fn : environment → declaration → bool :=
    (λ e d, declaration.is_auto_or_internal e d || bnot (declaration.is_theorem d) || d.to_name.is_aux),
  f ← io.mk_file_handle dest io.mode.append,

  let mk_decl_msg (d : declaration) : tactic string := do {
    decl_type ← do {
      (format.to_string ∘ format.flatten) <$> tactic.pp d.type
    },
    let msg : json := json.object $ [
      ("decl_name", d.to_name.to_string),
      ("decl_type", (decl_type : string))
    ],
    pure $ json.unparse msg
  },

  io.run_tactic' $ do {
    env ← get_env,
    decls ← list.filter (λ d, !(ignore_decls_fn env d)) <$> lint_mathlib_decls,
    for_ decls $ λ decl, do {
      msg ← mk_decl_msg decl,
      tactic.unsafe_run_io $ io.fs.put_str_ln f msg,
      tactic.trace format!"DECL: {decl.to_name}"
    }
  }
}

end main


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Transform
import Lean.Meta.Tactic.Injection
import Lean.Meta.Tactic.Apply
import Lean.Meta.Tactic.Refl
import Lean.Meta.Tactic.Cases
import Lean.Meta.Tactic.Subst
import Lean.Meta.Tactic.Simp.Types
import Lean.Meta.Tactic.Assumption

namespace Lean.Meta

private def mkAnd? (args : Array Expr) : Option Expr := Id.run do
  if args.isEmpty then
    return none
  else
    let mut result := args.back
    for arg in args.reverse[1:] do
      result := mkApp2 (mkConst ``And) arg result
    return result

def elimOptParam (type : Expr) : CoreM Expr := do
  Core.transform type fun e =>
    if e.isAppOfArity  ``optParam 2 then
      return TransformStep.visit (e.getArg! 0)
    else
      return .continue

private partial def mkInjectiveTheoremTypeCore? (ctorVal : ConstructorVal) (useEq : Bool) : MetaM (Option Expr) := do
  let us := ctorVal.levelParams.map mkLevelParam
  let type ← elimOptParam ctorVal.type
  forallBoundedTelescope type ctorVal.numParams fun params type =>
  forallTelescope type fun args1 resultType => do
    let jp (args2 args2New : Array Expr) : MetaM (Option Expr) := do
      let lhs := mkAppN (mkAppN (mkConst ctorVal.name us) params) args1
      let rhs := mkAppN (mkAppN (mkConst ctorVal.name us) params) args2
      let eq ← mkEq lhs rhs
      let mut eqs := #[]
      for arg1 in args1, arg2 in args2 do
        let arg1Type ← inferType arg1
        if !(← isProp arg1Type) && arg1 != arg2 then
          eqs := eqs.push (← mkEqHEq arg1 arg2)
      if let some andEqs := mkAnd? eqs then
        let result ← if useEq then
          mkEq eq andEqs
        else
          mkArrow eq andEqs
        mkForallFVars params (← mkForallFVars args1 (← mkForallFVars args2New result))
      else
        return none
    let rec mkArgs2 (i : Nat) (type : Expr) (args2 args2New : Array Expr) : MetaM (Option Expr) := do
      if h : i < args1.size then
        match (← whnf type) with
        | Expr.forallE n d b _ =>
          let arg1 := args1.get ⟨i, h⟩
          if arg1.occurs resultType then
            mkArgs2 (i + 1) (b.instantiate1 arg1) (args2.push arg1) args2New
          else
            withLocalDecl n (if useEq then BinderInfo.default else BinderInfo.implicit) d fun arg2 =>
              mkArgs2 (i + 1) (b.instantiate1 arg2) (args2.push arg2) (args2New.push arg2)
        | _ => throwError "unexpected constructor type for '{ctorVal.name}'"
      else
        jp args2 args2New
    if useEq then
      mkArgs2 0 type #[] #[]
    else
      withNewBinderInfos (params.map fun param => (param.fvarId!, BinderInfo.implicit)) <|
      withNewBinderInfos (args1.map fun arg1 => (arg1.fvarId!, BinderInfo.implicit)) <|
        mkArgs2 0 type #[] #[]

private def mkInjectiveTheoremType? (ctorVal : ConstructorVal) : MetaM (Option Expr) :=
  mkInjectiveTheoremTypeCore? ctorVal false

private def injTheoremFailureHeader (ctorName : Name) : MessageData :=
  m!"failed to prove injectivity theorem for constructor '{ctorName}', use 'set_option genInjectivity false' to disable the generation"

private def throwInjectiveTheoremFailure {α} (ctorName : Name) (mvarId : MVarId) : MetaM α :=
  throwError "{injTheoremFailureHeader ctorName}{indentD <| MessageData.ofGoal mvarId}"

private def solveEqOfCtorEq (ctorName : Name) (mvarId : MVarId) (h : FVarId) : MetaM Unit := do
  match (← injection mvarId h) with
  | InjectionResult.solved => unreachable!
  | InjectionResult.subgoal mvarId .. =>
    (←  mvarId.splitAnd).forM fun mvarId =>
      unless (← mvarId.assumptionCore) do
        throwInjectiveTheoremFailure ctorName mvarId

private def mkInjectiveTheoremValue (ctorName : Name) (targetType : Expr) : MetaM Expr :=
  forallTelescopeReducing targetType fun xs type => do
    let mvar ← mkFreshExprSyntheticOpaqueMVar type
    solveEqOfCtorEq ctorName mvar.mvarId! xs.back.fvarId!
    mkLambdaFVars xs mvar

def mkInjectiveTheoremNameFor (ctorName : Name) : Name :=
  ctorName ++ `inj

private def mkInjectiveTheorem (ctorVal : ConstructorVal) : MetaM Unit := do
  let some type ← mkInjectiveTheoremType? ctorVal
    | return ()
  let value ← mkInjectiveTheoremValue ctorVal.name type
  let name := mkInjectiveTheoremNameFor ctorVal.name
  addDecl <| Declaration.thmDecl {
    name
    levelParams := ctorVal.levelParams
    type        := (← instantiateMVars type)
    value       := (← instantiateMVars value)
  }

def mkInjectiveEqTheoremNameFor (ctorName : Name) : Name :=
  ctorName ++ `injEq

private def mkInjectiveEqTheoremType? (ctorVal : ConstructorVal) : MetaM (Option Expr) :=
  mkInjectiveTheoremTypeCore? ctorVal true

private def mkInjectiveEqTheoremValue (ctorName : Name) (targetType : Expr) : MetaM Expr := do
  forallTelescopeReducing targetType fun xs type => do
    let mvar ← mkFreshExprSyntheticOpaqueMVar type
    let [mvarId₁, mvarId₂] ← mvar.mvarId!.apply (mkConst ``Eq.propIntro)
      | throwError "unexpected number of subgoals when proving injective theorem for constructor '{ctorName}'"
    let (h, mvarId₁) ← mvarId₁.intro1
    let (_, mvarId₂) ← mvarId₂.intro1
    solveEqOfCtorEq ctorName mvarId₁ h
    let mvarId₂ ← mvarId₂.casesAnd
    if let some mvarId₂ ← mvarId₂.substEqs then
      try mvarId₂.refl catch _ => throwError (injTheoremFailureHeader ctorName)
    mkLambdaFVars xs mvar

private def mkInjectiveEqTheorem (ctorVal : ConstructorVal) : MetaM Unit := do
  let some type ← mkInjectiveEqTheoremType? ctorVal
    | return ()
  let value ← mkInjectiveEqTheoremValue ctorVal.name type
  let name := mkInjectiveEqTheoremNameFor ctorVal.name
  addDecl <| Declaration.thmDecl {
    name
    levelParams := ctorVal.levelParams
    type        := (← instantiateMVars type)
    value       := (← instantiateMVars value)
  }
  addSimpTheorem (ext := simpExtension) name (post := true) (inv := false) AttributeKind.global (prio := eval_prio default)

register_builtin_option genInjectivity : Bool := {
  defValue := true
  descr    := "generate injectivity theorems for inductive datatype constructors"
}

def mkInjectiveTheorems (declName : Name) : MetaM Unit := do
  if (← getEnv).contains ``Eq.propIntro && genInjectivity.get (← getOptions) &&  !(← isInductivePredicate declName) then
    let info ← getConstInfoInduct declName
    unless info.isUnsafe do
      for ctor in info.ctors do
        let ctorVal ← getConstInfoCtor ctor
        if ctorVal.numFields > 0 then
          mkInjectiveTheorem ctorVal
          mkInjectiveEqTheorem ctorVal

end Lean.Meta