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

namespace Lean.Meta

/-- Create `SizeOf` local instances for applicable parameters, and execute `k` using them. -/
private partial def mkLocalInstances (params : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  loop 0 #[]
where
  loop (i : Nat) (insts : Array Expr) : MetaM α := do
    if i < params.size then
      let param := params[i]!
      let paramType ← inferType param
      let instType? ← forallTelescopeReducing paramType fun xs _ => do
        let type := mkAppN param xs
        try
          let sizeOf ← mkAppM `SizeOf #[type]
          let instType ← mkForallFVars xs sizeOf
          return some instType
        catch _ =>
          return none
      match instType? with
      | none => loop (i+1) insts
      | some instType =>
        let instName ← mkFreshUserName `inst
        withLocalDecl instName BinderInfo.instImplicit instType fun inst =>
          loop (i+1) (insts.push inst)
    else
      k insts

/--
  Return `some x` if `fvar` has type of the form `... -> motive ... fvar` where `motive` in `motiveFVars`.
  That is, `x` "produces" one of the recursor motives.
-/
private def isInductiveHypothesis? (motiveFVars : Array Expr) (fvar : Expr) : MetaM (Option Expr) := do
  forallTelescopeReducing (← inferType fvar) fun _ type =>
    if type.isApp && motiveFVars.contains type.getAppFn then
      return some type.appArg!
    else
      return none

private def isInductiveHypothesis (motiveFVars : Array Expr) (fvar : Expr) : MetaM Bool :=
  return (← isInductiveHypothesis? motiveFVars fvar).isSome

/--
  Let `motiveFVars` be free variables for each motive in a kernel recursor, and `minorFVars` the free variables for a minor premise.
  Then, return `some idx` if `minorFVars[idx]` has a type of the form `... -> motive ... fvar` for some `motive` in `motiveFVars`.
-/
private def isRecField? (motiveFVars : Array Expr) (minorFVars : Array Expr) (fvar : Expr) : MetaM (Option Nat) := do
  let mut idx := 0
  for minorFVar in minorFVars do
    if let some fvar' ← isInductiveHypothesis? motiveFVars minorFVar then
      if fvar == fvar'.getAppFn then
        return some idx
    idx := idx + 1
  return none

private partial def mkSizeOfMotives (motiveFVars : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  loop 0 #[]
where
  loop (i : Nat) (motives : Array Expr) : MetaM α := do
    if i < motiveFVars.size then
      let type ← inferType motiveFVars[i]!
      let motive ← forallTelescopeReducing type fun xs _ => do
        mkLambdaFVars xs <| mkConst ``Nat
      trace[Meta.sizeOf] "motive: {motive}"
      loop (i+1) (motives.push motive)
    else
      k motives

private partial def ignoreField (x : Expr) : MetaM Bool := do
  let type ← whnf (← inferType x)
  if type.isForall then
    -- TODO: add support for finite domains
    if type.isArrow && type.bindingDomain!.isConstOf ``Unit then
      ignoreField type.bindingBody!
    else
      return true
  else
    return false

/-- See `ignoreField`. We have support for functions of the form `Unit → ...` -/
private partial def mkSizeOfRecFieldFormIH (ih : Expr) : MetaM Expr := do
  if (← whnf (← inferType ih)).isForall then
     mkSizeOfRecFieldFormIH (mkApp ih (mkConst ``Unit.unit))
  else
     return ih

private partial def mkSizeOfMinors (motiveFVars : Array Expr) (minorFVars : Array Expr) (minorFVars' : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  assert! minorFVars.size == minorFVars'.size
  loop 0 #[]
where
  loop (i : Nat) (minors : Array Expr) : MetaM α := do
    if i < minorFVars.size then
      forallTelescopeReducing (← inferType minorFVars[i]!) fun xs _ => do
      forallBoundedTelescope (← inferType minorFVars'[i]!) xs.size fun xs' _ => do
        let mut minor ← mkNumeral (mkConst ``Nat) 1
        for x in xs, x' in xs' do
          unless (← isInductiveHypothesis motiveFVars x) do
          unless (← ignoreField x) do -- we suppress higher-order fields
            match (← isRecField? motiveFVars xs x) with
            | some idx => minor ← mkAdd minor (← mkSizeOfRecFieldFormIH xs'[idx]!)
            | none     => minor ← mkAdd minor (← mkAppM ``SizeOf.sizeOf #[x'])
        minor ← mkLambdaFVars xs' minor
        trace[Meta.sizeOf] "minor: {minor}"
        loop (i+1) (minors.push minor)
    else
      k minors

/--
  Create a "sizeOf" function with name `declName` using the recursor `recName`.
-/
partial def mkSizeOfFn (recName : Name) (declName : Name): MetaM Unit := do
  trace[Meta.sizeOf] "recName: {recName}"
  let recInfo : RecursorVal ← getConstInfoRec recName
  forallTelescopeReducing recInfo.type fun xs _ =>
    let levelParams := recInfo.levelParams.tail! -- universe parameters for declaration being defined
    let params := xs[:recInfo.numParams]
    let motiveFVars := xs[recInfo.numParams : recInfo.numParams + recInfo.numMotives]
    let minorFVars := xs[recInfo.getFirstMinorIdx : recInfo.getFirstMinorIdx + recInfo.numMinors]
    let indices := xs[recInfo.getFirstIndexIdx : recInfo.getFirstIndexIdx + recInfo.numIndices]
    let major := xs[recInfo.getMajorIdx]!
    let nat := mkConst ``Nat
    mkLocalInstances params fun localInsts =>
    mkSizeOfMotives motiveFVars fun motives => do
      let us := levelOne :: levelParams.map mkLevelParam -- universe level parameters for `rec`-application
      let recFn := mkConst recName us
      let val := mkAppN recFn (params ++ motives)
      forallBoundedTelescope (← inferType val) recInfo.numMinors fun minorFVars' _ =>
      mkSizeOfMinors motiveFVars minorFVars minorFVars' fun minors => do
        withInstImplicitAsImplict params do
          let sizeOfParams := params ++ localInsts ++ indices ++ #[major]
          let sizeOfType ← mkForallFVars sizeOfParams nat
          let val := mkAppN val (minors ++ indices ++ #[major])
          let sizeOfValue ← mkLambdaFVars sizeOfParams val
          trace[Meta.sizeOf] "declName: {declName}"
          trace[Meta.sizeOf] "type: {sizeOfType}"
          trace[Meta.sizeOf] "val: {sizeOfValue}"
          addDecl <| Declaration.defnDecl {
            name        := declName
            levelParams := levelParams
            type        := sizeOfType
            value       := sizeOfValue
            safety      := DefinitionSafety.safe
            hints       := ReducibilityHints.abbrev
          }

/--
  Create `sizeOf` functions for all inductive datatypes in the mutual inductive declaration containing `typeName`
  The resulting array contains the generated functions names. The `NameMap` maps recursor names into the generated function names.
  There is a function for each element of the mutual inductive declaration, and for auxiliary recursors for nested inductive types.
-/
def mkSizeOfFns (typeName : Name) : MetaM (Array Name × NameMap Name) := do
  let indInfo ← getConstInfoInduct typeName
  let recInfo ← getConstInfoRec (mkRecName typeName)
  let numExtra := recInfo.numMotives - indInfo.all.length -- numExtra > 0 for nested inductive types
  let mut result := #[]
  let baseName := indInfo.all.head! ++ `_sizeOf -- we use the first inductive type as the base name for `sizeOf` functions
  let mut i := 1
  let mut recMap : NameMap Name := {}
  for indTypeName in indInfo.all do
    let sizeOfName := baseName.appendIndexAfter i
    let recName := mkRecName indTypeName
    mkSizeOfFn recName sizeOfName
    recMap := recMap.insert recName sizeOfName
    result := result.push sizeOfName
    i := i + 1
  for j in [:numExtra] do
    let recName := (mkRecName indInfo.all.head!).appendIndexAfter (j+1)
    let sizeOfName := baseName.appendIndexAfter i
    mkSizeOfFn recName sizeOfName
    recMap := recMap.insert recName sizeOfName
    result := result.push sizeOfName
    i := i + 1
  return (result, recMap)

def mkSizeOfSpecLemmaName (ctorName : Name) : Name :=
  ctorName ++ `sizeOf_spec

def mkSizeOfSpecLemmaInstance (ctorApp : Expr) : MetaM Expr :=
  matchConstCtor ctorApp.getAppFn (fun _ => throwError "failed to apply 'sizeOf' spec, constructor expected{indentExpr ctorApp}") fun ctorInfo _ => do
    let ctorArgs     := ctorApp.getAppArgs
    let ctorParams   := ctorArgs[:ctorInfo.numParams]
    let ctorFields   := ctorArgs[ctorInfo.numParams:]
    let lemmaName  := mkSizeOfSpecLemmaName ctorInfo.name
    let lemmaInfo  ← getConstInfo lemmaName
    let lemmaArity ← forallTelescopeReducing lemmaInfo.type fun xs _ => return xs.size
    let lemmaArgMask := ctorParams.toArray.map some
    let lemmaArgMask := lemmaArgMask ++ mkArray (lemmaArity - ctorInfo.numParams - ctorInfo.numFields) (none (α := Expr))
    let lemmaArgMask := lemmaArgMask ++ ctorFields.toArray.map some
    mkAppOptM lemmaName lemmaArgMask

/-! # SizeOf spec theorem for nested inductive types -/
namespace SizeOfSpecNested

structure Context where
  indInfo    : InductiveVal
  sizeOfFns  : Array Name
  ctorName   : Name
  params     : Array Expr
  localInsts : Array Expr
  recMap     : NameMap Name -- mapping from recursor name into `_sizeOf_<idx>` function name (see `mkSizeOfFns`)

abbrev M := ReaderT Context MetaM

def throwUnexpected {α} (msg : MessageData) : M α := do
  throwError "failed to generate sizeOf theorem for {(← read).ctorName} (use `set_option genSizeOfSpec false` to disable theorem generation), {msg}"

def throwFailed {α} : M α := do
  throwError "failed to generate sizeOf theorem for {(← read).ctorName}, (use `set_option genSizeOfSpec false` to disable theorem generation)"

/-- Convert a recursor application into a `_sizeOf_<idx>` application. -/
private def recToSizeOf (e : Expr) : M Expr := do
  matchConstRec e.getAppFn (fun _ => throwFailed) fun info us => do
    match (← read).recMap.find? info.name with
    | none => throwUnexpected m!"expected recursor application {indentExpr e}"
    | some sizeOfName =>
      let args    := e.getAppArgs
      let indices := args[info.getFirstIndexIdx : info.getFirstIndexIdx + info.numIndices]
      let major   := args[info.getMajorIdx]!
      return mkAppN (mkConst sizeOfName us.tail!) ((← read).params ++ (← read).localInsts ++ indices ++ #[major])

mutual
  /-- Construct minor premise proof for `mkSizeOfAuxLemmaProof`. `ys` contains fields and inductive hypotheses for the minor premise. -/
  private partial def mkMinorProof (ys : Array Expr) (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.minor] "{lhs} =?= {rhs}"
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      match (← whnfI lhs).natAdd?, (← whnfI rhs).natAdd? with
      | some (a₁, b₁), some (a₂, b₂) =>
        let p₁ ← mkMinorProof ys a₁ a₂
        let p₂ ← mkMinorProofStep ys b₁ b₂
        mkCongr (← mkCongrArg (mkConst ``Nat.add) p₁) p₂
      | _, _ =>
        throwUnexpected m!"expected 'Nat.add' application, lhs is {indentExpr lhs}\nrhs is{indentExpr rhs}"

  /--
    Helper method for `mkMinorProof`. The proof step is one of the following
    - Reflexivity
    - Assumption (i.e., using an inductive hypotheses from `ys`)
    - `mkSizeOfAuxLemma` application. This case happens when we have multiple levels of nesting
  -/
  private partial def mkMinorProofStep (ys : Array Expr) (lhs rhs : Expr) : M Expr := do
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      let lhs ← recToSizeOf lhs
      trace[Meta.sizeOf.minor.step] "{lhs} =?= {rhs}"
      let target ← mkEq lhs rhs
      for y in ys do
        if (← isDefEq (← inferType y) target) then
          return y
      mkSizeOfAuxLemma lhs rhs

  /-- Construct proof of auxiliary lemma. See `mkSizeOfAuxLemma` -/
  private partial def mkSizeOfAuxLemmaProof (info : InductiveVal) (lhs : Expr) : M Expr := do
    let lhsArgs := lhs.getAppArgs
    let sizeOfBaseArgs := lhsArgs[:lhsArgs.size - info.numIndices - 1]
    let indicesMajor := lhsArgs[lhsArgs.size - info.numIndices - 1:]
    let sizeOfLevels := lhs.getAppFn.constLevels!
    let rec
      /-- Auxiliary function for constructing an `_sizeOf_<idx>` for `ys`,
        where `ys` are the indices + major.
        Recall that if `info.name` is part of a mutually inductive declaration, then the resulting application
        is not necessarily a `lhs.getAppFn` application.
        The result is an application of one of the `(← read),sizeOfFns` functions.
        We use this auxiliary function to builtin the motive of the recursor. -/
      mkSizeOf (ys : Array Expr) : M Expr := do
      for sizeOfFn in (← read).sizeOfFns do
        let candidate := mkAppN (mkAppN (mkConst sizeOfFn sizeOfLevels) sizeOfBaseArgs) ys
        if (← isTypeCorrect candidate) then
          return candidate
      throwFailed
    let major := lhs.appArg!
    let majorType ← whnf (← inferType major)
    let majorTypeArgs := majorType.getAppArgs
    match majorType.getAppFn.const? with
    | none => throwFailed
    | some (_, us) =>
      let recName := mkRecName info.name
      let recInfo ← getConstInfoRec recName
      let r := mkConst recName (levelZero :: us)
      let r := mkAppN r majorTypeArgs[:info.numParams]
      forallBoundedTelescope (← inferType r) recInfo.numMotives fun motiveFVars _ => do
        let mut r := r
        -- Add motives
        for motiveFVar in motiveFVars do
          let motive ← forallTelescopeReducing (← inferType motiveFVar) fun ys _ => do
            let lhs ← mkSizeOf ys
            let rhs ← mkAppM ``SizeOf.sizeOf #[ys.back]
            mkLambdaFVars ys (← mkEq lhs rhs)
          r := mkApp r motive
        forallBoundedTelescope (← inferType r) recInfo.numMinors fun minorFVars _ => do
          let mut r := r
          -- Add minors
          for minorFVar in minorFVars do
            let minor ← forallTelescopeReducing (← inferType minorFVar) fun ys target => do
              let target ← whnf target
              match target.eq? with
              | none => throwFailed
              | some (_, lhs, rhs) =>
                if (← isDefEq lhs rhs) then
                  mkLambdaFVars ys (← mkEqRefl rhs)
                else
                  let lhs ← unfoldDefinition lhs -- Unfold `_sizeOf_<idx>`
                  -- rhs is of the form `sizeOf (ctor ...)`
                  let ctorApp := rhs.appArg!
                  let specLemma ← mkSizeOfSpecLemmaInstance ctorApp
                  let specEq ← whnf (← inferType specLemma)
                  match specEq.eq? with
                  | none => throwFailed
                  | some (_, _, rhsExpanded) =>
                    let lhs_eq_rhsExpanded ← mkMinorProof ys lhs rhsExpanded
                    let rhsExpanded_eq_rhs ← mkEqSymm specLemma
                    mkLambdaFVars ys (← mkEqTrans lhs_eq_rhsExpanded rhsExpanded_eq_rhs)
            r := mkApp r minor
          -- Add indices and major
          return mkAppN r indicesMajor

  /--
    Generate proof for `C._sizeOf_<idx> t = sizeOf t` where `C._sizeOf_<idx>` is a auxiliary function
    generated for a nested inductive type in `C`.
    For example, given
    ```lean
    inductive Expr where
      | app (f : String) (args : List Expr)
    ```
    We generate the auxiliary function `Expr._sizeOf_1 : List Expr → Nat`.
    To generate the `sizeOf` spec lemma
    ```
    sizeOf (Expr.app f args) = 1 + sizeOf f + sizeOf args
    ```
    we need an auxiliary lemma for showing `Expr._sizeOf_1 args = sizeOf args`.
    Recall that `sizeOf (Expr.app f args)` is definitionally equal to `1 + sizeOf f + Expr._sizeOf_1 args`, but
    `Expr._sizeOf_1 args` is **not** definitionally equal to `sizeOf args`. We need a proof by induction.
  -/
  private partial def mkSizeOfAuxLemma (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.aux] "{lhs} =?= {rhs}"
    match lhs.getAppFn.const? with
    | none => throwFailed
    | some (fName, us) =>
      let thmLevelParams ← us.mapM fun
        | Level.param n => return n
        | _ => throwFailed
      let thmName  := fName.appendAfter "_eq"
      if (← getEnv).contains thmName then
        -- Auxiliary lemma has already been defined
        return mkAppN (mkConst thmName us) lhs.getAppArgs
      else
        -- Define auxiliary lemma
        -- First, generalize indices
        let x := lhs.appArg!
        let xType ← whnf (← inferType x)
        matchConstInduct xType.getAppFn (fun _ => throwFailed) fun info _ => do
          let params := xType.getAppArgs[:info.numParams]
          forallTelescopeReducing (← inferType (mkAppN xType.getAppFn params)) fun indices _ => do
            let majorType := mkAppN (mkAppN xType.getAppFn params) indices
            withLocalDeclD `x majorType fun major => do
              let lhsArgs := lhs.getAppArgs
              let lhsArgsNew := lhsArgs[:lhsArgs.size - 1 - indices.size] ++ indices ++ #[major]
              let lhsNew := mkAppN lhs.getAppFn lhsArgsNew
              let rhsNew ← mkAppM ``SizeOf.sizeOf #[major]
              let eq ← mkEq lhsNew rhsNew
              let thmParams := lhsArgsNew
              let thmType ← mkForallFVars thmParams eq
              let thmValue ← mkSizeOfAuxLemmaProof info lhsNew
              let thmValue ← mkLambdaFVars thmParams thmValue
              trace[Meta.sizeOf] "thmValue: {thmValue}"
              addDecl <| Declaration.thmDecl {
                name        := thmName
                levelParams := thmLevelParams
                type        := thmType
                value       := thmValue
              }
              return mkAppN (mkConst thmName us) lhs.getAppArgs

end

/- Prove SizeOf spec lemma of the form `sizeOf <ctor-application> = 1 + sizeOf <field_1> + ... + sizeOf <field_n> -/
partial def main (lhs rhs : Expr) : M Expr := do
  if (← isDefEq lhs rhs) then
    mkEqRefl rhs
  else
    /- Expand lhs and rhs to obtain `Nat.add` applications -/
    let lhs ← whnfI lhs            -- Expand `sizeOf (ctor ...)` into `_sizeOf_<idx>` application
    let lhs ← unfoldDefinition lhs -- Unfold `_sizeOf_<idx>` application into `HAdd.hAdd` application
    loop lhs rhs
where
  loop (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.loop] "{lhs} =?= {rhs}"
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      match (← whnfI lhs).natAdd?, (← whnfI rhs).natAdd? with
      | some (a₁, b₁), some (a₂, b₂) =>
        let p₁ ← loop a₁ a₂
        let p₂ ← step b₁ b₂
        mkCongr (← mkCongrArg (mkConst ``Nat.add) p₁) p₂
      | _, _ =>
        throwUnexpected m!"expected 'Nat.add' application, lhs is {indentExpr lhs}\nrhs is{indentExpr rhs}"

  step (lhs rhs : Expr) : M Expr := do
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      let lhs ← recToSizeOf lhs
      mkSizeOfAuxLemma lhs rhs

end SizeOfSpecNested

private def mkSizeOfSpecTheorem (indInfo : InductiveVal) (sizeOfFns : Array Name) (recMap : NameMap Name) (ctorName : Name) : MetaM Unit := do
  let ctorInfo ← getConstInfoCtor ctorName
  let us := ctorInfo.levelParams.map mkLevelParam
  let simpAttr ← ofExcept <| getAttributeImpl (← getEnv) `simp
  forallTelescopeReducing ctorInfo.type fun xs _ => do
    let params := xs[:ctorInfo.numParams]
    let fields := xs[ctorInfo.numParams:]
    let ctorApp := mkAppN (mkConst ctorName us) xs
    mkLocalInstances params fun localInsts => do
      let lhs ← mkAppM ``SizeOf.sizeOf #[ctorApp]
      let mut rhs ← mkNumeral (mkConst ``Nat) 1
      for field in fields do
        unless (← ignoreField field) do
          rhs ← mkAdd rhs (← mkAppM ``SizeOf.sizeOf #[field])
      let target ← mkEq lhs rhs
      trace[Meta.sizeOf] "ctor: {ctorInfo.name}, target: {target}"
      let thmName   := mkSizeOfSpecLemmaName ctorName
      let thmParams := params ++ localInsts ++ fields
      let thmType ← mkForallFVars thmParams target
      let thmValue ← if indInfo.isNested then
        SizeOfSpecNested.main lhs rhs |>.run {
          indInfo, sizeOfFns, ctorName, params, localInsts, recMap
        }
      else
        mkEqRefl rhs
      let thmValue ← mkLambdaFVars thmParams thmValue
      trace[Meta.sizeOf] "sizeOf spec theorem name: {thmName}"
      trace[Meta.sizeOf] "sizeOf spec theorem type: {thmType}"
      trace[Meta.sizeOf] "sizeOf spec theorem value: {thmValue}"
      unless (← isDefEq (← inferType thmValue) thmType) do
        throwError "type mismatch"
      addDecl <| Declaration.thmDecl {
        name        := thmName
        levelParams := ctorInfo.levelParams
        type        := thmType
        value       := thmValue
      }
      simpAttr.add thmName default AttributeKind.global

private def mkSizeOfSpecTheorems (indTypeNames : Array Name) (sizeOfFns : Array Name) (recMap : NameMap Name) : MetaM Unit := do
  for indTypeName in indTypeNames do
    let indInfo ← getConstInfoInduct indTypeName
    for ctorName in indInfo.ctors do
      mkSizeOfSpecTheorem indInfo sizeOfFns recMap ctorName
  return ()

register_builtin_option genSizeOf : Bool := {
  defValue := true
  descr    := "generate `SizeOf` instance for inductive types and structures"
}

register_builtin_option genSizeOfSpec : Bool := {
  defValue := true
  descr    := "generate `SizeOf` specificiation theorems for automatically generated instances"
}

def mkSizeOfInstances (typeName : Name) : MetaM Unit := do
  if (← getEnv).contains ``SizeOf && genSizeOf.get (← getOptions) && !(← isInductivePredicate typeName) then
    let indInfo ← getConstInfoInduct typeName
    unless indInfo.isUnsafe do
      let (fns, recMap) ← mkSizeOfFns typeName
      for indTypeName in indInfo.all, fn in fns do
        let indInfo ← getConstInfoInduct indTypeName
        forallTelescopeReducing indInfo.type fun xs _ =>
          let params := xs[:indInfo.numParams]
          withInstImplicitAsImplict params do
            let indices := xs[indInfo.numParams:]
            mkLocalInstances params fun localInsts => do
              let us := indInfo.levelParams.map mkLevelParam
              let indType := mkAppN (mkConst indTypeName us) xs
              let sizeOfIndType ← mkAppM ``SizeOf #[indType]
              withLocalDeclD `m indType fun m => do
                let v ← mkLambdaFVars #[m] <| mkAppN (mkConst fn us) (params ++ localInsts ++ indices ++ #[m])
                let sizeOfMk ← mkAppM ``SizeOf.mk #[v]
                let instDeclName := indTypeName ++ `_sizeOf_inst
                let instDeclType ← mkForallFVars (xs ++ localInsts) sizeOfIndType
                let instDeclValue ← mkLambdaFVars (xs ++ localInsts) sizeOfMk
                trace[Meta.sizeOf] ">> {instDeclName} : {instDeclType}"
                addDecl <| Declaration.defnDecl {
                  name        := instDeclName
                  levelParams := indInfo.levelParams
                  type        := instDeclType
                  value       := instDeclValue
                  safety      := .safe
                  hints       := .abbrev
                }
                addInstance instDeclName AttributeKind.global (eval_prio default)
      if genSizeOfSpec.get (← getOptions) then
        mkSizeOfSpecTheorems indInfo.all.toArray fns recMap

builtin_initialize
  registerTraceClass `Meta.sizeOf

end Lean.Meta


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Util.HasConstCache
import Lean.Meta.CasesOn
import Lean.Meta.Match.Match
import Lean.Elab.RecAppSyntax
import Lean.Elab.PreDefinition.Basic
import Lean.Elab.PreDefinition.Structural.Basic

namespace Lean.Elab.Structural
open Meta

private def throwToBelowFailed : MetaM α :=
  throwError "toBelow failed"

/-- See `toBelow` -/
private partial def toBelowAux (C : Expr) (belowDict : Expr) (arg : Expr) (F : Expr) : MetaM Expr := do
  let belowDict ← whnf belowDict
  trace[Elab.definition.structural] "belowDict: {belowDict}, arg: {arg}"
  match belowDict with
  | .app (.app (.const `PProd _) d1) d2 =>
    (do toBelowAux C d1 arg (← mkAppM `PProd.fst #[F]))
    <|>
    (do toBelowAux C d2 arg (← mkAppM `PProd.snd #[F]))
  | .app (.app (.const `And _) d1) d2 =>
    (do toBelowAux C d1 arg (← mkAppM `And.left #[F]))
    <|>
    (do toBelowAux C d2 arg (← mkAppM `And.right #[F]))
  | _ => forallTelescopeReducing belowDict fun xs belowDict => do
    let arg ← zetaReduce arg
    let argArgs := arg.getAppArgs
    unless argArgs.size >= xs.size do throwToBelowFailed
    let n := argArgs.size
    let argTailArgs := argArgs.extract (n - xs.size) n
    let belowDict := belowDict.replaceFVars xs argTailArgs
    match belowDict with
    | .app belowDictFun belowDictArg =>
      unless belowDictFun.getAppFn == C do throwToBelowFailed
      unless ← isDefEq belowDictArg arg do throwToBelowFailed
      pure (mkAppN F argTailArgs)
    | _ => throwToBelowFailed

/-- See `toBelow` -/
private def withBelowDict (below : Expr) (numIndParams : Nat) (k : Expr → Expr → MetaM α) : MetaM α := do
  let belowType ← inferType below
  trace[Elab.definition.structural] "belowType: {belowType}"
  belowType.withApp fun f args => do
    let motivePos := numIndParams + 1
    unless motivePos < args.size do throwError "unexpected 'below' type{indentExpr belowType}"
    let pre := mkAppN f (args.extract 0 numIndParams)
    let preType ← inferType pre
    forallBoundedTelescope preType (some 1) fun x _ => do
      let motiveType ← inferType x[0]!
      withLocalDeclD (← mkFreshUserName `C) motiveType fun C =>
        let belowDict := mkApp pre C
        let belowDict := mkAppN belowDict (args.extract (numIndParams + 1) args.size)
        k C belowDict

/--
  `below` is a free variable with type of the form `I.below indParams motive indices major`,
  where `I` is the name of an inductive datatype.

  For example, when trying to show that the following function terminates using structural recursion
  ```lean
  def addAdjacent : List Nat → List Nat
  | []       => []
  | [a]      => [a]
  | a::b::as => (a+b) :: addAdjacent as
  ```
  when we are visiting `addAdjacent as` at `replaceRecApps`, `below` has type
  `@List.below Nat (fun (x : List Nat) => List Nat) (a::b::as)`
  The motive `fun (x : List Nat) => List Nat` depends on the actual function we are trying to compute.
  So, we first replace it with a fresh variable `C` at `withBelowDict`.
  Recall that `brecOn` implements course-of-values recursion, and `below` can be viewed as a dictionary
  of the "previous values".
  We search this dictionary using the auxiliary function `toBelowAux`.
  The dictionary is built using the `PProd` (`And` for inductive predicates).
  We keep searching it until we find `C recArg`, where `C` is the auxiliary fresh variable created at `withBelowDict`.  -/
private partial def toBelow (below : Expr) (numIndParams : Nat) (recArg : Expr) : MetaM Expr := do
  withBelowDict below numIndParams fun C belowDict =>
    toBelowAux C belowDict recArg below

/--
  This method is used after `matcherApp.addArg arg` to check whether the new type of `arg` has been "refined/modified"
  in at least one alternative.
-/
def refinedArgType (matcherApp : MatcherApp) (arg : Expr) : MetaM Bool := do
  let argType ← inferType arg
  (Array.zip matcherApp.alts matcherApp.altNumParams).anyM fun (alt, numParams) =>
    lambdaTelescope alt fun xs _ => do
      if xs.size >= numParams then
        let refinedArg := xs[numParams - 1]!
        return !(← isDefEq (← inferType refinedArg) argType)
      else
        return false

private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
  let containsRecFn (e : Expr) : StateRefT (HasConstCache recFnName) M Bool :=
    modifyGet (·.contains e)
  let rec loop (below : Expr) (e : Expr) : StateRefT (HasConstCache recFnName) M Expr := do
    if !(← containsRecFn e) then
      return e
    match e with
    | Expr.lam n d b c =>
      withLocalDecl n c (← loop below d) fun x => do
        mkLambdaFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.forallE n d b c =>
      withLocalDecl n c (← loop below d) fun x => do
        mkForallFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.letE n type val body _ =>
      withLetDecl n (← loop below type) (← loop below val) fun x => do
        mkLetFVars #[x] (← loop below (body.instantiate1 x)) (usedLetOnly := false)
    | Expr.mdata d b     =>
      if let some _ := getRecAppSyntax? e then
        loop below b
      else
        return mkMData d (← loop below b)
    | Expr.proj n i e    => return mkProj n i (← loop below e)
    | Expr.app _ _ =>
      let processApp (e : Expr) : StateRefT (HasConstCache recFnName) M Expr :=
        e.withApp fun f args => do
          if f.isConstOf recFnName then
            let numFixed  := recArgInfo.fixedParams.size
            let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
            if recArgPos >= args.size then
              throwError "insufficient number of parameters at recursive application {indentExpr e}"
            let recArg := args[recArgPos]!
            -- For reflexive type, we may have nested recursive applications in recArg
            let recArg ← loop below recArg
            let f ← try toBelow below recArgInfo.indParams.size recArg catch  _ => throwError "failed to eliminate recursive application{indentExpr e}"
            -- Recall that the fixed parameters are not in the scope of the `brecOn`. So, we skip them.
            let argsNonFixed := args.extract numFixed args.size
            -- The function `f` does not explicitly take `recArg` and its indices as arguments. So, we skip them too.
            let mut fArgs := #[]
            for i in [:argsNonFixed.size] do
              if recArgInfo.pos != i && !recArgInfo.indicesPos.contains i then
                let arg := argsNonFixed[i]!
                let arg ← replaceRecApps recFnName recArgInfo below arg
                fArgs := fArgs.push arg
            return mkAppN f fArgs
          else
            return mkAppN (← loop below f) (← args.mapM (loop below))
      match (← matchMatcherApp? e) with
      | some matcherApp =>
        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
          processApp e
        else
          /- Here is an example we currently do not handle
             ```
             def g (xs : List Nat) : Nat :=
             match xs with
             | [] => 0
             | y::ys =>
               match ys with
               | []       => 1
               | _::_::zs => g zs + 1
               | zs       => g ys + 2
             ```
             We are matching on `ys`, but still using `ys` in the third alternative.
             If we push the `below` argument over the dependent match it will be able to eliminate recursive call using `zs`.
             To make it work, users have to write the third alternative as `| zs => g zs + 2`
             If this is too annoying in practice, we may replace `ys` with the matching term, but
             this may generate weird error messages, when it doesn't work. -/
          trace[Elab.definition.structural] "below before matcherApp.addArg: {below} : {← inferType below}"
          let matcherApp ← mapError (matcherApp.addArg below) (fun msg => "failed to add `below` argument to 'matcher' application" ++ indentD msg)
          if !(← refinedArgType matcherApp below) then
            processApp e
          else
            let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
              lambdaTelescope alt fun xs altBody => do
                trace[Elab.definition.structural] "altNumParams: {numParams}, xs: {xs}"
                unless xs.size >= numParams do
                  throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
                let belowForAlt := xs[numParams - 1]!
                mkLambdaFVars xs (← loop belowForAlt altBody)
            pure { matcherApp with alts := altsNew }.toExpr
      | none =>
      match (← toCasesOnApp? e) with
      | some casesOnApp =>
        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
          processApp e
        else if let some casesOnApp ← casesOnApp.addArg? below (checkIfRefined := true) then
          let altsNew ← (Array.zip casesOnApp.alts casesOnApp.altNumParams).mapM fun (alt, numParams) =>
            lambdaTelescope alt fun xs altBody => do
              unless xs.size >= numParams do
                throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
              let belowForAlt := xs[numParams]!
              mkLambdaFVars xs (← loop belowForAlt altBody)
          return { casesOnApp with alts := altsNew }.toExpr
        else
          processApp e
      | none => processApp e
    | e => ensureNoRecFn recFnName e
  loop below e |>.run' {}

def mkBRecOn (recFnName : Name) (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
  trace[Elab.definition.structural] "mkBRecOn: {value}"
  let type  := (← inferType value).headBeta
  let major := recArgInfo.ys[recArgInfo.pos]!
  let otherArgs := recArgInfo.ys.filter fun y => y != major && !recArgInfo.indIndices.contains y
  trace[Elab.definition.structural] "fixedParams: {recArgInfo.fixedParams}, otherArgs: {otherArgs}"
  let motive ← mkForallFVars otherArgs type
  let mut brecOnUniv ← getLevel motive
  trace[Elab.definition.structural] "brecOn univ: {brecOnUniv}"
  let useBInductionOn := recArgInfo.reflexive && brecOnUniv == levelZero
  if recArgInfo.reflexive && brecOnUniv != levelZero then
    brecOnUniv ← decLevel brecOnUniv
  let motive ← mkLambdaFVars (recArgInfo.indIndices.push major) motive
  trace[Elab.definition.structural] "brecOn motive: {motive}"
  let brecOn :=
    if useBInductionOn then
      Lean.mkConst (mkBInductionOnName recArgInfo.indName) recArgInfo.indLevels
    else
      Lean.mkConst (mkBRecOnName recArgInfo.indName) (brecOnUniv :: recArgInfo.indLevels)
  let brecOn := mkAppN brecOn recArgInfo.indParams
  let brecOn := mkApp brecOn motive
  let brecOn := mkAppN brecOn recArgInfo.indIndices
  let brecOn := mkApp brecOn major
  check brecOn
  let brecOnType ← inferType brecOn
  trace[Elab.definition.structural] "brecOn     {brecOn}"
  trace[Elab.definition.structural] "brecOnType {brecOnType}"
  forallBoundedTelescope brecOnType (some 1) fun F _ => do
    let F := F[0]!
    let FType ← inferType F
    trace[Elab.definition.structural] "FType: {FType}"
    let FType ← instantiateForall FType recArgInfo.indIndices
    let FType ← instantiateForall FType #[major]
    forallBoundedTelescope FType (some 1) fun below _ => do
      -- TODO: `below` user name is `f`, and it will make a global `f` to be pretty printed as `_root_.f` in error messages.
      -- We should add an option to `forallBoundedTelescope` to ensure fresh names are used.
      let below := below[0]!
      let valueNew     ← replaceRecApps recFnName recArgInfo below value
      let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
      let brecOn       := mkApp brecOn Farg
      return mkAppN brecOn otherArgs

end Lean.Elab.Structural


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.normed_space.basic
import Mathlib.PostPort

universes u_1 u_2 l

namespace Mathlib

/-!
# Extended norm

In this file we define a structure `enorm 𝕜 V` representing an extended norm (i.e., a norm that can
take the value `∞`) on a vector space `V` over a normed field `𝕜`. We do not use `class` for
an `enorm` because the same space can have more than one extended norm. For example, the space of
measurable functions `f : α → ℝ` has a family of `L_p` extended norms.

We prove some basic inequalities, then define

* `emetric_space` structure on `V` corresponding to `e : enorm 𝕜 V`;
* the subspace of vectors with finite norm, called `e.finite_subspace`;
* a `normed_space` structure on this space.

The last definition is an instance because the type involves `e`.

## Implementation notes

We do not define extended normed groups. They can be added to the chain once someone will need them.

## Tags

normed space, extended norm
-/

/-- Extended norm on a vector space. As in the case of normed spaces, we require only
`∥c • x∥ ≤ ∥c∥ * ∥x∥` in the definition, then prove an equality in `map_smul`. -/
structure enorm (𝕜 : Type u_1) (V : Type u_2) [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V]
where
  to_fun : V → ennreal
  eq_zero' : ∀ (x : V), to_fun x = 0 → x = 0
  map_add_le' : ∀ (x y : V), to_fun (x + y) ≤ to_fun x + to_fun y
  map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ ↑(nnnorm c) * to_fun x

namespace enorm

protected instance has_coe_to_fun {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : has_coe_to_fun (enorm 𝕜 V) :=
  has_coe_to_fun.mk (fun (x : enorm 𝕜 V) => V → ennreal) to_fun

theorem injective_coe_fn {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : function.injective fun (e : enorm 𝕜 V) (x : V) => coe_fn e x := sorry

theorem ext {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] {e₁ : enorm 𝕜 V} {e₂ : enorm 𝕜 V} (h : ∀ (x : V), coe_fn e₁ x = coe_fn e₂ x) : e₁ = e₂ :=
  injective_coe_fn (funext h)

theorem ext_iff {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] {e₁ : enorm 𝕜 V} {e₂ : enorm 𝕜 V} : e₁ = e₂ ↔ ∀ (x : V), coe_fn e₁ x = coe_fn e₂ x :=
  { mp := fun (h : e₁ = e₂) (x : V) => h ▸ rfl, mpr := ext }

@[simp] theorem coe_inj {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] {e₁ : enorm 𝕜 V} {e₂ : enorm 𝕜 V} : ⇑e₁ = ⇑e₂ ↔ e₁ = e₂ :=
  function.injective.eq_iff injective_coe_fn

@[simp] theorem map_smul {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (c : 𝕜) (x : V) : coe_fn e (c • x) = ↑(nnnorm c) * coe_fn e x := sorry

@[simp] theorem map_zero {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : coe_fn e 0 = 0 := sorry

@[simp] theorem eq_zero_iff {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) {x : V} : coe_fn e x = 0 ↔ x = 0 :=
  { mp := eq_zero' e x, mpr := fun (h : x = 0) => Eq.symm h ▸ map_zero e }

@[simp] theorem map_neg {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : V) : coe_fn e (-x) = coe_fn e x := sorry

theorem map_sub_rev {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : V) (y : V) : coe_fn e (x - y) = coe_fn e (y - x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn e (x - y) = coe_fn e (y - x))) (Eq.symm (neg_sub y x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn e (-(y - x)) = coe_fn e (y - x))) (map_neg e (y - x))))
      (Eq.refl (coe_fn e (y - x))))

theorem map_add_le {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : V) (y : V) : coe_fn e (x + y) ≤ coe_fn e x + coe_fn e y :=
  map_add_le' e x y

theorem map_sub_le {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : V) (y : V) : coe_fn e (x - y) ≤ coe_fn e x + coe_fn e y := sorry

protected instance partial_order {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : partial_order (enorm 𝕜 V) :=
  partial_order.mk (fun (e₁ e₂ : enorm 𝕜 V) => ∀ (x : V), coe_fn e₁ x ≤ coe_fn e₂ x)
    (preorder.lt._default fun (e₁ e₂ : enorm 𝕜 V) => ∀ (x : V), coe_fn e₁ x ≤ coe_fn e₂ x) sorry sorry sorry

/-- The `enorm` sending each non-zero vector to infinity. -/
protected instance has_top {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : has_top (enorm 𝕜 V) :=
  has_top.mk (mk (fun (x : V) => ite (x = 0) 0 ⊤) sorry sorry sorry)

protected instance inhabited {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : Inhabited (enorm 𝕜 V) :=
  { default := ⊤ }

theorem top_map {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] {x : V} (hx : x ≠ 0) : coe_fn ⊤ x = ⊤ :=
  if_neg hx

protected instance semilattice_sup_top {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] : semilattice_sup_top (enorm 𝕜 V) :=
  semilattice_sup_top.mk ⊤ LessEq Less sorry sorry sorry sorry
    (fun (e₁ e₂ : enorm 𝕜 V) => mk (fun (x : V) => max (coe_fn e₁ x) (coe_fn e₂ x)) sorry sorry sorry) sorry sorry sorry

@[simp] theorem coe_max {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e₁ : enorm 𝕜 V) (e₂ : enorm 𝕜 V) : ⇑(e₁ ⊔ e₂) = fun (x : V) => max (coe_fn e₁ x) (coe_fn e₂ x) :=
  rfl

theorem max_map {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e₁ : enorm 𝕜 V) (e₂ : enorm 𝕜 V) (x : V) : coe_fn (e₁ ⊔ e₂) x = max (coe_fn e₁ x) (coe_fn e₂ x) :=
  rfl

/-- Structure of an `emetric_space` defined by an extended norm. -/
def emetric_space {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : emetric_space V :=
  emetric_space.mk sorry sorry (map_sub_rev e) sorry
    (uniform_space_of_edist (fun (x y : V) => coe_fn e (x - y)) sorry (map_sub_rev e) sorry)

/-- The subspace of vectors with finite enorm. -/
def finite_subspace {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : subspace 𝕜 V :=
  submodule.mk (set_of fun (x : V) => coe_fn e x < ⊤) sorry sorry sorry

/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space_of_dist`
to ensure that this definition agrees with `e.emetric_space`. -/
protected instance finite_subspace.metric_space {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : metric_space ↥(finite_subspace e) :=
  let _inst : emetric_space V := emetric_space e;
  emetric_space.to_metric_space_of_dist (fun (x y : ↥(finite_subspace e)) => ennreal.to_real (edist x y)) sorry sorry

theorem finite_dist_eq {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : ↥(finite_subspace e)) (y : ↥(finite_subspace e)) : dist x y = ennreal.to_real (coe_fn e (↑x - ↑y)) :=
  rfl

theorem finite_edist_eq {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : ↥(finite_subspace e)) (y : ↥(finite_subspace e)) : edist x y = coe_fn e (↑x - ↑y) :=
  rfl

/-- Normed group instance on `e.finite_subspace`. -/
protected instance finite_subspace.normed_group {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : normed_group ↥(finite_subspace e) :=
  normed_group.mk sorry

theorem finite_norm_eq {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) (x : ↥(finite_subspace e)) : norm x = ennreal.to_real (coe_fn e ↑x) :=
  rfl

/-- Normed space instance on `e.finite_subspace`. -/
protected instance finite_subspace.normed_space {𝕜 : Type u_1} {V : Type u_2} [normed_field 𝕜] [add_comm_group V] [vector_space 𝕜 V] (e : enorm 𝕜 V) : normed_space 𝕜 ↥(finite_subspace e) :=
  normed_space.mk sorry


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.limits.filtered_colimit_commutes_finite_limit
import category_theory.limits.preserves.functor_category
import category_theory.limits.bicones
import category_theory.limits.comma
import category_theory.limits.preserves.finite
import category_theory.limits.shapes.finite_limits

/-!
# Representably flat functors

We define representably flat functors as functors such that the category of structured arrows
over `X` is cofiltered for each `X`. This concept is also known as flat functors as in [Elephant]
Remark C2.3.7, and this name is suggested by Mike Shulman in
https://golem.ph.utexas.edu/category/2011/06/flat_functors_and_morphisms_of.html to avoid
confusion with other notions of flatness.

This definition is equivalent to left exact functors (functors that preserves finite limits) when
`C` has all finite limits.

## Main results

* `flat_of_preserves_finite_limits`: If `F : C ⥤ D` preserves finite limits and `C` has all finite
  limits, then `F` is flat.
* `preserves_finite_limits_of_flat`: If `F : C ⥤ D` is flat, then it preserves all finite limits.
* `preserves_finite_limits_iff_flat`: If `C` has all finite limits,
  then `F` is flat iff `F` is left_exact.
* `Lan_preserves_finite_limits_of_flat`: If `F : C ⥤ D` is a flat functor between small categories,
  then the functor `Lan F.op` between presheaves of sets preserves all finite limits.
* `flat_iff_Lan_flat`: If `C`, `D` are small and `C` has all finite limits, then `F` is flat iff
  `Lan F.op : (Cᵒᵖ ⥤ Type*) ⥤ (Dᵒᵖ ⥤ Type*)` is flat.
* `preserves_finite_limits_iff_Lan_preserves_finite_limits`: If `C`, `D` are small and `C` has all
  finite limits, then `F` preserves finite limits iff `Lan F.op : (Cᵒᵖ ⥤ Type*) ⥤ (Dᵒᵖ ⥤ Type*)`
  does.

-/

universes w v₁ v₂ v₃ u₁ u₂ u₃

open category_theory
open category_theory.limits
open opposite

namespace category_theory

namespace structured_arrow_cone
open structured_arrow
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₁} D]
variables {J : Type w} [small_category J]
variables {K : J ⥤ C} (F : C ⥤ D) (c : cone K)

/--
Given a cone `c : cone K` and a map `f : X ⟶ c.X`, we can construct a cone of structured
arrows over `X` with `f` as the cone point. This is the underlying diagram.
-/
@[simps]
def to_diagram : J ⥤ structured_arrow c.X K :=
{ obj := λ j, structured_arrow.mk (c.π.app j),
  map := λ j k g, structured_arrow.hom_mk g (by simpa) }

/-- Given a diagram of `structured_arrow X F`s, we may obtain a cone with cone point `X`. -/
@[simps]
def diagram_to_cone {X : D} (G : J ⥤ structured_arrow X F) : cone (G ⋙ proj X F ⋙ F) :=
{ X := X, π := { app := λ j, (G.obj j).hom } }

/--
Given a cone `c : cone K` and a map `f : X ⟶ F.obj c.X`, we can construct a cone of structured
arrows over `X` with `f` as the cone point.
-/
@[simps]
def to_cone {X : D} (f : X ⟶ F.obj c.X) :
  cone (to_diagram (F.map_cone c) ⋙ map f ⋙ pre _ K F) :=
{ X := mk f, π := { app := λ j, hom_mk (c.π.app j) rfl,
                    naturality' := λ j k g, by { ext, dsimp, simp } } }

end structured_arrow_cone

section representably_flat
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]
variables {E : Type u₃} [category.{v₃} E]

/--
A functor `F : C ⥤ D` is representably-flat functor if the comma category `(X/F)`
is cofiltered for each `X : C`.
-/
class representably_flat (F : C ⥤ D) : Prop :=
(cofiltered : ∀ (X : D), is_cofiltered (structured_arrow X F))

attribute [instance] representably_flat.cofiltered

local attribute [instance] is_cofiltered.nonempty

instance representably_flat.id : representably_flat (𝟭 C) :=
begin
  constructor,
  intro X,
  haveI : nonempty (structured_arrow X (𝟭 C)) := ⟨structured_arrow.mk (𝟙 _)⟩,
  rsufficesI : is_cofiltered_or_empty (structured_arrow X (𝟭 C)),
  { constructor },
  constructor,
  { intros Y Z,
    use structured_arrow.mk (𝟙 _),
    use structured_arrow.hom_mk Y.hom (by erw [functor.id_map, category.id_comp]),
    use structured_arrow.hom_mk Z.hom (by erw [functor.id_map, category.id_comp]) },
  { intros Y Z f g,
    use structured_arrow.mk (𝟙 _),
    use structured_arrow.hom_mk Y.hom (by erw [functor.id_map, category.id_comp]),
    ext,
    transitivity Z.hom; simp }
end

instance representably_flat.comp (F : C ⥤ D) (G : D ⥤ E)
  [representably_flat F] [representably_flat G] : representably_flat (F ⋙ G) :=
begin
  constructor,
  intro X,
  haveI : nonempty (structured_arrow X (F ⋙ G)),
  { have f₁ : structured_arrow X G := nonempty.some infer_instance,
    have f₂ : structured_arrow f₁.right F := nonempty.some infer_instance,
    exact ⟨structured_arrow.mk (f₁.hom ≫ G.map f₂.hom)⟩ },
  rsufficesI : is_cofiltered_or_empty (structured_arrow X (F ⋙ G)),
  { constructor },
  constructor,
  { intros Y Z,
    let W := @is_cofiltered.min (structured_arrow X G) _ _
      (structured_arrow.mk Y.hom) (structured_arrow.mk Z.hom),
    let Y' : W ⟶ _ := is_cofiltered.min_to_left _ _,
    let Z' : W ⟶ _ := is_cofiltered.min_to_right _ _,

    let W' := @is_cofiltered.min (structured_arrow W.right F) _ _
      (structured_arrow.mk Y'.right) (structured_arrow.mk Z'.right),
    let Y'' : W' ⟶ _ := is_cofiltered.min_to_left _ _,
    let Z'' : W' ⟶ _ := is_cofiltered.min_to_right _ _,

    use structured_arrow.mk (W.hom ≫ G.map W'.hom),
    use structured_arrow.hom_mk Y''.right (by simp [← G.map_comp]),
    use structured_arrow.hom_mk Z''.right (by simp [← G.map_comp]) },
  { intros Y Z f g,
    let W := @is_cofiltered.eq (structured_arrow X G) _ _
        (structured_arrow.mk Y.hom) (structured_arrow.mk Z.hom)
        (structured_arrow.hom_mk (F.map f.right) (structured_arrow.w f))
        (structured_arrow.hom_mk (F.map g.right) (structured_arrow.w g)),
    let h : W ⟶ _ := is_cofiltered.eq_hom _ _,
    let h_cond : h ≫ _ = h ≫ _ := is_cofiltered.eq_condition _ _,

    let W' := @is_cofiltered.eq (structured_arrow W.right F) _ _
        (structured_arrow.mk h.right) (structured_arrow.mk (h.right ≫ F.map f.right))
        (structured_arrow.hom_mk f.right rfl)
        (structured_arrow.hom_mk g.right (congr_arg comma_morphism.right h_cond).symm),
    let h' : W' ⟶ _ := is_cofiltered.eq_hom _ _,
    let h'_cond : h' ≫ _ = h' ≫ _ := is_cofiltered.eq_condition _ _,

    use structured_arrow.mk (W.hom ≫ G.map W'.hom),
    use structured_arrow.hom_mk h'.right (by simp [← G.map_comp]),
    ext,
    exact (congr_arg comma_morphism.right h'_cond : _) }
end

end representably_flat

section has_limit
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₁} D]

local attribute [instance] has_finite_limits_of_has_finite_limits_of_size

lemma cofiltered_of_has_finite_limits [has_finite_limits C] : is_cofiltered C :=
{ cone_objs := λ A B, ⟨limits.prod A B, limits.prod.fst, limits.prod.snd, trivial⟩,
  cone_maps :=  λ A B f g, ⟨equalizer f g, equalizer.ι f g, equalizer.condition f g⟩,
  nonempty := ⟨⊤_ C⟩ }

lemma flat_of_preserves_finite_limits [has_finite_limits C] (F : C ⥤ D)
  [preserves_finite_limits F] : representably_flat F := ⟨λ X,
begin
  haveI : has_finite_limits (structured_arrow X F) :=
  begin
    apply has_finite_limits_of_has_finite_limits_of_size.{v₁} (structured_arrow X F),
    intros J sJ fJ, resetI, constructor
  end,
  exact cofiltered_of_has_finite_limits
end⟩

namespace preserves_finite_limits_of_flat
open structured_arrow
open structured_arrow_cone
variables {J : Type v₁} [small_category J] [fin_category J] {K : J ⥤ C}
variables (F : C ⥤ D) [representably_flat F] {c : cone K} (hc : is_limit c) (s : cone (K ⋙ F))
include hc

/--
(Implementation).
Given a limit cone `c : cone K` and a cone `s : cone (K ⋙ F)` with `F` representably flat,
`s` can factor through `F.map_cone c`.
-/
noncomputable def lift : s.X ⟶ F.obj c.X :=
let s' := is_cofiltered.cone (to_diagram s ⋙ structured_arrow.pre _ K F) in
s'.X.hom ≫ (F.map $ hc.lift $
  (cones.postcompose ({ app := λ X, 𝟙 _, naturality' := by simp }
      : (to_diagram s ⋙ pre s.X K F) ⋙ proj s.X F ⟶ K)).obj $
  (structured_arrow.proj s.X F).map_cone s')

lemma fac (x : J) : lift F hc s ≫ (F.map_cone c).π.app x = s.π.app x :=
by simpa [lift, ←functor.map_comp]

local attribute [simp] eq_to_hom_map

lemma uniq {K : J ⥤ C} {c : cone K} (hc : is_limit c)
  (s : cone (K ⋙ F)) (f₁ f₂ : s.X ⟶ F.obj c.X)
  (h₁ : ∀ (j : J), f₁ ≫ (F.map_cone c).π.app j = s.π.app j)
  (h₂ : ∀ (j : J), f₂ ≫ (F.map_cone c).π.app j = s.π.app j) : f₁ = f₂ :=
begin
  -- We can make two cones over the diagram of `s` via `f₁` and `f₂`.
  let α₁ : to_diagram (F.map_cone c) ⋙ map f₁ ⟶ to_diagram s :=
  { app := λ X, eq_to_hom (by simp [←h₁]), naturality' := λ _ _ _, by { ext, simp } },
  let α₂ : to_diagram (F.map_cone c) ⋙ map f₂ ⟶ to_diagram s :=
  { app := λ X, eq_to_hom (by simp [←h₂]), naturality' := λ _ _ _, by { ext, simp } },
  let c₁ : cone (to_diagram s ⋙ pre s.X K F) :=
    (cones.postcompose (whisker_right α₁ (pre s.X K F) : _)).obj (to_cone F c f₁),
  let c₂ : cone (to_diagram s ⋙ pre s.X K F) :=
    (cones.postcompose (whisker_right α₂ (pre s.X K F) : _)).obj (to_cone F c f₂),

  -- The two cones can then be combined and we may obtain a cone over the two cones since
  -- `structured_arrow s.X F` is cofiltered.
  let c₀ := is_cofiltered.cone (bicone_mk _ c₁ c₂),
  let g₁ : c₀.X ⟶ c₁.X := c₀.π.app (bicone.left),
  let g₂ : c₀.X ⟶ c₂.X := c₀.π.app (bicone.right),

  -- Then `g₁.right` and `g₂.right` are two maps from the same cone into the `c`.
  have : ∀ (j : J), g₁.right ≫ c.π.app j = g₂.right ≫ c.π.app j,
  { intro j,
    injection c₀.π.naturality (bicone_hom.left  j) with _ e₁,
    injection c₀.π.naturality (bicone_hom.right j) with _ e₂,
    simpa using e₁.symm.trans e₂ },
  have : c.extend g₁.right = c.extend g₂.right,
  { unfold cone.extend, congr' 1, ext x, apply this },

  -- And thus they are equal as `c` is the limit.
  have : g₁.right = g₂.right,
  calc g₁.right = hc.lift (c.extend g₁.right) : by { apply hc.uniq (c.extend _), tidy }
            ... = hc.lift (c.extend g₂.right) : by { congr, exact this }
            ... = g₂.right                    : by { symmetry, apply hc.uniq (c.extend _), tidy },

  -- Finally, since `fᵢ` factors through `F(gᵢ)`, the result follows.
  calc f₁ = 𝟙 _ ≫ f₁                  : by simp
      ... = c₀.X.hom ≫ F.map g₁.right : g₁.w
      ... = c₀.X.hom ≫ F.map g₂.right : by rw this
      ... = 𝟙 _ ≫ f₂                  : g₂.w.symm
      ... = f₂                         : by simp
end

end preserves_finite_limits_of_flat

/-- Representably flat functors preserve finite limits. -/
noncomputable
def preserves_finite_limits_of_flat (F : C ⥤ D) [representably_flat F] :
  preserves_finite_limits F :=
begin
  apply preserves_finite_limits_of_preserves_finite_limits_of_size,
  intros J _ _, constructor,
  intros K, constructor,
  intros c hc,
  exactI { lift := preserves_finite_limits_of_flat.lift F hc,
    fac' := preserves_finite_limits_of_flat.fac F hc,
    uniq' := λ s m h, by
    { apply preserves_finite_limits_of_flat.uniq F hc,
      exact h,
      exact preserves_finite_limits_of_flat.fac F hc s } }
end

/--
If `C` is finitely cocomplete, then `F : C ⥤ D` is representably flat iff it preserves
finite limits.
-/
noncomputable
def preserves_finite_limits_iff_flat [has_finite_limits C] (F : C ⥤ D) :
  representably_flat F ≃ preserves_finite_limits F :=
{ to_fun := λ _, by exactI preserves_finite_limits_of_flat F,
  inv_fun := λ _, by exactI flat_of_preserves_finite_limits F,
  left_inv := λ _, proof_irrel _ _,
  right_inv := λ x, by { cases x, unfold preserves_finite_limits_of_flat,
    dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr } }

end has_limit

section small_category
variables {C D : Type u₁} [small_category C] [small_category D] (E : Type u₂) [category.{u₁} E]

/--
(Implementation)
The evaluation of `Lan F` at `X` is the colimit over the costructured arrows over `X`.
-/
noncomputable
def Lan_evaluation_iso_colim (F : C ⥤ D) (X : D)
  [∀ (X : D), has_colimits_of_shape (costructured_arrow F X) E] :
  Lan F ⋙ (evaluation D E).obj X ≅
  ((whiskering_left _ _ E).obj (costructured_arrow.proj F X)) ⋙ colim :=
nat_iso.of_components (λ G, colim.map_iso (iso.refl _))
begin
  intros G H i,
  ext,
  simp only [functor.comp_map, colimit.ι_desc_assoc, functor.map_iso_refl, evaluation_obj_map,
    whiskering_left_obj_map, category.comp_id, Lan_map_app, category.assoc],
  erw [colimit.ι_pre_assoc (Lan.diagram F H X) (costructured_arrow.map j.hom),
    category.id_comp, category.comp_id, colimit.ι_map],
  rcases j with ⟨j_left, ⟨⟨⟩⟩, j_hom⟩,
  congr,
  rw [costructured_arrow.map_mk, category.id_comp, costructured_arrow.mk]
end

variables [concrete_category.{u₁} E] [has_limits E] [has_colimits E]
variables [reflects_limits (forget E)] [preserves_filtered_colimits (forget E)]
variables [preserves_limits (forget E)]

/--
If `F : C ⥤ D` is a representably flat functor between small categories, then the functor
`Lan F.op` that takes presheaves over `C` to presheaves over `D` preserves finite limits.
-/
noncomputable
instance Lan_preserves_finite_limits_of_flat (F : C ⥤ D) [representably_flat F] :
  preserves_finite_limits (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ E)) :=
begin
  apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁},
  intros J _ _, resetI,
  apply preserves_limits_of_shape_of_evaluation (Lan F.op : (Cᵒᵖ ⥤ E) ⥤ (Dᵒᵖ ⥤ E)) J,
  intro K,
  haveI : is_filtered (costructured_arrow F.op K) :=
    is_filtered.of_equivalence (structured_arrow_op_equivalence F (unop K)),
  exact preserves_limits_of_shape_of_nat_iso (Lan_evaluation_iso_colim _ _ _).symm,
end

instance Lan_flat_of_flat (F : C ⥤ D) [representably_flat F] :
  representably_flat (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ E)) := flat_of_preserves_finite_limits _

variable [has_finite_limits C]

noncomputable
instance Lan_preserves_finite_limits_of_preserves_finite_limits (F : C ⥤ D)
  [preserves_finite_limits F] : preserves_finite_limits (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ E)) :=
begin
  haveI := flat_of_preserves_finite_limits F,
  apply_instance
end

lemma flat_iff_Lan_flat (F : C ⥤ D) :
  representably_flat F ↔ representably_flat (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u₁)) :=
⟨λ H, by exactI infer_instance, λ H,
begin
  resetI,
  haveI := preserves_finite_limits_of_flat (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u₁)),
  haveI : preserves_finite_limits F :=
    begin
      apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁},
      intros, resetI, apply preserves_limit_of_Lan_presesrves_limit
    end,
  apply flat_of_preserves_finite_limits
end⟩

/--
If `C` is finitely complete, then `F : C ⥤ D` preserves finite limits iff
`Lan F.op : (Cᵒᵖ ⥤ Type*) ⥤ (Dᵒᵖ ⥤ Type*)` preserves finite limits.
-/
noncomputable
def preserves_finite_limits_iff_Lan_preserves_finite_limits (F : C ⥤ D) :
  preserves_finite_limits F ≃ preserves_finite_limits (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u₁)) :=
{ to_fun := λ _, by exactI infer_instance,
  inv_fun := λ _,
  begin
    apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁},
    intros, resetI, apply preserves_limit_of_Lan_presesrves_limit
  end,
  left_inv := λ x,
  begin
    cases x, unfold preserves_finite_limits_of_flat,
    dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr
  end,
  right_inv := λ x,
  begin
    cases x,
    unfold preserves_finite_limits_of_flat,
    congr,
    unfold category_theory.Lan_preserves_finite_limits_of_preserves_finite_limits
      category_theory.Lan_preserves_finite_limits_of_flat,
    dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr
  end }

end small_category
end category_theory


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.midpoint
import Mathlib.topology.metric_space.isometry
import Mathlib.topology.instances.real_vector_space
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# Torsors of additive normed group actions.

This file defines torsors of additive normed group actions, with a
metric space structure.  The motivating case is Euclidean affine
spaces.

-/

/-- A `normed_add_torsor V P` is a torsor of an additive normed group
action by a `normed_group V` on points `P`. We bundle the metric space
structure and require the distance to be the same as results from the
norm (which in fact implies the distance yields a metric space, but
bundling just the distance and using an instance for the metric space
results in type class problems). -/
class normed_add_torsor (V : outParam (Type u_1)) (P : Type u_2) [outParam (normed_group V)]
    [metric_space P]
    extends add_torsor V P where
  dist_eq_norm' : ∀ (x y : P), dist x y = norm (x -ᵥ y)

/-- The distance equals the norm of subtracting two points. In this
lemma, it is necessary to have `V` as an explicit argument; otherwise
`rw dist_eq_norm_vsub` sometimes doesn't work. -/
theorem dist_eq_norm_vsub (V : Type u_2) {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (x : P) (y : P) : dist x y = norm (x -ᵥ y) :=
  normed_add_torsor.dist_eq_norm' x y

/-- A `normed_group` is a `normed_add_torsor` over itself. -/
protected instance normed_group.normed_add_torsor (V : Type u_2) [normed_group V] :
    normed_add_torsor V V :=
  normed_add_torsor.mk dist_eq_norm

@[simp] theorem dist_vadd_cancel_left {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (v : V) (x : P) (y : P) :
    dist (v +ᵥ x) (v +ᵥ y) = dist x y :=
  sorry

@[simp] theorem dist_vadd_cancel_right {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (v₁ : V) (v₂ : V) (x : P) :
    dist (v₁ +ᵥ x) (v₂ +ᵥ x) = dist v₁ v₂ :=
  sorry

@[simp] theorem dist_vadd_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) (x : P) : dist (v +ᵥ x) x = norm v :=
  sorry

@[simp] theorem dist_vadd_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) (x : P) : dist x (v +ᵥ x) = norm v :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist x (v +ᵥ x) = norm v)) (dist_comm x (v +ᵥ x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (dist (v +ᵥ x) x = norm v)) (dist_vadd_left v x)))
      (Eq.refl (norm v)))

@[simp] theorem dist_vsub_cancel_left {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) (y : P) (z : P) :
    dist (x -ᵥ y) (x -ᵥ z) = dist y z :=
  sorry

@[simp] theorem dist_vsub_cancel_right {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) (y : P) (z : P) :
    dist (x -ᵥ z) (y -ᵥ z) = dist x y :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (dist (x -ᵥ z) (y -ᵥ z) = dist x y)) (dist_eq_norm (x -ᵥ z) (y -ᵥ z))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (norm (x -ᵥ z - (y -ᵥ z)) = dist x y))
          (vsub_sub_vsub_cancel_right x y z)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (norm (x -ᵥ y) = dist x y)) (dist_eq_norm_vsub V x y)))
        (Eq.refl (norm (x -ᵥ y)))))

theorem dist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) :
    dist (v +ᵥ p) (v' +ᵥ p') ≤ dist v v' + dist p p' :=
  sorry

theorem dist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) :
    dist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ dist p₁ p₃ + dist p₂ p₄ :=
  sorry

theorem nndist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) :
    nndist (v +ᵥ p) (v' +ᵥ p') ≤ nndist v v' + nndist p p' :=
  sorry

theorem nndist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) :
    nndist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ nndist p₁ p₃ + nndist p₂ p₄ :=
  sorry

theorem edist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) :
    edist (v +ᵥ p) (v' +ᵥ p') ≤ edist v v' + edist p p' :=
  sorry

theorem edist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) :
    edist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ edist p₁ p₃ + edist p₂ p₄ :=
  sorry

/-- The distance defines a metric space structure on the torsor. This
is not an instance because it depends on `V` to define a `metric_space
P`. -/
def metric_space_of_normed_group_of_add_torsor (V : Type u_1) (P : Type u_2) [normed_group V]
    [add_torsor V P] : metric_space P :=
  metric_space.mk sorry sorry sorry sorry
    (fun (x y : P) => ennreal.of_real ((fun (x y : P) => norm (x -ᵥ y)) x y))
    (uniform_space_of_dist (fun (x y : P) => norm (x -ᵥ y)) sorry sorry sorry)

namespace isometric

/-- The map `v ↦ v +ᵥ p` as an isometric equivalence between `V` and `P`. -/
def vadd_const {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : V ≃ᵢ P :=
  mk (equiv.vadd_const p) sorry

@[simp] theorem coe_vadd_const {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : ⇑(vadd_const p) = fun (v : V) => v +ᵥ p :=
  rfl

@[simp] theorem coe_vadd_const_symm {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : ⇑(isometric.symm (vadd_const p)) = fun (p' : P) => p' -ᵥ p :=
  rfl

@[simp] theorem vadd_const_to_equiv {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : to_equiv (vadd_const p) = equiv.vadd_const p :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : P ≃ᵢ V :=
  mk (equiv.const_vsub p) sorry

@[simp] theorem coe_const_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : ⇑(const_vsub p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (p : P) : ⇑(isometric.symm (const_vsub p)) = fun (v : V) => -v +ᵥ p :=
  rfl

/-- The map `p ↦ v +ᵥ p` as an isometric automorphism of `P`. -/
def const_vadd {V : Type u_2} (P : Type u_3) [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) : P ≃ᵢ P :=
  mk (equiv.const_vadd P v) sorry

@[simp] theorem coe_const_vadd {V : Type u_2} (P : Type u_3) [normed_group V] [metric_space P]
    [normed_add_torsor V P] (v : V) : ⇑(const_vadd P v) = has_vadd.vadd v :=
  rfl

@[simp] theorem const_vadd_zero (V : Type u_2) (P : Type u_3) [normed_group V] [metric_space P]
    [normed_add_torsor V P] : const_vadd P 0 = isometric.refl P :=
  to_equiv_inj (equiv.const_vadd_zero V P)

/-- Point reflection in `x` as an `isometric` homeomorphism. -/
def point_reflection {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (x : P) : P ≃ᵢ P :=
  isometric.trans (const_vsub x) (vadd_const x)

theorem point_reflection_apply {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (x : P) (y : P) : coe_fn (point_reflection x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_to_equiv {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) :
    to_equiv (point_reflection x) = equiv.point_reflection x :=
  rfl

@[simp] theorem point_reflection_self {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) : coe_fn (point_reflection x) x = x :=
  equiv.point_reflection_self x

theorem point_reflection_involutive {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (x : P) : function.involutive ⇑(point_reflection x) :=
  equiv.point_reflection_involutive x

@[simp] theorem point_reflection_symm {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) :
    isometric.symm (point_reflection x) = point_reflection x :=
  to_equiv_inj (equiv.point_reflection_symm x)

@[simp] theorem dist_point_reflection_fixed {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] (x : P) (y : P) :
    dist (coe_fn (point_reflection x) y) x = dist y x :=
  sorry

theorem dist_point_reflection_self' {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (x : P) (y : P) :
    dist (coe_fn (point_reflection x) y) y = norm (bit0 (x -ᵥ y)) :=
  sorry

theorem dist_point_reflection_self {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (𝕜 : Type u_1) [normed_field 𝕜] [normed_space 𝕜 V] (x : P) (y : P) :
    dist (coe_fn (point_reflection x) y) y = norm (bit0 1) * dist x y :=
  sorry

theorem point_reflection_fixed_iff {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] (𝕜 : Type u_1) [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)]
    {x : P} {y : P} : coe_fn (point_reflection x) y = y ↔ y = x :=
  affine_equiv.point_reflection_fixed_iff_of_module 𝕜

theorem dist_point_reflection_self_real {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) :
    dist (coe_fn (point_reflection x) y) y = bit0 1 * dist x y :=
  sorry

@[simp] theorem point_reflection_midpoint_left {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) :
    coe_fn (point_reflection (midpoint ℝ x y)) x = y :=
  affine_equiv.point_reflection_midpoint_left x y

@[simp] theorem point_reflection_midpoint_right {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) :
    coe_fn (point_reflection (midpoint ℝ x y)) y = x :=
  affine_equiv.point_reflection_midpoint_right x y

end isometric

theorem lipschitz_with.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [emetric_space α] {f : α → V} {g : α → P} {Kf : nnreal}
    {Kg : nnreal} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
    lipschitz_with (Kf + Kg) (f +ᵥ g) :=
  fun (x y : α) =>
    trans_rel_left LessEq
      (le_trans (edist_vadd_vadd_le (f x) (f y) (g x) (g y)) (add_le_add (hf x y) (hg x y)))
      (Eq.symm (add_mul (↑Kf) (↑Kg) (edist x y)))

theorem lipschitz_with.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [emetric_space α] {f : α → P} {g : α → P} {Kf : nnreal}
    {Kg : nnreal} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
    lipschitz_with (Kf + Kg) (f -ᵥ g) :=
  fun (x y : α) =>
    trans_rel_left LessEq
      (le_trans (edist_vsub_vsub_le (f x) (g x) (f y) (g y)) (add_le_add (hf x y) (hg x y)))
      (Eq.symm (add_mul (↑Kf) (↑Kg) (edist x y)))

theorem uniform_continuous_vadd {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] : uniform_continuous fun (x : V × P) => prod.fst x +ᵥ prod.snd x :=
  lipschitz_with.uniform_continuous
    (lipschitz_with.vadd lipschitz_with.prod_fst lipschitz_with.prod_snd)

theorem uniform_continuous_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] : uniform_continuous fun (x : P × P) => prod.fst x -ᵥ prod.snd x :=
  lipschitz_with.uniform_continuous
    (lipschitz_with.vsub lipschitz_with.prod_fst lipschitz_with.prod_snd)

theorem continuous_vadd {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] : continuous fun (x : V × P) => prod.fst x +ᵥ prod.snd x :=
  uniform_continuous.continuous uniform_continuous_vadd

theorem continuous_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] : continuous fun (x : P × P) => prod.fst x -ᵥ prod.snd x :=
  uniform_continuous.continuous uniform_continuous_vsub

theorem filter.tendsto.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] {l : filter α} {f : α → V} {g : α → P} {v : V} {p : P}
    (hf : filter.tendsto f l (nhds v)) (hg : filter.tendsto g l (nhds p)) :
    filter.tendsto (f +ᵥ g) l (nhds (v +ᵥ p)) :=
  filter.tendsto.comp (continuous.tendsto continuous_vadd (v, p))
    (filter.tendsto.prod_mk_nhds hf hg)

theorem filter.tendsto.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] {l : filter α} {f : α → P} {g : α → P} {x : P} {y : P}
    (hf : filter.tendsto f l (nhds x)) (hg : filter.tendsto g l (nhds y)) :
    filter.tendsto (f -ᵥ g) l (nhds (x -ᵥ y)) :=
  filter.tendsto.comp (continuous.tendsto continuous_vsub (x, y))
    (filter.tendsto.prod_mk_nhds hf hg)

theorem continuous.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P}
    (hf : continuous f) (hg : continuous g) : continuous (f +ᵥ g) :=
  continuous.comp continuous_vadd (continuous.prod_mk hf hg)

theorem continuous.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P}
    (hf : continuous f) (hg : continuous g) : continuous (f -ᵥ g) :=
  continuous.comp continuous_vsub (continuous.prod_mk hf hg)

theorem continuous_at.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P} {x : α}
    (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (f +ᵥ g) x :=
  filter.tendsto.vadd hf hg

theorem continuous_at.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P} {x : α}
    (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (f -ᵥ g) x :=
  filter.tendsto.vsub hf hg

theorem continuous_within_at.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P} {x : α}
    {s : set α} (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
    continuous_within_at (f +ᵥ g) s x :=
  filter.tendsto.vadd hf hg

theorem continuous_within_at.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P} {x : α}
    {s : set α} (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
    continuous_within_at (f -ᵥ g) s x :=
  filter.tendsto.vsub hf hg

/-- The map `g` from `V1` to `V2` corresponding to a map `f` from `P1`
to `P2`, at a base point `p`, is an isometry if `f` is one. -/
theorem isometry.vadd_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V'] [metric_space P']
    [normed_add_torsor V' P'] {f : P → P'} (hf : isometry f) {p : P} {g : V → V'}
    (hg : ∀ (v : V), g v = f (v +ᵥ p) -ᵥ f p) : isometry g :=
  sorry

/-- If `f` is an affine map, then its linear part is continuous iff `f` is continuous. -/
theorem affine_map.continuous_linear_iff {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V']
    [metric_space P'] [normed_add_torsor V' P'] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V]
    [normed_space 𝕜 V'] {f : affine_map 𝕜 P P'} :
    continuous ⇑(affine_map.linear f) ↔ continuous ⇑f :=
  sorry

@[simp] theorem dist_center_homothety {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V]
    (p₁ : P) (p₂ : P) (c : 𝕜) :
    dist p₁ (coe_fn (affine_map.homothety p₁ c) p₂) = norm c * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_homothety_center {V : Type u_2} {P : Type u_3} [normed_group V]
    [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V]
    (p₁ : P) (p₂ : P) (c : 𝕜) :
    dist (coe_fn (affine_map.homothety p₁ c) p₂) p₁ = norm c * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_homothety_self {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P)
    (c : 𝕜) : dist (coe_fn (affine_map.homothety p₁ c) p₂) p₂ = norm (1 - c) * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_self_homothety {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P)
    (c : 𝕜) : dist p₂ (coe_fn (affine_map.homothety p₁ c) p₂) = norm (1 - c) * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_left_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)]
    (p₁ : P) (p₂ : P) : dist p₁ (midpoint 𝕜 p₁ p₂) = norm (bit0 1)⁻¹ * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_midpoint_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)]
    (p₁ : P) (p₂ : P) : dist (midpoint 𝕜 p₁ p₂) p₁ = norm (bit0 1)⁻¹ * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_midpoint_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)]
    (p₁ : P) (p₂ : P) : dist (midpoint 𝕜 p₁ p₂) p₂ = norm (bit0 1)⁻¹ * dist p₁ p₂ :=
  sorry

@[simp] theorem dist_right_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)]
    (p₁ : P) (p₂ : P) : dist p₂ (midpoint 𝕜 p₁ p₂) = norm (bit0 1)⁻¹ * dist p₁ p₂ :=
  sorry

/-- A continuous map between two normed affine spaces is an affine map provided that
it sends midpoints to midpoints. -/
def affine_map.of_map_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P]
    [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V'] [metric_space P']
    [normed_add_torsor V' P'] [normed_space ℝ V] [normed_space ℝ V'] (f : P → P')
    (h : ∀ (x y : P), f (midpoint ℝ x y) = midpoint ℝ (f x) (f y)) (hfc : continuous f) :
    affine_map ℝ P P' :=
  affine_map.mk' f
    (↑(add_monoid_hom.to_real_linear_map
        (add_monoid_hom.of_map_midpoint ℝ ℝ
          (⇑(affine_equiv.symm (affine_equiv.vadd_const ℝ (f (classical.arbitrary P)))) ∘
            f ∘ ⇑(affine_equiv.vadd_const ℝ (classical.arbitrary P)))
          sorry sorry)
        sorry))
    (classical.arbitrary P) sorry

end Mathlib