/-!
# Monad Stacks
Before you read this: This chapter does not attempt to introduce the concept
of a monad in general, it assume this as a given and explains the monads
and constructs on top of them that are essential to Lean meta programming.
If you don't know what a monad is already you can read (TODO: Link to monad tutorial).

## Monad Transformers
Quite often in functional programming with monads one wants to have the power
of more than one monad available. Specifically in Lean meta programming it
is a very common pattern that we have some sort of read only input, an
execution context, available to us, as well as the ability to operate on
a mutable state. Both of these issues have monads that can solve them
separately already, namely the `Reader` monad for read only input and the
`StateM` monad for the mutable state. Now we can try to just "stack" them
ontop like this:`
-/
namespace Playground1
abbrev Context := Nat
abbrev State := String

abbrev MyM (α : Type) := Reader Context (StateM State α)

end Playground1
/-!
And this will indeed type check, however we have a very annoying issue,
if we attempt to synthesize a `Monad` instance for this via the `#synth` command:
-/
namespace Playground1

-- failed to synthesize
--  Monad MyM
#synth Monad MyM

def test1 : MyM Unit := pure () -- failure, pure requires a monad instance
def test2 : MyM Unit := do
  let res ← test1 -- failure, <- syntax requires a monad instance
  pure res -- same issue as with the pure above

end Playground1
/-!
We can fix this by manually declaring the instance though:
-/
namespace Playground1

instance : Monad MyM where
  pure x := fun ctx state => (x, state)
  bind x f := fun ctx state =>
    let (res, newState) := x ctx state
    f res ctx newState

end Playground1

/-!
Now while we can use bind, aka the `<-` Syntax and `pure` now we are still
missing convenience functions:
- `Reader` should give us `read` to get the context
- `StateM` should give us `get` and `set` to get and set the state
-/
namespace Playground1

def foo : MyM Unit := do
  let ctx ← read -- failure because read is not found, the bind syntax works
  let state ← get -- failure because get is not found, the bind syntax works
  set state -- failure because set is not found
  pure () -- pure also works thanks to the monad instance!

end Playground1
/-!
Now we could of course write all of these functions ourselves and keep repeating
ourselves whenever we do this sort of "combining monads" again but it would obviously
be much nicer if we could just have all of this done for us automatically.
This is where monad transformers come in. A monad transformer gives us a way
to combine the effects that certain monads give us (not all monad can be turned into
a transformer) in a nice way. For these monads specifically there is the `Reader`
transformer `ReaderT` and the `StateM` transformer `StateT`, let's see how they
perform:
-/
namespace Playground2
abbrev Context := Nat
abbrev State := String

-- `StateM` is defined as `StateM σ α = StateT σ Id α` so the following two are equivalent.
abbrev MyM  := ReaderT Context (StateT State Id)
abbrev MyM2  := ReaderT Context (StateM State)
-- This definition of `StateM` makes perfect sense since the `Id` monad has no effect,
-- so combining it with `StateT` will create a monad that has only the state effect.
-- Can you guess the definition of `Reader` based on `ReaderT`?

#synth Monad MyM -- monad instance!
#synth Monad MyM2 -- monad instance!

end Playground2
/-!
So that's the monad instance for free. The other thing that failed above,
was that we didn't have access to `read`, `get` and `set`, anymore, let's
see whether our monad transformers allow this:
-/
namespace Playground2

def testReader : MyM String := do
  let get ← read -- obtain our context
  pure s!"This is my context: {get}"

def testState (add : State) : MyM Unit := do
  let old ← get
  set s!"{old} + {add}"

def testStateChange : MyM String := do
  let _ ← testState "new stuff!"
  testState "more new stuff!"
  get

def MyM.run (context : Context) (state : State) (x : MyM α) : α :=
  Prod.fst <$> StateT.run (ReaderT.run x context) state

#eval MyM.run 12 "hello" testReader -- "This is my context: 12"
#eval MyM.run 12 "hello" testStateChange -- "hello + new stuff! + more new stuff!"

end Playground2
/-!
Nice! Everything just seems to work here, if you are interested in how
Lean does this internally you can check out the infrastructure around:
- `MonadReader`, `MonadReaderOf` for the `ReaderT` part
- `MonadState`, `MonadStateOf` for the `StateT` part

for most applications the idea that our `ReaderT` `StateT` monad transformers
just combine nicely out of the box is perfectly fine though.

### Lifting
The next interesting question one might come up with is, can we just combine
monad stacks nicely like this as well? What we are aiming for is that
assuming we have a monad stack `S` and another one of our monad stacks `MyM`,
that is built on top of `S`, we want to be able to execute computations inside of `S`
just as easily inside of `MyM` as well. Let's see if the built-in stacks
can do this already, as an example for `S` we will use the `IO` monad which is
a monad stack under the hood as well:
-/
namespace Playground3

abbrev Context := Nat
abbrev State := String

abbrev MyM  := ReaderT Context (StateT State IO)

def test : MyM Unit := do
  let old ← get
  let new := s!"Number {←read}, String: {old}"
  IO.println s!"Old was: {old}, New will be: {new}"
  set new

def MyM.run (context : Context) (state : State) (x : MyM α) : IO α :=
  Prod.fst <$> StateT.run (ReaderT.run x context) state

#eval MyM.run 12 "hello" test -- Old was: hello, New will be: Number 12, String: hello

end Playground3
/-!
This also just worked without any additional effort on our side! The infrastructure
responsible for this is `MonadLift` and `MonadLiftT` as well as some effort
in the implementation of `do` to figure out when to lift. However you can again
ignore this if you want, it just works out of the box most of the time.
-/

/-!
## Error monads
Next up we'll take a look at 2 monads you have most likely not heard of yet,
both of which will show up in meta programming.

First is `EStateM`, as it's name suggests it is very similar to `StateM` but
with the fundamental difference that it can throw some sort of `E`rror,
as such it is parameterized by 3 types: `EStateM Error State Value`.
It is one of the monads that implement the `MonadExcept`/`MonadExceptOf`
machinery which allows us to introduce a concept of exceptions into our
monad stacks:
-/
namespace Playground4

abbrev Context := Nat
abbrev Error := String
abbrev State := Nat

abbrev MyM := ReaderT Nat (EStateM Error State)

def alarm (x : String) : MyM Unit := do
  throw s!"Alarm!: {x}"

def main : MyM String := do
  alarm "hi"
  pure "test"

def MyM.run (context : Context) (state : State) (x : MyM α) : Sum α Error :=
  let res := EStateM.run (ReaderT.run x context) state
  match res with
  | .ok v _ => Sum.inl v
  | .error e _ => Sum.inr e

#eval MyM.run 12 13 main -- Sum.inr "Alarm!: hi"

end Playground4
/-!
What happened here is that `alarm` threw an exception and because we didn't
have any mechanism in place to catch it, the rest of our program didn't get
executed and the error got propagated up to us. Luckily Lean has some
nice built-in syntax to catch exceptions (if we want to do so):
-/
namespace Playground4

def main2 : MyM String := do
  try
    alarm "hi"
    pure "Success"
  catch err =>
    pure s!"Got an error: {err}"

#eval MyM.run 12 13 main2 -- Sum.inl "Got an error: Alarm!: hi"

end Playground4
/-!
There exists another monad that implements `MonadExcept`, its the one underlying `IO`, `EIO`.
`EIO` is basically `IO` but parameterized with an exception type.
`IO` sets this to the `IO.Error`, a type based on UNIX errno. Unsurprisingly
`EIO` (and thus `IO`) have the capability to throw exceptions.

Note: `EIO` is in fact based on `EStateM`, this is however not a tutorial on the inner
workings of `IO` so we will leave it at that.

### `StateRefT`
`StateT` is implemented as a function that forwards the state
from one monadic computation to the next like this: `State -> (Value, State)`.
Especially when updating the state lots of times this does of course become
rather inefficient so there is an alternative to it, `StateRefT`. Thanks to
`MonadState` the `StateRefT` transformer behaves basically identical to the
user. Internally it works with an `ST.Ref` which is in essence a truly
mutable memory location and thus much more efficient than ordinary `StateT`,
hence most of the meta programming monad stacks are implemented with it instead
of `StateT`. There is only a single issue with this, Lean is a pure programming
language so we can't just have mutable memory locations like that, this is why
`StateRefT` expects another monad stack that can provide this capability.
Right now these are:
- The `IO` family and stacks built on top of them, that is `IO`, `EIO` and `BaseIO`
- `EST` and stacks built on top of it, `EST` is a (not reducible) alias to `EStateM`
  (TODO: Figure out why this distinction is made)

For our example we will simply use `IO`.
-/
namespace Playground5

abbrev Context := Nat
abbrev State := String

abbrev MyM  := ReaderT Context (StateRefT State IO)

def test : MyM Unit := do
  let old ← get
  let new := s!"Number {←read}, String: {old}"
  IO.println s!"Old was: {old}, New will be: {new}"
  set new

def MyM.run (context : Context) (state : State) (x : MyM α) : IO α :=
  -- We use StateRefT' because StateRefT is actually a macro, figuring out the
  -- details on how to provide the mutable memory location based on the stack we are building on.
  Prod.fst <$> StateRefT'.run (ReaderT.run x context) state

#eval MyM.run 12 "hello" test -- Old was: hello, New will be: Number 12, String: hello

end Playground5

/-!
## More `Monad` type class extensions
Last but not least lets take a look at a few more, general, `Monad` extensions
that might be useful along the way.
### `MonadWithReader`
Provides a function `withReader : (ρ → ρ) → m α → m α` where `ρ` is the context
stored inside of a `Reader`. The idea is, that you pass it a function
that will be applied to your context and the resulting context will be passed on to
the second argument as its context, returning the result of that computation.
This allows you to temporarily change the context in some sub section of your
program before continuing with the original one. In order to make this accessible
in monad stacks as well there exists an equivalent machinery to `MonadReader`/`MonadReaderOf`,
named `MonadWithReaderOf`.
### `MonadFinally`
`MonadFinally` provides a function `tryFinally' : m α → (Option α → m β) → m (α × β)`
that works as follows: `tryFinally' x f` runs `x` and then the "finally" computation `f`.
When `x` succeeds with `a : α`, `f (some a)` is returned. If `x` fails for `m`'s definition
of failure, `f none` is returned. Hence `tryFinally'` can be thought of as performing the same
role as a finally block in an imperative programming language. (TODO: This is a docstring,
link to rendered documentation instead). Like above `MonadFinally` is implemented
so that it is accessible throughout monad stacks that are based on a monad which implements
this behaviour.
### `MonadBackTrack`
TODO: The doc string does explain what it does: Similar to MonadState,
but it retrieves/restores only the "backtrackable" part of the state.

However this is a little abstract and probably requires an example, the issue
with this is that all instances of `MonadBackTrack` are inside the meta stack
so I'm not quite sure how to do one.
### `MonadControl`
Is explained in an excellent doc string [here](https://github.com/leanprover/lean4/blob/575b1187c500af22bfc4c49c8aa58371d91843fa/src/Init/Control/Basic.lean#L69-L178)
### `MonadFunctor`
TODO: Again the doc string explains it: A functor in the category of monads.
Can be used to lift monad-transforming functions. Based on pipes' MFunctor,
but not restricted to monad transformers. Alternatively, an implementation
of MonadTransFunctor.

This might however be rather confusing to most people (including me) so
we should probably try to come up with some nice examples as well.
-/

/-!
# Monads used in Lean 4

Here is a list of monads that are used in Lean 4 that you might run into. Some have already been discussed above.
Monad stacks can be quite tall in Lean 4. For example if we were to write out the full defininition of `TacticM`:

```lean
TacticM :=
  EStateM Exception IO.RealWorld
  |> StateRefT Core.State
  |> ReaderT Core.Context
  |> StateRefT Meta.State
  |> ReaderT Meta.Context
  |> StateRefT Elab.Term.State
  |> ReaderT Elab.Term.Context
  |> StateRefT Elab.Tactic.State
  |> ReaderT Elab.Tactic.Context
```

## The IO monads

An IO monad is used to create computations that interact with the rest of the computer.
Things like: connecting to the internet, writing files etc.
Use an IO monad to say, "hey! this code can cause arbitrary OS-level side effects".
TODO: potentially there will be a whole chapter on the IO API, so we will just focus on the monad here.

In Lean 4 there are a family of IO monads: `IO`, `EIO ε`, `BaseIO`.
`EIO ε` is the main one, it is defined as `EStateM ε IO.RealWorld`: you can throw errors of type `ε` and it has a strange state object called `IO.Realworld`.

This state is a little strange.
There is a magic definition `IO.RealWorld : Type := Unit`, that represents the 'io state' of your application.
You should never actually use `IO.RealWorld`.
A description of how it works in Haskell is given [here](https://www.well-typed.com/blog/2014/06/understanding-the-realworld/).
To summarise: it's essentially a placeholder for the current state of everything outside your app.
It seems to just be some bookkeeping for the compiler (TODO: check with authorities), since if you are passing this `() : IO.Realworld` object around,
the optimiser will never try to reorder operations and so on.
You should always use `EIO` and items defined in terms of `EIO`, because of course you can't reset the state of reality.

The difference between `IO`, `BaseIO` and `EIO ε` are the exceptions that are thrown. `BaseIO` has no exceptions and `IO := EIO IO.Error`.
`IO.Error` is specialised for errors that can happen when interfacing with the OS (rather than lean-specific errors which use `Exception`).
There is an error type for all of the errors that you might get from the OS while doing syscalls.
There is also a `userError (msg : String)` for when you want to pass a user error.

## `CoreM`

The best way to think about `CoreM` is that it tracks everything Lean-related that doesn't yet involve managing expressions.
It's a set of common context and state for the other metaprogramming monads.
You can use this to running attribute handlers (`AttrM := CoreM`), manipulating the environment and setting options.

It is defined as `ReaderT Core.Context $ StateRefT Core.State $ EIO Exception`.

The main things in the context are:
- The options that are set. I.e. storing the settings from `set_option trace.simplify.rewrite true` commands.
- The current namespace.
- Which namespaces are currently open. That is, things that have been opened with the `open` command.

The main things in the state are:
- The current `Environment`
- The name generator (responsible for making sure that unique names are created.)
- The trace state (where messages to the user are stored)

## `MetaM`

`CoreM` is `MetaM` with a local context and a metavariable state.
It is used for building expressions where you need to handle metavariables and local contexts.
You can learn more about it in [[main/metam]].

## `TermElabM`

The `TermElabM` tracks a lot of extra information that is needed to turn Lean syntax in to expressions: pending elaboration problems, pending tactics to be executed, etc.
This is used for writing term elaborators. You will encounter it when writing `elab` methods for custom syntax.

## `TacticM`

The tactic monad.
This is `TermElabM` with a list of goals. It is used to implement your own tactics.

## `CommandElabM`

This one sits outside the main monad stack.
It works similarly to a combined `TermElabM` and `CoreM`. It is used for elaborating commands.

## `MacroM`

A macro is a function `Syntax → MacroM Syntax`. The macro state and context contains information
needed to expand macros hygienically. You can learn more about macros in [[main/macros]] and [The Lean manual](https://leanprover.github.io/lean4/doc/macro_overview.html).

## `RequestM`

This is used to handle the requests in the Lean language server from vscode or emacs.

## `ImportM`

TODO

## Conversion table

Often when writing monads you will want to run monad `A` in monad `B`.
This is done with 'running' and 'lifting' monads.
Here is a table giving methods that can be used to lift or run monads from other monads.

| run ↓ in → | IO | `CoreM`  | `MetaM`  | `TermElabM` | `TacticM` | `CommandElabM` |
| ----------- | ---- | -------  | -------  | ----------- |  -------- |  -------------- |
| IO        |   .   | `liftM`  | `liftM`  | `liftM`     |   `liftM`        | `liftM`
| `CoreM`     |   `CoreM.toIO`, `CoreM.run`   |    .      | `liftM`  | `liftM`     |   `liftM`        | `liftCoreM`
| `MetaM`     | `MetaM.toIO`     | `MetaM.run`      |    .      | `liftM`     |   `liftM`        |
| `TermElabM` |      |          |    `TermElabM.run`      |      .       |     `liftM`      | `runTermElabM`, `liftTermElabM`
| `TacticM`   |      |          |    |    `Lean.Elab.Tactic.run`         |       .    |
| `CommandElabM` | `CommandElabM.run`  |          |          |             |          |        .        |

If you are writing your own definitions involving monads, rather than specifically
using a concrete monad like `MetaM`, consider using a variable monad `M` with monad typeclasses for the
bits that you need: eg `[MonadEnv M]` if you are using the environment or `[MonadControlT MetaM M]` if you want to use the metavariable context.
Doing this means that you have to worry less about lifting and running concrete monads.

-/


namespace List

@[simp] theorem filter_nil {p : α → Bool} : filter p [] = [] := by
  simp [filter, filterAux, reverse, reverseAux]

theorem cons_eq_append (a : α) (as : List α) : a :: as = [a] ++ as := rfl

theorem filter_cons (a : α) (as : List α) :
  filter p (a :: as) = if p a then a :: filter p as else filter p as :=
  sorry

@[simp] theorem filter_append {as bs : List α} {p : α → Bool} :
  filter p (as ++ bs) = filter p as ++ filter p bs :=
  match as with
  | []      => by simp
  | a :: as => by
    rw [filter_cons, cons_append, filter_cons]
    cases p a
    simp [filter_append]
    simp [filter_append]

-- the previous contains a more complicated version of
def f : Nat → Nat
  | 0 => 1
  | i+1 => (fun x => f x) i


/-
Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul-Nicolas Madelaine, Robert Y. Lewis, Mario Carneiro, Gabriel Ebner
-/
import Lean.Meta.CongrTheorems
import Lean.Meta.Tactic.Simp.SimpTheorems
import Std.Tactic.CoeExt

open Lean Meta

namespace Std.Tactic.NormCast
open Tactic.Coe

/--
`Label` is a type used to classify `norm_cast` lemmas.
* elim lemma:   LHS has 0 head coes and ≥ 1 internal coe
* move lemma:   LHS has 1 head coe and 0 internal coes,    RHS has 0 head coes and ≥ 1 internal coes
* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes
-/
inductive Label
  /-- elim lemma: LHS has 0 head coes and ≥ 1 internal coe -/
  | elim
  /-- move lemma: LHS has 1 head coe and 0 internal coes,
  RHS has 0 head coes and ≥ 1 internal coes -/
  | move
  /-- squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes -/
  | squash
  deriving DecidableEq, Repr, Inhabited

/-- Assuming `e` is an application, returns the list of subterms that `simp` will rewrite in. -/
def getSimpArgs (e : Expr) : MetaM (Array Expr) := do
  match ← mkCongrSimp? e.getAppFn with
  | none => return e.getAppArgs
  | some {argKinds, ..} =>
    let mut args := #[]
    for a in e.getAppArgs, k in argKinds do
      if k matches .eq then
        args := args.push a
    return args

/-- Count how many coercions are at the top of the expression. -/
partial def countHeadCoes (e : Expr) : MetaM Nat := do
  if let Expr.const fn .. := e.getAppFn then
    if let some info ← getCoeFnInfo? fn then
      if e.getAppNumArgs >= info.numArgs then
        return (← countHeadCoes (e.getArg! info.coercee)) + 1
  return 0

/-- Count how many coercions are inside the expression, including the top ones. -/
partial def countCoes (e : Expr) : MetaM Nat :=
  lambdaTelescope e fun _ e => do
    if let Expr.const fn .. := e.getAppFn then
      if let some info ← getCoeFnInfo? fn then
        if e.getAppNumArgs >= info.numArgs then
          let mut coes := (← countHeadCoes (e.getArg! info.coercee)) + 1
          for i in [info.numArgs:e.getAppNumArgs] do
            coes := coes + (← countCoes (e.getArg! i))
          return coes
    return (← (← getSimpArgs e).mapM countCoes).foldl (·+·) 0

/-- Count how many coercions are inside the expression, excluding the top ones. -/
def countInternalCoes (e : Expr) : MetaM Nat :=
  return (← countCoes e) - (← countHeadCoes e)

/-- Classifies a declaration of type `ty` as a `norm_cast` rule. -/
def classifyType (ty : Expr) : MetaM Label :=
  forallTelescopeReducing ty fun _ ty => do
    let ty ← whnf ty
    let (lhs, rhs) ←
      if ty.isAppOfArity ``Eq 3 then pure (ty.getArg! 1, ty.getArg! 2)
      else if ty.isAppOfArity ``Iff 2 then pure (ty.getArg! 0, ty.getArg! 1)
      else throwError "norm_cast: lemma must be = or ↔, but is{indentExpr ty}"
    let lhsCoes ← countCoes lhs
    if lhsCoes = 0 then throwError "norm_cast: badly shaped lemma, lhs must contain at least one coe{indentExpr lhs}"
    let lhsHeadCoes ← countHeadCoes lhs
    let rhsHeadCoes ← countHeadCoes rhs
    let rhsInternalCoes ← countInternalCoes rhs
    if lhsHeadCoes = 0 then
      return Label.elim
    else if lhsHeadCoes = 1 then do
      unless rhsHeadCoes = 0 do throwError "norm_cast: badly shaped lemma, rhs can't start with coe{indentExpr rhs}"
      if rhsInternalCoes = 0 then
        return Label.squash
      else
        return Label.move
    else if rhsHeadCoes < lhsHeadCoes then do
      return Label.squash
    else do
      throwError "norm_cast: badly shaped shaped squash lemma, rhs must have fewer head coes than lhs{indentExpr ty}"

/-- The `push_cast` simp attribute. -/
initialize pushCastExt : SimpExtension ←
  registerSimpAttr `push_cast <|
    "The `push_cast` simp attribute uses `norm_cast` lemmas " ++
    "to move casts toward the leaf nodes of the expression."

/--  The `norm_cast` attribute stores three simp sets. -/
structure NormCastExtension where
  /-- A simp set which lifts coercion arrows to the top level. -/
  up : SimpExtension
  /-- A simp set which pushes coercion arrows to the leaves. -/
  down : SimpExtension
  /-- A simp set which simplifies transitive coercions. -/
  squash : SimpExtension
  deriving Inhabited

/-- The `norm_cast` extension data. -/
initialize normCastExt : NormCastExtension ← pure {
  up := ← mkSimpExt (decl_name% ++ `up)
  down := ← mkSimpExt (decl_name% ++ `down)
  squash := ← mkSimpExt (decl_name% ++ `squash)
}

/-- `addElim decl` adds `decl` as an `elim` lemma to the cache. -/
def addElim (decl : Name)
    (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit :=
  addSimpTheorem normCastExt.up decl (post := true) (inv := false) kind prio

/-- `addMove decl` adds `decl` as a `move` lemma to the cache. -/
def addMove (decl : Name)
    (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do
  addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio
  addSimpTheorem normCastExt.up decl (post := true) (inv := true) kind prio
  addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio

/-- `addSquash decl` adds `decl` as a `squash` lemma to the cache. -/
def addSquash (decl : Name)
    (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do
  addSimpTheorem pushCastExt decl (post := true) (inv := false) kind prio
  addSimpTheorem normCastExt.squash decl (post := true) (inv := false) kind prio
  addSimpTheorem normCastExt.down decl (post := true) (inv := false) kind prio

/-- `addInfer decl` infers the label of `decl` and adds it to the cache.

* elim lemma:   LHS has 0 head coes and ≥ 1 internal coe
* move lemma:   LHS has 1 head coe and 0 internal coes,    RHS has 0 head coes and ≥ 1 internal coes
* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes
-/
def addInfer (decl : Name)
    (kind := AttributeKind.global) (prio := eval_prio default) : MetaM Unit := do
  let ty := (← getConstInfo decl).type
  match ← classifyType ty with
  | Label.elim => addElim decl kind prio
  | Label.squash => addSquash decl kind prio
  | Label.move => addMove decl kind prio

namespace Attr
/-- The possible `norm_cast` kinds: `elim`, `move`, or `squash`. -/
syntax normCastLabel := &"elim" <|> &"move" <|> &"squash"

/--
The `norm_cast` attribute should be given to lemmas that describe the
behaviour of a coercion in regard to an operator, a relation, or a particular
function.

It only concerns equality or iff lemmas involving `↑`, `⇑` and `↥`, describing the behavior of
the coercion functions.
It does not apply to the explicit functions that define the coercions.

Examples:
```lean
@[norm_cast] theorem coe_nat_inj' {m n : ℕ} : (↑m : ℤ) = ↑n ↔ m = n

@[norm_cast] theorem coe_int_denom (n : ℤ) : (n : ℚ).denom = 1

@[norm_cast] theorem cast_id : ∀ n : ℚ, ↑n = n

@[norm_cast] theorem coe_nat_add (m n : ℕ) : (↑(m + n) : ℤ) = ↑m + ↑n

@[norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n

@[norm_cast] theorem cast_one : ((1 : ℚ) : α) = 1
```

Lemmas tagged with `@[norm_cast]` are classified into three categories: `move`, `elim`, and
`squash`. They are classified roughly as follows:

* elim lemma:   LHS has 0 head coes and ≥ 1 internal coe
* move lemma:   LHS has 1 head coe and 0 internal coes,    RHS has 0 head coes and ≥ 1 internal coes
* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes

`norm_cast` uses `move` and `elim` lemmas to factor coercions toward the root of an expression
and to cancel them from both sides of an equation or relation. It uses `squash` lemmas to clean
up the result.

Occasionally you may want to override the automatic classification.
You can do this by giving an optional `elim`, `move`, or `squash` parameter to the attribute.

```lean
@[simp, norm_cast elim] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n := by
  rw [← of_real_nat_cast, of_real_re]
```

Don't do this unless you understand what you are doing.

A full description of the tactic, and the use of each lemma category, can be found at
<https://lean-forward.github.io/norm_cast/norm_cast.pdf>.
-/
syntax (name := norm_cast) "norm_cast" (ppSpace normCastLabel)? (ppSpace num)? : attr
end Attr

initialize registerBuiltinAttribute {
  name := `norm_cast
  descr := "attribute for norm_cast"
  add := fun decl stx kind => MetaM.run' do
    let `(attr| norm_cast $[$label:normCastLabel]? $[$prio]?) := stx | unreachable!
    let prio := (prio.bind (·.1.isNatLit?)).getD (eval_prio default)
    match label.bind (·.1.isStrLit?) with
    | "elim" => addElim decl kind prio
    | "move" => addMove decl kind prio
    | "squash" => addSquash decl kind prio
    | none => addInfer decl kind prio
    | _ => unreachable!
}


open tactic

meta def force { α : Type } (t : tactic α) : tactic α :=
  do gs ← get_goals,
     a ← t,
     gs' ← get_goals,
     guard (gs ≠ gs') <|> fail "force tactic failed",
     return a

namespace tactic.interactive
  meta def force (t : itactic) : tactic unit := _root_.force t
end tactic.interactive

set_option pp.all true

lemma a ( p q : nat ) : 1 = 1 :=
begin
  -- p q : nat
  -- ⊢ @eq.{1} nat (@one.{0} nat nat.has_one) (@one.{0} nat nat.has_one)
  force {
    revert q,
    intron 1
    -- p q : nat
    -- ⊢ @eq.{1} nat (@one.{0} nat nat.has_one) (@one.{0} nat nat.has_one)
  } -- ... but force succeeds here.
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jeremy Avigad, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rel
import Mathlib.PostPort

universes u l u_1 u_2 u_3

namespace Mathlib

/-- `roption α` is the type of "partial values" of type `α`. It
  is similar to `option α` except the domain condition can be an
  arbitrary proposition, not necessarily decidable. -/
structure roption (α : Type u) where
  dom : Prop
  get : dom → α

namespace roption

/-- Convert an `roption α` with a decidable domain to an option -/
def to_option {α : Type u_1} (o : roption α) [Decidable (dom o)] : Option α :=
  dite (dom o) (fun (h : dom o) => some (get o h)) fun (h : ¬dom o) => none

/-- `roption` extensionality -/
theorem ext' {α : Type u_1} {o : roption α} {p : roption α} (H1 : dom o ↔ dom p)
    (H2 : ∀ (h₁ : dom o) (h₂ : dom p), get o h₁ = get p h₂) : o = p :=
  sorry

/-- `roption` eta expansion -/
@[simp] theorem eta {α : Type u_1} (o : roption α) : (mk (dom o) fun (h : dom o) => get o h) = o :=
  sorry

/-- `a ∈ o` means that `o` is defined and equal to `a` -/
protected def mem {α : Type u_1} (a : α) (o : roption α) := ∃ (h : dom o), get o h = a

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

theorem mem_eq {α : Type u_1} (a : α) (o : roption α) : a ∈ o = ∃ (h : dom o), get o h = a := rfl

theorem dom_iff_mem {α : Type u_1} {o : roption α} : dom o ↔ ∃ (y : α), y ∈ o := sorry

theorem get_mem {α : Type u_1} {o : roption α} (h : dom o) : get o h ∈ o := Exists.intro h rfl

/-- `roption` extensionality -/
theorem ext {α : Type u_1} {o : roption α} {p : roption α} (H : ∀ (a : α), a ∈ o ↔ a ∈ p) : o = p :=
  sorry

/-- The `none` value in `roption` has a `false` domain and an empty function. -/
def none {α : Type u_1} : roption α := mk False False._oldrec

protected instance inhabited {α : Type u_1} : Inhabited (roption α) := { default := none }

@[simp] theorem not_mem_none {α : Type u_1} (a : α) : ¬a ∈ none :=
  fun (h : a ∈ none) => Exists.fst h

/-- The `some a` value in `roption` has a `true` domain and the
  function returns `a`. -/
def some {α : Type u_1} (a : α) : roption α := mk True fun (_x : True) => a

theorem mem_unique {α : Type u_1} : relator.left_unique has_mem.mem := sorry

theorem get_eq_of_mem {α : Type u_1} {o : roption α} {a : α} (h : a ∈ o) (h' : dom o) :
    get o h' = a :=
  mem_unique (Exists.intro h' rfl) h

@[simp] theorem get_some {α : Type u_1} {a : α} (ha : dom (some a)) : get (some a) ha = a := rfl

theorem mem_some {α : Type u_1} (a : α) : a ∈ some a := Exists.intro trivial rfl

@[simp] theorem mem_some_iff {α : Type u_1} {a : α} {b : α} : b ∈ some a ↔ b = a := sorry

theorem eq_some_iff {α : Type u_1} {a : α} {o : roption α} : o = some a ↔ a ∈ o := sorry

theorem eq_none_iff {α : Type u_1} {o : roption α} : o = none ↔ ∀ (a : α), ¬a ∈ o := sorry

theorem eq_none_iff' {α : Type u_1} {o : roption α} : o = none ↔ ¬dom o :=
  { mp := fun (e : o = none) => Eq.symm e ▸ id,
    mpr := fun (h : ¬dom o) => iff.mpr eq_none_iff fun (a : α) (h' : a ∈ o) => h (Exists.fst h') }

theorem some_ne_none {α : Type u_1} (x : α) : some x ≠ none :=
  id
    fun (h : some x = none) =>
      id (eq.mpr (id (Eq._oldrec (Eq.refl (dom none)) (Eq.symm h))) trivial)

theorem ne_none_iff {α : Type u_1} {o : roption α} : o ≠ none ↔ ∃ (x : α), o = some x := sorry

theorem eq_none_or_eq_some {α : Type u_1} (o : roption α) : o = none ∨ ∃ (x : α), o = some x :=
  sorry

@[simp] theorem some_inj {α : Type u_1} {a : α} {b : α} : some a = some b ↔ a = b :=
  function.injective.eq_iff
    fun (a b : α) (h : some a = some b) => congr_fun (eq_of_heq (and.right (mk.inj h))) trivial

@[simp] theorem some_get {α : Type u_1} {a : roption α} (ha : dom a) : some (get a ha) = a :=
  Eq.symm (iff.mpr eq_some_iff (Exists.intro ha rfl))

theorem get_eq_iff_eq_some {α : Type u_1} {a : roption α} {ha : dom a} {b : α} :
    get a ha = b ↔ a = some b :=
  sorry

protected instance none_decidable {α : Type u_1} : Decidable (dom none) := decidable.false

protected instance some_decidable {α : Type u_1} (a : α) : Decidable (dom (some a)) :=
  decidable.true

def get_or_else {α : Type u_1} (a : roption α) [Decidable (dom a)] (d : α) : α :=
  dite (dom a) (fun (ha : dom a) => get a ha) fun (ha : ¬dom a) => d

@[simp] theorem get_or_else_none {α : Type u_1} (d : α) : get_or_else none d = d := dif_neg id

@[simp] theorem get_or_else_some {α : Type u_1} (a : α) (d : α) : get_or_else (some a) d = a :=
  dif_pos trivial

@[simp] theorem mem_to_option {α : Type u_1} {o : roption α} [Decidable (dom o)] {a : α} :
    a ∈ to_option o ↔ a ∈ o :=
  sorry

/-- Convert an `option α` into an `roption α` -/
def of_option {α : Type u_1} : Option α → roption α := sorry

@[simp] theorem mem_of_option {α : Type u_1} {a : α} {o : Option α} : a ∈ of_option o ↔ a ∈ o :=
  sorry

@[simp] theorem of_option_dom {α : Type u_1} (o : Option α) :
    dom (of_option o) ↔ ↥(option.is_some o) :=
  sorry

theorem of_option_eq_get {α : Type u_1} (o : Option α) :
    of_option o = mk (↥(option.is_some o)) option.get :=
  sorry

protected instance has_coe {α : Type u_1} : has_coe (Option α) (roption α) := has_coe.mk of_option

@[simp] theorem mem_coe {α : Type u_1} {a : α} {o : Option α} : a ∈ ↑o ↔ a ∈ o := mem_of_option

@[simp] theorem coe_none {α : Type u_1} : ↑none = none := rfl

@[simp] theorem coe_some {α : Type u_1} (a : α) : ↑(some a) = some a := rfl

protected theorem induction_on {α : Type u_1} {P : roption α → Prop} (a : roption α)
    (hnone : P none) (hsome : ∀ (a : α), P (some a)) : P a :=
  or.elim (classical.em (dom a)) (fun (h : dom a) => some_get h ▸ hsome (get a h))
    fun (h : ¬dom a) => Eq.symm (iff.mpr eq_none_iff' h) ▸ hnone

protected instance of_option_decidable {α : Type u_1} (o : Option α) :
    Decidable (dom (of_option o)) :=
  sorry

@[simp] theorem to_of_option {α : Type u_1} (o : Option α) : to_option (of_option o) = o :=
  option.cases_on o (Eq.refl (to_option (of_option none)))
    fun (o : α) => Eq.refl (to_option (of_option (some o)))

@[simp] theorem of_to_option {α : Type u_1} (o : roption α) [Decidable (dom o)] :
    of_option (to_option o) = o :=
  ext fun (a : α) => iff.trans mem_of_option mem_to_option

def equiv_option {α : Type u_1} : roption α ≃ Option α :=
  equiv.mk (fun (o : roption α) => to_option o) of_option sorry sorry

protected instance order_bot {α : Type u_1} : order_bot (roption α) :=
  order_bot.mk none (fun (x y : roption α) => ∀ (i : α), i ∈ x → i ∈ y)
    (partial_order.lt._default fun (x y : roption α) => ∀ (i : α), i ∈ x → i ∈ y) sorry sorry sorry
    sorry

protected instance preorder {α : Type u_1} : preorder (roption α) :=
  partial_order.to_preorder (roption α)

theorem le_total_of_le_of_le {α : Type u_1} {x : roption α} {y : roption α} (z : roption α)
    (hx : x ≤ z) (hy : y ≤ z) : x ≤ y ∨ y ≤ x :=
  sorry

/-- `assert p f` is a bind-like operation which appends an additional condition
  `p` to the domain and uses `f` to produce the value. -/
def assert {α : Type u_1} (p : Prop) (f : p → roption α) : roption α :=
  mk (∃ (h : p), dom (f h)) fun (ha : ∃ (h : p), dom (f h)) => get (f sorry) sorry

/-- The bind operation has value `g (f.get)`, and is defined when all the
  parts are defined. -/
protected def bind {α : Type u_1} {β : Type u_2} (f : roption α) (g : α → roption β) : roption β :=
  assert (dom f) fun (b : dom f) => g (get f b)

/-- The map operation for `roption` just maps the value and maintains the same domain. -/
def map {α : Type u_1} {β : Type u_2} (f : α → β) (o : roption α) : roption β :=
  mk (dom o) (f ∘ get o)

theorem mem_map {α : Type u_1} {β : Type u_2} (f : α → β) {o : roption α} {a : α} :
    a ∈ o → f a ∈ map f o :=
  sorry

@[simp] theorem mem_map_iff {α : Type u_1} {β : Type u_2} (f : α → β) {o : roption α} {b : β} :
    b ∈ map f o ↔ ∃ (a : α), ∃ (H : a ∈ o), f a = b :=
  sorry

@[simp] theorem map_none {α : Type u_1} {β : Type u_2} (f : α → β) : map f none = none := sorry

@[simp] theorem map_some {α : Type u_1} {β : Type u_2} (f : α → β) (a : α) :
    map f (some a) = some (f a) :=
  iff.mpr eq_some_iff (mem_map f (mem_some a))

theorem mem_assert {α : Type u_1} {p : Prop} {f : p → roption α} {a : α} (h : p) :
    a ∈ f h → a ∈ assert p f :=
  sorry

@[simp] theorem mem_assert_iff {α : Type u_1} {p : Prop} {f : p → roption α} {a : α} :
    a ∈ assert p f ↔ ∃ (h : p), a ∈ f h :=
  sorry

theorem assert_pos {α : Type u_1} {p : Prop} {f : p → roption α} (h : p) : assert p f = f h := sorry

theorem assert_neg {α : Type u_1} {p : Prop} {f : p → roption α} (h : ¬p) : assert p f = none :=
  sorry

theorem mem_bind {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} {a : α} {b : β} :
    a ∈ f → b ∈ g a → b ∈ roption.bind f g :=
  sorry

@[simp] theorem mem_bind_iff {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β}
    {b : β} : b ∈ roption.bind f g ↔ ∃ (a : α), ∃ (H : a ∈ f), b ∈ g a :=
  sorry

@[simp] theorem bind_none {α : Type u_1} {β : Type u_2} (f : α → roption β) :
    roption.bind none f = none :=
  sorry

@[simp] theorem bind_some {α : Type u_1} {β : Type u_2} (a : α) (f : α → roption β) :
    roption.bind (some a) f = f a :=
  sorry

theorem bind_some_eq_map {α : Type u_1} {β : Type u_2} (f : α → β) (x : roption α) :
    roption.bind x (some ∘ f) = map f x :=
  sorry

theorem bind_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : roption α) (g : α → roption β)
    (k : β → roption γ) :
    roption.bind (roption.bind f g) k = roption.bind f fun (x : α) => roption.bind (g x) k :=
  sorry

@[simp] theorem bind_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → β) (x : roption α)
    (g : β → roption γ) : roption.bind (map f x) g = roption.bind x fun (y : α) => g (f y) :=
  sorry

@[simp] theorem map_bind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α → roption β)
    (x : roption α) (g : β → γ) :
    map g (roption.bind x f) = roption.bind x fun (y : α) => map g (f y) :=
  sorry

theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (g : β → γ) (f : α → β)
    (o : roption α) : map g (map f o) = map (g ∘ f) o :=
  sorry

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

protected instance is_lawful_monad : is_lawful_monad roption :=
  is_lawful_monad.mk bind_some bind_assoc

theorem map_id' {α : Type u_1} {f : α → α} (H : ∀ (x : α), f x = x) (o : roption α) : map f o = o :=
  eq.mpr (id (Eq._oldrec (Eq.refl (map f o = o)) ((fun (this : f = id) => this) (funext H))))
    (id_map o)

@[simp] theorem bind_some_right {α : Type u_1} (x : roption α) : roption.bind x some = x := sorry

@[simp] theorem pure_eq_some {α : Type u_1} (a : α) : pure a = some a := rfl

@[simp] theorem ret_eq_some {α : Type u_1} (a : α) : return a = some a := rfl

@[simp] theorem map_eq_map {α : Type u_1} {β : Type u_1} (f : α → β) (o : roption α) :
    f <$> o = map f o :=
  rfl

@[simp] theorem bind_eq_bind {α : Type u_1} {β : Type u_1} (f : roption α) (g : α → roption β) :
    f >>= g = roption.bind f g :=
  rfl

theorem bind_le {β : Type u_2} {α : Type u_2} (x : roption α) (f : α → roption β) (y : roption β) :
    x >>= f ≤ y ↔ ∀ (a : α), a ∈ x → f a ≤ y :=
  sorry

protected instance monad_fail : monad_fail roption :=
  monad_fail.mk fun (_x : Type u_1) (_x_1 : string) => none

/- `restrict p o h` replaces the domain of `o` with `p`, and is well defined when
  `p` implies `o` is defined. -/

def restrict {α : Type u_1} (p : Prop) (o : roption α) : (p → dom o) → roption α := sorry

@[simp] theorem mem_restrict {α : Type u_1} (p : Prop) (o : roption α) (h : p → dom o) (a : α) :
    a ∈ restrict p o h ↔ p ∧ a ∈ o :=
  sorry

/-- `unwrap o` gets the value at `o`, ignoring the condition.
  (This function is unsound.) -/
theorem assert_defined {α : Type u_1} {p : Prop} {f : p → roption α} (h : p) :
    dom (f h) → dom (assert p f) :=
  exists.intro

theorem bind_defined {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} (h : dom f) :
    dom (g (get f h)) → dom (roption.bind f g) :=
  assert_defined

@[simp] theorem bind_dom {α : Type u_1} {β : Type u_2} {f : roption α} {g : α → roption β} :
    dom (roption.bind f g) ↔ ∃ (h : dom f), dom (g (get f h)) :=
  iff.rfl

end roption

/-- `pfun α β`, or `α →. β`, is the type of partial functions from
  `α` to `β`. It is defined as `α → roption β`. -/
def pfun (α : Type u_1) (β : Type u_2) := α → roption β

infixr:25 " →. " => Mathlib.pfun

namespace pfun

protected instance inhabited {α : Type u_1} {β : Type u_2} : Inhabited (α →. β) :=
  { default := fun (a : α) => roption.none }

/-- The domain of a partial function -/
def dom {α : Type u_1} {β : Type u_2} (f : α →. β) : set α :=
  set_of fun (a : α) => roption.dom (f a)

theorem mem_dom {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) :
    x ∈ dom f ↔ ∃ (y : β), y ∈ f x :=
  sorry

theorem dom_eq {α : Type u_1} {β : Type u_2} (f : α →. β) :
    dom f = set_of fun (x : α) => ∃ (y : β), y ∈ f x :=
  set.ext (mem_dom f)

/-- Evaluate a partial function -/
def fn {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) (h : dom f x) : β := roption.get (f x) h

/-- Evaluate a partial function to return an `option` -/
def eval_opt {α : Type u_1} {β : Type u_2} (f : α →. β) [D : decidable_pred (dom f)] (x : α) :
    Option β :=
  roption.to_option (f x)

/-- Partial function extensionality -/
theorem ext' {α : Type u_1} {β : Type u_2} {f : α →. β} {g : α →. β}
    (H1 : ∀ (a : α), a ∈ dom f ↔ a ∈ dom g)
    (H2 : ∀ (a : α) (p : dom f a) (q : dom g a), fn f a p = fn g a q) : f = g :=
  funext fun (a : α) => roption.ext' (H1 a) (H2 a)

theorem ext {α : Type u_1} {β : Type u_2} {f : α →. β} {g : α →. β}
    (H : ∀ (a : α) (b : β), b ∈ f a ↔ b ∈ g a) : f = g :=
  funext fun (a : α) => roption.ext (H a)

/-- Turn a partial function into a function out of a subtype -/
def as_subtype {α : Type u_1} {β : Type u_2} (f : α →. β) (s : ↥(dom f)) : β := fn f ↑s sorry

/-- The set of partial functions `α →. β` is equivalent to
the set of pairs `(p : α → Prop, f : subtype p → β)`. -/
def equiv_subtype {α : Type u_1} {β : Type u_2} :
    (α →. β) ≃ sigma fun (p : α → Prop) => Subtype p → β :=
  equiv.mk (fun (f : α →. β) => sigma.mk (fun (a : α) => roption.dom (f a)) (as_subtype f))
    (fun (f : sigma fun (p : α → Prop) => Subtype p → β) (x : α) =>
      roption.mk (sigma.fst f x) fun (h : sigma.fst f x) => sigma.snd f { val := x, property := h })
    sorry sorry

theorem as_subtype_eq_of_mem {α : Type u_1} {β : Type u_2} {f : α →. β} {x : α} {y : β}
    (fxy : y ∈ f x) (domx : x ∈ dom f) : as_subtype f { val := x, property := domx } = y :=
  roption.mem_unique (roption.get_mem (as_subtype._proof_1 f { val := x, property := domx })) fxy

/-- Turn a total function into a partial function -/
protected def lift {α : Type u_1} {β : Type u_2} (f : α → β) : α →. β :=
  fun (a : α) => roption.some (f a)

protected instance has_coe {α : Type u_1} {β : Type u_2} : has_coe (α → β) (α →. β) :=
  has_coe.mk pfun.lift

@[simp] theorem lift_eq_coe {α : Type u_1} {β : Type u_2} (f : α → β) : pfun.lift f = ↑f := rfl

@[simp] theorem coe_val {α : Type u_1} {β : Type u_2} (f : α → β) (a : α) :
    coe f a = roption.some (f a) :=
  rfl

/-- The graph of a partial function is the set of pairs
  `(x, f x)` where `x` is in the domain of `f`. -/
def graph {α : Type u_1} {β : Type u_2} (f : α →. β) : set (α × β) :=
  set_of fun (p : α × β) => prod.snd p ∈ f (prod.fst p)

def graph' {α : Type u_1} {β : Type u_2} (f : α →. β) : rel α β := fun (x : α) (y : β) => y ∈ f x

/-- The range of a partial function is the set of values
  `f x` where `x` is in the domain of `f`. -/
def ran {α : Type u_1} {β : Type u_2} (f : α →. β) : set β :=
  set_of fun (b : β) => ∃ (a : α), b ∈ f a

/-- Restrict a partial function to a smaller domain. -/
def restrict {α : Type u_1} {β : Type u_2} (f : α →. β) {p : set α} (H : p ⊆ dom f) : α →. β :=
  fun (x : α) => roption.restrict (x ∈ p) (f x) H

@[simp] theorem mem_restrict {α : Type u_1} {β : Type u_2} {f : α →. β} {s : set α} (h : s ⊆ dom f)
    (a : α) (b : β) : b ∈ restrict f h a ↔ a ∈ s ∧ b ∈ f a :=
  sorry

def res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) : α →. β :=
  restrict (pfun.lift f) (set.subset_univ s)

theorem mem_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (a : α) (b : β) :
    b ∈ res f s a ↔ a ∈ s ∧ f a = b :=
  sorry

theorem res_univ {α : Type u_1} {β : Type u_2} (f : α → β) : res f set.univ = ↑f := rfl

theorem dom_iff_graph {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) :
    x ∈ dom f ↔ ∃ (y : β), (x, y) ∈ graph f :=
  roption.dom_iff_mem

theorem lift_graph {α : Type u_1} {β : Type u_2} {f : α → β} {a : α} {b : β} :
    (a, b) ∈ graph ↑f ↔ f a = b :=
  sorry

/-- The monad `pure` function, the total constant `x` function -/
protected def pure {α : Type u_1} {β : Type u_2} (x : β) : α →. β := fun (_x : α) => roption.some x

/-- The monad `bind` function, pointwise `roption.bind` -/
def bind {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : α →. β) (g : β → α →. γ) : α →. γ :=
  fun (a : α) => roption.bind (f a) fun (b : β) => g b a

/-- The monad `map` function, pointwise `roption.map` -/
def map {α : Type u_1} {β : Type u_2} {γ : Type u_3} (f : β → γ) (g : α →. β) : α →. γ :=
  fun (a : α) => roption.map f (g a)

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

protected instance is_lawful_monad {α : Type u_1} : is_lawful_monad (pfun α) :=
  is_lawful_monad.mk
    (fun (β γ : Type u_2) (x : β) (f : β → α →. γ) =>
      funext fun (a : α) => roption.bind_some a (f x))
    fun (β γ δ : Type u_2) (f : α →. β) (g : β → α →. γ) (k : γ → α →. δ) =>
      funext fun (a : α) => roption.bind_assoc (f a) (fun (b : β) => g b a) fun (b : γ) => k b a

theorem pure_defined {α : Type u_1} {β : Type u_2} (p : set α) (x : β) : p ⊆ dom (pfun.pure x) :=
  set.subset_univ p

theorem bind_defined {α : Type u_1} {β : Type u_2} {γ : Type u_2} (p : set α) {f : α →. β}
    {g : β → α →. γ} (H1 : p ⊆ dom f) (H2 : ∀ (x : β), p ⊆ dom (g x)) : p ⊆ dom (f >>= g) :=
  fun (a : α) (ha : a ∈ p) => Exists.intro (H1 ha) (H2 (roption.get (f a) (H1 ha)) ha)

def fix {α : Type u_1} {β : Type u_2} (f : α →. β ⊕ α) : α →. β :=
  fun (a : α) =>
    roption.assert (acc (fun (x y : α) => sum.inr x ∈ f y) a)
      fun (h : acc (fun (x y : α) => sum.inr x ∈ f y) a) =>
        well_founded.fix_F
          (fun (a : α) (IH : (y : α) → sum.inr y ∈ f a → roption β) =>
            roption.assert (roption.dom (f a))
              fun (hf : roption.dom (f a)) =>
                (fun (_x : β ⊕ α) (e : roption.get (f a) hf = _x) =>
                    sum.cases_on _x
                      (fun (b : β) (e : roption.get (f a) hf = sum.inl b) => roption.some b)
                      (fun (a' : α) (e : roption.get (f a) hf = sum.inr a') => IH a' sorry) e)
                  (roption.get (f a) hf) sorry)
          a h

theorem dom_of_mem_fix {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {a : α} {b : β}
    (h : b ∈ fix f a) : roption.dom (f a) :=
  sorry

theorem mem_fix_iff {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {a : α} {b : β} :
    b ∈ fix f a ↔ sum.inl b ∈ f a ∨ ∃ (a' : α), sum.inr a' ∈ f a ∧ b ∈ fix f a' :=
  sorry

def fix_induction {α : Type u_1} {β : Type u_2} {f : α →. β ⊕ α} {b : β} {C : α → Sort u_3} {a : α}
    (h : b ∈ fix f a)
    (H : (a : α) → b ∈ fix f a → ((a' : α) → b ∈ fix f a' → sum.inr a' ∈ f a → C a') → C a) : C a :=
  sorry

end pfun

namespace pfun

def image {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) : set β := rel.image (graph' f) s

theorem image_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) :
    image f s = set_of fun (y : β) => ∃ (x : α), ∃ (H : x ∈ s), y ∈ f x :=
  rfl

theorem mem_image {α : Type u_1} {β : Type u_2} (f : α →. β) (y : β) (s : set α) :
    y ∈ image f s ↔ ∃ (x : α), ∃ (H : x ∈ s), y ∈ f x :=
  iff.rfl

theorem image_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set α} {t : set α} (h : s ⊆ t) :
    image f s ⊆ image f t :=
  rel.image_mono (graph' f) h

theorem image_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) (t : set α) :
    image f (s ∩ t) ⊆ image f s ∩ image f t :=
  rel.image_inter (graph' f) s t

theorem image_union {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set α) (t : set α) :
    image f (s ∪ t) = image f s ∪ image f t :=
  rel.image_union (graph' f) s t

def preimage {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : set α :=
  rel.preimage (fun (x : α) (y : β) => y ∈ f x) s

theorem preimage_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    preimage f s = set_of fun (x : α) => ∃ (y : β), ∃ (H : y ∈ s), y ∈ f x :=
  rfl

theorem mem_preimage {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (x : α) :
    x ∈ preimage f s ↔ ∃ (y : β), ∃ (H : y ∈ s), y ∈ f x :=
  iff.rfl

theorem preimage_subset_dom {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    preimage f s ⊆ dom f :=
  sorry

theorem preimage_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set β} {t : set β}
    (h : s ⊆ t) : preimage f s ⊆ preimage f t :=
  rel.preimage_mono (fun (x : α) (y : β) => y ∈ f x) h

theorem preimage_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) :
    preimage f (s ∩ t) ⊆ preimage f s ∩ preimage f t :=
  rel.preimage_inter (fun (x : α) (y : β) => y ∈ f x) s t

theorem preimage_union {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) :
    preimage f (s ∪ t) = preimage f s ∪ preimage f t :=
  rel.preimage_union (fun (x : α) (y : β) => y ∈ f x) s t

theorem preimage_univ {α : Type u_1} {β : Type u_2} (f : α →. β) : preimage f set.univ = dom f :=
  sorry

def core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) : set α := rel.core (graph' f) s

theorem core_def {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    core f s = set_of fun (x : α) => ∀ (y : β), y ∈ f x → y ∈ s :=
  rfl

theorem mem_core {α : Type u_1} {β : Type u_2} (f : α →. β) (x : α) (s : set β) :
    x ∈ core f s ↔ ∀ (y : β), y ∈ f x → y ∈ s :=
  iff.rfl

theorem compl_dom_subset_core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    dom fᶜ ⊆ core f s :=
  fun (x : α) (hx : x ∈ (dom fᶜ)) (y : β) (fxy : graph' f x y) =>
    absurd (iff.mpr (mem_dom f x) (Exists.intro y fxy)) hx

theorem core_mono {α : Type u_1} {β : Type u_2} (f : α →. β) {s : set β} {t : set β} (h : s ⊆ t) :
    core f s ⊆ core f t :=
  rel.core_mono (graph' f) h

theorem core_inter {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) (t : set β) :
    core f (s ∩ t) = core f s ∩ core f t :=
  rel.core_inter (graph' f) s t

theorem mem_core_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (t : set β) (x : α) :
    x ∈ core (res f s) t ↔ x ∈ s → f x ∈ t :=
  sorry

theorem core_res {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) (t : set β) :
    core (res f s) t = sᶜ ∪ f ⁻¹' t :=
  sorry

theorem core_restrict {α : Type u_1} {β : Type u_2} (f : α → β) (s : set β) :
    core (↑f) s = f ⁻¹' s :=
  sorry

theorem preimage_subset_core {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    preimage f s ⊆ core f s :=
  sorry

theorem preimage_eq {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    preimage f s = core f s ∩ dom f :=
  sorry

theorem core_eq {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    core f s = preimage f s ∪ (dom fᶜ) :=
  sorry

theorem preimage_as_subtype {α : Type u_1} {β : Type u_2} (f : α →. β) (s : set β) :
    as_subtype f ⁻¹' s = subtype.val ⁻¹' preimage f s :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
-/
import Lean.Parser.Term

namespace Lean
namespace Parser
namespace Tactic

builtin_initialize
  register_parser_alias tacticSeq
  register_parser_alias tacticSeqIndentGt

/- This is a fallback tactic parser for any identifier which exists only
to improve syntax error messages.
```
example : True := by foo -- unknown tactic
```
-/
@[builtin_tactic_parser] def «unknown»    := leading_parser
  withPosition (ident >> errorAtSavedPos "unknown tactic" true)

@[builtin_tactic_parser] def nestedTactic := tacticSeqBracketed

def matchRhs  := Term.hole <|> Term.syntheticHole <|> tacticSeq
def matchAlts := Term.matchAlts (rhsParser := matchRhs)

/-- `match` performs case analysis on one or more expressions.
See [Induction and Recursion][tpil4].
The syntax for the `match` tactic is the same as term-mode `match`, except that
the match arms are tactics instead of expressions.
```
example (n : Nat) : n = n := by
  match n with
  | 0 => rfl
  | i+1 => simp
```

[tpil4]: https://leanprover.github.io/theorem_proving_in_lean4/induction_and_recursion.html
-/
@[builtin_tactic_parser] def «match» := leading_parser:leadPrec
  "match " >> optional Term.generalizingParam >>
  optional Term.motive >> sepBy1 Term.matchDiscr ", " >>
  " with " >> ppDedent matchAlts

/--
The tactic
```
intro
| pat1 => tac1
| pat2 => tac2
```
is the same as:
```
intro x
match x with
| pat1 => tac1
| pat2 => tac2
```
That is, `intro` can be followed by match arms and it introduces the values while
doing a pattern match. This is equivalent to `fun` with match arms in term mode.
-/
@[builtin_tactic_parser] def introMatch := leading_parser
  nonReservedSymbol "intro " >> matchAlts

/-- `decide` will attempt to prove a goal of type `p` by synthesizing an instance
of `Decidable p` and then evaluating it to `isTrue ..`. Because this uses kernel
computation to evaluate the term, it may not work in the presence of definitions
by well founded recursion, since this requires reducing proofs.
```
example : 2 + 2 ≠ 5 := by decide
```
-/
@[builtin_tactic_parser] def decide := leading_parser
  nonReservedSymbol "decide"

/-- `native_decide` will attempt to prove a goal of type `p` by synthesizing an instance
of `Decidable p` and then evaluating it to `isTrue ..`. Unlike `decide`, this
uses `#eval` to evaluate the decidability instance.

This should be used with care because it adds the entire lean compiler to the trusted
part, and the axiom `ofReduceBool` will show up in `#print axioms` for theorems using
this method or anything that transitively depends on them. Nevertheless, because it is
compiled, this can be significantly more efficient than using `decide`, and for very
large computations this is one way to run external programs and trust the result.
```
example : (List.range 1000).length = 1000 := by native_decide
```
-/
@[builtin_tactic_parser] def nativeDecide := leading_parser
  nonReservedSymbol "native_decide"

end Tactic
end Parser
end Lean


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/

/-!
# Extra facts about `pprod`
-/

variables {α : Sort*} {β : Sort*}

@[simp] lemma pprod.mk.eta {p : pprod α β} : pprod.mk p.1 p.2 = p :=
pprod.cases_on p (λ a b, rfl)


import Lean

def f1 (x : Nat) : Except String Nat :=
  if x > 0 then
    .ok x
  else
    .error "argument is zero"

namespace Lean.Elab
open Lsp

def identOf : Info → Option (RefIdent × Bool)
  | .ofTermInfo ti => match ti.expr with
    | .const n .. => some (.const n, ti.isBinder)
    | .fvar id .. => some (.fvar id, ti.isBinder)
    | _ => none
  | .ofFieldInfo fi => some (.const fi.projName, false)
  | _ => none

def isConst (e : Expr) : Bool :=
  e matches .const ..

def isImplicit (bi : BinderInfo) : Bool :=
  bi matches .implicit

end Lean.Elab

def f2 (xs : List Nat) : List Nat :=
  .map (· + 1) xs

def f2' (xs : List Nat) : List Nat :=
  .map .succ xs

def f3 : Nat :=
  .zero

def f4 (x : Nat) : Nat :=
  .succ x

example (xs : List α) : Lean.RBTree α ord :=
  xs.foldl .insert ∅