/-
File: signature_recover_public_key_ec_double_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_compute_doubling_slope_soundness
open tactic

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

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

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

theorem auto_sound_ec_double_block5
    -- An independent ap variable.
    (ap : F)
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_double σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 244))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 232))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 212))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 196))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 68))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_point : point = cast_EcPoint mem (σ.fp - 8))
    (νbound : ℕ)
    -- conclusion
  : ensuresb_ret νbound mem
    {pc := σ.pc + 14, ap := ap, fp := σ.fp}
    (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 7)
        (auto_spec_ec_double_block5 mem κ range_check_ptr point (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  have h_mem_rec := h_mem,
  unpack_memory code_ec_double at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72⟩,
  -- function call
  step_assert_eq hpc14 with arg0,
  step_assert_eq hpc15 with arg1,
  step_assert_eq hpc16 with arg2,
  step_assert_eq hpc17 with arg3,
  step_assert_eq hpc18 with arg4,
  step_assert_eq hpc19 with arg5,
  step_assert_eq hpc20 with arg6,
  step_sub hpc21 (auto_sound_compute_doubling_slope mem _ range_check_ptr point _ _ _ _ _ _ _),
  { rw hpc22, norm_num2, exact h_mem_12 },
  { rw hpc22, norm_num2, exact h_mem_4 },
  { rw hpc22, norm_num2, exact h_mem_5 },
  { rw hpc22, norm_num2, exact h_mem_6 },
  { rw hpc22, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call23 ap23 h_call23,
  rcases h_call23 with ⟨h_call23_ap_offset, h_call23⟩,
  rcases h_call23 with ⟨rc_m23, rc_mle23, hl_range_check_ptr₁, h_call23⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap23 - 4) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_slope: cast_BigInt3 mem (ap23 - 3) = slope,
  simp only [hr_rev_slope] at h_call23,
  have htv_slope := hr_rev_slope.symm, clear hr_rev_slope,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call23 },
  rw [hin_range_check_ptr] at h_call23,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- function call
  step_sub hpc23 (auto_sound_unreduced_sqr mem _ slope _ _),
  { rw hpc24, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { simp only [h_call23_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call25 ap25 h_call25,
  rcases h_call25 with ⟨h_call25_ap_offset, h_call25⟩,
  generalize' hr_rev_slope_sqr: cast_UnreducedBigInt3 mem (ap25 - 3) = slope_sqr,
  simp only [hr_rev_slope_sqr] at h_call25,
  have htv_slope_sqr := hr_rev_slope_sqr.symm, clear hr_rev_slope_sqr,
  clear ,
  -- function call
  step_assert_eq hpc25 with arg0,
  step_sub hpc26 (auto_sound_nondet_bigint3 mem _ range_check_ptr₁ _ _),
  { rw hpc27, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call28 ap28 h_call28,
  rcases h_call28 with ⟨h_call28_ap_offset, h_call28⟩,
  rcases h_call28 with ⟨rc_m28, rc_mle28, hl_range_check_ptr₂, h_call28⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap28 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_new_x: cast_BigInt3 mem (ap28 - 3) = new_x,
  simp only [hr_rev_new_x] at h_call28,
  have htv_new_x := hr_rev_new_x.symm, clear hr_rev_new_x,
  try { simp only [arg0] at hl_range_check_ptr₂ },
  try { rw [h_call25_ap_offset] at hl_range_check_ptr₂ }, try { arith_simps at hl_range_check_ptr₂ },
  rw [←htv_range_check_ptr₂, ←htv_range_check_ptr₁] at hl_range_check_ptr₂,
  try { simp only [arg0] at h_call28 },
  try { rw [h_call25_ap_offset] at h_call28 }, try { arith_simps at h_call28 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call28,
  clear arg0,
  -- function call
  step_assert_eq hpc28 with arg0,
  step_sub hpc29 (auto_sound_nondet_bigint3 mem _ range_check_ptr₂ _ _),
  { rw hpc30, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call31 ap31 h_call31,
  rcases h_call31 with ⟨h_call31_ap_offset, h_call31⟩,
  rcases h_call31 with ⟨rc_m31, rc_mle31, hl_range_check_ptr₃, h_call31⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap31 - 4) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_new_y: cast_BigInt3 mem (ap31 - 3) = new_y,
  simp only [hr_rev_new_y] at h_call31,
  have htv_new_y := hr_rev_new_y.symm, clear hr_rev_new_y,
  try { simp only [arg0] at hl_range_check_ptr₃ },
  rw [←htv_range_check_ptr₃, ←htv_range_check_ptr₂] at hl_range_check_ptr₃,
  try { simp only [arg0] at h_call31 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call31,
  clear arg0,
  -- function call
  step_assert_eq hpc31 with arg0,
  step_assert_eq hpc32 hpc33 with arg1,
  step_assert_eq hpc34 with arg2,
  step_assert_eq hpc35 with arg3,
  step_assert_eq hpc36 hpc37 with arg4,
  step_assert_eq hpc38 with arg5,
  step_assert_eq hpc39 with arg6,
  step_assert_eq hpc40 hpc41 with arg7,
  step_assert_eq hpc42 with arg8,
  step_assert_eq hpc43 with arg9,
  step_assert_eq hpc44 with arg10,
  step_assert_eq hpc45 with arg11,
  step_assert_eq hpc46 with arg12,
  step_sub hpc47 (auto_sound_verify_zero mem _ range_check_ptr₃ {
    d0 := slope_sqr.d0 - new_x.d0 - 2 * point.x.d0,
    d1 := slope_sqr.d1 - new_x.d1 - 2 * point.x.d1,
    d2 := slope_sqr.d2 - new_x.d2 - 2 * point.x.d2
  } _ _ _),
  { rw hpc48, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), arg1, arg2, (eq_sub_of_eq_add arg3), arg4, arg5, (eq_sub_of_eq_add arg6), arg7, arg8, arg9, (eq_sub_of_eq_add arg10), (eq_sub_of_eq_add arg11), (eq_sub_of_eq_add arg12)] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_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_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), arg1, arg2, (eq_sub_of_eq_add arg3), arg4, arg5, (eq_sub_of_eq_add arg6), arg7, arg8, arg9, (eq_sub_of_eq_add arg10), (eq_sub_of_eq_add arg11), (eq_sub_of_eq_add arg12)] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call49 ap49 h_call49,
  rcases h_call49 with ⟨h_call49_ap_offset, h_call49⟩,
  rcases h_call49 with ⟨rc_m49, rc_mle49, hl_range_check_ptr₄, h_call49⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap49 - 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 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at h_call49 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call49,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
  -- function call
  step_assert_eq hpc49 with arg0,
  step_assert_eq hpc50 with arg1,
  step_assert_eq hpc51 with arg2,
  step_assert_eq hpc52 with arg3,
  step_assert_eq hpc53 with arg4,
  step_assert_eq hpc54 with arg5,
  step_sub hpc55 (auto_sound_unreduced_mul mem _ {
    d0 := point.x.d0 - new_x.d0,
    d1 := point.x.d1 - new_x.d1,
    d2 := point.x.d2 - new_x.d2
  } slope _ _ _),
  { rw hpc56, norm_num2, exact h_mem_5 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, arg4, arg5] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_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_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, arg4, arg5] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call57 ap57 h_call57,
  rcases h_call57 with ⟨h_call57_ap_offset, h_call57⟩,
  generalize' hr_rev_x_diff_slope: cast_UnreducedBigInt3 mem (ap57 - 3) = x_diff_slope,
  simp only [hr_rev_x_diff_slope] at h_call57,
  have htv_x_diff_slope := hr_rev_x_diff_slope.symm, clear hr_rev_x_diff_slope,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- function call
  step_assert_eq hpc57 with arg0,
  step_assert_eq hpc58 with arg1,
  step_assert_eq hpc59 with arg2,
  step_assert_eq hpc60 with arg3,
  step_assert_eq hpc61 with arg4,
  step_assert_eq hpc62 with arg5,
  step_assert_eq hpc63 with arg6,
  step_sub hpc64 (auto_sound_verify_zero mem _ range_check_ptr₄ {
    d0 := x_diff_slope.d0 - point.y.d0 - new_y.d0,
    d1 := x_diff_slope.d1 - point.y.d1 - new_y.d1,
    d2 := x_diff_slope.d2 - point.y.d2 - new_y.d2
  } _ _ _),
  { rw hpc65, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), (eq_sub_of_eq_add arg6)] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_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_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), (eq_sub_of_eq_add arg6)] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call66 ap66 h_call66,
  rcases h_call66 with ⟨h_call66_ap_offset, h_call66⟩,
  rcases h_call66 with ⟨rc_m66, rc_mle66, hl_range_check_ptr₅, h_call66⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap66 - 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 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₅ },
  try { rw [h_call57_ap_offset] at hl_range_check_ptr₅ }, try { arith_simps at hl_range_check_ptr₅ },
  rw [←htv_range_check_ptr₅, ←htv_range_check_ptr₄] at hl_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call66 },
  try { rw [h_call57_ap_offset] at h_call66 }, try { arith_simps at h_call66 },
  rw [←htv_range_check_ptr₄, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call66,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- return
  step_assert_eq hpc66 with hret0,
  step_assert_eq hpc67 with hret1,
  step_assert_eq hpc68 with hret2,
  step_assert_eq hpc69 with hret3,
  step_assert_eq hpc70 with hret4,
  step_assert_eq hpc71 with hret5,
  step_ret hpc72,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m23+rc_m28+rc_m31+rc_m49+rc_m66+0+0), split,
  linarith [rc_mle23, rc_mle28, rc_mle31, rc_mle49, rc_mle66],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5] },
    rw [←htv_range_check_ptr₅, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  dsimp [auto_spec_ec_double_block5],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call23],
  use_only [range_check_ptr₁],
  use_only [slope],
  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 spec23 := h_call23 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec23,
  try { dsimp at spec23, arith_simps at spec23 },
  use_only [spec23],
  use_only [κ_call25],
  use_only [slope_sqr],
  try { dsimp at h_call25, arith_simps at h_call25 },
  try { use_only [h_call25] },
  use_only [κ_call28],
  use_only [range_check_ptr₂],
  use_only [new_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 spec28 := h_call28 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec28,
  try { dsimp at spec28, arith_simps at spec28 },
  use_only [spec28],
  use_only [κ_call31],
  use_only [range_check_ptr₃],
  use_only [new_y],
  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 spec31 := h_call31 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec31,
  try { dsimp at spec31, arith_simps at spec31 },
  use_only [spec31],
  use_only [κ_call49],
  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 spec49 := h_call49 rc_h_range_check_ptr₃',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←htv_range_check_ptr₄] at spec49,
  try { dsimp at spec49, arith_simps at spec49 },
  use_only [spec49],
  use_only [κ_call57],
  use_only [x_diff_slope],
  try { dsimp at h_call57, arith_simps at h_call57 },
  try { use_only [h_call57] },
  use_only [κ_call66],
  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 spec66 := h_call66 rc_h_range_check_ptr₄',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←htv_range_check_ptr₅] at spec66,
  try { dsimp at spec66, arith_simps at spec66 },
  use_only [spec66],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope, htv_range_check_ptr₅] }, },
  try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5] },
  try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_ap_offset, h_call66_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end

theorem auto_sound_ec_double
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_double σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 244))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 232))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 212))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 196))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 68))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_point : point = cast_EcPoint mem (σ.fp - 8))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 7)
        (spec_ec_double mem κ range_check_ptr point (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_ec_double at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72⟩,
  -- if statement
  step_jnz hpc0 hpc1 with hcond hcond,
  {
    -- if: positive branch
    have a0 : point.x.d0 = 0, {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [hcond] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
    },
    try { dsimp at a0 }, try { arith_simps at a0 },
    clear hcond,
    -- if statement
    step_jnz hpc2 hpc3 with hcond hcond,
    {
      -- if: positive branch
      have a2 : point.x.d1 = 0, {
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hcond] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      try { dsimp at a2 }, try { arith_simps at a2 },
      clear hcond,
      -- if statement
      step_jnz hpc4 hpc5 with hcond hcond,
      {
        -- if: positive branch
        have a4 : point.x.d2 = 0, {
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
          try { dsimp [cast_EcPoint, cast_BigInt3] },
          try { arith_simps }, try { simp only [hcond] },
          try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
        },
        try { dsimp at a4 }, try { arith_simps at a4 },
        clear hcond,
        -- return
        step_assert_eq hpc6 with hret0,
        step_assert_eq hpc7 with hret1,
        step_assert_eq hpc8 with hret2,
        step_assert_eq hpc9 with hret3,
        step_assert_eq hpc10 with hret4,
        step_assert_eq hpc11 with hret5,
        step_assert_eq hpc12 with hret6,
        step_ret hpc13,
        -- finish
        step_done, use_only [rfl, rfl],
        -- range check condition
        use_only (0+0), split,
        linarith [],
        split,
        { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5 ,hret6] },
          try { arith_simps, refl <|> norm_cast }, try { refl } },
        intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
        have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
        -- Final Proof
        -- user-provided reduction
        suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
        { apply sound_ec_double, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_ec_double],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a0],
        left,
        use_only [a2],
        left,
        use_only [a4],
        try { split, linarith },
        try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] }, },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5, hret6] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      {
        -- if: negative branch
        have a4 : point.x.d2 ≠ 0, {
          try { simp only [ne.def] },
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
          try { dsimp [cast_EcPoint, cast_BigInt3] },
          try { arith_simps }, try { simp only [hcond] },
          try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
        },
        try { dsimp at a4 }, try { arith_simps at a4 },
        clear hcond,
        -- Use the block soundness theorem.
        apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
        intros κ_block5 τ, try { arith_simps },
        intro h_block5,
        rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
        -- range check condition
        use_only (rc_m_block5+0+0), split,
        linarith [rc_m_le_block5],
        split,
        { arith_simps, try { simp only [hblk_range_check_ptr₁] },
          try { arith_simps, refl <|> norm_cast }, try { refl } },
        intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
        have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
        -- Final Proof
        -- user-provided reduction
        suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
        { apply sound_ec_double, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_ec_double],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a0],
        left,
        use_only [a2],
        right,
        use_only [a4],
        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 h_block5' := h_block5 rc_h_range_check_ptr',
        try { rw [←hin_range_check_ptr] at h_block5' },
        try { dsimp at h_block5, arith_simps at h_block5' },
        have h_block5 := h_block5',
        use_only[κ_block5],
        use [h_block5],
        try { linarith }
      }
    },
    {
      -- if: negative branch
      have a2 : point.x.d1 ≠ 0, {
        try { simp only [ne.def] },
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hcond] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      try { dsimp at a2 }, try { arith_simps at a2 },
      clear hcond,
      -- Use the block soundness theorem.
      apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
      intros κ_block5 τ, try { arith_simps },
      intro h_block5,
      rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
      -- range check condition
      use_only (rc_m_block5+0+0), split,
      linarith [rc_m_le_block5],
      split,
      { arith_simps, try { simp only [hblk_range_check_ptr₁] },
        try { arith_simps, refl <|> norm_cast }, try { refl } },
      intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
      have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
      -- Final Proof
      -- user-provided reduction
      suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
      { apply sound_ec_double, apply auto_spec },
      -- prove the auto generated assertion
      dsimp [auto_spec_ec_double],
      try { norm_num1 }, try { arith_simps },
      left,
      use_only [a0],
      right,
      use_only [a2],
      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 h_block5' := h_block5 rc_h_range_check_ptr',
      try { rw [←hin_range_check_ptr] at h_block5' },
      try { dsimp at h_block5, arith_simps at h_block5' },
      have h_block5 := h_block5',
      use_only[κ_block5],
      use [h_block5],
      try { linarith }
    }
  },
  {
    -- if: negative branch
    have a0 : point.x.d0 ≠ 0, {
      try { simp only [ne.def] },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [hcond] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
    },
    try { dsimp at a0 }, try { arith_simps at a0 },
    clear hcond,
    -- Use the block soundness theorem.
    apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
    intros κ_block5 τ, try { arith_simps },
    intro h_block5,
    rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
    -- range check condition
    use_only (rc_m_block5+0+0), split,
    linarith [rc_m_le_block5],
    split,
    { arith_simps, try { simp only [hblk_range_check_ptr₁] },
      try { arith_simps, refl <|> norm_cast }, try { refl } },
    intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
    have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
    -- Final Proof
    -- user-provided reduction
    suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
    { apply sound_ec_double, apply auto_spec },
    -- prove the auto generated assertion
    dsimp [auto_spec_ec_double],
    try { norm_num1 }, try { arith_simps },
    right,
    use_only [a0],
    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 h_block5' := h_block5 rc_h_range_check_ptr',
    try { rw [←hin_range_check_ptr] at h_block5' },
    try { dsimp at h_block5, arith_simps at h_block5' },
    have h_block5 := h_block5',
    use_only[κ_block5],
    use [h_block5],
    try { linarith }
  }
end


import condensed.top_comparison
import condensed.exact
import for_mathlib.exact_functor

.

open category_theory
open category_theory.limits
open opposite

namespace Condensed

universes u

variables {X Y Z : Condensed.{u} Ab.{u+1}} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0)
  (S : Profinite.{u})

noncomputable theory

instance evaluation_additive (S : Profinite.{u}) :
  functor.additive (Condensed.evaluation _ S : Condensed.{u} Ab.{u+1} ⥤ _) :=
⟨λ X Y f g, rfl⟩

lemma evaluation_exact (S : ExtrDisc.{u}) :
  functor.exact (Condensed.evaluation _ S.val : Condensed.{u} Ab.{u+1} ⥤ _) :=
begin
  intros X Y Z f g h,
  rw Condensed.exact_iff_ExtrDisc at h,
  apply h
end

abbreviation homology_evaluation_iso (S : ExtrDisc.{u}) :
  (homology f g w).val.obj (op S.val) ≅
  homology (f.val.app (op S.val)) (g.val.app (op S.val))
    (by { rw [← f.val.comp_app, ← Sheaf.hom.comp_val, w], refl }) :=
(Condensed.evaluation Ab.{u+1} _).homology_iso _ _ _ _

.

abbreviation homology_functor_evaluation_iso {M : Type*} (c : complex_shape M)
  (i : M) (S : ExtrDisc.{u}) :
  homology_functor (Condensed.{u} Ab.{u+1}) c i ⋙ Condensed.evaluation _ S.val ≅
  (Condensed.evaluation _ S.val).map_homological_complex _ ⋙ homology_functor Ab.{u+1} c i :=
(Condensed.evaluation Ab.{u+1} _).homology_functor_iso _ _

end Condensed


-- import ..src.struct_tact

-- lemma test :
--     forall (o1 : option nat) (o2 : nat → option nat) n
--         o1 >>= o2 = some n ->


/- Enumerable and the Decidable instance may already be in Mathlib -/

class Enumerable (α : Type u) where
  elems    : List α
  complete : ∀ a : α, a ∈ elems

def List.allTrue (p : α → Prop) [(a : α) → Decidable (p a)] : List α → Bool
  | [] => true
  | a :: as => p a && allTrue p as

theorem List.of_allTrue [(a : α) → Decidable (p a)] (hc : allTrue p as) (hin : a ∈ as) : p a := by
  induction as with
  | nil => contradiction
  | cons b bs ih =>
    cases hin with simp [allTrue] at hc
    | head => simp [*]
    | tail _ h => exact ih hc.2 h

theorem List.allTrue_of_forall [(a : α) → Decidable (p a)] (h : ∀ a, p a) : allTrue p as := by
  induction as <;> simp [allTrue, *]

instance [Enumerable α] (p : α → Prop) [(a : α) → Decidable (p a)] : Decidable (∀ a, p a) :=
  have : List.allTrue p Enumerable.elems → (a : α) → p a :=
    fun h a => List.of_allTrue h (Enumerable.complete a)
  decidable_of_decidable_of_iff (Iff.intro this List.allTrue_of_forall)

inductive States | s0 | s1 | s2 | s3 | s4 | s5 | s6 | s7 | s8 | s9 | s10 | s11
deriving DecidableEq

/- We can add a `deriving` for `Enumerable` in the future. -/
open States in
instance : Enumerable States where
  elems := [s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11]
  complete a := by cases a <;> decide

open States
def f : States → States → States
| s0, s0 => s0
| s0, s1 => s0
| s0, s2 => s0
| s0, s3 => s0
| s0, s4 => s0
| s0, s5 => s0
| s0, s6 => s0
| s0, s7 => s0
| s0, s8 => s0
| s0, s9 => s0
| s0, s10 => s0
| s0, s11 => s0
| s1, s0 => s0
| s1, s1 => s0
| s1, s2 => s0
| s1, s3 => s0
| s1, s4 => s0
| s1, s5 => s0
| s1, s6 => s0
| s1, s7 => s0
| s1, s8 => s0
| s1, s9 => s0
| s1, s10 => s0
| s1, s11 => s0
| s2, s0 => s0
| s2, s1 => s0
| s2, s2 => s0
| s2, s3 => s0
| s2, s4 => s0
| s2, s5 => s0
| s2, s6 => s0
| s2, s7 => s0
| s2, s8 => s0
| s2, s9 => s0
| s2, s10 => s0
| s2, s11 => s0
| s3, s0 => s0
| s3, s1 => s0
| s3, s2 => s0
| s3, s3 => s0
| s3, s4 => s0
| s3, s5 => s0
| s3, s6 => s0
| s3, s7 => s0
| s3, s8 => s0
| s3, s9 => s0
| s3, s10 => s0
| s3, s11 => s0
| s4, s0 => s0
| s4, s1 => s0
| s4, s2 => s0
| s4, s3 => s0
| s4, s4 => s0
| s4, s5 => s0
| s4, s6 => s0
| s4, s7 => s0
| s4, s8 => s0
| s4, s9 => s0
| s4, s10 => s0
| s4, s11 => s0
| s5, s0 => s0
| s5, s1 => s0
| s5, s2 => s0
| s5, s3 => s0
| s5, s4 => s0
| s5, s5 => s0
| s5, s6 => s0
| s5, s7 => s0
| s5, s8 => s0
| s5, s9 => s0
| s5, s10 => s0
| s5, s11 => s0
| s6, s0 => s0
| s6, s1 => s0
| s6, s2 => s0
| s6, s3 => s0
| s6, s4 => s0
| s6, s5 => s0
| s6, s6 => s0
| s6, s7 => s0
| s6, s8 => s0
| s6, s9 => s0
| s6, s10 => s0
| s6, s11 => s0
| s7, s0 => s0
| s7, s1 => s0
| s7, s2 => s0
| s7, s3 => s0
| s7, s4 => s0
| s7, s5 => s0
| s7, s6 => s0
| s7, s7 => s0
| s7, s8 => s0
| s7, s9 => s0
| s7, s10 => s0
| s7, s11 => s0
| s8, s0 => s0
| s8, s1 => s0
| s8, s2 => s0
| s8, s3 => s0
| s8, s4 => s0
| s8, s5 => s0
| s8, s6 => s0
| s8, s7 => s0
| s8, s8 => s0
| s8, s9 => s0
| s8, s10 => s0
| s8, s11 => s0
| s9, s0 => s0
| s9, s1 => s0
| s9, s2 => s0
| s9, s3 => s0
| s9, s4 => s0
| s9, s5 => s0
| s9, s6 => s0
| s9, s7 => s0
| s9, s8 => s0
| s9, s9 => s0
| s9, s10 => s0
| s9, s11 => s0
| s10, s0 => s0
| s10, s1 => s0
| s10, s2 => s0
| s10, s3 => s0
| s10, s4 => s0
| s10, s5 => s0
| s10, s6 => s0
| s10, s7 => s0
| s10, s8 => s0
| s10, s9 => s0
| s10, s10 => s0
| s10, s11 => s0
| s11, s0 => s0
| s11, s1 => s0
| s11, s2 => s0
| s11, s3 => s0
| s11, s4 => s0
| s11, s5 => s0
| s11, s6 => s0
| s11, s7 => s0
| s11, s8 => s0
| s11, s9 => s0
| s11, s10 => s0
| s11, s11 => s0

set_option maxHeartbeats 0
example : ∀ x y z, f (f (f s0 x) y) z = f (f x z) (f y z) := by
 native_decide -- This is fast, but the TCB is much bigger


/-
File: signature_recover_public_key_unreduced_sqr_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
open tactic

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

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.unreduced_sqr autogenerated soundness theorem -/

theorem auto_sound_unreduced_sqr
    -- arguments
    (a : BigInt3 F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_unreduced_sqr σ.pc)
    -- input arguments on the stack
    (hin_a : a = cast_BigInt3 mem (σ.fp - 5))
    -- conclusion
  : ensures_ret mem σ (λ κ τ, τ.ap = σ.ap + 12 ∧ spec_unreduced_sqr mem κ a (cast_UnreducedBigInt3 mem (τ.ap - 3))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_unreduced_sqr at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15⟩,
  -- tempvar
  step_assert_eq hpc0 hpc1 with tv_twice_d00,
  generalize' hl_rev_twice_d0: (a.d0 * 2 : F) = twice_d0,
  have hl_twice_d0 := hl_rev_twice_d0.symm, clear hl_rev_twice_d0,
  have htv_twice_d0: twice_d0 = _, {
    apply eq.symm, apply eq.trans tv_twice_d00,
      try { simp only [add_neg_eq_sub, hin_a, hl_twice_d0] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_twice_d00,
  try { dsimp at hl_twice_d0 }, try { arith_simps at hl_twice_d0 },
  -- return
  step_assert_eq hpc2 with hret0,
  step_assert_eq hpc3 hpc4 with hret1,
  step_assert_eq hpc5 with hret2,
  step_assert_eq hpc6 with hret3,
  step_assert_eq hpc7 hpc8 with hret4,
  step_assert_eq hpc9 with hret5,
  step_assert_eq hpc10 with hret6,
  step_assert_eq hpc11 with hret7,
  step_assert_eq hpc12 with hret8,
  step_assert_eq hpc13 with hret9,
  step_assert_eq hpc14 with hret10,
  step_ret hpc15,
  -- finish
  step_done, use_only [rfl, rfl],
  split, refl,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_unreduced_sqr mem _ a _,
  { apply sound_unreduced_sqr, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_unreduced_sqr],
  try { norm_num1 }, try { arith_simps },
  use_only [twice_d0, hl_twice_d0],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_a, hl_twice_d0, htv_twice_d0] }, },
  try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5, hret6, hret7, hret8, hret9, hret10] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import Radon.defs

open_locale nnreal big_operators classical

noncomputable theory

open category_theory
open category_theory.limits
open topological_space

local attribute [instance]
  locally_constant.seminormed_add_comm_group
  locally_constant.pseudo_metric_space

namespace Profinite

/-- Consider an element of `X.Radon_LC p c` as a function on the
type of locally constant functions. -/
def Radon_LC_to_fun (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon_LC p c → locally_constant X ℝ → ℝ :=
λ μ, μ.1

/-- Consider an element of `X.Radon p c` as a function on the
type of continuous functions. -/
def Radon_to_fun (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon p c → C(X,ℝ) → ℝ :=
λ μ, μ.1

lemma Radon_LC_to_fun_injective (X : Profinite.{0}) (p c : ℝ≥0) :
  function.injective (X.Radon_LC_to_fun p c) :=
begin
  intros a b h, ext x : 2,
  exact congr_fun h x
end

lemma Radon_to_fun_injective (X : Profinite.{0}) (p c : ℝ≥0) :
  function.injective (X.Radon_to_fun p c) :=
begin
  intros a b h, ext x : 2,
  exact congr_fun h x
end

lemma Radon_LC_to_fun_continuous (X : Profinite.{0}) (p c : ℝ≥0) :
  continuous (X.Radon_LC_to_fun p c) :=
begin
  apply continuous_pi,
  intros f,
  refine continuous.comp (weak_dual.eval_continuous f) (continuous_subtype_coe),
end

lemma Radon_to_fun_continuous (X : Profinite.{0}) (p c : ℝ≥0) :
  continuous (X.Radon_to_fun p c) :=
begin
  apply continuous_pi,
  intros f,
  refine continuous.comp (weak_dual.eval_continuous f) (continuous_subtype_coe),
end

--WHY!?!?!?
instance t2_space_fun_to_R (X : Type*) :
  t2_space (X → ℝ) :=
@Pi.t2_space X (λ _, ℝ) infer_instance
begin
  intros a, dsimp,
  apply_instance
end

instance t2_space_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0) :
  t2_space (X.Radon_LC p c) :=
⟨λ f g h, separated_by_continuous (X.Radon_LC_to_fun_continuous p c)
  $ (X.Radon_LC_to_fun_injective p c).ne h⟩

instance t2_space_Radon (X : Profinite.{0}) (p c : ℝ≥0) :
  t2_space (X.Radon p c) :=
⟨λ f g h, separated_by_continuous (X.Radon_to_fun_continuous p c)
  $ (X.Radon_to_fun_injective p c).ne h⟩

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_equiv_aux (X : Profinite.{0}) (p : ℝ≥0)
  (T : discrete_quotient X) :
  weak_dual ℝ (locally_constant (X.diagram.obj T) ℝ) ≃
  real_measures p (X.fintype_diagram.obj T) :=
{ to_fun := λ μ t,
    μ (clopens.indicator_LC $
      discrete_quotient.fibre ⊥ (discrete_quotient.equiv_bot t)),
  inv_fun := λ μ,
  { to_fun := λ e, ∑ t : T, μ t * e t,
    map_add' := begin
      intros x y,
      dsimp,
      simp only [mul_add, finset.sum_add_distrib],
    end,
    map_smul' := begin
      intros r e, dsimp,
      rw finset.mul_sum,
      simp_rw [← mul_assoc, mul_comm r],
    end,
    cont := begin
      apply continuous_finset_sum, intros t ht,
      refine continuous.comp (continuous_mul_left (μ t)) _,
      apply locally_constant.continuous_eval,
    end },
  left_inv := begin
    intros μ, ext t, dsimp,
    haveI : fintype (X.diagram.obj T),
    { show fintype T, by apply_instance },
    conv_rhs { rw t.eq_sum_of_fintype },
    rw μ.map_sum,
    apply finset.sum_congr, convert rfl,
    intros t ht,
    rw [μ.map_smul, mul_comm], change _ = _ * _,
    congr' 3, ext w, change _ = _ ↔ _ = _,
    split,
    { intros h, apply_fun discrete_quotient.equiv_bot.symm at h,
      erw discrete_quotient.equiv_bot.symm_apply_apply at h,
      rw discrete_quotient.equiv_bot.symm_apply_apply at h,
      exact h },
    { intros h, rw h, refl, }
  end,
  right_inv := begin
    intros μ, ext (t : T), dsimp,
    rw finset.sum_eq_single t,
    { change _ * ite _ _ _ = _, rw if_pos, erw mul_one,
      change _ = _, refl },
    { intros s _ hs, change _ * ite _ _ _ = _, rw [if_neg, mul_zero],
      change _ ≠ _, contrapose! hs,
      apply_fun discrete_quotient.equiv_bot.symm at hs,
      erw discrete_quotient.equiv_bot.symm_apply_apply at hs,
      rw discrete_quotient.equiv_bot.symm_apply_apply at hs,
      exact hs },
    { intros h, exact false.elim (h (finset.mem_univ _)) },
  end }

lemma bdd_LC_iff_comparison
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)]
  (f : weak_dual ℝ (locally_constant (X.diagram.obj T) ℝ)) :
  f.bdd_LC p c ↔
  X.Radon_LC_comparison_component_equiv_aux p T f ∈
    pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
begin
  split,
  { intros h, change ∑ (t : T), _ ≤ _, specialize h ⊥,
    convert h using 1,
    fapply finset.sum_bij',
    { intros t _, exact discrete_quotient.equiv_bot t, },
    { intros, exact finset.mem_univ _ },
    { intros t _, congr, },
    { intros t _, exact discrete_quotient.equiv_bot.symm t, },
    { intros, exact finset.mem_univ _ },
    { intros, apply equiv.apply_symm_apply },
    { intros, exact discrete_quotient.equiv_bot.apply_symm_apply _, } },
  { intros h E, change ∑ (e : E), _ ≤ _,
    change ∑ (t : T), _ ≤ _ at h,
    dsimp [Radon_LC_comparison_component_equiv_aux] at h,
    refine le_trans _ h,
    have : ∀ e : E,
      (E.fibre e).indicator_LC =
      ∑ t in finset.univ.filter (λ t : T, E.proj t = e),
        ((⊥ : discrete_quotient T).fibre
        (discrete_quotient.equiv_bot t)).indicator_LC,
    { intros e,
      ext (q : T), rw locally_constant.sum_apply,
      change ite (_ = _) (1 : ℝ) 0 = _, split_ifs with hh hh,
      { rw finset.sum_eq_single q,
        change _ = ite (_ = _) (1 : ℝ) _, erw if_pos rfl,
        { intros t ht hh,
          change ite (_ = _) _ (0 : ℝ) = 0, rw if_neg,
          contrapose! hh,
          rw finset.mem_filter at ht,
          apply_fun discrete_quotient.equiv_bot.symm at hh,
          erw discrete_quotient.equiv_bot.symm_apply_apply at hh,
          rw discrete_quotient.equiv_bot.symm_apply_apply at hh,
          exact hh.symm },
        { intros h, refine false.elim (h _), rw finset.mem_filter,
          refine ⟨finset.mem_univ _, hh⟩ } },
      { symmetry, apply finset.sum_eq_zero,
        intros t ht, rw finset.mem_filter at ht,
        change ite (_ = _) _ (0 : ℝ) = 0, rw if_neg,
        contrapose! hh,
        apply_fun discrete_quotient.equiv_bot.symm at hh,
        erw discrete_quotient.equiv_bot.symm_apply_apply at hh,
        rw discrete_quotient.equiv_bot.symm_apply_apply at hh,
        rw hh,
        exact ht.2 } },
    simp_rw [this, f.map_sum], clear this,
    have : ∑ (x : ↥E),
      ∥∑ (i : ↥T) in
        finset.filter (λ (t : ↥T), E.proj t = x) finset.univ,
        f ((⊥ : discrete_quotient T).fibre
          (discrete_quotient.equiv_bot i)).indicator_LC∥₊^(p : ℝ) ≤
      ∑ (x : E), ∑ (i : T) in finset.filter (λ (t : ↥T), E.proj t = x) finset.univ,
        ∥ f ((⊥ : discrete_quotient T).fibre
          (discrete_quotient.equiv_bot i)).indicator_LC∥₊^(p : ℝ),
    { apply finset.sum_le_sum,
      intros e _,
      apply real.pow_nnnorm_sum_le },
    refine le_trans this _, clear this,
    erw ← finset.sum_bUnion,
    have : finset.univ.bUnion (λ (x : ↥E), finset.filter (λ (t : ↥T), E.proj t = x) finset.univ) =
      finset.univ,
    { rw finset.eq_univ_iff_forall,
      intros t,
      rw finset.mem_bUnion,
      refine ⟨E.proj t, finset.mem_univ _, _⟩,
      rw finset.mem_filter,
      refine ⟨finset.mem_univ _, rfl⟩ },
    rw this,
    intros a ha b hb hh q, dsimp, rw finset.mem_inter, rintros ⟨h1,h2⟩,
    simp only [finset.not_mem_empty], apply hh,
    rw finset.mem_filter at h1 h2,
    rw [← h1.2, h2.2] },
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_equiv
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≃
  pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
{ to_fun := λ μ, ⟨X.Radon_LC_comparison_component_equiv_aux p T μ.1,
    begin
      rw ← bdd_LC_iff_comparison, exact μ.2,
    end⟩,
  inv_fun := λ μ, ⟨(X.Radon_LC_comparison_component_equiv_aux p T).symm μ.1,
    begin
      have := μ.2,
      rw ← (X.Radon_LC_comparison_component_equiv_aux p T).apply_symm_apply μ.val at this,
      rw ← bdd_LC_iff_comparison at this,
      exact this,
    end⟩,
  left_inv := begin
    intros μ, ext1,
    apply (X.Radon_LC_comparison_component_equiv_aux p T).symm_apply_apply,
  end,
  right_inv := begin
    intros μ, ext1,
    apply (X.Radon_LC_comparison_component_equiv_aux p T).apply_symm_apply,
  end }

lemma continuous_Radon_LC_comparison_component_equiv_symm
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  continuous (X.Radon_LC_comparison_component_equiv T p c).symm :=
begin
  apply continuous.subtype_mk,
  apply weak_dual.continuous_of_continuous_eval,
  intros y,
  apply continuous_finset_sum,
  rintros t -,
  refine continuous.comp (continuous_mul_right (y t)) _,
  refine continuous.comp (continuous_apply t) continuous_subtype_coe,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_homeo
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≃ₜ
  pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
{ continuous_to_fun := begin
    rw continuous_iff_is_closed, intros S hS,
    erw ← (Radon_LC_comparison_component_equiv _ _ _ _).symm.image_eq_preimage,
    apply is_compact.is_closed,
    apply hS.is_compact.image,
    apply continuous_Radon_LC_comparison_component_equiv_symm,
  end,
  continuous_inv_fun := continuous_Radon_LC_comparison_component_equiv_symm _ _ _ _,
  ..(X.Radon_LC_comparison_component_equiv T p c) }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_iso
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≅
  Top.of (pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c) :=
Top.iso_of_homeo $ Radon_LC_comparison_component_homeo _ _ _ _

lemma Radon_LC_comparison_naturality_aux (X : Profinite.{0})
  (S T : discrete_quotient X) (f : S ⟶ T) (t : T) (q : S) :
  ((⊥ : discrete_quotient T).fibre (discrete_quotient.equiv_bot t)).indicator_LC
    (X.fintype_diagram.map f q) =
  ∑ i : S in finset.univ.filter (λ j, X.fintype_diagram.map f j = t),
    ((⊥ : discrete_quotient S).fibre (discrete_quotient.equiv_bot i)).indicator_LC q :=
begin
  by_cases H : (X.fintype_diagram.map f q = t),
  { rw @finset.sum_eq_single ℝ S _
      (finset.filter (λ (j : (X.fintype_diagram.obj S).α),
        X.fintype_diagram.map f j = t) finset.univ)
      (λ i, ((⊥ : discrete_quotient S).fibre
        (discrete_quotient.equiv_bot i)).indicator_LC q) q _ _,
    { dsimp [clopens.indicator_LC, set.indicator, discrete_quotient.fibre],
      erw if_pos rfl,
      rw if_pos, congr' 1 },
    { intros s hs hsq, rw finset.mem_filter at hs,
      dsimp [clopens.indicator_LC, set.indicator, discrete_quotient.fibre],
      rw if_neg,
      contrapose! hsq,
      apply_fun discrete_quotient.equiv_bot.symm at hsq,
      rw equiv.symm_apply_apply at hsq,
      erw equiv.symm_apply_apply at hsq,
      exact hsq.symm },
    { intros hq,
      erw finset.mem_filter at hq,
      push_neg at hq, specialize hq (finset.mem_univ _),
      exact false.elim (hq H) } },
  { change ite _ _ _ = _, rw if_neg,
    { symmetry, apply finset.sum_eq_zero,
      intros s hs, rw finset.mem_filter at hs, replace hs := hs.2,
      change ite _ _ _ = _, rw if_neg,
      contrapose! H,
      dsimp [discrete_quotient.fibre] at H,
      apply_fun discrete_quotient.equiv_bot.symm at H,
      rw equiv.symm_apply_apply at H,
      erw equiv.symm_apply_apply at H,
      rw H, exact hs },
    { contrapose! H,
      dsimp [discrete_quotient.fibre] at H,
      apply_fun discrete_quotient.equiv_bot.symm at H,
      rw equiv.symm_apply_apply at H,
      erw equiv.symm_apply_apply at H,
      exact H } },
end

/-- The restriction of `Radon_LC_functor` to the discrete quotients of a profinite set `X`
is isomorphic to the `c`-th level of the restriction of `real_measures.functor p`.
This is one of the key isomorphisms used in the comparison between Radon measures and `ℳ_p`.
 -/
def Radon_LC_comparison (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.diagram ⋙ Radon_LC_functor p c ≅
  X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c ⋙
  CompHaus_to_Top :=
nat_iso.of_components
(λ T, Radon_LC_comparison_component_iso _ _ _ _)
begin
  intros S T f,
  ext a t,
  dsimp [Radon_functor, Radon_LC_comparison_component_iso,
    Radon_LC_comparison_component_homeo,
    Radon_LC_comparison_component_equiv,
    Radon_LC_comparison_component_equiv_aux,
    Radon_LC_functor, real_measures.map_hom,
    CompHausFiltPseuNormGrp₁.level,
    map_Radon_LC, weak_dual.comap
    ],
  let aa : weak_dual ℝ (locally_constant S ℝ) := a.1,
  erw ← aa.map_sum,
  congr' 1,
  ext q,
  rw locally_constant.sum_apply,
  dsimp [continuous_map.comap_LC],
  convert Radon_LC_comparison_naturality_aux X S T f t q,
end

end Profinite


import data.cpi.transition.basic data.multiset2 data.option2

-- TODO: Move this somewhere sensible
instance quot.lift.decidable_pred {α : Type*} [setoid α] (p : α → Prop) [dec : decidable_pred p] (h : ∀ a b, a ≈ b → p a = p b)
  : decidable_pred (quot.lift p h)
| x := quot.hrec_on x dec (λ x y r, subsingleton.helim (congr_arg decidable (h x y r)) (dec x) (dec y))

namespace cpi
namespace transition

variables {ℍ : Type} {ω : context}

/-- The set of all transitions from a nil species. -/
def enumerate_nil {Γ} {ℓ : lookup ℍ ω Γ}
  : fintype (transition.transition_from ℓ species.nil)
  := ⟨ finset.empty, (λ ⟨ k, α, E, t ⟩, by cases t) ⟩

/-- ξ_choice acts as an embedding. This is effectively ξ_choice.inj but lifted
    to transitions. -/
def ξ_choice.embed
    {Γ f} (ℓ : lookup ℍ ω Γ)
    (π : prefix_expr ℍ Γ f) (A : species ℍ ω (f.apply Γ)) (As : species.choices ℍ ω Γ)
  : transition_from ℓ (Σ# As) ↪ transition_from ℓ (Σ# (whole.cons π A As))
  := { to_fun := λ t, transition_from.mk (ξ_choice t.2.2.2),
       inj := λ ⟨ k, α, E, t ⟩ ⟨ k', α', E', t' ⟩ eq, by { cases eq, from rfl} }

private def enumerate_choice_communicate_ts {Γ} (ℓ : lookup ℍ ω Γ) :
  ∀ (a :  name Γ) (b : list (name Γ)) (y : ℕ)
    (A : species ℍ ω (context.extend y Γ))
    {As : species.choices ℍ ω Γ}
  , fintype (transition_from ℓ (Σ# As))
  → finset (transition_from ℓ (Σ# (whole.cons (a#(b;y)) A As)))
| a b y A As child :=
  finset.insert_nmem'
    (transition_from.mk (choice₁ a b rfl y A As))
    (finset.map (ξ_choice.embed ℓ _ A As) child.elems)
    (λ mem, begin
      rcases finset.mem_map.mp mem with ⟨ ⟨ k, α, E, t ⟩, mem, eql ⟩,

      unfold_coes at eql,
      simp only [ξ_choice.embed, transition_from.mk] at eql,
      unfold_projs at eql,
      cases eql,
    end)

private def enumerate_choice_communicate {Γ} (ℓ : lookup ℍ ω Γ) :
  ∀ (a :  name Γ) (b : list (name Γ)) (y : ℕ)
    (A : species ℍ ω (context.extend y Γ))
    {As : species.choices ℍ ω Γ}
  , fintype (transition_from ℓ (Σ# As))
  → fintype (transition_from ℓ (Σ# (whole.cons (a#(b;y)) A As)))
| a b y A As child :=
  { elems := enumerate_choice_communicate_ts ℓ a b y A child,
    complete := λ x, begin
      rcases x with ⟨ k, α, E, t ⟩,
      cases t,
      case ξ_choice {
        have : transition_from.mk t_a ∈ child.elems := @fintype.complete _ child _,
        have this := finset.mem_map_of_mem (ξ_choice.embed ℓ (a#(b;y)) A As) this,
        from finset.mem_insert_nmem_of_mem this _,
      },
      case choice₁ {
        subst t_b_len,
        from finset.mem_insert_nmem_self _
      },
    end }

private def enumerate_choice_spontaneous_ts {Γ} (ℓ : lookup ℍ ω Γ) :
  ∀ (k : ℍ) (A : species ℍ ω Γ) {As : species.choices ℍ ω Γ}
  , fintype (transition_from ℓ (Σ# As))
  → finset (transition_from ℓ (Σ# (whole.cons (τ@k) A As)))
| k A As child :=
  finset.insert_nmem'
    (transition_from.mk (choice₂ k A As))
    (finset.map (ξ_choice.embed ℓ _ A As) child.elems)
    (λ mem, begin
      rcases finset.mem_map.mp mem with ⟨ ⟨ k, α, E, t ⟩, mem, eql ⟩,

      unfold_coes at eql,
      simp only [ξ_choice.embed, transition_from.mk] at eql,
      unfold_projs at eql,
      cases eql,
    end)

private def enumerate_choice_spontaneous {Γ} (ℓ : lookup ℍ ω Γ) :
  ∀ (k : ℍ) (A : species ℍ ω Γ) {As : species.choices ℍ ω Γ}
  , fintype (transition_from ℓ (Σ# As))
  → fintype (transition_from ℓ (Σ# (whole.cons (τ@k) A As)))
| k A As child :=
  { elems := enumerate_choice_spontaneous_ts ℓ k A child,
    complete := λ x, begin
      rcases x with ⟨ k', α, E, t ⟩,
      cases t,
      case ξ_choice {
        have : transition_from.mk t_a ∈ child.elems := @fintype.complete _ child _,
        have this := finset.mem_map_of_mem (ξ_choice.embed ℓ (τ@k) A As) this,
        from finset.mem_insert_nmem_of_mem this _,
      },
      case choice₂ { from finset.mem_insert_nmem_self _ },
    end }

/-- The set of all transitions from a guarded choice species. -/
def enumerate_choices {Γ} (ℓ : lookup ℍ ω Γ) :
  ∀ (As : species.choices ℍ ω Γ), fintype (transition_from ℓ (Σ# As))
| species.whole.empty :=
  { elems := finset.empty,
    complete := λ ⟨ k, α, E, t ⟩, by cases t }
| (species.whole.cons (a#(b; y)) A As) := enumerate_choice_communicate ℓ a b y A (enumerate_choices As)
| (species.whole.cons (τ@k) A As) := enumerate_choice_spontaneous ℓ k A (enumerate_choices As)

private def defn.from {Γ n} (ℓ : lookup ℍ ω Γ) (D : reference n ω) (as : vector (name Γ) n)
  : transition_from ℓ (Σ# (species.rename (name.mk_apply as) (ℓ _ D)))
  → transition_from ℓ (apply D as)
| ⟨ k, α, E, t ⟩ := ⟨ k, α, E, defn _ _ _ _ rfl t ⟩

private def defn.embed {Γ n} (ℓ : lookup ℍ ω Γ) (D : reference n ω) (as : vector (name Γ) n)
  : transition_from ℓ (Σ# (species.rename (name.mk_apply as) (ℓ _ D)))
  ↪ transition_from ℓ (apply D as)
  := ⟨ defn.from ℓ D as, λ t t' eql, begin
    rcases t with ⟨ k, α, E, t ⟩, rcases t' with ⟨ k', α', E', t' ⟩,
    simp only [defn.from] at eql,

    rcases sigma.mk.inj eql with ⟨ ⟨ _ ⟩, eql₁ ⟩, clear eql,
    rcases sigma.mk.inj (eq_of_heq eql₁) with ⟨ ⟨ _ ⟩, eql₂ ⟩, clear eql₁,
    rcases sigma.mk.inj (eq_of_heq eql₂) with ⟨ ⟨ _ ⟩, eql₃ ⟩, clear eql₂,
    have eql := eq_of_heq (defn.inj (eq_of_heq eql₃)).2, clear eql₃, subst eql,
  end ⟩

private def enumerate_apply_ts {Γ n} (ℓ : lookup ℍ ω Γ) (D : reference n ω) (as : vector (name Γ) n)
  : finset (transition_from ℓ (apply D as))
  := finset.map (defn.embed ℓ D as)
      (enumerate_choices ℓ (species.rename (name.mk_apply as) (ℓ _ D))).elems

private lemma enumerate_apply_complete {Γ n} (ℓ : lookup ℍ ω Γ) (D : reference n ω) (as : vector (name Γ) n)
  : ∀ x, x ∈ enumerate_apply_ts ℓ D as
| ⟨ k, α, E, defn ℓ' D as B eql t ⟩ := begin
  subst eql,
  have h :=
    @fintype.complete _
      (enumerate_choices ℓ (species.rename (name.mk_apply as) (ℓ _ D)))
      (transition_from.mk t),
  from finset.mem_map_of_mem (defn.embed ℓ D as) h,
end

/-- The set of all transitions from a species invocation. -/
def enumerate_apply {Γ n} (ℓ : lookup ℍ ω Γ) (D : reference n ω) (as : vector (name Γ) n)
  : fintype (transition_from ℓ (apply D as)) :=
  ⟨ enumerate_apply_ts ℓ D as, enumerate_apply_complete ℓ D as ⟩

/-- Wrap a transition in parL. -/
def parL {Γ : context} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : transition.transition_from ℓ A → transition.transition_from ℓ (A |ₛ B)
| ⟨ _, α, production.species E, t ⟩ := ⟨ _, α, _, transition.parL_species B t ⟩
| ⟨ _, α, production.concretion E, t ⟩ := ⟨ _, α, _, transition.parL_concretion B t ⟩

/-- Wrap a transition in parL, as a function embedding. -/
def parL.embed {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : transition.transition_from ℓ A ↪ transition.transition_from ℓ (A |ₛ B)
  := ⟨ parL A B, λ t t' eq, begin
        rcases t with ⟨ k, α, E, t ⟩, rcases t' with ⟨ k', α', E', t' ⟩,
          cases E; cases E'; cases eq; from rfl,
        end ⟩

/-- Wrap a transition in parR. -/
def parR {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : transition.transition_from ℓ B → transition.transition_from ℓ (A |ₛ B)
| ⟨ _, α, production.species E, t ⟩ := ⟨ _, α, _, transition.parR_species A t ⟩
| ⟨ _, α, production.concretion E, t ⟩ := ⟨ _, α, _, transition.parR_concretion A t ⟩

/-- Wrap a transition in parL, as a function embedding. -/
def parR.embed {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : transition.transition_from ℓ B ↪ transition.transition_from ℓ (A |ₛ B)
  := ⟨ parR A B, λ t t' eq, begin
        rcases t with ⟨ k, α, E, t ⟩, rcases t' with ⟨ k', α', E', t' ⟩,
          cases E; cases E'; cases eq; from rfl,
        end ⟩

/-- Determine if two transitions result have products with compatible
    concretions. -/
private def com₁.is_compatible {Γ} (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ)
  : transition.transition_from ℓ A × transition.transition_from ℓ B
  → Prop
| ⟨ ⟨ _, l, @production.concretion _ _ _ a x F, t ⟩,
    ⟨ _, l', @production.concretion _ _ _ b y G, t' ⟩ ⟩ := a = y ∧ b = x
| ⟨ ⟨ _, l, production.concretion F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩ := false
| ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.concretion G, t' ⟩ ⟩ := false
| ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩ := false

instance com₁.is_compatible.decide {Γ} (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ)
  : decidable_pred (com₁.is_compatible ℓ A B)
| ⟨ ⟨ _, l, @production.concretion _ _ _ a x F, t ⟩,
    ⟨ _, l', @production.concretion _ _ _ b y G, t' ⟩ ⟩
    := by { unfold com₁.is_compatible, by apply_instance }
| ⟨ ⟨ _, l, production.concretion F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩ := decidable.false
| ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.concretion G, t' ⟩ ⟩ := decidable.false
| ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩ := decidable.false

/-- The subtype of all transition pairs which are compatible. -/
@[nolint has_inhabited_instance]
def com₁.compatible {Γ} (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ) : Type
  := { p : transition.transition_from ℓ A × transition.transition_from ℓ B
     // com₁.is_compatible ℓ A B p }

/-- Convert a compatible pair of transitions to a com₁ transition. -/
def com₁.of_compatible {Γ} (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ)
  : com₁.compatible ℓ A B → transition.transition_from ℓ (A |ₛ B)
| ⟨ ⟨ ⟨ _, l, @production.concretion _ _ _ a x F, t ⟩,
     ⟨ _, l', @production.concretion _ _ _ b y G, t' ⟩ ⟩, p ⟩ := begin
  cases l with _ a, cases l' with _ b, rcases p with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
  refine ⟨ _, _, _, com₁ rfl rfl t t' ⟩,
end
| ⟨ ⟨ ⟨ _, l, production.concretion F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩, p ⟩ := false.elim p
| ⟨ ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.concretion G, t' ⟩ ⟩, p ⟩ := false.elim p
| ⟨ ⟨ ⟨ _, l, production.species F, t ⟩, ⟨ _, l', production.species G, t' ⟩ ⟩, p ⟩ := false.elim p

/-- We need a separate lemma to show com₁.of_compatible - we need to
    generalise several variables, otherwise the case splits do not go through.
-/
private lemma com₁.of_compatible.inj_help {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ) :
  ∀ {a x} {a₁ b₁} {F₁ : concretion ℍ ω Γ a x} {G₁ : concretion ℍ ω Γ x a}
    {b y} {a₂ b₂} {F₂ : concretion ℍ ω Γ b y} {G₂ : concretion ℍ ω Γ y b}
    {FG₁ FG₂ : species ℍ ω Γ} {α₁ α₂ : label ℍ Γ kind.species}
    (eFG₁ : FG₁ = concretion.pseudo_apply F₁ G₁)
    (eFG₂ : FG₂ = concretion.pseudo_apply F₂ G₂)
    (eα₁ : α₁ = τ⟨ a₁, b₁ ⟩) (eα₂ : α₂ = τ⟨ a₂, b₂ ⟩)
    (tf₁ : A [ℓ, #a₁]⟶ (production.concretion F₁)) (tg₁ : B [ℓ, #b₁]⟶ (production.concretion G₁))
    (tf₂ : A [ℓ, #a₂]⟶ (production.concretion F₂)) (tg₂ : B [ℓ, #b₂]⟶ (production.concretion G₂))
  , (τ⟨ a₁, b₁ ⟩ = (τ⟨ a₂, b₂ ⟩ : label ℍ Γ _))
  → sigma.mk (production.species FG₁) (com₁ eFG₁ eα₁ tf₁ tg₁)
  == sigma.mk (production.species FG₂) (com₁ eFG₂ eα₂ tf₂ tg₂)
  → a = b ∧ x = y ∧ a₁ = a₂ ∧ b₁ = b₂ ∧ F₁ == F₂ ∧ G₁ == G₂ ∧ tf₁ == tf₂ ∧ tg₁ == tg₂
| a x a₁ b₁ F₁ G₁ b y a₂ b₂ F₂ G₂ FG₁ FG₂ α₁ α₂ eFG₁ eFG₂ eα₁ eα₂
  tf₁ tg₁ tf₂ tg₂ eqα eqT := begin
  have : α₁ = α₂ := trans eα₁ (trans eqα eα₂.symm), subst this,
  rcases sigma.mk.inj (eq_of_heq eqT) with ⟨ eqFG, eqT ⟩,
  have : FG₁ = FG₂ := production.species.inj eqFG, subst this,

  rcases com₁.inj (eq_of_heq eqT) with ⟨ ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, F, G, tf, tg ⟩,
  from ⟨ rfl, rfl, rfl, rfl, F, G, tf, tg ⟩,
end

private lemma com₁.of_compatible.inj {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : function.injective (com₁.of_compatible ℓ A B)
| ⟨ ⟨ ⟨ k₁, α₁, E₁, t₁ ⟩, ⟨ k₁', α₁', E₁', t₁' ⟩ ⟩, is₁ ⟩
  ⟨ ⟨ ⟨ k₂, α₂, E₂, t₂ ⟩, ⟨ k₂', α₂', E₂', t₂' ⟩ ⟩, is₂ ⟩ eql := begin
  cases E₁; cases E₁'; try { unfold com₁.is_compatible at is₁, contradiction },
  rcases is₁ with ⟨ l, r ⟩, subst l, subst r, cases α₁, cases α₁',

  cases E₂; cases E₂'; try { unfold com₁.is_compatible at is₂, contradiction },
  rcases is₂ with ⟨ l, r ⟩, subst l, subst r, cases α₂, cases α₂',

  simp only [com₁.of_compatible] at eql,

  rcases sigma.mk.inj (eq_of_heq (sigma.mk.inj eql).2) with ⟨ eqα, eqT ⟩,
  rcases com₁.of_compatible.inj_help A B rfl rfl rfl rfl t₁ t₁' t₂ t₂' eqα eqT
    with ⟨ ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
  from rfl,
end

/-- Convert a compatible pair of transitions to a com₁ transition. -/
def com₁.embed {Γ} (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ)
  : com₁.compatible ℓ A B ↪ transition.transition_from ℓ (A |ₛ B)
  := ⟨ com₁.of_compatible ℓ A B, com₁.of_compatible.inj A B ⟩

private lemma com₁.impossible_l {Γ}
    (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ) {b y}
    {F : concretion ℍ ω Γ b y} {G : concretion ℍ ω Γ y b}
  : ∀ {a₁ a₂} {C FG : species ℍ ω Γ}
      (t : A [ℓ, τ⟨ a₁, a₂ ⟩]⟶ (production.species C))
      (t₁ : A [ℓ, #a₁]⟶ (production.concretion F))
      (t₂ : B [ℓ, #a₂]⟶ (production.concretion G))
      (h : FG = concretion.pseudo_apply F G)
    , (C |ₛ B) = FG
    → ¬ (parL_species B t == com₁ h rfl t₁ t₂)
| a₁ a₂ C FG t t₁ t₂ h cfg eql := by { subst cfg, cases (eq_of_heq eql) }

private lemma com₁.impossible_r {Γ}
    (ℓ : lookup ℍ ω Γ) (A B : species ℍ ω Γ) {b y}
    {F : concretion ℍ ω Γ b y} {G : concretion ℍ ω Γ y b}
  : ∀ {a₁ a₂} {C FG : species ℍ ω Γ}
      (t : B [ℓ, τ⟨ a₁, a₂ ⟩]⟶ (production.species C))
      (t₁ : A [ℓ, #a₁]⟶ (production.concretion F))
      (t₂ : B [ℓ, #a₂]⟶ (production.concretion G))
      (h : FG = concretion.pseudo_apply F G)
    , (A |ₛ C) = FG
    → ¬ (parR_species A t == com₁ h rfl t₁ t₂)
| a₁ a₂ C FG t t₁ t₂ h cfg eql := by { subst cfg, cases (eq_of_heq eql) }

private def enumerate_parallel_ts {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
  : fintype (transition.transition_from ℓ A)
  → fintype (transition.transition_from ℓ B)
  → finset (transition.transition_from ℓ (A |ₛ B))
| As Bs :=
  finset.union_disjoint
    (finset.map
      (com₁.embed ℓ A B)
      ((finset.product As.elems Bs.elems).subtype (com₁.is_compatible ℓ A B)))
    (finset.union_disjoint
      (As.elems.map (parL.embed A B))
      (Bs.elems.map (parR.embed A B))
      (λ x memL memR, begin
        rcases finset.mem_map.mp memL with ⟨ ⟨ k, α, E, t ⟩, mem, eql ⟩, clear mem,
        unfold_coes at eql, simp only [parL.embed] at eql, subst eql,

        rcases finset.mem_map.mp memR with ⟨ ⟨ k', α', E', t' ⟩, mem, eql ⟩, clear mem,
        unfold_coes at eql, simp only [parR.embed] at eql,

        cases E; cases E'; simp only [parL, parR] at eql; cases eql,
      end))
    (λ x memL memR, begin
      rcases finset.mem_map.mp memL with ⟨ ⟨ ⟨ ⟨ k₁, α₁, E₁, t₁ ⟩, ⟨ k₂, α₂, E₂, t₂ ⟩ ⟩, d ⟩, mem, eql ⟩, clear memL mem,
      unfold_coes at eql, simp only [com₁.embed] at eql,
      cases E₁; cases E₂; try { simpa only [com₁.is_compatible] using d },
      rcases d with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩, cases α₁, cases α₂,
      simp only [com₁.of_compatible] at eql, subst eql,

      cases finset.mem_union_disjoint.mp memR,
      case or.inl {
        rcases finset.mem_map.mp h with ⟨ ⟨ k, α, E, t ⟩, mem, eql ⟩, clear mem memR,
        unfold_coes at eql, simp only [parL.embed] at eql,
        cases E,
        case production.species {
          rcases sigma.mk.inj eql with ⟨ ⟨ _ ⟩, eql₁ ⟩, clear eql,
          rcases sigma.mk.inj (eq_of_heq eql₁) with ⟨ ⟨ _ ⟩, eql₂ ⟩, clear eql₁,
          rcases sigma.mk.inj (eq_of_heq eql₂) with ⟨ eqlE, eqlT ⟩,

          from com₁.impossible_l ℓ A B t t₁ t₂ rfl (production.species.inj eqlE) eqlT,
        },
        case production.concretion { cases (sigma.mk.inj eql).1 },
      },
      case or.inr {
        rcases finset.mem_map.mp h with ⟨ ⟨ k, α, E, t ⟩, mem, eql ⟩, clear mem memR,
        unfold_coes at eql, simp only [parR.embed] at eql,
        cases E,
        case production.species {
          rcases sigma.mk.inj eql with ⟨ ⟨ _ ⟩, eql₁ ⟩, clear eql,
          rcases sigma.mk.inj (eq_of_heq eql₁) with ⟨ ⟨ _ ⟩, eql₂ ⟩, clear eql₁,
          rcases sigma.mk.inj (eq_of_heq eql₂) with ⟨ eqlE, eqlT ⟩,

          from com₁.impossible_r ℓ A B t t₁ t₂ rfl (production.species.inj eqlE) eqlT,
        },
        case production.concretion { cases (sigma.mk.inj eql).1 },
      },
    end)

private lemma enumate_parallel_compute_l_species
    {Γ ℓ} {A B : species ℍ ω Γ} {l : label ℍ Γ kind.species} {E}
    (As : fintype (transition_from ℓ A)) (Bs : fintype (transition_from ℓ B))
    (t : transition A ℓ l (production.species E))
  : transition_from.mk (parL_species B t) ∈ enumerate_parallel_ts A B As Bs :=
  let h := @fintype.complete _ As (transition_from.mk t) in
  let g := finset.mem_map_of_mem (parL.embed A B) h in
  finset.mem_union_disjoint.mpr (or.inr (finset.mem_union_disjoint.mpr (or.inl g)))

private lemma enumate_parallel_compute_l_concretion
    {Γ ℓ} {A B} {l : label ℍ Γ kind.concretion} {b y} {E : concretion ℍ ω Γ b y}
    (As : fintype (transition_from ℓ A)) (Bs : fintype (transition_from ℓ B))
    (t : transition A ℓ l (production.concretion E))
  : transition_from.mk (parL_concretion B t) ∈ enumerate_parallel_ts A B As Bs :=
  let h := @fintype.complete _ As (transition_from.mk t) in
  let g := finset.mem_map_of_mem (parL.embed A B) h in
  finset.mem_union_disjoint.mpr (or.inr (finset.mem_union_disjoint.mpr (or.inl g)))

private lemma enumate_parallel_compute_r_species
    {Γ ℓ} {A B : species ℍ ω Γ} {l : label ℍ Γ kind.species} {E}
    (As : fintype (transition_from ℓ A)) (Bs : fintype (transition_from ℓ B))
    (t : transition B ℓ l (production.species E))
  : transition_from.mk (parR_species A t) ∈ enumerate_parallel_ts A B As Bs :=
  let h := @fintype.complete _ Bs (transition_from.mk t) in
  let g := finset.mem_map_of_mem (parR.embed A B) h in
  finset.mem_union_disjoint.mpr (or.inr (finset.mem_union_disjoint.mpr (or.inr g)))

private lemma enumerate_parallel_complete {Γ} {ℓ : lookup ℍ ω Γ} (A B : species ℍ ω Γ)
    (As : fintype (transition.transition_from ℓ A)) (Bs : fintype (transition.transition_from ℓ B))
  : ∀ x, x ∈ enumerate_parallel_ts A B As Bs
| ⟨ k, α, E, parL_species _ t ⟩ := enumate_parallel_compute_l_species As Bs t
| ⟨ k, α, E, parL_concretion _ t ⟩ := enumate_parallel_compute_l_concretion As Bs t
| ⟨ k, α, E, parR_species _ t ⟩ := enumate_parallel_compute_r_species As Bs t
| ⟨ k, α, E, parR_concretion _ t ⟩ :=
  let h := @fintype.complete _ Bs (transition_from.mk t) in
  let g := finset.mem_map_of_mem (parR.embed A B) h in
  finset.mem_union_disjoint.mpr (or.inr (finset.mem_union_disjoint.mpr (or.inr g)))
| ⟨ k, α, E, com₁ eqFG eqα tf tg ⟩ := begin
  subst eqFG, subst eqα,
  let t : com₁.compatible ℓ A B
    := ⟨ ( transition_from.mk tf, transition_from.mk tg ), ⟨ rfl, rfl ⟩ ⟩,
  have h
    := finset.mem_subtype.mpr
      (finset.mem_product.mpr ⟨ @fintype.complete _ As t.val.1, @fintype.complete _ Bs t.val.2 ⟩),
  from finset.mem_union_disjoint.mpr (or.inl (finset.mem_map_of_mem (com₁.embed ℓ A B) h)),
end

/-- The set of all transitions from a parallel composition of species -/
def enumerate_parallel {Γ} {ℓ : lookup ℍ ω Γ} {A B : species ℍ ω Γ}
  : fintype (transition.transition_from ℓ A)
  → fintype (transition.transition_from ℓ B)
  → fintype (transition.transition_from ℓ (A |ₛ B))
| As Bs := ⟨ enumerate_parallel_ts A B As Bs, enumerate_parallel_complete A B As Bs ⟩

private def is_restriction_name {Γ} (M : affinity ℍ)
  : name (context.extend M.arity Γ) → name (context.extend M.arity Γ)
  → Prop
| (name.zero a) (name.zero b) := option.is_some' (M.f a b)
| (name.extend _) (name.extend _) := true
| (name.extend _) (name.zero _) := false
| (name.zero _) (name.extend _) := false

private def is_restriction_name.comm {Γ} (M : affinity ℍ)
  : ∀ (a b : name (context.extend M.arity Γ))
  , is_restriction_name M a b = is_restriction_name M b a
| a b := by { cases a; cases b; from rfl <|> simp only [is_restriction_name, M.symm] }

private def is_restriction_like {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : transition.transition_from (lookup.rename name.extend ℓ) A
  → Prop
| ⟨ _, τ⟨ p ⟩, E, t ⟩ := upair.lift_on p (is_restriction_name M) (is_restriction_name.comm M)
| ⟨ _, τ@' k, E, t ⟩ := true
| ⟨ _, # (name.zero n), E, t ⟩ := false
| ⟨ _, # (name.extend n), E, t ⟩ := true

private def is_restriction {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  := { t : transition_from (lookup.rename name.extend ℓ) A // is_restriction_like ℓ M A t }

private def is_restriction.name_lift {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ)
  (A : species ℍ ω (context.extend M.arity Γ))
  (B : species ℍ ω (context.extend M.arity Γ)) :
  ∀ (a b : name (context.extend M.arity Γ))
  , is_restriction_name M a b
  → A [lookup.rename name.extend ℓ, τ⟨ a, b ⟩]⟶ (production.species B)
  → transition.transition_from ℓ (ν(M) A)
| (name.zero a) (name.zero b) is_some t :=
  let this : M.get (upair.mk a b) = some (option.get' is_some) := option.eq_some_of_is_some' is_some in
  ⟨ _, _, _, com₂ M (option.get' is_some) this rfl t ⟩
| (name.extend a) (name.extend b) fls t := begin
  have : τ⟨ name.extend a, name.extend b ⟩ = label.rename (@name.extend Γ M.arity) (τ⟨ a, b ⟩),
  { simpa only [label.rename] },
  from ⟨ _, _, _, ν₁_species M this t ⟩,
end
| (name.extend _) (name.zero _) fls t := false.elim fls
| (name.zero a) (name.extend b) fls t := false.elim fls

private lemma is_restriction_name_lift.comm_zero {Γ} {ℓ : lookup ℍ ω Γ} (M : affinity ℍ) (A B : species ℍ ω (context.extend M.arity Γ))
    {x y : fin M.arity}
    {tL : A [lookup.rename name.extend ℓ, τ⟨ (upair.mk (name.zero x) (name.zero y)) ⟩]⟶ (production.species B)}
    {tR : A [lookup.rename name.extend ℓ, τ⟨ (upair.mk (name.zero y) (name.zero x)) ⟩]⟶ (production.species B)}
    (eT : tL == tR)
    (k₁ k₂ : ℍ)
    (e₁ : M.get (upair.mk x y) = some k₁)
    (e₂ : M.get (upair.mk y x) = some k₂)
  : transition.transition_from.mk (com₂ M k₁ e₁ rfl tL)  = transition.transition_from.mk (com₂ M k₂ e₂ rfl tR) := begin
  have : k₁ = k₂,
  {
    rw upair.mk.comm at e₁,
    from option.some.inj (trans e₁.symm e₂),
  }, subst this,

  refine sigma.mk.inj_iff.mpr ⟨ rfl, heq_of_eq _ ⟩, simp only [heq_iff_eq],
  from ⟨ rfl, ⟨ rfl, rfl ⟩, quot.sound (or.inr ⟨ rfl, rfl ⟩), quot.sound (or.inr ⟨ rfl, rfl ⟩), eT ⟩,
end

private lemma is_restriction_name_lift.comm_extend {Γ} {ℓ : lookup ℍ ω Γ} (M : affinity ℍ) (A B : species ℍ ω (context.extend M.arity Γ))
    {x y : name Γ}
    {tL : A [lookup.rename name.extend ℓ, τ⟨ (upair.mk (name.extend x) (name.extend y)) ⟩]⟶ (production.species B)}
    {tR : A [lookup.rename name.extend ℓ, τ⟨ (upair.mk (name.extend y) (name.extend x)) ⟩]⟶ (production.species B)}
    (eT : tL == tR)
    (l₁ l₂ : label ℍ Γ kind.species)
    (e₁ : τ⟨ (upair.mk (name.extend x) (name.extend y)) ⟩ = label.rename name.extend l₁)
    (e₂ : τ⟨ (upair.mk (name.extend y) (name.extend x)) ⟩ = label.rename name.extend l₂)
  : transition.transition_from.mk (ν₁_species M e₁ tL) = transition.transition_from.mk (ν₁_species M e₂ tR) := begin
  have : l₁ = l₂,
  {
    rw [upair.mk.comm] at e₁,
    from label.rename.inj (@name.extend.inj _ _) (trans e₁.symm e₂),
  }, subst this,

  refine sigma.mk.inj_iff.mpr ⟨ rfl, heq_of_eq _ ⟩, simp only [heq_iff_eq],
  from ⟨ rfl, ⟨ rfl, rfl ⟩, quot.sound (or.inr ⟨ rfl, rfl ⟩), eT ⟩,
end

private lemma is_restriction.name_lift.comm {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A B : species ℍ ω (context.extend M.arity Γ)) :
  ∀ (a b : name (context.extend M.arity Γ))
  ,  is_restriction.name_lift ℓ M A B a b
  == is_restriction.name_lift ℓ M A B b a
| (name.zero x) (name.zero y) := function.hfunext
  (by { unfold is_restriction_name, rw M.symm })
  (λ irlL irlR eIRL, function.hfunext
    (by rw upair.mk.comm)
    (λ tL tR eT, heq_of_eq (is_restriction_name_lift.comm_zero M A B eT _ _ _ _)))
| (name.extend x) (name.extend y) := function.hfunext rfl
  (λ irlL irlR eIRL, function.hfunext
    (by rw upair.mk.comm)
    (λ tL tR eT, heq_of_eq (is_restriction_name_lift.comm_extend M A B eT _ _ _ _)))
| (name.zero x) (name.extend y) := function.hfunext rfl
    (λ irlL irlR eIRL, function.hfunext (by rw upair.mk.comm) (λ x b z, heq.rfl))
| (name.extend x) (name.zero y) := function.hfunext rfl
    (λ irlL irlR eIRL, function.hfunext (by rw upair.mk.comm) (λ x b z, heq.rfl))

lemma ν₁_species.inj' {Γ} {ℓ : lookup ℍ ω Γ} (M : affinity ℍ) {A} :
  ∀ {E₁ E₂}
    {l₁ : label ℍ Γ kind.species} {l'₁ : label ℍ (context.extend M.arity Γ) kind.species}
    {l₂ : label ℍ Γ kind.species} {l'₂ : label ℍ (context.extend M.arity Γ) kind.species}
    {e₁ : l'₁ = label.rename name.extend l₁}
    {e₂ : l'₂ = label.rename name.extend l₂}
    {t₁ : A [lookup.rename name.extend ℓ, l'₁]⟶ (production.species E₁)}
    {t₂ : A [lookup.rename name.extend ℓ, l'₂]⟶ (production.species E₂)}
  , transition_from.mk (ν₁_species M e₁ t₁) = transition_from.mk (ν₁_species M e₂ t₂)
  → transition_from.mk t₁ = transition_from.mk t₂
| E₁ E₂ l₁ l'₁ l₂ l'₂ e₁ e₂ t₁ t₂ eql := begin
  rcases sigma.mk.inj (eq_of_heq (sigma.mk.inj eql).2) with ⟨ this, eqR ⟩, subst ‹l₁ = l₂›,
  have : l'₁ = l'₂ := trans e₁ e₂.symm, subst ‹l'₁ = l'₂›,

  rcases sigma.mk.inj (eq_of_heq eqR) with ⟨ ⟨ _ ⟩, eqT ⟩,
  rcases ν₁_species.inj (eq_of_heq eqT) with ⟨ _, ⟨ _ ⟩ ⟩,
  from rfl,
end

lemma ν₁_concretion.inj' {Γ} {ℓ : lookup ℍ ω Γ} (M : affinity ℍ) {A} :
  ∀ {a x b y} {E₁ : concretion ℍ ω _ a x} {E₂ : concretion ℍ ω _ b y}
    {l₁ : label ℍ Γ kind.concretion} {l'₁ : label ℍ (context.extend M.arity Γ) kind.concretion}
    {l₂ : label ℍ Γ kind.concretion} {l'₂ : label ℍ (context.extend M.arity Γ) kind.concretion}
    {e₁ : l'₁ = label.rename name.extend l₁}
    {e₂ : l'₂ = label.rename name.extend l₂}
    {t₁ : A [lookup.rename name.extend ℓ, l'₁]⟶ (production.concretion E₁)}
    {t₂ : A [lookup.rename name.extend ℓ, l'₂]⟶ (production.concretion E₂)}
  , transition_from.mk (ν₁_concretion M e₁ t₁) = transition_from.mk (ν₁_concretion M e₂ t₂)
  → transition_from.mk t₁ = transition_from.mk t₂
| a x b y E₁ E₂ l₁ l'₁ l₂ l'₂ e₁ e₂ t₁ t₂ eql := begin
  rcases sigma.mk.inj (eq_of_heq (sigma.mk.inj eql).2) with ⟨ this, eqR ⟩, subst ‹l₁ = l₂›,
  have : l'₁ = l'₂ := trans e₁ e₂.symm, subst ‹l'₁ = l'₂›,

  rcases sigma.mk.inj (eq_of_heq eqR) with ⟨ ⟨ _ ⟩, eqT ⟩,
  rcases ν₁_concretion.inj (eq_of_heq eqT) with ⟨ _, ⟨ _ ⟩ ⟩,
  from rfl,
end

private lemma is_restriction.name_lift.inj_zero {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ)
    (A : species ℍ ω (context.extend M.arity Γ)) :
  ∀ {B₁ B₂ : species ℍ ω (context.extend M.arity Γ)}
    {p q : upair (fin M.arity)}
    {t₁ : A [lookup.rename name.extend ℓ, τ⟨ (upair.map name.zero p) ⟩]⟶ (production.species B₁)}
    {t₂ : A [lookup.rename name.extend ℓ, τ⟨ (upair.map name.zero q) ⟩]⟶ (production.species B₂)}
    {k₁ k₂ : ℍ} {e₁ : M.get p = some k₁} {e₂ : M.get q = some k₂}
  , transition_from.mk (com₂ M k₁ e₁ rfl t₁) = transition_from.mk (com₂ M k₂ e₂ rfl t₂)
  → transition_from.mk t₁ = transition_from.mk t₂
| B₁ B₂ p q t₁ t₂ k₁ k₂ e₁ e₂ eql := begin
  rcases sigma.mk.inj (eq_of_heq (sigma.mk.inj eql).2) with ⟨ ⟨ _ ⟩, eqR ⟩,
  rcases sigma.mk.inj (eq_of_heq eqR) with ⟨ ⟨ _ ⟩, eqT ⟩,
  rcases com₂.inj (eq_of_heq eqT) with ⟨ ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
  from rfl,
end

private lemma is_restriction.name_lift.inj {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ)
    (A : species ℍ ω (context.extend M.arity Γ)) {B₁ B₂ : species ℍ ω (context.extend M.arity Γ)} :
  ∀ {a₁ b₁ a₂ b₂ : name (context.extend M.arity Γ)}
    (t₁ : A [lookup.rename name.extend ℓ, τ⟨ a₁, b₁ ⟩]⟶ (production.species B₁))
    (t₂ : A [lookup.rename name.extend ℓ, τ⟨ a₂, b₂ ⟩]⟶ (production.species B₂))
    (irl₁ : is_restriction_name M a₁ b₁)
    (irl₂ : is_restriction_name M a₂ b₂)
  , is_restriction.name_lift ℓ M A B₁ a₁ b₁ irl₁ t₁ = is_restriction.name_lift ℓ M A B₂ a₂ b₂ irl₂ t₂
  → transition_from.mk t₁ = transition_from.mk t₂
| a₁ b₁ a₂ b₂ t₁ t₂ irl₁ irl₂ eql := begin
  cases a₁; cases b₁; try { from false.elim irl₁ };
  cases a₂; cases b₂; try { from false.elim irl₂ <|> cases eql };
  simp only [is_restriction.name_lift] at eql,

  case name.extend { from ν₁_species.inj' M eql },
  case name.zero { from is_restriction.name_lift.inj_zero ℓ M A eql },
end

private def is_restriction.lift {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : is_restriction ℓ M A
  → transition.transition_from ℓ (ν(M) A)
| ⟨ ⟨ _, τ@' k, production.species B, t ⟩, _ ⟩ := begin
  have : τ@' k = label.rename (@name.extend Γ M.arity) (τ@' k), { simp only [label.rename] },
  from ⟨ _, _, _, ν₁_species M this t ⟩,
end
| ⟨ ⟨ _, τ⟨ p ⟩, production.species B, t ⟩, irl ⟩ := begin
  unfold is_restriction_like at irl,
  from upair.rec_on p
    (λ a b irl t, is_restriction.name_lift ℓ M A B a b irl t)
    (is_restriction.name_lift.comm ℓ M A B)
    irl t,
end
| ⟨ ⟨ _, # (name.zero n), E, t ⟩, irl ⟩ := false.elim irl
| ⟨ ⟨ _, # (name.extend n), production.concretion F, t ⟩, _ ⟩ := begin
  have : # (name.extend n) = label.rename (@name.extend Γ M.arity) (# n), { simp only [label.rename] },
  from ⟨ _, # n, production.concretion (ν'(M) F), ν₁_concretion M this t ⟩,
end

private def is_restriction.lift.inj_both {Γ : context} {ℓ : lookup ℍ ω Γ}
    (M : affinity ℍ) (A B : species ℍ ω (context.extend M.arity Γ)) :
  ∀ {B B' : species ℍ ω (context.extend M.arity Γ)}
    {p q : upair (name (context.extend M.arity Γ))}

    (t : A [lookup.rename name.extend ℓ, τ⟨ p ⟩]⟶ (production.species B))
    (irl : is_restriction_like ℓ M A ⟨kind.species, ⟨τ⟨ p ⟩, ⟨production.species B, t⟩⟩⟩)

    (t' : A [lookup.rename name.extend ℓ, τ⟨ q ⟩]⟶ (production.species B'))
    (irl' : is_restriction_like ℓ M A ⟨kind.species, ⟨τ⟨ q ⟩, ⟨production.species B', t'⟩⟩⟩)

  , is_restriction.lift ℓ M A ⟨⟨kind.species, ⟨τ⟨ p ⟩, ⟨production.species B, t⟩⟩⟩, irl⟩
  = is_restriction.lift ℓ M A ⟨⟨kind.species, ⟨τ⟨ q ⟩, ⟨production.species B', t'⟩⟩⟩, irl'⟩
  → (⟨⟨kind.species, ⟨τ⟨ p ⟩, ⟨production.species B, t⟩⟩⟩, irl⟩ : is_restriction ℓ M A)
  = ⟨⟨kind.species, ⟨τ⟨ q ⟩, ⟨production.species B', t'⟩⟩⟩, irl'⟩
| B B' p q t irl t' irl' eql := begin
  unfold is_restriction.lift at eql,
  rcases upair.exists_rep p with ⟨ a, b, ⟨ _ ⟩ ⟩,
  rcases upair.exists_rep q with ⟨ a', b', ⟨ _ ⟩ ⟩,

  simp only [],
  from is_restriction.name_lift.inj ℓ M A t t' irl irl' eql,
end

private def is_restriction.lift.inj {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : function.injective (is_restriction.lift ℓ M A)
| ⟨ ⟨ _, # (name.zero n), E, t ⟩, irl ⟩ _ eql := false.elim irl

| ⟨ ⟨ _, τ@' k, production.species B, t ⟩, _ ⟩ ⟨ ⟨ _, # (name.zero n), E, t' ⟩, irl ⟩ eql := false.elim irl
| ⟨ ⟨ _, τ@' k, production.species B, t ⟩, _ ⟩ ⟨ ⟨ _, τ@' k', production.species B', t' ⟩, _ ⟩ eql
  := by { cases ν₁_species.inj' M eql, from rfl }
| ⟨ ⟨ _, τ@' k, production.species B, t ⟩, _ ⟩ ⟨ ⟨ _, τ⟨ p ⟩, production.species B', t' ⟩, irl ⟩ eql := begin
  rcases upair.exists_rep p with ⟨ a, b, ⟨ _ ⟩ ⟩,
  simp only [is_restriction.lift, upair.rec_on_beta] at eql,
  cases a; cases b; cases eql <|> from false.elim irl,
end
| ⟨ ⟨ _, τ@' k, production.species B, t ⟩, _ ⟩ ⟨ ⟨ _, # (name.extend n), production.concretion F, t' ⟩, _ ⟩ eql := by cases eql

| ⟨ ⟨ _, τ⟨ p ⟩, production.species B, t ⟩, _ ⟩ ⟨ ⟨ _, # (name.zero n'), E, t' ⟩, irl ⟩ eql := false.elim irl
| ⟨ ⟨ _, τ⟨ p ⟩, production.species B, t ⟩, irl ⟩ ⟨ ⟨ _, # (name.extend n'), production.concretion F', t' ⟩, _ ⟩ eql := begin
  rcases upair.exists_rep p with ⟨ a, b, ⟨ _ ⟩ ⟩,
  simp only [is_restriction.lift, upair.rec_on_beta] at eql,
  cases a; cases b; cases eql <|> from false.elim irl,
end
| ⟨ ⟨ _, τ⟨ p ⟩, production.species B, t ⟩, irl ⟩ ⟨ ⟨ _, τ@' k', production.species B', t' ⟩, _ ⟩ eql := begin
  rcases upair.exists_rep p with ⟨ a, b, ⟨ _ ⟩ ⟩,
  simp only [is_restriction.lift, upair.rec_on_beta] at eql,
  cases a; cases b; cases eql <|> from false.elim irl,
end
| ⟨ ⟨ _, τ⟨ p ⟩, production.species B, t ⟩, irl ⟩ ⟨ ⟨ _, τ⟨ q ⟩, production.species B', t' ⟩, irl' ⟩ eql
  := is_restriction.lift.inj_both M A B t irl t' irl' eql

| ⟨ ⟨ _, # (name.extend n), production.concretion F, t ⟩, _ ⟩ ⟨ ⟨ _, # (name.extend n'), production.concretion F', t' ⟩, _ ⟩ eql
  := by { cases ν₁_concretion.inj' M eql, from rfl }
| ⟨ ⟨ _, # (name.extend n), production.concretion F, t ⟩, _ ⟩ ⟨ ⟨ _, # (name.zero n'), E, t' ⟩, irl ⟩ eql := false.elim irl
| ⟨ ⟨ _, # (name.extend n), production.concretion F, t ⟩, _ ⟩ ⟨ ⟨ _, τ@' k', production.species B', t' ⟩, _ ⟩ eql := by cases eql
| ⟨ ⟨ _, # (name.extend n), production.concretion F, t ⟩, _ ⟩ ⟨ ⟨ _, τ⟨ p ⟩, production.species B', t' ⟩, irl ⟩ eql := begin
  rcases upair.exists_rep p with ⟨ a, b, ⟨ _ ⟩ ⟩,
  simp only [is_restriction.lift, upair.rec_on_beta] at eql,
  cases a; cases b; cases eql <|> from false.elim irl,
end

private def is_restriction.embed {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : is_restriction ℓ M A
  ↪ transition.transition_from ℓ (ν(M) A)
  := ⟨ is_restriction.lift ℓ M A, is_restriction.lift.inj ℓ M A ⟩

instance is_restriction_name.decide {Γ} (M : affinity ℍ)
  : decidable_pred (λ (p : upair.pair (name (context.extend M.arity Γ))), is_restriction_name M p.fst p.snd)
| ⟨ name.zero a, name.zero b ⟩ := by { unfold is_restriction_name, apply_instance }
| ⟨ name.extend _, name.extend _ ⟩ := decidable.true
| ⟨ name.extend _, name.zero _ ⟩ := decidable.false
| ⟨ name.zero _, name.extend _ ⟩ := decidable.false

instance is_restriction_like.decide {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : decidable_pred (is_restriction_like ℓ M A)
| ⟨ _, τ⟨ p ⟩, E, t ⟩ := quot.lift.decidable_pred _ _ _
| ⟨ _, τ@' k, E, t ⟩ := decidable.true
| ⟨ _, # (name.zero n), E, t ⟩ := decidable.false
| ⟨ _, # (name.extend n), E, t ⟩ := decidable.true

private def enumerate_restriction {Γ} (ℓ : lookup ℍ ω Γ) (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
  : fintype (transition.transition_from (lookup.rename name.extend ℓ) A)
  → fintype (transition.transition_from ℓ (ν(M) A))
| As :=
  ⟨ finset.map (is_restriction.embed ℓ M A)
      (finset.subtype (is_restriction_like ℓ M A) As.elems)
  , λ t, begin
    rcases t with ⟨ k, α, E, t ⟩,
    cases t,
    case com₂ : p p' B k eql eqp t {
      rcases upair.exists_rep p with ⟨ a, b, ep' ⟩, subst ep',

      simp only [upair.map_beta] at eqp, subst eqp, cases eqp,

      have : is_restriction_like ℓ M A (transition_from.mk t),
      {
        show option.is_some' (M.f a b),
        have : M.f a b = some k := eql,
        rw this, from true.intro,
      },

      have kdef : k = option.get' this := option.some.inj (trans eql.symm (option.eq_some_of_is_some' this)),
      subst kdef,

      let t' : is_restriction ℓ M A := ⟨ ⟨ _, _, _, t ⟩, this ⟩,
      have this := finset.mem_map_of_mem (is_restriction.embed ℓ M A)
        (finset.mem_subtype.mpr (@fintype.complete _ As t'.val)),
      unfold_coes at this,
      simp only [is_restriction.embed, is_restriction.lift, upair.rec_on_beta, is_restriction.name_lift] at this,

      from this,
    },
    case ν₁_species : l l' B eql t {
      have : is_restriction_like ℓ M A (transition_from.mk t),
      {
        cases l; simp only [label.rename] at eql; subst eql;
        simp only [transition_from.mk, is_restriction_like],

        rcases upair.exists_rep l_k with ⟨ a, b, ⟨ _ ⟩ ⟩,
        from true.intro,
      },
      let t' : is_restriction ℓ M A := ⟨ ⟨ _, _, _, t ⟩, this ⟩,
      have this := finset.mem_map_of_mem (is_restriction.embed ℓ M A)
        (finset.mem_subtype.mpr (@fintype.complete _ As t'.val)),
      unfold_coes at this,

      cases l,
      case label.spontaneous { simp only [label.rename] at eql, subst eql, from this },

      have up : ∀ (a b : name Γ), (quot.mk setoid.r (upair.pair.mk a b)) = upair.mk a b := λ a b, rfl,
      rcases quot.exists_rep l_k with ⟨ ⟨ a, b ⟩, h ⟩, rw up at h, subst h,
      simp only [label.rename, upair.map_beta] at eql, subst eql,

      simp only [is_restriction.embed, is_restriction.lift, upair.rec_on_beta, is_restriction.name_lift] at this,
      from this,
    },
    case ν₁_concretion : l l' b y B eql t {
      cases l, simp only [label.rename] at eql, subst eql,
      let t' : is_restriction ℓ M A := ⟨ ⟨ _, _, _, t ⟩, true.intro ⟩,
      from finset.mem_map_of_mem (is_restriction.embed ℓ M A)
        (finset.mem_subtype.mpr (@fintype.complete _ As t'.val)),
    }
  end ⟩

/-- Show that the available transitions from a species is finite and thus
    enumerable.-/
def enumerate :
  ∀ {Γ} (ℓ : lookup ℍ ω Γ) (A : species ℍ ω Γ)
  , fintype (transition_from ℓ A)
| Γ ℓ nil := enumerate_nil
| Γ ℓ (apply D as) := enumerate_apply ℓ D as
| Γ ℓ (A |ₛ B) := enumerate_parallel (enumerate ℓ A) (enumerate ℓ B)
| Γ ℓ (Σ# As) := enumerate_choices ℓ As
| Γ ℓ (ν(M) A) := enumerate_restriction ℓ M A (enumerate (lookup.rename name.extend ℓ) A)
using_well_founded {
  rel_tac := λ _ _,
    `[exact ⟨_, measure_wf (λ x, whole.sizeof _ _ _ _ x.2.2 ) ⟩ ],
  dec_tac := tactic.fst_dec_tac,
}

instance {Γ} (ℓ : lookup ℍ ω Γ) (A : species ℍ ω Γ)
  : fintype (transition_from ℓ A) := enumerate ℓ A

end transition
end cpi

#lint-