-- ArkLib/Data/FieldTheory/BinaryField/Tower/Impl.lean

import ArkLib.Data.Classes.DCast

import ArkLib.Data.FieldTheory.BinaryField.Tower.Basic

namespace ConcreteBinaryTower

open Polynomial

def ConcreteBTField : ℕ → Type := fun k => BitVec (2 ^ k)

section BitVecDCast

instance BitVec.instDCast : DCast Nat BitVec where
  dcast h := BitVec.cast h
  dcast_id := by admit /- proof elided -/

end BitVecDCast

section ConversionUtils

instance ConcreteBTField.instDCast_local : DCast ℕ ConcreteBTField where
  dcast h_k_eq term_k1 := BitVec.cast (congrArg (fun n => 2 ^ n) h_k_eq) term_k1
  dcast_id := by admit /- proof elided -/

end ConversionUtils

section NumericLemmas

end NumericLemmas

section FieldOperationsAndInstances

def zero {k : ℕ} : ConcreteBTField k := BitVec.zero (2 ^ k)

def one {k : ℕ} : ConcreteBTField k := 1#(2 ^ k)

def split {k : ℕ} (h : k > 0) (x : ConcreteBTField k) :
    ConcreteBTField (k - 1) × ConcreteBTField (k - 1) :=
  let lo_bits : BitVec (2 ^ (k - 1) - 1 - 0 + 1) :=
    BitVec.extractLsb (hi := 2 ^ (k - 1) - 1) (lo := 0) x
  let hi_bits : BitVec (2 ^ k - 1 - 2 ^ (k - 1) + 1) :=
    BitVec.extractLsb (hi := 2 ^ k - 1) (lo := 2 ^ (k - 1)) x
  have h_lo : 2 ^ (k - 1) - 1 - 0 + 1 = 2 ^ (k - 1) := by admit /- proof elided -/

-- Repository definitions used:
content: class DCast (α : Sort*) (β : α → Sort*) where
  dcast : ∀ {a a' : α}, a = a' → β a → β a'
  dcast_id : ∀ {a : α}, dcast (Eq.refl a) = id

-- Repository lemmas used:
content: @[simp]
theorem dcast_eq : dcast (Eq.refl a) b = b

content: theorem one_le_sub_consecutive_two_pow (n : ℕ): 1 ≤ 2^(n+1) - 2^n

content: theorem zero_lt_pow_n (m : ℕ) (n : ℕ) (h_m : m > 0): 0 < m^n

-- Local definitions used:
content: def ConcreteBTField : ℕ → Type := fun k => BitVec (2 ^ k)

content: instance BitVec.instDCast : DCast Nat BitVec where
  dcast h := BitVec.cast h
  dcast_id := by admit /- proof elided -/

content: instance ConcreteBTField.instDCast_local : DCast ℕ ConcreteBTField where
  dcast h_k_eq term_k1 := BitVec.cast (congrArg (fun n => 2 ^ n) h_k_eq) term_k1
  dcast_id := by admit /- proof elided -/

content: def zero {k : ℕ} : ConcreteBTField k := BitVec.zero (2 ^ k)

content: def one {k : ℕ} : ConcreteBTField k := 1#(2 ^ k)

content: def split {k : ℕ} (h : k > 0) (x : ConcreteBTField k) :
    ConcreteBTField (k - 1) × ConcreteBTField (k - 1) :=
  let lo_bits : BitVec (2 ^ (k - 1) - 1 - 0 + 1) :=
    BitVec.extractLsb (hi := 2 ^ (k - 1) - 1) (lo := 0) x
  let hi_bits : BitVec (2 ^ k - 1 - 2 ^ (k - 1) + 1) :=
    BitVec.extractLsb (hi := 2 ^ k - 1) (lo := 2 ^ (k - 1)) x
  have h_lo : 2 ^ (k - 1) - 1 - 0 + 1 = 2 ^ (k - 1) := by admit /- proof elided -/

-- Local lemmas used:
content: theorem BitVec.dcast_bitvec_eq {l r val : ℕ} (h_width_eq : l = r) :
    dcast h_width_eq (BitVec.ofNat l val) = BitVec.ofNat r val

content: theorem BitVec.dcast_bitvec_eq_zero {l r : ℕ} (h_width_eq : l = r) :
  dcast (h_width_eq) 0#(l) = 0#(r)

content: lemma one_le_sub_middle_of_pow2 {k : ℕ} (h_k : 1 ≤ k) : 1 ≤ 2 ^ k - 2 ^ (k - 1)

content: lemma sub_middle_of_pow2_with_one_canceled {k : ℕ} (h_k : 1 ≤ k) : 2 ^ k - 1 - 2 ^ (k - 1) + 1
  = 2 ^ (k - 1)

content: lemma one_bitvec_toNat {width : ℕ} (h_width : width > 0) : (1#width).toNat = 1

content: lemma one_bitvec_shiftRight {d : ℕ} (h_d : d > 0) : 1 >>> d = 0

-- Target theorem and proof:
lemma split_one {k : ℕ} (h_k : k > 0) :
    split h_k (one (k:=k)) = (zero (k:=k - 1), one (k:=k - 1))
:= by
  rw [split]
  let lo_bits := BitVec.extractLsb (hi := 2 ^ (k - 1) - 1) (lo := 0) (one (k:=k))
  let hi_bits := BitVec.extractLsb (hi := 2 ^ k - 1) (lo := 2 ^ (k - 1)) (one (k:=k))
  apply Prod.ext
  · simp only
    simp only [BitVec.extractLsb, BitVec.extractLsb']
    rw [one]
    have one_toNat_eq := one_bitvec_toNat (width:=2 ^ k)
      (h_width:=zero_lt_pow_n (m:=2) (n:=k) (h_m:=Nat.zero_lt_two))
    rw [one_toNat_eq]
    have one_shiftRight_eq : 1 >>> 2 ^ (k - 1) = 0 :=
      one_bitvec_shiftRight (d:=2 ^ (k - 1)) (h_d:=by exact Nat.two_pow_pos (k - 1))
    rw [one_shiftRight_eq]
    rw [zero, BitVec.zero_eq]
    have h_sub_middle := sub_middle_of_pow2_with_one_canceled (k:=k) (h_k:=h_k)
    rw [BitVec.dcast_bitvec_eq_zero]
  · simp only
    simp only [BitVec.extractLsb, BitVec.extractLsb']
    simp only [Nat.sub_zero, one, BitVec.toNat_ofNat, Nat.ofNat_pos, pow_pos, Nat.one_mod_two_pow,
      Nat.shiftRight_zero] -- converts BitVec.toNat one >>> 0 into 1#(2 ^ (k - 1))
    rw [BitVec.dcast_bitvec_eq]