/-
File: signature_recover_public_key_ec_mul_soundness.lean

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

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

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

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

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


/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.Lean.Expr.Basic

/-!

# The `#help` command

The `#help` command can be used to list all definitions in a variety of extensible aspects of lean.

* `#help option` lists options (used in `set_option myOption`)
* `#help attr` lists attributes (used in `@[myAttr] def foo := ...`)
* `#help cats` lists syntax categories (like `term`, `tactic`, `stx` etc)
* `#help cat C` lists elements of syntax category C
  * `#help term`, `#help tactic`, `#help conv`, `#help command`
    are shorthand for `#help cat term` etc.
  * `#help cat+ C` also shows `elab` and `macro` definitions associated to the syntaxes

All forms take an optional identifier to narrow the search; for example `#help option pp` shows
only `pp.*` options.

-/

namespace Mathlib.Tactic
open Lean Meta Elab Tactic Command

/--
The command `#help option` shows all options that have been defined in the current environment.
Each option has a format like:
```
option pp.all : Bool := false
  (pretty printer) display coercions, implicit parameters, proof terms, fully qualified names,
  universe, and disable beta reduction and notations during pretty printing
```
This says that `pp.all` is an option which can be set to a `Bool` value, and the default value is
`false`. If an option has been modified from the default using e.g. `set_option pp.all true`,
it will appear as a `(currently: true)` note next to the option.

The form `#help option id` will show only options that begin with `id`.
-/
elab "#help" &"option" id:(ident)? : command => do
  let id := id.map (·.getId.toString false)
  let mut decls : Lean.RBMap _ _ compare := {}
  for (name, decl) in show Lean.RBMap .. from ← getOptionDecls do
    let name := name.toString false
    if let some id := id then
      if !id.isPrefixOf name then
        continue
    decls := decls.insert name decl
  let mut msg := Format.nil
  let opts ← getOptions
  if decls.isEmpty then
    match id with
    | some id => throwError "no options start with {id}"
    | none => throwError "no options found (!)"
  for (name, decl) in decls do
    let mut msg1 := match decl.defValue with
    | .ofString val => s!"String := {repr val}"
    | .ofBool val => s!"Bool := {repr val}"
    | .ofName val => s!"Name := {repr val}"
    | .ofNat val => s!"Nat := {repr val}"
    | .ofInt val => s!"Int := {repr val}"
    | .ofSyntax val => s!"Syntax := {repr val}"
    if let some val := opts.find name then
      msg1 := s!"{msg1}  (currently: {val})"
    msg := msg ++ .nest 2 (f!"option {name} : {msg1}" ++ .line ++ decl.descr) ++ .line ++ .line
  logInfo msg

/--
The command `#help attribute` (or the short form `#help attr`) shows all attributes that have been
defined in the current environment.
Each option has a format like:
```
[inline]: mark definition to always be inlined
```
This says that `inline` is an attribute that can be placed on definitions like
`@[inline] def foo := 1`. (Individual attributes may have restrictions on where they can be
applied; see the attribute's documentation for details.) Both the attribute's `descr` field as well
as the docstring will be displayed here.

The form `#help attr id` will show only attributes that begin with `id`.
-/
elab "#help" (&"attr" <|> &"attribute") id:(ident)? : command => do
  let id := id.map (·.getId.toString false)
  let mut decls : Lean.RBMap _ _ compare := {}
  for (name, decl) in ← attributeMapRef.get do
    let name := name.toString false
    if let some id := id then
      if !id.isPrefixOf name then
        continue
    decls := decls.insert name decl
  let mut msg := Format.nil
  let env ← getEnv
  if decls.isEmpty then
    match id with
    | some id => throwError "no attributes start with {id}"
    | none => throwError "no attributes found (!)"
  for (name, decl) in decls do
    let mut msg1 := s!"[{name}]: {decl.descr}"
    if let some doc ← findDocString? env decl.ref then
      msg1 := s!"{msg1}\n{doc.trim}"
    msg := msg ++ .nest 2 msg1 ++ .line ++ .line
  logInfo msg

/-- Gets the initial string token in a parser description. For example, for a declaration like
`syntax "bla" "baz" term : tactic`, it returns `some "bla"`. Returns `none` for syntax declarations
that don't start with a string constant. -/
partial def getHeadTk (e : Expr) : Option String :=
  match e.getAppFnArgs with
  | (``ParserDescr.node, #[_, _, p]) => getHeadTk p
  | (``ParserDescr.unary, #[.app _ (.lit (.strVal "withPosition")), p]) => getHeadTk p
  | (``ParserDescr.unary, #[.app _ (.lit (.strVal "atomic")), p]) => getHeadTk p
  | (``ParserDescr.binary, #[.app _ (.lit (.strVal "andthen")), p, _]) => getHeadTk p
  | (``ParserDescr.nonReservedSymbol, #[.lit (.strVal tk), _]) => some tk
  | (``ParserDescr.symbol, #[.lit (.strVal tk)]) => some tk
  | (``Parser.withAntiquot, #[_, p]) => getHeadTk p
  | (``Parser.leadingNode, #[_, _, p]) => getHeadTk p
  | (``HAndThen.hAndThen, #[_, _, _, _, p, _]) => getHeadTk p
  | (``Parser.nonReservedSymbol, #[.lit (.strVal tk), _]) => some tk
  | (``Parser.symbol, #[.lit (.strVal tk)]) => some tk
  | _ => none

/--
The command `#help cats` shows all syntax categories that have been defined in the
current environment.
Each syntax has a format like:
```
category command [Lean.Parser.initFn✝]
```
The name of the syntax category in this case is `command`, and `Lean.Parser.initFn✝` is the
name of the declaration that introduced it. (It is often an anonymous declaration like this,
but you can click to go to the definition.) It also shows the doc string if available.

The form `#help cats id` will show only syntax categories that begin with `id`.
-/
elab "#help" &"cats" id:(ident)? : command => do
  let id := id.map (·.getId.toString false)
  let mut decls : Lean.RBMap _ _ compare := {}
  for (name, cat) in (Parser.parserExtension.getState (← getEnv)).categories do
    let name := name.toString false
    if let some id := id then
      if !id.isPrefixOf name then
        continue
    decls := decls.insert name cat
  let mut msg := MessageData.nil
  let env ← getEnv
  if decls.isEmpty then
    match id with
    | some id => throwError "no syntax categories start with {id}"
    | none => throwError "no syntax categories found (!)"
  for (name, cat) in decls do
    let mut msg1 := m!"category {name} [{mkConst cat.declName}]"
    if let some doc ← findDocString? env cat.declName then
      msg1 := msg1 ++ Format.line ++ doc.trim
    msg := msg ++ .nest 2 msg1 ++ (.line ++ .line : Format)
  logInfo msg

/--
The command `#help cat C` shows all syntaxes that have been defined in syntax category `C` in the
current environment.
Each syntax has a format like:
```
syntax "first"... [Parser.tactic.first]
  `first | tac | ...` runs each `tac` until one succeeds, or else fails.
```
The quoted string is the leading token of the syntax, if applicable. It is followed by the full
name of the syntax (which you can also click to go to the definition), and the documentation.

* The form `#help cat C id` will show only attributes that begin with `id`.
* The form `#help cat+ C` will also show information about any `macro`s and `elab`s
  associated to the listed syntaxes.
-/
elab "#help" &"cat" more:"+"? catStx:ident id:(ident <|> str)? : command => do
  let id := id.map fun id ↦ match id.raw with
    | .ident _ _ v _ => v.toString false
    | id => id.isStrLit?.get!
  let mut decls : Lean.RBMap _ _ compare := {}
  let mut rest : Lean.RBMap _ _ compare := {}
  let catName := catStx.getId.eraseMacroScopes
  let some cat := (Parser.parserExtension.getState (← getEnv)).categories.find? catName
    | throwErrorAt catStx "{catStx} is not a syntax category"
  liftTermElabM <| Term.addCategoryInfo catStx catName
  let env ← getEnv
  for (k, _) in cat.kinds do
    let mut used := false
    if let some tk := do getHeadTk (← (← env.find? k).value?) then
      let tk := tk.trim
      if let some id := id then
        if !id.isPrefixOf tk then
          continue
      used := true
      decls := decls.insert tk ((decls.findD tk #[]).push k)
    if !used && id.isNone then
      rest := rest.insert (k.toString false) k
  let mut msg := MessageData.nil
  if decls.isEmpty && rest.isEmpty then
    match id with
    | some id => throwError "no {catName} declarations start with {id}"
    | none => throwError "no {catName} declarations found"
  let env ← getEnv
  let addMsg (k : SyntaxNodeKind) (msg msg1 : MessageData) : CommandElabM MessageData := do
    let mut msg1 := msg1
    if let some doc ← findDocString? env k then
      msg1 := msg1 ++ Format.line ++ doc.trim
    msg1 := .nest 2 msg1
    if more.isSome then
      let addElabs {α} (type : String) (attr : KeyedDeclsAttribute α)
          (msg : MessageData) : CommandElabM MessageData := do
        let mut msg := msg
        for e in attr.getEntries env k do
          let x := e.declName
          msg := msg ++ Format.line ++ m!"+ {type} {mkConst x}"
          if let some doc ← findDocString? env x then
            msg := msg ++ .nest 2 (Format.line ++ doc.trim)
        pure msg
      msg1 ← addElabs "macro" macroAttribute msg1
      match catName with
      | `term => msg1 ← addElabs "term elab" Term.termElabAttribute msg1
      | `command => msg1 ← addElabs "command elab" commandElabAttribute msg1
      | `tactic | `conv => msg1 ← addElabs "tactic elab" tacticElabAttribute msg1
      | _ => pure ()
    return msg ++ msg1 ++ (.line ++ .line : Format)
  for (name, ks) in decls do
    for k in ks do
      msg ← addMsg k msg m!"syntax {repr name}... [{mkConst k}]"
  for (_, k) in rest do
    msg ← addMsg k msg m!"syntax ... [{mkConst k}]"
  logInfo msg

/--
The command `#help term` shows all term syntaxes that have been defined in the current environment.
See `#help cat` for more information.
-/
macro "#help" tk:&"term" more:"+"? id:(ident <|> str)? : command =>
  `(#help cat$[+%$more]? $(mkIdentFrom tk `term) $(id.map (⟨·.raw⟩))?)

/--
The command `#help tactic` shows all tactics that have been defined in the current environment.
See `#help cat` for more information.
-/
macro "#help" tk:&"tactic" more:"+"? id:(ident <|> str)? : command => do
  `(#help cat$[+%$more]? $(mkIdentFrom tk `tactic) $(id.map (⟨·.raw⟩))?)

/--
The command `#help conv` shows all tactics that have been defined in the current environment.
See `#help cat` for more information.
-/
macro "#help" tk:&"conv" more:"+"? id:(ident <|> str)? : command =>
  `(#help cat$[+%$more]? $(mkIdentFrom tk `conv) $(id.map (⟨·.raw⟩))?)

/--
The command `#help command` shows all commands that have been defined in the current environment.
See `#help cat` for more information.
-/
macro "#help" tk:&"command" more:"+"? id:(ident <|> str)? : command =>
  `(#help cat$[+%$more]? $(mkIdentFrom tk `command) $(id.map (⟨·.raw⟩))?)


import Straume.Chunk
import Straume.Coco
import Straume.Flood
import Straume.Iterator
import Straume.Zeptoparsec

open Straume.Chunk (Chunk Terminable coreturn)
open Straume.Coco (Coco)
open Straume.Flood (Flood)
open Straume.Iterator (Iterable iter)
open Straume.Iterator (Bijection)
open Zeptoparsec renaming Parsec → Zepto.Parsec
open Zeptoparsec renaming ParseResult → Zepto.Res

/-
  This module is designed first and foremost to provide Megaparsec users
  with a way to work with greater-than-RAM and infinite streams.
-/
namespace Straume.Aka

universe u
universe v

-- class Stream (S : Type) where
--   Token : Type
--   ordToken : Ord Token
--   Chunk \a : Type
--   ordChunk \a : Ord Chunk \a
--   tokenToChunk : Token → Chunk \a
--   tokensToChunk : List Token → Chunk \a
--   chunkToChunk \a : Chunk \a → List Token
--   chunkLength : Chunk \a → Nat
--   take1 : S → Option (Token × S)
--   takeN : Nat → S → Option (Chunk \a × S)
--   takeWhile : (Token → Bool) → S → (Chunk \a × S)

-------------------------------
----         takeN         ----
-------------------------------

def takeN {f : Type u → Type u} {α β : Type u}
          (n : Nat) (src : s) (b : Nat := 2048)
          [Coco α s] [Flood m s] [Terminable f] [Monad m] [Iterable α β]
          : m (f α × s) := do
  -- BEST EFFORT
  let l := Iterable.length (Coco.coco src : α)
  let srcₑ ← Flood.flood src $ max b ((n - l) + 1) -- We expand the buffer
  -- EXTRACTION
  let it₀ := iter $ Coco.coco srcₑ
  let it₁ := { it₀ with i := n }
  let firstN := Iterable.extract it₀ it₁
  -- CHUNK PREPARATION
  let k := Iterable.length $ it₀.s
  let res :=
    if k == 0 && l == 0
    then Terminable.mkNil -- Expansion unsuccessful => Stream was always empty
    else match k - n with
      | 0 => Terminable.mkFin firstN -- We expanded to less than `n`
      | _otherwise => Terminable.mkCont firstN
  pure (res, Coco.replace srcₑ $ Iterable.extract it₁ { it₁ with i := k })

-------------------------------
----         take1         ----
-------------------------------

-- We use `takeN` to snip off `α` of length 1 and then use
-- `Iterable` to take the first (and only) element.
def take1 {f : Type u → Type u} {α β : Type u}
          (src : s) (b := 2048)
          [Coco α s] [Flood m s] [Terminable f] [Monad m]
          [Iterable α β] [Bijection β α] : m ((f β) × s) :=
  takeN 1 src b >>= fun ((y : f α), s₁) =>
    pure ((Iterable.curr ∘ iter) <$> y, s₁)

-------------------------------
----       takeWhile       ----
-------------------------------

private partial def takeWhileDo
    {f : Type u → Type u} {α β : Type u}
    (φ : β → Bool) (stream₀ : s) (b : Nat) (acc : f α)
    [Coco α s] [Iterable α β] [Terminable f] [Monad m]
    [Inhabited (m (f α × s))] [Inhabited α] [Flood m s]
    : m (f α × s) := do
  let ((atom : f β), stream) ← take1 stream₀ b
  match Terminable.un atom with
  | .none => pure (acc, stream₀)
  | .some c =>
    if φ c then
      match (Terminable.reason acc, Terminable.reason atom) with
      -- cont cases
      | (.none, .none) =>
        takeWhileDo φ stream b $
          Terminable.mkCont $ Iterable.push (coreturn acc) c
      -- fin cases
      | (.none, .some ()) =>
        pure (Terminable.mkFin $ Iterable.push (coreturn acc) c, stream)
      -- nil case
      | _otherwise => pure (acc, stream₀)
    else
      pure (acc, stream₀)

partial def takeWhile
    {f : Type u → Type u} {α β : Type u}
    (φ : β → Bool) (src : s) (b : Nat := 2048)
    [Coco α s] [Iterable α β] [Terminable f] [Monad m]
    [Inhabited (m (f α × s))] [Inhabited α] [Flood m s]
    : m (f α × s) :=
  takeWhileDo φ src b Terminable.mkNil

open Straume.Combinators

-------------------------------
----      chunkLength      ----
-------------------------------

def chunkLength (fx : f α) [Terminable f] [Iterable α β] : Nat :=
  match (Terminable.un fx) with
  | .none => 0
  | .some e => Iterable.length e

def storeLength (fx : f α) [Terminable f] [Iterable α β] : f Nat :=
  Iterable.length <$> fx

-------------------------------
----       Aka class       ----
-------------------------------

/-
  A way to read atomic values `v` out of a source `s`,
  which emits `Iterable α v`.
  The information about finality is tacked onto the values of type `v`
  via type `f`.
  An example of such `f` is `Chunk`.
-/
class Aka (m : Type u → Type v)
          (s : Type u)
          (f : Type u → Type u)
          (v : Type u) where
                        -- TODO: Can we express _buffer > 0 in types?
  take1 (_source : s) (_buffer : Nat := 2048) : m ((f v) × s)

instance : Aka IO (String × IO.FS.Handle) Chunk Char where
  take1 src b := take1 src b


example : 1 = 2 := calc
  _ = _ := sorry

example : 1 = 2 :=
  calc
  _ = _ := sorry

example : 1 = 2 := by calc
  _ = _ := sorry

example : 1 = 2 := by
  calc
  _ = _ := sorry


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Transform
import Lean.Meta.CongrTheorems
import Lean.Meta.Tactic.Replace
import Lean.Meta.Tactic.Util
import Lean.Meta.Tactic.Clear
import Lean.Meta.Tactic.Simp.Types
import Lean.Meta.Tactic.Simp.Rewrite

namespace Lean.Meta
namespace Simp

builtin_initialize congrHypothesisExceptionId : InternalExceptionId ←
  registerInternalExceptionId `congrHypothesisFailed

def throwCongrHypothesisFailed : MetaM α :=
  throw <| Exception.internal congrHypothesisExceptionId

def Result.getProof (r : Result) : MetaM Expr := do
  match r.proof? with
  | some p => return p
  | none   => mkEqRefl r.expr

private def mkEqTrans (r₁ r₂ : Result) : MetaM Result := do
  match r₁.proof? with
  | none => return r₂
  | some p₁ => match r₂.proof? with
    | none    => return { r₂ with proof? := r₁.proof? }
    | some p₂ => return { r₂ with proof? := (← Meta.mkEqTrans p₁ p₂) }

def mkCongrFun (r : Result) (a : Expr) : MetaM Result :=
  match r.proof? with
  | none   => return { expr := mkApp r.expr a, proof? := none }
  | some h => return { expr := mkApp r.expr a, proof? := (← Meta.mkCongrFun h a) }

def mkCongr (r₁ r₂ : Result) : MetaM Result :=
  let e := mkApp r₁.expr r₂.expr
  match r₁.proof?, r₂.proof? with
  | none,     none   => return { expr := e, proof? := none }
  | some h,  none    => return { expr := e, proof? := (← Meta.mkCongrFun h r₂.expr) }
  | none,    some h  => return { expr := e, proof? := (← Meta.mkCongrArg r₁.expr h) }
  | some h₁, some h₂ => return { expr := e, proof? := (← Meta.mkCongr h₁ h₂) }

private def mkImpCongr (r₁ r₂ : Result) : MetaM Result := do
  let e ← mkArrow r₁.expr r₂.expr
  match r₁.proof?, r₂.proof? with
  | none,     none   => return { expr := e, proof? := none }
  | _,        _      => return { expr := e, proof? := (← Meta.mkImpCongr (← r₁.getProof) (← r₂.getProof)) } -- TODO specialize if bootleneck

/-- Return true if `e` is of the form `ofNat n` where `n` is a kernel Nat literal -/
def isOfNatNatLit (e : Expr) : Bool :=
  e.isAppOfArity ``OfNat.ofNat 3 && e.appFn!.appArg!.isNatLit

private def reduceProj (e : Expr) : MetaM Expr := do
  match (← reduceProj? e) with
  | some e => return e
  | _      => return e

private def reduceProjFn? (e : Expr) : SimpM (Option Expr) := do
  matchConst e.getAppFn (fun _ => pure none) fun cinfo _ => do
    match (← getProjectionFnInfo? cinfo.name) with
    | none => return none
    | some projInfo =>
      if projInfo.fromClass then
        if (← read).simpTheorems.isDeclToUnfold cinfo.name then
          -- We only unfold class projections when the user explicitly requested them to be unfolded.
          -- Recall that `unfoldDefinition?` has support for unfolding this kind of projection.
          withReducibleAndInstances <| unfoldDefinition? e
        else
          return none
      else
        -- `structure` projection
        match (← unfoldDefinition? e) with
        | none   => pure none
        | some e =>
          match (← reduceProj? e.getAppFn) with
          | some f => return some (mkAppN f e.getAppArgs)
          | none   => return none

private def reduceFVar (cfg : Config) (e : Expr) : MetaM Expr := do
  if cfg.zeta then
    match (← getFVarLocalDecl e).value? with
    | some v => return v
    | none   => return e
  else
    return e

private def unfold? (e : Expr) : SimpM (Option Expr) := do
  let f := e.getAppFn
  if !f.isConst then
    return none
  let fName := f.constName!
  if (← isProjectionFn fName) then
    return none -- should be reduced by `reduceProjFn?`
  if (← read).simpTheorems.isDeclToUnfold e.getAppFn.constName! then
    withDefault <| unfoldDefinition? e
  else
    return none

private partial def reduce (e : Expr) : SimpM Expr := withIncRecDepth do
  let cfg := (← read).config
  if cfg.beta then
    let e' := e.headBeta
    if e' != e then
      return (← reduce e')
  -- TODO: eta reduction
  if cfg.proj then
    match (← reduceProjFn? e) with
    | some e => return (← reduce e)
    | none   => pure ()
  if cfg.iota then
    match (← reduceRecMatcher? e) with
    | some e => return (← reduce e)
    | none   => pure ()
  match (← unfold? e) with
  | some e => reduce e
  | none => return e

private partial def dsimp (e : Expr) : M Expr := do
  transform e (post := fun e => return TransformStep.done (← reduce e))

inductive SimpLetCase where
  | dep -- `let x := v; b` is not equivalent to `(fun x => b) v`
  | nondepDepVar -- `let x := v; b` is equivalent to `(fun x => b) v`, but result type depends on `x`
  | nondep -- `let x := v; b` is equivalent to `(fun x => b) v`, and result type does not depend on `x`

def getSimpLetCase (n : Name) (t : Expr) (v : Expr) (b : Expr) : MetaM SimpLetCase := do
  withLocalDeclD n t fun x => do
    let bx := b.instantiate1 x
    /- The following step is potentially very expensive when we have many nested let-decls.
       TODO: handle a block of nested let decls in a single pass if this becomes a performance problem. -/
    if (← isTypeCorrect bx) then
      let bxType ← whnf (← inferType bx)
      if (← dependsOn bxType x.fvarId!) then
        return SimpLetCase.nondepDepVar
      else
        return SimpLetCase.nondep
    else
      return SimpLetCase.dep

/-- Given the application `e`, remove unnecessary casts of the form `Eq.rec a rfl` and `Eq.ndrec a rfl`. -/
partial def removeUnnecessaryCasts (e : Expr) : MetaM Expr := do
  let mut args := e.getAppArgs
  let mut modified := false
  for i in [:args.size] do
    let arg := args[i]
    if isDummyEqRec arg then
      args := args.set! i (elimDummyEqRec arg)
      modified := true
  if modified then
    return mkAppN e.getAppFn args
  else
    return e
where
  isDummyEqRec (e : Expr) : Bool :=
    (e.isAppOfArity ``Eq.rec 6 || e.isAppOfArity ``Eq.ndrec 6) && e.appArg!.isAppOf ``Eq.refl

  elimDummyEqRec (e : Expr) : Expr :=
    if isDummyEqRec e then
      elimDummyEqRec e.appFn!.appFn!.appArg!
    else
      e

partial def simp (e : Expr) : M Result := withIncRecDepth do
  checkMaxHeartbeats "simp"
  let cfg ← getConfig
  if (← isProof e) then
    return { expr := e }
  if cfg.memoize then
    if let some result := (← get).cache.find? e then
      return result
  simpLoop { expr := e }

where
  simpLoop (r : Result) : M Result := do
    let cfg ← getConfig
    if (← get).numSteps > cfg.maxSteps then
      throwError "simp failed, maximum number of steps exceeded"
    else
      let init := r.expr
      modify fun s => { s with numSteps := s.numSteps + 1 }
      match (← pre r.expr) with
      | Step.done r'  => cacheResult cfg (← mkEqTrans r r')
      | Step.visit r' =>
        let r ← mkEqTrans r r'
        let r ← mkEqTrans r (← simpStep r.expr)
        match (← post r.expr) with
        | Step.done r'  => cacheResult cfg (← mkEqTrans r r')
        | Step.visit r' =>
          let r ← mkEqTrans r r'
          if cfg.singlePass || init == r.expr then
            cacheResult cfg r
          else
            simpLoop r

  simpStep (e : Expr) : M Result := do
    match e with
    | Expr.mdata m e _ => let r ← simp e; return { r with expr := mkMData m r.expr }
    | Expr.proj ..     => simpProj e
    | Expr.app ..      => simpApp e
    | Expr.lam ..      => simpLambda e
    | Expr.forallE ..  => simpForall e
    | Expr.letE ..     => simpLet e
    | Expr.const ..    => simpConst e
    | Expr.bvar ..     => unreachable!
    | Expr.sort ..     => return { expr := e }
    | Expr.lit ..      => simpLit e
    | Expr.mvar ..     => return { expr := (← instantiateMVars e) }
    | Expr.fvar ..     => return { expr := (← reduceFVar (← getConfig) e) }

  simpLit (e : Expr) : M Result := do
    match e.natLit? with
    | some n =>
      /- If `OfNat.ofNat` is marked to be unfolded, we do not pack orphan nat literals as `OfNat.ofNat` applications
         to avoid non-termination. See issue #788.  -/
      if (← getSimpTheorems).isDeclToUnfold ``OfNat.ofNat then
        return { expr := e }
      else
        return { expr := (← mkNumeral (mkConst ``Nat) n) }
    | none   => return { expr := e }

  simpProj (e : Expr) : M Result := do
    match (← reduceProj? e) with
    | some e => return { expr := e }
    | none =>
      let s := e.projExpr!
      let motive? ← withLocalDeclD `s (← inferType s) fun s => do
        let p := e.updateProj! s
        if (← dependsOn (← inferType p) s.fvarId!) then
          return none
        else
          let motive ← mkLambdaFVars #[s] (← mkEq e p)
          if !(← isTypeCorrect motive) then
            return none
          else
            return some motive
      if let some motive := motive? then
        let r ← simp s
        let eNew := e.updateProj! r.expr
        match r.proof? with
        | none => return { expr := eNew }
        | some h =>
          let hNew ← mkEqNDRec motive (← mkEqRefl e) h
          return { expr := eNew, proof? := some hNew }
      else
        return { expr := (← dsimp e) }

  congrArgs (r : Result) (args : Array Expr) : M Result := do
    if args.isEmpty then
      return r
    else
      let infos := (← getFunInfoNArgs r.expr args.size).paramInfo
      let mut r := r
      let mut i := 0
      for arg in args do
        trace[Debug.Meta.Tactic.simp] "app [{i}] {infos.size} {arg} hasFwdDeps: {infos[i].hasFwdDeps}"
        if i < infos.size && !infos[i].hasFwdDeps then
          r ← mkCongr r (← simp arg)
        else if (← whnfD (← inferType r.expr)).isArrow then
          r ← mkCongr r (← simp arg)
        else
          r ← mkCongrFun r (← dsimp arg)
        i := i + 1
      return r

  visitFn (e : Expr) : M Result := do
    let f := e.getAppFn
    let fNew ← simp f
    if fNew.expr == f then
      return { expr := e }
    else
      let args := e.getAppArgs
      let eNew := mkAppN fNew.expr args
      if fNew.proof?.isNone then return { expr := eNew }
      let mut proof ← fNew.getProof
      for arg in args do
        proof ← Meta.mkCongrFun proof arg
      return { expr := eNew, proof? := proof }

  mkCongrSimp? (f : Expr) : M (Option CongrTheorem) := do
    if f.isConst then if (← isMatcher f.constName!) then
      -- We always use simple congruence theorems for auxiliary match applications
      return none
    let info ← getFunInfo f
    let kinds := getCongrSimpKinds info
    if kinds.all fun k => match k with | CongrArgKind.fixed => true | CongrArgKind.eq => true | _ => false then
      /- If all argument kinds are `fixed` or `eq`, then using
         simple congruence theorems `congr`, `congrArg`, and `congrFun` produces a more compact proof -/
      return none
    match (← get).congrCache.find? f with
    | some thm? => return thm?
    | none =>
      let thm? ← mkCongrSimpCore? f info kinds
      modify fun s => { s with congrCache := s.congrCache.insert f thm? }
      return thm?

  /-- Try to use automatically generated congruence theorems. See `mkCongrSimp?`. -/
  tryAutoCongrTheorem? (e : Expr) : M (Option Result) := do
    let f := e.getAppFn
    -- TODO: cache
    let some cgrThm ← mkCongrSimp? f | return none
    if cgrThm.argKinds.size != e.getAppNumArgs then return none
    let mut simplified := false
    let mut hasProof   := false
    let mut hasCast    := false
    let mut argsNew    := #[]
    let mut argResults := #[]
    let args := e.getAppArgs
    for arg in args, kind in cgrThm.argKinds do
      match kind with
      | CongrArgKind.fixed => argsNew := argsNew.push arg
      | CongrArgKind.cast  => hasCast := true; argsNew := argsNew.push arg
      | CongrArgKind.subsingletonInst => argsNew := argsNew.push arg
      | CongrArgKind.eq =>
        let argResult ← simp arg
        argResults := argResults.push argResult
        argsNew    := argsNew.push argResult.expr
        if argResult.proof?.isSome then hasProof := true
        if arg != argResult.expr then simplified := true
      | _ => unreachable!
    if !simplified then return some { expr := e }
    if !hasProof then return some { expr := mkAppN f argsNew }
    let mut proof := cgrThm.proof
    let mut type  := cgrThm.type
    let mut j := 0 -- index at argResults
    let mut subst := #[]
    for arg in args, kind in cgrThm.argKinds do
      proof := mkApp proof arg
      subst := subst.push arg
      type := type.bindingBody!
      match kind with
      | CongrArgKind.fixed => pure ()
      | CongrArgKind.cast  => pure ()
      | CongrArgKind.subsingletonInst =>
        let clsNew := type.bindingDomain!.instantiateRev subst
        let instNew ←
          if (← isDefEq (← inferType arg) clsNew) then
            pure arg
          else
            match (← trySynthInstance clsNew) with
            | LOption.some val => pure val
            | _ =>
              trace[Meta.Tactic.simp.congr] "failed to synthesize instance{indentExpr clsNew}"
              return none
        proof := mkApp proof instNew
        subst := subst.push instNew
        type := type.bindingBody!
      | CongrArgKind.eq =>
        let argResult := argResults[j]
        let argProof ← argResult.getProof
        j := j + 1
        proof := mkApp2 proof argResult.expr argProof
        subst := subst.push argResult.expr |>.push argProof
        type := type.bindingBody!.bindingBody!
      | _ => unreachable!
    let some (_, _, rhs) := type.instantiateRev subst |>.eq? | unreachable!
    let rhs ← if hasCast then removeUnnecessaryCasts rhs else pure rhs
    return some { expr := rhs, proof? := proof }

  congrDefault (e : Expr) : M Result := do
    if let some result ← tryAutoCongrTheorem? e then
      mkEqTrans result (← visitFn result.expr)
    else
      withParent e <| e.withApp fun f args => do
        congrArgs (← simp f) args

  /- Return true iff processing the given congruence theorem hypothesis produced a non-refl proof. -/
  processCongrHypothesis (h : Expr) : M Bool := do
    forallTelescopeReducing (← inferType h) fun xs hType => withNewLemmas xs do
      let lhs ← instantiateMVars hType.appFn!.appArg!
      let r ← simp lhs
      let rhs := hType.appArg!
      rhs.withApp fun m zs => do
        let val ← mkLambdaFVars zs r.expr
        unless (← isDefEq m val) do
          throwCongrHypothesisFailed
        unless (← isDefEq h (← mkLambdaFVars xs (← r.getProof))) do
          throwCongrHypothesisFailed
        return r.proof?.isSome

  /- Try to rewrite `e` children using the given congruence theorem -/
  trySimpCongrTheorem? (c : SimpCongrTheorem) (e : Expr) : M (Option Result) := withNewMCtxDepth do
    trace[Debug.Meta.Tactic.simp.congr] "{c.theoremName}, {e}"
    let thm ← mkConstWithFreshMVarLevels c.theoremName
    let (xs, bis, type) ← forallMetaTelescopeReducing (← inferType thm)
    if c.hypothesesPos.any (· ≥ xs.size) then
      return none
    let lhs := type.appFn!.appArg!
    let rhs := type.appArg!
    let numArgs := lhs.getAppNumArgs
    let mut e := e
    let mut extraArgs := #[]
    if e.getAppNumArgs > numArgs then
      let args := e.getAppArgs
      e := mkAppN e.getAppFn args[:numArgs]
      extraArgs := args[numArgs:].toArray
    if (← isDefEq lhs e) then
      let mut modified := false
      for i in c.hypothesesPos do
        let x := xs[i]
        try
          if (← processCongrHypothesis x) then
            modified := true
        catch ex =>
          trace[Meta.Tactic.simp.congr] "processCongrHypothesis {c.theoremName} failed {← inferType x}"
          if ex.isMaxRecDepth then
            -- Recall that `processCongrHypothesis` invokes `simp` recursively.
            throw ex
          else
            return none
      unless modified do
        trace[Meta.Tactic.simp.congr] "{c.theoremName} not modified"
        return none
      unless (← synthesizeArgs c.theoremName xs bis (← read).discharge?) do
        trace[Meta.Tactic.simp.congr] "{c.theoremName} synthesizeArgs failed"
        return none
      let eNew ← instantiateMVars rhs
      let proof ← instantiateMVars (mkAppN thm xs)
      congrArgs { expr := eNew, proof? := proof } extraArgs
    else
      return none

  congr (e : Expr) : M Result := do
    let f := e.getAppFn
    if f.isConst then
      let congrThms ← getSimpCongrTheorems
      let cs := congrThms.get f.constName!
      for c in cs do
        match (← trySimpCongrTheorem? c e) with
        | none   => pure ()
        | some r => return r
      congrDefault e
    else
      congrDefault e

  simpApp (e : Expr) : M Result := do
    let e ← reduce e
    if !e.isApp then
      simp e
    else if isOfNatNatLit e then
      -- Recall that we expand "orphan" kernel nat literals `n` into `ofNat n`
      return { expr := e }
    else
      congr e

  simpConst (e : Expr) : M Result :=
    return { expr := (← reduce e) }

  withNewLemmas {α} (xs : Array Expr) (f : M α) : M α := do
    if (← getConfig).contextual then
      let mut s ← getSimpTheorems
      let mut updated := false
      for x in xs do
        if (← isProof x) then
          s ← s.add #[] x
          updated := true
      if updated then
        withSimpTheorems s f
      else
        f
    else
      f

  simpLambda (e : Expr) : M Result :=
    withParent e <| lambdaTelescope e fun xs e => withNewLemmas xs do
      let r ← simp e
      let eNew ← mkLambdaFVars xs r.expr
      match r.proof? with
      | none   => return { expr := eNew }
      | some h =>
        let p ← xs.foldrM (init := h) fun x h => do
          mkFunExt (← mkLambdaFVars #[x] h)
        return { expr := eNew, proof? := p }

  simpArrow (e : Expr) : M Result := do
    trace[Debug.Meta.Tactic.simp] "arrow {e}"
    let p := e.bindingDomain!
    let q := e.bindingBody!
    let rp ← simp p
    trace[Debug.Meta.Tactic.simp] "arrow [{(← getConfig).contextual}] {p} [{← isProp p}] -> {q} [{← isProp q}]"
    if (← pure (← getConfig).contextual <&&> isProp p <&&> isProp q) then
      trace[Debug.Meta.Tactic.simp] "ctx arrow {rp.expr} -> {q}"
      withLocalDeclD e.bindingName! rp.expr fun h => do
        let s ← getSimpTheorems
        let s ← s.add #[] h
        withSimpTheorems s do
          let rq ← simp q
          match rq.proof? with
          | none    => mkImpCongr rp rq
          | some hq =>
            let hq ← mkLambdaFVars #[h] hq
            return { expr := (← mkArrow rp.expr rq.expr), proof? := (← mkImpCongrCtx (← rp.getProof) hq) }
    else
      mkImpCongr rp (← simp q)

  simpForall (e : Expr) : M Result := withParent e do
    trace[Debug.Meta.Tactic.simp] "forall {e}"
    if e.isArrow then
      simpArrow e
    else if (← isProp e) then
      withLocalDecl e.bindingName! e.bindingInfo! e.bindingDomain! fun x => withNewLemmas #[x] do
        let b := e.bindingBody!.instantiate1 x
        let rb ← simp b
        let eNew ← mkForallFVars #[x] rb.expr
        match rb.proof? with
        | none   => return { expr := eNew }
        | some h => return { expr := eNew, proof? := (← mkForallCongr (← mkLambdaFVars #[x] h)) }
    else
      return { expr := (← dsimp e) }

  simpLet (e : Expr) : M Result := do
    let Expr.letE n t v b _ := e | unreachable!
    if (← getConfig).zeta then
      return { expr := b.instantiate1 v }
    else
      match (← getSimpLetCase n t v b) with
      | SimpLetCase.dep => return { expr := (← dsimp e) }
      | SimpLetCase.nondep =>
        let rv ← simp v
        withLocalDeclD n t fun x => do
          let bx := b.instantiate1 x
          let rbx ← simp bx
          let hb? ← match rbx.proof? with
            | none => pure none
            | some h => pure (some (← mkLambdaFVars #[x] h))
          let e' := mkLet n t rv.expr (← abstract rbx.expr #[x])
          match rv.proof?, hb? with
          | none,   none   => return { expr := e' }
          | some h, none   => return { expr := e', proof? := some (← mkLetValCongr (← mkLambdaFVars #[x] rbx.expr) h) }
          | _,      some h => return { expr := e', proof? := some (← mkLetCongr (← rv.getProof) h) }
      | SimpLetCase.nondepDepVar =>
        let v' ← dsimp v
        withLocalDeclD n t fun x => do
          let bx := b.instantiate1 x
          let rbx ← simp bx
          let e' := mkLet n t v' (← abstract rbx.expr #[x])
          match rbx.proof? with
          | none => return { expr := e' }
          | some h =>
            let h ← mkLambdaFVars #[x] h
            return { expr := e', proof? := some (← mkLetBodyCongr v' h) }

  cacheResult (cfg : Config) (r : Result) : M Result := do
    if cfg.memoize then
      modify fun s => { s with cache := s.cache.insert e r }
    return r

def main (e : Expr) (ctx : Context) (methods : Methods := {}) : MetaM Result :=
  withConfig (fun c => { c with etaStruct := ctx.config.etaStruct }) <| withReducible do
    try
      simp e methods ctx |>.run' {}
    catch ex =>
      if ex.isMaxHeartbeat then throwNestedTacticEx `simp ex else throw ex

partial def isEqnThmHypothesis (e : Expr) : Bool :=
  e.isForall && go e
where
  go (e : Expr) : Bool :=
    if e.isForall then
      go e.bindingBody!
    else
      e.isConstOf ``False

abbrev Discharge := Expr → SimpM (Option Expr)

def dischargeUsingAssumption (e : Expr) : SimpM (Option Expr) := do
  (← getLCtx).findDeclRevM? fun localDecl => do
    if localDecl.isAuxDecl then
      return none
    else if (← isDefEq e localDecl.type) then
      return some localDecl.toExpr
    else
      return none

namespace DefaultMethods
mutual
  partial def discharge? (e : Expr) : SimpM (Option Expr) := do
    if isEqnThmHypothesis e then
      let r ← dischargeUsingAssumption e
      if r.isSome then
        return r
    let ctx ← read
    trace[Meta.Tactic.simp.discharge] ">> discharge?: {e}"
    if ctx.dischargeDepth >= ctx.config.maxDischargeDepth then
      trace[Meta.Tactic.simp.discharge] "maximum discharge depth has been reached"
      return none
    else
      withReader (fun ctx => { ctx with dischargeDepth := ctx.dischargeDepth + 1 }) do
        let r ← simp e { pre := pre, post := post, discharge? := discharge? }
        if r.expr.isConstOf ``True then
          try
            return some (← mkOfEqTrue (← r.getProof))
          catch _ =>
            return none
        else
          return none

  partial def pre (e : Expr) : SimpM Step :=
    preDefault e discharge?

  partial def post (e : Expr) : SimpM Step :=
    postDefault e discharge?
end

def methods : Methods :=
  { pre := pre, post := post, discharge? := discharge? }

end DefaultMethods

end Simp

def simp (e : Expr) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM Simp.Result := do profileitM Exception "simp" (← getOptions) do
  match discharge? with
  | none   => Simp.main e ctx (methods := Simp.DefaultMethods.methods)
  | some d => Simp.main e ctx (methods := { pre := (Simp.preDefault . d), post := (Simp.postDefault . d), discharge? := d })

/--
  Auxiliary method.
  Given the current `target` of `mvarId`, apply `r` which is a new target and proof that it is equaal to the current one.
-/
def applySimpResultToTarget (mvarId : MVarId) (target : Expr) (r : Simp.Result) : MetaM MVarId := do
  match r.proof? with
  | some proof => replaceTargetEq mvarId r.expr proof
  | none =>
    if target != r.expr then
      replaceTargetDefEq mvarId r.expr
    else
      return mvarId

/-- See `simpTarget`. This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
def simpTargetCore (mvarId : MVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM (Option MVarId) := do
  let target ← instantiateMVars (← getMVarType mvarId)
  let r ← simp target ctx discharge?
  if r.expr.isConstOf ``True then
    match r.proof? with
    | some proof => assignExprMVar mvarId  (← mkOfEqTrue proof)
    | none => assignExprMVar mvarId (mkConst ``True.intro)
    return none
  else
    applySimpResultToTarget mvarId target r

/--
  Simplify the given goal target (aka type). Return `none` if the goal was closed. Return `some mvarId'` otherwise,
  where `mvarId'` is the simplified new goal. -/
def simpTarget (mvarId : MVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM (Option MVarId) :=
  withMVarContext mvarId do
    checkNotAssigned mvarId `simp
    simpTargetCore mvarId ctx discharge?

/--
  Apply the result `r` for `prop` (which is inhabited by `proof`). Return `none` if the goal was closed. Return `some (proof', prop')`
  otherwise, where `proof' : prop'` and `prop'` is the simplified `prop`.

  This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
def applySimpResultToProp (mvarId : MVarId) (proof : Expr) (prop : Expr) (r : Simp.Result) : MetaM (Option (Expr × Expr)) := do
  if r.expr.isConstOf ``False then
    match r.proof? with
    | some eqProof => assignExprMVar mvarId (← mkFalseElim (← getMVarType mvarId) (← mkEqMP eqProof proof))
    | none => assignExprMVar mvarId (← mkFalseElim (← getMVarType mvarId) proof)
    return none
  else
    match r.proof? with
    | some eqProof => return some ((← mkEqMP eqProof proof), r.expr)
    | none =>
      if r.expr != prop then
        return some ((← mkExpectedTypeHint proof r.expr), r.expr)
      else
        return some (proof, r.expr)

def applySimpResultToFVarId (mvarId : MVarId) (fvarId : FVarId) (r : Simp.Result) : MetaM (Option (Expr × Expr)) := do
  let localDecl ← getLocalDecl fvarId
  applySimpResultToProp mvarId (mkFVar fvarId) localDecl.type r

/--
  Simplify `prop` (which is inhabited by `proof`). Return `none` if the goal was closed. Return `some (proof', prop')`
  otherwise, where `proof' : prop'` and `prop'` is the simplified `prop`.

  This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
def simpStep (mvarId : MVarId) (proof : Expr) (prop : Expr) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM (Option (Expr × Expr)) := do
  let r ← simp prop ctx discharge?
  applySimpResultToProp mvarId proof prop r

def applySimpResultToLocalDeclCore (mvarId : MVarId) (fvarId : FVarId) (r : Option (Expr × Expr)) : MetaM (Option (FVarId × MVarId)) := do
  match r with
  | none => return none
  | some (value, type') =>
    let localDecl ← getLocalDecl fvarId
    if localDecl.type != type' then
      let mvarId ← assert mvarId localDecl.userName type' value
      let mvarId ← tryClear mvarId localDecl.fvarId
      let (fvarId, mvarId) ← intro1P mvarId
      return some (fvarId, mvarId)
    else
      return some (fvarId, mvarId)

/--
  Simplify `simp` result to the given local declaration. Return `none` if the goal was closed.
  This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
def applySimpResultToLocalDecl (mvarId : MVarId) (fvarId : FVarId) (r : Simp.Result) : MetaM (Option (FVarId × MVarId)) := do
  applySimpResultToLocalDeclCore mvarId fvarId (← applySimpResultToFVarId mvarId fvarId r)

def simpLocalDecl (mvarId : MVarId) (fvarId : FVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM (Option (FVarId × MVarId)) := do
  withMVarContext mvarId do
    checkNotAssigned mvarId `simp
    let localDecl ← getLocalDecl fvarId
    let type ← instantiateMVars localDecl.type
    applySimpResultToLocalDeclCore mvarId fvarId (← simpStep mvarId (mkFVar fvarId) type ctx discharge?)

abbrev FVarIdToLemmaId := FVarIdMap Name

def simpGoal (mvarId : MVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) (simplifyTarget : Bool := true) (fvarIdsToSimp : Array FVarId := #[]) (fvarIdToLemmaId : FVarIdToLemmaId := {}) : MetaM (Option (Array FVarId × MVarId)) := do
  withMVarContext mvarId do
    checkNotAssigned mvarId `simp
    let mut mvarId := mvarId
    let mut toAssert : Array Hypothesis := #[]
    for fvarId in fvarIdsToSimp do
      let localDecl ← getLocalDecl fvarId
      let type ← instantiateMVars localDecl.type
      let ctx ← match fvarIdToLemmaId.find? localDecl.fvarId with
        | none => pure ctx
        | some thmId => pure { ctx with simpTheorems := ctx.simpTheorems.eraseCore thmId }
      match (← simpStep mvarId (mkFVar fvarId) type ctx discharge?) with
      | none => return none
      | some (value, type) => toAssert := toAssert.push { userName := localDecl.userName, type := type, value := value }
    if simplifyTarget then
      match (← simpTarget mvarId ctx discharge?) with
      | none => return none
      | some mvarIdNew => mvarId := mvarIdNew
    let (fvarIdsNew, mvarIdNew) ← assertHypotheses mvarId toAssert
    let mvarIdNew ← tryClearMany mvarIdNew fvarIdsToSimp
    return (fvarIdsNew, mvarIdNew)

def simpTargetStar (mvarId : MVarId) (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) : MetaM TacticResultCNM := withMVarContext mvarId do
  trace[Meta.debug] "simpTargetStar:\n{mvarId}"
  let mut ctx := ctx
  for h in (← getPropHyps) do
    let localDecl ← getLocalDecl h
    let proof  := localDecl.toExpr
    trace[Meta.debug] "adding {localDecl.toExpr}"
    let simpTheorems ← ctx.simpTheorems.add #[] proof
    ctx := { ctx with simpTheorems }
  match (← simpTarget mvarId ctx discharge?) with
  | none => return TacticResultCNM.closed
  | some mvarId' =>
    trace[Meta.debug] "simpTargetStar result:\n{mvarId'}"
    if (← getMVarType mvarId) == (← getMVarType mvarId') then
      return TacticResultCNM.noChange
    else
      return TacticResultCNM.modified mvarId'

end Lean.Meta