-- Blase/Blase/AutoStructs/FormulaToAuto.lean

import Batteries.Data.Fin.Basic

import Batteries.Data.Fin.Lemmas

import Blase.SingleWidth.Defs

import Blase.AutoStructs.Constructions

import Blase.AutoStructs.Defs

import Blase.AutoStructs.FiniteStateMachine

import Mathlib.Tactic.Ring

import Mathlib.Data.Nat.Size -- TODO: remove and get rid of shiftLeft_eq_mul_pow use

import Mathlib.Data.BitVec

import Mathlib.Tactic.FinCases

open Fin.NatCast

open Mathlib

def NFA.sa (_ : NFA α σ) := σ → Language α

structure NFA.correct (M : NFA α σ) (ζ : M.sa) (L : Language α) where
  cond1 : ∀ w, (w ∈ L ↔ ∃ q ∈ M.accept, w ∈ ζ q)
  cond2 : ∀ w q, q ∈ M.eval w ↔ w ∈ ζ q

abbrev BVRel := ∀ ⦃w⦄, BitVec w → BitVec w → Prop

abbrev BVNRel n := ∀ ⦃w⦄, List.Vector (BitVec w) n → Prop

def NFA'.sa (M : NFA' n) := M.σ → BVNRel n

def NFA'.sa2 (M : NFA' 2) := M.σ → BVRel

def langRel (R : BVNRel n) : Set (BitVecs n) :=
  { bvs | R bvs.bvs }

def langRel2 (R : BVRel) : Set (BitVecs 2) :=
  { bvs | R (bvs.bvs.get 0) (bvs.bvs.get 1) }

structure NFA'.correct (M : NFA' n) (ζ : M.sa) (L : BVNRel n) where
  cond1 : ∀ ⦃w⦄ (bvn : List.Vector (BitVec w) n), (L bvn ↔ ∃ q ∈ M.M.accept, ζ q bvn)
  cond2 q : q ∈ M.M.start ↔ ζ q (List.Vector.replicate n .nil)
  cond3 q a {w} (bvn : List.Vector (BitVec w) n) : q ∈ M.M.stepSet { q | ζ q bvn } a ↔
              ζ q (List.Vector.ofFn fun k => BitVec.cons (a.getLsbD k) (bvn.get k))

structure NFA'.correct2 (M : NFA' 2) (ζ : M.sa2) (L : BVRel) where
  cond1 : ∀ (bv1 bv2 : BitVec w), (L bv1 bv2 ↔ ∃ q ∈ M.M.accept, ζ q bv1 bv2)
  cond2 q : q ∈ M.M.start ↔ ζ q .nil .nil
  cond3 q a w (bv1 bv2 : BitVec w) : q ∈ M.M.stepSet { q | ζ q bv1 bv2 } a ↔
              ζ q (BitVec.cons (a.getLsbD 0) bv1) (BitVec.cons (a.getLsbD 1) bv2)

section fsm

abbrev Alphabet (arity: Type) [FinEnum arity] := BitVec (FinEnum.card arity + 1)

variable {arity : Type} [FinEnum arity]

def finFunToBitVec [fe : FinEnum carry] (c : carry → Bool) : BitVec (FinEnum.card carry) :=
  BitVec.ofFn fun i => c (fe.equiv.invFun i)

def bitVecToFinFun [FinEnum ar] (bv : BitVec $ FinEnum.card ar) : ar → Bool :=
  fun c => bv[FinEnum.equiv.toFun c]

def NFA.ofFSM (p : FSM arity) : NFA (Alphabet arity) (p.α → Bool) where
  start := { q | q = p.initCarry }
  accept := ⊤
  step s a := {s' |
    let (s'', b) := p.nextBit s (bitVecToFinFun (a.truncate $ FinEnum.card arity))
    s' = s'' ∧ a.msb = b }

@[simp]
abbrev inFSMRel (p : FSM arity) {w} (bvn : List.Vector (BitVec w) _) :=
  bvn.get (Fin.last (FinEnum.card arity)) = p.evalBV (fun ar => bvn.get (FinEnum.equiv.toFun ar))

def NFA'.ofFSM_sa (p : FSM arity) : (NFA'.ofFSM' p).sa := fun q _ bvn =>
    inFSMRel p bvn ∧ q = p.carryBV (fun ar => bvn.get (FinEnum.equiv.toFun ar))

def NFA'.ofFSM_correct (p : FSM arity) :
    (NFA'.ofFSM' p).correct (ofFSM_sa p) (fun _ bvn => inFSMRel p bvn) :=

open BitStream in

def CNFA.ofFSM (p : FSM arity) : CNFA (FinEnum.card arity + 1) :=
  worklistRun (BitVec (FinEnum.card p.α))
    (fun _ => true)
    #[finFunToBitVec p.initCarry]
    (by admit /- proof elided -/
    )
    f
  where

end fsm

section nfas_relations

def RawCNFA.autEq : RawCNFA (BitVec 2) :=
  let m := RawCNFA.empty
  let (s, m) := m.newState
  let m := m.addInitial s
  let m := m.addFinal s
  let m := m.addTrans 0 s s
  let m := m.addTrans 3 s s
  m

def CNFA.autEq : CNFA 2 :=
  ⟨RawCNFA.autEq, by admit /- proof elided -/
  ⟩

def NFA.autEq : NFA (BitVec 2) Unit :=
  { start := ⊤, accept := ⊤, step _ a := { _s' | if a = 0 ∨ a = 3 then true else false }}

def NFA'.autEq : NFA' 2 :=
  ⟨Unit, NFA.autEq⟩

def NFA'.eqRel : BVRel := fun _ x y => x = y

def autEq_equiv : CNFA.autEq.m.states ≃ NFA'.autEq.σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | _ => ()
  invFun q :=
    match q with
    | () => ⟨0, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

def RawCNFA.autUnsignedCmp (cmp: RelationOrdering) : RawCNFA (BitVec 2) :=
  let m := RawCNFA.empty
  let (seq, m) := m.newState
  let (sgt, m) := m.newState
  let (slt, m) := m.newState
  let m := m.addInitial seq
  let m := m.addManyTrans [0#2, 3#2] seq seq
  let m := m.addTrans 1#2 seq sgt
  let m := m.addTrans 2#2 seq slt
  let m := m.addManyTrans [0#2, 1#2, 3#2] sgt sgt
  let m := m.addTrans 2#2 sgt slt
  let m := m.addManyTrans [0#2, 2#2, 3#2] slt slt
  let mf := m.addTrans 1#2 slt sgt
  match cmp with
  | .lt => mf.addFinal slt
  | .le => (mf.addFinal slt).addFinal seq
  | .gt => mf.addFinal sgt
  | .ge => (mf.addFinal sgt).addFinal seq

def CNFA.autUnsignedCmp (cmp: RelationOrdering) : CNFA 2 :=
  ⟨RawCNFA.autUnsignedCmp cmp, RawCNFA.autoUnsignedCmp_wf⟩

inductive NFA.unsignedCmpState : Type where
| eq | gt | lt
deriving Fintype, DecidableEq

def NFA.unsignedCmpStep (q : NFA.unsignedCmpState) (a : BitVec 2) : List NFA.unsignedCmpState :=
  match q, a with
  | .eq, 0 => [ .eq ] | .eq, 3 => [ .eq ] | .eq, 1 => [ .gt ] | .eq, 2 => [ .lt ]
  | .gt, 0 => [ .gt ] | .gt, 1 => [ .gt ] | .gt, 3 => [ .gt ] | .gt, 2 => [ .lt ]
  | .lt, 0 => [ .lt ] | .lt, 1 => [ .gt ] | .lt, 2 => [ .lt ] | .lt, 3 => [ .lt ]

def NFA.autUnsignedCmp (cmp: RelationOrdering) : NFA (BitVec 2) unsignedCmpState where
  step s a := { s' | s' ∈ unsignedCmpStep s a }
  start := {s | s = .eq }
  accept := { s | s ∈ match cmp with | .lt => [unsignedCmpState.lt] | .le => [.lt, .eq] | .gt => [.gt] | .ge => [.gt, .eq] }

def NFA'.autUnsignedCmp (cmp: RelationOrdering) : NFA' 2 :=
  ⟨_, NFA.autUnsignedCmp cmp⟩

def RelationOrdering.urel (cmp : RelationOrdering) : BVRel :=
  match cmp with
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .le => fun _ bv1 bv2 => bv1.ule bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1
  | .ge => fun _ bv1 bv2 => bv2.ule bv1

def NFA'.autUnsignedCmpSA (q : NFA.unsignedCmpState) : BVRel :=
  match q with
  | .eq => fun _ bv1 bv2 => bv1 = bv2
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1

def RawCNFA.autSignedCmp (cmp: RelationOrdering) : RawCNFA (BitVec 2) :=
  let (m, sltfin, sgtfin, seq) := m
  match cmp with
  | .lt => m.addFinal sltfin
  | .le => (m.addFinal sltfin).addFinal seq
  | .gt => m.addFinal sgtfin
  | .ge => (m.addFinal sgtfin).addFinal seq
where

def CNFA.autSignedCmp (cmp: RelationOrdering) : CNFA 2 :=
  ⟨RawCNFA.autSignedCmp cmp, RawCNFA.autSignedCmp_wf⟩

inductive NFA.signedCmpState : Type where
| eq | gt | lt | ltfin | gtfin
deriving DecidableEq, Fintype

def NFA.signedCmpStep (q : NFA.signedCmpState) (a : BitVec 2) : List NFA.signedCmpState :=
  match q, a with
  | .eq, 0 => [ .eq ] | .eq, 3 => [.eq] | .eq, 1 => [.gt, .ltfin] | .eq, 2 => [ .lt, .gtfin ]
  | .gt, 0 => [ .gt, .gtfin ] | .gt, 1 => [ .gt, .ltfin ] | .gt, 3 => [ .gt, .gtfin ] | .gt, 2 => [ .lt, .gtfin ]
  | .lt, 0 => [ .lt, .ltfin ] | .lt, 1 => [ .gt, .ltfin ] | .lt, 2 => [ .lt, .gtfin ] | .lt, 3 => [ .lt, .ltfin ]
  | .gtfin, _ => ∅
  | .ltfin, _ => ∅

def NFA.autSignedCmp (cmp: RelationOrdering) : NFA (BitVec 2) signedCmpState where
  step s a := { s' | s' ∈ signedCmpStep s a }
  start := { s | s = signedCmpState.eq }
  accept := { s | s ∈ match cmp with | .lt => [NFA.signedCmpState.ltfin] | .le => [.ltfin, .eq] | .gt => [.gtfin] | .ge => [.gtfin, .eq] }

def NFA'.autSignedCmp (cmp: RelationOrdering) : NFA' 2 :=
  ⟨_, NFA.autSignedCmp cmp⟩

def RelationOrdering.srel (cmp : RelationOrdering) : BVRel :=
  match cmp with
  | .lt => fun _ bv1 bv2 => bv1.slt bv2
  | .le => fun _ bv1 bv2 => bv1.sle bv2
  | .gt => fun _ bv1 bv2 => bv2.slt bv1
  | .ge => fun _ bv1 bv2 => bv2.sle bv1

def NFA'.autSignedCmpSA (q : NFA.signedCmpState) : BVRel :=
  match q with
  | .eq => fun _ bv1 bv2 => bv1 = bv2
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1
  | .ltfin => fun _ bv1 bv2 => bv1.slt bv2
  | .gtfin => fun _ bv1 bv2 => bv2.slt bv1

def unsigned_equiv cmp : (CNFA.autUnsignedCmp cmp).m.states ≃ (NFA'.autUnsignedCmp cmp).σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .eq
    | 1 => .gt
    | _ => .lt
  invFun q :=
    match q with
    | .eq => ⟨0, by admit /- proof elided -/
    ⟩
    | .gt => ⟨1, by admit /- proof elided -/
    ⟩
    | .lt => ⟨2, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

def signed_equiv cmp : (CNFA.autSignedCmp cmp).m.states ≃ (NFA'.autSignedCmp cmp).σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .eq
    | 1 => .gt
    | 2 => .lt
    | 3 => .gtfin
    | _ => .ltfin
  invFun q :=
    match q with
    | .eq => ⟨0, by admit /- proof elided -/
    ⟩
    | .gt => ⟨1, by admit /- proof elided -/
    ⟩
    | .lt => ⟨2, by admit /- proof elided -/
    ⟩
    | .gtfin => ⟨3, by admit /- proof elided -/
    ⟩
    | .ltfin => ⟨4, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

def RawCNFA.autMsbSet : RawCNFA (BitVec 1) :=
  let m := RawCNFA.empty
  let (si, m) := m.newState
  let (sf, m) := m.newState
  let m := m.addInitial si
  let m := m.addFinal sf
  let m := m.addTrans 1 si sf
  let m := m.addManyTrans [0, 1] si si
  m

@[inline]
def CNFA.autMsbSet : CNFA 1 :=
  ⟨RawCNFA.autMsbSet, RawCNFA.autMsbSet_wf⟩

inductive NFA.msbState : Type where
| i | f
deriving DecidableEq, Fintype

def NFA.msbStep (q : NFA.msbState) (a : BitVec 1) : List NFA.msbState :=
  match q, a with
  | .i, 0 => [.i]
  | .i, 1 => [.i, .f]
  | _, _ => []

def NFA.autMsbSet : NFA (BitVec 1) msbState where
  step s a := { s' | s' ∈ msbStep s a }
  start := {.i}
  accept := {.f}

def NFA'.autMsbSet : NFA' 1 := ⟨_, NFA.autMsbSet⟩

def NFA.msbLang : Language (BitVec 1) := { bvs  | bvs.getLast? = some 1 }

def NFA.msbSA (q : msbState) : Language (BitVec 1) :=
  match q with
  | .i => ⊤
  | .f => msbLang

def NFA.msbCorrect : NFA.autMsbSet.correct msbSA msbLang :=

def autMsb_equiv : CNFA.autMsbSet.m.states ≃ NFA'.autMsbSet.σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .i
    | 1 => .f
    | _ => .i
  invFun q :=
    match q with
    | .i => ⟨0, by admit /- proof elided -/
    ⟩
    | .f => ⟨1, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

def WidthPredicate.final? (wp : WidthPredicate) (n : Nat) (s : State) : Bool :=
  decide (wp.sat s n)

def RawCNFA.autWidth (wp : WidthPredicate) (n : Nat) : RawCNFA (BitVec 0) :=
  let m := (n+2).iterate f empty
  let m := m.addInitial 0
  m.addTrans (BitVec.zero 0) (n + 1) (n + 1)
where
  f m :=
    let (s, m) := m.newState
    let m := if wp.final? n s then m.addFinal s else m
    if s > 0 then m.addTrans (BitVec.zero 0) (s-1) s else m

def CNFA.autWidth (wp : WidthPredicate) (n : Nat) : CNFA 0 :=
  ⟨RawCNFA.autWidth wp n, RawCNFA.autWidth_wf⟩

def NFA.autWidth (wp : WidthPredicate) (n : Nat) : NFA (BitVec 0) (Fin (n+2)) where
  start := { 0 }
  accept := { s | wp.final? n s }
  step s₁ _ := { s₂ | if s₁ = Fin.last (n+1) then s₁ = s₂ else s₂ = s₁ + 1 }

def NFA'.autWidth (wp : WidthPredicate) (n : Nat) : NFA' 0 := ⟨_, NFA.autWidth wp n⟩

@[simp]
def NFA'.autWidth_spec : (autWidth wp n).accepts = { bv | wp.sat bv.w n } :=

def autWidth_equiv : (CNFA.autWidth wp n).m.states ≃ (NFA'.autWidth wp n).σ where
  toFun := fun ⟨s, hs⟩ =>
    Fin.mk s (by admit /- proof elided -/
    )
  invFun q := ⟨q.val, by admit /- proof elided -/
  ⟩
  left_inv := by admit /- proof elided -/

end nfas_relations

def Relation.autOfRelation : Relation → CNFA 2
| .eq => CNFA.autEq
| .signed ord => CNFA.autSignedCmp ord
| .unsigned ord => CNFA.autUnsignedCmp ord

def Relation.absAutOfRelation (rel : Relation) : NFA' 2 :=
  match rel with
  | .eq => NFA'.autEq
  | .unsigned cmp => NFA'.autUnsignedCmp cmp
  | .signed cmp => NFA'.autSignedCmp cmp

def unopNfa (op : Unop) (m : CNFA n) : CNFA n :=
  match op with
  | .neg => m.neg

def unopAbsNfa (op : Unop) (M : NFA' n) : NFA' n :=
  match op with
  | .neg => M.neg

def binopNfa (op : Binop) (m1 m2 : CNFA n) : CNFA n :=
  match op with
  | .and => m1.inter m2
  | .or => m1.union m2
  | .impl => m1.neg.union m2
  | .equiv => (m1.neg.union m2).inter (m2.neg.union m1)

def binopAbsNfa (op : Binop) (M1 M2: NFA' n) : NFA' n :=
  match op with
  | .and => M1.inter M2
  | .or => M1.union M2
  | .impl => M1.neg.union M2
  | .equiv => (M1.neg.union M2).inter (M2.neg.union M1)

def liftOp n : Fin (n + 1) → Fin (n + 3) :=
  fun k =>
    if k = n then Fin.last (n+2) else k.castLE (by admit /- proof elided -/
    )

@[simp]
def liftOp_unchanged (k : Fin n) : liftOp n k.castSucc = k.castLE (by simp) :=

def liftUnop n : Fin (n + 1) → Fin (n + 2) :=
  fun k =>
    if k = n then Fin.last (n+1) else k.castLE (by admit /- proof elided -/
    )

inductive TermBinop where
| and | or | xor | add | sub

def TermBinop.subst (op : TermBinop) (t₁ t₂ : Term) : Term :=
  match op with
  | .and => .and t₁ t₂
  | .or => .or t₁ t₂
  | .xor => .xor t₁ t₂
  | .add => .add t₁ t₂
  | .sub => .sub t₁ t₂

def TermBinop.openTerm (op : TermBinop) : Term := op.subst (.var 0) (.var 1)

@[simp]
def TermBinop.openTerm_arity (op : TermBinop) : op.openTerm.arity + 1 = 3 :=

def TermBinop.termGadget (t : TermBinop) : CNFA 3 :=
  match t with
  | .and => FSM.ofTerm (.and (.var 0) (.var 1)) |> CNFA.ofFSM
  | .or => FSM.ofTerm (.or (.var 0) (.var 1)) |> CNFA.ofFSM
  | .xor => FSM.ofTerm (.xor (.var 0) (.var 1)) |> CNFA.ofFSM
  | .add => FSM.ofTerm (.add (.var 0) (.var 1)) |> CNFA.ofFSM
  | .sub => FSM.ofTerm (.sub (.var 0) (.var 1)) |> CNFA.ofFSM

def autOfTermBinop (op : TermBinop) (m₁ : CNFA (n + 1)) (m₂ : CNFA (m + 1)) : CNFA ((n ⊔ m) + 1 ) :=
  let mop : CNFA 3 := op.termGadget
  let f₁ := liftMaxSuccSucc1 n m
  let m1' := m₁.lift f₁
  let f₂ := liftMaxSuccSucc2 n m
  let m2' := m₂.lift f₂
  let mop := mop.lift $ liftLast3 (max (FinEnum.card (Fin n)) (FinEnum.card (Fin m)))
  let m := CNFA.inter m1' m2' |> CNFA.inter mop
  let mfinal := m.proj (liftOp _)
  mfinal.minimize

def swapLastTwoBlock (x : Fin (n + 3)) : Fin (n + 3) :=
  if x = Fin.last (n+2) then n
  else if x = n+1 then Fin.last (n + 2)
  else if x = n then n + 1
  else x

inductive TermUnop where
| neg | not | shiftL (k : Nat)

def TermUnop.openTerm (op : TermUnop) : Term :=
  match op with
  | .neg => .neg (.var 0)
  | .not => .not (.var 0)
  | .shiftL k => .shiftL (.var 0) k

def TermUnop.openTerm_arity (op : TermUnop) : op.openTerm.arity = 1 :=

@[simp]
def TermUnop.openTerm_arity' (op : TermUnop) : op.openTerm.arity + 1 = 2 :=

def TermUnop.subst (op : TermUnop) (t : Term) : Term :=
  match op with
  | .neg => .neg t
  | .not => .not t
  | .shiftL k => .shiftL t k

def TermUnop.termGadget (t : TermUnop) : CNFA 2 :=
  match t with
  | .neg => FSM.ofTerm (.neg (.var 0)) |> CNFA.ofFSM
  | .not => FSM.ofTerm (.not (.var 0)) |> CNFA.ofFSM
  | .shiftL k => FSM.ofTerm (.shiftL (.var 0) k) |> CNFA.ofFSM

def autOfTermUnop (op : TermUnop) (m : CNFA (n + 1)) : CNFA (n + 1) :=
  let mop : CNFA 2 := op.termGadget
  let mop : CNFA (n + 2) := mop.lift (λ i ↦ i.natAdd n)
  let m : CNFA (n + 2) := m.lift (λ i ↦ i.castLE (by admit /- proof elided -/
  ))
  let m := CNFA.inter m mop
  let mfinal := m.proj (liftUnop n)
  mfinal.minimize

def nfaOfTerm (t : Term) : CNFA (t.arity + 1) :=
  match t with
  | .var n => FSM.ofTerm (.var n) |> CNFA.ofFSM
  | .zero => FSM.ofTerm .zero |> CNFA.ofFSM
  | .negOne => FSM.ofTerm .negOne |> CNFA.ofFSM
  | .one => FSM.ofTerm .one |> CNFA.ofFSM
  | .ofNat n => FSM.ofTerm (.ofNat n) |> CNFA.ofFSM
  | .and t₁ t₂ => autOfTermBinop .and (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .or t₁ t₂ => autOfTermBinop .or (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .xor t₁ t₂ => autOfTermBinop .xor (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .add t₁ t₂ => autOfTermBinop .add (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .sub t₁ t₂ => autOfTermBinop .sub (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .neg t => autOfTermUnop .neg (nfaOfTerm t)
  | .not t => autOfTermUnop .not (nfaOfTerm t)
  | .shiftL t k => autOfTermUnop (.shiftL k) (nfaOfTerm t)

def swapLastTwo (x : Fin (n + 2)) : Fin (n + 2) :=
  if x = Fin.last (n + 1) then n else if x = n then Fin.last (n + 1) else x

def nfaOfFormula (φ : Formula) : CNFA φ.arity :=
  match φ with
  | .width wp n => CNFA.autWidth wp n
  | .atom rel t1 t2 =>
    let m1 := nfaOfTerm t1
    let m2 := nfaOfTerm t2
    let f1 := liftMaxSucc1 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity)
    let m1' := m1.lift f1
    let f2 := liftMaxSucc2 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity)
    let m2' := m2.lift f2
    let meq := rel.autOfRelation.lift $ liftLast2 (max (FinEnum.card (Fin t1.arity)) (FinEnum.card (Fin t2.arity)))
    let m := CNFA.inter m1' m2' |> CNFA.inter meq
    let mfinal := m.proj (liftExcept2 _)
    mfinal
  | .msbSet t =>
    let m := (termEvalEqFSM t).toFSM |> CNFA.ofFSM
    let mMsb := CNFA.autMsbSet.lift $ fun _ => Fin.last t.arity
    let res := m.inter mMsb
    res.proj $ fun n => n.castLE (by admit /- proof elided -/
    )
  | .unop op φ => unopNfa op (nfaOfFormula φ)
  | .binop op φ1 φ2 =>
    let m1 := (nfaOfFormula φ1).lift $ liftMax1 φ1.arity φ2.arity
    let m2 := (nfaOfFormula φ2).lift $ liftMax2 φ1.arity φ2.arity
    binopNfa op m1 m2

-- Repository definitions used:
content: syntax "max" : MLIR.Pretty.uniform_op

syntax "slt" : MLIR.Pretty.uniform_op

syntax "xor" : MLIR.Pretty.uniform_op

content: macro_rules
  | `(mlir_op| $res:mlir_op_operand = const ($x)
      $[: $outer_type]? ) => do
      let outer_type ← outer_type.getDM `(mlir_type| _)
      `(mlir_op| $res:mlir_op_operand = "const"()
          {val = $x:num : $outer_type} : ($outer_type) -> ($outer_type) )

content: macro_rules
  | `(mlir_op| $res:mlir_op_operand = li ($x)
     $[: $outer_type]?  ) => do
      let outer_type ← outer_type.getDM `(mlir_type| _ )
      `(mlir_op| $res:mlir_op_operand = "li"()
          {imm = $x:num : $outer_type } : ($outer_type) -> ($outer_type))

content: macro_rules
| `(mlir_op| $res:mlir_op_operand = $op1:MLIR.Pretty.RV.opWithImmediate $reg1 , $x : $t)  => do
    let some opName := MLIR.EDSL.Pretty.extractOpName op1.raw
      | Macro.throwUnsupported
    `(mlir_op| $res:mlir_op_operand = $opName ($reg1) {imm = $x:num : $t} : ($t) -> ($t) )

content: macro_rules
| `(mlir_op| $res:mlir_op_operand = $op1:MLIR.Pretty.RV.opWithShamt $reg1 , $x  : $t )  => do
    let some opName := MLIR.EDSL.Pretty.extractOpName op1.raw
      | Macro.throwUnsupported
    `(mlir_op| $res:mlir_op_operand = $opName ($reg1) {shamt = $x:num : $t}  : ($t) -> ($t) )

content: def carry (initCarry : Bool) (x y : BitStream) : BitStream :=
  fun n => (addAux' initCarry x y n).2

content: def BitStream : Type := Nat → Bool

content: def addAux' (carryIn : Bool) (x y : BitStream) (i : Nat) :  Bool × Bool :=
  let carryIn : Bool := match i with
    | 0 => carryIn
    | i + 1 => (addAux' carryIn x y i).2
  Prod.swap (BitVec.adcb (x i) (y i) carryIn)

content: def BitVec.ofFn {w : Nat} (f : Fin w → Bool) : BitVec w :=
  BitVec.iunfoldr (fun i _ => ((), f i)) () |>.2

content: noncomputable def f : (ZMod q)[X] := X^(2^n) + 1

content: def worklistRun (final : S → Bool) (inits : Array S)
    (hinits : inits.toList.Nodup) (f : S → Array (BitVec n × S)) : CNFA n :=
  ⟨worklistRun' _ S final inits hinits f, worklistRun'_wf (BitVec n) S⟩

content: def worklistRun' (final : S → Bool) (inits : Array S) (hinits : inits.toList.Nodup) (f : S → Array (A × S)) : RawCNFA A :=
  let st0 := worklist.initState _ _ inits hinits final
  go st0
where go (st0 : worklist.St A S) : RawCNFA A :=
  if hemp : st0.worklist.isEmpty then st0.m else
  let sa? := st0.worklist.back?
  match heq : sa? with
  | some sa =>
    let wl := st0.worklist.pop
    let st1 := { st0 with worklist := wl,
                          worklist_nodup := by admit /- proof elided -/

content: structure worklist.St where
  m : RawCNFA A
  map : Std.HashMap S State := ∅
  worklist : Array S := ∅
  worklist_nodup : worklist.toList.Nodup
  worklist_incl : ∀ sa ∈ worklist, sa ∈ map

content: def worklist.initState (inits : Array S) (hinits : inits.toList.Nodup) (final? : S → Bool) : worklist.St A S :=
  let m := RawCNFA.empty (A := A)
  let mapm := inits.foldl (init := (Std.HashMap.emptyWithCapacity, m)) fun (map, m) sa =>
    let (s, m) := m.newState
    let m := m.addInitial s
    let m := if final? sa then m.addFinal s else m
    (map.insert sa s, m)
  let map := mapm.1
  let m := mapm.2
  let worklist_incl : ∀ sa ∈ inits, sa ∈ map :=

content: instance RawCNFA.statesFinset (m : RawCNFA A) : Fintype m.states := (Finset.range m.stateMax).fintypeCoeSort

content: abbrev State := Nat

content: def RawCNFA.empty : RawCNFA A := {
  stateMax := 0
  initials := ∅
  finals := ∅
  trans := ∅
}

content: def processOneElem (final : S → Bool) (s : State) (st : worklist.St A S) : A × S → worklist.St A S :=
  fun (a', sa') =>
    let (s', st') := st.addOrCreateState _ _ (final sa') sa'
    let m := st'.m.addTrans a' s s'
    { st' with m }

content: def worklist.St.addOrCreateState (st : worklist.St A S) (final? : Bool) (sa : S) : State × worklist.St A S :=
  match heq : st.map[sa]? with
  | some s => (s, st)
  | none =>
    let (s, m) := st.m.newState
    let m := if final? then m.addFinal s else m
    let map := st.map.insert sa s
    let worklist := st.worklist.push sa
    have worklist_nodup : worklist.toList.Nodup := by admit /- proof elided -/

content: structure CNFA (n : Nat) where
  m : RawCNFA (BitVec n)
  wf : m.WF

content: structure FSM (arity : Type) : Type 1 where
   
  ( α  : Type )
  [ i : FinEnum α ]
  [ h : Hashable α ]
  [ dec_eq : DecidableEq α ]
   
  ( initCarry : α → Bool )
   
  outputCirc : Circuit (α ⊕ arity)
  nextStateCirc : α → Circuit (α ⊕ arity)

content: inductive Circuit (α : Type u) : Type u
  | tru : Circuit α
  | fals : Circuit α
   
  | var : (positive: Bool) → α → Circuit α
  | and : Circuit α → Circuit α → Circuit α
  | or : Circuit α → Circuit α → Circuit α
  | xor : Circuit α → Circuit α → Circuit α
deriving Repr, DecidableEq

content: def Var (Γ : Context Ty) (ty : Ty) : Type := { v : VarName // Γ.hasType v ty }

content: def sub (x y : BitStream) : BitStream :=
  fun n => (subAux x y n).1

content: def subAux (x y : BitStream) : Nat → Bool × Bool
  | 0 => (xor (x 0) (y 0), !(x 0) && y 0)
  | n+1 =>
    let borrow := (subAux x y n).2
    let a := x (n + 1)
    let b := y (n + 1)
    (xor a (xor b borrow), !a && b || ((!(xor a b)) && borrow))

content: abbrev ofTerm (t : Term) : FSM (Fin t.arity) := termEvalEqFSM t |>.toFSM

content: inductive Term : Type
| var : Nat → Term
 
| zero : Term
 
| negOne : Term
 
| one : Term
 
| ofNat (n : Nat) : Term
 
| and : Term → Term → Term
 
| or : Term → Term → Term
 
| xor : Term → Term → Term
 
| not : Term → Term
 
| add : Term → Term → Term
 
| sub : Term → Term → Term
 
| neg : Term → Term


 
| shiftL : Term → Nat → Term


deriving Repr, Inhabited, Lean.ToExpr

content: def termEvalEqFSM : ∀ (t : Term), FSMTermSolution t
  | ofNat n =>
    { toFSM := FSM.ofNat n,
      good := by admit /- proof elided -/

content: def or : FSM Bool :=
  { α := Empty,
    initCarry := Empty.elim,
    outputCirc := Circuit.var true (inr true) ||| Circuit.var true (inr false),
    nextStateCirc := fun a => a.elim
  }

content: def shiftLeft (n : Nat) : FSM Unit :=
  match n with
  | 0 => FSM.id
  | n + 1 => composeUnaryAux (FSM.ls false) (shiftLeft n)

content: def id : FSM Unit := {
 α := Empty,
 initCarry := Empty.elim,
 outputCirc := Circuit.var true (inr ()),
 nextStateCirc := Empty.elim
}

content: def ls (b : Bool) : FSM Unit :=
  { α := Unit,
    initCarry := fun _ => b,
    nextStateCirc := fun () => Circuit.var true (inr ()),
    outputCirc := Circuit.var true (inl ())
  }

content: def composeUnaryAux
    (p : FSM Unit)
    (q : FSM arity) :
    FSM arity :=
  p.compose
    arity
    _
    (λ _ => id)
    (λ _ => q)

content: def compose [FinEnum arity] [DecidableEq arity] [Hashable arity]
    (new_arity : Type)        
    (q_arity : arity → Type)  
    (vars : ∀ (a : arity), q_arity a → new_arity)
    
    
    (q : ∀ (a : arity), FSM (q_arity a)) : 
    FSM new_arity :=
  { α := p.α ⊕ (Σ a, (q a).α),
    i := by admit /- proof elided -/

content: def and : FSM Bool :=
  { α := Empty,
    initCarry := Empty.elim,
    nextStateCirc := fun a => a.elim,
    outputCirc := Circuit.var true (inr true) &&& Circuit.var true (inr false),
  }

content: def xor : FSM Bool :=
  { α := Empty,
    initCarry := Empty.elim,
    outputCirc := Circuit.var true (inr true) ^^^ Circuit.var true (inr false),
    nextStateCirc := Empty.elim
  }

content: def neg : FSM Unit :=
  { α := Unit,
    i := by admit /- proof elided -/

content: def composeBinary
    (p : FSM Bool)
    {t₁ t₂ : Term}
    (q₁ : FSMTermSolution t₁)
    (q₂ : FSMTermSolution t₂) :
    FSM (Fin (max t₁.arity t₂.arity)) := composeBinaryAux p q₁.toFSM q₂.toFSM

content: def composeBinaryAux
    (p : FSM Bool)
    (q₁ : FSM (Fin a₁))
    (q₂ : FSM (Fin a₂)) :
    FSM (Fin (max a₁ a₂)) :=
  p.compose (Fin (max a₁ a₂))
    (λ b => Fin (cond b a₁ a₂))
    (λ b i => Fin.castLE (by admit /- proof elided -/
    ) i)
    (λ b => match b with
      | true => q₁
      | false => q₂)

content: structure FSMTermSolution (t : Term) extends FSM (Fin t.arity) where
  ( good : t.evalFin = toFSM.eval )

content: @[simp] def Term.evalFin (t : Term) (vars : Fin (arity t) → BitStream) : BitStream :=
  match t with
  | var n => vars (Fin.last n)
  | zero    => BitStream.zero
  | one     => BitStream.one
  | negOne  => BitStream.negOne
  | ofNat n => BitStream.ofNat n
  | and t₁ t₂ =>
      let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ &&& x₂
  | or t₁ t₂ =>
      let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ ||| x₂
  | xor t₁ t₂ =>
      let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ ^^^ x₂
  | not t     => ~~~(t.evalFin vars)
  | add t₁ t₂ =>
      let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ + x₂
  | sub t₁ t₂ =>
      let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ - x₂
  | neg t       => -(Term.evalFin t vars)
 
 
  | shiftL t n  => BitStream.shiftLeft (Term.evalFin t vars) n

content: @[simp] def Predicate.evalFin (p : Predicate) (vars : Fin (arity p) → BitStream) : BitStream :=
match p with
| .width .eq n => BitStream.falseIffEq n
| .width .neq n => BitStream.falseIffNeq n
| .width .lt n => BitStream.falseIffLt n
| .width .le n => BitStream.falseIffLe n
| .width .gt n => BitStream.falseIffGt n
| .width .ge n => BitStream.falseIffGe n
| .binary .eq t₁ t₂ =>
    let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
    ) i))
    let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
    ) i))
    Predicate.evalEq x₁ x₂
| .binary .neq t₁ t₂  =>
    let x₁ := t₁.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
    ) i))
    let x₂ := t₂.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
    ) i))
    Predicate.evalNeq x₁ x₂
| .land p q =>
  
  
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  Predicate.evalLand x₁ x₂
| .lor p q =>
  
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  Predicate.evalLor x₁ x₂
| .binary .slt p q =>
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  Predicate.evalSlt x₁ x₂
| .binary .sle p q =>
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  Predicate.evalLor (Predicate.evalSlt x₁ x₂) (Predicate.evalEq x₁ x₂)
| .binary .ult p q =>
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  (Predicate.evalUlt x₁ x₂)
| .binary .ule p q =>
  let x₁ := p.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  let x₂ := q.evalFin (fun i => vars (Fin.castLE (by admit /- proof elided -/
  ) i))
  Predicate.evalLor (Predicate.evalUlt x₁ x₂) (Predicate.evalEq x₁ x₂)

content: def Predicate.evalUlt (t₁ t₂ : BitStream) : BitStream := (~~~ (t₁.borrow t₂)).concat true

content: def borrow (x y : BitStream) : BitStream :=
  fun n => (subAux x y n).2

content: def Predicate.evalLor (t₁ t₂ : BitStream) : BitStream := (t₁ &&& t₂)

content: def Predicate.evalSlt (t₁ t₂ : BitStream) : BitStream :=
    (((Predicate.evalUlt t₁ t₂)) ^^^ (Predicate.evalMsbEq t₁ t₂))

content: def Predicate.evalMsbEq (t₁ t₂ : BitStream) : BitStream :=
  (t₁ ^^^ t₂).concat false

content: def Predicate.evalLand (t₁ t₂ : BitStream) : BitStream := (t₁ ||| t₂)

content: def Predicate.evalNeq (t₁ t₂ : BitStream) : BitStream := (t₁.nxor t₂).concat true |>.scanAnd

content: def nxor (a b : BitStream) : BitStream := fun i => a i == b i

content: def scanAnd (s : BitStream) : BitStream := scanl true Bool.and s

content: abbrev scanl (init : Bool) (f : Bool → Bool → Bool) (s : BitStream) : BitStream :=
  fun n => match n with
    | 0 => f init (s 0)
    | n+1 => f (scanl init f s n) (s (n + 1))

content: def Predicate.evalEq (t₁ t₂ : BitStream) : BitStream := (t₁ ^^^ t₂).concat false |>.scanOr

content: def scanOr (s : BitStream) : BitStream := scanl false Bool.or s

content: inductive Predicate : Type where
 
| width (wp : WidthPredicate) (n : Nat) : Predicate
| binary (p : BinaryPredicate) (t₁ t₂ : Term)
| land  (p q : Predicate) : Predicate
| lor (p q : Predicate) : Predicate
deriving Repr, Inhabited, Lean.ToExpr

content: abbrev falseIffNeq (n : Nat) : BitStream := fun i => decide (i == n)

content: abbrev falseIffLt (n : Nat) : BitStream := fun i => decide (i ≥ n)

content: abbrev falseIffLe (n : Nat) : BitStream := fun i => decide (i > n)

content: abbrev falseIffGe (n : Nat) : BitStream := fun i => decide (i < n)

content: abbrev falseIffEq (n : Nat) : BitStream := fun i => decide (i != n)

content: abbrev falseIffGt (n : Nat) : BitStream := fun i => decide (i ≤ n)

content: def Term.width (t : Term) : WidthExpr :=
  match t with

  | .ofNat w _n => w
  | .var _v w => w
  | .add w _a _b => w
  | .zext _a wnew => wnew
  | .setWidth _a wnew => wnew
  | .sext _a wnew => wnew
  | .bor w _a _b => w
  | .band w _a _b => w
  | .bxor w _a _b => w
  | .bnot w _a => w
  | .boolVar _v => WidthExpr.const 1 
  | .boolConst _b => WidthExpr.const 1
  | .shiftl w _a _k => w
  | .bvOfBool _b => WidthExpr.const 1
  | binWidthRel _k wa wb => WidthExpr.const 0
  | binRel _k w _a _b => w
  | or _p1 _p2 => WidthExpr.const 0
  | and _p1 _p2 => WidthExpr.const 0
  | pvar _v => WidthExpr.const 0
  | boolBinRel _k _a _b => WidthExpr.const 0

content: @[simp] def Term.arity : Term → Nat
| (var n) => n+1
| zero => 0
| one => 0
| negOne => 0
| ofNat _ => 0
| Term.and t₁ t₂ => max (arity t₁) (arity t₂)
| Term.or t₁ t₂ => max (arity t₁) (arity t₂)
| Term.xor t₁ t₂ => max (arity t₁) (arity t₂)
| Term.not t => arity t
| add t₁ t₂ => max (arity t₁) (arity t₂)
| sub t₁ t₂ => max (arity t₁) (arity t₂)
| neg t => arity t


| shiftL t .. => arity t

content: abbrev negOne : BitStream := fun _ => true

content: def shiftLeft (x : BitStream) (k : Nat) : BitStream :=
  fun i => if i < k then false else x (i - k) 

content: def ofNat (x : Nat) : BitStream :=
  Nat.testBit x

content: abbrev one    : BitStream := (· == 0)

content: abbrev zero   : BitStream := fun _ => false

content: def ofNat (n : Nat)  : FSM (Fin 0) :=
  match hn : n with
  | 0 => FSM.zero

  | n' + 1 =>
    let bit := n.testBit 0
    let m := n / 2
    have h : m < n := by admit /- proof elided -/

content: def zero : FSM (Fin 0) :=
  { α := Empty,
    initCarry := Empty.elim,
    nextStateCirc := Empty.elim,
    outputCirc := Circuit.fals
  }

content: def composeUnary
    (p : FSM Unit)
    {t : Term}
    (q : FSMTermSolution t) :
    FSM (Fin t.arity) := composeUnaryAux p q.toFSM

content: def one : FSM (Fin 0) :=
  { α := Unit,
    i := by admit /- proof elided -/

content: def var (n : ℕ) : FSM (Fin (n+1)) :=
  { α := Empty,
    i := by admit /- proof elided -/

content: def add : FSM Bool :=
  { α := Unit,
    initCarry := λ _ => false,
    nextStateCirc := fun () =>
      Circuit.var true (inr true) &&& Circuit.var true (inr false) |||
      Circuit.var true (inr true) &&& Circuit.var true (inl ()) |||
      Circuit.var true (inr false) &&& Circuit.var true (inl ()),
    outputCirc := Circuit.var true (inr true) ^^^
                  Circuit.var true (inr false) ^^^
                  Circuit.var true (inl ()),
  }

content: def negOne : FSM (Fin 0) :=
  { α := Empty,
    i := by admit /- proof elided -/

content: def sub : FSM Bool :=
  { α := Unit,
    initCarry := fun _ => false,
    outputCirc := Circuit.var true (inr true) ^^^
                  Circuit.var true (inr false) ^^^
                  Circuit.var true (inl ()),
    nextStateCirc := fun _ =>
      (Circuit.var false (inr true) &&& Circuit.var true (inr false)) |||
      (Circuit.var false (inr true) ^^^ Circuit.var true (inr false)) &&&
      (Circuit.var true (inl ()))
  }

content: def not : FSM Unit :=
  { α := Empty,
    initCarry := Empty.elim,
    nextStateCirc := Empty.elim,
    outputCirc := Circuit.var false (inr ())
  }

content: def add (x y : BitStream) : BitStream :=
  fun n => (addAux x y n).1

content: def addAux (x y : BitStream) (i : Nat) :  Bool × Bool :=
  let carryIn : Bool := match i with
    | 0 => false
    | i + 1 => (addAux x y i).2
  Prod.swap (BitVec.adcb (x i) (y i) carryIn)

content: def neg (x : BitStream) : BitStream :=
  fun n => (negAux x n).1

content: def negAux (x : BitStream) : Nat → Bool × Bool
  | 0 => (x 0, !(x 0))
  | n+1 =>
    let borrow := (negAux x n).2
    let a := x (n + 1)
    (xor (!a) borrow, !a && borrow)

content: def CNFA.inter (m1 m2 : CNFA n) : CNFA n := product (fun b1 b2 => b1 && b2) m1 m2

content: def product (final? : Bool → Bool → Bool) (m₁ m₂ : CNFA n) : CNFA n :=
  worklistRun (m₁.m.states × m₂.m.states) final (product.inits m₁ m₂)
    (by admit /- proof elided -/
    ) f
where final (ss : m₁.m.states × m₂.m.states) := final? (ss.1 ∈ m₁.m.finals) (ss.2 ∈ m₂.m.finals)
      f (ss : m₁.m.states × m₂.m.states) :=
        let (s1, s2) := ss
        (FinEnum.toList (α := BitVec n)).foldl (init := Array.empty) fun as a =>
          product.prodArray' (λ s₁ s₂ ↦ (a, (s₁, s₂)))
            (fun s' => m₁.wf.trans_tgt_lt (s := s1) (a := a)) (fun s' => m₂.wf.trans_tgt_lt (s := s2) (a := a)) as

content: @[inline]
def product.prodArray' (a : Array γ) :=
  m₁.attachWith _ hm₁ |>.fold (init := a) fun is s1 =>
    m₂.attachWith _ hm₂ |>.fold (init := is) fun is s2 =>
      is.push (f s1 s2)

content: def product.inits_nodup : inits m₁ m₂ |>.toList.Nodup :=

content: def product.inits (m₁ m₂ : CNFA n) :=
  product.prodArray Prod.mk @m₁.wf.initials_lt @m₂.wf.initials_lt

content: @[inline]
def product.prodArray := prodArray' f hm₁ hm₂ (Array.emptyWithCapacity <| m₁.size * m₂.size)

content: def liftMaxSuccSucc2 (n m : Nat) : Fin (m + 1) → Fin (max n m + 3) :=
  fun k => if _ : k = Fin.last m then max n m + 1 else k.castLE (by admit /- proof elided -/
  )

content: def liftMaxSuccSucc1 (n m : Nat) : Fin (n + 1) → Fin (max n m + 3) :=
  fun k => if _ : k = Fin.last n then (max n m).cast else k.castLE (by admit /- proof elided -/
  )

content: def liftLast3 n : Fin 3 → Fin (n + 3)
| 0 => n
| 1 => n + 1
| 2 => Fin.last (n + 2)

content: inductive Unop
| neg
deriving Repr

content: inductive RelationOrdering
| lt | le | gt | ge
deriving Repr, Fintype

content: inductive Relation
| eq
| signed (ord : RelationOrdering)
| unsigned (ord : RelationOrdering)
deriving Repr

content: inductive WidthPredicate
| eq
| neq
| lt
| le
| gt
| ge
deriving Repr, Inhabited, Lean.ToExpr

content: inductive Binop
| and | or | impl | equiv
deriving Repr

content: def liftLast2 n : Fin 2 → Fin (n + 2)
| 0 => n
| 1 => Fin.last (n + 1)

content: def liftMaxSucc2 (n m : Nat) : Fin (m + 1) → Fin (max n m + 2) :=
  fun k => if _ : k = m then Fin.last (max n m + 1) else k.castLE (by admit /- proof elided -/
  )

content: def liftMaxSucc1 (n m : Nat) : Fin (n + 1) → Fin (max n m + 2) :=
  fun k => if _ : k = n then Fin.last (max n m) else k.castLE (by admit /- proof elided -/
  )

content: def liftMax2 (n m : Nat) : Fin m → Fin (max n m) :=
  fun k => k.castLE (by admit /- proof elided -/
  )

content: def liftExcept2 n : Fin n → Fin (n + 2) :=
  fun k => Fin.castLE (by admit /- proof elided -/
  ) k

content: @[simp]
def Formula.arity : Formula → Nat
| width _ _ => 0
| atom _ t1 t2 => max t1.arity t2.arity
| msbSet t => t.arity
| unop _ φ => φ.arity
| binop _ φ1 φ2 => max φ1.arity φ2.arity

content: def liftMax1 (n m : Nat) : Fin n → Fin (max n m) :=
  fun k => k.castLE (by admit /- proof elided -/
  )

content: inductive Formula : Type
| width : WidthPredicate → Nat → Formula
| atom : Relation → Term → Term → Formula
| msbSet : Term → Formula
| unop : Unop → Formula → Formula
| binop : Binop → Formula → Formula → Formula
deriving Repr

content: def CNFA.inter_bv_language (m₁ m₂ : CNFA n) :
    m₁.bv_recognizes L₁ →
    m₂.bv_recognizes L₂ →
    (m₁.inter m₂).bv_recognizes (L₁ ∩ L₂) :=

content: def HashSet.inter [BEq A] [Hashable A] (m1 m2 : Std.HashSet A) : Std.HashSet A :=
  m1.fold (init := ∅) fun mi x => if m2.contains x then mi.insert x else mi

content: @[simp]
def Formula.language (φ : Formula) : Set (BitVecs φ.arity) :=
  match φ with
  | .width wp n => { bvs | wp.sat bvs.w n }
  | .atom rel t1 t2 =>
    let l1 := t1.language.lift (liftMaxSucc1 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity))
    let l2 := t2.language.lift (liftMaxSucc2 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity))
    let lrel := rel.language.lift $ liftLast2 (max (FinEnum.card (Fin t1.arity)) (FinEnum.card (Fin t2.arity)))
    let l := lrel ∩ l1 ∩ l2
    l.proj (liftExcept2 _)
  | .unop .neg φ => φ.languageᶜ
  | .binop op φ1 φ2 =>
    let l1 := φ1.language.lift $ liftMax1 φ1.arity φ2.arity
    let l2 := φ2.language.lift $ liftMax2 φ1.arity φ2.arity
    langBinop op l1 l2
  | .msbSet t =>
    let lmsb := langMsb.lift $ fun _ => Fin.last t.arity
    let l' := t.language ∩ lmsb
    l'.proj fun n => n.castLE (by admit /- proof elided -/
    )

content: @[simp]
def WidthPredicate.sat (wp : WidthPredicate) (w n : Nat) : Bool :=
  match wp with
  | .eq => w = n
  | .neq => w ≠ n
  | .lt => w < n
  | .le => w ≤ n
  | .gt => w > n
  | .ge => w ≥ n

content: @[simp]
def _root_.Set.proj (f : Fin n → Fin m) (bvs : Set (BitVecs m)) : Set (BitVecs n) :=
  BitVecs.transport f '' bvs

content: def BitVecs.transport (f : Fin n → Fin m) (bvs : BitVecs m) : BitVecs n :=
  { w := bvs.w, bvs := bvs.bvs.transport f }

content: def BitVec.transport (f : Fin n2 → Fin n1) (bv : BitVec n1) : BitVec n2 :=
  BitVec.ofFn fun i => bv.getLsbD (f i)

content: structure BitVecs (n : Nat) where
  w : Nat
  bvs : List.Vector (BitVec w) n

content: def List.Vector.transport (v : Vector α m) (f : Fin n → Fin m) : Vector α n :=
  Vector.ofFn fun i => v.get (f i)

content: def BitVecs'.transport (f : Fin n → Fin m) (bvs' : BitVecs' m): BitVecs' n :=
  bvs'.map fun bv => bv.transport f

content: def Term.language (t : Term) : Set (BitVecs (t.arity + 1)) :=
  { bvs : BitVecs (t.arity + 1) | t.evalFinBV (fun n => bvs.bvs.get n) = bvs.bvs.get t.arity }

content: @[simp] def Term.evalFinBV (t : Term) (vars : Fin (arity t) → BitVec w) : BitVec w :=
  match t with
  | .var n => vars (Fin.last n)
  | .zero    => BitVec.zero w
  | .one     => 1
  | .negOne  => -1
  | .ofNat n => BitVec.ofNat _ n
  | .and t₁ t₂ =>
      let x₁ := t₁.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ &&& x₂
  | .or t₁ t₂ =>
      let x₁ := t₁.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ ||| x₂
  | .xor t₁ t₂ =>
      let x₁ := t₁.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ ^^^ x₂
  | .not t     => ~~~(t.evalFinBV vars)
  
  | .add t₁ t₂ =>
      let x₁ := t₁.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ + x₂
  | .sub t₁ t₂ =>
      let x₁ := t₁.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      let x₂ := t₂.evalFinBV (fun i => vars (Fin.castLE (by admit /- proof elided -/
      ) i))
      x₁ - x₂
  | .neg t       => -(t.evalFinBV vars)
  | .shiftL a n => (a.evalFinBV vars) <<< n

content: @[simp]
def _root_.Set.lift (f : Fin n → Fin m) (bvs : Set (BitVecs n)) : Set (BitVecs m) :=
  BitVecs.transport f ⁻¹' bvs

content: @[simp]
def Formula.sat {w : Nat} (φ : Formula) (ρ : Fin φ.arity → BitVec w) : Prop :=
  match φ with
  | .width wp n => wp.sat w n
  | .atom rel t1 t2 =>
    let bv1 := t1.evalFinBV (fun n => ρ $ Fin.castLE (by admit /- proof elided -/
    ) n)
    let bv2 := t2.evalFinBV (fun n => ρ $ Fin.castLE (by admit /- proof elided -/
    ) n)
    evalRelation rel bv1 bv2
  | .unop .neg φ => ¬ φ.sat ρ
  | .binop op φ1 φ2 =>
    let b1 := φ1.sat (fun n => ρ $ Fin.castLE (by admit /- proof elided -/
    ) n)
    let b2 := φ2.sat (fun n => ρ $ Fin.castLE (by admit /- proof elided -/
    ) n)
    evalBinop op b1 b2
  | .msbSet t => (t.evalFinBV ρ).msb

content: def evalBinop (op : Binop) (b1 b2 : Prop) : Prop :=
  match op with
  | .and => b1 ∧ b2
  | .or => b1 ∨ b2
  | .impl => b1 → b2
  | .equiv => b1 ↔ b2

content: def evalRelation (rel : Relation) {w} (bv1 bv2 : BitVec w) : Prop :=
  match rel with
  | .eq => bv1 = bv2
  | .signed .lt => bv1.slt bv2
  | .signed .le => bv1.sle  bv2
  | .signed .gt => bv2.slt bv1
  | .signed .ge => bv2.sle bv1
  | .unsigned .lt => bv1.ult bv2
  | .unsigned .le => bv1.ule bv2
  | .unsigned .gt => bv2.ult bv1
  | .unsigned .ge => bv2.ule bv1

content: def langBinop (op : Binop) (l1 l2 : Set (BitVecs n)) : Set (BitVecs n) :=
  match op with
  | .and => l1 ∩ l2
  | .or => l1 ∪ l2
  | .impl => l1ᶜ ∪ l2
  | .equiv => (l1ᶜ ∪ l2) ∩ (l2ᶜ ∪ l1)

content: @[simp]
def Relation.language (rel : Relation) : Set (BitVecs 2) :=
  { bvs | evalRelation rel (bvs.bvs.get 0) (bvs.bvs.get 1) }

content: structure NFA' (n : Nat) where
  σ : Type
  M : NFA (BitVec n) σ

content: def eval (x : arity → BitStream) : BitStream :=
  fun n => (p.nextBit (p.carry x n) (fun i => x i n)).2

content: def nextBit : p.State → (arity → Bool) → p.State × Bool :=
  fun carry inputBits =>
    let input := Sum.elim carry inputBits
    let newState : p.State  := fun (a : p.α) => (p.nextStateCirc a).eval input
    let outBit : Bool       := (p.outputCirc).eval input
    (newState, outBit)

content: abbrev State : Type := p.α → Bool

content: def carry (x : arity → BitStream) : ℕ → p.State
  | 0 => p.initCarry
  | n+1 => (p.nextBit (carry x n) (fun i => x i n)).1

content: def carryBV (x : ar → BitVec w) : p.State :=
  p.carry (fun ar => .ofBitVecSext (x ar)) w

content: def evalBV {w} (x : ar → BitVec w) : BitVec w :=
  BitVec.ofFn fun k => p.eval (fun ar => .ofBitVecSext (x ar)) k

content: abbrev ofBitVecSext {w} (x : BitVec w) : BitStream :=
  fun i => if i < w then x.getLsbD i else x.msb

content: def enc (bvs : BitVecs n) : BitVecs' n :=
  (List.finRange bvs.w).map (fun i =>
    BitVec.ofFn (fun (k : Fin n) => (bvs.bvs.get k)[i]))

content: abbrev BitVecs' (n : Nat) := List (BitVec n)

content: @[simps]
def dec (bvs' : BitVecs' n) : BitVecs n where
  w := bvs'.length
  bvs := List.Vector.ofFn fun k => BitVec.ofFn fun i => bvs'[i].getLsbD k

content: def accepts (M : NFA' n) : Set (BitVecs n) := dec '' M.accepts'

content: def accepts' (M : NFA' n) : Set (BitVecs' n) := M.M.accepts

content: def worklistRun_spec : (worklistRun S final inits hinits f |>.Sim $ nfa' inits final f) :=
  worklistRun'_spec inits final f

content: def nfa' : NFA' n :=
  { σ := _, M := nfa inits final f }

content: def nfa : NFA A S where
  start := { sa | sa ∈ inits }
  accept := { sa | final sa }
  step sa a := { sa' | (a, sa') ∈ f sa }

content: def worklistRun'_spec :
    (worklistRun' A S final inits hinits f |>.Sim $ nfa inits final f) :=

content: structure StInv (m : RawCNFA A) (map : Std.HashMap S State) where
  wf : m.WF
  map_states : ∀ (sa : S) s, map[sa]? = some s → s ∈ m.states
  map_surj : ∀ s : m.states, ∃ (sa : S), map[sa]? = some s.val
  map_inj : ∀ {s} {sa sa' : S}, map[sa]? = some s → map[sa']? = some s → sa = sa'

content: def worklist.St.D (st : worklist.St A S) : Set S := st.visited

content: def worklist.St.visited (st : worklist.St A S) : Set S := { s : S | s ∈ st.map ∧ s ∉ st.worklist }

content: def worklistGo_spec {st : worklist.St A S} (inv : StInv A S st.m st.map) :
    st.sim inits final f ∅ →
    (worklistRun'.go A S final f st |>.Sim $ nfa inits final f) :=

content: def worklist.St.rel (st : worklist.St A S) : SetRel State S := {(s, sa) | st.map[sa]? = some s }

content: def processOneElem_mot (s : State) (sa : S) (n : ℕ) (st : worklist.St A S) : Prop :=
  st.map[sa]? = some s ∧
  sa ∈ st.visited ∧
  StInv A S st.m st.map ∧
  st.sim inits final f  {(sa1, a, sa') | sa1 = sa ∧ ∃ k ≥ n, (f sa)[k]? = some (a, sa') }

content: abbrev worklist.St.sim {st : worklist.St A S} (T : Set (S × A × S)) :=
  st.m.Simul (nfa inits final f) st.rel st.D T

content: def RawCNFA.Sim (m : RawCNFA A) (A : NFA A S) := ∃ R, RawCNFA.Simul m A R ⊤ ∅

content: structure RawCNFA.Simul (m : RawCNFA A) (M : NFA A Q) (R : SetRel State Q) (D : Set Q) (T : Set (Q × A × Q)) where
  accept {s q} : s ~[R] q → (s ∈ m.finals ↔ q ∈ M.accept)
  initial₁ {s} : s ∈ m.initials → ∃ q ∈ M.start, s ~[R] q
  initial₂ {q} : q ∈ M.start → ∃ s ∈ m.initials, s ~[R] q
  trans_match₁ {s s' a q} : s ~[R] q → s' ∈ m.tr s a → ∃ q', q' ∈ M.step q a ∧ s' ~[R] q'
  trans_match₂ {s a q q'} : s ~[R] q → q' ∈ M.step q a → q ∈ D → (q, a, q') ∉ T → ∃ s', s' ∈ m.tr s a ∧ s' ~[R] q'

content: structure RawCNFA.SimulFun (m : RawCNFA A) (M : NFA A Q) (f : m.states ≃ Q)  where
  accept {q} : ((f.invFun q).val ∈ m.finals ↔ q ∈ M.accept)
  initial {q} : q ∈ M.start ↔ (f.invFun q).val ∈ m.initials
  trans_match {a q q'} : q' ∈ M.step q a ↔ (f.invFun q').val ∈ m.tr (f.invFun q) a

content: @[inline]
def RawCNFA.tr (m : RawCNFA A) s a := m.trans.getD (s, a) ∅

content: abbrev R := (ZMod q)[X] ⧸ (Ideal.span {f q n})

content: def CNFA.Sim (m : CNFA n) (M : NFA' n) :=
  m.m.Sim M.M

content: def CNFA.bv_recognizes (m : CNFA n) (L : Set (BitVecs n)) :=
  ∃ L', m.recognizes L' ∧ L = dec '' L'

content: def RawCNFA.recognizes (m : RawCNFA A) (L : Language A) :=
  ∃ (σ : Type) (M : NFA A σ), m.Sim M ∧ M.accepts = L

content: def CNFA.recognizes (m : CNFA n) (L : Language (BitVec n)) :=
  ∃ (M : NFA' n), m.Sim M ∧ M.M.accepts = L

content: def BitVecs.cast (bvs : BitVecs n) (h : n = n') : BitVecs n' :=
  { w := bvs.w, bvs := h ▸ bvs.bvs }

content: def Valuation.cons {Γ : Ctxt Ty} {t : Ty} (x : toType t) (V : Γ.Valuation) :
    (Γ.cons t).Valuation :=

content: def CNFA.minimize (m : CNFA n) : CNFA n :=
  let mᵣ := m.reverse.determinize
  mᵣ.reverse.determinize

content: def CNFA.determinize (m : CNFA n) : CNFA n :=
  worklistRun (BitVec m.m.stateMax)
    (fun ss => ss.any fun n b => b == true && n ∈ m.m.finals)
    (determinize.inits m)
    (by admit /- proof elided -/
    )
    f
where
  f := fun (ss : BitVec m.m.stateMax) =>
        (FinEnum.toList (BitVec n)).foldl (init := Array.empty) fun ts a =>
          let ss' := m.m.transSetBV ss a
          ts.push (a, ss')

content: def CNFA.determinize.inits (m : CNFA n) : Array (BitVec m.m.stateMax) :=
  #[BitVec.ofFn (fun n => n ∈ m.m.initials)]

content: def CNFA.reverse (m : CNFA n) : CNFA n :=
  ⟨m.m.reverse, RawCNFA.reverse_spec m.wf |>.1⟩

content: def RawCNFA.reverse (m : RawCNFA A) : RawCNFA A :=
  let m' := { stateMax := m.stateMax, trans := Std.HashMap.emptyWithCapacity m.trans.size, initials := m.finals, finals := m.initials}
  m.trans.fold (init := m') processState
where
  processState := fun m' (s, a) ss' =>
    ss'.fold (init := m') fun m' s' => m'.addTrans a s' s

content: def CNFA.toNFA' (m : CNFA n) : NFA' n := ⟨_, m.toNFA⟩

content: def CNFA.toNFA (m : CNFA n) : NFA (BitVec n) m.m.states where
  start := { s | s.val ∈ m.m.initials }
  accept := { s | s.val ∈ m.m.finals }
  step s₁ a := { s₂ | s₂.val ∈ m.m.tr s₁.val a }

content: def RawCNFA.states (m : RawCNFA A) : Finset State := Finset.range m.stateMax

content: def reverse (M : NFA' n) : NFA' n where
  σ := _
  M := M.M.reverse

content: def CNFA.determinize_spec (m : CNFA n)
  {M : NFA' n} (hsim : m.Sim M) :
    m.determinize.Sim M.determinize :=

content: private def bv_to_set (bv : BitVec w) : Set State :=
  { s | bv.getLsbD s }

content: structure _root_.SetRel.set_eq (R : SetRel α β) (A : Set α) (B : Set β) where
  fwd : a ∈ A → ∃ b ∈ B, a ~[R] b
  bwd : b ∈ B → ∃ a ∈ A, a ~[R] b

content: @[inline]
def RawCNFA.lift (m₁: RawCNFA (BitVec n1)) (f : Fin n1 → Fin n2) : RawCNFA (BitVec n2) :=
  let trans := (List.range m₁.stateMax).foldl (init := ∅) fun m2 s => processState m2 s
  { m₁ with trans }
where

content: @[inline]
def CNFA.lift (m: CNFA n1) (f : Fin n1 → Fin n2) : CNFA n2 :=
  ⟨m.m.lift f, m.m.lift_wf m.wf⟩

content: @[inline]
def RawCNFA.proj (m1: RawCNFA (BitVec n1)) (f : Fin n2 → Fin n1) : RawCNFA (BitVec n2) :=
  let trans := m1.trans.keysArray.foldl (init := Std.HashMap.emptyWithCapacity) process
  { m1 with trans }
where

content: def CNFA.proj_spec (m : CNFA n2) (f : Fin n1 → Fin n2) {M : NFA' n2} :
    m.Sim M → (m.proj f |>.Sim (M.proj f)) :=

content: @[inline]
def CNFA.proj (m: CNFA n2) (f : Fin n1 → Fin n2) : CNFA n1 :=
  ⟨m.m.proj f, m.m.proj_wf m.wf⟩

content: def CNFA.neg_spec (m : CNFA n)  {M : NFA' n} (hsim : m.Sim M) :
    m.neg.Sim M.neg :=

content: def CNFA.neg (m : CNFA n) : CNFA n := m.determinize.flipFinals

content: def CNFA.flipFinals (m : CNFA n) : CNFA n := ⟨m.m.flipFinals, m.m.flipFinals_wf m.wf⟩

content: def RawCNFA.flipFinals (m : RawCNFA A) : RawCNFA A :=
  let oldFinals := m.finals
  let newFinals := (List.range m.stateMax).foldl (init := ∅) fun fins s =>
    if oldFinals.contains s then fins else fins.insert s
  { m with finals := newFinals }

content: def bv2 : BitVec 4 := BitVec.ofNat 4 1 

content: def bv1 : BitVec 4 := BitVec.ofNat 4 5 

content: instance instFinEnumBV : FinEnum (BitVec w) where
  card := 2^w
  equiv := {
    toFun := fun x => x.toFin
    invFun := fun x => BitVec.ofFin x
    left_inv := by admit /- proof elided -/

content: structure RawCNFA.WF (m : RawCNFA A) where
  initials_lt : ∀ {s}, s ∈ m.initials → s ∈ m.states
  finals_lt : ∀ {s}, s ∈ m.finals → s ∈ m.states
  trans_src_lt : ∀ s_a ∈ m.trans, s_a.1 ∈ m.states
  trans_tgt_lt : s' ∈ m.tr s a → s' ∈ m.states

content: def CNFA.product_spec (final? : Bool → Bool → Bool) (m1 m2 : CNFA n)
  {M1 : NFA' n} {M2 : NFA' n} :
    m1.Sim M1 →
    m2.Sim M2 →
    (product final? m1 m2).Sim (NFA'.product (to_prop final?) M1 M2) :=

content: noncomputable def to_prop (f : Bool → Bool → Bool) (p1 p2 : Prop) : Prop :=
  f (@Decidable.decide p1 (Classical.propDecidable _)) (@Decidable.decide p2 (Classical.propDecidable _))

content: def CNFA.union (m1 m2 : CNFA n) : CNFA n :=
  product (fun b1 b2 => b1 || b2) m1.addSink m2.addSink

content: @[inline]
def CNFA.addSink (m : CNFA n) : CNFA n := ⟨m.m.addSink, wf_createSink m.wf⟩

content: @[inline]
def RawCNFA.addSink (m : RawCNFA A) : RawCNFA A := m.createSink.2

content: noncomputable def complete (M : NFA' n) : NFA' n where
  σ := _
  M := M.M.complete

content: def RawCNFA.addTrans (m : RawCNFA A) (a : A) (s s' : State) : RawCNFA A :=
  let ns := m.trans.getD (s, a) ∅
  let ns := ns.insert s'
  { m with trans :=  m.trans.insert (s, a) ns }

content: def RawCNFA.newState (m : RawCNFA A) : State × RawCNFA A :=
  let old := m.stateMax
  let m := { m with stateMax := old + 1 }
  (old, m)

content: def RawCNFA.addInitial (m : RawCNFA A) (s : State) : RawCNFA A :=
  { m with initials := m.initials.insert s }

content: @[simp]
def langMsb : Set (BitVecs 1) := { bvs | bvs.bvs.get 0 |>.msb }

content: def head (x : BitStream) : Bool      := x 0

content: infixr:67 "::ᵥ" => Valuation.cons

-- Repository lemmas used:
content: @[ext]
theorem ext {x y : BitStream} (h : ∀ i, x i = y i) : x = y

content: lemma bisim_comp (m : RawCNFA A) :
    m.Sim M₁ → M₁.Bisim M₂ → m.Sim M₂

content: lemma bisimul_comp {m : RawCNFA A} :
    m.Simul M₁ R₁ ⊤ ∅ → M₁.Bisimul R₂ M₂ →
    m.Simul M₂ (R₁.comp R₂) ⊤ ∅

content: lemma CNFA.bv_recognizes_equiv {m : CNFA n} :
    m.bv_recognizes L ↔ ∃ (M : NFA' n), m.Sim M ∧ M.accepts = L

content: @[simp]
lemma List.Vector.append_get_ge {x : List.Vector α n} {y : List.Vector α m} {i : Fin (n+m)} (hlt: n ≤ i) :
    (x ++ y).get i = y.get ((i.cast (Nat.add_comm n m) |>.subNat n hlt))

content: @[simp]
lemma List.Vector.append_get_lt {x : List.Vector α n} {y : List.Vector α m} {i : Fin (n+m)} (hlt: i < n) :
    (x ++ y).get i = x.get (i.castLT hlt)

content: lemma CNFA.minimize_bv_language {m : CNFA n} :
    m.bv_recognizes L → m.minimize.bv_recognizes L

content: lemma CNFA.minimize_language {m : CNFA n} :
    m.recognizes L → m.minimize.recognizes L

content: lemma CNFA.reverse_language {m : CNFA n} (hl : m.recognizes L) : m.reverse.recognizes L.reverse

content: lemma CNFA.reverse_spec {m : CNFA n} : m.reverse.Sim m.toNFA'.reverse

content: lemma RawCNFA.reverse_spec {m : RawCNFA A} (hwf : m.WF) :
    let m'

content: lemma RawCNFA.reverse_spec_procesState {m : RawCNFA A} (hwf : m.WF) s₀ a₀ ss' (hs₀ : s₀ ∈ m.states) :
    let motive m' ss'

content: lemma CNFA.determinize_language {m : CNFA n} :
    m.recognizes L → m.determinize.recognizes L

content: @[simp]
lemma CNFA.lift_bv_language {m : CNFA n1} {f : Fin n1 → Fin n2} :
    m.bv_recognizes L → (m.lift f |>.bv_recognizes (BitVecs.transport f ⁻¹' L))

content: lemma CNFA.lift_spec (m : CNFA n1) (f : Fin n1 → Fin n2) {M : NFA' n1} :
    m.Sim M → (m.lift f |>.Sim (M.lift f))

content: lemma CNFA.proj_bv_language {m : CNFA n2} {f : Fin n1 → Fin n2} :
    m.bv_recognizes L → (m.proj f |>.bv_recognizes (BitVecs.transport f '' L))

content: @[simp]
lemma BitVecs.transport_getElem {bvs : BitVecs m} (f : Fin n → Fin m) (i : Fin n) :
    (bvs.transport f).bvs.get i = bvs.bvs.get (f i)

content: lemma simulFun_sim {m : CNFA n} f :
    m.m.SimulFun M.M f → m.Sim M

content: lemma simulFun_sim_raw [LawfulBEq A] {m : RawCNFA A} (hwf : m.WF) f :
    m.SimulFun M f → m.Sim M

content: @[simp]
lemma RawCNFA.Simul.initial {m : RawCNFA A} {M : NFA A Q} (hsim : m.Simul M R ⊤ ∅) :
    R.set_eq m.initials.toSet M.start

content: lemma CNFA.inter_spec (m1 m2 : CNFA n)
  {M1 : NFA' n} {M2 : NFA' n} :
    m1.Sim M1 →
    m2.Sim M2 →
    (m1.inter m2).Sim (M1.inter M2)

content: lemma CNFA.union_spec (m1 m2 : CNFA n)
  {M1 : NFA' n} {M2 : NFA' n} :
    m1.Sim M1 →
    m2.Sim M2 →
    (m1.union m2).Sim (M1.union M2)

content: lemma CNFA.addSink_spec (m : CNFA n) (M : NFA' n) :
    m.Sim M →
    m.addSink.Sim M.complete

content: @[grind ., simp, aesop 50% unsafe]
lemma wf_addTrans [LawfulBEq A] (m : RawCNFA A) (hwf : m.WF) s a s' (hin : s ∈ m.states) (hin' : s' ∈ m.states) :
    (m.addTrans a s s').WF

content: @[grind =, simp]
lemma RawCNFA.same_stateMax (m : RawCNFA A) x y (z : Std.HashMap (State × A) (Std.HashSet State)) :
    (RawCNFA.mk m.stateMax x y z).states = m.states

content: @[grind =, simp, aesop 50% unsafe]
lemma newState_eq (m : RawCNFA A) :
    m.newState.1 = m.stateMax

content: @[grind =, simp]
lemma addInitial_stateMax {m : RawCNFA A} : (m.addInitial s).stateMax = m.stateMax

content: @[grind =, simp]
lemma addTrans_stateMax {m : RawCNFA A} : (m.addTrans a s s').stateMax = m.stateMax

content: @[simp]
lemma dec_enc' : dec (enc bvs) = bvs

content: @[simp]
lemma dec_enc : Function.RightInverse (α := BitVecs' n) enc dec

content: lemma dec_enc_w (bvs : BitVecs n) : (dec (enc bvs)).w = bvs.w

content: @[simp]
theorem BitVec.ofFn_getElem {w : Nat} (f : Fin w → Bool) {i : Nat} (hi : i < w) :
    (BitVec.ofFn f)[i] = f ⟨i, hi⟩

content: @[simp]
theorem BitVec.ofFn_getLsbD {w : Nat} {f : Fin w → Bool} {i : Nat} (hi : i < w) :
    (BitVec.ofFn f).getLsbD i = f ⟨i, hi⟩

content: theorem BitVec.ofFn_getLsbD_fin {w : Nat} {f : Fin w → Bool} {i : Fin w} :
    (BitVec.ofFn f).getLsbD i = f i

-- Local definitions used:
content: def NFA.sa (_ : NFA α σ) := σ → Language α

content: structure NFA.correct (M : NFA α σ) (ζ : M.sa) (L : Language α) where
  cond1 : ∀ w, (w ∈ L ↔ ∃ q ∈ M.accept, w ∈ ζ q)
  cond2 : ∀ w q, q ∈ M.eval w ↔ w ∈ ζ q

content: abbrev BVRel := ∀ ⦃w⦄, BitVec w → BitVec w → Prop

content: abbrev BVNRel n := ∀ ⦃w⦄, List.Vector (BitVec w) n → Prop

content: def NFA'.sa (M : NFA' n) := M.σ → BVNRel n

content: def NFA'.sa2 (M : NFA' 2) := M.σ → BVRel

content: def langRel (R : BVNRel n) : Set (BitVecs n) :=
  { bvs | R bvs.bvs }

content: def langRel2 (R : BVRel) : Set (BitVecs 2) :=
  { bvs | R (bvs.bvs.get 0) (bvs.bvs.get 1) }

content: structure NFA'.correct (M : NFA' n) (ζ : M.sa) (L : BVNRel n) where
  cond1 : ∀ ⦃w⦄ (bvn : List.Vector (BitVec w) n), (L bvn ↔ ∃ q ∈ M.M.accept, ζ q bvn)
  cond2 q : q ∈ M.M.start ↔ ζ q (List.Vector.replicate n .nil)
  cond3 q a {w} (bvn : List.Vector (BitVec w) n) : q ∈ M.M.stepSet { q | ζ q bvn } a ↔
              ζ q (List.Vector.ofFn fun k => BitVec.cons (a.getLsbD k) (bvn.get k))

content: structure NFA'.correct2 (M : NFA' 2) (ζ : M.sa2) (L : BVRel) where
  cond1 : ∀ (bv1 bv2 : BitVec w), (L bv1 bv2 ↔ ∃ q ∈ M.M.accept, ζ q bv1 bv2)
  cond2 q : q ∈ M.M.start ↔ ζ q .nil .nil
  cond3 q a w (bv1 bv2 : BitVec w) : q ∈ M.M.stepSet { q | ζ q bv1 bv2 } a ↔
              ζ q (BitVec.cons (a.getLsbD 0) bv1) (BitVec.cons (a.getLsbD 1) bv2)

content: abbrev Alphabet (arity: Type) [FinEnum arity] := BitVec (FinEnum.card arity + 1)

content: def finFunToBitVec [fe : FinEnum carry] (c : carry → Bool) : BitVec (FinEnum.card carry) :=
  BitVec.ofFn fun i => c (fe.equiv.invFun i)

content: def bitVecToFinFun [FinEnum ar] (bv : BitVec $ FinEnum.card ar) : ar → Bool :=
  fun c => bv[FinEnum.equiv.toFun c]

content: def NFA.ofFSM (p : FSM arity) : NFA (Alphabet arity) (p.α → Bool) where
  start := { q | q = p.initCarry }
  accept := ⊤
  step s a := {s' |
    let (s'', b) := p.nextBit s (bitVecToFinFun (a.truncate $ FinEnum.card arity))
    s' = s'' ∧ a.msb = b }

content: @[simp]
abbrev inFSMRel (p : FSM arity) {w} (bvn : List.Vector (BitVec w) _) :=
  bvn.get (Fin.last (FinEnum.card arity)) = p.evalBV (fun ar => bvn.get (FinEnum.equiv.toFun ar))

content: def NFA'.ofFSM_sa (p : FSM arity) : (NFA'.ofFSM' p).sa := fun q _ bvn =>
    inFSMRel p bvn ∧ q = p.carryBV (fun ar => bvn.get (FinEnum.equiv.toFun ar))

content: def NFA'.ofFSM_correct (p : FSM arity) :
    (NFA'.ofFSM' p).correct (ofFSM_sa p) (fun _ bvn => inFSMRel p bvn) :=

content: def CNFA.ofFSM (p : FSM arity) : CNFA (FinEnum.card arity + 1) :=
  worklistRun (BitVec (FinEnum.card p.α))
    (fun _ => true)
    #[finFunToBitVec p.initCarry]
    (by admit /- proof elided -/
    )
    f
  where

content: def RawCNFA.autEq : RawCNFA (BitVec 2) :=
  let m := RawCNFA.empty
  let (s, m) := m.newState
  let m := m.addInitial s
  let m := m.addFinal s
  let m := m.addTrans 0 s s
  let m := m.addTrans 3 s s
  m

content: def CNFA.autEq : CNFA 2 :=
  ⟨RawCNFA.autEq, by admit /- proof elided -/
  ⟩

content: def NFA.autEq : NFA (BitVec 2) Unit :=
  { start := ⊤, accept := ⊤, step _ a := { _s' | if a = 0 ∨ a = 3 then true else false }}

content: def NFA'.autEq : NFA' 2 :=
  ⟨Unit, NFA.autEq⟩

content: def NFA'.eqRel : BVRel := fun _ x y => x = y

content: def autEq_equiv : CNFA.autEq.m.states ≃ NFA'.autEq.σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | _ => ()
  invFun q :=
    match q with
    | () => ⟨0, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

content: def RawCNFA.autUnsignedCmp (cmp: RelationOrdering) : RawCNFA (BitVec 2) :=
  let m := RawCNFA.empty
  let (seq, m) := m.newState
  let (sgt, m) := m.newState
  let (slt, m) := m.newState
  let m := m.addInitial seq
  let m := m.addManyTrans [0#2, 3#2] seq seq
  let m := m.addTrans 1#2 seq sgt
  let m := m.addTrans 2#2 seq slt
  let m := m.addManyTrans [0#2, 1#2, 3#2] sgt sgt
  let m := m.addTrans 2#2 sgt slt
  let m := m.addManyTrans [0#2, 2#2, 3#2] slt slt
  let mf := m.addTrans 1#2 slt sgt
  match cmp with
  | .lt => mf.addFinal slt
  | .le => (mf.addFinal slt).addFinal seq
  | .gt => mf.addFinal sgt
  | .ge => (mf.addFinal sgt).addFinal seq

content: def CNFA.autUnsignedCmp (cmp: RelationOrdering) : CNFA 2 :=
  ⟨RawCNFA.autUnsignedCmp cmp, RawCNFA.autoUnsignedCmp_wf⟩

content: inductive NFA.unsignedCmpState : Type where
| eq | gt | lt
deriving Fintype, DecidableEq

content: def NFA.unsignedCmpStep (q : NFA.unsignedCmpState) (a : BitVec 2) : List NFA.unsignedCmpState :=
  match q, a with
  | .eq, 0 => [ .eq ] | .eq, 3 => [ .eq ] | .eq, 1 => [ .gt ] | .eq, 2 => [ .lt ]
  | .gt, 0 => [ .gt ] | .gt, 1 => [ .gt ] | .gt, 3 => [ .gt ] | .gt, 2 => [ .lt ]
  | .lt, 0 => [ .lt ] | .lt, 1 => [ .gt ] | .lt, 2 => [ .lt ] | .lt, 3 => [ .lt ]

content: def NFA.autUnsignedCmp (cmp: RelationOrdering) : NFA (BitVec 2) unsignedCmpState where
  step s a := { s' | s' ∈ unsignedCmpStep s a }
  start := {s | s = .eq }
  accept := { s | s ∈ match cmp with | .lt => [unsignedCmpState.lt] | .le => [.lt, .eq] | .gt => [.gt] | .ge => [.gt, .eq] }

content: def NFA'.autUnsignedCmp (cmp: RelationOrdering) : NFA' 2 :=
  ⟨_, NFA.autUnsignedCmp cmp⟩

content: def RelationOrdering.urel (cmp : RelationOrdering) : BVRel :=
  match cmp with
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .le => fun _ bv1 bv2 => bv1.ule bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1
  | .ge => fun _ bv1 bv2 => bv2.ule bv1

content: def NFA'.autUnsignedCmpSA (q : NFA.unsignedCmpState) : BVRel :=
  match q with
  | .eq => fun _ bv1 bv2 => bv1 = bv2
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1

content: def RawCNFA.autSignedCmp (cmp: RelationOrdering) : RawCNFA (BitVec 2) :=
  let (m, sltfin, sgtfin, seq) := m
  match cmp with
  | .lt => m.addFinal sltfin
  | .le => (m.addFinal sltfin).addFinal seq
  | .gt => m.addFinal sgtfin
  | .ge => (m.addFinal sgtfin).addFinal seq
where

content: def CNFA.autSignedCmp (cmp: RelationOrdering) : CNFA 2 :=
  ⟨RawCNFA.autSignedCmp cmp, RawCNFA.autSignedCmp_wf⟩

content: inductive NFA.signedCmpState : Type where
| eq | gt | lt | ltfin | gtfin
deriving DecidableEq, Fintype

content: def NFA.signedCmpStep (q : NFA.signedCmpState) (a : BitVec 2) : List NFA.signedCmpState :=
  match q, a with
  | .eq, 0 => [ .eq ] | .eq, 3 => [.eq] | .eq, 1 => [.gt, .ltfin] | .eq, 2 => [ .lt, .gtfin ]
  | .gt, 0 => [ .gt, .gtfin ] | .gt, 1 => [ .gt, .ltfin ] | .gt, 3 => [ .gt, .gtfin ] | .gt, 2 => [ .lt, .gtfin ]
  | .lt, 0 => [ .lt, .ltfin ] | .lt, 1 => [ .gt, .ltfin ] | .lt, 2 => [ .lt, .gtfin ] | .lt, 3 => [ .lt, .ltfin ]
  | .gtfin, _ => ∅
  | .ltfin, _ => ∅

content: def NFA.autSignedCmp (cmp: RelationOrdering) : NFA (BitVec 2) signedCmpState where
  step s a := { s' | s' ∈ signedCmpStep s a }
  start := { s | s = signedCmpState.eq }
  accept := { s | s ∈ match cmp with | .lt => [NFA.signedCmpState.ltfin] | .le => [.ltfin, .eq] | .gt => [.gtfin] | .ge => [.gtfin, .eq] }

content: def NFA'.autSignedCmp (cmp: RelationOrdering) : NFA' 2 :=
  ⟨_, NFA.autSignedCmp cmp⟩

content: def RelationOrdering.srel (cmp : RelationOrdering) : BVRel :=
  match cmp with
  | .lt => fun _ bv1 bv2 => bv1.slt bv2
  | .le => fun _ bv1 bv2 => bv1.sle bv2
  | .gt => fun _ bv1 bv2 => bv2.slt bv1
  | .ge => fun _ bv1 bv2 => bv2.sle bv1

content: def NFA'.autSignedCmpSA (q : NFA.signedCmpState) : BVRel :=
  match q with
  | .eq => fun _ bv1 bv2 => bv1 = bv2
  | .lt => fun _ bv1 bv2 => bv1.ult bv2
  | .gt => fun _ bv1 bv2 => bv2.ult bv1
  | .ltfin => fun _ bv1 bv2 => bv1.slt bv2
  | .gtfin => fun _ bv1 bv2 => bv2.slt bv1

content: def unsigned_equiv cmp : (CNFA.autUnsignedCmp cmp).m.states ≃ (NFA'.autUnsignedCmp cmp).σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .eq
    | 1 => .gt
    | _ => .lt
  invFun q :=
    match q with
    | .eq => ⟨0, by admit /- proof elided -/
    ⟩
    | .gt => ⟨1, by admit /- proof elided -/
    ⟩
    | .lt => ⟨2, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

content: def signed_equiv cmp : (CNFA.autSignedCmp cmp).m.states ≃ (NFA'.autSignedCmp cmp).σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .eq
    | 1 => .gt
    | 2 => .lt
    | 3 => .gtfin
    | _ => .ltfin
  invFun q :=
    match q with
    | .eq => ⟨0, by admit /- proof elided -/
    ⟩
    | .gt => ⟨1, by admit /- proof elided -/
    ⟩
    | .lt => ⟨2, by admit /- proof elided -/
    ⟩
    | .gtfin => ⟨3, by admit /- proof elided -/
    ⟩
    | .ltfin => ⟨4, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

content: def RawCNFA.autMsbSet : RawCNFA (BitVec 1) :=
  let m := RawCNFA.empty
  let (si, m) := m.newState
  let (sf, m) := m.newState
  let m := m.addInitial si
  let m := m.addFinal sf
  let m := m.addTrans 1 si sf
  let m := m.addManyTrans [0, 1] si si
  m

content: @[inline]
def CNFA.autMsbSet : CNFA 1 :=
  ⟨RawCNFA.autMsbSet, RawCNFA.autMsbSet_wf⟩

content: inductive NFA.msbState : Type where
| i | f
deriving DecidableEq, Fintype

content: def NFA.msbStep (q : NFA.msbState) (a : BitVec 1) : List NFA.msbState :=
  match q, a with
  | .i, 0 => [.i]
  | .i, 1 => [.i, .f]
  | _, _ => []

content: def NFA.autMsbSet : NFA (BitVec 1) msbState where
  step s a := { s' | s' ∈ msbStep s a }
  start := {.i}
  accept := {.f}

content: def NFA'.autMsbSet : NFA' 1 := ⟨_, NFA.autMsbSet⟩

content: def NFA.msbLang : Language (BitVec 1) := { bvs  | bvs.getLast? = some 1 }

content: def NFA.msbSA (q : msbState) : Language (BitVec 1) :=
  match q with
  | .i => ⊤
  | .f => msbLang

content: def NFA.msbCorrect : NFA.autMsbSet.correct msbSA msbLang :=

content: def autMsb_equiv : CNFA.autMsbSet.m.states ≃ NFA'.autMsbSet.σ where
  toFun := fun ⟨s, hs⟩ =>
    match s with
    | 0 => .i
    | 1 => .f
    | _ => .i
  invFun q :=
    match q with
    | .i => ⟨0, by admit /- proof elided -/
    ⟩
    | .f => ⟨1, by admit /- proof elided -/
    ⟩
  left_inv := by admit /- proof elided -/

content: def WidthPredicate.final? (wp : WidthPredicate) (n : Nat) (s : State) : Bool :=
  decide (wp.sat s n)

content: def RawCNFA.autWidth (wp : WidthPredicate) (n : Nat) : RawCNFA (BitVec 0) :=
  let m := (n+2).iterate f empty
  let m := m.addInitial 0
  m.addTrans (BitVec.zero 0) (n + 1) (n + 1)
where
  f m :=
    let (s, m) := m.newState
    let m := if wp.final? n s then m.addFinal s else m
    if s > 0 then m.addTrans (BitVec.zero 0) (s-1) s else m

content: def CNFA.autWidth (wp : WidthPredicate) (n : Nat) : CNFA 0 :=
  ⟨RawCNFA.autWidth wp n, RawCNFA.autWidth_wf⟩

content: def NFA.autWidth (wp : WidthPredicate) (n : Nat) : NFA (BitVec 0) (Fin (n+2)) where
  start := { 0 }
  accept := { s | wp.final? n s }
  step s₁ _ := { s₂ | if s₁ = Fin.last (n+1) then s₁ = s₂ else s₂ = s₁ + 1 }

content: def NFA'.autWidth (wp : WidthPredicate) (n : Nat) : NFA' 0 := ⟨_, NFA.autWidth wp n⟩

content: @[simp]
def NFA'.autWidth_spec : (autWidth wp n).accepts = { bv | wp.sat bv.w n } :=

content: def autWidth_equiv : (CNFA.autWidth wp n).m.states ≃ (NFA'.autWidth wp n).σ where
  toFun := fun ⟨s, hs⟩ =>
    Fin.mk s (by admit /- proof elided -/
    )
  invFun q := ⟨q.val, by admit /- proof elided -/
  ⟩
  left_inv := by admit /- proof elided -/

content: def Relation.autOfRelation : Relation → CNFA 2
| .eq => CNFA.autEq
| .signed ord => CNFA.autSignedCmp ord
| .unsigned ord => CNFA.autUnsignedCmp ord

content: def Relation.absAutOfRelation (rel : Relation) : NFA' 2 :=
  match rel with
  | .eq => NFA'.autEq
  | .unsigned cmp => NFA'.autUnsignedCmp cmp
  | .signed cmp => NFA'.autSignedCmp cmp

content: def unopNfa (op : Unop) (m : CNFA n) : CNFA n :=
  match op with
  | .neg => m.neg

content: def unopAbsNfa (op : Unop) (M : NFA' n) : NFA' n :=
  match op with
  | .neg => M.neg

content: def binopNfa (op : Binop) (m1 m2 : CNFA n) : CNFA n :=
  match op with
  | .and => m1.inter m2
  | .or => m1.union m2
  | .impl => m1.neg.union m2
  | .equiv => (m1.neg.union m2).inter (m2.neg.union m1)

content: def binopAbsNfa (op : Binop) (M1 M2: NFA' n) : NFA' n :=
  match op with
  | .and => M1.inter M2
  | .or => M1.union M2
  | .impl => M1.neg.union M2
  | .equiv => (M1.neg.union M2).inter (M2.neg.union M1)

content: def liftOp n : Fin (n + 1) → Fin (n + 3) :=
  fun k =>
    if k = n then Fin.last (n+2) else k.castLE (by admit /- proof elided -/
    )

content: @[simp]
def liftOp_unchanged (k : Fin n) : liftOp n k.castSucc = k.castLE (by simp) :=

content: def liftUnop n : Fin (n + 1) → Fin (n + 2) :=
  fun k =>
    if k = n then Fin.last (n+1) else k.castLE (by admit /- proof elided -/
    )

content: inductive TermBinop where
| and | or | xor | add | sub

content: def TermBinop.subst (op : TermBinop) (t₁ t₂ : Term) : Term :=
  match op with
  | .and => .and t₁ t₂
  | .or => .or t₁ t₂
  | .xor => .xor t₁ t₂
  | .add => .add t₁ t₂
  | .sub => .sub t₁ t₂

content: def TermBinop.openTerm (op : TermBinop) : Term := op.subst (.var 0) (.var 1)

content: @[simp]
def TermBinop.openTerm_arity (op : TermBinop) : op.openTerm.arity + 1 = 3 :=

content: def TermBinop.termGadget (t : TermBinop) : CNFA 3 :=
  match t with
  | .and => FSM.ofTerm (.and (.var 0) (.var 1)) |> CNFA.ofFSM
  | .or => FSM.ofTerm (.or (.var 0) (.var 1)) |> CNFA.ofFSM
  | .xor => FSM.ofTerm (.xor (.var 0) (.var 1)) |> CNFA.ofFSM
  | .add => FSM.ofTerm (.add (.var 0) (.var 1)) |> CNFA.ofFSM
  | .sub => FSM.ofTerm (.sub (.var 0) (.var 1)) |> CNFA.ofFSM

content: def autOfTermBinop (op : TermBinop) (m₁ : CNFA (n + 1)) (m₂ : CNFA (m + 1)) : CNFA ((n ⊔ m) + 1 ) :=
  let mop : CNFA 3 := op.termGadget
  let f₁ := liftMaxSuccSucc1 n m
  let m1' := m₁.lift f₁
  let f₂ := liftMaxSuccSucc2 n m
  let m2' := m₂.lift f₂
  let mop := mop.lift $ liftLast3 (max (FinEnum.card (Fin n)) (FinEnum.card (Fin m)))
  let m := CNFA.inter m1' m2' |> CNFA.inter mop
  let mfinal := m.proj (liftOp _)
  mfinal.minimize

content: def swapLastTwoBlock (x : Fin (n + 3)) : Fin (n + 3) :=
  if x = Fin.last (n+2) then n
  else if x = n+1 then Fin.last (n + 2)
  else if x = n then n + 1
  else x

content: inductive TermUnop where
| neg | not | shiftL (k : Nat)

content: def TermUnop.openTerm (op : TermUnop) : Term :=
  match op with
  | .neg => .neg (.var 0)
  | .not => .not (.var 0)
  | .shiftL k => .shiftL (.var 0) k

content: def TermUnop.openTerm_arity (op : TermUnop) : op.openTerm.arity = 1 :=

content: @[simp]
def TermUnop.openTerm_arity' (op : TermUnop) : op.openTerm.arity + 1 = 2 :=

content: def TermUnop.subst (op : TermUnop) (t : Term) : Term :=
  match op with
  | .neg => .neg t
  | .not => .not t
  | .shiftL k => .shiftL t k

content: def TermUnop.termGadget (t : TermUnop) : CNFA 2 :=
  match t with
  | .neg => FSM.ofTerm (.neg (.var 0)) |> CNFA.ofFSM
  | .not => FSM.ofTerm (.not (.var 0)) |> CNFA.ofFSM
  | .shiftL k => FSM.ofTerm (.shiftL (.var 0) k) |> CNFA.ofFSM

content: def autOfTermUnop (op : TermUnop) (m : CNFA (n + 1)) : CNFA (n + 1) :=
  let mop : CNFA 2 := op.termGadget
  let mop : CNFA (n + 2) := mop.lift (λ i ↦ i.natAdd n)
  let m : CNFA (n + 2) := m.lift (λ i ↦ i.castLE (by admit /- proof elided -/
  ))
  let m := CNFA.inter m mop
  let mfinal := m.proj (liftUnop n)
  mfinal.minimize

content: def nfaOfTerm (t : Term) : CNFA (t.arity + 1) :=
  match t with
  | .var n => FSM.ofTerm (.var n) |> CNFA.ofFSM
  | .zero => FSM.ofTerm .zero |> CNFA.ofFSM
  | .negOne => FSM.ofTerm .negOne |> CNFA.ofFSM
  | .one => FSM.ofTerm .one |> CNFA.ofFSM
  | .ofNat n => FSM.ofTerm (.ofNat n) |> CNFA.ofFSM
  | .and t₁ t₂ => autOfTermBinop .and (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .or t₁ t₂ => autOfTermBinop .or (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .xor t₁ t₂ => autOfTermBinop .xor (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .add t₁ t₂ => autOfTermBinop .add (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .sub t₁ t₂ => autOfTermBinop .sub (nfaOfTerm t₁) (nfaOfTerm t₂)
  | .neg t => autOfTermUnop .neg (nfaOfTerm t)
  | .not t => autOfTermUnop .not (nfaOfTerm t)
  | .shiftL t k => autOfTermUnop (.shiftL k) (nfaOfTerm t)

content: def swapLastTwo (x : Fin (n + 2)) : Fin (n + 2) :=
  if x = Fin.last (n + 1) then n else if x = n then Fin.last (n + 1) else x

content: def nfaOfFormula (φ : Formula) : CNFA φ.arity :=
  match φ with
  | .width wp n => CNFA.autWidth wp n
  | .atom rel t1 t2 =>
    let m1 := nfaOfTerm t1
    let m2 := nfaOfTerm t2
    let f1 := liftMaxSucc1 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity)
    let m1' := m1.lift f1
    let f2 := liftMaxSucc2 (FinEnum.card $ Fin t1.arity) (FinEnum.card $ Fin t2.arity)
    let m2' := m2.lift f2
    let meq := rel.autOfRelation.lift $ liftLast2 (max (FinEnum.card (Fin t1.arity)) (FinEnum.card (Fin t2.arity)))
    let m := CNFA.inter m1' m2' |> CNFA.inter meq
    let mfinal := m.proj (liftExcept2 _)
    mfinal
  | .msbSet t =>
    let m := (termEvalEqFSM t).toFSM |> CNFA.ofFSM
    let mMsb := CNFA.autMsbSet.lift $ fun _ => Fin.last t.arity
    let res := m.inter mMsb
    res.proj $ fun n => n.castLE (by admit /- proof elided -/
    )
  | .unop op φ => unopNfa op (nfaOfFormula φ)
  | .binop op φ1 φ2 =>
    let m1 := (nfaOfFormula φ1).lift $ liftMax1 φ1.arity φ2.arity
    let m2 := (nfaOfFormula φ2).lift $ liftMax2 φ1.arity φ2.arity
    binopNfa op m1 m2

-- Local lemmas used:
content: lemma NFA.correct_spec {M : NFA α σ} {ζ : M.sa} {L : Language α} :
    M.correct ζ L → M.accepts = L

content: @[simp]
lemma in_enc : x ∈ enc '' S ↔ dec x ∈ S

content: @[simp]
lemma dec_snoc_in_langRel {n} {R : BVNRel n} {w : BitVecs' n} {a : BitVec n} :
    dec (w ++ [a]) ∈ langRel R ↔
      R (List.Vector.ofFn fun k => .cons (a.getLsbD k) ((dec w).bvs.get k))

content: lemma NFA'.correct_spec {M : NFA' n} {ζ : M.sa} {L : BVNRel n} :
    M.correct ζ L → M.accepts = langRel L

content: lemma NFA'.correct2_spec {M : NFA' 2} {ζ : M.sa2} {L : BVRel} :
    M.correct2 ζ L → M.accepts = langRel2 L

content: @[simp]
lemma NFA'.ofFSM_spec (t : Term) :
    (ofFSM (FSM.ofTerm t)).accepts = t.language

content: lemma CNFA.ofFSM_spec (p : FSM arity) :
    (CNFA.ofFSM p).Sim (NFA'.ofFSM p)

content: lemma CNFA.ofFSM_bv_language :
    (CNFA.ofFSM (FSM.ofTerm t)).bv_recognizes t.language

content: lemma NFA'.autEq_correct : autEq.correct2 (fun _ => eqRel) eqRel

content: lemma CNFA.autEq_spec : autEq.Sim NFA'.autEq

content: lemma BitVec.ule_iff_ult_or_eq {w : ℕ} (bv1 bv2 : BitVec w):
    (bv1.ule bv2) = true ↔ (bv1.ult bv2) = true ∨ bv1 = bv2

content: @[simp]
lemma ucmp_tricho {bv1 bv2 : BitVec w} : (bv2.ult bv1) = false → (bv1.ult bv2) = false → bv1 = bv2

content: lemma NFA'.autUnsignedCmp_correct cmp : autUnsignedCmp cmp |>.correct2 autUnsignedCmpSA cmp.urel

content: private lemma BitVec.sle_iff_slt_or_eq {w : ℕ} (bv1 bv2 : BitVec w):
    (bv1.sle bv2) = true ↔ (bv1.slt bv2) = true ∨ bv1 = bv2

content: lemma NFA'.autSignedCmp_correct cmp : autSignedCmp cmp |>.correct2 autSignedCmpSA cmp.srel

content: lemma CNFA.autUnsignedCmp_spec {cmp} : (CNFA.autUnsignedCmp cmp).Sim (NFA'.autUnsignedCmp cmp)

content: lemma CNFA.autSignedCmp_spec {cmp} : (CNFA.autSignedCmp cmp).Sim (NFA'.autSignedCmp cmp)

content: lemma CNFA.autMsbSet_spec : CNFA.autMsbSet.Sim NFA'.autMsbSet

content: @[simp]
lemma autMsbSet_accepts : NFA'.autMsbSet.accepts = langMsb

content: lemma CNFA.autMsbSet_bv_language : autMsbSet.bv_recognizes langMsb

content: lemma RawCNFA.autWidth_spec {wp : WidthPredicate} :
  let m := RawCNFA.autWidth wp n
  m.WF ∧ m.stateMax = n+2 ∧
  (∀ s, s ∈ m.states → (s ∈ m.initials ↔ s = 0) ∧ (s ∈ m.finals ↔ wp.final? n s)) ∧
  (∀ s s', s ∈ m.states → s' ∈ m.states → (s' ∈ m.tr s 0 ↔ if s = n+1 then s = s' else s' = s + 1))

content: @[simp]
lemma CNFA.autWidth_states: s ∈ (autWidth wp n).m.states ↔ s < n+2

content: lemma CNFA.autWidth_initials : s ∈ (autWidth wp n).m.initials ↔ s = 0

content: lemma CNFA.autWidth_finals (hn : s < n + 2) : s ∈ (autWidth wp n).m.finals ↔ wp.final? n s

content: lemma CNFA.autWidth_tr (hs : s < n + 2) (hs' : s' < n + 2) : s' ∈ (autWidth wp n).m.tr s 0 ↔ if s = n+1 then s = s' else s' = s + 1

content: lemma CNFA.autWidth_spec : autWidth wp n |>.Sim (NFA'.autWidth wp n)

content: lemma CNFA.autWidth_bv_language :
    (autWidth wp n).bv_recognizes { bv | wp.sat bv.w n }

content: lemma autOfRelation_spec (r : Relation) :
  r.autOfRelation.Sim r.absAutOfRelation

content: @[simp]
lemma autOfRelation_accepts (r : Relation) :
    r.absAutOfRelation.accepts = r.language

content: lemma CNFA.autOfRelation_bv_language (r : Relation) :
    (r.autOfRelation).bv_recognizes r.language

content: lemma unopNfa_spec (op : Unop) (m : CNFA n) (M : NFA' n) :
    m.Sim M → (unopNfa op m).Sim (unopAbsNfa op M)

content: lemma unopNfa_accepts (op : Unop) (M : NFA' n) :
    (unopAbsNfa op M).accepts = M.acceptsᶜ

content: lemma unopNfa_bv_language (op : Unop) :
    m.bv_recognizes L → (unopNfa op m).bv_recognizes Lᶜ

content: lemma binopNfa_bv_language (op : Binop) {m₁ m₂ : CNFA n}  :
    m₁.bv_recognizes L₁ → m₂.bv_recognizes L₂ →
    (binopNfa op m₁ m₂).bv_recognizes (langBinop op L₁ L₂)

content: lemma TermBinop.subst_arity' {op : TermBinop} : (op.subst t₁ t₂).arity + 1= t₁.arity ⊔ t₂.arity + 1

content: @[simp]
lemma BitVecs.cast_eq  (x : BitVecs n) (h : n = n') : h ▸ x = x.cast h

content: lemma Fin.natAdd_zero' [h : NeZero m] : Fin.natAdd (m := m) n 0 = n

content: lemma TermBinop.alt_lang {t₁ t₂ : Term} (op : TermBinop) :
  (op.subst_arity' ▸ (op.subst t₁ t₂).language) =
    let lop : Set (BitVecs 3) := op.openTerm_arity ▸ op.openTerm.language
    let lop' : Set (BitVecs ((t₁.arity ⊔ t₂.arity) + 3)) := lop.lift (liftLast3 (max t₁.arity t₂.arity))
    let l₁ := t₁.language.lift (liftMaxSuccSucc1 t₁.arity t₂.arity)
    let l₂ := t₂.language.lift (liftMaxSuccSucc2 t₁.arity t₂.arity)
    let l := l₁ ∩ l₂ ∩ lop'
    l.proj (liftOp _)

content: @[simp]
lemma TermUnop.subst_arity' {op : TermUnop} : (op.subst t).arity + 1 = t.arity + 1

content: lemma autOfTermBinop_bv_language op {t₁ t₂ : Term} (m₁ : CNFA (t₁.arity + 1)) (m₂ : CNFA (t₂.arity + 1)) :
    m₁.bv_recognizes t₁.language →
    m₂.bv_recognizes t₂.language →
    (autOfTermBinop op m₁ m₂ |>.bv_recognizes (op.subst_arity' ▸ (op.subst t₁ t₂).language))

content: lemma TermUnop.alt_lang {t : Term} (op : TermUnop) :
  (op.subst_arity' ▸ (op.subst t).language) =
    let lop : Set (BitVecs 2) := op.openTerm_arity' ▸ op.openTerm.language
    let lop' : Set (BitVecs (t.arity + 2)) := lop.lift (λ i ↦ i.natAdd t.arity)
    let lt : Set (BitVecs (t.arity + 2)) := t.language.lift (λ i ↦ i.castLE (by omega))
    let l := lt ∩ lop'
    l.proj (liftUnop t.arity)

content: lemma autOfTermUnop_bv_language op {t : Term} (m : CNFA (t.arity + 1)) :
    m.bv_recognizes t.language →
    (autOfTermUnop op m |>.bv_recognizes (op.subst_arity' ▸ (op.subst t).language))

content: lemma nfaOfTerm_bv_language (t : Term) :
    nfaOfTerm t |>.bv_recognizes t.language

-- Target theorem and proof:
theorem nfaOfFormula_bv_language φ :
    (nfaOfFormula φ).bv_recognizes φ.language
:= by
  induction φ
  case width rel n =>
    simp only [nfaOfFormula]
    apply CNFA.autWidth_bv_language
  case atom rel t1 t2 =>
    simp only [nfaOfFormula, Formula.language]
    apply CNFA.proj_bv_language
    ac_nf
    apply CNFA.inter_bv_language
    · apply CNFA.lift_bv_language
      exact CNFA.autOfRelation_bv_language rel
    · apply CNFA.inter_bv_language
      · apply CNFA.lift_bv_language
        exact nfaOfTerm_bv_language t1
      · apply CNFA.lift_bv_language
        exact nfaOfTerm_bv_language t2
  case msbSet t =>
    simp only [nfaOfFormula, Formula.language]
    apply CNFA.proj_bv_language
    apply CNFA.inter_bv_language
    · exact CNFA.ofFSM_bv_language
    · apply CNFA.lift_bv_language
      apply CNFA.autMsbSet_bv_language
  case unop op φ ih =>
    simp only [nfaOfFormula, Formula.language]
    exact unopNfa_bv_language op ih
  case binop op φ₁ φ2 ih₁ ih₂ =>
    simp only [nfaOfFormula, Formula.language]
    apply binopNfa_bv_language op
    · apply CNFA.lift_bv_language; assumption
    · apply CNFA.lift_bv_language; assumption