/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Util.FindMVar
import Lean.Meta.SynthInstance
import Lean.Meta.CollectMVars
import Lean.Meta.Tactic.Util

namespace Lean.Meta
/-- Controls which new mvars are turned in to goals by the `apply` tactic.
- `nonDependentFirst`  mvars that don't depend on other goals appear first in the goal list.
- `nonDependentOnly` only mvars that don't depend on other goals are added to goal list.
- `all` all unassigned mvars are added to the goal list.
-/
inductive ApplyNewGoals where
  | nonDependentFirst | nonDependentOnly | all

/-- Configures the behaviour of the `apply` tactic. -/
structure ApplyConfig where
  newGoals := ApplyNewGoals.nonDependentFirst
  /--
  If `synthAssignedInstances` is `true`, then `apply` will synthesize instance implicit arguments
  even if they have assigned by `isDefEq`, and then check whether the synthesized value matches the
  one inferred. The `congr` tactic sets this flag to false.
  -/
  synthAssignedInstances := true
  /--
  If `approx := true`, then we turn on `isDefEq` approximations. That is, we use
  the `approxDefEq` combinator.
  -/
  approx : Bool := true

/--
  Compute the number of expected arguments and whether the result type is of the form
  (?m ...) where ?m is an unassigned metavariable.
-/
def getExpectedNumArgsAux (e : Expr) : MetaM (Nat × Bool) :=
  withDefault <| forallTelescopeReducing e fun xs body =>
    pure (xs.size, body.getAppFn.isMVar)

def getExpectedNumArgs (e : Expr) : MetaM Nat := do
  let (numArgs, _) ← getExpectedNumArgsAux e
  pure numArgs

private def throwApplyError {α} (mvarId : MVarId) (eType : Expr) (targetType : Expr) : MetaM α :=
  throwTacticEx `apply mvarId m!"failed to unify{indentExpr eType}\nwith{indentExpr targetType}"

def synthAppInstances (tacticName : Name) (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) (synthAssignedInstances : Bool) : MetaM Unit :=
  newMVars.size.forM fun i => do
    if binderInfos[i]!.isInstImplicit then
      let mvar := newMVars[i]!
      if synthAssignedInstances || !(← mvar.mvarId!.isAssigned) then
        let mvarType ← inferType mvar
        let mvarVal  ← synthInstance mvarType
        unless (← isDefEq mvar mvarVal) do
          throwTacticEx tacticName mvarId "failed to assign synthesized instance"

def appendParentTag (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) : MetaM Unit := do
  let parentTag ← mvarId.getTag
  if newMVars.size == 1 then
    -- if there is only one subgoal, we inherit the parent tag
    newMVars[0]!.mvarId!.setTag parentTag
  else
    unless parentTag.isAnonymous do
      newMVars.size.forM fun i => do
        let mvarIdNew := newMVars[i]!.mvarId!
        unless (← mvarIdNew.isAssigned) do
          unless binderInfos[i]!.isInstImplicit do
            let currTag ← mvarIdNew.getTag
            mvarIdNew.setTag (appendTag parentTag currTag)

/--
If `synthAssignedInstances` is `true`, then `apply` will synthesize instance implicit arguments
even if they have assigned by `isDefEq`, and then check whether the synthesized value matches the
one inferred. The `congr` tactic sets this flag to false.
-/
def postprocessAppMVars (tacticName : Name) (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) (synthAssignedInstances := true) : MetaM Unit := do
  synthAppInstances tacticName mvarId newMVars binderInfos synthAssignedInstances
  -- TODO: default and auto params
  appendParentTag mvarId newMVars binderInfos

private def dependsOnOthers (mvar : Expr) (otherMVars : Array Expr) : MetaM Bool :=
  otherMVars.anyM fun otherMVar => do
    if mvar == otherMVar then
      return false
    else
      let otherMVarType ← inferType otherMVar
      return (otherMVarType.findMVar? fun mvarId => mvarId == mvar.mvarId!).isSome

/-- Partitions the given mvars in to two arrays (non-deps, deps)
according to whether the given mvar depends on other mvars in the array.-/
private def partitionDependentMVars (mvars : Array Expr) : MetaM (Array MVarId × Array MVarId) :=
  mvars.foldlM (init := (#[], #[])) fun (nonDeps, deps) mvar => do
    let currMVarId := mvar.mvarId!
    if (← dependsOnOthers mvar mvars) then
      return (nonDeps, deps.push currMVarId)
    else
      return (nonDeps.push currMVarId, deps)

private def reorderGoals (mvars : Array Expr) : ApplyNewGoals → MetaM (List MVarId)
  | ApplyNewGoals.nonDependentFirst => do
      let (nonDeps, deps) ← partitionDependentMVars mvars
      return nonDeps.toList ++ deps.toList
  | ApplyNewGoals.nonDependentOnly => do
      let (nonDeps, _) ← partitionDependentMVars mvars
      return nonDeps.toList
  | ApplyNewGoals.all => return mvars.toList.map Lean.Expr.mvarId!

/-- Custom `isDefEq` for the `apply` tactic -/
private def isDefEqApply (cfg : ApplyConfig) (a b : Expr) : MetaM Bool := do
  if cfg.approx then
    approxDefEq <| isDefEqGuarded a b
  else
    isDefEqGuarded a b

/--
Close the given goal using `apply e`.
-/
def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
  mvarId.withContext do
    mvarId.checkNotAssigned `apply
    let targetType ← mvarId.getType
    let eType      ← inferType e
    let (numArgs, hasMVarHead) ← getExpectedNumArgsAux eType
    /-
    The `apply` tactic adds `_`s to `e`, and some of these `_`s become new goals.
    When `hasMVarHead` is `false` we try different numbers, until we find a type compatible with `targetType`.
    We used to try only `numArgs-targetTypeNumArgs` when `hasMVarHead = false`, but this is not always correct.
    For example, consider the following example
    ```
    example {α β} [LE_trans β] (x y z : α → β) (h₀ : x ≤ y) (h₁ : y ≤ z) : x ≤ z := by
      apply le_trans
      assumption
      assumption
    ```
    In this example, `targetTypeNumArgs = 1` because `LE` for functions is defined as
    ```
    instance {α : Type u} {β : Type v} [LE β] : LE (α → β) where
      le f g := ∀ i, f i ≤ g i
    ```
    -/
    let rangeNumArgs ← if hasMVarHead then
      pure [numArgs : numArgs+1]
    else
      let targetTypeNumArgs ← getExpectedNumArgs targetType
      pure [numArgs - targetTypeNumArgs : numArgs+1]
    /-
    Auxiliary function for trying to add `n` underscores where `n ∈ [i: rangeNumArgs.stop)`
    See comment above
    -/
    let rec go (i : Nat) : MetaM (Array Expr × Array BinderInfo) := do
      if i < rangeNumArgs.stop then
        let s ← saveState
        let (newMVars, binderInfos, eType) ← forallMetaTelescopeReducing eType i
        if (← isDefEqApply cfg eType targetType) then
          return (newMVars, binderInfos)
        else
          s.restore
          go (i+1)
      else
        let (_, _, eType) ← forallMetaTelescopeReducing eType (some rangeNumArgs.start)
        throwApplyError mvarId eType targetType
    let (newMVars, binderInfos) ← go rangeNumArgs.start
    postprocessAppMVars `apply mvarId newMVars binderInfos cfg.synthAssignedInstances
    let e ← instantiateMVars e
    mvarId.assign (mkAppN e newMVars)
    let newMVars ← newMVars.filterM fun mvar => not <$> mvar.mvarId!.isAssigned
    let otherMVarIds ← getMVarsNoDelayed e
    let newMVarIds ← reorderGoals newMVars cfg.newGoals
    let otherMVarIds := otherMVarIds.filter fun mvarId => !newMVarIds.contains mvarId
    let result := newMVarIds ++ otherMVarIds.toList
    result.forM (·.headBetaType)
    return result
termination_by go i => rangeNumArgs.stop - i

@[deprecated MVarId.apply]
def apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
  mvarId.apply e cfg

partial def splitAndCore (mvarId : MVarId) : MetaM (List MVarId) :=
  mvarId.withContext do
    mvarId.checkNotAssigned `splitAnd
    let type ← mvarId.getType'
    if !type.isAppOfArity ``And 2 then
      return [mvarId]
    else
      let tag ← mvarId.getTag
      let rec go (type : Expr) : StateRefT (Array MVarId) MetaM Expr := do
        let type ← whnf type
        if type.isAppOfArity ``And 2 then
          let p₁ := type.appFn!.appArg!
          let p₂ := type.appArg!
          return mkApp4 (mkConst ``And.intro) p₁ p₂ (← go p₁) (← go p₂)
        else
          let idx := (← get).size + 1
          let mvar ← mkFreshExprSyntheticOpaqueMVar type (tag ++ (`h).appendIndexAfter idx)
          modify fun s => s.push mvar.mvarId!
          return mvar
      let (val, s) ← go type |>.run #[]
      mvarId.assign val
      return s.toList

/--
Apply `And.intro` as much as possible to goal `mvarId`.
-/
abbrev _root_.Lean.MVarId.splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
  splitAndCore mvarId

@[deprecated MVarId.splitAnd]
def splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
  mvarId.splitAnd

def _root_.Lean.MVarId.exfalso (mvarId : MVarId) : MetaM MVarId :=
  mvarId.withContext do
    mvarId.checkNotAssigned `exfalso
    let target ← instantiateMVars (← mvarId.getType)
    let u ← getLevel target
    let mvarIdNew ← mkFreshExprSyntheticOpaqueMVar (mkConst ``False) (tag := (← mvarId.getTag))
    mvarId.assign (mkApp2 (mkConst ``False.elim [u]) target mvarIdNew)
    return mvarIdNew.mvarId!

end Lean.Meta


/-
File: signature_recover_public_key_ec_mul_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_ec_add_soundness
import .signature_recover_public_key_ec_mul_inner_soundness
open tactic

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

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

/- starkware.cairo.common.cairo_secp.ec.ec_mul autogenerated soundness theorem -/

theorem auto_sound_ec_mul
    -- arguments
    (range_check_ptr : F) (point : EcPoint F) (scalar : BigInt3 F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_mul σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 561))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 549))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 529))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 513))
    (h_mem_8 : mem_at mem code_is_zero (σ.pc  - 490))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 385))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 341))
    (h_mem_14 : mem_at mem code_ec_double (σ.pc  - 317))
    (h_mem_15 : mem_at mem code_fast_ec_add (σ.pc  - 244))
    (h_mem_16 : mem_at mem code_ec_add (σ.pc  - 157))
    (h_mem_17 : mem_at mem code_ec_mul_inner (σ.pc  - 101))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 12))
    (hin_point : point = cast_EcPoint mem (σ.fp - 11))
    (hin_scalar : scalar = cast_BigInt3 mem (σ.fp - 5))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 12)) (mem $ τ.ap - 7)
        (spec_ec_mul mem κ range_check_ptr point scalar (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_ec_mul 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⟩,
  -- ap += 18
  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_assert_eq hpc7 with arg5,
  step_assert_eq hpc8 with arg6,
  step_assert_eq hpc9 with arg7,
  step_assert_eq hpc10 hpc11 with arg8,
  step_sub hpc12 (auto_sound_ec_mul_inner mem _ range_check_ptr point scalar.d0 86 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc13, norm_num2, exact h_mem_17 },
  { rw hpc13, norm_num2, exact h_mem_4 },
  { rw hpc13, norm_num2, exact h_mem_5 },
  { rw hpc13, norm_num2, exact h_mem_6 },
  { rw hpc13, norm_num2, exact h_mem_7 },
  { rw hpc13, norm_num2, exact h_mem_12 },
  { rw hpc13, norm_num2, exact h_mem_13 },
  { rw hpc13, norm_num2, exact h_mem_14 },
  { rw hpc13, norm_num2, exact h_mem_15 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    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_point, hin_scalar] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call14 ap14 h_call14,
  rcases h_call14 with ⟨rc_m14, rc_mle14, hl_range_check_ptr₁, h_call14⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap14 - 13) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_pow2_0: cast_EcPoint mem (ap14 - 12) = pow2_0,
  simp only [hr_rev_pow2_0] at h_call14,
  have htv_pow2_0 := hr_rev_pow2_0.symm, clear hr_rev_pow2_0,
  generalize' hr_rev_res0: cast_EcPoint mem (ap14 - 6) = res0,
  simp only [hr_rev_res0] at h_call14,
  have htv_res0 := hr_rev_res0.symm, clear hr_rev_res0,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8] 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 ,arg5 ,arg6 ,arg7 ,arg8] at h_call14 },
  rw [hin_range_check_ptr] at h_call14,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8,
  -- local var
  step_assert_eq hpc14 with temp0,
  step_assert_eq hpc15 with temp1,
  step_assert_eq hpc16 with temp2,
  step_assert_eq hpc17 with temp3,
  step_assert_eq hpc18 with temp4,
  step_assert_eq hpc19 with temp5,
  have lc_res0: res0 = cast_EcPoint mem σ.fp, {
    try { ext } ; {
      try { simp only [htv_res0] },
      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_assert_eq hpc20 with arg0,
  step_assert_eq hpc21 with arg1,
  step_assert_eq hpc22 with arg2,
  step_assert_eq hpc23 with arg3,
  step_assert_eq hpc24 with arg4,
  step_assert_eq hpc25 with arg5,
  step_assert_eq hpc26 with arg6,
  step_assert_eq hpc27 with arg7,
  step_assert_eq hpc28 hpc29 with arg8,
  step_sub hpc30 (auto_sound_ec_mul_inner mem _ range_check_ptr₁ pow2_0 scalar.d1 86 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc31, norm_num2, exact h_mem_17 },
  { rw hpc31, norm_num2, exact h_mem_4 },
  { rw hpc31, norm_num2, exact h_mem_5 },
  { rw hpc31, norm_num2, exact h_mem_6 },
  { rw hpc31, norm_num2, exact h_mem_7 },
  { rw hpc31, norm_num2, exact h_mem_12 },
  { rw hpc31, norm_num2, exact h_mem_13 },
  { rw hpc31, norm_num2, exact h_mem_14 },
  { rw hpc31, norm_num2, exact h_mem_15 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call32 ap32 h_call32,
  rcases h_call32 with ⟨rc_m32, rc_mle32, hl_range_check_ptr₂, h_call32⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap32 - 13) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_pow2_1: cast_EcPoint mem (ap32 - 12) = pow2_1,
  simp only [hr_rev_pow2_1] at h_call32,
  have htv_pow2_1 := hr_rev_pow2_1.symm, clear hr_rev_pow2_1,
  generalize' hr_rev_res1: cast_EcPoint mem (ap32 - 6) = res1,
  simp only [hr_rev_res1] at h_call32,
  have htv_res1 := hr_rev_res1.symm, clear hr_rev_res1,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8] 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] at h_call32 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call32,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8,
  -- local var
  step_assert_eq hpc32 with temp0,
  step_assert_eq hpc33 with temp1,
  step_assert_eq hpc34 with temp2,
  step_assert_eq hpc35 with temp3,
  step_assert_eq hpc36 with temp4,
  step_assert_eq hpc37 with temp5,
  have lc_res1: res1 = cast_EcPoint mem (σ.fp + 6), {
    try { ext } ; {
      try { simp only [htv_res1] },
      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_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 hpc47 with arg8,
  step_sub hpc48 (auto_sound_ec_mul_inner mem _ range_check_ptr₂ pow2_1 scalar.d2 84 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc49, norm_num2, exact h_mem_17 },
  { 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_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 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8] },
    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 - 13) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_res2: cast_EcPoint mem (ap50 - 6) = res2,
  simp only [hr_rev_res2] at h_call50,
  have htv_res2 := hr_rev_res2.symm, clear hr_rev_res2,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8] 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] at h_call50 },
  rw [←htv_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,
  -- local var
  step_assert_eq hpc50 with temp0,
  step_assert_eq hpc51 with temp1,
  step_assert_eq hpc52 with temp2,
  step_assert_eq hpc53 with temp3,
  step_assert_eq hpc54 with temp4,
  step_assert_eq hpc55 with temp5,
  have lc_res2: res2 = cast_EcPoint mem (σ.fp + 12), {
    try { ext } ; {
      try { simp only [htv_res2] },
      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_assert_eq hpc56 with arg0,
  step_assert_eq hpc57 with arg1,
  step_assert_eq hpc58 with arg2,
  step_assert_eq hpc59 with arg3,
  step_assert_eq hpc60 with arg4,
  step_assert_eq hpc61 with arg5,
  step_assert_eq hpc62 with arg6,
  step_assert_eq hpc63 with arg7,
  step_assert_eq hpc64 with arg8,
  step_assert_eq hpc65 with arg9,
  step_assert_eq hpc66 with arg10,
  step_assert_eq hpc67 with arg11,
  step_assert_eq hpc68 with arg12,
  step_sub hpc69 (auto_sound_ec_add mem _ range_check_ptr₃ res0 res1 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc70, norm_num2, exact h_mem_16 },
  { rw hpc70, norm_num2, exact h_mem_4 },
  { rw hpc70, norm_num2, exact h_mem_5 },
  { rw hpc70, norm_num2, exact h_mem_6 },
  { rw hpc70, norm_num2, exact h_mem_7 },
  { rw hpc70, norm_num2, exact h_mem_8 },
  { rw hpc70, norm_num2, exact h_mem_12 },
  { rw hpc70, norm_num2, exact h_mem_13 },
  { rw hpc70, norm_num2, exact h_mem_14 },
  { rw hpc70, norm_num2, exact h_mem_15 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
    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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call71 ap71 h_call71,
  rcases h_call71 with ⟨rc_m71, rc_mle71, hl_range_check_ptr₄, h_call71⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap71 - 7) = range_check_ptr₄,
  have htv_range_check_ptr₄ := hr_rev_range_check_ptr₄.symm, clear hr_rev_range_check_ptr₄,
  generalize' hr_rev_res: cast_EcPoint mem (ap71 - 6) = res,
  simp only [hr_rev_res] at h_call71,
  have htv_res := hr_rev_res.symm, clear hr_rev_res,
  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_call71 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call71,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
  -- function call
  step_assert_eq hpc71 with arg0,
  step_assert_eq hpc72 with arg1,
  step_assert_eq hpc73 with arg2,
  step_assert_eq hpc74 with arg3,
  step_assert_eq hpc75 with arg4,
  step_assert_eq hpc76 with arg5,
  step_sub hpc77 (auto_sound_ec_add mem _ range_check_ptr₄ res res2 _ _ _ _ _ _ _ _ _ _ _ _ _),
  { rw hpc78, norm_num2, exact h_mem_16 },
  { rw hpc78, norm_num2, exact h_mem_4 },
  { rw hpc78, norm_num2, exact h_mem_5 },
  { rw hpc78, norm_num2, exact h_mem_6 },
  { rw hpc78, norm_num2, exact h_mem_7 },
  { rw hpc78, norm_num2, exact h_mem_8 },
  { rw hpc78, norm_num2, exact h_mem_12 },
  { rw hpc78, norm_num2, exact h_mem_13 },
  { rw hpc78, norm_num2, exact h_mem_14 },
  { rw hpc78, norm_num2, exact h_mem_15 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2, htv_range_check_ptr₄, htv_res] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
    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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2, htv_range_check_ptr₄, htv_res] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      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_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2, htv_range_check_ptr₄, htv_res] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call79 ap79 h_call79,
  rcases h_call79 with ⟨rc_m79, rc_mle79, hl_range_check_ptr₅, h_call79⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap79 - 7) = range_check_ptr₅,
  have htv_range_check_ptr₅ := hr_rev_range_check_ptr₅.symm, clear hr_rev_range_check_ptr₅,
  generalize' hr_rev_res₁: cast_EcPoint mem (ap79 - 6) = res₁,
  simp only [hr_rev_res₁] at h_call79,
  have htv_res₁ := hr_rev_res₁.symm, clear hr_rev_res₁,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5] 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] at h_call79 },
  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_call79,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- return
  step_ret hpc79,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m14+rc_m32+rc_m50+rc_m71+rc_m79+0+0), split,
  linarith [rc_mle14, rc_mle32, rc_mle50, rc_mle71, rc_mle79],
  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₁, 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_ec_mul mem _ range_check_ptr point scalar _ _,
  { apply sound_ec_mul, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_ec_mul],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call14],
  use_only [range_check_ptr₁],
  use_only [pow2_0],
  use_only [res0],
  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 spec14 := h_call14 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec14,
  try { dsimp at spec14, arith_simps at spec14 },
  use_only [spec14],
  use_only [κ_call32],
  use_only [range_check_ptr₂],
  use_only [pow2_1],
  use_only [res1],
  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 spec32 := h_call32 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec32,
  try { dsimp at spec32, arith_simps at spec32 },
  use_only [spec32],
  use_only [κ_call50],
  use_only [range_check_ptr₃],
  use_only [(cast_EcPoint mem (ap50 - 12))],
  use_only [res2],
  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₂, ←htv_range_check_ptr₃] at spec50,
  try { dsimp at spec50, arith_simps at spec50 },
  use_only [spec50],
  use_only [κ_call71],
  use_only [range_check_ptr₄],
  use_only [res],
  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 spec71 := h_call71 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 spec71,
  try { dsimp at spec71, arith_simps at spec71 },
  use_only [spec71],
  use_only [κ_call79],
  use_only [range_check_ptr₅],
  use_only [res₁],
  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 spec79 := h_call79 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 spec79,
  try { dsimp at spec79, arith_simps at spec79 },
  use_only [spec79],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, hin_scalar, htv_range_check_ptr₁, htv_pow2_0, htv_res0, lc_res0, htv_range_check_ptr₂, htv_pow2_1, htv_res1, lc_res1, htv_range_check_ptr₃, htv_res2, lc_res2, htv_range_check_ptr₄, htv_res, htv_range_check_ptr₅, htv_res₁] }, },
  try { dsimp [cast_EcPoint, cast_BigInt3] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import sheaves.sheaf_of_rings Kenny.sheaf_on_opens ring_theory.subring

universes v w u₁ v₁ u

open topological_space lattice

def sheaf_of_rings_on_opens (X : Type u) [topological_space X] (U : opens X) : Type (max u (v+1)) :=
sheaf_of_rings.{u v} X

namespace sheaf_of_rings_on_opens

variables {X : Type u} [topological_space X] {U : opens X}

def to_sheaf_on_opens (F : sheaf_of_rings_on_opens X U) : sheaf_on_opens X U :=
{ locality := F.2,
  gluing := F.3,
  .. F.F }

-- def eval (F : sheaf_of_rings_on_opens X U) : Π (V : opens X), V ≤ U → Type v :=
-- F.to_sheaf_on_opens.eval

instance comm_ring_eval (F : sheaf_of_rings_on_opens X U) (V HVU) : comm_ring (F.to_sheaf_on_opens.eval V HVU) :=
F.1.2 V

-- def res (F : sheaf_of_rings_on_opens X U) : Π (V : opens X) (HVU : V ≤ U) (W : opens X) (HWU : W ≤ U) (HWV : W ≤ V), F.to_sheaf_on_opens.eval V HVU → F.to_sheaf_on_opens.eval W HWU :=
-- F.to_sheaf_on_opens.res

instance is_ring_hom_res (F : sheaf_of_rings_on_opens X U) (V HVU W HWU HWV) : is_ring_hom (F.to_sheaf_on_opens.res V HVU W HWU HWV) :=
F.1.3 V W HWV

section
variables (F : sheaf_of_rings_on_opens X U) (V : opens X) (HVU : V ≤ U) (W : opens X) (HWU : W ≤ U) (HWV : W ≤ V)
variables (x y : F.to_sheaf_on_opens.eval V HVU) (n : ℕ)
@[simp] lemma res_add : F.to_sheaf_on_opens.res V HVU W HWU HWV (x + y) = F.to_sheaf_on_opens.res V HVU W HWU HWV x + F.to_sheaf_on_opens.res V HVU W HWU HWV y := is_ring_hom.map_add _
@[simp] lemma res_zero : F.to_sheaf_on_opens.res V HVU W HWU HWV 0 = 0 := is_ring_hom.map_zero _
@[simp] lemma res_neg : F.to_sheaf_on_opens.res V HVU W HWU HWV (-x) = -F.to_sheaf_on_opens.res V HVU W HWU HWV x := is_ring_hom.map_neg _
@[simp] lemma res_sub : F.to_sheaf_on_opens.res V HVU W HWU HWV (x - y) = F.to_sheaf_on_opens.res V HVU W HWU HWV x - F.to_sheaf_on_opens.res V HVU W HWU HWV y := is_ring_hom.map_sub _
@[simp] lemma res_mul : F.to_sheaf_on_opens.res V HVU W HWU HWV (x * y) = F.to_sheaf_on_opens.res V HVU W HWU HWV x * F.to_sheaf_on_opens.res V HVU W HWU HWV y := is_ring_hom.map_mul _
@[simp] lemma res_one : F.to_sheaf_on_opens.res V HVU W HWU HWV 1 = 1 := is_ring_hom.map_one _
@[simp] lemma res_pow : F.to_sheaf_on_opens.res V HVU W HWU HWV (x^n) = (F.to_sheaf_on_opens.res V HVU W HWU HWV x)^n := is_semiring_hom.map_pow _ x n
end

theorem res_self (F : sheaf_of_rings_on_opens X U) (V HVU HV x) :
  F.to_sheaf_on_opens.res V HVU V HVU HV x = x :=
F.to_sheaf_on_opens.res_self V HVU HV x

theorem res_res (F : sheaf_of_rings_on_opens X U) (V HVU W HWU HWV S HSU HSW x) :
  F.to_sheaf_on_opens.res W HWU S HSU HSW (F.to_sheaf_on_opens.res V HVU W HWU HWV x) = F.to_sheaf_on_opens.res V HVU S HSU (le_trans HSW HWV) x :=
F.to_sheaf_on_opens.res_res V HVU W HWU HWV S HSU HSW x

theorem locality (F : sheaf_of_rings_on_opens X U) (V HVU s t) (OC : covering V)
  (H : ∀ i : OC.γ, F.to_sheaf_on_opens.res V HVU (OC.Uis i) (le_trans (subset_covering i) HVU) (subset_covering i) s =
    F.to_sheaf_on_opens.res V HVU (OC.Uis i) (le_trans (subset_covering i) HVU) (subset_covering i) t) :
  s = t :=
F.locality OC s t H

-- noncomputable def glue (F : sheaf_of_rings_on_opens X U) (V HVU) (OC : covering V)
--   (s : Π i : OC.γ, F.to_sheaf_on_opens.eval (OC.Uis i) (le_trans (subset_covering i) HVU))
--   (H : ∀ i j : OC.γ, F.to_sheaf_on_opens.res _ _ (OC.Uis i ⊓ OC.Uis j) (le_trans inf_le_left (le_trans (subset_covering i) HVU)) inf_le_left (s i) =
--     F.to_sheaf_on_opens.res _ _ (OC.Uis i ⊓ OC.Uis j) (le_trans inf_le_left (le_trans (subset_covering i) HVU)) inf_le_right (s j)) :
--   F.to_sheaf_on_opens.eval V HVU :=
-- classical.some $ F.gluing OC s H

-- theorem res_glue (F : sheaf_of_rings_on_opens X U) (V HVU) (OC : covering V) (s H i) :
--   F.to_sheaf_on_opens.res V HVU (OC.Uis i) (le_trans (subset_covering i) HVU) (subset_covering i) (F.glue V HVU OC s H) = s i :=
-- classical.some_spec (F.gluing OC s H) i

-- theorem eq_glue (F : sheaf_of_rings_on_opens X U) (V HVU) (OC : covering V)
--   (s : Π i : OC.γ, F.to_sheaf_on_opens.eval (OC.Uis i) (le_trans (subset_covering i) HVU)) (H t)
--   (ht : ∀ i, F.to_sheaf_on_opens.res V HVU (OC.Uis i) (le_trans (subset_covering i) HVU) (subset_covering i) t = s i) :
--   F.glue V HVU OC s H = t :=
-- F.locality V HVU _ _ OC $ λ i, by rw [res_glue, ht]

def res_subset (F : sheaf_of_rings_on_opens X U) (V : opens X) (HVU : V ≤ U) : sheaf_of_rings_on_opens X V :=
F

theorem res_res_subset (F : sheaf_of_rings_on_opens X U) (V HVU S HSV T HTV HTS x) :
  (F.to_sheaf_on_opens.res_subset V HVU).res S HSV T HTV HTS x = F.to_sheaf_on_opens.res S (le_trans HSV HVU) T (le_trans HTV HVU) HTS x :=
rfl

-- def stalk (F : sheaf_of_rings_on_opens.{v} X U) (x : X) (hx : x ∈ U) : Type (max u v) :=
-- stalk_of_rings F.1 x

instance comm_ring_stalk (F : sheaf_of_rings_on_opens.{v} X U) (x : X) (hx : x ∈ U) :
  comm_ring (F.to_sheaf_on_opens.stalk x hx) :=
stalk_of_rings_is_comm_ring F.1 x

-- def to_stalk (F : sheaf_of_rings_on_opens.{v} X U) (x : X) (hx : x ∈ U) (V : opens X) (hxV : x ∈ V) (HVU : V ≤ U) (s : F.to_sheaf_on_opens.eval V HVU) : F.to_sheaf_on_opens.stalk x hx :=
-- F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s

instance is_ring_hom_to_stalk (F : sheaf_of_rings_on_opens X U) (x hx V hxV HVU) :
  is_ring_hom (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU) :=
to_stalk.is_ring_hom _ _ _ _

section
variables (F : sheaf_of_rings_on_opens.{v} X U) (x : X) (hx : x ∈ U) (V : opens X) (hxV : x ∈ V) (HVU : V ≤ U)
variables (s t : F.to_sheaf_on_opens.eval V HVU) (n : ℕ)
@[simp] lemma to_stalk_add : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU (s + t) = F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s + F.to_sheaf_on_opens.to_stalk x hx V hxV HVU t := is_ring_hom.map_add _
@[simp] lemma to_stalk_zero : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU 0 = 0 := is_ring_hom.map_zero _
@[simp] lemma to_stalk_neg : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU (-s) = -F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s := is_ring_hom.map_neg _
@[simp] lemma to_stalk_sub : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU (s - t) = F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s - F.to_sheaf_on_opens.to_stalk x hx V hxV HVU t := is_ring_hom.map_sub _
@[simp] lemma to_stalk_mul : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU (s * t) = F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s * F.to_sheaf_on_opens.to_stalk x hx V hxV HVU t := is_ring_hom.map_mul _
@[simp] lemma to_stalk_one : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU 1 = 1 := is_ring_hom.map_one _
@[simp] lemma to_stalk_pow : F.to_sheaf_on_opens.to_stalk x hx V hxV HVU (s^n) = (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s)^n := is_semiring_hom.map_pow _ s n
end

@[simp] lemma to_stalk_res (F : sheaf_of_rings_on_opens.{v} X U) (x : X) (hx : x ∈ U) (V : opens X) (hxV : x ∈ V) (HVU : V ≤ U)
  (W : opens X) (hxW : x ∈ W) (HWV : W ≤ V) (s : F.to_sheaf_on_opens.eval V HVU) :
  F.to_sheaf_on_opens.to_stalk x hx W hxW (le_trans HWV HVU) (F.to_sheaf_on_opens.res _ _ _ _ HWV s) = F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s :=
to_stalk_res _ _ _ _ _ _ _ _

@[elab_as_eliminator] theorem stalk.induction_on {F : sheaf_of_rings_on_opens X U} {x : X} {hx : x ∈ U}
  {C : F.to_sheaf_on_opens.stalk x hx → Prop} (g : F.to_sheaf_on_opens.stalk x hx)
  (H : ∀ V : opens X, ∀ hxV : x ∈ V, ∀ HVU : V ≤ U, ∀ s : F.to_sheaf_on_opens.eval V HVU, C (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s)) :
  C g :=
quotient.induction_on g $ λ e,
have (⟦e⟧ : F.to_sheaf_on_opens.stalk x hx) = ⟦⟨e.1 ⊓ U, ⟨e.2, hx⟩, F.F.res _ _ (set.inter_subset_left _ _) e.3⟩⟧,
from quotient.sound ⟨e.1 ⊓ U, ⟨e.2, hx⟩, set.inter_subset_left _ _, set.subset.refl _,
  by dsimp only [to_sheaf_on_opens]; rw ← presheaf.Hcomp'; refl⟩,
this.symm ▸ H (e.1 ⊓ U) ⟨e.2, hx⟩ inf_le_right _

@[elab_as_eliminator] theorem stalk.induction_on₂ {F : sheaf_of_rings_on_opens X U} {x : X} {hx : x ∈ U}
  {C : F.to_sheaf_on_opens.stalk x hx → F.to_sheaf_on_opens.stalk x hx → Prop} (g1 g2 : F.to_sheaf_on_opens.stalk x hx)
  (H : ∀ V : opens X, ∀ hxV : x ∈ V, ∀ HVU : V ≤ U, ∀ s t : F.to_sheaf_on_opens.eval V HVU, C (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s) (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU t)) :
  C g1 g2 :=
quotient.induction_on₂ g1 g2 $ λ e1 e2,
have h1 : (⟦e1⟧ : F.to_sheaf_on_opens.stalk x hx) = _root_.to_stalk F.F x (e1.1 ⊓ e2.1 ⊓ U) ⟨⟨e1.2, e2.2⟩, hx⟩ (F.F.res _ _ (λ p hp, hp.1.1) e1.3),
by erw [_root_.to_stalk_res]; cases e1; refl,
have h2 : (⟦e2⟧ : F.to_sheaf_on_opens.stalk x hx) = _root_.to_stalk F.F x (e1.1 ⊓ e2.1 ⊓ U) ⟨⟨e1.2, e2.2⟩, hx⟩ (F.F.res _ _ (λ p hp, hp.1.2) e2.3),
by erw [_root_.to_stalk_res]; cases e2; refl,
h1.symm ▸ h2.symm ▸ H _ _ inf_le_right _ _

structure morphism (F : sheaf_of_rings_on_opens.{v} X U) (G : sheaf_of_rings_on_opens.{w} X U) : Type (max u v w) :=
(η : F.to_sheaf_on_opens.morphism G.to_sheaf_on_opens)
[hom : ∀ V HV, is_ring_hom (η.map V HV)]
attribute [instance] morphism.hom

namespace morphism

section
variables {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U}
variables (η : F.morphism G) (V : opens X) (HVU : V ≤ U) (x y : F.to_sheaf_on_opens.eval V HVU) (n : ℕ)
@[simp] lemma map_add : η.1.map V HVU (x + y) = η.1.map V HVU x + η.1.map V HVU y := is_ring_hom.map_add _
@[simp] lemma map_zero : η.1.map V HVU 0 = 0 := is_ring_hom.map_zero _
@[simp] lemma map_neg : η.1.map V HVU (-x) = -η.1.map V HVU x := is_ring_hom.map_neg _
@[simp] lemma map_sub : η.1.map V HVU (x - y) = η.1.map V HVU x - η.1.map V HVU y := is_ring_hom.map_sub _
@[simp] lemma map_mul : η.1.map V HVU (x * y) = η.1.map V HVU x * η.1.map V HVU y := is_ring_hom.map_mul _
@[simp] lemma map_one : η.1.map V HVU 1 = 1 := is_ring_hom.map_one _
@[simp] lemma map_pow : η.1.map V HVU (x^n) = (η.1.map V HVU x)^n := is_semiring_hom.map_pow _ x n
end

protected def id (F : sheaf_of_rings_on_opens.{v} X U) : F.morphism F :=
{ η := sheaf_on_opens.morphism.id _,
  hom := λ _ _, is_ring_hom.id }

def comp {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} {H : sheaf_of_rings_on_opens.{u₁} X U}
  (η : G.morphism H) (ξ : F.morphism G) : F.morphism H :=
{ η := η.1.comp ξ.1,
  hom := λ _ _, is_ring_hom.comp _ _ }

@[simp] lemma comp_apply {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} {H : sheaf_of_rings_on_opens.{u₁} X U}
  (η : G.morphism H) (ξ : F.morphism G) (V HV s) :
  (η.comp ξ).1.1 V HV s = η.1.1 V HV (ξ.1.1 V HV s) :=
rfl

@[ext] lemma ext {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U}
  {η ξ : F.morphism G} (H : ∀ V HV x, η.1.map V HV x = ξ.1.map V HV x) : η = ξ :=
by cases η; cases ξ; congr; ext; apply H

@[simp] lemma id_comp {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) :
  (morphism.id G).comp η = η :=
ext $ λ V HV x, rfl

@[simp] lemma comp_id {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) :
  η.comp (morphism.id F) = η :=
ext $ λ V HV x, rfl

@[simp] lemma comp_assoc {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} {H : sheaf_of_rings_on_opens.{u₁} X U} {I : sheaf_of_rings_on_opens.{v₁} X U}
  (η : H.morphism I) (ξ : G.morphism H) (χ : F.morphism G) :
  (η.comp ξ).comp χ = η.comp (ξ.comp χ) :=
rfl

def res_subset {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (V : opens X) (HVU : V ≤ U) :
  (F.res_subset V HVU).morphism (G.res_subset V HVU) :=
{ η := η.1.res_subset V HVU,
  hom := λ _ _, η.2 _ _ }

@[simp] lemma res_subset_apply {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (V : opens X) (HVU : V ≤ U)
  (W HWV s) : (η.res_subset V HVU).1.1 W HWV s = η.1.1 W (le_trans HWV HVU) s :=
rfl

@[simp] lemma comp_res_subset {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} {H : sheaf_of_rings_on_opens.{u₁} X U}
  (η : G.morphism H) (ξ : F.morphism G) (V : opens X) (HVU : V ≤ U) :
  (η.res_subset V HVU).comp (ξ.res_subset V HVU) = (η.comp ξ).res_subset V HVU :=
rfl

@[simp] lemma id_res_subset {F : sheaf_of_rings_on_opens.{v} X U} (V : opens X) (HVU : V ≤ U) :
  (morphism.id F).res_subset V HVU = morphism.id (F.res_subset V HVU) :=
rfl

-- def stalk {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (x : X) (hx : x ∈ U)
--   (s : F.to_sheaf_on_opens.stalk x hx) : G.to_sheaf_on_opens.stalk x hx :=
-- quotient.lift_on s (λ g, ⟦(⟨g.1 ⊓ U, (⟨g.2, hx⟩ : x ∈ g.1 ⊓ U),
--   η.1.map _ inf_le_right (presheaf.res F.1.1 _ _ (set.inter_subset_left _ _) g.3)⟩ : stalk.elem _ _)⟧) $
-- λ g₁ g₂ ⟨V, hxV, HV1, HV2, hg⟩, quotient.sound ⟨V ⊓ U, ⟨hxV, hx⟩, set.inter_subset_inter_left _ HV1, set.inter_subset_inter_left _ HV2,
-- calc  G.to_sheaf_on_opens.res _ _ (V ⊓ U) inf_le_right (inf_le_inf HV1 (le_refl _)) (η.1.map (g₁.U ⊓ U) inf_le_right ((F.F).res (g₁.U) (g₁.U ⊓ U) (set.inter_subset_left _ _) (g₁.s)))
--     = η.1.map (V ⊓ U) inf_le_right ((F.F).res V (V ⊓ U) (set.inter_subset_left _ _) ((F.F).res (g₁.U) V HV1 (g₁.s))) :
--   by rw ← η.3; dsimp only [sheaf_on_opens.res, sheaf_of_rings_on_opens.to_sheaf_on_opens]; rw [← presheaf.Hcomp', ← presheaf.Hcomp']
-- ... = G.to_sheaf_on_opens.res _ _ (V ⊓ U) _ _ (η.1.map (g₂.U ⊓ U) inf_le_right ((F.F).res (g₂.U) (g₂.U ⊓ U) _ (g₂.s))) :
--   by erw [hg, ← η.3]; dsimp only [sheaf_on_opens.res, sheaf_of_rings_on_opens.to_sheaf_on_opens]; rw [← presheaf.Hcomp', ← presheaf.Hcomp']⟩

-- @[simp] lemma stalk_to_stalk {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (x : X) (hx : x ∈ U)
--   (V : opens X) (HVU : V ≤ U) (hxV : x ∈ V) (s : F.to_sheaf_on_opens.eval V HVU) :
--   η.stalk x hx (F.to_sheaf_on_opens.to_stalk x hx V hxV HVU s) =
--   G.to_sheaf_on_opens.to_stalk x hx V hxV HVU (η.1.map V HVU s) :=
-- quotient.sound ⟨V, hxV, set.subset_inter (set.subset.refl _) HVU, set.subset.refl _,
-- calc  G.to_sheaf_on_opens.res (V ⊓ U) inf_le_right V HVU (le_inf (le_refl V) HVU) (η.1.map (V ⊓ U) inf_le_right (F.to_sheaf_on_opens.res V HVU (V ⊓ U) inf_le_right inf_le_left s))
--     = G.to_sheaf_on_opens.res V HVU V HVU (le_refl V) (η.1.map V HVU s) : by rw [η.3, res_res]⟩

instance is_ring_hom_stalk {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (x : X) (hx : x ∈ U) :
  is_ring_hom (η.1.stalk x hx) :=
{ map_one := quotient.sound ⟨U, hx, set.subset_inter (set.subset_univ U.1) (set.subset.refl U.1), set.subset_univ U.1,
    by dsimp only; erw [_root_.res_one, η.map_one, _root_.res_one, _root_.res_one]⟩,
  map_mul := λ y z, stalk.induction_on₂ y z $ λ V hxV HVU s t,
    by rw [sheaf_on_opens.morphism.stalk_to_stalk, sheaf_on_opens.morphism.stalk_to_stalk, ← to_stalk_mul,
      sheaf_on_opens.morphism.stalk_to_stalk, η.map_mul, to_stalk_mul],
  map_add := λ y z, stalk.induction_on₂ y z $ λ V hxV HVU s t,
    by rw [sheaf_on_opens.morphism.stalk_to_stalk, sheaf_on_opens.morphism.stalk_to_stalk, ← to_stalk_add,
      sheaf_on_opens.morphism.stalk_to_stalk, η.map_add, to_stalk_add] }

section
variables {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (η : F.morphism G) (x : X) (hx : x ∈ U)
variables (s t : F.to_sheaf_on_opens.stalk x hx) (n : ℕ)
@[simp] lemma stalk_add : η.1.stalk x hx (s + t) = η.1.stalk x hx s + η.1.stalk x hx t := is_ring_hom.map_add _
@[simp] lemma stalk_zero : η.1.stalk x hx 0 = 0 := is_ring_hom.map_zero _
@[simp] lemma stalk_neg : η.1.stalk x hx (-s) = -η.1.stalk x hx s := is_ring_hom.map_neg _
@[simp] lemma stalk_sub : η.1.stalk x hx (s - t) = η.1.stalk x hx s - η.1.stalk x hx t := is_ring_hom.map_sub _
@[simp] lemma stalk_mul : η.1.stalk x hx (s * t) = η.1.stalk x hx s * η.1.stalk x hx t := is_ring_hom.map_mul _
@[simp] lemma stalk_one : η.1.stalk x hx 1 = 1 := is_ring_hom.map_one _
@[simp] lemma stalk_pow : η.1.stalk x hx (s^n) = (η.1.stalk x hx s)^n := is_semiring_hom.map_pow _ s n
end

end morphism

structure equiv (F : sheaf_of_rings_on_opens.{v} X U) (G : sheaf_of_rings_on_opens.{w} X U) : Type (max u v w) :=
(to_fun : F.morphism G)
(inv_fun : G.to_sheaf_on_opens.morphism F.to_sheaf_on_opens)
(left_inv : ∀ V HVU s, inv_fun.1 V HVU (to_fun.1.1 V HVU s) = s)
(right_inv : ∀ V HVU s, to_fun.1.1 V HVU (inv_fun.1 V HVU s) = s)

namespace equiv

def to_sheaf_on_opens {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (e : F.equiv G) :
  F.to_sheaf_on_opens.equiv G.to_sheaf_on_opens :=
{ to_fun := e.1.1, .. e }

def to_ring_equiv {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{v} X U} (e : equiv F G) (V HVU) :
  F.to_sheaf_on_opens.eval V HVU ≃+* G.to_sheaf_on_opens.eval V HVU :=
ring_equiv.of' { to_fun := e.1.1.1 V HVU, inv_fun := e.2.1 V HVU, left_inv := e.3 V HVU, right_inv := e.4 V HVU }

def refl (F : sheaf_of_rings_on_opens.{v} X U) : equiv F F :=
⟨morphism.id F, sheaf_on_opens.morphism.id F.to_sheaf_on_opens, λ _ _ _, rfl, λ _ _ _, rfl⟩

@[simp] lemma refl_apply (F : sheaf_of_rings_on_opens.{v} X U) (V HV s) :
  (refl F).1.1.1 V HV s = s := rfl

def symm {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{v} X U} (e : equiv F G) : equiv G F :=
⟨{ η := e.2,
   hom := λ V HVU, (ring_equiv.symm (e.to_ring_equiv V HVU)).hom },
e.1.1, e.4, e.3⟩

def trans {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{v} X U} {H : sheaf_of_rings_on_opens.{u₁} X U}
  (e₁ : equiv F G) (e₂ : equiv G H) : equiv F H :=
⟨e₂.1.comp e₁.1, e₁.2.comp e₂.2,
λ _ _ _, by rw [morphism.comp_apply, sheaf_on_opens.morphism.comp_apply, e₂.3, e₁.3],
λ _ _ _, by rw [morphism.comp_apply, sheaf_on_opens.morphism.comp_apply, e₁.4, e₂.4]⟩

@[simp] lemma trans_apply {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{v} X U} {H : sheaf_of_rings_on_opens.{u₁} X U}
  (e₁ : equiv F G) (e₂ : equiv G H) (V HV s) :
  (e₁.trans e₂).1.1.1 V HV s = e₂.1.1.1 V HV (e₁.1.1.1 V HV s) :=
rfl

def res_subset {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (e : equiv F G)
  (V : opens X) (HVU : V ≤ U) : equiv (F.res_subset V HVU) (G.res_subset V HVU) :=
⟨e.1.res_subset V HVU, e.2.res_subset V HVU,
λ _ _ _, by rw [morphism.res_subset_apply, sheaf_on_opens.morphism.res_subset_apply, e.3],
λ _ _ _, by rw [morphism.res_subset_apply, sheaf_on_opens.morphism.res_subset_apply, e.4]⟩

@[simp] lemma res_subset_apply {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (e : equiv F G)
  (V : opens X) (HVU : V ≤ U) (W HW s) :
  (e.res_subset V HVU).1.1.1 W HW s = e.1.1.1 W (le_trans HW HVU) s :=
rfl

-- def stalk {F : sheaf_of_rings_on_opens.{v} X U} {G : sheaf_of_rings_on_opens.{w} X U} (e : equiv F G) (x : X) (hx : x ∈ U) :
--   F.to_sheaf_on_opens.stalk x hx ≃ G.to_sheaf_on_opens.stalk x hx :=
-- { to_fun := e.1.1.stalk x hx,
--   inv_fun := e.2.stalk x hx,
--   left_inv := λ g, stalk.induction_on g $ λ V hxV HVU s,
--     by rw [sheaf_on_opens.morphism.stalk_to_stalk, sheaf_on_opens.morphism.stalk_to_stalk, e.3]; refl,
--   right_inv := λ g, stalk.induction_on g $ λ V hxV HVU s,
--     by rw [sheaf_on_opens.morphism.stalk_to_stalk, sheaf_on_opens.morphism.stalk_to_stalk, e.4]; refl }

end equiv

def sheaf_glue {I : Type u} (S : I → opens X) (F : Π (i : I), sheaf_of_rings_on_opens.{v} X (S i))
  (φ : Π i j, equiv ((F i).res_subset ((S i) ⊓ (S j)) inf_le_left) ((F j).res_subset ((S i) ⊓ (S j)) inf_le_right)) :
  sheaf_of_rings_on_opens.{max u v} X (⋃S) :=
{ F :=
  { Fring := λ U, @subtype.comm_ring (Π (i : I), (F i).to_sheaf_on_opens.eval (S i ⊓ U) inf_le_left) _
      { f | ∀ (i j : I), (φ i j).1.1.1 (S i ⊓ S j ⊓ U) inf_le_left
              ((F i).to_sheaf_on_opens.res (S i ⊓ U) inf_le_left (S i ⊓ S j ⊓ U) (le_trans inf_le_left inf_le_left)
                (le_inf (le_trans inf_le_left inf_le_left) inf_le_right)
                (f i)) =
            (F j).to_sheaf_on_opens.res (S j ⊓ U) inf_le_left (S i ⊓ S j ⊓ U) (le_trans inf_le_left inf_le_right)
              (by rw inf_assoc; exact inf_le_right)
              (f j) }
      { add_mem := λ f g hf hg i j, by erw [res_add, morphism.map_add, res_add, hf i j, hg i j],
        zero_mem := λ i j, by erw [res_zero, morphism.map_zero, res_zero]; refl,
        neg_mem := λ f hf i j, by erw [res_neg, morphism.map_neg, res_neg, hf i j],
        one_mem := λ i j, by erw [res_one, morphism.map_one, res_one]; refl,
        mul_mem := λ f g hf hg i j, by erw [res_mul, morphism.map_mul, res_mul, hf i j, hg i j] },
    res_is_ring_hom := λ U V HVU,
      { map_one := subtype.eq $ funext $ λ i, res_one _ _ _ _ _ _,
        map_mul := λ f g, subtype.eq $ funext $ λ i, res_mul _ _ _ _ _ _ _ _,
        map_add := λ f g, subtype.eq $ funext $ λ i, res_add _ _ _ _ _ _ _ _ },
    .. sheaf_on_opens.sheaf_glue S (λ i, (F i).to_sheaf_on_opens) (λ i j, (φ i j).to_sheaf_on_opens) }
  .. sheaf_on_opens.sheaf_glue S (λ i, (F i).to_sheaf_on_opens) (λ i j, (φ i j).to_sheaf_on_opens) }

@[simp] lemma sheaf_glue_res_val {I : Type u} (S : I → opens X) (F : Π (i : I), sheaf_of_rings_on_opens.{v} X (S i))
  (φ : Π i j, equiv ((F i).res_subset ((S i) ⊓ (S j)) inf_le_left) ((F j).res_subset ((S i) ⊓ (S j)) inf_le_right))
  (U HU V HV HVU s i) :
  ((sheaf_glue S F φ).to_sheaf_on_opens.res U HU V HV HVU s).1 i =
  (F i).to_sheaf_on_opens.res _ _ _ _ (inf_le_inf (le_refl _) HVU) (s.1 i) := rfl

def universal_property (I : Type u) (S : I → opens X) (F : Π (i : I), sheaf_of_rings_on_opens.{v} X (S i))
  (φ : Π i j, equiv ((F i).res_subset ((S i) ⊓ (S j)) inf_le_left) ((F j).res_subset ((S i) ⊓ (S j)) inf_le_right))
  (Hφ1 : ∀ i V HV s, (φ i i).1.1.1 V HV s = s)
  (Hφ2 : ∀ i j k V HV1 HV2 HV3 s, (φ j k).1.1.1 V HV1 ((φ i j).1.1.1 V HV2 s) = (φ i k).1.1.1 V HV3 s)
  (i : I) :
  equiv (res_subset (sheaf_glue S F φ) (S i) (le_supr S i)) (F i) :=
{ to_fun :=
  { η := (sheaf_on_opens.universal_property I S (λ i, (F i).to_sheaf_on_opens) (λ i j, (φ i j).to_sheaf_on_opens) Hφ1 Hφ2 i).1,
    hom := λ U HU,
    { map_one := res_one _ _ _ _ _ _,
      map_mul := λ x y, res_mul _ _ _ _ _ _ _ _,
      map_add := λ x y, res_add _ _ _ _ _ _ _ _ } },
  .. sheaf_on_opens.universal_property I S (λ i, (F i).to_sheaf_on_opens) (λ i j, (φ i j).to_sheaf_on_opens) Hφ1 Hφ2 i }

end sheaf_of_rings_on_opens


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

Notation for operators defined at Prelude.lean
-/
prelude
import Init.Prelude
import Init.Coe
set_option linter.missingDocs true -- keep it documented

namespace Lean

/--
Auxiliary type used to represent syntax categories. We mainly use auxiliary
definitions with this type to attach doc strings to syntax categories.
-/
structure Parser.Category

namespace Parser.Category

/-- `command` is the syntax category for things that appear at the top level
of a lean file. For example, `def foo := 1` is a `command`, as is
`namespace Foo` and `end Foo`. Commands generally have an effect on the state of
adding something to the environment (like a new definition), as well as
commands like `variable` which modify future commands within a scope. -/
def command : Category := {}

/-- `term` is the builtin syntax category for terms. A term denotes an expression
in lean's type theory, for example `2 + 2` is a term. The difference between
`Term` and `Expr` is that the former is a kind of syntax, while the latter is
the result of elaboration. For example `by simp` is also a `Term`, but it elaborates
to different `Expr`s depending on the context. -/
def term : Category := {}

/-- `tactic` is the builtin syntax category for tactics. These appear after
`by` in proofs, and they are programs that take in the proof context
(the hypotheses in scope plus the type of the term to synthesize) and construct
a term of the expected type. For example, `simp` is a tactic, used in:
```
example : 2 + 2 = 4 := by simp
```
-/
def tactic : Category := {}

/-- `doElem` is a builtin syntax category for elements that can appear in the `do` notation.
For example, `let x ← e` is a `doElem`, and a `do` block consists of a list of `doElem`s. -/
def doElem : Category := {}

/-- `level` is a builtin syntax category for universe levels.
This is the `u` in `Sort u`: it can contain `max` and `imax`, addition with
constants, and variables. -/
def level : Category := {}

/-- `attr` is a builtin syntax category for attributes.
Declarations can be annotated with attributes using the `@[...]` notation. -/
def attr : Category := {}

/-- `stx` is a builtin syntax category for syntax. This is the abbreviated
parser notation used inside `syntax` and `macro` declarations. -/
def stx : Category := {}

/-- `prio` is a builtin syntax category for priorities.
Priorities are used in many different attributes.
Higher numbers denote higher priority, and for example typeclass search will
try high priority instances before low priority.
In addition to literals like `37`, you can also use `low`, `mid`, `high`, as well as
add and subtract priorities. -/
def prio : Category := {}

/-- `prec` is a builtin syntax category for precedences. A precedence is a value
that expresses how tightly a piece of syntax binds: for example `1 + 2 * 3` is
parsed as `1 + (2 * 3)` because `*` has a higher pr0ecedence than `+`.
Higher numbers denote higher precedence.
In addition to literals like `37`, there are some special named priorities:
* `arg` for the precedence of function arguments
* `max` for the highest precedence used in term parsers (not actually the maximum possible value)
* `lead` for the precedence of terms not supposed to be used as arguments
and you can also add and subtract precedences. -/
def prec : Category := {}

end Parser.Category

namespace Parser.Syntax

/-! DSL for specifying parser precedences and priorities -/

/-- Addition of precedences. This is normally used only for offseting, e.g. `max + 1`. -/
syntax:65 (name := addPrec) prec " + " prec:66 : prec
/-- Subtraction of precedences. This is normally used only for offseting, e.g. `max - 1`. -/
syntax:65 (name := subPrec) prec " - " prec:66 : prec

/-- Addition of priorities. This is normally used only for offseting, e.g. `default + 1`. -/
syntax:65 (name := addPrio) prio " + " prio:66 : prio
/-- Subtraction of priorities. This is normally used only for offseting, e.g. `default - 1`. -/
syntax:65 (name := subPrio) prio " - " prio:66 : prio

end Parser.Syntax

instance : CoeOut (TSyntax ks) Syntax where
  coe stx := stx.raw

instance : Coe SyntaxNodeKind SyntaxNodeKinds where
  coe k := List.cons k List.nil

end Lean

/--
Maximum precedence used in term parsers, in particular for terms in
function position (`ident`, `paren`, ...)
-/
macro "max"  : prec => `(prec| 1024)
/-- Precedence used for application arguments (`do`, `by`, ...). -/
macro "arg"  : prec => `(prec| 1023)
/-- Precedence used for terms not supposed to be used as arguments (`let`, `have`, ...). -/
macro "lead" : prec => `(prec| 1022)
/-- Parentheses are used for grouping precedence expressions. -/
macro "(" p:prec ")" : prec => return p
/-- Minimum precedence used in term parsers. -/
macro "min"  : prec => `(prec| 10)
/-- `(min+1)` (we can only write `min+1` after `Meta.lean`) -/
macro "min1" : prec => `(prec| 11)
/--
`max:prec` as a term. It is equivalent to `eval_prec max` for `eval_prec` defined at `Meta.lean`.
We use `max_prec` to workaround bootstrapping issues.
-/
macro "max_prec" : term => `(1024)

/-- The default priority `default = 1000`, which is used when no priority is set. -/
macro "default" : prio => `(prio| 1000)
/-- The standardized "low" priority `low = 100`, for things that should be lower than default priority. -/
macro "low"     : prio => `(prio| 100)
/--
The standardized "medium" priority `med = 1000`. This is lower than `default`, and higher than `low`.
-/
macro "mid"     : prio => `(prio| 500)
/-- The standardized "high" priority `high = 10000`, for things that should be higher than default priority. -/
macro "high"    : prio => `(prio| 10000)
/-- Parentheses are used for grouping priority expressions. -/
macro "(" p:prio ")" : prio => return p

/-
Note regarding priorities. We want `low < mid < default` because we have the following default instances:
```
@[default_instance low] instance (n : Nat) : OfNat Nat n where ...
@[default_instance mid] instance : Neg Int where ...
@[default_instance default] instance [Add α] : HAdd α α α where ...
@[default_instance default] instance [Sub α] : HSub α α α where ...
...
```

Monomorphic default instances must always "win" to preserve the Lean 3 monomorphic "look&feel".
The `Neg Int` instance must have precedence over the `OfNat Nat n` one, otherwise we fail to elaborate `#check -42`
See issue #1813 for an example that failed when `mid = default`.
-/

-- Basic notation for defining parsers
-- NOTE: precedence must be at least `arg` to be used in `macro` without parentheses

/--
`p+` is shorthand for `many1(p)`. It uses parser `p` 1 or more times, and produces a
`nullNode` containing the array of parsed results. This parser has arity 1.

If `p` has arity more than 1, it is auto-grouped in the items generated by the parser.
-/
syntax:arg stx:max "+" : stx

/--
`p*` is shorthand for `many(p)`. It uses parser `p` 0 or more times, and produces a
`nullNode` containing the array of parsed results. This parser has arity 1.

If `p` has arity more than 1, it is auto-grouped in the items generated by the parser.
-/
syntax:arg stx:max "*" : stx

/--
`(p)?` is shorthand for `optional(p)`. It uses parser `p` 0 or 1 times, and produces a
`nullNode` containing the array of parsed results. This parser has arity 1.

`p` is allowed to have arity n > 1 (in which case the node will have either 0 or n children),
but if it has arity 0 then the result will be ambiguous.

Because `?` is an identifier character, `ident?` will not work as intended.
You have to write either `ident ?` or `(ident)?` for it to parse as the `?` combinator
applied to the `ident` parser.
-/
syntax:arg stx:max "?" : stx

/--
`p1 <|> p2` is shorthand for `orelse(p1, p2)`, and parses either `p1` or `p2`.
It does not backtrack, meaning that if `p1` consumes at least one token then
`p2` will not be tried. Therefore, the parsers should all differ in their first
token. The `atomic(p)` parser combinator can be used to locally backtrack a parser.
(For full backtracking, consider using extensible syntax classes instead.)

On success, if the inner parser does not generate exactly one node, it will be
automatically wrapped in a `group` node, so the result will always be arity 1.

The `<|>` combinator does not generate a node of its own, and in particular
does not tag the inner parsers to distinguish them, which can present a problem
when reconstructing the parse. A well formed `<|>` parser should use disjoint
node kinds for `p1` and `p2`.
-/
syntax:2 stx:2 " <|> " stx:1 : stx

macro_rules
  | `(stx| $p +) => `(stx| many1($p))
  | `(stx| $p *) => `(stx| many($p))
  | `(stx| $p ?) => `(stx| optional($p))
  | `(stx| $p₁ <|> $p₂) => `(stx| orelse($p₁, $p₂))

/--
`p,*` is shorthand for `sepBy(p, ",")`. It parses 0 or more occurrences of
`p` separated by `,`, that is: `empty | p | p,p | p,p,p | ...`.

It produces a `nullNode` containing a `SepArray` with the interleaved parser
results. It has arity 1, and auto-groups its component parser if needed.
-/
macro:arg x:stx:max ",*"   : stx => `(stx| sepBy($x, ",", ", "))
/--
`p,+` is shorthand for `sepBy(p, ",")`. It parses 1 or more occurrences of
`p` separated by `,`, that is: `p | p,p | p,p,p | ...`.

It produces a `nullNode` containing a `SepArray` with the interleaved parser
results. It has arity 1, and auto-groups its component parser if needed.
-/
macro:arg x:stx:max ",+"   : stx => `(stx| sepBy1($x, ",", ", "))

/--
`p,*,?` is shorthand for `sepBy(p, ",", allowTrailingSep)`.
It parses 0 or more occurrences of `p` separated by `,`, possibly including
a trailing `,`, that is: `empty | p | p, | p,p | p,p, | p,p,p | ...`.

It produces a `nullNode` containing a `SepArray` with the interleaved parser
results. It has arity 1, and auto-groups its component parser if needed.
-/
macro:arg x:stx:max ",*,?" : stx => `(stx| sepBy($x, ",", ", ", allowTrailingSep))

/--
`p,+,?` is shorthand for `sepBy1(p, ",", allowTrailingSep)`.
It parses 1 or more occurrences of `p` separated by `,`, possibly including
a trailing `,`, that is: `p | p, | p,p | p,p, | p,p,p | ...`.

It produces a `nullNode` containing a `SepArray` with the interleaved parser
results. It has arity 1, and auto-groups its component parser if needed.
-/
macro:arg x:stx:max ",+,?" : stx => `(stx| sepBy1($x, ",", ", ", allowTrailingSep))

/--
`!p` parses the negation of `p`. That is, it fails if `p` succeeds, and
otherwise parses nothing. It has arity 0.
-/
macro:arg "!" x:stx:max : stx => `(stx| notFollowedBy($x))

/--
The `nat_lit n` macro constructs "raw numeric literals". This corresponds to the
`Expr.lit (.natVal n)` constructor in the `Expr` data type.

Normally, when you write a numeral like `#check 37`, the parser turns this into
an application of `OfNat.ofNat` to the raw literal `37` to cast it into the
target type, even if this type is `Nat` (so the cast is the identity function).
But sometimes it is necessary to talk about the raw numeral directly,
especially when proving properties about the `ofNat` function itself.
-/
syntax (name := rawNatLit) "nat_lit " num : term

@[inherit_doc] infixr:90 " ∘ "  => Function.comp
@[inherit_doc] infixr:35 " × "  => Prod

@[inherit_doc] infixl:55 " ||| " => HOr.hOr
@[inherit_doc] infixl:58 " ^^^ " => HXor.hXor
@[inherit_doc] infixl:60 " &&& " => HAnd.hAnd
@[inherit_doc] infixl:65 " + "   => HAdd.hAdd
@[inherit_doc] infixl:65 " - "   => HSub.hSub
@[inherit_doc] infixl:70 " * "   => HMul.hMul
@[inherit_doc] infixl:70 " / "   => HDiv.hDiv
@[inherit_doc] infixl:70 " % "   => HMod.hMod
@[inherit_doc] infixl:75 " <<< " => HShiftLeft.hShiftLeft
@[inherit_doc] infixl:75 " >>> " => HShiftRight.hShiftRight
@[inherit_doc] infixr:80 " ^ "   => HPow.hPow
@[inherit_doc] infixl:65 " ++ "  => HAppend.hAppend
@[inherit_doc] prefix:75 "-"    => Neg.neg
@[inherit_doc] prefix:100 "~~~"  => Complement.complement

/-!
  Remark: the infix commands above ensure a delaborator is generated for each relations.
  We redefine the macros below to be able to use the auxiliary `binop%` elaboration helper for binary operators.
  It addresses issue #382. -/
macro_rules | `($x ||| $y) => `(binop% HOr.hOr $x $y)
macro_rules | `($x ^^^ $y) => `(binop% HXor.hXor $x $y)
macro_rules | `($x &&& $y) => `(binop% HAnd.hAnd $x $y)
macro_rules | `($x + $y)   => `(binop% HAdd.hAdd $x $y)
macro_rules | `($x - $y)   => `(binop% HSub.hSub $x $y)
macro_rules | `($x * $y)   => `(binop% HMul.hMul $x $y)
macro_rules | `($x / $y)   => `(binop% HDiv.hDiv $x $y)
macro_rules | `($x % $y)   => `(binop% HMod.hMod $x $y)
macro_rules | `($x ^ $y)   => `(binop% HPow.hPow $x $y)
macro_rules | `($x ++ $y)  => `(binop% HAppend.hAppend $x $y)
macro_rules | `(- $x)      => `(unop% Neg.neg $x)

-- declare ASCII alternatives first so that the latter Unicode unexpander wins
@[inherit_doc] infix:50 " <= " => LE.le
@[inherit_doc] infix:50 " ≤ "  => LE.le
@[inherit_doc] infix:50 " < "  => LT.lt
@[inherit_doc] infix:50 " >= " => GE.ge
@[inherit_doc] infix:50 " ≥ "  => GE.ge
@[inherit_doc] infix:50 " > "  => GT.gt
@[inherit_doc] infix:50 " = "  => Eq
@[inherit_doc] infix:50 " == " => BEq.beq
/-!
  Remark: the infix commands above ensure a delaborator is generated for each relations.
  We redefine the macros below to be able to use the auxiliary `binrel%` elaboration helper for binary relations.
  It has better support for applying coercions. For example, suppose we have `binrel% Eq n i` where `n : Nat` and
  `i : Int`. The default elaborator fails because we don't have a coercion from `Int` to `Nat`, but
  `binrel%` succeeds because it also tries a coercion from `Nat` to `Int` even when the nat occurs before the int. -/
macro_rules | `($x <= $y) => `(binrel% LE.le $x $y)
macro_rules | `($x ≤ $y)  => `(binrel% LE.le $x $y)
macro_rules | `($x < $y)  => `(binrel% LT.lt $x $y)
macro_rules | `($x > $y)  => `(binrel% GT.gt $x $y)
macro_rules | `($x >= $y) => `(binrel% GE.ge $x $y)
macro_rules | `($x ≥ $y)  => `(binrel% GE.ge $x $y)
macro_rules | `($x = $y)  => `(binrel% Eq $x $y)
macro_rules | `($x == $y) => `(binrel_no_prop% BEq.beq $x $y)

@[inherit_doc] infixr:35 " /\\ " => And
@[inherit_doc] infixr:35 " ∧ "   => And
@[inherit_doc] infixr:30 " \\/ " => Or
@[inherit_doc] infixr:30 " ∨  "  => Or
@[inherit_doc] notation:max "¬" p:40 => Not p

@[inherit_doc] infixl:35 " && " => and
@[inherit_doc] infixl:30 " || " => or
@[inherit_doc] notation:max "!" b:40 => not b

@[inherit_doc] infix:50 " ∈ " => Membership.mem
/-- `a ∉ b` is negated elementhood. It is notation for `¬ (a ∈ b)`. -/
notation:50 a:50 " ∉ " b:50 => ¬ (a ∈ b)

@[inherit_doc] infixr:67 " :: " => List.cons
@[inherit_doc HOrElse.hOrElse] syntax:20 term:21 " <|> " term:20 : term
@[inherit_doc HAndThen.hAndThen] syntax:60 term:61 " >> " term:60 : term
@[inherit_doc] infixl:55  " >>= " => Bind.bind
@[inherit_doc] notation:60 a:60 " <*> " b:61 => Seq.seq a fun _ : Unit => b
@[inherit_doc] notation:60 a:60 " <* " b:61 => SeqLeft.seqLeft a fun _ : Unit => b
@[inherit_doc] notation:60 a:60 " *> " b:61 => SeqRight.seqRight a fun _ : Unit => b
@[inherit_doc] infixr:100 " <$> " => Functor.map

macro_rules | `($x <|> $y) => `(binop_lazy% HOrElse.hOrElse $x $y)
macro_rules | `($x >> $y)  => `(binop_lazy% HAndThen.hAndThen $x $y)

namespace Lean

/--
`binderIdent` matches an `ident` or a `_`. It is used for identifiers in binding
position, where `_` means that the value should be left unnamed and inaccessible.
-/
syntax binderIdent := ident <|> hole

namespace Parser.Tactic

/--
A case tag argument has the form `tag x₁ ... xₙ`; it refers to tag `tag` and renames
the last `n` hypotheses to `x₁ ... xₙ`.
-/
syntax caseArg := binderIdent binderIdent*

end Parser.Tactic
end Lean

@[inherit_doc dite] syntax (name := termDepIfThenElse)
  ppRealGroup(ppRealFill(ppIndent("if " Lean.binderIdent " : " term " then") ppSpace term)
    ppDedent(ppSpace) ppRealFill("else " term)) : term

macro_rules
  | `(if $h:ident : $c then $t else $e) => do
    let mvar ← Lean.withRef c `(?m)
    `(let_mvar% ?m := $c; wait_if_type_mvar% ?m; dite $mvar (fun $h:ident => $t) (fun $h:ident => $e))
  | `(if _%$h : $c then $t else $e) => do
    let mvar ← Lean.withRef c `(?m)
    `(let_mvar% ?m := $c; wait_if_type_mvar% ?m; dite $mvar (fun _%$h => $t) (fun _%$h => $e))

@[inherit_doc ite] syntax (name := termIfThenElse)
  ppRealGroup(ppRealFill(ppIndent("if " term " then") ppSpace term)
    ppDedent(ppSpace) ppRealFill("else " term)) : term

macro_rules
  | `(if $c then $t else $e) => do
    let mvar ← Lean.withRef c `(?m)
    `(let_mvar% ?m := $c; wait_if_type_mvar% ?m; ite $mvar $t $e)

/--
`if let pat := d then t else e` is a shorthand syntax for:
```
match d with
| pat => t
| _ => e
```
It matches `d` against the pattern `pat` and the bindings are available in `t`.
If the pattern does not match, it returns `e` instead.
-/
syntax (name := termIfLet)
  ppRealGroup(ppRealFill(ppIndent("if " "let " term " := " term " then") ppSpace term)
    ppDedent(ppSpace) ppRealFill("else " term)) : term

macro_rules
  | `(if let $pat := $d then $t else $e) =>
    `(match $d:term with | $pat => $t | _ => $e)

@[inherit_doc cond] syntax (name := boolIfThenElse)
  ppRealGroup(ppRealFill(ppIndent("bif " term " then") ppSpace term)
    ppDedent(ppSpace) ppRealFill("else " term)) : term

macro_rules
  | `(bif $c then $t else $e) => `(cond $c $t $e)

/--
Haskell-like pipe operator `<|`. `f <| x` means the same as the same as `f x`,
except that it parses `x` with lower precedence, which means that `f <| g <| x`
is interpreted as `f (g x)` rather than `(f g) x`.
-/
syntax:min term " <| " term:min : term

macro_rules
  | `($f $args* <| $a) => `($f $args* $a)
  | `($f <| $a) => `($f $a)

/--
Haskell-like pipe operator `|>`. `x |> f` means the same as the same as `f x`,
and it chains such that `x |> f |> g` is interpreted as `g (f x)`.
-/
syntax:min term " |> " term:min1 : term

macro_rules
  | `($a |> $f $args*) => `($f $args* $a)
  | `($a |> $f)        => `($f $a)

/--
Alternative syntax for `<|`. `f $ x` means the same as the same as `f x`,
except that it parses `x` with lower precedence, which means that `f $ g $ x`
is interpreted as `f (g x)` rather than `(f g) x`.
-/
-- Note that we have a whitespace after `$` to avoid an ambiguity with antiquotations.
syntax:min term atomic(" $" ws) term:min : term

macro_rules
  | `($f $args* $ $a) => `($f $args* $a)
  | `($f $ $a) => `($f $a)

@[inherit_doc Subtype] syntax "{ " withoutPosition(ident (" : " term)? " // " term) " }" : term

macro_rules
  | `({ $x : $type // $p }) => ``(Subtype (fun ($x:ident : $type) => $p))
  | `({ $x // $p })         => ``(Subtype (fun ($x:ident : _) => $p))

/--
`without_expected_type t` instructs Lean to elaborate `t` without an expected type.
Recall that terms such as `match ... with ...` and `⟨...⟩` will postpone elaboration until
expected type is known. So, `without_expected_type` is not effective in this case.
-/
macro "without_expected_type " x:term : term => `(let aux := $x; aux)

/--
The syntax `[a, b, c]` is shorthand for `a :: b :: c :: []`, or
`List.cons a (List.cons b (List.cons c List.nil))`. It allows conveniently constructing
list literals.

For lists of length at least 64, an alternative desugaring strategy is used
which uses let bindings as intermediates as in
`let left := [d, e, f]; a :: b :: c :: left` to avoid creating very deep expressions.
Note that this changes the order of evaluation, although it should not be observable
unless you use side effecting operations like `dbg_trace`.
-/
syntax "[" withoutPosition(term,*) "]"  : term

/--
Auxiliary syntax for implementing `[$elem,*]` list literal syntax.
The syntax `%[a,b,c|tail]` constructs a value equivalent to `a::b::c::tail`.
It uses binary partitioning to construct a tree of intermediate let bindings as in
`let left := [d, e, f]; a :: b :: c :: left` to avoid creating very deep expressions.
-/
syntax "%[" withoutPosition(term,* "|" term) "]" : term

namespace Lean

macro_rules
  | `([ $elems,* ]) => do
    -- NOTE: we do not have `TSepArray.getElems` yet at this point
    let rec expandListLit (i : Nat) (skip : Bool) (result : TSyntax `term) : MacroM Syntax := do
      match i, skip with
      | 0,   _     => pure result
      | i+1, true  => expandListLit i false result
      | i+1, false => expandListLit i true  (← ``(List.cons $(⟨elems.elemsAndSeps.get! i⟩) $result))
    if elems.elemsAndSeps.size < 64 then
      expandListLit elems.elemsAndSeps.size false (← ``(List.nil))
    else
      `(%[ $elems,* | List.nil ])

-- Declare `this` as a keyword that unhygienically binds to a scope-less `this` assumption (or other binding).
-- The keyword prevents declaring a `this` binding except through metaprogramming, as is done by `have`/`show`.
/-- Special identifier introduced by "anonymous" `have : ...`, `suffices p ...` etc. -/
macro tk:"this" : term =>
  return (⟨(Syntax.ident tk.getHeadInfo "this".toSubstring `this [])⟩ : TSyntax `term)

/--
Category for carrying raw syntax trees between macros; any content is printed as is by the pretty printer.
The only accepted parser for this category is an antiquotation.
-/
declare_syntax_cat rawStx

instance : Coe Syntax (TSyntax `rawStx) where
  coe stx := ⟨stx⟩

/-- `with_annotate_term stx e` annotates the lexical range of `stx : Syntax` with term info for `e`. -/
scoped syntax (name := withAnnotateTerm) "with_annotate_term " rawStx ppSpace term : term

/--
The attribute `@[deprecated]` on a declaration indicates that the declaration
is discouraged for use in new code, and/or should be migrated away from in
existing code. It may be removed in a future version of the library.

`@[deprecated myBetterDef]` means that `myBetterDef` is the suggested replacement.
-/
syntax (name := deprecated) "deprecated " (ident)? : attr

/--
When `parent_dir` contains the current Lean file, `include_str "path" / "to" / "file"` becomes
a string literal with the contents of the file at `"parent_dir" / "path" / "to" / "file"`. If this
file cannot be read, elaboration fails.
-/
syntax (name := includeStr) "include_str" term : term


import Lbar.ext_aux3
import Lbar.iota

noncomputable theory

universes v u u'

open opposite category_theory category_theory.limits category_theory.preadditive
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r < 1)] [fact (r' < 1)]

open bounded_homotopy_category

variables {r'}
variables (BD : breen_deligne.package)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.data.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.data.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')

section preps

variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]
variables (ι : ulift.{u+1} ℕ → ℝ≥0) (hι : monotone ι)

set_option pp.universes true

lemma homotopy_category.colimit_cofan_bdd {A : Type u} [category.{v} A] [abelian A]
[has_coproducts A] {α : Type v} (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] : homotopy_category.is_bounded_above
  (homotopy_category.colimit_cofan $ λ a : α, (X a).val).X :=
begin
    obtain ⟨n,hn⟩ := homotopy_category.is_uniformly_bounded_above.cond (val ∘ X),
      use n, intros i hi,
    dsimp [homotopy_category.colimit_cofan],
    let e : (∐ λ (a : α), (X a).val.as).X i ≅
      (∐ λ (a : α), (X a).val.as.X i) := homotopy_category.coproduct_iso _ _,
    refine is_zero_of_iso_of_zero _ e.symm,
    apply category_theory.is_zero_colimit,
    intros j,
    apply hn j _ hi,
  end

def Tinv2_iso_of_bicartesian_aux_1
  (i : ℤ) : commsq.{u+2 u+1}
  (shift_sub_id.{u+1}
     ((QprimeFP.{u} r' BD.data κ₂ M).op ⋙
        (Ext.{u+1 u+2} i).flip.obj ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).obj V.to_Cond))
     ι
     hι)
  (pi_Ext_iso_Ext_sigma.{u} BD κ₂ M V (λ (k : ulift.{u+1 0} ℕ), ι k) i).hom
  (pi_Ext_iso_Ext_sigma.{u} BD κ₂ M V (λ (k : ulift.{u+1 0} ℕ), ι k) i).hom
  (((Ext.{u+1 u+2} i).map
      (of_hom.{u+1 u+2} (QprimeFP.shift_sub_id.{u u+2 u+1} ι hι (QprimeFP_int.{u} r' BD.data κ₂ M))).op).app
     ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).obj (Condensed.of_top_ab.{u} ↥V))) :=
begin
    apply commsq.of_eq,
    dsimp only [shift_sub_id, QprimeFP.shift_sub_id],
    simp only [sub_comp, comp_sub, homological_complex.of_hom_sub, category_theory.op_sub,
      functor.map_sub, op_id, category_theory.functor.map_id, of_hom_id,
      nat_trans.app_sub, nat_trans.id_app, category.comp_id, category.id_comp],
    apply congr_arg2 _ _ rfl,
    rw ← iso.eq_comp_inv,
    dsimp only [pi_Ext_iso_Ext_sigma, iso.trans_hom, iso.trans_inv,
      iso.symm_hom, iso.symm_inv, functor.map_iso_hom,
      iso.op_hom, op_comp, functor.flip_obj_map, functor.map_iso_inv],
    simp only [category.assoc, ← nat_trans.comp_app_assoc, ← functor.map_comp_assoc,
      ← functor.map_comp, iso.op_inv, ← op_comp],
    rw cofan_point_iso_colimit_conj_eq_desc,
    rw iso.eq_inv_comp,
    have := Ext_coproduct_iso_naturality_shift _
      (λ (k : ulift ℕ), (QprimeFP r' BD.data κ₂ M).obj (ι k))
      (λ k, (QprimeFP r' BD.data κ₂ M).map (hom_of_le $ hι $
        by exact_mod_cast k.down.le_succ)) i ((single (Condensed Ab) 0).obj V.to_Cond),
    exact this.symm,
    { apply homotopy_category.colimit_cofan_bdd },
end

@[reassoc]
lemma Ext_coproduct_iso_π
  (A : Type u) [category.{v} A] [abelian A] [enough_projectives A] [has_coproducts A] [AB4 A]
  (X : ulift.{v} ℕ → bounded_homotopy_category A) [uniformly_bounded X] (i : ℤ) (Y) (k) :
  (Ext_coproduct_iso X i Y).hom ≫ pi.π _ k =
  ((Ext i).map $ quiver.hom.op $ sigma.ι _ _).app Y :=
begin
  dsimp only [Ext_coproduct_iso, iso.trans_hom, pi_iso, preadditive_yoneda_coproduct_iso,
    as_iso_hom, preadditive_yoneda_coproduct_to_product],
  simp only [category.assoc, limit.lift_π, limit.lift_π_assoc, fan.mk_π_app],
  dsimp only [Ext_iso, iso.symm_hom, functor.map_iso_hom, functor.map_iso_inv],
  simp only [← functor.map_comp, iso.op_hom, iso.op_inv, ← op_comp],
  dsimp only [Ext, Ext0, functor.comp_map, whiskering_left_obj_map, whisker_left_app,
    functor.flip_map_app, replacement_iso],
  congr' 2,
  simp only [category.assoc, iso.inv_comp_eq, quiver.hom.unop_op, unop_op, op_unop],
  apply lift_unique,
  simp only [category.assoc, iso.inv_comp_eq, quiver.hom.unop_op, unop_op, op_unop],
  erw lift_lifts,
  simp only [uniform_π, colimit.ι_desc, cofan.mk_ι_app, lift_lifts_assoc],
  refl,
end

lemma Tinv2_iso_of_bicartesian_aux_2
  [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (j) {e : (homotopy_category.colimit_cofan.{u+1 u+2}
     (λ (a : ulift.{u+1 0} ℕ),
        ((λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ₂ M).obj (ι k)) a).val)).X.is_bounded_above } :
  ((cofan.{u+1 u+2} (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ₂ M).obj (ι k))).ι.app j ≫
     of_hom.{u+1 u+2} (sigma_map.{u u+2 u+1} ι (QprimeFP_int.Tinv.{u} BD.data κ₂ κ M))) ≫
  (cofan_point_iso_colimit.{u} (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k))).hom =
  (QprimeFP.Tinv _ _ _ _).app _ ≫
  sigma.ι (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k)) j :=
begin
  rw [← iso.eq_comp_inv], simp only [category.assoc, cofan_point_iso_colimit,
    colimit.comp_cocone_point_unique_up_to_iso_inv],
  dsimp only [bounded_homotopy_category.cofan, cofan.mk_ι_app, of_hom,
    homotopy_category.colimit_cofan, QprimeFP.Tinv, whisker_right_app,
    chain_complex.to_bounded_homotopy_category, functor.comp_map],
  erw [← (homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).map_comp],
  erw [← (homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).map_comp],
  congr' 1,
  dsimp only [sigma_map],
  erw [colimit.ι_desc],
  refl,
end

lemma Tinv2_iso_of_bicartesian_aux_3
  [∀ c n, fact (κ₂ c n ≤ κ c n)]
  [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (j)
  {e : (homotopy_category.colimit_cofan.{u+1 u+2}
     (λ (a : ulift.{u+1 0} ℕ),
        ((λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ₂ M).obj (ι k)) a).val)).X.is_bounded_above} :
  (cofan.{u+1 u+2} (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ₂ M).obj (ι k))).ι.app j ≫
  of_hom.{u+1 u+2} (sigma_map.{u u+2 u+1} ι (QprimeFP_int.ι.{u} BD.data κ₂ κ M)) ≫
    (cofan_point_iso_colimit.{u} (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k))).hom =
  (QprimeFP.ι _ κ₂ κ M).app _ ≫
  sigma.ι ((λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k))) j :=
begin
  simp only [← category.assoc], rw [← iso.eq_comp_inv],
  simp only [category.assoc, cofan_point_iso_colimit, colimit.comp_cocone_point_unique_up_to_iso_inv],
  dsimp only [bounded_homotopy_category.cofan, cofan.mk_ι_app, of_hom,
    homotopy_category.colimit_cofan, QprimeFP.ι, whisker_right_app,
    chain_complex.to_bounded_homotopy_category, functor.comp_map],
  erw [← (homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).map_comp],
  erw [← (homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).map_comp],
  congr' 1,
  dsimp only [sigma_map],
  erw [colimit.ι_desc],
  refl,
end

lemma Tinv2_iso_of_bicartesian_aux [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (i : ℤ)
  (H1 : (shift_sub_id.commsq (ExtQprime.Tinv2 r r' BD.data κ κ₂ M V i) ι hι).bicartesian) :
  (Ext_Tinv2_commsq (of_hom (sigma_map (λ (k : ulift ℕ), ι k) (QprimeFP_int.Tinv BD.data κ₂ κ M)))
  (of_hom (sigma_map (λ (k : ulift ℕ), ι k) (QprimeFP_int.ι BD.data κ₂ κ M)))
  (of_hom (sigma_map (λ (k : ulift ℕ), ι k) (QprimeFP_int.Tinv BD.data κ₂ κ M)))
  (of_hom (sigma_map (λ (k : ulift ℕ), ι k) (QprimeFP_int.ι BD.data κ₂ κ M)))
  (of_hom (QprimeFP.shift_sub_id ι hι (QprimeFP_int r' BD.data κ₂ M)))
  (of_hom (QprimeFP.shift_sub_id ι hι (QprimeFP_int r' BD.data κ M)))
  (auux $ commsq_shift_sub_id_Tinv _ _ _ _ _ _)
  (auux $ commsq_shift_sub_id_ι _ _ _ _ _ _)
  ((single _ 0).map (Condensed.of_top_ab_map (normed_group_hom.to_add_monoid_hom (normed_with_aut.T.inv : V ⟶ V)) (normed_group_hom.continuous _)))
  i).bicartesian :=
begin
  have h1 := _, have h2 := _, have h3 := _,
  refine commsq.bicartesian.of_iso
    (pi_Ext_iso_Ext_sigma _ _ _ _ _ _) (pi_Ext_iso_Ext_sigma _ _ _ _ _ _)
    (pi_Ext_iso_Ext_sigma _ _ _ _ _ _) (pi_Ext_iso_Ext_sigma _ _ _ _ _ _)
    h1 h2 h2 h3 H1,
  apply Tinv2_iso_of_bicartesian_aux_1,
  { clear h1, apply commsq.of_eq, rw ← iso.eq_comp_inv,
    apply limit.hom_ext, intros j, rw lim_map_π,
    dsimp [pi_Ext_iso_Ext_sigma],
    simp only [category.assoc],
    have := Ext_coproduct_iso_π _
      (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ₂ M).obj (ι k))
      i ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).obj V.to_Cond) j,
    rw [this, ← nat_trans.comp_app, ← functor.map_comp, ← op_comp],
    clear this,
    erw colimit.ι_desc,
    dsimp [Ext_Tinv2, ExtQprime.Tinv2],
    simp only [sub_comp, comp_sub],
    refine congr_arg2 _ _ _,
    { simp only [← nat_trans.comp_app, ← functor.map_comp, ← op_comp],
      rw Tinv2_iso_of_bicartesian_aux_2,
      swap,
      { apply homotopy_category.colimit_cofan_bdd },
      simp only [functor.map_comp, op_comp, nat_trans.comp_app, category.assoc],
      have := Ext_coproduct_iso_π _
        (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k))
        i ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).obj V.to_Cond) j,
      rw ← iso.eq_inv_comp at this,
      rw ← reassoc_of this, refl },
    { simp only [category.assoc, nat_trans.naturality, ← nat_trans.comp_app_assoc,
        ← functor.map_comp_assoc, ← functor.map_comp, ← nat_trans.comp_app, ← op_comp],
      rw Tinv2_iso_of_bicartesian_aux_3,
      simp only [functor.map_comp, op_comp, nat_trans.comp_app, category.assoc],
      have := Ext_coproduct_iso_π _
        (λ (k : ulift.{u+1 0} ℕ), (QprimeFP.{u} r' BD.data κ M).obj (ι k))
        i ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).obj V.to_Cond) j,
      rw ← iso.eq_inv_comp at this,
      rw ← reassoc_of this,
      refl,
      { apply homotopy_category.colimit_cofan_bdd } } },
  apply Tinv2_iso_of_bicartesian_aux_1,
end

lemma Tinv2_iso_of_bicartesian [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (hκ : Lbar.sufficiently_increasing κ ι)
  (hκ₂ : Lbar.sufficiently_increasing κ₂ ι)
  (i : ℤ)
  (H1 : (shift_sub_id.commsq (ExtQprime.Tinv2 r r' BD.data κ κ₂ M V i) ι hι).bicartesian)
  (H2 : (shift_sub_id.commsq (ExtQprime.Tinv2 r r' BD.data κ κ₂ M V (i+1)) ι hι).bicartesian) :
  is_iso (((Ext (i+1)).map ((BD.eval freeCond'.{u}).map M.Tinv_cond).op).app
    ((single (Condensed Ab) 0).obj V.to_Cond) -
    ((Ext (i+1)).obj ((BD.eval freeCond').op.obj (op (M.to_Condensed)))).map
      ((single (Condensed Ab) 0).map
        (Condensed.of_top_ab_map
          (normed_group_hom.to_add_monoid_hom normed_with_aut.T.inv) (normed_group_hom.continuous _)))) :=
begin
  let Vc := (single (Condensed Ab) 0).obj V.to_Cond,
  have SES₁ := QprimeFP.short_exact BD κ₂ M ι hι hκ₂,
  have SES₂ := QprimeFP.short_exact BD κ M ι hι hκ,
  have := Ext_iso_of_bicartesian_of_bicartesian SES₁ SES₂
    (sigma_map _ (QprimeFP_int.Tinv BD.data _ _ M))
    (sigma_map _ (QprimeFP_int.Tinv BD.data _ _ M))
    (category_theory.functor.map _ M.Tinv_cond)
    (sigma_map _ (QprimeFP_int.ι BD.data _ _ M))
    (sigma_map _ (QprimeFP_int.ι BD.data _ _ M))
    (commsq_shift_sub_id_Tinv BD.data _ _ M ι hι)
    (commsq_sigma_proj_Tinv BD _ _ M ι)
    (commsq_shift_sub_id_ι BD.data _ _ M ι hι)
    (commsq_sigma_proj_ι BD _ _ M ι)
    Vc ((single _ _).map $ Condensed.of_top_ab_map
      (normed_group_hom.to_add_monoid_hom normed_with_aut.T.inv) (normed_group_hom.continuous _))
    _
    (Tinv2_iso_of_bicartesian_aux _ _ _ _ _ _ _ _ _ H1)
    (Tinv2_iso_of_bicartesian_aux _ _ _ _ _ _ _ _ _ H2),
  delta Ext_Tinv2 at this,
  simpa only [op_id, category_theory.functor.map_id, category.id_comp, nat_trans.id_app],
end

lemma Tinv2_iso_of_bicartesian' [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (H : ∀ i, ∃ (ι) (hι),
    Lbar.sufficiently_increasing κ ι ∧
    Lbar.sufficiently_increasing κ₂ ι ∧
    (shift_sub_id.commsq (ExtQprime.Tinv2 r r' BD.data κ κ₂ M V i) ι hι).bicartesian ∧
    (shift_sub_id.commsq (ExtQprime.Tinv2 r r' BD.data κ κ₂ M V (i+1)) ι hι).bicartesian)
  (i : ℤ) :
  is_iso (((Ext i).map ((BD.eval freeCond'.{u}).map M.Tinv_cond).op).app
    ((single (Condensed Ab) 0).obj V.to_Cond) -
    ((Ext i).obj ((BD.eval freeCond').op.obj (op (M.to_Condensed)))).map
      ((single (Condensed Ab) 0).map
        (Condensed.of_top_ab_map
          (normed_group_hom.to_add_monoid_hom normed_with_aut.T.inv) (normed_group_hom.continuous _)))) :=
begin
  obtain ⟨i, rfl⟩ : ∃ k, k+1 = i := ⟨i-1, sub_add_cancel _ _⟩,
  obtain ⟨ι, hι, hκ, hκ₂, H1, H2⟩ := H i,
  apply Tinv2_iso_of_bicartesian _ _ _ _ _ _ ι hι hκ hκ₂ i H1 H2,
end

end preps


import ReactorModel.Determinism.InstantaneousStep

open Classical

namespace Execution
namespace Instantaneous
namespace Execution

variable [ReactorType.Indexable α] {s₁ s₂ : State α}

theorem progress_not_mem_rcns (e : s₁ ⇓ᵢ* s₂) (h : rcn ∈ s₁.progress) : rcn ∉ e.rcns := by
  induction e <;> simp [rcns, not_or]
  case trans e e' hi =>
    simp [hi $ e.monotonic_progress h]
    intro hc
    exact absurd (hc ▸ h) e.rcn_not_mem_progress

theorem mem_progress_iff (e : s₁ ⇓ᵢ* s₂) :
    (rcn ∈ s₂.progress) ↔ (rcn ∈ e.rcns ∨ rcn ∈ s₁.progress) := by
  induction e <;> simp [rcns]
  case trans s₁ s₂ s₃ e e' hi =>
    simp [hi]
    constructor <;> intro
    all_goals repeat cases ‹_ ∨ _› <;> simp [*]
    case mp.inr h      => cases e.mem_progress_iff.mp h <;> simp [*]
    case mpr.inl.inl h => simp [e.rcn_mem_progress]
    case mpr.inr h     => simp [e.monotonic_progress h]

-- Corollary of `InstExecution.mem_progress_iff`.
theorem rcns_mem_progress (e : s₁ ⇓ᵢ* s₂) (h : rcn ∈ e.rcns) : rcn ∈ s₂.progress :=
  e.mem_progress_iff.mpr $ .inl h

theorem rcns_nodup {s₁ s₂ : State α} : (e : s₁ ⇓ᵢ* s₂) → e.rcns.Nodup
  | refl       => List.nodup_nil
  | trans e e' => List.nodup_cons.mpr ⟨e'.progress_not_mem_rcns e.rcn_mem_progress, e'.rcns_nodup⟩

theorem progress_eq_rcns_perm
    (e₁ : s ⇓ᵢ* s₁) (e₂ : s ⇓ᵢ* s₂) (hp : s₁.progress = s₂.progress) : e₁.rcns ~ e₂.rcns := by
  apply List.perm_ext e₁.rcns_nodup e₂.rcns_nodup |>.mpr
  intro rcn
  by_cases hc : rcn ∈ s.progress
  case pos => simp [e₁.progress_not_mem_rcns hc, e₂.progress_not_mem_rcns hc]
  case neg =>
    constructor <;> intro hm
    case mp  => exact e₂.mem_progress_iff.mp (hp ▸ e₁.rcns_mem_progress hm) |>.resolve_right hc
    case mpr => exact e₁.mem_progress_iff.mp (hp ▸ e₂.rcns_mem_progress hm) |>.resolve_right hc

theorem preserves_tag {s₁ s₂ : State α} : (s₁ ⇓ᵢ* s₂) → s₁.tag = s₂.tag
  | refl => rfl
  | trans e e' => e.preserves_tag.trans e'.preserves_tag

theorem rcns_trans_eq_cons (e₁ : s ⇓ᵢ s₁) (e₂ : s₁ ⇓ᵢ* s₂) :
    (trans e₁ e₂).rcns = e₁.rcn :: e₂.rcns := by
  simp [rcns, Step.rcn]

theorem progress_eq {s₁ s₂ : State α} :
    (e : s₁ ⇓ᵢ* s₂) → s₂.progress = s₁.progress ∪ { i | i ∈ e.rcns }
  | refl => by simp [rcns]
  | trans e e' => by
    simp [e.progress_eq ▸ e'.progress_eq, rcns_trans_eq_cons]
    apply Set.insert_union'

theorem mem_rcns_not_mem_progress (e : s₁ ⇓ᵢ* s₂) (h : rcn ∈ e.rcns) : rcn ∉ s₁.progress := by
  induction e
  case refl => contradiction
  case trans e e' hi =>
    cases e'.rcns_trans_eq_cons e ▸ h
    case head   => exact e.rcn_not_mem_progress
    case tail h => exact mt e.monotonic_progress (hi h)

theorem mem_rcns_iff (e : s₁ ⇓ᵢ* s₂) : rcn ∈ e.rcns ↔ (rcn ∈ s₂.progress ∧ rcn ∉ s₁.progress) := by
  simp [e.progress_eq, s₁.mem_record'_progress_iff e.rcns rcn, or_and_right]
  exact e.mem_rcns_not_mem_progress

theorem equiv {s₁ s₂ : State α} : (s₁ ⇓ᵢ* s₂) → s₁.rtr ≈ s₂.rtr
  | refl => .refl
  | trans e e' => ReactorType.Equivalent.trans e.equiv e'.equiv

theorem head_minimal (e : s₁ ⇓ᵢ s₂) (e' : s₂ ⇓ᵢ* s₃) : (e.rcn :: e'.rcns) ≮[s₁.rtr] e.rcn := by
  by_contra hc
  simp [Minimal] at hc
  have ⟨_, hm, h⟩ := hc e.acyclic
  replace hc := mt e.monotonic_progress $ e'.mem_rcns_not_mem_progress hm
  exact absurd (e.allows_rcn.deps h) hc

theorem head_not_mem_tail (e : s₁ ⇓ᵢ s₂) (e' : s₂ ⇓ᵢ* s₃) (h : i ∈ e'.rcns) : e.rcn ≠ i := by
  intro hc
  have := trans e e' |>.rcns_nodup
  have := hc.symm ▸ List.not_nodup_cons_of_mem h
  contradiction

-- The core lemma for `prepend_minimal`.
theorem cons_prepend_minimal
    (e : s₁ ⇓ᵢ s₂) (e' : s₂ ⇓ᵢ* s₃) (hm : i ∈ e'.rcns) (hr : (e.rcn :: e'.rcns) ≮[s₁.rtr] i) :
    ∃ f : s₁ ⇓ᵢ* s₃, f.rcns = i :: e.rcn :: (e'.rcns.erase i) := by
  induction e' generalizing s₁ <;> simp [rcns] at *
  case trans s₁ s₂ s₄ e' e'' hi =>
    cases hm
    case inl hm =>
      simp [hm] at hr
      have ⟨_, f, f', ⟨hf₁, hf₂⟩⟩ := e.prepend_indep e' hr.cons_head
      exists trans f $ trans f' e''
      simp [hm, rcns, ←hf₁, ←hf₂]
    case inr hm =>
      have ⟨f, hf⟩ :=  hi e' hm $ hr.cons_tail.equiv e.equiv
      cases f <;> simp [rcns] at hf
      case trans f f'' =>
        have ⟨h₁, h₂⟩ := hf
        have ⟨_, f, f', ⟨hf₁, hf₂⟩⟩ := e.prepend_indep f $ h₁.symm ▸ hr |>.cons_head
        exists trans f $ trans f' f''
        simp [rcns, hf₁, h₁, hf₂, h₂, e''.rcns.erase_cons_tail $ head_not_mem_tail e' e'' hm]

theorem prepend_minimal (e : s₁ ⇓ᵢ* s₂) (hm : i ∈ e.rcns) (hr : e.rcns ≮[s₁.rtr] i) :
    ∃ (e' : s₁ ⇓ᵢ* s₂), e'.rcns = i :: (e.rcns.erase i) := by
  cases e <;> simp [rcns] at *; cases ‹_ ∨ _›
  case trans.inl e e' h =>
    exists trans e e'
    simp [rcns, h]
  case trans.inr e e' h =>
    exact e'.rcns.erase_cons_tail (head_not_mem_tail e e' h) ▸ cons_prepend_minimal e e' h hr

theorem rcns_perm_deterministic
    (e₁ : s ⇓ᵢ* s₁) (e₂ : s ⇓ᵢ* s₂) (hp : e₁.rcns ~ e₂.rcns) : s₁.rtr = s₂.rtr := by
  induction e₁
  case refl => cases e₂ <;> simp [rcns] at hp ⊢
  case trans s sₘ₁ s₁ e₁ e₁' hi =>
    have hm := hp.mem_iff.mp $ List.mem_cons_self _ _
    have hm' := e₁'.head_minimal e₁ |>.perm hp
    have ⟨e₂, he₂⟩ := e₂.prepend_minimal hm hm'
    cases e₂ <;> simp [rcns] at he₂
    case trans sₘ₂ e₂ e₂' =>
      have ⟨h, h'⟩ := he₂
      cases e₁.deterministic e₂ h.symm
      apply hi e₂'
      rw [h']
      exact List.perm_cons _ |>.mp (hp.trans $ List.perm_cons_erase hm)

protected theorem deterministic
    (e₁ : s ⇓ᵢ* s₁) (e₂ : s ⇓ᵢ* s₂) (ht : s₁.tag = s₂.tag) (hp : s₁.progress = s₂.progress) :
    s₁ = s₂ := by
  ext1 <;> try assumption
  exact rcns_perm_deterministic e₁ e₂ $ progress_eq_rcns_perm e₁ e₂ hp

end Execution
end Instantaneous
end Execution