/-
Copyright (c) 2022 by the authors listed in the file AUTHORS and their
institutional affiliations. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Nawrocki
-/

import Lean.Meta.Basic
import Lean.Meta.Eqns
import Lean.Meta.Tactic.Assert
import Lean.Elab.Tactic.Basic
import Lean.Elab.Term

import Smt.Tactic.WHNFSmt

/-! Utilities for handling "equational definitions". An equational definition is an equation
of the form `∀ x₁ ⋯ xₙ, c x₁ ⋯ xₙ = body[x₁,⋯,xₙ]` in the local context, where `c` is either
a global constant or a local variable. The LHS should be fully applied so that the equality
is not at a universally quantified (aka function) type.

These usually start off as copied equational theorems of global constants but are then transformed
to an SMT-compatible form.

Note that equational definitions have an advantage over let-bindings in that we do not need
to justify the termination of `body`. This does however imply that rewriting by an equational
definition may never reach a fixpoint.

## Representation

The equational definition for `foo` is stored as `foo.def` in the local context.

TODO(WN): We could have a custom `smt` tactic mode which provides explicit storage for eqn-defs
and displays them more nicely. -/

namespace Smt
open Lean Meta Elab Term Tactic

/-- The user name of an equational definition for 'nm'. -/
def eqnDefName (nm : Name) : Name :=
  nm ++ `def

def throwNotEqnDef [Monad m] [MonadError m] (e : Expr) : m α :=
  throwError "expected equational definition, got{indentD e}"

/-- Get the head symbol `c` of an equational definition. -/
def getEqnDefHead (eqn : Expr) : MetaM Expr :=
  forallTelescopeReducing eqn fun _ eqn => do
    let some (_, lhs, _) := eqn.eq? | throwNotEqnDef eqn
    return lhs.getAppFn

/-- Get the body of an equational definition as a lambda `fun x₁ ⋯ xₙ => body[x₁,⋯,xₙ]`. -/
def getEqnDefLam (eqn : Expr) : MetaM Expr :=
  forallTelescopeReducing eqn fun args eqn => do
    let some (_, _, body) := eqn.eq? | throwNotEqnDef eqn
    mkLambdaFVars args body

/-- If `nm` has an equational definition, `getEqnDefLam` it. -/
def getEqnDefLamFor? (nm : Name) : MetaM (Option Expr) := do
  let some ld := (← getLCtx).findFromUserName? (eqnDefName nm) | return none
  getEqnDefLam ld.type

/-- Add an equational definition `$nm.def : ∀ x₁ ⋯ xₙ, $nm x₁ ⋯ xₙ = body[x₁,⋯,xₙ]`
for a constant and return the equation's fvar. -/
def addEqnDefForConst (nm : Name) : TacticM FVarId := do
  let some eqnThm ← getUnfoldEqnFor? (nonRec := true) nm
    | throwError "failed to retrieve equation theorem for '{nm}'"
  let eqnInfo ← getConstInfo eqnThm
  let (eqn, pf) ← forallTelescopeReducing eqnInfo.type fun args eqn => do
    let some (_, lhs, body) := eqn.eq? | throwNotEqnDef eqn
    let pf ← mkAppOptM eqnInfo.name (args.map some)
    /- Consider the curried definition
    ```lean
    def baw (a : Int) : Int → Int := Int.add a
    ```
    For this, Lean generates the equational theorem
    ```lean
    ∀ (a : Int), baw a = Int.add a
    ```
    which is transformed by the first `forallTelescope` into `baw a = Int.add a`, an equality
    at a function type. Since we want equational definitions to be fully applied, we need to apply
    a second `forallTelescope` on the type of this equality in order to get `baw a b = Int.add a b`,
    which then gets abstracted into `∀ (a b : Int), baw a b = Int.add a b`. -/
    forallTelescopeReducing (← inferType lhs) fun args' _ => do
      let lhs' ← mkAppOptM' lhs (args'.map some)
      let body' ← mkAppOptM' body (args'.map some)
      let eq ← mkEq lhs' body'
      let pf ← args'.foldlM (init := pf) (mkCongrFun · ·)
      -- Abstract the proof into a lambda with a forall type
      let eqAbstracted ← mkForallFVars (args ++ args') eq
      let pfAbstracted ← mkLambdaFVars (args ++ args') pf
      let pfAbstracted ← ensureHasType (some eqAbstracted) pfAbstracted
      return (eqAbstracted, pfAbstracted)

  liftMetaTacticAux fun mvarId => do
    let (fv, mvarId) ← (← mvarId.assert (nm ++ `def) eqn pf).intro1P
    return (fv, [mvarId])

/-- Given `e : tp`, make a local constant `$nm : tp := e` and add an equational definition
`$nm.def : ∀ x₁ ⋯ xₙ, $nm x₁ ⋯ xₙ = e x₁ ⋯ xₙ` for it. Return fvar ids of the constant
and the equation.

`e` is expected to be fully abstracted, i.e. of the form `fun x₁ ⋯ xₙ => body`
where `body` does not have a forall type. -/
def addEqnDefWithBody (nm : Name) (e : Expr) : TacticM (FVarId × FVarId) := do
  let tp ← inferType e
  let fvVar ← liftMetaTacticAux fun mvarId => do
    -- TODO: We have to `define` in order for the proofs to go through, but ideally
    -- we would hide the actual `let` body in the goal state as it's already shown
    -- in the equational definition.
    let (fvVar, mvarId) ← (← mvarId.define nm tp e).intro1P
    return (fvVar, [mvarId])

  let (eqn, pf) ← withMainContext <| lambdaTelescope e fun args body => do
    let lhs ← mkAppOptM' (mkFVar fvVar) (args.map some)
    let eqn ← mkEq lhs body
    let pf ← mkEqRefl lhs
    -- Abstract the proof into a lambda with a forall type
    let eqAbstracted ← mkForallFVars args eqn
    let pfAbstracted ← mkLambdaFVars args pf
    let pfAbstracted ← ensureHasType (some eqAbstracted) pfAbstracted
    return (eqAbstracted, pfAbstracted)

  liftMetaTacticAux fun mvarId => do
    let (fvEq, mvarId) ← (← mvarId.assert (nm ++ `def) eqn pf).intro1P
    return ((fvVar, fvEq), [mvarId])

open Lean Meta Elab Tactic in
/-- Place an equational definition for a constant in the local context. -/
elab "extract_def" i:ident : tactic => do
  let nm ← resolveGlobalConstNoOverloadWithInfo i
  let _ ← addEqnDefForConst nm

/-- Specialize an equational definition via partial evaluation. See `specialize_def`. -/
def specializeEqnDef (x : FVarId) (args : Array Expr) (opaqueConsts : HashSet Name := {})
    : TacticM FVarId := do
  withMainContext do
    let eqn ← inferType (mkFVar x)

    -- Compute specialized body
    let newEqn ← instantiateForall eqn args
    let newLamBody ← getEqnDefLam newEqn
    let newLamBody ← smtOpaqueReduce newLamBody opaqueConsts

    -- Compute specialization name
    let ld ← x.getDecl
    let some nm := ld.userName.eraseSuffix? `def | throwError "{mkFVar x} is not an eqn def!"
    let nm ← args.foldlM (init := nm) fun nm arg => do
      let txt := toString (← ppExpr arg)
      -- let txt := txt.replace " " "_"
      return nm ++ Name.mkSimple txt

    -- Define the specialization
    let (fvVar, _fvEq) ← addEqnDefWithBody nm newLamBody

    -- TODO: these nested withContexts are a bit wonky, can we get a nicer api? `withAddEqnDefForLocal` or something
    withMainContext do
      -- Compute the rewrite helper
      let (eqnRw, pfRw) ← forallTelescope newEqn fun fvArgs newEqn => do
        let some (_, specializedHead, _) := newEqn.eq? | throwNotEqnDef newEqn
        let rhs ← mkAppOptM' (mkFVar fvVar) (fvArgs.map some)
        let eqnRw ← mkEq specializedHead rhs
        -- TODO: Typechecking partial evaluations is currently a fundamental performance bottleneck
        let pf ← mkSorry eqnRw false
        -- let pf ← mkAppOptM' (mkFVar fvEq) (fvArgs.map some)
        -- let pf ← mkEqSymm pf
        let eqAbstracted ← mkForallFVars fvArgs eqnRw
        let pfAbstracted ← mkLambdaFVars fvArgs pf
        --let pfAbstracted ← ensureHasType (some eqAbstracted) pfAbstracted
        return (eqAbstracted, pfAbstracted)

      liftMetaTacticAux fun mvarId => do
        let (fvEq, mvarId) ← (← mvarId.assert (nm ++ `specialization) eqnRw pfRw).intro1P
        return (fvEq, [mvarId])

syntax blockingConsts := "blocking [" term,* "]"

/-- `specialize_def foo [arg₁, ⋯, argₙ]` introduces a new equational definition `foo.arg₁.⋯.argₙ`
whose body is the partial evaluation of `foo arg₁ ⋯ argₙ`. During reduction, all SMT-LIB builtins
are blocked from unfolding and `let_opaque` bindings are not zeta-eliminated. It also introduces
a `foo.arg₁.⋯.argₙ.specialization` equation which can be used to rewrite other expressions.

You can block additional constants from unfolding during evaluation using
`specialize_def foo [arg₁, ⋯, argₙ] blocking [bar₁, bar₂]`.

See `Playground/WHNFExamples.lean` for examples of partially evaluating definitions.

**WARNING**: This is currently extremely slow! On any sizeable expression the evaluator, typechecker,
or kernel is likely to time out. -/
syntax (name := specializeDef) "specialize_def" ident "[" term,* "]" optional(blockingConsts) : tactic

open Lean Meta Elab Tactic in
@[tactic specializeDef] def elabSpecializeDef : Tactic
  | `(tactic|specialize_def $i [ $ts,* ]) => go i ts {}
  | `(tactic|specialize_def $i [ $ts,* ] blocking [ $bs,* ]) =>
    withMainContext do
      let opaqueConsts ← bs.getElems.foldlM (init := HashSet.empty) fun cs b => do
        match ← elabTerm b none with
        | .const nm _ => return cs.insert nm
        | .fvar fv    => return cs.insert (← fv.getDecl).userName
        | _           => throwError "expected a (local) constant, got{indentD b}"
      go i ts opaqueConsts
  | stx => throwError "unexpected syntax {stx}"
where go (i : TSyntax `ident) (ts : TSyntaxArray `term) (opaqueConsts : HashSet Name) : TacticM Unit :=
  withMainContext do
    let nm := i.getId
    let ld ← getLocalDeclFromUserName (eqnDefName nm)
    let args ← forallTelescopeReducing (← inferType (mkFVar ld.fvarId)) fun args _ => do
      let mut ret : Array Expr := #[]
      for (stx, arg) in ts.zip args do
        let e ← elabTerm stx (some (← inferType arg))
        ret := ret.push e
      return ret
    -- Block the function being specialized from unfolding in recursive definitions
    let opaqueConsts := opaqueConsts.insert nm
    let _ ← specializeEqnDef ld.fvarId args opaqueConsts

end Smt


import data.fin.tuple.basic
import data.finsupp.basic
import data.finsupp.pointwise
import data.list.basic
import data.list.range
import data.list.fin_range
import data.option.basic
import data.pfun
import data.prod.lex

lemma bool.coe_iff_eq_tt (b : bool) : b ↔ b = tt := iff.rfl
@[simp] lemma option.bind_const_none {α β} (x : option α) :
  x.bind (λ _, none) = (none : option β) :=
by cases x; simp
@[simp] lemma option.is_none_ff_iff_is_some {α} (x : option α) :
  x.is_none = ff ↔ x.is_some = tt :=
by cases x; simp

@[simp] lemma fin.tuple_eval_one {n : ℕ} {α : fin (n + 2) → Type*}
  (x₀ : α 0) (x₁ : α 1) (x₂ : Π i : fin n, α i.succ.succ) :
  fin.cons x₀ (fin.cons x₁ x₂) 1 = x₁ := rfl

@[simp] lemma fin.tuple_eval_two {n : ℕ} {α : fin (n + 3) → Type*}
  (x₀ : α 0) (x₁ : α 1) (x₂ : α 2) (x₃ : Π i : fin n, α i.succ.succ.succ) :
  fin.cons x₀ (fin.cons x₁ (fin.cons x₂ x₃)) 2 = x₂ := rfl

universes u v
variables {m : Type u → Type v} [monad m]

/- Technically `m` only needs to be applicative but whatever -/
def fin.tuple_sequence : ∀ {n : ℕ} {α : fin n → Type u},
  (Π i, m (α i)) → m (Π i, α i)
| 0 _ _ := pure default
| (n+1) α x := (x 0) >>= λ r, (fin.tuple_sequence (fin.tail x)) >>= λ x', return (fin.cons r x')

@[simp] lemma fin.tuple_sequence₁ [is_lawful_monad m] {α : fin 1 → Type u} (x : Π i, m (α i)) :
  fin.tuple_sequence x = (x 0) >>= λ r₀, pure (fin.cons r₀ default) :=
by simp [fin.tuple_sequence] with functor_norm

@[simp] lemma fin.tuple_sequence₂ [is_lawful_monad m] {α : fin 2 → Type u} (x : Π i, m (α i)) :
  fin.tuple_sequence x = (x 0) >>= λ r₀, (x 1) >>= λ r₁, pure (fin.cons r₀ $ fin.cons r₁ $ default) :=
by { simp [fin.tuple_sequence] with functor_norm, refl, }

def fin.tuple_some {n : ℕ} {α : fin n → Type u} (x : Π i, option (α i)) : option (Π i, α i) :=
fin.tuple_sequence x

@[simp] lemma option.bind_is_some {α β} (x : option α) (y : α → option β):
  (x >>= y).is_some ↔ (∃ (h : x.is_some), (y (option.get h)).is_some) :=
by cases x; simp

@[simp] lemma option.map_is_some {α β} (x : option α) (y : α → β) :
  (y <$> x).is_some = x.is_some := by cases x; simp

@[simp] lemma option.not_is_some' {α} (x : option α) : !x.is_some = x.is_none :=
by { cases x; simp, }

def option.guard_prop {α} (p : Prop) [decidable p] (x : α) : option α :=
  if p then some x else none
@[simp] lemma option.guard_prop_is_some {α} {p : Prop} [decidable p] {x : α} :
  (option.guard_prop p x).is_some ↔ p :=
by { dsimp only [option.guard_prop], split_ifs; simpa }

@[simp] lemma option.coe_part_dom {α} (x : option α) :
  (x : part α).dom ↔ x.is_some := by cases x; simp

@[simp] lemma option.coe_part_eq_some {α} (x : option α) (y : α) :
  (x : part α) = part.some y ↔ x = some y :=
by simp [part.eq_some_iff]

@[simp] lemma list.nth_is_some_iff {α} {x : list α} {n : ℕ} :
  (x.nth n).is_some ↔ n < x.length :=
by { rw ← not_iff_not, simp [option.is_none_iff_eq_none], }

@[simp] lemma option.map_is_some' {α β} (x : option α) (f : α → β) :
  (x.map f).is_some = x.is_some := by cases x; simp

lemma list.zip_with_fst {α β} {l₁ : list α} {l₂ : list β} (hl : l₁.length ≤ l₂.length) :
  list.zip_with (λ a b, a) l₁ l₂ = l₁ :=
by { erw [← list.map_uncurry_zip_eq_zip_with, list.map_fst_zip], exact hl, }

lemma list.zip_with_snd {α β} {l₁ : list α} {l₂ : list β} (hl : l₂.length ≤ l₁.length) :
  list.zip_with (λ a b, b) l₁ l₂ = l₂ :=
by { erw [← list.map_uncurry_zip_eq_zip_with, list.map_snd_zip], exact hl, }

@[simp] lemma multiset.map_nth_le {α} {n : ℕ} {l : list α} (hn : l.length = n) :
    (finset.univ.val : multiset (fin n)).map (λ i, l.nth_le i (by rw hn; exact i.prop)) = l :=
by { subst hn, simp [finset.univ, fintype.elems], erw list.map_nth_le, }

@[simp] lemma le_ff_iff {b : bool} : b ≤ ff ↔ b = ff :=
by cases b; simp

lemma ne_min_of_ne_and_ne {ι : Type*} [linear_order ι] {a x y : ι} (hx : a ≠ x) (hy : a ≠ y) :
  a ≠ min x y := by cases min_choice x y with h; rw h; assumption

@[simp] lemma max_ne_self_iff {ι : Type*} [linear_order ι] (a b : ι) :
  ¬(a = max a b) ↔ a < b :=
by { rw max_def, split_ifs, { simpa using h }, { simpa using le_of_not_ge h } }

@[simp] lemma max_ne_self_iff' {ι : Type*} [linear_order ι] (a b : ι) :
  ¬(b = max a b) ↔ b < a :=
by { rw max_comm, simp, }

section with_top
variables {ι : Type} [partial_order ι]

@[simp] lemma with_top.is_some_iff_lt_top {x : with_top ι} :
  x.is_some ↔ x < ⊤ :=
by { rw [← not_iff_not, eq_ff_eq_not_eq_tt, option.not_is_some, option.is_none_iff_eq_none, lt_top_iff_ne_top, ne, not_not], refl, }

lemma prod.lex.le_iff' {α β : Type} [has_lt α] [has_le β] {x y : α ×ₗ β} :
  x ≤ y ↔ x.1 < y.1 ∨ (x.1 = y.1 ∧ x.2 ≤ y.2) := prod.lex_def _ _

lemma prod.lex.le_iff'' {α β : Type} [partial_order α] [preorder β] {x y : α ×ₗ β} :
  x ≤ y ↔ x.1 ≤ y.1 ∧ (x.1 = y.1 → x.2 ≤ y.2) :=
by { rw [prod.lex.le_iff', le_iff_lt_or_eq], have := @ne_of_lt _ _ x.1 y.1, tauto!, }

lemma prod.lex.lt_iff' {α β : Type} [has_lt α] [has_lt β] {x y : α ×ₗ β} :
  x < y ↔ x.1 < y.1 ∨ (x.1 = y.1 ∧ x.2 < y.2) := prod.lex_def _ _

lemma prod.lex.fst_le_of_le {α β : Type} [preorder α] [preorder β] {x y : α ×ₗ β} (h : x ≤ y) : x.1 ≤ y.1 :=
by { rw prod.lex.le_iff' at h, cases h, { exact h.le, }, { exact h.1.le, }, }

lemma prod.lex.fst_lt_of_lt_of_le {α β : Type} [preorder α] [partial_order β] {x y : α ×ₗ β}
  (h : x < y) (h' : y.2 ≤ x.2) : x.1 < y.1 :=
by { rw prod.lex.lt_iff' at h, cases h, { exact h, }, cases h.2.not_le h', }

@[simp, norm_cast] lemma prod.with_top.coe_inj {α : Type} (x y : α) : (x : with_top α) = y ↔ x = y :=
option.some_inj

end with_top

/- NOTE: This stuff is already in mathlib (`data.finsupp.pointwise`) -/

-- variables {ι α : Type}

-- noncomputable instance finsupp.has_mul [mul_zero_class α] : has_mul (ι →₀ α) :=
-- ⟨λ a b, finsupp.zip_with (*) (zero_mul _) a b⟩

-- lemma finsupp.mul_apply [mul_zero_class α] (g₁ g₂ : ι →₀ α) (a : ι) : (g₁ * g₂) a = g₁ a * g₂ a := rfl

-- -- #check pi.distrib -- todo, tactic like this?
-- noncomputable instance finsupp.non_unital_semiring [non_unital_semiring α] : non_unital_semiring (ι →₀ α) :=
-- {
--   zero := 0,
--   add_assoc := λ a b c, fun_like.ext _ _ (by simp [finsupp.add_apply, add_assoc]),
--   zero_add  := λ a,     fun_like.ext _ _ (by simp [finsupp.add_apply]),
--   add_zero  := λ a,     fun_like.ext _ _ (by simp [finsupp.add_apply]),
--   add_comm  := λ a b,   fun_like.ext _ _ (by simp [finsupp.add_apply, add_comm] ),
--   zero_mul  := λ a,     fun_like.ext _ _ (by simp [finsupp.mul_apply]),
--   mul_zero  := λ a,     fun_like.ext _ _ (by simp [finsupp.mul_apply]),

--   left_distrib  := λ a b c, by simp [fun_like.ext_iff, finsupp.mul_apply, finsupp.add_apply, left_distrib],
--   right_distrib := λ a b c, by simp [fun_like.ext_iff, finsupp.mul_apply, finsupp.add_apply, right_distrib],

--   mul_assoc     := λ a b c, by simp [fun_like.ext_iff, finsupp.mul_apply, mul_assoc],

--   ..finsupp.has_mul, ..finsupp.has_add, }

@[simp] lemma finsupp.mul_single {ι β : Type*} [mul_zero_class β] (i : ι) (x y : β) :
  (finsupp.single i x) * (finsupp.single i y) = finsupp.single i (x * y) :=
by { ext a, by_cases i = a; simp [h], }

lemma finsupp.mul_eq_zero_of_disjoint_support {ι β : Type*} [decidable_eq ι] [mul_zero_class β] (f g : ι →₀ β) (h : disjoint f.support g.support) :
  f * g = 0 :=
begin
  rw [← finsupp.support_eq_empty, ← finset.subset_empty],
  refine trans finsupp.support_mul _,
  rwa [finset.subset_empty, ← finset.disjoint_iff_inter_eq_empty],
end

lemma finsupp.mul_single_eq_zero {ι β : Type*} [mul_zero_class β] (i₁ i₂ : ι) (hi : i₁ ≠ i₂) (x y : β) :
  (finsupp.single i₁ x) * (finsupp.single i₂ y) = 0 :=
by { classical, rw [finsupp.mul_eq_zero_of_disjoint_support], simp [finset.disjoint_iff_ne, finsupp.mem_support_single], intros, exact hi, }

set_option pp.implicit true


import polytime
open num (to_bits of_bits)

@[simp] def encode_option_nat : option ℕ → ℕ
| none := 0
| (some n) := bit1 n

@[simp] def decode_option_nat : ℕ → option ℕ
| 0 := none
| n := some (of_bits (to_bits n).tail)

@[simp] lemma decode_option_nat_bit1 (n : ℕ) : decode_option_nat (bit1 n) = some n :=
by { cases e : (bit1 n), { simp at e, contradiction, },
  simp only [decode_option_nat, nat.succ_ne_zero, not_false_iff], rw ← e, simp, }

@[simp] lemma decode_encode_option_nat (n : option ℕ) : decode_option_nat (encode_option_nat n) = n :=
by { cases n, { refl, }, simp, }

class polycodable (α : Type*) :=
(encode : α → ℕ)
(decode [] : ℕ → option α)
(decode_encode : ∀ x, decode (encode x) = some x)
(poly [] : ∃ c : code, polytime c ∧ ∀ x, c.eval x =  part.some (encode_option_nat ((decode x).map encode)))

attribute [simp] polycodable.decode_encode

open polycodable

instance : polycodable ℕ :=
{ encode := id,
  decode := some,
  decode_encode := λ n, rfl,
  poly := ⟨code.bit tt, polytime_bit _, λ n, by simp [nat.bit]⟩ }

@[simp] lemma encode_nat_id (n : ℕ) : encode n = n := rfl
@[simp] lemma decode_nat_id (n : ℕ) : decode ℕ n = some n := rfl

def decode_option_code (f : code) : code :=
code.case ((code.case zero (code.bit tt) zero).comp f) ((code.case zero (code.bit tt) zero).comp f) zero

lemma polytime_decode_option_code {f : code} (hf : polytime f) : polytime (decode_option_code f) :=
begin
  -- TODO: This obviously needs to be a tactic
  apply polytime_case,
  { apply polytime_comp, { apply polytime_case, apply polytime_zero, apply polytime_bit, apply polytime_zero, }, exact hf, },
  apply polytime_comp, apply polytime_case, apply polytime_zero, apply polytime_bit, apply polytime_zero, exact hf, apply polytime_zero,
end

instance {α : Type} [polycodable α] : polycodable (option α) :=
{ encode := λ x, encode_option_nat (x.map encode),
  decode := λ x, some ((decode_option_nat x) >>= decode α),
  decode_encode := λ x, by cases x; simp,
  poly :=
  begin
    obtain ⟨c, pc, ec⟩ := polycodable.poly α,
    use (code.bit tt).comp (decode_option_code c), split,
    { apply polytime_comp (polytime_bit _), exact polytime_decode_option_code pc, },
    intro x, simp only [decode_option_code],
    rcases e : (to_bits x) with _|_|_,
    { simp only [num.to_bits_nil_iff, nat.cast_eq_zero] at e, subst e, simp [nat.bit], },
    all_goals { have : x ≠ 0 := λ h, by { subst h, simpa using e, },
      simp [e, this, nat.bit, ec],
      cases decode α (of_bits this_tl); simp, },
  end  }

def is_polytime {α β : Type} [polycodable α] [polycodable β] (f : α → β) : Prop :=
∃ c : code, polytime c ∧ ∀ x, c.eval (encode x) = part.some (encode $ f x)

@[simps] def polycodable.mk' {α : Type} (encode : α → ℕ) (decode : ℕ → option α) (decode_encode : ∀ x, decode (encode x) = some x)
  (poly : is_polytime (λ x, (decode x).map encode)) : polycodable α :=
{ encode := encode,
  decode := decode,
  decode_encode := decode_encode,
  poly := by simpa [is_polytime, polycodable.encode] using poly }

variables {α β γ : Type} [polycodable α] [polycodable β] [polycodable γ]

lemma encode_decode_is_polytime (α : Type) [polycodable α] : is_polytime (λ x : ℕ, (decode α x).map encode) :=
by simpa [is_polytime, polycodable.encode] using poly α

lemma is_polytime_iff (f : α → β) :
  is_polytime f ↔ ∃ c : code, polytime c ∧ ∀ x : ℕ, c.eval x = part.some (encode $ (decode α x).map f) :=
begin
  split, swap,
  { rintro ⟨c, pc, hc⟩,
    use tail.comp c,
    split, { exact polytime_comp polytime_tail pc,},
    intro x, specialize hc (encode x),
    simp [hc, polycodable.encode], },
  rintro ⟨c, pc, hc⟩,
  obtain ⟨de, pde, hde⟩ := polycodable.poly α,
  use (code.case zero ((code.bit tt).comp c) zero).comp de,
  split, { exact polytime_comp (polytime_case polytime_zero (polytime_comp (polytime_bit _) pc) polytime_zero) pde, },
  intro x, specialize hde x,
  cases decode α x,
  { simp [hde], refl, }, simp [hde, hc], refl,
end

lemma is_polytime_comp {f : β → γ} {g : α → β} : is_polytime f → is_polytime g → is_polytime (f ∘ g)
| ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ := ⟨fc.comp gc, polytime_comp fp gp, λ x, by simp [hf, hg]⟩

lemma is_polytime_encode (α : Type) [polycodable α] : is_polytime (@encode α _) :=
⟨code.id, polytime_id, λ x, by simp⟩

lemma is_polytime_decode (α : Type) [polycodable α] : is_polytime (decode α) := poly α

lemma is_polytime_const (β : Type) [polycodable β] (x : α) : is_polytime (λ _ : β, x) :=
⟨code.const (encode x), polytime_const _, λ x, by simp⟩

section equiv

def polycodable_of_equiv {β : Type} (eqv : α ≃ β) : polycodable β :=
polycodable.mk'
  (λ b, (polycodable.encode (eqv.symm b)))
  (λ n, (polycodable.decode α n).map eqv)
  (λ b, by simp)
  (by { convert encode_decode_is_polytime α, ext b : 1, cases decode α b; simp, })

lemma is_polytime_of_equiv_symm {β : Type} (eqv : α ≃ β)
  {f : α → γ} (hf : is_polytime f) : @is_polytime β γ (polycodable_of_equiv eqv) _ (f ∘ eqv.symm) :=
by { rcases hf with ⟨c, pc, hc⟩, use c, split, { assumption, }, intro x, exact hc (eqv.symm x), }

lemma is_polytime_of_equiv {β : Type} (eqv : α ≃ β)
  {f : γ → α} (hf : is_polytime f) : @is_polytime γ β _ (polycodable_of_equiv eqv) (eqv ∘ f) :=
by { rcases hf with ⟨c, pc, hc⟩, use c, split, { assumption, }, intro x, rw hc x, simp [encode], }

end equiv

section bool

instance : polycodable bool :=
polycodable.mk'
(λ b, cond b 1 0) (λ n, some (if n = 0 then ff else tt)) (λ x, by cases x; simp)
⟨(code.bit tt).comp to_bit, polytime_comp (polytime_bit _) polytime_to_bit, λ x, by cases x; simp; refl⟩

lemma is_polytime_cond {c : α → bool} {f g : α → β} : is_polytime c → is_polytime f → is_polytime g → is_polytime (λ x, cond (c x) (f x) (g x))
| ⟨cc, cp, hc⟩ ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ :=
⟨code.ite cc gc fc, (polytime_ite cp gp fp), λ x, by cases e : c x; simp [hc, hf, hg, e]⟩

lemma is_polytime_is_some (α : Type) [polycodable α] : is_polytime (@option.is_some α) :=
⟨to_bit, polytime_to_bit, λ x, by cases x; simp [polycodable.encode]⟩

end bool

section prod

instance {α β : Type} [polycodable α] [polycodable β] : polycodable (α × β) :=
polycodable.mk'
  (λ x, nat.mkpair' (encode x.1) (encode x.2))
  (λ x, (decode α (nat.unpair' x).1) >>= (λ x₁, (decode β (nat.unpair' x).2).map $ λ x₂, (x₁, x₂)))
  (λ x, by simp [return, pure])
begin
  obtain ⟨somec₁, somep₁, hsome₁⟩ := is_polytime_is_some α,
  obtain ⟨somec₂, somep₂, hsome₂⟩ := is_polytime_is_some β,
  obtain ⟨d₁, dp₁, hd₁⟩ := is_polytime_decode α,
  obtain ⟨d₂, dp₂, hd₂⟩ := is_polytime_decode β,
  simp only [encode_nat_id] at hd₁ hd₂,
  obtain ⟨e₁, ep₁, he₁⟩ := is_polytime_encode α,
  obtain ⟨e₂, ep₂, he₂⟩ := is_polytime_encode β,
  use (code.ite (somec₁.comp $ d₁.comp code.fst) zero $
      code.ite (somec₂.comp $ d₂.comp code.snd) zero $
      (code.bit tt).comp (code.pair (tail.comp $ d₁.comp code.fst) (tail.comp $ d₂.comp code.snd))),
  split,
  { have P₁ : polytime (d₁.comp code.fst) := polytime_comp dp₁ polytime_fst,
    have P₂ : polytime (d₂.comp code.snd) := polytime_comp dp₂ polytime_snd,
    exact (
      polytime_ite (polytime_comp somep₁ P₁) polytime_zero $
      polytime_ite (polytime_comp somep₂ P₂) polytime_zero $
      (polytime_comp (polytime_bit _) (polytime_pair (polytime_comp polytime_tail P₁) (polytime_comp polytime_tail P₂)))), },
  intro x,
  cases H₁ : decode α (nat.unpair' x).1, { simp [H₁, hd₁, hsome₁], refl, },
  cases H₂ : decode β (nat.unpair' x).2, { simp [H₁, hd₁, hsome₁, H₂, hd₂, hsome₂], refl, },
  simp [H₁, hd₁, hsome₁, H₂, hd₂, hsome₂], simp [polycodable.encode, nat.bit],
end

lemma polytime_prod_fst (α β : Type) [polycodable α] [polycodable β] : is_polytime (@prod.fst α β) :=
⟨code.fst, polytime_fst, λ x, by simp [polycodable.encode]⟩

lemma polytime_prod_snd (α β : Type) [polycodable α] [polycodable β] : is_polytime (@prod.snd α β) :=
⟨code.snd, polytime_snd, λ x, by simp [polycodable.encode]⟩

lemma prod_encode_def (x : α × β) : (encode x.1).mkpair' (encode x.2) = encode x := rfl

lemma is_polytime_pair {f : α → β} {g : α → γ} : is_polytime f → is_polytime g → is_polytime (λ x, (f x, g x))
| ⟨fc, fp, hf⟩ ⟨gc, gp, hg⟩ := ⟨code.pair fc gc, polytime_pair fp gp, λ x, by simp [hf, hg]⟩

def is_polytime₂ (f : α → β → γ) : Prop := is_polytime (function.uncurry f)

lemma is_polytime₂_comp {δ : Type} [polycodable δ] {f : α → β → γ} {g : δ → α} {h : δ → β}
  (hf : is_polytime₂ f) (hg : is_polytime g) (hh : is_polytime h) :
  is_polytime (λ x, f (g x) (h x)) :=
is_polytime_comp hf (is_polytime_pair hg hh)

@[simp] lemma function.uncurry_prod_mk (α β : Type*) : function.uncurry (@prod.mk α β) = id :=
by ext x; cases x; simp

lemma is_polytime₂_ignore_fst {f : α → β} (h : is_polytime f) : is_polytime₂ (λ x : γ, f) :=
by { have := is_polytime_comp h (polytime_prod_snd _ _), exact this, }

lemma is_polytime_prod_mk : is_polytime₂ (@prod.mk α β) := ⟨code.id, polytime_id, λ x, by simp⟩

end prod

section bool

lemma is_polytime_band : is_polytime₂ band :=
begin
  convert_to is_polytime₂ (λ b₁ b₂, cond b₁ b₂ ff),
  { ext b₁ b₂, cases b₁; cases b₂; refl, },
  apply is_polytime_cond,
  exacts [polytime_prod_fst _ _, polytime_prod_snd _ _, is_polytime_const _ _],
end

lemma is_polytime_bor : is_polytime₂ bor :=
begin
  convert_to is_polytime₂ (λ b₁ b₂, cond b₁ tt b₂), { ext b₁ b₂, cases b₁; cases b₂; refl, },
  apply is_polytime_cond,
  exacts [polytime_prod_fst _ _,  is_polytime_const _ _, polytime_prod_snd _ _],
end

end bool

section option

lemma is_polytime_elim {g : α → option β} {f : α → β → γ} {df : α → γ} :
  is_polytime g → is_polytime₂ f → is_polytime df → is_polytime (λ x, (g x).elim (df x) (f x))
| ⟨gc, gp, hg⟩ ⟨fc, fp, hf⟩ ⟨dfc, dfp, hdf⟩ :=
⟨code.ite gc dfc (fc.comp $ code.pair code.id (tail.comp gc)),
  polytime_ite gp dfp (polytime_comp fp $ polytime_pair polytime_id (polytime_comp polytime_tail gp)),
  λ x,
begin
  simp only [← prod_encode_def] at hf,
  cases e : g x with v, { simp [hg, hdf, e, encode], }, { simp [hg, hdf, e, encode, hf (x, v)], }
end⟩

lemma is_polytime_some : is_polytime (@some α) :=
⟨code.bit tt, polytime_bit _, by simp [encode, nat.bit]⟩

lemma is_polytime_of_is_polytime_some {f : α → β} (hf : is_polytime (some ∘ f)) : is_polytime f :=
by { rcases hf with ⟨c, pc, hc⟩, use [tail.comp c, polytime_comp polytime_tail pc], intro x, simp [hc x, encode], }

lemma is_polytime_bind_option {f : α → option β} {g : α → β → option γ} (hf : is_polytime f) (hg : is_polytime₂ g) :
  is_polytime (λ x, (f x).bind (g x)) :=
begin
  convert_to is_polytime (λ x, (f x).elim none (g x)), { ext x : 1, cases f x; simp, },
  exact is_polytime_elim hf hg (is_polytime_const _ none),
end

lemma is_polytime_map_option {f : α → option β} {g : α → β → γ} (hf : is_polytime f) (hg : is_polytime₂ g) :
  is_polytime (λ x, (f x).map (g x)) :=
begin
  change is_polytime (λ x, (f x).bind (some ∘ (g x))), -- turns out, defeq !
  exact is_polytime_bind_option hf (is_polytime_comp is_polytime_some hg),
end

end option

section embedding

def polycodable_of_embedding {β : Type} (e : β → α) (f : α → option β)
  (h : ∀ x, f (e x) = some x) (poly : is_polytime (λ x, (f x).map e)) : polycodable β :=
polycodable.mk'
(λ x, encode (e x))
(λ n, decode α n >>= f)
(λ x, by simp [h])
begin
  convert_to is_polytime (λ n, decode α n >>= (λ x, ((f x).map e).map encode)),
  { ext n : 1, cases decode α n; simp, },
  apply is_polytime_bind_option, { exact is_polytime_decode _, },
  apply is_polytime₂_ignore_fst, apply is_polytime_map_option poly,
  apply is_polytime₂_ignore_fst, apply is_polytime_encode,
end

lemma is_polytime_of_embedding_inclusion {β : Type} {e : β → α} {f : α → option β}
  {h : ∀ x, f (e x) = some x} {poly : is_polytime (λ x, (f x).map e)} :
  by { haveI := polycodable_of_embedding e f h poly, exact (is_polytime e), } :=
by { use [code.id, polytime_id], intro, simp, }

lemma is_polytime_of_embedding_inverse {β : Type} {e : β → α} {f : α → option β}
  {h : ∀ x, f (e x) = some x} {poly : is_polytime (λ x, (f x).map e)} :
  by { haveI := polycodable_of_embedding e f h poly, exact (is_polytime f), } :=
by { rcases poly with ⟨c, pc, hc⟩, use [c, pc], intro x, simp [hc x, encode], refl, }

end embedding

section subtype

def is_polytime_pred (p : α → Prop) [decidable_pred p] : Prop :=
is_polytime (λ x : α, (p x : bool))

lemma is_polytime_ite {p : α → Prop} [decidable_pred p] (hp : is_polytime_pred p) {f g : α → β}
  (hf : is_polytime f) (hg : is_polytime g) : is_polytime (λ x, if p x then f x else g x) :=
begin
  convert_to is_polytime (λ x, cond (p x) (f x) (g x)), { ext x, split_ifs with h; simp [h], },
  apply is_polytime_cond; assumption,
end

def polycodable_subtype {p : α → Prop} [decidable_pred p] (hp : is_polytime_pred p) :
  polycodable {x // p x} :=
polycodable_of_embedding
  (λ x, (x : α))
  (λ x, if h : p x then some ⟨x, h⟩ else none)
  (λ x, by simpa [imp_false] using subtype.prop x)
begin
  convert_to is_polytime (λ x, if p x then some x else none), { ext x : 1, split_ifs; simp, },
  exact is_polytime_ite hp is_polytime_some (is_polytime_const _ _),
end

end subtype

section sigma

private def sum_as_tuple : α ⊕ β → bool × ℕ
| (sum.inl a) := (ff, encode a)
| (sum.inr b) := (tt, encode b)

private def tuple_as_sum (n : bool × ℕ) : option (α ⊕ β) :=
cond n.1 ((decode β n.2).map sum.inr) ((decode α n.2).map sum.inl)

instance : polycodable (α ⊕ β) :=
polycodable_of_embedding sum_as_tuple tuple_as_sum
  (λ x, by cases x; simp [sum_as_tuple, tuple_as_sum])
begin
  convert_to is_polytime (λ n : bool × ℕ, cond n.1 ((decode β n.2).map (λ x, (tt, encode x)))
    ((decode α n.2).map (λ x, (ff, encode x)))),
  { ext n : 1, cases n with b v, cases b; simp [tuple_as_sum]; congr, },
  apply is_polytime_cond (polytime_prod_fst _ _),
  change is_polytime₂ (λ (b : bool) (n : ℕ), (decode β n).map (λ x, (tt, encode x))),
  { apply is_polytime₂_ignore_fst, apply is_polytime_map_option, apply is_polytime_decode,
    apply is_polytime₂_ignore_fst, apply is_polytime₂_comp is_polytime_prod_mk, apply is_polytime_const,
    apply is_polytime_encode, },
  change is_polytime₂ (λ (b : bool) (n : ℕ), (decode α n).map (λ x, (ff, encode x))),
  { apply is_polytime₂_ignore_fst, apply is_polytime_map_option, apply is_polytime_decode,
    apply is_polytime₂_ignore_fst, apply is_polytime₂_comp is_polytime_prod_mk, apply is_polytime_const,
    apply is_polytime_encode, },
end

private lemma is_polytime_sum_as_tuple : is_polytime (@sum_as_tuple α β _ _) := is_polytime_of_embedding_inclusion
private lemma is_polytime_tuple_as_sum : is_polytime (@tuple_as_sum α β _ _) := is_polytime_of_embedding_inverse

lemma is_polytime_sum_inl : is_polytime (@sum.inl α β) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ a : α, (tuple_as_sum (ff, encode a) : option (α ⊕ β)) ),
  { ext a : 1, simp [tuple_as_sum], },
  apply is_polytime_comp is_polytime_tuple_as_sum,
  apply is_polytime₂_comp is_polytime_prod_mk, { apply is_polytime_const, }, apply is_polytime_encode,
end

lemma is_polytime_sum_inr : is_polytime (@sum.inr α β) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ b : β, (tuple_as_sum (tt, encode b) : option (α ⊕ β)) ),
  { ext b : 1, simp [tuple_as_sum], },
  apply is_polytime_comp is_polytime_tuple_as_sum,
  apply is_polytime₂_comp is_polytime_prod_mk, { apply is_polytime_const, }, apply is_polytime_encode,
end

lemma is_polytime_sum_elim {δ : Type} [polycodable δ] {f : δ → α → γ} (g : δ → β → γ) {h : δ → α ⊕ β }
  (hf : is_polytime₂ f) (hg : is_polytime₂ g) (hh : is_polytime h) :
  is_polytime (λ x, (h x).elim (f x) (g x)) :=
begin
  apply is_polytime_of_is_polytime_some,
  convert_to is_polytime (λ x : δ, cond (sum_as_tuple $ h x).1 ((decode β $ (sum_as_tuple $ h x).2).map (g x))
    ((decode α $ (sum_as_tuple $ h x).2).map (f x))),
  { ext x : 1, simp only [function.comp_app], cases h x; simp [sum_as_tuple], },
  apply is_polytime_cond, { apply is_polytime_comp (polytime_prod_fst _ _), apply is_polytime_comp is_polytime_sum_as_tuple hh, },
  { apply is_polytime_map_option, apply is_polytime_comp (is_polytime_decode _), apply is_polytime_comp (polytime_prod_snd _ _),
    apply is_polytime_comp is_polytime_sum_as_tuple hh, exact hg, },
  apply is_polytime_map_option, apply is_polytime_comp (is_polytime_decode _), apply is_polytime_comp (polytime_prod_snd _ _),
  apply is_polytime_comp is_polytime_sum_as_tuple hh, exact hf,
end

end sigma

section list

def mklist (ls : list ℕ) : ℕ := ls.foldr nat.mkpair' 0
def unlist : ℕ → list ℕ
| 0 := []
| (nat.succ n) := have wf : (nat.unpair' n.succ).2 < n.succ := nat.unpair'_snd_lt n,
              (nat.unpair' n.succ).1 :: (unlist (nat.unpair' n.succ).2)

@[simp] lemma unlist_mklist (ls : list ℕ) : unlist (mklist ls) = ls :=
begin
  induction ls with h t ih, { simp [mklist, unlist], },
  simp only [mklist, list.foldr],
  cases e : nat.mkpair' h _, { cases nat.mkpair'_ne_zero _ _ e, },
  simp only [unlist], rw ← e,
  split; simp, exact ih,
end

section recursion

end recursion

end list


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.congruence
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_4 u_3 u_2 u_5 l u_6 u_7 u_8 u_9

namespace Mathlib

/-!
# Tensor product of semimodules over commutative semirings.

This file constructs the tensor product of semimodules over commutative semirings. Given a semiring
`R` and semimodules over it `M` and `N`, the standard construction of the tensor product is
`tensor_product R M N`. It is also a semimodule over `R`.

It comes with a canonical bilinear map `M → N → tensor_product R M N`.

Given any bilinear map `M → N → P`, there is a unique linear map `tensor_product R M N → P` whose
composition with the canonical bilinear map `M → N → tensor_product R M N` is the given bilinear
map `M → N → P`.

We start by proving basic lemmas about bilinear maps.

## Notations

This file uses the localized notation `M ⊗ N` and `M ⊗[R] N` for `tensor_product R M N`, as well
as `m ⊗ₜ n` and `m ⊗ₜ[R] n` for `tensor_product.tmul R m n`.

## Tags

bilinear, tensor, tensor product
-/

namespace linear_map

/-- Create a bilinear map from a function that is linear in each component. -/
def mk₂ (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : M → N → P) (H1 : ∀ (m₁ m₂ : M) (n : N), f (m₁ + m₂) n = f m₁ n + f m₂ n)
    (H2 : ∀ (c : R) (m : M) (n : N), f (c • m) n = c • f m n)
    (H3 : ∀ (m : M) (n₁ n₂ : N), f m (n₁ + n₂) = f m n₁ + f m n₂)
    (H4 : ∀ (c : R) (m : M) (n : N), f m (c • n) = c • f m n) : linear_map R M (linear_map R N P) :=
  mk (fun (m : M) => mk (f m) (H3 m) sorry) sorry sorry

@[simp] theorem mk₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : M → N → P)
    {H1 : ∀ (m₁ m₂ : M) (n : N), f (m₁ + m₂) n = f m₁ n + f m₂ n}
    {H2 : ∀ (c : R) (m : M) (n : N), f (c • m) n = c • f m n}
    {H3 : ∀ (m : M) (n₁ n₂ : N), f m (n₁ + n₂) = f m n₁ + f m n₂}
    {H4 : ∀ (c : R) (m : M) (n : N), f m (c • n) = c • f m n} (m : M) (n : N) :
    coe_fn (coe_fn (mk₂ R f H1 H2 H3 H4) m) n = f m n :=
  rfl

theorem ext₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] {f : linear_map R M (linear_map R N P)} {g : linear_map R M (linear_map R N P)}
    (H : ∀ (m : M) (n : N), coe_fn (coe_fn f m) n = coe_fn (coe_fn g m) n) : f = g :=
  ext fun (m : M) => ext fun (n : N) => H m n

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map from `M × N` to
`P`, change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def flip {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) : linear_map R N (linear_map R M P) :=
  mk₂ R (fun (n : N) (m : M) => coe_fn (coe_fn f m) n) sorry sorry sorry sorry

@[simp] theorem flip_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) :
    coe_fn (coe_fn (flip f) n) m = coe_fn (coe_fn f m) n :=
  rfl

theorem flip_inj {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] {f : linear_map R M (linear_map R N P)} {g : linear_map R M (linear_map R N P)}
    (H : flip f = flip g) : f = g :=
  sorry

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map `M → N → P`,
change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def lflip (R : Type u_1) [comm_semiring R] (M : Type u_2) (N : Type u_3) (P : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R M (linear_map R N P)) (linear_map R N (linear_map R M P)) :=
  mk flip sorry sorry

@[simp] theorem lflip_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) :
    coe_fn (coe_fn (coe_fn (lflip R M N P) f) n) m = coe_fn (coe_fn f m) n :=
  rfl

theorem map_zero₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (y : N) : coe_fn (coe_fn f 0) y = 0 :=
  map_zero (coe_fn (flip f) y)

theorem map_neg₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_group M] [add_comm_monoid N] [add_comm_group P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (x : M) (y : N) :
    coe_fn (coe_fn f (-x)) y = -coe_fn (coe_fn f x) y :=
  map_neg (coe_fn (flip f) y) x

theorem map_sub₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_group M] [add_comm_monoid N] [add_comm_group P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (x : M) (y : M) (z : N) :
    coe_fn (coe_fn f (x - y)) z = coe_fn (coe_fn f x) z - coe_fn (coe_fn f y) z :=
  map_sub (coe_fn (flip f) z) x y

theorem map_add₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (x₁ : M) (x₂ : M) (y : N) :
    coe_fn (coe_fn f (x₁ + x₂)) y = coe_fn (coe_fn f x₁) y + coe_fn (coe_fn f x₂) y :=
  map_add (coe_fn (flip f) y) x₁ x₂

theorem map_smul₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (r : R) (x : M) (y : N) :
    coe_fn (coe_fn f (r • x)) y = r • coe_fn (coe_fn f x) y :=
  map_smul (coe_fn (flip f) y) r x

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def lcomp (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} (P : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M N) : linear_map R (linear_map R N P) (linear_map R M P) :=
  flip (comp (flip id) f)

@[simp] theorem lcomp_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R M N) (g : linear_map R N P) (x : M) :
    coe_fn (coe_fn (lcomp R P f) g) x = coe_fn g (coe_fn f x) :=
  rfl

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def llcomp (R : Type u_1) [comm_semiring R] (M : Type u_2) (N : Type u_3) (P : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R N P) (linear_map R (linear_map R M N) (linear_map R M P)) :=
  flip (mk (lcomp R P) sorry sorry)

@[simp] theorem llcomp_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R M N) (x : M) :
    coe_fn (coe_fn (coe_fn (llcomp R M N P) f) g) x = coe_fn f (coe_fn g x) :=
  rfl

/-- Composing a linear map `Q → N` and a bilinear map `M → N → P` to
form a bilinear map `M → Q → P`. -/
def compl₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M (linear_map R N P)) (g : linear_map R Q N) :
    linear_map R M (linear_map R Q P) :=
  comp (lcomp R P g) f

@[simp] theorem compl₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M (linear_map R N P)) (g : linear_map R Q N) (m : M) (q : Q) :
    coe_fn (coe_fn (compl₂ f g) m) q = coe_fn (coe_fn f m) (coe_fn g q) :=
  rfl

/-- Composing a linear map `P → Q` and a bilinear map `M × N → P` to
form a bilinear map `M → N → Q`. -/
def compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} {P : Type u_4}
    {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M (linear_map R N P)) (g : linear_map R P Q) :
    linear_map R M (linear_map R N Q) :=
  comp (coe_fn (llcomp R N P Q) g) f

@[simp] theorem compr₂_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} {Q : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M (linear_map R N P)) (g : linear_map R P Q) (m : M) (n : N) :
    coe_fn (coe_fn (compr₂ f g) m) n = coe_fn g (coe_fn (coe_fn f m) n) :=
  rfl

/-- Scalar multiplication as a bilinear map `R → M → M`. -/
def lsmul (R : Type u_1) [comm_semiring R] (M : Type u_2) [add_comm_monoid M] [semimodule R M] :
    linear_map R R (linear_map R M M) :=
  mk₂ R has_scalar.smul sorry sorry sorry sorry

@[simp] theorem lsmul_apply {R : Type u_1} [comm_semiring R] {M : Type u_2} [add_comm_monoid M]
    [semimodule R M] (r : R) (m : M) : coe_fn (coe_fn (lsmul R M) r) m = r • m :=
  rfl

end linear_map

namespace tensor_product

-- open free_add_monoid

/-- The relation on `free_add_monoid (M × N)` that generates a congruence whose quotient is
the tensor product. -/
inductive eqv (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    free_add_monoid (M × N) → free_add_monoid (M × N) → Prop
    where
| of_zero_left : ∀ (n : N), eqv R M N (free_add_monoid.of (0, n)) 0
| of_zero_right : ∀ (m : M), eqv R M N (free_add_monoid.of (m, 0)) 0
| of_add_left :
    ∀ (m₁ m₂ : M) (n : N),
      eqv R M N (free_add_monoid.of (m₁, n) + free_add_monoid.of (m₂, n))
        (free_add_monoid.of (m₁ + m₂, n))
| of_add_right :
    ∀ (m : M) (n₁ n₂ : N),
      eqv R M N (free_add_monoid.of (m, n₁) + free_add_monoid.of (m, n₂))
        (free_add_monoid.of (m, n₁ + n₂))
| of_smul :
    ∀ (r : R) (m : M) (n : N),
      eqv R M N (free_add_monoid.of (r • m, n)) (free_add_monoid.of (m, r • n))
| add_comm : ∀ (x y : free_add_monoid (M × N)), eqv R M N (x + y) (y + x)

end tensor_product

/-- The tensor product of two semimodules `M` and `N` over the same commutative semiring `R`.
The localized notations are `M ⊗ N` and `M ⊗[R] N`, accessed by `open_locale tensor_product`. -/
def tensor_product (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :=
  add_con.quotient (add_con_gen sorry)

namespace tensor_product

protected instance add_comm_monoid {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    add_comm_monoid (tensor_product R M N) :=
  add_comm_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry sorry

protected instance inhabited {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    Inhabited (tensor_product R M N) :=
  { default := 0 }

/-- The canonical function `M → N → M ⊗ N`. The localized notations are `m ⊗ₜ n` and `m ⊗ₜ[R] n`,
accessed by `open_locale tensor_product`. -/
def tmul (R : Type u_1) [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) : tensor_product R M N :=
  coe_fn (add_con.mk' (add_con_gen (eqv R M N))) (free_add_monoid.of (m, n))

protected theorem induction_on {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N]
    {C : tensor_product R M N → Prop} (z : tensor_product R M N) (C0 : C 0)
    (C1 : ∀ {x : M} {y : N}, C (tmul R x y))
    (Cp : ∀ {x y : tensor_product R M N}, C x → C y → C (x + y)) : C z :=
  sorry

@[simp] theorem zero_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (n : N) :
    tmul R 0 n = 0 :=
  quotient.sound' (add_con_gen.rel.of (free_add_monoid.of (0, n)) 0 (eqv.of_zero_left n))

theorem add_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (m₁ : M) (m₂ : M) (n : N) :
    tmul R (m₁ + m₂) n = tmul R m₁ n + tmul R m₂ n :=
  sorry

@[simp] theorem tmul_zero {R : Type u_1} [comm_semiring R] {M : Type u_3} (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) :
    tmul R m 0 = 0 :=
  quotient.sound' (add_con_gen.rel.of (free_add_monoid.of (m, 0)) 0 (eqv.of_zero_right m))

theorem tmul_add {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n₁ : N) (n₂ : N) :
    tmul R m (n₁ + n₂) = tmul R m n₁ + tmul R m n₂ :=
  sorry

/--
A typeclass for `has_scalar` structures which can be moved across a tensor product.

This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that
we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if
`R` does not support negation.

Note that `semimodule R' (M ⊗[R] N)` is available even without this typeclass on `R'`; it's only
needed if `tensor_product.smul_tmul`, `tensor_product.smul_tmul'`, or `tensor_product.tmul_smul` is
used.
-/
class compatible_smul (R : Type u_1) [comm_semiring R] (R' : Type u_2) [comm_semiring R']
    (M : Type u_3) (N : Type u_4) [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N]
    where
  smul_tmul : ∀ (r : R') (m : M) (n : N), tmul R (r • m) n = tmul R m (r • n)

/-- Note that this provides the default `compatible_smul R R M N` instance through
`mul_action.is_scalar_tower.left`. -/
protected instance compatible_smul.is_scalar_tower {R : Type u_1} [comm_semiring R] {R' : Type u_2}
    [comm_semiring R'] {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N]
    [semimodule R M] [semimodule R N] [semimodule R' M] [semimodule R' N] [has_scalar R' R]
    [is_scalar_tower R' R M] [is_scalar_tower R' R N] : compatible_smul R R' M N :=
  compatible_smul.mk sorry

/-- `smul` can be moved from one side of the product to the other .-/
theorem smul_tmul {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R'] {M : Type u_3}
    {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N]
    [semimodule R' M] [semimodule R' N] [compatible_smul R R' M N] (r : R') (m : M) (n : N) :
    tmul R (r • m) n = tmul R m (r • n) :=
  compatible_smul.smul_tmul r m n

/-- Auxiliary function to defining scalar multiplication on tensor product. -/
def smul.aux {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] {R' : Type u_2} [has_scalar R' M]
    (r : R') : free_add_monoid (M × N) →+ tensor_product R M N :=
  coe_fn free_add_monoid.lift fun (p : M × N) => tmul R (r • prod.fst p) (prod.snd p)

theorem smul.aux_of {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] {R' : Type u_2}
    [has_scalar R' M] (r : R') (m : M) (n : N) :
    coe_fn (smul.aux r) (free_add_monoid.of (m, n)) = tmul R (r • m) n :=
  rfl

-- Most of the time we want the instance below this one, which is easier for typeclass resolution

-- to find. The `unused_arguments` is from one of the two comm_classes - while we only make use

-- of one, it makes sense to make the API symmetric.

protected instance has_scalar' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] : has_scalar R' (tensor_product R M N) :=
  has_scalar.mk fun (r : R') => ⇑(add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) sorry)

protected instance has_scalar {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    has_scalar R (tensor_product R M N) :=
  tensor_product.has_scalar'

protected theorem smul_zero {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] (r : R') : r • 0 = 0 :=
  add_monoid_hom.map_zero
    (add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) (has_scalar'._proof_1 r))

protected theorem smul_add {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] (r : R') (x : tensor_product R M N) (y : tensor_product R M N) :
    r • (x + y) = r • x + r • y :=
  add_monoid_hom.map_add
    (add_con.lift (add_con_gen (eqv R M N)) (smul.aux r) (has_scalar'._proof_1 r)) x y

-- Most of the time we want the instance below this one, which is easier for typeclass resolution

-- to find.

protected instance semimodule' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] : semimodule R' (tensor_product R M N) :=
  (fun (this : ∀ (r : R') (m : M) (n : N), r • tmul R m n = tmul R (r • m) n) =>
      semimodule.mk sorry sorry)
    sorry

protected instance semimodule {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    semimodule R (tensor_product R M N) :=
  tensor_product.semimodule'

-- note that we don't actually need `compatible_smul` here, but we include it for symmetry

-- with `tmul_smul` to avoid exposing our asymmetric definition.

theorem smul_tmul' {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] [compatible_smul R R' M N] (r : R') (m : M) (n : N) :
    r • tmul R m n = tmul R (r • m) n :=
  rfl

@[simp] theorem tmul_smul {R : Type u_1} [comm_semiring R] {R' : Type u_2} [comm_semiring R']
    {M : Type u_3} {N : Type u_4} [add_comm_monoid M] [add_comm_monoid N] [semimodule R M]
    [semimodule R N] [semimodule R' M] [semimodule R' N] [smul_comm_class R R' M]
    [smul_comm_class R R' N] [compatible_smul R R' M N] (r : R') (x : M) (y : N) :
    tmul R x (r • y) = r • tmul R x y :=
  Eq.symm (smul_tmul r x y)

/-- The canonical bilinear map `M → N → M ⊗[R] N`. -/
def mk (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    linear_map R M (linear_map R N (tensor_product R M N)) :=
  linear_map.mk₂ R (fun (_x : M) (_y : N) => tmul R _x _y) add_tmul sorry tmul_add sorry

@[simp] theorem mk_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    coe_fn (coe_fn (mk R M N) m) n = tmul R m n :=
  rfl

theorem ite_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (x₁ : M) (x₂ : N) (P : Prop)
    [Decidable P] : tmul R (ite P x₁ 0) x₂ = ite P (tmul R x₁ x₂) 0 :=
  sorry

theorem tmul_ite {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (x₁ : M) (x₂ : N) (P : Prop)
    [Decidable P] : tmul R x₁ (ite P x₂ 0) = ite P (tmul R x₁ x₂) 0 :=
  sorry

theorem sum_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] {α : Type u_2} (s : finset α) (m : α → M)
    (n : N) :
    tmul R (finset.sum s fun (a : α) => m a) n = finset.sum s fun (a : α) => tmul R (m a) n :=
  sorry

theorem tmul_sum {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) {α : Type u_2} (s : finset α)
    (n : α → N) :
    tmul R m (finset.sum s fun (a : α) => n a) = finset.sum s fun (a : α) => tmul R m (n a) :=
  sorry

/-- Auxiliary function to constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def lift_aux {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) : tensor_product R M N →+ P :=
  add_con.lift (add_con_gen (eqv R M N))
    (coe_fn free_add_monoid.lift fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p))
    sorry

theorem lift_aux_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) :
    coe_fn (lift_aux f) (tmul R m n) = coe_fn (coe_fn f m) n :=
  zero_add ((fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p)) (m, n))

@[simp] theorem lift_aux.smul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (r : R)
    (x : tensor_product R M N) : coe_fn (lift_aux f) (r • x) = r • coe_fn (lift_aux f) x :=
  sorry

/-- Constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P` with the property that
its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def lift {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R M (linear_map R N P)) :
    linear_map R (tensor_product R M N) P :=
  linear_map.mk (add_monoid_hom.to_fun (lift_aux f)) sorry lift_aux.smul

@[simp] theorem lift.tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (x : M) (y : N) :
    coe_fn (lift f) (tmul R x y) = coe_fn (coe_fn f x) y :=
  zero_add ((fun (p : M × N) => coe_fn (coe_fn f (prod.fst p)) (prod.snd p)) (x, y))

@[simp] theorem lift.tmul' {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] {f : linear_map R M (linear_map R N P)} (x : M) (y : N) :
    linear_map.to_fun (lift f) (tmul R x y) = coe_fn (coe_fn f x) y :=
  lift.tmul x y

theorem ext {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] {g : linear_map R (tensor_product R M N) P}
    {h : linear_map R (tensor_product R M N) P}
    (H : ∀ (x : M) (y : N), coe_fn g (tmul R x y) = coe_fn h (tmul R x y)) : g = h :=
  sorry

theorem lift.unique {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] {f : linear_map R M (linear_map R N P)}
    {g : linear_map R (tensor_product R M N) P}
    (H : ∀ (x : M) (y : N), coe_fn g (tmul R x y) = coe_fn (coe_fn f x) y) : g = lift f :=
  sorry

theorem lift_mk {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} [add_comm_monoid M]
    [add_comm_monoid N] [semimodule R M] [semimodule R N] : lift (mk R M N) = linear_map.id :=
  Eq.symm (lift.unique fun (x : M) (y : N) => rfl)

theorem lift_compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    {f : linear_map R M (linear_map R N P)} (g : linear_map R P Q) :
    lift (linear_map.compr₂ f g) = linear_map.comp g (lift f) :=
  sorry

theorem lift_mk_compr₂ {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R (tensor_product R M N) P) :
    lift (linear_map.compr₂ (mk R M N) f) = f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) f) = f)) (lift_compr₂ f)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (linear_map.comp f (lift (mk R M N)) = f)) lift_mk))
      (eq.mpr
        (id (Eq._oldrec (Eq.refl (linear_map.comp f linear_map.id = f)) (linear_map.comp_id f)))
        (Eq.refl f)))

theorem mk_compr₂_inj {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] {g : linear_map R (tensor_product R M N) P}
    {h : linear_map R (tensor_product R M N) P}
    (H : linear_map.compr₂ (mk R M N) g = linear_map.compr₂ (mk R M N) h) : g = h :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g = h)) (Eq.symm (lift_mk_compr₂ g))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) g) = h)) H))
      (eq.mpr
        (id (Eq._oldrec (Eq.refl (lift (linear_map.compr₂ (mk R M N) h) = h)) (lift_mk_compr₂ h)))
        (Eq.refl h)))

/-- Linearly constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def uncurry (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R M (linear_map R N P)) (linear_map R (tensor_product R M N) P) :=
  linear_map.flip
    (lift
      (linear_map.comp (linear_map.lflip R (linear_map R M (linear_map R N P)) N P)
        (linear_map.flip linear_map.id)))

@[simp] theorem uncurry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R M (linear_map R N P)) (m : M) (n : N) :
    coe_fn (coe_fn (uncurry R M N P) f) (tmul R m n) = coe_fn (coe_fn f m) n :=
  sorry

/-- A linear equivalence constructing a linear map `M ⊗ N → P` given a bilinear map `M → N → P`
with the property that its composition with the canonical bilinear map `M → N → M ⊗ N` is
the given bilinear map `M → N → P`. -/
def lift.equiv (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_equiv R (linear_map R M (linear_map R N P)) (linear_map R (tensor_product R M N) P) :=
  linear_equiv.mk (linear_map.to_fun (uncurry R M N P)) sorry sorry
    (fun (f : linear_map R (tensor_product R M N) P) => linear_map.compr₂ (mk R M N) f) sorry sorry

/-- Given a linear map `M ⊗ N → P`, compose it with the canonical bilinear map `M → N → M ⊗ N` to
form a bilinear map `M → N → P`. -/
def lcurry (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R (tensor_product R M N) P) (linear_map R M (linear_map R N P)) :=
  ↑(linear_equiv.symm (lift.equiv R M N P))

@[simp] theorem lcurry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) (m : M) (n : N) :
    coe_fn (coe_fn (coe_fn (lcurry R M N P) f) m) n = coe_fn f (tmul R m n) :=
  rfl

/-- Given a linear map `M ⊗ N → P`, compose it with the canonical bilinear map `M → N → M ⊗ N` to
form a bilinear map `M → N → P`. -/
def curry {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R (tensor_product R M N) P) :
    linear_map R M (linear_map R N P) :=
  coe_fn (lcurry R M N P) f

@[simp] theorem curry_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R (tensor_product R M N) P) (m : M) (n : N) :
    coe_fn (coe_fn (curry f) m) n = coe_fn f (tmul R m n) :=
  rfl

theorem ext_threefold {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    {g : linear_map R (tensor_product R (tensor_product R M N) P) Q}
    {h : linear_map R (tensor_product R (tensor_product R M N) P) Q}
    (H :
      ∀ (x : M) (y : N) (z : P),
        coe_fn g (tmul R (tmul R x y) z) = coe_fn h (tmul R (tmul R x y) z)) :
    g = h :=
  sorry

-- We'll need this one for checking the pentagon identity!

theorem ext_fourfold {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N] [semimodule R P]
    [semimodule R Q] [semimodule R S]
    {g : linear_map R (tensor_product R (tensor_product R (tensor_product R M N) P) Q) S}
    {h : linear_map R (tensor_product R (tensor_product R (tensor_product R M N) P) Q) S}
    (H :
      ∀ (w : M) (x : N) (y : P) (z : Q),
        coe_fn g (tmul R (tmul R (tmul R w x) y) z) = coe_fn h (tmul R (tmul R (tmul R w x) y) z)) :
    g = h :=
  sorry

/--
The base ring is a left identity for the tensor product of modules, up to linear equivalence.
-/
protected def lid (R : Type u_1) [comm_semiring R] (M : Type u_3) [add_comm_monoid M]
    [semimodule R M] : linear_equiv R (tensor_product R R M) M :=
  linear_equiv.of_linear (lift (linear_map.lsmul R M)) (coe_fn (mk R R M) 1) sorry sorry

@[simp] theorem lid_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M]
    [semimodule R M] (m : M) (r : R) : coe_fn (tensor_product.lid R M) (tmul R r m) = r • m :=
  sorry

@[simp] theorem lid_symm_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M]
    [semimodule R M] (m : M) : coe_fn (linear_equiv.symm (tensor_product.lid R M)) m = tmul R 1 m :=
  rfl

/--
The tensor product of modules is commutative, up to linear equivalence.
-/
protected def comm (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] :
    linear_equiv R (tensor_product R M N) (tensor_product R N M) :=
  linear_equiv.of_linear (lift (linear_map.flip (mk R N M))) (lift (linear_map.flip (mk R M N)))
    sorry sorry

@[simp] theorem comm_tmul (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    coe_fn (tensor_product.comm R M N) (tmul R m n) = tmul R n m :=
  rfl

@[simp] theorem comm_symm_tmul (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    coe_fn (linear_equiv.symm (tensor_product.comm R M N)) (tmul R n m) = tmul R m n :=
  rfl

/--
The base ring is a right identity for the tensor product of modules, up to linear equivalence.
-/
protected def rid (R : Type u_1) [comm_semiring R] (M : Type u_3) [add_comm_monoid M]
    [semimodule R M] : linear_equiv R (tensor_product R M R) M :=
  linear_equiv.trans (tensor_product.comm R M R) (tensor_product.lid R M)

@[simp] theorem rid_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M]
    [semimodule R M] (m : M) (r : R) : coe_fn (tensor_product.rid R M) (tmul R m r) = r • m :=
  sorry

@[simp] theorem rid_symm_apply {R : Type u_1} [comm_semiring R] {M : Type u_3} [add_comm_monoid M]
    [semimodule R M] (m : M) : coe_fn (linear_equiv.symm (tensor_product.rid R M)) m = tmul R m 1 :=
  rfl

/-- The associator for tensor product of R-modules, as a linear equivalence. -/
protected def assoc (R : Type u_1) [comm_semiring R] (M : Type u_3) (N : Type u_4) (P : Type u_5)
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_equiv R (tensor_product R (tensor_product R M N) P)
        (tensor_product R M (tensor_product R N P)) :=
  linear_equiv.of_linear
    (lift
      (lift
        (linear_map.comp (lcurry R N P (tensor_product R M (tensor_product R N P)))
          (mk R M (tensor_product R N P)))))
    (lift
      (linear_map.comp (uncurry R N P (tensor_product R (tensor_product R M N) P))
        (curry (mk R (tensor_product R M N) P))))
    sorry sorry

@[simp] theorem assoc_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (m : M) (n : N) (p : P) :
    coe_fn (tensor_product.assoc R M N P) (tmul R (tmul R m n) p) = tmul R m (tmul R n p) :=
  rfl

@[simp] theorem assoc_symm_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (m : M) (n : N) (p : P) :
    coe_fn (linear_equiv.symm (tensor_product.assoc R M N P)) (tmul R m (tmul R n p)) =
        tmul R (tmul R m n) p :=
  rfl

/-- The tensor product of a pair of linear maps between modules. -/
def map {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5} {Q : Type u_6}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q] [semimodule R M]
    [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_map R M P)
    (g : linear_map R N Q) : linear_map R (tensor_product R M N) (tensor_product R P Q) :=
  lift (linear_map.comp (linear_map.compl₂ (mk R P Q) g) f)

@[simp] theorem map_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M P) (g : linear_map R N Q) (m : M) (n : N) :
    coe_fn (map f g) (tmul R m n) = tmul R (coe_fn f m) (coe_fn g n) :=
  rfl

theorem map_comp {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {P' : Type u_8}
    {Q' : Type u_9} [add_comm_monoid P'] [semimodule R P'] [add_comm_monoid Q'] [semimodule R Q']
    (f₂ : linear_map R P P') (f₁ : linear_map R M P) (g₂ : linear_map R Q Q')
    (g₁ : linear_map R N Q) :
    map (linear_map.comp f₂ f₁) (linear_map.comp g₂ g₁) = linear_map.comp (map f₂ g₂) (map f₁ g₁) :=
  sorry

theorem lift_comp_map {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] {Q' : Type u_9}
    [add_comm_monoid Q'] [semimodule R Q'] (i : linear_map R P (linear_map R Q Q'))
    (f : linear_map R M P) (g : linear_map R N Q) :
    linear_map.comp (lift i) (map f g) = lift (linear_map.compl₂ (linear_map.comp i f) g) :=
  sorry

/-- If `M` and `P` are linearly equivalent and `N` and `Q` are linearly equivalent
then `M ⊗ N` and `P ⊗ Q` are linearly equivalent. -/
def congr {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (f : linear_equiv R M P)
    (g : linear_equiv R N Q) : linear_equiv R (tensor_product R M N) (tensor_product R P Q) :=
  linear_equiv.of_linear (map ↑f ↑g) (map ↑(linear_equiv.symm f) ↑(linear_equiv.symm g)) sorry sorry

@[simp] theorem congr_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_equiv R M P) (g : linear_equiv R N Q) (m : M) (n : N) :
    coe_fn (congr f g) (tmul R m n) = tmul R (coe_fn f m) (coe_fn g n) :=
  rfl

@[simp] theorem congr_symm_tmul {R : Type u_1} [comm_semiring R] {M : Type u_3} {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_equiv R M P) (g : linear_equiv R N Q) (p : P) (q : Q) :
    coe_fn (linear_equiv.symm (congr f g)) (tmul R p q) =
        tmul R (coe_fn (linear_equiv.symm f) p) (coe_fn (linear_equiv.symm g) q) :=
  rfl

end tensor_product

namespace linear_map

/-- `ltensor M f : M ⊗ N →ₗ M ⊗ P` is the natural linear map induced by `f : N →ₗ P`. -/
def ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R N P) :
    linear_map R (tensor_product R M N) (tensor_product R M P) :=
  tensor_product.map id f

/-- `rtensor f M : N₁ ⊗ M →ₗ N₂ ⊗ M` is the natural linear map induced by `f : N₁ →ₗ N₂`. -/
def rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] (f : linear_map R N P) :
    linear_map R (tensor_product R N M) (tensor_product R P M) :=
  tensor_product.map f id

@[simp] theorem ltensor_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (m : M) (n : N) :
    coe_fn (ltensor M f) (tensor_product.tmul R m n) = tensor_product.tmul R m (coe_fn f n) :=
  rfl

@[simp] theorem rtensor_tmul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (m : M) (n : N) :
    coe_fn (rtensor M f) (tensor_product.tmul R n m) = tensor_product.tmul R (coe_fn f n) m :=
  rfl

/-- `ltensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def ltensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R N P) (linear_map R (tensor_product R M N) (tensor_product R M P)) :=
  mk (ltensor M) sorry sorry

/-- `rtensor_hom M` is the natural linear map that sends a linear map `f : N →ₗ P` to `M ⊗ f`. -/
def rtensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M] [semimodule R N]
    [semimodule R P] :
    linear_map R (linear_map R N P) (linear_map R (tensor_product R N M) (tensor_product R P M)) :=
  mk (fun (f : linear_map R N P) => rtensor M f) sorry sorry

@[simp] theorem coe_ltensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] : ⇑(ltensor_hom M) = ltensor M :=
  rfl

@[simp] theorem coe_rtensor_hom {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] : ⇑(rtensor_hom M) = rtensor M :=
  rfl

@[simp] theorem ltensor_add {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) :
    ltensor M (f + g) = ltensor M f + ltensor M g :=
  map_add (ltensor_hom M) f g

@[simp] theorem rtensor_add {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) :
    rtensor M (f + g) = rtensor M f + rtensor M g :=
  map_add (rtensor_hom M) f g

@[simp] theorem ltensor_zero {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] : ltensor M 0 = 0 :=
  map_zero (ltensor_hom M)

@[simp] theorem rtensor_zero {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] : rtensor M 0 = 0 :=
  map_zero (rtensor_hom M)

@[simp] theorem ltensor_smul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (r : R) (f : linear_map R N P) :
    ltensor M (r • f) = r • ltensor M f :=
  map_smul (ltensor_hom M) r f

@[simp] theorem rtensor_smul {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [semimodule R M]
    [semimodule R N] [semimodule R P] (r : R) (f : linear_map R N P) :
    rtensor M (r • f) = r • rtensor M f :=
  map_smul (rtensor_hom M) r f

theorem ltensor_comp {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (g : linear_map R P Q)
    (f : linear_map R N P) : ltensor M (comp g f) = comp (ltensor M g) (ltensor M f) :=
  sorry

theorem rtensor_comp {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4} {P : Type u_5}
    {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
    [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q] (g : linear_map R P Q)
    (f : linear_map R N P) : rtensor M (comp g f) = comp (rtensor M g) (rtensor M f) :=
  sorry

@[simp] theorem ltensor_id {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : ltensor M id = id :=
  sorry

@[simp] theorem rtensor_id {R : Type u_1} [comm_semiring R] (M : Type u_3) (N : Type u_4)
    [add_comm_monoid M] [add_comm_monoid N] [semimodule R M] [semimodule R N] : rtensor M id = id :=
  sorry

@[simp] theorem ltensor_comp_rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M P) (g : linear_map R N Q) :
    comp (ltensor P g) (rtensor N f) = tensor_product.map f g :=
  sorry

@[simp] theorem rtensor_comp_ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
    [add_comm_monoid Q] [semimodule R M] [semimodule R N] [semimodule R P] [semimodule R Q]
    (f : linear_map R M P) (g : linear_map R N Q) :
    comp (rtensor Q f) (ltensor M g) = tensor_product.map f g :=
  sorry

@[simp] theorem map_comp_rtensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N]
    [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N]
    [semimodule R P] [semimodule R Q] [semimodule R S] (f : linear_map R M P) (g : linear_map R N Q)
    (f' : linear_map R S M) :
    comp (tensor_product.map f g) (rtensor N f') = tensor_product.map (comp f f') g :=
  sorry

@[simp] theorem map_comp_ltensor {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N]
    [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N]
    [semimodule R P] [semimodule R Q] [semimodule R S] (f : linear_map R M P) (g : linear_map R N Q)
    (g' : linear_map R S N) :
    comp (tensor_product.map f g) (ltensor M g') = tensor_product.map f (comp g g') :=
  sorry

@[simp] theorem rtensor_comp_map {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N]
    [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N]
    [semimodule R P] [semimodule R Q] [semimodule R S] (f' : linear_map R P S)
    (f : linear_map R M P) (g : linear_map R N Q) :
    comp (rtensor Q f') (tensor_product.map f g) = tensor_product.map (comp f' f) g :=
  sorry

@[simp] theorem ltensor_comp_map {R : Type u_1} [comm_semiring R] (M : Type u_3) {N : Type u_4}
    {P : Type u_5} {Q : Type u_6} {S : Type u_7} [add_comm_monoid M] [add_comm_monoid N]
    [add_comm_monoid P] [add_comm_monoid Q] [add_comm_monoid S] [semimodule R M] [semimodule R N]
    [semimodule R P] [semimodule R Q] [semimodule R S] (g' : linear_map R Q S)
    (f : linear_map R M P) (g : linear_map R N Q) :
    comp (ltensor P g') (tensor_product.map f g) = tensor_product.map f (comp g' g) :=
  sorry

end linear_map

namespace tensor_product

/-- Auxiliary function to defining negation multiplication on tensor product. -/
def neg.aux (R : Type u_1) [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] :
    free_add_monoid (M × N) →+ tensor_product R M N :=
  coe_fn free_add_monoid.lift fun (p : M × N) => tmul R (-prod.fst p) (prod.snd p)

theorem neg.aux_of {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    coe_fn (neg.aux R) (free_add_monoid.of (m, n)) = tmul R (-m) n :=
  rfl

protected instance has_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] :
    Neg (tensor_product R M N) :=
  { neg := ⇑(add_con.lift (add_con_gen (eqv R M N)) (neg.aux R) sorry) }

protected instance add_comm_group {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N] :
    add_comm_group (tensor_product R M N) :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry Neg.neg
    (fun (_x _x_1 : tensor_product R M N) => add_semigroup.add _x (-_x_1)) sorry sorry

theorem neg_tmul {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    tmul R (-m) n = -tmul R m n :=
  rfl

theorem tmul_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n : N) :
    tmul R m (-n) = -tmul R m n :=
  linear_map.map_neg (coe_fn (mk R M N) m) n

theorem tmul_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] (m : M) (n₁ : N) (n₂ : N) :
    tmul R m (n₁ - n₂) = tmul R m n₁ - tmul R m n₂ :=
  linear_map.map_sub (coe_fn (mk R M N) m) n₁ n₂

theorem sub_tmul {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3} [add_comm_group M]
    [add_comm_group N] [semimodule R M] [semimodule R N] (m₁ : M) (m₂ : M) (n : N) :
    tmul R (m₁ - m₂) n = tmul R m₁ n - tmul R m₂ n :=
  linear_map.map_sub₂ (mk R M N) m₁ m₂ n

/--
While the tensor product will automatically inherit a ℤ-module structure from
`add_comm_group.int_module`, that structure won't be compatible with lemmas like `tmul_smul` unless
we use a `ℤ-module` instance provided by `tensor_product.semimodule'`.

When `R` is a `ring` we get the required `tensor_product.compatible_smul` instance through
`is_scalar_tower`, but when it is only a `semiring` we need to build it from scratch.
The instance diamond in `compatible_smul` doesn't matter because it's in `Prop`.
-/
protected instance compatible_smul.int {R : Type u_1} [comm_semiring R] {M : Type u_2}
    {N : Type u_3} [add_comm_group M] [add_comm_group N] [semimodule R M] [semimodule R N]
    [semimodule ℤ M] [semimodule ℤ N] : compatible_smul R ℤ M N :=
  compatible_smul.mk sorry

end tensor_product

namespace linear_map

@[simp] theorem ltensor_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) :
    ltensor M (f - g) = ltensor M f - ltensor M g :=
  sorry

@[simp] theorem rtensor_sub {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) (g : linear_map R N P) :
    rtensor M (f - g) = rtensor M f - rtensor M g :=
  sorry

@[simp] theorem ltensor_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) : ltensor M (-f) = -ltensor M f :=
  sorry

@[simp] theorem rtensor_neg {R : Type u_1} [comm_semiring R] {M : Type u_2} {N : Type u_3}
    {P : Type u_4} [add_comm_group M] [add_comm_group N] [add_comm_group P] [semimodule R M]
    [semimodule R N] [semimodule R P] (f : linear_map R N P) : rtensor M (-f) = -rtensor M f :=
  sorry

end Mathlib