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

! This file was ported from Lean 3 source module tactic.to_additive
! leanprover-community/mathlib commit bfe9e712c5178b227be330f7c10c2e91ab48eaf8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.TransformDecl
import Mathbin.Tactic.Algebra
import Mathbin.Tactic.Lint.Basic
import Mathbin.Tactic.Alias

/-!
# Transport multiplicative to additive

This file defines an attribute `to_additive` that can be used to
automatically transport theorems and definitions (but not inductive
types and structures) from a multiplicative theory to an additive theory.

Usage information is contained in the doc string of `to_additive.attr`.

### Missing features

* Automatically transport structures and other inductive types.

* For structures, automatically generate theorems like `group α ↔
  add_group (additive α)`.
-/

namespace ToAdditive

open Tactic

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
section PerformanceHack

-- see Note [user attribute parameters]
attribute [local semireducible] reflected

/-- Temporarily change the `has_reflect` instance for `name`. -/
@[local instance]
unsafe def hacky_name_reflect : has_reflect Name := fun n => q((id $(expr.const n []) : Name))
#align to_additive.hacky_name_reflect to_additive.hacky_name_reflect

/-- An auxiliary attribute used to store the names of the additive versions of declarations
that have been processed by `to_additive`. -/
@[user_attribute]
unsafe def aux_attr : user_attribute (name_map Name) Name
    where
  Name := `to_additive_aux
  descr := "Auxiliary attribute for `to_additive`. DON'T USE IT"
  parser := failed
  cache_cfg :=
    ⟨fun ns =>
      ns.foldlM
        (fun dict n' => do
          let n :=
            match n' with
            | Name.mk_string s pre => if s = "_to_additive" then pre else n'
            | _ => n'
          let param ← aux_attr.get_param_untyped n'
          pure <| dict n param)
        mk_name_map,
      []⟩
#align to_additive.aux_attr to_additive.aux_attr

end PerformanceHack

section ExtraAttributes

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.many -/
/-- An attribute that tells `@[to_additive]` that certain arguments of this definition are not
involved when using `@[to_additive]`.
This helps the heuristic of `@[to_additive]` by also transforming definitions if `ℕ` or another
fixed type occurs as one of these arguments.
-/
@[user_attribute]
unsafe def ignore_args_attr : user_attribute (name_map <| List ℕ) (List ℕ)
    where
  Name := `to_additive_ignore_args
  descr :=
    "Auxiliary attribute for `to_additive` stating that certain arguments are not additivized."
  cache_cfg :=
    ⟨fun ns =>
      ns.foldlM
        (fun dict n => do
          let param ← ignore_args_attr.get_param_untyped n
          -- see Note [user attribute parameters]
              return <|
              dict n (param expr.to_nat).iget)
        mk_name_map,
      []⟩
  parser := parser.many lean.parser.small_nat
#align to_additive.ignore_args_attr to_additive.ignore_args_attr

/--
An attribute that is automatically added to declarations tagged with `@[to_additive]`, if needed.

This attribute tells which argument is the type where this declaration uses the multiplicative
structure. If there are multiple argument, we typically tag the first one.
If this argument contains a fixed type, this declaration will note be additivized.
See the Heuristics section of `to_additive.attr` for more details.

If a declaration is not tagged, it is presumed that the first argument is relevant.
`@[to_additive]` uses the function `to_additive.first_multiplicative_arg` to automatically tag
declarations. It is ok to update it manually if the automatic tagging made an error.

Implementation note: we only allow exactly 1 relevant argument, even though some declarations
(like `prod.group`) have multiple arguments with a multiplicative structure on it.
The reason is that whether we additivize a declaration is an all-or-nothing decision, and if
we will not be able to additivize declarations that (e.g.) talk about multiplication on `ℕ × α`
anyway.

Warning: adding `@[to_additive_reorder]` with an equal or smaller number than the number in this
attribute is currently not supported.
-/
@[user_attribute]
unsafe def relevant_arg_attr : user_attribute (name_map ℕ) ℕ
    where
  Name := `to_additive_relevant_arg
  descr :=
    "Auxiliary attribute for `to_additive` stating which arguments are the types with a " ++
      "multiplicative structure."
  cache_cfg :=
    ⟨fun ns =>
      ns.foldlM
        (fun dict n => do
          let param ← relevant_arg_attr.get_param_untyped n
          -- see Note [user attribute parameters]
              -- we subtract 1 from the values provided by the user.
              return <|
              dict n <| param)
        mk_name_map,
      []⟩
  parser := lean.parser.small_nat
#align to_additive.relevant_arg_attr to_additive.relevant_arg_attr

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.many -/
/-- An attribute that stores all the declarations that needs their arguments reordered when
applying `@[to_additive]`. Currently, we only support swapping consecutive arguments.
The list of the natural numbers contains the positions of the first of the two arguments
to be swapped.
If the first two arguments are swapped, the first two universe variables are also swapped.
Example: `@[to_additive_reorder 1 4]` swaps the first two arguments and the arguments in
positions 4 and 5.
-/
@[user_attribute]
unsafe def reorder_attr : user_attribute (name_map <| List ℕ) (List ℕ)
    where
  Name := `to_additive_reorder
  descr := "Auxiliary attribute for `to_additive` that stores arguments that need to be reordered."
  cache_cfg :=
    ⟨fun ns =>
      ns.foldlM
        (fun dict n => do
          let param ← reorder_attr.get_param_untyped n
          -- see Note [user attribute parameters]
              return <|
              dict n (param expr.to_nat).iget)
        mk_name_map,
      []⟩
  parser := do
    let l ← parser.many lean.parser.small_nat
    guard (l (· ≠ 0)) <|> exceptional.fail "The reorder positions must be positive"
    return l
#align to_additive.reorder_attr to_additive.reorder_attr

end ExtraAttributes

/-- Find the first argument of `nm` that has a multiplicative type-class on it.
Returns 1 if there are no types with a multiplicative class as arguments.
E.g. `prod.group` returns 1, and `pi.has_one` returns 2.
-/
unsafe def first_multiplicative_arg (nm : Name) : tactic ℕ := do
  let d ← get_decl nm
  let (es, _) := d.type.pi_binders
  let l ←
    es.mapIdxM fun n bi => do
        let tgt := bi.type.pi_codomain
        let n_bi := bi.type.pi_binders.fst.length
        let tt ← has_attribute' `to_additive tgt.get_app_fn.const_name |
          return none
        let n2 := tgt.get_app_args.headI.get_app_fn.match_var.map fun m => n + n_bi - m
        return <| n2
  let l := l.reduceOption
  return <| if l = [] then 1 else l min l
#align to_additive.first_multiplicative_arg to_additive.first_multiplicative_arg

/-- A command that can be used to have future uses of `to_additive` change the `src` namespace
to the `tgt` namespace.

For example:
```
run_cmd to_additive.map_namespace `quotient_group `quotient_add_group
```

Later uses of `to_additive` on declarations in the `quotient_group` namespace will be created
in the `quotient_add_group` namespaces.
-/
unsafe def map_namespace (src tgt : Name) : Tactic := do
  let n := src.mk_string "_to_additive"
  let decl := declaration.thm n [] q(Unit) (pure (reflect ()))
  add_decl decl
  aux_attr n tgt tt
#align to_additive.map_namespace to_additive.map_namespace

/-- `value_type` is the type of the arguments that can be provided to `to_additive`.
`to_additive.parser` parses the provided arguments:
* `replace_all`: replace all multiplicative declarations, do not use the heuristic.
* `trace`: output the generated additive declaration.
* `tgt : name`: the name of the target (the additive declaration).
* `doc`: an optional doc string.
* if `allow_auto_name` is `ff` (default) then `@[to_additive]` will check whether the given name
  can be auto-generated.
-/
structure ValueType : Type where
  replaceAll : Bool
  trace : Bool
  tgt : Name
  doc : Option String
  allowAutoName : Bool
  deriving has_reflect, Inhabited
#align to_additive.value_type ToAdditive.ValueType

/-- `add_comm_prefix x s` returns `"comm_" ++ s` if `x = tt` and `s` otherwise. -/
unsafe def add_comm_prefix : Bool → String → String
  | tt, s => "comm_" ++ s
  | ff, s => s
#align to_additive.add_comm_prefix to_additive.add_comm_prefix

/-- Dictionary used by `to_additive.guess_name` to autogenerate names. -/
unsafe def tr : Bool → List String → List String
  | is_comm, "one" :: "le" :: s => add_comm_prefix is_comm "nonneg" :: tr false s
  | is_comm, "one" :: "lt" :: s => add_comm_prefix is_comm "pos" :: tr false s
  | is_comm, "le" :: "one" :: s => add_comm_prefix is_comm "nonpos" :: tr false s
  | is_comm, "lt" :: "one" :: s => add_comm_prefix is_comm "neg" :: tr false s
  | is_comm, "mul" :: "single" :: s => add_comm_prefix is_comm "single" :: tr false s
  | is_comm, "mul" :: "support" :: s => add_comm_prefix is_comm "support" :: tr false s
  | is_comm, "mul" :: "tsupport" :: s => add_comm_prefix is_comm "tsupport" :: tr false s
  | is_comm, "mul" :: "indicator" :: s => add_comm_prefix is_comm "indicator" :: tr false s
  | is_comm, "mul" :: s => add_comm_prefix is_comm "add" :: tr false s
  | is_comm, "smul" :: s => add_comm_prefix is_comm "vadd" :: tr false s
  | is_comm, "inv" :: s => add_comm_prefix is_comm "neg" :: tr false s
  | is_comm, "div" :: s => add_comm_prefix is_comm "sub" :: tr false s
  | is_comm, "one" :: s => add_comm_prefix is_comm "zero" :: tr false s
  | is_comm, "prod" :: s => add_comm_prefix is_comm "sum" :: tr false s
  | is_comm, "finprod" :: s => add_comm_prefix is_comm "finsum" :: tr false s
  | is_comm, "pow" :: s => add_comm_prefix is_comm "nsmul" :: tr false s
  | is_comm, "npow" :: s => add_comm_prefix is_comm "nsmul" :: tr false s
  | is_comm, "zpow" :: s => add_comm_prefix is_comm "zsmul" :: tr false s
  | is_comm, "is" :: "square" :: s => add_comm_prefix is_comm "even" :: tr false s
  | is_comm, "is" :: "scalar" :: "tower" :: s =>
    add_comm_prefix is_comm "vadd_assoc_class" :: tr false s
  | is_comm, "is" :: "central" :: "scalar" :: s =>
    add_comm_prefix is_comm "is_central_vadd" :: tr false s
  | is_comm, "is" :: "regular" :: s => add_comm_prefix is_comm "is_add_regular" :: tr false s
  | is_comm, "is" :: "left" :: "regular" :: s =>
    add_comm_prefix is_comm "is_add_left_regular" :: tr false s
  | is_comm, "is" :: "right" :: "regular" :: s =>
    add_comm_prefix is_comm "is_add_right_regular" :: tr false s
  | is_comm, "division" :: "monoid" :: s =>
    "subtraction" :: add_comm_prefix is_comm "monoid" :: tr false s
  | is_comm, "monoid" :: s => ("add_" ++ add_comm_prefix is_comm "monoid") :: tr false s
  | is_comm, "submonoid" :: s => ("add_" ++ add_comm_prefix is_comm "submonoid") :: tr false s
  | is_comm, "group" :: s => ("add_" ++ add_comm_prefix is_comm "group") :: tr false s
  | is_comm, "subgroup" :: s => ("add_" ++ add_comm_prefix is_comm "subgroup") :: tr false s
  | is_comm, "semigroup" :: s => ("add_" ++ add_comm_prefix is_comm "semigroup") :: tr false s
  | is_comm, "magma" :: s => ("add_" ++ add_comm_prefix is_comm "magma") :: tr false s
  | is_comm, "haar" :: s => ("add_" ++ add_comm_prefix is_comm "haar") :: tr false s
  | is_comm, "prehaar" :: s => ("add_" ++ add_comm_prefix is_comm "prehaar") :: tr false s
  | is_comm, "unit" :: s => ("add_" ++ add_comm_prefix is_comm "unit") :: tr false s
  | is_comm, "units" :: s => ("add_" ++ add_comm_prefix is_comm "units") :: tr false s
  | is_comm, "comm" :: s => tr true s
  | is_comm, "root" :: s => add_comm_prefix is_comm "div" :: tr false s
  | is_comm, "rootable" :: s => add_comm_prefix is_comm "divisible" :: tr false s
  | is_comm, "prods" :: s => add_comm_prefix is_comm "sums" :: tr false s
  | is_comm, x :: s => add_comm_prefix is_comm x :: tr false s
  | tt, [] => ["comm"]
  | ff, [] => []
#align to_additive.tr to_additive.tr

/-- Autogenerate target name for `to_additive`. -/
unsafe def guess_name : String → String :=
  String.mapTokens ''' fun s =>
    String.intercalate (String.singleton '_') <| tr false (s.splitOn '_')
#align to_additive.guess_name to_additive.guess_name

/-- Return the provided target name or autogenerate one if one was not provided. -/
unsafe def target_name (src tgt : Name) (dict : name_map Name) (allow_auto_name : Bool) :
    tactic Name :=
  (if tgt.getPrefix ≠ Name.anonymous ∨ allow_auto_name then
      -- `tgt` is a full name
        pure
        tgt
    else
      match src with
      | Name.mk_string s pre => do
        let tgt_auto := guess_name s
        guard (tgt ≠ tgt_auto ∨ tgt = src) <|>
            trace
              ("`to_additive " ++ src ++ "`: correctly autogenerated target " ++
                    "name, you may remove the explicit " ++
                  tgt_auto ++
                " argument.")
        pure <| Name.mk_string (if tgt = Name.anonymous then tgt_auto else tgt) (pre dict)
      | _ => fail ("to_additive: can't transport " ++ src.toString)) >>=
    fun res =>
    if res = src ∧ tgt ≠ src then
      fail
        ("to_additive: can't transport " ++ src.toString ++
          " to itself.\nGive the desired additive name explicitly using `@[to_additive additive_name]`. ")
    else pure res
#align to_additive.target_name to_additive.target_name

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- the parser for the arguments to `to_additive`. -/
unsafe def parser : lean.parser ValueType := do
  let bang ← Option.isSome <$> parser.optional (tk "!")
  let ques ← Option.isSome <$> parser.optional (tk "?")
  let tgt ← parser.optional ident
  let e ← parser.optional texpr
  let doc ←
    match e with
      | some pe => some <$> (to_expr pe >>= eval_expr String : tactic String)
      | none => pure none
  return ⟨bang, ques, tgt Name.anonymous, doc, ff⟩
#align to_additive.parser to_additive.parser

private unsafe def proceed_fields_aux (src tgt : Name) (prio : ℕ)
    (f : Name → tactic (List String)) : Tactic := do
  let src_fields ← f src
  let tgt_fields ← f tgt
  guard (src_fields = tgt_fields) <|> fail ("Failed to map fields of " ++ src)
  (src_fields tgt_fields).mapM' fun names =>
      guard (names = names) <|> aux_attr (src names) (tgt names) tt prio
#align to_additive.proceed_fields_aux to_additive.proceed_fields_aux

/-- Add the `aux_attr` attribute to the structure fields of `src`
so that future uses of `to_additive` will map them to the corresponding `tgt` fields. -/
unsafe def proceed_fields (env : environment) (src tgt : Name) (prio : ℕ) : Tactic :=
  let aux := proceed_fields_aux src tgt prio
  do
  ((aux fun n => pure <| List.map Name.toString <| (env n).getD []) >>
        aux fun n => (List.map fun x : Name => "to_" ++ x) <$> get_tagged_ancestors n) >>
      aux fun n =>
        (env n).mapM fun cs =>
          match cs with
          | Name.mk_string s pre => (guard (pre = n) <|> fail "Bad constructor name") >> pure s
          | _ => fail "Bad constructor name"
#align to_additive.proceed_fields to_additive.proceed_fields

/-- The attribute `to_additive` can be used to automatically transport theorems
and definitions (but not inductive types and structures) from a multiplicative
theory to an additive theory.

To use this attribute, just write:

```
@[to_additive]
theorem mul_comm' {α} [comm_semigroup α] (x y : α) : x * y = y * x := comm_semigroup.mul_comm
```

This code will generate a theorem named `add_comm'`. It is also
possible to manually specify the name of the new declaration:

```
@[to_additive add_foo]
theorem foo := sorry
```

An existing documentation string will _not_ be automatically used, so if the theorem or definition
has a doc string, a doc string for the additive version should be passed explicitly to
`to_additive`.

```
/-- Multiplication is commutative -/
@[to_additive "Addition is commutative"]
theorem mul_comm' {α} [comm_semigroup α] (x y : α) : x * y = y * x := comm_semigroup.mul_comm
```

The transport tries to do the right thing in most cases using several
heuristics described below.  However, in some cases it fails, and
requires manual intervention.

If the declaration to be transported has attributes which need to be
copied to the additive version, then `to_additive` should come last:

```
@[simp, to_additive] lemma mul_one' {G : Type*} [group G] (x : G) : x * 1 = x := mul_one x
```

The following attributes are supported and should be applied correctly by `to_additive` to
the new additivized declaration, if they were present on the original one:
```
reducible, _refl_lemma, simp, norm_cast, instance, refl, symm, trans, elab_as_eliminator, no_rsimp,
continuity, ext, ematch, measurability, alias, _ext_core, _ext_lemma_core, nolint
```

The exception to this rule is the `simps` attribute, which should come after `to_additive`:

```
@[to_additive, simps]
instance {M N} [has_mul M] [has_mul N] : has_mul (M × N) := ⟨λ p q, ⟨p.1 * q.1, p.2 * q.2⟩⟩
```

Additionally the `mono` attribute is not handled by `to_additive` and should be applied afterwards
to both the original and additivized lemma.

## Implementation notes

The transport process generally works by taking all the names of
identifiers appearing in the name, type, and body of a declaration and
creating a new declaration by mapping those names to additive versions
using a simple string-based dictionary and also using all declarations
that have previously been labeled with `to_additive`.

In the `mul_comm'` example above, `to_additive` maps:
* `mul_comm'` to `add_comm'`,
* `comm_semigroup` to `add_comm_semigroup`,
* `x * y` to `x + y` and `y * x` to `y + x`, and
* `comm_semigroup.mul_comm'` to `add_comm_semigroup.add_comm'`.

### Heuristics

`to_additive` uses heuristics to determine whether a particular identifier has to be
mapped to its additive version. The basic heuristic is

* Only map an identifier to its additive version if its first argument doesn't
  contain any unapplied identifiers.

Examples:
* `@has_mul.mul ℕ n m` (i.e. `(n * m : ℕ)`) will not change to `+`, since its
  first argument is `ℕ`, an identifier not applied to any arguments.
* `@has_mul.mul (α × β) x y` will change to `+`. It's first argument contains only the identifier
  `prod`, but this is applied to arguments, `α` and `β`.
* `@has_mul.mul (α × ℤ) x y` will not change to `+`, since its first argument contains `ℤ`.

The reasoning behind the heuristic is that the first argument is the type which is "additivized",
and this usually doesn't make sense if this is on a fixed type.

There are some exceptions to this heuristic:

* Identifiers that have the `@[to_additive]` attribute are ignored.
  For example, multiplication in `↥Semigroup` is replaced by addition in `↥AddSemigroup`.
* If an identifier `d` has attribute `@[to_additive_relevant_arg n]` then the argument
  in position `n` is checked for a fixed type, instead of checking the first argument.
  `@[to_additive]` will automatically add the attribute `@[to_additive_relevant_arg n]` to a
  declaration when the first argument has no multiplicative type-class, but argument `n` does.
* If an identifier has attribute `@[to_additive_ignore_args n1 n2 ...]` then all the arguments in
  positions `n1`, `n2`, ... will not be checked for unapplied identifiers (start counting from 1).
  For example, `cont_mdiff_map` has attribute `@[to_additive_ignore_args 21]`, which means
  that its 21st argument `(n : ℕ∞)` can contain `ℕ`
  (usually in the form `has_top.top ℕ ...`) and still be additivized.
  So `@has_mul.mul (C^∞⟮I, N; I', G⟯) _ f g` will be additivized.

### Troubleshooting

If `@[to_additive]` fails because the additive declaration raises a type mismatch, there are
various things you can try.
The first thing to do is to figure out what `@[to_additive]` did wrong by looking at the type
mismatch error.

* Option 1: It additivized a declaration `d` that should remain multiplicative. Solution:
  * Make sure the first argument of `d` is a type with a multiplicative structure. If not, can you
    reorder the (implicit) arguments of `d` so that the first argument becomes a type with a
    multiplicative structure (and not some indexing type)?
    The reason is that `@[to_additive]` doesn't additivize declarations if their first argument
    contains fixed types like `ℕ` or `ℝ`. See section Heuristics.
    If the first argument is not the argument with a multiplicative type-class, `@[to_additive]`
    should have automatically added the attribute `@[to_additive_relevant_arg]` to the declaration.
    You can test this by running the following (where `d` is the full name of the declaration):
    ```
      run_cmd to_additive.relevant_arg_attr.get_param `d >>= tactic.trace
    ```
    The expected output is `n` where the `n`-th argument of `d` is a type (family) with a
    multiplicative structure on it. If you get a different output (or a failure), you could add
    the attribute `@[to_additive_relevant_arg n]` manually, where `n` is an argument with a
    multiplicative structure.
* Option 2: It didn't additivize a declaration that should be additivized.
  This happened because the heuristic applied, and the first argument contains a fixed type,
  like `ℕ` or `ℝ`. Solutions:
  * If the fixed type has an additive counterpart (like `↥Semigroup`), give it the `@[to_additive]`
    attribute.
  * If the fixed type occurs inside the `k`-th argument of a declaration `d`, and the
    `k`-th argument is not connected to the multiplicative structure on `d`, consider adding
    attribute `[to_additive_ignore_args k]` to `d`.
  * If you want to disable the heuristic and replace all multiplicative
    identifiers with their additive counterpart, use `@[to_additive!]`.
* Option 3: Arguments / universe levels are incorrectly ordered in the additive version.
  This likely only happens when the multiplicative declaration involves `pow`/`^`. Solutions:
  * Ensure that the order of arguments of all relevant declarations are the same for the
    multiplicative and additive version. This might mean that arguments have an "unnatural" order
    (e.g. `monoid.npow n x` corresponds to `x ^ n`, but it is convenient that `monoid.npow` has this
    argument order, since it matches `add_monoid.nsmul n x`.
  * If this is not possible, add the `[to_additive_reorder k]` to the multiplicative declaration
    to indicate that the `k`-th and `(k+1)`-st arguments are reordered in the additive version.

If neither of these solutions work, and `to_additive` is unable to automatically generate the
additive version of a declaration, manually write and prove the additive version.
Often the proof of a lemma/theorem can just be the multiplicative version of the lemma applied to
`multiplicative G`.
Afterwards, apply the attribute manually:

```
attribute [to_additive foo_add_bar] foo_bar
```

This will allow future uses of `to_additive` to recognize that
`foo_bar` should be replaced with `foo_add_bar`.

### Handling of hidden definitions

Before transporting the “main” declaration `src`, `to_additive` first
scans its type and value for names starting with `src`, and transports
them. This includes auxiliary definitions like `src._match_1`,
`src._proof_1`.

In addition to transporting the “main” declaration, `to_additive` transports
its equational lemmas and tags them as equational lemmas for the new declaration,
attributes present on the original equational lemmas are also transferred first (notably
`_refl_lemma`).

### Structure fields and constructors

If `src` is a structure, then `to_additive` automatically adds
structure fields to its mapping, and similarly for constructors of
inductive types.

For new structures this means that `to_additive` automatically handles
coercions, and for old structures it does the same, if ancestry
information is present in `@[ancestor]` attributes. The `ancestor`
attribute must come before the `to_additive` attribute, and it is
essential that the order of the base structures passed to `ancestor` matches
between the multiplicative and additive versions of the structure.

### Name generation

* If `@[to_additive]` is called without a `name` argument, then the
  new name is autogenerated.  First, it takes the longest prefix of
  the source name that is already known to `to_additive`, and replaces
  this prefix with its additive counterpart. Second, it takes the last
  part of the name (i.e., after the last dot), and replaces common
  name parts (“mul”, “one”, “inv”, “prod”) with their additive versions.

* Namespaces can be transformed using `map_namespace`. For example:
  ```
  run_cmd to_additive.map_namespace `quotient_group `quotient_add_group
  ```

  Later uses of `to_additive` on declarations in the `quotient_group`
  namespace will be created in the `quotient_add_group` namespaces.

* If `@[to_additive]` is called with a `name` argument `new_name`
  /without a dot/, then `to_additive` updates the prefix as described
  above, then replaces the last part of the name with `new_name`.

* If `@[to_additive]` is called with a `name` argument
  `new_namespace.new_name` /with a dot/, then `to_additive` uses this
  new name as is.

As a safety check, in the first case `to_additive` double checks
that the new name differs from the original one.

-/
@[user_attribute]
protected unsafe def attr : user_attribute Unit ValueType
    where
  Name := `to_additive
  descr := "Transport multiplicative to additive"
  parser := parser
  after_set :=
    some fun src prio persistent => do
      guard persistent <|> fail "`to_additive` can't be used as a local attribute"
      let env ← get_env
      let val ← attr.get_param src
      let dict ← aux_attr.get_cache
      let ignore ← ignore_args_attr.get_cache
      let relevant ← relevant_arg_attr.get_cache
      let reorder ← reorder_attr.get_cache
      let tgt ← target_name src val.tgt dict val.allowAutoName
      aux_attr src tgt tt
      let dict := dict.insert src tgt
      let first_mult_arg ← first_multiplicative_arg src
      when (first_mult_arg ≠ 1) <| relevant_arg_attr src first_mult_arg tt
      if env tgt then proceed_fields env src tgt prio
        else do
          transform_decl_with_prefix_dict dict val val relevant ignore reorder src tgt
              [`reducible, `_refl_lemma, `simp, `norm_cast, `instance, `refl, `symm, `trans,
                `elab_as_eliminator, `no_rsimp, `continuity, `ext, `ematch, `measurability, `alias,
                `_ext_core, `_ext_lemma_core, `nolint, `protected]
          whenM (has_attribute' `simps src)
              (trace "Apply the simps attribute after the to_additive attribute")
          whenM (has_attribute' `mono src)
              (trace <|
                "to_additive does not work with mono, apply the mono attribute to both" ++
                  "versions after")
          match val with
            | some doc => add_doc_string tgt doc
            | none => do
              let some alias_target ← tactic.alias.get_alias_target src |
                skip
              let alias_name := alias_target
              let some add_alias_name ← pure (dict alias_name) |
                skip
              add_doc_string tgt alias_target
#align to_additive.attr to_additive.attr

add_tactic_doc
  { Name := "to_additive"
    category := DocCategory.attr
    declNames := [`to_additive.attr]
    tags := ["transport", "environment", "lemma derivation"] }

end ToAdditive

-- map operations
attribute [to_additive] Mul One Inv Div

-- the following types are supported by `@[to_additive]` and mapped to themselves.
attribute [to_additive Empty] Empty

attribute [to_additive PEmpty] PEmpty

attribute [to_additive PUnit] PUnit

attribute [to_additive Unit] Unit

section Linter

open Tactic Expr

/-- A linter that checks that multiplicative and additive lemmas have both doc strings if one of
them has one -/
@[linter]
unsafe def linter.to_additive_doc : linter
    where
  test d := do
    let mul_name := d.to_name
    let dict ← to_additive.aux_attr.get_cache
    match dict mul_name with
      | some add_name => do
        let mul_doc ← try_core <| doc_string mul_name
        let add_doc ← try_core <| doc_string add_name
        match mul_doc, add_doc with
          | tt, ff =>
            return <|
              some <|
                "declaration has a docstring, but its additive version `" ++ add_name ++
                    "` does not. You might want to pass a string argument to " ++
                  "`to_additive`."
          | ff, tt =>
            return <|
              some <|
                "declaration has no docstring, but its additive version `" ++ add_name ++
                  "` does. You might want to add a doc string to the declaration."
          | _, _ => return none
      | none => return none
  auto_decls := false
  no_errors_found := "Multiplicative and additive lemmas are consistently documented"
  errors_found :=
    "The following declarations have doc strings, but their additive versions do " ++
      "not (or vice versa)."
  is_fast := false
#align linter.to_additive_doc linter.to_additive_doc

end Linter


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default

universes u l

namespace Mathlib

/--
A difference list is a function that, given a list, returns the original
contents of the difference list prepended to the given list.

This structure supports `O(1)` `append` and `concat` operations on lists, making it
useful for append-heavy uses such as logging and pretty printing.
-/
structure dlist (α : Type u) where
  apply : List α → List α
  invariant : ∀ (l : List α), apply l = apply [] ++ l

namespace dlist

/-- Convert a list to a dlist -/
def of_list {α : Type u} (l : List α) : dlist α := mk (append l) sorry

/-- Convert a lazily-evaluated list to a dlist -/
def lazy_of_list {α : Type u} (l : thunk (List α)) : dlist α :=
  mk (fun (xs : List α) => l Unit.unit ++ xs) sorry

/-- Convert a dlist to a list -/
def to_list {α : Type u} : dlist α → List α := sorry

/--  Create a dlist containing no elements -/
def empty {α : Type u} : dlist α := mk id sorry

/-- Create dlist with a single element -/
def singleton {α : Type u} (x : α) : dlist α := mk (List.cons x) sorry

/-- `O(1)` Prepend a single element to a dlist -/
def cons {α : Type u} (x : α) : dlist α → dlist α := sorry

/-- `O(1)` Append a single element to a dlist -/
def concat {α : Type u} (x : α) : dlist α → dlist α := sorry

/-- `O(1)` Append dlists -/
protected def append {α : Type u} : dlist α → dlist α → dlist α := sorry

protected instance has_append {α : Type u} : Append (dlist α) := { append := dlist.append }

theorem to_list_of_list {α : Type u} (l : List α) : to_list (of_list l) = l := sorry

theorem of_list_to_list {α : Type u} (l : dlist α) : of_list (to_list l) = l := sorry

theorem to_list_empty {α : Type u} : to_list empty = [] := sorry

theorem to_list_singleton {α : Type u} (x : α) : to_list (singleton x) = [x] := sorry

theorem to_list_append {α : Type u} (l₁ : dlist α) (l₂ : dlist α) :
    to_list (l₁ ++ l₂) = to_list l₁ ++ to_list l₂ :=
  sorry

theorem to_list_cons {α : Type u} (x : α) (l : dlist α) : to_list (cons x l) = x :: to_list l :=
  sorry

theorem to_list_concat {α : Type u} (x : α) (l : dlist α) :
    to_list (concat x l) = to_list l ++ [x] :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro, Johannes Hölzl, Simon Hudon, Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.basic
import Mathlib.control.traversable.lemmas
import Mathlib.control.traversable.instances
import Mathlib.PostPort

universes u_1 u u_2

namespace Mathlib

/-!
# Functoriality of `multiset`.
-/

namespace multiset

protected instance functor : Functor multiset :=
  { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β }

@[simp] theorem fmap_def {α' : Type u_1} {β' : Type u_1} {s : multiset α'} (f : α' → β') : f <$> s = map f s :=
  rfl

protected instance is_lawful_functor : is_lawful_functor multiset := sorry

def traverse {F : Type u → Type u} [Applicative F] [is_comm_applicative F] {α' : Type u} {β' : Type u} (f : α' → F β') : multiset α' → F (multiset β') :=
  quotient.lift (Functor.map coe ∘ traverse f) sorry

protected instance monad : Monad multiset :=
  { toApplicative :=
      { toFunctor := { map := Functor.map, mapConst := Functor.mapConst },
        toPure := { pure := fun (α : Type u_1) (x : α) => x ::ₘ 0 },
        toSeq :=
          { seq := fun (α β : Type u_1) (f : multiset (α → β)) (x : multiset α) => bind f fun (_x : α → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : multiset α) (b : multiset β) =>
                (fun (α β : Type u_1) (f : multiset (α → β)) (x : multiset α) => bind f fun (_x : α → β) => map _x x) β α
                  (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : multiset α) (b : multiset β) =>
                (fun (α β : Type u_1) (f : multiset (α → β)) (x : multiset α) => bind f fun (_x : α → β) => map _x x) β β
                  (map (function.const α id) a) b } },
    toBind := { bind := bind } }

@[simp] theorem pure_def {α : Type u_1} : pure = fun (x : α) => x ::ₘ 0 :=
  rfl

@[simp] theorem bind_def {α : Type u_1} {β : Type u_1} : bind = bind :=
  rfl

protected instance is_lawful_monad : is_lawful_monad multiset := sorry

@[simp] theorem lift_beta {α : Type u_1} {β : Type u_2} (x : List α) (f : List α → β) (h : ∀ (a b : List α), a ≈ b → f a = f b) : quotient.lift f h ↑x = f x :=
  quotient.lift_beta f h x

@[simp] theorem map_comp_coe {α : Type u_1} {β : Type u_1} (h : α → β) : Functor.map h ∘ coe = coe ∘ Functor.map h := sorry

theorem id_traverse {α : Type u_1} (x : multiset α) : traverse id.mk x = x := sorry

theorem comp_traverse {G : Type u_1 → Type u_1} {H : Type u_1 → Type u_1} [Applicative G] [Applicative H] [is_comm_applicative G] [is_comm_applicative H] {α : Type u_1} {β : Type u_1} {γ : Type u_1} (g : α → G β) (h : β → H γ) (x : multiset α) : traverse (functor.comp.mk ∘ Functor.map h ∘ g) x = functor.comp.mk (traverse h <$> traverse g x) := sorry

theorem map_traverse {G : Type u_1 → Type u_1} [Applicative G] [is_comm_applicative G] {α : Type u_1} {β : Type u_1} {γ : Type u_1} (g : α → G β) (h : β → γ) (x : multiset α) : Functor.map h <$> traverse g x = traverse (Functor.map h ∘ g) x := sorry

theorem traverse_map {G : Type u_1 → Type u_1} [Applicative G] [is_comm_applicative G] {α : Type u_1} {β : Type u_1} {γ : Type u_1} (g : α → β) (h : β → G γ) (x : multiset α) : traverse h (map g x) = traverse (h ∘ g) x := sorry

theorem naturality {G : Type u_1 → Type u_1} {H : Type u_1 → Type u_1} [Applicative G] [Applicative H] [is_comm_applicative G] [is_comm_applicative H] (eta : applicative_transformation G H) {α : Type u_1} {β : Type u_1} (f : α → G β) (x : multiset α) : coe_fn eta (multiset β) (traverse f x) = traverse (coe_fn eta β ∘ f) x := sorry


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

/-!
# `generalize_proofs`

A simple tactic to find and replace all occurrences of proof terms in the
context and goal with new variables.
-/

open interactive interactive.types lean.parser

namespace tactic

private meta def collect_proofs_in :
  expr → list expr → list name × list expr → tactic (list name × list expr)
| e ctx (ns, hs) :=
let go (tac : list name × list expr → tactic (list name × list expr)) :
  tactic (list name × list expr) :=
do t ← infer_type e,
   mcond (is_prop t) (do
     first (hs.map $ λ h, do
       t' ← infer_type h,
       is_def_eq t t',
       g ← target,
       change $ g.replace (λ a n, if a = e then some h else none),
       return (ns, hs)) <|>
     (let (n, ns) := (match ns with
        | [] := (`_x, [])
        | (n :: ns) := (n, ns)
        end : name × list name) in
      do generalize e n,
         h ← intro n,
         return (ns, h::hs)) <|> return (ns, hs)) (tac (ns, hs)) in
match e with
| expr.const _ _ := go return
| expr.local_const _ _ _ _ := do t ← infer_type e, collect_proofs_in t ctx (ns, hs)
| expr.mvar _ _ _ := do
  e ← instantiate_mvars e,
  match e with
  | expr.mvar _ _ _ := do t ← infer_type e, collect_proofs_in t ctx (ns, hs)
  | _ := collect_proofs_in e ctx (ns, hs)
  end
| expr.app f x :=
  go (λ nh, collect_proofs_in f ctx nh >>= collect_proofs_in x ctx)
| expr.lam n b d e :=
  go (λ nh, do
    nh ← collect_proofs_in d ctx nh,
    var ← mk_local' n b d,
    collect_proofs_in (expr.instantiate_var e var) (var::ctx) nh)
| expr.pi n b d e := do
  nh ← collect_proofs_in d ctx (ns, hs),
  var ← mk_local' n b d,
  collect_proofs_in (expr.instantiate_var e var) (var::ctx) nh
| expr.elet n t d e :=
  go (λ nh, do
    nh ← collect_proofs_in t ctx nh,
    nh ← collect_proofs_in d ctx nh,
    collect_proofs_in (expr.instantiate_var e d) ctx nh)
| expr.macro m l :=
  go (λ nh, mfoldl (λ x e, collect_proofs_in e ctx x) nh l)
| _ := return (ns, hs)
end

/-- Generalize proofs in the goal, naming them with the provided list. -/
meta def generalize_proofs (ns : list name) (loc : interactive.loc) : tactic unit :=
do intros_dep,
  hs ← local_context >>= mfilter is_proof,
  n ← loc.get_locals >>= revert_lst,
  t ← target,
  collect_proofs_in t [] (ns, hs),
  intron n <|> (intros $> ())

local postfix (name := parser.many) *:9001 := many

namespace interactive
/-- Generalize proofs in the goal, naming them with the provided list.

For example:
```lean
example : list.nth_le [1, 2] 1 dec_trivial = 2 :=
begin
  -- ⊢ [1, 2].nth_le 1 _ = 2
  generalize_proofs h,
  -- h : 1 < [1, 2].length
  -- ⊢ [1, 2].nth_le 1 h = 2
end
```
-/
meta def generalize_proofs : parse ident_* → parse location → tactic unit :=
tactic.generalize_proofs
end interactive

add_tactic_doc
{ name       := "generalize_proofs",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.generalize_proofs],
  tags       := ["context management"] }

end tactic


/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Basic
import Init.Data.Fin.Basic
import Init.Data.UInt
import Init.Data.Repr
import Init.Data.ToString.Basic
import Init.Util
universe u v w

namespace Array
variable {α : Type u}

@[extern "lean_mk_array"]
def mkArray {α : Type u} (n : Nat) (v : α) : Array α := {
  data := List.replicate n v
}

@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
  List.length_replicate ..

instance : EmptyCollection (Array α) := ⟨Array.empty⟩
instance : Inhabited (Array α) where
  default := Array.empty

def isEmpty (a : Array α) : Bool :=
  a.size = 0

def singleton (v : α) : Array α :=
  mkArray 1 v

/- Low-level version of `fget` which is as fast as a C array read.
   `Fin` values are represented as tag pointers in the Lean runtime. Thus,
   `fget` may be slightly slower than `uget`. -/
@[extern "lean_array_uget"]
def uget (a : @& Array α) (i : USize) (h : i.toNat < a.size) : α :=
  a.get ⟨i.toNat, h⟩

def back [Inhabited α] (a : Array α) : α :=
  a.get! (a.size - 1)

def get? (a : Array α) (i : Nat) : Option α :=
  if h : i < a.size then some (a.get ⟨i, h⟩) else none

def back? (a : Array α) : Option α :=
  a.get? (a.size - 1)

-- auxiliary declaration used in the equation compiler when pattern matching array literals.
abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
  a.get ⟨i, h₁.symm ▸ h₂⟩

@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
  List.length_set ..

@[simp] theorem size_push (a : Array α) (v : α) : (push a v).size = a.size + 1 :=
  List.length_concat ..

/- Low-level version of `fset` which is as fast as a C array fset.
   `Fin` values are represented as tag pointers in the Lean runtime. Thus,
   `fset` may be slightly slower than `uset`. -/
@[extern "lean_array_uset"]
def uset (a : Array α) (i : USize) (v : α) (h : i.toNat < a.size) : Array α :=
  a.set ⟨i.toNat, h⟩ v

@[extern "lean_array_fswap"]
def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
  let v₁ := a.get i
  let v₂ := a.get j
  let a'  := a.set i v₂
  a'.set (size_set a i v₂ ▸ j) v₁

@[extern "lean_array_swap"]
def swap! (a : Array α) (i j : @& Nat) : Array α :=
  if h₁ : i < a.size then
  if h₂ : j < a.size then swap a ⟨i, h₁⟩ ⟨j, h₂⟩
  else panic! "index out of bounds"
  else panic! "index out of bounds"

@[inline] def swapAt (a : Array α) (i : Fin a.size) (v : α) : α × Array α :=
  let e := a.get i
  let a := a.set i v
  (e, a)

@[inline]
def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
  if h : i < a.size then
    swapAt a ⟨i, h⟩ v
  else
    have : Inhabited α := ⟨v⟩
    panic! ("index " ++ toString i ++ " out of bounds")

@[extern "lean_array_pop"]
def pop (a : Array α) : Array α := {
  data := a.data.dropLast
}

def shrink (a : Array α) (n : Nat) : Array α :=
  let rec loop
    | 0,   a => a
    | n+1, a => loop n a.pop
  loop (a.size - n) a

@[inline]
def modifyM [Monad m] [Inhabited α] (a : Array α) (i : Nat) (f : α → m α) : m (Array α) := do
  if h : i < a.size then
    let idx : Fin a.size := ⟨i, h⟩
    let v                := a.get idx
    let a'               := a.set idx arbitrary
    let v ← f v
    pure <| a'.set (size_set a .. ▸ idx) v
  else
    pure a

@[inline]
def modify [Inhabited α] (a : Array α) (i : Nat) (f : α → α) : Array α :=
  Id.run <| a.modifyM i f

@[inline]
def modifyOp [Inhabited α] (self : Array α) (idx : Nat) (f : α → α) : Array α :=
  self.modify idx f

/-
  We claim this unsafe implementation is correct because an array cannot have more than `usizeSz` elements in our runtime.

  This kind of low level trick can be removed with a little bit of compiler support. For example, if the compiler simplifies `as.size < usizeSz` to true. -/
@[inline] unsafe def forInUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : m β :=
  let sz := USize.ofNat as.size
  let rec @[specialize] loop (i : USize) (b : β) : m β := do
    if i < sz then
      let a := as.uget i lcProof
      match (← f a b) with
      | ForInStep.done  b => pure b
      | ForInStep.yield b => loop (i+1) b
    else
      pure b
  loop 0 b

-- Move?
private theorem zeroLtOfLt : {a b : Nat} → a < b → 0 < b
  | 0,   _, h => h
  | a+1, b, h =>
    have : a < b := Nat.ltTrans (Nat.ltSuccSelf _) h
    zeroLtOfLt this

/- Reference implementation for `forIn` -/
@[implementedBy Array.forInUnsafe]
protected def forIn {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (b : β) (f : α → β → m (ForInStep β)) : m β :=
  let rec loop (i : Nat) (h : i ≤ as.size) (b : β) : m β := do
    match i, h with
    | 0,   _ => pure b
    | i+1, h =>
      have h' : i < as.size            := Nat.ltOfLtOfLe (Nat.ltSuccSelf i) h
      have : as.size - 1 < as.size     := Nat.subLt (zeroLtOfLt h') (by decide)
      have : as.size - 1 - i < as.size := Nat.ltOfLeOfLt (Nat.subLe (as.size - 1) i) this
      match (← f (as.get ⟨as.size - 1 - i, this⟩) b) with
      | ForInStep.done b  => pure b
      | ForInStep.yield b => loop i (Nat.leOfLt h') b
  loop as.size (Nat.leRefl _) b

instance : ForIn m (Array α) α where
  forIn := Array.forIn

/- See comment at forInUnsafe -/
@[inline]
unsafe def foldlMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : β → α → m β) (init : β) (as : Array α) (start := 0) (stop := as.size) : m β :=
  let rec @[specialize] fold (i : USize) (stop : USize) (b : β) : m β := do
    if i == stop then
      pure b
    else
      fold (i+1) stop (← f b (as.uget i lcProof))
  if start < stop then
    if stop ≤ as.size then
      fold (USize.ofNat start) (USize.ofNat stop) init
    else
      pure init
  else
    pure init

/- Reference implementation for `foldlM` -/
@[implementedBy foldlMUnsafe]
def foldlM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : β → α → m β) (init : β) (as : Array α) (start := 0) (stop := as.size) : m β :=
  let fold (stop : Nat) (h : stop ≤ as.size) :=
    let rec loop (i : Nat) (j : Nat) (b : β) : m β := do
      if hlt : j < stop then
        match i with
        | 0    => pure b
        | i'+1 =>
          loop i' (j+1) (← f b (as.get ⟨j, Nat.ltOfLtOfLe hlt h⟩))
      else
        pure b
    loop (stop - start) start init
  if h : stop ≤ as.size then
    fold stop h
  else
    fold as.size (Nat.leRefl _)

/- See comment at forInUnsafe -/
@[inline]
unsafe def foldrMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → β → m β) (init : β) (as : Array α) (start := as.size) (stop := 0) : m β :=
  let rec @[specialize] fold (i : USize) (stop : USize) (b : β) : m β := do
    if i == stop then
      pure b
    else
      fold (i-1) stop (← f (as.uget (i-1) lcProof) b)
  if start ≤ as.size then
    if stop < start then
      fold (USize.ofNat start) (USize.ofNat stop) init
    else
      pure init
  else if stop < as.size then
    fold (USize.ofNat as.size) (USize.ofNat stop) init
  else
    pure init

/- Reference implementation for `foldrM` -/
@[implementedBy foldrMUnsafe]
def foldrM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → β → m β) (init : β) (as : Array α) (start := as.size) (stop := 0) : m β :=
  let rec fold (i : Nat) (h : i ≤ as.size) (b : β) : m β := do
    if i == stop then
      pure b
    else match i, h with
      | 0, _   => pure b
      | i+1, h =>
        have : i < as.size := Nat.ltOfLtOfLe (Nat.ltSuccSelf _) h
        fold i (Nat.leOfLt this) (← f (as.get ⟨i, this⟩) b)
  if h : start ≤ as.size then
    if stop < start then
      fold start h init
    else
      pure init
  else if stop < as.size then
    fold as.size (Nat.leRefl _) init
  else
    pure init

/- See comment at forInUnsafe -/
@[inline]
unsafe def mapMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → m β) (as : Array α) : m (Array β) :=
  let sz := USize.ofNat as.size
  let rec @[specialize] map (i : USize) (r : Array NonScalar) : m (Array PNonScalar.{v}) := do
    if i < sz then
     let v    := r.uget i lcProof
     let r    := r.uset i arbitrary lcProof
     let vNew ← f (unsafeCast v)
     map (i+1) (r.uset i (unsafeCast vNew) lcProof)
    else
     pure (unsafeCast r)
  unsafeCast <| map 0 (unsafeCast as)

/- Reference implementation for `mapM` -/
@[implementedBy mapMUnsafe]
def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α → m β) (as : Array α) : m (Array β) :=
  as.foldlM (fun bs a => do let b ← f a; pure (bs.push b)) (mkEmpty as.size)

@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (f : Fin as.size → α → m β) : m (Array β) :=
  let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
    match i, inv with
    | 0,    _  => pure bs
    | i+1, inv =>
      have : j < as.size := by rw [← inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_left_comm]; apply Nat.leAddRight
      let idx : Fin as.size := ⟨j, this⟩
      have : i + (j + 1) = as.size := by rw [← inv, Nat.add_comm j 1, Nat.add_assoc]
      map i (j+1) this (bs.push (← f idx (as.get idx)))
  map as.size 0 rfl (mkEmpty as.size)

@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (f : α → m (Option β)) : m (Option β) := do
  for a in as do
    match (← f a) with
    | some b => return b
    | _      => pure ⟨⟩
  return none

@[inline]
def findM? {α : Type} {m : Type → Type} [Monad m] (as : Array α) (p : α → m Bool) : m (Option α) := do
  for a in as do
    if (← p a) then
      return a
  return none

@[inline]
def findIdxM? [Monad m] (as : Array α) (p : α → m Bool) : m (Option Nat) := do
  let mut i := 0
  for a in as do
    if (← p a) then
      return some i
    i := i + 1
  return none

@[inline]
unsafe def anyMUnsafe {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
  let rec @[specialize] any (i : USize) (stop : USize) : m Bool := do
    if i == stop then
      pure false
    else
      if (← p (as.uget i lcProof)) then
        pure true
      else
        any (i+1) stop
  if start < stop then
    if stop ≤ as.size then
      any (USize.ofNat start) (USize.ofNat stop)
    else
      pure false
  else
    pure false

@[implementedBy anyMUnsafe]
def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
  let any (stop : Nat) (h : stop ≤ as.size) :=
    let rec loop (i : Nat) (j : Nat) : m Bool := do
      if hlt : j < stop then
        match i with
        | 0    => pure false
        | i'+1 =>
          if (← p (as.get ⟨j, Nat.ltOfLtOfLe hlt h⟩)) then
            pure true
          else
            loop i' (j+1)
      else
        pure false
    loop (stop - start) start
  if h : stop ≤ as.size then
    any stop h
  else
    any as.size (Nat.leRefl _)

@[inline]
def allM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
  return !(← as.anyM fun v => return !(← p v))

@[inline]
def findSomeRevM? {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (as : Array α) (f : α → m (Option β)) : m (Option β) :=
  let rec @[specialize] find : (i : Nat) → i ≤ as.size → m (Option β)
    | 0,   h => pure none
    | i+1, h => do
      have : i < as.size := Nat.ltOfLtOfLe (Nat.ltSuccSelf _) h
      let r ← f (as.get ⟨i, this⟩)
      match r with
      | some v => pure r
      | none   =>
        have : i ≤ as.size := Nat.leOfLt this
        find i this
  find as.size (Nat.leRefl _)

@[inline]
def findRevM? {α : Type} {m : Type → Type w} [Monad m] (as : Array α) (p : α → m Bool) : m (Option α) :=
  as.findSomeRevM? fun a => return if (← p a) then some a else none

@[inline]
def forM {α : Type u} {m : Type v → Type w} [Monad m] (f : α → m PUnit) (as : Array α) (start := 0) (stop := as.size) : m PUnit :=
  as.foldlM (fun _ => f) ⟨⟩ start stop

@[inline]
def forRevM {α : Type u} {m : Type v → Type w} [Monad m] (f : α → m PUnit) (as : Array α) (start := as.size) (stop := 0) : m PUnit :=
  as.foldrM (fun a _ => f a) ⟨⟩ start stop

@[inline]
def foldl {α : Type u} {β : Type v} (f : β → α → β) (init : β) (as : Array α) (start := 0) (stop := as.size) : β :=
  Id.run <| as.foldlM f init start stop

@[inline]
def foldr {α : Type u} {β : Type v} (f : α → β → β) (init : β) (as : Array α) (start := as.size) (stop := 0) : β :=
  Id.run <| as.foldrM f init start stop

@[inline]
def map {α : Type u} {β : Type v} (f : α → β) (as : Array α) : Array β :=
  Id.run <| as.mapM f

@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size → α → β) : Array β :=
  Id.run <| as.mapIdxM f

@[inline]
def find? {α : Type} (as : Array α) (p : α → Bool) : Option α :=
  Id.run <| as.findM? p

@[inline]
def findSome? {α : Type u} {β : Type v} (as : Array α) (f : α → Option β) : Option β :=
  Id.run <| as.findSomeM? f

@[inline]
def findSome! {α : Type u} {β : Type v} [Inhabited β] (a : Array α) (f : α → Option β) : β :=
  match findSome? a f with
  | some b => b
  | none   => panic! "failed to find element"

@[inline]
def findSomeRev? {α : Type u} {β : Type v} (as : Array α) (f : α → Option β) : Option β :=
  Id.run <| as.findSomeRevM? f

@[inline]
def findRev? {α : Type} (as : Array α) (p : α → Bool) : Option α :=
  Id.run <| as.findRevM? p

@[inline]
def findIdx? {α : Type u} (as : Array α) (p : α → Bool) : Option Nat :=
  let rec loop (i : Nat) (j : Nat) (inv : i + j = as.size) : Option Nat :=
    if hlt : j < as.size then
      match i, inv with
      | 0, inv => by
        apply False.elim
        rw [Nat.zero_add] at inv
        rw [inv] at hlt
        exact absurd hlt (Nat.ltIrrefl _)
      | i+1, inv =>
        if p (as.get ⟨j, hlt⟩) then
          some j
        else
          have : i + (j+1) = as.size := by
            rw [← inv, Nat.add_comm j 1, Nat.add_assoc]
          loop i (j+1) this
    else
      none
  loop as.size 0 rfl

def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v

@[inline]
def any (as : Array α) (p : α → Bool) (start := 0) (stop := as.size) : Bool :=
  Id.run <| as.anyM p start stop

@[inline]
def all (as : Array α) (p : α → Bool) (start := 0) (stop := as.size) : Bool :=
  Id.run <| as.allM p start stop

def contains [BEq α] (as : Array α) (a : α) : Bool :=
  as.any fun b => a == b

def elem [BEq α] (a : α) (as : Array α) : Bool :=
  as.contains a

-- TODO(Leo): justify termination using wf-rec, and use `swap`
partial def reverse (as : Array α) : Array α :=
  let n   := as.size
  let mid := n / 2
  let rec rev (as : Array α) (i : Nat) :=
    if i < mid then
      rev (as.swap! i (n - i - 1)) (i+1)
    else
      as
  rev as 0

@[inline] def getEvenElems (as : Array α) : Array α :=
  (·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
    if even then
      (false, r.push a)
    else
      (true, r)

@[export lean_array_to_list]
def toList (as : Array α) : List α :=
  as.foldr List.cons []

instance {α : Type u} [Repr α] : Repr (Array α) where
  reprPrec a _ :=
    if a.size == 0 then
      "#[]"
    else
      Std.Format.bracketFill "#[" (@Std.Format.joinSep _ ⟨repr⟩ (toList a) ("," ++ Std.Format.line)) "]"

instance [ToString α] : ToString (Array α) where
  toString a := "#" ++ toString a.toList

protected def append (as : Array α) (bs : Array α) : Array α :=
  bs.foldl (init := as) fun r v => r.push v

instance : Append (Array α) := ⟨Array.append⟩

protected def appendList (as : Array α) (bs : List α) : Array α :=
  bs.foldl (init := as) fun r v => r.push v

instance : HAppend (Array α) (List α) (Array α) := ⟨Array.appendList⟩

@[inline]
def concatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β) :=
  as.foldlM (init := empty) fun bs a => do return bs ++ (← f a)

@[inline]
def concatMap (f : α → Array β) (as : Array α) : Array β :=
  as.foldl (init := empty) fun bs a => bs ++ f a

end Array

export Array (mkArray)

syntax "#[" sepBy(term, ", ") "]" : term

macro_rules
  | `(#[ $elems,* ]) => `(List.toArray [ $elems,* ])

namespace Array

-- TODO(Leo): cleanup
@[specialize]
partial def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : α → α → Bool) (i : Nat) : Bool :=
  if h : i < a.size then
     let aidx : Fin a.size := ⟨i, h⟩;
     let bidx : Fin b.size := ⟨i, hsz ▸ h⟩;
     match p (a.get aidx) (b.get bidx) with
     | true  => isEqvAux a b hsz p (i+1)
     | false => false
  else
    true

@[inline] def isEqv (a b : Array α) (p : α → α → Bool) : Bool :=
  if h : a.size = b.size then
    isEqvAux a b h p 0
  else
    false

instance [BEq α] : BEq (Array α) :=
  ⟨fun a b => isEqv a b BEq.beq⟩

@[inline]
def filter (p : α → Bool) (as : Array α) (start := 0) (stop := as.size) : Array α :=
  as.foldl (init := #[]) (start := start) (stop := stop) fun r a =>
    if p a then r.push a else r

@[inline]
def filterM [Monad m] (p : α → m Bool) (as : Array α) (start := 0) (stop := as.size) : m (Array α) :=
  as.foldlM (init := #[]) (start := start) (stop := stop) fun r a => do
    if (← p a) then r.push a else r

@[specialize]
def filterMapM [Monad m] (f : α → m (Option β)) (as : Array α) (start := 0) (stop := as.size) : m (Array β) :=
  as.foldlM (init := #[]) (start := start) (stop := stop) fun bs a => do
    match (← f a) with
    | some b => pure (bs.push b)
    | none   => pure bs

@[inline]
def filterMap (f : α → Option β) (as : Array α) (start := 0) (stop := as.size) : Array β :=
  Id.run <| as.filterMapM f (start := start) (stop := stop)

@[specialize]
def getMax? (as : Array α) (lt : α → α → Bool) : Option α :=
  if h : 0 < as.size then
    let a0 := as.get ⟨0, h⟩
    some <| as.foldl (init := a0) (start := 1) fun best a =>
      if lt best a then a else best
  else
    none

@[inline]
def partition (p : α → Bool) (as : Array α) : Array α × Array α := do
  let mut bs := #[]
  let mut cs := #[]
  for a in as do
    if p a then
      bs := bs.push a
    else
      cs := cs.push a
  return (bs, cs)

theorem ext (a b : Array α)
    (h₁ : a.size = b.size)
    (h₂ : (i : Nat) → (hi₁ : i < a.size) → (hi₂ : i < b.size) → a.get ⟨i, hi₁⟩ = b.get ⟨i, hi₂⟩)
    : a = b := by
  let rec extAux (a b : List α)
      (h₁ : a.length = b.length)
      (h₂ : (i : Nat) → (hi₁ : i < a.length) → (hi₂ : i < b.length) → a.get i hi₁ = b.get i hi₂)
      : a = b := by
    induction a generalizing b with
    | nil =>
      cases b with
      | nil       => rfl
      | cons b bs => rw [List.length_cons] at h₁; injection h₁
    | cons a as ih =>
      cases b with
      | nil => rw [List.length_cons] at h₁; injection h₁
      | cons b bs =>
        have hz₁ : 0 < (a::as).length := by rw [List.length_cons]; apply Nat.zeroLtSucc
        have hz₂ : 0 < (b::bs).length := by rw [List.length_cons]; apply Nat.zeroLtSucc
        have headEq : a = b := h₂ 0 hz₁ hz₂
        have h₁' : as.length = bs.length := by rw [List.length_cons, List.length_cons] at h₁; injection h₁; assumption
        have h₂' : (i : Nat) → (hi₁ : i < as.length) → (hi₂ : i < bs.length) → as.get i hi₁ = bs.get i hi₂ := by
          intro i hi₁ hi₂
          have hi₁' : i+1 < (a::as).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
          have hi₂' : i+1 < (b::bs).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
          have : (a::as).get (i+1) hi₁' = (b::bs).get (i+1) hi₂' := h₂ (i+1) hi₁' hi₂'
          apply this
        have tailEq : as = bs := ih bs h₁' h₂'
        rw [headEq, tailEq]
  cases a; cases b
  apply congrArg
  apply extAux
  assumption
  assumption

theorem extLit {n : Nat}
    (a b : Array α)
    (hsz₁ : a.size = n) (hsz₂ : b.size = n)
    (h : (i : Nat) → (hi : i < n) → a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
  Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ hi₂ => h i (hsz₁ ▸ hi₁)

end Array

-- CLEANUP the following code
namespace Array

partial def indexOfAux [BEq α] (a : Array α) (v : α) : Nat → Option (Fin a.size)
  | i =>
    if h : i < a.size then
      let idx : Fin a.size := ⟨i, h⟩;
      if a.get idx == v then some idx
      else indexOfAux a v (i+1)
    else none

def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
  indexOfAux a v 0

partial def eraseIdxAux : Nat → Array α → Array α
  | i, a =>
    if h : i < a.size then
      let idx  : Fin a.size := ⟨i, h⟩;
      let idx1 : Fin a.size := ⟨i - 1, by exact Nat.ltOfLeOfLt (Nat.predLe i) h⟩;
      eraseIdxAux (i+1) (a.swap idx idx1)
    else
      a.pop

def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
  eraseIdxAux (i.val + 1) a

def eraseIdx (a : Array α) (i : Nat) : Array α :=
  if i < a.size then eraseIdxAux (i+1) a else a

@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
  show ((a.set i (a.get j)).set (size_set a i _ ▸ j) (a.get i)).size = a.size
  rw [size_set, size_set]

@[simp] theorem size_pop (a : Array α) : a.pop.size = a.size - 1 :=
  List.length_dropLast ..

section
/- Instance for justifying `partial` declaration.
   We should be able to delete it as soon as we restore support for well-founded recursion. -/
instance eraseIdxSzAuxInstance (a : Array α) : Inhabited { r : Array α // r.size = a.size - 1 } where
  default := ⟨a.pop, size_pop a⟩

partial def eraseIdxSzAux (a : Array α) : ∀ (i : Nat) (r : Array α), r.size = a.size → { r : Array α // r.size = a.size - 1 }
  | i, r, heq =>
    if h : i < r.size then
      let idx  : Fin r.size := ⟨i, h⟩;
      let idx1 : Fin r.size := ⟨i - 1, by exact Nat.ltOfLeOfLt (Nat.predLe i) h⟩;
      eraseIdxSzAux a (i+1) (r.swap idx idx1) ((size_swap r idx idx1).trans heq)
    else
      ⟨r.pop, (size_pop r).trans (heq ▸ rfl)⟩
end

def eraseIdx' (a : Array α) (i : Fin a.size) : { r : Array α // r.size = a.size - 1 } :=
  eraseIdxSzAux a (i.val + 1) a rfl

def erase [BEq α] (as : Array α) (a : α) : Array α :=
  match as.indexOf? a with
  | none   => as
  | some i => as.feraseIdx i

partial def insertAtAux (i : Nat) : Array α → Nat → Array α
  | as, j =>
    if i == j then as
    else
      let as := as.swap! (j-1) j;
      insertAtAux i as (j-1)

/--
  Insert element `a` at position `i`.
  Pre: `i < as.size` -/
def insertAt (as : Array α) (i : Nat) (a : α) : Array α :=
  if i > as.size then panic! "invalid index"
  else
    let as := as.push a;
    as.insertAtAux i as.size

def toListLitAux (a : Array α) (n : Nat) (hsz : a.size = n) : ∀ (i : Nat), i ≤ a.size → List α → List α
  | 0,     hi, acc => acc
  | (i+1), hi, acc => toListLitAux a n hsz i (Nat.leOfSuccLe hi) (a.getLit i hsz (Nat.ltOfLtOfEq (Nat.ltOfLtOfLe (Nat.ltSuccSelf i) hi) hsz) :: acc)

def toArrayLit (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
  List.toArray <| toListLitAux a n hsz n (hsz ▸ Nat.leRefl _) []

theorem toArrayLitEq (a : Array α) (n : Nat) (hsz : a.size = n) : a = toArrayLit a n hsz :=
  -- TODO: this is painful to prove without proper automation
  sorry
  /-
  First, we need to prove
  ∀ i j acc, i ≤ a.size → (toListLitAux a n hsz (i+1) hi acc).index j = if j < i then a.getLit j hsz _ else acc.index (j - i)
  by induction

  Base case is trivial
  (j : Nat) (acc : List α) (hi : 0 ≤ a.size)
       |- (toListLitAux a n hsz 0 hi acc).index j = if j < 0 then a.getLit j hsz _ else acc.index (j - 0)
  ...  |- acc.index j = acc.index j

  Induction

  (j : Nat) (acc : List α) (hi : i+1 ≤ a.size)
        |- (toListLitAux a n hsz (i+1) hi acc).index j = if j < i + 1 then a.getLit j hsz _ else acc.index (j - (i + 1))
    ... |- (toListLitAux a n hsz i hi' (a.getLit i hsz _ :: acc)).index j = if j < i + 1 then a.getLit j hsz _ else acc.index (j - (i + 1))  * by def
    ... |- if j < i     then a.getLit j hsz _ else (a.getLit i hsz _ :: acc).index (j-i)    * by induction hypothesis
           =
           if j < i + 1 then a.getLit j hsz _ else acc.index (j - (i + 1))
  If j < i, then both are a.getLit j hsz _
  If j = i, then lhs reduces else-branch to (a.getLit i hsz _) and rhs is then-brachn (a.getLit i hsz _)
  If j >= i + 1, we use
     - j - i >= 1 > 0
     - (a::as).index k = as.index (k-1) If k > 0
     - j - (i + 1) = (j - i) - 1
     Then lhs = (a.getLit i hsz _ :: acc).index (j-i) = acc.index (j-i-1) = acc.index (j-(i+1)) = rhs

  With this proof, we have

  ∀ j, j < n → (toListLitAux a n hsz n _ []).index j = a.getLit j hsz _

  We also need

  - (toListLitAux a n hsz n _ []).length = n
  - j < n -> (List.toArray as).getLit j _ _ = as.index j

  Then using Array.extLit, we have that a = List.toArray <| toListLitAux a n hsz n _ []
  -/

partial def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) : Nat → Bool
  | i =>
    if h : i < as.size then
      let a := as.get ⟨i, h⟩;
      let b := bs.get ⟨i, Nat.ltOfLtOfLe h hle⟩;
      if a == b then
        isPrefixOfAux as bs hle (i+1)
      else
        false
    else
      true

/- Return true iff `as` is a prefix of `bs` -/
def isPrefixOf [BEq α] (as bs : Array α) : Bool :=
  if h : as.size ≤ bs.size then
    isPrefixOfAux as bs h 0
  else
    false

private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size → Bool
  | 0,   h => true
  | i+1, h =>
    have : i < as.size := Nat.ltTrans (Nat.ltSuccSelf _) h;
    a != as.get ⟨i, this⟩ && allDiffAuxAux as a i this

private partial def allDiffAux [BEq α] (as : Array α) : Nat → Bool
  | i =>
    if h : i < as.size then
      allDiffAuxAux as (as.get ⟨i, h⟩) i h && allDiffAux as (i+1)
    else
      true

def allDiff [BEq α] (as : Array α) : Bool :=
  allDiffAux as 0

@[specialize] partial def zipWithAux (f : α → β → γ) (as : Array α) (bs : Array β) : Nat → Array γ → Array γ
  | i, cs =>
    if h : i < as.size then
      let a := as.get ⟨i, h⟩;
      if h : i < bs.size then
        let b := bs.get ⟨i, h⟩;
        zipWithAux f as bs (i+1) <| cs.push <| f a b
      else
        cs
    else
      cs

@[inline] def zipWith (as : Array α) (bs : Array β) (f : α → β → γ) : Array γ :=
  zipWithAux f as bs 0 #[]

def zip (as : Array α) (bs : Array β) : Array (α × β) :=
  zipWith as bs Prod.mk

def unzip (as : Array (α × β)) : Array α × Array β :=
  as.foldl (init := (#[], #[])) fun (as, bs) (a, b) => (as.push a, bs.push b)

def split (as : Array α) (p : α → Bool) : Array α × Array α :=
  as.foldl (init := (#[], #[])) fun (as, bs) a =>
    if p a then (as.push a, bs) else (as, bs.push a)

end Array


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury Kudryashov.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.transform_decl
import Mathlib.tactic.algebra
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Transport multiplicative to additive

This file defines an attribute `to_additive` that can be used to
automatically transport theorems and definitions (but not inductive
types and structures) from a multiplicative theory to an additive theory.

Usage information is contained in the doc string of `to_additive.attr`.

### Missing features

* Automatically transport structures and other inductive types.

* For structures, automatically generate theorems like `group α ↔
  add_group (additive α)`.

* Rewrite rules for the last part of the name that work in more
  cases. E.g., we can replace `monoid` with `add_monoid` etc.
-/

namespace to_additive

/-- An auxiliary attribute used to store the names of the additive versions of declarations
that have been processed by `to_additive`. -/
/-- A command that can be used to have future uses of `to_additive` change the `src` namespace
to the `tgt` namespace.

For example:
```
run_cmd to_additive.map_namespace `quotient_group `quotient_add_group
```

Later uses of `to_additive` on declarations in the `quotient_group` namespace will be created
in the `quotient_add_group` namespaces.
-/
/-- `value_type` is the type of the arguments that can be provided to `to_additive`.
`to_additive.parser` parses the provided arguments into `name` for the target and an
optional doc string. -/
structure value_type where
  tgt : name
  doc : Option string

/-- `add_comm_prefix x s` returns `"comm_" ++ s` if `x = tt` and `s` otherwise. -/
/-- Dictionary used by `to_additive.guess_name` to autogenerate names. -/
/-- Autogenerate target name for `to_additive`. -/
/-- Return the provided target name or autogenerate one if one was not provided. -/
/-- the parser for the arguments to `to_additive` -/
/-- Add the `aux_attr` attribute to the structure fields of `src`
so that future uses of `to_additive` will map them to the corresponding `tgt` fields. -/
/--
The attribute `to_additive` can be used to automatically transport theorems
and definitions (but not inductive types and structures) from a multiplicative
theory to an additive theory.

To use this attribute, just write:

```
@[to_additive]
theorem mul_comm' {α} [comm_semigroup α] (x y : α) : x * y = y * x := comm_semigroup.mul_comm
```

This code will generate a theorem named `add_comm'`.  It is also
possible to manually specify the name of the new declaration, and
provide a documentation string:

```
@[to_additive add_foo "add_foo doc string"]
/-- foo doc string -/
end Mathlib


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

Binder elimination
-/
import order.complete_lattice

namespace old_conv
open tactic monad

meta instance : monad_fail old_conv :=
{ fail := λ α s, (λr e, tactic.fail (to_fmt s) : old_conv α), ..old_conv.monad }

meta instance : has_monad_lift tactic old_conv :=
⟨λα, lift_tactic⟩

meta instance (α : Type) : has_coe (tactic α) (old_conv α) :=
⟨monad_lift⟩

meta def current_relation : old_conv name := λr lhs, return ⟨r, lhs, none⟩

meta def head_beta : old_conv unit :=
λ r e, do n ← tactic.head_beta e, return ⟨(), n, none⟩

/- congr should forward data! -/
meta def congr_arg : old_conv unit → old_conv unit := congr_core (return ())
meta def congr_fun : old_conv unit → old_conv unit := λc, congr_core c (return ())

meta def congr_rule (congr : expr) (cs : list (list expr → old_conv unit)) :
  old_conv unit :=
λr lhs, do
  meta_rhs ← infer_type lhs >>= mk_meta_var, -- is maybe overly restricted for `heq`
  t ← mk_app r [lhs, meta_rhs],
  ((), meta_pr) ← solve_aux t (do
    apply congr,
    focus $ cs.map $ λc, (do
      xs ← intros,
      conversion (head_beta >> c xs)),
    done),
  rhs ← instantiate_mvars meta_rhs,
  pr ← instantiate_mvars meta_pr,
  return ⟨(), rhs, some pr⟩

meta def congr_binder (congr : name) (cs : expr → old_conv unit) : old_conv unit := do
  e ← mk_const congr,
  congr_rule e [λbs, do [b] ← return bs, cs b]

meta def funext' : (expr → old_conv unit) → old_conv unit := congr_binder ``_root_.funext

meta def propext' {α : Type} (c : old_conv α) : old_conv α := λr lhs, (do
  guard (r = `iff),
  c r lhs)
<|> (do
  guard (r = `eq),
  ⟨res, rhs, pr⟩ ← c `iff lhs,
  match pr with
  | some pr := return ⟨res, rhs, (expr.const `propext [] : expr) lhs rhs pr⟩
  | none := return ⟨res, rhs, none⟩
  end)

meta def apply (pr : expr) : old_conv unit :=
λ r e, do
  sl ← simp_lemmas.mk.add pr,
  apply_lemmas sl r e

meta def applyc (n : name) : old_conv unit :=
λ r e, do
  sl ← simp_lemmas.mk.add_simp n,
  apply_lemmas sl r e

meta def apply' (n : name) : old_conv unit := do
  e ← mk_const n,
  congr_rule e []

end old_conv

open expr tactic old_conv

/- Binder elimination:

We assume a binder `B : p → Π (α : Sort u), (α → t) → t`, where `t` is a type depending on `p`.
Examples:
  ∃: there is no `p` and `t` is `Prop`.
  ⨅, ⨆: here p is `β` and `[complete_lattice β]`, `p` is `β`

Problem: ∀x, _ should be a binder, but is not a constant!

Provide a mechanism to rewrite:

  B (x : α) ..x.. (h : x = t), p x  =  B ..x/t.., p t

Here ..x.. are binders, maybe also some constants which provide commutativity rules with `B`.

-/

meta structure binder_eq_elim :=
(match_binder  : expr → tactic (expr × expr))    -- returns the bound type and body
(adapt_rel     : old_conv unit → old_conv unit)          -- optionally adapt `eq` to `iff`
(apply_comm    : old_conv unit)                      -- apply commutativity rule
(apply_congr   : (expr → old_conv unit) → old_conv unit) -- apply congruence rule
(apply_elim_eq : old_conv unit)                      -- (B (x : β) (h : x = t), s x) = s t

meta def binder_eq_elim.check_eq (b : binder_eq_elim) (x : expr) : expr → tactic unit
| `(@eq %%β %%l %%r) := guard ((l = x ∧ ¬ x.occurs r) ∨ (r = x ∧ ¬ x.occurs l))
| _ := fail "no match"

meta def binder_eq_elim.pull (b : binder_eq_elim) (x : expr) : old_conv unit := do
  (β, f) ← lhs >>= (lift_tactic ∘ b.match_binder),
  guard (¬ x.occurs β)
  <|> b.check_eq x β
  <|> (do
    b.apply_congr $ λx, binder_eq_elim.pull,
    b.apply_comm)

meta def binder_eq_elim.push (b : binder_eq_elim) : old_conv unit :=
  b.apply_elim_eq
<|> (do
  b.apply_comm,
  b.apply_congr $ λx, binder_eq_elim.push)
<|> (do
  b.apply_congr $ b.pull,
  binder_eq_elim.push)

meta def binder_eq_elim.check (b : binder_eq_elim) (x : expr) : expr → tactic unit
| e := do
  (β, f) ← b.match_binder e,
  b.check_eq x β
  <|> (do
    (lam n bi d bd) ← return f,
    x ← mk_local' n bi d,
    binder_eq_elim.check $ bd.instantiate_var x)

meta def binder_eq_elim.old_conv (b : binder_eq_elim) : old_conv unit := do
  (β, f) ← lhs >>= (lift_tactic ∘ b.match_binder),
  (lam n bi d bd) ← return f,
  x ← mk_local' n bi d,
  b.check x (bd.instantiate_var x),
  b.adapt_rel b.push

theorem {u v} exists_elim_eq_left {α : Sort u} (a : α) (p : Π(a':α), a' = a → Prop) :
  (∃(a':α)(h : a' = a), p a' h) ↔ p a rfl :=
⟨λ⟨a', ⟨h, p_h⟩⟩, match a', h, p_h with ._, rfl, h := h end, λh, ⟨a, rfl, h⟩⟩

theorem {u v} exists_elim_eq_right {α : Sort u} (a : α) (p : Π(a':α), a = a' → Prop) :
  (∃(a':α)(h : a = a'), p a' h) ↔ p a rfl :=
⟨λ⟨a', ⟨h, p_h⟩⟩, match a', h, p_h with ._, rfl, h := h end, λh, ⟨a, rfl, h⟩⟩

meta def exists_eq_elim : binder_eq_elim :=
{ match_binder  := λe, (do `(@Exists %%β %%f) ← return e, return (β, f)),
  adapt_rel     := propext',
  apply_comm    := applyc ``exists_comm,
  apply_congr   := congr_binder ``exists_congr,
  apply_elim_eq := apply' ``exists_elim_eq_left <|> apply' ``exists_elim_eq_right }

theorem {u v} forall_comm {α : Sort u} {β : Sort v} (p : α → β → Prop) :
  (∀a b, p a b) ↔ (∀b a, p a b) :=
⟨assume h b a, h a b, assume h b a, h a b⟩

theorem {u v} forall_elim_eq_left {α : Sort u} (a : α) (p : Π(a':α), a' = a → Prop) :
  (∀(a':α)(h : a' = a), p a' h) ↔ p a rfl :=
⟨λh, h a rfl, λh a' h_eq, match a', h_eq with ._, rfl := h end⟩

theorem {u v} forall_elim_eq_right {α : Sort u} (a : α) (p : Π(a':α), a = a' → Prop) :
  (∀(a':α)(h : a = a'), p a' h) ↔ p a rfl :=
⟨λh, h a rfl, λh a' h_eq, match a', h_eq with ._, rfl := h end⟩

meta def forall_eq_elim : binder_eq_elim :=
{ match_binder  := λe, (do (expr.pi n bi d bd) ← return e, return (d, expr.lam n bi d bd)),
  adapt_rel     := propext',
  apply_comm    := applyc ``forall_comm,
  apply_congr   := congr_binder ``forall_congr,
  apply_elim_eq := apply' ``forall_elim_eq_left <|> apply' ``forall_elim_eq_right }

meta def supr_eq_elim : binder_eq_elim :=
{ match_binder  := λe, (do `(@supr %%α %%cl %%β %%f) ← return e, return (β, f)),
  adapt_rel     := λc, (do r ← current_relation, guard (r = `eq), c),
  apply_comm    := applyc ``supr_comm,
  apply_congr   := congr_arg ∘ funext',
  apply_elim_eq := applyc ``supr_supr_eq_left <|> applyc ``supr_supr_eq_right }

meta def infi_eq_elim : binder_eq_elim :=
{ match_binder  := λe, (do `(@infi %%α %%cl %%β %%f) ← return e, return (β, f)),
  adapt_rel     := λc, (do r ← current_relation, guard (r = `eq), c),
  apply_comm    := applyc ``infi_comm,
  apply_congr   := congr_arg ∘ funext',
  apply_elim_eq := applyc ``infi_infi_eq_left <|> applyc ``infi_infi_eq_right }

universes u v w w₂
variables {α : Type u} {β : Type v} {ι : Sort w} {ι₂ : Sort w₂} {s t : set α} {a : α}

section
variables [complete_lattice α]

example {s : set β} {f : β → α} : Inf (set.image f s) = (⨅ a ∈ s, f a) :=
begin
  simp [Inf_eq_infi, infi_and],
  conversion infi_eq_elim.old_conv,
end

example {s : set β} {f : β → α} : Sup (set.image f s) = (⨆ a ∈ s, f a) :=
begin
  simp [Sup_eq_supr, supr_and],
  conversion supr_eq_elim.old_conv,
end

end


/-
Copyright (c) 2023 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Floris van Doorn
-/
import Lean

/-!
# `addRelatedDecl`

-/

open Lean Meta Elab

namespace Mathlib.Tactic

/-- A helper function for constructing a related declaration from an existing one.

This is currently used by the attributes `reassoc` and `elementwise`,
and has been factored out to avoid code duplication.
Feel free to add features as needed for other applications.

This helper:
* calls `addDeclarationRanges`, so jump-to-definition works,
* copies the `protected` status of the existing declaration, and
* supports copying attributes.

Arguments:
* `src : Name` is the existing declaration that we are modifying.
* `suffix : String` will be appended to `src` to form the name of the new declaration.
* `ref : Syntax` is the syntax where the user requested the related declaration.
* `construct type value levels : MetaM (Expr × List Name)`
  given the type, value, and universe variables of the original declaration,
  should construct the value of the new declaration,
  along with the names of its universe variables.
* `attrs` is the attributes that should be applied to both the new and the original declaration,
  e.g. in the usage `@[reassoc (attr := simp)]`.
  We apply it to both declarations, to have the same behavior as `to_additive`, and to shorten some
  attribute commands. Note that `@[elementwise (attr := simp), reassoc (attr := simp)]` will try
  to apply `simp` twice to the current declaration, but that causes no issues.
-/
def addRelatedDecl (src : Name) (suffix : String) (ref : Syntax)
    (attrs? : Option (Syntax.TSepArray `Lean.Parser.Term.attrInstance ","))
    (construct : Expr → Expr → List Name → MetaM (Expr × List Name)) :
    MetaM Unit := do
  let tgt := match src with
    | Name.str n s => Name.mkStr n $ s ++ suffix
    | x => x
  addDeclarationRanges tgt {
    range := ← getDeclarationRange (← getRef)
    selectionRange := ← getDeclarationRange ref }
  let info ← getConstInfo src
  let (newValue, newLevels) ← construct info.type info.value! info.levelParams
  let newValue ← instantiateMVars newValue
  let newType ← instantiateMVars (← inferType newValue)
  match info with
  | ConstantInfo.thmInfo info =>
    addAndCompile <| .thmDecl
      { info with levelParams := newLevels, type := newType, name := tgt, value := newValue }
  | ConstantInfo.defnInfo info =>
    -- Structure fields are created using `def`, even when they are propositional,
    -- so we don't rely on this to decided whether we should be constructing a `theorem` or a `def`.
    addAndCompile <| if ← isProp newType then .thmDecl
      { info with levelParams := newLevels, type := newType, name := tgt, value := newValue }
      else .defnDecl
      { info with levelParams := newLevels, type := newType, name := tgt, value := newValue }
  | _ => throwError "Constant {src} is not a theorem or definition."
  if isProtected (← getEnv) src then
    setEnv $ addProtected (← getEnv) tgt
  let attrs := match attrs? with | some attrs => attrs | none => #[]
  _ ← Term.TermElabM.run' <| do
    let attrs ← elabAttrs attrs
    Term.applyAttributes src attrs
    Term.applyAttributes tgt attrs


variables {p q : Prop} (hp : p) (hq : q)

include hp hq

example : p ∧ q ∧ p :=
begin
  apply and.intro hp,
  exact and.intro hq hp
end


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

universe u v

theorem Option.eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀z, x = some z ↔ y = some z) → x = y
  | none,   none,   _ => rfl
  | none,   some z, h => Option.noConfusion ((h z).2 rfl)
  | some z, none,   h => Option.noConfusion ((h z).1 rfl)
  | some _, some w, h => Option.noConfusion ((h w).2 rfl) (congrArg some)

theorem Option.eq_none_of_isNone {α : Type u} : ∀ {o : Option α}, o.isNone → o = none
  | none, _ => rfl


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

universes u_1 u_2 l u v u_3 w x u_4

namespace Mathlib

/-!
# Injective functions
-/

namespace function

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

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

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

end function

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

namespace function

namespace embedding

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end embedding

end function

namespace equiv

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

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

end equiv

namespace set

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

end set

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

-- `algebra.group.defs` import.

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

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


/-
Copyright (c) 2019 Rob Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rob Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.simp_result
import Mathlib.PostPort

namespace Mathlib

namespace tactic

/--
`delta_instance ids` tries to solve the goal by calling `apply_instance`,
first unfolding the definitions in `ids`.
-/
-- We call `dsimp_result` here because otherwise

-- `delta_target` will insert an `id` in the result.

-- See the note [locally reducible category instances]

-- https://github.com/leanprover-community/mathlib/blob/c9fca15420e2ad443707ace831679fd1762580fe/src/algebra/category/Mon/basic.lean#L27

-- for an example where this used to cause a problem.

end Mathlib


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino, Patrick Massot
-/

import Lean
import Mathlib.Util.Tactic

namespace Mathlib.Tactic

open Lean Meta Parser Elab Tactic

/-- Renames a bound variable in a hypothesis. -/
def renameBVarHyp (mvarId : MVarId) (fvarId : FVarId) (old new : Name) :
    MetaM Unit :=
  modifyLocalDecl mvarId fvarId fun ldecl ↦
    ldecl.setType $ ldecl.type.renameBVar old new

/-- Renames a bound variable in the target. -/
def renameBVarTarget (mvarId : MVarId) (old new : Name) : MetaM Unit :=
  modifyTarget mvarId fun e ↦ e.renameBVar old new

/--
* `rename_bvar old new` renames all bound variables named `old` to `new` in the target.
* `rename_bvar old new at h` does the same in hypothesis `h`.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_bvar n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_bvar m n, -- target is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```
Note: name clashes are resolved automatically.
-/
elab "rename_bvar " old:ident " → " new:ident loc?:(ppSpace location)? : tactic => do
  let mvarId ← getMainGoal
  match loc? with
  | none => renameBVarTarget mvarId old.getId new.getId
  | some loc =>
    withLocation (expandLocation loc)
      (fun fvarId ↦ renameBVarHyp mvarId fvarId old.getId new.getId)
      (renameBVarTarget mvarId old.getId new.getId)
      fun _ ↦ throwError "unexpected location syntax"


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

Traversable instance for lazy_lists.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.traversable.equiv
import Mathlib.control.traversable.instances
import Mathlib.Lean3Lib.data.lazy_list
import Mathlib.PostPort

universes u_1 u u_2 u_3

namespace Mathlib

/-!
## Definitions on lazy lists

This file contains various definitions and proofs on lazy lists.

TODO: move the `lazy_list.lean` file from core to mathlib.
-/

namespace thunk

/-- Creates a thunk with a (non-lazy) constant value. -/
def mk {α : Type u_1} (x : α) : thunk α :=
  fun (_x : Unit) => x

protected instance decidable_eq {α : Type u} [DecidableEq α] : DecidableEq (thunk α) :=
  sorry

end thunk

namespace lazy_list

/-- Isomorphism between strict and lazy lists. -/
def list_equiv_lazy_list (α : Type u_1) : List α ≃ lazy_list α :=
  equiv.mk of_list to_list sorry sorry

protected instance inhabited {α : Type u} : Inhabited (lazy_list α) :=
  { default := nil }

protected instance decidable_eq {α : Type u} [DecidableEq α] : DecidableEq (lazy_list α) :=
  sorry

/-- Traversal of lazy lists using an applicative effect. -/
protected def traverse {m : Type u → Type u} [Applicative m] {α : Type u} {β : Type u} (f : α → m β) : lazy_list α → m (lazy_list β) :=
  sorry

protected instance traversable : traversable lazy_list :=
  traversable.mk lazy_list.traverse

protected instance is_lawful_traversable : is_lawful_traversable lazy_list :=
  equiv.is_lawful_traversable' list_equiv_lazy_list sorry sorry sorry

/-- `init xs`, if `xs` non-empty, drops the last element of the list.
Otherwise, return the empty list. -/
def init {α : Type u_1} : lazy_list α → lazy_list α :=
  sorry

/-- Return the first object contained in the list that satisfies
predicate `p` -/
def find {α : Type u_1} (p : α → Prop) [decidable_pred p] : lazy_list α → Option α :=
  sorry

/-- `interleave xs ys` creates a list where elements of `xs` and `ys` alternate. -/
def interleave {α : Type u_1} : lazy_list α → lazy_list α → lazy_list α :=
  sorry

/-- `interleave_all (xs::ys::zs::xss)` creates a list where elements of `xs`, `ys`
and `zs` and the rest alternate. Every other element of the resulting list is taken from
`xs`, every fourth is taken from `ys`, every eighth is taken from `zs` and so on. -/
def interleave_all {α : Type u_1} : List (lazy_list α) → lazy_list α :=
  sorry

/-- Monadic bind operation for `lazy_list`. -/
protected def bind {α : Type u_1} {β : Type u_2} : lazy_list α → (α → lazy_list β) → lazy_list β :=
  sorry

/-- Reverse the order of a `lazy_list`.
It is done by converting to a `list` first because reversal involves evaluating all
the list and if the list is all evaluated, `list` is a better representation for
it than a series of thunks. -/
def reverse {α : Type u_1} (xs : lazy_list α) : lazy_list α :=
  of_list (list.reverse (to_list xs))

protected instance monad : Monad lazy_list := sorry

theorem append_nil {α : Type u_1} (xs : lazy_list α) : (append xs fun (_ : Unit) => nil) = xs := sorry

theorem append_assoc {α : Type u_1} (xs : lazy_list α) (ys : lazy_list α) (zs : lazy_list α) : (append (append xs fun (_ : Unit) => ys) fun (_ : Unit) => zs) =
  append xs fun (_ : Unit) => append ys fun (_ : Unit) => zs := sorry

theorem append_bind {α : Type u_1} {β : Type u_2} (xs : lazy_list α) (ys : thunk (lazy_list α)) (f : α → lazy_list β) : lazy_list.bind (append xs ys) f = append (lazy_list.bind xs f) fun (_ : Unit) => lazy_list.bind (ys Unit.unit) f := sorry

protected instance is_lawful_monad : is_lawful_monad lazy_list := sorry

/-- Try applying function `f` to every element of a `lazy_list` and
return the result of the first attempt that succeeds. -/
def mfirst {m : Type u_1 → Type u_2} [alternative m] {α : Type u_3} {β : Type u_1} (f : α → m β) : lazy_list α → m β :=
  sorry

/-- Membership in lazy lists -/
protected def mem {α : Type u_1} (x : α) : lazy_list α → Prop :=
  sorry

protected instance has_mem {α : outParam (Type u_1)} : has_mem α (lazy_list α) :=
  has_mem.mk lazy_list.mem

protected instance mem.decidable {α : Type u_1} [DecidableEq α] (x : α) (xs : lazy_list α) : Decidable (x ∈ xs) :=
  sorry

@[simp] theorem mem_nil {α : Type u_1} (x : α) : x ∈ nil ↔ False :=
  iff.rfl

@[simp] theorem mem_cons {α : Type u_1} (x : α) (y : α) (ys : thunk (lazy_list α)) : x ∈ cons y ys ↔ x = y ∨ x ∈ ys Unit.unit :=
  iff.rfl

theorem forall_mem_cons {α : Type u_1} {p : α → Prop} {a : α} {l : thunk (lazy_list α)} : (∀ (x : α), x ∈ cons a l → p x) ↔ p a ∧ ∀ (x : α), x ∈ l Unit.unit → p x := sorry

/-! ### map for partial functions -/

/-- Partial map. If `f : Π a, p a → β` is a partial function defined on
  `a : α` satisfying `p`, then `pmap f l h` is essentially the same as `map f l`
  but is defined only when all members of `l` satisfy `p`, using the proof
  to apply `f`. -/
@[simp] def pmap {α : Type u_1} {β : Type u_2} {p : α → Prop} (f : (a : α) → p a → β) (l : lazy_list α) : (∀ (a : α), a ∈ l → p a) → lazy_list β :=
  sorry

/-- "Attach" the proof that the elements of `l` are in `l` to produce a new `lazy_list`
  with the same elements but in the type `{x // x ∈ l}`. -/
def attach {α : Type u_1} (l : lazy_list α) : lazy_list (Subtype fun (x : α) => x ∈ l) :=
  pmap Subtype.mk l sorry

protected instance has_repr {α : Type u_1} [has_repr α] : has_repr (lazy_list α) :=
  has_repr.mk fun (xs : lazy_list α) => repr (to_list xs)