import Yatima.Typechecker.Equal

/-!
# Yatima typechecker: Infer

## Basic Structure

This is the third of the three main files that constitute the Yatima typechecker: `Eval`, `Equal`,
and `Infer`.

TODO: Add a high level overview of Infer in the context of Eval-Equal-Infer.

## Infer

In this module the two major functions `check` and `infer` are defined.
* `check` : Checks that a Yatima expression has a prescribed type.
* `infer` : Determines the type of a given Yatima expression.
-/

namespace Yatima.Typechecker

open IR PP
open Lurk (F)

/--
  Gives the correct type information for a lambda based on the information of the body.
  No lambdas can be a proposition, a struct or be elements of the unit type.
-/
def lamInfo : TypeInfo → TypeInfo
| .proof => .proof
| _ => .none

def piInfo (dom img : TypeInfo) : TypecheckM TypeInfo := match dom, img with
| .sort lvl, .sort lvl' => pure $ .sort $ .reduceIMax lvl lvl'
| .sort _, _ => throw "Image is not a type"
| _, .sort _ => throw "Domain is not a type"
| _, _ => throw "Neither image nor domain are types"

def eqSortInfo (inferType expectType : SusValue) : TypecheckM Bool := do
  match inferType.info, expectType.info with
  | .sort lvl, .sort lvl' => pure $ lvl.equalUniv lvl'
  | .sort _, e => throw s!"Expected type {← ppValue expectType.get} {repr e} is not actually a type"
  | e, .sort _ => throw s!"Inferred type {← ppValue inferType.get} {repr e} is not actually a type"
  | e, e' => throw s!"Neither expected {← ppValue expectType.get} {repr e} nor inferred types {← ppValue inferType.get} {repr e'} are actually types"
/--
  Gives the correct type information for a term based on its type.
-/
def infoFromType (typ : SusValue) : TypecheckM TypeInfo :=
  match typ.info with
  | .sort .zero => pure .proof
  | _ =>
    match typ.get with
    | .app (.const f _) _ _ => do match derefConst f (← read).store with
      | .inductiveProj p =>
        let induct ← getIndFromProj p
        if induct.unit then pure .unit else pure .none
      | _ => pure .none
    | .sort lvl => pure (.sort lvl)
    | _ => pure .none

mutual

  partial def getStructInfo (v : Value) :
      TypecheckM (F × TypedExpr × List Univ × List SusValue) := do
    match v with
    | .app (.const indF univs) params _ =>
      let .inductiveProj p := derefConst indF (← read).store
        | throw s!"Expected a structure type, found {← ppValue v}"
      let ind ← getIndFromProj p
      -- Sanity check
      unless ind.struct && ind.params == params.length do
        throw s!"Expected a structure type, found {← ppValue v}"
      withLimitedAxioms $ checkConst indF
      let ctorF := mkConstructorProjF p.block p.idx 0 (← read).quick
      match (← get).typedConsts.find? ctorF with
      | .some (.constructor type _ _) =>
        return (indF, type, univs, params)
      | _ => throw s!"Implementation broken: ctorF {ctorF} is not a constructor"
    | v => throw s!"Expected a structure type, found {← ppValue v}"

  /--
  Checks if `term : IR.Expr` has type `type : SusValue`. Returns the typed IR for `term`
  -/
  partial def check (term : IR.Expr) (type : SusValue) : TypecheckM TypedExpr := do
    let (term, inferType) ← infer term
    if !(← eqSortInfo inferType type) then
      throw s!"Term: {← ppTypedExpr term}\nInfo mismatch:\n{repr inferType.info}\n\nnot equal to\n{repr type.info}\n\nExpected type: {← ppValue type.get}\nInferred type: {← ppValue inferType.get}"
    if !(← equal (← read).lvl type inferType) then
      throw s!"Expected type {← ppValue type.get}, found type {← ppValue inferType.get}"
    pure term

  /-- Infers the type of `term : IR.Expr`. Returns the typed IR for `term` along with its inferred type  -/
  partial def infer (term : IR.Expr) : TypecheckM (TypedExpr × SusValue) := do
    match term with
    | .var idx lvls =>
      let ctx ← read
      if idx < ctx.lvl then
        -- this is a bound free variable
        if !lvls.isEmpty then
          -- bound free variables should never have universe levels (sanity check)
          throw s!"found var@{idx} with unexpected universe variables"
        let types := ctx.types
        let some type := types.get? idx
          | throw s!"var@{idx} out of environment range (size {types.length})"
        let term := ⟨← infoFromType type, .var idx⟩
        pure (term, type)
      else
        -- this free variable came from `recrCtx`, and thus represents a mutual reference
        match ctx.mutTypes.find? (idx - ctx.lvl) with
        | some (constF, typeValFn) =>
          if some constF == ctx.recF? then
            throw s!"Invalid recursion in {(← read).constNames.getF constF}"
          let type := typeValFn lvls
          let term := ⟨← infoFromType type, .const constF lvls⟩
          pure (term, type)
        | none =>
          throw $ s!"var@{idx} out of environment range (size {ctx.types.length})"
            ++ " and does not represent a mutual constant"
    | .sort lvl =>
      let univs := (← read).env.univs
      let lvl := Univ.instBulkReduce univs lvl
      let lvl' := lvl.succ
      let typ := .mk (.sort lvl'.succ) ⟨ fun _ => .sort lvl' ⟩
      -- NOTE: we populate `SusTypeInfo.sort` here for consistency but technically it isn't necessary
      -- because `lvl'` can never become `Univ.zero`.
      let term := ⟨.sort lvl', .sort lvl⟩
      return (term, typ)
    | .app fnc' arg =>
      let (fnc, fncType) ← infer fnc'
      match fncType.get with
      | .pi dom img env =>
        let arg ← check arg dom
        let ctx ← read
        let stt ← get
        let typ := suspend img { ctx with env := env.extendWith $ suspend arg ctx stt} stt
        let term := ⟨← infoFromType typ, .app fnc arg⟩
        pure (term, typ)
      | val => throw s!"Expected a pi type, found {← ppValue val}"
    | .lam dom bod => do
      let (dom, _) ← isSort dom
      let ctx ← read
      let domVal := suspend dom ctx (← get)
      let var := mkSusVar (← infoFromType domVal) ctx.lvl
      let (bod, imgVal) ← withExtendedCtx var domVal $ infer bod
      let term := ⟨lamInfo bod.info, .lam dom bod⟩
      let typ := .mk (← piInfo domVal.info imgVal.info) $
        Value.pi domVal (← quoteTyped (ctx.lvl+1) ctx.env imgVal.getTyped) ctx.env
      pure (term, typ)
    | .pi dom img =>
      let (dom, domLvl) ← isSort dom
      let ctx ← read
      let domVal := suspend dom ctx (← get)
      let domSusVal := mkSusVar (← infoFromType domVal) ctx.lvl
      withExtendedCtx domSusVal domVal $ do
        let (img, imgLvl) ← isSort img
        let sortLvl := .reduceIMax domLvl imgLvl
        let typ := .mk (.sort sortLvl.succ) ⟨ fun _ => .sort $ sortLvl ⟩
        let term := ⟨← infoFromType typ, .pi dom img⟩
        return (term, typ)
    | .letE expType exp bod =>
      let (expType, _) ← isSort expType
      let ctx ← read
      let expTypeVal := suspend expType ctx (← get)
      let exp ← check exp expTypeVal
      let expVal := suspend exp ctx (← get)
      let (bod, typ) ← withExtendedCtx expVal expTypeVal $ infer bod
      let term := ⟨bod.info, .letE expType exp bod⟩
      return (term, typ)
    | .lit (.natVal v) =>
      let typ := .mk (.sort $ .succ .zero) (mkConst (← primF .nat) [])
      let term := ⟨.none, .lit (.natVal v)⟩
      pure $ (term, typ)
    | .lit (.strVal s) =>
      let typ := .mk (.sort $ .succ .zero) (mkConst (← primF .string) [])
      let term := ⟨.none, .lit (.strVal s)⟩
      pure $ (term, typ)
    | .const k constUnivs =>
      withLimitedAxioms $ checkConst k
      let ctx ← read
      let univs := ctx.env.univs
      let tconst ← derefTypedConst k
      let env := ⟨[], constUnivs.map (Univ.instBulkReduce univs)⟩
      let typ := suspend tconst.type { ctx with env := env } (← get)
      let term := ⟨← infoFromType typ, .const k constUnivs⟩
      pure (term, typ)
    | .proj idx expr =>
      let (expr, exprType) ← infer expr
      let (indF, ctorType, univs, params) ←  getStructInfo exprType.get
      let mut ctorType ← applyType (← withEnv ⟨[], univs⟩ $ eval ctorType) params.reverse
      for i in [:idx] do
        match ctorType with
        | .pi dom img piEnv =>
          let info ← infoFromType dom
          let proj := suspend ⟨info, .proj indF i expr⟩ (← read) (← get)
          ctorType ← withNewExtendedEnv piEnv proj $ eval img
        | _ => pure ()
      match ctorType with
      | .pi dom _ _  =>
        match exprType.info, dom.info with
        | .sort .zero, .sort .zero =>
          let term := ⟨← infoFromType dom, .proj indF idx expr⟩
          pure (term, dom)
        | .sort .zero, _ =>
          throw s!"Projection {← ppTypedExpr expr}.{idx} not allowed"
        | _, _ =>
          let term := ⟨← infoFromType dom, .proj indF idx expr⟩
          pure (term, dom)
      | _ => throw "Impossible case. Implementation broken."

  /--
  Checks if `expr : IR.Expr` is `Sort lvl` for some level `lvl`, and throws `TypecheckerError.notTyp`
  if it is not.
  -/
  partial def isSort (expr : IR.Expr) : TypecheckM (TypedExpr × Univ) := do
    let (expr, typ) ← infer expr
    match typ.get with
    | .sort u =>
      pure (expr, u)
    | val => throw s!"Expected a sort type, found {← ppValue val}"

  partial def checkIndBlock (indBlockF : F) : TypecheckM Unit := do
    let quick := (← read).quick
    let indBlock ← match derefConst indBlockF (← read).store with
      | .mutIndBlock blk => pure blk
      | _ => throw "Invalid Const kind. Expected mutIndBlock"

    -- Check all inductives
    let mut mutTypes := .empty
    for (indIdx, ind) in indBlock.enum do
      let f := mkInductiveProjF indBlockF indIdx quick
      let univs := List.range ind.lvls |>.map .var
      let (type, _) ← withEnv ⟨ [], univs ⟩ $ isSort ind.type
      let ctx ← read
      let stt ← get
      let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
      mutTypes := mutTypes.insert indIdx (f, typeSus)
      modify fun stt => { stt with typedConsts := stt.typedConsts.insert f (.inductive type ind.struct) }

    -- Check all constructors
    for (indIdx, ind) in indBlock.enum do
      let start := mutTypes.size
      for (cidx, ctor) in ind.ctors.enum do
        let f := mkConstructorProjF indBlockF indIdx cidx quick
        let univs := List.range ctor.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort ctor.type
        let ctx ← read
        let stt ← get
        let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
        mutTypes := mutTypes.insert (start + cidx) (f, typeSus)
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f (.constructor type ctor.idx ctor.fields) }

    -- Check all recursor types
    for (indIdx, ind) in indBlock.enum do
      let start := mutTypes.size
      for (ridx, recr) in ind.recrs.enum do
        let f := mkRecursorProjF indBlockF indIdx ridx quick
        let univs := List.range recr.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort recr.type
        let ctx ← read
        let stt ← get
        let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
        mutTypes := mutTypes.insert (start + ridx) (f, typeSus)

    -- Check all recursor rules
    for (indIdx, ind) in indBlock.enum do
      for (ridx, recr) in ind.recrs.enum do
        -- TODO: do not recompute `f`, `univs` and `type`
        let f := mkRecursorProjF indBlockF indIdx ridx quick
        let univs := List.range recr.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort recr.type
        let indProj := ⟨indBlockF, indIdx⟩
        let rules ← recr.rules.mapM fun rule => do
          let (rhs, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ infer rule.rhs
          pure (rule.fields, rhs)
        let recrConst := .recursor type recr.params recr.motives recr.minors recr.indices recr.isK indProj ⟨rules⟩
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f recrConst }

    return ()

  /-- Typechecks a `Yatima.Const`. The `TypecheckM Unit` computation finishes if the check finishes,
  otherwise a `TypecheckError` is thrown in some other function in the typechecker stack.

  Note that inductives, constructors, and recursors are constructed to typecheck, so this function
  only has to check the other `Const` constructors.
  -/
  partial def checkConst (f : F) : TypecheckM Unit := withResetCtx do
    match (← get).typedConsts.find? f with
    | some _ =>
      pure ()
    | none =>
      let c := derefConst f (← read).store
      if c.isMutType then return ()
      let univs := List.range (← c.levels) |>.map .var
      withEnv ⟨ [], univs ⟩ do
        let quick := (← read).quick
        let newConst ← match c with
          | .axiom ax =>
            if (← read).limitAxioms then
              if quick then
                if !(allowedAxiomQuick f) then
                  throw s!"Axiom {(← read).constNames.getF f} is not allowed"
              else
                if !(allowedAxiom f) then
                  throw s!"Axiom {(← read).constNames.getF f} is not allowed"
            let (type, _) ← isSort ax.type
            pure $ TypedConst.axiom type
          | .opaque data =>
            let (type, _) ← isSort data.type
            let typeSus := suspend type (← read) (← get)
            let value ← withRecF f $ check data.value typeSus
            pure $ TypedConst.opaque type value
          | .theorem data =>
            let (type, _) ← isSort data.type
            let typeSus := suspend type (← read) (← get)
            let value ← withRecF f $ check data.value typeSus
            pure $ TypedConst.theorem type value
          | .definition data =>
            let (type, _) ← isSort data.type
            let ctx ← read
            let typeSus := suspend type ctx (← get)
            let value ←
              if data.part then
                let mutTypes :=
                  let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} (← get))
                  (default : RecrCtx).insert 0 (f, typeSus)
                withMutTypes mutTypes $ withRecF f $ check data.value typeSus
              else withRecF f $ check data.value typeSus
            pure $ TypedConst.definition type value data.part
          | .definitionProj p@⟨defBlockF, _⟩ =>
            let data ← getDefFromProj p
            let (type, _) ← isSort data.type
            let ctx ← read
            let defBlock ← match derefConst defBlockF ctx.store with
              | .mutDefBlock blk => pure blk
              | _ => throw "Invalid Const kind. Expected mutDefBlock"
            let typeSus := suspend type ctx (← get)
            let value ←
              if data.part then
                -- check order should be the same as `recrCtx` in CA
                let mutTypes ← defBlock.enum.foldlM (init := default) fun acc (i, defn) => do
                  let defProjF := mkDefinitionProjF defBlockF i quick
                  -- TODO avoid repeated work here
                  let (type, _) ← isSort defn.type
                  let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} (← get))
                  pure $ acc.insert i (defProjF, typeSus)
                withMutTypes mutTypes $ withRecF f $ check data.value typeSus
              else withRecF f $ check data.value typeSus
            pure $ TypedConst.definition type value data.part
          | .inductiveProj ⟨indBlockF, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .constructorProj ⟨indBlockF, _, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .recursorProj ⟨indBlockF, _, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .quotient data =>
            let (type, _) ← isSort (← c.type)
            pure $ .quotient type data.kind
          | _ => throw "Impossible case. Cannot typecheck a mutual block."
        -- TODO is it okay to use the original hash for the `TypedConst`, or should we compute a new one?
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f newConst }
end

end Yatima.Typechecker


import for_mathlib.category_theory.localization.shift
import for_mathlib.category_theory.triangulated.triangulated_functor

open category_theory category_theory.limits

namespace category_theory

namespace functor

variables {C H D : Type*} [category C] [category H] [category D]
  [has_shift C ℤ] [has_shift H ℤ] [has_shift D ℤ]
  [has_zero_object C] [has_zero_object H] [has_zero_object D]
  [preadditive C] [preadditive H] [preadditive D]
  [∀ (n : ℤ), (shift_functor C n).additive]
  [∀ (n : ℤ), (shift_functor H n).additive]
  [∀ (n : ℤ), (shift_functor D n).additive]
  [pretriangulated C] [pretriangulated H] [pretriangulated D]
  (L : C ⥤ H) [L.has_comm_shift ℤ]

class ess_surj_on_dist_triang :=
(condition [] : ∀ (T : pretriangulated.triangle H) (hT : T ∈ dist_triang H),
  ∃ (T' : pretriangulated.triangle C) (hT' : T' ∈ dist_triang C),
    nonempty (L.map_triangle.obj T' ≅ T))

variables {L}

lemma is_triangulated.of_ess_surj_on_dist_triang [L.ess_surj_on_dist_triang]
  {F : C ⥤ D} {G : H ⥤ D} (e : L ⋙ G ≅ F) [G.has_comm_shift ℤ] [F.has_comm_shift ℤ]
  [F.is_triangulated] [e.hom.respects_comm_shift ℤ] : G.is_triangulated :=
{ map_distinguished' := λ T hT, begin
    obtain ⟨T', hT', ⟨e₁⟩⟩ := ess_surj_on_dist_triang.condition L T hT,
    exact pretriangulated.isomorphic_distinguished _ (F.map_distinguished _ hT') _
      (G.map_triangle.map_iso e₁.symm ≪≫ (map_triangle_comp L G).symm.app T' ≪≫
      (map_triangle_nat_iso e).app T'),
  end }

instance localization_lift_is_triangulated [L.ess_surj_on_dist_triang]
  (W : morphism_property C) [L.is_localization W]
  (F : C ⥤ D) (hF : W.is_inverted_by F) [F.has_comm_shift ℤ] [F.is_triangulated] :
  (localization.lift F hF L).is_triangulated :=
is_triangulated.of_ess_surj_on_dist_triang (localization.fac F hF L)

end functor

end category_theory


/-
File: signature_recover_public_key_recover_public_key_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
import .signature_recover_public_key_get_generator_point_soundness
import .signature_recover_public_key_ec_negate_soundness
import .signature_recover_public_key_div_mod_n_soundness
import .signature_recover_public_key_get_point_from_x_soundness
import .signature_recover_public_key_ec_mul_soundness
open tactic

open starkware.cairo.common.cairo_secp.signature
open starkware.cairo.common.math
open starkware.cairo.common.cairo_secp.bigint
open starkware.cairo.common.cairo_secp.field
open starkware.cairo.common.cairo_secp.ec

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.cairo_secp.signature.recover_public_key autogenerated soundness theorem -/

theorem auto_sound_recover_public_key
    -- arguments
    (range_check_ptr : F) (msg_hash r s : BigInt3 F) (v : F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_recover_public_key σ.pc)
    -- all dependencies are in memory
    (h_mem_0 : mem_at mem code_assert_nn (σ.pc  - 817))
    (h_mem_1 : mem_at mem code_assert_le (σ.pc  - 813))
    (h_mem_2 : mem_at mem code_assert_nn_le (σ.pc  - 808))
    (h_mem_3 : mem_at mem code_bigint_mul (σ.pc  - 799))
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 785))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 773))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 753))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 737))
    (h_mem_8 : mem_at mem code_is_zero (σ.pc  - 714))
    (h_mem_9 : mem_at mem code_reduce (σ.pc  - 678))
    (h_mem_10 : mem_at mem code_validate_reduced_field_element (σ.pc  - 665))
    (h_mem_11 : mem_at mem code_ec_negate (σ.pc  - 625))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 609))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 565))
    (h_mem_14 : mem_at mem code_ec_double (σ.pc  - 541))
    (h_mem_15 : mem_at mem code_fast_ec_add (σ.pc  - 468))
    (h_mem_16 : mem_at mem code_ec_add (σ.pc  - 381))
    (h_mem_17 : mem_at mem code_ec_mul_inner (σ.pc  - 325))
    (h_mem_18 : mem_at mem code_ec_mul (σ.pc  - 224))
    (h_mem_19 : mem_at mem code_get_generator_point (σ.pc  - 144))
    (h_mem_20 : mem_at mem code_div_mod_n (σ.pc  - 131))
    (h_mem_21 : mem_at mem code_get_point_from_x (σ.pc  - 66))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 13))
    (hin_msg_hash : msg_hash = cast_BigInt3 mem (σ.fp - 12))
    (hin_r : r = cast_BigInt3 mem (σ.fp - 9))
    (hin_s : s = cast_BigInt3 mem (σ.fp - 6))
    (hin_v : v = mem (σ.fp - 3))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 13)) (mem $ τ.ap - 7)
        (spec_recover_public_key mem κ range_check_ptr msg_hash r s v (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_recover_public_key at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72, hpc73, hpc74, hpc75, hpc76, hpc77, hpc78, hpc79, hpc80, hpc81, hpc82, hpc83, hpc84, hpc85⟩,
  -- ap += 15
  step_advance_ap hpc0 hpc1,
  -- function call
  step_assert_eq hpc2 with arg0,
  step_assert_eq hpc3 with arg1,
  step_assert_eq hpc4 with arg2,
  step_assert_eq hpc5 with arg3,
  step_assert_eq hpc6 with arg4,
  step_sub hpc7 (auto_sound_get_point_from_x mem _ range_check_ptr r v _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc8, norm_num2, exact h_mem_21 },
  { rw hpc8, norm_num2, exact h_mem_0 },
  { rw hpc8, norm_num2, exact h_mem_1 },
  { rw hpc8, norm_num2, exact h_mem_2 },
  { rw hpc8, norm_num2, exact h_mem_4 },
  { rw hpc8, norm_num2, exact h_mem_5 },
  { rw hpc8, norm_num2, exact h_mem_6 },
  { rw hpc8, norm_num2, exact h_mem_7 },
  { rw hpc8, norm_num2, exact h_mem_9 },
  { rw hpc8, norm_num2, exact h_mem_10 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call9 ap9 h_call9,
  rcases h_call9 with ⟨rc_m9, rc_mle9, hl_range_check_ptr₁, h_call9⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap9 - 7) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_r_point: cast_EcPoint mem (ap9 - 6) = r_point,
  simp only [hr_rev_r_point] at h_call9,
  have htv_r_point := hr_rev_r_point.symm, clear hr_rev_r_point,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4] at h_call9 },
  rw [hin_range_check_ptr] at h_call9,
  clear arg0 arg1 arg2 arg3 arg4,
  -- local var
  step_assert_eq hpc9 with temp0,
  step_assert_eq hpc10 with temp1,
  step_assert_eq hpc11 with temp2,
  step_assert_eq hpc12 with temp3,
  step_assert_eq hpc13 with temp4,
  step_assert_eq hpc14 with temp5,
  have lc_r_point: r_point = cast_EcPoint mem σ.fp, {
    try { ext } ; {
      try { simp only [htv_r_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2, temp3, temp4, temp5] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2 temp3 temp4 temp5,
  -- function call
  step_sub hpc15 (auto_sound_get_generator_point mem _  _),
  { rw hpc16, norm_num2, exact h_mem_19 },
  intros κ_call17 ap17 h_call17,
  rcases h_call17 with ⟨h_call17_ap_offset, h_call17⟩,
  generalize' hr_rev_generator_point: cast_EcPoint mem (ap17 - 6) = generator_point,
  simp only [hr_rev_generator_point] at h_call17,
  have htv_generator_point := hr_rev_generator_point.symm, clear hr_rev_generator_point,
  clear ,
  -- function call
  step_assert_eq hpc17 with arg0,
  step_assert_eq hpc18 with arg1,
  step_assert_eq hpc19 with arg2,
  step_assert_eq hpc20 with arg3,
  step_assert_eq hpc21 with arg4,
  step_assert_eq hpc22 with arg5,
  step_assert_eq hpc23 with arg6,
  step_sub hpc24 (auto_sound_div_mod_n mem _ range_check_ptr₁ msg_hash r _ _ _ _ _ _),
  { rw hpc25, norm_num2, exact h_mem_20 },
  { rw hpc25, norm_num2, exact h_mem_3 },
  { rw hpc25, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
    try { simp only [h_call17_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { simp only [h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { simp only [h_call17_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call26 ap26 h_call26,
  rcases h_call26 with ⟨h_call26_ap_offset, h_call26⟩,
  rcases h_call26 with ⟨rc_m26, rc_mle26, hl_range_check_ptr₂, h_call26⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap26 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_u1: cast_BigInt3 mem (ap26 - 3) = u1,
  simp only [hr_rev_u1] at h_call26,
  have htv_u1 := hr_rev_u1.symm, clear hr_rev_u1,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₂ },
  try { rw [h_call17_ap_offset] at hl_range_check_ptr₂ }, try { arith_simps at hl_range_check_ptr₂ },
  rw [←htv_range_check_ptr₂, ←htv_range_check_ptr₁] at hl_range_check_ptr₂,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call26 },
  try { rw [h_call17_ap_offset] at h_call26 }, try { arith_simps at h_call26 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call26,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- function call
  step_assert_eq hpc26 with arg0,
  step_assert_eq hpc27 with arg1,
  step_assert_eq hpc28 with arg2,
  step_assert_eq hpc29 with arg3,
  step_assert_eq hpc30 with arg4,
  step_assert_eq hpc31 with arg5,
  step_assert_eq hpc32 with arg6,
  step_sub hpc33 (auto_sound_div_mod_n mem _ range_check_ptr₂ s r _ _ _ _ _ _),
  { rw hpc34, norm_num2, exact h_mem_20 },
  { rw hpc34, norm_num2, exact h_mem_3 },
  { rw hpc34, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
    try { simp only [h_call17_ap_offset, h_call26_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call35 ap35 h_call35,
  rcases h_call35 with ⟨h_call35_ap_offset, h_call35⟩,
  rcases h_call35 with ⟨rc_m35, rc_mle35, hl_range_check_ptr₃, h_call35⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap35 - 4) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_u2: cast_BigInt3 mem (ap35 - 3) = u2,
  simp only [hr_rev_u2] at h_call35,
  have htv_u2 := hr_rev_u2.symm, clear hr_rev_u2,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₃ },
  rw [←htv_range_check_ptr₃, ←htv_range_check_ptr₂] at hl_range_check_ptr₃,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call35 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call35,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- local var
  step_assert_eq hpc35 with temp0,
  step_assert_eq hpc36 with temp1,
  step_assert_eq hpc37 with temp2,
  have lc_u2: u2 = cast_BigInt3 mem (σ.fp + 6), {
    try { ext } ; {
      try { simp only [htv_u2] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2,
  -- function call
  step_assert_eq hpc38 with arg0,
  step_assert_eq hpc39 with arg1,
  step_assert_eq hpc40 with arg2,
  step_assert_eq hpc41 with arg3,
  step_assert_eq hpc42 with arg4,
  step_assert_eq hpc43 with arg5,
  step_assert_eq hpc44 with arg6,
  step_assert_eq hpc45 with arg7,
  step_assert_eq hpc46 with arg8,
  step_assert_eq hpc47 with arg9,
  step_sub hpc48 (auto_sound_ec_mul mem _ range_check_ptr₃ generator_point u1 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc49, norm_num2, exact h_mem_18 },
  { rw hpc49, norm_num2, exact h_mem_4 },
  { rw hpc49, norm_num2, exact h_mem_5 },
  { rw hpc49, norm_num2, exact h_mem_6 },
  { rw hpc49, norm_num2, exact h_mem_7 },
  { rw hpc49, norm_num2, exact h_mem_8 },
  { rw hpc49, norm_num2, exact h_mem_12 },
  { rw hpc49, norm_num2, exact h_mem_13 },
  { rw hpc49, norm_num2, exact h_mem_14 },
  { rw hpc49, norm_num2, exact h_mem_15 },
  { rw hpc49, norm_num2, exact h_mem_16 },
  { rw hpc49, norm_num2, exact h_mem_17 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
    try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call50 ap50 h_call50,
  rcases h_call50 with ⟨rc_m50, rc_mle50, hl_range_check_ptr₄, h_call50⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap50 - 7) = range_check_ptr₄,
  have htv_range_check_ptr₄ := hr_rev_range_check_ptr₄.symm, clear hr_rev_range_check_ptr₄,
  generalize' hr_rev_point1: cast_EcPoint mem (ap50 - 6) = point1,
  simp only [hr_rev_point1] at h_call50,
  have htv_point1 := hr_rev_point1.symm, clear hr_rev_point1,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9] at h_call50 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call50,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9,
  -- function call
  step_sub hpc50 (auto_sound_ec_negate mem _ range_check_ptr₄ point1 _ _ _ _ _),
  { rw hpc51, norm_num2, exact h_mem_11 },
  { rw hpc51, norm_num2, exact h_mem_4 },
  { rw hpc51, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call52 ap52 h_call52,
  rcases h_call52 with ⟨h_call52_ap_offset, h_call52⟩,
  rcases h_call52 with ⟨rc_m52, rc_mle52, hl_range_check_ptr₅, h_call52⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap52 - 7) = range_check_ptr₅,
  have htv_range_check_ptr₅ := hr_rev_range_check_ptr₅.symm, clear hr_rev_range_check_ptr₅,
  generalize' hr_rev_minus_point1: cast_EcPoint mem (ap52 - 6) = minus_point1,
  simp only [hr_rev_minus_point1] at h_call52,
  have htv_minus_point1 := hr_rev_minus_point1.symm, clear hr_rev_minus_point1,
  rw [←htv_range_check_ptr₅, ←htv_range_check_ptr₄] at hl_range_check_ptr₅,
  rw [←htv_range_check_ptr₄, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call52,
  clear ,
  -- local var
  step_assert_eq hpc52 with temp0,
  step_assert_eq hpc53 with temp1,
  step_assert_eq hpc54 with temp2,
  step_assert_eq hpc55 with temp3,
  step_assert_eq hpc56 with temp4,
  step_assert_eq hpc57 with temp5,
  have lc_minus_point1: minus_point1 = cast_EcPoint mem (σ.fp + 9), {
    try { ext } ; {
      try { simp only [htv_minus_point1] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [temp0, temp1, temp2, temp3, temp4, temp5] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  clear temp0 temp1 temp2 temp3 temp4 temp5,
  -- function call
  step_assert_eq hpc58 with arg0,
  step_assert_eq hpc59 with arg1,
  step_assert_eq hpc60 with arg2,
  step_assert_eq hpc61 with arg3,
  step_assert_eq hpc62 with arg4,
  step_assert_eq hpc63 with arg5,
  step_assert_eq hpc64 with arg6,
  step_assert_eq hpc65 with arg7,
  step_assert_eq hpc66 with arg8,
  step_assert_eq hpc67 with arg9,
  step_sub hpc68 (auto_sound_ec_mul mem _ range_check_ptr₅ r_point u2 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc69, norm_num2, exact h_mem_18 },
  { rw hpc69, norm_num2, exact h_mem_4 },
  { rw hpc69, norm_num2, exact h_mem_5 },
  { rw hpc69, norm_num2, exact h_mem_6 },
  { rw hpc69, norm_num2, exact h_mem_7 },
  { rw hpc69, norm_num2, exact h_mem_8 },
  { rw hpc69, norm_num2, exact h_mem_12 },
  { rw hpc69, norm_num2, exact h_mem_13 },
  { rw hpc69, norm_num2, exact h_mem_14 },
  { rw hpc69, norm_num2, exact h_mem_15 },
  { rw hpc69, norm_num2, exact h_mem_16 },
  { rw hpc69, norm_num2, exact h_mem_17 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
    try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call70 ap70 h_call70,
  rcases h_call70 with ⟨rc_m70, rc_mle70, hl_range_check_ptr₆, h_call70⟩,
  generalize' hr_rev_range_check_ptr₆: mem (ap70 - 7) = range_check_ptr₆,
  have htv_range_check_ptr₆ := hr_rev_range_check_ptr₆.symm, clear hr_rev_range_check_ptr₆,
  generalize' hr_rev_point2: cast_EcPoint mem (ap70 - 6) = point2,
  simp only [hr_rev_point2] at h_call70,
  have htv_point2 := hr_rev_point2.symm, clear hr_rev_point2,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9] at hl_range_check_ptr₆ },
  rw [←htv_range_check_ptr₆, ←htv_range_check_ptr₅] at hl_range_check_ptr₆,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9] at h_call70 },
  rw [←htv_range_check_ptr₅, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call70,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9,
  -- function call
  step_assert_eq hpc70 with arg0,
  step_assert_eq hpc71 with arg1,
  step_assert_eq hpc72 with arg2,
  step_assert_eq hpc73 with arg3,
  step_assert_eq hpc74 with arg4,
  step_assert_eq hpc75 with arg5,
  step_assert_eq hpc76 with arg6,
  step_assert_eq hpc77 with arg7,
  step_assert_eq hpc78 with arg8,
  step_assert_eq hpc79 with arg9,
  step_assert_eq hpc80 with arg10,
  step_assert_eq hpc81 with arg11,
  step_assert_eq hpc82 with arg12,
  step_sub hpc83 (auto_sound_ec_add mem _ range_check_ptr₆ minus_point1 point2 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc84, norm_num2, exact h_mem_16 },
  { rw hpc84, norm_num2, exact h_mem_4 },
  { rw hpc84, norm_num2, exact h_mem_5 },
  { rw hpc84, norm_num2, exact h_mem_6 },
  { rw hpc84, norm_num2, exact h_mem_7 },
  { rw hpc84, norm_num2, exact h_mem_8 },
  { rw hpc84, norm_num2, exact h_mem_12 },
  { rw hpc84, norm_num2, exact h_mem_13 },
  { rw hpc84, norm_num2, exact h_mem_14 },
  { rw hpc84, norm_num2, exact h_mem_15 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1, htv_range_check_ptr₆, htv_point2] },
    try { dsimp [cast_BigInt3, cast_EcPoint] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
    try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1, htv_range_check_ptr₆, htv_point2] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1, htv_range_check_ptr₆, htv_point2] },
      try { dsimp [cast_BigInt3, cast_EcPoint] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call85 ap85 h_call85,
  rcases h_call85 with ⟨rc_m85, rc_mle85, hl_range_check_ptr₇, h_call85⟩,
  generalize' hr_rev_range_check_ptr₇: mem (ap85 - 7) = range_check_ptr₇,
  have htv_range_check_ptr₇ := hr_rev_range_check_ptr₇.symm, clear hr_rev_range_check_ptr₇,
  generalize' hr_rev_public_key_point: cast_EcPoint mem (ap85 - 6) = public_key_point,
  simp only [hr_rev_public_key_point] at h_call85,
  have htv_public_key_point := hr_rev_public_key_point.symm, clear hr_rev_public_key_point,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at hl_range_check_ptr₇ },
  rw [←htv_range_check_ptr₇, ←htv_range_check_ptr₆] at hl_range_check_ptr₇,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at h_call85 },
  rw [←htv_range_check_ptr₆, hl_range_check_ptr₆, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call85,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
  -- return
  step_ret hpc85,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m9+rc_m26+rc_m35+rc_m50+rc_m52+rc_m70+rc_m85+0+0), split,
  linarith [rc_mle9, rc_mle26, rc_mle35, rc_mle50, rc_mle52, rc_mle70, rc_mle85],
  split,
  { arith_simps,
    rw [←htv_range_check_ptr₇, hl_range_check_ptr₇, hl_range_check_ptr₆, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_recover_public_key mem _ range_check_ptr msg_hash r s v _ _,
  { apply sound_recover_public_key, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_recover_public_key],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call9],
  use_only [range_check_ptr₁],
  use_only [r_point],
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
  have spec9 := h_call9 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec9,
  try { dsimp at spec9, arith_simps at spec9 },
  use_only [spec9],
  use_only [κ_call17],
  use_only [generator_point],
  try { dsimp at h_call17, arith_simps at h_call17 },
  try { use_only [h_call17] },
  use_only [κ_call26],
  use_only [range_check_ptr₂],
  use_only [u1],
  have rc_h_range_check_ptr₂ := range_checked_offset' rc_h_range_check_ptr₁,
  have rc_h_range_check_ptr₂' := range_checked_add_right rc_h_range_check_ptr₂, try { norm_cast at rc_h_range_check_ptr₂' },
  have spec26 := h_call26 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec26,
  try { dsimp at spec26, arith_simps at spec26 },
  use_only [spec26],
  use_only [κ_call35],
  use_only [range_check_ptr₃],
  use_only [u2],
  have rc_h_range_check_ptr₃ := range_checked_offset' rc_h_range_check_ptr₂,
  have rc_h_range_check_ptr₃' := range_checked_add_right rc_h_range_check_ptr₃, try { norm_cast at rc_h_range_check_ptr₃' },
  have spec35 := h_call35 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec35,
  try { dsimp at spec35, arith_simps at spec35 },
  use_only [spec35],
  use_only [κ_call50],
  use_only [range_check_ptr₄],
  use_only [point1],
  have rc_h_range_check_ptr₄ := range_checked_offset' rc_h_range_check_ptr₃,
  have rc_h_range_check_ptr₄' := range_checked_add_right rc_h_range_check_ptr₄, try { norm_cast at rc_h_range_check_ptr₄' },
  have spec50 := h_call50 rc_h_range_check_ptr₃',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←htv_range_check_ptr₄] at spec50,
  try { dsimp at spec50, arith_simps at spec50 },
  use_only [spec50],
  use_only [κ_call52],
  use_only [range_check_ptr₅],
  use_only [minus_point1],
  have rc_h_range_check_ptr₅ := range_checked_offset' rc_h_range_check_ptr₄,
  have rc_h_range_check_ptr₅' := range_checked_add_right rc_h_range_check_ptr₅, try { norm_cast at rc_h_range_check_ptr₅' },
  have spec52 := h_call52 rc_h_range_check_ptr₄',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←htv_range_check_ptr₅] at spec52,
  try { dsimp at spec52, arith_simps at spec52 },
  use_only [spec52],
  use_only [κ_call70],
  use_only [range_check_ptr₆],
  use_only [point2],
  have rc_h_range_check_ptr₆ := range_checked_offset' rc_h_range_check_ptr₅,
  have rc_h_range_check_ptr₆' := range_checked_add_right rc_h_range_check_ptr₆, try { norm_cast at rc_h_range_check_ptr₆' },
  have spec70 := h_call70 rc_h_range_check_ptr₅',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←hl_range_check_ptr₅, ←htv_range_check_ptr₆] at spec70,
  try { dsimp at spec70, arith_simps at spec70 },
  use_only [spec70],
  use_only [κ_call85],
  use_only [range_check_ptr₇],
  use_only [public_key_point],
  have rc_h_range_check_ptr₇ := range_checked_offset' rc_h_range_check_ptr₆,
  have rc_h_range_check_ptr₇' := range_checked_add_right rc_h_range_check_ptr₇, try { norm_cast at rc_h_range_check_ptr₇' },
  have spec85 := h_call85 rc_h_range_check_ptr₆',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←hl_range_check_ptr₅, ←hl_range_check_ptr₆, ←htv_range_check_ptr₇] at spec85,
  try { dsimp at spec85, arith_simps at spec85 },
  use_only [spec85],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_msg_hash, hin_r, hin_s, hin_v, htv_range_check_ptr₁, htv_r_point, lc_r_point, htv_generator_point, htv_range_check_ptr₂, htv_u1, htv_range_check_ptr₃, htv_u2, lc_u2, htv_range_check_ptr₄, htv_point1, htv_range_check_ptr₅, htv_minus_point1, lc_minus_point1, htv_range_check_ptr₆, htv_point2, htv_range_check_ptr₇, htv_public_key_point] }, },
  try { dsimp [cast_BigInt3, cast_EcPoint] },
  try { simp only [h_call17_ap_offset, h_call26_ap_offset, h_call35_ap_offset, h_call52_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import phase2.approximation

open set
open_locale classical

universe u

namespace con_nf
variables [params.{u}] (α : Λ) [position_data.{}] [phase_2_assumptions α] {β : type_index}
  (π : near_litter_approx) (A : extended_index β)

namespace near_litter_approx

def id_on_flexible : local_perm litter := {
  to_fun := id,
  inv_fun := id,
  domain := {L | flexible α L A} \ π.litter_perm.domain,
  to_fun_domain' := λ L h, h,
  inv_fun_domain' := λ L h, h,
  left_inv' := λ L h, rfl,
  right_inv' := λ L h, rfl,
}

lemma id_on_flexible_domain :
  (id_on_flexible α π A).domain = {L | flexible α L A} \ π.litter_perm.domain := rfl

lemma id_on_flexible_domain_disjoint :
  disjoint π.litter_perm.domain (id_on_flexible α π A).domain :=
by rw [disjoint_iff_inter_eq_empty, id_on_flexible_domain, inter_diff_self]

noncomputable def flexible_completion_litter_perm : local_perm litter :=
local_perm.piecewise π.litter_perm (id_on_flexible α π A) (id_on_flexible_domain_disjoint α π A)

lemma flexible_completion_litter_perm_domain' :
  (flexible_completion_litter_perm α π A).domain = π.litter_perm.domain ∪ {L | flexible α L A} :=
by rw [flexible_completion_litter_perm, local_perm.piecewise_domain,
  id_on_flexible_domain, union_diff_self]

noncomputable def flexible_completion : near_litter_approx := {
  atom_perm := π.atom_perm,
  litter_perm := flexible_completion_litter_perm α π A,
  domain_small := π.domain_small,
}

lemma flexible_completion_litter_perm_domain :
  (flexible_completion α π A).litter_perm.domain = π.litter_perm.domain ∪ {L | flexible α L A} :=
by rw [flexible_completion, flexible_completion_litter_perm_domain']

lemma flexible_completion_litter_perm_domain_free (hπ : π.free α A) :
  (flexible_completion α π A).litter_perm.domain = {L | flexible α L A} :=
begin
  rw [flexible_completion_litter_perm_domain, union_eq_right_iff_subset],
  exact λ L hL, hπ L hL,
end

end near_litter_approx

end con_nf


import for_mathlib.algebra.homology.derived_category

noncomputable theory

open category_theory category_theory.limits category_theory.category
open_locale zero_object

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

namespace category_theory

lemma iso.is_iso_app_iff {C D : Type*} [category C] [category D] {X Y : C} (e : X ≅ Y)
  {F G : C ⥤ D} (φ : F ⟶ G) :
  is_iso (φ.app X) ↔ is_iso (φ.app Y) :=
begin
  suffices : ∀ ⦃X Y : C⦄ (e : X ≅ Y) (hX : is_iso (φ.app X)), is_iso (φ.app Y),
  { exact ⟨this e, this e.symm⟩, },
  intros X Y e,
  introI,
  refine ⟨⟨G.map e.inv ≫ inv (φ.app X) ≫ F.map e.hom,
    by simp only [← functor.map_comp, nat_iso.naturality_2'_assoc, iso.inv_hom_id, functor.map_id],
    by simp only [← functor.map_comp, assoc, nat_trans.naturality, is_iso.inv_hom_id_assoc,
      iso.inv_hom_id, functor.map_id]⟩⟩,
end

end category_theory

namespace category_theory.short_complex
/-- should be moved... -/

lemma exact.of_is_zero_X₂ {C : Type*} [category C] [has_zero_morphisms C]
  (S : short_complex C) (h : is_zero S.X₂) : S.exact :=
begin
  rw (homology_data.of_zeros S (h.eq_of_tgt _ _) (h.eq_of_src _ _)).exact_iff,
  exact h,
end

lemma quasi_iso.of_cokernel_cofork {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) [S₁.has_homology] [S₂.has_homology]
  [mono φ.τ₃] (hf₂ : S₂.f = 0) (hτ₂ : is_colimit (cokernel_cofork.of_π φ.τ₂
    (show S₁.f ≫ φ.τ₂ = 0, by rw [← φ.comm₁₂, hf₂, comp_zero]))) :
  short_complex.quasi_iso φ :=
begin
  have w : S₁.f ≫ φ.τ₂ = 0 := by rw [← φ.comm₁₂, hf₂, comp_zero],
  let h₁ := S₁.some_right_homology_data,
  let e : S₂.X₂ ≅ h₁.Q := is_colimit.cocone_point_unique_up_to_iso hτ₂ h₁.hp,
  have he : φ.τ₂ ≫ e.hom = h₁.p :=
    is_colimit.comp_cocone_point_unique_up_to_iso_hom hτ₂ h₁.hp walking_parallel_pair.one,
  have wp : S₂.f ≫ e.hom = 0 := by simp only [hf₂, zero_comp],
  let hp : is_colimit (cokernel_cofork.of_π e.hom wp) :=
    cokernel_cofork.is_colimit.of_π _ _ (λ A x hx, e.inv ≫ x)
      (λ A x hx, e.hom_inv_id_assoc _) (λ A x hx b hb, by simp only [←hb, iso.inv_hom_id_assoc]),
  have comm : e.inv ≫ S₂.g = h₁.g' ≫ φ.τ₃,
  { rw [← cancel_epi h₁.p, h₁.p_g'_assoc, ← φ.comm₂₃, ← he, assoc, e.hom_inv_id_assoc], },
  have wι : h₁.ι ≫ e.inv ≫ S₂.g = 0 :=
    by simp only [comm, right_homology_data.ι_g'_assoc, zero_comp],
  have hι : is_limit (kernel_fork.of_ι h₁.ι wι) := kernel_fork.is_limit.of_ι _ _
      (λ A x hx, h₁.hι.lift (kernel_fork.of_ι _
        (show x ≫ h₁.g' = 0, by rw [← cancel_mono φ.τ₃, assoc, ← comm, hx, zero_comp])))
      (λ A x hx, fork.is_limit.lift_ι' _ _)
      (λ A x hx b hb, by { erw [← cancel_mono h₁.ι, hb, fork.is_limit.lift_ι'], refl, }),
  let h₂ : S₂.right_homology_data :=
  { Q := h₁.Q,
    H := h₁.H,
    p := e.hom,
    wp := wp,
    hp := hp,
    ι := h₁.ι,
    wι := wι,
    hι := hι, },
  let hφ : right_homology_map_data φ h₁ h₂ :=
  { φQ := 𝟙 _,
    φH := 𝟙 _,
    commp' := begin
      dsimp [h₂],
      simp only [comp_id, he],
    end, },
  rw hφ.quasi_iso_iff,
  dsimp,
  apply_instance,
end

end category_theory.short_complex

open category_theory category_theory.limits category_theory.category

namespace cochain_complex

variables (K L : cochain_complex C ℤ)

def trunc_ge.X (n : ℤ) (i : ℤ) : C :=
if i < n
  then 0
  else if i = n
    then (homological_complex.short_complex_functor C (complex_shape.up ℤ) i ⋙
      short_complex.cycles_co_functor C).obj K
    else K.X i

lemma trunc_ge.is_zero_X (n : ℤ) (i : ℤ) (hn : i < n) :
  is_zero (trunc_ge.X K n i) :=
begin
  dsimp [trunc_ge.X],
  simpa only [if_pos hn] using is_zero_zero C,
end

def trunc_ge.X_iso_X (n : ℤ) (i : ℤ) (hn : n < i) :
  trunc_ge.X K n i ≅ K.X i :=
eq_to_iso begin
  dsimp [trunc_ge.X],
  rw [if_neg (show ¬i<n, by linarith), if_neg (show i ≠ n, by linarith)],
end

def trunc_ge.X_iso_cycles_co (n : ℤ) (i : ℤ) (hn : i = n) :
  trunc_ge.X K n i ≅ (K.sc' i).cycles_co :=
eq_to_iso begin
  dsimp [trunc_ge.X],
  simpa only [if_neg (show ¬ i<n, by linarith), if_pos hn],
end

def trunc_ge.d (n : ℤ) (i j : ℤ) : trunc_ge.X K n i ⟶ trunc_ge.X K n j :=
begin
  by_cases hij : i+1 = j,
  { by_cases hi₀ : i<n,
    { exact 0, },
    { by_cases hn : i = n,
      { refine (trunc_ge.X_iso_cycles_co K n i hn).hom ≫
          short_complex.desc_cycles_co _ (K.d i j ≫ (trunc_ge.X_iso_X K n j (by linarith)).inv) _,
        have hj : j = (complex_shape.up ℤ).next i,
        { rw [next],
          linarith, },
        subst hj,
        erw [reassoc_of ((homological_complex.sc' K i).zero), zero_comp], },
      { exact (trunc_ge.X_iso_X K n i (by { cases (not_lt.1 hi₀).lt_or_eq; tauto, })).hom ≫
          K.d i j ≫ (trunc_ge.X_iso_X K n j (by linarith)).inv, }, }, },
  { exact 0, },
end

def trunc_ge.π_f (n i : ℤ) : K.X i ⟶ trunc_ge.X K n i :=
begin
  by_cases hi : i < n,
  { exact 0, },
  { by_cases hn : i = n,
    { exact (K.sc' i).p_cycles_co ≫ (trunc_ge.X_iso_cycles_co K n i hn).inv, },
    { exact (trunc_ge.X_iso_X K n i (by { cases (not_lt.1 hi).lt_or_eq; tauto, })).inv, }, },
end

instance (n i : ℤ) : epi (trunc_ge.π_f K n i) :=
begin
  dsimp [trunc_ge.π_f],
  by_cases h₀ : i < n,
  { rw dif_pos h₀,
    constructor,
    intros Z f₁ f₂ eq,
    apply (trunc_ge.is_zero_X K n i h₀).eq_of_src, },
  { rw dif_neg h₀,
    by_cases hn : i = n,
    { rw dif_pos hn,
      apply epi_comp, },
    { rw dif_neg hn,
      apply_instance, }, },
end

lemma trunc_ge.is_iso_π_f (n i : ℤ) (hi : n < i) :
  is_iso (trunc_ge.π_f K n i) :=
begin
  dsimp [trunc_ge.π_f],
  simp only [dif_neg (show ¬ i < n, by linarith),
    dif_neg (show i ≠ n, by linarith)],
  apply_instance,
end

lemma trunc_ge.π_f_eq_zero (n i : ℤ) (hi : i < n) :
  trunc_ge.π_f K n i = 0 :=
by { dsimp [trunc_ge.π_f], rw [dif_pos hi], }

lemma trunc_ge.π_f_eq_of_eq (n i : ℤ) (hn : i = n) :
  trunc_ge.π_f K n i = (K.sc' i).p_cycles_co ≫ (trunc_ge.X_iso_cycles_co K n i hn).inv :=
by { dsimp [trunc_ge.π_f], rw [dif_neg (show ¬i<n, by linarith), dif_pos hn], }

lemma trunc_ge.π_f_eq_X_iso_X_inv (n i : ℤ) (hi : n < i) :
  trunc_ge.π_f K n i = (trunc_ge.X_iso_X K n i hi).inv :=
by { dsimp [trunc_ge.π_f], rw [dif_neg, dif_neg]; linarith, }

lemma trunc_ge.shape (n i j : ℤ) (hij : i+1 ≠ j) : trunc_ge.d K n i j = 0 :=
by { dsimp only [trunc_ge.d], rw dif_neg hij, }

lemma trunc_ge.d_eq_zero (n : ℤ) (i j : ℤ) (hj : j ≤ n) :
  trunc_ge.d K n i j = 0 :=
begin
  by_cases hij : i+1 = j,
  { dsimp [trunc_ge.d],
    rw [dif_pos hij, dif_pos],
    linarith, },
  { rw trunc_ge.shape K n i j hij, },
end

lemma trunc_ge.d_eq_d (n : ℤ) (i j : ℤ) (hij : i + 1 = j) (hi : n < i) :
  trunc_ge.d K n i j = (trunc_ge.X_iso_X K n i hi).hom ≫ K.d i j ≫
    (trunc_ge.X_iso_X K n j (by simpa only [← hij] using hi.trans (lt_add_one i))).inv :=
by { dsimp [trunc_ge.d], rw [dif_pos hij, dif_neg, dif_neg]; linarith, }

lemma trunc_ge.d_comp_π_eq_zero (n : ℤ) (i j : ℤ) (hij : i + 1 = j) (hj : j = n) :
  K.d i j ≫ trunc_ge.π_f K n j = 0 :=
begin
  have hi : i = (complex_shape.up ℤ).prev j := by { rw [prev], linarith, },
  subst hi,
  dsimp [trunc_ge.π_f],
  erw [dif_neg (show ¬j<n, by linarith), dif_pos hj, ← assoc,
    (homological_complex.sc' K j).f_cycles_co_p, zero_comp],
end

def trunc_ge.π_is_cokernel (n i j : ℤ) (hij : i + 1 = j) (hj : j = n) :
  is_colimit (cokernel_cofork.of_π _ (trunc_ge.d_comp_π_eq_zero K n i j hij hj)) :=
begin
  have hij' : i = (complex_shape.up ℤ).prev j := by { rw [prev], linarith, },
  subst hij',
  exact is_colimit.of_iso_colimit (homological_complex.sc' K j).cycles_co_is_cokernel
    (cofork.ext (trunc_ge.X_iso_cycles_co K n j hj).symm (trunc_ge.π_f_eq_of_eq K n j hj).symm),
end

@[simp, reassoc]
lemma trunc_ge.d_comm (n i j : ℤ) :
  trunc_ge.π_f K n i ≫ trunc_ge.d K n i j =
    K.d i j ≫ trunc_ge.π_f K n j :=
begin
  by_cases hij : i+1 = j,
  { by_cases hj₀ : j < n,
    { apply (trunc_ge.is_zero_X K n j hj₀).eq_of_tgt, },
    by_cases hj : j = n,
    { simp only [trunc_ge.d_comp_π_eq_zero K n i j hij hj,
        trunc_ge.d_eq_zero K n i j (by linarith), comp_zero], },
    by_cases hi : i = n,
    { dsimp [trunc_ge.d, trunc_ge.π_f],
      simp only [dif_pos hij, dif_neg (show ¬ i < n, by linarith), dif_pos hi, dif_neg hj₀,
        trunc_ge.π_f_eq_X_iso_X_inv K n j (by linarith), assoc, iso.inv_hom_id_assoc,
        dif_neg hj, short_complex.p_desc_cycles_co], },
    { have hi' : n < i,
      { subst hij,
        cases (not_lt.1 hj₀).lt_or_eq,
        { rw int.lt_add_one_iff at h,
          cases h.lt_or_eq with h' h',
          { exact h', },
          { exfalso, exact hi h'.symm, }, },
        { exfalso, exact hj h.symm, }, },
      simp only [trunc_ge.d_eq_d K n i j hij hi', trunc_ge.π_f_eq_X_iso_X_inv K n i hi',
        trunc_ge.π_f_eq_X_iso_X_inv K n j (by linarith), iso.inv_hom_id_assoc], }, },
  { rw [trunc_ge.shape K n i j hij, K.shape i j hij, zero_comp, comp_zero], },
end

@[simp, reassoc]
lemma trunc_ge.d_comp_d (n i j k : ℤ) : trunc_ge.d K n i j ≫ trunc_ge.d K n j k = 0 :=
by simp only [← cancel_epi (trunc_ge.π_f K n i), trunc_ge.d_comm_assoc,
  trunc_ge.d_comm, homological_complex.d_comp_d_assoc, zero_comp, comp_zero]

@[simps]
def trunc_ge (n : ℤ) : cochain_complex C ℤ :=
{ X := trunc_ge.X K n,
  d := trunc_ge.d K n,
  shape' := trunc_ge.shape K n,
  d_comp_d' := λ i j k hij hjk, trunc_ge.d_comp_d K n i j k, }

@[simps]
def trunc_ge.π (n : ℤ) : K ⟶ K.trunc_ge n :=
{ f := trunc_ge.π_f K n,
  comm' := λ i j hij, trunc_ge.d_comm K n i j, }

variables {K L}

def trunc_ge.map_f (φ : K ⟶ L) (n i : ℤ) :
  (K.trunc_ge n).X i ⟶ (L.trunc_ge n).X i :=
begin
  by_cases hi : n < i,
  { exact (trunc_ge.X_iso_X K n i hi).hom ≫ φ.f i ≫
    (trunc_ge.X_iso_X L n i hi).inv, },
  { by_cases hn : i = n,
    { exact (trunc_ge.X_iso_cycles_co K n i hn).hom ≫
        (homological_complex.short_complex_functor C (complex_shape.up ℤ) i ⋙
        short_complex.cycles_co_functor C).map φ ≫ (trunc_ge.X_iso_cycles_co L n i hn).inv, },
    { exact 0, }, },
end

lemma trunc_ge.map_f_eq_f (φ : K ⟶ L) (n i : ℤ) (hi : n < i) :
  trunc_ge.map_f φ n i = (trunc_ge.X_iso_X K n i hi).hom ≫ φ.f i ≫
    (trunc_ge.X_iso_X L n i hi).inv :=
begin
  dsimp only [trunc_ge.map_f],
  simp only [dif_pos hi],
end

@[simp, reassoc]
lemma trunc_ge.π_f_comm_map_f (φ : K ⟶ L) (n i : ℤ) :
  trunc_ge.π_f K n i ≫ trunc_ge.map_f φ n i =
    φ.f i ≫ trunc_ge.π_f L n i :=
begin
  by_cases hi : n < i,
  { simp only [trunc_ge.π_f_eq_X_iso_X_inv _ n i hi,
      trunc_ge.map_f_eq_f φ n i hi, iso.inv_hom_id_assoc], },
  { by_cases hn : i = n,
    { dsimp [trunc_ge.map_f, trunc_ge.π_f],
      simp only [dif_neg hi, dif_pos hn, dif_neg (show ¬ i < n, by linarith), assoc,
        iso.inv_hom_id_assoc],
      exact ((short_complex.p_cycles_co_nat_trans C).naturality_assoc
        ((homological_complex.short_complex_functor C (complex_shape.up ℤ) i).map φ) _).symm, },
    { refine (trunc_ge.is_zero_X L n i _).eq_of_tgt _ _,
      cases (not_lt.1 hi).lt_or_eq,
      { exact h, },
      { exfalso, exact hn h, }, }, },
end

@[reassoc]
lemma trunc_ge.map_comm_f (φ : K ⟶ L) (n i j : ℤ) :
  trunc_ge.map_f φ n i ≫ trunc_ge.d L n i j =
    trunc_ge.d K n i j ≫ trunc_ge.map_f φ n j :=
by simp only [← cancel_epi (trunc_ge.π_f K n i), trunc_ge.π_f_comm_map_f_assoc,
  trunc_ge.d_comm, homological_complex.hom.comm_assoc,
  trunc_ge.d_comm_assoc, trunc_ge.π_f_comm_map_f]

@[simp]
lemma trunc_ge.map_id_f (K : cochain_complex C ℤ) (n i : ℤ) :
  trunc_ge.map_f (𝟙 K) n i = 𝟙 _ :=
begin
  simp only [← cancel_epi (trunc_ge.π_f K n i), trunc_ge.π_f_comm_map_f,
    homological_complex.id_f, id_comp],
  erw comp_id,
end

@[simp]
lemma trunc_ge.map_comp_f {K L M : cochain_complex C ℤ}
  (φ : K ⟶ L) (φ' : L ⟶ M) (n i : ℤ) :
  trunc_ge.map_f (φ ≫ φ') n i =
    trunc_ge.map_f φ n i ≫ trunc_ge.map_f φ' n i :=
by simp only [← cancel_epi (trunc_ge.π_f K n i), trunc_ge.π_f_comm_map_f,
    homological_complex.comp_f, assoc, trunc_ge.π_f_comm_map_f_assoc]

variable (C)

@[simps]
def trunc_ge_functor (n : ℤ) :
  cochain_complex C ℤ ⥤ cochain_complex C ℤ :=
{ obj := λ K, K.trunc_ge n,
  map := λ K L φ,
  { f := λ i, trunc_ge.map_f φ n i,
    comm' := λ i j hij, trunc_ge.map_comm_f φ n i j, }, }

@[simps]
def trunc_ge.nat_trans_π (n : ℤ) :
  𝟭 _ ⟶ trunc_ge_functor C n :=
{ app := λ K, trunc_ge.π K n,
  naturality' := λ K L φ, begin
    ext i
    dsimp,
    simp only [functor.id_map, homological_complex.comp_f, trunc_ge_functor_map_f],
    dsimp,
    simp only [trunc_ge.π_f_comm_map_f],
  end, }

variables {C} (K)

lemma trunc_ge.is_zero_homology (n i : ℤ) (hi : i < n) :
  is_zero ((homology_functor C _ i).obj (K.trunc_ge n)) :=
begin
  dsimp [homology_functor],
  rw ← short_complex.exact_iff_is_zero_homology,
  exact short_complex.exact.of_is_zero_X₂ _ (trunc_ge.is_zero_X K n i hi),
end

lemma trunc_ge.is_iso_homology_map_π (n i : ℤ) (hi : n ≤ i) :
  is_iso ((homology_functor C _ i).map (trunc_ge.π K n)) :=
begin
  let φ := (homological_complex.short_complex_functor C (complex_shape.up ℤ) i).map
    (trunc_ge.π K n),
  haveI : is_iso φ.τ₃ := trunc_ge.is_iso_π_f K n _ (by { rw [next], linarith, }),
  cases hi.lt_or_eq,
  { haveI : epi φ.τ₁ := by { dsimp, apply_instance, },
    haveI : is_iso φ.τ₂ := trunc_ge.is_iso_π_f K n i h,
    exact short_complex.quasi_iso.of_epi_of_is_iso_of_mono φ, },
  { exact short_complex.quasi_iso.of_cokernel_cofork φ
      ((trunc_ge.is_zero_X K n _ (by { rw [prev], linarith, })).eq_of_src _ _)
      (trunc_ge.π_is_cokernel K n _ i (by { rw [prev], linarith, }) h.symm), },
end

variables {K L}

lemma trunc_ge.map_homology_iso (φ : K ⟶ L) (n i : ℤ) [is_iso (homology_map φ i)] :
  is_iso (homology_map ((trunc_ge_functor C n).map φ) i) :=
begin
  by_cases hi : n ≤ i,
  { have eq := (homology_functor C _ i).congr_map ((trunc_ge.nat_trans_π C n).naturality φ),
    simp only [functor.map_comp, functor.id_map, trunc_ge.nat_trans_π_app] at eq,
    change homology_map φ i ≫ homology_map (trunc_ge.π L n) i =
      homology_map (trunc_ge.π K n) i ≫ homology_map _ i at eq,
    haveI : ∀ (M : cochain_complex C ℤ), is_iso (homology_map (trunc_ge.π M n) i) :=
      λ M, trunc_ge.is_iso_homology_map_π M n i hi,
    simp only [← cancel_epi (inv (homology_map (trunc_ge.π K n) i)),
      is_iso.inv_hom_id_assoc] at eq,
    rw ← eq,
    apply_instance, },
  { simp only [not_le] at hi,
    exact ⟨⟨0, (trunc_ge.is_zero_homology K n i hi).eq_of_src _ _,
       (trunc_ge.is_zero_homology L n i hi).eq_of_src _ _⟩⟩, },
end

instance trunc_ge.map_quasi_iso (φ : K ⟶ L) (n : ℤ) [quasi_iso φ] :
  quasi_iso ((trunc_ge_functor _ n).map φ) :=
⟨λ i, trunc_ge.map_homology_iso φ n i⟩

variable (C)

lemma trunc_ge_functor_comp_Q_inverts_quasi_isomorphisms (n : ℤ) :
  (quasi_isomorphisms _ _).is_inverted_by
    (cochain_complex.trunc_ge_functor C n ⋙ derived_category.Q) :=
λ K L φ hφ, begin
  haveI : quasi_iso φ := by simpa only [← mem_quasi_isomorphisms_iff] using hφ,
  dsimp,
  apply_instance,
end

variable {C}

class is_strictly_ge (K : cochain_complex C ℤ) (n : ℤ) : Prop :=
(is_zero' : ∀ (i : ℤ) (hi : i < n), is_zero (K.X i))

lemma is_strictly_ge.is_zero (K : cochain_complex C ℤ) (n i : ℤ) [K.is_strictly_ge n]
  (hi : i < n) : is_zero (K.X i) :=
is_strictly_ge.is_zero' i hi

lemma is_strictly_ge_of_le (K : cochain_complex C ℤ) (n m : ℤ) (hnm : n ≤ m)
  [K.is_strictly_ge m] :
  K.is_strictly_ge n :=
⟨λ i hi, is_strictly_ge.is_zero K m i (by linarith)⟩

lemma is_strictly_ge.of_iso {K L : cochain_complex C ℤ} (e : K ≅ L) (n : ℤ)
  [K.is_strictly_ge n] : L.is_strictly_ge n :=
⟨λ i hi, is_zero.of_iso (is_strictly_ge.is_zero K n i hi)
  ((homological_complex.eval _ _ i).map_iso e.symm)⟩

lemma is_strictly_ge.iff_of_iso {K L : cochain_complex C ℤ} (e : K ≅ L) (n : ℤ) :
  K.is_strictly_ge n ↔ L.is_strictly_ge n :=
begin
  split,
  { introI,
    exact is_strictly_ge.of_iso e n, },
  { introI,
    exact is_strictly_ge.of_iso e.symm n, },
end

class is_ge (K : cochain_complex C ℤ) (n : ℤ) : Prop :=
(is_zero' : ∀ (i : ℤ) (hi : i < n ), is_zero (K.homology i))

lemma is_ge.is_zero (K : cochain_complex C ℤ) (n i : ℤ) [K.is_ge n] (hi : i < n) :
  is_zero (K.homology i) :=
is_ge.is_zero' i hi

lemma is_ge_of_le (K : cochain_complex C ℤ) (n m : ℤ) (hnm : n ≤ m) [K.is_ge m] : K.is_ge n :=
⟨λ i hi, is_ge.is_zero K m i (by linarith)⟩

lemma is_ge.of_iso {K L : cochain_complex C ℤ} (e : K ≅ L) (n : ℤ) [K.is_ge n] : L.is_ge n :=
⟨λ i hi, is_zero.of_iso (is_ge.is_zero K n i hi) ((homology_functor _ _ i).map_iso e.symm)⟩

lemma is_ge.iff_of_iso {K L : cochain_complex C ℤ} (e : K ≅ L) (n : ℤ) :
  K.is_ge n ↔ L.is_ge n :=
begin
  split,
  { introI,
    exact is_ge.of_iso e n, },
  { introI,
    exact is_ge.of_iso e.symm n, },
end

@[priority 100]
instance is_ge_of_is_strictly_ge (K : cochain_complex C ℤ) (n : ℤ)
  [K.is_strictly_ge n] : K.is_ge n :=
⟨λ i hi, begin
  rw ← short_complex.exact_iff_is_zero_homology,
  exact short_complex.exact.of_is_zero_X₂ _ (is_strictly_ge.is_zero K n i hi),
end⟩

instance trunc_ge_is_strictly_ge (K : cochain_complex C ℤ) (n : ℤ) :
  (K.trunc_ge n).is_strictly_ge n :=
⟨trunc_ge.is_zero_X K n⟩

instance trunc_ge_is_strictly_ge' (K : cochain_complex C ℤ) (n : ℤ) :
  ((trunc_ge_functor C n).obj K).is_strictly_ge n :=
(infer_instance : (K.trunc_ge n).is_strictly_ge n)

lemma trunc_ge.is_iso_π_f_iff_d_eq_zero (K : cochain_complex C ℤ) (n i j : ℤ)
  (hij : i+1 = j) (hj : j = n) :
  is_iso ((trunc_ge.π K n).f j) ↔ K.d i j = 0 :=
begin
  split,
  { intro h,
    haveI : is_iso (trunc_ge.π_f K n j) := h,
    rw [← cancel_mono (trunc_ge.π_f K n j), trunc_ge.d_comp_π_eq_zero K n i j hij hj,
      zero_comp], },
  { exact cokernel_cofork.is_colimit.is_iso_π_of_zero _ (trunc_ge.π_is_cokernel K n i j hij hj), },
end

instance (K : cochain_complex C ℤ) (n : ℤ) [K.is_strictly_ge n] :
  is_iso (trunc_ge.π K n) :=
begin
  haveI : ∀ (i : ℤ), is_iso ((trunc_ge.π K n).f i),
  { intro i,
    by_cases hi : n < i,
    { exact trunc_ge.is_iso_π_f K n i hi, },
    { cases (not_lt.1 hi).lt_or_eq,
      { refine ⟨⟨0, (is_strictly_ge.is_zero K n i h).eq_of_src _ _, _⟩⟩,
        rw ← cancel_epi (trunc_ge.π_f K n i),
        apply (is_strictly_ge.is_zero K n i h).eq_of_src, },
      { rw trunc_ge.is_iso_π_f_iff_d_eq_zero K n (i-1) i (by linarith) h,
        apply (is_strictly_ge.is_zero K n (i-1) (by linarith)).eq_of_src, }, }, },
  apply homological_complex.hom.is_iso_of_components,
end

end cochain_complex

namespace derived_category

variable (C)

def trunc_ge_functor (n : ℤ) : derived_category C ⥤ derived_category C :=
localization.lift _ (cochain_complex.trunc_ge_functor_comp_Q_inverts_quasi_isomorphisms C n) Q

instance (n : ℤ) : localization.lifting Q (quasi_isomorphisms _ _)
  (cochain_complex.trunc_ge_functor C n ⋙ derived_category.Q) (trunc_ge_functor C n) :=
localization.lifting_lift _ _ _

def trunc_ge_functor_iso (n : ℤ) :
  Q ⋙ trunc_ge_functor C n ≅ (cochain_complex.trunc_ge_functor C n ⋙ derived_category.Q) :=
localization.lifting.iso _ (quasi_isomorphisms _ _) _ _

def trunc_ge_nat_trans_π (n : ℤ) : 𝟭 (derived_category C) ⟶ trunc_ge_functor C n :=
localization.lift_nat_trans Q (quasi_isomorphisms _ _)
  Q (cochain_complex.trunc_ge_functor C n ⋙ derived_category.Q) _ _
  (whisker_right (cochain_complex.trunc_ge.nat_trans_π C n) Q)

@[simp]
lemma trunc_ge_nat_trans_π_app (K : cochain_complex C ℤ) (n : ℤ) :
  (trunc_ge_nat_trans_π C n).app (Q.obj K) =
    Q.map (cochain_complex.trunc_ge.π K n) ≫ (trunc_ge_functor_iso C n).inv.app K :=
begin
  dsimp only [trunc_ge_nat_trans_π, trunc_ge_functor_iso],
  simp only [localization.lifting.id_iso, functor.right_unitor_hom_app, whisker_right_app,
    cochain_complex.trunc_ge.nat_trans_π_app, localization.lift_nat_trans_app],
  dsimp,
  rw id_comp,
end

variable {C}

class is_ge (K : derived_category C) (n : ℤ) : Prop :=
(is_zero' : ∀ (i : ℤ) (hi : i < n ), is_zero (K.homology i))

lemma is_ge.is_zero (K : derived_category C) (n i : ℤ) [K.is_ge n]
  (hi : i < n) : is_zero (K.homology i) :=
is_ge.is_zero' i hi

lemma is_ge_of_le (K : derived_category C) (n m : ℤ) (hnm : n ≤ m) [K.is_ge m] : K.is_ge n :=
⟨λ i hi, is_ge.is_zero K m i (by linarith)⟩

lemma is_ge.of_iso {K L : derived_category C} (e : K ≅ L) (n : ℤ) [K.is_ge n] : L.is_ge n :=
⟨λ i hi, is_zero.of_iso (is_ge.is_zero K n i hi) ((homology_functor _ i).map_iso e.symm)⟩

lemma is_ge.iff_of_iso {K L : derived_category C} (e : K ≅ L) (n : ℤ) :
  K.is_ge n ↔ L.is_ge n :=
begin
  split,
  { introI,
    exact is_ge.of_iso e n, },
  { introI,
    exact is_ge.of_iso e.symm n, },
end

variable (C)

def Q_comp_trunc_ge_functor_comp_homology_functor_iso (n i : ℤ) :
  Q ⋙ trunc_ge_functor C n ⋙ homology_functor C i ≅
    cochain_complex.trunc_ge_functor C n ⋙ _root_.homology_functor _ _ i :=
(functor.associator _ _ _).symm ≪≫
  iso_whisker_right (trunc_ge_functor_iso C n) (homology_functor C i) ≪≫
  functor.associator _ _ _ ≪≫ iso_whisker_left _ (homology_functor_factors C i)

variable {C}

lemma is_zero_homology_trunc_ge_of_lt (K : derived_category C) (n i : ℤ)
  (hi : i < n) :
  is_zero (((trunc_ge_functor C n).obj K).homology i) :=
is_zero.of_iso (cochain_complex.is_ge.is_zero _ n i hi)
  (((trunc_ge_functor C n ⋙ homology_functor C i).map_iso (Q.obj_obj_preimage_iso K)).symm ≪≫
    ((Q_comp_trunc_ge_functor_comp_homology_functor_iso C n i).app _))

lemma is_iso_homology_map_trunc_ge_nat_trans_π_of_ge (K : derived_category C) (n i : ℤ)
  (hi : n ≤ i) :
  is_iso ((homology_functor C i).map ((trunc_ge_nat_trans_π C n).app K)) :=
begin
  erw ← (Q.obj_obj_preimage_iso K).is_iso_app_iff
    (whisker_right (trunc_ge_nat_trans_π C n) (homology_functor C i)),
  dsimp,
  erw [trunc_ge_nat_trans_π_app, functor.map_comp],
  haveI : ∀ (L : cochain_complex C ℤ), is_iso ((homology_functor C i).map (Q.map
    (cochain_complex.trunc_ge.π L n))),
  { intro L,
    erw nat_iso.is_iso_map_iff (homology_functor_factors C i),
    exact cochain_complex.trunc_ge.is_iso_homology_map_π L n i hi, },
  apply_instance,
end

lemma is_iso_trunc_ge_nat_trans_π_app_iff (K : derived_category C) (n : ℤ) :
  is_iso ((trunc_ge_nat_trans_π C n).app K) ↔ K.is_ge n :=
begin
  rw is_iso_iff_is_iso_homology,
  split,
  { introI hK,
    exact ⟨λ i hi, is_zero.of_iso (is_zero_homology_trunc_ge_of_lt K n i hi)
      (as_iso ((homology_functor C i).map ((trunc_ge_nat_trans_π C n).app K)))⟩, },
  { introI,
    intro i,
    by_cases hi : n ≤ i,
    { exact is_iso_homology_map_trunc_ge_nat_trans_π_of_ge K n i hi, },
    { simp only [not_le] at hi,
      exact ⟨⟨0, (is_ge.is_zero K n i hi).eq_of_src _ _,
        (is_zero_homology_trunc_ge_of_lt K n i hi).eq_of_src _ _⟩⟩, }, },
end

instance (K : derived_category C) (n : ℤ) [K.is_ge n] :
  is_iso ((trunc_ge_nat_trans_π C n).app K) :=
by { rw is_iso_trunc_ge_nat_trans_π_app_iff, apply_instance, }

end derived_category

namespace cochain_complex

lemma is_zero_homology_iff_is_zero_homology_Q_obj (K : cochain_complex C ℤ) (n : ℤ) :
  is_zero (K.homology n) ↔ is_zero ((derived_category.Q.obj K).homology n) :=
((derived_category.homology_functor_factors C n).app K).symm.is_zero_iff

lemma is_ge_iff_Q_obj_is_ge (K : cochain_complex C ℤ) (n : ℤ) :
  K.is_ge n ↔ (derived_category.Q.obj K).is_ge n :=
begin
  split,
  { introI,
    exact ⟨λ i hi, by simpa only [← is_zero_homology_iff_is_zero_homology_Q_obj]
      using is_ge.is_zero K n i hi⟩, },
  { introI,
    exact ⟨λ i hi, by simpa only [is_zero_homology_iff_is_zero_homology_Q_obj]
      using derived_category.is_ge.is_zero (derived_category.Q.obj _) n i hi⟩, },
end

instance Q_obj_is_ge_of_is_ge (K : cochain_complex C ℤ) (n : ℤ) [K.is_ge n] :
  (derived_category.Q.obj K).is_ge n :=
begin
  rw ← is_ge_iff_Q_obj_is_ge,
  apply_instance,
end

lemma is_ge_iff_of_quasi_iso {K L : cochain_complex C ℤ} (φ : K ⟶ L) [quasi_iso φ] (n : ℤ) :
  K.is_ge n ↔ L.is_ge n :=
begin
  simp only [is_ge_iff_Q_obj_is_ge],
  exact derived_category.is_ge.iff_of_iso (as_iso (derived_category.Q.map φ)) n,
end

lemma quasi_iso_trunc_ge_π_iff (K : cochain_complex C ℤ) (n : ℤ) :
  quasi_iso (trunc_ge.π K n) ↔ K.is_ge n :=
begin
  rw [is_ge_iff_Q_obj_is_ge, ← derived_category.is_iso_Q_map_iff,
    ← derived_category.is_iso_trunc_ge_nat_trans_π_app_iff,
    derived_category.trunc_ge_nat_trans_π_app],
  split,
  { introI,
    apply_instance, },
  { apply is_iso.of_is_iso_comp_right, },
end

instance (K : cochain_complex C ℤ) (n : ℤ) [K.is_ge n] :
  quasi_iso (trunc_ge.π K n) :=
by { rw quasi_iso_trunc_ge_π_iff, apply_instance, }

end cochain_complex

namespace derived_category

lemma left_factorisation_of_is_ge {K L : cochain_complex C ℤ} (φ : Q.obj K ⟶ Q.obj L) (n : ℤ)
  [L.is_ge n] :
  ∃ (L' : cochain_complex C ℤ) (hL' : L'.is_strictly_ge n) (f : K ⟶ L') (s : L ⟶ L') (hs : quasi_iso s),
    φ = Q.map f ≫ (by { haveI := hs, exact inv (Q.map s), }) :=
begin
  obtain ⟨L', f, s, hs, eq⟩ := left_factorisation φ,
  haveI := hs,
  haveI : quasi_iso ((cochain_complex.trunc_ge.nat_trans_π C n).app L'),
  { erw cochain_complex.quasi_iso_trunc_ge_π_iff,
    dsimp,
    rw ← cochain_complex.is_ge_iff_of_quasi_iso s,
    apply_instance, },
  exact ⟨_, infer_instance,
    f ≫ (cochain_complex.trunc_ge.nat_trans_π _ n).app L',
    s ≫ (cochain_complex.trunc_ge.nat_trans_π _ n).app L', infer_instance,
    by simp only [assoc, functor.map_comp, is_iso.inv_comp, is_iso.hom_inv_id_assoc, eq]⟩,
end

lemma right_factorisation_of_is_strictly_ge {K L : cochain_complex C ℤ} (φ : Q.obj K ⟶ Q.obj L)
  (n : ℤ) [K.is_strictly_ge n] [L.is_strictly_ge n] :
  ∃ (K' : cochain_complex C ℤ) (hK' : K'.is_strictly_ge n) (s : K' ⟶ K) (f : K' ⟶ L) (hs : quasi_iso s),
    φ = (by { haveI := hs, exact inv (Q.map s), }) ≫ Q.map f :=
begin
  obtain ⟨K', s, f, hs, eq⟩ := right_factorisation φ,
  haveI := hs,
  haveI : quasi_iso (cochain_complex.trunc_ge.π K' n),
  { rw [cochain_complex.quasi_iso_trunc_ge_π_iff, cochain_complex.is_ge_iff_of_quasi_iso s],
    apply_instance, },
  refine ⟨(cochain_complex.trunc_ge K' n), infer_instance,
    (cochain_complex.trunc_ge_functor C n).map s ≫
      category_theory.inv (cochain_complex.trunc_ge.π K n),
    (cochain_complex.trunc_ge_functor C n).map f ≫
      category_theory.inv (cochain_complex.trunc_ge.π L n), infer_instance, _⟩,
  have comms := Q.congr_map ((cochain_complex.trunc_ge.nat_trans_π C n).naturality s),
  have commf := Q.congr_map ((cochain_complex.trunc_ge.nat_trans_π C n).naturality f),
  dsimp at comms commf,
  simp only [Q.map_comp, ← cancel_epi (inv (Q.map (cochain_complex.trunc_ge.π K' n))),
    is_iso.inv_hom_id_assoc] at comms commf,
  simp only [eq, Q.map_comp, ← commf, ← comms, functor.map_inv, assoc, is_iso.hom_inv_id, comp_id,
    is_iso.hom_inv_id_assoc, is_iso.eq_inv_comp],
end

lemma exists_iso_Q_obj_of_ge (K : derived_category C) (n : ℤ) [K.is_ge n] :
  ∃ (K' : cochain_complex C ℤ) (hK' : K'.is_strictly_ge n),
    nonempty (K ≅ Q.obj K') :=
begin
  let K' := Q.obj_preimage K,
  haveI : K'.is_ge n,
  { rw [cochain_complex.is_ge_iff_Q_obj_is_ge, is_ge.iff_of_iso (Q.obj_obj_preimage_iso K)],
    apply_instance, },
  exact ⟨K'.trunc_ge n, infer_instance, ⟨(Q.obj_obj_preimage_iso K).symm ≪≫
    (as_iso ((trunc_ge_nat_trans_π C n).app (Q.obj K'))) ≪≫
    (trunc_ge_functor_iso C n).app K'⟩⟩,
end

end derived_category


import category_theory.abelian.exact
import .split_exact

universes v u u'

namespace category_theory

namespace functor

open category_theory.limits

variables {A : Type u} {B : Type u'} [category.{v} A] [category.{v} B]
  [abelian A] [abelian B] (F : A ⥤ B) [functor.additive F]
  [preserves_finite_limits F] [preserves_finite_colimits F]

variables {X Y Z : A} (f : X ⟶ Y) (g : Y ⟶ Z)

lemma map_short_exact (h : short_exact f g) : short_exact (F.map f) (F.map g) :=
begin
  rcases h with ⟨hfg⟩,
  haveI : mono (F.map f),
  { rw (abelian.tfae_mono X f).out 0 2 at h_mono,
    rw (abelian.tfae_mono (F.obj X) (F.map f)).out 0 2,
    have := F.map_exact _ _ h_mono, rwa F.map_zero at this, },
  haveI : epi (F.map g),
  { rw (abelian.tfae_epi Z g).out 0 2 at h_epi,
    rw (abelian.tfae_epi (F.obj Z) (F.map g)).out 0 2,
    have := F.map_exact _ _ h_epi, rwa F.map_zero at this, },
  refine ⟨F.map_exact f g hfg⟩,
end

end functor

end category_theory


import tactic.linarith
import category_theory.triangulated.rotate
import for_mathlib.category_theory.triangulated.shift_compatibility
import for_mathlib.category_theory.triangulated.pretriangulated_misc
import for_mathlib.category_theory.functor.shift
import for_mathlib.category_theory.triangulated.triangulated_functor

noncomputable theory

namespace category_theory

open limits

namespace pretriangulated

open preadditive category pretriangulated

variables (C : Type*) [category C] [preadditive C] [has_shift C ℤ]

@[simps]
def triangle.shift_functor (n : ℤ) : triangle C ⥤ triangle C :=
{ obj := λ T, begin
    let ε : ℤ := ↑((-1 : units ℤ) ^ n),
    exact triangle.mk (ε • (shift_functor C n).map T.mor₁)
      (ε • (shift_functor C n).map T.mor₂)
      ((ε • (shift_functor C n).map T.mor₃) ≫ (shift_functor_add_comm C 1 n).hom.app _),
  end,
  map := λ T₁ T₂ f,
  { hom₁ := (shift_functor C n).map f.hom₁,
    hom₂ := (shift_functor C n).map f.hom₂,
    hom₃ := (shift_functor C n).map f.hom₃,
    comm₁' := by { dsimp, simp only [preadditive.zsmul_comp, preadditive.comp_zsmul,
      ← functor.map_comp, f.comm₁], },
    comm₂' := by { dsimp, simp only [preadditive.zsmul_comp, preadditive.comp_zsmul,
      ← functor.map_comp, f.comm₂], },
    comm₃' := by { dsimp,
      simp only [assoc, preadditive.zsmul_comp, preadditive.comp_zsmul, ← functor.map_comp_assoc,
        ← f.comm₃],
      simp only [functor.map_comp, assoc],
      erw ← nat_trans.naturality,
      refl, }, }, }

variables [has_zero_object C] [∀ (n : ℤ), functor.additive (shift_functor C n)]

def triangle.shift_functor_one_iso : triangle.shift_functor C 1 ≅ rotate C ⋙ rotate C ⋙ rotate C :=
nat_iso.of_components
  (λ T, triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (iso.refl _) (by tidy) (by tidy) begin
    dsimp,
    simp only [zpow_one, units.coe_neg_one, neg_smul, one_zsmul, neg_comp, functor.map_id,
      comp_id, id_comp, neg_inj, shift_functor_add_comm_eq_refl, iso.refl_hom, nat_trans.id_app],
    apply comp_id,
  end)
  (by tidy)

local attribute [reducible] discrete.add_monoidal

def triangle.shift_functor_zero : triangle.shift_functor C 0 ≅ 𝟭 _ :=
nat_iso.of_components (λ T, triangle.mk_iso _ _ ((shift_functor_zero C ℤ).app _)
  ((shift_functor_zero C ℤ).app _) ((shift_functor_zero C ℤ).app _) (by tidy) (by tidy) begin
  dsimp,
  simp only [zpow_zero, units.coe_one, one_zsmul, assoc, shift_functor_add_comm_hom_app],
  erw ← nat_trans.naturality,
  congr' 1,
  dsimp,
  simp only [obj_ε_inv_app, discrete.functor_map_id, nat_trans.id_app, comp_id,
    μ_inv_hom_app, ε_inv_app_obj],
end) (by tidy)

def triangle.shift_functor_add (a₁ a₂ : ℤ) :
  triangle.shift_functor C (a₁ + a₂) ≅
    triangle.shift_functor C a₁ ⋙ triangle.shift_functor C a₂ :=
nat_iso.of_components (λ T, begin
  dsimp only [triangle.shift_functor],
  refine triangle.mk_iso _ _ ((shift_functor_add C a₁ a₂).app _) ((shift_functor_add C a₁ a₂).app _)
    ((shift_functor_add C a₁ a₂).app _) _ _ _,
  { dsimp only [triangle.mk, functor.comp],
    simp only [zsmul_comp, comp_zsmul, functor.map_zsmul, smul_smul],
    congr' 1,
    { rw [zpow_add, units.coe_mul, mul_comm], },
    { exact (shift_functor_add C a₁ a₂).hom.naturality T.mor₁, }, },
  { dsimp only [triangle.mk, functor.comp],
    simp only [zsmul_comp, comp_zsmul, functor.map_zsmul, smul_smul,
      zpow_add, units.coe_mul, mul_comm],
    congr' 1,
    exact (shift_functor_add C a₁ a₂).hom.naturality T.mor₂, },
  { dsimp only [triangle.mk, functor.comp],
    simp only [zsmul_comp, comp_zsmul, functor.map_zsmul, smul_smul,
      zpow_add, units.coe_mul, mul_comm],
    congr' 1,
    simp only [functor.map_comp, assoc],
    erw ← nat_trans.naturality_assoc,
    congr' 1,
    apply shift_compatibility, },
end)
(λ T T' f, by ext; apply nat_trans.naturality)

def triangle.shift_functor_sub_one_iso : triangle.shift_functor C (-1) ≅ inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C :=
begin
  symmetry,
  calc inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C ≅ 𝟭 _ ⋙ inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C : (functor.left_unitor _).symm
  ... ≅ triangle.shift_functor C 0 ⋙ inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C :
    iso_whisker_right (triangle.shift_functor_zero C).symm _
  ... ≅ triangle.shift_functor C ((-1) + 1) ⋙ inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C :
    iso_whisker_right (eq_to_iso (by congr)) _
  ... ≅ (triangle.shift_functor C (-1) ⋙ triangle.shift_functor C 1) ⋙ inv_rotate C ⋙ inv_rotate C ⋙ inv_rotate C :
    iso_whisker_right (triangle.shift_functor_add C _ _) _
  ... ≅ _ : functor.associator _ _ _
  ... ≅ _ : iso_whisker_left _ _
  ... ≅ triangle.shift_functor C (-1) : functor.right_unitor _,
  let e : rotate C ⋙ inv_rotate C ≅ 𝟭 _ := (triangle_rotation C).unit_iso.symm,
  let α := iso_whisker_left (rotate C ⋙ rotate C) (iso_whisker_right e (inv_rotate C ⋙ inv_rotate C)),
  let β := iso_whisker_left (rotate C) (iso_whisker_right e (inv_rotate C)),
  exact iso_whisker_right (triangle.shift_functor_one_iso C) _ ≪≫ α ≪≫ β ≪≫ e,
end

def triangle.shift_functor_iso_of_eq {a₁ a₂ : ℤ} (h : a₁ = a₂) :
  triangle.shift_functor C a₁ ≅ triangle.shift_functor C a₂ := by subst h

lemma triangle.shift_distinguished [pretriangulated C]
  (T : triangle C) (hT : T ∈ dist_triang C) (n : ℤ) :
  (triangle.shift_functor C n).obj T ∈ dist_triang C :=
begin
  have hpos : ∀ (T' : triangle C) (hT' : T' ∈ dist_triang C),
    (triangle.shift_functor C (1 : ℤ)).obj T' ∈ dist_triang C,
  { intros T' hT',
    exact pretriangulated.isomorphic_distinguished _ (rot_of_dist_triangle C _
      (rot_of_dist_triangle C _ (rot_of_dist_triangle C _ hT'))) _
      ((triangle.shift_functor_one_iso C).app T'), },
  have hneg : ∀ (T' : triangle C) (hT' : T' ∈ dist_triang C),
    (triangle.shift_functor C (-1 : ℤ)).obj T' ∈ dist_triang C,
  { intros T' hT',
    exact pretriangulated.isomorphic_distinguished _ (inv_rot_of_dist_triangle C _
      (inv_rot_of_dist_triangle C _ (inv_rot_of_dist_triangle C _ hT'))) _
      ((triangle.shift_functor_sub_one_iso C).app T'), },
  by_cases 0 ≤ n,
  { obtain ⟨m, hm⟩ : ∃ (m : ℕ), n = m := int.eq_coe_of_zero_le h,
    subst hm, clear h,
    induction m with n hn,
    { exact pretriangulated.isomorphic_distinguished _ hT _
        ((triangle.shift_functor_zero C).app T), },
    { refine pretriangulated.isomorphic_distinguished _ _ _
        ((triangle.shift_functor_add C (↑n) 1).app T),
      apply hpos,
      apply hn, }, },
  { obtain ⟨m, hm⟩ : ∃ (m : ℕ), n = -(m : ℤ),
    { obtain ⟨k, hk⟩ := int.eq_coe_of_zero_le (show 0 ≤ -n, by linarith),
      exact ⟨k, by linarith⟩, },
    subst hm, clear h,
    induction m with n hn,
    { exact pretriangulated.isomorphic_distinguished _ hT _
        ((triangle.shift_functor_zero C).app T), },
    { refine pretriangulated.isomorphic_distinguished _ _ _
        (_ ≪≫ (triangle.shift_functor_add C (-↑n) (-1 : ℤ)).app T),
      { apply hneg,
        apply hn, },
      { refine (triangle.shift_functor_iso_of_eq C _).app _,
        simp only [nat.cast_succ, neg_add_rev, int.add_neg_one],
        linarith, }, }, },
end

example : ℕ := 42

def triangle.shift_functor_comm {C D : Type*} [category C] [category D]
  [preadditive C] [preadditive D] [has_shift C ℤ] [has_shift D ℤ] [has_zero_object C] [has_zero_object D]
  [∀ (n : ℤ), (shift_functor C n).additive] [∀ (n : ℤ), (shift_functor D n).additive] (F : C ⥤ D)
  [F.additive]
  [F.has_comm_shift ℤ] (n : ℤ) :
  triangle.shift_functor C n ⋙ F.map_triangle ≅
    F.map_triangle ⋙ triangle.shift_functor D n :=
begin
  refine nat_iso.of_components (λ T, triangle.mk_iso _ _
    ((F.comm_shift_iso n).app _) ((F.comm_shift_iso n).app _) ((F.comm_shift_iso n).app _) _ _ _)
    (λ T₁ T₂ f, _),
  { have eq₁ := (F.comm_shift_iso n).hom.naturality T.mor₁,
    dsimp at ⊢ eq₁,
    simp only [F.map_zsmul, zsmul_comp, eq₁, comp_zsmul], },
  { have eq₂ := (F.comm_shift_iso n).hom.naturality T.mor₂,
    dsimp at ⊢ eq₂,
    simp only [F.map_zsmul, zsmul_comp, eq₂, comp_zsmul], },
  { have eq₃ := (F.comm_shift_iso n).hom.naturality T.mor₃,
    dsimp at ⊢ eq₃,
    simp only [F.map_zsmul, zsmul_comp, comp_zsmul, functor.map_comp, assoc, ← reassoc_of eq₃,
      F.map_shift_functor_add_comm], },
  { ext; apply (F.comm_shift_iso n).hom.naturality, },
end

end pretriangulated

end category_theory