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

! This file was ported from Lean 3 source module init.meta.decl_cmds
! leanprover-community/mathlib commit b40f3af8018f0cc5811d5f56e4f9888877009b4f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Meta.Tactic
import Leanbin.Init.Meta.RbMap

open Tactic

open Native

private unsafe def apply_replacement (replacements : name_map Name) (e : expr) : expr :=
  e.replace fun e d =>
    match e with
    | expr.const n ls =>
      match replacements.find n with
      | some new_n => some (expr.const new_n ls)
      | none => none
    | _ => none
#align apply_replacement apply_replacement

/--
Given a set of constant renamings `replacements` and a declaration name `src_decl_name`, create a new
   declaration called `new_decl_name` s.t. its type is the type of `src_decl_name` after applying the
   given constant replacement.

   Remark: the new type must be definitionally equal to the type of `src_decl_name`.

   Example:
   Assume the environment contains
        def f : nat -> nat  := ...
        def g : nat -> nat  := f
        lemma f_lemma : forall a, f a > 0 := ...

   Moreover, assume we have a mapping M containing `f -> `g
   Then, the command
        run_command copy_decl_updating_type M `f_lemma `g_lemma
   creates the declaration
        lemma g_lemma : forall a, g a > 0 := ... -/
unsafe def copy_decl_updating_type (replacements : name_map Name) (src_decl_name : Name)
    (new_decl_name : Name) : Tactic := do
  let env ← get_env
  let decl ← env.get src_decl_name
  let decl := decl.update_name <| new_decl_name
  let decl := decl.update_type <| apply_replacement replacements decl.type
  let decl := decl.update_value <| expr.const src_decl_name (decl.univ_params.map level.param)
  add_decl decl
#align copy_decl_updating_type copy_decl_updating_type

unsafe def copy_decl_using (replacements : name_map Name) (src_decl_name : Name)
    (new_decl_name : Name) : Tactic := do
  let env ← get_env
  let decl ← env.get src_decl_name
  let decl := decl.update_name <| new_decl_name
  let decl := decl.update_type <| apply_replacement replacements decl.type
  let decl := decl.map_value <| apply_replacement replacements
  add_decl decl
#align copy_decl_using copy_decl_using


/-
File: signature_recover_public_key_fast_ec_add_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_unreduced_sqr_soundness
import .signature_recover_public_key_compute_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.fast_ec_add autogenerated soundness theorem -/

theorem auto_sound_fast_ec_add_block9
    -- An independent ap variable.
    (ap : F)
    -- arguments
    (range_check_ptr : F) (point0 point1 : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_fast_ec_add σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 317))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 305))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 285))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 269))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 97))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 15))
    (hin_point0 : point0 = cast_EcPoint mem (σ.fp - 14))
    (hin_point1 : point1 = cast_EcPoint mem (σ.fp - 8))
    (νbound : ℕ)
    -- conclusion
  : ensuresb_ret νbound mem
    {pc := σ.pc + 28, ap := ap, fp := σ.fp}
    (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 15)) (mem $ τ.ap - 7)
        (auto_spec_fast_ec_add_block9 mem κ range_check_ptr point0 point1 (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  have h_mem_rec := h_mem,
  unpack_memory code_fast_ec_add at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72, hpc73, hpc74, hpc75, hpc76, hpc77, hpc78, hpc79, hpc80, hpc81, hpc82, hpc83, hpc84, hpc85, hpc86⟩,
  -- function call
  step_assert_eq hpc28 with arg0,
  step_assert_eq hpc29 with arg1,
  step_assert_eq hpc30 with arg2,
  step_assert_eq hpc31 with arg3,
  step_assert_eq hpc32 with arg4,
  step_assert_eq hpc33 with arg5,
  step_assert_eq hpc34 with arg6,
  step_assert_eq hpc35 with arg7,
  step_assert_eq hpc36 with arg8,
  step_assert_eq hpc37 with arg9,
  step_assert_eq hpc38 with arg10,
  step_assert_eq hpc39 with arg11,
  step_assert_eq hpc40 with arg12,
  step_sub hpc41 (auto_sound_compute_slope mem _ range_check_ptr point0 point1 _ _ _ _ _ _ _),
  { rw hpc42, norm_num2, exact h_mem_13 },
  { rw hpc42, norm_num2, exact h_mem_4 },
  { rw hpc42, norm_num2, exact h_mem_5 },
  { rw hpc42, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call43 ap43 h_call43,
  rcases h_call43 with ⟨h_call43_ap_offset, h_call43⟩,
  rcases h_call43 with ⟨rc_m43, rc_mle43, hl_range_check_ptr₁, h_call43⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap43 - 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 (ap43 - 3) = slope,
  simp only [hr_rev_slope] at h_call43,
  have htv_slope := hr_rev_slope.symm, clear hr_rev_slope,
  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₁, ←hin_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_call43 },
  rw [hin_range_check_ptr] at h_call43,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
  -- function call
  step_sub hpc43 (auto_sound_unreduced_sqr mem _ slope _ _),
  { rw hpc44, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, htv_range_check_ptr₁, htv_slope] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { simp only [h_call43_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call45 ap45 h_call45,
  rcases h_call45 with ⟨h_call45_ap_offset, h_call45⟩,
  generalize' hr_rev_slope_sqr: cast_UnreducedBigInt3 mem (ap45 - 3) = slope_sqr,
  simp only [hr_rev_slope_sqr] at h_call45,
  have htv_slope_sqr := hr_rev_slope_sqr.symm, clear hr_rev_slope_sqr,
  clear ,
  -- function call
  step_assert_eq hpc45 with arg0,
  step_sub hpc46 (auto_sound_nondet_bigint3 mem _ range_check_ptr₁ _ _),
  { rw hpc47, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call48 ap48 h_call48,
  rcases h_call48 with ⟨h_call48_ap_offset, h_call48⟩,
  rcases h_call48 with ⟨rc_m48, rc_mle48, hl_range_check_ptr₂, h_call48⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap48 - 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 (ap48 - 3) = new_x,
  simp only [hr_rev_new_x] at h_call48,
  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_call45_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_call48 },
  try { rw [h_call45_ap_offset] at h_call48 }, try { arith_simps at h_call48 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call48,
  clear arg0,
  -- function call
  step_assert_eq hpc48 with arg0,
  step_sub hpc49 (auto_sound_nondet_bigint3 mem _ range_check_ptr₂ _ _),
  { rw hpc50, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call51 ap51 h_call51,
  rcases h_call51 with ⟨h_call51_ap_offset, h_call51⟩,
  rcases h_call51 with ⟨rc_m51, rc_mle51, hl_range_check_ptr₃, h_call51⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap51 - 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 (ap51 - 3) = new_y,
  simp only [hr_rev_new_y] at h_call51,
  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_call51 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call51,
  clear arg0,
  -- function call
  step_assert_eq hpc51 with arg0,
  step_assert_eq hpc52 with arg1,
  step_assert_eq hpc53 with arg2,
  step_assert_eq hpc54 with arg3,
  step_assert_eq hpc55 with arg4,
  step_assert_eq hpc56 with arg5,
  step_assert_eq hpc57 with arg6,
  step_assert_eq hpc58 with arg7,
  step_assert_eq hpc59 with arg8,
  step_assert_eq hpc60 with arg9,
  step_sub hpc61 (auto_sound_verify_zero mem _ range_check_ptr₃ {
    d0 := slope_sqr.d0 - new_x.d0 - point0.x.d0 - point1.x.d0,
    d1 := slope_sqr.d1 - new_x.d1 - point0.x.d1 - point1.x.d1,
    d2 := slope_sqr.d2 - new_x.d2 - point0.x.d2 - point1.x.d2
  } _ _ _),
  { rw hpc62, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), arg6, (eq_sub_of_eq_add arg7), (eq_sub_of_eq_add arg8), (eq_sub_of_eq_add arg9)] },
    try { simp only [h_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_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_point0, hin_point1, 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), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3), (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), arg6, (eq_sub_of_eq_add arg7), (eq_sub_of_eq_add arg8), (eq_sub_of_eq_add arg9)] },
      try { simp only [h_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call63 ap63 h_call63,
  rcases h_call63 with ⟨h_call63_ap_offset, h_call63⟩,
  rcases h_call63 with ⟨rc_m63, rc_mle63, hl_range_check_ptr₄, h_call63⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap63 - 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] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9] at h_call63 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call63,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9,
  -- function call
  step_assert_eq hpc63 with arg0,
  step_assert_eq hpc64 with arg1,
  step_assert_eq hpc65 with arg2,
  step_assert_eq hpc66 with arg3,
  step_assert_eq hpc67 with arg4,
  step_assert_eq hpc68 with arg5,
  step_sub hpc69 (auto_sound_unreduced_mul mem _ {
    d0 := point0.x.d0 - new_x.d0,
    d1 := point0.x.d1 - new_x.d1,
    d2 := point0.x.d2 - new_x.d2
  } slope _ _ _),
  { rw hpc70, norm_num2, exact h_mem_5 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset, h_call63_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_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset, h_call63_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call71 ap71 h_call71,
  rcases h_call71 with ⟨h_call71_ap_offset, h_call71⟩,
  generalize' hr_rev_x_diff_slope: cast_UnreducedBigInt3 mem (ap71 - 3) = x_diff_slope,
  simp only [hr_rev_x_diff_slope] at h_call71,
  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 hpc71 with arg0,
  step_assert_eq hpc72 with arg1,
  step_assert_eq hpc73 with arg2,
  step_assert_eq hpc74 with arg3,
  step_assert_eq hpc75 with arg4,
  step_assert_eq hpc76 with arg5,
  step_assert_eq hpc77 with arg6,
  step_sub hpc78 (auto_sound_verify_zero mem _ range_check_ptr₄ {
    d0 := x_diff_slope.d0 - point0.y.d0 - new_y.d0,
    d1 := x_diff_slope.d1 - point0.y.d1 - new_y.d1,
    d2 := x_diff_slope.d2 - point0.y.d2 - new_y.d2
  } _ _ _),
  { rw hpc79, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset, h_call63_ap_offset, h_call71_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_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset, h_call63_ap_offset, h_call71_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call80 ap80 h_call80,
  rcases h_call80 with ⟨h_call80_ap_offset, h_call80⟩,
  rcases h_call80 with ⟨rc_m80, rc_mle80, hl_range_check_ptr₅, h_call80⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap80 - 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_call71_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_call80 },
  try { rw [h_call71_ap_offset] at h_call80 }, try { arith_simps at h_call80 },
  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_call80,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- return
  step_assert_eq hpc80 with hret0,
  step_assert_eq hpc81 with hret1,
  step_assert_eq hpc82 with hret2,
  step_assert_eq hpc83 with hret3,
  step_assert_eq hpc84 with hret4,
  step_assert_eq hpc85 with hret5,
  step_ret hpc86,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m43+rc_m48+rc_m51+rc_m63+rc_m80+0+0), split,
  linarith [rc_mle43, rc_mle48, rc_mle51, rc_mle63, rc_mle80],
  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_fast_ec_add_block9],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call43],
  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 spec43 := h_call43 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec43,
  try { dsimp at spec43, arith_simps at spec43 },
  use_only [spec43],
  use_only [κ_call45],
  use_only [slope_sqr],
  try { dsimp at h_call45, arith_simps at h_call45 },
  try { use_only [h_call45] },
  use_only [κ_call48],
  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 spec48 := h_call48 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec48,
  try { dsimp at spec48, arith_simps at spec48 },
  use_only [spec48],
  use_only [κ_call51],
  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 spec51 := h_call51 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec51,
  try { dsimp at spec51, arith_simps at spec51 },
  use_only [spec51],
  use_only [κ_call63],
  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 spec63 := h_call63 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 spec63,
  try { dsimp at spec63, arith_simps at spec63 },
  use_only [spec63],
  use_only [κ_call71],
  use_only [x_diff_slope],
  try { dsimp at h_call71, arith_simps at h_call71 },
  try { use_only [h_call71] },
  use_only [κ_call80],
  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 spec80 := h_call80 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 spec80,
  try { dsimp at spec80, arith_simps at spec80 },
  use_only [spec80],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, 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_call43_ap_offset, h_call45_ap_offset, h_call48_ap_offset, h_call51_ap_offset, h_call63_ap_offset, h_call71_ap_offset, h_call80_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end

theorem auto_sound_fast_ec_add_block5
    -- An independent ap variable.
    (ap : F)
    -- arguments
    (range_check_ptr : F) (point0 point1 : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_fast_ec_add σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 317))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 305))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 285))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 269))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 97))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 15))
    (hin_point0 : point0 = cast_EcPoint mem (σ.fp - 14))
    (hin_point1 : point1 = 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 - 15)) (mem $ τ.ap - 7)
        (auto_spec_fast_ec_add_block5 mem κ range_check_ptr point0 point1 (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  have h_mem_rec := h_mem,
  unpack_memory code_fast_ec_add at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72, hpc73, hpc74, hpc75, hpc76, hpc77, hpc78, hpc79, hpc80, hpc81, hpc82, hpc83, hpc84, hpc85, hpc86⟩,
  -- if statement
  step_jnz hpc14 hpc15 with hcond hcond,
  {
    -- if: positive branch
    have a14 : point1.x.d0 = 0, {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      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 a14 }, try { arith_simps at a14 },
    clear hcond,
    -- if statement
    step_jnz hpc16 hpc17 with hcond hcond,
    {
      -- if: positive branch
      have a16 : point1.x.d1 = 0, {
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
        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 a16 }, try { arith_simps at a16 },
      clear hcond,
      -- if statement
      step_jnz hpc18 hpc19 with hcond hcond,
      {
        -- if: positive branch
        have a18 : point1.x.d2 = 0, {
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
          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 a18 }, try { arith_simps at a18 },
        clear hcond,
        -- return
        step_assert_eq hpc20 with hret0,
        step_assert_eq hpc21 with hret1,
        step_assert_eq hpc22 with hret2,
        step_assert_eq hpc23 with hret3,
        step_assert_eq hpc24 with hret4,
        step_assert_eq hpc25 with hret5,
        step_assert_eq hpc26 with hret6,
        step_ret hpc27,
        -- 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
        dsimp [auto_spec_fast_ec_add_block5],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a14],
        left,
        use_only [a16],
        left,
        use_only [a18],
        try { split, linarith },
        try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] }, },
        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 a18 : point1.x.d2 ≠ 0, {
          try { simp only [ne.def] },
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
          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 a18 }, try { arith_simps at a18 },
        clear hcond,
        -- Use the block soundness theorem.
        apply ensuresb_ret_trans (auto_sound_fast_ec_add_block9 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 νbound),
        intros κ_block9 τ, try { arith_simps },
        intro h_block9,
        rcases h_block9 with ⟨rc_m_block9, rc_m_le_block9, hblk_range_check_ptr₁, h_block9⟩,
        -- range check condition
        use_only (rc_m_block9+0+0), split,
        linarith [rc_m_le_block9],
        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
        dsimp [auto_spec_fast_ec_add_block5],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a14],
        left,
        use_only [a16],
        right,
        use_only [a18],
        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_block9' := h_block9 rc_h_range_check_ptr',
        try { rw [←hin_range_check_ptr] at h_block9' },
        try { dsimp at h_block9, arith_simps at h_block9' },
        have h_block9 := h_block9',
        use_only[κ_block9],
        use [h_block9],
        try { linarith }
      }
    },
    {
      -- if: negative branch
      have a16 : point1.x.d1 ≠ 0, {
        try { simp only [ne.def] },
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
        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 a16 }, try { arith_simps at a16 },
      clear hcond,
      -- Use the block soundness theorem.
      apply ensuresb_ret_trans (auto_sound_fast_ec_add_block9 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 νbound),
      intros κ_block9 τ, try { arith_simps },
      intro h_block9,
      rcases h_block9 with ⟨rc_m_block9, rc_m_le_block9, hblk_range_check_ptr₁, h_block9⟩,
      -- range check condition
      use_only (rc_m_block9+0+0), split,
      linarith [rc_m_le_block9],
      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
      dsimp [auto_spec_fast_ec_add_block5],
      try { norm_num1 }, try { arith_simps },
      left,
      use_only [a14],
      right,
      use_only [a16],
      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_block9' := h_block9 rc_h_range_check_ptr',
      try { rw [←hin_range_check_ptr] at h_block9' },
      try { dsimp at h_block9, arith_simps at h_block9' },
      have h_block9 := h_block9',
      use_only[κ_block9],
      use [h_block9],
      try { linarith }
    }
  },
  {
    -- if: negative branch
    have a14 : point1.x.d0 ≠ 0, {
      try { simp only [ne.def] },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      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 a14 }, try { arith_simps at a14 },
    clear hcond,
    -- Use the block soundness theorem.
    apply ensuresb_ret_trans (auto_sound_fast_ec_add_block9 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 νbound),
    intros κ_block9 τ, try { arith_simps },
    intro h_block9,
    rcases h_block9 with ⟨rc_m_block9, rc_m_le_block9, hblk_range_check_ptr₁, h_block9⟩,
    -- range check condition
    use_only (rc_m_block9+0+0), split,
    linarith [rc_m_le_block9],
    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
    dsimp [auto_spec_fast_ec_add_block5],
    try { norm_num1 }, try { arith_simps },
    right,
    use_only [a14],
    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_block9' := h_block9 rc_h_range_check_ptr',
    try { rw [←hin_range_check_ptr] at h_block9' },
    try { dsimp at h_block9, arith_simps at h_block9' },
    have h_block9 := h_block9',
    use_only[κ_block9],
    use [h_block9],
    try { linarith }
  }
end

theorem auto_sound_fast_ec_add
    -- arguments
    (range_check_ptr : F) (point0 point1 : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_fast_ec_add σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 317))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 305))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 285))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 269))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 97))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 15))
    (hin_point0 : point0 = cast_EcPoint mem (σ.fp - 14))
    (hin_point1 : point1 = cast_EcPoint mem (σ.fp - 8))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 15)) (mem $ τ.ap - 7)
        (spec_fast_ec_add mem κ range_check_ptr point0 point1 (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_fast_ec_add at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72, hpc73, hpc74, hpc75, hpc76, hpc77, hpc78, hpc79, hpc80, hpc81, hpc82, hpc83, hpc84, hpc85, hpc86⟩,
  -- if statement
  step_jnz hpc0 hpc1 with hcond hcond,
  {
    -- if: positive branch
    have a0 : point0.x.d0 = 0, {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      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 : point0.x.d1 = 0, {
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
        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 : point0.x.d2 = 0, {
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
          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_fast_ec_add mem _ range_check_ptr point0 point1 _ _,
        { apply sound_fast_ec_add, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_fast_ec_add],
        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_point0, hin_point1] }, },
        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 : point0.x.d2 ≠ 0, {
          try { simp only [ne.def] },
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
          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_fast_ec_add_block5 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 ν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_fast_ec_add mem _ range_check_ptr point0 point1 _ _,
        { apply sound_fast_ec_add, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_fast_ec_add],
        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 : point0.x.d1 ≠ 0, {
        try { simp only [ne.def] },
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
        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_fast_ec_add_block5 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 ν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_fast_ec_add mem _ range_check_ptr point0 point1 _ _,
      { apply sound_fast_ec_add, apply auto_spec },
      -- prove the auto generated assertion
      dsimp [auto_spec_fast_ec_add],
      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 : point0.x.d0 ≠ 0, {
      try { simp only [ne.def] },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1] },
      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_fast_ec_add_block5 mem σ _ range_check_ptr point0 point1 h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_13 hin_range_check_ptr hin_point0 hin_point1 ν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_fast_ec_add mem _ range_check_ptr point0 point1 _ _,
    { apply sound_fast_ec_add, apply auto_spec },
    -- prove the auto generated assertion
    dsimp [auto_spec_fast_ec_add],
    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 Lean

import Smt.Reconstruction.Certifying.Boolean
import Smt.Reconstruction.Certifying.Pull

namespace Smt.Reconstruction.Certifying

open Lean Elab.Tactic Meta

def congDupOr (i : Nat) (nm : Ident) (last : Bool) : TacticM Syntax :=
  match i with
  | 0 =>
    if last then `(dupOr₂ $nm)
    else `(dupOr $nm)
  | (i' + 1) => do
    let nm' := mkIdent (Name.mkSimple "w")
    let r ← congDupOr i' nm' last
    let r: Term := ⟨r⟩
    `(congOrLeft (fun $nm' => $r) $nm)

-- i: the index fixed in the original list
-- j: the index of li.head! in the original list
def loop (i j n : Nat) (pivot : Expr) (li : List Expr) (nm : Ident) : TacticM Ident :=
  match li with
  | [] => return nm
  | e::es =>
    if e == pivot then do
      -- step₁: move expr that is equal to the pivot to position i + 1
      let step₁ ←
        if j > i + 1 then
          let fname ← mkIdent <$> mkFreshId
          let e ← getTypeFromName nm.getId
          let t ← instantiateMVars e
          pullToMiddleCore (i + 1) j nm t fname
          pure fname
        else pure nm

      -- step₂: apply congOrLeft i times with dupOr
      let step₂: Ident ← do
        let last := i + 1 == n - 1
        let tactic ← congDupOr i step₁ last
        let tactic := ⟨tactic⟩
        let fname ← mkIdent <$> mkFreshId
        evalTactic (← `(tactic| have $fname := $tactic))
        pure fname

      loop i j (n - 1) pivot es step₂
    else loop i (j + 1) n pivot es nm

def factorCore (type : Expr) (source : Ident) (suffixIdx : Nat) : TacticM Unit :=
  withMainContext do
    let initialLength := getLength type
    let mut li := collectPropsInOrChain' suffixIdx type
    let n := li.length
    let mut answer := source
    for i in List.range n do
      li := List.drop i li
      match li with
      | [] => break
      | e::es => do
        answer ← loop i (i + 1) (li.length + i) e es answer
        let e ← getTypeFromName answer.getId
        let t ← instantiateMVars e
        let newLength := getLength t
        let propsDropped := initialLength - newLength
        li := collectPropsInOrChain' (suffixIdx - propsDropped) t
    evalTactic (← `(tactic| exact $answer))

syntax (name := factor) "factor" term (",")? (term)? : tactic

def parseFactor : Syntax → TacticM (Option Nat)
  | `(tactic| factor $_)     => pure none
  | `(tactic| factor $_, $i) => elabTerm i none >>= pure ∘ getNatLit?
  | _                        => throwError "[factor]: wrong usage"

@[tactic factor] def evalFactor : Tactic := fun stx => do
  /- let startTime ← IO.monoMsNow -/
  withMainContext do
    let e ← elabTerm stx[1] none
    let type ← inferType e
    let lastSuffix := getLength type - 1
    let source := ⟨stx[1]⟩
    let sufIdx :=
      match (← parseFactor stx) with
      | none => lastSuffix
      | some i => i
    factorCore type source sufIdx
  /- let endTime ← IO.monoMsNow -/
  /- logInfo m!"[factor] Time taken: {endTime - startTime}ms" -/

example : A ∨ A ∨ A ∨ A ∨ B ∨ A ∨ B ∨ A ∨ C ∨ B ∨ C ∨ B ∨ A → A ∨ B ∨ C :=
  by intro h
     factor h

example : (A ∨ B ∨ C) ∨ (A ∨ B ∨ C) → A ∨ B ∨ C := by
  intro h
  factor h, 1

example : (A ∨ B ∨ C) ∨ (E ∨ F) ∨ (A ∨ B ∨ C) ∨ (E ∨ F) → (A ∨ B ∨ C) ∨ (E ∨ F) := by
  intro h
  factor h, 3

end Smt.Reconstruction.Certifying


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.meta.smt.congruence_closure
import Mathlib.Lean3Lib.init.meta.attribute
import Mathlib.Lean3Lib.init.meta.simp_tactic
import Mathlib.Lean3Lib.init.meta.interactive_base
import Mathlib.Lean3Lib.init.meta.derive

universes l

namespace Mathlib

/-- Heuristic instantiation lemma -/
/-- `mk_core m e as_simp`, m is used to decide which definitions will be unfolded in patterns.
   If as_simp is tt, then this tactic will try to use the left-hand-side of the conclusion
   as a pattern. -/
/--
Create a new "cached" attribute (attr_name : user_attribute hinst_lemmas).
It also creates "cached" attributes for each attr_names and simp_attr_names if they have not been defined
yet. Moreover, the hinst_lemmas for attr_name will be the union of the lemmas tagged with
    attr_name, attrs_name, and simp_attr_names.
For the ones in simp_attr_names, we use the left-hand-side of the conclusion as the pattern.
-/
structure ematch_config where
  max_instances : ℕ
  max_generation : ℕ

end Mathlib


import for_mathlib.composable_morphisms
import algebra.homology.additive
import for_mathlib.homological_complex_map_d_to_d_from

noncomputable theory

open category_theory category_theory.category category_theory.limits

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

section

variables (C)

/- Category of complexes `X ⟶ Y ⟶ Z` -/
@[derive category]
def short_complex [has_zero_morphisms C] := { S : composable_morphisms C // S.zero }

variables {C}

namespace category_theory

namespace arrow

namespace hom

lemma congr_left {f g : arrow C} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : φ₁.left = φ₂.left := by rw h
lemma congr_right {f g : arrow C} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : φ₁.right = φ₂.right := by rw h

end hom

end arrow

end category_theory

end

open category_theory

namespace homological_complex

variables [has_zero_morphisms C] [has_zero_object C] {M : Type*} {c : complex_shape M}

lemma prev_id (X : homological_complex C c) (i : M) : hom.prev (𝟙 X) i = 𝟙 (X.X_prev i) :=
begin
  rcases h : c.prev i with _ | ⟨j,w⟩,
  { rw homological_complex.prev_eq_zero' _ i h,
    symmetry,
    rw ← limits.is_zero.iff_id_eq_zero,
    exact limits.is_zero.of_iso (limits.is_zero_zero _)
      (homological_complex.X_prev_iso_zero X h), },
  { rw homological_complex.hom.prev_eq _ w,
    simp only [homological_complex.hom.prev_eq _ w,
      homological_complex.id_f, id_comp, iso.hom_inv_id], },
end

lemma next_id (X : homological_complex C c) (i : M) : hom.next (𝟙 X) i = 𝟙 (X.X_next i) :=
arrow.hom.congr_right (hom.sq_from_id X i)

lemma prev_comp {X Y Z : homological_complex C c} (f : X ⟶ Y) (g : Y ⟶ Z)
  (i : M) : hom.prev (f ≫ g) i = hom.prev f i ≫ hom.prev g i :=
begin
  rcases h : c.prev i with _ | ⟨j,w⟩,
  { simp only [homological_complex.prev_eq_zero' _ i h, comp_zero], },
  { simp only [homological_complex.hom.prev_eq _ w, comp_f, assoc, iso.inv_hom_id_assoc], },
end

lemma next_comp {X Y Z : homological_complex C c} (f : X ⟶ Y) (g : Y ⟶ Z)
  (i : M) : hom.next (f ≫ g) i = hom.next f i ≫ hom.next g i :=
arrow.hom.congr_right (hom.sq_from_comp f g i)

end homological_complex

namespace short_complex

@[simp, reassoc]
lemma zero [has_zero_morphisms C] (S : short_complex C) : S.1.f ≫ S.1.g = 0 := S.2

@[simps]
def mk [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
  short_complex C := ⟨composable_morphisms.mk f g, zero⟩

@[simp]
lemma mk_id_τ₁ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₁ (𝟙 (mk f g zero)) = 𝟙 X := rfl
@[simp]
lemma mk_id_τ₂ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₂ (𝟙 (mk f g zero)) = 𝟙 Y := rfl
@[simp]
lemma mk_id_τ₃ [has_zero_morphisms C] {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (zero : f ≫ g = 0) :
composable_morphisms.hom.τ₃ (𝟙 (mk f g zero)) = 𝟙 Z := rfl

@[simp]
lemma comp_τ₁ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₁ = f.τ₁ ≫ g.τ₁ := rfl
@[simp]
lemma comp_τ₂ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₂ = f.τ₂ ≫ g.τ₂ := rfl
@[simp]
lemma comp_τ₃ [has_zero_morphisms C] {S₁ S₂ S₃ : short_complex C} (f : S₁ ⟶ S₂) (g : S₂ ⟶ S₃) :
  (f ≫ g).τ₃ = f.τ₃ ≫ g.τ₃ := rfl

@[simps]
def hom_mk [has_zero_morphisms C] {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} {f₁ : X₁ ⟶ Y₁} {g₁ : Y₁ ⟶ Z₁}
  {f₂ : X₂ ⟶ Y₂} {g₂ : Y₂ ⟶ Z₂} {zero₁ : f₁ ≫ g₁ = 0} {zero₂ : f₂ ≫ g₂ = 0}
  (τ₁ : X₁ ⟶ X₂) (τ₂ : Y₁ ⟶ Y₂) (τ₃ : Z₁ ⟶ Z₂) (comm₁₂ : f₁ ≫ τ₂ = τ₁ ≫ f₂)
  (comm₂₃ : g₁ ≫ τ₃ = τ₂ ≫ g₂) :
  mk f₁ g₁ zero₁ ⟶ mk f₂ g₂ zero₂ := ⟨τ₁, τ₂, τ₃, comm₁₂, comm₂₃⟩

@[simps]
def iso_mk [has_zero_morphisms C] {S₁ S₂ : short_complex C}
  (τ₁ : S₁.1.X ≅ S₂.1.X) (τ₂ : S₁.1.Y ≅ S₂.1.Y) (τ₃ : S₁.1.Z ≅ S₂.1.Z)
  (comm₁₂ : S₁.1.f ≫ τ₂.hom = τ₁.hom ≫ S₂.1.f)
  (comm₂₃ : S₁.1.g ≫ τ₃.hom = τ₂.hom ≫ S₂.1.g) :
  S₁ ≅ S₂ :=
{ hom := ⟨τ₁.hom, τ₂.hom, τ₃.hom, comm₁₂, comm₂₃⟩,
  inv := begin
    refine ⟨τ₁.inv, τ₂.inv, τ₃.inv, _, _⟩,
    { simp only [← cancel_mono τ₂.hom, ← cancel_epi τ₁.hom,
        assoc, iso.inv_hom_id, comp_id, iso.hom_inv_id_assoc, comm₁₂], },
    { simp only [← cancel_mono τ₃.hom, ← cancel_epi τ₂.hom,
        assoc, iso.inv_hom_id, comp_id, iso.hom_inv_id_assoc, comm₂₃], },
  end,
  hom_inv_id' := begin
    ext,
    { simpa only [comp_τ₁, hom_mk_τ₁, iso.hom_inv_id], },
    { simpa only [comp_τ₂, hom_mk_τ₂, iso.hom_inv_id], },
    { simpa only [comp_τ₃, hom_mk_τ₃, iso.hom_inv_id], },
  end,
  inv_hom_id' := begin
    ext,
    { simpa only [iso.inv_hom_id, comp_τ₁, hom_mk_τ₁], },
    { simpa only [iso.inv_hom_id, comp_τ₂, hom_mk_τ₂], },
    { simpa only [iso.inv_hom_id, comp_τ₃, hom_mk_τ₃], },
  end, }

lemma is_iso_of_is_isos [has_zero_morphisms C] {S₁ S₂ : short_complex C}
  (φ : S₁ ⟶ S₂) (h₁ : is_iso φ.τ₁) (h₂ : is_iso φ.τ₂) (h₃ : is_iso φ.τ₃) : is_iso φ :=
begin
  let e : S₁ ≅ S₂ := iso_mk (as_iso φ.τ₁) (as_iso φ.τ₂) (as_iso φ.τ₃) φ.comm₁₂ φ.comm₂₃,
  unfreezingI { rcases φ with ⟨τ₁, τ₂, τ₃, comm₁₂, comm₂₂⟩, },
  exact is_iso.of_iso e,
end

def homology [abelian C] (S : short_complex C) : C := homology S.1.f S.1.g S.2

@[simps]
def homology_functor [abelian C] : short_complex C ⥤ C :=
{ obj := λ X, X.homology,
  map := λ X Y φ, homology.map X.2 Y.2 ⟨φ.τ₁, φ.τ₂, φ.comm₁₂.symm⟩
    ⟨φ.τ₂, φ.τ₃, φ.comm₂₃.symm⟩ rfl,
  map_id' := λ X, by apply homology.map_id,
  map_comp' := λ X Y Z φ ψ, by { symmetry, apply homology.map_comp, }, }

variable (C)

@[simps]
def functor_homological_complex [has_zero_morphisms C] [has_zero_object C]
  {M : Type*} (c : complex_shape M) (i : M) :
  homological_complex C c ⥤ short_complex C :=
{ obj := λ X, mk (X.d_to i) (X.d_from i) (X.d_to_comp_d_from i),
  map := λ X Y f, composable_morphisms.hom.mk (f.prev i) (f.f i) (f.next i)
    (f.comm_to i).symm (f.comm_from i).symm,
  map_id' := λ X, begin
    ext,
    { exact X.prev_id i, },
    { refl, },
    { exact X.next_id i, },
  end,
  map_comp' := λ X Y Z f g, begin
    ext,
    { exact homological_complex.prev_comp f g i, },
    { refl, },
    { exact homological_complex.next_comp f g i, },
  end, }

@[simps]
def homology_functor_iso [abelian C] {M : Type*} (c : complex_shape M) (i : M) :
  _root_.homology_functor C c i ≅
  functor_homological_complex C c i ⋙ short_complex.homology_functor :=
nat_iso.of_components (λ X, iso.refl _)
  (λ X Y f, by { ext, simpa only [iso.refl_hom, id_comp, comp_id], })

end short_complex

namespace category_theory

namespace functor

@[simps]
def map_short_complex [has_zero_morphisms C] [has_zero_morphisms D] (F : C ⥤ D)
  [F.preserves_zero_morphisms] :
  short_complex C ⥤ short_complex D :=
full_subcategory.lift _ (induced_functor _ ⋙ F.map_composable_morphisms)
(λ X, begin
  have h := X.2,
  dsimp [composable_morphisms.zero] at h ⊢,
  rw [← F.map_comp, h, F.map_zero],
end)

end functor

namespace nat_trans

@[simps]
def map_short_complex [has_zero_morphisms C] [has_zero_morphisms D] {F G : C ⥤ D}
  [F.preserves_zero_morphisms] [G.preserves_zero_morphisms] (φ : F ⟶ G) :
  F.map_short_complex ⟶ G.map_short_complex :=
{ app := λ X, ⟨φ.app _, φ.app _, φ.app _, φ.naturality _, φ.naturality _⟩, }

end nat_trans

end category_theory

open category_theory

namespace short_complex

variable {C}

def functor_homological_complex_map [preadditive C] [has_zero_object C]
  [preadditive D] [has_zero_object D] (F : C ⥤ D) [F.additive]
  {M : Type*} (c : complex_shape M) (i : M) :
short_complex.functor_homological_complex C c i ⋙ F.map_short_complex ≅
F.map_homological_complex c ⋙ short_complex.functor_homological_complex D c i :=
nat_iso.of_components
  (λ X, iso_mk (F.obj_X_prev X i) (iso.refl _) ((F.obj_X_next X i))
    (by simpa only [iso.refl_hom, comp_id] using F.map_d_to X i)
    (by simpa only [iso.refl_hom, id_comp] using F.d_from_map X i))
  (λ X Y f, begin
    ext,
    { simp only [functor.comp_map, comp_τ₁, functor.map_short_complex_map_τ₁,
        functor_homological_complex_map_τ₁, iso_mk_hom_τ₁, F.map_prev], },
    { dsimp, simp only [comp_id, id_comp], },
    { simp only [functor.comp_map, comp_τ₃, functor.map_short_complex_map_τ₃,
        functor_homological_complex_map_τ₃, iso_mk_hom_τ₃, F.map_next], },
  end)

lemma naturality_functor_homological_complex_map [preadditive C] [has_zero_object C]
  [preadditive D] [has_zero_object D] {F G : C ⥤ D} [F.additive] [G.additive]
  {M : Type*} (c : complex_shape M) (i : M) (φ : F ⟶ G) (X : homological_complex C c) :
  (nat_trans.map_short_complex φ).app
    ((short_complex.functor_homological_complex C c i).obj X) ≫
    (short_complex.functor_homological_complex_map G c i).hom.app X =
  (short_complex.functor_homological_complex_map F c i).hom.app X ≫
    (short_complex.functor_homological_complex D c i).map
      ((nat_trans.map_homological_complex φ c).app X) :=
begin
  ext; dsimp [functor_homological_complex_map],
  { apply φ.map_prev, },
  { simp only [comp_id, id_comp], },
  { apply φ.map_next, },
end

end short_complex


import .lovelib

/-! # CS-VU Diversity and Support Information

When in doubt: Please be respectful and courteous to everyone!

* For class-related interactions: please come talk to the lecturer

* Talk to your study advisors to find resources and support information

* CS BETA diversity address to send your concerns/questions:
  diversity.cs.beta@vu.nl

* Department diversity office hours, every 3rd Monday of the month, 12-1pm
  (lunch hours)
  * STORM Diversity Committee (DiversityCie), diversitycie@storm.vu.nl
    * Student-led committee for promoting diversity in our faculty

* Support information:
  * Student well being:
    https://vu.nl/en/student/student-wellbeing
  * Safe social setting on campus
    https://vu.nl/en/about-vu/more-about/safe-social-setting-on-campus

* https://3d.vu.nl/ for diversity and support related issues at the VU level

# LoVe Preface

## Proof Assistants

Proof assistants (also called interactive theorem provers)

* check and help develop formal proofs;
* can be used to prove big theorems, not only logic puzzles;
* can be tedious to use;
* are highly addictive (think video games).

A selection of proof assistants, classified by logical foundations:

* set theory: Isabelle/ZF, Metamath, Mizar;
* simple type theory: HOL4, HOL Light, Isabelle/HOL;
* **dependent type theory**: Agda, Coq, **Lean**, Matita, PVS.

## Success Stories

Mathematics:

* the four-color theorem (in Coq);
* the Kepler conjecture (in HOL Light and Isabelle/HOL);
* the definition of perfectoid spaces (in Lean).

Computer science:

* hardware;
* operating systems;
* programming language theory;
* compilers;
* security.

## Lean

Lean is a proof assistant developed primarily by Leonardo de Moura (Microsoft
Research) since 2012.

Its mathematical library, `mathlib`, is developed under the leadership of
Jeremy Avigad (Carnegie Mellon University).

We use the community version of Lean 3. We use its basic libraries, `mathlib`,
and `LoVelib`. Lean is a research project.

Strengths:

* highly expressive logic based on a dependent type theory called the
  **calculus of inductive constructions**;
* extended with classical axioms and quotient types;
* metaprogramming framework;
* modern user interface;
* documentation;
* open source;
* endless source of puns (Lean Forward, Lean Together, Boolean, …).

## This Course

### Web Site

    https://lean-forward.github.io/logical-verification/2022/index.html

### Installation Instructions

    https://github.com/blanchette/logical_verification_2022/blob/main/README.md#logical-verification-2022---installation-instructions

### Repository (Demos, Exercises, Homework)

    https://github.com/blanchette/logical_verification_2022

The file you are currently looking at is a demo. There are

* 13 demo files;
* 13 exercise sheets;
* 11 homework sheets (10 points each);
* 1 project (20 points).

You may submit at most 10 homework, or at most 8 homework and the project.
Homework, including the project, must be done individually. The homework builds
on the exercises, which build on the demos.

### The Hitchhiker's Guide to Logical Verification

    https://github.com/blanchette/logical_verification_2022/blob/main/hitchhikers_guide.pdf
    https://github.com/blanchette/logical_verification_2022/blob/main/hitchhikers_guide_tablet.pdf

The lecture notes consist of a preface and 13 chapters. They cover the same
material as the corresponding lectures but with more details. Sometimes there
will not be enough time to cover everything in class, so reading the lecture
notes will be necessary.

### Final Exam

The course aims at teaching concepts, not syntax. Therefore, the final exam is
on paper. It is also closed book.

## Our Goal

We want you to

* master fundamental theory and techniques in interactive theorem proving;
* familiarize yourselves with some application areas;
* develop some practical skills you can apply on a larger project (as a hobby,
  for an MSc or PhD, or in industry);
* feel ready to move to another proof assistant and apply what you have learned;
* understand the domain well enough to start reading scientific papers.

This course is neither a pure logical foundations course nor a Lean tutorial.
Lean is our vehicle, not an end in itself.

# LoVe Demo 1: Definitions and Statements

We introduce the basics of Lean and proof assistants, without trying to carry
out actual proofs yet. We focus on specifying objects and statements of their
intended properties. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## A View of Lean

In a first approximation:

    Lean = functional programming + logic

In today's lecture, we cover inductive types, recursive functions, and lemma
statements.

If you are not familiar with typed functional programming (e.g., Haskell, ML,
OCaml, Scala), we recommend that you study a tutorial, such as the first
chapters of the online tutorial __Learn You a Haskell for Great Good!__:

    http://learnyouahaskell.com/chapters

Make sure to at least reach, and read, the section titled "Lambdas".

## Types and Terms

Similar to simply typed λ-calculus or typed functional programming languages
(ML, OCaml, Haskell).

Types `σ`, `τ`, `υ`:

* type variables `α`;
* basic types `T`;
* complex types `T σ1 … σN`.

Some type constructors `T` are written infix, e.g., `→` (function type).

The function arrow is right-associative:
`σ₁ → σ₂ → σ₃ → τ` = `σ₁ → (σ₂ → (σ₃ → τ))`.

Polymorphic types are also possible. In Lean, the type variables must be bound
using `∀`, e.g., `∀α, α → α`.

Terms `t`, `u`:

* constants `c`;
* variables `x`;
* applications `t u`;
* λ-expressions `λx, t`.

__Currying__: functions can be

* fully applied (e.g., `f x y z` if `f` is ternary);
* partially applied (e.g., `f x y`, `f x`);
* left unapplied (e.g., `f`).

Application is left-associative: `f x y z` = `((f x) y) z`. -/

#check ℕ
#check ℤ

#check empty
#check unit
#check bool

#check ℕ → ℤ
#check ℤ → ℕ
#check bool → ℕ → ℤ
#check (bool → ℕ) → ℤ
#check ℕ → (bool → ℕ) → ℤ

#check λx : ℕ, x
#check λf : ℕ → ℕ, λg : ℕ → ℕ, λh : ℕ → ℕ, λx : ℕ, h (g (f x))
#check λ(f g h : ℕ → ℕ) (x : ℕ), h (g (f x))

constants a b : ℤ
constant f : ℤ → ℤ
constant g : ℤ → ℤ → ℤ

#check λx : ℤ, g (f (g a x)) (g x b)
#check λx, g (f (g a x)) (g x b)

#check λx, x

constant trool : Type
constants trool.true trool.false trool.maybe : trool

/-! ### Type Checking and Type Inference

Type checking and type inference are decidable problems (although this property is
quickly lost if features such as overloading or subtyping are added).

Type judgment: `C ⊢ t : σ`, meaning `t` has type `σ` in local context `C`.

Typing rules:

    —————————— Cst   if c is declared with type σ
    C ⊢ c : σ

    —————————— Var   if x : σ is the last occurrence of x in C
    C ⊢ x : σ

    C ⊢ t : σ → τ    C ⊢ u : σ
    ——————————————————————————— App
    C ⊢ t u : τ

    C, x : σ ⊢ t : τ
    ———————————————————————— Lam
    C ⊢ (λx : σ, t) : σ → τ

### Type Inhabitation

Given a type `σ`, the __type inhabitation__ problem consists of finding a term
of that type. Type inhabitation is undecidable.

Recursive procedure:

1. If `σ` is of the form `τ → υ`, a candidate inhabitant is an anonymous
   function of the form `λx, _`.

2. Alternatively, you can use any constant or variable `x : τ₁ → ⋯ → τN → σ` to
   build the term `x _ … _`. -/

constants α β γ : Type

def some_fun_of_type : (α → β → γ) → ((β → α) → β) → α → γ :=
λf g a, f a (g (λb, a))

/-! ## Type Definitions

An __inductive type__ (also called __inductive datatype__,
__algebraic datatype__, or just __datatype__) is a type that consists all the
values that can be built using a finite number of applications of its
__constructors__, and only those.

### Natural Numbers -/

namespace my_nat

/-! Definition of type `nat` (= `ℕ`) of natural numbers, using Peano-style unary
notation: -/

inductive nat : Type
| zero : nat
| succ : nat → nat

#check nat
#check nat.zero
#check nat.succ

end my_nat

#print nat
#print ℕ

/-! ### Arithmetic Expressions -/

inductive aexp : Type
| num : ℤ → aexp
| var : string → aexp
| add : aexp → aexp → aexp
| sub : aexp → aexp → aexp
| mul : aexp → aexp → aexp
| div : aexp → aexp → aexp

/-! ### Lists -/

namespace my_list

inductive list (α : Type) : Type
| nil  : list
| cons : α → list → list

#check list.nil
#check list.cons

end my_list

#print list

/-! ## Function Definitions

The syntax for defining a function operating on an inductive type is very
compact: We define a single function and use __pattern matching__ to extract the
arguments to the constructors. -/

def add : ℕ → ℕ → ℕ
| m nat.zero     := m
| m (nat.succ n) := nat.succ (add m n)

#eval add 2 7
#reduce add 2 7

def mul : ℕ → ℕ → ℕ
| _ nat.zero     := nat.zero
| m (nat.succ n) := add m (mul m n)

#eval mul 2 7

#print mul
#print mul._main

def power : ℕ → ℕ → ℕ
| _ nat.zero     := 1
| m (nat.succ n) := mul m (power m n)

#eval power 2 5

def power₂ (m : ℕ) : ℕ → ℕ
| nat.zero     := 1
| (nat.succ n) := mul m (power₂ n)

#eval power₂ 2 5

def iter (α : Type) (z : α) (f : α → α) : ℕ → α
| nat.zero     := z
| (nat.succ n) := f (iter n)

#check iter

def power₃ (m n : ℕ) : ℕ :=
iter ℕ 1 (λl, mul m l) n

#eval power₃ 2 5

def append (α : Type) : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append xs ys)

#check append
#eval append _ [3, 1] [4, 1, 5]

def append₂ {α : Type} : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append₂ xs ys)

#check append₂
#eval append₂ [3, 1] [4, 1, 5]

#check @append₂
#eval @append₂ _ [3, 1] [4, 1, 5]

/-! Aliases:

    `[]`          := `nil`
    `x :: xs`     := `cons x xs`
    `[x₁, …, xN]` := `x₁ :: … :: xN :: []` -/

def append₃ {α : Type} : list α → list α → list α
| []        ys := ys
| (x :: xs) ys := x :: append₃ xs ys

def reverse {α : Type} : list α → list α
| []        := []
| (x :: xs) := reverse xs ++ [x]

def eval (env : string → ℤ) : aexp → ℤ
| (aexp.num i)     := i
| (aexp.var x)     := env x
| (aexp.add e₁ e₂) := eval e₁ + eval e₂
| (aexp.sub e₁ e₂) := eval e₁ - eval e₂
| (aexp.mul e₁ e₂) := eval e₁ * eval e₂
| (aexp.div e₁ e₂) := eval e₁ / eval e₂

#eval eval (λs, 7) (aexp.div (aexp.var "x") (aexp.num 0))

/-! Lean only accepts the function definitions for which it can prove
termination. In particular, it accepts __structurally recursive__ functions,
which peel off exactly one constructor at a time.

## Lemma Statements

Notice the similarity with `def` commands. -/

namespace sorry_lemmas

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
sorry

lemma add_assoc (l m n : ℕ) :
  add (add l m) n = add l (add m n) :=
sorry

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

lemma mul_add (l m n : ℕ) :
  mul l (add m n) = add (mul l m) (mul l n) :=
sorry

lemma reverse_reverse {α : Type} (xs : list α) :
  reverse (reverse xs) = xs :=
sorry

/-! Axioms are like lemmas but without proofs (`:= …`). Constant declarations
are like definitions but without bodies (`:= …`). -/

constants a b : ℤ

axiom a_less_b :
  a < b

end sorry_lemmas

end LoVe


import Lean
import LeanCodePrompts.Translate

open Lean Server Lsp RequestM

partial def String.Iterator.findFirst? : String.Iterator → String → Option String.Pos
  | i, pre => if i.hasNext then
    if i.remainingToString.startsWith pre then
      some i.pos
    else
      i.next.findFirst? pre
  else none

def String.Range.expand : String.Range → Nat → String.Range
  | ⟨start, stop⟩, i => ⟨start - ⟨i⟩, stop + ⟨i⟩⟩

/-- Finds the comment or doc-string in the source nearest to the given position. -/
partial def nearestComment? (source : String)
  (pos : String.Pos) (start : String.Pos := ⟨0⟩) : Option String.Range := do
    guard $ start ≤ pos
    let firstCommentRange ← findFirstComment? source start
    if (firstCommentRange.expand 2).contains pos then
      some firstCommentRange
    else
      nearestComment? source pos (source.next firstCommentRange.stop)
  where findFirstComment? (source : String) (init : String.Pos) : Option String.Range := do
    let start ← (String.Iterator.mk source init).findFirst? "/-"
    let stop ← (String.Iterator.mk source start).findFirst? "-/"
    return ⟨start, stop + ⟨2⟩⟩

/-- Extracts the text contained in a comment. -/
def extractCommentText (comment : String) : Option String := do
  guard $ comment.startsWith "/-"
  guard $ comment.endsWith "-/"
  let text := comment |>.drop 2 |>.dropRight 2
  let c := text.front
  if c.isAlphanum || c.isWhitespace then
    return text
  else
    return text.drop 1

/-
open Parser.Command in
def Syntax.extractComment : Syntax → Option String
  | `($doc:docComment ) => getDocStringText doc
  | _ => none

#check getDocStringText
-/

/-- A code action for translating doc-strings to Lean code using OpenAI Codex -/
@[codeActionProvider] def formaliseDocStr : CodeActionProvider := fun params snap => do
  let doc ← readDoc
  let text := doc.meta.text
  let source := text.source

  -- the current position in the text document
  let lspPos : Lsp.Position := params.range.end
  -- The position from which to start searching for a comment (by default, five lines above the given position)
  let lspBeginPos : Lsp.Position := ⟨lspPos.line - 5, 0⟩
  let pos : String.Pos := text.lspPosToUtf8Pos lspPos
  let beginPos : String.Pos := text.lspPosToUtf8Pos lspBeginPos
  let comment? := nearestComment? source pos beginPos

  let edit : IO TextEdit := do
    let some ⟨start, stop⟩ := comment? | throw $ IO.userError "No input found."
    return {
    range := ⟨text.leanPosToLspPos <| text.toPosition start, text.leanPosToLspPos <| text.toPosition stop⟩
    newText := ← do
      -- the smallest node of the `InfoTree` containing the current position
      let info? := snap.infoTree.findInfo? (·.contains pos)
      -- the `Syntax` corresponding to the `Info` node
      let stx? := (·.stx) <$> info?

      -- the statement to be translated to Lean code
      let stmt? : Option String :=
        (none /- TODO: First attempt to parse using `Syntax` -/)  <|>
        ( /- Parse as a string -/
          let comment := source.extract start stop
          extractCommentText comment
        )

      let translation' := snap.runTermElabM doc.meta <| translateViewM stmt?.get!
      let translation ← EIO.toIO (λ _ => IO.userError "Translation failed.") translation'
      return formatAsTheorem stmt? translation
  }

  let ca : CodeAction := {
    title := "Translate theorem docstring to Lean code",
    kind? := "quickfix",
    disabled? :=
      match comment? with
        | .some _ => none
        | .none => some ⟨"No nearby comments available."⟩ }
  return #[{ eager := ca, lazy? := some $ return {ca with edit? := WorkspaceEdit.ofTextEdit params.textDocument.uri $ ← edit} }]
where
  formatAsTheorem : Option String → String → String
    | some comment, type => s!"/-{comment}-/\nexample : {type.trim} := by sorry"
    |     none    , type => s!"\nexample : {type.trim} := by sorry"

-- @[codeActionProvider] def informaliseThm : CodeActionProvider := fun params snap => do
--   let doc ← readDoc
--   let text := doc.meta.text
--   let source := text.source

--   let edit : IO TextEdit := do
--     -- the current position in the text document
--     let pos : String.Pos := text.lspPosToUtf8Pos params.range.end
--     return {
--     range := params.range
--     newText := ← do
--       -- the smallest node of the `InfoTree` containing the current position
--       let info? := snap.infoTree.findInfo? (·.contains pos)
--       -- the `Syntax` corresponding to the `Info` node
--       let stx? := (·.stx) <$> info?

--       -- the statement to be translated to Lean code
--       let thm? : Option String := stx? >>= Syntax.reprint

--       let translation' := snap.runTermElabM doc.meta <| statementToDoc thm?.get!
--       let translation ← EIO.toIO (λ _ => IO.userError "Translation failed.") translation'
--       return "/--" ++ translation ++ "-/\n"
--   }

--   let ca : CodeAction := { title := "Add a docstring to a Lean theorem", kind? := "quickfix" }
--   return #[{ eager := ca, lazy? := some $ return {ca with edit? := WorkspaceEdit.ofTextEdit params.textDocument.uri $ ← edit} }]

-- open RequestM in
-- @[codeActionProvider]
-- def readFile : CodeActionProvider := fun params _snap => do
--   let doc ← readDoc
--   let text := doc.meta.text
--   let source := text.source
--   let pos := text.lspPosToUtf8Pos params.range.end
--   let edit : TextEdit := {
--     range := params.range
--     newText :=
--       let tail := Substring.mk source pos source.endPos
--       let tail := tail.toString.splitOn "/-" |>.head!
--       "/- " ++ tail ++ "-/"
--   }
--   let ca : CodeAction := {title := "tail of source", kind? := "quickfix"}
--   return #[{eager := ca, lazy? := some $ return { ca with edit? := WorkspaceEdit.ofTextEdit params.textDocument.uri edit}}]

/-

example : 1 = 1 := by
  simp
-/


import data.dlist
import separation.specification

import tactic.monotonicity
import util.meta.tactic

universes u v

namespace tactic.interactive

open applicative
open lean.parser
open interactive
open interactive.types
open tactic functor list nat separation

local postfix `?`:9001 := optional
local postfix *:9001 := many

@[user_attribute]
meta def ptr_abstraction : user_attribute :=
{ name  := `ptr_abstraction
, descr := "Abstraction predicate for pointer structures" }

meta def mk_sep_assert : list expr → expr
 | [] := `(emp)
 | (e :: []) := e
 | (e :: es) := `(%%e :*: %%(mk_sep_assert es))

meta inductive assert_with_vars
 | s_and : assert_with_vars → assert_with_vars → assert_with_vars
 | s_exists : expr → assert_with_vars → assert_with_vars
 | leaf : expr → assert_with_vars
 | prop : expr → assert_with_vars
open predicate
meta def parse_assert_with_vars : expr → tactic assert_with_vars
 | `(s_and %%e₀ %%e₁) := assert_with_vars.s_and <$> parse_assert_with_vars e₀
                                                <*> parse_assert_with_vars e₁
 | `(p_exists %%e) :=
   do `(λ _ : %%t, %%e') ← pure e,
      assert_with_vars.s_exists t <$> parse_assert_with_vars e'
 | `([| %%e |]) :=
   return $ assert_with_vars.prop e
 | e := return $ assert_with_vars.leaf e

meta def assert_with_vars.to_expr : assert_with_vars → pexpr
 | (assert_with_vars.leaf e) := to_pexpr e
 | (assert_with_vars.prop e) :=  ``([| %%e |])
 | (assert_with_vars.s_and e₀ e₁) := ``(%%(e₀.to_expr) :*: %%(e₁.to_expr))
 | (assert_with_vars.s_exists t e) := ``(p_exists %%(expr.lam `x binder_info.default (to_pexpr t) e.to_expr))

meta def hexists_to_meta_var (rules : list simp_arg_type)
: list expr → assert_with_vars → tactic (assert_with_vars × expr)
 | vs (assert_with_vars.s_and e₀ e₁) :=
   do (x₀,p₀) ← hexists_to_meta_var vs e₀,
      (x₁,p₁) ← hexists_to_meta_var vs e₁,
      let x := assert_with_vars.s_and x₀ x₁,
      prod.mk x <$> to_expr ``(s_and_s_imp_s_and %%p₀ %%p₁)
 | vs (assert_with_vars.s_exists t e) :=
   do v ← mk_meta_var t,
      (x,p) ← hexists_to_meta_var (v :: vs) e,
      let x := assert_with_vars.s_exists t x,
      q ← expr.lam `x binder_info.default t <$> to_expr e.to_expr,
      prod.mk x <$> to_expr ``(@s_exists_intro _ _ %%q %%v %%p)
 | vs (assert_with_vars.prop e) :=
   do let x := assert_with_vars.leaf `(emp),
      p ← mk_meta_var e,
      prod.mk x <$> to_expr ``(s_imp_of_eq (eq.symm (embed_eq_emp %%p)))
 | vs (assert_with_vars.leaf e) :=
   do let e' := e.instantiate_vars vs.reverse,
      (r,u) ← mk_simp_set tt [] rules,
      (e'',p) ← conv.convert (conv.interactive.simp tt rules []
        { fail_if_unchanged := ff }) e',
      ast ← parse_assert_with_vars e'' ,
      (assert_with_vars.leaf _) ← pure ast | (do
        (x,p') ← hexists_to_meta_var [] ast,
        prod.mk x <$> to_expr ``(s_imp_trans _  %%p' (s_imp_of_eq (eq.symm %%p)))),
      prod.mk ast <$> to_expr ``(s_imp_of_eq (eq.symm %%p))

meta def parse_sep_assert' : expr → tactic (dlist expr)
 | `(%%e₀ :*: %%e₁) := (++) <$> parse_sep_assert' e₀ <*> parse_sep_assert' e₁
 | e := return $ dlist.singleton e

meta def parse_sep_assert : expr → tactic (list expr) :=
map dlist.to_list ∘ parse_sep_assert'

meta def match_sep' (unif : bool)
: list expr → list expr → tactic (list expr × list expr × list expr)
 | es (x :: xs) := do
    es' ← delete_expr { unify := unif } x es,
    match es' with
     | (some es') := do
       (c,l,r) ← match_sep' es' xs, return (x::c,l,r)
     | none := do
       (c,l,r) ← match_sep' es xs, return (c,l,x::r)
    end
 | es [] := do
return ([],es,[])

/--
`(common,left,right) ← match_sep unif l r` finds the commonalities
between `l` and `r` and returns the differences  -/
meta def match_sep (unif : bool) (l : list expr) (r : list expr)
: tactic (list expr × list expr × list expr) :=
do (s',l',r') ← match_sep' unif l r,
   s' ← mmap instantiate_mvars s',
   l' ← mmap instantiate_mvars l',
   r' ← mmap instantiate_mvars r',
   return (s',l',r')

def expr_pat (t₀ t₁ : Type) : ℕ → Type
 | 0 := t₁
 | (succ n) := t₀ → expr_pat n

def tuple : ℕ → Type → Type
 | 0 _ := unit
 | 1 t := t
 | (succ n) t := t × tuple n t

meta def match_expr : ∀ (n : ℕ) (p : expr_pat expr pexpr n) (e : expr), tactic (tuple n expr)
  | 0 p e := to_expr p >>= unify e
  | 1 p e := do v ← mk_mvar, match_expr 0 (p v) e, instantiate_mvars v
  | (succ (succ n)) p e := do
v ← mk_mvar,
r ← match_expr (succ n) (p v) e,
e ← instantiate_mvars v,
return (e,r)

meta def reshuffle (e₀ e₁ : expr) : tactic unit := do
t ← target,
(t₀,t₁) ← match_eq t,
h₀ ← to_expr ``(%%t₀ = %%e₀) >>= assert `h₀,
solve1 ac_refl,
h₁ ← to_expr ``(%%t₁ = %%e₁) >>= assert `h₁,
solve1 admit,
`[rw h₀],
`[rw h₁],
tactic.clear h₀, tactic.clear h₁

meta def find_match (pat : expr) : expr → list expr → tactic expr
 | e rest := do
(unify e pat >> return (mk_sep_assert rest))
<|>
(do hprop ← to_expr ``(hprop),
    lv ← mk_meta_var hprop,
    rv ← mk_meta_var hprop,
    to_expr ``(%%lv :*: %%rv) >>= unify e,
      -- this unification could be generalized to:
      -- (le,re) ← match_pat (λ p₀ p₁, ``(%%p₀ :*: %%p₁))
    le ← instantiate_mvars lv,
    re ← instantiate_mvars rv,
    (find_match le (re :: rest) <|> find_match re (le :: rest)))
<|>
do p ← pp pat,
   e ← pp e,
   fail $ to_fmt "no match found for `" ++ p ++ to_fmt "` in: \n`" ++ e ++ to_fmt "`"

meta def sep_goal : tactic (expr × expr × expr) := do
g ← target,
t  ← to_expr ``(hprop),
e₀ ← mk_meta_var t,
e₂ ← mk_meta_var t,
e₃ ← mk_meta_var t,
pat ← to_expr ``(%%e₀ = %%e₂ :*: %%e₃) >>= unify g,
prod.mk <$> instantiate_mvars e₀
        <*> (prod.mk <$> instantiate_mvars e₂
                     <*> instantiate_mvars e₃)

/-- Apply on a goal of the form
    ``x = y :*: m?``
    with m? a meta variable. The goal is to decompose `x` into a conjunction
    made of an occurrence of `y` (anywhere).
 -/
meta def match_assert : tactic unit := do
(hp,pat,var) ← sep_goal,
e ← find_match pat hp [],
unify e var,
tactic.target >>= instantiate_mvars >>= tactic.change,
try `[simp] >> ac_refl

/-- apply on a goal of the form `sat p spec` -/
meta def extract_context_aux (h : name) (subst_flag : bool) : tactic unit :=
do `[apply precondition _],
   swap,
  `[symmetry],
   solve1 (do
   --  cxt ← mk_meta_var `(Prop),
     (hp,pat,var) ← sep_goal,
     to_expr ``( [| _ |] ) >>= unify pat,
     e ← find_match pat hp [],
     unify e var,
     tactic.target >>= instantiate_mvars >>= tactic.change,
     try `[simp],
     try ac_refl),
   `[apply context_left],
   x ← tactic.intro h,
   when subst_flag $ try (tactic.subst x),
   return ()

meta def subst_flag := (tk "with" *> tk "subst" *> pure tt) <|> return ff

meta def extract_context
: parse ident* → ∀ (x : parse subst_flag), tactic unit
 | [] x := return ()
 | (h :: hs) x := extract_context_aux h x >> extract_context hs x

meta def match_sep_imp : expr → tactic (expr × expr)
 | `(%%e₀ =*> %%e₁) := return (e₀, e₁)
 | _ := fail "expression is not an sep implication"

meta def intro_unit (v : parse ident_?) : tactic unit :=
do e ← match v with
       | none := intro1
       | (some v) := tactic.intro v
       end,
   t ← infer_type e,
   if t = `(unit)
   then () <$ tactic.cases e
   else return ()

meta def simp_ptr_abstr : tactic unit :=
do abs ← attribute.get_instances `ptr_abstraction,
   abs' ← mmap (map simp_arg_type.expr ∘ resolve_name) abs,
   try (dsimp tt abs' [] (loc.ns [none])),
   try `[simp [s_and_s_exists_distr,s_exists_s_and_distr]
       { fail_if_unchanged := ff }]

meta def ac_match' : tactic unit :=
do abs ← attribute.get_instances `ptr_abstraction
           >>= mmap (map simp_arg_type.expr ∘ resolve_name),
   try (simp none tt abs [] (loc.ns [none])),
   try `[simp [s_and_s_exists_distr,s_exists_s_and_distr]
       { fail_if_unchanged := ff }],
   repeat `[apply s_exists_elim, intro_unit],
   repeat `[apply s_exists_intro],
   try (unfold_projs (loc.ns [])),
   done <|> focus1 (do
     repeat `[rw [embed_eq_emp],
     simp { fail_if_unchanged := ff } ],
     all_goals (try assumption)),
   done <|> (do
     solve1 (do
       try `[apply s_imp_of_eq],
       t ← target,
       (e₀,e₁) ← match_eq t,
       e₀ ← parse_sep_assert e₀,
       e₁ ← parse_sep_assert e₁,
       (c,l,r) ← match_sep ff e₀ e₁,
       (c',l',r') ← match_sep tt l r,
       (c'',l',r') ← match_sep tt l' r',
       let ll := l'.length,
       let rl := r'.length,
       let l'' := l' ++ list.repeat `(emp) (rl - ll),
       h ← assert `h `(%%(mk_sep_assert l'') = (%%(mk_sep_assert r') : hprop)),
       solve1 tactic.reflexivity,
       target >>= instantiate_mvars >>= tactic.change,
       try `[simp { fail_if_unchanged := ff }],
       try `[rw s_and_comm, try { refl }],
       try ac_refl))

meta def ac_match : tactic unit := do
ac_match'

example (e₁ e₂ e₃ : hprop)
: e₁ :*: e₂ :*: e₃ = e₂ :*: e₃ :*: e₁ :=
begin
  ac_mono1,
  exact @rfl _ emp
end

def replicate {m : Type u → Type v} [monad m] {α} : ℕ → m α → m (list α)
 | 0 _ := return []
 | (succ n) m := lift₂ cons m (replicate n m)

private meta def get_pi_expl_arity_aux (t : expr) : expr → expr → tactic expr
| e r := do
(unify t e >> instantiate_mvars r)
<|>
match e with
| (expr.pi n bi d b) :=
  do m ← mk_fresh_name,
--     let l := expr.local_const m n bi d,
     l ← mk_meta_var d,
     new_b ← instantiate_mvars (expr.instantiate_var b l),

     if binder_info.default = bi
     then get_pi_expl_arity_aux new_b (r l)
     else get_pi_expl_arity_aux new_b r
| e := instantiate_mvars r
end

/-- Compute the arity of the given (Pi-)type -/
meta def get_pi_expl_arity (target e : expr) : tactic expr := do
t ← infer_type e,
get_pi_expl_arity_aux target t e

meta def s_exists1 (v : parse ident) : tactic unit := do
`[ simp [s_exists_s_and_distr,s_and_s_exists_distr] { fail_if_unchanged := ff }
 , apply s_exists_intro_pre],
intro v, return ()

meta def s_exists (vs : parse ident*) : tactic unit :=
mmap' s_exists1 vs

meta def s_intros : parse ident* → parse subst_flag → tactic unit
 | [] _ := return ()
 | (x :: xs) sbst := do
v ← tactic.try_core (s_exists1 x),
match v with
 | (some _) := s_intros xs sbst
 | none := extract_context (x :: xs) sbst
end

meta def decide : tactic unit := do
solve1 $ do
 `[apply of_as_true],
 triv

meta def bind_step (spec_thm : parse texpr? ) (ids : parse with_ident_list) : tactic unit :=
do g ← target,
   (hd,tl,spec) ← (match_expr 3 (λ e₀ e₁ s, ``(sat (%%e₀ >>= %%e₁) %%s)) g
                : tactic (expr × expr × expr)),
   let (cmd,args) := hd.get_app_fn_args,
   let s : option _ := spec_thm,
   e ← (resolve_name (cmd.const_name <.> "spec") >>= to_expr) <| (to_expr <$> s),
   r ← to_expr ``(sat _ _),
   e' ← get_pi_expl_arity r e,
   `[apply (bind_framing_left _ %%e')],
   solve1 (try `[simp [s_and_assoc]] >> try ac_match'),
   all_goals (try `[apply of_as_true, apply trivial]),
   (v,ids) ← return $ match ids with
                  | [] := (none,[])
                  | (id :: ids) := (some id, ids)
                 end,
   intro_unit v, `[simp],
   s_intros ids tt

open option

meta def simp_h_entails : tactic unit :=
do `(%%p =*> %%q) ← target,
   r ← parse_assert_with_vars q,
   abs ← attribute.get_instances `ptr_abstraction,
   abs' ← mmap (map (simp_arg_type.expr ∘ to_pexpr) ∘ resolve_name) abs,
   (_,p) ← hexists_to_meta_var abs' [] r,
   h ← mk_meta_var `(hprop),
   g ← mk_mvar,
   p' ← to_expr ``(s_imp_trans %%h %%g %%p),
   t ← target,
   infer_type p' >>= unify t,
   gs ← get_goals,

   set_goals [g],
   (applyc `separation.s_imp_of_eq >> ac_match'),
   done,
   set_goals gs,
   () <$ tactic.apply p' { new_goals := new_goals.non_dep_only }

meta def last_step' (s : parse texpr?) : tactic unit :=
solve1 $
do `(sat %%hd %%spec) ← target,
   let (cmd,args) := hd.get_app_fn_args,
   e ← (resolve_name (cmd.const_name <.> "spec") >>= to_expr) <| (to_expr <$> s),
   r ← to_expr ``(sat _ _),
   e' ← get_pi_expl_arity r e,
   p₀ ← mk_mvar,
   p₁ ← mk_mvar,
   r ← to_expr ``(framing_spec' _ %%e' %%p₀ %%p₁),
   t ← target,
   infer_type r >>= unify t,
   gs ← get_goals,
   set_goals [p₀],
   simp_h_entails,
   all_goals (try $ `[apply of_as_true, apply trivial] <|> solve_by_elim),
   done,
   set_goals [p₁],
   intro1,
   simp_h_entails,
   all_goals (try $ `[apply of_as_true, apply trivial] <|> solve_by_elim),
   done,
   set_goals gs,
   tactic.apply r,
   return ()

meta def last_step (spec : parse texpr?) : tactic unit :=
do last_step' spec,
   solve1 (do
      try `[simp [s_and_assoc]],
      ac_match') <|> fail "first solve1",
   solve1 (do
      intro_unit `_,
      ac_match',
      all_goals (try assumption)) <|> fail "second solve1",
   all_goals (try $ `[apply of_as_true, apply trivial] <|> solve_by_elim)

-- meta def himp_zoom : tactic unit :=
-- do `(%%lhs =*> %%rhs) ← target | failed,
--    ls ← parse_sep_assert lhs,
--    rs ← parse_sep_assert rhs,
--    (s,l,r) ← match_sep ff ls rs,
--    let s' := mk_sep_assert s,
--    let lhs' := mk_sep_assert (l ++ s),
--    let rhs' := mk_sep_assert (r ++ s),
--    h   ← to_expr ``(%%(mk_sep_assert l) =*> %%(mk_sep_assert r))
--       >>= assert `h,
--    tactic.swap,
--    prf ← to_expr ``(s_and_s_imp_s_and_right %%(mk_sep_assert s) %%h),
--    note `h none prf,
--    return ()

example (e₁ e₂ e₃ e₄ e₅ e₆ : hprop)
  (h : e₃ :*: e₁ :*: e₅ :*: e₄ =*> e₆)
: e₃ :*: e₁ :*: e₅ :*: e₂ :*: e₄ =*> e₂ :*: e₆ :=
begin
  ac_mono1,
  solve_by_elim
end

example (e₁ e₂ e₃ e₄ e₅ e₆ : hprop)
  (h : e₁ :*: e₅ :*: e₄ =*> emp)
: e₃ :*: e₁ :*: e₅ :*: e₂ :*: e₄ =*> e₂ :*: e₃ :=
begin
  ac_mono1,
  solve_by_elim
end

end tactic.interactive


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

The writer monad transformer for passing immutable state.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.monad.basic
import Mathlib.algebra.group.basic
import Mathlib.PostPort

universes u v l u_1 u_2 u_3 u₀ u₁ v₀ v₁

namespace Mathlib

structure writer_t (ω : Type u) (m : Type u → Type v) (α : Type u) where
  run : m (α × ω)

def writer (ω : Type u) (α : Type u) := writer_t ω id

namespace writer_t

protected theorem ext {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} (x : writer_t ω m α)
    (x' : writer_t ω m α) (h : run x = run x') : x = x' :=
  sorry

protected def tell {ω : Type u} {m : Type u → Type v} [Monad m] (w : ω) : writer_t ω m PUnit :=
  mk (pure (PUnit.unit, w))

protected def listen {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} :
    writer_t ω m α → writer_t ω m (α × ω) :=
  sorry

protected def pass {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} :
    writer_t ω m (α × (ω → ω)) → writer_t ω m α :=
  sorry

protected def pure {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} [HasOne ω] (a : α) :
    writer_t ω m α :=
  mk (pure (a, 1))

protected def bind {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} {β : Type u} [Mul ω]
    (x : writer_t ω m α) (f : α → writer_t ω m β) : writer_t ω m β :=
  mk
    (do
      let x ← run x
      let x' ← run (f (prod.fst x))
      pure (prod.fst x', prod.snd x * prod.snd x'))

protected instance monad {ω : Type u} {m : Type u → Type v} [Monad m] [HasOne ω] [Mul ω] :
    Monad (writer_t ω m) :=
  sorry

protected instance is_lawful_monad {ω : Type u} {m : Type u → Type v} [Monad m] [monoid ω]
    [is_lawful_monad m] : is_lawful_monad (writer_t ω m) :=
  sorry

protected def lift {ω : Type u} {m : Type u → Type v} [Monad m] {α : Type u} [HasOne ω] (a : m α) :
    writer_t ω m α :=
  mk (flip Prod.mk 1 <$> a)

protected instance has_monad_lift {ω : Type u} (m : Type u → Type u_1) [Monad m] [HasOne ω] :
    has_monad_lift m (writer_t ω m) :=
  has_monad_lift.mk fun (α : Type u) => writer_t.lift

protected def monad_map {ω : Type u} {m : Type u → Type u_1} {m' : Type u → Type u_2} [Monad m]
    [Monad m'] {α : Type u} (f : {α : Type u} → m α → m' α) : writer_t ω m α → writer_t ω m' α :=
  fun (x : writer_t ω m α) => mk (f (run x))

protected instance monad_functor {ω : Type u} (m : Type u → Type u_1) (m' : Type u → Type u_1)
    [Monad m] [Monad m'] : monad_functor m m' (writer_t ω m) (writer_t ω m') :=
  monad_functor.mk writer_t.monad_map

protected def adapt {ω : Type u} {m : Type u → Type v} [Monad m] {ω' : Type u} {α : Type u}
    (f : ω → ω') : writer_t ω m α → writer_t ω' m α :=
  fun (x : writer_t ω m α) => mk (prod.map id f <$> run x)

protected instance monad_except {ω : Type u} {m : Type u → Type v} [Monad m]
    (ε : outParam (Type u_1)) [HasOne ω] [Monad m] [monad_except ε m] :
    monad_except ε (writer_t ω m) :=
  monad_except.mk (fun (α : Type u) => writer_t.lift ∘ throw)
    fun (α : Type u) (x : writer_t ω m α) (c : ε → writer_t ω m α) =>
      mk (catch (run x) fun (e : ε) => run (c e))

end writer_t

/--
An implementation of [MonadReader](
https://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Reader-Class.html#t:MonadReader).
It does not contain `local` because this function cannot be lifted using `monad_lift`.
Instead, the `monad_reader_adapter` class provides the more general `adapt_reader` function.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader (ρ : out_param (Type u)) (n : Type u → Type u) :=
(lift {α : Type u} : (∀ {m : Type u → Type u} [monad m], reader_t ρ m α) → n α)
```
-/
class monad_writer (ω : outParam (Type u)) (m : Type u → Type v) where
  tell : ω → m PUnit
  listen : {α : Type u} → m α → m (α × ω)
  pass : {α : Type u} → m (α × (ω → ω)) → m α

protected instance writer_t.monad_writer {ω : Type u} {m : Type u → Type v} [Monad m] :
    monad_writer ω (writer_t ω m) :=
  monad_writer.mk writer_t.tell (fun (α : Type u) => writer_t.listen)
    fun (α : Type u) => writer_t.pass

protected instance reader_t.monad_writer {ω : Type u} {ρ : Type u} {m : Type u → Type v} [Monad m]
    [monad_writer ω m] : monad_writer ω (reader_t ρ m) :=
  monad_writer.mk (fun (x : ω) => monad_lift (monad_writer.tell x))
    (fun (α : Type u) (_x : reader_t ρ m α) => sorry)
    fun (α : Type u) (_x : reader_t ρ m (α × (ω → ω))) => sorry

def swap_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} : (α × β) × γ → (α × γ) × β := sorry

protected instance state_t.monad_writer {ω : Type u} {σ : Type u} {m : Type u → Type v} [Monad m]
    [monad_writer ω m] : monad_writer ω (state_t σ m) :=
  monad_writer.mk (fun (x : ω) => monad_lift (monad_writer.tell x))
    (fun (α : Type u) (_x : state_t σ m α) => sorry)
    fun (α : Type u) (_x : state_t σ m (α × (ω → ω))) => sorry

def except_t.pass_aux {ε : Type u_1} {α : Type u_2} {ω : Type u_3} :
    except ε (α × (ω → ω)) → except ε α × (ω → ω) :=
  sorry

protected instance except_t.monad_writer {ω : Type u} {ε : Type u} {m : Type u → Type v} [Monad m]
    [monad_writer ω m] : monad_writer ω (except_t ε m) :=
  monad_writer.mk (fun (x : ω) => monad_lift (monad_writer.tell x))
    (fun (α : Type u) (_x : except_t ε m α) => sorry)
    fun (α : Type u) (_x : except_t ε m (α × (ω → ω))) => sorry

def option_t.pass_aux {α : Type u_1} {ω : Type u_2} : Option (α × (ω → ω)) → Option α × (ω → ω) :=
  sorry

protected instance option_t.monad_writer {ω : Type u} {m : Type u → Type v} [Monad m]
    [monad_writer ω m] : monad_writer ω (option_t m) :=
  monad_writer.mk (fun (x : ω) => monad_lift (monad_writer.tell x))
    (fun (α : Type u) (_x : option_t m α) => sorry)
    fun (α : Type u) (_x : option_t m (α × (ω → ω))) => sorry

/-- Adapt a monad stack, changing the type of its top-most environment.

This class is comparable to
[Control.Lens.Magnify](https://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Zoom.html#t:Magnify),
but does not use lenses (why would it), and is derived automatically for any transformer
implementing `monad_functor`.

Note: This class can be seen as a simplification of the more "principled" definition
```
class monad_reader_functor (ρ ρ' : out_param (Type u)) (n n' : Type u → Type u) :=
(map {α : Type u} : (∀ {m : Type u → Type u} [monad m], reader_t ρ m α → reader_t ρ' m α) → n α → n' α)
```
-/
class monad_writer_adapter (ω : outParam (Type u)) (ω' : outParam (Type u)) (m : Type u → Type v)
    (m' : Type u → Type v)
    where
  adapt_writer : {α : Type u} → (ω → ω') → m α → m' α

/-- Transitivity.

This instance generates the type-class problem with a metavariable argument (which is why this
is marked as `[nolint dangerous_instance]`).
Currently that is not a problem, as there are almost no instances of `monad_functor` or
`monad_writer_adapter`.

see Note [lower instance priority] -/
protected instance monad_writer_adapter_trans {ω : Type u} {ω' : Type u} {m : Type u → Type v}
    {m' : Type u → Type v} {n : Type u → Type v} {n' : Type u → Type v}
    [monad_writer_adapter ω ω' m m'] [monad_functor m m' n n'] : monad_writer_adapter ω ω' n n' :=
  monad_writer_adapter.mk
    fun (α : Type u) (f : ω → ω') => monad_map fun (α : Type u) => adapt_writer f

protected instance writer_t.monad_writer_adapter {ω : Type u} {ω' : Type u} {m : Type u → Type v}
    [Monad m] : monad_writer_adapter ω ω' (writer_t ω m) (writer_t ω' m) :=
  monad_writer_adapter.mk fun (α : Type u) => writer_t.adapt

protected instance writer_t.monad_run (ω : Type u) (m : Type u → Type (max u u_1))
    (out : outParam (Type u → Type (max u u_1))) [monad_run out m] :
    monad_run (fun (α : Type u) => out (α × ω)) (writer_t ω m) :=
  monad_run.mk fun (α : Type u) (x : writer_t ω m α) => run (writer_t.run x)

/-- reduce the equivalence between two writer monads to the equivalence between
their underlying monad -/
def writer_t.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁} {α₁ : Type u₀} {ω₁ : Type u₀}
    {α₂ : Type u₁} {ω₂ : Type u₁} (F : m₁ (α₁ × ω₁) ≃ m₂ (α₂ × ω₂)) :
    writer_t ω₁ m₁ α₁ ≃ writer_t ω₂ m₂ α₂ :=
  equiv.mk (fun (_x : writer_t ω₁ m₁ α₁) => sorry) (fun (_x : writer_t ω₂ m₂ α₂) => sorry) sorry
    sorry

end Mathlib