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

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

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

/- starkware.cairo.common.cairo_secp.signature.div_mod_n autogenerated soundness theorem -/

theorem auto_sound_div_mod_n
    -- arguments
    (range_check_ptr : F) (a b : BigInt3 F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_div_mod_n σ.pc)
    -- all dependencies are in memory
    (h_mem_3 : mem_at mem code_bigint_mul (σ.pc  - 668))
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 654))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_a : a = cast_BigInt3 mem (σ.fp - 8))
    (hin_b : b = cast_BigInt3 mem (σ.fp - 5))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      τ.ap = σ.ap + 88 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 4)
        (spec_div_mod_n mem κ range_check_ptr a b (mem (τ.ap - 4)) (cast_BigInt3 mem (τ.ap - 3)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_div_mod_n 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⟩,
  -- function call
  step_assert_eq hpc0 with arg0,
  step_sub hpc1 (auto_sound_nondet_bigint3 mem _ range_check_ptr _ _),
  { rw hpc2, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call3 ap3 h_call3,
  rcases h_call3 with ⟨h_call3_ap_offset, h_call3⟩,
  rcases h_call3 with ⟨rc_m3, rc_mle3, hl_range_check_ptr₁, h_call3⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap3 - 4) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_res: cast_BigInt3 mem (ap3 - 3) = res,
  simp only [hr_rev_res] at h_call3,
  have htv_res := hr_rev_res.symm, clear hr_rev_res,
  try { simp only [arg0] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0] at h_call3 },
  rw [hin_range_check_ptr] at h_call3,
  clear arg0,
  -- function call
  step_assert_eq hpc3 with arg0,
  step_sub hpc4 (auto_sound_nondet_bigint3 mem _ range_check_ptr₁ _ _),
  { rw hpc5, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res] },
    try { dsimp [cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call3_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call6 ap6 h_call6,
  rcases h_call6 with ⟨h_call6_ap_offset, h_call6⟩,
  rcases h_call6 with ⟨rc_m6, rc_mle6, hl_range_check_ptr₂, h_call6⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap6 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_k: cast_BigInt3 mem (ap6 - 3) = k,
  simp only [hr_rev_k] at h_call6,
  have htv_k := hr_rev_k.symm, clear hr_rev_k,
  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_call6 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call6,
  clear arg0,
  -- function call
  step_assert_eq hpc6 with arg0,
  step_assert_eq hpc7 with arg1,
  step_assert_eq hpc8 with arg2,
  step_assert_eq hpc9 with arg3,
  step_assert_eq hpc10 with arg4,
  step_assert_eq hpc11 with arg5,
  step_sub hpc12 (auto_sound_bigint_mul mem _ res b _ _ _),
  { rw hpc13, norm_num2, exact h_mem_3 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call6_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_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call14 ap14 h_call14,
  rcases h_call14 with ⟨h_call14_ap_offset, h_call14⟩,
  generalize' hr_rev_res_b: cast_UnreducedBigInt5 mem (ap14 - 5) = res_b,
  simp only [hr_rev_res_b] at h_call14,
  have htv_res_b := hr_rev_res_b.symm, clear hr_rev_res_b,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- let
  generalize' hl_rev_n: ({
    d0 := N0,
    d1 := N1,
    d2 := N2
  } : BigInt3 F) = n,
  have hl_n := hl_rev_n.symm, clear hl_rev_n,
  try { dsimp at hl_n }, try { arith_simps at hl_n },
  -- function call
  step_assert_eq hpc14 with arg0,
  step_assert_eq hpc15 with arg1,
  step_assert_eq hpc16 with arg2,
  step_assert_eq hpc17 hpc18 with arg3,
  step_assert_eq hpc19 hpc20 with arg4,
  step_assert_eq hpc21 hpc22 with arg5,
  step_sub hpc23 (auto_sound_bigint_mul mem _ k n _ _ _),
  { rw hpc24, norm_num2, exact h_mem_3 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_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_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call25 ap25 h_call25,
  rcases h_call25 with ⟨h_call25_ap_offset, h_call25⟩,
  generalize' hr_rev_k_n: cast_UnreducedBigInt5 mem (ap25 - 5) = k_n,
  simp only [hr_rev_k_n] at h_call25,
  have htv_k_n := hr_rev_k_n.symm, clear hr_rev_k_n,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- tempvar
  step_assert_eq hpc25 with tv_carry10,
  step_assert_eq hpc26 with tv_carry11,
  step_assert_eq hpc27 hpc28 with tv_carry12,
  generalize' hl_rev_carry1: ((res_b.d0 - k_n.d0 - a.d0) / (BASE : ℤ) : F) = carry1,
  have hl_carry1 := hl_rev_carry1.symm, clear hl_rev_carry1,
  have htv_carry1: carry1 = _, {
    have h_δ25_c0 : ∀ x : F, x / (BASE : ℤ) = x * (-46768052394588894761721767695234645457402928824320 : ℤ),
    { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
    apply eq.symm, apply eq.trans tv_carry12,
      try { simp only [h_δ25_c0] at hl_carry1 },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add tv_carry10), (eq_sub_of_eq_add tv_carry11)] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_carry10 tv_carry11 tv_carry12,
  try { dsimp at hl_carry1 }, try { arith_simps at hl_carry1 },
  -- compound assert eq
  step_assert_eq hpc29 hpc30 with temp0,
  step_assert_eq hpc31 with temp1,
  have a29: mem (range_check_ptr₂ + 0) = carry1 + 2 ^ 127, {
    apply assert_eq_reduction temp1.symm,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
    try { arith_simps }, try { simp only [temp0] },
    try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a29 }, try { arith_simps at a29 },
  clear temp0 temp1,
  -- tempvar
  step_assert_eq hpc32 with tv_carry20,
  step_assert_eq hpc33 with tv_carry21,
  step_assert_eq hpc34 with tv_carry22,
  step_assert_eq hpc35 hpc36 with tv_carry23,
  generalize' hl_rev_carry2: ((res_b.d1 - k_n.d1 - a.d1 + carry1) / (BASE : ℤ) : F) = carry2,
  have hl_carry2 := hl_rev_carry2.symm, clear hl_rev_carry2,
  have htv_carry2: carry2 = _, {
    have h_δ32_c0 : ∀ x : F, x / (BASE : ℤ) = x * (-46768052394588894761721767695234645457402928824320 : ℤ),
    { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
    apply eq.symm, apply eq.trans tv_carry23,
      try { simp only [h_δ32_c0] at hl_carry2 },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add tv_carry20), (eq_sub_of_eq_add tv_carry21), tv_carry22] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_carry20 tv_carry21 tv_carry22 tv_carry23,
  try { dsimp at hl_carry2 }, try { arith_simps at hl_carry2 },
  -- compound assert eq
  step_assert_eq hpc37 hpc38 with temp0,
  step_assert_eq hpc39 with temp1,
  have a37: mem (range_check_ptr₂ + 1) = carry2 + 2 ^ 127, {
    apply assert_eq_reduction temp1.symm,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
    try { arith_simps }, try { simp only [temp0] },
    try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a37 }, try { arith_simps at a37 },
  clear temp0 temp1,
  -- tempvar
  step_assert_eq hpc40 with tv_carry30,
  step_assert_eq hpc41 with tv_carry31,
  step_assert_eq hpc42 with tv_carry32,
  step_assert_eq hpc43 hpc44 with tv_carry33,
  generalize' hl_rev_carry3: ((res_b.d2 - k_n.d2 - a.d2 + carry2) / (BASE : ℤ) : F) = carry3,
  have hl_carry3 := hl_rev_carry3.symm, clear hl_rev_carry3,
  have htv_carry3: carry3 = _, {
    have h_δ40_c0 : ∀ x : F, x / (BASE : ℤ) = x * (-46768052394588894761721767695234645457402928824320 : ℤ),
    { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
    apply eq.symm, apply eq.trans tv_carry33,
      try { simp only [h_δ40_c0] at hl_carry3 },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add tv_carry30), (eq_sub_of_eq_add tv_carry31), tv_carry32] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_carry30 tv_carry31 tv_carry32 tv_carry33,
  try { dsimp at hl_carry3 }, try { arith_simps at hl_carry3 },
  -- compound assert eq
  step_assert_eq hpc45 hpc46 with temp0,
  step_assert_eq hpc47 with temp1,
  have a45: mem (range_check_ptr₂ + 2) = carry3 + 2 ^ 127, {
    apply assert_eq_reduction temp1.symm,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3, htv_carry3] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
    try { arith_simps }, try { simp only [temp0] },
    try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a45 }, try { arith_simps at a45 },
  clear temp0 temp1,
  -- tempvar
  step_assert_eq hpc48 with tv_carry40,
  step_assert_eq hpc49 with tv_carry41,
  step_assert_eq hpc50 hpc51 with tv_carry42,
  generalize' hl_rev_carry4: ((res_b.d3 - k_n.d3 + carry3) / (BASE : ℤ) : F) = carry4,
  have hl_carry4 := hl_rev_carry4.symm, clear hl_rev_carry4,
  have htv_carry4: carry4 = _, {
    have h_δ48_c0 : ∀ x : F, x / (BASE : ℤ) = x * (-46768052394588894761721767695234645457402928824320 : ℤ),
    { intro x,  apply div_eq_mul_inv', apply PRIME.int_cast_mul_eq_one, rw [PRIME], try { simp_int_casts }, norm_num1 },
    apply eq.symm, apply eq.trans tv_carry42,
      try { simp only [h_δ48_c0] at hl_carry4 },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3, htv_carry3, hl_carry4] },
      try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add tv_carry40), tv_carry41] },
      try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_carry40 tv_carry41 tv_carry42,
  try { dsimp at hl_carry4 }, try { arith_simps at hl_carry4 },
  -- compound assert eq
  step_assert_eq hpc52 hpc53 with temp0,
  step_assert_eq hpc54 with temp1,
  have a52: mem (range_check_ptr₂ + 3) = carry4 + 2 ^ 127, {
    apply assert_eq_reduction temp1.symm,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3, htv_carry3, hl_carry4, htv_carry4] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
    try { arith_simps }, try { simp only [temp0] },
    try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a52 }, try { arith_simps at a52 },
  clear temp0 temp1,
  -- compound assert eq
  step_assert_eq hpc55 with temp0,
  step_assert_eq hpc56 hpc57 with temp1,
  step_assert_eq hpc58 with temp2,
  have a55: res_b.d4 - k_n.d4 + carry4 = 0, {
    apply assert_eq_reduction temp2.symm,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3, htv_carry3, hl_carry4, htv_carry4] },
    try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
    try { arith_simps }, try { simp only [(eq_sub_of_eq_add temp0), temp1] },
    try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a55 }, try { arith_simps at a55 },
  clear temp0 temp1 temp2,
  -- let
  generalize' hl_rev_range_check_ptr₃: (range_check_ptr₂ + 4 : F) = range_check_ptr₃,
  have hl_range_check_ptr₃ := hl_rev_range_check_ptr₃.symm, clear hl_rev_range_check_ptr₃,
  try { dsimp at hl_range_check_ptr₃ }, try { arith_simps at hl_range_check_ptr₃ },
  -- return
  step_assert_eq hpc59 hpc60 with hret0,
  step_assert_eq hpc61 with hret1,
  step_assert_eq hpc62 with hret2,
  step_assert_eq hpc63 with hret3,
  step_ret hpc64,
  -- finish
  step_done, use_only [rfl, rfl],
  split,
  { try { simp only [h_call3_ap_offset ,h_call6_ap_offset ,h_call14_ap_offset ,h_call25_ap_offset] },
    try { arith_simps }, try { refl } },
  -- range check condition
  use_only (rc_m3+rc_m6+4+0+0), split,
  linarith [rc_mle3, rc_mle6],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3] },
    try { simp only [h_call25_ap_offset ,h_call14_ap_offset] }, try { arith_simps },
    rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_div_mod_n mem _ range_check_ptr a b _ _,
  { apply sound_div_mod_n, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_div_mod_n],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call3],
  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 spec3 := h_call3 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec3,
  try { dsimp at spec3, arith_simps at spec3 },
  use_only [spec3],
  use_only [κ_call6],
  use_only [range_check_ptr₂],
  use_only [k],
  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 spec6 := h_call6 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec6,
  try { dsimp at spec6, arith_simps at spec6 },
  use_only [spec6],
  use_only [κ_call14],
  use_only [res_b],
  try { dsimp at h_call14, arith_simps at h_call14 },
  try { use_only [h_call14] },
  use_only [n, hl_n],
  use_only [κ_call25],
  use_only [k_n],
  try { dsimp at h_call25, arith_simps at h_call25 },
  try { use_only [h_call25] },
  use_only [carry1, hl_carry1],
  use_only [a29],
  cases rc_h_range_check_ptr₂' (0) (by norm_num1) with n hn, arith_simps at hn,
  use_only [n], { simp only [a29.symm, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr], arith_simps, exact hn },
  use_only [carry2, hl_carry2],
  use_only [a37],
  cases rc_h_range_check_ptr₂' (1) (by norm_num1) with n hn, arith_simps at hn,
  use_only [n], { simp only [a37.symm, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr], arith_simps, exact hn },
  use_only [carry3, hl_carry3],
  use_only [a45],
  cases rc_h_range_check_ptr₂' (2) (by norm_num1) with n hn, arith_simps at hn,
  use_only [n], { simp only [a45.symm, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr], arith_simps, exact hn },
  use_only [carry4, hl_carry4],
  use_only [a52],
  cases rc_h_range_check_ptr₂' (3) (by norm_num1) with n hn, arith_simps at hn,
  use_only [n], { simp only [a52.symm, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr], arith_simps, exact hn },
  use_only [a55],
  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₃' },
  use_only [range_check_ptr₃, hl_range_check_ptr₃],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁, htv_res, htv_range_check_ptr₂, htv_k, htv_res_b, hl_n, htv_k_n, hl_carry1, htv_carry1, hl_carry2, htv_carry2, hl_carry3, htv_carry3, hl_carry4, htv_carry4, hl_range_check_ptr₃] }, },
  try { dsimp [cast_BigInt3, cast_UnreducedBigInt5] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3] },
  try { simp only [h_call3_ap_offset, h_call6_ap_offset, h_call14_ap_offset, h_call25_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import category_theory.isomorphism category_theory.concrete_category
import category_theory.limits.shapes.equalizers
import category_theory.endomorphism
import category_theory.category.preorder data.fin.basic
import category_theory.arrow
import category_theory.category.Cat
import category_theory.limits.presheaf
import category_theory.limits.comma

-- Should not be here...
lemma nat.iterate_succ {α : Type*} (f : α → α)
  : ∀ (n : ℕ) (x0 : α), f^[n + 1] x0 = f (f^[n] x0)
| 0       x0 := rfl
| (n + 1) x0 := nat.iterate_succ n (f x0)

namespace category_theory

open category_theory category_theory.limits

local attribute [instance]
  category_theory.concrete_category.has_coe_to_sort
  category_theory.concrete_category.has_coe_to_fun

lemma iso.eq_app_inv_of_app_hom_eq
  {C : Type*} [category C] [concrete_category C] {X Y : C} (f : X ≅ Y)
  {x : X} {y : Y} (H : f.hom x = y) : x = f.inv y :=
begin
  transitivity f.inv (f.hom x),
  { rw [← comp_apply, iso.hom_inv_id, id_apply] },
  { rw H }
end

lemma is_iso.eq_app_inv_of_app_hom_eq
  {C : Type*} [category C] [concrete_category C] {X Y : C} (f : X ⟶ Y) [is_iso f]
  {x : X} {y : Y} : f x = y → x = inv f y :=
  iso.eq_app_inv_of_app_hom_eq (as_iso f)

theorem is_iso.cancel_iso_inv_left {C : Type*} [category C] {X Y Z : C}
  (f : Y ⟶ X) [is_iso f] : ∀ (g g' : Y ⟶ Z), inv f ≫ g = inv f ≫ g' ↔ g = g' :=
  iso.cancel_iso_inv_left (as_iso f)

lemma parallel_pair_comp
  {C : Type*} {D : Type*} [category C] [category D] (F : C ⥤ D) {X Y : C} (f g : X ⟶ Y)
  : parallel_pair f g ⋙ F = parallel_pair (F.map f) (F.map g) :=
begin
  apply category_theory.functor.hext,
  { intro u, cases u; refl },
  { intros u v i, cases u; cases v; cases i,
    all_goals { simp },
    all_goals { refl } },
end

def parallel_pair_comp.cocone_comp_to_cocone_pair
  {C : Type*} {D : Type*} [category C] [category D] (F : C ⥤ D) {X Y : C} (f g : X ⟶ Y)
  (c : cocone (parallel_pair f g ⋙ F)) : cocone (parallel_pair (F.map f) (F.map g)) := {
    X := c.X,
    ι := eq_to_hom (parallel_pair_comp F f g).symm ≫ c.ι
  }

def parallel_pair_comp.cocone_pair_to_cocone_comp
  {C : Type*} {D : Type*} [category C] [category D] (F : C ⥤ D) {X Y : C} (f g : X ⟶ Y)
  (c : cocone (parallel_pair (F.map f) (F.map g))) : cocone (parallel_pair f g ⋙ F) := {
    X := c.X,
    ι := eq_to_hom (parallel_pair_comp F f g) ≫ c.ι
  }

def parallel_pair_comp.is_colimit_comp_to_is_colimit_pair
  {C : Type*} {D : Type*} [category C] [category D] (F : C ⥤ D) {X Y : C} (f g : X ⟶ Y)
  (c : cocone (parallel_pair f g ⋙ F)) (hc : is_colimit c)
  : is_colimit (parallel_pair_comp.cocone_comp_to_cocone_pair F f g c) := {
    desc := λ s, hc.desc (parallel_pair_comp.cocone_pair_to_cocone_comp F f g s),
    fac' := by { intros, refine eq.trans (category.assoc _ _ _) _, rw hc.fac',
                 refine eq.trans (category.assoc _ _ _).symm _, simp },
    uniq' := λ s m h, hc.uniq' (parallel_pair_comp.cocone_pair_to_cocone_comp F f g s) m
                               (λ u, by { refine eq.trans _ (congr_arg (λ w, nat_trans.app (eq_to_hom (parallel_pair_comp F f g)) u ≫ w) (h u)),
                                          refine eq.trans _ (category.assoc _ _ _),
                                          refine congr_arg (λ w, w ≫ m) _,
                                          refine eq.trans _ (category.assoc _ _ _),
                                          simp }) }

def parallel_pair_comp.is_colimit_pair_to_is_colimit_comp
  {C : Type*} {D : Type*} [category C] [category D] (F : C ⥤ D) {X Y : C} (f g : X ⟶ Y)
  (c : cocone (parallel_pair (F.map f) (F.map g))) (hc : is_colimit c)
  : is_colimit (parallel_pair_comp.cocone_pair_to_cocone_comp F f g c) := {
    desc := λ s, hc.desc (parallel_pair_comp.cocone_comp_to_cocone_pair F f g s),
    fac' := by { intros, refine eq.trans (category.assoc _ _ _) _, rw hc.fac',
                 refine eq.trans (category.assoc _ _ _).symm _, simp },
    uniq' := λ s m h, hc.uniq' (parallel_pair_comp.cocone_comp_to_cocone_pair F f g s) m
                               (λ u, by { refine eq.trans _ (congr_arg (λ w, nat_trans.app (eq_to_hom (parallel_pair_comp F f g).symm) u ≫ w) (h u)),
                                          refine eq.trans _ (category.assoc _ _ _),
                                          refine congr_arg (λ w, w ≫ m) _,
                                          refine eq.trans _ (category.assoc _ _ _),
                                          simp }) }

lemma concrete_category.pow_eq_iter {C : Type*} [category C] [concrete_category C] {X : C} (f : X ⟶ X)
  (k : ℕ) : @coe_fn _ _ concrete_category.has_coe_to_fun (f ^ k : End X) = (f^[k]) :=
begin
  ext x,
  induction k with k ih,
  { simp },
  { rw nat.iterate_succ, rw ← npow_eq_pow, dsimp [monoid.npow, npow_rec], simp, congr, exact ih }
end

universe u
def restricted_yoneda_functor {C : Type u} [small_category C] {ℰ : Type*} [category ℰ]
  : (C ⥤ ℰ)ᵒᵖ ⥤ ℰ ⥤ Cᵒᵖ ⥤ Type u :=
  category_theory.functor.op_hom _ _
  ⋙ whiskering_left Cᵒᵖ ℰᵒᵖ (Type u)
  ⋙ (whiskering_left _ _ _).obj yoneda

lemma restricted_yoneda_functor_obj {C : Type u} [small_category C] {ℰ : Type*} [category ℰ]
  (A : C ⥤ ℰ) : restricted_yoneda_functor.obj (opposite.op A) = colimit_adj.restricted_yoneda A := rfl

def functor.map_cone_comp {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E)
  : cones.functoriality K (F ⋙ G)
  ≅ cones.functoriality K F
    ⋙ cones.functoriality (K ⋙ F) G
    ⋙ cones.postcompose (functor.associator K F G).hom :=
begin
  refine nat_iso.of_components _ _,
  { intro c, refine category_theory.limits.cones.ext (iso.refl _) _,
    intro j, symmetry, exact eq.trans (category.id_comp _) (category.comp_id _) },
  { intros c c' f, ext,
    exact eq.trans (category.comp_id _) (category.id_comp _).symm }
end

def functor.map_cone_map_cone {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E)
  : cones.functoriality K (F ⋙ G) ⋙ cones.postcompose (functor.associator K F G).inv
  ≅ cones.functoriality K F ⋙ cones.functoriality (K ⋙ F) G :=
  ((whiskering_right _ _ _).obj (cones.postcompose (functor.associator K F G).inv)).map_iso
    (functor.map_cone_comp K F G)
  ≪≫ ((whiskering_right _ _ _).obj (cones.postcompose (functor.associator K F G).inv)).map_iso
        (functor.associator (cones.functoriality K F) (cones.functoriality (K ⋙ F) G)
                            (cones.postcompose (K.associator F G).hom)).symm

  ≪≫ (functor.associator _ _ _)
  ≪≫ ((whiskering_left _ _ _).obj _).map_iso
        ((limits.cones.postcompose_comp _ _).symm ≪≫
          by { rw (K.associator F G).hom_inv_id, exact limits.cones.postcompose_id })
  ≪≫ (functor.right_unitor _)

def functor.map_cone_comp' {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E) (c : cone K)
  : (F ⋙ G).map_cone c
  ≅ (cones.postcompose (functor.associator K F G).hom).obj (G.map_cone (F.map_cone c)) :=
  ((evaluation _ _).obj c).map_iso (functor.map_cone_comp K F G)

def functor.map_cone_map_cone' {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E) (c : cone K)
  : (cones.postcompose (functor.associator K F G).inv).obj ((F ⋙ G).map_cone c)
  ≅ G.map_cone (F.map_cone c) :=
  ((evaluation _ _).obj c).map_iso (functor.map_cone_map_cone K F G)

def functor.map_cocone_comp {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E)
  : cocones.functoriality K (F ⋙ G)
  ≅ cocones.functoriality K F
    ⋙ cocones.functoriality (K ⋙ F) G
    ⋙ cocones.precompose (functor.associator K F G).hom :=
begin
  refine nat_iso.of_components _ _,
  { intro c, refine category_theory.limits.cocones.ext (iso.refl _) _,
    intro j,
    exact eq.trans (category.comp_id _) (category.id_comp _).symm },
  { intros c c' f, ext,
    exact eq.trans (category.comp_id _) (category.id_comp _).symm }
end

def functor.map_cocone_map_cocone {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E)
  : cocones.functoriality K (F ⋙ G) ⋙ cocones.precompose (functor.associator K F G).inv
  ≅ cocones.functoriality K F ⋙ cocones.functoriality (K ⋙ F) G :=
  ((whiskering_right _ _ _).obj (cocones.precompose (functor.associator K F G).inv)).map_iso
    (functor.map_cocone_comp K F G)
  ≪≫ ((whiskering_right _ _ _).obj (cocones.precompose (functor.associator K F G).inv)).map_iso
        (functor.associator (cocones.functoriality K F) (cocones.functoriality (K ⋙ F) G)
                            (cocones.precompose (K.associator F G).hom)).symm

  ≪≫ (functor.associator _ _ _)
  ≪≫ ((whiskering_left _ _ _).obj _).map_iso
        ((limits.cocones.precompose_comp _ _).symm ≪≫
          by { rw (K.associator F G).inv_hom_id, exact limits.cocones.precompose_id })
  ≪≫ (functor.right_unitor _)

def functor.map_cocone_comp' {J C D E : Type*} [category J] [category C] [category D] [category E]
  (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E) (c : cocone K)
  : (F ⋙ G).map_cocone c
  ≅ (cocones.precompose (functor.associator K F G).hom).obj (G.map_cocone (F.map_cocone c)) :=
  ((evaluation _ _).obj c).map_iso (functor.map_cocone_comp K F G)

def functor.map_cocone_map_cocone' {J C D E : Type*} [category J] [category C] [category D]
  [category E] (K : J ⥤ C) (F : C ⥤ D) (G : D ⥤ E) (c : cocone K)
  : (cocones.precompose (functor.associator K F G).inv).obj ((F ⋙ G).map_cocone c)
  ≅ G.map_cocone (F.map_cocone c) :=
  ((evaluation _ _).obj c).map_iso (functor.map_cocone_map_cocone K F G)

def category_theory.limits.preserves_limits_of_equiv_domain {C : Type*} [category C]
  {D : Type*} [category D] {J : Type*} [category J] {K : J ⥤ C}
  {C' : Type*} [category C'] (F : C ⥤ D) (e : C ≌ C')
  (h : preserves_limit (K ⋙ e.functor) (e.inverse ⋙ F))
  : preserves_limit K F :=
begin
  constructor, intros c hc,
  let α : K ⋙ F ≅ (K ⋙ e.functor) ⋙ (e.inverse ⋙ F) :=
  calc K ⋙ F ≅ K ⋙ (𝟭 C ⋙ F) : ((whiskering_left _ _ _).obj K).map_iso F.left_unitor.symm
          ... ≅ K ⋙ ((e.functor ⋙ e.inverse) ⋙ F) : ((whiskering_left _ _ _).obj K).map_iso
                                                          (((whiskering_right _ _ _).obj F).map_iso
                                                            e.unit_iso)
          ... ≅ K ⋙ (e.functor ⋙ (e.inverse ⋙ F)) : ((whiskering_left _ _ _).obj K).map_iso
                                                          (functor.associator _ _ _)
          ... ≅ (K ⋙ e.functor) ⋙ (e.inverse ⋙ F) : functor.associator _ _ _,
  refine is_limit.equiv_of_nat_iso_of_iso α.symm
                                          ((e.inverse ⋙ F).map_cone (e.functor.map_cone c))
                                          (F.map_cone c) _ _,
  { ext, swap, { exact F.map_iso (e.unit_iso.app c.X).symm },
    { dsimp,
      refine eq.trans (congr_arg _ (category.id_comp _))
               (eq.trans (congr_arg _ (category.id_comp _))
                 (eq.trans (congr_arg _ (category.comp_id _)) _)),
      rw [← F.map_comp, ← F.map_comp],
      refine congr_arg _ _,
      rw [← functor.comp_map],
      apply e.unit_iso.inv.naturality } },
  { destruct h, intros h' _, refine h' _,
    destruct adjunction.is_equivalence_preserves_limits e.functor, intros h'' _,
    destruct h'', intros h''' _, destruct @h''' K, intros H _,
    exact H hc, }
end.

def category_theory.limits.preserves_colimits_of_equiv_domain {C : Type*} [category C]
  {D : Type*} [category D] {J : Type*} [category J] {K : J ⥤ C}
  {C' : Type*} [category C'] (F : C ⥤ D) (e : C ≌ C')
  (h : preserves_colimit (K ⋙ e.functor) (e.inverse ⋙ F))
  : preserves_colimit K F :=
begin
  constructor, intros c hc,
  let α : K ⋙ F ≅ (K ⋙ e.functor) ⋙ (e.inverse ⋙ F) :=
  calc K ⋙ F ≅ K ⋙ (𝟭 C ⋙ F) : ((whiskering_left _ _ _).obj K).map_iso F.left_unitor.symm
          ... ≅ K ⋙ ((e.functor ⋙ e.inverse) ⋙ F) : ((whiskering_left _ _ _).obj K).map_iso
                                                          (((whiskering_right _ _ _).obj F).map_iso
                                                            e.unit_iso)
          ... ≅ K ⋙ (e.functor ⋙ (e.inverse ⋙ F)) : ((whiskering_left _ _ _).obj K).map_iso
                                                          (functor.associator _ _ _)
          ... ≅ (K ⋙ e.functor) ⋙ (e.inverse ⋙ F) : functor.associator _ _ _,
  refine is_colimit.equiv_of_nat_iso_of_iso α.symm
                                            ((e.inverse ⋙ F).map_cocone (e.functor.map_cocone c))
                                            (F.map_cocone c) _ _,
  { ext, swap, { exact F.map_iso (e.unit_iso.app c.X).symm },
    { dsimp,
      refine eq.trans (congr_arg2 _ (congr_arg2 _ (category.comp_id _) rfl) rfl)  _,
      refine eq.trans (congr_arg2 _ (congr_arg2 _ (category.comp_id _) rfl) rfl)  _,
      refine eq.trans (congr_arg2 _ (congr_arg2 _ (category.id_comp _) rfl) rfl)  _,
      rw [← F.map_comp, ← F.map_comp],
      refine congr_arg _ _,
      rw [← functor.comp_map],
      rw ← e.unit_iso.hom.naturality, simp } },
  { destruct h, intros h' _, refine h' _,
    destruct adjunction.is_equivalence_preserves_colimits e.functor, intros h'' _,
    destruct h'', intros h''' _, destruct @h''' K, intros H _,
    exact H hc, }
end.

def category_theory.limits.preserves_colimits_of_equiv_codomain {C : Type*} [category C]
  {D : Type*} [category D] {J : Type*} [category J] {K : J ⥤ C}
  {D' : Type*} [category D'] (F : C ⥤ D) (e : D ≌ D')
  (h : preserves_colimit K (F ⋙ e.functor))
  : preserves_colimit K F :=
  @limits.preserves_colimit_of_nat_iso _ _ _ _ _ _ _ _ _
    (functor.associator _ _ _ ≪≫ ((whiskering_left _ _ _).obj F).map_iso e.unit_iso.symm
                              ≪≫ functor.right_unitor _)
    (@limits.comp_preserves_colimit C _ D' _ J _ K D _ (F ⋙ e.functor) e.inverse h _)

def category_theory.iso_to_equiv {C : Type*} [category C] {D : Type*} [category D]
  (F : Cat.of C ≅ Cat.of D) : C ≌ D :=
  ⟨F.hom, F.inv, eq_to_iso (F.hom_inv_id.symm), eq_to_iso (F.inv_hom_id),
   by { intro, simp, rw category_theory.eq_to_hom_map, simp, refl }⟩.

lemma colimit_iso_colimit_cocone_desc {J C : Type*} [category J] [category C]
  (F : J ⥤ C) [has_colimit F] (c : colimit_cocone F) (c' : cocone F)
  : (colimit.iso_colimit_cocone c).inv ≫ colimit.desc F c' = c.is_colimit.desc c' :=
 by { apply c.is_colimit.hom_ext, intro j, simp }

-- universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄
-- I think the universe levels are borked :(
-- def comma.cocone_of_preserves_is_colimit'
--   {J : Type u₁} [small_category.{u₁} J] {A : Type u₂}
--   [category.{(max u₁ u₂) u₂} A] {B : Type u₃}
--   [category.{(max u₁ u₃) u₃} B] {T : Type u₄}
--   [category.{(max u₁ u₄) u₄} T] {L : A ⥤ T} {R : B ⥤ T}
--   (F : J ⥤ comma L R)
--   [preserves_colimit (F ⋙ comma.fst L R) L]
--   {c₁ : cocone (F ⋙ comma.fst L R)} (t₁ : is_colimit c₁)
--   {c₂ : cocone (F ⋙ comma.snd L R)} (t₂ : is_colimit c₂) :
--   is_colimit (comma.cocone_of_preserves.{u₁} F t₁ c₂) :=
-- { desc := λ s,
--   { left := t₁.desc ((fst L R).map_cocone s),
--     right := t₂.desc ((snd L R).map_cocone s),
--     w' := (is_colimit_of_preserves L t₁).hom_ext $ λ j,
--     begin
--       rw [cocone_of_preserves_X_hom, (is_colimit_of_preserves L t₁).fac_assoc,
--         colimit_auxiliary_cocone_ι_app, assoc, ←R.map_comp, t₂.fac, L.map_cocone_ι_app,
--         ←L.map_comp_assoc, t₁.fac],
--       exact (s.ι.app j).w,
--     end },
--   uniq' := λ s m w, comma_morphism.ext _ _
--       (t₁.uniq ((fst L R).map_cocone s) _ (by simp [←w]))
--       (t₂.uniq ((snd L R).map_cocone s) _ (by simp [←w])) }

end category_theory


import tactic.basic core data.sum tactic.rcases
universes u₁ u₂

open interactive interactive.types
open lean.parser nat tactic

meta def get_ext_subject : expr → tactic name
| (expr.pi n bi d b) :=
  do v  ← mk_local' n bi d,
     b' ← whnf $ b.instantiate_var v,
     get_ext_subject b'
| (expr.app _ e) :=
  do t ← infer_type e >>= instantiate_mvars >>= head_beta,
     if t.get_app_fn.is_constant then
       pure $ t.get_app_fn.const_name
     else if t.is_pi then
       pure $ name.mk_numeral 0 name.anonymous
     else if t.is_sort then
       pure $ name.mk_numeral 1 name.anonymous
     else do
       t ← pp t,
       fail format!"only constants and Pi types are supported: {t}"
| e := fail format!"Only expressions of the form `_ → _ → ... → R ... e are supported: {e}"

open native

@[reducible] def ext_param_type := option name ⊕ option name

meta def opt_minus : lean.parser (option name → ext_param_type) :=
sum.inl <$ tk "-" <|> pure sum.inr

meta def ext_param :=
opt_minus <*> ( name.mk_numeral 0 name.anonymous <$ brackets "(" ")" (tk "→" <|> tk "->") <|>
                none <$  tk "*" <|>
                some <$> ident )

meta def saturate_fun : name → tactic expr
| (name.mk_numeral 0 name.anonymous) :=
do v₀ ← mk_mvar,
   v₁ ← mk_mvar,
   return $ v₀.imp v₁
| (name.mk_numeral 1 name.anonymous) :=
do u ← mk_meta_univ,
   pure $ expr.sort u
| n :=
do e ← resolve_constant n >>= mk_const,
   a ← get_arity e,
   e.mk_app <$> (list.iota a).mmap (λ _, mk_mvar)

meta def equiv_type_constr (n n' : name) : tactic unit :=
do e  ← saturate_fun n,
   e' ← saturate_fun n',
   unify e e' <|> fail format!"{n} and {n'} are not definitionally equal types"

/--
 Tag lemmas of the form:

 ```
 @[extensionality]
 lemma my_collection.ext (a b : my_collection)
   (h : ∀ x, a.lookup x = b.lookup y) :
   a = b := ...
 ```

 The attribute indexes extensionality lemma using the type of the
 objects (i.e. `my_collection`) which it gets from the statement of
 the lemma.  In some cases, the same lemma can be used to state the
 extensionality of multiple types that are definitionally equivalent.

 ```
 attribute [extensionality [(→),thunk,stream]] funext
 ```

 Those parameters are cumulative. The following are equivalent:

 ```
 attribute [extensionality [(→),thunk]] funext
 attribute [extensionality [stream]] funext
 ```
 and
 ```
 attribute [extensionality [(→),thunk,stream]] funext
 ```

 One removes type names from the list for one lemma with:
 ```
 attribute [extensionality [-stream,-thunk]] funext
  ```

 Finally, the following:

 ```
 @[extensionality]
 lemma my_collection.ext (a b : my_collection)
   (h : ∀ x, a.lookup x = b.lookup y) :
   a = b := ...
 ```

 is equivalent to

 ```
 @[extensionality *]
 lemma my_collection.ext (a b : my_collection)
   (h : ∀ x, a.lookup x = b.lookup y) :
   a = b := ...
 ```

 This allows us specify type synonyms along with the type
 that referred to in the lemma statement.

 ```
 @[extensionality [*,my_type_synonym]]
 lemma my_collection.ext (a b : my_collection)
   (h : ∀ x, a.lookup x = b.lookup y) :
   a = b := ...
 ```
 -/
@[user_attribute]
meta def extensional_attribute : user_attribute (name_map name) (bool × list ext_param_type × list name × list (name × name)) :=
{ name := `extensionality,
  descr := "lemmas usable by `ext` tactic",
  cache_cfg := { mk_cache := λ ls,
                          do { attrs ← ls.mmap $ λ l,
                                     do { ⟨_,_,ls,_⟩ ← extensional_attribute.get_param l,
                                          pure $ prod.mk <$> ls <*> pure l },
                               pure $ rb_map.of_list $ attrs.join },
                 dependencies := [] },
  parser :=
    do { ls ← pure <$> ext_param <|> list_of ext_param <|> pure [],
         m ← extensional_attribute.get_cache,
         pure $ (ff,ls,[],m.to_list)  },
  after_set := some $ λ n _ b,
    do (ff,ls,_,ls') ← extensional_attribute.get_param n | pure (),
       s ← mk_const n >>= infer_type >>= get_ext_subject,
       let (rs,ls'') := if ls.empty
                           then ([],[s])
                           else ls.partition_map (sum.map (flip option.get_or_else s) (flip option.get_or_else s)),
       ls''.mmap' (equiv_type_constr s),
       let l := ls'' ∪ (ls'.filter $ λ l, prod.snd l = n).map prod.fst \ rs,
       extensional_attribute.set n (tt,[],l,[]) b }

attribute [extensionality] array.ext propext
attribute [extensionality [(→),thunk]] _root_.funext

namespace ulift
@[extensionality] lemma ext {α : Type u₁} (X Y : ulift.{u₂} α) (w : X.down = Y.down) : X = Y :=
begin
  cases X, cases Y, dsimp at w, rw w,
end
end ulift

namespace tactic

meta def try_intros : ext_patt → tactic ext_patt
| [] := try intros $> []
| (x::xs) :=
do tgt ← target >>= whnf,
   if tgt.is_pi
     then rintro [x] >> try_intros xs
     else pure (x :: xs)

meta def ext1 (xs : ext_patt) : tactic ext_patt :=
do subject ← target >>= get_ext_subject,
   m ← extensional_attribute.get_cache,
   do { rule ← m.find subject,
        applyc rule } <|>
     do { ls ← attribute.get_instances `extensionality,
          ls.any_of applyc } <|>
     fail format!"no applicable extensionality rule found for {subject}",
   try_intros xs

meta def ext : ext_patt → option ℕ → tactic unit
| _  (some 0) := skip
| xs n        := focus1 $ do
  ys ← ext1 xs, try (ext ys (nat.pred <$> n))

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

/--
  `ext1 id` selects and apply one extensionality lemma (with attribute
  `extensionality`), using `id`, if provided, to name a local constant
  introduced by the lemma. If `id` is omitted, the local constant is
  named automatically, as per `intro`.
 -/
meta def interactive.ext1 (xs : parse ext_parse) : tactic unit :=
ext1 xs $> ()

/--
  - `ext` applies as many extensionality lemmas as possible;
  - `ext ids`, with `ids` a list of identifiers, finds extentionality and applies them
    until it runs out of identifiers in `ids` to name the local constants.

  When trying to prove:

  ```
  α β : Type,
  f g : α → set β
  ⊢ f = g
  ```

  applying `ext x y` yields:

  ```
  α β : Type,
  f g : α → set β,
  x : α,
  y : β
  ⊢ y ∈ f x ↔ y ∈ f x
  ```

  by applying functional extensionality and set extensionality.

  A maximum depth can be provided with `ext x y z : 3`.
  -/
meta def interactive.ext : parse ext_parse → parse (tk ":" *> small_nat)? → tactic unit
 | [] (some n) := iterate_range 1 n (ext1 [] $> ())
 | [] none     := repeat1 (ext1 [] $> ())
 | xs n        := tactic.ext xs n

end tactic


/-
Copyright (c) 2016 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Sebastian Ullrich

Classy functions for lifting monadic actions of different shapes.

This theory is roughly modeled after the Haskell 'layers' package https://hackage.haskell.org/package/layers-0.1.
Please see https://hackage.haskell.org/package/layers-0.1/docs/Documentation-Layers-Overview.html for an exhaustive discussion of the different approaches to lift functions.

! This file was ported from Lean 3 source module init.control.lift
! leanprover-community/mathlib commit 9af482290ef68e8aaa5ead01aa7b09b7be7019fd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Function
import Leanbin.Init.Coe
import Leanbin.Init.Control.Monad

universe u v w

/-- A function for lifting a computation from an inner monad to an outer monad.
    Like [MonadTrans](https://hackage.haskell.org/package/transformers-0.5.5.0/docs/Control-Monad-Trans-Class.html),
    but `n` does not have to be a monad transformer.
    Alternatively, an implementation of [MonadLayer](https://hackage.haskell.org/package/layers-0.1/docs/Control-Monad-Layer.html#t:MonadLayer) without `layerInvmap` (so far). -/
class HasMonadLift (m : Type u → Type v) (n : Type u → Type w) where
  monadLift : ∀ {α}, m α → n α
#align has_monad_lift HasMonadLift

/-- The reflexive-transitive closure of `has_monad_lift`.
    `monad_lift` is used to transitively lift monadic computations such as `state_t.get` or `state_t.put s`.
    Corresponds to [MonadLift](https://hackage.haskell.org/package/layers-0.1/docs/Control-Monad-Layer.html#t:MonadLift). -/
class HasMonadLiftT (m : Type u → Type v) (n : Type u → Type w) where
  monadLift : ∀ {α}, m α → n α
#align has_monad_lift_t HasMonadLiftT

export HasMonadLiftT (monadLift)

/-- A coercion that may reduce the need for explicit lifting.
    Because of [limitations of the current coercion resolution](https://github.com/leanprover/lean/issues/1402), this definition is not marked as a global instance and should be marked locally instead. -/
@[reducible]
def hasMonadLiftToHasCoe {m n} [HasMonadLiftT m n] {α} : Coe (m α) (n α) :=
  ⟨monadLift⟩
#align has_monad_lift_to_has_coe hasMonadLiftToHasCoe

instance (priority := 100) hasMonadLiftTTrans (m n o) [HasMonadLiftT m n] [HasMonadLift n o] :
    HasMonadLiftT m o :=
  ⟨fun α ma => HasMonadLift.monadLift (monadLift ma : n α)⟩
#align has_monad_lift_t_trans hasMonadLiftTTrans

instance hasMonadLiftTRefl (m) : HasMonadLiftT m m :=
  ⟨fun α => id⟩
#align has_monad_lift_t_refl hasMonadLiftTRefl

@[simp]
theorem monadLift_refl {m : Type u → Type v} {α} : (monadLift : m α → m α) = id :=
  rfl
#align monad_lift_refl monadLift_refl

/- warning: monad_functor -> MonadFunctor is a dubious translation:
lean 3 declaration is
  (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u3}) -> (Type.{u1} -> Type.{u3}) -> Sort.{max (succ (succ u1)) (succ u2) (succ u3)}
but is expected to have type
  (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u3}) -> Sort.{max (max (succ (succ u1)) (succ u2)) (succ u3)}
Case conversion may be inaccurate. Consider using '#align monad_functor MonadFunctorₓ'. -/
/-- A functor in the category of monads. Can be used to lift monad-transforming functions.
    Based on pipes' [MFunctor](https://hackage.haskell.org/package/pipes-2.4.0/docs/Control-MFunctor.html),
    but not restricted to monad transformers.
    Alternatively, an implementation of [MonadTransFunctor](http://duairc.netsoc.ie/layers-docs/Control-Monad-Layer.html#t:MonadTransFunctor). -/
class MonadFunctor (m m' : Type u → Type v) (n n' : Type u → Type w) where
  monadMap {α : Type u} : (∀ {α}, m α → m' α) → n α → n' α
#align monad_functor MonadFunctor

/- warning: monad_functor_t -> MonadFunctorT is a dubious translation:
lean 3 declaration is
  (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u3}) -> (Type.{u1} -> Type.{u3}) -> Sort.{max (succ (succ u1)) (succ u2) (succ u3)}
but is expected to have type
  (Type.{u1} -> Type.{u2}) -> (Type.{u1} -> Type.{u3}) -> Sort.{max (max (succ (succ u1)) (succ u2)) (succ u3)}
Case conversion may be inaccurate. Consider using '#align monad_functor_t MonadFunctorTₓ'. -/
/-- The reflexive-transitive closure of `monad_functor`.
    `monad_map` is used to transitively lift monad morphisms such as `state_t.zoom`.
    A generalization of [MonadLiftFunctor](http://duairc.netsoc.ie/layers-docs/Control-Monad-Layer.html#t:MonadLiftFunctor), which can only lift endomorphisms (i.e. m = m', n = n'). -/
class MonadFunctorT (m m' : Type u → Type v) (n n' : Type u → Type w) where
  monadMap {α : Type u} : (∀ {α}, m α → m' α) → n α → n' α
#align monad_functor_t MonadFunctorT

export MonadFunctorT (monadMap)

instance (priority := 100) monadFunctorTTrans (m m' n n' o o') [MonadFunctorT m m' n n']
    [MonadFunctor n n' o o'] : MonadFunctorT m m' o o' :=
  ⟨fun α f => MonadFunctor.monadMap fun α => (monadMap @f : n α → n' α)⟩
#align monad_functor_t_trans monadFunctorTTrans

instance monadFunctorTRefl (m m') : MonadFunctorT m m' m m' :=
  ⟨fun α f => f⟩
#align monad_functor_t_refl monadFunctorTRefl

@[simp]
theorem monadMap_refl {m m' : Type u → Type v} (f : ∀ {α}, m α → m' α) {α} :
    (monadMap @f : m α → m' α) = f :=
  rfl
#align monad_map_refl monadMap_refl

/-- Run a monad stack to completion.
    `run` should be the composition of the transformers' individual `run` functions.
    This class mostly saves some typing when using highly nested monad stacks:
    ```
    @[reducible] def my_monad := reader_t my_cfg $ state_t my_state $ except_t my_err id
    -- def my_monad.run {α : Type} (x : my_monad α) (cfg : my_cfg) (st : my_state) := ((x.run cfg).run st).run
    def my_monad.run {α : Type} (x : my_monad α) := monad_run.run x
    ```
    -/
class MonadRun (out : outParam <| Type u → Type v) (m : Type u → Type v) where
  run {α : Type u} : m α → out α
#align monad_run MonadRun

export MonadRun (run)


import Lean
import Lean.Parser.Term

open Lean Elab Command Term Meta

namespace SumMacro

-- The Prismatic class lets you move between a sum type and its subtypes
-- For instance if you had a sum type X := A | B then
--  > inject goes from A → X or B → X
--  > project goes from X → Option A or X → Option B
class Prismatic (e : Type → Type) (u : Type → Type v) where
    inject : e α → u α
    project : u α → Option (e α)

-- Given a sum type we need a way to label each branch of the sum type.
-- For example given X := A | B we need to generate contructors for A and B.
-- For normal sum types these are usually Left and Right, but one reason to use
-- macros is so that the names are a little more readable.
-- Typically the subtype name is just the name of the subtype, assuming
-- the subtype is just an identifier indicating some type. However, you can
-- actually pass in an expression as a subtype. We need a way to generate
-- an ID for that expression that is (mostly) unique and also repeatable
-- for that expression (thus we can't just generate random names).
partial
def compileSubId : Syntax → Name := fun subterm =>
    match subterm with
    | .missing => "missing_"
    | .node _ kind args =>
        if kind == strLitKind
        then compileSubId args[0]!
        -- ignore parenthesis
        else if kind == ``Lean.Parser.Term.paren
        then compileSubId args[1]!
        -- for parameterized types we merge the function and its argument
        else if kind == ``Lean.Parser.Term.app
        then
            let fName := compileSubId args[0]!
            let argNames := compileSubId args[1]!
            fName ++ argNames
        -- if we didn't handle the term already we just punt and try
        -- to fold together all the sub nodes, ignoring null or empty values
        else if args.size > 0
        then Array.foldl (fun x y =>
                              let y' := compileSubId y
                              if x == ""
                              then compileSubId y
                              else if y' == "null"
                              then x
                              else x ++ y') "" args
        else if kind == `null
        then "null"
        else toString kind
    | .atom _ val => val
    | .ident _ _ val _ => val

def sumCtorName2 : Ident → Term → Name := fun sumid subterm => sumid.getId ++ Name.appendAfter (compileSubId subterm) "select"

-- to generate the sum type we basically need to generate constructors for each subtype
-- and then tie it all together with an inductive view.
def elabSumI (sumid : Ident) (subids : Syntax.TSepArray `term ",") : CommandElabM Unit := do
    let subvals : Array (TSyntax `term) := subids
    let toCtor : Term → CommandElabM CtorView :=
      fun subterm => do
        let ty ← `({x : Type} → $subterm x → $sumid x)
        pure { ref := default,
                modifiers := default,
                declName := sumCtorName2 sumid subterm,
                binders := Syntax.missing,
                type? := ty
                }
    let subCtors : Array CtorView ← Array.sequenceMap subvals toCtor
    let indView : InductiveView := {
        ref := default,
        modifiers := {docString? := "argh"},
        declId := sumid,
        shortDeclName := sumid.getId,
        declName      := sumid.getId,
        levelNames := [],
        binders := Syntax.missing,
        type? := (← `(Type → Type 1)),
        ctors := subCtors,
        derivingClasses := #[],
        computedFields := #[]
        }
    elabInductiveViews #[indView]

-- you can make the sum type directly using mkSumI but typically you use
-- mkSumType which also generates prismatic instances
elab "mkSumI" sumid:ident " o: " subids:term,+ ":o" : command => elabSumI sumid subids

def elabPrismatic (sumid : Ident) (subterm: Term) : CommandElabM Unit := do
    let ctorName : Ident := Lean.mkIdent <| sumCtorName2 sumid subterm
    let instanceCmd ←
      `(instance  : Prismatic $subterm ($sumid) where
          inject := fun sx => $ctorName sx
          project := fun bx => match bx with
                                | $ctorName sx => Option.some sx
                                | _ => Option.none)
    elabCommand instanceCmd

elab "mkPrismatic" sumid:ident subid:term : command => elabPrismatic sumid subid

elab "mkSumType" sumid:ident " >| " subids:term,+ " |< " : command => do
    elabSumI sumid subids
    let mkP := fun subterm => elabPrismatic sumid subterm
    Array.forM mkP (subids : Array Term)

def elabCollapse (collapsertarget : TSyntax `term) (sumid : Ident) (subids: Syntax.TSepArray `term sep) (collapsers : Syntax.TSepArray `term sep) : TermElabM Expr := do
    let evalBranch : (TSyntax `term × TSyntax `term) → TermElabM (TSyntax `Lean.Parser.Term.matchAlt) := fun ⟨subval, collapser⟩ => do
        let ctorName := Lean.mkIdent <| sumCtorName2 sumid subval
        `(Parser.Term.matchAltExpr| | $ctorName x => $collapser x)
    let subidsArray : Array (TSyntax `term) := subids
    let collapsersArray : Array (TSyntax `term) := collapsers
    let branches ← Array.sequenceMap (Array.zip subidsArray collapsersArray) evalBranch
    let collapserFunc ← `(fun {α : Type} (sumVal : $sumid α) => (match sumVal with $branches:matchAlt* : $collapsertarget α))
    elabTerm collapserFunc Option.none

elab "buildInterpreter" commandtype:ident targetmonad:ident subids:term,+ " [: " collapsers:term,+ " :] " : term =>
    elabCollapse targetmonad commandtype subids collapsers

/-
namespace x

inductive OtherI (y : Type) where
  | A : y → OtherI y
  | C : y → y → OtherI y
    deriving Repr

inductive EcksI (x : Type) (y : Type) where
| X : x → y → EcksI x y
-/
/-
mkSumI Argh o: (EcksI Nat),OtherI :o
mkPrismatic Argh (EcksI Nat)
mkPrismatic Argh OtherI

mkSumType Argh >| EcksI Nat, OtherI |<

def collapserArgh := buildInterpreter Argh IO (EcksI Nat),OtherI
    [:
      (fun s => match s with
                | EcksI.X x y => pure y),
      (fun o => match o with
                | OtherI.A y => pure y
                | OtherI.C a b => pure b)
    :]

open Prismatic

def aVal : Argh Nat := inject <| EcksI.X 3 4
end x

-/

/-#print Argh
#check Argh.EcksI.Natselect (EcksI.X 3 4)
#check @Prismatic.inject (EcksI Nat) Argh _ Nat (EcksI.X 3 5)
#check (Prismatic.inject (EcksI.X 3 7) : Argh Nat)
#check blargh aVal
-/

end SumMacro


/-
Copyright (c) E.W.Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Author: E.W.Ayers
-/
prelude
import init.function
import init.data.option.basic
import init.util
import init.meta.tactic
import init.meta.mk_dec_eq_instance
import init.meta.json

/-! A component is a piece of UI which may contain internal state. Use component.mk to build new components.

## Using widgets.

To make a widget, you need to make a custom executor object and then instead of calling `save_info_thunk` you call `save_widget`.

Additionally, you will need a compatible build of the vscode extension or web app to use widgets in vscode.

## How it works:

The design is inspired by React.
If you are familiar with using React or Elm or a similar functional UI framework then that's helpful for this.
The [React article on reconciliation](https://reactjs.org/docs/reconciliation.html) might be helpful.

One can imagine making a UI for a particular object as just being a function `f : α → UI` where `UI` is some inductive datatype for buttons, textboxes, lists and so on.
The process of evaluating `f` is called __rendering__.
So for example `α` could be `tactic_state` and the function renders a goal view.

## HTML

For our purposes, `UI` is an HTML tree and is written `html α : Type`. I'm going to assume some familiarity with HTML for the purposes of this document.
An HTML tree is composed of elements and strings.
Each element has a tag such as "div", "span", "article" and so on and a set of attributes and child html.
Use the helper function `h : string → list (attr α) → list (html α) → html α` to build new pieces of `html`. So for example:

```lean
h "ul" [] [
     h "li" [] ["this is list item 1"],
     h "li" [style [("color", "blue")]] ["this is list item 2"],
     h "hr" [] [],
     h "li" [] [
          h "span" [] ["there is a button here"],
          h "button" [on_click (λ _, 3)] ["click me!"]
     ]
]
```
Has the type `html nat`.
The `nat` type is called the __action__ and whenever the user interacts with the UI, the html will emit an object of type `nat`.
So for example if the user clicks the button above, the html will 'emit' `3`.
The above example is compiled to the following piece of html:

```html
<ul>
  <li>this is list item 1</li>
  <li style="{ color: blue; }">this is list item 2</li>
  <hr/>
  <li>
     <span>There is a button here</span>
     <button onClick="[handler]">click me!</button>
  </li>
</ul>
```

## Components

In order for the UI to react to events, you need to be able to take these actions α and alter some state.
To do this we use __components__. `component` takes two type arguments: `π` and `α`. `α` is called the 'action' and `π` are the 'props'.
The props can be thought of as a kind of wrapped function domain for `component`. So given `C : component nat α`, one can turn this into html with
`html.of_component 4 C : html α`.

The base constructor for a component is `pure`:
```lean
meta def Hello : component string α := component.pure (λ s, ["hello, ", s, ", good day!"])

#html Hello "lean" -- renders "hello, lean, good day!"
```
So here a pure component is just a simple function `π → list (html α)`.
However, one can augment components with __hooks__.
The hooks available for compoenents are listed in the inductive definition for component.

Here we will just look at the `with_state` hook, which can be used to build components with inner state.

```
meta inductive my_action
| increment
| decrement
open my_action

meta def Counter : component unit α :=
component.with_state
     my_action          -- the action of the inner component
     int                -- the state
     (λ _, 0)           -- initialise the state
     (λ _ _ s, s)       -- update the state if the props change
     (λ _ s a,          -- update the state if an action was received
          match a with
          | increment := (s + 1, none) -- replace `none` with `some _` to emit an action
          | decrement := (s - 1, none)
          end
     )
$ component.pure (λ ⟨state, ⟨⟩⟩, [
     button "+" (λ _, increment),
     to_string state,
     button "-" (λ _, decrement)
  ])

#html Counter ()
```

You can add many hooks to a component.

- `filter_map_action` lets you filter or map actions that are emmitted by the component
- `map_props` lets you map the props.
- `with_should_update` will not re-render the child component if the given test returns false. This can be useful for efficiency.
- `with_state` discussed above.`
- `with_mouse` subscribes the component to the mouse state, for example whether or not the mouse is over the component. See the `tests/lean/widget/widget_mouse.lean` test for an example.

Given an active document, Lean (in server mode) maintains a set of __widgets__ for the document.
A widget is a component `c`, some `p : Props` and an internal state-manager which manages the states
of the component and subcomponents and also handles the routing of events from the UI.

## Reconciliation

If a parent component's state changes, this can cause child components to change position or to appear and dissappear.
However we want to preserve the state of these child components where we can.
The UI system will try to match up these child components through a process called __reconciliation__.

Reconciliation will make sure that the states are carried over correctly and will also not rerender subcomponents if they haven't changed their props or state.
To compute whether two components are the same, the system will perform a hash on their VM objects.
Not all VM objects can be hashed, so it's important to make sure that any items that you expect to change over the lifetime of the component are fed through the 'Props' argument.
This is why we need the props argument on `component`.
The reconciliation engine uses the `props_eq` predicate passed to the component constructor to determine whether the props have changed and hence whether the component should be re-rendered.

## Keys

If you have some list of components and the list changes according to some state, it is important to add keys to the components so
that if two components change order in the list their states are preserved.
If you don't provide keys or there are duplicate keys then you may get some strange behaviour in both the Lean widget engine and react.

It is possible to use incorrect HTML tags and attributes, there is (currently) no type checking that the result is a valid piece of HTML.
So for example, the client widget system will error if you add a `text_change_event` attribute to anything other than an element tagged with `input`.

## Styles with Tachyons

The widget system assumes that a stylesheet called 'tachyons' is present.
You can find documentation for this stylesheet at [Tachyons.io](http://tachyons.io/).
Tachyons was chosen because it is very terse and allows arbitrary styling without using inline styles and without needing to dynamically load a stylesheet.

## Further work (up for grabs!)

- Add type checking for html.
- Better error handling when the html tree is malformed.
- Better error handling when keys are malformed.
- Add a 'with_task' which lets long-running operations (eg running `simp`) not block the UI update.
- Timers, animation (ambitious).
- More event handlers
- Drag and drop support.
- The current perf bottleneck is sending the full UI across to the server for every update.
  Instead, it should be possible to send a smaller [JSON Patch](http://jsonpatch.com).
  Which is already supported by `json.hpp` and javascript ecosystem.

-/

namespace widget

inductive mouse_event_kind
| on_click
| on_mouse_enter
| on_mouse_leave

/-- An effect is some change that the widget makes outside of its own state.
Usually, giving instructions to the editor to perform some task.
- `insert_text_relative` will insert at a line relative to the position of the widget.
- `insert_text_absolute` will insert text at the precise position given.
- `reveal_position` will move the editor to view the given position.
- `highlight_position` will add a text highlight to the given position.
- `clear_highlighting` will remove all highlights created with `highlight_position`.
- `copy_text` will copy the given text to the clipboard.
- `custom` can be used to pass custom effects to the client without having to recompile Lean.
-/
meta inductive effect : Type
| insert_text_absolute (file_name : option string) (p : pos) (text : string)
| insert_text_relative (relative_line : int) (text : string)
| reveal_position (file_name : option string) (p : pos)
| highlight_position (file_name : option string) (p : pos)
| clear_highlighting
| copy_text (text : string)
| custom (key : string) (value : string)

meta def effects := list effect

meta mutual inductive component, html, attr

with component : Type → Type → Type
| pure
     {Props Action : Type}
     (view : Props → list (html Action))
     : component Props Action
| filter_map_action
     {Props InnerAction OuterAction}
     (action_map : Props → InnerAction → option OuterAction)
     : component Props InnerAction → component Props OuterAction
| map_props
     {Props1 Props2 Action}
     (map : Props2 → Props1)
     : component Props1 Action → component Props2 Action
| with_should_update
     {Props Action : Type}
     (should_update : Π (old new : Props), bool)
     : component Props Action → component Props Action
| with_state
     {Props Action : Type}
     (InnerAction State : Type)
     (init : Props → State)
     (props_changed : Props → Props → State → State)
     (update : Props → State → InnerAction → State × option Action)
     : component (State × Props) InnerAction → component Props Action
| with_effects
     {Props Action : Type}
     (emit : Props → Action → effects)
     : component Props Action → component Props Action

with html : Type → Type
| element      {α : Type} (tag : string) (attrs : list (attr α)) (children : list (html α)) : html α
| of_string    {α : Type} : string → html α
| of_component {α : Type} {Props : Type} : Props → component Props α → html α

with attr : Type → Type
| val               {α : Type} (name : string) (value : json) : attr α
| mouse_event       {α : Type} (kind : mouse_event_kind) (handler : unit → α) : attr α
| style             {α : Type} : list (string × string) → attr α
| tooltip           {α : Type} : html α → attr α
| text_change_event {α : Type} (handler : string → α) : attr α

variables {α β : Type} {π : Type}

namespace component

meta def map_action (f : α → β) : component π α → component π β
| c := filter_map_action (λ p a, some $ f a) c

/-- Returns a component that will never trigger an action. -/
meta def ignore_action : component π α → component π β
| c := component.filter_map_action (λ p a, none) c

meta def ignore_props : component unit α → component π α
| c := with_should_update (λ a b, ff) $ component.map_props (λ p, ()) c

meta instance : has_coe (component π empty) (component π α) :=
⟨component.filter_map_action (λ p x, none)⟩

meta instance : has_coe_to_fun (component π α) (λ c, π → html α) :=
⟨λ c p, html.of_component p c⟩

meta def stateful {π α : Type}
     (β σ : Type)
     (init : π → option σ → σ)
     (update : π → σ → β → σ × option α)
     (view : π → σ → list (html β))
     : component π α :=
with_state β σ (λ p, init p none) (λ _ p s, init p $ some s) update (component.pure (λ ⟨s,p⟩, view p s))

meta def stateless {π α : Type} [decidable_eq π] (view : π → list (html α)) : component π α :=
component.with_should_update (λ p1 p2, p1 ≠ p2)
$ component.pure view

/-- Causes the component to only update on a props change when `test old_props new_props` yields `ff`. -/
meta def with_props_eq (test : π → π → bool) : component π α → component π α
| c := component.with_should_update (λ x y, bnot $ test x y) c

end component

meta mutual def attr.map_action, html.map_action (f : α → β)
with attr.map_action : attr α → attr β
| (attr.val k v) := attr.val k v
| (attr.style s) := attr.style s
| (attr.tooltip h) := attr.tooltip $ html.map_action h
| (attr.mouse_event k a) := attr.mouse_event k (f ∘ a)
| (attr.text_change_event a) := attr.text_change_event (f ∘ a)
with html.map_action : html α → html β
| (html.element t a c) := html.element t (list.map attr.map_action a) (list.map html.map_action c)
| (html.of_string s) := html.of_string s
| (html.of_component p c) := html.of_component p $ component.map_action f c

meta instance attr.is_functor : functor attr :=
{ map := @attr.map_action }

meta instance html.is_functor : functor html :=
{ map := λ _ _, html.map_action }

namespace html

/-- See Note [use has_coe_t]. -/
meta instance to_string_coe [has_to_string β] : has_coe_t β (html α) :=
⟨html.of_string ∘ to_string⟩

meta instance : has_emptyc (html α) := ⟨of_string ""⟩

meta instance list_coe : has_coe (html α) (list (html α)) := ⟨λ x, [x]⟩

end html

meta def as_element : html α → option (string × list (attr α) × list (html α))
| (html.element t a c) := some ⟨t,a,c⟩
| _ := none

meta def key [has_to_string β] : β → attr α
| s := attr.val "key" $ to_string s

meta def className : string → attr α
| s := attr.val "className" $ s

meta def on_click : (unit → α) → attr α
| a := attr.mouse_event mouse_event_kind.on_click a

meta def on_mouse_enter : (unit → α) → attr α
| a := attr.mouse_event mouse_event_kind.on_mouse_enter a

meta def on_mouse_leave : (unit → α) → attr α
| a := attr.mouse_event mouse_event_kind.on_mouse_leave a

/-- Alias for `html.element`. -/
meta def h : string → list (attr α) → list (html α) → html α := html.element
/-- Alias for className. -/
meta def cn : string → attr α := className

meta def button : string → thunk α → html α
| s t := h "button" [on_click t] [s]

meta def textbox : string → (string → α) → html α
| s t := h "input" [attr.val "type" "text", attr.val "value" s, attr.text_change_event t] []

meta structure select_item (α : Type) :=
(result : α)
(key : string)
(view : list (html α))

/-- Choose from a dropdown selection list. -/
meta def select {α} [decidable_eq α] : list (select_item α) → α → html α
| items value :=
     let k := match list.filter (λ i, select_item.result i = value) items with
              | [] := "" | (h::_) := select_item.key h
              end in
     h "select" [
          attr.val "value" k,
          attr.val "key" k,
          attr.text_change_event (λ k,
               match items.filter (λ i, select_item.key i = k) with
               | [] := undefined
               | (h::_) := h.result
               end
          )]
     $ items.map (λ i, h "option" [attr.val "value" i.key] $ select_item.view i)

/-- If the html is not an of_element it will wrap it in a div. -/
meta def with_attrs : list (attr α) →  html α → html α
| a x := match as_element x with
         | (some ⟨t,as,c⟩) := html.element t (a ++ as) c
         | none := html.element "div" a [x]
         end

/-- If the html is not an of_element it will wrap it in a div. -/
meta def with_attr : attr α →  html α → html α
| a x := with_attrs [a] x

meta def with_style : string → string → html α → html α
| k v h := with_attr (attr.style [(k,v)]) h

meta def with_cn : string → html α → html α
| s h := with_attr (className s) h

meta def with_key {β} [has_to_string β] : β → html α → html α
| s h := with_attr (key s) h

meta def effect.insert_text : string → effect :=
effect.insert_text_relative 0

end widget

namespace tactic

/-- Same as `tactic.save_info_thunk` except saves a widget to be displayed by a compatible infoviewer. -/
meta constant save_widget : pos → widget.component tactic_state empty → tactic unit

/-- Outputs a widget trace position at the given position. -/
meta constant trace_widget_at (p : pos) (w : widget.component tactic_state empty)
     (text := "(widget)") : tactic unit

/-- Outputs a widget trace position at the current default trace position. -/
meta def trace_widget (w : widget.component tactic_state empty) (text := "(widget)") : tactic unit :=
do p ← get_trace_msg_pos, trace_widget_at p w text

end tactic


import Lean.Elab.Tactic.ElabTerm
import Lean.Elab.Tactic.Conv.Basic

namespace Lean.Elab.Tactic.Conv
open Meta

syntax (name := print_lhs) "print_lhs" : conv
syntax (name := print_rhs) "print_rhs" : conv
syntax (name := add_id) "add_id" : conv
syntax (name := add_foo) "add_foo" : conv

@[tactic print_lhs] def printLhs : Tactic := fun stx => do
  match stx with
  | `(conv| print_lhs) => do
    let lhs ← getLhs
    IO.println lhs
    -- dbg_trace lhs
  | _ => throwUnsupportedSyntax

@[tactic print_rhs] def printRhs : Tactic := fun stx => do
  match stx with
  | `(conv| print_rhs) => do
    let rhs ← getRhs
    IO.println rhs
    -- dbg_trace rhs
  | _ => throwUnsupportedSyntax

theorem id_eq {α} (a : α) : a = id a := by rfl

@[tactic add_id] def addId : Tactic := fun stx => do
  match stx with
  | `(conv| add_id) => do
    let lhs ← getLhs
    let lhs' ← mkAppM `id #[lhs]
    let eq ← mkAppM `Lean.Elab.Tactic.Conv.id_eq #[lhs]
    updateLhs lhs' eq
    -- dbg_trace rhs
  | _ => throwUnsupportedSyntax

-- @[irreducible]
def foo {α} (a : α) := a

@[tactic add_foo] def addFoo : Tactic := fun stx => do
  match stx with
  | `(conv| add_foo) => do
    let lhs ← getLhs
    let lhs' ← mkAppM `Lean.Elab.Tactic.Conv.foo #[lhs]
    let eqGoal ← mkFreshExprSyntheticOpaqueMVar (← mkEq lhs' lhs)

    updateLhs lhs' eqGoal

    replaceMainGoal [eqGoal.mvarId!, (← getMainGoal)]
  | _ => throwUnsupportedSyntax

example (x y z : Nat) : (x + y) + z = (x + (foo y + z)) :=
by
  conv =>
    enter [1,1,2]
    add_foo; (tactic => unfold foo; rfl)

  .
  apply Nat.add_assoc
  done


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/

/-!

# Project directory locator

We use the dummy declaration in this file to locate the project directory of mathlib.

-/

/-- This is a dummy declaration that is used to determine the project folder of mathlib, using the
  tactic `tactic.decl_olean`. This is used in `tactic.get_mathlib_dir`. -/
lemma mathlib_dir_locator : true := trivial


import classes.unrestricted.basics.definition

variables {T : Type} {g : grammar T}

/-- The relation `grammar_derives` is reflexive. -/
lemma grammar_deri_self {w : list (symbol T g.nt)} :
  grammar_derives g w w :=
relation.refl_trans_gen.refl

lemma grammar_deri_of_tran {v w : list (symbol T g.nt)} :
  grammar_transforms g v w → grammar_derives g v w :=
relation.refl_trans_gen.single

/-- The relation `grammar_derives` is transitive. -/
lemma grammar_deri_of_deri_deri {u v w : list (symbol T g.nt)}
    (huv : grammar_derives g u v) (hvw : grammar_derives g v w) :
  grammar_derives g u w :=
relation.refl_trans_gen.trans huv hvw

lemma grammar_deri_of_deri_tran {u v w : list (symbol T g.nt)}
    (huv : grammar_derives g u v) (hvw : grammar_transforms g v w) :
  grammar_derives g u w :=
grammar_deri_of_deri_deri huv (grammar_deri_of_tran hvw)

lemma grammar_deri_of_tran_deri {u v w : list (symbol T g.nt)}
    (huv : grammar_transforms g u v) (hvw : grammar_derives g v w) :
  grammar_derives g u w :=
grammar_deri_of_deri_deri (grammar_deri_of_tran huv) hvw

lemma grammar_tran_or_id_of_deri {u w : list (symbol T g.nt)} (ass : grammar_derives g u w) :
  (u = w) ∨
  (∃ v : list (symbol T g.nt), (grammar_transforms g u v) ∧ (grammar_derives g v w)) :=
relation.refl_trans_gen.cases_head ass

lemma grammar_deri_with_prefix {w₁ w₂ : list (symbol T g.nt)}
    (pᵣ : list (symbol T g.nt))
    (ass : grammar_derives g w₁ w₂) :
  grammar_derives g (pᵣ ++ w₁) (pᵣ ++ w₂) :=
begin
  induction ass with x y trash hyp ih,
  {
    apply grammar_deri_self,
  },
  apply grammar_deri_of_deri_tran,
  {
    exact ih,
  },
  rcases hyp with ⟨r, rin, u, v, h_bef, h_aft⟩,
  use r,
  split,
  {
    exact rin,
  },
  use pᵣ ++ u,
  use v,
  rw h_bef,
  rw h_aft,
  split;
  simp only [list.append_assoc],
end

lemma grammar_deri_with_postfix {w₁ w₂ : list (symbol T g.nt)}
    (pₒ : list (symbol T g.nt))
    (ass : grammar_derives g w₁ w₂) :
  grammar_derives g (w₁ ++ pₒ) (w₂ ++ pₒ) :=
begin
  induction ass with x y trash hyp ih,
  {
    apply grammar_deri_self,
  },
  apply grammar_deri_of_deri_tran,
  {
    exact ih,
  },
  rcases hyp with ⟨r, rin, u, v, h_bef, h_aft⟩,
  use r,
  split,
  {
    exact rin,
  },
  use u,
  use v ++ pₒ,
  rw h_bef,
  rw h_aft,
  split;
  simp only [list.append_assoc],
end

def as_terminal {N : Type} : symbol T N → option T
| (symbol.terminal t)    := some t
| (symbol.nonterminal _) := none

def all_used_terminals (g : grammar T) : list T :=
list.filter_map as_terminal (list.join (list.map grule.output_string g.rules))


import tactic.lint
import algebra.ring.basic

open tactic

def foo1 (n m : ℕ) : ℕ := n + 1
def foo2 (n m : ℕ) : m = m := by refl
lemma foo3 (n m : ℕ) : ℕ := n - m
lemma foo.foo (n m : ℕ) : n ≥ n := le_refl n
instance bar.bar : has_add ℕ := by apply_instance  -- we don't check the name of instances
lemma foo.bar (ε > 0) : ε = ε := rfl -- >/≥ is allowed in binders (and in fact, in all hypotheses)
/-- Test exception in `def_lemma` linter. -/
@[pattern] def my_exists_intro := @Exists.intro

meta def fold_over_with_cond {α} (l : list declaration) (tac : declaration → tactic (option α)) :
  tactic (list (declaration × α)) :=
l.mmap_filter $ λ d, option.map (λ x, (d, x)) <$> tac d

run_cmd do
  let t := name × list ℕ,
  e ← get_env,
  let l := e.filter (λ d, e.in_current_file d.to_name ∧ ¬ d.is_auto_or_internal e),
  l2 ← fold_over_with_cond l (return ∘ check_unused_arguments),
  guard (l2.length = 4) <|> fail "wrong length",
  let l2 : list (name × list ℕ) := l2.map (λ x, ⟨x.1.to_name, x.2⟩),
  guard ((⟨`foo1, [2]⟩ : t) ∈ l2) <|> fail "foo1",
  guard ((⟨`foo2, [1]⟩ : t) ∈ l2) <|> fail "foo2",
  guard ((⟨`foo.foo, [2]⟩ : t) ∈ l2) <|> fail "foofoo",
  guard ((⟨`foo.bar, [2]⟩ : t) ∈ l2) <|> fail "foobar",
  l2 ← fold_over_with_cond l linter.def_lemma.test,
  guard $ l2.length = 2,
  let l2 : list (name × _) := l2.map $ λ x, ⟨x.1.to_name, x.2⟩,
  guard $ ∃(x ∈ l2), (x : name × _).1 = `foo2,
  guard $ ∃(x ∈ l2), (x : name × _).1 = `foo3,
  l3 ← fold_over_with_cond l linter.dup_namespace.test,
  guard $ l3.length = 1,
  guard $ ∃(x ∈ l3), (x : declaration × _).1.to_name = `foo.foo,
  l4 ← fold_over_with_cond l linter.ge_or_gt.test,
  guard $ l4.length = 1,
  guard $ ∃(x ∈ l4), (x : declaration × _).1.to_name = `foo.foo,
  -- guard $ ∃(x ∈ l4), (x : declaration × _).1.to_name = `foo4,
  (_, s) ← lint ff,
  guard $ "/- (slow tests skipped) -/\n".is_suffix_of s.to_string,
  (_, s2) ← lint tt,
  guard $ s.to_string ≠ s2.to_string,
  skip

/- check customizability and nolint -/

meta def dummy_check (d : declaration) : tactic (option string) :=
return $ if d.to_name.last = "foo" then some "gotcha!" else none

meta def linter.dummy_linter : linter :=
{ test := dummy_check,
  auto_decls := ff,
  no_errors_found := "found nothing.",
  errors_found := "found something:" }

@[nolint dummy_linter]
def bar.foo : (if 3 = 3 then 1 else 2) = 1 := if_pos (by refl)

run_cmd do
  (_, s) ← lint tt lint_verbosity.medium [`linter.dummy_linter] tt,
  guard $ "/- found something: -/\n#check @foo.foo /- gotcha! -/\n".is_suffix_of s.to_string

def incorrect_type_class_argument_test {α : Type} (x : α) [x = x] [decidable_eq α] [group α] :
  unit := ()

run_cmd do
  d ← get_decl `incorrect_type_class_argument_test,
  x ← linter.incorrect_type_class_argument.test d,
  guard $ x = some "These are not classes. argument 3: [_inst_1 : x = x]"

section
def impossible_instance_test {α β : Type} [add_group α] : has_add α := infer_instance
local attribute [instance] impossible_instance_test
run_cmd do
  d ← get_decl `impossible_instance_test,
  x ← linter.impossible_instance.test d,
  guard $ x = some "Impossible to infer argument 2: {β : Type}"

def dangerous_instance_test {α β γ : Type} [ring α] [add_comm_group β] [has_coe α β]
  [has_inv γ] : has_add β := infer_instance
local attribute [instance] dangerous_instance_test
run_cmd do
  d ← get_decl `dangerous_instance_test,
  x ← linter.dangerous_instance.test d,
  guard $ x = some
    "The following arguments become metavariables. argument 1: {α : Type}, argument 3: {γ : Type}"
end

section
def foo_has_mul {α} [has_mul α] : has_mul α := infer_instance
local attribute [instance, priority 1] foo_has_mul
run_cmd do
  d ← get_decl `foo_has_mul,
  some s ← fails_quickly 20 d,
  guard $ "type-class inference timed out".is_prefix_of s
local attribute [instance, priority 10000] foo_has_mul
run_cmd do
  d ← get_decl `foo_has_mul,
  some s ← fails_quickly 3000 d,
  guard $ "maximum class-instance resolution depth has been reached".is_prefix_of s
end

instance beta_redex_test {α} [monoid α] : (λ (X : Type), has_mul X) α := ⟨(*)⟩
run_cmd do
  d ← get_decl `beta_redex_test,
  x ← linter.instance_priority.test d,
  guard $ x = some "set priority below 1000"

/- Test exception in `def_lemma` linter. -/
run_cmd do
  d ← get_decl `my_exists_intro,
  t ← linter.def_lemma.test d,
  guard $ t = none


/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Compiler.LCNF.Simp.SimpM

namespace Lean.Compiler.LCNF
namespace Simp

/--
Auxiliary function for projecting "type class dictionary access".
That is, we are trying to extract one of the type class instance elements.
Remark: We do not consider parent instances to be elements.
For example, suppose `e` is `_x_4.1`, and we have
```
_x_2 : Monad (ReaderT Bool (ExceptT String Id)) := @ReaderT.Monad Bool (ExceptT String Id) _x_1
_x_3 : Applicative (ReaderT Bool (ExceptT String Id)) := _x_2.1
_x_4 : Functor (ReaderT Bool (ExceptT String Id)) := _x_3.1
```
Then, we will expand `_x_4.1` since it corresponds to the `Functor` `map` element,
and its type is not a type class, but is of the form
```
{α β : Type u} → (α → β) → ...
```
In the example above, the compiler should not expand `_x_3.1` or `_x_2.1` because they are
type class applications: `Functor` and `Applicative` respectively.
By eagerly expanding them, we may produce inefficient and bloated code.
For example, we may be using `_x_3.1` to invoke a function that expects a `Functor` instance.
By expanding `_x_3.1` we will be just expanding the code that creates this instance.

The result is representing a sequence of code containing let-declarations and local function declarations (`Array CodeDecl`)
and the free variable containing the result (`FVarId`). The resulting `FVarId` often depends only on a small
subset of `Array CodeDecl`. However, this method does try to filter the relevant ones.
We rely on the `used` var set available in `SimpM` to filter them. See `attachCodeDecls`.
-/
partial def inlineProjInst? (e : LetValue) : SimpM (Option (Array CodeDecl × FVarId)) := do
  let .proj _ i s := e | return none
  let sType ← getType s
  unless (← isClass? sType).isSome do return none
  let eType ← e.inferType
  unless  (← isClass? eType).isNone do return none
  let (fvarId?, decls) ← visit s [i] |>.run |>.run #[]
  if let some fvarId := fvarId? then
    return some (decls, fvarId)
  else
    eraseCodeDecls decls
    return none
where
  visit (fvarId : FVarId) (projs : List Nat) : OptionT (StateRefT (Array CodeDecl) SimpM) FVarId := do
    let some letDecl ← findLetDecl? fvarId | failure
    match letDecl.value with
    | .proj _ i s => visit s (i :: projs)
    | .fvar .. | .value .. | .erased => failure
    | .const declName us args =>
      if let some (.ctorInfo ctorVal) := (← getEnv).find? declName then
        let i :: projs := projs | unreachable!
        let arg := args[ctorVal.numParams + i]!
        let fvarId ← match arg with
          | .fvar fvarId => pure fvarId
          | .erased | .type .. =>
            let auxDecl ← mkLetDeclErased
            modify (·.push (.let auxDecl))
            pure auxDecl.fvarId
        if projs.isEmpty then
          return fvarId
        else
          visit fvarId projs
      else
        let some decl ← getDecl? declName | failure
        guard (decl.getArity == args.size)
        let params := decl.instantiateParamsLevelParams us
        let code := decl.instantiateValueLevelParams us
        let code ← betaReduce params code args (mustInline := true)
        visitCode code projs

  visitCode (code : Code) (projs : List Nat) : OptionT (StateRefT (Array CodeDecl) SimpM) FVarId := do
    match code with
    | .let decl k => modify (·.push (.let decl)); visitCode k projs
    | .fun decl k => modify (·.push (.fun decl)); visitCode k projs
    | .return fvarId => visit fvarId projs
    | _ => eraseCode code; failure


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Scott Morrison

! This file was ported from Lean 3 source module tactic.simp_command
! leanprover-community/mathlib commit 8f6fd1b69096c6a587f745d354306c0d46396915
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Core

/-!
## #simp
A user command to run the simplifier.
-/

namespace Tactic

/-- Strip all annotations of non local constants in the passed `expr`. (This is required in an
incantation later on in order to make the C++ simplifier happy.) -/
private unsafe def strip_annotations_from_all_non_local_consts {elab : Bool} (e : expr elab) :
    expr elab :=
  expr.unsafe_cast <|
    e.unsafe_cast.replace fun e n =>
      match e.is_annotation with
      | some (_, expr.local_const _ _ _ _) => none
      | some (_, _) => e.erase_annotations
      | _ => none
#align tactic.strip_annotations_from_all_non_local_consts tactic.strip_annotations_from_all_non_local_consts

/-- `simp_arg_type.to_pexpr` retrieves the `pexpr` underlying the given `simp_arg_type`, if there is
one. -/
unsafe def simp_arg_type.to_pexpr : simp_arg_type → Option pexpr
  | sat@(simp_arg_type.expr e) => e
  | sat@(simp_arg_type.symm_expr e) => e
  | sat => none
#align tactic.simp_arg_type.to_pexpr tactic.simp_arg_type.to_pexpr

/-- Incantation which prepares a `pexpr` in a `simp_arg_type` for use by the simplifier after
`expr.replace_subexprs` as been called to replace some of its local variables. -/
private unsafe def replace_subexprs_for_simp_arg (e : pexpr) (rules : List (expr × expr)) : pexpr :=
  strip_annotations_from_all_non_local_consts <|
    pexpr.of_expr <| e.unsafe_cast.replace_subexprs rules
#align tactic.replace_subexprs_for_simp_arg tactic.replace_subexprs_for_simp_arg

/-- `simp_arg_type.replace_subexprs` calls `expr.replace_subexprs` on the underlying `pexpr`, if
there is one, and then prepares the result for use by the simplifier. -/
unsafe def simp_arg_type.replace_subexprs : simp_arg_type → List (expr × expr) → simp_arg_type
  | simp_arg_type.expr e, rules => simp_arg_type.expr <| replace_subexprs_for_simp_arg e rules
  | simp_arg_type.symm_expr e, rules =>
    simp_arg_type.symm_expr <| replace_subexprs_for_simp_arg e rules
  | sat, rules => sat
#align tactic.simp_arg_type.replace_subexprs tactic.simp_arg_type.replace_subexprs

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
-- Turn off the messages if the result is exactly `true` with this option.
initialize
  registerTraceClass.1 `silence_simp_if_true

/-- The basic usage is `#simp e`, where `e` is an expression,
which will print the simplified form of `e`.

You can specify additional simp lemmas as usual for example using
`#simp [f, g] : e`, or `#simp with attr : e`.
(The colon is optional, but helpful for the parser.)

`#simp` understands local variables, so you can use them to
introduce parameters.
-/
@[user_command]
unsafe def simp_cmd (_ : parse <| tk "#simp") : lean.parser Unit := do
  let no_dflt ← only_flag
  let hs ← simp_arg_list
  let attr_names ← with_ident_list
  let o ← optional (tk ":")
  let e ← types.texpr
  let-- Retrieve the `pexpr`s parsed as part of the simp args, and collate them into a big list.
  hs_es := List.join <| hs.map <| Option.toList ∘ simp_arg_type.to_pexpr
  let/- Synthesize a `tactic_state` including local variables as hypotheses under which `expr.simp`
         may be safely called with expected behaviour given the `variables` in the environment. -/
    (ts, mappings)
    ← synthesize_tactic_state_with_variables_as_hyps (e :: hs_es)
  let simp_result
    ←-- Enter the `tactic` monad, *critically* using the synthesized tactic state `ts`.
        lean.parser.of_tactic
        fun _ =>
        (/- Resolve the local variables added by the parser to `e` (when it was parsed) against the local
                 hypotheses added to the `ts : tactic_state` which we are using. -/
          do
            let e ← to_expr e
            let/- Replace the variables referenced in the passed `simp_arg_list` with the `expr`s corresponding
                   to the local hypotheses we created.

                   We would prefer to just elaborate the `pexpr`s encoded in the `simp_arg_list` against the
                   tactic state we have created (as we could with `e` above), but the simplifier expects
                   `pexpr`s and not `expr`s. Thus, we just modify the `pexpr`s now and let `simp` do the
                   elaboration when the time comes.

                   You might think that we could just examine each of these `pexpr`s, call `to_expr` on them,
                   and then call `to_pexpr` afterward and save the results over the original `pexprs`. Due to
                   how functions like `simp_lemmas.add_pexpr` are implemented in the core library, the `simp`
                   framework is not robust enough to handle this method. When pieces of expressions like
                   annotation macros are injected, the direct patten matches in the `simp_lemmas.*` codebase
                   fail, and the lemmas we want don't get added.
                   -/
            hs := hs.map fun sat => sat.replace_subexprs mappings
            -- Finally, call `expr.simp` with `e` and return the result.
                Prod.fst <$>
                e { } failed no_dflt attr_names hs)
          ts
  -- Trace the result.
      when
      (¬is_trace_enabled_for `silence_simp_if_true ∨ simp_result ≠ expr.const `true [])
      (trace simp_result)
#align tactic.simp_cmd tactic.simp_cmd

add_tactic_doc
  { Name := "#simp"
    category := DocCategory.cmd
    declNames := [`tactic.simp_cmd]
    tags := ["simplification"] }

end Tactic


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.lint.default
import Mathlib.tactic.ext
import Mathlib.tactic.simps
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

namespace subtype

/-- See Note [custom simps projection] -/
def simps.val {α : Sort u_1} {p : α → Prop} (x : Subtype p) : α :=
  ↑x

/-- A version of `x.property` or `x.2` where `p` is syntactically applied to the coercion of `x`
  instead of `x.1`. A similar result is `subtype.mem` in `data.set.basic`. -/
theorem prop {α : Sort u_1} {p : α → Prop} (x : Subtype p) : p ↑x :=
  property x

@[simp] theorem val_eq_coe {α : Sort u_1} {p : α → Prop} {x : Subtype p} : val x = ↑x :=
  rfl

@[simp] protected theorem forall {α : Sort u_1} {p : α → Prop} {q : (Subtype fun (a : α) => p a) → Prop} : (∀ (x : Subtype fun (a : α) => p a), q x) ↔ ∀ (a : α) (b : p a), q { val := a, property := b } := sorry

/-- An alternative version of `subtype.forall`. This one is useful if Lean cannot figure out `q`
  when using `subtype.forall` from right to left. -/
protected theorem forall' {α : Sort u_1} {p : α → Prop} {q : (x : α) → p x → Prop} : (∀ (x : α) (h : p x), q x h) ↔ ∀ (x : Subtype fun (a : α) => p a), q (↑x) (property x) :=
  iff.symm subtype.forall

@[simp] protected theorem exists {α : Sort u_1} {p : α → Prop} {q : (Subtype fun (a : α) => p a) → Prop} : (∃ (x : Subtype fun (a : α) => p a), q x) ↔ ∃ (a : α), ∃ (b : p a), q { val := a, property := b } := sorry

protected theorem ext {α : Sort u_1} {p : α → Prop} {a1 : Subtype fun (x : α) => p x} {a2 : Subtype fun (x : α) => p x} : ↑a1 = ↑a2 → a1 = a2 := sorry

theorem ext_iff {α : Sort u_1} {p : α → Prop} {a1 : Subtype fun (x : α) => p x} {a2 : Subtype fun (x : α) => p x} : a1 = a2 ↔ ↑a1 = ↑a2 :=
  { mp := congr_arg fun {a1 : Subtype fun (x : α) => p x} => ↑a1, mpr := subtype.ext }

theorem heq_iff_coe_eq {α : Sort u_1} {p : α → Prop} {q : α → Prop} (h : ∀ (x : α), p x ↔ q x) {a1 : Subtype fun (x : α) => p x} {a2 : Subtype fun (x : α) => q x} : a1 == a2 ↔ ↑a1 = ↑a2 :=
  Eq._oldrec (fun (a2' : Subtype fun (x : α) => p x) => iff.trans heq_iff_eq ext_iff)
    (funext fun (x : α) => propext (h x)) a2

theorem ext_val {α : Sort u_1} {p : α → Prop} {a1 : Subtype fun (x : α) => p x} {a2 : Subtype fun (x : α) => p x} : val a1 = val a2 → a1 = a2 :=
  subtype.ext

theorem ext_iff_val {α : Sort u_1} {p : α → Prop} {a1 : Subtype fun (x : α) => p x} {a2 : Subtype fun (x : α) => p x} : a1 = a2 ↔ val a1 = val a2 :=
  ext_iff

@[simp] theorem coe_eta {α : Sort u_1} {p : α → Prop} (a : Subtype fun (a : α) => p a) (h : p ↑a) : { val := ↑a, property := h } = a :=
  subtype.ext rfl

@[simp] theorem coe_mk {α : Sort u_1} {p : α → Prop} (a : α) (h : p a) : ↑{ val := a, property := h } = a :=
  rfl

@[simp] theorem mk_eq_mk {α : Sort u_1} {p : α → Prop} {a : α} {h : p a} {a' : α} {h' : p a'} : { val := a, property := h } = { val := a', property := h' } ↔ a = a' :=
  ext_iff

theorem coe_eq_iff {α : Sort u_1} {p : α → Prop} {a : Subtype fun (a : α) => p a} {b : α} : ↑a = b ↔ ∃ (h : p b), a = { val := b, property := h } := sorry

theorem coe_injective {α : Sort u_1} {p : α → Prop} : function.injective coe :=
  fun (a b : Subtype p) => subtype.ext

theorem val_injective {α : Sort u_1} {p : α → Prop} : function.injective val :=
  coe_injective

/-- Restrict a (dependent) function to a subtype -/
def restrict {α : Sort u_1} {β : α → Type u_2} (f : (x : α) → β x) (p : α → Prop) (x : Subtype p) : β (val x) :=
  f ↑x

theorem restrict_apply {α : Sort u_1} {β : α → Type u_2} (f : (x : α) → β x) (p : α → Prop) (x : Subtype p) : restrict f p x = f (val x) :=
  Eq.refl (restrict f p x)

theorem restrict_def {α : Sort u_1} {β : Type u_2} (f : α → β) (p : α → Prop) : restrict f p = f ∘ coe :=
  Eq.refl (restrict f p)

theorem restrict_injective {α : Sort u_1} {β : Type u_2} {f : α → β} (p : α → Prop) (h : function.injective f) : function.injective (restrict f p) :=
  function.injective.comp h coe_injective

/-- Defining a map into a subtype, this can be seen as an "coinduction principle" of `subtype`-/
def coind {α : Sort u_1} {β : Sort u_2} (f : α → β) {p : β → Prop} (h : ∀ (a : α), p (f a)) : α → Subtype p :=
  fun (a : α) => { val := f a, property := h a }

theorem coind_injective {α : Sort u_1} {β : Sort u_2} {f : α → β} {p : β → Prop} (h : ∀ (a : α), p (f a)) (hf : function.injective f) : function.injective (coind f h) :=
  fun (x y : α) (hxy : coind f h x = coind f h y) => hf (congr_arg val hxy)

theorem coind_surjective {α : Sort u_1} {β : Sort u_2} {f : α → β} {p : β → Prop} (h : ∀ (a : α), p (f a)) (hf : function.surjective f) : function.surjective (coind f h) := sorry

theorem coind_bijective {α : Sort u_1} {β : Sort u_2} {f : α → β} {p : β → Prop} (h : ∀ (a : α), p (f a)) (hf : function.bijective f) : function.bijective (coind f h) :=
  { left := coind_injective h (and.left hf), right := coind_surjective h (and.right hf) }

/-- Restriction of a function to a function on subtypes. -/
@[simp] theorem map_coe {α : Sort u_1} {β : Sort u_2} {p : α → Prop} {q : β → Prop} (f : α → β) (h : ∀ (a : α), p a → q (f a)) : ∀ (ᾰ : Subtype p), ↑(map f h ᾰ) = f ↑ᾰ :=
  fun (ᾰ : Subtype p) => Eq.refl ↑(map f h ᾰ)

theorem map_comp {α : Sort u_1} {β : Sort u_2} {γ : Sort u_3} {p : α → Prop} {q : β → Prop} {r : γ → Prop} {x : Subtype p} (f : α → β) (h : ∀ (a : α), p a → q (f a)) (g : β → γ) (l : ∀ (a : β), q a → r (g a)) : map g l (map f h x) = map (g ∘ f) (fun (a : α) (ha : p a) => l (f a) (h a ha)) x :=
  rfl

theorem map_id {α : Sort u_1} {p : α → Prop} {h : ∀ (a : α), p a → p (id a)} : map id h = id := sorry

theorem map_injective {α : Sort u_1} {β : Sort u_2} {p : α → Prop} {q : β → Prop} {f : α → β} (h : ∀ (a : α), p a → q (f a)) (hf : function.injective f) : function.injective (map f h) :=
  coind_injective (fun (x : Subtype fun (a : α) => p a) => map._proof_1 f h x) (function.injective.comp hf coe_injective)

theorem map_involutive {α : Sort u_1} {p : α → Prop} {f : α → α} (h : ∀ (a : α), p a → p (f a)) (hf : function.involutive f) : function.involutive (map f h) :=
  fun (x : Subtype fun (a : α) => p a) => subtype.ext (hf ↑x)

protected instance has_equiv {α : Sort u_1} [has_equiv α] (p : α → Prop) : has_equiv (Subtype p) :=
  has_equiv.mk fun (s t : Subtype p) => ↑s ≈ ↑t

theorem equiv_iff {α : Sort u_1} [has_equiv α] {p : α → Prop} {s : Subtype p} {t : Subtype p} : s ≈ t ↔ ↑s ≈ ↑t :=
  iff.rfl

protected theorem refl {α : Sort u_1} {p : α → Prop} [setoid α] (s : Subtype p) : s ≈ s :=
  setoid.refl ↑s

protected theorem symm {α : Sort u_1} {p : α → Prop} [setoid α] {s : Subtype p} {t : Subtype p} (h : s ≈ t) : t ≈ s :=
  setoid.symm h

protected theorem trans {α : Sort u_1} {p : α → Prop} [setoid α] {s : Subtype p} {t : Subtype p} {u : Subtype p} (h₁ : s ≈ t) (h₂ : t ≈ u) : s ≈ u :=
  setoid.trans h₁ h₂

theorem equivalence {α : Sort u_1} [setoid α] (p : α → Prop) : equivalence has_equiv.equiv :=
  mk_equivalence has_equiv.equiv subtype.refl subtype.symm subtype.trans

protected instance setoid {α : Sort u_1} [setoid α] (p : α → Prop) : setoid (Subtype p) :=
  setoid.mk has_equiv.equiv (equivalence p)

end subtype

namespace subtype

/-! Some facts about sets, which require that `α` is a type. -/

@[simp] theorem coe_prop {α : Type u_1} {S : set α} (a : Subtype fun (a : α) => a ∈ S) : ↑a ∈ S :=
  prop a

theorem val_prop {α : Type u_1} {S : set α} (a : Subtype fun (a : α) => a ∈ S) : val a ∈ S :=
  property a