theorem modifySize {A : Type u} (as : Array A) (f : A → A) (n : Nat) : (as.modify n f).size = as.size := by
  simp [Array.modify, Array.modifyM, Id.run]; split <;> simp [Id.run]

structure Idx (p : Array String) where
  n : Fin p.size

structure Store where
  arr : Array String
  -- integer pointers into `arr`, type-indexed by `arr`
  ids : Array (Idx arr)

instance {arr : Array String} {f : String → String} {n : Nat} : Coe (Array (Idx arr)) (Array (Idx (arr.modify n f))) where
  coe xs :=
    xs.map (fun x => Idx.mk ((modifySize arr f n) ▸ x.n))

def store1 : Store := {
  arr := #["a", "b", "c", "d", "e"]
  ids := #[⟨2, by simp⟩]
}

def tryCoeStore := {
  store1 with
  -- using a lambda here hangs
  arr := store1.arr.modify 2 (fun _ => "Z")
}


/-
File: signature_recover_public_key_reduce_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_verify_zero_soundness
import .signature_recover_public_key_nondet_bigint3_soundness
open tactic

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

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

/- starkware.cairo.common.cairo_secp.field.reduce autogenerated soundness theorem -/

theorem auto_sound_reduce
    -- arguments
    (range_check_ptr : F) (x : UnreducedBigInt3 F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_reduce σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 107))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 59))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 6))
    (hin_x : x = cast_UnreducedBigInt3 mem (σ.fp - 5))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      τ.ap = σ.ap + 31 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 6)) (mem $ τ.ap - 4)
        (spec_reduce mem κ range_check_ptr x (mem (τ.ap - 4)) (cast_BigInt3 mem (τ.ap - 3)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_reduce at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12⟩,
  -- function call
  step_assert_eq hpc0 with arg0,
  step_sub hpc1 (auto_sound_nondet_bigint3 mem _ range_check_ptr _ _),
  { rw hpc2, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x] },
    try { dsimp [cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call3 ap3 h_call3,
  rcases h_call3 with ⟨h_call3_ap_offset, h_call3⟩,
  rcases h_call3 with ⟨rc_m3, rc_mle3, hl_range_check_ptr₁, h_call3⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap3 - 4) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_reduced_x: cast_BigInt3 mem (ap3 - 3) = reduced_x,
  simp only [hr_rev_reduced_x] at h_call3,
  have htv_reduced_x := hr_rev_reduced_x.symm, clear hr_rev_reduced_x,
  try { simp only [arg0] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0] at h_call3 },
  rw [hin_range_check_ptr] at h_call3,
  clear arg0,
  -- function call
  step_assert_eq hpc3 with arg0,
  step_assert_eq hpc4 with arg1,
  step_assert_eq hpc5 with arg2,
  step_assert_eq hpc6 with arg3,
  step_sub hpc7 (auto_sound_verify_zero mem _ range_check_ptr₁ {
    d0 := x.d0 - reduced_x.d0,
    d1 := x.d1 - reduced_x.d1,
    d2 := x.d2 - reduced_x.d2
  } _ _ _),
  { rw hpc8, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, htv_range_check_ptr₁, htv_reduced_x] },
    try { dsimp [cast_UnreducedBigInt3, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3)] },
    try { simp only [h_call3_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, htv_range_check_ptr₁, htv_reduced_x] },
      try { dsimp [cast_UnreducedBigInt3, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3)] },
      try { simp only [h_call3_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call9 ap9 h_call9,
  rcases h_call9 with ⟨h_call9_ap_offset, h_call9⟩,
  rcases h_call9 with ⟨rc_m9, rc_mle9, hl_range_check_ptr₂, h_call9⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap9 - 1) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] 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] at h_call9 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call9,
  clear arg0 arg1 arg2 arg3,
  -- return
  step_assert_eq hpc9 with hret0,
  step_assert_eq hpc10 with hret1,
  step_assert_eq hpc11 with hret2,
  step_ret hpc12,
  -- finish
  step_done, use_only [rfl, rfl],
  split,
  { try { simp only [h_call3_ap_offset ,h_call9_ap_offset] },
    try { arith_simps }, try { refl } },
  -- range check condition
  use_only (rc_m3+rc_m9+0+0), split,
  linarith [rc_mle3, rc_mle9],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2] },
    rw [←htv_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_reduce mem _ range_check_ptr x _ _,
  { apply sound_reduce, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_reduce],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call3],
  use_only [range_check_ptr₁],
  use_only [reduced_x],
  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 spec3 := h_call3 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec3,
  try { dsimp at spec3, arith_simps at spec3 },
  use_only [spec3],
  use_only [κ_call9],
  use_only [range_check_ptr₂],
  have rc_h_range_check_ptr₂ := range_checked_offset' rc_h_range_check_ptr₁,
  have rc_h_range_check_ptr₂' := range_checked_add_right rc_h_range_check_ptr₂, try { norm_cast at rc_h_range_check_ptr₂' },
  have spec9 := h_call9 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec9,
  try { dsimp at spec9, arith_simps at spec9 },
  use_only [spec9],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_x, htv_range_check_ptr₁, htv_reduced_x, htv_range_check_ptr₂] }, },
  try { dsimp [cast_UnreducedBigInt3, cast_BigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2] },
  try { simp only [h_call3_ap_offset, h_call9_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import Init.Classical
import AssertCmd

namespace EVM

deriving instance Repr for ByteArray
deriving instance DecidableEq for ByteArray

structure PushArg where
  bytes : ByteArray
  pf : bytes.size > 0 ∧ bytes.size <= 32

instance : BEq PushArg := { beq := fun a b => a.bytes == b.bytes }

instance : Repr PushArg where
  reprPrec x n := reprPrec x.bytes n

-- instance

inductive InstrExpr where
| IAdd
| IMul
| ISub
| IDiv
| ISdiv
| IMod
| ISmod
| IAddmod
| IMulmod
| IExp
| ISignextend
| ILt
| IGt
| ISlt
| ISgt
| IEq
| IIszero
| IAnd
| IOr
| IXor
| INot
| IByte
| IShl
| IShr
| ISar
| ISha3
deriving Repr, BEq

inductive InstrCtxt where
| IAddress
| IBalance
| IOrigin
| ICaller
| ICallvalue
| ICalldataload
| ICalldatasize
| ICalldatacopy
| ICodesize
| ICodecopy
| IGasprice
| IExtcodesize
| IExtcodecopy
| IReturndatasize
| IReturndatacopy
| IExtcodehash
| IBlockhash
| ICoinbase
| ITimestamp
| INumber
| IDifficulty
| IGaslimit
| IChainid
| ISelfbalance
| IBasefee
deriving Repr, BEq

inductive InstrMem where
| IPop
| IMload
| IMstore
| IMstore8
| ISload
| ISstore
deriving Repr, BEq

inductive InstrOther where
| IStop
| IJump
| IJumpi
| IPc
| IMsize
| IGas
| IJumpdest
| IPush (arg: PushArg)
| IDup (idx: Fin 16)
| ISwap (idx: Fin 16)
| ILog (idx: Fin 5)
| ICreate
| ICall
| ICallcode
| IReturn
| IDelegatecall
| ICreate2
| IStaticcall
| IRevert
| IInvalid
| ISelfdestruct
deriving Repr, BEq

inductive Instruction where
| expr (i : InstrExpr)
| ctxt (i : InstrCtxt)
| mem (i : InstrMem)
| other (i : InstrOther)
deriving Repr, BEq

#print Coe

instance : Coe InstrExpr Instruction := ⟨Instruction.expr⟩
instance : Coe InstrCtxt Instruction := ⟨Instruction.ctxt⟩
instance : Coe InstrMem Instruction := ⟨Instruction.mem⟩
instance : Coe InstrOther Instruction := ⟨Instruction.other⟩

open InstrExpr
open InstrCtxt
open InstrMem
open InstrOther

private def ofOne (u: UInt8) := ByteArray.mk #[u]

open Instruction
def encode (i: Instruction) : ByteArray := match i with
| Instruction.expr e => match e with
  | InstrExpr.IAdd => ofOne 0x01
  | InstrExpr.IMul => ofOne 0x02
  | InstrExpr.ISub => ofOne 0x03
  | InstrExpr.IDiv => ofOne 0x04
  | InstrExpr.ISdiv => ofOne 0x05
  | InstrExpr.IMod => ofOne 0x06
  | InstrExpr.ISmod => ofOne 0x07
  | InstrExpr.IAddmod => ofOne 0x08
  | InstrExpr.IMulmod => ofOne 0x09
  | InstrExpr.IExp => ofOne 0x0a
  | InstrExpr.ISignextend => ofOne 0x0b
  | InstrExpr.ILt => ofOne 0x10
  | InstrExpr.IGt => ofOne 0x11
  | InstrExpr.ISlt => ofOne 0x12
  | InstrExpr.ISgt => ofOne 0x13
  | InstrExpr.IEq => ofOne 0x14
  | InstrExpr.IIszero => ofOne 0x15
  | InstrExpr.IAnd => ofOne 0x16
  | InstrExpr.IOr => ofOne 0x17
  | InstrExpr.IXor => ofOne 0x18
  | InstrExpr.INot => ofOne 0x19
  | InstrExpr.IByte => ofOne 0x1a
  | InstrExpr.IShl => ofOne 0x1b
  | InstrExpr.IShr => ofOne 0x1c
  | InstrExpr.ISar => ofOne 0x1d
  | InstrExpr.ISha3 => ofOne 0x20
| Instruction.ctxt e => match e with
  | InstrCtxt.IAddress => ofOne 0x30
  | InstrCtxt.IBalance => ofOne 0x31
  | InstrCtxt.IOrigin => ofOne 0x32
  | InstrCtxt.ICaller => ofOne 0x33
  | InstrCtxt.ICallvalue => ofOne 0x34
  | InstrCtxt.ICalldataload => ofOne 0x35
  | InstrCtxt.ICalldatasize => ofOne 0x36
  | InstrCtxt.ICalldatacopy => ofOne 0x37
  | InstrCtxt.ICodesize => ofOne 0x38
  | InstrCtxt.ICodecopy => ofOne 0x39
  | InstrCtxt.IGasprice => ofOne 0x3a
  | InstrCtxt.IExtcodesize => ofOne 0x3b
  | InstrCtxt.IExtcodecopy => ofOne 0x3c
  | InstrCtxt.IReturndatasize => ofOne 0x3d
  | InstrCtxt.IReturndatacopy => ofOne 0x3e
  | InstrCtxt.IExtcodehash => ofOne 0x3f
  | InstrCtxt.IBlockhash => ofOne 0x40
  | InstrCtxt.ICoinbase => ofOne 0x41
  | InstrCtxt.ITimestamp => ofOne 0x42
  | InstrCtxt.INumber => ofOne 0x43
  | InstrCtxt.IDifficulty => ofOne 0x44
  | InstrCtxt.IGaslimit => ofOne 0x45
  | InstrCtxt.IChainid => ofOne 0x46
  | InstrCtxt.ISelfbalance => ofOne 0x47
  | InstrCtxt.IBasefee => ofOne 0x48
| Instruction.mem e => match e with
  | InstrMem.IPop => ofOne 0x50
  | InstrMem.IMload => ofOne 0x51
  | InstrMem.IMstore => ofOne 0x52
  | InstrMem.IMstore8 => ofOne 0x53
  | InstrMem.ISload => ofOne 0x54
  | InstrMem.ISstore => ofOne 0x55
| Instruction.other e => match e with
  | InstrOther.IStop => ofOne 0x00
  | InstrOther.IJump => ofOne 0x56
  | InstrOther.IJumpi => ofOne 0x57
  | InstrOther.IPc => ofOne 0x58
  | InstrOther.IMsize => ofOne 0x59
  | InstrOther.IGas => ofOne 0x5a
  | InstrOther.IJumpdest => ofOne 0x5b
  | InstrOther.IPush arg => (ofOne (0x60 + arg.bytes.size.toUInt8 - 1)) ++ arg.bytes
  | InstrOther.IDup n => ofOne (0x80 + n.val.toUInt8)
  | InstrOther.ISwap n => ofOne (0x90 + n.val.toUInt8)
  | InstrOther.ILog 0 => ofOne 0xa0
  | InstrOther.ILog 1 => ofOne 0xa1
  | InstrOther.ILog 2 => ofOne 0xa2
  | InstrOther.ILog 3 => ofOne 0xa3
  | InstrOther.ILog 4 => ofOne 0xa4
  | InstrOther.ICreate => ofOne 0xf0
  | InstrOther.ICall => ofOne 0xf1
  | InstrOther.ICallcode => ofOne 0xf2
  | InstrOther.IReturn => ofOne 0xf3
  | InstrOther.IDelegatecall => ofOne 0xf4
  | InstrOther.ICreate2 => ofOne 0xf5
  | InstrOther.IStaticcall => ofOne 0xfa
  | InstrOther.IRevert => ofOne 0xfd
  | InstrOther.IInvalid => ofOne 0xfe
  | InstrOther.ISelfdestruct => ofOne 0xff

private def get? (b: ByteArray) (i: Nat) : Option UInt8 := dite (i < b.size) (fun p => b.get ⟨ i, p ⟩ ) (fun _ => none)

@[simp] private theorem Array.ofToSubarray (a: Array α) : Array.ofSubarray a.toSubarray = a := sorry

@[simp] private theorem extractSize (b: ByteArray) (n: Nat) (h: b.size >= n) a : (b.extract a n).size = n - a := by
  admit

@[simp] private theorem pff (b: ByteArray) n (h1: n <= 32) (h3: b.size >= n): (b.extract 1 (n+1)).size > 0 ∧ (b.extract 1 (n+1)).size <= 32 := by
  -- rw [extractSize b n h3 1]
  -- simp
  admit

private def btailn (b: ByteArray) n := b.extract n b.size

-- #eval btailn (ByteArray.mk #[0x00, 0x01]) 1

private def taken? (b: ByteArray) n (h: n <= 32) : Option Instruction × ByteArray :=
  dite (b.size >= n)
    (fun pf => (Instruction.other $ InstrOther.IPush { bytes := b.extract 1 (n+1), pf := pff b n h pf}, btailn b (n+1) ))
    (fun _ => (none, b))

private theorem t0lt32 : 0 <= 32 := by simp
private theorem t1lt32 : 1 <= 32 := by simp
private theorem t2lt32 : 2 <= 32 := by simp
private theorem t3lt32 : 3 <= 32 := by simp
private theorem t4lt32 : 4 <= 32 := by simp
private theorem t5lt32 : 5 <= 32 := by simp
private theorem t6lt32 : 6 <= 32 := by simp
private theorem t7lt32 : 7 <= 32 := by simp
private theorem t8lt32 : 8 <= 32 := by simp
private theorem t9lt32 : 9 <= 32 := by simp
private theorem t10lt32 : 10 <= 32 := by simp
private theorem t11lt32 : 11 <= 32 := by simp
private theorem t12lt32 : 12 <= 32 := by simp
private theorem t13lt32 : 13 <= 32 := by simp
private theorem t14lt32 : 14 <= 32 := by simp
private theorem t15lt32 : 15 <= 32 := by simp
private theorem t16lt32 : 16 <= 32 := by simp
private theorem t17lt32 : 17 <= 32 := by simp
private theorem t18lt32 : 18 <= 32 := by simp
private theorem t19lt32 : 19 <= 32 := by simp
private theorem t20lt32 : 20 <= 32 := by simp
private theorem t21lt32 : 21 <= 32 := by simp
private theorem t22lt32 : 22 <= 32 := by simp
private theorem t23lt32 : 23 <= 32 := by simp
private theorem t24lt32 : 24 <= 32 := by simp
private theorem t25lt32 : 25 <= 32 := by simp
private theorem t26lt32 : 26 <= 32 := by simp
private theorem t27lt32 : 27 <= 32 := by simp
private theorem t28lt32 : 28 <= 32 := by simp
private theorem t29lt32 : 29 <= 32 := by simp
private theorem t30lt32 : 30 <= 32 := by simp
private theorem t31lt32 : 31 <= 32 := by simp
private theorem t32lt32 : 32 <= 32 := by simp

set_option maxHeartbeats 200000
def decode (b: ByteArray) : Option Instruction × ByteArray :=
  let btail := btailn b 1
  match get? b 0 with
  | none => (none, b)
  | some v => match v.val.val with
    | 0x00 => (some IStop, btail)
    | 0x01 => (some IAdd, btail)
    | 0x02 => (some IMul, btail)
    | 0x03 => (some ISub, btail)
    | 0x04 => (some IDiv, btail)
    | 0x05 => (some ISdiv, btail)
    | 0x06 => (some IMod, btail)
    | 0x07 => (some ISmod, btail)
    | 0x08 => (some IAddmod, btail)
    | 0x09 => (some IMulmod, btail)
    | 0x0a => (some IExp, btail)
    | 0x0b => (some ISignextend, btail)

    | 0x10 => (some ILt, btail)
    | 0x11 => (some IGt, btail)
    | 0x12 => (some ISlt, btail)
    | 0x13 => (some ISgt, btail)
    | 0x14 => (some IEq, btail)
    | 0x15 => (some IIszero, btail)
    | 0x16 => (some IAnd, btail)
    | 0x17 => (some IOr, btail)
    | 0x18 => (some IXor, btail)
    | 0x19 => (some INot, btail)
    | 0x1a => (some IByte, btail)
    | 0x1b => (some IShl, btail)
    | 0x1c => (some IShr, btail)
    | 0x1d => (some ISar, btail)

    | 0x20 => (some ISha3, btail)

    | 0x30 => (some IAddress, btail)
    | 0x31 => (some IBalance, btail)
    | 0x32 => (some IOrigin, btail)
    | 0x33 => (some ICaller, btail)
    | 0x34 => (some ICallvalue, btail)
    | 0x35 => (some ICalldataload, btail)
    | 0x36 => (some ICalldatasize, btail)
    | 0x37 => (some ICalldatacopy, btail)
    | 0x38 => (some ICodesize, btail)
    | 0x39 => (some ICodecopy, btail)
    | 0x3a => (some IGasprice, btail)
    | 0x3b => (some IExtcodesize, btail)
    | 0x3c => (some IExtcodecopy, btail)
    | 0x3d => (some IReturndatasize, btail)
    | 0x3e => (some IReturndatacopy, btail)
    | 0x3f => (some IExtcodehash, btail)

    | 0x40 => (some IBlockhash, btail)
    | 0x41 => (some ICoinbase, btail)
    | 0x42 => (some ITimestamp, btail)
    | 0x43 => (some INumber, btail)
    | 0x44 => (some IDifficulty, btail)
    | 0x45 => (some IGaslimit, btail)
    | 0x46 => (some IChainid, btail)
    | 0x47 => (some ISelfbalance, btail)
    | 0x48 => (some IBasefee, btail)

    | 0x50 => (some IPop, btail)
    | 0x51 => (some IMload, btail)
    | 0x52 => (some IMstore, btail)
    | 0x53 => (some IMstore8, btail)
    | 0x54 => (some ISload, btail)
    | 0x55 => (some ISstore, btail)
    | 0x56 => (some IJump, btail)
    | 0x57 => (some IJumpi, btail)
    | 0x58 => (some IPc, btail)
    | 0x59 => (some IMsize, btail)
    | 0x5a => (some IGas, btail)
    | 0x5b => (some IJumpdest, btail)

    | 0x60 => taken? b 1 t1lt32
    | 0x61 => taken? b 2 t2lt32
    | 0x62 => taken? b 3 t3lt32
    | 0x63 => taken? b 4 t4lt32
    | 0x64 => taken? b 5 t5lt32
    | 0x65 => taken? b 6 t6lt32
    | 0x66 => taken? b 7 t7lt32
    | 0x67 => taken? b 8 t8lt32
    | 0x68 => taken? b 9 t9lt32
    | 0x69 => taken? b 10 t10lt32
    | 0x6a => taken? b 11 t11lt32
    | 0x6b => taken? b 12 t12lt32
    | 0x6c => taken? b 13 t13lt32
    | 0x6d => taken? b 14 t14lt32
    | 0x6e => taken? b 15 t15lt32
    | 0x6f => taken? b 16 t16lt32
    | 0x70 => taken? b 17 t17lt32
    | 0x71 => taken? b 18 t18lt32
    | 0x72 => taken? b 19 t19lt32
    | 0x73 => taken? b 20 t20lt32
    | 0x74 => taken? b 21 t21lt32
    | 0x75 => taken? b 22 t22lt32
    | 0x76 => taken? b 23 t23lt32
    | 0x77 => taken? b 24 t24lt32
    | 0x78 => taken? b 25 t25lt32
    | 0x79 => taken? b 26 t26lt32
    | 0x7a => taken? b 27 t27lt32
    | 0x7b => taken? b 28 t28lt32
    | 0x7c => taken? b 29 t29lt32
    | 0x7d => taken? b 30 t30lt32
    | 0x7e => taken? b 31 t31lt32
    | 0x7f => taken? b 32 t32lt32

    | 0x80 => (some $ IDup 0, btail)
    | 0x81 => (some $ IDup 1, btail)
    | 0x82 => (some $ IDup 2, btail)
    | 0x83 => (some $ IDup 3, btail)
    | 0x84 => (some $ IDup 4, btail)
    | 0x85 => (some $ IDup 5, btail)
    | 0x86 => (some $ IDup 6, btail)
    | 0x87 => (some $ IDup 7, btail)
    | 0x88 => (some $ IDup 8, btail)
    | 0x89 => (some $ IDup 9, btail)
    | 0x8a => (some $ IDup 10, btail)
    | 0x8b => (some $ IDup 11, btail)
    | 0x8c => (some $ IDup 12, btail)
    | 0x8d => (some $ IDup 13, btail)
    | 0x8e => (some $ IDup 14, btail)
    | 0x8f => (some $ IDup 15, btail)

    | 0x90 => (some $ ISwap 0, btail)
    | 0x91 => (some $ ISwap 1, btail)
    | 0x92 => (some $ ISwap 2, btail)
    | 0x93 => (some $ ISwap 3, btail)
    | 0x94 => (some $ ISwap 4, btail)
    | 0x95 => (some $ ISwap 5, btail)
    | 0x96 => (some $ ISwap 6, btail)
    | 0x97 => (some $ ISwap 7, btail)
    | 0x98 => (some $ ISwap 8, btail)
    | 0x99 => (some $ ISwap 9, btail)
    | 0x9a => (some $ ISwap 10, btail)
    | 0x9b => (some $ ISwap 11, btail)
    | 0x9c => (some $ ISwap 12, btail)
    | 0x9d => (some $ ISwap 13, btail)
    | 0x9e => (some $ ISwap 14, btail)
    | 0x9f => (some $ ISwap 15, btail)

    | 0xa0 => (some $ ILog 0, btail)
    | 0xa1 => (some $ ILog 1, btail)
    | 0xa2 => (some $ ILog 2, btail)
    | 0xa3 => (some $ ILog 3, btail)
    | 0xa4 => (some $ ILog 4, btail)

    | 0xf0 => (some ICreate, btail)
    | 0xf1 => (some ICall, btail)
    | 0xf2 => (some ICallcode, btail)
    | 0xf3 => (some IReturn, btail)
    | 0xf4 => (some IDelegatecall, btail)
    | 0xf5 => (some ICreate2, btail)
    | 0xfa => (some IStaticcall, btail)
    | 0xfd => (some IRevert, btail)
    | 0xfe => (some IInvalid, btail)
    | 0xff => (some ISelfdestruct, btail)

    | _ => (none, b)

@[simp] private def getFirstElem : (get? (ByteArray.mk #[a]) 0) = some a := rfl
@[simp] private def extractEmpty (b: ByteArray) n : ByteArray.extract b n n = ByteArray.empty := sorry
@[simp] private def btailnSizeOne : btailn {data := #[a]} 1 = ByteArray.empty := by
  simp [btailn, ByteArray.size, Array.size, List.length]

private theorem finCases' (n : Fin 16) :
  (((n = 15 ∨ n = 14) ∨ (n = 13 ∨ n = 12)) ∨
  ((n = 11 ∨ n = 10) ∨ (n = 9 ∨ n = 8))) ∨
  (((n = 7 ∨ n = 6) ∨ (n = 5 ∨ n = 4)) ∨
  ((n = 3 ∨ n = 2) ∨ (n = 1 ∨ n = 0))) := match n with
  | Fin.mk n pf => by
  by_cases h : n = 15; subst h; exact Or.inl $ Or.inl $ Or.inl $ Or.inl rfl
  have pf : n < 15 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 14; subst h; exact Or.inl $ Or.inl $ Or.inl $ Or.inr rfl
  have pf : n < 14 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 13; subst h; exact Or.inl $ Or.inl $ Or.inr $ Or.inl rfl
  have pf : n < 13 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 12; subst h; exact Or.inl $ Or.inl $ Or.inr $ Or.inr rfl
  have pf : n < 12 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 11; subst h; exact Or.inl $ Or.inr $ Or.inl $ Or.inl rfl
  have pf : n < 11 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 10; subst h; exact Or.inl $ Or.inr $ Or.inl $ Or.inr rfl
  have pf : n < 10 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 9; subst h; exact Or.inl $ Or.inr $ Or.inr $ Or.inl rfl
  have pf : n < 9 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 8; subst h; exact Or.inl $ Or.inr $ Or.inr $ Or.inr rfl
  have pf : n < 8 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 7; subst h; exact Or.inr $ Or.inl $ Or.inl $ Or.inl rfl
  have pf : n < 7 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 6; subst h; exact Or.inr $ Or.inl $ Or.inl $ Or.inr rfl
  have pf : n < 6 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 5; subst h; exact Or.inr $ Or.inl $ Or.inr $ Or.inl rfl
  have pf : n < 5 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 4; subst h; exact Or.inr $ Or.inl $ Or.inr $ Or.inr rfl
  have pf : n < 4 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 3; subst h; exact Or.inr $ Or.inr $ Or.inl $ Or.inl rfl
  have pf : n < 3 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 2; subst h; exact Or.inr $ Or.inr $ Or.inl $ Or.inr rfl
  have pf : n < 2 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 1; subst h; exact Or.inr $ Or.inr $ Or.inr $ Or.inl rfl
  have pf : n < 1 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  by_cases h : n = 0; subst h; exact Or.inr $ Or.inr $ Or.inr $ Or.inr rfl
  have pf : n < 0 := by apply Nat.lt_of_le_and_ne (Nat.le_of_lt_succ pf) h
  cases pf

private theorem finCases5 (motive: Fin 5 -> Prop) (n : Fin 5)
  (f0 : motive 0) (f1 : motive 1) (f2 : motive 2) (f3 : motive 3)
  (f4 : motive 4) : motive n := match n with | Fin.mk n pf => match n with
  | 0 => f0
  | 1 => f1
  | 2 => f2
  | 3 => f3
  | 4 => f4
  | Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ n' => by
    repeat (have pf := Nat.lt_of_succ_lt_succ pf)
    cases pf

private theorem finCases16 (motive: Fin 16 -> Prop) (n : Fin 16)
  (f0 : motive 0) (f1 : motive 1) (f2 : motive 2) (f3 : motive 3)
  (f4 : motive 4) (f5 : motive 5) (f6 : motive 6) (f7 : motive 7)
  (f8 : motive 8) (f9 : motive 9) (f10 : motive 10) (f11 : motive 11)
  (f12 : motive 12) (f13 : motive 13) (f14 : motive 14) (f15 : motive 15) : motive n := match n with | Fin.mk n pf => match n with
  | 0 => f0 | 1 => f1 | 2 => f2 | 3 => f3
  | 4 => f4 | 5 => f5 | 6 => f6 | 7 => f7
  | 8 => f8 | 9 => f9 | 10 => f10 | 11 => f11
  | 12 => f12 | 13 => f13 | 14 => f14 | 15 => f15
  | Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $
    Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $
    Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $
    Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ Nat.succ $ n' => by
    repeat (have pf := Nat.lt_of_succ_lt_succ pf)
    cases pf

@[simp] private theorem t1 : get? { data := #[a] } 0 = some a := by simp
@[simp] private theorem t2 : btailn { data := #[a] } 1 = ByteArray.empty := by simp

private theorem encDecIPush (n: PushArg) : decode (encode (IPush n)) = (some (Instruction.other $ IPush n), ByteArray.empty) := by
  simp [encode, ofOne]
  admit

#assert (encode (IPush { bytes := ByteArray.mk #[0x01, 0x02, 0x02], pf := sorry } )).data == (ByteArray.mk #[0x62, 0x01, 0x02, 0x02]).data
-- #assert (decode (encode (IPush { bytes := ByteArray.mk #[0x01, 0x02, 0x02], pf := sorry } ))).fst == (some $ Instruction.other $ IPush { bytes := ByteArray.mk #[0x01, 0x02, 0x02], pf := sorry })

private theorem encDecIDup (n: Fin 16) : decode (encode (IDup n)) = (some (Instruction.other $ IDup n), ByteArray.empty) := by
  simp [encode, ofOne]
  have h0 : 128 + (0: Fin 16).val.toUInt8 = 128 := by rfl
  have h1 : 128 + (1: Fin 16).val.toUInt8 = 129 := by rfl
  have h2 : 128 + (2: Fin 16).val.toUInt8 = 130 := by rfl
  have h3 : 128 + (3: Fin 16).val.toUInt8 = 131 := by rfl
  have h4 : 128 + (4: Fin 16).val.toUInt8 = 132 := by rfl
  have h5 : 128 + (5: Fin 16).val.toUInt8 = 133 := by rfl
  have h6 : 128 + (6: Fin 16).val.toUInt8 = 134 := by rfl
  have h7 : 128 + (7: Fin 16).val.toUInt8 = 135 := by rfl
  have h8 : 128 + (8: Fin 16).val.toUInt8 = 136 := by rfl
  have h9 : 128 + (9: Fin 16).val.toUInt8 = 137 := by rfl
  have h10 : 128 + (10: Fin 16).val.toUInt8 = 138 := by rfl
  have h11 : 128 + (11: Fin 16).val.toUInt8 = 139 := by rfl
  have h12 : 128 + (12: Fin 16).val.toUInt8 = 140 := by rfl
  have h13 : 128 + (13: Fin 16).val.toUInt8 = 141 := by rfl
  have h14 : 128 + (14: Fin 16).val.toUInt8 = 142 := by rfl
  have h15 : 128 + (15: Fin 16).val.toUInt8 = 143 := by rfl

  cases n using finCases16 <;> simp only [h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15] <;> (unfold decode ; rw [t1, t2])

private theorem encDecISwap (n: Fin 16) : decode (encode (ISwap n)) = (some (Instruction.other $ ISwap n), ByteArray.empty) := by
  simp [encode, ofOne]
  have h0 : 144 + (0: Fin 16).val.toUInt8 = 144 := by rfl
  have h1 : 144 + (1: Fin 16).val.toUInt8 = 145 := by rfl
  have h2 : 144 + (2: Fin 16).val.toUInt8 = 146 := by rfl
  have h3 : 144 + (3: Fin 16).val.toUInt8 = 147 := by rfl
  have h4 : 144 + (4: Fin 16).val.toUInt8 = 148 := by rfl
  have h5 : 144 + (5: Fin 16).val.toUInt8 = 149 := by rfl
  have h6 : 144 + (6: Fin 16).val.toUInt8 = 150 := by rfl
  have h7 : 144 + (7: Fin 16).val.toUInt8 = 151 := by rfl
  have h8 : 144 + (8: Fin 16).val.toUInt8 = 152 := by rfl
  have h9 : 144 + (9: Fin 16).val.toUInt8 = 153 := by rfl
  have h10 : 144 + (10: Fin 16).val.toUInt8 = 154 := by rfl
  have h11 : 144 + (11: Fin 16).val.toUInt8 = 155 := by rfl
  have h12 : 144 + (12: Fin 16).val.toUInt8 = 156 := by rfl
  have h13 : 144 + (13: Fin 16).val.toUInt8 = 157 := by rfl
  have h14 : 144 + (14: Fin 16).val.toUInt8 = 158 := by rfl
  have h15 : 144 + (15: Fin 16).val.toUInt8 = 159 := by rfl

  cases n using finCases16 <;> simp only [h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15] <;> (unfold decode ; rw [t1, t2])

private theorem encDecILog (n: Fin 5) : decode (encode (ILog n)) = (some (Instruction.other $ ILog n), ByteArray.empty) := by
  simp [encode, ofOne]
  have h0 : 144 + (0: Fin 16).val.toUInt8 = 144 := by rfl
  have h1 : 144 + (1: Fin 16).val.toUInt8 = 145 := by rfl
  have h2 : 144 + (2: Fin 16).val.toUInt8 = 146 := by rfl
  have h3 : 144 + (3: Fin 16).val.toUInt8 = 147 := by rfl
  have h4 : 144 + (4: Fin 16).val.toUInt8 = 148 := by rfl
  have h5 : 144 + (5: Fin 16).val.toUInt8 = 149 := by rfl
  have h6 : 144 + (6: Fin 16).val.toUInt8 = 150 := by rfl
  have h7 : 144 + (7: Fin 16).val.toUInt8 = 151 := by rfl
  have h8 : 144 + (8: Fin 16).val.toUInt8 = 152 := by rfl
  have h9 : 144 + (9: Fin 16).val.toUInt8 = 153 := by rfl
  have h10 : 144 + (10: Fin 16).val.toUInt8 = 154 := by rfl
  have h11 : 144 + (11: Fin 16).val.toUInt8 = 155 := by rfl
  have h12 : 144 + (12: Fin 16).val.toUInt8 = 156 := by rfl
  have h13 : 144 + (13: Fin 16).val.toUInt8 = 157 := by rfl
  have h14 : 144 + (14: Fin 16).val.toUInt8 = 158 := by rfl
  have h15 : 144 + (15: Fin 16).val.toUInt8 = 159 := by rfl

  cases n using finCases5 <;> simp only [h0, h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, h15] <;> (unfold decode ; rw [t1, t2])

#eval 0

macro "solvefast" : tactic => `(simp [encode, ofOne]; unfold decode; rw [t1, t2])

private theorem encodeDecodeIStop : decode (encode IStop) = (some $ Instruction.other $ IStop, ByteArray.empty) := by solvefast
private theorem encodeDecodeIAdd : decode (encode IAdd) = (some $ Instruction.expr $ IAdd, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMul : decode (encode IMul) = (some $ Instruction.expr $ IMul, ByteArray.empty) := by solvefast
private theorem encodeDecodeISub : decode (encode ISub) = (some $ Instruction.expr $ ISub, ByteArray.empty) := by solvefast
private theorem encodeDecodeIDiv : decode (encode IDiv) = (some $ Instruction.expr $ IDiv, ByteArray.empty) := by solvefast
private theorem encodeDecodeISdiv : decode (encode ISdiv) = (some $ Instruction.expr $ ISdiv, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMod : decode (encode IMod) = (some $ Instruction.expr $ IMod, ByteArray.empty) := by solvefast
private theorem encodeDecodeISmod : decode (encode ISmod) = (some $ Instruction.expr $ ISmod, ByteArray.empty) := by solvefast
private theorem encodeDecodeIAddmod : decode (encode IAddmod) = (some $ Instruction.expr $ IAddmod, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMulmod : decode (encode IMulmod) = (some $ Instruction.expr $ IMulmod, ByteArray.empty) := by solvefast
private theorem encodeDecodeIExp : decode (encode IExp) = (some $ Instruction.expr $ IExp, ByteArray.empty) := by solvefast
private theorem encodeDecodeISignextend : decode (encode ISignextend) = (some $ Instruction.expr $ ISignextend, ByteArray.empty) := by solvefast
private theorem encodeDecodeILt : decode (encode ILt) = (some $ Instruction.expr $ ILt, ByteArray.empty) := by solvefast
private theorem encodeDecodeIGt : decode (encode IGt) = (some $ Instruction.expr $ IGt, ByteArray.empty) := by solvefast
private theorem encodeDecodeISlt : decode (encode ISlt) = (some $ Instruction.expr $ ISlt, ByteArray.empty) := by solvefast
private theorem encodeDecodeISgt : decode (encode ISgt) = (some $ Instruction.expr $ ISgt, ByteArray.empty) := by solvefast
private theorem encodeDecodeIEq : decode (encode IEq) = (some $ Instruction.expr $ IEq, ByteArray.empty) := by solvefast
private theorem encodeDecodeIIszero : decode (encode IIszero) = (some $ Instruction.expr $ IIszero, ByteArray.empty) := by solvefast
private theorem encodeDecodeIAnd : decode (encode IAnd) = (some $ Instruction.expr $ IAnd, ByteArray.empty) := by solvefast
private theorem encodeDecodeIOr : decode (encode IOr) = (some $ Instruction.expr $ IOr, ByteArray.empty) := by solvefast
private theorem encodeDecodeIXor : decode (encode IXor) = (some $ Instruction.expr $ IXor, ByteArray.empty) := by solvefast
private theorem encodeDecodeINot : decode (encode INot) = (some $ Instruction.expr $ INot, ByteArray.empty) := by solvefast
private theorem encodeDecodeIByte : decode (encode IByte) = (some $ Instruction.expr $ IByte, ByteArray.empty) := by solvefast
private theorem encodeDecodeIShl : decode (encode IShl) = (some $ Instruction.expr $ IShl, ByteArray.empty) := by solvefast
private theorem encodeDecodeIShr : decode (encode IShr) = (some $ Instruction.expr $ IShr, ByteArray.empty) := by solvefast
private theorem encodeDecodeISar : decode (encode ISar) = (some $ Instruction.expr $ ISar, ByteArray.empty) := by solvefast
private theorem encodeDecodeISha3 : decode (encode ISha3) = (some $ Instruction.expr $ ISha3, ByteArray.empty) := by solvefast
private theorem encodeDecodeIAddress : decode (encode IAddress) = (some $ Instruction.ctxt $ IAddress, ByteArray.empty) := by solvefast
private theorem encodeDecodeIBalance : decode (encode IBalance) = (some $ Instruction.ctxt $ IBalance, ByteArray.empty) := by solvefast
private theorem encodeDecodeIOrigin : decode (encode IOrigin) = (some $ Instruction.ctxt $ IOrigin, ByteArray.empty) := by solvefast
private theorem encodeDecodeICaller : decode (encode ICaller) = (some $ Instruction.ctxt $ ICaller, ByteArray.empty) := by solvefast
private theorem encodeDecodeICallvalue : decode (encode ICallvalue) = (some $ Instruction.ctxt $ ICallvalue, ByteArray.empty) := by solvefast
private theorem encodeDecodeICalldataload : decode (encode ICalldataload) = (some $ Instruction.ctxt $ ICalldataload, ByteArray.empty) := by solvefast
private theorem encodeDecodeICalldatasize : decode (encode ICalldatasize) = (some $ Instruction.ctxt $ ICalldatasize, ByteArray.empty) := by solvefast
private theorem encodeDecodeICalldatacopy : decode (encode ICalldatacopy) = (some $ Instruction.ctxt $ ICalldatacopy, ByteArray.empty) := by solvefast
private theorem encodeDecodeICodesize : decode (encode ICodesize) = (some $ Instruction.ctxt $ ICodesize, ByteArray.empty) := by solvefast
private theorem encodeDecodeICodecopy : decode (encode ICodecopy) = (some $ Instruction.ctxt $ ICodecopy, ByteArray.empty) := by solvefast
private theorem encodeDecodeIGasprice : decode (encode IGasprice) = (some $ Instruction.ctxt $ IGasprice, ByteArray.empty) := by solvefast
private theorem encodeDecodeIExtcodesize : decode (encode IExtcodesize) = (some $ Instruction.ctxt $ IExtcodesize, ByteArray.empty) := by solvefast
private theorem encodeDecodeIExtcodecopy : decode (encode IExtcodecopy) = (some $ Instruction.ctxt $ IExtcodecopy, ByteArray.empty) := by solvefast
private theorem encodeDecodeIReturndatasize : decode (encode IReturndatasize) = (some $ Instruction.ctxt $ IReturndatasize, ByteArray.empty) := by solvefast
private theorem encodeDecodeIReturndatacopy : decode (encode IReturndatacopy) = (some $ Instruction.ctxt $ IReturndatacopy, ByteArray.empty) := by solvefast
private theorem encodeDecodeIExtcodehash : decode (encode IExtcodehash) = (some $ Instruction.ctxt $ IExtcodehash, ByteArray.empty) := by solvefast
private theorem encodeDecodeIBlockhash : decode (encode IBlockhash) = (some $ Instruction.ctxt $ IBlockhash, ByteArray.empty) := by solvefast
private theorem encodeDecodeICoinbase : decode (encode ICoinbase) = (some $ Instruction.ctxt $ ICoinbase, ByteArray.empty) := by solvefast
private theorem encodeDecodeITimestamp : decode (encode ITimestamp) = (some $ Instruction.ctxt $ ITimestamp, ByteArray.empty) := by solvefast
private theorem encodeDecodeINumber : decode (encode INumber) = (some $ Instruction.ctxt $ INumber, ByteArray.empty) := by solvefast
private theorem encodeDecodeIDifficulty : decode (encode IDifficulty) = (some $ Instruction.ctxt $ IDifficulty, ByteArray.empty) := by solvefast
private theorem encodeDecodeIGaslimit : decode (encode IGaslimit) = (some $ Instruction.ctxt $ IGaslimit, ByteArray.empty) := by solvefast
private theorem encodeDecodeIChainid : decode (encode IChainid) = (some $ Instruction.ctxt $ IChainid, ByteArray.empty) := by solvefast
private theorem encodeDecodeISelfbalance : decode (encode ISelfbalance) = (some $ Instruction.ctxt $ ISelfbalance, ByteArray.empty) := by solvefast
private theorem encodeDecodeIBasefee : decode (encode IBasefee) = (some $ Instruction.ctxt $ IBasefee, ByteArray.empty) := by solvefast
private theorem encodeDecodeIPop : decode (encode IPop) = (some $ Instruction.mem $ IPop, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMload : decode (encode IMload) = (some $ Instruction.mem $ IMload, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMstore : decode (encode IMstore) = (some $ Instruction.mem $ IMstore, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMstore8 : decode (encode IMstore8) = (some $ Instruction.mem $ IMstore8, ByteArray.empty) := by solvefast
private theorem encodeDecodeISload : decode (encode ISload) = (some $ Instruction.mem $ ISload, ByteArray.empty) := by solvefast
private theorem encodeDecodeISstore : decode (encode ISstore) = (some $ Instruction.mem $ ISstore, ByteArray.empty) := by solvefast
private theorem encodeDecodeIJump : decode (encode IJump) = (some $ Instruction.other $ IJump, ByteArray.empty) := by solvefast
private theorem encodeDecodeIJumpi : decode (encode IJumpi) = (some $ Instruction.other $ IJumpi, ByteArray.empty) := by solvefast
private theorem encodeDecodeIPc : decode (encode IPc) = (some $ Instruction.other $ IPc, ByteArray.empty) := by solvefast
private theorem encodeDecodeIMsize : decode (encode IMsize) = (some $ Instruction.other $ IMsize, ByteArray.empty) := by solvefast
private theorem encodeDecodeIGas : decode (encode IGas) = (some $ Instruction.other $ IGas, ByteArray.empty) := by solvefast
private theorem encodeDecodeIJumpdest : decode (encode IJumpdest) = (some $ Instruction.other $ IJumpdest, ByteArray.empty) := by solvefast
private theorem encodeDecodeICreate : decode (encode ICreate) = (some $ Instruction.other $ ICreate, ByteArray.empty) := by solvefast
private theorem encodeDecodeICall : decode (encode ICall) = (some $ Instruction.other $ ICall, ByteArray.empty) := by solvefast
private theorem encodeDecodeICallcode : decode (encode ICallcode) = (some $ Instruction.other $ ICallcode, ByteArray.empty) := by solvefast
private theorem encodeDecodeIReturn : decode (encode IReturn) = (some $ Instruction.other $ IReturn, ByteArray.empty) := by solvefast
private theorem encodeDecodeIDelegatecall : decode (encode IDelegatecall) = (some $ Instruction.other $ IDelegatecall, ByteArray.empty) := by solvefast
private theorem encodeDecodeICreate2 : decode (encode ICreate2) = (some $ Instruction.other $ ICreate2, ByteArray.empty) := by solvefast
private theorem encodeDecodeIStaticcall : decode (encode IStaticcall) = (some $ Instruction.other $ IStaticcall, ByteArray.empty) := by solvefast
private theorem encodeDecodeIRevert : decode (encode IRevert) = (some $ Instruction.other $ IRevert, ByteArray.empty) := by solvefast
private theorem encodeDecodeIInvalid : decode (encode IInvalid) = (some $ Instruction.other $ IInvalid, ByteArray.empty) := by solvefast
private theorem encodeDecodeISelfdestruct : decode (encode ISelfdestruct) = (some $ Instruction.other $ ISelfdestruct, ByteArray.empty) := by solvefast

theorem encodeDecode (i: Instruction) : decode (encode i) = (some i, ByteArray.empty) :=
match i with
| IStop => encodeDecodeIStop
| IAdd => encodeDecodeIAdd
| IMul => encodeDecodeIMul
| ISub => encodeDecodeISub
| IDiv => encodeDecodeIDiv
| ISdiv => encodeDecodeISdiv
| IMod => encodeDecodeIMod
| ISmod => encodeDecodeISmod
| IAddmod => encodeDecodeIAddmod
| IMulmod => encodeDecodeIMulmod
| IExp => encodeDecodeIExp
| ISignextend => encodeDecodeISignextend

| ILt => encodeDecodeILt
| IGt => encodeDecodeIGt
| ISlt => encodeDecodeISlt
| ISgt => encodeDecodeISgt
| IEq => encodeDecodeIEq
| IIszero => encodeDecodeIIszero
| IAnd => encodeDecodeIAnd
| IOr => encodeDecodeIOr
| IXor => encodeDecodeIXor
| INot => encodeDecodeINot
| IByte => encodeDecodeIByte
| IShl => encodeDecodeIShl
| IShr => encodeDecodeIShr
| ISar => encodeDecodeISar

| ISha3 => encodeDecodeISha3

| IAddress => encodeDecodeIAddress
| IBalance => encodeDecodeIBalance
| IOrigin => encodeDecodeIOrigin
| ICaller => encodeDecodeICaller
| ICallvalue => encodeDecodeICallvalue
| ICalldataload => encodeDecodeICalldataload
| ICalldatasize => encodeDecodeICalldatasize
| ICalldatacopy => encodeDecodeICalldatacopy
| ICodesize => encodeDecodeICodesize
| ICodecopy => encodeDecodeICodecopy
| IGasprice => encodeDecodeIGasprice
| IExtcodesize => encodeDecodeIExtcodesize
| IExtcodecopy => encodeDecodeIExtcodecopy
| IReturndatasize => encodeDecodeIReturndatasize
| IReturndatacopy => encodeDecodeIReturndatacopy
| IExtcodehash => encodeDecodeIExtcodehash

| IBlockhash => encodeDecodeIBlockhash
| ICoinbase => encodeDecodeICoinbase
| ITimestamp => encodeDecodeITimestamp
| INumber => encodeDecodeINumber
| IDifficulty => encodeDecodeIDifficulty
| IGaslimit => encodeDecodeIGaslimit
| IChainid => encodeDecodeIChainid
| ISelfbalance => encodeDecodeISelfbalance
| IBasefee => encodeDecodeIBasefee

| IPop => encodeDecodeIPop
| IMload => encodeDecodeIMload
| IMstore => encodeDecodeIMstore
| IMstore8 => encodeDecodeIMstore8
| ISload => encodeDecodeISload
| ISstore => encodeDecodeISstore
| IJump => encodeDecodeIJump
| IJumpi => encodeDecodeIJumpi
| IPc => encodeDecodeIPc
| IMsize => encodeDecodeIMsize
| IGas => encodeDecodeIGas
| IJumpdest => encodeDecodeIJumpdest

| IPush arg => encDecIPush arg

| IDup n => encDecIDup n

| ISwap n => encDecISwap n

| ILog n => encDecILog n

| ICreate => encodeDecodeICreate
| ICall => encodeDecodeICall
| ICallcode => encodeDecodeICallcode
| IReturn => encodeDecodeIReturn
| IDelegatecall => encodeDecodeIDelegatecall
| ICreate2 => encodeDecodeICreate2
| IStaticcall => encodeDecodeIStaticcall
| IRevert => encodeDecodeIRevert
| IInvalid => encodeDecodeIInvalid
| ISelfdestruct => encodeDecodeISelfdestruct

end EVM


import Duper.Simp
import Duper.Util.ProofReconstruction
import Lean.Meta.Basic

namespace Duper
open RuleM
open SimpResult
open Lean
open Meta

initialize Lean.registerTraceClass `Rule.identPropFalseElim

/-- Determines whether a literal has exactly the form `False = True` or `True = False`-/
def isFalsePropLiteral (lit : Lit) : MetaM Bool := do
  match lit.ty with
  | Expr.sort lvl =>
    if Level.isEquiv (← Lean.instantiateLevelMVars lvl) levelZero then
      return lit.sign &&
        ((lit.lhs == mkConst ``True && lit.rhs == mkConst ``False) ||
        (lit.lhs == mkConst ``False && lit.rhs == mkConst ``True))
    else return false
  | _ => return false

theorem prop_false_ne_true (h : False = True) : False := by rw [h]; exact ⟨⟩

theorem prop_true_ne_false (h : True = False) : False := by rw [← h]; exact ⟨⟩

def mkIdentPropFalseElimProof (refs : List (Option Nat)) (premises : List Expr) (parents : List ProofParent) (transferExprs : Array Expr)
  (c : Clause) : MetaM Expr :=
  Meta.forallTelescope c.toForallExpr fun xs body => do
    let cLits := c.lits.map (fun l => l.map (fun e => e.instantiateRev xs))
    let (parentsLits, appliedPremises, transferExprs) ← instantiatePremises parents premises xs transferExprs
    let parentLits := parentsLits[0]!
    let appliedPremise := appliedPremises[0]!

    let mut proofCases : Array Expr := Array.mkEmpty parentLits.size
    for i in [:parentLits.size] do
      let lit := parentLits[i]!
      if (← isFalsePropLiteral lit) then -- lit has the form `False = True` or `True = False`
        let proofCase ← Meta.withLocalDeclD `h lit.toExpr fun h => do
          if (lit.lhs == mkConst ``False) then
            let proofCase := mkApp (mkConst ``prop_false_ne_true) h
            let proofCase := mkApp2 (mkConst ``False.elim [levelZero]) body proofCase
            Meta.mkLambdaFVars #[h] proofCase
          else if(lit.lhs == mkConst ``True) then
            let proofCase := mkApp (mkConst ``prop_true_ne_false) h
            let proofCase := mkApp2 (mkConst ``False.elim [levelZero]) body proofCase
            Meta.mkLambdaFVars #[h] proofCase
          else
            throwError "mkIdentPropFalseElimProof failed to match {lit.lhs} to an expected expression"
        proofCases := proofCases.push proofCase
      else -- refs[i] should have the value (some j) where parentLits[i] == c[j]
        match refs[i]! with
        | none => throwError "Refs invariant is not satisfied in identPropFalseElim"
        | some j =>
          let proofCase ← Meta.withLocalDeclD `h parentLits[i]!.toExpr fun h => do
            Meta.mkLambdaFVars #[h] $ ← orIntro (cLits.map Lit.toExpr) j h
          proofCases := proofCases.push proofCase
    let proof ← orCases (parentLits.map Lit.toExpr) proofCases
    Meta.mkLambdaFVars xs $ mkApp proof appliedPremise

/-- Eliminate literals that are exactly of the form `False = True` or `True = False`.
    This is a special case of the propFalseElim inference rule in which σ is the identity. -/
def identPropFalseElim : MSimpRule := fun c => do
  let c ← loadClause c
  /-
    Spec for newLits and refs:
    If c.lits[i] is `False = True` or `True = False`, then refs[i] = none
    If c.lits[i] isn't `False = True` or `True = False`,then refs[i] = some j where newLits[j] = c.lits[i]
  -/
  let mut newLits : List Lit := []
  let mut refs : List (Option Nat) := []
  for lit in c.lits do
    if (← isFalsePropLiteral lit) then
      refs := none :: refs
    else
      refs := (some newLits.length) :: refs
      newLits := lit :: newLits
  -- To achieve the desired spec for newLits and refs, I must reverse them
  newLits := newLits.reverse
  refs := refs.reverse
  if (newLits.length = c.lits.size) then
    trace[Rule.identPropFalseElim] "Returning Unapplicable on {c.lits}"
    return none
  else
    trace[Rule.identPropFalseElim] "Succeeded on {c.lits}, yielding {newLits}"
    let resultClause ← yieldClause (MClause.mk newLits.toArray) "identity prop false elimination"
      (some (mkIdentPropFalseElimProof refs))
    return some #[resultClause]

end Duper


import condensed.is_proetale_sheaf
import condensed.adjunctions
import category_theory.limits.filtered_colimit_commutes_finite_limit
import for_mathlib.AddCommGroup.explicit_limits

open category_theory
open category_theory.limits

universe u
variables
  {J : Type (u+1)} [small_category J] [is_filtered J]
  {C : Type (u+2)}
  [category.{u+1} C]
  [concrete_category.{u+1} C]
  [has_limits C]
  [has_colimits_of_shape J C]
  [preserves_colimits_of_shape J (forget C)]
  [reflects_limits (forget C)]
  [preserves_limits (forget C)]
  (F : J ⥤ Condensed.{u} C)

open opposite

namespace is_sheaf_colimit_presheaf_aux

namespace empty

variables (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op Profinite.empty) ⟶ ⊤_ _ := terminal.from _

variables [∀ j, is_iso (comparison_component G j)]

noncomputable
def first_iso : (colimit G).obj (op Profinite.empty) ≅
  colimit (limit (functor.empty _ ⋙ G.flip)) :=
let e₁ := is_colimit_of_preserves ((evaluation _ _).obj (op Profinite.empty))
  (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _),
    e₃ : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op Profinite.empty) ≅
      limit (functor.empty Profiniteᵒᵖ ⋙ G.flip) :=
      nat_iso.of_components
      (λ j,
        let e₄ := is_limit_of_preserves ((evaluation _ _).obj j)
          (limit.is_limit (functor.empty _ ⋙ G.flip)),
            e₅ := (limit.is_limit _).cone_point_unique_up_to_iso e₄,
            e₆ : functor.empty C ≅
              (functor.empty Profiniteᵒᵖ ⋙ G.flip) ⋙ (evaluation J C).obj j :=
              nat_iso.of_components (λ i, i.as.elim) (λ i, i.as.elim) in
        as_iso (comparison_component G j) ≪≫
          has_limit.iso_of_nat_iso e₆ ≪≫ e₅)
      begin
        intros X Y f, dsimp [comparison_component],
        apply (is_limit_of_preserves ((evaluation J C).obj Y)
          (limit.is_limit (functor.empty Profiniteᵒᵖ ⋙ G.flip))).hom_ext,
        intros j, rcases j with ⟨⟨⟩⟩
      end in
e₂ ≪≫ has_colimit.iso_of_nat_iso e₃

-- Move this!
noncomputable
instance preserves_finite_limits_of_concrete :
  preserves_finite_limits (colim : (J ⥤ C) ⥤ C) :=
begin
  apply preserves_finite_limits_of_preserves_finite_limits_of_size,
  introsI K _ _,
  exact limits.filtered_colim_preserves_finite_limits,
end

noncomputable
def second_iso : colimit (limit (functor.empty.{0} _ ⋙ G.flip)) ≅
  limit (colimit (functor.empty.{0} _ ⋙ G.flip).flip) :=
(is_limit_of_preserves colim (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
  (has_limit.iso_of_nat_iso (colimit_flip_iso_comp_colim _).symm)
--colimit_limit_iso _ -- TODO: Fix universes in `colimit_limit_iso`.

noncomputable
def third_iso : limit (colimit (functor.empty _ ⋙ G.flip).flip) ≅ ⊤_ _ :=
has_limit.iso_of_nat_iso $ nat_iso.of_components (λ i, i.as.elim) (λ i, i.as.elim)

noncomputable
def comparison : (colimit G).obj (op Profinite.empty) ⟶ ⊤_ _ := terminal.from _

theorem is_iso_comparison : is_iso (comparison G) :=
begin
  suffices : comparison G = (first_iso G).hom ≫ (second_iso G).hom ≫ (third_iso G).hom,
  { rw this, apply_instance },
  simp,
end

end empty

namespace prod

variables (X Y : Profinite.{u}) (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op $ Profinite.sum X Y) ⟶ prod ((G.obj j).obj (op X)) ((G.obj j).obj (op Y)) :=
prod.lift ((G.obj j).map (Profinite.sum.inl _ _).op) ((G.obj j).map (Profinite.sum.inr _ _).op)

variables [∀ j, is_iso (comparison_component X Y G j)]

noncomputable
def first_iso_aux_aux (j) :
  (G ⋙ (evaluation Profiniteᵒᵖ C).obj (op (X.sum Y))).obj j ≅
  (G.flip.obj (op X) ⨯ G.flip.obj (op Y)).obj j :=
let e₄ : pair ((G.obj j).obj (op X)) ((G.obj j).obj (op Y)) ≅
  pair (G.flip.obj (op X)) (G.flip.obj (op Y)) ⋙ (evaluation J C).obj j :=
  nat_iso.of_components
  (λ p, match p with
    | discrete.mk walking_pair.left := iso.refl _
    | discrete.mk walking_pair.right := iso.refl _
    end) begin
      rintros (_|_) (_|_) (_|_), refl, refl,
    end in
as_iso (comparison_component X Y G j) ≪≫
  has_limit.iso_of_nat_iso e₄ ≪≫
  (limit.is_limit _).cone_point_unique_up_to_iso
    (is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _))

noncomputable
def first_iso_aux : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)) ≅
  G.flip.obj (op X) ⨯ G.flip.obj (op Y) :=
nat_iso.of_components (λ j, first_iso_aux_aux X Y G j)
begin
  intros i j f, dsimp [comparison_component, first_iso_aux_aux],
  apply
    (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).hom_ext,
  rintros (_|_),
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have h1 :=
      (is_limit_of_preserves ((evaluation J C).obj j)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) (discrete.mk walking_pair.left),
    have h2 :=
      (is_limit_of_preserves ((evaluation J C).obj i)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) (discrete.mk walking_pair.left),
    dsimp at h1 h2, simp [h1, reassoc_of h2],
    dsimp [first_iso_aux_aux._match_1], simp },
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have h1 :=
      (is_limit_of_preserves ((evaluation J C).obj j)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) (discrete.mk walking_pair.right),
    have h2 :=
      (is_limit_of_preserves ((evaluation J C).obj i)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) (discrete.mk walking_pair.right),
    dsimp at h1 h2, simp [h1, reassoc_of h2],
    dsimp [first_iso_aux_aux._match_1], simp },
end

noncomputable
def first_iso : (colimit G).obj (op $ Profinite.sum X Y) ≅
  colimit (prod (G.flip.obj (op X)) (G.flip.obj (op Y))) :=
let e₁ := is_colimit_of_preserves ((evaluation _ _).obj (op $ Profinite.sum X Y))
  (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _) in
e₂ ≪≫ has_colimit.iso_of_nat_iso (first_iso_aux X Y G)

noncomputable
def second_iso : colimit (prod (G.flip.obj (op X)) (G.flip.obj (op Y))) ≅
  limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
(is_limit_of_preserves colim (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
  (has_limit.iso_of_nat_iso (colimit_flip_iso_comp_colim _).symm)
--colimit_limit_iso _

noncomputable
def third_iso_aux_left :
  (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip).obj (discrete.mk walking_pair.left) ≅
  (colimit G).obj (op X) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj (discrete.mk walking_pair.left))
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
    e₂ :=
  is_colimit_of_preserves ((evaluation _ _).obj (op X))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

noncomputable
def third_iso_aux_right :
  (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip).obj (discrete.mk walking_pair.right) ≅
  (colimit G).obj (op Y) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj (discrete.mk walking_pair.right))
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
    e₂ :=
  is_colimit_of_preserves ((evaluation _ _).obj (op Y))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

/--/
noncomputable
def third_iso_aux : cone (pair (op X) (op Y) ⋙ colimit G) :=
{ X := limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limit.π _ walking_pair.left ≫ (third_iso_aux_left X Y G).hom
    | walking_pair.right := limit.π _ walking_pair.right ≫ (third_iso_aux_right X Y G).hom
    end,
    naturality' := admit } }

noncomputable
def third_iso_aux' : cone (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
{ X := limit (pair (op X) (op Y) ⋙ colimit G),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limit.π _ walking_pair.left ≫ (third_iso_aux_left X Y G).inv
    | walking_pair.right := limit.π _ walking_pair.right ≫ (third_iso_aux_right X Y G).inv
    end,
    naturality' := admit } }
-/

noncomputable
def third_iso_aux : cone (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
{ X := prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)),
  π :=
  { app := λ p,
    match p with
    | discrete.mk walking_pair.left := limits.prod.fst ≫ (third_iso_aux_left _ _ _).inv
    | discrete.mk walking_pair.right := limits.prod.snd ≫ (third_iso_aux_right _ _ _).inv
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_),
      { dsimp [third_iso_aux._match_1], simp },
      { dsimp [third_iso_aux._match_1], simp },
    end } }

noncomputable
def third_iso :
  limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)
    ≅ prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
{ hom := prod.lift
    (limit.π _ (discrete.mk walking_pair.left) ≫ (third_iso_aux_left _ _ _).hom)
    (limit.π _ (discrete.mk walking_pair.right) ≫ (third_iso_aux_right _ _ _).hom),
  inv := limit.lift _ (third_iso_aux _ _ _),
  hom_inv_id' := begin
    ext (_|_),
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux, third_iso_aux._match_1], simp },
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux, third_iso_aux._match_1], simp },
  end,
  inv_hom_id' := begin
    ext,
    { simp only [prod.comp_lift, limit.lift_π_assoc, prod.lift_fst, category.id_comp],
      dsimp [third_iso_aux], simp, },
    { simp only [prod.comp_lift, limit.lift_π_assoc, prod.lift_snd, category.id_comp],
      dsimp [third_iso_aux], simp, },
  end }

/-
noncomputable
def fourth_iso_aux : cone (pair (op X) (op Y) ⋙ colimit G) :=
{ X := prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limits.prod.fst
    | walking_pair.right := limits.prod.snd
    end,
    naturality' := admit } }

noncomputable
def fourth_iso : limit (pair (op X) (op Y) ⋙ colimit G) ≅
  prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
{ hom := prod.lift (limit.π _ walking_pair.left) (limit.π _ walking_pair.right),
  inv := limit.lift _ (fourth_iso_aux _ _ _),
  hom_inv_id' := admit,
  inv_hom_id' := admit }
-/

noncomputable
def comparison : (colimit G).obj (op $ Profinite.sum X Y) ⟶
  prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
prod.lift
  ((colimit G).map (Profinite.sum.inl _ _).op)
  ((colimit G).map (Profinite.sum.inr _ _).op)

lemma is_iso_comparison_aux_fst (j) :
  (colimit.ι G j).app (op (X.sum Y)) ≫ comparison X Y G ≫ limits.prod.fst =
    (colimit.ι G j).app (op (X.sum Y)) ≫
      (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom ≫
      limits.prod.fst :=
begin
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [prod.comp_lift, prod.lift_fst, category.assoc,
    has_limit.iso_of_nat_iso_hom_π_assoc, iso.symm_hom,
    colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    binary_fan.π_app_left],
  dsimp [has_colimit.iso_of_nat_iso, colim, colim_map, is_colimit.map,
    is_colimit.cocone_point_unique_up_to_iso,
    colimit_obj_iso_colimit_comp_evaluation,
    third_iso_aux, third_iso_aux_left, preserves_colimit_iso],
  have := (is_colimit_of_preserves
    ((evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)))
    (colimit.is_colimit G)).fac _ j,
  dsimp at this, slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι,
    nat_trans.comp_app, category.assoc, flip_comp_evaluation_inv_app,
    functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, first_iso_aux_aux, comparison_component,
    is_limit.cone_point_unique_up_to_iso],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc,
    category.id_comp, category.assoc],
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac _
      (discrete.mk walking_pair.left), dsimp at this,
  slice_rhs 2 3 { rw this }, clear this,
  simp only [limit.cone_π, category.assoc, limit.lift_π_assoc,
    cones.postcompose_obj_π, nat_trans.comp_app, nat_iso.of_components_hom_app],
  have := (is_colimit_of_preserves ((evaluation _ C).obj (discrete.mk walking_pair.left))
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)).fac _ j,
  dsimp at this, slice_rhs 3 4 { rw this }, clear this,
  dsimp [first_iso_aux_aux._match_1], simp only [category.id_comp, nat_trans.naturality],
end

lemma is_iso_comparison_aux_snd (j) : (colimit.ι G j).app (op (X.sum Y)) ≫ comparison X Y G ≫
  limits.prod.snd = (colimit.ι G j).app (op (X.sum Y)) ≫
    (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom ≫
    limits.prod.snd :=
begin
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [prod.comp_lift, prod.lift_snd, category.assoc,
    has_limit.iso_of_nat_iso_hom_π_assoc, iso.symm_hom,
    colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    binary_fan.π_app_right],
  dsimp [has_colimit.iso_of_nat_iso, colim, colim_map, is_colimit.map,
    is_colimit.cocone_point_unique_up_to_iso,
    colimit_obj_iso_colimit_comp_evaluation,
    third_iso_aux, third_iso_aux_right, preserves_colimit_iso],
  have := (is_colimit_of_preserves
    ((evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)))
    (colimit.is_colimit G)).fac _ j,
  dsimp at this, slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι,
    nat_trans.comp_app, category.assoc, flip_comp_evaluation_inv_app,
    functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, first_iso_aux_aux, comparison_component,
    is_limit.cone_point_unique_up_to_iso],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc,
    category.id_comp, category.assoc],
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac _
      (discrete.mk walking_pair.right), dsimp at this,
  slice_rhs 2 3 { rw this }, clear this,
  simp only [limit.cone_π, category.assoc, limit.lift_π_assoc,
    cones.postcompose_obj_π, nat_trans.comp_app, nat_iso.of_components_hom_app],
  have := (is_colimit_of_preserves ((evaluation _ C).obj (discrete.mk walking_pair.right))
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)).fac _ j,
  dsimp at this, slice_rhs 3 4 { rw this }, clear this,
  dsimp [first_iso_aux_aux._match_1], simp only [category.id_comp, nat_trans.naturality],
end

lemma is_iso_comparison : is_iso (comparison X Y G) :=
begin
  suffices : (comparison X Y G) =
    (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom,
  { rw this, apply_instance },
  ext,
  { simp only [category.assoc, is_iso_comparison_aux_fst] },
  { simp only [category.assoc, is_iso_comparison_aux_snd] }
end

end prod

namespace eq

variables {X Y : Profinite.{u}} (f : X ⟶ Y) (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op $ Y) ⟶
  equalizer
    ((G.obj j).map (Profinite.pullback.fst f f).op)
    ((G.obj j).map (Profinite.pullback.snd f f).op) :=
equalizer.lift ((G.obj j).map f.op)
begin
  simp_rw [← (G.obj j).map_comp, ← op_comp, Profinite.pullback.condition],
end

variables [∀ j, is_iso (comparison_component f G j)]

def first_iso_aux_aux (j) : parallel_pair ((G.obj j).map (Profinite.pullback.fst f f).op)
  ((G.obj j).map (Profinite.pullback.snd f f).op) ≅
    parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
  (G.flip.map (Profinite.pullback.snd f f).op) ⋙
    (evaluation J C).obj j :=
nat_iso.of_components (λ p,
  match p with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end)
begin
  rintro (_|_) (_|_) (_|_),
  refl,
  dsimp [first_iso_aux_aux._match_1], simp,
  dsimp [first_iso_aux_aux._match_1], simp,
  refl,
end

noncomputable
def first_iso_aux : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op Y) ≅
  equalizer (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op) :=
nat_iso.of_components (λ j,
  as_iso (comparison_component f G j)
    ≪≫
    has_limit.iso_of_nat_iso (first_iso_aux_aux _ _ _)
    ≪≫ (limit.is_limit _).cone_point_unique_up_to_iso
    (is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _)))
begin
  intros i j g, dsimp [comparison_component, first_iso_aux_aux],
  apply (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)))).hom_ext,
  rintros (_|_),
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have := (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.zero,
    dsimp at this, simp only [category.assoc, this], clear this,
    have := (is_limit_of_preserves ((evaluation J C).obj i)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.zero,
    dsimp at this, simp only [nat_trans.naturality, category.assoc, reassoc_of this], clear this,
    simp only [has_limit.iso_of_nat_iso_hom_π, nat_iso.of_components_hom_app,
      equalizer.lift_ι_assoc, functor.flip_obj_map, has_limit.iso_of_nat_iso_hom_π_assoc],
    dsimp [first_iso_aux_aux._match_1],
    simp only [category.comp_id, category.id_comp, nat_trans.naturality] },
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have := (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.one,
    dsimp at this, simp only [category.assoc, this], clear this,
    have := (is_limit_of_preserves ((evaluation J C).obj i)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.one,
    dsimp at this, simp only [nat_trans.naturality, category.assoc, reassoc_of this], clear this,
    simp only [has_limit.iso_of_nat_iso_hom_π, nat_iso.of_components_hom_app,
      limit.lift_π_assoc, fork.of_ι_π_app, category.assoc, functor.flip_obj_map,
      has_limit.iso_of_nat_iso_hom_π_assoc],
    dsimp [first_iso_aux_aux._match_1],
    simp only [category.comp_id, category.id_comp,
      nat_trans.naturality, nat_trans.naturality_assoc] }
end

noncomputable
def first_iso : (colimit G).obj (op $ Y) ≅
  colimit (equalizer
    (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)) :=
let e₁ := is_colimit_of_preserves
  ((evaluation _ _).obj (op $ Y)) (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _) in
e₂ ≪≫ has_colimit.iso_of_nat_iso (first_iso_aux f G)

noncomputable
def second_iso : colimit (equalizer
    (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)) ≅
    limit (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) :=
(is_limit_of_preserves colim (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
  (has_limit.iso_of_nat_iso (colimit_flip_iso_comp_colim _).symm)
--colimit_limit_iso _

noncomputable
def third_iso_aux :
  (colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).obj
    walking_parallel_pair.zero ≅ (colimit G).obj (op X) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_parallel_pair.zero)
    (colimit.is_colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip),
    e₂ := is_colimit_of_preserves ((evaluation _ _).obj (op X)) (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

noncomputable
def third_iso_aux'' :
  (colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).obj
    walking_parallel_pair.one ≅ (colimit G).obj (op $ Profinite.pullback f f) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_parallel_pair.one)
    (colimit.is_colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip),
    e₂ := is_colimit_of_preserves ((evaluation _ _).obj (op $ Profinite.pullback f f))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

lemma third_iso_aux_fst :
    (third_iso_aux f G).inv ≫ (colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).map
    walking_parallel_pair_hom.left = (colimit G).map (Profinite.pullback.fst f f).op ≫
    (third_iso_aux'' f G).inv :=
begin
  dsimp [third_iso_aux, third_iso_aux''],
  apply (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
  (op X)) (colimit.is_colimit G)).hom_ext, intros j,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  have h1 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op X))
    (colimit.is_colimit G)).fac _ j,
  have h2 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
    (op $ Profinite.pullback f f)) (colimit.is_colimit G)).fac _ j,
  dsimp at h1 h2,
  slice_lhs 1 2 { rw h1 }, clear h1,
  rw ← nat_trans.naturality_assoc,
  slice_rhs 2 3 { rw h2 }, clear h2,
  dsimp, rw ← nat_trans.naturality, refl
end

lemma third_iso_aux_snd :
    (third_iso_aux f G).inv ≫ (colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).map
    walking_parallel_pair_hom.right = (colimit G).map (Profinite.pullback.snd f f).op ≫
    (third_iso_aux'' f G).inv :=
begin
  dsimp [third_iso_aux, third_iso_aux''],
  apply (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
  (op X)) (colimit.is_colimit G)).hom_ext, intros j,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  have h1 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op X))
    (colimit.is_colimit G)).fac _ j,
  have h2 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
    (op $ Profinite.pullback f f)) (colimit.is_colimit G)).fac _ j,
  dsimp at h1 h2,
  slice_lhs 1 2 { rw h1 }, clear h1,
  rw ← nat_trans.naturality_assoc,
  slice_rhs 2 3 { rw h2 }, clear h2,
  dsimp, rw ← nat_trans.naturality, refl
end

noncomputable
def third_iso_aux' : cone (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) :=
{ X := equalizer
      ((colimit G).map (Profinite.pullback.fst f f).op)
      ((colimit G).map (Profinite.pullback.snd f f).op),
  π :=
  { app := λ p,
    match p with
    | walking_parallel_pair.zero := equalizer.ι _ _ ≫ (third_iso_aux _ _).inv
    | walking_parallel_pair.one := equalizer.ι _ _ ≫ (third_iso_aux f G).inv ≫
        category_theory.functor.map _ walking_parallel_pair_hom.left
    end,
  naturality' := begin
    rintro (_|_) (_|_) ⟨⟩,
    { dsimp, simp only [category.id_comp, category_theory.functor.map_id, category.comp_id], },
    { dsimp [third_iso_aux'._match_1], simp only [category.id_comp, category.assoc], },
    { dsimp [third_iso_aux'._match_1], simp only [category.id_comp, category.assoc],
      rw [third_iso_aux_fst, third_iso_aux_snd],
      simp only [category.assoc, equalizer.condition_assoc] },
    { dsimp, simp only [category.id_comp, category_theory.functor.map_id, category.comp_id], },
  end } }

noncomputable
def third_iso : limit (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) ≅
    equalizer
      ((colimit G).map (Profinite.pullback.fst f f).op)
      ((colimit G).map (Profinite.pullback.snd f f).op) :=
{ hom := equalizer.lift
    (limit.π _ walking_parallel_pair.zero ≫ (third_iso_aux f G).hom) begin
      have := third_iso_aux_fst f G, rw iso.eq_comp_inv at this, rw ← this, clear this,
      have := third_iso_aux_snd f G, rw iso.eq_comp_inv at this, rw ← this, clear this,
      simp only [category.assoc, iso.hom_inv_id_assoc],
      simp only [← category.assoc], congr' 1,
      let F := _, change limit.π F _ ≫ F.map _ = limit.π F _ ≫ F.map _,
      simp [limit.w F walking_parallel_pair_hom.left],
    end,
  inv := limit.lift _ (third_iso_aux' _ _),
  hom_inv_id' := begin
    ext (_|_),
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux', third_iso_aux'._match_1],
      simp only [equalizer.lift_ι_assoc, category.assoc, iso.hom_inv_id, category.comp_id] },
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux', third_iso_aux'._match_1],
      simp only [equalizer.lift_ι_assoc, category.assoc, iso.hom_inv_id_assoc,
        category.comp_id, category.id_comp, limit.w] }
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.assoc, equalizer.lift_ι, limit.lift_π_assoc, category.id_comp],
    dsimp [third_iso_aux, third_iso_aux'],
    simp only [category.assoc, iso.inv_hom_id, category.comp_id],
  end }

noncomputable
def comparison :
  (colimit G).obj (op $ Y) ⟶
  equalizer
    ((colimit G).map (Profinite.pullback.fst f f).op)
    ((colimit G).map (Profinite.pullback.snd f f).op) :=
equalizer.lift ((colimit G).map f.op)
begin
  simp only [← functor.map_comp, ← op_comp, Profinite.pullback.condition],
end

theorem is_iso_comparison : is_iso (comparison f G) :=
begin
  suffices : comparison f G =
    (first_iso f G).hom ≫ (second_iso f G).hom ≫ (third_iso f G).hom,
  { rw this, apply_instance },
  ext,
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [category.assoc, equalizer.lift_ι, has_limit.iso_of_nat_iso_hom_π_assoc,
    iso.symm_hom, colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    equalizer.fork_π_app_zero],
  dsimp [has_colimit.iso_of_nat_iso, is_colimit.cocone_point_unique_up_to_iso,
    colim, colim_map, is_colimit.map, colimit_obj_iso_colimit_comp_evaluation,
    preserves_colimit_iso, third_iso_aux],
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op Y))
    (colimit.is_colimit G)).fac _ j, dsimp at this,
  slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι, nat_trans.comp_app,
    category.assoc, flip_comp_evaluation_inv_app, functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, comparison_component],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc, category.id_comp, category.assoc],
  dsimp [is_limit.cone_point_unique_up_to_iso],
  have := (is_colimit_of_preserves ((evaluation walking_parallel_pair C).obj
    walking_parallel_pair.zero) (colimit.is_colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip)).fac _ j,
  dsimp at this, slice_rhs 4 5 { rw this }, clear this,
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)))).fac _ walking_parallel_pair.zero,
  dsimp at this ⊢, slice_rhs 2 3 { erw this }, clear this,
  dsimp,
  simp only [limit.lift_π_assoc, cones.postcompose_obj_π, nat_trans.comp_app,
    fork.of_ι_π_app, category.assoc],
  dsimp [first_iso_aux_aux],
  simp only [category.id_comp, nat_trans.naturality],
end

end eq

end is_sheaf_colimit_presheaf_aux
open is_sheaf_colimit_presheaf_aux

/-
variables {K : Type (u+1)} [small_category K] [fin_category K]
  (E : K ⥤ Profinite.{u}ᵒᵖ) [has_limit E] (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)
  [∀ j, preserves_limits_of_shape K (G.obj j)]

noncomputable
def comparison_map_component (j : J) : (G.obj j).obj (limit E) ⟶ limit (E ⋙ G.obj j) :=
limit.lift (E ⋙ G.obj j) $ (G.obj j).map_cone (limit.cone E)

noncomputable
def comparison_map : (colimit G).obj (limit E) ⟶ limit (E ⋙ colimit G) :=
limit.lift (E ⋙ colimit G) $ (colimit G).map_cone (limit.cone E)

noncomputable
def first_iso : (colimit G).obj (limit E) ≅ colimit (limit (E ⋙ G.flip)) :=
let e := is_colimit_of_preserves ((evaluation _ _).obj (limit E))
  (colimit.is_colimit G),
  ee := e.cocone_point_unique_up_to_iso (colimit.is_colimit _),
  tt : G ⋙ (evaluation Profiniteᵒᵖ C).obj (limit E) ≅ limit (E ⋙ G.flip) :=
    nat_iso.of_components (λ j, begin
      dsimp,
      refine (is_limit_of_preserves (G.obj j) (limit.is_limit E)).cone_point_unique_up_to_iso
        (limit.is_limit _) ≪≫ _,
      refine _ ≪≫ (limit.is_limit _).cone_point_unique_up_to_iso
        ((is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _))),
      dsimp,
      refine has_limit.iso_of_nat_iso _,
      refine nat_iso.of_components _ _,
      intros k, exact iso.refl _,
      intros k₁ k₂ f, dsimp, simp,
    end) admit in
ee ≪≫ has_colimit.iso_of_nat_iso tt

noncomputable
def second_iso : colimit (limit (E ⋙ G.flip)) ≅ limit (colimit (E ⋙ G.flip).flip) :=
  colimit_limit_iso _

noncomputable
def third_iso : limit (colimit (E ⋙ G.flip).flip) ≅ limit (E ⋙ colimit G) :=
has_limit.iso_of_nat_iso $
nat_iso.of_components (λ k,
  let ee := (is_colimit_of_preserves ((evaluation _ _).obj k)
    (colimit.is_colimit (E ⋙ G.flip).flip)).cocone_point_unique_up_to_iso
    (colimit.is_colimit _) in
  ee ≪≫
  begin
    dsimp,
    refine _ ≪≫
      (colimit.is_colimit _).cocone_point_unique_up_to_iso
      ((is_colimit_of_preserves ((evaluation _ _).obj (E.obj k)) (colimit.is_colimit _))),
    dsimp,
    refine has_colimit.iso_of_nat_iso _,
    refine nat_iso.of_components _ _,
    intros j, exact iso.refl _,
    intros i j f, dsimp, simp,
  end) admit

lemma is_iso : is_iso (comparison_map E G) :=
begin
  suffices : comparison_map E G =
    (first_iso E G).hom ≫ (second_iso E G).hom ≫ (third_iso E G).hom,
  { rw this, apply_instance },
  admit,
end

-- Use the comparison map above
variable (K)
def key : preserves_limits_of_shape K (colimit G) := admit

end is_sheaf_colimit_presheaf_aux
open is_sheaf_colimit_presheaf_aux

theorem empty_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.empty_condition' ↔
  nonempty (preserves_limits_of_shape (discrete pempty.{u+1}) G) := admit

theorem product_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.product_condition' ↔
  nonempty (preserves_limits_of_shape (discrete walking_pair.{u+1}) G) := admit

theorem equalizer_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.equalizer_condition' ↔
  nonempty (preserves_limits_of_shape (walking_parallel_pair.{u+1}) G) := admit
-/

lemma is_sheaf_colimit_presheaf :
  presheaf.is_sheaf proetale_topology (colimit (F ⋙ Sheaf_to_presheaf _ _)) :=
begin
  --rw is_sheaf_iff_is_sheaf_of_type,
  let G := (colimit (F ⋙ Sheaf_to_presheaf _ _)),
  let Gs := F ⋙ Sheaf_to_presheaf _ _,
  have hGs : ∀ j, presheaf.is_sheaf proetale_topology (Gs.obj j),
  { intros j, exact (F.obj j).2 },
  have hGsempty : ∀ j, (Gs.obj j).empty_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.1 },
  have hGsprod : ∀ j, (Gs.obj j).product_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.2.1 },
  have hGseq : ∀ j, (Gs.obj j).equalizer_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.2.2 },
  rw G.is_proetale_sheaf_tfae.out 0 3,
  refine ⟨_,_,_⟩,
  { apply_with empty.is_iso_comparison { instances := ff },
    exact hGsempty,
    all_goals { apply_instance } },
  { intros X Y,
    apply_with prod.is_iso_comparison { instances := ff },
    intros j, apply hGsprod,
    all_goals { apply_instance } },
  { intros X Y f hf,
    apply_with eq.is_iso_comparison { instances := ff },
    intros j, apply hGseq, assumption' }
end

@[simps]
noncomputable
def filtered_cocone : cocone F :=
{ X := ⟨colimit (F ⋙ Sheaf_to_presheaf _ _), is_sheaf_colimit_presheaf _⟩,
  ι :=
  { app := λ j, Sheaf.hom.mk $ colimit.ι (F ⋙ Sheaf_to_presheaf _ _) j,
    naturality' := begin
      intros i j f,
      ext1, dsimp,
      simpa using colimit.w (F ⋙ Sheaf_to_presheaf _ _) f,
    end } }

noncomputable
def filtered_cocone_is_colimit : is_colimit (filtered_cocone F) :=
{ desc := λ S, Sheaf.hom.mk $ colimit.desc (F ⋙ Sheaf_to_presheaf _ _)
    ((Sheaf_to_presheaf _ _).map_cocone S),
  fac' := begin
    intros S j,
    ext1, dsimp,
    simp,
  end,
  uniq' := begin
    intros S m hm,
    ext1, dsimp,
    apply colimit.hom_ext,
    intros j, specialize hm j, apply_fun (λ e, e.val) at hm,
    dsimp at hm, simpa using hm,
  end } .

section

local attribute [-simp] forget_map_eq_coe

noncomputable
def preserves_limits_aux_1 (G : J ⥤ Condensed.{u} Ab.{u+1}) :
  colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙ forget Ab ≅
  colimit (G ⋙ Sheaf_to_presheaf _ _ ⋙ (whiskering_right _ _ _).obj (forget Ab)) :=
nat_iso.of_components
begin
  intros X,
  let E := (G ⋙ Sheaf_to_presheaf _ _ ⋙ (whiskering_right _ _ _).obj (forget Ab)),
  let e₀ := colimit.is_colimit E,
  let e₁ := is_colimit_of_preserves ((evaluation _ _).obj X) e₀,
  refine _ ≪≫ (colimit.is_colimit _).cocone_point_unique_up_to_iso e₁,
  change (forget Ab).obj _ ≅ colimit _,
  let e₂ := colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab),
  let e₃ := is_colimit_of_preserves ((evaluation _ _).obj X) e₂,
  let e₄ := e₃.cocone_point_unique_up_to_iso (colimit.is_colimit _),
  refine (forget Ab).map_iso e₄ ≪≫ _,
  change (forget Ab).obj (colimit _) ≅ _,
  let e₅ := is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab)
    ⋙ (evaluation Profiniteᵒᵖ Ab).obj X)),
  exact e₅.cocone_point_unique_up_to_iso (colimit.is_colimit _),
end
begin
  intros X Y f, dsimp, simp only [category.assoc],
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  let E₀ := is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj X)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab)),
  let E := is_colimit_of_preserves (forget Ab) E₀,
  apply E.hom_ext, intros j, dsimp,

  -- Let's work on the LHS

  slice_lhs 1 3
  { simp only [← (forget Ab).map_comp],
    rw ← ((colimit.ι (G ⋙ Sheaf_to_presheaf proetale_topology Ab) j)).naturality_assoc, },
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj Y)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this,
  dsimp,
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj Y))).fac _ j,
  simp only [(forget Ab).map_comp, category.assoc],
  dsimp at this, slice_lhs 2 3 { rw this }, clear this,
  erw colimit.ι_desc,

  -- Now for the RHS

  slice_rhs 1 2 { rw ← (forget Ab).map_comp },
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj X)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this,
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj X))).fac _ j,
  dsimp at this, slice_rhs 1 2 { erw this }, clear this, erw colimit.ι_desc,
  dsimp, erw ← nat_trans.naturality, refl,
end

local attribute [-simp] types_comp_apply functor_to_types.comp

noncomputable
def preserves_limits_of_shape_of_filtered_aux (G : J ⥤ Condensed.{u} Ab.{u+1}) :
  Condensed_Ab_to_CondensedSet.{u}.map_cocone (filtered_cocone G) ≅
  filtered_cocone (G ⋙ Condensed_Ab_to_CondensedSet.{u}) :=
cocones.ext
{ hom := Sheaf.hom.mk $ (preserves_limits_aux_1 G).hom,
  inv := Sheaf.hom.mk $ (preserves_limits_aux_1 G).inv,
  hom_inv_id' := by { ext1, simp },
  inv_hom_id' := by { ext1, simp } }
begin
  intros j, ext, dsimp [preserves_limits_aux_1, is_colimit.cocone_point_unique_up_to_iso],

  simp only [← category.assoc, ← (forget Ab).map_comp],
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj x)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this, dsimp, simp only [category.assoc],
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj x))).fac _ j,
  dsimp at this, simp only [← category.assoc], rw this, clear this, erw colimit.ι_desc,
  refl,

end

end

noncomputable
instance Condensed_Ab_to_CondensedSet_preserves_limits_of_shape_of_filtered :
  preserves_colimits_of_shape J Condensed_Ab_to_CondensedSet.{u} :=
begin
  constructor,
  intros G,
  apply preserves_colimit_of_preserves_colimit_cocone (filtered_cocone_is_colimit G),
  apply is_colimit.of_iso_colimit (filtered_cocone_is_colimit
    (G ⋙ Condensed_Ab_to_CondensedSet)),
  exact (preserves_limits_of_shape_of_filtered_aux G).symm,
end


import topology.basic
import category_theory.basic
import category_theory.instances
import category_theory.universal_properties.product
import category_theory.universal_properties.colimit

universes v v₁ v₂ u u₁ u₂

open classical
open category
open topology
open set

/-
  We have a category C with obj in Type u and mor in Type v, we'd like to think of C
  as being at least locally small so we will of v as being the level of sets.

-/

def inc_to_mor {X : Type u} [topology X] {O₁ O₂ : Open X} : inclusion O₁ O₂ →
  inclusion (op O₁).val (op O₂).val :=
begin
  intro,
  simp [op_val],
  assumption,
end

noncomputable def open_cover_res {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] (𝓕 : opposite (Open X) +→ C) {U : Open X} {I : Type v} {f : I → Open X}
  (hf : is_open_cover f U) : Mor (𝓕.map (op U)) (Π₀ (λ i : I, 𝓕.map (op (f i)))).1 :=
  into_product (λ i : I, 𝓕.fmap (inc_to_mor (is_open_cover_includes hf i)))

def inter_index {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] (𝓕 : opposite (Open X) +→ C) {I : Type v} (f : I → Open X)
  : I → I → C := λ i j , 𝓕.map (op (f i ∩ f j))

def inter_res_b_left {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] (𝓕 : opposite (Open X) +→ C) {I : Type v} (f : I → Open X)
  (i : I) : Π j : I, Mor (𝓕.map (op (f i))) (inter_index 𝓕 f i j) := λ j,𝓕.fmap (inc_to_mor (inter_inc_left (f i) (f j)))

noncomputable def intersection_res_left {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] (𝓕 : opposite (Open X) +→ C) {I : Type v} (f : I → Open X)
  : Mor (Π₀ (λ i : I, 𝓕.map (op (f i)))).1 (Π₀ (λ ij : I × I, 𝓕.map (op (f ij.1 ∩ f ij.2)))).1
  := (prod_can_iso (double_prod_prod_left (inter_index 𝓕 f)) (has_product_prod_is_prod
     (function.uncurry (inter_index 𝓕 f))))
     ∘ₘ Πₘ (λ i : I, into_product (λ j, 𝓕.fmap (inc_to_mor (inter_inc_left (f i) (f j)))))

noncomputable def intersection_res_right {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] (𝓕 : opposite (Open X) +→ C) {I : Type v} (f : I → Open X)
  : Mor (Π₀ (λ i : I, 𝓕.map (op (f i)))).1 (Π₀ (λ ij : I × I, 𝓕.map (op (f ij.1 ∩ f ij.2)))).1
  := (prod_can_iso (double_prod_prod_right (inter_index 𝓕 f)) (has_product_prod_is_prod
     (function.uncurry (inter_index 𝓕 f))))
     ∘ₘ Πₘ (λ j : I, into_product (λ i, 𝓕.fmap (inc_to_mor (inter_inc_right (f i) (f j)))))

structure sheaf (X : Type v) [topology X] (C : Type u) [category.{v} C] [has_products.{v u v} C]
  [has_small_filtered_colimits C] :=
(body : opposite (Open X) +→ C)
(res_exact_seq : ∀ {U : Open X} {I : Type v} {f : I → Open X} (hf : is_open_cover f U),
  is_equaliser (intersection_res_left body f) (intersection_res_right body f)
  ⟨body.map (op U), open_cover_res body hf⟩)

namespace sheaf

theorem op_open_sets_at_a_point_filtered_category {X : Type v} [topology X] (p : X)
  : filtered_category (opposite ({O : Open X // p ∈ O})) :=
begin
  split,
  intros i₁ i₂,
  cases i₁ with O₁,
  cases i₂ with O₂,
  have hp : p ∈ (O₁ ∩ O₂ : Open X),
    exact ⟨O₁.property, O₂.property⟩,
  existsi op (subtype.mk (O₁ ∩ O₂ : Open X) hp),
  split,
  split,
  apply inc_to_mor,
  simp,
  apply inter_inc_left,
  split,
  apply inc_to_mor,
  simp,
  apply inter_inc_right,
  intros i j f₁ f₂,
  existsi j,
  existsi idₘ j,
  apply inclusion_equality,
end

def stalk_shape {X : Type v} [topology X] {C : Type u} [category.{v} C] [has_products.{v u v} C]
  [has_small_filtered_colimits C] (𝓕 : sheaf X C) (p : X) : opposite ({O: Open X // p ∈ O}) +→ C
  := 𝓕.body ⊚ (op_functor (open_at_point_forget p))

noncomputable def stalk {X : Type v} [topology X] {C : Type u} [category.{v} C] [has_products.{v u v} C]
  [has_small_filtered_colimits C] (𝓕 : sheaf X C) (p : X)
  : Σ st : C, (Π oOp : opposite ({O: Open X // p ∈ O}), Mor ((stalk_shape 𝓕 p).map oOp) st)
  := filtered_colimit (op_open_sets_at_a_point_filtered_category p) (stalk_shape 𝓕 p)

theorem stalk_property {X : Type v} [topology X] {C : Type u} [category.{v} C] [has_products.{v u v} C]
  [has_small_filtered_colimits C] (𝓕 : sheaf X C) (p : X)
  : is_colimit (stalk_shape 𝓕 p) (stalk 𝓕 p)
  := filtered_colimit_property (op_open_sets_at_a_point_filtered_category p) (stalk_shape 𝓕 p)

instance sheaf_category (X : Type v) [topology X] (C : Type u) [category.{v} C] [has_products.{v u v} C]
  [has_small_filtered_colimits C] : category (sheaf X C) :=
{
  Mor := λ 𝓕₁ 𝓕₂, 𝓕₁.body →ₙ 𝓕₂.body,
  idₘ := λ 𝓕, idₙ 𝓕.body,
  comp := λ F₁ F₂ F₃ φ₁ φ₂, φ₁ ∘ₙ φ₂,
  comp_assoc :=
    begin
      intros F₁ F₂ F₃ F₄ φ₁ φ₂ φ₃,
      apply natural_trans_equality,
      apply funext,
      intro,
      simp,
      rw comp_assoc,
    end,
  id_comp_left :=
    begin
      intros F₁ F₂ φ,
      apply natural_trans_equality,
      apply funext,
      intro,
      rw natural_trans_comp_map,
      simp,
      rw id_comp_left,
    end,
  id_comp_right :=
    begin
      intros F₁ F₂ φ,
      apply natural_trans_equality,
      apply funext,
      intro,
      rw natural_trans_comp_map,
      simp,
      rw id_comp_right,
    end,
}

noncomputable def natural_trans_im_cocone {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ : sheaf X C} (φ : Mor 𝓕₁ 𝓕₂)
  (p : X) : Σ c : C, Π O : opposite {O : Open X // p ∈ O}, Mor (𝓕₁.body.map (op O.val)) c
  := ⟨(stalk 𝓕₂ p).1, λ O : opposite {O : Open X // p ∈ O}, ((stalk 𝓕₂ p).2 ( O))∘ₘ(φ.map (op O.val))⟩

theorem natural_trans_im_cocone_obj {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ : sheaf X C}
  (φ : Mor 𝓕₁ 𝓕₂) (p : X) : (natural_trans_im_cocone φ p).1 = (stalk 𝓕₂ p).1 := rfl

theorem natural_trans_im_cocone_map {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ : sheaf X C}
  (φ : Mor 𝓕₁ 𝓕₂) (p : X) : (natural_trans_im_cocone φ p).2 = λ O : opposite {O : Open X // p ∈ O},
  ((stalk 𝓕₂ p).2 O) ∘ₘ (φ.map (op O.val)) := rfl

theorem existance_of_induced_morphism_of_stalks_nat {X : Type v} [topology X] {C : Type u}
  [category.{v} C] [has_products.{v u v} C] [has_small_filtered_colimits C]
  {𝓕₁ 𝓕₂ : sheaf X C} (φ : Mor 𝓕₁ 𝓕₂) (p : X) : ∃! φₚ : Mor (stalk 𝓕₁ p).1 (stalk 𝓕₂ p).1,
   ∀ O : opposite {O : Open X// p ∈ O}, ((stalk 𝓕₂ p).2 O) ∘ₘ (φ.map (op O.val))
   = φₚ ∘ₘ ((stalk 𝓕₁ p).2 O) :=
begin
  have hcc : is_cocone (stalk_shape 𝓕₁ p) (natural_trans_im_cocone φ p),
    intros O₁ O₂ i₂₁,
    have hrw₁ : (stalk_shape 𝓕₁ p).fmap i₂₁ = 𝓕₁.body.fmap i₂₁ := rfl,
    have hrw₂ : (stalk_shape 𝓕₂ p).fmap i₂₁ = 𝓕₂.body.fmap i₂₁ := rfl,
    rw [hrw₁,← comp_assoc,← φ.natural,comp_assoc],
    have h𝓕₁ := (stalk_property 𝓕₂ p).1 ,
    simp,
    have hrw₄ : (stalk 𝓕₂ p).2 O₁ = ((stalk 𝓕₂ p).2 O₂) ∘ₘ 𝓕₂.body.fmap i₂₁,
      cases stalk 𝓕₂ p,
      apply h𝓕₁,
    rw hrw₄,
    refl,
  -- what follows is mere abstract nonsense.
  have hint := (stalk_property 𝓕₁ p).2 (natural_trans_im_cocone φ p) hcc,
  rw natural_trans_im_cocone_map φ p at hint,
  cases hint with φₚ hφₚ,
  simp [natural_trans_im_cocone_obj] at hφₚ,
  existsi φₚ,
  exact hφₚ,
end

noncomputable def induced_mor_of_stalks_nat {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ : sheaf X C} (φ : Mor 𝓕₁ 𝓕₂)
  (p : X) : Mor (stalk 𝓕₁ p).1 (stalk 𝓕₂ p).1 := some (existance_of_induced_morphism_of_stalks_nat φ p)

theorem induced_mor_of_stalks_nat_property {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ : sheaf X C} (φ : Mor 𝓕₁ 𝓕₂) (p : X)
  : (∀ O : opposite {O : Open X// p ∈ O}, ((stalk 𝓕₂ p).2 O) ∘ₘ (φ.map (op O.val))
     = (induced_mor_of_stalks_nat φ p) ∘ₘ ((stalk 𝓕₁ p).2 O)) ∧
     (∀ φₚ, (∀ O, ((stalk 𝓕₂ p).2 O) ∘ₘ (φ.map (op O.val)) = φₚ ∘ₘ ((stalk 𝓕₁ p).2 O))
     → φₚ = (induced_mor_of_stalks_nat φ p)) := some_spec (existance_of_induced_morphism_of_stalks_nat φ p)

theorem induced_mor_of_stalks_nat_compose {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] {𝓕₁ 𝓕₂ 𝓕₃: sheaf X C} (φ₁ : Mor 𝓕₂ 𝓕₃)
  (φ₂ : Mor 𝓕₁ 𝓕₂) (p : X) : induced_mor_of_stalks_nat (φ₁ ∘ₘ φ₂) p = (induced_mor_of_stalks_nat φ₁ p)
    ∘ₘ (induced_mor_of_stalks_nat φ₂ p) :=
begin
  symmetry,
  apply (induced_mor_of_stalks_nat_property (φ₁ ∘ₘ φ₂) p).2,
  intro,
  cases induced_mor_of_stalks_nat_property φ₁ p with hrw₁ up₁,
  cases induced_mor_of_stalks_nat_property φ₂ p with hrw₂ up₂,
  rw [←comp_assoc, ←hrw₂, comp_assoc, ←hrw₁],
  have hrw₃ : φ₁ ∘ₘ φ₂  = φ₁ ∘ₙ φ₂ := rfl,
  simp [hrw₃,comp_assoc],
end

theorem induced_mor_of_stalks_nat_id {X : Type v} [topology X] {C : Type u} [category.{v} C]
  [has_products.{v u v} C] [has_small_filtered_colimits C] (𝓕 : sheaf X C) (p : X)
  : induced_mor_of_stalks_nat (idₘ 𝓕) p = idₘ (stalk 𝓕 p).1 :=
begin
  symmetry,
  apply (induced_mor_of_stalks_nat_property (idₘ 𝓕) p).2,
  intro,
  have hrw₁ : idₘ 𝓕 = idₙ 𝓕.body := rfl,
  have hrw₂ : (idₙ 𝓕.body).map (op ↑(O.val)) = idₘ (𝓕.body.map (op ↑(O.val))) := rfl,
  have hrw₃ : idₘ ((stalk_shape 𝓕 p).map O) = idₘ (𝓕.body.map (op ↑(O.val))) := rfl,
  rw [hrw₁,hrw₂,← hrw₃,id_comp_left],
  dsimp,
  rw id_comp_right ((stalk 𝓕 p).2 O),
end

noncomputable def stalk_of_nat_trans {X : Type v} [topology X] (C : Type u) [category.{v} C]
  [has_products.{v u v} C]
  [has_small_filtered_colimits C] (p : X) : sheaf X C +→ C :=
{
  map := λ 𝓕, (stalk 𝓕 p).1,
  fmap := λ _ _ φ, induced_mor_of_stalks_nat φ p,
  fmap_prevs_comp :=
    begin
      intros 𝓕₁ 𝓕₂ 𝓕₃ φ₁ φ₂,
      rw induced_mor_of_stalks_nat_compose,
    end,
  fmap_prevs_id :=
    begin
      intro 𝓕,
      rw induced_mor_of_stalks_nat_id,
    end,
}

end sheaf


import data.nat.basic

open classical

lemma all_zero : ∃ a b c : ℕ, a + b + c = 0 :=
begin
  use 0,
  use 0,
  use 0,
end

example : 1 = 1 :=
begin
  choose a b c h using all_zero,
  exact rfl,
end


universes u v

namespace state_t

variables {σ α : Type u}
variables {m : Type u → Type u}
variables [monad m]
variables [is_lawful_monad m]

open is_lawful_monad
lemma get_bind (s : σ) (f : σ → state_t σ m α)
: (get >>= f).run s = (f s).run s :=
by { simp [bind,state_t.bind,get,state_t.get,monad_state.lift,pure_bind,has_pure.pure,bind._match_1] }

end state_t