/-
# `MetaM`

The Lean 4 metaprogramming API is organised around a small zoo of monads. The
four main ones are:

- `CoreM` gives access to the *environment*, i.e. the set of things that
  have been declared or imported at the current point in the program.
- `MetaM` gives access to the *metavariable context*, i.e. the set of
  metavariables that are currently declared and the values assigned to them (if
  any).
- `TermElabM` gives access to various information used during elaboration.
- `TacticM` gives access to the list of current goals.

These monads extend each other, so a `MetaM` operation also has access to the
environment and a `TermElabM` computation can use metavariables. There are also
other monads which do not neatly fit into this hierarchy, e.g. `CommandElabM`
extends `MetaM` but neither extends nor is extended by `TermElabM`.

This chapter demonstrates a number of useful operations in the `MetaM` monad.
`MetaM` is of particular importance because it allows us to give meaning to
every expression: the environment (from `CoreM`) gives meaning to constants like
`Nat.zero` or `List.map` and the metavariable context gives meaning to both
metavariables and local hypotheses. -/

import Lean

open Lean Lean.Expr Lean.Meta

/-!
## Metavariables

### Overview

The 'Meta' in `MetaM` refers to metavariables, so we should talk about these
first. Lean users do not usually interact much with metavariables -- at least
not consciously -- but they are used all over the place in metaprograms. There
are two ways to view them: as holes in an expression or as goals.

Take the goal perspective first. When we prove things in Lean, we always operate
on goals, such as

```lean
n m : Nat
⊢ n + m = m + n
```

These goals are internally represented by metavariables. Accordingly, each
metavariable has a *local context* containing hypotheses (here `[n : Nat, m :
Nat]`) and a *target type* (here `n + m = m + n`). Metavariables also have a
unique name, say `m`, and we usually render them as `?m`.

To close a goal, we must give an expression `e` of the target type. The
expression may contain fvars from the metavariable's local context, but no
others. Internally, closing a goal in this way corresponds to *assigning* the
metavariable; we write `?m := e` for this assignment.

The second, complementary view of metavariables is that they represent holes
in an expression. For instance, an application of `Eq.trans` may generate two
goals which look like this:

```lean
n m : Nat
⊢ n = ?x

n m : Nat
⊢ ?x = m
```

Here `?x` is another metavariable -- a hole in the target types of both goals,
to be filled in later during the proof. The type of `?x` is `Nat` and its local
context is `[n : Nat, m : Nat]`. Now, if we solve the first goal by reflexivity,
then `?x` must be `n`, so we assign `?x := n`. Crucially, this also affects the
second goal: it is "updated" (not really, as we will see) to have target `n =
m`. The metavariable `?x` represents the same expression everywhere it occurs.

### Tactic Communication via Metavariables

Tactics use metavariables to communicate the current goals. To see how, consider
this simple (and slightly artificial) proof:
-/

example {α} (a : α) (f : α → α) (h : ∀ a, f a = a) : f (f a) = a := by
  apply Eq.trans
  apply h
  apply h

/-!
After we enter tactic mode, our ultimate goal is to generate an expression of
type `f (f a) = a` which may involve the hypotheses `α`, `a`, `f` and `h`. So
Lean generates a metavariable `?m1` with target `f (f a) = a` and a local
context containing these hypotheses. This metavariable is passed to the first
`apply` tactic as the current goal.

The `apply` tactic then tries to apply `Eq.trans` and succeeds, generating three
new metavariables:

```lean
...
⊢ f (f a) = ?b

...
⊢ ?b = a

...
⊢ α
```

Call these metavariables `?m2`, `?m3` and `?b`. The last one, `?b`, stands for
the intermediate element of the transitivity proof and occurs in `?m2` and
`?m3`. The local contexts of all metavariables in this proof are the same, so
we omit them.

Having created these metavariables, `apply` assigns

```lean
?m1 := @Eq.trans α (f (f a)) ?b a ?m2 ?m3
```

and reports that `?m2`, `?m3` and `?b` are now the current goals.

At this point the second `apply` tactic takes over. It receives `?m2` as the
current goal and applies `h` to it. This succeeds and the tactic assigns `?m2 :=
h (f a)`. This assignment implies that `?b` must be `f a`, so the tactic also
assigns `?b := f a`. Assigned metavariables are not considered open goals, so
the only goal that remains is `?m3`.

Now the third `apply` comes in. Since `?b` has been assigned, the target of
`?m3` is now `f (f a) = a`. Again, the application of `h` succeeds and the
tactic assigns `?m3 := h a`.

At this point, all metavariables are assigned as follows:

```lean
?m1 := @Eq.trans α (f (f a)) ?b a ?m2 ?m3
?m2 := h (f a)
?m3 := h a
?b  := f a
```

Exiting the `by` block, Lean constructs the final proof term by taking the
assignment of `?m1` and replacing each metavariable with its assignment. This
yields

```lean
@Eq.trans α (f (f a)) (f a) a (h (f a)) (h a)
```

The example also shows how the two views of metavariables -- as holes in an
expression or as goals -- are related: the goals we get are holes in the final
proof term.

### Basic Operations

Let us make these concepts concrete. When we operate in the `MetaM` monad, we
have read-write access to a `MetavarContext` structure containing information
about the currently declared metavariables. Each metavariable is identified by
an `MVarId` (a unique `Name`). To create a new metavariable, we use
`Lean.Meta.mkFreshExprMVar` with type

```lean
mkFreshExprMVar (type? : Option Expr) (kind := MetavarKind.natural)
    (userName := Name.anonymous) : MetaM Expr
```

Its arguments are:

- `type?`: the target type of the new metavariable. If `none`, the target type
  is `Sort ?u`, where `?u` is a universe level metavariable. (This is a special
  class of metavariables for universe levels, distinct from the expression
  metavariables which we have been calling simply "metavariables".)
- `kind`: the metavariable kind. See the [Metavariable Kinds
  section](#metavariable-kinds) (but the default is usually correct).
- `userName`: the new metavariable's user-facing name. This is what gets printed
  when the metavariable appears in a goal. Unlike the `MVarId`, this name does
  not need to be unique.

The returned `Expr` is always a metavariable. We can use `Lean.Expr.mvarId!` to
extract the `MVarId`, which is guaranteed to be unique. (Arguably
`mkFreshExprMVar` should just return the `MVarId`.)

The local context of the new metavariable is inherited from the current local
context, more about which in the next section. If you want to give a different
local context, use `Lean.Meta.mkFreshExprMVarAt`.

Metavariables are initially unassigned. To assign them, use
`Lean.MVarId.assign` with type

```lean
assign (mvarId : MVarId) (val : Expr) : MetaM Unit
```

This updates the `MetavarContext` with the assignment `?mvarId := val`. You must
make sure that `mvarId` is not assigned yet (or that the old assignment is
definitionally equal to the new assignment). You must also make sure that the
assigned value, `val`, has the right type. This means (a) that `val` must have
the target type of `mvarId` and (b) that `val` must only contain fvars from the
local context of `mvarId`.

If you `#check Lean.MVarId.assign`, you will see that its real type is more
general than the one we showed above: it works in any monad that has access to a
`MetavarContext`. But `MetaM` is by far the most important such monad, so in
this chapter, we specialise the types of `assign` and similar functions.

To get information about a declared metavariable, use `Lean.MVarId.getDecl`.
Given an `MVarId`, this returns a `MetavarDecl` structure. (If no metavariable
with the given `MVarId` is declared, the function throws an exception.) The
`MetavarDecl` contains information about the metavariable, e.g. its type, local
context and user-facing name. This function has some convenient variants, such
as `Lean.MVarId.getType`.

To get the current assignment of a metavariable (if any), use
`Lean.getExprMVarAssignment?`. To check whether a metavariable is assigned, use
`Lean.MVarId.isAssigned`. However, these functions are relatively rarely
used in tactic code because we usually prefer a more powerful operation:
`Lean.Meta.instantiateMVars` with type

```lean
instantiateMVars : Expr → MetaM Expr
```

Given an expression `e`, `instantiateMVars` replaces any assigned metavariable
`?m` in `e` with its assigned value. Unassigned metavariables remain as they
are.

This operation should be used liberally. When we assign a metavariable, existing
expressions containing this metavariable are not immediately updated. This is a
problem when, for example, we match on an expression to check whether it is an
equation. Without `instantiateMVars`, we might miss the fact that the expression
`?m`, where `?m` happens to be assigned to `0 = n`, represents an equation. In
other words, `instantiateMVars` brings our expressions up to date with the
current metavariable state.

Instantiating metavariables requires a full traversal of the input expression,
so it can be somewhat expensive. But if the input expression does not contain
any metavariables, `instantiateMVars` is essentially free. Since this is the
common case, liberal use of `instantiateMVars` is fine in most situations.

Before we go on, here is a synthetic example demonstrating how the basic
metavariable operations are used. More natural examples appear in the following
sections.
-/

#eval show MetaM Unit from do
  -- Create two fresh metavariables of type `Nat`.
  let mvar1 ← mkFreshExprMVar (Expr.const ``Nat []) (userName := `mvar1)
  let mvar2 ← mkFreshExprMVar (Expr.const ``Nat []) (userName := `mvar2)
  -- Create a fresh metavariable of type `Nat → Nat`. The `mkArrow` function
  -- creates a function type.
  let mvar3 ← mkFreshExprMVar (← mkArrow (.const ``Nat []) (.const ``Nat []))
    (userName := `mvar3)

  -- Define a helper function that prints each metavariable.
  let printMVars : MetaM Unit := do
    IO.println s!"  meta1: {← instantiateMVars mvar1}"
    IO.println s!"  meta2: {← instantiateMVars mvar2}"
    IO.println s!"  meta3: {← instantiateMVars mvar3}"

  IO.println "Initially, all metavariables are unassigned:"
  printMVars

  -- Assign `mvar1 : Nat := ?mvar3 ?mvar2`.
  mvar1.mvarId!.assign (.app mvar3 mvar2)
  IO.println "After assigning mvar1:"
  printMVars

  -- Assign `mvar2 : Nat := 0`.
  mvar2.mvarId!.assign (.const ``Nat.zero [])
  IO.println "After assigning mvar2:"
  printMVars

  -- Assign `mvar3 : Nat → Nat := Nat.succ`.
  mvar3.mvarId!.assign (.const ``Nat.succ [])
  IO.println "After assigning mvar3:"
  printMVars
-- Initially, all metavariables are unassigned:
--   meta1: ?_uniq.1
--   meta2: ?_uniq.2
--   meta3: ?_uniq.3
-- After assigning mvar1:
--   meta1: ?_uniq.3 ?_uniq.2
--   meta2: ?_uniq.2
--   meta3: ?_uniq.3
-- After assigning mvar2:
--   meta1: ?_uniq.3 Nat.zero
--   meta2: Nat.zero
--   meta3: ?_uniq.3
-- After assigning mvar3:
--   meta1: Nat.succ Nat.zero
--   meta2: Nat.zero
--   meta3: Nat.succ

/-!
### Local Contexts

Consider the expression `e` which refers to the free variable with unique name
`h`:

```lean
e := .fvar (FVarId.mk `h)
```

What is the type of this expression? The answer depends on the local context in
which `e` is interpreted. One local context may declare that `h` is a local
hypothesis of type `Nat`; another local context may declare that `h` is a local
definition with value `List.map`.

Thus, expressions are only meaningful if they are interpreted in the local
context for which they were intended. And as we saw, each metavariable has its
own local context. So in principle, functions which manipulate expressions
should have an additional `MVarId` argument specifying the goal in which the
expression should be interpreted.

That would be cumbersome, so Lean goes a slightly different route. In `MetaM`,
we always have access to an ambient `LocalContext`, obtained with `Lean.getLCtx`
of type

```lean
getLCtx : MetaM LocalContext
```

All operations involving fvars use this ambient local context.

The downside of this setup is that we always need to update the ambient local
context to match the goal we are currently working on. To do this, we use
`Lean.MVarId.withContext` of type

```lean
withContext (mvarId : MVarId) (c : MetaM α) : MetaM α
```

This function takes a metavariable `mvarId` and a `MetaM` computation `c` and
executes `c` with the ambient context set to the local context of `mvarId`. A
typical use case looks like this:

```lean
def someTactic (mvarId : MVarId) ... : ... :=
  mvarId.withContext do
    ...
```

The tactic receives the current goal as the metavariable `mvarId` and
immediately sets the current local context. Any operations within the `do` block
then use the local context of `mvarId`.

Once we have the local context properly set, we can manipulate fvars. Like
metavariables, fvars are identified by an `FVarId` (a unique `Name`). Basic
operations include:

- `Lean.FVarId.getDecl : FVarId → MetaM LocalDecl` retrieves the declaration
  of a local hypothesis. As with metavariables, a `LocalDecl` contains all
  information pertaining to the local hypothesis, e.g. its type and its
  user-facing name.
- `Lean.Meta.getLocalDeclFromUserName : Name → MetaM LocalDecl` retrieves the
  declaration of the local hypothesis with the given user-facing name. If there
  are multiple such hypotheses, the bottommost one is returned. If there is
  none, an exception is thrown.

We can also iterate over all hypotheses in the local context, using the `ForIn`
instance of `LocalContext`. A typical pattern is this:

```lean
for ldecl in ← getLCtx do
  if ldecl.isImplementationDetail then
    continue
  -- do something with the ldecl
```

The loop iterates over every `LocalDecl` in the context. The
`isImplementationDetail` check skips local hypotheses which are 'implementation
details', meaning they are introduced by Lean or by tactics for bookkeeping
purposes. They are not shown to users and tactics are expected to ignore them.

At this point, we can build the `MetaM` part of an `assumption` tactic:
-/

def myAssumption (mvarId : MVarId) : MetaM Bool := do
  -- Check that `mvarId` is not already assigned.
  mvarId.checkNotAssigned `myAssumption
  -- Use the local context of `mvarId`.
  mvarId.withContext do
    -- The target is the type of `mvarId`.
    let target ← mvarId.getType
    -- For each hypothesis in the local context:
    for ldecl in ← getLCtx do
      -- If the hypothesis is an implementation detail, skip it.
      if ldecl.isImplementationDetail then
        continue
      -- If the type of the hypothesis is definitionally equal to the target
      -- type:
      if ← isDefEq ldecl.type target then
        -- Use the local hypothesis to prove the goal.
        mvarId.assign ldecl.toExpr
        -- Stop and return true.
        return true
    -- If we have not found any suitable local hypothesis, return false.
    return false

/-
The `myAssumption` tactic contains three functions we have not seen before:

- `Lean.MVarId.checkNotAssigned` checks that a metavariable is not already
  assigned. The 'myAssumption' argument is the name of the current tactic. It is
  used to generate a nicer error message.
- `Lean.Meta.isDefEq` checks whether two definitions are definitionally equal.
  See the [Definitional Equality section](#definitional-equality).
- `Lean.LocalDecl.toExpr` is a helper function which constructs the `fvar`
  expression corresponding to a local hypothesis.

### Delayed Assignments

The above discussion of metavariable assignment contains a lie by omission:
there are actually two ways to assign a metavariable. We have seen the regular
way; the other way is called a *delayed assignment*.

We do not discuss delayed assignments in any detail here since they are rarely
useful for tactic writing. If you want to learn more about them, see the
comments in `MetavarContext.lean` in the Lean standard library. But they create
two complications which you should be aware of.

First, delayed assignments make `Lean.MVarId.isAssigned` and
`getExprMVarAssignment?` medium-calibre footguns. These functions only check for
regular assignments, so you may need to use `Lean.MVarId.isDelayedAssigned`
and `Lean.Meta.getDelayedMVarAssignment?` as well.

Second, delayed assignments break an intuitive invariant. You may have assumed
that any metavariable which remains in the output of `instantiateMVars` is
unassigned, since the assigned metavariables have been substituted. But delayed
metavariables can only be substituted once their assigned value contains no
unassigned metavariables. So delayed-assigned metavariables can appear in an
expression even after `instantiateMVars`.

### Metavariable Depth

Metavariable depth is also a niche feature, but one that is occasionally useful.
Any metavariable has a *depth* (a natural number), and a `MetavarContext` has a
corresponding depth as well. Lean only assigns a metavariable if its depth is
equal to the depth of the current `MetavarContext`. Newly created metavariables
inherit the `MetavarContext`'s depth, so by default every metavariable is
assignable.

This setup can be used when a tactic needs some temporary metavariables and also
needs to make sure that other, non-temporary metavariables will not be assigned.
To ensure this, the tactic proceeds as follows:

1. Save the current `MetavarContext`.
2. Increase the depth of the `MetavarContext`.
3. Perform whatever computation is necessary, possibly creating and assigning
   metavariables. Newly created metavariables are at the current depth of the
   `MetavarContext` and so can be assigned. Old metavariables are at a lower
   depth, so cannot be assigned.
4. Restore the saved `MetavarContext`, thereby erasing all the temporary
   metavariables and resetting the `MetavarContext` depth.

This pattern is encapsulated in `Lean.Meta.withNewMCtxDepth`.

## Computation

Computation is a core concept of dependent type theory. The terms `2`, `Nat.succ
1` and `1 + 1` are all "the same" in the sense that they compute the same value.
We call them *definitionally equal*. The problem with this, from a
metaprogramming perspective, is that definitionally equal terms may be
represented by entirely different expressions, but our users would usually
expect that a tactic which works for `2` also works for `1 + 1`. So when we
write our tactics, we must do additional work to ensure that definitionally
equal terms are treated similarly.

### Full Normalisation

The simplest thing we can do with computation is to bring a term into normal
form. With some exceptions for numeric types, the normal form of a term `t` of
type `T` is a sequence of applications of `T`'s constructors. E.g. the normal
form of a list is a sequence of applications of `List.cons` and `List.nil`.

The function that normalises a term (i.e. brings it into normal form) is
`Lean.Meta.reduce` with type signature

```lean
reduce (e : Expr) (explicitOnly skipTypes skipProofs := true) : MetaM Expr
```

We can use it like this:
-/

def someNumber : Nat := (· + 2) $ 3

#eval Expr.const ``someNumber []
-- Lean.Expr.const `someNumber []

#eval reduce (Expr.const ``someNumber [])
-- Lean.Expr.lit (Lean.Literal.natVal 5)

/-!
Incidentally, this shows that the normal form of a term of type `Nat` is not
always an application of the constructors of `Nat`; it can also be a literal.
Also note that `#eval` can be used not only to evaluate a term, but also to
execute a `MetaM` program.

The optional arguments of `reduce` allow us to skip certain parts of an
expression. E.g. `reduce e (explicitOnly := true)` does not normalise any
implicit arguments in the expression `e`. This yields better performance: since
normal forms can be very big, it may be a good idea to skip parts of an
expression that the user is not going to see anyway.

The `#reduce` command is essentially an application of `reduce`:
-/

#reduce someNumber
-- 5

/-!
### Transparency

An ugly but important detail of Lean 4 metaprogramming is that any given
expression does not have a single normal form. Rather, it has a normal form up
to a given *transparency*.

A transparency is a value of `Lean.Meta.TransparencyMode`, an enumeration with
four values: `reducible`, `instances`, `default` and `all`. Any `MetaM`
computation has access to an ambient `TransparencyMode` which can be obtained
with `Lean.Meta.getTransparency`.

The current transparency determines which constants get unfolded during
normalisation, e.g. by `reduce`. (To unfold a constant means to replace it with
its definition.) The four settings unfold progressively more constants:

- `reducible`: unfold only constants tagged with the `@[reducible]` attribute.
  Note that `abbrev` is a shorthand for `@[reducible] def`.
- `instances`: unfold reducible constants and constants tagged with the
  `@[instance]` attribute. Again, the `instance` command is a shorthand for
  `@[instance] def`.
- `default`: unfold all constants except those tagged as `@[irreducible]`.
- `all`: unfold all constants, even those tagged as `@[irreducible]`.

The ambient transparency is usually `default`. To execute an operation with a
specific transparency, use `Lean.Meta.withTransparency`. There are also
shorthands for specific transparencies, e.g. `Lean.Meta.withReducible`.

Putting everything together for an example (where we use `Lean.Meta.ppExpr` to
pretty-print an expression): -/

def traceConstWithTransparency (md : TransparencyMode) (c : Name) :
    MetaM Format := do
  ppExpr (← withTransparency md $ reduce (.const c []))

@[irreducible] def irreducibleDef : Nat      := 1
def                defaultDef     : Nat      := irreducibleDef + 1
abbrev             reducibleDef   : Nat      := defaultDef + 1

/-!
We start with `reducible` transparency, which only unfolds `reducibleDef`:
-/

#eval traceConstWithTransparency .reducible ``reducibleDef
-- defaultDef + 1

/-!
If we repeat the above command but let Lean print implicit arguments as well,
we can see that the `+` notation amounts to an application of the `hAdd`
function, which is a member of the `HAdd` typeclass:
-/

set_option pp.explicit true
#eval traceConstWithTransparency .reducible ``reducibleDef
-- @HAdd.hAdd Nat Nat Nat (@instHAdd Nat instAddNat) defaultDef 1

/-!
When we reduce with `instances` transparency, this applications is unfolded and
replaced by `Nat.add`:
-/

#eval traceConstWithTransparency .instances ``reducibleDef
-- Nat.add defaultDef 1

/-!
With `default` transparency, `Nat.add` is unfolded as well:
-/

#eval traceConstWithTransparency .default ``reducibleDef
-- Nat.succ (Nat.succ irreducibleDef)

/-!
And with `TransparencyMode.all`, we're finally able to unfold `irreducibleDef`:
-/

#eval traceConstWithTransparency .all ``reducibleDef
-- 3

/-!
The `#eval` commands illustrate that the same term, `reducibleDef`, can have a
different normal form for each transparency.

Why all this ceremony? Essentially for performance: if we allowed normalisation
to always unfold every constant, operations such as type class search would
become prohibitively expensive. The tradeoff is that we must choose the
appropriate transparency for each operation that involves normalisation.

### Weak Head Normalisation

Transparency addresses some of the performance issues with normalisation. But
even more important is to recognise that for many purposes, we don't need to
fully normalise terms at all. Suppose we are building a tactic that
automatically splits hypotheses of the type `P ∧ Q`. We might want this tactic
to recognise a hypothesis `h : X` if `X` reduces to `P ∧ Q`. But if `P`
additionally reduces to `Y ∨ Z`, the specific `Y` and `Z` do not concern us.
Reducing `P` would be unnecessary work.

This situation is so common that the fully normalising `reduce` is in fact
rarely used. Instead, the normalisation workhorse of Lean is `whnf`, which
reduces an expression to *weak head normal form* (WHNF).

Roughly speaking, an expression `e` is in weak-head normal form when it has the
form

```text
e = f x₁ ... xₙ   (n ≥ 0)
```

and `f` cannot be reduced (at the current transparency). To conveniently check
the WHNF of an expression, we define a function `whnf'`, using some functions
that will be discussed in the Elaboration chapter.
-/

open Lean.Elab.Term in
def whnf' (e : TermElabM Syntax) : TermElabM Format := do
  let e ← elabTermAndSynthesize (← e) none
  ppExpr (← whnf e)

/-!
Now, here are some examples of expressions in WHNF.

Constructor applications are in WHNF (with some exceptions for numeric types):
-/

#eval whnf' `(List.cons 1 [])
-- [1]

/-!
The *arguments* of an application in WHNF may or may not be in WHNF themselves:
-/

#eval whnf' `(List.cons (1 + 1) [])
-- [1 + 1]

/-!
Applications of constants are in WHNF if the current transparency does not
allow us to unfold the constants:
-/

#eval withTransparency .reducible $ whnf' `(List.append [1] [2])
-- List.append [1] [2]

/-!
Lambdas are in WHNF:
-/

#eval whnf' `(λ x : Nat => x)
-- fun x => x

/-!
Foralls are in WHNF:
-/

#eval whnf' `(∀ x, x > 0)
-- ∀ (x : Nat), x > 0

/-!
Sorts are in WHNF:
-/

#eval whnf' `(Type 3)
-- Type 3

/-!
Literals are in WHNF:
-/

#eval whnf' `((15 : Nat))
-- 15

/-!
Here are some more expressions in WHNF which are a bit tricky to test:

```lean
?x 0 1  -- Assuming the metavariable `?x` is unassigned, it is in WHNF.
h 0 1   -- Assuming `h` is a local hypothesis, it is in WHNF.
```

On the flipside, here are some expressions that are not in WHNF.

Applications of constants are not in WHNF if the current transparency allows us
to unfold the constants:
-/

#eval whnf' `(List.append [1])
-- fun x => 1 :: List.append [] x

/-!
Applications of lambdas are not in WHNF:
-/

#eval whnf' `((λ x y : Nat => x + y) 1)
-- `fun y => 1 + y`

/-!
`let` bindings are not in WHNF:
-/

#eval whnf' `(let x : Nat := 1; x)
-- 1

/-!
And again some tricky examples:

```lean
?x 0 1 -- Assuming `?x` is assigned (e.g. to `Nat.add`), its application is not
          in WHNF.
h 0 1  -- Assuming `h` is a local definition (e.g. with value `Nat.add`), its
          application is not in WHNF.
```

Returning to the tactic that motivated this section, let us write a function
that matches a type of the form `P ∧ Q`, avoiding extra computation. WHNF
makes it easy:
-/

def matchAndReducing (e : Expr) : MetaM (Option (Expr × Expr)) := do
  match ← whnf e with
  | (.app (.app (.const ``And _) P) Q) => return some (P, Q)
  | _ => return none

/-
By using `whnf`, we ensure that if `e` evaluates to something of the form `P
∧ Q`, we'll notice. But at the same time, we don't perform any unnecessary
computation in `P` or `Q`.

However, our 'no unnecessary computation' mantra also means that if we want to
perform deeper matching on an expression, we need to use `whnf` multiple times.
Suppose we want to match a type of the form `P ∧ Q ∧ R`. The correct way to do
this uses `whnf` twice:
-/

def matchAndReducing₂ (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
  match ← whnf e with
  | (.app (.app (.const ``And _) P) e') =>
    match ← whnf e' with
    | (.app (.app (.const ``And _) Q) R) => return some (P, Q, R)
    | _ => return none
  | _ => return none

/-!
This sort of deep matching up to computation could be automated. But until
someone builds this automation, we have to figure out the necessary `whnf`s
ourselves.

### Definitional Equality

As mentioned, definitional equality is equality up to computation. Two
expressions `t` and `s` are definitionally equal or *defeq* (at the current
transparency) if their normal forms (at the current transparency) are equal.

To check whether two expressions are defeq, use `Lean.Meta.isDefEq` with type
signature

```lean
isDefEq : Expr → Expr → MetaM Bool
```

Even though definitional equality is defined in terms of normal forms, `isDefEq`
does not actually compute the normal forms of its arguments, which would be very
expensive. Instead, it tries to "match up" `t` and `s` using as few reductions
as possible. This is a necessarily heuristic endeavour and when the heuristics
misfire, `isDefEq` can become very expensive. In the worst case, it may have to
reduce `s` and `t` so often that they end up in normal form anyway. But usually
the heuristics are good and `isDefEq` is reasonably fast.

If expressions `t` and `u` contain assignable metavariables, `isDefEq` may
assign these metavariables to make `t` defeq to `u`. We also say that `isDefEq`
*unifies* `t` and `u`; such unification queries are sometimes written `t =?= u`.
For instance, the unification `List ?m =?= List Nat` succeeds and assigns `?m :=
Nat`. The unification `Nat.succ ?m =?= n + 1` succeeds and assigns `?m := n`.
The unification `?m₁ + ?m₂ + ?m₃ =?= m + n - k` fails and no metavariables are
assigned (even though there is a 'partial match' between the expressions).

Whether `isDefEq` considers a metavariable assignable is determined by two
factors:

1. The metavariable's depth must be equal to the current `MetavarContext` depth.
   See the [Metavariable Depth section](#metavariable-depth).
2. Each metavariable has a *kind* (a value of type `MetavarKind`) whose sole
   purpose is to modify the behaviour of `isDefEq`. Possible kinds are:
   - Natural: `isDefEq` may freely assign the metavariable. This is the default.
   - Synthetic: `isDefEq` may assign the metavariable, but avoids doing so if
     possible. For example, suppose `?n` is a natural metavariable and `?s` is a
     synthetic metavariable. When faced with the unification problem
     `?s =?= ?n`, `isDefEq` assigns `?n` rather than `?s`.
   - Synthetic opaque: `isDefEq` never assigns the metavariable.

## Constructing Expressions

In the previous chapter, we saw some primitive functions for building
expressions: `Expr.app`, `Expr.const`, `mkAppN` and so on. There is nothing
wrong with these functions, but the additional facilities of `MetaM` often
provide more convenient ways.

### Applications

When we write regular Lean code, Lean helpfully infers many implicit arguments
and universe levels. If it did not, our code would look rather ugly: -/

def appendAppend (xs ys : List α) := (xs.append ys).append xs

set_option pp.all true in
set_option pp.explicit true in
#print appendAppend
-- def appendAppend.{u_1} : {α : Type u_1} → List.{u_1} α → List.{u_1} α → List.{u_1} α :=
-- fun {α : Type u_1} (xs ys : List.{u_1} α) => @List.append.{u_1} α (@List.append.{u_1} α xs ys) xs

/-!
The `.{u_1}` suffixes are universe levels, which must be given for every
polymorphic constant. And of course the type `α` is passed around everywhere.

Exactly the same problem occurs during metaprogramming when we construct
expressions. A hand-made expression representing the right-hand side of the
above definition looks like this:
-/

def appendAppendRHSExpr₁ (u : Level) (α xs ys : Expr) : Expr :=
  mkAppN (.const ``List.append [u])
    #[α, mkAppN (.const ``List.append [u]) #[α, xs, ys], xs]

/-!
Having to specify the implicit arguments and universe levels is annoying and
error-prone. So `MetaM` provides a helper function which allows us to omit
implicit information: `Lean.Meta.mkAppM` of type

```lean
mkAppM : Name → Array Expr → MetaM Expr
```

Like `mkAppN`, `mkAppM` constructs an application. But while `mkAppN` requires
us to give all universe levels and implicit arguments ourselves, `mkAppM` infers
them. This means we only need to provide the explicit arguments, which makes for
a much shorter example:
-/

def appendAppendRHSExpr₂ (xs ys : Expr) : MetaM Expr := do
  mkAppM ``List.append #[← mkAppM ``List.append #[xs, ys], xs]

/-!
Note the absence of any `α`s and `u`s. There is also a variant of `mkAppM`,
`mkAppM'`, which takes an `Expr` instead of a `Name` as the first argument,
allowing us to construct applications of expressions which are not constants.

However, `mkAppM` is not magic: if you write `mkAppM ``List.append #[]`, you
will get an error at runtime. This is because `mkAppM` tries to determine what
the type `α` is, but with no arguments given to `append`, `α` could be anything,
so `mkAppM` fails.

Another occasionally useful variant of `mkAppM` is `Lean.Meta.mkAppOptM` of type

```lean
mkAppOptM : Name → Array (Option Expr) → MetaM Expr
```

Whereas `mkAppM` always infers implicit and instance arguments and always
requires us to give explicit arguments, `mkAppOptM` lets us choose freely which
arguments to provide and which to infer. With this, we can, for example, give
instances explicitly, which we use in the following example to give a
non-standard `Ord` instance.
-/

def revOrd : Ord Nat where
  compare x y := compare y x

def ordExpr : MetaM Expr := do
  mkAppOptM ``compare #[none, Expr.const ``revOrd [], mkNatLit 0, mkNatLit 1]

#eval format <$> ordExpr
-- Ord.compare.{0} Nat revOrd
--   (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))
--   (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))

/-!
Like `mkAppM`, `mkAppOptM` has a primed variant `Lean.Meta.mkAppOptM'` which
takes an `Expr` instead of a `Name` as the first argument. The file which
contains `mkAppM` also contains various other helper functions, e.g. for making
list literals or `sorry`s.

### Lambdas and Foralls

Another common task is to construct expressions involving `λ` or `∀` binders.
Suppose we want to create the expression `λ (x : Nat), Nat.add x x`. One way is
to write out the lambda directly:
-/

def doubleExpr₁ : Expr :=
  .lam `x (.const ``Nat []) (mkAppN (.const ``Nat.add []) #[.bvar 0, .bvar 0])
    BinderInfo.default

#eval ppExpr doubleExpr₁
-- fun x => Nat.add x x

/-!
This works, but the use of `bvar` is highly unidiomatic. Lean uses a so-called
*locally closed* variable representation. This means that all but the
lowest-level functions in the Lean API expect expressions not to contain 'loose
`bvar`s', where a `bvar` is loose if it is not bound by a binder in the same
expression. (Outsied of Lean, such variables are usually called 'free'. The name
`bvar` -- 'bound variable' -- already indicates that `bvar`s are never supposed
to be free.)

As a result, if in the above example we replace `mkAppN` with the slightly
higher-level `mkAppM`, we get a runtime error. Adhering to the locally closed
convention, `mkAppM` expects any expressions given to it to have no loose bound
variables, and `.bvar 0` is precisely that.

So instead of using `bvar`s directly, the Lean way is to construct expressions
with bound variables in two steps:

1. Construct the body of the expression (in our example: the body of the
   lambda), using temporary local hypotheses (`fvar`s) to stand in for the bound
   variables.
2. Replace these `fvar`s with `bvar`s and, at the same time, add the
   corresponding lambda binders.

This process ensures that we do not need to handle expressions with loose
`bvar`s at any point (except during step 2, which is performed 'atomically' by a
bespoke function). Applying the process to our example:

-/

def doubleExpr₂ : MetaM Expr :=
  withLocalDecl `x BinderInfo.default (.const ``Nat []) λ x => do
    let body ← mkAppM ``Nat.add #[x, x]
    mkLambdaFVars #[x] body

#eval show MetaM _ from do
  ppExpr (← doubleExpr₂)
-- fun x => Nat.add x x

/-!
There are two new functions. First, `Lean.Meta.withLocalDecl` has type

```lean
withLocalDecl (name : Name) (bi : BinderInfo) (type : Expr) (k : Expr → MetaM α) : MetaM α
```

Given a variable name, binder info and type, `withLocalDecl` constructs a new
`fvar` and passes it to the computation `k`. The `fvar` is avaible in the local
context during the execution of `k` but is deleted again afterwards.

The second new function is `Lean.Meta.mkLambdaFVars` with type (ignoring some
optional arguments)

```
mkLambdaFVars : Array Expr → Expr → MetaM Expr
```

This function takes an array of `fvar`s and an expression `e`. It then adds one
lambda binder for each `fvar` `x` and replaces every occurence of `x` in `e`
with a bound variable corresponding to the new lambda binder. The returned
expression does not contain the `fvar`s any more, which is good since they
disappear after we leave the `withLocalDecl` context. (Instead of `fvar`s, we
can also give `mvar`s to `mkLambdaFVars`, despite its name.)

Some variants of the above functions may be useful:

- `withLocalDecls` declares multiple temporary `fvar`s.
- `mkForallFVars` creates `∀` binders instead of `λ` binders. `mkLetFVars`
  creates `let` binders.
- `mkArrow` is the non-dependent version of `mkForallFVars` which construcs
  a function type `X → Y`. Since the type is non-dependent, there is no need
  for temporary `fvar`s.

Using all these functions, we can construct larger expressions such as this one:

```lean
λ (f : Nat → Nat), ∀ (n : Nat), f n = f (n + 1)
```
-/

def somePropExpr : MetaM Expr := do
  let funcType ← mkArrow (.const ``Nat []) (.const ``Nat [])
  withLocalDecl `f BinderInfo.default funcType fun f => do
    let feqn ← withLocalDecl `n BinderInfo.default (.const ``Nat []) fun n => do
      let lhs := .app f n
      let rhs := .app f (← mkAppM ``Nat.succ #[n])
      let eqn ← mkEq lhs rhs
      mkForallFVars #[n] eqn
    mkLambdaFVars #[f] feqn

/-!
The next line registers `someProp` as a name for the expression we've just
constructed, allowing us to play with it more easily. The mechanisms behind this
are discussed in the Elaboration chapter.
-/

elab "someProp" : term => somePropExpr

#check someProp
-- fun f => ∀ (n : Nat), f n = f (Nat.succ n) : (Nat → Nat) → Prop
#reduce someProp Nat.succ
-- ∀ (n : Nat), Nat.succ n = Nat.succ (Nat.succ n)

/-!
### Deconstructing Expressions

Just like we can construct expressions more easily in `MetaM`, we can also
deconstruct them more easily. Particularly useful is a family of functions for
deconstructing expressions which start with `λ` and `∀` binders.

When we are given a type of the form `∀ (x₁ : T₁) ... (xₙ : Tₙ), U`, we are
often interested in doing something with the conclusion `U`. For instance, the
`apply` tactic, when given an expression `e : ∀ ..., U`, compares `U` with the
current target to determine whether `e` can be applied.

To do this, we could repeatedly match on the type expression, removing `∀`
binders until we get to `U`. But this would leave us with an `U` containing
unbound `bvar`s, which, as we saw, is bad. Instead, we use
`Lean.Meta.forallTelescope` of type

```
forallTelescope (type : Expr) (k : Array Expr → Expr → MetaM α) : MetaM α
```

Given `type = ∀ (x₁ : T₁) ... (xₙ : Tₙ), U x₁ ... xₙ`, this function creates one
fvar `fᵢ` for each `∀`-bound variable `xᵢ` and replaces each `xᵢ` with `fᵢ` in
the conclusion `U`. It then calls the computation `k`, passing it the `fᵢ` and
the conclusion `U f₁ ... fₙ`. Within this computation, the `fᵢ` are registered
in the local context; afterwards, they are deleted again (similar to
`withLocalDecl`).

There are many useful variants of `forallTelescope`:

- `forallTelescopeReducing`: like `forallTelescope` but matching is performed up
  to computation. This means that if you have an expression `X` which is
  different from but defeq to `∀ x, P x`, `forallTelescopeReducing X` will
  deconstruct `X` into `x` and `P x`. The non-reducing `forallTelescope` would
  not recognise `X` as a quantified expression. The matching is performed by
  essentially calling `whnf` repeatedly, using the ambient transparency.
- `forallBoundedTelescope`: like `forallTelescopeReducing` (even though there is
  no "reducing" in the name) but stops after a specified number of `∀` binders.
- `forallMetaTelescope`, `forallMetaTelescopeReducing`,
  `forallMetaBoundedTelescope`: like the corresponding non-`meta` functions, but
  the bound variables are replaced by new `mvar`s instead of `fvar`s. Unlike the
  non-`meta` functions, the `meta` functions do not delete the new metavariables
  after performing some computation, so the metavariables remain in the
  environment indefinitely.
- `lambdaTelescope`, `lambdaTelescopeReducing`, `lambdaBoundedTelescope`,
  `lambdaMetaTelescope`: like the corresponding `forall` functions, but for
  `λ` binders instead of `∀`.

Using one of the telescope functions, we can implement our own `apply` tactic:
-/

def myApply (goal : MVarId) (e : Expr) : MetaM (List MVarId) := do
  -- Check that the goal is not yet assigned.
  goal.checkNotAssigned `myApply
  -- Operate in the local context of the goal.
  goal.withContext do
    -- Get the goal's target type.
    let target ← goal.getType
    -- Get the type of the given expression.
    let type ← inferType e
    -- If `type` has the form `∀ (x₁ : T₁) ... (xₙ : Tₙ), U`, introduce new
    -- metavariables for the `xᵢ` and obtain the conclusion `U`. (If `type` does
    -- not have this form, `args` is empty and `conclusion = type`.)
    let (args, _, conclusion) ← forallMetaTelescopeReducing type
    -- If the conclusion unifies with the target:
    if ← isDefEq target conclusion then
      -- Assign the goal to `e x₁ ... xₙ`, where the `xᵢ` are the fresh
      -- metavariables in `args`.
      goal.assign (mkAppN e args)
      -- `isDefEq` may have assigned some of the `args`. Report the rest as new
      -- goals.
      let newGoals ← args.filterMapM λ mvar => do
        let mvarId := mvar.mvarId!
        if ! (← mvarId.isAssigned) && ! (← mvarId.isDelayedAssigned) then
          return some mvarId
        else
          return none
      return newGoals.toList
    -- If the conclusion does not unify with the target, throw an error.
    else
      throwTacticEx `myApply goal m!"{e} is not applicable to goal with target {target}"

/-!
The real `apply` does some additional pre- and postprocessing, but the core
logic is what we show here. To test our tactic, we need an elaboration
incantation, more about which in the Elaboration chapter.
-/

elab "myApply" e:term : tactic => do
  let e ← Elab.Term.elabTerm e none
  Elab.Tactic.liftMetaTactic (myApply · e)

example (h : α → β) (a : α) : β := by
  myApply h
  myApply a

/-!
## Backtracking

Many tactics naturally require backtracking: the ability to go back to a
previous state, as if the tactic had never been executed. A few examples:

- `first | t | u` first executes `t`. If `t` fails, it backtracks and executes
  `u`.
- `try t` executes `t`. If `t` fails, it backtracks to the initial state,
  erasing any changes made by `t`.
- `trivial` attempts to solve the goal using a number of simple tactics
  (e.g. `rfl` or `contradiction`). After each unsuccessful application of such a
  tactic, `trivial` backtracks.

Good thing, then, that Lean's core data structures are designed to enable easy
and efficient backtracking. The corresponding API is provided by the
`Lean.MonadBacktrack` class. `MetaM`, `TermElabM` and `TacticM` are all
instances of this class. (`CoreM` is not but could be.)

`MonadBacktrack` provides two fundamental operations:

- `Lean.saveState : m s` returns a representation of the current state, where
  `m` is the monad we are in and `s` is the state type. E.g. for `MetaM`,
  `saveState` returns a `Lean.Meta.SavedState` containing the current
  environment, the current `MetavarContext` and various other pieces of
  information.
- `Lean.restoreState : s → m Unit` takes a previously saved state and restores
  it. This effectively resets the compiler state to the previous point.

With this, we can roll our own `MetaM` version of the `try` tactic:
-/

def tryM (x : MetaM Unit) : MetaM Unit := do
  let s ← saveState
  try
    x
  catch _ =>
    restoreState s

/-!
We first save the state, then execute `x`. If `x` fails, we backtrack the state.

The standard library defines many combinators like `tryM`. Here are the most
useful ones:

- `Lean.withoutModifyingState (x : m α) : m α` executes the action `x`, then
  resets the state and returns `x`'s result. You can use this, for example, to
  check for definitional equality without assigning metavariables:
  ```lean
  withoutModifyingState $ isDefEq x y
  ```
  If `isDefEq` succeeds, it may assign metavariables in `x` and `y`. Using
  `withoutModifyingState`, we can make sure this does not happen.
- `Lean.observing? (x : m α) : m (Option α)` executes the action `x`. If `x`
  succeeds, `observing?` returns its result. If `x` fails (throws an exception),
  `observing?` backtracks the state and returns `none`. This is a more
  informative version of our `tryM` combinator.
- `Lean.commitIfNoEx (x : α) : m α` executes `x`. If `x` succeeds,
  `commitIfNoEx` returns its result. If `x` throws an exception, `commitIfNoEx`
  backtracks the state and rethrows the exception.

Note that the builtin `try ... catch ... finally` does not perform any
backtracking. So code which looks like this is probably wrong:

```lean
try
  doSomething
catch e =>
  doSomethingElse
```

The `catch` branch, `doSomethingElse`, is executed in a state containing
whatever modifications `doSomething` made before it failed. Since we probably
want to erase these modifications, we should write instead:

```lean
try
  commitIfNoEx doSomething
catch e =>
  doSomethingElse
```

Another `MonadBacktrack` gotcha is that `restoreState` does not backtrack the
*entire* state. Caches, trace messages and the global name generator, among
other things, are not backtracked, so changes made to these parts of the state
are not reset by `restoreState`. This is usually what we want: if a tactic
executed by `observing?` produces some trace messages, we want to see them even
if the tactic fails. See `Lean.Meta.SavedState.restore` and `Lean.Core.restore`
for details on what is and is not backtracked.

In the next chapter, we move towards the topic of elaboration, of which
you've already seen several glimpses in this chapter. We start by discussing
Lean's syntax system, which allows you to add custom syntactic constructs to the
Lean parser.

## Exercises

1. [**Metavariables**] Create a metavariable with type `Nat`, and assign to it value `3`.
Notice that changing the type of the metavarible from `Nat` to, for example, `String`, doesn't raise any errors - that's why, as was mentioned, we must make sure *"(a) that `val` must have the target type of `mvarId` and (b) that `val` must only contain `fvars` from the local context of `mvarId`"*.
2. [**Metavariables**] What would `instantiateMVars (Lean.mkAppN (Expr.const 'Nat.add []) #[mkNatLit 1, mkNatLit 2])` output?
3. [**Metavariables**] Fill in the missing lines in the following code.

  ```
  #eval show MetaM Unit from do
    let oneExpr := Expr.app (Expr.const `Nat.succ []) (Expr.const ``Nat.zero [])
    let twoExpr := Expr.app (Expr.const `Nat.succ []) oneExpr

    -- Create `mvar1` with type `Nat`
    -- let mvar1 ← ...
    -- Create `mvar2` with type `Nat`
    -- let mvar2 ← ...
    -- Create `mvar3` with type `Nat`
    -- let mvar3 ← ...

    -- Assign `mvar1` to `2 + ?mvar2 + ?mvar3`
    -- ...

    -- Assign `mvar3` to `1`
    -- ...

    -- Instantiate `mvar1`, which should result in expression `2 + ?mvar2 + 1`
    ...
  ```
4. [**Metavariables**] Consider the theorem `red`, and tactic `explore` below.
  a) What would be the `type` and `userName` of metavariable `mvarId`?
  b) What would be the `type`s and `userName`s of all local declarations in this metavariable's local context?
  Print them all out.

  ```
  elab "explore" : tactic => do
    let mvarId : MVarId ← Lean.Elab.Tactic.getMainGoal
    let metavarDecl : MetavarDecl ← mvarId.getDecl

    IO.println "Our metavariable"
    -- ...

    IO.println "All of its local declarations"
    -- ...

  theorem red (hA : 1 = 1) (hB : 2 = 2) : 2 = 2 := by
    explore
    sorry
  ```
5. [**Metavariables**] Write a tactic `solve` that proves the theorem `red`.
6. [**Computation**] What is the normal form of the following expressions:
  **a)** `fun x => x` of type `Bool → Bool`
  **b)** `(fun x => x) ((true && false) || true)` of type `Bool`
  **c)** `800 + 2` of type `Nat`
7. [**Computation**] Show that `1` created with `Expr.lit (Lean.Literal.natVal 1)` is definitionally equal to an expression created with `Expr.app (Expr.const ``Nat.succ []) (Expr.const ``Nat.zero [])`.
8. [**Computation**] Determine whether the following expressions are definitionally equal. If `Lean.Meta.isDefEq` succeeds, and it leads to metavariable assignment, write down the assignments.
  **a)** `5 =?= (fun x => 5) ((fun y : Nat → Nat => y) (fun z : Nat => z))`
  **b)** `2 + 1 =?= 1 + 2`
  **c)** `?a =?= 2`, where `?a` has a type `String`
  **d)** `?a + Int =?= "hi" + ?b`, where `?a` and `?b` don't have a type
  **e)** `2 + ?a =?= 3`
  **f)** `2 + ?a =?= 2 + 1`
9. [**Computation**] Write down what you expect the following code to output.

```
@[reducible] def reducibleDef     : Nat := 1 -- same as `abbrev`
@[instance] def instanceDef       : Nat := 2 -- same as `instance`
def defaultDef                    : Nat := 3
@[irreducible] def irreducibleDef : Nat := 4

@[reducible] def sum := [reducibleDef, instanceDef, defaultDef, irreducibleDef]

#eval show MetaM Unit from do
  let constantExpr := Expr.const `sum []

  Meta.withTransparency Meta.TransparencyMode.reducible do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- ...

  Meta.withTransparency Meta.TransparencyMode.instances do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- ...

  Meta.withTransparency Meta.TransparencyMode.default do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- ...

  Meta.withTransparency Meta.TransparencyMode.all do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- ...

  let reducedExpr ← Meta.reduce constantExpr
  dbg_trace (← ppExpr reducedExpr) -- ...
```
10. [**Constructing Expressions**] Create expression `fun x, 1 + x` in two ways:
  **a)** not idiomatically, with loose bound variables
  **b)** idiomatically.
  In what version can you use `Lean.mkAppN`? In what version can you use `Lean.Meta.mkAppM`?
11. [**Constructing Expressions**] Create expression `∀ (yellow: Nat), yellow`.
12. [**Constructing Expressions**] Create expression `∀ (n : Nat), n = n + 1` in two ways:
  **a)** not idiomatically, with loose bound variables
  **b)** idiomatically.
  In what version can you use `Lean.mkApp3`? In what version can you use `Lean.Meta.mkEq`?
13. [**Constructing Expressions**] Create expression `fun (f : Nat → Nat), ∀ (n : Nat), f n = f (n + 1)` idiomatically.
14. [**Constructing Expressions**] What would you expect the output of the following code to be?

```
#eval show Lean.Elab.Term.TermElabM _ from do
  let stx : Syntax ← `(∀ (a : Prop) (b : Prop), a ∨ b → b → a ∧ a)
  let expr ← Elab.Term.elabTermAndSynthesize stx none

  let (_, _, conclusion) ← forallMetaTelescope expr
  dbg_trace conclusion -- ...

  let (_, _, conclusion) ← forallMetaBoundedTelescope expr 2
  dbg_trace conclusion -- ...

  let (_, _, conclusion) ← lambdaMetaTelescope expr
  dbg_trace conclusion -- ...
```
15. [**Backtracking**] Check that the expressions `?a + Int` and `"hi" + ?b` are definitionally equal with `isDefEq` (make sure to use the proper types or `Option.none` for the types of your metavariables!).
Use `saveState` and `restoreState` to revert metavariable assignments.
-/


import for_mathlib.category_theory.localization.equivalence

noncomputable theory

namespace category_theory

variables {C₁ C₂ C₃ E : Type*} [category C₁] [category C₂] [category C₃]

open localization

namespace morphism_property

@[refl]
lemma subset.refl (W : morphism_property C₁) : W ⊆ W := λ X Y f hf, hf

@[simp]
def map (W : morphism_property C₁) (F : C₁ ⥤ C₂) : morphism_property C₂ :=
λ X₂ Y₂ f₂, ∃ (X₁ Y₁ : C₁) (f₁ : X₁ ⟶ Y₁) (hf₁ : W f₁),
  nonempty (arrow.mk (F.map f₁) ≅ arrow.mk f₂)

lemma map_mem_map (W : morphism_property C₁) (F : C₁ ⥤ C₂) {X₁ Y₁ : C₁} (f₁ : X₁ ⟶ Y₁)
  (hf₁ : W f₁) : W.map F (F.map f₁) :=
⟨_, _, f₁, hf₁, nonempty.intro (iso.refl _)⟩

lemma map_is_inverted_by_iff (W : morphism_property C₁) (F : C₁ ⥤ C₂) (G : C₂ ⥤ C₃) :
  (W.map F).is_inverted_by G ↔ W.is_inverted_by (F ⋙ G) :=
begin
  split,
  { intros h X₁ Y₁ f₁ hf₁,
    exact h _ (W.map_mem_map F f₁ hf₁), },
  { rintros h X₂ Y₂ f₂ ⟨X₁, Y₁, f₁, hf₁, ⟨e⟩⟩,
    exact ((respects_iso.isomorphisms C₃).arrow_mk_iso_iff (G.map_arrow.map_iso e)).1 (h _ hf₁), },
end

end morphism_property

namespace localization

section

lemma strict_universal_property_fixed_target.comp {E : Type*} [category E]
  {L₁ : C₁ ⥤ C₂} {L₂ : C₂ ⥤ C₃} {W₁ : morphism_property C₁} {W₂ : morphism_property C₂}
  (h₁ : strict_universal_property_fixed_target L₁ W₁ E)
  (h₂ : strict_universal_property_fixed_target L₂ W₂ E)
  (W₃ : morphism_property C₁) (hW₃ : W₃.is_inverted_by (L₁ ⋙ L₂))
  (hW₁₃ : W₁ ⊆ W₃) (hW₂₃ : W₂ ⊆ W₃.map L₁) :
  strict_universal_property_fixed_target (L₁ ⋙ L₂) W₃ E :=
{ inverts := hW₃,
  lift := λ F hF, begin
    have h : W₁.is_inverted_by F := λ X₁ Y₁ f₁ hf₁, hF f₁ (hW₁₃ _ hf₁),
    exact h₂.lift (h₁.lift F h) (λ X₂ Y₂ f₂ hf₂, begin
      obtain ⟨X₁, Y₁, f₁, hf₁, ⟨e⟩⟩ := hW₂₃ _ hf₂,
      refine ((morphism_property.respects_iso.isomorphisms E).arrow_mk_iso_iff
        ((h₁.lift F h).map_arrow.map_iso e)).1 _,
      refine ((morphism_property.respects_iso.isomorphisms E).arrow_mk_iso_iff
        (arrow.iso_of_nat_iso (eq_to_iso (h₁.fac F h)) (arrow.mk f₁))).2 (hF _ hf₁),
    end),
  end,
  fac := λ F hF, by rw [functor.assoc, h₂.fac, h₁.fac],
  uniq := λ F₁ F₂ h, begin
    simp only [functor.assoc] at h,
    exact h₂.uniq _ _ (h₁.uniq _ _ h),
  end, }

end

@[protected]
lemma comp (L₁ : C₁ ⥤ C₂) (L₂ : C₂ ⥤ C₃) (W₁ : morphism_property C₁)
  (W₂ : morphism_property C₂) (W₃ : morphism_property C₁)
  [L₁.is_localization W₁] [L₂.is_localization W₂] (hW₃ : W₃.is_inverted_by (L₁ ⋙ L₂))
  (hW₁₃ : W₁ ⊆ W₃) (hW₃' : W₂ ⊆ W₃.map L₁) :
  (L₁ ⋙ L₂).is_localization W₃ :=
begin
  let L₁' := W₁.Q,
  let eq₂ := equivalence_from_model L₁ W₁,
  let W₂' : morphism_property (W₁.localization) := W₂.map eq₂.inverse,
  let L₂' := W₂'.Q,
  have h₂ : W₂'.is_inverted_by (eq₂.functor ⋙ L₂),
  { dsimp only [W₂'],
    rw morphism_property.map_is_inverted_by_iff,
    refine (morphism_property.is_inverted_by.iff_of_iso W₂ _).1 (localization.inverts L₂ W₂),
    exact L₂.left_unitor.symm ≪≫ iso_whisker_right eq₂.counit_iso.symm _ ≪≫ functor.associator _ _ _, },
  let F₃ : W₂'.localization ⥤ C₃ := localization.lift (eq₂.functor ⋙ L₂) h₂ L₂',
  let H : Comm_sq eq₂.functor L₂' L₂ F₃ := ⟨localization.fac _ _ _⟩,
  have h₁' : W₁.is_inverted_by L₁' := localization.inverts _ _,
  have h₁₂' : W₁.is_inverted_by (L₁' ⋙ L₂') :=
    morphism_property.is_inverted_by.of_comp W₁ _ h₁' L₂',
  letI : lifting L₁ W₁ L₁' eq₂.inverse := ⟨comp_equivalence_from_model_inverse_iso _ _⟩,
  let F₁₂' := localization.lift (L₁' ⋙ L₂') h₁₂' L₁,
  let e₁₂ : F₁₂' ≅ eq₂.inverse ⋙ L₂' := lift_nat_iso L₁ W₁ (L₁' ⋙ L₂') (L₁' ⋙ L₂') _ _ (iso.refl _),
  have hF₁₂' : W₂.is_inverted_by F₁₂',
  { have h := localization.inverts W₂'.Q W₂',
    rw morphism_property.map_is_inverted_by_iff at h,
    exact (morphism_property.is_inverted_by.iff_of_iso _ e₁₂.symm).1 h, },
  let G₃ : C₃ ⥤ W₂'.localization := localization.lift F₁₂' hF₁₂' L₂,
  letI : lifting L₂ W₂ (eq₂.inverse ⋙ W₂'.Q) G₃ :=
    ⟨localization.fac F₁₂' hF₁₂' L₂ ≪≫ lift_nat_iso L₁ W₁
      (L₁' ⋙ L₂') (L₁' ⋙ L₂') _ _ (iso.refl _)⟩,
  let e₂ : (eq₂.inverse ⋙ L₂') ⋙ F₃ ≅ L₂ := functor.associator _ _ _ ≪≫
      iso_whisker_left _ (localization.fac (eq₂.functor ⋙ L₂) h₂ L₂') ≪≫
      (functor.associator _ _ _).symm ≪≫ iso_whisker_right eq₂.counit_iso _ ≪≫ L₂.left_unitor,
  let e₃ : eq₂.functor ⋙ eq₂.inverse ⋙ L₂' ≅ L₂' :=
    (functor.associator _ _ _).symm ≪≫ iso_whisker_right eq₂.unit_iso.symm _ ≪≫ L₂'.left_unitor,
  letI := lifting_is_equivalence H W₂' W₂ (eq₂.inverse ⋙ L₂') G₃ e₂ e₃,
  haveI : (L₁' ⋙ L₂').is_localization W₃,
  { have h₁ : W₃.is_inverted_by (W₁.Q ⋙ W₂'.Q),
    { suffices : W₃.is_inverted_by (W₁.Q ⋙ W₂'.Q ⋙ F₃),
      { intros X₁ Y₁ f₁ hf₁,
        haveI : is_iso (F₃.map ((W₁.Q ⋙ W₂'.Q).map f₁)) := this f₁ hf₁,
        exact is_iso_of_reflects_iso _ F₃, },
      refine (morphism_property.is_inverted_by.iff_of_iso W₃ _).1 hW₃,
      exact iso_whisker_right ((Q_comp_equivalence_from_model_functor_iso L₁ W₁).symm) _ ≪≫
         functor.associator _ _ _ ≪≫ iso_whisker_left _ (localization.fac _ _ _).symm, },
    have h₂ : W₂' ⊆ W₃.map W₁.Q,
    { dsimp only [W₂'],
      rintros X Y f ⟨X₂, Y₂, f₂, hf₂, ⟨e₂⟩⟩,
      rcases  hW₃' _ hf₂ with ⟨X₁, Y₁, f₁, hf₁, ⟨e₁⟩⟩,
      refine ⟨X₁, Y₁, f₁, hf₁, ⟨_⟩⟩,
      refine arrow.iso_of_nat_iso (comp_equivalence_from_model_inverse_iso L₁ W₁).symm (arrow.mk f₁)
        ≪≫ eq₂.inverse.map_arrow.map_iso e₁ ≪≫ e₂, },
    refine functor.is_localization.mk' _ _ _ _,
    all_goals { exact (strict_universal_property_fixed_target_Q W₁ _).comp
      (strict_universal_property_fixed_target_Q W₂' _) W₃ h₁ hW₁₃ h₂, }, },
  apply functor.is_localization.of_equivalence (L₁' ⋙ L₂') W₃ (L₁ ⋙ L₂) F₃.as_equivalence,
  exact functor.associator _ _ _ ≪≫ iso_whisker_left _ (localization.fac _ _ _) ≪≫
    (functor.associator _ _ _).symm ≪≫ iso_whisker_right (Q_comp_equivalence_from_model_functor_iso L₁ W₁) _,
end

end localization

end category_theory


import data.serial.string
import tactic.linarith
import category.monad_trans
import data.list.nursery
import system.io

universes u

namespace json

inductive value
| object : unit → list (string × value) → value
| number : ℤ → value
| array : unit → list value → value
| bool : bool → value
| string : string → value
| nil : value
-- with object : Type
-- | fields : list (string × value) → object

open value (hiding object bool string)

@[reducible] def object := list (string × value)

def is_atom : value → bool
| (number n) := tt
| (value.bool b) := tt
| (value.string s) := tt
| value.nil := tt
| _ := ff

def encode_line : value → string
| (number n) := to_string n
| (value.bool n) := to_string n
| (value.string n) := to_string n
| nil := "nil"
| (value.object _ _) := "<object>"
| (value.array _ _) := "<array>"

namespace syntax

@[derive decidable_eq]
inductive token
| open_curly  | close_curly
| open_square | close_square
| colon | comma | nil | bool (b : bool)
| number (n : ℤ) | string (s : string)

abbreviation put_m' := medium.put_m'.{u} token
abbreviation put_m  := medium.put_m'.{u} token punit
abbreviation get_m  := medium.get_m.{u} token
export medium (hiding put_m put_m' get_m)

namespace put_m'
export medium.put_m'
end put_m'

namespace get_m
export medium.get_m
end get_m

export token (hiding number string bool)

mutual def encode_val, encode_obj, encode_array
with encode_val : value → put_m
| (value.string s) := write_word $ token.string s
| (value.number n) := write_word $ token.number n
| (value.bool b) := write_word $ token.bool b
| (value.nil) := write_word $ token.nil
| (value.object _ []) :=
  write_word open_curly >> write_word close_curly
| (value.object _ ((fn,v)::vs)) :=
  do write_word open_curly,
     write_word (token.string fn),
     write_word colon,
     encode_obj v vs,
     write_word close_curly
| (value.array _ obj) :=
  write_word open_square >> encode_array obj >> write_word close_square
with encode_obj : value → list (string × value) → put_m
| v [] := encode_val v
| v ((fn,v') :: vs) :=
do encode_val v,
   write_word comma,
   write_word (token.string fn),
   write_word colon,
   encode_obj v' vs
with encode_array : list value → put_m
| [] := pure ()
| (v :: vs) :=
do encode_val v,
   when (¬ vs = []) $ do
     write_word comma,
     encode_array vs

inductive partial_val
| array (ar : list value)
| object (obj : list (string × value)) (field : string)

def parser_state := list partial_val

open ulift

def push : list partial_val → value → get_m ( value ⊕ parser_state )
| [] v := pure (sum.inl v)
| (partial_val.array ar :: vs) v :=
  do t ← read_word,
     if down t = comma then pure (sum.inr (partial_val.array (v :: ar) :: vs))
     else if down t = close_square then push vs (value.array () (list.reverse $ v :: ar))
     else failure
| (partial_val.object ar fn :: vs) v :=
  do t ← read_word,
     if down t = comma then do
       ⟨token.string fn'⟩ ← read_word | failure,
       ⟨colon⟩ ← read_word | failure,
       pure (sum.inr (partial_val.object ((fn,v) :: ar) fn' :: vs))
     else if down t = close_curly then push vs (value.object () (list.reverse $ (fn,v) :: ar))
     else failure

def parser_step : parser_state → token → get_m ( value ⊕ parser_state )
| vs nil := push vs value.nil
| vs open_curly :=
  do t ← read_word,
     match down t with
     | (token.string fn) :=
       expect_word colon >>
       pure (sum.inr (partial_val.object [] fn :: vs))
     | close_curly := push vs (value.object () [])
     | _ := failure
     end
| vs open_square := pure (sum.inr (partial_val.array [] :: vs))
| vs (token.bool b) := push vs (value.bool b)
| vs (token.number n) := push vs (value.number n)
| vs (token.string str) := push vs (value.string str)
| vs close_square :=
  match vs with
  | (partial_val.array vs' :: vs) := push vs $ value.array () vs'.reverse
  | _ := failure
  end
| _ _ := failure

def decode_val : get_m value :=
get_m.loop parser_step pure []

def encoding_correctness_val (m : ℕ) :=
(∀ (v : value) (vs : list partial_val) (x : punit → put_m), sizeof v ≤ m →
   get_m.loop parser_step pure vs -<< (encode_val v >>= x) =
   (push vs v >>= get_m.loop.rest parser_step pure) -<< x punit.star)

def encoding_correctness_obj (m : ℕ) :=
(∀ (fn : string) (v : value) (obj obj' : object)
   (vs : list partial_val) (x : punit → put_m),
   sizeof obj' ≤ m → sizeof v < m →
get_m.loop parser_step pure (partial_val.object obj fn :: vs) -<<
  (encode_obj v obj' >>= λ _, write_word close_curly >>= x) =
  (push vs (value.object punit.star (obj.reverse ++ (fn,v) :: obj')) >>= get_m.loop.rest parser_step pure) -<< x punit.star)

def encoding_correctness_array (m : ℕ) :=
(∀ (v v' : list value)
   (vs : list partial_val) (x : punit → put_m), sizeof v' ≤ m →
get_m.loop parser_step pure (partial_val.array v :: vs) -<<
      (encode_array v' >>= λ (x_1 : punit), write_word close_square >>= x) =
    (push vs (value.array punit.star (v.reverse ++ v')) >>= get_m.loop.rest parser_step pure) -<< x punit.star)

section correctness

variables n : ℕ
variables ih_val : ∀ (x : ℕ), x < n → encoding_correctness_val x
variables ih_obj : ∀ (x : ℕ), x < n → encoding_correctness_obj x
variables ih_ar : ∀ (x : ℕ), x < n → encoding_correctness_array x

include ih_val ih_obj ih_ar

lemma encode_val_ind_step : encoding_correctness_val n :=
begin
  dsimp [encoding_correctness_val], introv h,
  { cases v with v fs _ v fs; casesm* unit;
          try { simp [encode_val,parser_step] },
    { rcases fs with _ | ⟨ ⟨ fn,v ⟩, vs ⟩,
      { simp [encode_val,parser_step] with functor_norm },
      { simp [encode_val,parser_step,expect_word] with functor_norm,
        apply ih_obj (1 + sizeof v + sizeof vs),
        apply lt_of_lt_of_le _ h,
        well_founded_tactics.default_dec_tac,
        apply le_of_lt, well_founded_tactics.default_dec_tac,
        well_founded_tactics.default_dec_tac }, },
    { simp [encode_val,parser_step] with functor_norm,
      rw ih_ar; try { refl },
      apply lt_of_lt_of_le _ h,
      simp [sizeof,has_sizeof.sizeof,value.sizeof,punit.sizeof,list.sizeof] } },
end

lemma encode_obj_ind_step : encoding_correctness_obj n :=
begin
  dsimp [encoding_correctness_obj], introv h h',
  { rcases obj' with _ | ⟨ ⟨ fn', v' ⟩, obj' ⟩,
    { simp [encode_obj], rw ih_val; try { assumption <|> refl },
      simp [push] with functor_norm, },
    { simp [encode_obj] with functor_norm, rw ih_val (sizeof v),
      simp [push] with functor_norm, rw ih_obj (1 + sizeof v' + sizeof obj'),
      congr' 4, simp,
      apply lt_of_lt_of_le _ h,
      all_goals { try { well_founded_tactics.default_dec_tac } },
      apply le_of_lt, well_founded_tactics.default_dec_tac,
      refl } },
end

lemma encode_array_ind_step : encoding_correctness_array n :=
begin
  dsimp [encoding_correctness_array], introv h,
  { cases v' with v' vs'; simp [encode_array,parser_step] with functor_norm,
    rw ih_val (sizeof v' ),
    by_cases h' : (vs' = []),
    { subst vs', simp [when,list.empty,push] with functor_norm },
    { simp [when,*,push] with functor_norm,
      rw ih_ar (sizeof vs'), simp, apply lt_of_lt_of_le _ h,
      well_founded_tactics.default_dec_tac, refl },
    apply lt_of_lt_of_le _ h,
    well_founded_tactics.default_dec_tac,
    refl },
end

end correctness

lemma encoding_correctness' (m : ℕ) :
    encoding_correctness_val m ∧
    encoding_correctness_obj m ∧
    encoding_correctness_array m :=
begin
  induction m using nat.strong_induction_on with n ih,
  simp [imp_and_distrib,forall_and_distrib,push] at ih,
  rcases ih with ⟨ ih_val, ih_obj, ih_ar ⟩,
  repeat { split },
  apply encode_val_ind_step; assumption,
  apply encode_obj_ind_step; assumption,
  apply encode_array_ind_step; assumption,
end

lemma encoding_correctness (v : value) :
  decode_val -<< encode_val v = some v :=
begin
  have := (encoding_correctness' (sizeof v)).1 v [] pure _,
  simp with functor_norm at this,
  simp [decode_val,this,push], refl, refl
end

def value.repr : token → string
| (token.number n) := to_string n
| (token.string s) := "\"" ++ s ++ "\""
| (token.bool b) := to_string b
| nil := "nil"
| open_curly := "'{'"
| close_curly := "'}'"
| open_square := "'['"
| close_square := "']'"
| colon := "':'"
| comma := "','"

instance : has_repr token := ⟨ value.repr ⟩

#eval (encode_val (value.object ()
           [ ("a",value.number 3),
             ("boo",value.array () [ value.number 3,
                                     value.array () [ value.number 3, value.number 7, value.string "ho" ] ,
                                     value.string "abc" ]) ])).eval

end syntax
end json

-- namespace yaml

-- open string.medium json

-- @[reducible] def writer := reader_t ℕ put_m'

-- def newline : writer unit :=
-- ⟨ λ n, emit $ "\n" ++ (list.repeat ' ' n).as_string ⟩

-- def bump {α} (tac : writer α) : writer α :=
-- ⟨ λ n, tac.run (n+2) ⟩

-- mutual def encode_aux, encode_obj, encode_array
-- with encode_aux : value → writer unit
-- | (value.string v) := monad_lift $ emit $ "\"" ++ v ++ "\""
-- | (value.bool v) := monad_lift $ emit $ to_string v
-- | (value.number v) := monad_lift $ emit $ to_string v
-- | value.nil := monad_lift $ emit "nil"
-- | (value.object _ o) := encode_obj o
-- | (value.array _ ar) := encode_array ar
-- with encode_obj : list (string × value) → writer unit
-- | [] := monad_lift $ emit "[]"
-- | ((f,v) :: vs) :=
--   do monad_lift $ emit (f ++ ": "),
--      bump $ do {
--        when (¬ is_atom v) newline,
--        encode_aux v },
--      when (¬ vs.empty) $ do
--        newline,
--        encode_obj vs
-- with encode_array : list value → writer unit
-- | [] := monad_lift $ emit "[]"
-- | (v :: vs) :=
--   do monad_lift $ emit "- ",
--      bump $ encode_aux v,
--      when (¬ vs.empty) $ do
--        newline,
--        encode_array vs

-- def encode (v : value) : put_m :=
-- (encode_aux v).run 0

-- def select_aux {α} (f : char → list (bool × reader α)) (c : char) : reader α :=
-- (prod.snd <$> list.find (λ x, prod.fst x = tt) (f c)).get_or_else failure

-- def select {α} (f : char → list (bool × reader α)) : reader α :=
-- peek >>= select_aux f

-- def try_char (p : char → Prop) [decidable_pred p] : reader (option char) :=
-- do c ← read_char,
--    if p c then pure c
--           else unread c >> pure none

-- def many_loop (p : char → Prop) [decidable_pred p] : list char → char → get_m ((list char × option char) ⊕ list char)
-- | s c :=
-- if p c then pure (sum.inr $ c :: s)
--        else pure (sum.inl (s.reverse,some c))

-- def many (p : char → Prop) [decidable_pred p] : reader (list char) :=
-- ⟨ λ n, ⟨ λ s : option char,
-- do s' ← match s with
--         | none := pure $ sum.inr []
--         | (some s) := many_loop p [] s
--         end,
--    match s' with
--    | (sum.inl x) := pure x
--    | (sum.inr x) := get_m.loop (many_loop p) pure x
--    end ⟩ ⟩

-- def parse_nat : reader ℕ :=
-- do c ← read_char,
--    guard c.is_digit,
--    cs ← many char.is_digit,
--    pure $ list.foldl (λ x (c : char), 10 * x + c.val - '0'.val) 0 (c :: cs)

-- def parse_int : reader ℤ :=
-- do x ← try_char (= '-'),
--    n ← parse_nat,
--    pure $ if x.is_some then - ↑n
--                        else n

-- def parse_value : reader value :=
-- value.number <$> parse_int <* expect_char '\n'

-- -- def read_write (i n : ℕ) :
-- --   parse_value.run i -<< encode (value.number n) = some (value.number n) :=
-- -- begin
-- --   rw [encode,encode_aux,emit],
-- --   induction n using nat.strong_induction_on,
-- --   simp [to_string,has_to_string.to_string],
-- --   unfold_coes, simp [int.repr],
-- --   -- induction h : (string.to_list (to_string ↑n)) generalizing n;
-- --     -- rw [mmap'],
-- --   -- { admit },
-- --   -- { simp [monad_lift_and_then writer,parse_value,parse_int] with functor_norm, }
-- -- end

-- #eval do io.put_str_ln "",
--          io.put_str_ln $ to_string $ encode (value.object ()
--            [ ("a",value.number 3),
--              ("boo",value.array () [ value.number 3,
--                                      value.array () [ value.number 3, value.number 7, value.string "ho" ] ,
--                                      value.string "abc" ]) ])

-- end yaml


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

/-!
# Documentation commands

We generate html documentation from mathlib. It is convenient to collect lists of tactics, commands,
notes, etc. To facilitate this, we declare these documentation entries in the library
using special commands.

* `library_note` adds a note describing a certain feature or design decision. These can be
  referenced in doc strings with the text `note [name of note]`.
* `add_tactic_doc` adds an entry documenting an interactive tactic, command, hole command, or
  attribute.

Since these commands are used in files imported by `tactic.core`, this file has no imports.

## Implementation details

`library_note note_id note_msg` creates a declaration `` `library_note.i `` for some `i`.
This declaration is a pair of strings `note_id` and `note_msg`, and it gets tagged with the
`library_note` attribute.

Similarly, `add_tactic_doc` creates a declaration `` `tactic_doc.i `` that stores the provided
information.
-/

/-- A rudimentary hash function on strings. -/
def string.hash (s : string) : ℕ :=
s.fold 1 (λ h c, (33*h + c.val) % unsigned_sz)

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

open tactic

/--
`copy_doc_string fr to` copies the docstring from the declaration named `fr`
to each declaration named in the list `to`. -/
meta def tactic.copy_doc_string (fr : name) (to : list name) : tactic unit :=
do fr_ds ← doc_string fr,
   to.mmap' $ λ tgt, add_doc_string tgt fr_ds

open lean lean.parser interactive

/--
`copy_doc_string source → target_1 target_2 ... target_n` copies the doc string of the
declaration named `source` to each of `target_1`, `target_2`, ..., `target_n`.
 -/
@[user_command] meta def copy_doc_string_cmd
  (_ : parse (tk "copy_doc_string")) : parser unit :=
do fr ← parser.ident,
   tk "->",
   to ← parser.many parser.ident,
   expr.const fr _  ← resolve_name fr,
   to ← parser.of_tactic (to.mmap $ λ n, expr.const_name <$> resolve_name n),
   tactic.copy_doc_string fr to

/-! ### The `library_note` command -/

/-- A user attribute `library_note` for tagging decls of type `string × string` for use in note
output. -/
@[user_attribute] meta def library_note_attr : user_attribute :=
{ name := `library_note,
  descr := "Notes about library features to be included in documentation",
  parser := failed }

/--
`mk_reflected_definition name val` constructs a definition declaration by reflection.

Example: ``mk_reflected_definition `foo 17`` constructs the definition
declaration corresponding to `def foo : ℕ := 17`
-/
meta def mk_reflected_definition (decl_name : name) {type} [reflected _ type]
  (body : type) [reflected _ body] : declaration :=
mk_definition decl_name (reflect type).collect_univ_params (reflect type) (reflect body)

/--
If `note_name` and `note` are strings, `add_library_note note_name note` adds a declaration named
`library_note.<note_name>` with `note` as the docstring and tags it with the `library_note`
attribute.
-/
meta def tactic.add_library_note (note_name note : string) : tactic unit :=
do let decl_name := `library_note <.> note_name,
   add_decl $ mk_reflected_definition decl_name (),
   add_doc_string decl_name note,
   library_note_attr.set decl_name () tt none

open tactic

/--
A command to add library notes. Syntax:
```
/--
note message
-/
library_note "note id"
```
-/
@[user_command] meta def library_note (mi : interactive.decl_meta_info)
  (_ : parse (tk "library_note")) : parser unit := do
note_name ← parser.pexpr,
note_name ← eval_pexpr string note_name,
some doc_string ← pure mi.doc_string | fail "library_note requires a doc string",
add_library_note note_name doc_string

/-- Collects all notes in the current environment.
Returns a list of pairs `(note_id, note_content)` -/
meta def tactic.get_library_notes : tactic (list (string × string)) :=
attribute.get_instances `library_note >>=
  list.mmap (λ dcl, prod.mk dcl.last <$> doc_string dcl)

/-! ### The `add_tactic_doc_entry` command -/

/-- The categories of tactic doc entry. -/
@[derive [decidable_eq, has_reflect]]
inductive doc_category
| tactic | cmd | hole_cmd | attr

/-- Format a `doc_category` -/
meta def doc_category.to_string : doc_category → string
| doc_category.tactic := "tactic"
| doc_category.cmd := "command"
| doc_category.hole_cmd := "hole_command"
| doc_category.attr := "attribute"

meta instance : has_to_format doc_category := ⟨↑doc_category.to_string⟩

/-- The information used to generate a tactic doc entry -/
@[derive has_reflect]
structure tactic_doc_entry :=
(name : string)
(category : doc_category)
(decl_names : list _root_.name)
(tags : list string := [])
(inherit_description_from : option _root_.name := none)

/-- Turns a `tactic_doc_entry` into a JSON representation. -/
meta def tactic_doc_entry.to_json (d : tactic_doc_entry) (desc : string) : json :=
json.object [
  ("name", d.name),
  ("category", d.category.to_string),
  ("decl_names", d.decl_names.map (json.of_string ∘ to_string)),
  ("tags", d.tags.map json.of_string),
  ("description", desc)
]

meta instance tactic_doc_entry.has_to_string : has_to_string (tactic_doc_entry × string) :=
⟨λ ⟨doc, desc⟩, json.unparse (doc.to_json desc)⟩

/-- A user attribute `tactic_doc` for tagging decls of type `tactic_doc_entry`
for use in doc output -/
@[user_attribute] meta def tactic_doc_entry_attr : user_attribute :=
{ name := `tactic_doc,
  descr := "Information about a tactic to be included in documentation",
  parser := failed }

/-- Collects everything in the environment tagged with the attribute `tactic_doc`. -/
meta def tactic.get_tactic_doc_entries : tactic (list (tactic_doc_entry × string)) :=
attribute.get_instances `tactic_doc >>=
  list.mmap (λ dcl, prod.mk <$> (mk_const dcl >>= eval_expr tactic_doc_entry) <*> doc_string dcl)

/-- `add_tactic_doc tde` adds a declaration to the environment
with `tde` as its body and tags it with the `tactic_doc`
attribute. If `tde.decl_names` has exactly one entry `` `decl`` and
if `tde.description` is the empty string, `add_tactic_doc` uses the doc
string of `decl` as the description. -/
meta def tactic.add_tactic_doc (tde : tactic_doc_entry) (doc : option string) : tactic unit :=
do desc ← doc <|> (do
    inh_id ← match tde.inherit_description_from, tde.decl_names with
    | some inh_id, _ := pure inh_id
    | none, [inh_id] := pure inh_id
    | none, _ := fail "A tactic doc entry must either:
 1. have a description written as a doc-string for the `add_tactic_doc` invocation, or
 2. have a single declaration in the `decl_names` field, to inherit a description from, or
 3. explicitly indicate the declaration to inherit the description from using
    `inherit_description_from`."
    end,
    doc_string inh_id <|> fail (to_string inh_id ++ " has no doc string")),
  let decl_name := `tactic_doc <.> tde.category.to_string <.> tde.name,
  add_decl $ mk_definition decl_name [] `(tactic_doc_entry) (reflect tde),
  add_doc_string decl_name desc,
  tactic_doc_entry_attr.set decl_name () tt none

/--
A command used to add documentation for a tactic, command, hole command, or attribute.

Usage: after defining an interactive tactic, command, or attribute,
add its documentation as follows.
```lean
/--
describe what the command does here
-/
add_tactic_doc
{ name := "display name of the tactic",
  category := cat,
  decl_names := [`dcl_1, `dcl_2],
  tags := ["tag_1", "tag_2"] }
```

The argument to `add_tactic_doc` is a structure of type `tactic_doc_entry`.
* `name` refers to the display name of the tactic; it is used as the header of the doc entry.
* `cat` refers to the category of doc entry.
  Options: `doc_category.tactic`, `doc_category.cmd`, `doc_category.hole_cmd`, `doc_category.attr`
* `decl_names` is a list of the declarations associated with this doc. For instance,
  the entry for `linarith` would set ``decl_names := [`tactic.interactive.linarith]``.
  Some entries may cover multiple declarations.
  It is only necessary to list the interactive versions of tactics.
* `tags` is an optional list of strings used to categorize entries.
* The doc string is the body of the entry. It can be formatted with markdown.
  What you are reading now is the description of `add_tactic_doc`.

If only one related declaration is listed in `decl_names` and if this
invocation of `add_tactic_doc` does not have a doc string, the doc string of
that declaration will become the body of the tactic doc entry. If there are
multiple declarations, you can select the one to be used by passing a name to
the `inherit_description_from` field.

If you prefer a tactic to have a doc string that is different then the doc entry,
you should write the doc entry as a doc string for the `add_tactic_doc` invocation.

Note that providing a badly formed `tactic_doc_entry` to the command can result in strange error
messages.

-/
@[user_command] meta def add_tactic_doc_command (mi : interactive.decl_meta_info)
  (_ : parse $ tk "add_tactic_doc") : parser unit := do
pe ← parser.pexpr,
e ← eval_pexpr tactic_doc_entry pe,
tactic.add_tactic_doc e mi.doc_string .

/--
At various places in mathlib, we leave implementation notes that are referenced from many other
files. To keep track of these notes, we use the command `library_note`. This makes it easy to
retrieve a list of all notes, e.g. for documentation output.

These notes can be referenced in mathlib with the syntax `Note [note id]`.
Often, these references will be made in code comments (`--`) that won't be displayed in docs.
If such a reference is made in a doc string or module doc, it will be linked to the corresponding
note in the doc display.

Syntax:
```
/--
note message
-/
library_note "note id"
```

An example from `meta.expr`:

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

This note can be referenced near a usage of `pi_binders`:

```
-- See Note [open expressions]
/-- behavior of f -/
def f := pi_binders ...
```
-/
add_tactic_doc
{ name                     := "library_note",
  category                 := doc_category.cmd,
  decl_names               := [`library_note, `tactic.add_library_note],
  tags                     := ["documentation"],
  inherit_description_from := `library_note }

add_tactic_doc
{ name                     := "add_tactic_doc",
  category                 := doc_category.cmd,
  decl_names               := [`add_tactic_doc_command, `tactic.add_tactic_doc],
  tags                     := ["documentation"],
  inherit_description_from := `add_tactic_doc_command }

add_tactic_doc
{ name := "copy_doc_string",
  category := doc_category.cmd,
  decl_names := [`copy_doc_string_cmd, `tactic.copy_doc_string],
  tags := ["documentation"],
  inherit_description_from := `copy_doc_string_cmd }

-- add docs to core tactics

/--
The congruence closure tactic `cc` tries to solve the goal by chaining
equalities from context and applying congruence (i.e. if `a = b`, then `f a = f b`).
It is a finishing tactic, i.e. it is meant to close
the current goal, not to make some inconclusive progress.
A mostly trivial example would be:

```lean
example (a b c : ℕ) (f : ℕ → ℕ) (h: a = b) (h' : b = c) : f a = f c := by cc
```

As an example requiring some thinking to do by hand, consider:

```lean
example (f : ℕ → ℕ) (x : ℕ)
  (H1 : f (f (f x)) = x) (H2 : f (f (f (f (f x)))) = x) :
  f x = x :=
by cc
```

The tactic works by building an equality matching graph. It's a graph where
the vertices are terms and they are linked by edges if they are known to
be equal. Once you've added all the equalities in your context, you take
the transitive closure of the graph and, for each connected component
(i.e. equivalence class) you can elect a term that will represent the
whole class and store proofs that the other elements are equal to it.
You then take the transitive closure of these equalities under the
congruence lemmas.

The `cc` implementation in Lean does a few more tricks: for example it
derives `a=b` from `nat.succ a = nat.succ b`, and `nat.succ a !=
nat.zero` for any `a`.

* The starting reference point is Nelson, Oppen, [Fast decision procedures based on congruence
closure](http://www.cs.colorado.edu/~bec/courses/csci5535-s09/reading/nelson-oppen-congruence.pdf),
Journal of the ACM (1980)

* The congruence lemmas for dependent type theory as used in Lean are described in
[Congruence closure in intensional type theory](https://leanprover.github.io/papers/congr.pdf)
(de Moura, Selsam IJCAR 2016).
-/
add_tactic_doc
{ name := "cc (congruence closure)",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.cc],
  tags := ["core", "finishing"] }

/--
`conv {...}` allows the user to perform targeted rewriting on a goal or hypothesis,
by focusing on particular subexpressions.

See <https://leanprover-community.github.io/extras/conv.html> for more details.

Inside `conv` blocks, mathlib currently additionally provides
* `erw`,
* `ring`, `ring2` and `ring_exp`,
* `norm_num`,
* `norm_cast`,
* `apply_congr`, and
* `conv` (within another `conv`).

`apply_congr` applies congruence lemmas to step further inside expressions,
and sometimes gives better results than the automatically generated
congruence lemmas used by `congr`.

Using `conv` inside a `conv` block allows the user to return to the previous
state of the outer `conv` block after it is finished. Thus you can continue
editing an expression without having to start a new `conv` block and re-scoping
everything. For example:
```lean
example (a b c d : ℕ) (h₁ : b = c) (h₂ : a + c = a + d) : a + b = a + d :=
by conv
{ to_lhs,
  conv
  { congr, skip,
    rw h₁ },
  rw h₂, }
```
Without `conv`, the above example would need to be proved using two successive
`conv` blocks, each beginning with `to_lhs`.

Also, as a shorthand, `conv_lhs` and `conv_rhs` are provided, so that
```lean
example : 0 + 0 = 0 :=
begin
  conv_lhs { simp }
end
```
just means
```lean
example : 0 + 0 = 0 :=
begin
  conv { to_lhs, simp }
end
```
and likewise for `to_rhs`.
-/
add_tactic_doc
{ name := "conv",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.conv],
  tags := ["core"] }

add_tactic_doc
{ name := "simp",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.simp],
  tags := ["core", "simplification"] }

/--
Accepts terms with the type `component tactic_state string` or `html empty` and
renders them interactively.
Requires a compatible version of the vscode extension to view the resulting widget.

### Example:

```lean
/-- A simple counter that can be incremented or decremented with some buttons. -/
meta def counter_widget {π α : Type} : component π α :=
component.ignore_props $ component.mk_simple int int 0 (λ _ x y, (x + y, none)) (λ _ s,
  h "div" [] [
    button "+" (1 : int),
    html.of_string $ to_string $ s,
    button "-" (-1)
  ]
)

#html counter_widget
```
-/
add_tactic_doc
{ name := "#html",
  category := doc_category.cmd,
  decl_names := [`show_widget_cmd],
  tags := ["core", "widgets"] }

/--
The `add_decl_doc` command is used to add a doc string to an existing declaration.

```lean
def foo := 5

/--
Doc string for foo.
-/
add_decl_doc foo
```
-/
@[user_command] meta def add_decl_doc_command (mi : interactive.decl_meta_info)
  (_ : parse $ tk "add_decl_doc") : parser unit := do
n ← parser.ident,
n ← resolve_constant n,
some doc ← pure mi.doc_string | fail "add_decl_doc requires a doc string",
add_doc_string n doc

add_tactic_doc
{ name := "add_decl_doc",
  category := doc_category.cmd,
  decl_names := [``add_decl_doc_command],
  tags := ["documentation"] }


import .gluing

universes v u

open category_theory
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.cofibrations
open precofibration_category cofibration_category
open homotopy_theory.weak_equivalences

variables {C : Type u} [category.{v} C] [cofibration_category.{v} C]
  [has_initial_object.{v} C]

variables {a b a' b' : C} {i : a ⟶ b} {f : a ⟶ a'} {i' : a' ⟶ b'} {f' : b ⟶ b'}
  (po : Is_pushout i f f' i')

lemma pushout_is_weq (ha : cofibrant a) (ha' : cofibrant a') (hi : is_cof i) (hf : is_weq f) :
  is_weq f' :=
have _ := gluing_weq (Is_pushout.refl i) po ha ha ha ha' hi hi
  (weq_id a) (weq_id b) hf (by simp) (by simp),
begin
  convert ←this,
  apply pushout_induced_eq_iff; simp [po.commutes]
end

instance [all_objects_cofibrant.{v} C] : left_proper.{v} C :=
{ pushout_weq_by_cof := λ a b a' b' f g f' g' po hf hg,
    by refine pushout_is_weq po _ _ hf hg; exact all_objects_cofibrant.cofibrant _ }

end homotopy_theory.cofibrations


import for_mathlib.composable_morphisms
import algebra.homology.additive
import for_mathlib.homological_complex_map_d_to_d_from

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables {C D : Type*} [category C] [category D]

section

variables (C)

/- Category of complexes `X ⟶ Y ⟶ Z` -/
@[derive category]
def short_complex [has_zero_morphisms C] := full_subcategory $ λ S : composable_morphisms C, S.zero

end

open category_theory

namespace homological_complex

variables [has_zero_morphisms C] {M : Type*} {c : complex_shape M}

lemma prev_id (X : homological_complex C c) (i : M) : hom.prev (𝟙 X) i = 𝟙 (X.X_prev i) := rfl

lemma next_id (X : homological_complex C c) (i : M) : hom.next (𝟙 X) i = 𝟙 (X.X_next i) := rfl

lemma prev_comp {X Y Z : homological_complex C c} (f : X ⟶ Y) (g : Y ⟶ Z)
  (i : M) : hom.prev (f ≫ g) i = hom.prev f i ≫ hom.prev g i := rfl

lemma next_comp {X Y Z : homological_complex C c} (f : X ⟶ Y) (g : Y ⟶ Z)
  (i : M) : hom.next (f ≫ g) i = hom.next f i ≫ hom.next g i := rfl

end homological_complex

namespace short_complex

@[simp, reassoc]
lemma zero [has_zero_morphisms C] (S : short_complex C) : S.1.f ≫ S.1.g = 0 := S.2

@[simps]
def mk [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
  short_complex C := ⟨composable_morphisms.mk f g, zero⟩

@[simp]
lemma mk_id_τ₁ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₁ (𝟙 (mk f g zero)) = 𝟙 X := rfl
@[simp]
lemma mk_id_τ₂ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₂ (𝟙 (mk f g zero)) = 𝟙 Y := rfl
@[simp]
lemma mk_id_τ₃ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₃ (𝟙 (mk f g zero)) = 𝟙 Z := rfl

@[simp]
lemma comp_τ₁ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₁ = f.τ₁ ≫ g.τ₁ := rfl
@[simp]
lemma comp_τ₂ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₂ = f.τ₂ ≫ g.τ₂ := rfl
@[simp]
lemma comp_τ₃ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₃ = f.τ₃ ≫ g.τ₃ := rfl

@[simps]
def hom_mk [has_zero_morphisms C] {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} {f₁ : X₁ ⟶ Y₁} {g₁ : Y₁ ⟶ Z₁}
  {f₂ : X₂ ⟶ Y₂} {g₂ : Y₂ ⟶ Z₂} {zero₁ : f₁ ≫ g₁ = 0} {zero₂ : f₂ ≫ g₂ = 0}
  (τ₁ : X₁ ⟶ X₂) (τ₂ : Y₁ ⟶ Y₂) (τ₃ : Z₁ ⟶ Z₂) (comm₁₂ : f₁ ≫ τ₂ = τ₁ ≫ f₂)
  (comm₂₃ : g₁ ≫ τ₃ = τ₂ ≫ g₂) :
  mk f₁ g₁ zero₁ ⟶ mk f₂ g₂ zero₂ := ⟨τ₁, τ₂, τ₃, comm₁₂, comm₂₃⟩

@[simps]
def iso_mk [has_zero_morphisms C] {S₁ S₂ : short_complex C}
  (τ₁ : S₁.1.X ≅ S₂.1.X) (τ₂ : S₁.1.Y ≅ S₂.1.Y) (τ₃ : S₁.1.Z ≅ S₂.1.Z)
  (comm₁₂ : S₁.1.f ≫ τ₂.hom = τ₁.hom ≫ S₂.1.f)
  (comm₂₃ : S₁.1.g ≫ τ₃.hom = τ₂.hom ≫ S₂.1.g) :
  S₁ ≅ S₂ :=
{ hom := ⟨τ₁.hom, τ₂.hom, τ₃.hom, comm₁₂, comm₂₃⟩,
  inv := begin
    refine ⟨τ₁.inv, τ₂.inv, τ₃.inv, _, _⟩,
    { simp only [← cancel_mono τ₂.hom, ← cancel_epi τ₁.hom,
        assoc, iso.inv_hom_id, comp_id, iso.hom_inv_id_assoc, comm₁₂], },
    { simp only [← cancel_mono τ₃.hom, ← cancel_epi τ₂.hom,
        assoc, iso.inv_hom_id, comp_id, iso.hom_inv_id_assoc, comm₂₃], },
  end,
  hom_inv_id' := begin
    ext,
    { simpa only [comp_τ₁, hom_mk_τ₁, iso.hom_inv_id], },
    { simpa only [comp_τ₂, hom_mk_τ₂, iso.hom_inv_id], },
    { simpa only [comp_τ₃, hom_mk_τ₃, iso.hom_inv_id], },
  end,
  inv_hom_id' := begin
    ext,
    { simpa only [iso.inv_hom_id, comp_τ₁, hom_mk_τ₁], },
    { simpa only [iso.inv_hom_id, comp_τ₂, hom_mk_τ₂], },
    { simpa only [iso.inv_hom_id, comp_τ₃, hom_mk_τ₃], },
  end, }

lemma is_iso_of_is_isos [has_zero_morphisms C] {S₁ S₂ : short_complex C}
  (φ : S₁ ⟶ S₂) (h₁ : is_iso φ.τ₁) (h₂ : is_iso φ.τ₂) (h₃ : is_iso φ.τ₃) : is_iso φ :=
begin
  let e : S₁ ≅ S₂ := iso_mk (as_iso φ.τ₁) (as_iso φ.τ₂) (as_iso φ.τ₃) φ.comm₁₂ φ.comm₂₃,
  unfreezingI { rcases φ with ⟨τ₁, τ₂, τ₃, comm₁₂, comm₂₂⟩, },
  exact is_iso.of_iso e,
end

def homology [abelian C] (S : short_complex C) : C := homology S.1.f S.1.g S.2

@[simps]
def homology_functor [abelian C] : short_complex C ⥤ C :=
{ obj := λ X, X.homology,
  map := λ X Y φ, homology.map X.2 Y.2 ⟨φ.τ₁, φ.τ₂, φ.comm₁₂.symm⟩
    ⟨φ.τ₂, φ.τ₃, φ.comm₂₃.symm⟩ rfl,
  map_id' := λ X, by apply homology.map_id,
  map_comp' := λ X Y Z φ ψ, by { symmetry, apply homology.map_comp, }, }

variable (C)

@[simps]
def functor_homological_complex [has_zero_morphisms C]
  {M : Type*} (c : complex_shape M) (i : M) :
  homological_complex C c ⥤ short_complex C :=
{ obj := λ X, mk (X.d_to i) (X.d_from i) (X.d_to_comp_d_from i),
  map := λ X Y f, composable_morphisms.hom.mk (f.prev i) (f.f i) (f.next i)
    (f.comm_to i).symm (f.comm_from i).symm,
  map_id' := λ X, begin
    ext,
    { exact X.prev_id i, },
    { refl, },
    { exact X.next_id i, },
  end,
  map_comp' := λ X Y Z f g, begin
    ext,
    { exact homological_complex.prev_comp f g i, },
    { refl, },
    { exact homological_complex.next_comp f g i, },
  end, }

@[simps]
def homology_functor_iso [abelian C] {M : Type*} (c : complex_shape M) (i : M) :
  _root_.homology_functor C c i ≅
  functor_homological_complex C c i ⋙ short_complex.homology_functor :=
nat_iso.of_components (λ X, iso.refl _)
  (λ X Y f, by { ext, simpa only [iso.refl_hom, id_comp, comp_id], })

end short_complex

namespace category_theory

namespace functor

@[simps]
def map_short_complex [has_zero_morphisms C] [has_zero_morphisms D] (F : C ⥤ D)
  [F.preserves_zero_morphisms] :
  short_complex C ⥤ short_complex D :=
full_subcategory.lift _ (induced_functor _ ⋙ F.map_composable_morphisms)
(λ X, begin
  have h := X.2,
  dsimp [composable_morphisms.zero] at h ⊢,
  rw [← F.map_comp, h, F.map_zero],
end)

end functor

namespace nat_trans

@[simps]
def map_short_complex [has_zero_morphisms C] [has_zero_morphisms D] {F G : C ⥤ D}
  [F.preserves_zero_morphisms] [G.preserves_zero_morphisms] (φ : F ⟶ G) :
  F.map_short_complex ⟶ G.map_short_complex :=
{ app := λ X, ⟨φ.app _, φ.app _, φ.app _, φ.naturality _, φ.naturality _⟩, }

end nat_trans

end category_theory

open category_theory

namespace short_complex

variable {C}

def functor_homological_complex_map [preadditive C] [preadditive D] (F : C ⥤ D) [F.additive]
  {M : Type*} (c : complex_shape M) (i : M) :
short_complex.functor_homological_complex C c i ⋙ F.map_short_complex ≅
F.map_homological_complex c ⋙ short_complex.functor_homological_complex D c i :=
iso.refl _

variables [preadditive C] [preadditive D] {F G : C ⥤ D} [functor.additive F] [functor.additive G]
  {M : Type*} (c : complex_shape M) (i : M) (φ : F ⟶ G) (X : homological_complex C c)

lemma nat_trans.map_short_complex_app :
  (nat_trans.map_short_complex φ).app ((short_complex.functor_homological_complex C c i).obj X) =
  (short_complex.functor_homological_complex D c i).map
    ((nat_trans.map_homological_complex φ c).app X) := rfl

lemma naturality_functor_homological_complex_map :
  (nat_trans.map_short_complex φ).app
    ((short_complex.functor_homological_complex C c i).obj X) ≫
    (short_complex.functor_homological_complex_map G c i).hom.app X =
  (short_complex.functor_homological_complex_map F c i).hom.app X ≫
    (short_complex.functor_homological_complex D c i).map
      ((nat_trans.map_homological_complex φ c).app X) :=
begin
  dsimp only [functor_homological_complex_map, iso.refl_hom, nat_trans.id_app],
  erw [nat_trans.map_short_complex_app, category.id_comp, category.comp_id],
end

end short_complex