/-
File: math_spec.lean

Modified version of the autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.prelude
import tactic.polyrith

import starkware.cairo.common.bool_spec

open starkware.cairo.common.bool
open_locale big_operators
namespace starkware.cairo.common.math

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]

-- End of automatically generated prelude.

namespace assert_le_felt

@[reducible] def PRIME_OVER_3_HIGH := 3544607988759775765608368578435044694
@[reducible] def PRIME_OVER_2_HIGH := 5316911983139663648412552867652567041

end assert_le_felt

namespace split_felt

@[reducible] def MAX_HIGH := (((-1)) : ℤ) / (2 ^ 128 : ℤ)
@[reducible] def MAX_LOW := 0

end split_felt

namespace assert_250_bit

@[reducible] def UPPER_BOUND := 2 ^ 250
@[reducible] def SHIFT := 2 ^ 128
@[reducible] def HIGH_BOUND := (UPPER_BOUND : ℤ) / (SHIFT : ℤ)

end assert_250_bit

namespace starkware.cairo.common.math.assert_250_bit

@[reducible] def UPPER_BOUND := 2 ^ 250
@[reducible] def SHIFT := 2 ^ 128
@[reducible] def HIGH_BOUND := (UPPER_BOUND : ℤ) / (SHIFT : ℤ)

end starkware.cairo.common.math.assert_250_bit

namespace starkware.cairo.common.math.split_felt

@[reducible] def MAX_HIGH := ((-1) : ℤ) / (2 ^ 128 : ℤ)
@[reducible] def MAX_LOW := 0

end starkware.cairo.common.math.split_felt

/-
Constants and calculations
-/

def UPPER_BOUND := 2^250
def HIGH_PART_SHIFT := 2^250 / 2^128
def MAX_HIGH := (PRIME - 1) / 2^128
def MAX_LOW := (PRIME - 1) % 2^128
def CUTOFF := 2^128

theorem UPPER_BOUND_eq : UPPER_BOUND =
  1809251394333065553493296640760748560207343510400633813116524750123642650624 :=
by unfold UPPER_BOUND; norm_num1

theorem HIGH_PART_SHIFT_eq : HIGH_PART_SHIFT = 5316911983139663491615228241121378304 :=
by unfold HIGH_PART_SHIFT; norm_num1

theorem MAX_HIGH_eq : MAX_HIGH = 10633823966279327296825105735305134080 :=
by unfold MAX_HIGH; unfold PRIME; norm_num1

theorem MAX_LOW_eq : MAX_LOW = 0 :=
by unfold MAX_LOW; unfold PRIME; norm_num1

theorem CUTOFF_eq : CUTOFF = 340282366920938463463374607431768211456 :=
by unfold CUTOFF; norm_num1

lemma rc_bound_le_CUTOFF : rc_bound F ≤ CUTOFF := rc_bound_hyp F

/-
Specifications for all the functions.
-/

def spec_assert_not_zero (mem : F → F) (κ : ℕ) (value : F) : Prop :=
  value ≠ 0

def spec_assert_not_equal (mem : F → F) (κ : ℕ) (a b : F) : Prop :=
  a ≠ b

def spec_assert_nn (mem : F → F) (κ : ℕ) (range_check_ptr a ρ_range_check_ptr : F) : Prop :=
  ∃ n : ℕ, n < rc_bound F ∧ a = ↑n

def spec_assert_le (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ n : ℕ, n < rc_bound F ∧ b = a + ↑n

def spec_assert_lt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ n : ℕ, n < rc_bound F ∧ b = a + ↑(n + 1)

def spec_assert_nn_le (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ m n : ℕ, m < rc_bound F ∧ n < rc_bound F ∧ a = ↑m ∧ b = ↑(m + n)

def spec_assert_in_range (mem : F → F) (κ : ℕ) (range_check_ptr value lower upper ρ_range_check_ptr : F) : Prop :=
  ∃ m n : ℕ, m < rc_bound F ∧ n < rc_bound F ∧ value = lower + ↑m ∧ upper = value + ↑(n + 1)

def spec_assert_le_250_bit (mem : F → F) (range_check_ptr a b ret0 : F) : Prop :=
   ∃ n : ℕ, n < rc_bound F * HIGH_PART_SHIFT + rc_bound F ∧ b = a + ↑n

def spec_split_felt (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ_high ρ_low : F) : Prop :=
∃ hi lo : ℕ, hi < rc_bound F ∧ lo < rc_bound F  ∧
  ρ_high = ↑hi ∧ ρ_low = ↑lo ∧ value = ↑(hi * CUTOFF + lo) ∧ hi * CUTOFF + lo < PRIME

def spec_assert_le_felt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ m n : ℕ, m < PRIME ∧ n < PRIME ∧ a = ↑m ∧ b = ↑n ∧ m ≤ n

def spec_assert_lt_felt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
    ∃ m n : ℕ, m < PRIME ∧ n < PRIME ∧ a = ↑m ∧ b = ↑n ∧ m < n

def spec_abs_value (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  ∃ n : ℕ, n < rc_bound F ∧ ρ = ↑n ∧ (ρ = value ∨ ρ = -value)

def spec_sign (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  (value = 0 ∧ ρ = 0) ∨
  (value ≠ 0 ∧ (∃ n : ℕ, n < rc_bound F ∧ ((value = -↑n ∧ ρ = -1) ∨ (value = ↑n ∧ ρ = 1))))

def spec_unsigned_div_rem (mem : F → F) (κ : ℕ) (range_check_ptr value div ρ_range_check_ptr ρ_q ρ_r : F) : Prop :=
  ∃ q r n : ℕ, q < rc_bound F ∧ r < rc_bound F ∧ n < rc_bound F ∧
    value = ↑q * div + ↑r ∧ div = r + ↑(n + 1) ∧ ρ_q = q ∧ ρ_r = r

def spec_signed_div_rem (mem : F → F) (κ : ℕ) (range_check_ptr value div bound ρ_range_check_ptr ρ_q ρ_r : F) : Prop :=
  ∃ biased_q r n m : ℕ, ∃ q: F, biased_q < rc_bound F ∧ r < rc_bound F ∧ n < rc_bound F ∧ m < rc_bound F ∧
    q = ↑biased_q - bound ∧ value = q * div + ↑r ∧
    div = r + ↑(n + 1) ∧ 2 * bound = ↑biased_q + ↑(m + 1) ∧
    ρ_q = q ∧ ρ_r = r

def spec_split_int (mem : F → F) (κ : ℕ) (range_check_ptr value n base bound output ρ_range_check_ptr : F) : Prop :=
  base ≠ 0 → ∃ (nn : ℕ), nn < ring_char F ∧ n = ↑nn ∧
    (∀ i : ℕ, i < nn → ∃ m : ℕ, mem (output + i) + ↑m = bound - 1) ∧
      value = ∑ i in (finset.range nn), (mem (output + i) * base ^ i)

def spec_sqrt (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  ∃ r n₁ n₂ n₃ : ℕ, r < rc_bound F ∧ n₁ < rc_bound F ∧ n₂ < rc_bound F ∧
    ρ = ↑r ∧ value = ρ ^ 2 + ↑n₁ ∧ (ρ + 1) ^ 2 = value + ↑(n₂ + 1) ∧ 2^250 = (ρ + 1) ^ 2 + ↑n₃

def spec_horner_eval (mem : F → F) (κ : ℕ) (n_coefficients coefficients point ρ_res : F) : Prop :=
  ∃ (n : ℕ), n < ring_char F ∧ n_coefficients = ↑n ∧
    ρ_res = ∑ i in (finset.range n), (mem (coefficients + i) * point ^ i)

/-
-- Function: assert_not_zero
-/

/- assert_not_zero autogenerated specification -/

def auto_spec_assert_not_zero_block3 (mem : F → F) (κ : ℕ) (value : F) : Prop :=
  1 ≤ κ

def auto_spec_assert_not_zero (mem : F → F) (κ : ℕ) (value : F) : Prop :=
  ((value = 0 ∧
    value = 1 ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_not_zero_block3 mem κ₁ value ∧
    κ₁ + 2 ≤ κ) ∨
   (value ≠ 0 ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_not_zero_block3 mem κ₁ value ∧
    κ₁ + 1 ≤ κ))

/- assert_not_zero soundness theorem -/

theorem sound_assert_not_zero
    {mem : F → F}
    (κ : ℕ)
    (value : F)
    (h_auto : auto_spec_assert_not_zero mem κ value) :
  spec_assert_not_zero mem κ value :=
begin
  rcases h_auto with (⟨h0, h1⟩ | ⟨h, _⟩),
  { exfalso, rw h0 at h1, apply zero_ne_one h1.left },
  use h
end

/-
-- Function: assert_not_equal
-/

/- assert_not_equal autogenerated specification -/

def auto_spec_assert_not_equal_block3 (mem : F → F) (κ : ℕ) (a b : F) : Prop :=
  1 ≤ κ

def auto_spec_assert_not_equal (mem : F → F) (κ : ℕ) (a b : F) : Prop :=
  ((a = b ∧
    a = a + 1 ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_not_equal_block3 mem κ₁ a b ∧
    κ₁ + 3 ≤ κ) ∨
   (a ≠ b ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_not_equal_block3 mem κ₁ a b ∧
    κ₁ + 2 ≤ κ))

/- assert_not_equal soundness theorem -/

theorem sound_assert_not_equal
    {mem : F → F}
    (κ : ℕ)
    (a b : F)
    (h_auto : auto_spec_assert_not_equal mem κ a b) :
  spec_assert_not_equal mem κ a b :=
begin
  rcases h_auto with (⟨h0, h1⟩ | ⟨h, _⟩),
  { exfalso, apply @zero_ne_one F, rw [←sub_eq_of_eq_add' h1.left, sub_self] },
  use h
end

/-
-- Function: assert_nn
-/

/- assert_nn autogenerated specification -/

def auto_spec_assert_nn (mem : F → F) (κ : ℕ) (range_check_ptr a ρ_range_check_ptr : F) : Prop :=
  a = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) (a) ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 1 ∧
  3 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁

/- assert_nn soundness theorem -/

theorem sound_assert_nn
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_nn mem κ range_check_ptr a ρ_range_check_ptr) :
  spec_assert_nn mem κ range_check_ptr a ρ_range_check_ptr :=
begin
  exact h_auto.2.1
end

/-
-- Function: assert_le
-/

/- assert_le autogenerated specification -/

def auto_spec_assert_le (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_nn mem κ₁ range_check_ptr (b - a) range_check_ptr₁ ∧
  κ₁ + 4 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁

/- assert_le soundness theorem -/

theorem sound_assert_le
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a b ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_le mem κ range_check_ptr a b ρ_range_check_ptr) :
  spec_assert_le mem κ range_check_ptr a b ρ_range_check_ptr :=
begin
  rcases h_auto with ⟨_, _, nn_b_sub_a, _⟩,
  rcases nn_b_sub_a with ⟨n, nlt, neq⟩,
  exact ⟨n, nlt, eq_add_of_sub_eq' neq⟩
end

/-
-- Function: assert_lt
-/

/- assert_lt autogenerated specification -/

def auto_spec_assert_lt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_le mem κ₁ range_check_ptr a (b - 1) range_check_ptr₁ ∧
  κ₁ + 5 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁

/- assert_lt soundness theorem -/

theorem sound_assert_lt
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a b ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_lt mem κ range_check_ptr a b ρ_range_check_ptr) :
  spec_assert_lt mem κ range_check_ptr a b ρ_range_check_ptr :=
begin
  rcases h_auto with ⟨_, _, nn_b_sub_a, _⟩,
  rcases nn_b_sub_a with ⟨n, nlt, neq⟩,
  use [n, nlt],
  rw [eq_add_of_sub_eq' neq, nat.cast_add, nat.cast_one, add_comm, add_assoc]
end

/-
-- Function: assert_nn_le
-/

/- assert_nn_le autogenerated specification -/

def auto_spec_assert_nn_le (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_nn mem κ₁ range_check_ptr a range_check_ptr₁ ∧
  ∃ (κ₂ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₂ range_check_ptr₁ a b range_check_ptr₂ ∧
  κ₁ + κ₂ + 7 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₂

/- assert_nn_le soundness theorem -/

theorem sound_assert_nn_le
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a b ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_nn_le mem κ range_check_ptr a b ρ_range_check_ptr) :
  spec_assert_nn_le mem κ range_check_ptr a b ρ_range_check_ptr :=
begin
  rcases h_auto with ⟨_, _, nn_a, _, _, le_ab, _⟩,
  rcases nn_a with ⟨m, mlt, aeq⟩,
  rcases le_ab with ⟨n, nlt, abeq⟩,
  use [m, n, mlt, nlt, aeq],
  rw [abeq, aeq, nat.cast_add]
end

/-
-- Function: assert_in_range
-/

/- assert_in_range autogenerated specification -/

def auto_spec_assert_in_range (mem : F → F) (κ : ℕ) (range_check_ptr value lower upper ρ_range_check_ptr : F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_le mem κ₁ range_check_ptr lower value range_check_ptr₁ ∧
  ∃ (κ₂ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₂ range_check_ptr₁ value (upper - 1) range_check_ptr₂ ∧
  κ₁ + κ₂ + 8 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₂

/- assert_in_range soundness theorem -/

theorem sound_assert_in_range
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value lower upper ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_in_range mem κ range_check_ptr value lower upper ρ_range_check_ptr) :
  spec_assert_in_range mem κ range_check_ptr value lower upper ρ_range_check_ptr :=
begin
  rcases h_auto with ⟨_, _, lower_le, _, _, value_le, _⟩,
  rcases lower_le with ⟨m, mlt, eq1⟩,
  rcases value_le with ⟨n, nlt, eq2⟩,
  use [m, n, mlt, nlt, eq1],
  rw [eq_add_of_sub_eq' eq2, nat.cast_add, nat.cast_one, add_comm, add_assoc]
end

/-
-- Function: assert_le_250_bit
-/

/- assert_le_250_bit autogenerated specification -/

def auto_spec_assert_le_250_bit (mem : F → F) (range_check_ptr a b ret0 : F) : Prop :=
  ∃ low : F, low = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) low ∧
  ∃ high : F, high = mem (range_check_ptr + 1) ∧
  is_range_checked (rc_bound F) high ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 2 ∧
  ∃ UPPER_BOUND : F, UPPER_BOUND = 1809251394333065553493296640760748560207343510400633813116524750123642650624 ∧
  ∃ HIGH_PART_SHIFT : F, HIGH_PART_SHIFT = 5316911983139663491615228241121378304 ∧
  ∃ diff : F, diff = b - a ∧
  diff = high * HIGH_PART_SHIFT + low ∧
  ret0 = range_check_ptr₁

/- assert_le_250_bit soundness theorem -/

theorem sound_assert_le_250_bit
    {mem : F → F}
    (range_check_ptr a b ret0 : F)
    (h_auto : auto_spec_assert_le_250_bit mem range_check_ptr a b ret0) :
  spec_assert_le_250_bit mem range_check_ptr a b ret0 :=
begin
  rcases h_auto with ⟨low, _, rc_low, high, _, rc_high, _, _, _, _, H, rfl, diff, diffeq, diffeq2, _⟩,
  rcases rc_high with ⟨m, mlt, rfl⟩,
  rcases rc_low with ⟨n, nlt, rfl⟩,
  use [m * HIGH_PART_SHIFT + n], split,
  exact add_lt_add_of_le_of_lt (nat.mul_le_mul_right _ (le_of_lt mlt)) nlt,
  rw [eq_add_of_sub_eq diffeq.symm, add_comm diff, diffeq2, HIGH_PART_SHIFT_eq],
  rw [nat.cast_add, nat.cast_mul], simp only [nat.cast_bit0, nat.cast_one]
end

/-
-- Function: assert_250_bit
-/

/- assert_250_bit autogenerated specification -/

def auto_spec_assert_250_bit (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr : F) : Prop :=
  ∃ UPPER_BOUND : F, UPPER_BOUND = 1809251394333065553493296640760748560207343510400633813116524750123642650624 ∧
  ∃ SHIFT : F, SHIFT = 340282366920938463463374607431768211456 ∧
  ∃ HIGH_BOUND : F, HIGH_BOUND = 5316911983139663491615228241121378304 ∧
  ∃ low : F, low = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) low ∧
  ∃ high : F, high = mem (range_check_ptr + 1) ∧
  is_range_checked (rc_bound F) high ∧
  mem (range_check_ptr + 2) = HIGH_BOUND - 1 - high ∧
  is_range_checked (rc_bound F) (HIGH_BOUND - 1 - high) ∧
  value = high * SHIFT + low ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 3 ∧
  10 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁

def spec_assert_250_bit (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr : F) : Prop :=
  auto_spec_assert_250_bit mem κ range_check_ptr value ρ_range_check_ptr

/- assert_250_bit soundness theorem -/

theorem sound_assert_250_bit
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_250_bit mem κ range_check_ptr value ρ_range_check_ptr) :
  spec_assert_250_bit mem κ range_check_ptr value ρ_range_check_ptr :=
begin
  exact h_auto
end

/-
-- Function: split_felt
-/

/- split_felt autogenerated specification -/

def auto_spec_split_felt_block11 (mem : F → F) (κ : ℕ) (range_check_ptr value low high ρ_range_check_ptr ρ_high ρ_low : F) : Prop :=
  3 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr ∧
  ρ_high = high ∧
  ρ_low = low

def auto_spec_split_felt (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ_high ρ_low : F) : Prop :=
  ∃ MAX_HIGH : F, MAX_HIGH = 10633823966279327296825105735305134080 ∧
  ∃ MAX_LOW : F, MAX_LOW = 0 ∧
  ∃ low : F, low = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) low ∧
  ∃ high : F, high = mem (range_check_ptr + 1) ∧
  is_range_checked (rc_bound F) high ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 2 ∧
  value = high * (2 ^ 128) + low ∧
  ((high = MAX_HIGH ∧
    ∃ (κ₁ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₁ range_check_ptr₁ low MAX_LOW range_check_ptr₂ ∧
    ∃ (κ₂ : ℕ), auto_spec_split_felt_block11 mem κ₂ range_check_ptr₂ value low high ρ_range_check_ptr ρ_high ρ_low ∧
    κ₁ + κ₂ + 12 ≤ κ) ∨
   (high ≠ MAX_HIGH ∧
    ∃ (κ₁ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₁ range_check_ptr₁ high (MAX_HIGH - 1) range_check_ptr₂ ∧
    ∃ (κ₂ : ℕ), auto_spec_split_felt_block11 mem κ₂ range_check_ptr₂ value low high ρ_range_check_ptr ρ_high ρ_low ∧
    κ₁ + κ₂ + 11 ≤ κ))

/- split_felt soundness theorem -/

lemma split_felt_aux0 {hi lo : ℕ} (hhi : hi ≤ MAX_HIGH) (hlo : lo ≤ MAX_LOW) :
  hi * CUTOFF + lo < PRIME :=
begin
  apply (lt_of_le_of_lt (add_le_add (nat.mul_le_mul_right _ hhi) hlo)),
  rw [MAX_HIGH, MAX_LOW, CUTOFF, add_comm, mul_comm, nat.mod_add_div, PRIME],
  apply PRIME_sub_one_lt
end

lemma split_felt_aux1 {n : ℕ} (hn : n < rc_bound F) (h : (↑n : F) = MAX_HIGH) :
  n = MAX_HIGH :=
by { apply PRIME.nat_coe_field_inj _ _ h, { linarith [two_mul_rc_bound_lt_PRIME F] }, rw [MAX_HIGH_eq, PRIME]; norm_num1 }

lemma split_felt_aux2 {m n : ℕ} (hm : m < rc_bound F) (hn : n < rc_bound F)
    (h : (MAX_LOW : F) = m + n) :
  m ≤ MAX_LOW :=
begin
  apply le_trans (nat.le_add_right _ n) (le_of_eq _),
  rw ←nat.cast_add at h, symmetry,
  apply PRIME.nat_coe_field_inj _ _ h,
  { rw [MAX_LOW_eq, PRIME], norm_num1 },
  linarith [hm, hn, two_mul_rc_bound_lt_PRIME F]
end

lemma split_felt_aux3 {hi lo : ℕ} (hhi : hi < MAX_HIGH) (hlo : lo < rc_bound F) :
  hi * CUTOFF + lo < PRIME :=
begin
  have : hi * CUTOFF + lo < (hi + 1) * CUTOFF,
  { rw [add_mul, one_mul, CUTOFF], apply add_lt_add_left,
    exact lt_of_lt_of_le hlo (rc_bound_hyp F) },
  apply lt_of_lt_of_le this,
  transitivity (MAX_HIGH * CUTOFF),
  apply nat.mul_le_mul_right _ hhi,
  transitivity,
  apply nat.div_mul_le_self,
  apply (le_of_lt PRIME_sub_one_lt)
end

lemma split_felt_aux4 {hi n : ℕ} (hhi : hi < rc_bound F) (hn : n < rc_bound F)
    (h : (MAX_HIGH - 1 : F) = hi + n) :
  hi < MAX_HIGH :=
begin
  rw ←nat.cast_add at h,
  apply nat.lt_of_le_of_lt _ (nat.pred_lt (show MAX_HIGH ≠ 0, by { rw MAX_HIGH_eq, norm_num })), rw ←nat.sub_one,
  have : MAX_HIGH - 1 = hi + n,
  { rw [←nat.cast_one, ←nat.cast_sub] at h,
    apply PRIME.nat_coe_field_inj _ _ h,
    { rw [MAX_HIGH_eq, PRIME], norm_num1 },
    linarith [hhi, hn, two_mul_rc_bound_lt_PRIME F], rw [MAX_HIGH_eq], norm_num },
  rw this,
  apply nat.le_add_right
end

theorem sound_split_felt
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value ρ_range_check_ptr ρ_high ρ_low : F)
    (h_auto : auto_spec_split_felt mem κ range_check_ptr value ρ_range_check_ptr ρ_high ρ_low) :
  spec_split_felt mem κ range_check_ptr value ρ_range_check_ptr ρ_high ρ_low :=
begin
  rcases h_auto with ⟨H, rfl, L, rfl, low, _, rc_low, high, _, rc_high, _, _, val_eq, htemp⟩,
  rcases rc_high with ⟨hi, hilt, hieq⟩,
  rcases rc_low with ⟨lo, lolt, loeq⟩,
  rcases htemp with (⟨heq, _, _, hle, _, ⟨_, _, ret1eq, ret2eq⟩, _ ⟩ | ⟨hne, _, _, hle, _, ⟨_, _, ret1eq, ret2eq⟩, _⟩),
  { use [hi, lo, hilt, lolt, ret1eq.trans hieq, ret2eq.trans loeq],
    split,
    { rw [CUTOFF, val_eq, hieq, loeq], norm_cast },
    rcases hle with ⟨n, nlt, neq⟩,
    apply split_felt_aux0,
    apply le_of_eq, apply split_felt_aux1 hilt, rw [←hieq, heq, MAX_HIGH_eq],
    simp only [nat.cast_bit0, nat.cast_bit1, nat.cast_one],
    apply split_felt_aux2 lolt nlt,
    rw [MAX_LOW_eq, nat.cast_zero, neq, loeq] },
  use [hi, lo, hilt, lolt, ret1eq.trans hieq, ret2eq.trans loeq],
  split,
  { rw [CUTOFF, val_eq, hieq, loeq], norm_cast },
  rcases hle with ⟨n, nlt, neq⟩,
  apply split_felt_aux3 _ lolt,
  apply split_felt_aux4 hilt nlt,
  rw [←hieq, ←neq, MAX_HIGH_eq], simp only [nat.cast_bit0, nat.cast_bit1, nat.cast_one]
end

/-
-- Function: assert_le_felt
-/

/- assert_le_felt autogenerated specification -/

def auto_spec_assert_le_felt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ PRIME_OVER_3_HIGH : F, PRIME_OVER_3_HIGH = 3544607988759775765608368578435044694 ∧
  ∃ PRIME_OVER_2_HIGH : F, PRIME_OVER_2_HIGH = 5316911983139663648412552867652567041 ∧
  ∃ arc_short : F, arc_short = mem (range_check_ptr) + mem (range_check_ptr + 1) * PRIME_OVER_3_HIGH ∧
  is_range_checked (rc_bound F) (mem (range_check_ptr)) ∧
  is_range_checked (rc_bound F) (mem (range_check_ptr + 1)) ∧
  ∃ arc_long : F, arc_long = mem (range_check_ptr + 2) + mem (range_check_ptr + 3) * PRIME_OVER_2_HIGH ∧
  is_range_checked (rc_bound F) (mem (range_check_ptr + 2)) ∧
  is_range_checked (rc_bound F) (mem (range_check_ptr + 3)) ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 4 ∧
  ∃ arc_sum : F, arc_sum = arc_short + arc_long ∧
  ∃ arc_prod : F, arc_prod = arc_short * arc_long ∧
  ∃ anon_cond : F,
  ((anon_cond = 0 ∧
    arc_sum = ((-1)) - a ∧
    arc_prod = (a - b) * (1 + b) ∧
    18 ≤ κ ∧
    ρ_range_check_ptr = range_check_ptr₁) ∨
   (anon_cond ≠ 0 ∧
    ∃ anon_cond : F,
    ((anon_cond = 0 ∧
      ∃ m1mb : F, m1mb = ((-1)) - b ∧
      arc_sum = a + m1mb ∧
      arc_prod = a * m1mb ∧
      18 ≤ κ ∧
      ρ_range_check_ptr = range_check_ptr₁) ∨
     (anon_cond ≠ 0 ∧
      arc_sum = b ∧
      arc_prod = a * (b - a) ∧
      17 ≤ κ ∧
      ρ_range_check_ptr = range_check_ptr₁))))

/- assert_le_felt soundness theorem -/

lemma assert_le_felt_aux {hia loa hib lob : ℕ}
    (hlt : hia < hib) (hloa : loa < rc_bound F) :
  hia * CUTOFF + loa ≤ hib * CUTOFF + lob :=
have hrc : rc_bound F ≤ CUTOFF, by { rw [CUTOFF], apply rc_bound_hyp F},
calc
  hia * CUTOFF + loa ≤ (hia + 1) * CUTOFF :
    by { rw [add_mul, one_mul], apply add_le_add_left, linarith }
  ... ≤ hib * CUTOFF : by { apply nat.mul_le_mul_right, apply hlt }
  ... ≤ hib * CUTOFF + lob : nat.le_add_right _ _

theorem eq_of_sum_product_eq {F : Type*} [field F] {a b c d: F}
    (hsum : a + b = c + d) (hprod : a * b = c * d) :
  (a = c ∧ b = d) ∨ (a = d ∧ b = c) :=
begin
  have : (a - c) * (a - d) = 0,
  { transitivity (a * a - (c + d) * a + c * d),
    { ring },
    rw [←hsum, ←hprod], ring },
  rcases (eq_zero_or_eq_zero_of_mul_eq_zero this) with h | h,
  { left,
    rw sub_eq_zero at h,
    use h,
    rwa [h, add_left_cancel_iff] at hsum },
  right,
  rw sub_eq_zero at h,
  use h,
  rwa [h, add_comm, add_right_cancel_iff] at hsum
end

theorem sound_assert_le_felt
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a b ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_le_felt mem κ range_check_ptr a b ρ_range_check_ptr) :
  spec_assert_le_felt mem κ range_check_ptr a b ρ_range_check_ptr :=
begin
  rcases h_auto with ⟨P3H, P3Heq, P2H, P2Heq, arc_short, arc_short_eq, hrc, hrc1, arc_long, arc_long_eq, hrc2, hrc3, _, _,
  arc_sum, arc_sum_eq, arc_prod, arc_prod_eq, _, hrest⟩,
  rcases hrc with ⟨n, nlt, neq⟩,
  rcases hrc1 with ⟨n1, n1lt, n1eq⟩,
  rcases hrc2 with ⟨n2, n2lt, n2eq⟩,
  rcases hrc3 with ⟨n3, n3lt, n3eq⟩,
  have arc_short_eq' : arc_short = ↑(n + n1 * assert_le_felt.PRIME_OVER_3_HIGH),
  { rw [assert_le_felt.PRIME_OVER_3_HIGH],
    simp only [nat.cast_add, nat.cast_mul, nat.cast_bit0, nat.cast_bit1, nat.cast_one, arc_short_eq, ←neq, ←n1eq, P3Heq] },
  generalize n_arc_short_eq : n + n1 * assert_le_felt.PRIME_OVER_3_HIGH =
    n_arc_short,
  have coe_n_arc_short_eq : ↑n_arc_short = arc_short,
  { rw [←n_arc_short_eq, arc_short_eq'] },
  have n_arc_short_le : n_arc_short ≤ 2^128 * (1 + assert_le_felt.PRIME_OVER_3_HIGH),
  { rw [mul_add, mul_one, ←n_arc_short_eq],
    apply add_le_add (le_of_lt (lt_of_lt_of_le nlt(rc_bound_hyp F))),
    apply nat.mul_le_mul_of_nonneg_right,
    exact le_of_lt (lt_of_lt_of_le n1lt(rc_bound_hyp F)) },
  have arc_long_eq' : arc_long = ↑(n2 + n3 * assert_le_felt.PRIME_OVER_2_HIGH),
  { rw [assert_le_felt.PRIME_OVER_2_HIGH],
    simp only [nat.cast_add, nat.cast_mul, nat.cast_bit0, nat.cast_bit1, nat.cast_one, arc_long_eq, ←n2eq, ←n3eq, P2Heq] },
  generalize n_arc_long_eq : n2 + n3 * assert_le_felt.PRIME_OVER_2_HIGH = n_arc_long,
  have coe_n_arc_long_eq : ↑n_arc_long = arc_long,
  { rw [←n_arc_long_eq, arc_long_eq'] },
  have n_arc_long_le : n_arc_long ≤ 2^128 * (1 + assert_le_felt.PRIME_OVER_2_HIGH),
  { rw [mul_add, mul_one, ←n_arc_long_eq],
    apply add_le_add (le_of_lt (lt_of_lt_of_le n2lt(rc_bound_hyp F))),
    apply nat.mul_le_mul_of_nonneg_right,
    exact le_of_lt (lt_of_lt_of_le n3lt(rc_bound_hyp F)) },
  have short_add_long_add_one_le_PRIME:
    n_arc_short + (n_arc_long + 1) ≤ PRIME,
  { refine le_trans (add_le_add n_arc_short_le (add_le_add_right n_arc_long_le _)) _,
    rw [assert_le_felt.PRIME_OVER_2_HIGH, assert_le_felt.PRIME_OVER_3_HIGH, PRIME],
    norm_num1 },
  have short_add_one_add_long_le_PRIME: (n_arc_short + 1) + n_arc_long ≤ PRIME,
  { rw [add_assoc, add_comm 1],
    exact short_add_long_add_one_le_PRIME },
  have long_add_one_le_PRIME: n_arc_long + 1 ≤ PRIME :=
    le_trans (nat.le_add_left _ _) short_add_long_add_one_le_PRIME,
  have short_add_one_le_PRIME: n_arc_short + 1 ≤ PRIME :=
    le_trans (nat.le_add_right _ _) short_add_one_add_long_le_PRIME,
  have long_le_PRIME: n_arc_long ≤ PRIME :=
    le_trans (nat.le_add_left _ _) short_add_one_add_long_le_PRIME,
  have short_le_PRIME: n_arc_short ≤ PRIME :=
    le_trans (nat.le_add_right _ _) short_add_long_add_one_le_PRIME,
  have long_lt_PRIME: n_arc_long < PRIME := nat.lt_of_succ_le long_add_one_le_PRIME,
  have short_lt_PRIME: n_arc_short < PRIME := nat.lt_of_succ_le short_add_one_le_PRIME,
  have short_add_long_lt_PRIME: n_arc_short + n_arc_long < PRIME :=
    nat.lt_of_succ_le short_add_long_add_one_le_PRIME,
  have coe_PRIME : (PRIME : F) = 0,
  { apply char_p.cast_eq_zero },
  rcases hrest with ⟨_, hcase1⟩ | ⟨_, ⟨_, ⟨_, hcase2⟩ | ⟨_, hcase3⟩⟩⟩,
  { rcases hcase1 with ⟨arc_sum_eq', arc_prod_eq', _, _⟩,
    have aux1 : b - a + (-1 - b) = arc_short + arc_long,
    { rw [←arc_sum_eq, arc_sum_eq'], ring },
    have aux2 : (b - a) * (-1 - b) = arc_short * arc_long,
    { rw [←arc_prod_eq, arc_prod_eq'], ring },
    rcases eq_of_sum_product_eq aux1 aux2 with ⟨h1, h2⟩ | ⟨h1, h2⟩,
    { use PRIME - (n_arc_short + (n_arc_long + 1)),
      use PRIME - (n_arc_long + 1),
      split,
      { apply nat.sub_lt PRIME_pos,
        apply add_pos_of_nonneg_of_pos (nat.zero_le _) (nat.succ_pos _) },
      split,
      { apply nat.sub_lt PRIME_pos,
        apply nat.succ_pos _ },
      split,
      { rw [nat.cast_sub], swap,
        { exact short_add_long_add_one_le_PRIME },
        rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_add, nat.cast_one, coe_n_arc_short_eq, coe_n_arc_long_eq],
        linear_combination -aux1 },
      split,
      { rw [nat.cast_sub], swap,
        { exact long_add_one_le_PRIME },
        rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_one, coe_n_arc_long_eq, neg_add],
        linear_combination -h2 },
      apply nat.sub_le_sub_left,
      apply nat.le_add_left },
    use PRIME - ((n_arc_short + 1) + n_arc_long),
    use PRIME - (n_arc_short + 1),
    split,
    { apply nat.sub_lt PRIME_pos,
      apply add_pos_of_pos_of_nonneg (nat.succ_pos _) (nat.zero_le _) },
    split,
    { apply nat.sub_lt PRIME_pos,
      apply nat.succ_pos _ },
    split,
    { rw [nat.cast_sub], swap,
      { exact short_add_one_add_long_le_PRIME },
      rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_add, nat.cast_one, coe_n_arc_short_eq, coe_n_arc_long_eq],
      linear_combination -aux1 },
    split,
    { rw [nat.cast_sub], swap,
      { exact short_add_one_le_PRIME },
      rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_one, coe_n_arc_short_eq, neg_add],
      linear_combination -h2 },
    apply nat.sub_le_sub_left,
    apply nat.le_add_right },
  { rcases hcase2 with ⟨_, rfl, arc_sum_eq', arc_prod_eq', _, _⟩,
    have aux1 : a + (-1 - b) = arc_short + arc_long,
    { rw [←arc_sum_eq, arc_sum_eq'] },
    have aux2 : a * (-1 - b) = arc_short * arc_long,
    { rw [←arc_prod_eq, arc_prod_eq'] },
    rcases eq_of_sum_product_eq aux1 aux2 with ⟨h1, h2⟩ | ⟨h1, h2⟩,
    { use n_arc_short,
      use PRIME - (n_arc_long + 1),
      split,
      { exact short_lt_PRIME },
      split,
      { apply nat.sub_lt PRIME_pos (nat.succ_pos _) },
      split,
      { rw [h1, coe_n_arc_short_eq] },
      split,
      { rw [nat.cast_sub], swap,
        { exact long_add_one_le_PRIME },
        rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_one, coe_n_arc_long_eq],
        linear_combination -h2 },
      apply le_tsub_of_add_le_right,
      exact short_add_long_add_one_le_PRIME },
    use n_arc_long,
    use PRIME - (n_arc_short + 1),
    split,
    { exact long_lt_PRIME },
    split,
    { apply nat.sub_lt PRIME_pos (nat.succ_pos _) },
    split,
    { rw [h1, coe_n_arc_long_eq] },
    split,
    { rw [nat.cast_sub], swap,
      { exact short_add_one_le_PRIME },
      rw [char_p.cast_eq_zero, zero_sub, nat.cast_add, nat.cast_one, coe_n_arc_short_eq],
      linear_combination -h2 },
    apply le_tsub_of_add_le_right,
    rw add_comm,
    exact short_add_one_add_long_le_PRIME },
  { rcases hcase3 with ⟨arc_sum_eq', arc_prod_eq', _, _⟩,
    have aux1 : a + (b - a) = arc_short + arc_long,
    { rw [←arc_sum_eq, arc_sum_eq'], ring },
    have aux2 : a * (b - a) = arc_short * arc_long,
    { rw [←arc_prod_eq, arc_prod_eq'] },
    rcases eq_of_sum_product_eq aux1 aux2 with ⟨h1, h2⟩ | ⟨h1, h2⟩,
    { use n_arc_short,
      use n_arc_short + n_arc_long,
      use short_lt_PRIME,
      use short_add_long_lt_PRIME,
      split, rw [h1, coe_n_arc_short_eq],
      split,
      { rw [nat.cast_add, coe_n_arc_short_eq, coe_n_arc_long_eq],
        linear_combination h1 + h2 },
    apply nat.le_add_right },
    use n_arc_long,
    use n_arc_short + n_arc_long,
    use long_lt_PRIME,
    use short_add_long_lt_PRIME,
    split, rw [h1, coe_n_arc_long_eq],
    split,
    { rw [nat.cast_add, coe_n_arc_short_eq, coe_n_arc_long_eq],
      linear_combination h1 + h2 },
    apply nat.le_add_left }
end

/-
-- Function: assert_lt_felt
-/

/- assert_lt_felt autogenerated specification -/

def auto_spec_assert_lt_felt_block3 (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_le_felt mem κ₁ range_check_ptr a b range_check_ptr₁ ∧
  κ₁ + 5 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₁

def auto_spec_assert_lt_felt (mem : F → F) (κ : ℕ) (range_check_ptr a b ρ_range_check_ptr : F) : Prop :=
  ((a = b ∧
    a = a + 1 ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_lt_felt_block3 mem κ₁ range_check_ptr a b ρ_range_check_ptr ∧
    κ₁ + 3 ≤ κ) ∨
   (a ≠ b ∧
    ∃ (κ₁ : ℕ), auto_spec_assert_lt_felt_block3 mem κ₁ range_check_ptr a b ρ_range_check_ptr ∧
    κ₁ + 2 ≤ κ))

/- assert_lt_felt soundness theorem -/

theorem sound_assert_lt_felt
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr a b ρ_range_check_ptr : F)
    (h_auto : auto_spec_assert_lt_felt mem κ range_check_ptr a b ρ_range_check_ptr) :
  spec_assert_lt_felt mem κ range_check_ptr a b ρ_range_check_ptr :=
begin
  cases h_auto with h_e h_ne,
  rcases h_e with ⟨_, h_a, _⟩,
  { exfalso, apply @zero_ne_one F, rw [←sub_eq_of_eq_add' h_a, sub_self] },
  rcases h_ne with ⟨h_a_ne_b, _, ⟨_, _, ⟨m, n, m_lt, n_lt, h_am, h_bn, h_le⟩, _, _⟩, _⟩,
  use [m,n, m_lt, n_lt, h_am, h_bn], apply lt_of_le_of_ne h_le,
  by_contra, rw [h, ←h_bn] at h_am, exact absurd h_am h_a_ne_b,
end

/-
-- Function: abs_value
-/

/- abs_value autogenerated specification -/

def auto_spec_abs_value (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  ∃ is_positive : F,
  ((is_positive = 0 ∧
    ∃ new_range_check_ptr : F, new_range_check_ptr = range_check_ptr + 1 ∧
    ∃ abs_value : F, abs_value = value * ((-1)) ∧
    mem (range_check_ptr) = abs_value ∧
    is_range_checked (rc_bound F) (abs_value) ∧
    ∃ range_check_ptr₁ : F, range_check_ptr₁ = new_range_check_ptr ∧
    6 ≤ κ ∧
    ρ_range_check_ptr = range_check_ptr₁ ∧
    ρ = abs_value) ∨
   (is_positive ≠ 0 ∧
    mem (range_check_ptr) = value ∧
    is_range_checked (rc_bound F) (value) ∧
    ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 1 ∧
    6 ≤ κ ∧
    ρ_range_check_ptr = range_check_ptr₁ ∧
    ρ = value))

/- abs_value soundness theorem -/

theorem sound_abs_value
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value ρ_range_check_ptr ρ : F)
    (h_auto : auto_spec_abs_value mem κ range_check_ptr value ρ_range_check_ptr ρ) :
  spec_abs_value mem κ range_check_ptr value ρ_range_check_ptr ρ :=
-- STATEMENT CHANGED, PREVIOUS STATEMENT:
--     (range_check_ptr value ρ_range_check_ptr ρ_abs_value : F)
--     (h_auto : auto_spec_abs_value mem κ range_check_ptr value ρ_range_check_ptr ρ_abs_value) :
--   spec_abs_value mem κ range_check_ptr value ρ_range_check_ptr ρ_abs_value :=
begin
  rcases h_auto with ⟨_, ⟨_, _, _, av, aveq, _, rcav, _, _, _, _, ret1eq⟩ | ⟨_, _, rcval, _, _, _, _, ret1eq⟩⟩,
  { rcases rcav with ⟨n, nlt, neq⟩,
    use [n, nlt, ret1eq.trans neq], right,
    rw [ret1eq, aveq, mul_neg_one] },
  rcases rcval with ⟨n, nlt, neq⟩,
  use [n, nlt, ret1eq.trans neq, or.inl ret1eq]
end

/-
-- Function: sign
-/

/- sign autogenerated specification -/

def auto_spec_sign (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  ((value = 0 ∧
    5 ≤ κ ∧
    ρ_range_check_ptr = range_check_ptr ∧
    ρ = 0) ∨
   (value ≠ 0 ∧
    ∃ is_positive : F,
    ((is_positive = 0 ∧
      mem (range_check_ptr) = value * ((-1)) ∧
      is_range_checked (rc_bound F) (value * ((-1))) ∧
      ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 1 ∧
      8 ≤ κ ∧
      ρ_range_check_ptr = range_check_ptr₁ ∧
      ρ = (-1)) ∨
     (is_positive ≠ 0 ∧
      mem (range_check_ptr) = value ∧
      is_range_checked (rc_bound F) (value) ∧
      ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 1 ∧
      8 ≤ κ ∧
      ρ_range_check_ptr = range_check_ptr₁ ∧
      ρ = 1))))

/- sign soundness theorem -/

theorem sound_sign
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value ρ_range_check_ptr ρ : F)
    (h_auto : auto_spec_sign mem κ range_check_ptr value ρ_range_check_ptr ρ) :
  spec_sign mem κ range_check_ptr value ρ_range_check_ptr ρ :=
-- STATEMENT CHANGED, PREVIOUS STATEMENT:
--     (range_check_ptr value ρ_range_check_ptr ρ_sign : F)
--     (h_auto : auto_spec_sign mem κ range_check_ptr value ρ_range_check_ptr ρ_sign) :
--   spec_sign mem κ range_check_ptr value ρ_range_check_ptr ρ_sign :=
begin
  rcases h_auto with (⟨valeq, _, _, ret1eq⟩ |
    ⟨valne, _, ⟨_, _, rc_valneg, _, _, _, _, ret1eq⟩ |  ⟨_, _, rc_val, _, _, _, _, ret1eq⟩⟩),
  { left, use [valeq, ret1eq] },
  { rcases rc_valneg with ⟨n, nlt, neq⟩, rw mul_neg_one at neq,
    right, use [valne, n, nlt, eq_neg_of_eq_neg neq.symm, ret1eq] },
  rcases rc_val with ⟨n, nlt, neq⟩,
  right, use [valne, n, nlt], right, use [neq, ret1eq]
end

/-
-- Function: unsigned_div_rem
-/

/- unsigned_div_rem autogenerated specification -/

def auto_spec_unsigned_div_rem (mem : F → F) (κ : ℕ) (range_check_ptr value div ρ_range_check_ptr ρ_q ρ_r : F) : Prop :=
  ∃ r : F, r = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) r ∧
  ∃ q : F, q = mem (range_check_ptr + 1) ∧
  is_range_checked (rc_bound F) q ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 2 ∧
  ∃ (κ₁ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₁ range_check_ptr₁ r (div - 1) range_check_ptr₂ ∧
  value = q * div + r ∧
  κ₁ + 12 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₂ ∧
  ρ_q = q ∧
  ρ_r = r

/- unsigned_div_rem soundness theorem -/

theorem sound_unsigned_div_rem
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value div ρ_range_check_ptr ρ_q ρ_r : F)
    (h_auto : auto_spec_unsigned_div_rem mem κ range_check_ptr value div ρ_range_check_ptr ρ_q ρ_r) :
  spec_unsigned_div_rem mem κ range_check_ptr value div ρ_range_check_ptr ρ_q ρ_r :=
begin
  rcases h_auto with ⟨fr, _, ⟨r, rlt, req⟩, fq, _, ⟨q, qlt, qeq⟩, _, _, _, _, ⟨n, nlt, neq⟩, valeq, _, _,
    ret1eq, ret2eq⟩,
  use [q, r, n, qlt, rlt, nlt], split, { rw [valeq, qeq, req] },
  split, { rw [eq_add_of_sub_eq neq, req, nat.cast_add, nat.cast_one, add_assoc] },
  use [ret1eq.trans qeq, ret2eq.trans req]
end

/-
-- Function: signed_div_rem
-/

/- signed_div_rem autogenerated specification -/

def auto_spec_signed_div_rem (mem : F → F) (κ : ℕ) (range_check_ptr value div bound ρ_range_check_ptr ρ_q ρ_r : F) : Prop :=
  ∃ r : F, r = mem (range_check_ptr) ∧
  is_range_checked (rc_bound F) r ∧
  ∃ biased_q : F, biased_q = mem (range_check_ptr + 1) ∧
  is_range_checked (rc_bound F) biased_q ∧
  ∃ range_check_ptr₁ : F, range_check_ptr₁ = range_check_ptr + 2 ∧
  ∃ q : F, q = biased_q - bound ∧
  value = q * div + r ∧
  ∃ (κ₁ : ℕ) (range_check_ptr₂ : F), spec_assert_le mem κ₁ range_check_ptr₁ r (div - 1) range_check_ptr₂ ∧
  ∃ (κ₂ : ℕ) (range_check_ptr₃ : F), spec_assert_le mem κ₂ range_check_ptr₂ biased_q (2 * bound - 1) range_check_ptr₃ ∧
  κ₁ + κ₂ + 20 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₃ ∧
  ρ_q = q ∧
  ρ_r = r

/- signed_div_rem soundness theorem -/

theorem sound_signed_div_rem
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value div bound ρ_range_check_ptr ρ_q ρ_r : F)
    (h_auto : auto_spec_signed_div_rem mem κ range_check_ptr value div bound ρ_range_check_ptr ρ_q ρ_r) :
  spec_signed_div_rem mem κ range_check_ptr value div bound ρ_range_check_ptr ρ_q ρ_r :=
begin
  rcases h_auto with ⟨fr, _, ⟨r, rlt, req⟩, fbq, _, ⟨bq, bqlt, bqeq⟩, _, _,
                        q, qeq, valeq, _, _, ⟨n, nlt, neq⟩, _, _, ⟨m, mlt, meq⟩, _, _, ret1eq, ret2eq⟩,
  use [bq, r, n, m, q, bqlt, rlt, nlt, mlt],
  split, { rw [qeq, bqeq] },
  split, { rw [valeq, req] },
  split, { rw [eq_add_of_sub_eq neq, req, nat.cast_add, nat.cast_one, add_assoc] },
  split, { rw [eq_add_of_sub_eq meq, bqeq, nat.cast_add, nat.cast_one, add_assoc] },
  use [ret1eq, ret2eq.trans req]
end

/-
-- Function: split_int
-/

/- split_int autogenerated specification -/

def auto_spec_split_int (mem : F → F) (κ : ℕ) (range_check_ptr value n base bound output ρ_range_check_ptr : F) : Prop :=
  ((n = 0 ∧
    value = 0 ∧
    4 ≤ κ ∧
    ρ_range_check_ptr = range_check_ptr) ∨
   (n ≠ 0 ∧
    ∃ low_part : F, low_part = mem (output) ∧
    ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_nn_le mem κ₁ range_check_ptr low_part (bound - 1) range_check_ptr₁ ∧
    ∃ δ6_0 : F,
    ∃ (κ₂ : ℕ), spec_split_int mem κ₂ range_check_ptr₁ (ddiv (value - low_part) base δ6_0) (n - 1) base bound (output + 1) ρ_range_check_ptr ∧
    κ₁ + κ₂ + 15 ≤ κ))

/- split_int soundness theorem -/

theorem sound_split_int
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value n base bound output ρ_range_check_ptr : F)
    (h_auto : auto_spec_split_int mem κ range_check_ptr value n base bound output ρ_range_check_ptr) :
  spec_split_int mem κ range_check_ptr value n base bound output ρ_range_check_ptr :=
begin
  intro base_nzero,
  cases h_auto,
  rcases h_auto with ⟨neq0, h_veq0, _⟩,
  use [0], split, exact PRIME.char_pos, split,
  rw neq0, exact nat.cast_zero.symm, split,
  rintro i h_ilt0, exact absurd h_ilt0 (nat.not_lt_zero i),
  rw h_veq0, exact (finset.sum_range_zero _).symm,
  rcases h_auto with ⟨nzero, low_part, low_part_eq, _, _, h_nn_le, ⟨d6, _, i_h, _⟩⟩,
  rcases i_h base_nzero with ⟨i_nn, i_nn_lt, i_nn_eq, i_bound, i_sum⟩,
  have : i_nn + 1 = ring_char F ∨ i_nn + 1 < ring_char F :=
    or.comm.mp (lt_or_eq_of_le (nat.succ_le_of_lt i_nn_lt)),
  cases this with h_eq_ring_char h_lt_ring_char,
  { exfalso, apply nzero,
    rw [eq_add_of_sub_eq i_nn_eq, ←nat.cast_one, ←nat.cast_add, h_eq_ring_char, (ring_char.spec F _)] },
  use [i_nn + 1, h_lt_ring_char], split,
  { rw [eq_add_of_sub_eq i_nn_eq, ←nat.cast_one, ←nat.cast_add] },
  split, rintro i ilt,
  cases nat.eq_zero_or_pos i with izero zero_lt_i,
  { rw [izero, nat.cast_zero, add_zero, ←low_part_eq],
    rcases h_nn_le with ⟨am, an, h_am_bound, h_an_bound, h_a_eq, h_b_eq⟩,
    use [an], rw [h_b_eq, h_a_eq, nat.cast_add] },
  {
    have hi : i - 1 < i_nn,
      { rw [nat.sub_one, ←(nat.pred_succ i_nn)],
        exact nat.pred_lt_pred (ne_of_lt zero_lt_i).symm ilt, },
    rcases i_bound (i - 1) hi with ⟨m, h_m⟩,
    -- have := nat.cast_sub zero_lt_i,
    use m, rw [←h_m, nat.cast_sub zero_lt_i, nat.cast_one],
    rw [add_add_sub_cancel output i 1]
  },
  {
    rw [add_comm i_nn 1, finset.sum_range_add _ _ _],
    simp [pow_add base 1 _, mul_comm base _],
    simp [←add_assoc, ←mul_assoc],
    rw [ddiv_eq base_nzero, div_eq_iff base_nzero, finset.sum_mul] at i_sum,
    rw [←i_sum], rw [low_part_eq], exact (add_sub_cancel'_right _ _).symm,
  },
end

/-
-- Function: sqrt
-/

/- sqrt autogenerated specification -/

def auto_spec_sqrt (mem : F → F) (κ : ℕ) (range_check_ptr value ρ_range_check_ptr ρ : F) : Prop :=
  ∃ root : F,
  ∃ (κ₁ : ℕ) (range_check_ptr₁ : F), spec_assert_nn_le mem κ₁ range_check_ptr root (2 ^ 125 - 1) range_check_ptr₁ ∧
  ∃ root_plus_one : F, root_plus_one = root + 1 ∧
  ∃ (κ₂ : ℕ) (range_check_ptr₂ : F), spec_assert_in_range mem κ₂ range_check_ptr₁ value (root * root) (root_plus_one * root_plus_one) range_check_ptr₂ ∧
  κ₁ + κ₂ + 13 ≤ κ ∧
  ρ_range_check_ptr = range_check_ptr₂ ∧
  ρ = root

/- sqrt soundness theorem -/

theorem sound_sqrt
    {mem : F → F}
    (κ : ℕ)
    (range_check_ptr value ρ_range_check_ptr ρ : F)
    (h_auto : auto_spec_sqrt mem κ range_check_ptr value ρ_range_check_ptr ρ) :
  spec_sqrt mem κ range_check_ptr value ρ_range_check_ptr ρ :=
-- STATEMENT CHANGED, PREVIOUS STATEMENT:
--     (range_check_ptr value ρ_range_check_ptr ρ_res : F)
--     (h_auto : auto_spec_sqrt mem κ range_check_ptr value ρ_range_check_ptr ρ_res) :
--   spec_sqrt mem κ range_check_ptr value ρ_range_check_ptr ρ_res :=
begin
  rcases h_auto with  ⟨root, _, _, h_nn_le_r, rp1, h_rp1, _, _, h_in_range, _, _, ret1eq⟩,
  rcases h_in_range with ⟨n₁, n₂, h_n₁, h_n₂, hrsqr, hr1sqr⟩,
  rcases h_nn_le_r with ⟨r, m, h_r, h_m, h_reqroot, h_rb⟩,
  use [r, n₁, n₂, (2 * (r + 1) * m + m ^ 2), h_r, h_n₁, h_n₂],
  rw [ret1eq, ←h_rp1],
  use [h_reqroot],
  split, { rw [pow_two root], exact hrsqr },
  split, { rw [pow_two rp1], exact hr1sqr },
  rw [h_rp1, h_reqroot],
  have h_r1b : (2 ^ 125 : F) = (↑r + 1) + ↑m,
    { rw [eq_add_of_sub_eq h_rb, nat.cast_add], ring },
  have h_125 : (2 ^ 250 : F) = (2 ^ 125 : F) ^ 2, { ring },
  rw [h_125, h_r1b], rw [add_sq _ ↑m], norm_cast, arith_simps,
end

/-
-- Function: horner_eval
-/

/- horner_eval autogenerated specification -/

def auto_spec_horner_eval (mem : F → F) (κ : ℕ) (n_coefficients coefficients point ρ_res : F) : Prop :=
  ((n_coefficients = 0 ∧
    3 ≤ κ ∧
    ρ_res = 0) ∨
   (n_coefficients ≠ 0 ∧
    ∃ (κ₁ : ℕ) (n_minus_one_res : F), spec_horner_eval mem κ₁ (n_coefficients - 1) (coefficients + 1) point n_minus_one_res ∧
    κ₁ + 9 ≤ κ ∧
    ρ_res = n_minus_one_res * point + mem (coefficients + 0)))

/- horner_eval soundness theorem -/

theorem sound_horner_eval
    {mem : F → F}
    (κ : ℕ)
    (n_coefficients coefficients point ρ_res : F)
    (h_auto : auto_spec_horner_eval mem κ n_coefficients coefficients point ρ_res) :
  spec_horner_eval mem κ n_coefficients coefficients point ρ_res :=
begin
  cases h_auto,
  -- zero case
  rcases h_auto with ⟨neq0, _, h_veq0⟩,
  use [0], split, exact PRIME.char_pos, split,
  rw neq0, exact nat.cast_zero.symm,
  rw h_veq0, exact (finset.sum_range_zero _).symm,
  -- non-zero case
  rcases h_auto with ⟨nzero, _, n_min_1_res, i_h, _, h_ret0⟩,
  rcases i_h with ⟨i_n, i_n_lt, i_n_eq, i_sum⟩,
  have : i_n + 1 = ring_char F ∨ i_n + 1 < ring_char F :=
    or.comm.mp (lt_or_eq_of_le (nat.succ_le_of_lt i_n_lt)),
  cases this with h_eq_ring_char h_lt_ring_char,
  { exfalso, apply nzero,
    rw [eq_add_of_sub_eq i_n_eq, ←nat.cast_one, ←nat.cast_add, h_eq_ring_char, (ring_char.spec F _)] },
  use [i_n + 1, h_lt_ring_char], split,
  { rw [eq_add_of_sub_eq i_n_eq, ←nat.cast_one, ←nat.cast_add] },
  {
    rw [add_comm i_n 1, finset.sum_range_add _ _ _],
    simp [pow_add point 1 _, mul_comm point _],
    simp [←add_assoc, ←mul_assoc],
    rw [h_ret0, add_comm, add_zero, add_left_cancel_iff, i_sum, finset.sum_mul]
  },
end

/-
-- Function: is_quad_residue
-/

/- is_quad_residue autogenerated specification -/

-- Do not change this definition.
def auto_spec_is_quad_residue (mem : F → F) (κ : ℕ) (x ρ : F) : Prop :=
  ∃ y : F,
  ∃ y_squared : F, y_squared = y * y ∧
  ((y_squared = x ∧
    7 ≤ κ ∧
    ρ = TRUE) ∨
   (y_squared ≠ x ∧
    3 * y_squared = x ∧
    8 ≤ κ ∧
    ρ = FALSE))

-- You may change anything in this definition except the name and arguments.
def spec_is_quad_residue (mem : F → F) (κ : ℕ) (x ρ : F) : Prop :=
  auto_spec_is_quad_residue mem κ x ρ

/- is_quad_residue soundness theorem -/

-- Do not change the statement of this theorem. You may change the proof.
theorem sound_is_quad_residue
    {mem : F → F}
    (κ : ℕ)
    (x ρ : F)
    (h_auto : auto_spec_is_quad_residue mem κ x ρ) :
  spec_is_quad_residue mem κ x ρ :=
begin
  exact h_auto
end

end starkware.cairo.common.math


namespace hidden

class mygroup (α : Type)
extends has_mul α, has_inv α :=
(e : α)
(mul_assoc (a b c : α) : a * b * c = a * (b * c))
(mul_id (a : α) : a * e = a)
(mul_inv (a : α) : a * a⁻¹ = e)

namespace mygroup

variables {α : Type} [mygroup α]

variables {a b c : α}
-- This sucks

theorem mul_by_right : a = b → a * c = b * c :=
begin
  assume h,
  congr,
  assumption,
end

theorem mul_cancel_right (c : α) : a * c = b * c → a = b :=
begin
  assume h,
  have := congr_arg (λ d, d * c⁻¹) h,
  dsimp only [] at this,
  repeat { rwa [mul_assoc, mul_inv, mul_id] at this },
end

theorem mul_right (c : α) : a = b ↔ a * c = b * c :=
⟨mul_by_right, mul_cancel_right c⟩

theorem mul_by_left : a = b → c * a = c * b :=
begin
  assume h,
  congr,
  assumption,
end

theorem inv_mul : a⁻¹ * a = e :=
begin
  -- This is actually a really hard theorem
  rw [←mul_inv a⁻¹, ←mul_id (a⁻¹ * a), ←mul_inv a⁻¹, ←mul_assoc],
  apply mul_by_right,
  rw [mul_assoc, mul_inv, mul_id],
end

theorem id_mul (a : α) : e * a = a :=
by rw [←mul_inv a, mul_assoc, inv_mul, mul_id]

theorem mul_cancel_left : c * a = c * b → a = b :=
begin
  assume h,
  have := congr_arg (λ d, c⁻¹ * d) h,
  dsimp only [] at this,
  repeat { rwa [←mul_assoc, inv_mul, id_mul] at this },
end

theorem mul_left (c : α) : a = b ↔ c * a = c * b :=
⟨mul_by_left, mul_cancel_left⟩

theorem id_unique : a * b = a ↔ b = e :=
begin
  split; assume h,
    rwa [mul_left a, mul_id],
  subst h,
  from mul_id a,
end

theorem inv_unique : a * b = e ↔ b = a⁻¹ :=
begin
  split; assume h,
    rwa [mul_left a, mul_inv],
  subst h,
  from mul_inv a,
end

end mygroup

end hidden


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_binomnegdiscrineq_10alt28asqp1
  (a : ℝ) :
  10 * a ≤ 28 * a^2 + 1 :=
begin
  refine le_of_not_gt _,
  by_cases h1 : (1:ℝ) < a * (bit1 (bit0 (a * 2 + (-(a * 2) + 1)))),
  apply not_lt_of_ge,
  all_goals { simp * at * },
  all_goals { nlinarith },
end


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.constructions.logging.random_oracle
import computational_monads.simulation_semantics.constructions.identity_oracle
import computational_monads.simulation_semantics.oracle_append
import computational_monads.asymptotics.polynomial_time
import computational_monads.asymptotics.negligable
import computational_monads.asymptotics.queries_at_most

/-!
# Cryptographic Signature Schemes

This file defines signature algorithms and security properties for them.
Signature algorithms are defined by a structure containing the relevant types,
and algorithms with inputs and outputs corresponding to the provided types.
A signature scheme is then defined to be a set of signatures indexed by a security parameter

Completeness is defined to be the property that any result of gen and sign passes verify.
Note that this doesn't allow for negligable failure, as some literature does.

Unforgeable is defined to be the property that any adversary with access to a signing oracle
cannot forge a valid message/signature pair with more than negligable advantage.

Note that the schemes assume algorithms have access to a shared random oracle.
Signature schemes that don't need this can provide the empty spec `[]ₒ`,
  which has no way to actually be queried
-/

open_locale ennreal nnreal
open oracle_comp oracle_spec

/-- Signature on messages `M`, public and secret keys `PK` and `SK`, signatures of type `S`.
  We model the algorithms as having access to a uniform selection oracle,
    and a set of random oracles that the algorithm has access to.
  If not in the random oracle model, can just take `random_oracles := []ₒ`, the empty `oracle_spec`
  We also bundle the polynomial complexity of the algorithms into the structure. -/
structure signature :=
-- Types of the possible messages, public keys, secret keys, and signatures
(M PK SK S : Type)
-- Equality between messages and between signatures is decidable (unneeded for `PK` and `SK`)
(decidable_eq_M : decidable_eq M)
(decidable_eq_S : decidable_eq S)
-- There exists at least one signature (in particular we can define a signing oracle)
(inhabited_S : inhabited S)
-- There are a finite number of possible signatures
(fintype_S : fintype S)
-- Random oracles for the algorithms, with finite ranges and computablity requirements.
(random_oracle_spec : oracle_spec)
-- The actual algorithms of the signature scheme.
(gen : unit → oracle_comp (uniform_selecting ++ random_oracle_spec) (PK × SK))
(sign : PK × SK × M → oracle_comp (uniform_selecting ++ random_oracle_spec) S)
(verify : PK × M × S → oracle_comp (uniform_selecting ++ random_oracle_spec) bool)
-- Requirement that all the algorithms have polynomial time complexity.
-- (gen_poly_time : poly_time_oracle_comp gen)
-- (sign_poly_time : poly_time_oracle_comp sign)
-- (verify_poly_time : poly_time_oracle_comp verify)

namespace signature

variable (sig : signature)

section oracle_instances

instance decidable_eq_S' : decidable_eq sig.S := sig.decidable_eq_S

instance decidable_eq_M' : decidable_eq sig.M := sig.decidable_eq_M

instance inhabited_S' : inhabited sig.S := sig.inhabited_S

instance fintype_S' : fintype sig.S := sig.fintype_S

end oracle_instances

section oracle_spec

/-- Shorthand for the combination of the `uniform_selecting` oracle and the `random_oracles`,
  i.e. the oracles available to the signature algorithms themselves -/
@[reducible, inline]
def base_oracle_spec (sig : signature) : oracle_spec := uniform_selecting ++ sig.random_oracle_spec

/-- Simulate the basic oracles for the signature, using `random_oracle` to simulate the
random oracle and preserving the `uniform_selecting` oracle as is. -/
noncomputable def base_oracle (sig : signature) :
  sim_oracle sig.base_oracle_spec uniform_selecting (query_log sig.random_oracle_spec) :=
sim_oracle.mask_state (idₛ ++ₛ random_oracle sig.random_oracle_spec)
  (equiv.punit_prod (query_log sig.random_oracle_spec))

/-- A signing oracle corresponding to a given signature scheme -/
@[reducible, inline]
def signing_oracle_spec (sig : signature) [inhabited sig.S] : oracle_spec := sig.M ↦ₒ sig.S

/-- Simulate a computation with access to a `signing_oracle_spec` to one with `base_oracle_spec`,
  using the provided public/secret keys to answer queries for signatures.
Additionally it logs and returns a list queries to the signing oracle -/
def signing_oracle (sig : signature) (pk : sig.PK) (sk : sig.SK) :
  sim_oracle sig.signing_oracle_spec sig.base_oracle_spec (query_log (sig.M ↦ₒ sig.S)) :=
sim_oracle.mask_state (⟪λ _ m, sig.sign (pk, sk, m)⟫ ∘ₛ (logging_oracle (sig.M ↦ₒ sig.S)))
  (equiv.prod_punit (query_log (signing_oracle_spec sig)))

end oracle_spec

section complete

/-- Generate a key, sign on the given message, and return the result of verify on the signature.
  Random oracles have a shared cache for the entire computation,
  and the uniform selection oracle just forwards its query on. -/
noncomputable def completeness_experiment (sig : signature) (m : sig.M) :
  oracle_comp uniform_selecting bool :=
default_simulate' sig.base_oracle
(do { (pk, sk) ← sig.gen (),
      σ ← sig.sign (pk, sk, m),
      sig.verify (pk, m, σ) })

lemma completeness_experiment.def (m : sig.M) : sig.completeness_experiment m = default_simulate'
  sig.base_oracle (do {k ← sig.gen (), σ ← sig.sign (k.1, k.2, m), sig.verify (k.1, m, σ)}) :=
begin
  sorry
end

@[simp] lemma support_completeness_experiment (m : sig.M) :
  (completeness_experiment sig m).support = ⋃ (pk : sig.PK) (sk : sig.SK) (σ : sig.S)
    (cache cache' : query_log sig.random_oracle_spec)
    (hk : ((pk, sk), cache) ∈ (default_simulate sig.base_oracle $ sig.gen ()).support)
    (hσ : (σ, cache') ∈ (simulate sig.base_oracle (sig.sign (pk, sk, m)) cache).support),
      (simulate' sig.base_oracle (sig.verify (pk, m, σ)) cache').support :=
begin
  ext x,
  simp only [completeness_experiment.def, default_simulate',
    support_simulate'_bind, set.mem_Union],
  sorry,
end

/-- Signature is complete if for any possible message, the generated signature is valid,
  i.e. the output of `sign` always returns true when `verify` is called.
  note that this definition doesn't allow for negligable failure of signing -/
def complete (sig : signature) := ∀ (m : sig.M), ⁅completeness_experiment sig m⁆ tt = 1

lemma complete_iff_signatures_support_subset :
  sig.complete ↔ ∀ (m : sig.M) (pk : sig.PK) (sk : sig.SK) (σ : sig.S)
    (log log' : query_log sig.random_oracle_spec),
    ((pk, sk), log) ∈ (default_simulate sig.base_oracle $ sig.gen ()).support →
    (σ, log') ∈ (simulate sig.base_oracle (sig.sign (pk, sk, m)) log).support →
    (simulate' sig.base_oracle (sig.verify (pk, m, σ)) log').support = {tt} :=
begin
  simp_rw [complete, eval_dist_eq_one_iff,
    support_completeness_experiment], sorry,
end

end complete

section unforgeable

/-- The adversary for the signing experiment has access to both the signature scheme's oracles,
  and a signing oracle that will be simulated with the hidden secret key. -/
@[reducible, inline]
def unforgeable_adversary_oracle_spec (sig : signature) : oracle_spec :=
uniform_selecting ++ sig.random_oracle_spec ++ sig.signing_oracle_spec

/-- An adversary for the unforgeable signature experiment.
  Note that the adversary only has access to the public key. -/
structure unforgeable_adversary (sig : signature) :=
(adv : sig.PK → oracle_comp (sig.unforgeable_adversary_oracle_spec) (sig.M × sig.S))
(adv_poly_time : poly_time_oracle_comp adv)
(query_bound : ℕ)
(adv_queries_at_most : ∀ pk, queries_at_most (adv pk) query_bound)

namespace unforgeable_adversary

variables {sig} (adversary : unforgeable_adversary sig)

/-- Wrapper function for simulation that hides the "state values" of the stateless oracles.
Runs the adversary with a signing oracle based on the provided public/secret keys,
  returning the results of the adversary, and a log of the queries made by the adversary
 -/
def simulate (pk : sig.PK) (sk : sig.SK) :
  oracle_comp sig.base_oracle_spec (sig.M × sig.S × query_log (sig.M ↦ₒ sig.S)) :=
do{ ((m, s), _, log) ← (default_simulate (idₛ ++ₛ signing_oracle sig pk sk) (adversary.adv pk)),
    return (m, s, log) }

/-- Experiement for testing if a signature scheme is unforgeable.
  Generate the public/secret keys, then simulate the adversary to get a signature.
  Adversary succeeds if the signature verifies and the message hasn't been queried -/
noncomputable def experiment (sig : signature) (adversary : unforgeable_adversary sig) :
  oracle_comp uniform_selecting bool :=
default_simulate' (idₛ ++ₛ random_oracle sig.random_oracle_spec)
(do { (pk, sk) ← sig.gen (),
      (m, σ, log) ← adversary.simulate pk sk,
      b ← sig.verify (pk, m, σ),
      return (if log.not_queried () m then b else ff) })

/-- Adversaries success at forging a signature. -/
noncomputable def advantage {sig : signature} (adversary : unforgeable_adversary sig) : ℝ≥0∞ :=
⁅(= tt) | adversary.experiment sig⁆

end unforgeable_adversary

end unforgeable

end signature

/-- signature scheme is a set of signature algorithms indexed by a security parameter -/
def signature_scheme := Π (sp : ℕ), signature

namespace signature_scheme

open signature

/-- Scheme is complete if it is complete for each security parameter -/
def complete (sig_scheme : signature_scheme) : Prop :=
∀ (sp : ℕ), (sig_scheme sp).complete

/-- Signature scheme is unforgeable if any polynomial time adversary has negligible advantage in
  `unforgeable_experiment` as the security parameter grows -/
def unforgeable (sig_scheme : signature_scheme) : Prop :=
∀ (adversary : Π (sp : ℕ), unforgeable_adversary $ sig_scheme sp),
  (∃ (p : polynomial ℕ), ∀ n, (adversary n).query_bound ≤ p.eval n) →
  negligable (λ sp, (adversary sp).advantage)

end signature_scheme


import substances
open set topological_space classical
local attribute [instance] prop_decidable

/-! # The Theory of Counterfactuals -/

namespace ontology

variables (ω : ontology)

/- **TODOs**
  TODO: consider changing the structure
  below to use relations once they become
  avaiable via relations.lean
-/

/-- **Counterfactual Relations** are simply
(dyadic) relations between events -/
structure cfr :=
  (entails : ω.event → ω.event → ω.event)
  /-- Subjunctive conditional/implication. -/
  add_decl_doc cfr.entails

/-- Given `c : ω.cfr`, use `c e₁ e₂` instead of `c.entails e₁ e₂`. -/
instance has_coe_to_fun_cfr : has_coe_to_fun ω.cfr :=
  ⟨_, cfr.entails⟩

-- Natural examples of `cfrs`.
section cfr_examples

  /-- The naive way to define a `cfr` is to think that subjunctive implication
      just reduces to normal implication in the context of some theory.
      So that, e.g., "If I were to throw something up it would go down" is true
      because there exists some true theory of physics which contains
      the law of universal gravitation from which it would be possible to prove
      this statement.
      Because we can see a true theory as simply an event,
      i.e. the event of the theory being true, this justifies our definition. -/
  def naive_cfr : ω.cfr := ⟨λe₁ e₂ w, ∃ e : ω.event, e.occurs w ∧ e ∩ e₁ ⇒ e₂⟩

  /- The previous definition contains a paradox, can you spot it? -/

  /-- `e₁` subjunctively entails `e₂` in world `w` if the removal of any entities from `w`
      implies `e₁ ⟶ e₂`.
      Alternatively, if for any world "smaller" than `w`
      in which `e₁` happens, `e₂` also happens. -/
  def removal_cfr : ω.cfr := ⟨λe₁ e₂ w, w.ideal ⇒ e₁ ⟶ e₂⟩
  /-- `e₁` subjunctively entails `e₂` in world `w` if the addition of any entities from `w`
      implies `e₁ ⟶ e₂`.
      Alternatively, if for any world "larger" than `w`
      in which `e₁` happens, `e₂` also happens. -/
  def addition_cfr : ω.cfr := ⟨λe₁ e₂ w, w.filter ⇒ e₁ ⟶ e₂⟩
  /-- `e₁` subjunctively entails `e₂` in world `w` if the addition or removal of any entities from `w`
      implies `e₁ ⟶ e₂`. -/
  def arithmetic_cfr : ω.cfr := ⟨λe₁ e₂, ω.removal_cfr e₁ e₂ ∪ ω.addition_cfr e₁ e₂⟩

end cfr_examples

section cfr

  variables {ω} (c : ω.cfr) (e₁ e₂ : ω.event)

  /-- **Counterfactual dependence** relation.
    i.e. if `e₁` were not the case `e₂` would not be the case. -/
  @[reducible]
  def cfr.depends : ω.event := c (-e₁) (-e₂)

  -- counterfactual entanglement
  @[reducible]
  def cfr.entangled : ω.event := c.depends e₁ e₂ ∩ c.depends e₂ e₁

  /-- Counterfactual **strong** (or one sided) dependence.
      Could also be called "event causation", but we reserve
      the name "cause" for a more qualified definition. -/
  @[reducible]
  def cfr.sdepends : ω.event := c.depends e₁ e₂ - c.depends e₂ e₁

  -- counterfactual independence
  @[reducible]
  def cfr.independent : ω.event := -c.depends e₁ e₂ ∩ -c.depends e₂ e₁

  /-- If `e₁` subjunctively entails `e₂` in `w` and `e₁` occurs in `w`, `e₂`
      should also occur in `w`. -/
  def cfr.postulate₁ : Prop := ∀ e₁ e₂, c e₁ e₂ ⇒ e₁ ⟶ e₂

  /-- A `cfr` is paradoxical if the falsity of the antecedent of the subjunctive implication
      implies its truth. -/
  def cfr.paradox₁ : Prop := ∀ e₁ e₂, -e₁ ⇒ c e₁ e₂

  /-- The naive cfr is paradoxical, because if the antecedent of the subjunctive
    implication is false the implication is always true. -/
  lemma naive_cfr_paradox₁ : ω.naive_cfr.paradox₁ :=
    begin
      intros e₁ e₂,
      unfold_coes,
      intros w hw,
      simp [naive_cfr, has_mem.mem, set.mem],
      use {w}, refine ⟨mem_singleton_iff.2 rfl, _⟩,
      replace hw := singleton_inter_eq_empty.2 hw,
      rw hw,
      tauto,
    end

end cfr

/-- **Closer_Than Relations (ctr)** are world-indexed pre-orders between worlds.
    They express that a world `w₁` is at least as close
    to a reference world `w` than some other world `w₂`. -/
structure ctr :=
  (closer : ω.world → ω.world → ω.world → Prop)
  (axiom₁ : ∀ w, reflexive $ closer w)
  (axiom₂ : ∀ w, transitive $ closer w)

/-- Given `c : ω.ctr`, use `c w w₁ w₂` instead of `c.closer w w₁ w₂`. -/
instance has_coe_to_fun_ctr : has_coe_to_fun ω.ctr :=
  ⟨_, ctr.closer⟩

/-- Irreflexive version of `ctr.closer`. -/
def ctr.closer' {ω : ontology} (c : ω.ctr) : ω.world → ω.world → ω.world → Prop :=
  assume w w₁ w₂,
  c w w₁ w₂ ∧ ¬ c w w₂ w₁

/- **TODOs**
  TODO: One idea was to construct
        the definition along the lines of
        "w₁ is at least as close to w than w₂ ↔
        the least cardinality/ordinality of linear orders/well-orders containing w and w₁
        is ≤ than the least cardinality/ordinality of linear orders/well-orders containing w and w₂"
        And maybe we could extend this to the sums of ordinals of multiple well-orders,
        for the case in which the possible worlds are incomparable.
        But the definition below is much simpler than that.
        Revise this idea in the future.
-/
/-- the natural `ctr` is the one naturally defined by
    the specialization order of the ontology. -/
def nctr : ω.ctr :=
  { closer := λ w w₁ w₂, w.entities ∩ w₂.entities ⊆ w.entities ∩ w₁.entities
  , axiom₁ := λ_, by simp [reflexive]
  , axiom₂ := begin
                intro w,
                simp [transitive],
                intros x y z h₁ h₂ e he,
                specialize h₂ he,
                apply h₁, clear h₁,
                replace he := he.left,
                exact ⟨he, h₂⟩,
              end
  }

instance default_ctr : inhabited ω.ctr :=
  -- comment out to change the `ctr`.
  ⟨ω.nctr⟩
  -- your new and improved `ctr` goes here:
  -- ⟨...⟩
  -- defining this thingy here ↑
  -- is what all philosophical
  -- discussions boil down to.

/-- The **Lewisian** `cfr` is the `cfr` defined by a `ctr`. -/
def lcfr (c : ω.ctr := default ω.ctr) : ω.cfr :=
  ⟨ λ e₁ e₂ w, ¬⋄e₁ ∨
    (∃ w', w' ∈ (e₁ ∩ e₂) ∧
    (∀ w'', e₁.occurs w'' → ¬ e₂.occurs w'' → c.closer' w w' w'')
    ) ⟩

instance default_cfr : inhabited ω.cfr :=
  -- comment out to change the `cfr`.
  ⟨ω.lcfr⟩
  -- your new and improved `cfr` goes here:
  -- ⟨...⟩
  -- defining this thingy here ↑
  -- is what all philosophical
  -- discussions boil down to.

/- **TODOs**
    TODO: Define ` ⟶+ ` notation as the
    subjunctive implication arrow relative to a default
    choice of counterfactual relation.
    TODO: Define `x ⟶- y` notation as `-x ⟶+ -y`.

    TODO: Specify different ways with which counterfactual
          relations (`cfrs`) can be
          defined. The main one
          (which should probably become the default)
          will be via Lewisian `ctrs`, or some such
          (perhaps "Prussian") variation of it,
          using the natural `ctr` as the
          default. It remains to be investigated whether
          this is equivalent to what is currently defined in
          causality.lean for the `x ⟶- y` case.

          Some other
          such ways could be by the introduction of primitive
          projection operators `π` of signature
          `event → world → world` or `event → world → set world`,
          which for every pair `e, w` would define what the
          world `w` would be like in case `e` were to occur.
          Then `e₁ ⟶+ e₂` should reduce to {w | (π e₁ w) ∈ e₂}
          or to {w | (π e₁ w) ⊆ e₂}, respectively.
          Compared to the `ctrs`, it does look harder to define
          such projections without assuming new primitives.
          Yet another way could be by the introduction of a
          collection of events with which to restrict the
          existential quantification of the `naive_cfr`
          definition, so as to avoid `cfr.paradox₁` and
          other such paradoxes.

    TODO: Don't forget to set up defaults (inhabited)
          for every type defined in this module.
          This is important.
-/

end ontology


import topology.sheaves.sheaf
import algebra.category.Group.limits
import oc
import lemmas.about_opens
import group_theory.perm.sign
import tactic

noncomputable theory

section

open topological_space Top Top.sheaf
open category_theory
open opposite

universe u
variables {X : Top.{u}} (𝓕 : sheaf Ab X) (U : X.oc)

section

variables {U}

def ignore {n : ℕ} (α : fin (n + 1) → U.ι) (i : fin (n + 1)) :
  fin n → U.ι :=
λ k, dite (k.1 < i.1)
  (λ ineq1, α ⟨k.1, lt_trans ineq1 i.2⟩)
  (λ ineq1, α ⟨k.1.pred, begin
    rw nat.lt_succ_iff,
    refine le_of_lt _,
    exact lt_of_le_of_lt (nat.pred_le _) k.2,
  end⟩)

def ignore₂ {n : ℕ} (α : fin (n + 2) → U.ι) (i : fin (n + 2)) (j : fin (n + 1)) :
  fin n → U.ι :=
ignore (ignore α i) j

lemma ignore.apply_lt {n : ℕ} (α : fin (n + 1) → U.ι) (i : fin (n + 1))
  {k : fin n} (ineq1 : k.1 < i.1) :
  ignore α i k = α ⟨k.1, lt_trans ineq1 i.2⟩ :=
dif_pos ineq1

lemma ignore.apply_not_lt {n : ℕ} (α : fin (n + 1) → U.ι) (i : fin (n + 1))
  {k : fin n} (ineq1 : ¬ k.1 < i.1) :
  ignore α i k = α ⟨k.1.pred, begin
    rw nat.lt_succ_iff,
    refine le_of_lt _,
    exact lt_of_le_of_lt (nat.pred_le _) k.2,
  end⟩ :=
dif_neg ineq1

lemma ignore.apply_ite {n : ℕ} (α : fin (n + 1) → U.ι) (i : fin (n + 1))
  (k : fin n) :
  ignore α i k =
  dite (k.1 < i.1)
    (λ ineq1, α ⟨k.1, lt_trans ineq1 i.2⟩)
    (λ ineq1, α ⟨k.1.pred, begin
      rw nat.lt_succ_iff,
      refine le_of_lt _,
      exact lt_of_le_of_lt (nat.pred_le _) k.2,
    end⟩) := rfl

/--

a0, a1, ..., ai, ..., aj, ...., a(n+2)

                                                j-1th  jth
ignore α i = a0, a1, ...., a(i-1), a(i+1), .... aj,   a(j+1) ...., a(n+2)
ignore α (ignore α i) j = a0, a1, ..., a(i-1), a(i+1), ..., aj, a(j+2), ... a(n+2)

(i < j)
so ignore₂ α i j = ignore₂ α (j + 1) i

(i = j)
                                  i-th         n+1st
ignore α i = a0, a1, ..., a(i-1), a(i+1), ... a(n+2)
                                              ith          nth
ignore (ignore α i) i = a0, a1, .... a(i-1), a(i+2), .... a(n+2)
-/

-- this is almost certainly correct, as I wrote a python script to test
lemma ignore₂_symm' {n : ℕ} (α : fin (n + 2) → U.ι)
  {i : ℕ} (hi : i ∈ finset.range n.succ)
  {j : ℕ} (hj : j ∈ finset.Ico i n.succ) : -- i ≤ j
  ignore₂ α ⟨j + 1, begin
    rw finset.mem_Ico at hj,
    rw nat.succ_lt_succ_iff,
    exact hj.2
  end⟩ ⟨i, finset.mem_range.mp hi⟩ = ignore₂ α ⟨i, lt_trans (finset.mem_range.mp hi) (lt_add_one _)⟩ ⟨j, (finset.mem_Ico.mp hj).2⟩ :=
begin
  /-
  if i = 0 then
    rhs = ignore₂ α 0 j m = ignore (ignore α 0) j m
      = ignore α 0 m = α (m - 1) if m < j
      = ignore α 0 (m-1) = α (m - 1) if j ≤ m

  if i = j,
    rhs = ignore₂ α i i m
    lhs = ignore₂ α (i+1) i m

  if i < j

  if 0 ≤ m ≤ i-1 < i < j,
  then rhs = ignore₂ α i j m = ignore (ignore α i) j m = ignore α i m = α m
       lhs = ignore₂ α (j + 1) i m = ignore (ignore α (j + 1)) i m = ignore α (j + 1) m = α m

  if i-1 < m < j, i.e. i ≤ m < j
  then rhs = ignore₂ α i j m = ignore (ignore α i) j m = ignore α i m = α (m - 1)
       lhs = ignore₂ α (j + 1) i m = ignore α (j + 1) (m - 1) = α (m - 1)

  if j = m, i < j, i.e. i ≤ j-1
  then rhs = ignore₂ α i j j = ignore (ignore α i) j j = ignore α i (j-1) = α (j-2)
    lhs = ignore₂ α (j + 1) i j = ignore α (j + 1) (j - 1) = α (j - 2)

  if j + 1 = m,
  then rhs = ignore₂ α i j (j+1) = ignore₂ α i j = α (j - 1)
    lhs = ignore₂ α (j+1) i (j+1) = ignore₂ α (j+1) j = α (j-1)

  if j + 1 < m, then j < m - 1 then j - 1 ≤ m-1
  then rhs = ignore₂ α i j m = ignore α i (m-1) = α (m-2)
    lhs = ignore₂ α (j+1) i m = ignore α (j + 1) (m-1) = α (m-2)
  -/
  rw finset.mem_Ico at hj,
  rw finset.mem_range at hi,
  ext1 m,
  change ignore _ _ _ = ignore _ _ _,
  by_cases ineq1 : m.1 < i,
  { have ineq2' : m.1 < j := lt_of_lt_of_le ineq1 hj.1,
    have ineq2 : m.1 < j + 1 := lt_trans ineq2' (lt_add_one _),
    rw ignore.apply_lt,
    swap, exact ineq1,
    rw ignore.apply_lt,
    swap, exact ineq2,
    rw ignore.apply_lt,
    swap, exact ineq2',
    rw ignore.apply_lt,
    exact ineq1 },
  { rw not_lt at ineq1,
    rw ignore.apply_not_lt,
    swap, rwa not_lt,
    sorry,
     },
  -- sorry,
end

lemma ignore₂.apply_lt_min {n : ℕ} (α : fin (n + 2) → U.ι)
  (i : fin (n + 2)) (j : fin (n + 1))
  (h : i.1 ≤ j.1)
  (k : fin n)
  (hj : k.1 < i.1) :
  ignore₂ α i j k = α ⟨k.1, by linarith [k.2]⟩ :=
begin
  change ignore _ _ _ = _,
  rw ignore.apply_lt,
  rw ignore.apply_lt,
  assumption,
  refine lt_of_lt_of_le _ h,
  assumption,
end

@[derive [decidable_eq]]
inductive sign
| neg
| zero
| pos

def unit_to_sign (n : ℤˣ) : sign :=
if n = 1 then sign.pos else sign.neg

def signature.order_aux {n : ℕ} {α : fin n → U.ι} (inj : function.injective α) :
  fin n ≃o finset.image α finset.univ :=
finset.order_iso_of_fin _ begin
  rw finset.card_image_of_injective _ inj,
  exact finset.card_fin n,
end

def signature.restrict_aux {n : ℕ} {α : fin n → U.ι} (inj : function.injective α) :
  fin n ≃ finset.image α finset.univ :=
equiv.of_bijective (λ k, ⟨α k, finset.mem_image.mpr ⟨k, finset.mem_univ _, rfl⟩⟩) begin
  split,
  { intros a b h,
    simp only [subtype.mk_eq_mk] at h,
    apply_fun α,
    exact h, },
  { rintros ⟨i, hi⟩,
    rw finset.mem_image at hi,
    rcases hi with ⟨j, _, rfl⟩,
    use j, }
end

def signature.equiv {n : ℕ} {α : fin n → U.ι} (inj : function.injective α) :
  fin n ≃ fin n :=
{ to_fun := function.comp (signature.order_aux inj).symm (signature.restrict_aux inj),
  inv_fun := function.comp (signature.restrict_aux inj).symm (signature.order_aux inj),
  left_inv := λ k, by simp,
  right_inv := λ k, by simp }

def signature {n : ℕ} (α : fin n → U.ι) : sign :=
dite (function.injective α)
(λ inj, unit_to_sign $ equiv.perm.sign (signature.equiv inj))
(λ _, sign.zero)

def swap {n : ℕ} (i j : fin n) (α : fin n → U.ι) : fin n → U.ι :=
λ k, if (k = i)
  then α j
  else if (k = j)
    then α i
    else α k

namespace swap

variables {U} {n : ℕ} (α : fin n → U.ι)

@[simp]
lemma same (i : fin n) :
  swap i i α = α :=
begin
  ext,
  change ite _ _ _ = _,
  split_ifs,
  { subst h, },
  { refl, }
end

@[simp]
lemma symmetric (i j : fin n) :
  swap i j α = swap j i α :=
begin
  ext,
  change ite _ _ _ = ite _ _ _,
  split_ifs with h1 h2,
  { subst h1,
    subst h2, },
  { subst h1, },
  { subst h, },
  { refl, },
end

@[simp]
lemma twice (i j : fin n) :
  swap i j (swap i j α) = α :=
begin
  ext,
  change ite _ _ _ = _,
  split_ifs with h1,
  { change ite _ _ _ = _,
    split_ifs with h2,
    { subst h2, subst h1, },
    { subst h1, }, },
  { change ite _ _ _ = _,
    rw if_pos rfl,
    subst h, },
  { change ite _ _ _ = _,
    split_ifs,
    refl, },
end

lemma apply1 (i j : fin n) :
  swap i j α i = α j :=
begin
  change ite _ _ _ = _,
  rw if_pos rfl,
end

lemma apply1' (i j : fin n) {i' : fin n} (eq1 : i'.1 = i.1) :
  swap i j α i' = α j :=
begin
  convert apply1 α i j,
  rw subtype.ext_iff_val,
  exact eq1,
end

lemma apply2 (i j : fin n) :
  swap i j α j = α i :=
begin
  change ite _ _ _ = _,
  rw if_pos rfl,
  split_ifs,
  { subst h, },
  { refl, }
end

lemma apply2' (i j : fin n) {j' : fin n} (eq1 : j'.1 = j.1) :
  swap i j α j' = α i :=
begin
  convert apply2 α i j,
  rw subtype.ext_iff_val,
  exact eq1,
end

lemma apply_ne (i j k : fin n)
  (ineq1 : k ≠ i)
  (ineq2 : k ≠ j) :
  swap i j α k = α k :=
begin
  change ite _ _ _ = _,
  rw [if_neg, if_neg];
  assumption,
end

lemma nat.pred_eq_self {n : ℕ} (h : n.pred = n) : n = 0 :=
begin
  induction n with n h1 generalizing h,
  { refl, },
  { rw nat.pred_succ at h,
    exfalso,
    have ineq1 := lt_add_one n,
    rw nat.succ_eq_add_one at h,
    rw ← h at ineq1,
    apply lt_irrefl _ ineq1, },
end

-- If `max i j < k`, then `ignore (swap i j α) k = swap i j (ignore α k)`
-- If `k < min i j`, then `ignore (swap i j α) k = swap (i + 1) (j + 1) (ignore α k)`
-- If `min i j ≤ k ≤ max i j`, then `ignore (swap i j α) k = swap (min i j) ((max i j) - 1) (ignore α k)` or `ignore (swap i j α) k = swap (min i j) (max i j) (ignore α k)`

-- lemma ignore_swap_eq_swap_ignore
--   (α : fin (n + 1) → U.ι)
--   (i j k : fin (n + 1)) :
--   ∃ (i' j' : fin n),
--   ignore (swap i j α) k = swap i' j' (ignore α k) := sorry

-- lemma swap_ignore_gt (α : fin (n+1) → U.ι) (i j k : fin (n+1))
--   (ineq1 : max i.1 j.1 < k.1):
--   ignore (swap i j α) k = swap ⟨i.1, begin
--     by_contra r,
--     rw not_lt at r,
--     have ineq2 := i.2,
--     have eq1 : i.1 = n,
--     { linarith, },
--     have ineq3 : n < k.1,
--     { refine lt_of_le_of_lt _ ineq1,
--       simp [← eq1], },
--     have ineq4 := k.2,
--     linarith,
--   end⟩ ⟨j.1, begin
--     by_contra r,
--     rw not_lt at r,
--     have ineq2 := j.2,
--     have eq1 : j.1 = n,
--     { linarith, },
--     have ineq3 : n < k.1,
--     { refine lt_of_le_of_lt _ ineq1,
--       simp [← eq1], },
--     have ineq4 := k.2,
--     linarith,
--   end⟩ (ignore α k) :=
-- begin
--   ext m,
--   by_cases ineq2 : m.1 = i.1;
--   by_cases ineq3 : m.1 = j.1,
--   { -- m = i = j,
--     rw [← ineq2, ← ineq3, max_self] at ineq1,
--     rw ignore.apply_lt,
--     swap, exact ineq1,
--     rw [apply1', apply1', ignore.apply_lt],
--     congr' 1,
--     rw subtype.ext_iff_val,
--     { convert ineq1,
--       rw subtype.ext_iff_val,
--       exact ineq3.symm, },
--     exact ineq2,
--     exact ineq2, },
--   { -- m = i but m ≠ j,
--     rw apply1',
--     swap, exact ineq2,
--     rw ← ineq2 at ineq1,
--     have ineq4 := lt_of_le_of_lt (le_max_left _ _) ineq1,
--     rw ignore.apply_lt,
--     swap, exact ineq4,
--     rw apply1',
--     swap, exact ineq2,
--     rw ignore.apply_lt,
--     swap, exact lt_of_le_of_lt (le_max_right _ _) ineq1,
--     congr' 1,
--     rw subtype.ext_iff_val, },
--   { -- m ≠ i but m = j,
--     rw apply2',
--     swap, exact ineq3,
--     rw ← ineq3 at ineq1,
--     have ineq4 := lt_of_le_of_lt (le_max_right _ _) ineq1,
--     rw ignore.apply_lt,
--     swap, exact ineq4,
--     rw ignore.apply_lt,
--     swap, exact lt_of_le_of_lt (le_max_left _ _) ineq1,
--     rw apply2',
--     swap, exact ineq3,
--     congr' 1,
--     rw subtype.ext_iff_val, },
--   { -- m ≠ i and m ≠ j,
--     rw apply_ne,
--     swap, contrapose! ineq2, rw ineq2,
--     swap, contrapose! ineq3, rw ineq3,
--     rw ignore.apply_ite,
--     rw ignore.apply_ite,
--     split_ifs with ineq4,
--     { rw apply_ne,

--       contrapose! ineq2,
--       rw ← ineq2,

--       contrapose! ineq3,
--       rw ← ineq3, },
--     { by_cases ineq5 : m.1.pred = i.1,
--       { rw apply1',
--         swap, exact ineq5,

--         have EQ : i.1 = j.1,
--         { have ineq0 : m.1 ≠ 0,
--           { intro r,
--             rw r at *,
--             linarith, },
--           have eq0 : m.1 = i.1 + 1,
--           { rw [← ineq5, ← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
--             linarith },
--           rw [eq0, not_lt] at ineq4,
--           have ineq6 : k.1 = i.1 + 1,
--           { have INEQ : i.1 < k.1 := lt_of_le_of_lt (le_max_left _ _) ineq1,
--             linarith },
--           have ineq7 : i.1 ≤ j.1,
--           { have INEQ := lt_of_lt_of_le ineq1 ineq4,
--             have EQ : max i.1 j.1 = j.1,
--             { suffices : i ≤ j,  }, },
--           sorry },
--         congr' 1,
--         rw [subtype.ext_iff_val, ← EQ, ← ineq5], },
--       { sorry } }, }
-- end

end swap

def face {n : ℕ} (α : fin n → U.ι) : opens X :=
  infi (λ (k : fin n), U.cover $ α k)

section face

lemma face.congr {n : ℕ} {α β : fin n → U.ι} (h : α = β) :
  face α = face β :=
by subst h

lemma face.swap_eq {n : ℕ} (α : fin n → U.ι) (i j : fin n) :
  face α = face (swap i j α) :=
begin
  change infi _ = infi _,
  refine le_antisymm _ _,
  { rw le_infi_iff,
    intros k,
    by_cases k = i,
    { subst h,
      by_cases k = j,
      { subst h,
        rw _root_.swap.same α k,
        intros p hp,
        erw opens.fintype_infi at hp,
        apply hp, },
      { rw _root_.swap.apply1,
        intros p hp,
        erw opens.fintype_infi at hp,
        apply hp, }, },
      { by_cases k = j,
        { subst h,
          rw _root_.swap.apply2,
          intros p hp,
          erw opens.fintype_infi at hp,
          apply hp, },
        { rw _root_.swap.apply_ne,
          intros p hp,
          erw opens.fintype_infi at hp,
          apply hp,
          assumption,
          assumption, }, }, },
  { intros p hp,
    erw opens.fintype_infi at hp ⊢,
    intros k,
    by_cases h1 : k = i,
    { subst h1,
      by_cases h2 : k = j,
      { subst j,
        rw _root_.swap.same at hp,
        apply hp, },
      { specialize hp j,
        rwa _root_.swap.apply2 at hp, }, },
    { by_cases h2 : k = j,
      { subst h2,
        specialize hp i,
        rwa _root_.swap.apply1 at hp, },
      { specialize hp k,
        rwa _root_.swap.apply_ne at hp,
        assumption,
        assumption }, }, }
end

lemma face.le_ignore {n : ℕ} (α : fin (n + 1) → U.ι) (k : fin (n + 1)) :
  face α ≤ face (ignore α k) :=
begin
  intros p hp,
  rw opens.mem_coe at hp ⊢,
  change _ ∈ infi _ at hp,
  change _ ∈ infi _,
  rw opens.fintype_infi at hp ⊢,
  rintros ⟨i, hi⟩,
  by_cases ineq : i < k.1,
  { specialize hp ⟨i, _⟩,
    { refine lt_trans hi _,
      exact lt_add_one n, },
    rw ignore.apply_lt,
    swap, exact ineq,
    exact hp, },
  { specialize hp ⟨i.pred, _⟩,
    { rw nat.lt_succ_iff,
      by_cases i = 0,
      { subst h,
        exact nat.zero_le _, },
      refine le_of_lt _,
      refine lt_trans _ hi,
      exact nat.pred_lt h, },
    rw ignore.apply_not_lt,
    convert hp,
    exact ineq, }
end

lemma face.le_ignore₂ {n : ℕ} (α : fin (n + 2) → U.ι) (i : fin (n + 2)) (j : fin (n + 1)) :
  face α ≤ face (ignore₂ α i j) :=
le_trans (face.le_ignore α i) (face.le_ignore _ j)

end face

end

def C.pre (n : ℕ) : Type* :=
Π (α : fin n → U.ι), 𝓕.1.obj (op $ face α)

namespace C_pre

variable {n : ℕ}
variables {𝓕 U}

instance : has_add (C.pre 𝓕 U n) :=
{ add := λ f g α, f α + g α }

@[simp] lemma add_apply (f g : C.pre 𝓕 U n) (α : fin n → U.ι) :
  (f + g) α = f α + g α := rfl

instance : has_zero (C.pre 𝓕 U n) :=
{ zero := λ α, 0 }

@[simp]
lemma zero_apply (α : fin n → U.ι) :
  (0 : C.pre 𝓕 U n) α = 0 := rfl

instance : has_scalar ℕ (C.pre 𝓕 U n) :=
{ smul := λ n f α, n • f α }

@[simp]
lemma nsmul_apply (f : C.pre 𝓕 U n) (α : fin n → U.ι) (m : ℕ) :
  (m • f) α = m • f α := rfl

instance : add_comm_monoid (C.pre 𝓕 U n) :=
{ add := (+),
  add_assoc := λ a b c, by ext; simp [add_assoc],
  zero := 0,
  zero_add := λ f, by ext; simp,
  add_zero := λ f, by ext; simp,
  nsmul := (•),
  nsmul_zero' := λ f, by ext; simp,
  nsmul_succ' := λ m f, begin
    ext,
    simp [nat.succ_eq_add_one, add_smul, add_comm],
  end,
  add_comm := λ f g, by ext; simp [add_comm] }

instance : add_comm_group (C.pre 𝓕 U n) :=
{ neg := λ f α, - f α,
  add_left_neg := λ f, by ext; simp,
  ..(_ : add_comm_monoid (C.pre 𝓕 U n))}

@[simp]
lemma neg_apply (f : C.pre 𝓕 U n) (α : fin n → U.ι) :
  (-f) α = - (f α) := rfl

end C_pre

abbreviation C (n : ℕ) := AddCommGroup.of (C.pre 𝓕 U n)

-- section

-- variables {𝓕 U}
-- def C.pre.is_skewsymmetric {n : ℕ} (f : C.pre 𝓕 U n) : Prop :=
-- ∀ (i j : fin n) (α : fin n → U.ι),
--   f α =
--   𝓕.1.map (eq_to_hom (face.swap_eq α i j)).op (- f (swap i j α))

-- def C.pre.is_skewsymmetric' {n : ℕ} (f : C.pre 𝓕 U n) : Prop :=
-- ∀ (i j : fin n) (α : fin n → U.ι),
--   f (swap i j α) =
--   - 𝓕.1.map (eq_to_hom (face.swap_eq α i j).symm).op (f α)

-- lemma is_skewsymmetric_iff_is_skewsymmetric' {n} (f : C.pre 𝓕 U n) :
--   C.pre.is_skewsymmetric f ↔ C.pre.is_skewsymmetric' f :=
-- { mp := λ h i j α, begin
--     specialize h i j α,
--     rw [h, map_neg, map_neg, neg_neg, ← comp_apply, ← 𝓕.1.map_comp, ← op_comp, eq_to_hom_trans, eq_to_hom_refl],
--     simp,
--   end,
--   mpr := λ h i j α, begin
--     specialize h i j α,
--     rw [h, neg_neg, ← comp_apply, ← 𝓕.1.map_comp, ← op_comp, eq_to_hom_trans, eq_to_hom_refl],
--     simp
--   end }

-- end

-- def C (n : ℕ) : Type* :=
-- { f : C.pre 𝓕 U n // f.is_skewsymmetric ∧ ∀ (α : fin n → U.ι), ¬ function.injective α → f α = 0}

-- namespace C

-- variables (n : ℕ)

-- @[ext]
-- lemma ext_val {f g : C 𝓕 U n} (eq1 : f.1 = g.1) :
--   f = g := subtype.ext_val eq1

-- instance : has_add (C 𝓕 U n) :=
-- { add := λ f g,
--   ⟨f.1 + g.1, begin
--     split,
--     intros i j α,
--     change f.1 α + g.1 α = 𝓕.1.map _ (- (f.1 _ + g.1 _)),
--     rw [map_neg, map_add, f.2.1 i j, g.2.1 i j, map_neg, map_neg, neg_add],

--     intros α ha,
--     change f.1 α + g.1 α = 0,
--     rw [f.2.2, g.2.2, add_zero];
--     assumption,
--   end⟩ }

-- instance : has_zero (C 𝓕 U n) :=
-- { zero :=
--   ⟨0, begin
--     split,
--     intros i j α,
--     simp only [C_pre.zero_apply, neg_zero, map_zero],

--     intros α ha,
--     simp,
--   end⟩ }

-- instance : has_scalar ℕ (C 𝓕 U n) :=
-- { smul := λ m f, ⟨m • f.1, begin
--     split,
--     intros i j α,
--     simp only [C_pre.nsmul_apply, eq_to_hom_op, eq_to_hom_map, map_neg, map_nsmul],
--     rw f.2.1 i j,
--     simp only [eq_to_hom_op, eq_to_hom_map, map_neg, neg_nsmul],

--     intros α ha,
--     change m • f.1 α = 0,
--     rw f.2.2 _ ha,
--     simp,
--   end⟩ }

-- instance : add_comm_monoid (C 𝓕 U n) :=
-- { add := (+),
--   add_assoc := λ a b c, begin
--     ext,
--     change (a.1 + b.1 + c.1) _ = (a.1 + (b.1 + c.1)) _,
--     simp only [C_pre.add_apply],
--     rw add_assoc,
--   end,
--   zero := 0,
--   zero_add := λ f, begin
--     ext,
--     change (0 + f.1) _ = _,
--     simp only [C_pre.add_apply, C_pre.zero_apply, zero_add],
--   end,
--   add_zero := λ f, begin
--     ext,
--     change (f.1 + 0) _ = _,
--     simp only [C_pre.add_apply, C_pre.zero_apply, add_zero],
--   end,
--   nsmul := (•),
--   nsmul_zero' := λ f, begin
--     ext,
--     change 0 • f.1 _ = 0,
--     rw zero_smul,
--   end,
--   nsmul_succ' := λ m f, begin
--     ext,
--     change (m + 1) • f.1 x = (f.1 + m • f.1) x,
--     rw [add_smul, one_smul, C_pre.add_apply, add_comm],
--     refl,
--   end,
--   add_comm := λ f g, begin
--     ext,
--     change (f.1 + g.1) x = (g.1 + f.1) x,
--     simp only [add_comm, C_pre.add_apply],
--   end }

-- instance : add_comm_group (C 𝓕 U n) :=
-- { neg := λ f, ⟨-f.1, begin
--     split,
--     intros i j α,
--     simp only [C_pre.neg_apply],
--     rw neg_neg,
--     rw f.2.1 i j,
--     simp only [map_neg, neg_neg],

--     intros α ha,
--     change - (f.1 α) = 0,
--     rw f.2.2 _ ha,
--     rw neg_zero,
--   end⟩,
--   add_left_neg := λ f, begin
--     ext,
--     change (-f.1 + f.1) x = 0,
--     simp,
--   end,
--   ..add_comm_monoid 𝓕 U n }

-- end C

end


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Eric Wieser

! This file was ported from Lean 3 source module algebra.graded_mul_action
! leanprover-community/mathlib commit 861a26926586cd46ff80264d121cdb6fa0e35cc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GradedMonoid

/-!
# Additively-graded multiplicative action structures

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over the sigma type `GradedMonoid A` such that `(•) : A i → M j → M (i + j)`; that is to say, `A`
has an additively-graded multiplicative action on `M`. The typeclasses are:

* `GradedMonoid.GSmul A M`
* `GradedMonoid.GMulAction A M`

With the `SigmaGraded` locale open, these respectively imbue:

* `SMul (GradedMonoid A) (GradedMonoid M)`
* `MulAction (GradedMonoid A) (GradedMonoid M)`

For now, these typeclasses are primarily used in the construction of `DirectSum.GModule.Module` and
the rest of that file.

## Internally graded multiplicative actions

In addition to the above typeclasses, in the most frequent case when `A` is an indexed collection of
`SetLike` subobjects (such as `AddSubmonoid`s, `AddSubgroup`s, or `Submodule`s), this file
provides the `Prop` typeclasses:

* `SetLike.GradedSmul A M` (which provides the obvious `GradedMonoid.GSmul A` instance)

which provides the API lemma

* `SetLike.graded_smul_mem_graded`

Note that there is no need for `SetLike.graded_mul_action` or similar, as all the information it
would contain is already supplied by `GradedSmul` when the objects within `A` and `M` have
a `MulAction` instance.

## tags

graded action
-/

variable {ι : Type _}

namespace GradedMonoid

/-! ### Typeclasses -/

section Defs

variable (A : ι → Type _) (M : ι → Type _)

/-- A graded version of `SMul`. Scalar multiplication combines grades additively, i.e.
if `a ∈ A i` and `m ∈ M j`, then `a • b` must be in `M (i + j)`-/
class GSmul [Add ι] where
  /-- The homogeneous multiplication map `smul` -/
  smul {i j} : A i → M j → M (i + j)
#align graded_monoid.ghas_smul GradedMonoid.GSmul

/-- A graded version of `Mul.toSMul` -/
instance GMul.toGSmul [Add ι] [GMul A] : GSmul A A where smul := GMul.mul
#align graded_monoid.ghas_mul.to_ghas_smul GradedMonoid.GMul.toGSmul

instance GSmul.toSMul [Add ι] [GSmul A M] : SMul (GradedMonoid A) (GradedMonoid M) :=
  ⟨fun x y ↦ ⟨_, GSmul.smul x.snd y.snd⟩⟩
#align graded_monoid.ghas_smul.to_has_smul GradedMonoid.GSmul.toSMul

theorem mk_smul_mk [Add ι] [GSmul A M] {i j} (a : A i) (b : M j) :
    mk i a • mk j b = mk (i + j) (GSmul.smul a b) :=
  rfl
#align graded_monoid.mk_smul_mk GradedMonoid.mk_smul_mk

/-- A graded version of `MulAction`. -/
class GMulAction [AddMonoid ι] [GMonoid A] extends GSmul A M where
  /-- One is the neutral element for `•` -/
  one_smul (b : GradedMonoid M) : (1 : GradedMonoid A) • b = b
  /-- Associativity of `•` and `*` -/
  mul_smul (a a' : GradedMonoid A) (b : GradedMonoid M) : (a * a') • b = a • a' • b
#align graded_monoid.gmul_action GradedMonoid.GMulAction

/-- The graded version of `Monoid.toMulAction`. -/
instance GMonoid.toGMulAction [AddMonoid ι] [GMonoid A] : GMulAction A A :=
  { GMul.toGSmul _ with
    one_smul := GMonoid.one_mul
    mul_smul := GMonoid.mul_assoc }
#align graded_monoid.gmonoid.to_gmul_action GradedMonoid.GMonoid.toGMulAction

instance GMulAction.toMulAction [AddMonoid ι] [GMonoid A] [GMulAction A M] :
    MulAction (GradedMonoid A) (GradedMonoid M)
    where
  one_smul := GMulAction.one_smul
  mul_smul := GMulAction.mul_smul
#align graded_monoid.gmul_action.to_mul_action GradedMonoid.GMulAction.toMulAction

end Defs

end GradedMonoid

/-! ### Shorthands for creating instance of the above typeclasses for collections of subobjects -/

section Subobjects

variable {R : Type _}

/-- A version of `GradedMonoid.GSmul` for internally graded objects. -/
class SetLike.GradedSmul {S R N M : Type _} [SetLike S R] [SetLike N M] [SMul R M] [Add ι]
  (A : ι → S) (B : ι → N) : Prop where
  /-- Multiplication is homogeneous -/
  smul_mem : ∀ ⦃i j : ι⦄ {ai bj}, ai ∈ A i → bj ∈ B j → ai • bj ∈ B (i + j)
#align set_like.has_graded_smul SetLike.GradedSmul

instance SetLike.toGSmul {S R N M : Type _} [SetLike S R] [SetLike N M] [SMul R M] [Add ι]
    (A : ι → S) (B : ι → N) [SetLike.GradedSmul A B] :
    GradedMonoid.GSmul (fun i ↦ A i) fun i ↦ B i
    where smul a b := ⟨a.1 • b.1, SetLike.GradedSmul.smul_mem a.2 b.2⟩
#align set_like.ghas_smul SetLike.toGSmul

/-
Porting note: simpNF linter returns
"Left-hand side does not simplify, when using the simp lemma on itself."
However, simp does indeed solve the following. Possibly related std#71,std#78
example {S R N M : Type _} [SetLike S R] [SetLike N M] [SMul R M] [Add ι]
    (A : ι → S) (B : ι → N) [SetLike.GradedSmul A B] {i j : ι} (x : A i) (y : B j) :
    (@GradedMonoid.GSmul.smul ι (fun i ↦ A i) (fun i ↦ B i) _ _ i j x y : M) = x.1 • y.1 := by simp
-/
@[simp,nolint simpNF]
theorem SetLike.coe_GSmul {S R N M : Type _} [SetLike S R] [SetLike N M] [SMul R M] [Add ι]
    (A : ι → S) (B : ι → N) [SetLike.GradedSmul A B] {i j : ι} (x : A i) (y : B j) :
    (@GradedMonoid.GSmul.smul ι (fun i ↦ A i) (fun i ↦ B i) _ _ i j x y : M) = x.1 • y.1 :=
  rfl
#align set_like.coe_ghas_smul SetLike.coe_GSmul

/-- Internally graded version of `Mul.toSMul`. -/
instance SetLike.GradedMul.toGradedSmul [AddMonoid ι] [Monoid R] {S : Type _} [SetLike S R]
    (A : ι → S) [SetLike.GradedMonoid A] : SetLike.GradedSmul A A
    where smul_mem _ _ _ _ hi hj := SetLike.GradedMonoid.toGradedMul.mul_mem hi hj
#align set_like.has_graded_mul.to_has_graded_smul SetLike.GradedMul.toGradedSmul

end Subobjects

section HomogeneousElements

variable {S R N M : Type _} [SetLike S R] [SetLike N M]

theorem SetLike.Homogeneous.graded_smul [Add ι] [SMul R M] {A : ι → S} {B : ι → N}
    [SetLike.GradedSmul A B] {a : R} {b : M} :
    SetLike.Homogeneous A a → SetLike.Homogeneous B b → SetLike.Homogeneous B (a • b)
  | ⟨i, hi⟩, ⟨j, hj⟩ => ⟨i + j, SetLike.GradedSmul.smul_mem hi hj⟩
#align set_like.is_homogeneous.graded_smul SetLike.Homogeneous.graded_smul

end HomogeneousElements