You are an expert Lean4 and formal verification agent proving a Lean4 theorem. Your output **must** strictly adhere to the specified format.

### Input Information
You will receive the following components, relevant to the target theorem:
* <all_available_defs>: Definitions available from imported modules (either from the current Lean repository or from Mathlib)
* <all_available_lemmas>: Lemmas/theorems available that may assist the proof.
* <local_ctx>...</local_ctx>: The local file context (imports, namespaces, definitions, comments, etc.) from the top of the file up to—but not including—the target theorem or any previously defined local lemmas/theorems.
* <target_theorem>...</target_theorem>: The target theorem statement, ending with `:=`.

**Notes**
1. Definitions include their full bodies, but for definitions whose bodies contain proofs, the proof parts are replaced by `admit` (i.e., admit /- proof elided -/), while the rest of the definition is kept unchanged; lemmas include only their statements.
2. You may freely reference any definition or lemma contained in these tags without redefining them.
3. The tags for available definitions and lemmas (all_available_defs, all_available_lemmas) may be omitted if empty.

### Output Format & Requirements
Your output MUST contain a complete, syntactically correct Lean 4 proof for the target theorem.

**Strict Output Structure:**
<reasoning> 
...
</reasoning> 

<lean4_invented_lemmas>
-- each lemma is a full Lean 4 declaration with a complete proof
...
</lean4_invented_lemmas>

<lean4_proof>
-- Lean 4 proof body of the target theorem
...
</lean4_proof>

**Requirements:**
1. <reasoning> and <lean4_invented_lemmas> are OPTIONAL. Include them only if they aid proof construction.
2. <lean4_proof> MUST contain only the proof body (tactics/terms), starting by "by", NOT the theorem declaration.
3. <lean4_invented_lemmas> (if present) MUST contain syntactically correct lemma declarations that type checks AND complete proof bodies. Defining a lemma using `axiom` is NOT allowed.
4. <reasoning> contains high-level proof planning.
5. If you create a lemma under <lean4_invented_lemmas> whose name is namespaced (e.g., X.Y.Z), you MUST always refer to it using its fully qualified name. Do NOT rely on shortened names. For example, write rw [X.Y.Z], not rw [Z] for invented lemmas.
6. All Lean 4 code MUST be syntactically correct. No `sorry`, `admit`, or non-Lean text. Comments allowed using `--` or `/- ... -/`.
7. Follow the tags and structure EXACTLY. No extra text before, between, or after the sections.
8. Do NOT wrap invented lemmas in a `mutual` block unless they have genuine mutual recursion. Declare each lemma independently.

### Examples are provided here (example input are under "User Prompt", and example assistant response are under "Agent Response"):
Example 1 ------------------- 
User Prompt:
<all_available_defs>
structure BitVec (w : Nat) where
  /-- Construct a `BitVec w` from a number less than `2^w`.
  O(1), because we use `Fin` as the internal representation of a bitvector. -/
  ofFin ::

  /-- Interpret a bitvector as a number less than `2^w`.
  O(1), because we use `Fin` as the internal representation of a bitvector. -/
  toFin : Fin (hPow 2 w)
</all_available_defs>

<all_available_lemmas>
theorem List.getElem_append_left{α : Type u_1} {l₁ l₂ : List α} {i : Nat} (hn : i < l₁.length) : (l₁ ++ l₂)[i] = l₁[i]
theorem getElem_eq_testBit_toNat (x : BitVec w) (i : Nat) (h : i < w) :
  x[i] = x.toNat.testBit i := rfl
@[simp, grind =] theorem toNat_cons (b : Bool) (x : BitVec w) :
    (cons b x).toNat = (b.toNat <<< w) ||| x.toNat
@[simp, grind =] theorem getLsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getLsbD x i = false
theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsbD i
</all_available_lemmas>

<local_ctx>
import Mathlib.Computability.NFA
import Mathlib.Data.FinEnum
import Mathlib.Data.Rel
import Mathlib.Data.Vector.Basic
import Blase.AutoStructs.ForLean

open Set
open Mathlib
open SetRel

-- this is better because card is defeq to n
instance (α : Type) : Inter (Language α) := ⟨Set.inter⟩
instance (α : Type) : Union (Language α) := ⟨Set.union⟩

/--
The set of `n`-tuples of bit vectors of an arbitrary width.
-/
structure BitVecs (n : Nat) where
  w : Nat
  bvs : List.Vector (BitVec w) n

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

abbrev BitVecs.empty : BitVecs n := ⟨0, List.Vector.replicate n .nil⟩
abbrev BitVecs.singleton {w : Nat} (bv : BitVec w) : BitVecs 1 := ⟨w, bv ::ᵥ .nil⟩
abbrev BitVecs.pair {w : Nat} (bv1 bv2 : BitVec w) : BitVecs 2 := ⟨w, bv1 ::ᵥ bv2 ::ᵥ .nil⟩

/--
The set of `n`-tuples of bit vectors of an arbitrary width, encoded as a list of
bit vectors of width `n`. The width of the encoded bit vectors is the length of
the list.
-/
abbrev BitVecs' (n : Nat) := List (BitVec n)

@[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

@[simp]
</local_ctx>

<target_theorem>
lemma dec_snoc n (bvs' : BitVecs' n) (a : BitVec n) :
  dec (bvs' ++ [a]) =
    { w := bvs'.length + 1
      bvs := List.Vector.ofFn fun k =>
        BitVec.cons (a.getLsbD k) ((dec bvs').bvs.get k) } :=
</target_theorem>

Agent Response:
<reasoning> 
The goal is to understand what `dec` does after appending one more bitvector `a` to `bvs'`. By definition, `dec` builds a width `= length` and a vector of bitvectors whose `i`-th bit at position `k` is `bvs'[i].getLsbD k`. So for `bvs' ++ [a]`, we expect the width to increase by 1 and each resulting bitvector to be `BitVec.cons` of the new bit coming from `a`.

First, I use `ext` twice: once on the record to focus on the `bvs` field, and once on the resulting bitvector. This reduces everything to a pointwise statement:
for fixed `k` and `i` with `i < bvs'.length + 1`,
the bit `(bvs' ++ [a])[i].getLsbD k` should match the bit at index `i` of `BitVec.cons (a.getLsbD k) ((dec bvs').bvs.get k)`.

At this point I need a clean description of indexing into `BitVec.cons`: if we have `x : BitVec n`, then `(cons b x)[i]` should give `b` at the new “last” index `n` and `x[i]` otherwise. That motivates an auxiliary lemma `getElem_cons` expressing exactly this behavior, proved via the `testBit`/`toNat` characterization and a case split on `i < n`, `i = n`, `i > n`.

Using `getElem_cons`, the RHS becomes an `if` on whether `i = bvs'.length`. So I split into cases:
- If `i = bvs'.length`, then `(bvs' ++ [a])[i]` is the appended `a`, so both sides reduce to `a.getLsbD k`.
- If `i ≠ bvs'.length`, the bound `i < bvs'.length + 1` forces `i < bvs'.length`. Then `(bvs' ++ [a])[i] = bvs'[i]` by `List.getElem_append_left`, and the RHS takes the “else” branch and likewise gives the bit from `bvs'[i]`. In both subcases, `simp` (plus the definition of `dec`) finishes.

So the whole proof is: `ext` to bit level, unfold `dec` with `simp_all`, rewrite with `getElem_cons`, split on the boundary index `i = length bvs'`, and in the “< length” branch use `List.getElem_append_left` and bounds to line up both sides.
</reasoning> 

<lean4_invented_lemmas>
@[grind =]
theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
    (cons b x)[i] = if h : i = n then b else x[i] := by
  simp only [BitVec.getElem_eq_testBit_toNat, BitVec.toNat_cons, Nat.testBit_or]
  rw [Nat.testBit_shiftLeft]
  rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
  · have p1 : ¬(n ≤ i) := by omega
    have p2 : i ≠ n := by omega
    simp [p1, p2]
  · simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_true, Nat.sub_self, Nat.testBit_zero,
    Bool.true_and, BitVec.testBit_toNat, BitVec.getLsbD_of_ge, Bool.or_false]
    cases b <;> trivial
  · have p1 : i ≠ n := by omega
    have p2 : i - n ≠ 0 := by omega
    simp [p1, p2, Nat.testBit_bool_toNat]
</lean4_invented_lemmas>

<lean4_proof>
by
  ext k i hi <;> simp_all
  rw [getElem_cons]
  split
  next heq => simp_all
  next h =>
    have hlt : i < List.length bvs' := by simp at hi; omega
    rw [List.getElem_append_left hlt]
    simp
</lean4_proof>

### Your task:
<all_available_defs>
class HasUniformSelect (cont : Type u) (β : outParam (Type)) where
  uniformSelect : cont → ProbComp β

def uniformSelect {cont : Type} (β : Type)
    [h : HasUniformSelect cont β] (xs : cont) : ProbComp β :=
  h.uniformSelect xs

instance hasUniformSelectList (α : Type) :
    HasUniformSelect (List α) α where
  uniformSelect := λ xs ↦ do match xs with
    | [] => failure
    | x :: xs => ((x :: xs)[·]) <$> $[0..xs.length]

instance hasUniformSelectVector (α : Type) (n : ℕ) :
    HasUniformSelect (Vector α (n + 1)) α where
  uniformSelect := λ xs ↦ $ xs.toList

noncomputable instance hasUniformSelectFinset (α : Type) [DecidableEq α] :
    HasUniformSelect (Finset α) α where
  uniformSelect := λ s ↦ $ s.toList

class SelectableType (β : Type) where
  selectElem : ProbComp β
  mem_support_selectElem (x : β) : x ∈ selectElem.support
  probOutput_selectElem_eq (x y : β) : [= x | selectElem] = [= y | selectElem]
  probFailure_selectElem : [⊥ | selectElem] = 0

def uniformOfFintype (β : Type) [h : SelectableType β] :
    ProbComp β := h.selectElem

instance (α : Type) [Unique α] : SelectableType α where
  selectElem := return default
  mem_support_selectElem x := Unique.eq_default x ▸ rfl
  probOutput_selectElem_eq x y := by admit /- proof elided -/

instance : SelectableType Bool where
  selectElem := $ [false, true]
  mem_support_selectElem x := by admit /- proof elided -/

instance (α β : Type) [Fintype α] [Fintype β] [Inhabited α] [Inhabited β]
    [SelectableType α] [SelectableType β] : SelectableType (α × β) where
  selectElem := (·, ·) <$> ($ᵗ α) <*> ($ᵗ β)
  mem_support_selectElem x := by admit /- proof elided -/

instance (n : ℕ) : SelectableType (Fin (n + 1)) where
  selectElem := $[0..n]
  mem_support_selectElem := by admit /- proof elided -/

instance (n : ℕ) [hn : NeZero n] : SelectableType (Fin n) where
  selectElem := congr_arg Fin (Nat.succ_pred (NeZero.ne n)).symm ▸ $ᵗ (Fin (n - 1 + 1))
  mem_support_selectElem x := by admit /- proof elided -/

instance (α : Type) (n : ℕ) [SelectableType α] : SelectableType (Vector α n) where
  selectElem := by admit /- proof elided -/

instance (α : Type) (n m : ℕ) [SelectableType α] : SelectableType (Matrix (Fin n) (Fin m) α) where
  
  selectElem := by admit /- proof elided -/

def vectorizationAdversary (G P : Type) := P → P → ProbComp G

def vectorizationExp [DecidableEq G]
    (adversary : vectorizationAdversary G P) : ProbComp Unit := do
  let p₁ ←$ᵗ P; let p₂ ←$ᵗ P
  let g ← adversary p₁ p₂
  guard (p₂ -ᵥ p₁ = g) 

def parallelizationAdversary (_G P : Type) := P → P → P → ProbComp P

def parallelizationExp [DecidableEq P]
    (adversary : parallelizationAdversary G P) : ProbComp Unit := do
  let x ←$ᵗ P; let g₁ ←$ᵗ G; let g₂ ←$ᵗ G
  let x₁ := g₁ +ᵥ x
  let x₂ := g₂ +ᵥ x
  let x₃ ← adversary x x₁ x₂
  guard (x₃ = g₁ +ᵥ g₂ +ᵥ x)

def parallelTestingAdversary (_G P : Type) := P → P → P → P → ProbComp Bool

def parallelTesting_experiment [DecidableEq G]
    (adversary : parallelTestingAdversary G P) : ProbComp Unit := do
  let x ←$ᵗ P; let g₁ ←$ᵗ G; let g₂ ←$ᵗ G
  let x₁ := g₁ +ᵥ x
  let x₂ := g₂ +ᵥ x
  let b ←$ᵗ Bool
  let x₃ ← if b then pure (g₂ +ᵥ g₁ +ᵥ x) else $ᵗ P
  let b' ← adversary x x₁ x₂ x₃
  guard (b = b')

noncomputable def parallelTestingAdvantage [SelectableType P] [SelectableType G] [DecidableEq G]
    (adversary : parallelTestingAdversary G P) : ℝ≥0∞ :=
  [= () | parallelTesting_experiment adversary] - 1 / 2

inductive FreeMonad (f : Type u → Type v) (α : Type w) : Type (max (u + 1) v w)
  | protected pure (x : α) : FreeMonad f α
  | roll {β : Type u} (x : f β) (r : β → FreeMonad f α) : FreeMonad f α

@[always_inline, inline]
def lift (x : f α) : FreeMonad f α := FreeMonad.roll x FreeMonad.pure

instance : MonadLift f (FreeMonad f) where
  monadLift x := FreeMonad.lift x

instance [Inhabited (f α)] : Inhabited (FreeMonad f α) := ⟨FreeMonad.lift default⟩

@[always_inline, inline]
protected def bind : FreeMonad f α → (α → FreeMonad f β) → FreeMonad f β
  | FreeMonad.pure x, g => g x
  | FreeMonad.roll x r, g => FreeMonad.roll x (λ u ↦ FreeMonad.bind (r u) g)

instance : Monad (FreeMonad f) where
  pure := FreeMonad.pure
  bind := FreeMonad.bind

instance : LawfulMonad (FreeMonad f) :=
  LawfulMonad.mk' (FreeMonad f)
    (λ x ↦ by admit /- proof elided -/
      )
    (λ x f ↦ rfl)
    (λ x f g ↦ by admit /- proof elided -/
      )

instance : MonadFunctor f (FreeMonad f) where
  monadMap g
    | FreeMonad.pure x => FreeMonad.pure x
    | FreeMonad.roll x r => g x >>= r

@[elab_as_elim]
protected def inductionOn {C : FreeMonad f α → Prop}
    (pure : ∀ x, C (pure x))
    (roll : ∀ {β} (x : f β), (r : β → FreeMonad f α) →
      (∀ y, C (r y)) → C (x >>= r)) :
    (oa : FreeMonad f α) → C oa
  | FreeMonad.pure x => pure x
  | FreeMonad.roll x r => roll x _ (λ u ↦
      FreeMonad.inductionOn pure roll (r u))

@[elab_as_elim]
protected def construct {C : FreeMonad f α → Type*}
    (pure : (x : α) → C (pure x))
    (roll : {β : Type u} → (x : f β) → (r : β → FreeMonad f α) →
      ((y : β) → C (r y)) → C (x >>= r)) :
    (oa : FreeMonad f α) → C oa
  | .pure x => pure x
  | .roll x r => roll x _ (λ u ↦ FreeMonad.construct pure roll (r u))

protected def mapM_aux [Pure m] [Bind m] (s : {α : Type u} → f α → m α) :
    (oa : FreeMonad f α) → m α
  | .pure x => pure x
  | .roll x r => s x >>= λ u ↦ (r u).mapM_aux s

protected def mapM' (m : Type u → Type w) [Monad m] [LawfulMonad m]
    (s : {α : Type u} → f α → m α) : FreeMonad f →ᵐ m where
  toFun := FreeMonad.mapM_aux s
  toFun_pure' x := rfl
  toFun_bind' x y := by admit /- proof elided -/

protected def mapM [Pure m] [Bind m] :
    (oa : FreeMonad f α) → (s : {α : Type u} → f α → m α) → m α
  | .pure x, _ => pure x
  | .roll x r, s => s x >>= λ u ↦ (r u).mapM s

noncomputable def depth : FreeMonad f α → ℕ∞
  | .pure _ => 0
  | .roll _ r => 1 + iSup (λ u ↦ depth (r u))

@[simp]
noncomputable def depthBindAux {f : Type u → Type v} {α β : Type u} :
    FreeMonad f α → (α → FreeMonad f β) → ℕ∞
  | .pure x, g => depth (g x)
  | .roll _ r, g => 1 + iSup (λ u ↦ depthBindAux (r u) g)

@[reducible] def SPMF : Type u → Type u := OptionT PMF

instance : FunLike (SPMF α) α ENNReal where
  coe sp x := sp.run (some x)
  coe_injective' p q h := by admit /- proof elided -/

class HasEvalDist (m : Type u → Type v) [Monad m] where
  evalDist {α : Type u} (mx : m α) : SPMF α
  evalDist_pure {α : Type u} (x : α) : evalDist (pure x : m α) = pure x
  evalDist_bind {α β : Type u} (mx : m α) (my : α → m β) :
    evalDist (mx >>= my) = evalDist mx >>= fun x => evalDist (my x)

def probOutput [HasEvalDist m] (mx : m α) (x : α) : ℝ≥0∞ := evalDist mx x

noncomputable def probEvent [HasEvalDist m] (mx : m α) (p : α → Prop) : ℝ≥0∞ :=
  (evalDist mx).run.toOuterMeasure (some '' {x | p x})

def probFailure [HasEvalDist m] (mx : m α) : ℝ≥0∞ := (evalDist mx).run none

instance hasEvalDist : HasEvalDist SPMF where
  evalDist := id
  evalDist_pure _ := rfl
  evalDist_bind _ _ := rfl

noncomputable instance hasEvalDist : HasEvalDist PMF where
  evalDist p := OptionT.mk p
  evalDist_pure _ := by admit /- proof elided -/

def zipCommits (sk : G) (gs : Vector G n)
    (bs : Vector Bool n) : Vector G n :=
  Vector.zipWith (λ c b ↦ if b then c else c + sk) gs bs

def unzipCommits (x₀ pk : P) (zs : Vector G n)
    (hash : Vector Bool n) : Vector P n :=
  Vector.zipWith (λ z b ↦ if b then z +ᵥ pk else z +ᵥ x₀) zs hash

def withCounting (so : QueryImpl spec m) : QueryImpl spec (WriterT spec.QueryCount m) where
  impl | q => tell (QueryCount.single q.index) *> ↑(so.impl q)

def countingOracle : QueryImpl spec (WriterT (QueryCount spec) (OracleComp spec)) :=
  idOracle.withCounting

instance : Extract Id where
  extract := id

instance : Extend Id where
  extend wx f := f wx

instance : Coseq Id where
  coseq wx wy := (wx, wy)

instance : Coapplicative Id where

instance : Comonad Id where

instance : LawfulCoapplicative Id where
  id_map := by admit /- proof elided -/

instance : LawfulComonad Id where
  map_eq_extend_extract := by admit /- proof elided -/

instance : Extract (Prod ε) where
  extract := Prod.snd 

instance : Extend (Prod ε) where
  extend wx f := (wx.1, f wx) 

instance : Functor (Prod ε) where 
  map f wx := (wx.1, f wx.2)

instance : Coseq (Prod ε) where
  coseq wx wy := (wx.1, (wx.2, wy.2)) 

instance : Coapplicative (Prod ε) where

instance : Comonad (Prod ε) where

instance : LawfulFunctor (Prod ε) where
  id_map := by admit /- proof elided -/

instance : LawfulCoapplicative (Prod ε) where
  
  coseqLeft_eq := by admit /- proof elided -/

instance : LawfulComonad (Prod ε) where
  
  map_eq_extend_extract := by admit /- proof elided -/

structure NonEmptyList (α : Type u) where
  head : α
  tail : List α

deriving Repr, DecidableEq

def toList (nel : NonEmptyList α) : List α := nel.head :: nel.tail

def fromList? : List α → Option (NonEmptyList α)
  | [] => none
  | h :: t => some ⟨h, t⟩

def map (f : α → β) : NonEmptyList α → NonEmptyList β
  | ⟨h, t⟩ => ⟨f h, List.map f t⟩

@[simp] def head_nel (nel : NonEmptyList α) : α := nel.head

def zip : NonEmptyList α → NonEmptyList β → NonEmptyList (α × β)
  | ⟨h₁, t₁⟩, ⟨h₂, t₂⟩ => ⟨(h₁, h₂), List.zip t₁ t₂⟩

def tails : NonEmptyList α → NonEmptyList (NonEmptyList α)
  | nel@⟨_, t⟩ =>
    
    let head_tail : NonEmptyList α := nel
    
    let rest_tails_list : List (NonEmptyList α) :=
      List.filterMap NonEmptyList.fromList? (List.tails t)
    ⟨head_tail, rest_tails_list⟩ 

instance : Functor Stream' where
  map := Stream'.map

instance : Extract Stream' where
  extract := Stream'.head

instance : Extend Stream' where
  extend s f := fun n => f (Stream'.drop n s) 

instance : Coseq Stream' where
  coseq := Stream'.zip Prod.mk 

instance : CoseqLeft Stream' where
  coseqLeft s₁ _ := s₁

instance : CoseqRight Stream' where
  coseqRight _ s₂ := s₂

instance : Coapplicative Stream' where

instance : Comonad Stream' where

instance : LawfulFunctor Stream' where
  id_map := by admit /- proof elided -/

instance : LawfulCoapplicative Stream' where
  coseqLeft_eq := by admit /- proof elided -/

instance : LawfulComonad Stream' where
  map_eq_extend_extract := by admit /- proof elided -/

instance : Functor NonEmptyList where
  map := NonEmptyList.map

instance : Extract NonEmptyList where
  extract := NonEmptyList.head_nel 

instance : Extend NonEmptyList where
  extend s f := NonEmptyList.map f (NonEmptyList.tails s) 

instance : Coseq NonEmptyList where
  coseq := NonEmptyList.zip 

instance : Coapplicative NonEmptyList where

instance : Comonad NonEmptyList where

instance : LawfulFunctor NonEmptyList where
  id_map := by admit /- proof elided -/

instance : LawfulCoapplicative NonEmptyList where
  coseqLeft_eq := by admit /- proof elided -/

instance : LawfulComonad NonEmptyList where
  map_eq_extend_extract := sorry 
  extend_extract := sorry 
  extract_extend := sorry 
  extend_assoc := sorry 

structure List.Zipper (α : Type u) where
  left   : List α 
  focus  : α      
  right  : List α 

deriving Repr, DecidableEq

@[simp]
def map (f : α → β) (z : Zipper α) : Zipper β :=
  ⟨ List.map f z.left, f z.focus, List.map f z.right ⟩

@[simp]
def extract (z : Zipper α) : α := z.focus

@[simp]
def duplicate (z : Zipper α) : Zipper (Zipper α) :=
  
  sorry 

def coseq (za : Zipper α) (zb : Zipper β) : Zipper (α × β) :=
  sorry 

instance : Functor Zipper where
  map := map

instance : Extract Zipper where
  extract := extract

instance : Extend Zipper where
  extend z f := map f (duplicate z)

instance : Coapplicative Zipper where
  coseq := coseq

instance : Comonad Zipper where

instance : LawfulFunctor Zipper where
  id_map    := sorry
  comp_map  := sorry
  map_const := sorry

instance : LawfulCoapplicative Zipper where
  coseqLeft_eq  := sorry
  coseqRight_eq := sorry
  coseq_assoc   := sorry

instance : LawfulComonad Zipper where
  map_eq_extend_extract := sorry 
  extend_extract        := sorry 
  extract_extend        := sorry 
  extend_assoc          := sorry 

structure EnvT (e : Type u₁) (w : Type u₂ → Type v₂) (a : Type u₂) where
   
  runEnvT : w a
   
  env : e

instance instFunctor [Functor w] : Functor (EnvT e w) where
  map f envt := { runEnvT := Functor.map f envt.runEnvT, env := envt.env }

instance instExtract [Extract w] : Extract (EnvT e w) where
  extract envt := Extract.extract envt.runEnvT

instance instExtend [Extend w] : Extend (EnvT e w) where
  extend envt k := { runEnvT := Extend.extend envt.runEnvT (fun w'a => k { runEnvT := w'a, env := envt.env }), env := envt.env }

instance instCoseq [Coseq w] : Coseq (EnvT e w) where
  coseq envt_a envt_b := { runEnvT := Coseq.coseq envt_a.runEnvT envt_b.runEnvT, env := envt_a.env }

instance instCoapplicative [Coapplicative w] : Coapplicative (EnvT e w) where

instance instComonad [Comonad w] : Comonad (EnvT e w) where

instance instLawfulFunctor [Comonad w] [LawfulFunctor w] : LawfulFunctor (EnvT e w) where
  id_map := by admit /- proof elided -/

instance instLawfulCoapplicative [Comonad w] [LawfulCoapplicative w] : LawfulCoapplicative (EnvT e w) where
  
  coseqLeft_eq := by admit /- proof elided -/

instance instLawfulComonad [Comonad w] [LawfulComonad w] : LawfulComonad (EnvT e w) where
  
  map_eq_extend_extract := by admit /- proof elided -/

structure StoreT (s : Type u₂) (w : Type u₂ → Type v₂) (a : Type u₂) where
   
  runStoreT : w (s → a)
   
  pos : s

instance instFunctor [Functor w] : Functor (StoreT s w) where
  map f storet := { runStoreT := Functor.map (fun g => f ∘ g) storet.runStoreT, pos := storet.pos }

instance instExtract [Comonad w] : Extract (StoreT s w) where
  extract storet := Extract.extract storet.runStoreT storet.pos

instance instExtend [Comonad w] : Extend (StoreT s w) where
  extend storet k := { runStoreT := Extend.extend storet.runStoreT (fun w'sa s' => k { runStoreT := w'sa, pos := s' }), pos := storet.pos }

instance instCoseq [Comonad w] : Coseq (StoreT s w) where
  coseq storet_a storet_b :=
    let run_ab := Coseq.coseq storet_a.runStoreT storet_b.runStoreT 
    let run_prod_s := Functor.map (fun (f, g) s' => (f s', g s')) run_ab 
    { runStoreT := run_prod_s, pos := storet_a.pos }

instance instCoapplicative [Comonad w] : Coapplicative (StoreT s w) where

instance instComonad [Comonad w] : Comonad (StoreT s w) where

instance instLawfulFunctor [Comonad w] [LawfulFunctor w] : LawfulFunctor (StoreT s w) where
  id_map := by admit /- proof elided -/

instance instLawfulCoapplicative [Comonad w] [LawfulCoapplicative w] : LawfulCoapplicative (StoreT s w) where
  coseqLeft_eq := sorry 
  coseqRight_eq := sorry 
  coseq_assoc := sorry 

instance instLawfulComonad [Comonad w] [LawfulComonad w] : LawfulComonad (StoreT s w) where
  map_eq_extend_extract := sorry 
  extend_extract := sorry 
  extract_extend := by admit /- proof elided -/

structure Day (f : Type u₁ → Type v₁) (g : Type u₂ → Type v₂) (a : Type u₃) where
   
  {α : Type u₁}
   
  {β : Type u₂}
   
  map' : α → β → a
   
  fa : f α
   
  gb : g β

instance instFunctor [Functor f] [Functor g] : Functor (Day f g) where
  map {a b : Type u₃} (k : a → b) (day : Day f g a) : Day f g b :=
    
    ⟨fun (x : day.α) (y : day.β) => k (day.map' x y), day.fa, day.gb⟩

def extract [Extract f] [Extract g] {a : Type u₃} (day : Day f g a) : a :=
  
  day.map' (Extract.extract day.fa) (Extract.extract day.gb)

def duplicate [Comonad f] [Comonad g] {a : Type u₃} (day : Day f g a) : Day f g (Day f g a) :=
  sorry 

def coseq [Comonad f] [Comonad g] {a b : Type u₃} (day_a : Day f g a) (day_b : Day f g b) : Day f g (a × b) :=
  
  let map_c := fun (x : day_a.α × day_b.α) (y : day_a.β × day_b.β) =>
                 (day_a.map' x.1 y.1, day_b.map' x.2 y.2)
  
  ⟨map_c, Coseq.coseq day_a.fa day_b.fa, Coseq.coseq day_a.gb day_b.gb⟩

instance instCoseq [Comonad f] [Comonad g] : Coseq (Day f g) where
  coseq := coseq

instance [Comonad f] [Comonad g] : Comonad (Day f g) where
  extract {a : Type u₃} := extract
  extend {a b : Type u₃} (day : Day f g a) (k : Day f g a → b) : Day f g b :=
    sorry 
    
  coseq {a b : Type u₃} := coseq 

instance (n : ℕ) : SelectableType (BitVec n) where
  selectElem := ofFin <$> ($ᵗ Fin (2 ^ n))
  mem_support_selectElem x := by admit /- proof elided -/

inductive FreeM (P : PFunctor.{uA, uB}) : Type v → Type (max uA uB v)
  | pure {α} (x : α) : FreeM P α
  | roll {α} (a : P.A) (r : P.B a → FreeM P α) : FreeM P α
deriving Inhabited

@[always_inline, inline]
def liftPos (a : P.A) : FreeM P (P.B a) := FreeM.roll a FreeM.pure

@[always_inline, inline]
def lift (x : P.Obj α) : FreeM P α := FreeM.roll x.1 (fun y ↦ FreeM.pure (x.2 y))

instance : MonadLift P (FreeM P) where
  monadLift x := FreeM.lift x

@[always_inline, inline]
protected def bind : FreeM P α → (α → FreeM P β) → FreeM P β
  | FreeM.pure x, g => g x
  | FreeM.roll x r, g => FreeM.roll x (λ u ↦ FreeM.bind (r u) g)

instance : Monad (FreeM P) where
  pure := FreeM.pure
  bind := FreeM.bind

instance : LawfulMonad (FreeM P) :=
  LawfulMonad.mk' (FreeM P)
    (λ x ↦ by admit /- proof elided -/
      )
    (λ x f ↦ rfl)
    (λ x f g ↦ by admit /- proof elided -/
      )

@[elab_as_elim]
protected def inductionOn {C : FreeM P α → Prop}
    (pure : ∀ x, C (pure x))
    (roll : (x : P.A) → (r : P.B x → FreeM P α) → (∀ y, C (r y)) → C (FreeM.roll x r)) :
    (oa : FreeM P α) → C oa
  | FreeM.pure x => pure x
  | FreeM.roll x r => roll x _ (λ u ↦ FreeM.inductionOn pure roll (r u))

@[elab_as_elim]
protected def construct {C : FreeM P α → Type*}
    (pure : (x : α) → C (pure x))
    (roll : (x : P.A) → (r : P.B x → FreeM P α) → ((y : P.B x) → C (r y)) → C (FreeM.roll x r)) :
    (oa : FreeM P α) → C oa
  | .pure x => pure x
  | .roll x r => roll x _ (λ u ↦ FreeM.construct pure roll (r u))

protected def mapM [Pure m] [Bind m] (s : (a : P.A) → m (P.B a)) : FreeM P α → m α
  | .pure a => Pure.pure a
  | .roll a r => (s a) >>= (λ u ↦ (r u).mapM s)

protected def mapMHom [Monad m] [LawfulMonad m] (s : (a : P.A) → m (P.B a)) : FreeM P →ᵐ m where
  toFun := FreeM.mapM s
  toFun_pure' x := rfl
  toFun_bind' x y := by admit /- proof elided -/

inductive PolyTimeOC {ι : Type} {spec : OracleSpec ι} :
    {α β : Type} → (α → OracleComp spec β) → Prop
  
  | polyTime_query {α : Type} (i : ι) (f : α → spec.domain i)
      (hf : Σ ea eb, Turing.TM2ComputableInPolyTime ea eb f) :
    PolyTimeOC (λ x ↦ (query i (f x) : OracleComp spec _))
  
  | polyTime_return {α β : Type} (f : α → β)
      (hf : Σ ea eb, Turing.TM2ComputableInPolyTime ea eb f) :
    PolyTimeOC (λ x ↦ return (f x))
  
  | polyTime_bind {α β γ : Type} (oa : α → OracleComp spec β)
      (ob : α → β → OracleComp spec γ)
      (hoa : PolyTimeOC oa) (hob : PolyTimeOC (Function.uncurry ob)) :
    PolyTimeOC (λ x ↦ do let y ← oa x; ob x y)

noncomputable def evalDistWhen (oa : OracleComp spec α)
    (query_dist : {α : Type _} →
      OracleQuery spec α → OptionT PMF α) :
    OptionT PMF α :=
  oa.simulateQ ⟨query_dist⟩

noncomputable def evalDist (oa : OracleComp spec α) : OptionT PMF α :=
  oa.simulateQ ⟨fun (query i _) => PMF.uniformOfFintype (spec.range i)⟩

noncomputable def probOutput (oa : OracleComp spec α) (x : α) : ℝ≥0∞ :=
  (evalDist oa).run (some x)

noncomputable def probFailure (oa : OracleComp spec α) : ℝ≥0∞ :=
  (evalDist oa).run none

noncomputable def probEvent (oa : OracleComp spec α) (p : α → Prop) : ℝ≥0∞ :=
  (evalDist oa).run.toOuterMeasure (Option.some '' {x | p x})

def HoareTriple (P : α → Prop) (comp : α → OracleComp spec β)
    (Q : β → Prop) (r : ℝ≥0∞) : Prop :=
  ∀ x : α, P x → r ≤ [Q | comp x]

def HoareTriple.bind {P : α → Prop} {comp₁ : α → OracleComp spec β}
    {Q : β → Prop} {comp₂ : α → β → OracleComp spec γ} {R : γ → Prop} {r r' : ℝ≥0∞}
    (h1 : ⦃P⦄ comp₁ ⦃Q⦄ r) (h2 : ∀ x, ⦃Q⦄ comp₂ x ⦃R⦄ r') :
        ⦃P⦄ fun x => comp₁ x >>= comp₂ x ⦃R⦄ (r * r') :=

def constProd (P : PFunctor.{uA, uB}) (α : Type u) : PFunctor.{max uA u, uB} where
  A := α × P.A
  B := fun s : α × P.A => P.B s.2

def CofreeC (F : PFunctor.{uA, uB}) (α : Type u) : Type _ :=
  M.{max uA u, uB} (constProd F α)

def head (t : CofreeC F α) : α :=
  (M.head t).1

def tail (t : CofreeC F α) : F (CofreeC F α) :=
  let d := M.dest t       
  ⟨d.1.2, d.2⟩            

def extract (t : CofreeC F α) : α :=
  head t

def extend (f : CofreeC F α → α) (t : CofreeC F α) : α :=
  f t

instance : Comonad (CofreeC F) where
  extract := extract
  extend := sorry
  coseq := sorry

instance : LawfulComonad (CofreeC F) := sorry

structure RelativeMonad (J : C ⥤ D) where
   
  T : C → D
   
  η : ∀ {X}, J.obj X ⟶ T X
   
  μ : ∀ {X Y}, ((J.obj X) ⟶ (T Y)) → ((T X) ⟶ (T Y))
   
  left_unit : ∀ {X}, μ η = 𝟙 (T X) := by admit /- proof elided -/

@[simps]
def inducedFunctor (M : RelativeMonad C D J) : C ⥤ D where
  obj X := M.T X
  map f := M.μ (J.map f ≫ M.η)
  map_comp f g := by admit /- proof elided -/

def inducedNatTrans (M : RelativeMonad C D J) : NatTrans J M.inducedFunctor where
  app X := M.η

def monadOfId (M : RelativeMonad C _ (𝟭 _)) : Monad C where
  toFunctor := M.inducedFunctor
  η := { app X := M.η }
  μ := NatTrans.mk (fun X => M.μ (𝟙 (M.T X)))
    (fun X Y f => by admit /- proof elided -/
    )
  right_unit _ := by admit /- proof elided -/

def ofNatIso {J₁ J₂ : C ⥤ D} (φ : J₁ ≅ J₂) (M : RelativeMonad C D J₁) : RelativeMonad C D J₂ where
  T := M.T
  η := φ.inv.app _ ≫ M.η
  μ := fun f => M.μ (φ.hom.app _ ≫ f)
  assoc f g := by admit /- proof elided -/

def precompose {C' : Type u₃} [Category.{v₃} C'] (J' : C' ⥤ C) (M : RelativeMonad C D J) :
    RelativeMonad C' D (J' ⋙ J) where
  T := M.T ∘ J'.obj
  η := M.η
  μ := M.μ

@[simps!]
def prod (M₁ : RelativeMonad C₁ D₁ J₁) (M₂ : RelativeMonad C₂ D₂ J₂) :
    RelativeMonad (C₁ × C₂) (D₁ × D₂) (Functor.prod J₁ J₂) where
  T := fun X => (M₁.T X.fst, M₂.T X.snd)
  η := ⟨M₁.η, M₂.η⟩
  μ := fun f => ⟨M₁.μ f.fst, M₂.μ f.snd⟩

structure RelativeMonadHom (M₁ : RelativeMonad C D₁ J₁) (M₂ : RelativeMonad C D₂ J₂) where
  J₁₂ : D₁ ⥤ D₂
  φ : J₂ ≅ (J₁ ⋙ J₁₂)
  map : ∀ {X}, J₁₂.obj (M₁.T X) ⟶ M₂.T X
  map_η : ∀ {X}, J₁₂.map M₁.η ≫ map = φ.inv.app X ≫ M₂.η := by admit /- proof elided -/

class RelativePure (j : Type u → Type w) (f : Type u → Type v) where
   
  pureᵣ : {α : Type u} → j α → f α

class RelativeBind (j : Type u → Type w) (m : Type u → Type v) where
   
  bindᵣ : {α β : Type u} → m α → (j α → m β) → m β

class RelativeFunctor (j : Type u → Type w) (f : Type u → Type v) where
   
  mapᵣ : {α β : Type u} → (j α → j β) → (f α → f β)
  mapConstᵣ : {α β : Type u} → j α → f β → f α := mapᵣ ∘ Function.const _

class RelativeMonad (j : Type u → Type w) (m : Type u → Type v)
    extends RelativePure j m, RelativeBind j m, RelativeFunctor j m where
  mapᵣ f x := bindᵣ x (pureᵣ ∘ f)

def instFunctorOfRelativeMonad {j : Type u → Type w} [Functor j] {m : Type u → Type v}
    [RelativeMonad j m] : Functor m where
  map f x := bindᵣ (j := j) x (pureᵣ ∘ (Functor.map f))

def instSeqOfRelativeMonadOfSeq {j : Type u → Type w} [Seq j] {m : Type u → Type v}
    [RelativeMonad j m] : Seq m where
  seq f x := bindᵣ (j := j) (m := m) f (fun y => mapᵣ (y <*> ·) (x ()))

instance [RelativePure Id f] : Pure f where
  pure := @pureᵣ Id f _

instance [RelativeBind Id m] : Bind m where
  bind := @bindᵣ Id m _

instance [RelativeFunctor Id f] : Functor f where
  map := @mapᵣ Id f _
  mapConst := @mapConstᵣ Id f _

instance [RelativeMonad Id m] : Monad m where
  pure := @pureᵣ Id m _
  bind := @bindᵣ Id m _

class LawfulRelativeFunctor (j : Type u → Type w) (f : Type u → Type v)
    [RelativeFunctor j f] where

  map_constᵣ {α β : Type u} : (mapConstᵣ : j α → f β → _) = mapᵣ ∘ (Function.const _)

  id_mapᵣ {α : Type u} (x : f α) : (id : j α → _) <$>ᵣ x = x

  comp_mapᵣ {α β γ : Type u} (g : j α → j β) (h : j β → j γ) (x : f α) :
    (h ∘ g) <$>ᵣ x = h <$>ᵣ g <$>ᵣ x

class LawfulRelativeMonad (j : Type u → Type w) (m : Type u → Type v)
    [RelativeMonad j m] extends LawfulRelativeFunctor j m where

  pure_bindᵣ {α β : Type u} (x : j α) (f : j α → m β) :
    (pureᵣ x) >>=ᵣ f = f x

  
  
  

  bind_pure_compᵣ {α β : Type u} (f : j α → j β) (x : m α) :
    x >>=ᵣ (fun y => pureᵣ (f y)) = f <$>ᵣ x

  bind_assocᵣ {α β γ : Type u} (x : m α) (f : j α → m β) (g : j β → m γ) :
    x >>=ᵣ f >>=ᵣ g = x >>=ᵣ fun x ↦ f x >>=ᵣ g

instance [RelativeFunctor Id f] [LawfulRelativeFunctor Id f] : LawfulFunctor f where
  map_const := @map_constᵣ Id f _ _
  id_map := @id_mapᵣ Id f _ _
  comp_map := @comp_mapᵣ Id f _ _

class MonadIso (m : Type u → Type v) (n : Type u → Type w) where
  toLift : MonadLiftT m n
  invLift : MonadLiftT n m
  monadLift_left_inv {α : Type u} :
    Function.LeftInverse (toLift.monadLift (α := α)) (invLift.monadLift (α := α))
  monadLift_right_inv {α : Type u} :
    Function.RightInverse (toLift.monadLift (α := α)) (invLift.monadLift (α := α))

class RelativeMonadMorphism (r₁ : Type u → Type v₁) (m₁ : Type u → Type v₁)
    (r₂ : Type u → Type v₂) (m₂ : Type u → Type v₂)
    [RelativeMonad r₁ m₁] [RelativeMonad r₂ m₂] where
  r₁₂ : Type v₁ → Type v₂
  [instFunctor : Functor r₁₂]
  φ : MonadIso r₂ (r₁₂ ∘ r₁)
  mmapᵣ {α : Type u} : r₁₂ (m₁ α) → m₂ α
  mmapᵣ_pureᵣ {α} :
    mmapᵣ ∘ (Functor.map (f := r₁₂) (@pureᵣ r₁ m₁ _ α)) = pureᵣ ∘ φ.invLift.monadLift
  mmapᵣ_bindᵣ {α β : Type u} (f : r₁ α → m₁ β) :
    mmapᵣ ∘ (Functor.map (f := r₁₂) (bindᵣ · f)) =
      (· >>=ᵣ mmapᵣ ∘ Functor.map (f := r₁₂) f ∘ φ.toLift.monadLift) ∘ mmapᵣ

def uniformErrSamp {p : ℕ} (χ : ℕ) (hχ : p > 2*χ) : ProbComp (Fin p) := do
  let e ←$ᵗ Fin (2*χ + 1)
  haveI : NeZero p := ⟨by admit /- proof elided -/
  ⟩
  return (Fin.castLE hχ e) - ⟨χ, by admit /- proof elided -/
  ⟩

def regevAsymmEnc (n m p : ℕ) [hp2 : p.AtLeastTwo] (errSampKG : ProbComp (Fin p)) :
    AsymmEncAlg ProbComp (M := Bool) (PK := Matrix (Fin n) (Fin m) (Fin p) × Vector (Fin p) m)
     (SK := Vector (Fin p) n) (C := Vector (Fin p) n × Fin p) where
  keygen := do
    let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
    let s ←$ᵗ Vector (Fin p) n
    let e ← (Vector.range m).mapM (fun _ ↦ errSampKG)
    return ((A, Vector.ofFn (Matrix.vecMul s.get A) + e), s)
  encrypt := λ (A, y) msg ↦ do
    let r2 ←$ᵗ Vector (Fin 2) m
    let r := (r2.map (Fin.castLE hp2.one_lt)).get
    let yr := dotProduct y.get r
    let signal := if msg then 0 else p / 2
    return (Vector.ofFn (Matrix.mulVec A r), yr + (Fin.ofNat p signal))
  decrypt := λ s (a, b) ↦ do
    let sa := dotProduct s.get a.get
    let val := Fin.val (sa - b)
    return if val < p/4 then true else val > 3*p/4
  __ := ExecutionMethod.default

def uniformRegevAsymmEnc (n m p : ℕ) [hp2 : p.AtLeastTwo] [NeZero m]
    (χ : ℕ) (he : p > 4*(χ*m + 1)) :=
  regevAsymmEnc n m p (uniformErrSamp χ (relax_p_bound he))

def Fin_Bound {n : ℕ} (x : Fin n) (b : ℕ) : Prop :=
  x.val ≤ b ∨ x.val + b ≥ n

def Fin_Bound_vec {n m : ℕ} (v : Vector (Fin n) m) (b : ℕ) : Prop :=
  ∀ i, Fin_Bound (v.get i) b

def Hybrid_0 : ProbComp Bool :=
  IND_CPA_OneTime_Game (encAlg := uniformRegevAsymmEnc n m p χ he) adv

example : Hybrid_0 adv = IND_CPA_OneTime_Game adv :=

def Hybrid_1 : ProbComp Bool := do
  let b ←$ᵗ Bool
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let u ←$ᵗ Vector (Fin p) m
  let ⟨m₁, m₂, st⟩ ← adv.chooseMessages (A, u)
  let c ← if b then (uniformRegevAsymmEnc n m p χ he).encrypt (A, u) m₁
    else (uniformRegevAsymmEnc n m p χ he).encrypt (A, u) m₂
  let b' ← adv.distinguish st c
  return b = b'

def Hybrid_01_Reduction : LWE_Adversary n m p := fun Au => do
  let b ←$ᵗ Bool
  let ⟨m₁, m₂, st⟩ ← adv.chooseMessages Au
  let c ← if b then (uniformRegevAsymmEnc n m p χ he).encrypt Au m₁
  else (uniformRegevAsymmEnc n m p χ he).encrypt Au m₂
  let b' ← adv.distinguish st c
  return b'

def Hybrid_2 : ProbComp Bool := do
  let b ←$ᵗ Bool
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let u ←$ᵗ Vector (Fin p) m
  let ⟨_, _, st⟩ ← adv.chooseMessages (A, u)
  
  let c₁ ←$ᵗ Vector (Fin p) n
  let c₂ ←$ᵗ Fin p
  let b' ← adv.distinguish st (c₁, c₂)
  return b = b'

def LHL_Consequence_Adv (n p : ℕ) := (Vector (Fin p) n) × (Fin p) → ProbComp Bool

def LHL_Consequence_Game_0 (adv : LHL_Consequence_Adv n p) : ProbComp Bool := do
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let u ←$ᵗ Vector (Fin p) m
  let r2 ←$ᵗ Vector (Fin 2) m
  let r := (r2.map (Fin.castLE hp2.one_lt)).get
  adv (Vector.ofFn (Matrix.mulVec A r), dotProduct u.get r)

def LHL_Consequence_Game_1 (adv : LHL_Consequence_Adv n p) : ProbComp Bool := do
  let x ←$ᵗ Vector (Fin p) n
  let y ←$ᵗ Fin p
  adv (x, y)

noncomputable def LHL_Consequence_Advantage (adv : LHL_Consequence_Adv n p) : ℝ :=
  (LHL_Consequence_Game_0 (m := m) adv).advantage₂' (LHL_Consequence_Game_1 adv)

def Hybrid_12_Reduction : LHL_Consequence_Adv n p := fun x => do
  let b ←$ᵗ Bool
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let u ←$ᵗ Vector (Fin p) m
  let ⟨_, _, st⟩ ← adv.chooseMessages (A, u)
  let b' ← adv.distinguish st x
  return b = b'

abbrev vcvLinters : Array LeanOption := #[
  
  ⟨`linter.hashCommand, true⟩,
  ⟨`linter.oldObtain, true,⟩,
  ⟨`linter.refine, true⟩,
  ⟨`linter.style.cdot, true⟩,
  ⟨`linter.style.dollarSyntax, true⟩,
  
  ⟨`linter.style.longLine, true⟩,
  ⟨`linter.style.longFile, .ofNat 1500⟩,
  ⟨`linter.style.missingEnd, true⟩,
  ⟨`linter.style.setOption, true⟩
]

package VCVio where
  
  leanOptions := #[
    ⟨`pp.unicode.fun, true⟩, 
    ⟨`pp.proofs.withType, false⟩,
    ⟨`autoImplicit, false⟩,
    ⟨`relaxedAutoImplicit, false⟩]
    ++ vcvLinters.map fun s ↦
      { s with name := `weak ++ s.name }

require "leanprover-community" / "mathlib" @ git "v4.24.0-rc1"

def supportWhen (oa : OracleComp spec α)
    (possible_outputs : {α : Type v} → OracleQuery spec α → Set α) : Set α :=

def support (oa : OracleComp spec α) : Set α :=
  oa.supportWhen fun _ => Set.univ

def finSupportWhen [DecidableEq α] (oa : OracleComp spec α)
    (possible_outputs : {α : Type v} → OracleQuery spec α → Finset α) : Finset α :=

def finSupport [∀ i, Fintype (spec.range i)] [DecidableEq α] (oa : OracleComp spec α) : Finset α :=
  oa.finSupportWhen fun | query _ _ => Finset.univ

instance supportWhen_finite [spec.FiniteRange] (oa : OracleComp spec α) :
    Finite ↥(oa.supportWhen poss) :=

instance support_finite [spec.FiniteRange] (oa : OracleComp spec α) :
    Finite ↥(oa.support) := supportWhen_finite _ oa

instance support_fintype [spec.FiniteRange] [DecidableEq α] (oa : OracleComp spec α) :
    Fintype ↥oa.support :=

instance decidablePred_mem_support [spec.FiniteRange] [hα : DecidableEq α]
    (oa : OracleComp spec α) : DecidablePred (· ∈ oa.support) :=

instance decidablePred_mem_finSupport [spec.DecidableEq] [spec.FiniteRange] [DecidableEq α]
    (oa : OracleComp spec α) : DecidablePred (· ∈ oa.finSupport) :=

def replicate {ι : Type u} {spec : OracleSpec ι} {α : Type v}
    (n : ℕ) (oa : OracleComp spec α) : OracleComp spec (List α) :=
  (List.replicate n ()).mapM fun () => oa

def replicateTR {ι : Type u} {spec : OracleSpec ι} {α : Type v}
    (n : ℕ) (oa : OracleComp spec α) : OracleComp spec (List α) :=
  (List.replicateTR n ()).mapM fun () => oa

instance : MonoidalCategory (Preord) where
  tensorObj X Y := ⟨X.carrier × Y.carrier⟩
  whiskerLeft X Y := fun f => ofHom ⟨fun x => (x.1, f.1 x.2),
      (by admit /- proof elided -/
      )⟩
  whiskerRight f Y := ofHom ⟨fun y => (f.hom y.1, y.2),
      (by admit /- proof elided -/
      )⟩
  tensorUnit := ⟨PUnit⟩
  associator X Y Z := {
    hom := ofHom ⟨fun ⟨⟨x, y⟩, z⟩ => ⟨x, ⟨y, z⟩⟩, by admit /- proof elided -/
      ⟩
    inv := ofHom ⟨fun ⟨x, ⟨y, z⟩⟩ => ⟨⟨x, y⟩, z⟩, by admit /- proof elided -/
      ⟩ }
  leftUnitor X := {
    hom := ofHom ⟨Prod.snd, (by admit /- proof elided -/
    )⟩
    inv := ofHom ⟨fun x => (PUnit.unit, x), by admit /- proof elided -/
    ⟩ }
  rightUnitor X := {
    hom := ofHom ⟨Prod.fst, (by admit /- proof elided -/
    )⟩
    inv := ofHom ⟨fun x => (x, PUnit.unit), by admit /- proof elided -/
    ⟩ }
  tensorHom_def f g := rfl
  
  tensor_comp f₁ f₂ g₁ g₂ := rfl
  whiskerLeft_id _ _ := rfl
  id_whiskerRight _ _ := rfl
  associator_naturality f₁ f₂ f₃ := rfl
  leftUnitor_naturality f := rfl
  rightUnitor_naturality f := rfl
  pentagon _ _ _ _ := rfl
  triangle _ _ := rfl

@[simps]
instance instProduct : EnrichedCategory V (C × D) where
  Hom X Y := (𝒞.Hom X.1 Y.1) ⊗ (𝒟.Hom X.2 Y.2)
  id X := (λ_ _).inv ≫ (sorry)
  
  comp X Y Z := by admit /- proof elided -/

structure RelativeMonad where
  T : C → D
  η : {A : C} → (J.obj A ⟶[ Bundled c ] T A)
  μ : {A B : C} → (J.obj A ⟶[ Bundled c ] T B) ⟶ (T A ⟶[ Bundled c ] T B)

@[simps]
def inducedFunctor (M : RelativeMonad C D J) : EnrichedFunctor (Bundled c) C D where
  obj A := M.T A
  map f := sorry

structure RelativeMonadHom (M N : RelativeMonad C D J) where

class RelativeMonadHom.IsStrict (M N : RelativeMonad C D J) (F : RelativeMonadHom C D J M N) where

abbrev PreordEnrichedCategory (C : Type u) := EnrichedCategory Preord C

def QueryCache (spec : OracleSpec ι) : Type u :=
  (i : ι) → spec.domain i → Option (spec.range i)

instance : EmptyCollection (QueryCache spec) := ⟨fun _ _ => none⟩

def cacheQuery  (i : ι) (t : spec.domain i) (u : spec.range i) :
    QueryCache spec := Function.update cache i (Function.update (cache i) t u)

@[reducible] def QueryCount (_spec : OracleSpec ι) : Type u := ι → ℕ

instance : Monoid (QueryCount spec) where
  mul qc qc' := qc + qc'
  mul_assoc := add_assoc
  one := 0
  one_mul := zero_add
  mul_one := add_zero

def single [DecidableEq ι] (i : ι) : QueryCount spec := Function.update 0 i 1

@[reducible]
def QueryLog (spec : OracleSpec ι) : Type _ :=
  List ((i : ι) × spec.domain i × spec.range i)

instance : Append (QueryLog spec) := ⟨List.append⟩

instance : Monoid (QueryLog spec) where
  mul := List.append
  mul_assoc := List.append_assoc
  one := List.nil
  one_mul := List.nil_append
  mul_one := List.append_nil

def singleton {α} (q : OracleQuery spec α) (u : α) : QueryLog spec :=
  match q with | query i t => [⟨i, (t, u)⟩]

def logQuery {α} (log : QueryLog spec) (q : OracleQuery spec α) (u : α) :
    QueryLog spec := log ++ singleton q u

instance [DecidableEq ι] [spec.DecidableEq] : DecidableEq (QueryLog spec) :=
  inferInstanceAs (DecidableEq (List _))

def getQ (log : QueryLog spec) (i : ι) : List (spec.domain i × spec.range i) :=
  List.foldr (fun ⟨j, t, u⟩ xs => if h : j = i then h ▸ (t, u) :: xs else xs) [] log

def countQ (log : QueryLog spec) (i : ι) : ℕ := (log.getQ i).length

def wasQueried [DecidableEq ι] [spec.DecidableEq] (log : QueryLog spec)
    (i : ι) (t : spec.domain i) : Bool :=
  match (log.getQ i).find? (λ (t', _) ↦ t = t') with
  | Option.some _ => true
  | Option.none => false

protected def fst (log : QueryLog (spec₁ ++ₒ spec₂)) : QueryLog spec₁ :=
  log.filterMap (fun | ⟨.inl i, t, u⟩ => some ⟨i, t, u⟩ | _ => none)

protected def snd (log : QueryLog (spec₁ ++ₒ spec₂)) : QueryLog spec₂ :=
  log.filterMap (fun | ⟨.inr i, t, u⟩ => some ⟨i, t, u⟩ | _ => none)

protected def inl (log : QueryLog spec₁) : QueryLog (spec₁ ++ₒ spec₂) :=
  log.map fun ⟨i, t, u⟩ => ⟨.inl i, t, u⟩

protected def inr (log : QueryLog spec₂) : QueryLog (spec₁ ++ₒ spec₂) :=
  log.map fun ⟨i, t, u⟩ => ⟨.inr i, t, u⟩

instance : Coe (QueryLog spec₁) (QueryLog (spec₁ ++ₒ spec₂)) := ⟨QueryLog.inl⟩

instance : Coe (QueryLog spec₂) (QueryLog (spec₁ ++ₒ spec₂)) := ⟨QueryLog.inr⟩

def QuerySeed (spec : OracleSpec ι) : Type _ :=
  (i : ι) → List (spec.range i)

instance : DFunLike (QuerySeed spec) ι (λ i ↦ List (spec.range i)) where
  coe := λ seed ↦ seed
  coe_injective' := Function.injective_id

@[simp] instance : EmptyCollection (QuerySeed spec) := ⟨λ _ ↦ []⟩

def update [DecidableEq ι] (seed : QuerySeed spec) (i : ι)
    (xs : List (spec.range i)) : QuerySeed spec :=
  Function.update seed i xs

def addValues [DecidableEq ι] {i : ι}
    (us : List (spec.range i)) (seed : QuerySeed spec) : QuerySeed spec :=
  Function.update seed i (seed i ++ us)

abbrev addValue (seed : QuerySeed spec) (i : ι) (u : spec.range i) : QuerySeed spec :=
  seed.addValues [u]

def takeAtIndex [DecidableEq ι] (seed : QuerySeed spec) (i : ι) (n : ℕ) : QuerySeed spec :=
  Function.update seed i ((seed i).take n)

def ofList [DecidableEq ι] {i : ι} (xs : List (spec.range i)) : QuerySeed spec :=
  fun j => if h : i = j then h ▸ xs else []

class SubSpec (spec : OracleSpec.{u,w} ι) (superSpec : OracleSpec τ)
  extends MonadLift (OracleQuery spec) (OracleQuery superSpec) where

def liftComp (oa : OracleComp spec α) (superSpec : OracleSpec τ)
      [h : MonadLift (OracleQuery spec) (OracleQuery superSpec)] :
      OracleComp superSpec α := simulateQ ⟨liftM⟩ oa

instance [MonadLift (OracleQuery spec) (OracleQuery superSpec)] :
    MonadLift (OracleComp spec) (OracleComp superSpec) where
  monadLift oa := liftComp oa superSpec

@[ext]
structure QueryImpl {ι : Type w} (spec : OracleSpec ι) (m : Type u → Type v) where
  impl {α : Type u} (q : OracleQuery spec α) : m α

instance QueryImpl.Inhabited [∀ i, Inhabited (spec.range i)] [Pure m] :
  Inhabited (QueryImpl spec m) := ⟨{impl q := pure q.defaultOutput}⟩

def simulateQ [AlternativeMonad m] (so : QueryImpl spec m) (oa : OracleComp spec α) : m α :=
  do Option.getM (← FreeMonad.mapM oa.run so.impl)

def idOracle : QueryImpl spec (OracleComp spec) where impl q := OracleComp.lift q

def defaultOracle [spec.FiniteRange] : QueryImpl spec Option where
  impl | q => do return q.defaultOutput

class MonadRelation (m : Type u → Type v) (n : Type u → Type w) where
  monadRel {α : Type u} : m α → n α → Prop

class LawfulMonadRelation (m : Type u → Type v) (n : Type u → Type w) [Monad m] [Monad n]
    [MonadRelation m n] where
  monadRel_pure {α : Type u} (a : α) : monadRel (pure a : m α) (pure a : n α)
  monadRel_bind {α β : Type u} {ma : m α} {mb : α → m β} {na : n α} {nb : α → n β}
    (ha : monadRel ma na) (hb : ∀ a, monadRel (mb a) (nb a)) : monadRel (ma >>= mb) (na >>= nb)

instance instOfMonadLiftT {m n} [MonadLiftT m n] : MonadRelation m n where
  monadRel := fun ma na => liftM ma = na

instance instOfLawfulMonadLiftT {m n} [Monad m] [Monad n] [MonadLiftT m n] [LawfulMonadLiftT m n] :
    LawfulMonadRelation m n where
  monadRel_pure _ := by admit /- proof elided -/

class MonadRelationHom (m₁ : Type u → Type v₁) (n₁ : Type u → Type w₁)
    (m₂ : Type u → Type v₂) (n₂ : Type u → Type w₂) where
  monadRelHomFst {α : Type u} : m₁ α → m₂ α
  monadRelHomSnd {α : Type u} : n₁ α → n₂ α

class LawfulMonadRelationHom (m₁ : Type u → Type v₁) (n₁ : Type u → Type w₁)
    (m₂ : Type u → Type v₂) (n₂ : Type u → Type w₂)
    [MonadRelation m₁ n₁] [MonadRelation m₂ n₂]
    [MonadRelationHom m₁ n₁ m₂ n₂] where
  monadRel_hom {α : Type u} {ma : m₁ α} {na : n₁ α} (h : ma ∼ₘ na) :
    (monadRelHomFst n₁ n₂ ma : m₂ α) ∼ₘ (monadRelHomSnd m₁ m₂ na : n₂ α)

def withCaching (so : QueryImpl spec m) : QueryImpl spec (StateT spec.QueryCache m) where
  impl | query i t => do match (← get) i t with
    | Option.some u => return u
    | Option.none =>
        let u ← so.impl (query i t)
        modifyGet fun cache => (u, cache.cacheQuery i t u)

@[inline, reducible] def cachingOracle :
    QueryImpl spec (StateT spec.QueryCache (OracleComp spec)) :=
  idOracle.withCaching

@[inline, reducible] def randomOracle [(i : ι) → SelectableType (spec.range i)] :
    QueryImpl spec (StateT spec.QueryCache (OracleComp unifSpec)) :=
  unifOracle.withCaching

structure NatHom (m : Type u → Type v) (n : Type u → Type w) where
  toFun : {α : Type u} → m α → n α

instance : CoeFun (NatHom m n) (λ _ ↦ {α : Type u} → m α → n α) where
  coe f {_} x := f.toFun x

structure PureHom (m : Type u → Type v) [Pure m] (n : Type u → Type w) [Pure n]
    extends NatHom m n where
  toFun_pure' {α : Type u} (x : α) : toFun (pure x) = (pure x : n α)

instance : Coe (PureHom m n) (NatHom m n) where
  coe f := f.toNatHom

structure BindHom (m : Type u → Type v) [Bind m] (n : Type u → Type w) [Bind n]
    extends NatHom m n where
  toFun_bind' {α β : Type u} (x : m α) (y : α → m β) :
    toFun (x >>= y) = toFun x >>= (fun a => toFun (y a))

instance : Coe (BindHom m n) (NatHom m n) where
  coe f := f.toNatHom

structure MonadHom (m : Type u → Type v) [Pure m] [Bind m]
    (n : Type u → Type w) [Pure n] [Bind n] extends NatHom m n, PureHom m n, BindHom m n

class IsMonadHom (m : Type u → Type v) [Pure m] [Bind m]
    (n : Type u → Type w) [Pure n] [Bind n]
    (f : {α : Type u} → m α → n α) where
  map_pure {α} (x : α) : f (pure x) = pure x
  map_bind {α β} (x : m α) (y : α → m β) : f (x >>= y) = f x >>= f ∘ y

instance (m : Type u → Type v) [Pure m] [Bind m]
    (n : Type u → Type w) [Pure n] [Bind n] (F : m →ᵐ n) :
    IsMonadHom m n F.toFun where
  map_pure := F.toFun_pure'
  map_bind := F.toFun_bind'

instance (m : Type u → Type v) [Pure m] [Bind m] (n : Type u → Type w) [Pure n] [Bind n] :
    CoeFun (m →ᵐ n) (λ _ ↦ {α : Type u} → m α → n α) where
  coe f {_} x := f.toFun x

def ofLift (m : Type u → Type v) (n : Type u → Type v) [Monad m] [Monad n]
    [MonadLift m n] [LawfulMonadLift m n] : m →ᵐ n where
  toFun := liftM
  toFun_pure' := liftM_pure
  toFun_bind' := liftM_bind

class Extract (w : Type u → Type v) where
   
  extract {α : Type u} : w α → α

class Extend (w : Type u → Type v) where
   
  extend {α β : Type u} : w α → (w α → β) → w β

class Coseq (w : Type u → Type v) where
   
  coseq : {α β : Type u} → w α → w β → w (α × β)

class CoseqLeft (w : Type u → Type v) where
   
  coseqLeft : {α β : Type u} → w α → w β → w α

class CoseqRight (w : Type u → Type v) where
   
  coseqRight : {α β : Type u} → w α → w β → w β

class Coapplicative (w : Type u → Type v) extends
    Functor w, Extract w, Coseq w, CoseqLeft w, CoseqRight w where
   
  coseqLeft wa wb := Functor.map Prod.fst (coseq wa wb)
   
  coseqRight wa wb := Functor.map Prod.snd (coseq wa wb)

class Comonad (w : Type u → Type v) extends Coapplicative w, Extend w where
   
  map f wa := extend wa (f ∘ extract)
   
  coseq wa wb := extend wa (fun wa' => (extract wa', extract wb))

class LawfulCoapplicative (w : Type u → Type v) [Coapplicative w] extends LawfulFunctor w where
   
  coseqLeft_eq : ∀ {α β : Type u} (wa : w α) (wb : w β),
    @coseqLeft w _ α β wa wb = Functor.map (@Prod.fst α β) (coseq wa wb)
   
  coseqRight_eq : ∀ {α β : Type u} (wa : w α) (wb : w β),
    coseqRight wa wb = Functor.map (@Prod.snd α β) (coseq wa wb)
   
  coseq_assoc : ∀ {α β γ : Type u} (wa : w α) (wb : w β) (wc : w γ),
    Functor.map (Equiv.prodAssoc α β γ) (coseq (coseq wa wb) wc) = coseq wa (coseq wb wc)

class LawfulComonad (w : Type u → Type v) [Comonad w] extends LawfulCoapplicative w where
   
  map_eq_extend_extract : ∀ {α β : Type u} (f : α → β) (wa : w α),
    Functor.map f wa = extend wa (f ∘ extract)
   
  extend_extract : ∀ {α : Type u} (wa : w α), extend wa (@extract w _ α) = wa
   
  extract_extend : ∀ {α β : Type u} (wa : w α) (f : w α → β),
    extract (extend wa f) = f wa
   
  extend_assoc : ∀ {α β γ : Type u} (wa : w α) (f : w α → β) (g : w β → γ),
    extend (extend wa f) g = extend wa (fun w'a => g (extend w'a f))

@[simp]
def duplicate {α : Type u} (wa : w α) : w (w α) :=
  extend wa id

inductive OracleQuery {ι : Type u} (spec : OracleSpec.{u,v} ι) : Type v → Type (max u v)
  | query (i : ι) (t : spec.domain i) : OracleQuery spec (spec.range i)

def defaultOutput [∀ i, Inhabited (spec.range i)] : (q : OracleQuery spec α) → α
  | query i t => default

def index : (q : OracleQuery spec α) → ι | query i t => i

def input : (q : OracleQuery spec α) → spec.domain q.index | query i t => t

def rangeDecidableEq [spec.DecidableEq] : OracleQuery spec α → DecidableEq α
  | query i t => inferInstance

def rangeFintype [spec.FiniteRange] : OracleQuery spec α → Fintype α
  | query i t => inferInstance

def rangeInhabited [spec.FiniteRange] : OracleQuery spec α → Inhabited α
  | query i t => inferInstance

instance isEmpty : IsEmpty (OracleQuery []ₒ α) where false | query i t => i.elim

instance [hι : DecidableEq ι] [hd : ∀ i, DecidableEq (spec.domain i)] {α : Type u} :
    DecidableEq (OracleQuery spec α)
  | query i t => λ q ↦ match hι i q.index with
    | isTrue h => by admit /- proof elided -/
    | isFalse h => isFalse λ h' ↦ h (congr_arg index h')

def OracleComp {ι : Type u} (spec : OracleSpec.{u,v} ι) :
    Type w → Type (max u (v + 1) w) :=
  OptionT (FreeMonad (OracleQuery.{u,v} spec))

abbrev ProbComp : Type z → Type (max z 1) := OracleComp unifSpec

instance : AlternativeMonad (OracleComp spec) :=
  inferInstanceAs (AlternativeMonad (OptionT (FreeMonad (OracleQuery spec))))

instance : LawfulMonad (OracleComp spec) :=
  inferInstanceAs (LawfulMonad (OptionT (FreeMonad (OracleQuery spec))))

instance : LawfulAlternative (OracleComp spec) :=
  inferInstanceAs (LawfulAlternative (OptionT (FreeMonad (OracleQuery spec))))

instance : Inhabited (OracleComp spec α) := ⟨failure⟩

def lift (q : OracleQuery spec α) : OracleComp spec α :=
  OptionT.lift (FreeMonad.lift q)

instance : MonadLift (OracleQuery spec) (OracleComp spec) where
  monadLift := lift

instance : MonadFunctor (OracleQuery spec) (OracleComp spec) where
  monadMap f := (OptionT.instMonadFunctor).monadMap
    ((FreeMonad.instMonadFunctor).monadMap f)

@[reducible, inline] def coin : OracleComp coinSpec Bool :=
  coinSpec.query () ()

@[reducible, inline] def uniformFin (n : ℕ) : ProbComp (Fin (n + 1)) :=
  unifSpec.query n ()

@[reducible, inline] def uniformFin' (n m : ℕ) : OracleComp probSpec (Fin (m + 1)) :=
  probSpec.query m n

@[elab_as_elim]
protected def inductionOn {C : OracleComp spec α → Prop}
    (pure : (a : α) → C (pure a))
    (query_bind : (i : ι) → (t : spec.domain i) →
      (oa : spec.range i → OracleComp spec α) → (∀ u, C (oa u)) → C (query i t >>= oa))
    (failure : C failure) (oa : OracleComp spec α) : C oa :=
  FreeMonad.inductionOn (Option.rec failure pure) (λ (query i t) ↦ query_bind i t) oa

@[elab_as_elim]
protected def induction {C : OracleComp spec α → Prop}
    (oa : OracleComp spec α) (pure : (a : α) → C (pure a))
    (query_bind : (i : ι) → (t : spec.domain i) →
      (oa : spec.range i → OracleComp spec α) → (∀ u, C (oa u)) → C (query i t >>= oa))
    (failure : C failure) : C oa :=
  FreeMonad.inductionOn (Option.rec failure pure) (λ (query i t) ↦ query_bind i t) oa

@[elab_as_elim]
protected def construct {C : OracleComp spec α → Type*}
    (pure : (a : α) → C (pure a))
    (query_bind : {β : Type v} → (q : OracleQuery spec β) →
      (oa : β → OracleComp spec α) → ((u : β) → C (oa u)) → C (q >>= oa))
    (failure : C failure) (oa : OracleComp spec α) : C oa :=
  FreeMonad.construct (Option.rec failure pure) query_bind oa

@[elab_as_elim]
protected def construct' {C : OracleComp spec α → Type*}
    (pure : (a : α) → C (pure a))
    (query_bind : (i : ι) → (t : spec.domain i) →
      (oa : spec.range i → OracleComp spec α) →
      ((u : spec.range i) → C (oa u)) → C (query i t >>= oa))
    (failure : C failure) (oa : OracleComp spec α) : C oa :=
  oa.construct pure (λ (query i t) ↦ query_bind i t) failure

def isPure {α : Type v} : OracleComp spec α → Bool
  | FreeMonad.pure x => Option.isSome x
  | _ => false

def isFailure {α : Type v} : OracleComp spec α → Bool
  | FreeMonad.pure x => Option.isNone x
  | _ => false

protected def mapM {m : Type v → Type w} [Monad m]
    (fail : {α : Type v} → m α)
    (query_map : {α : Type v} → OracleQuery spec α → m α)
    (oa : OracleComp spec α) : m α :=
  OracleComp.construct pure (λ q _ r ↦ query_map q >>= r) fail oa

def defaultResult [spec.FiniteRange] (oa : OracleComp spec α) : Option α :=
  oa.mapM (fail := none) (query_map := some ∘ OracleQuery.defaultOutput)

def totalQueries [FiniteRange spec] {α : Type v} (oa : OracleComp spec α) : ℕ :=

protected instance instDecidableEq [spec.FiniteRange] [hd : ∀ i, DecidableEq (spec.domain i)]
    [hι : DecidableEq ι] [h : DecidableEq α] : DecidableEq (OracleComp spec α) := fun
  | FreeMonad.pure (Option.some x), FreeMonad.pure (Option.some y) =>
    match h x y with
    | isTrue rfl => isTrue rfl
    | isFalse h => isFalse λ h' ↦ h (by admit /- proof elided -/
    )
  | FreeMonad.pure Option.none, FreeMonad.pure (Option.some y) => isFalse λ h ↦
      Option.some_ne_none y (by admit /- proof elided -/
      )
  | FreeMonad.pure (Option.some x), FreeMonad.pure Option.none => isFalse λ h ↦
      Option.some_ne_none x (by admit /- proof elided -/
      )
  | FreeMonad.pure Option.none, FreeMonad.pure Option.none => isTrue rfl
  | FreeMonad.pure x, FreeMonad.roll q r => isFalse <| by simp
  | FreeMonad.roll q r, FreeMonad.pure x => isFalse <| by simp
  | FreeMonad.roll (OracleQuery.query i t) r, FreeMonad.roll (OracleQuery.query i' t') s =>
    match hι i i' with
    | isTrue h => by admit /- proof elided -/
    | isFalse h => isFalse λ h' ↦ h <|
        match FreeMonad.roll.inj h' with
        | ⟨h1, h2, _⟩ => @congr_heq _ _ ι OracleQuery.index OracleQuery.index
            (query i t) (query i' t') (h1 ▸ HEq.rfl) h2

class LawfulMonadFunctor (m : semiOutParam (Type u → Type v)) (n : Type u → Type w)
    [Monad m] [Monad n] [MonadFunctor m n] : Prop where
   
  monadMap_id {α : Type u} :
    MonadFunctor.monadMap (fun {β} => (id : m β → _)) = (id : n α → _)

   
  monadMap_comp {α : Type u} (f : {β : Type u} → m β → m β) (g : {γ : Type u} → m γ → m γ) :
    (@MonadFunctor.monadMap m n _ α f) ∘ (@MonadFunctor.monadMap m n _ α g) =
      @MonadFunctor.monadMap m n _ α (f ∘ g)

class LawfulMonadFunctorT (m : Type u → Type v) (n : Type u → Type w) [Monad m] [Monad n]
    [MonadFunctorT m n] : Prop where
   
  monadMap_id {α : Type u} :
    monadMap (fun {β} => (id : m β → _)) = (id : n α → _)

   
  monadMap_comp {α : Type u} (f : {β : Type u} → m β → m β) (g : {γ : Type u} → m γ → m γ) :
    (@monadMap m n _ α f) ∘ (@monadMap m n _ α g) = @monadMap m n _ α (f ∘ g)

instance {m n o} [Monad m] [Monad n] [Monad o] [MonadFunctor n o] [MonadFunctorT m n]
    [LawfulMonadFunctor n o] [LawfulMonadFunctorT m n] : LawfulMonadFunctorT m o where
  monadMap_id := by admit /- proof elided -/

instance lawfulMonadFunctorRefl {m} [Monad m] : LawfulMonadFunctorT m m where
  monadMap_id := by admit /- proof elided -/

instance {m n} [MonadFunctor m n] : MonadFunctorT m n := inferInstance

instance [MonadLift m m'] : MonadLift (StateT σ m) (StateT σ m') where
  monadLift x := StateT.mk fun s => liftM ((x.run) s)

def allWhen (possible_outputs : {α : Type v} → OracleQuery spec α → Set α)
    (oa : OracleComp spec α) : Prop :=

def someWhen (possible_outputs : {α : Type v} → OracleQuery spec α → Set α)
    (oa : OracleComp spec α) : Prop :=

def neverFailsWhen (oa : OracleComp spec α)
    (possible_outputs : {α : Type v} → OracleQuery spec α → Set α) : Prop :=
  oa.allWhen (fun _ => True) False possible_outputs

@[reducible, inline] def neverFails (oa : OracleComp spec α) : Prop :=
  oa.neverFailsWhen fun _ => Set.univ

def mayFailWhen (oa : OracleComp spec α)
    (possible_outputs : {α : Type v} → OracleQuery spec α → Set α) : Prop :=
  oa.someWhen (fun _ => False) True possible_outputs

@[reducible, inline] def mayFail (oa : OracleComp spec α) : Prop :=
  mayFailWhen oa fun _ => Set.univ

@[simp]
instance [spec.FiniteRange] : DecidablePred (@OracleComp.neverFails _ spec α) :=
  fun oa => by admit /- proof elided -/
  | pure x => exact Decidable.isTrue (neverFails_pure x)
  | failure => exact Decidable.isFalse not_neverFails_failure
  | query_bind i t _ r =>
      simpa only [Function.const_apply, neverFails_bind_iff, neverFails_query, support_query,
        Set.mem_univ, forall_const, true_and] using Fintype.decidableForallFintype

@[simps!] def oneTimePad (n : ℕ) : SymmEncAlg ProbComp
    (M := BitVec n) (K := BitVec n) (C := BitVec n) where
  keygen := do $ᵗ BitVec n 
  encrypt k m := return k ^^^ m 
  decrypt k σ := some (k ^^^ σ) 
  __ := ExecutionMethod.default 

instance complete (n : ℕ) : (oneTimePad n).Complete := ⟨by admit /- proof elided -/
⟩

def generate_nonce : OracleComp unifSpec (BitVec 256) :=
  $ᵗ BitVec 256

def string_to_bitvec (s : String) : BitVec 256 :=
  s.foldl (λ acc c => (acc.shiftLeft 8) + BitVec.ofNat 256 c.toNat) 0

def bitvec_to_string (bv : BitVec 256) : String :=
  let rec chars (n : Nat) (acc : List Char) :=
    if n = 0 then acc
    else chars (n / 256) (Char.ofNat (n % 256) :: acc)
  String.mk (chars bv.toNat [])

def mock_hmac_sha256_out_type : Type := String

instance : Repr mock_hmac_sha256_out_type := instReprString

def mock_hmac_sha256 (key : BitVec 256) (data : BitVec 256) : mock_hmac_sha256_out_type :=
  "HMAC_SHA256_OUT(" ++ bitvec_to_string key  ++ "," ++ bitvec_to_string data ++ ")"

def mock_encrypt (msg : BitVec 256) : BitVec 256 :=
  msg ^^^ (BitVec.ofNat 256 0xABCDEF)

def mock_decrypt (ciphertext : BitVec 256) : BitVec 256 :=
  ciphertext ^^^ (BitVec.ofNat 256 0xABCDEF)

structure SecretMessage where
  content : String
  nonce : BitVec 256
  deriving Repr

structure EncryptedMessage where
  ciphertext : BitVec 256
  deriving Repr

structure Context where
  sender_id : BitVec 256
  recipient_id : BitVec 256
  timestamp : Nat
  message_id : Nat
  deriving Repr

structure FrankingTag where
  tag : mock_hmac_sha256_out_type 
  deriving Repr

structure ReportingTag where
  tag : mock_hmac_sha256_out_type 
  deriving Repr

structure MessagePackage where
  encrypted_message : EncryptedMessage
  franking_tag : FrankingTag
  reporting_tag : ReportingTag
  context : Context
  nonce : BitVec 256
  deriving Repr

structure AbuseReport where
  message : SecretMessage
  franking_tag : FrankingTag
  reporting_tag : ReportingTag
  context : Context
  deriving Repr

def serialize_message_data (msg : String) (nonce : BitVec 256) : BitVec 256 × BitVec 256 :=
  let msg_bv := string_to_bitvec msg
  (msg_bv, nonce)

def deserialize_message_data (data : BitVec 256 × BitVec 256) : String × BitVec 256 :=
  let (msg_bv, nonce) := data
  (bitvec_to_string msg_bv, nonce)

def generate_franking_tag (nonce : BitVec 256) (msg : String) : FrankingTag :=
  let (msg_bv, _) := serialize_message_data msg nonce
  let tf := mock_hmac_sha256 nonce msg_bv 
  { tag := tf }

def generate_reporting_tag (franking_tag : FrankingTag) (context : Context)
    (facebook_key : BitVec 256) : ReportingTag :=
  
  let context_bv := BitVec.ofNat 256 context.timestamp
  let serialized := franking_tag.tag.append (bitvec_to_string context_bv)
  let rf_tag := mock_hmac_sha256 facebook_key (string_to_bitvec serialized)
  { tag := rf_tag }

def prepare_encrypted_message (content : String) (nonce : BitVec 256) : EncryptedMessage :=
  let (msg_bv, _) := serialize_message_data content nonce
  { ciphertext := mock_encrypt msg_bv }

def decrypt_message (encrypted_msg : EncryptedMessage) (nonce : BitVec 256) : String :=
  let decrypted_bv := mock_decrypt encrypted_msg.ciphertext
  let (msg, _) := deserialize_message_data (decrypted_bv, nonce)
  msg

instance : DecidableEq mock_hmac_sha256_out_type :=
  fun x y => match String.decEq x y with
  | isTrue h => isTrue h
  | isFalse h => isFalse h

def verify_message_package
    (package : MessagePackage) : OracleComp unifSpec (Option SecretMessage) := do
  let content := decrypt_message package.encrypted_message package.nonce
  let (msg_bv, _) := serialize_message_data content package.nonce
  let computed_tf := mock_hmac_sha256 package.nonce msg_bv
  if computed_tf = package.franking_tag.tag then
    return some { content := content, nonce := package.nonce }
  else
    return none

def validate_abuse_report (report : AbuseReport) (facebook_key : BitVec 256) : Bool :=
  let (msg_bv, _) := serialize_message_data report.message.content report.message.nonce
  let computed_tf := mock_hmac_sha256 report.message.nonce msg_bv
  let context_bv := BitVec.ofNat 256 report.context.timestamp
  let serialized := report.franking_tag.tag.append (bitvec_to_string context_bv)
  let computed_rf := mock_hmac_sha256 facebook_key (string_to_bitvec serialized)
  (computed_tf = report.franking_tag.tag) && (computed_rf = report.reporting_tag.tag)

structure SimulationData where
  verified_msg : SecretMessage
  message_package : MessagePackage
  facebook_key : BitVec 256
  deriving Repr

def simulation_setup (message_content : String) : OracleComp unifSpec (Option SimulationData) := do
  let facebook_key := BitVec.ofNat 256 123456789
  let context : Context := {
    sender_id := BitVec.ofNat 256 1001, recipient_id := BitVec.ofNat 256 1002,
    timestamp := 1730230302,
    message_id := 123 }
  let nonce ← generate_nonce
  let franking_tag  := generate_franking_tag nonce message_content
  let encrypted_msg := prepare_encrypted_message message_content nonce
  let reporting_tag := generate_reporting_tag franking_tag context facebook_key
  let package : MessagePackage := {
    encrypted_message := encrypted_msg,
    franking_tag := franking_tag,
    reporting_tag := reporting_tag,
    context := context,
    nonce := nonce }
  let maybeVerifiedMsg ← verify_message_package package
  match maybeVerifiedMsg with
  | none => 
    return none
  | some verified_msg =>
    return some { verified_msg := verified_msg
                  message_package := package
                  facebook_key := facebook_key }

def test_abuse_report_validation : IO Unit := do
  let message_content := "Hello world"
  let manipulated_message := "Hell world"
  let maybeData ← OracleComp.runIO (simulation_setup message_content)
  match maybeData with
  | none =>
    IO.println "setup failed"
  | some data =>
    let valid_abuse_report := {
      message := data.verified_msg,
      franking_tag := data.message_package.franking_tag,
      reporting_tag := data.message_package.reporting_tag,
      context := data.message_package.context }
    let is_valid := validate_abuse_report valid_abuse_report data.facebook_key
    IO.println s!"valid abuse report validation result: {is_valid}"

    let invalid_abuse_report := {
      message := {
        content := manipulated_message,
        nonce := data.verified_msg.nonce },
      franking_tag := data.message_package.franking_tag,
      reporting_tag := data.message_package.reporting_tag,
      context := data.message_package.context }
    let is_invalid := validate_abuse_report invalid_abuse_report data.facebook_key
    IO.println s!"false abuse report validation result: {is_invalid}"

def withPregen (so : QueryImpl spec m) : QueryImpl spec (ReaderT spec.QuerySeed m) where
  impl | query i t => do
    let seed ← read
    do match seed i with
      | u :: us => ReaderT.adapt (fun seed => seed.update i us) (return u)
      | [] => so.impl (query i t)

@[inline, reducible] def seededOracle [DecidableEq ι] :
    QueryImpl spec (ReaderT (QuerySeed spec) (OracleComp spec)) :=
  idOracle.withPregen

class MonadTransformer (t : (Type u → Type v) → Type u → Type w) where
  [mapMonad (m) [Monad m] : Monad (t m)]
  [transform (m) [Monad m] : MonadLift m (t m)]

instance [MonadTransformer t] [Monad m] : Monad (t m) := MonadTransformer.mapMonad m

@[always_inline, inline, simp]
abbrev MonadTransformer.liftOf [MonadTransformer t] (m) [Monad m] : m α → t m α :=
  (transform m).monadLift

@[always_inline, inline, simp]
abbrev MonadTransformer.lift [MonadTransformer t] {m} [Monad m] : m α → t m α :=
  liftOf m

instance : MonadTransformer (ReaderT ρ) where
  mapMonad _ := inferInstance
  transform := inferInstance

instance : MonadTransformer (ExceptT ε) where
  mapMonad _ := inferInstance
  transform _ := inferInstance

instance : MonadTransformer (StateT σ) where
  mapMonad _ := inferInstance
  transform _ := inferInstance

instance : MonadTransformer OptionT where
  mapMonad _ := inferInstance
  transform _ := inferInstance

class LawfulMonadTransformer (t) [MonadTransformer t] : Prop where
  [monad_functor {m : Type u → Type v} [Monad m] [LawfulMonad m] : LawfulMonad (t m)]
  liftOf_pure {m : Type u → Type v} [Monad m] [LawfulMonad m] {α} (x : α) :
    liftOf m (pure x) = (pure x : t m α)
  liftOf_bind {m : Type u → Type v} [Monad m] [LawfulMonad m] {α β} (x : m α) (f : α → m β) :
    liftOf (t := t) m (x >>= f) = liftOf m x >>= (fun a => liftOf m (f a))

instance : LawfulMonadTransformer (ReaderT ρ) where
  monad_functor := inferInstance
  liftOf_pure _ := rfl
  liftOf_bind _ _ := rfl

instance : LawfulMonadTransformer (ExceptT ε) where
  monad_functor := inferInstance
  liftOf_pure _ := map_pure _ _
  liftOf_bind _ _ := by admit /- proof elided -/

instance : LawfulMonadTransformer (StateT σ) where
  monad_functor := inferInstance
  liftOf_pure _ := funext fun _ => pure_bind _ _
  liftOf_bind _ _ := by admit /- proof elided -/

instance : LawfulMonadTransformer OptionT where
  monad_functor := inferInstance
  liftOf_pure _ := pure_bind _ _
  liftOf_bind _ _ := by admit /- proof elided -/

class IsCovariant (t : (Type u → Type v) → Type u → Type w) [MonadTransformer t] where
  functorMap {m n : Type u → Type v} [MonadLiftT m n] :
    MonadLiftT (t m) (t n)

instance [MonadTransformer t] [Monad m] : MonadLift m (t m) := MonadTransformer.transform m

instance [MonadTransformer t] [Monad m] [LawfulMonad m] [LawfulMonadTransformer t]
    : LawfulMonadLift m (t m) where
  monadLift_pure := LawfulMonadTransformer.liftOf_pure
  monadLift_bind := LawfulMonadTransformer.liftOf_bind

class DijkstraMonad (w : Type u → Type v) (d : {α : Type u} → w α → Type z) [Monad w] where
  
  dPure {α : Type u} : (x : α) → d (pure x)
  dBind {α β : Type u} {wa : w α} {wb : α → w β} : d wa → ((a : α) → d (wb a)) → d (wa >>= wb)

def DijkstraMonad.dMap {w d} [Monad w] [DijkstraMonad w d] {α β} {a : w α} (f : α → β) :
    d a → d (a >>= fun b => pure (f b)) := fun x => x >>=ᵈ (fun a => dPure (f a))

class LawfulDijkstraMonad (w : Type u → Type v) (d : {α : Type u} → w α → Type z) [Monad w]
    [LawfulMonad w] [DijkstraMonad w d] where
  dPure_dBind {α β} {f : α → w β} (x : α) (g : (a : α) → d (f a)) :
    (pure_bind x f) ▸ (dPure x >>=ᵈ g) = g x
  dBind_dPure {α} {a : w α} (x : d a) :
    (bind_pure a) ▸ (x >>=ᵈ dPure) = x
  dBind_assoc {α β γ} {a} {f : α → w β} {g : β → w γ} (x : d a)
    (f' : (a : α) → d (f a)) (g' : (b : β) → d (g b)) :
      (bind_assoc a f g) ▸ ((x >>=ᵈ f') >>=ᵈ g') = x >>=ᵈ (fun a => f' a >>=ᵈ g')

class OrderedDijkstraMonad (w : Type u → Type v) (d : {α : Type u} → w α → Type z)
    [OrderedMonad w] extends DijkstraMonad w d where
  dWeaken {α} {wa wa' : w α} : d wa → (wa ≤ₘ wa') → d wa'
  dWeaken_refl {α} {wa : w α} (x : d wa) : dWeaken x (le_refl _) = x
  dWeaken_trans {α} {wa wa' wa'' : w α} (x : d wa) (h1 : wa ≤ₘ wa') (h2 : wa' ≤ₘ wa'') :
    dWeaken (dWeaken x h1) h2 = dWeaken x (le_trans h1 h2)
  dWeaken_dBind {α β} {wa wa' : w α} {f f' : α → w β} (x : d wa) (g : (a : α) → d (f a))
    (ha : wa ≤ₘ wa') (hf : ∀ a, f a ≤ₘ f' a) :
      (dWeaken x ha) >>=ᵈ (fun a => dWeaken (g a) (hf a)) = dWeaken (x >>=ᵈ g) (bind_mono ha hf)

def dDite {w d} [Monad w] [DijkstraMonad w d] {α} (c : Prop) [h : Decidable c] {t : c → w α}
    {e : ¬c → w α} : ((c' : c) → d (t c')) → ((c' : ¬c) → d (e c')) → d (dite c t e) :=
  fun dt de => Decidable.casesOn h (fun h => de h) (fun h => dt h)

def dIte {w d} [Monad w] [DijkstraMonad w d] {α} (c : Prop) [Decidable c] {t e : w α} :
    d t → d e → d (ite c t e) :=
  fun dt de => dDite c (fun _ => dt) (fun _ => de)

class DijkstraMonadMorphism (w₁ : Type u → Type v) (w₂ : Type u → Type w)
    (d₁ : {α : Type u} → w₁ α → Type z) (d₂ : {α : Type u} → w₂ α → Type z)
    [Monad w₁] [Monad w₂] [MonadLiftT w₁ w₂] [DijkstraMonad w₁ d₁] [DijkstraMonad w₂ d₂] where
  dMorphism {α : Type u} {a : w₁ α} : d₁ a → d₂ (monadLift a)

class LawfulDijkstraMonadLift (w₁ : Type u → Type v) (w₂ : Type u → Type w)
    (d₁ : {α : Type u} → w₁ α → Type z) (d₂ : {α : Type u} → w₂ α → Type z)
    [Monad w₁] [Monad w₂] [MonadLiftT w₁ w₂] [DijkstraMonad w₁ d₁] [DijkstraMonad w₂ d₂]
    [inst : DijkstraMonadMorphism w₁ w₂ d₁ d₂]
    [LawfulMonad w₁] [LawfulMonad w₂] [LawfulMonadLiftT w₁ w₂] where
  dMorphism_dPure {α : Type u} (a : α) :
    (monadLift_pure (m := w₁) (n := w₂) a) ▸ (dMorphism (dPure a : d₁ _)) = (dPure a : d₂ _)
  dMorphism_dBind {α β : Type u} {a : w₁ α} {f : α → w₁ β} (x : d₁ a) (g : (a : α) → d₁ (f a)) :
    (monadLift_bind (m := w₁) (n := w₂) a f) ▸ (dMorphism x >>=ᵈ (fun a => dMorphism (g a))) =
      inst.dMorphism (x >>=ᵈ g)

instance instOfMonadRelation {m n} [Monad m] [Monad n] [MonadRelation m n]
    [LawfulMonadRelation m n] : DijkstraMonad n (fun na => { ma : m _ // monadRel ma na}) where
  dPure x := ⟨pure x, monadRel_pure x⟩
  dBind x f := ⟨x.1 >>= (fun a => (f a).1), monadRel_bind x.2 (fun a => (f a).2)⟩

instance instOfMonadMorphism {m n} [Monad m] [Monad n] [h : MonadLiftT m n]
    [h' : LawfulMonadLiftT m n] :
      DijkstraMonad n (fun na => { ma : m _ // monadLift ma = na }) :=
  @instOfMonadRelation m n _ _ (@instOfMonadLiftT m n h) (@instOfLawfulMonadLiftT m n _ _ h h')

instance instMonadSigma {w d} [Monad w] [DijkstraMonad w d] :
    Monad (fun α => (w : w α) × d w) where
  pure x := ⟨pure x, dPure x⟩
  bind x f := ⟨x.1 >>= (fun a => (f a).1), x.2 >>=ᵈ (fun a => (f a).2)⟩

instance {w d} [Monad w] [DijkstraMonad w d] [h : LawfulMonad w] [LawfulDijkstraMonad w d] :
    LawfulMonad (fun α => (w : w α) × d w) :=
  LawfulMonad.mk' _
    (by admit /- proof elided -/
      )
      
      
      
      
    (by admit /- proof elided -/
        )
    (fun x f g => by admit /- proof elided -/
      )

instance {w d} [Monad w] [DijkstraMonad w d] : MonadLiftT (fun α => (w : w α) × d w) w where
  monadLift x := x.1

instance {w d} [Monad w] [DijkstraMonad w d] : MonadRelation (fun α => (w : w α) × d w) w :=
  instOfMonadLiftT

inductive FreeDijkstra (m : Type u → Type v) [Monad m] : {α : Type u} → m α → Type _ where
  | protected pure {α} (x : α) : FreeDijkstra m (pure x)
  | roll {α β} (x : m α) {f : α → m β} (r : α → FreeDijkstra m (x >>= f)) : FreeDijkstra m (x >>= f)

protected def mapM {m : Type u → Type v} {n : Type u → Type w}
    [AlternativeMonad n] (f : {α : Type u} → m α → n α)
    {α : Type u} (x : OptionT m α) : n α :=
  do (← f x.run).getM

structure NatEquiv (m : Type u → Type v) (n : Type u → Type w) where
  toFun : {α : Type u} → m α → n α
  invFun : {α : Type u} → n α → m α
  left_inv : ∀ {α}, Function.LeftInverse (@invFun α) (@toFun α) := by admit /- proof elided -/

def toNatHom (e : NatEquiv m n) : NatHom m n where
  toFun := e.toFun

def invNatHom (e : NatEquiv m n) : NatHom n m where
  toFun := e.invFun

instance : Coe (NatEquiv m n) (NatHom m n) where
  coe f := f.toNatHom

instance : Coe (NatEquiv m n) (NatHom n m) where
  coe f := f.invNatHom

def refl (m : Type u → Type v) : NatEquiv m m where
  toFun := id
  invFun := id
  left_inv := by admit /- proof elided -/

def symm (e : NatEquiv m n) : NatEquiv n m where
  toFun := e.invFun
  invFun := e.toFun
  left_inv := e.right_inv
  right_inv := e.left_inv

def trans (e₁ : NatEquiv m n) (e₂ : NatEquiv n p) : NatEquiv m p where
  toFun := e₂.toFun ∘ e₁.toFun
  invFun := e₁.invFun ∘ e₂.invFun
  left_inv := by admit /- proof elided -/

structure PureEquiv (m : Type u → Type v) [Pure m] (n : Type u → Type w) [Pure n]
    extends NatEquiv m n where
  map_pure' {α : Type u} (x : α) : toFun (pure x) = (pure x : n α)

instance : Coe (PureEquiv m n) (NatEquiv m n) where
  coe f := f.toNatEquiv

instance : Coe (PureEquiv m n) (PureHom m n) where
  coe f := ⟨f.toNatEquiv, f.map_pure'⟩

instance : Coe (PureEquiv m n) (PureHom n m) where
  coe f := ⟨f.toNatEquiv, f.map_pure_inv⟩

structure BindEquiv (m : Type u → Type v) [Bind m] (n : Type u → Type w) [Bind n]
    extends NatEquiv m n where
  map_bind' {α β : Type u} (x : m α) (y : α → m β) :
    toFun (x >>= y) = toFun x >>= (fun a => toFun (y a))

instance : Coe (BindEquiv m n) (NatEquiv m n) where
  coe f := f.toNatEquiv

instance : Coe (BindEquiv m n) (BindHom m n) where
  coe f := ⟨f.toNatEquiv, f.map_bind'⟩

instance : Coe (BindEquiv m n) (BindHom n m) where
  coe f := ⟨f.toNatEquiv, f.map_bind_inv⟩

structure MonadEquiv (m : Type u → Type v) [Pure m] [Bind m] (n : Type u → Type w) [Pure n] [Bind n]
    extends NatEquiv m n, PureEquiv m n, BindEquiv m n

instance : Coe (MonadEquiv m n) (NatEquiv m n) where
  coe f := f.toNatEquiv

instance : Coe (MonadEquiv m n) (MonadHom m n) where
  coe f := ⟨f.toNatHom, f.map_pure, f.map_bind⟩

instance : Coe (MonadEquiv m n) (MonadHom n m) where
  coe f := ⟨f.invNatHom, f.map_pure_inv, f.map_bind_inv⟩

private def lawLargeNumsTest (trials : ℕ) (die : ℕ) : IO Unit := do
  let n : ℕ := trials * die
  let xs ← OracleComp.replicateTR n $[0..die - 1]
  IO.println ("Rolling " ++ toString n ++ " " ++ toString die ++ "-sided dice:")
  for i in List.range die do
    IO.println <| "▸Num " ++ toString (i + 1) ++ "s: " ++ toString (xs.count i)

def main : IO Unit := do
  IO.println <| "Thanks for running me!"
  IO.println <| "Running an external addition of `1 + 1`:"
  IO.println <| myAdd 1 1
  IO.println <| "
  let trials : ℕ ← (100 + ·) <$> $[0..100]
  let die : ℕ ← (4 + ·) <$> $[0..4]
  lawLargeNumsTest trials die

@[simps!] def elgamalAsymmEnc (G P : Type) [SelectableType G] [SelectableType P]
    [AddGroup G] [Group P] [AddTorsor G P] : AsymmEncAlg ProbComp
    (M := P) (PK := P × P) (SK := G) (C := P × P) where
  keygen := do
    let x₀ ←$ᵗ P; let sk ←$ᵗ G
    return ((x₀, sk +ᵥ x₀), sk)
  encrypt := fun (x₀, pk) msg => do
    let g ←$ᵗ G
    return (g +ᵥ x₀, msg * (g +ᵥ pk))
  decrypt := fun sk (c₁, c₂) => do
    return c₂ / (sk +ᵥ c₁)
  __ := ExecutionMethod.default

def IND_CPA_parallelTesting_reduction
    (adversary : (elgamalAsymmEnc G P).IND_CPA_adversary) :
    parallelTestingAdversary G P := fun x x₁ x₂ x₃ => do
  let so : QueryImpl (P × P →ₒ P × P) ProbComp := ⟨fun (query () (m₁, _m₂)) =>
    return (x₂, m₁ * x₃)⟩
  simulateQ (idOracle ++ₛₒ so) (adversary (x, x₁))

structure ExecutionMethod (m : Type u → Type v) where
    exec {α : Type u} : m α → ProbComp α
    lift_probComp {α : Type u} : ProbComp α → m α
    exec_lift_probComp {α : Type u} (px : ProbComp α) :
      exec (lift_probComp px) = px

@[simp] protected def default : ExecutionMethod ProbComp where
  exec := id
  lift_probComp := id
  exec_lift_probComp _ := rfl

def LWE_Distr : ProbComp (Matrix (Fin n) (Fin m) (Fin p) × Vector (Fin p) m) := do
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let s ←$ᵗ Vector (Fin p) n
  
  let e ← (Vector.range m).mapM (fun _ ↦ errSamp)
  let u := A.vecMul s.get + e.get
  return (A, Vector.ofFn u)

def LWE_Uniform_Distr : ProbComp (Matrix (Fin n) (Fin m) (Fin p) × Vector (Fin p) m) := do
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let u ←$ᵗ Vector (Fin p) m
  return (A, u)

def LWE_Adversary := Matrix (Fin n) (Fin m) (Fin p) × Vector (Fin p) m → ProbComp Bool

def LWE_Experiment (adv : LWE_Adversary n m p) : ProbComp Bool := do
  let b ←$ᵗ Bool
  let distr ← if b then LWE_Distr n m p errSamp else LWE_Uniform_Distr n m p
  let b' ← adv distr
  return b' = b

noncomputable def LWE_Advantage (adv : LWE_Adversary n m p) : ℝ :=
  (LWE_Experiment n m p errSamp adv).advantage'

def LWE_Game_0 (adv : LWE_Adversary n m p) : ProbComp Bool := do
  let distr ← LWE_Distr n m p errSamp
  let b ← adv distr
  return b

def LWE_Game_1 (adv : LWE_Adversary n m p) : ProbComp Bool := do
  let distr ← LWE_Uniform_Distr n m p
  let b ← adv distr
  return b

def LWE_Search_Adversary :=
  Matrix (Fin n) (Fin m) (Fin p) × Vector (Fin p) m → ProbComp (Vector (Fin p) n)

def LWE_Search_Experiment (adv : LWE_Search_Adversary n m p) : ProbComp Bool := do
  let A ←$ᵗ Matrix (Fin n) (Fin m) (Fin p)
  let s ←$ᵗ Vector (Fin p) n
  
  let e ← (Vector.range m).mapM (fun _ ↦ errSamp)
  let u := A.vecMul s.get + e.get
  let s' ← adv (A, Vector.ofFn u)
  return s' = s

noncomputable def LWE_Search_Advantage (adv : LWE_Search_Adversary n m p) : ℝ :=
  (LWE_Search_Experiment n m p errSamp adv).advantage'

class MonadAlgebra (m : Type u → Type v) where
  monadAlg {α : Type u} : m α → α

class LawfulMonadAlgebra (m : Type u → Type v) [Monad m] [MonadAlgebra m] where
  monadAlg_pure {α : Type u} (a : α) : monadAlg (pure a : m α) = a
  monadAlg_bind {α β : Type u} (ma : m α) (mb : α → m β) :
    monadAlg (mb (monadAlg ma)) = monadAlg (ma >>= mb)

class IsCoupling (c : PMF (α × β)) (p : PMF α) (q : PMF β) where
  map_fst : c.map Prod.fst = p
  map_snd : c.map Prod.snd = q

def Coupling (p : PMF α) (q : PMF β) :=
  { c : PMF (α × β) // IsCoupling c p q }

abbrev SPMF : Type u → Type u := OptionT PMF

instance : FunLike (SPMF α) (Option α) ENNReal :=
  inferInstanceAs (FunLike (PMF (Option α)) (Option α) ENNReal)

@[ext]
class IsCoupling (c : SPMF (α × β)) (p : SPMF α) (q : SPMF β) : Prop where
  map_fst : Prod.fst <$> c = p
  map_snd : Prod.snd <$> c = q

def Coupling (p : SPMF α) (q : SPMF β) :=
  { c : SPMF (α × β) // IsCoupling c p q }

-- Interaction between `Coupling` and `pure` / `bind`

example (f g : α → β) (h : f = g) : ∀ x, f x = g x :=

structure FinRatPMF (α : Type u) : Type u where
  toList : List (α × ℚ≥0)
  sum_eq_one : (toList.map Prod.snd).sum = 1

def support [DecidableEq α] (p : FinRatPMF α) : Finset α := p.toList.map Prod.fst |>.toFinset

def pure (a : α) : FinRatPMF α := ⟨[(a, 1)], by admit /- proof elided -/
⟩

def bind (f : FinRatPMF α) (g : α → FinRatPMF β) : FinRatPMF β :=
  ⟨f.toList >>= (fun a => (g a.1).toList), by admit /- proof elided -/
    ⟩

instance : Monad FinRatPMF where
  pure := pure
  bind := bind

def toPMF [DecidableEq α] (p : FinRatPMF α) : PMF α :=
  ⟨fun x => (p.toList.filter (fun a => a.1 = x)).map Prod.snd |>.sum, by admit /- proof elided -/
    ⟩

protected def runIO {α : Type} (oa : ProbComp α) : IO α :=
  oa.mapM (fail := throw (IO.userError "Computation failed during execution"))
    
    (query_map := λ ⟨i, _⟩ ↦ (Fin.ofNat (i + 1)) <$> IO.rand 0 i) 

instance : MonadLift ProbComp IO where
  monadLift := OracleComp.runIO

def test : IO (ℕ × ℕ) := do
  let x ← IO.rand 0 1618
  let y ← IO.rand 0 3141
  let z := x + y
  IO.println z
  return (x, y)

class LawfulMonadStateOf (σ : outParam (Type u)) (m : Type u → Type v) [Monad m] [MonadStateOf σ m]
    : Prop where

   
  modifyGet_eq : {α : Type u} → (f : σ → α × σ) →
    MonadStateOf.modifyGet (m := m) f = do let (a, s) := f (← MonadStateOf.get); set s; pure a

   
  get_get : (MonadStateOf.get : m σ) *> (MonadStateOf.get : m σ) = MonadStateOf.get

  
  
  

   
  set_set : {s₁ s₂ : σ} → (do set s₁; set s₂) = set (m := m) s₂

   
  get_set : {s : σ} → (do set (m := m) s; MonadStateOf.get) = do set s; pure s

   
  set_get : (do let s ← MonadStateOf.get (m := m); set (σ := σ) s) = pure ⟨⟩

class LawfulMonadState (σ : outParam (Type u)) (m : Type u → Type v) [Monad m] :
    Type (max (u+1) v) extends MonadState σ m where

   
  modifyGet_eq : {α : Type u} → (f : σ → α × σ) →
    modifyGet f = do let (a, s) := f (← get); set s; pure a

   
  get_get : get *> get = get

   
  set_set : {s₁ s₂ : σ} → (do set s₁; set s₂) = set s₂

   
  get_set : {s : σ} → (do set s; get) = (do set s; pure s)

   
  set_get : (do let s ← get; set s) = pure ⟨⟩

instance {σ : Type u} {m : Type u → Type v} [Monad m] [LawfulMonad m] [MonadStateOf σ m]
    [LawfulMonadStateOf σ m] : LawfulMonadState σ m where
  modifyGet_eq f := LawfulMonadStateOf.modifyGet_eq f
  get_get := LawfulMonadStateOf.get_get
  set_set := LawfulMonadStateOf.set_set
  get_set := LawfulMonadStateOf.get_set
  set_get := LawfulMonadStateOf.set_get

instance : LawfulMonadStateOf σ (StateT σ m) where
  modifyGet_eq f := by admit /- proof elided -/

instance : LawfulMonadState σ (StateT σ m) := inferInstance

def PreCondition (σ : Type*) := σ → Prop

abbrev PreCondition.top (σ : Type*) : PreCondition σ := fun _ => True

instance {σ : Type*} : PartialOrder (PreCondition σ) where
  le P₁ P₂ := ∀ s, P₂ s → P₁ s
  le_refl P := by admit /- proof elided -/

def PostCondition (σ α : Type*) := σ → α → σ → Prop

instance {σ α : Type*} : PartialOrder (PostCondition σ α) where
  le Q₁ Q₂ := ∀ s a s', Q₂ s a s' → Q₁ s a s'
  le_refl Q := by admit /- proof elided -/

def HoareState (P : PreCondition σ) (α : Type*) (Q : PostCondition σ α) :=
  ∀ s : {s : σ // P s}, {result : α × σ // Q s result.1 result.2}

def pure (x : α) : HoareState (PreCondition.top σ) α (fun s a s' => s = s' ∧ a = x)
  | ⟨s, h⟩ => ⟨(x, s), by admit /- proof elided -/
  ⟩

def bind {P₁ : PreCondition σ} {Q₁ : PostCondition σ α}
    {P₂ : α → PreCondition σ} {Q₂ : α → PostCondition σ β}
    (m : HoareState P₁ α Q₁) (f : ∀ x, HoareState (P₂ x) β (Q₂ x)) :
      HoareState (fun s₁ => P₁ s₁ ∧ ∀ x s₂, Q₁ s₁ x s₂ → P₂ x s₂) β
        (fun s₁ y s₃ => ∃ x s₂, Q₁ s₁ x s₂ ∧ Q₂ x s₂ y s₃)
  | ⟨s₁, h₁⟩ => match m ⟨s₁, h₁.left⟩ with
    | ⟨(x, s₂), h₂⟩ =>
      let ⟨⟨y, s₃⟩, h₃⟩ := f x ⟨s₂, h₁.right x s₂ h₂⟩
      ⟨⟨y, s₃⟩, ⟨x, s₂, h₂, h₃⟩⟩

def get : HoareState (PreCondition.top σ) σ (fun s x s' => s = s' ∧ x = s)
  | ⟨s, h⟩ => ⟨(s, s), by admit /- proof elided -/
  ⟩

def set (s : σ) : HoareState (PreCondition.top σ) PUnit (fun _ _ s' => s = s')
  | ⟨_, _⟩ => ⟨(PUnit.unit, s), rfl⟩

def HoareTriple {σ α : Type _} (P : PreCondition σ) (comp : StateM σ α) (Q : PostCondition σ α) :
    Prop :=
  ∀ s : σ, P s → Q s (comp s).1 (comp s).2

class WeakestPrecondition (comp : StateM σ α) (Q : PostCondition σ α) where
  P : PreCondition σ
  hP : HoareTriple P comp Q
  hWeak : ∀ P', HoareTriple P' comp Q → P ≤ P'

class StrongestPostcondition (P : PreCondition σ) (comp : StateM σ α) where
  Q : PostCondition σ α
  hQ : HoareTriple P comp Q
  hStrong : ∀ Q', HoareTriple P comp Q' → Q' ≤ Q

instance {comp : StateM σ α} {Q : PostCondition σ α} :
    Subsingleton (WeakestPrecondition comp Q) :=

instance {P : PreCondition σ} {comp : StateM σ α} :
    Subsingleton (StrongestPostcondition P comp) :=

instance {Q : PostCondition σ α} {x : α} :
    Inhabited (WeakestPrecondition (pure x : StateM σ α) Q) where
  default := ⟨fun s => Q s x s, HoareTriple.pure_rule_backward x, fun _ hP' => hP'⟩

instance {Q : PostCondition σ σ} {x : σ} : WeakestPrecondition (pure x : StateM σ σ) Q := default

instance {P : PreCondition σ} {x : α} :
    Inhabited (StrongestPostcondition P (pure x : StateM σ α)) where
  default := ⟨fun s a s' => s = s' ∧ a = x ∧ P s, HoareTriple.pure_rule_forward x,
    fun y hP hy => by admit /- proof elided -/
    ⟩

instance {P : PreCondition σ} {x : α} : StrongestPostcondition P (pure x : StateM σ α) := default

instance {Q : PostCondition σ σ} : Inhabited (WeakestPrecondition (get : StateM σ σ) Q) where
  default := ⟨fun s => Q s s s, HoareTriple.get_rule_backward Q, fun _ hP' => hP'⟩

instance {Q : PostCondition σ σ} : WeakestPrecondition (get : StateM σ σ) Q := default

instance {P : PreCondition σ} {s' : σ} :
    Inhabited (StrongestPostcondition P (set s' : StateM σ Unit)) where
  default := ⟨fun s _ s'' => P s ∧ s'' = s', HoareTriple.set_rule_forward P s',
    fun Q' hQ' _ => by admit /- proof elided -/
    ⟩

instance {P : PreCondition σ} {s' : σ} :
  StrongestPostcondition P (set s' : StateM σ Unit) := default

inductive Tree' (a : Type*) where
  | leaf : a → Tree' a
  | node : Tree' a → Tree' a → Tree' a

def relabel (t : Tree' α) (n : ℕ) : Tree' ℕ × ℕ := match t with
  | .leaf _ => (.leaf n, n + 1)
  | .node l r =>
    let (l', n') := relabel l n
    let (r', n'') := relabel r n'
    (.node l' r', n'')

def relabelM : (t : Tree' α) → StateM ℕ (Tree' ℕ)
  | .leaf _ => do
    let n ← get
    set (n + 1)
    return .leaf n
  | .node l r => do
    let l' ← relabelM l
    let r' ← relabelM r
    return .node l' r'

def flatten : (t : Tree' α) → List α
  | .leaf a => [a]
  | .node l r => flatten l ++ flatten r

def size : Tree' α → ℕ
  | .leaf _ => 1
  | .node l r => size l + size r

def Nat.seq : ℕ → ℕ → List ℕ
  | _, 0 => []
  | n, m + 1 => n :: Nat.seq (n + 1) m

instance (n : ℕ) : Fintype (BitVec n) :=

instance (α : Type) [Inhabited α] : Inhabited {f : α → α // f.Bijective} :=
  ⟨id, Function.bijective_id⟩

def cases {α} {motive : {n : ℕ} → Vector α n → Sort*} (v_empty : motive #v[])
  (v_insert : {n : ℕ} → (hd : α) → (tl : Vector α n) → motive (tl.insertIdx 0 hd)) {m : ℕ} :
    (v : Vector α m) → motive v := match hm : m with
  | 0 => fun v => match v with | ⟨⟨[]⟩, rfl⟩ => v_empty
  | n + 1 => fun v => match hv : v with
    | ⟨⟨hd :: tl⟩, hSize⟩ => by admit /- proof elided -/

@[elab_as_elim]
def induction {α} {motive : {n : ℕ} → Vector α n → Sort*} (v_empty : motive #v[])
  (v_insert : {n : ℕ} → (hd : α) → (tl : Vector α n) → motive tl → motive (tl.insertIdx 0 hd))
    {m : ℕ} : (v : Vector α m) → motive v :=

def cases₂ {α β} {motive : {n : ℕ} → Vector α n → Vector β n → Sort*}
  (v_empty : motive #v[] #v[])
  (v_insert : {n : ℕ} → (hd : α) → (tl : Vector α n) → (hd' : β) → (tl' : Vector β n) →
    motive (tl.insertIdx 0 hd) (tl'.insertIdx 0 hd')) {m : ℕ} :
    (v : Vector α m) → (v' : Vector β m) → motive v v' := match hm : m with
  | 0 => fun v v' => match v, v' with | ⟨⟨[]⟩, rfl⟩, ⟨⟨[]⟩, rfl⟩ => v_empty
  | n + 1 => fun v v' => match hv : v, hv' : v' with
    | ⟨⟨hd :: tl⟩, hSize⟩, ⟨⟨hd' :: tl'⟩, hSize'⟩ => by admit /- proof elided -/

@[elab_as_elim]
def induction₂ {α β} {motive : {n : ℕ} → Vector α n → Vector β n → Sort*}
  (v_empty : motive #v[] #v[])
  (v_insert : {n : ℕ} → (hd : α) → (tl : Vector α n) → (hd' : β) → (tl' : Vector β n) →
    motive tl tl' → motive (tl.insertIdx 0 hd) (tl'.insertIdx 0 hd')) {m : ℕ} :
    (v : Vector α m) → (v' : Vector β m) → motive v v' :=

instance {α : Type} {n : ℕ} [Add α] : Add (Vector α n) where
  add v1 v2 := Vector.ofFn (v1.get + v2.get)

instance {α : Type} {n : ℕ} [Zero α] : Zero (Vector α n) where
  zero := Vector.ofFn (0)

protected def id (P : PFunctor.{uA, uB}) : Chart P P := id ⇉ fun _ => id

def comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (c' : Chart Q R) (c : Chart P Q) : Chart P R where
  toFunA := c'.toFunA ∘ c.toFunA
  toFunB := fun i => c'.toFunB (c.toFunA i) ∘ c.toFunB i

@[ext]
protected structure Equiv (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) where
  toChart : Chart P Q
  invChart : Chart Q P
  left_inv : comp invChart toChart = Chart.id P
  right_inv : comp toChart invChart = Chart.id Q

@[refl]
def refl (P : PFunctor.{uA, uB}) : P ≃c P :=
  ⟨Chart.id P, Chart.id P, rfl, rfl⟩

@[symm]
def symm {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃c Q) : Q ≃c P :=
  ⟨e.invChart, e.toChart, e.right_inv, e.left_inv⟩

def trans {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (e₁ : P ≃c Q) (e₂ : Q ≃c R) : P ≃c R :=
  ⟨e₂.toChart ∘c e₁.toChart, e₁.invChart ∘c e₂.invChart,
    by admit /- proof elided -/
      ⟩

def initial {P : PFunctor.{uA, uB}} : Chart 0 P :=
  PEmpty.elim ⇉ fun _ => PEmpty.elim

def terminal {P : PFunctor.{uA, uB}} : Chart P X :=
  (fun _ => PUnit.unit) ⇉ (fun _ _ => PUnit.unit)

alias fromZero := initial
alias toOne := terminal

def toChart (e : P ≃ₚ Q) : Chart P Q where
  toFunA := e.equivA
  toFunB := fun a => e.equivB a

instance : Zero PFunctor.{uA, uB} where
  zero := ⟨PEmpty, fun _ => PEmpty⟩

instance : One PFunctor.{uA, uB} where
  one := ⟨PUnit, fun _ => PEmpty⟩

def monomial (A : Type uA) (B : Type uB) : PFunctor.{uA, uB} :=
  ⟨A, fun _ => B⟩

@[inherit_doc] scoped[PFunctor] infixr:80 " X^ " => monomial

def C (A : Type uA) : PFunctor.{uA, uB} :=
  A X^ PEmpty

def X : PFunctor.{uA, uB} :=
  PUnit X^ PUnit

def linear (A : Type uA) : PFunctor.{uA, uB} :=
  A X^ PUnit

def selfMonomial (S : Type uA) : PFunctor.{uA, uA} :=
  S X^ S

def purePower (B : Type uB) : PFunctor.{uA, uB} :=
  PUnit X^ B

instance : IsEmpty (A 0) := inferInstanceAs (IsEmpty PEmpty)

instance : Unique (A 1) := inferInstanceAs (Unique PUnit)

instance {a} : IsEmpty (B 1 a) := inferInstanceAs (IsEmpty PEmpty)

instance {α} (a : α) : IsEmpty (B (C α) a) := inferInstanceAs (IsEmpty PEmpty)

instance : Unique (A X) := inferInstanceAs (Unique PUnit)

instance {a} : Unique (B X a) := inferInstanceAs (Unique PUnit)

instance {α} (a : α) : Unique (B (linear α) a) := inferInstanceAs (Unique PUnit)

instance {β} : Unique (A (purePower β)) := inferInstanceAs (Unique PUnit)

def sum (P : PFunctor.{uA₁, uB}) (Q : PFunctor.{uA₂, uB}) :
    PFunctor.{max uA₁ uA₂, uB} :=
  ⟨P.A ⊕ Q.A, Sum.elim P.B Q.B⟩

instance : HAdd PFunctor.{uA₁, uB} PFunctor.{uA₂, uB} PFunctor.{max uA₁ uA₂, uB} where
  hAdd := sum

instance : Add PFunctor.{uA, uB} where
  add := sum

alias coprod := sum

def sigma {I : Type v} (F : I → PFunctor.{uA, uB}) : PFunctor.{max uA v, uB} :=
  ⟨Σ i, (F i).A, fun ⟨i, a⟩ => (F i).B a⟩

def prod (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) :
    PFunctor.{max uA₁ uA₂, max uB₁ uB₂} :=
  ⟨P.A × Q.A, fun ab => P.B ab.1 ⊕ Q.B ab.2⟩

instance : HMul PFunctor.{uA₁, uB₁} PFunctor.{uA₂, uB₂} PFunctor.{max uA₁ uA₂, max uB₁ uB₂} where
  hMul := prod

instance : Mul PFunctor.{uA, uB} where
  mul := prod

def pi {I : Type v} (F : I → PFunctor.{uA, uB}) : PFunctor.{max uA v, max uB v} :=
  ⟨(i : I) → (F i).A, fun f => Σ i, (F i).B (f i)⟩

def tensor (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) :
    PFunctor.{max uA₁ uA₂, max uB₁ uB₂} :=
  ⟨P.A × Q.A, fun ab => P.B ab.1 × Q.B ab.2⟩

@[simp]
def compNth (P : PFunctor.{uA, uB}) : Nat → PFunctor.{max uA uB, uB}
  | 0 => X
  | Nat.succ n => P ◃ compNth P n

instance : NatPow PFunctor.{max uA uB, uB} where
  pow := compNth

protected def ulift (P : PFunctor.{uA, uB}) : PFunctor.{max uA vA, max uB vB} :=
  ⟨ULift P.A, fun a => ULift (P.B (ULift.down a))⟩

def exp (P Q : PFunctor.{uA, uB}) : PFunctor.{max uA uB, max uA uB} :=
  pi (fun a => P ◃ (X + C (Q.B a)))

instance : HPow PFunctor.{uA, uB} PFunctor.{uA, uB} PFunctor.{max uA uB, max uA uB} where
  hPow := exp

protected class Fintype (P : PFunctor.{uA, uB}) where
  fintype_B : ∀ a, Fintype (P.B a)

instance {P : PFunctor.{uA, uB}} [inst : P.Fintype] : PFunctor.Fintype (PFunctor.ulift P) where
  fintype_B := fun a => by admit /- proof elided -/

@[simp]
instance {P : PFunctor.{uA, uB}} [inst : P.Fintype] : ∀ a, Fintype (P.B a) :=
  fun a => inst.fintype_B a

@[ext]
protected structure Equiv (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) where
   
  equivA : P.A ≃ Q.A
   
  equivB : ∀ a, P.B a ≃ Q.B (equivA a)

@[inherit_doc] scoped[PFunctor] infixl:25 " ≃ₚ " => PFunctor.Equiv

def refl (P : PFunctor.{uA, uB}) : P ≃ₚ P where
  equivA := _root_.Equiv.refl P.A
  equivB := fun a => _root_.Equiv.refl (P.B a)

def symm {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (E : P ≃ₚ Q) : Q ≃ₚ P where
  equivA := E.equivA.symm
  equivB := fun a =>
    (Equiv.cast (congrArg Q.B ((Equiv.symm_apply_eq E.equivA).mp rfl))).trans
      (E.equivB (E.equivA.symm a)).symm

def trans {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (E : P ≃ₚ Q) (F : Q ≃ₚ R) : P ≃ₚ R where
  equivA := E.equivA.trans F.equivA
  equivB := fun a => (E.equivB a).trans (F.equivB (E.equivA a))

def cast {P Q : PFunctor.{uA, uB}} (hA : P.A = Q.A) (hB : ∀ a, P.B a = Q.B (cast hA a)) :
    P ≃ₚ Q where
  equivA := _root_.Equiv.cast hA
  equivB := fun a => _root_.Equiv.cast (hB a)

structure Lens (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) where
  toFunA : P.A → Q.A
  toFunB : ∀ a, Q.B (toFunA a) → P.B a

structure Chart (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) where
  toFunA : P.A → Q.A
  toFunB : ∀ a, P.B a → Q.B (toFunA a)

local instance instPreorderId {r} [h : Preorder r] : Preorder (id r) := h

def MonoCont (r : Type v) [Preorder r] : Type u → Type max u v
  | α => {m : Cont r α // ∀ p p' : α → r, (∀ a, p a ≤ p' a) → m p ≤ m p'}

instance {r} [h : Preorder r] : Monad (MonoCont r) where
  pure := fun a => ⟨pure a, fun p p' h => by admit /- proof elided -/
  ⟩
  bind := fun a f => ⟨a.1 >>= (fun a => (f a).1), fun p p' h => by admit /- proof elided -/
    ⟩

instance {r} [h : Preorder r] : LawfulMonad (MonoCont r) := LawfulMonad.mk' (MonoCont r)
  (id_map := fun x => rfl)
  (pure_bind := fun x f => rfl)
  (bind_assoc := fun x f g => rfl)
  (bind_pure_comp := fun x f => rfl)

instance {r α} [h : Preorder r] : Preorder (MonoCont r α) where
  le := fun x y => ∀ p p', (∀ a, p a ≤ p' a) → x.1 p ≤ y.1 p'
  le_refl := fun x => by admit /- proof elided -/

instance {r} [h : Preorder r] : OrderedMonad (MonoCont r) where
  monadOrder := inferInstance
  bind_mono := fun _ _ => by admit /- proof elided -/

local instance instPreorderProp : Preorder Prop where
  le := fun p q => p → q
  le_refl := fun p => id
  le_trans := fun p q r h1 h2 => h2 ∘ h1

def MonoContProp : Type u → Type u := @MonoCont Prop instPreorderProp

instance : Monad MonoContProp := inferInstanceAs (Monad (MonoCont Prop))

instance : LawfulMonad MonoContProp := inferInstanceAs (LawfulMonad (MonoCont Prop))

instance : OrderedMonad MonoContProp := inferInstanceAs (OrderedMonad (MonoCont Prop))

def MonoStateContProp (σ : Type u) := MonoCont (σ → Prop)

example {σ} : StateT σ (MonoContProp) = fun α => σ → MonoContProp (α × σ) := rfl

def effectObserve (m : Type u → Type v) (α : Type u) := m α → (m α → Prop) → Prop

structure forkInput (spec : OracleSpec ι) (α : Type) where
   
  main : OracleComp spec α
   
  queryBound : ι → ℕ
   
  js : List ι

def fork (main : OracleComp spec α)
    (qb : ι → ℕ) (js : List ι) (i : ι)
    (cf : α → Option (Fin (qb i + 1))) :
    OracleComp spec (α × α) := do
  let seed ← generateSeed spec qb js
  let x₁ ← (simulateQ seededOracle main).run seed
  let s : Fin (qb i + 1) ← (cf x₁).getM
  let u ←$ᵗ spec.range i 
  guard ((seed i)[s + 1]? ≠ some u) 
  let seed' := (seed.takeAtIndex i s).addValue i u
  let x₂ ← (simulateQ seededOracle main).run seed'
  guard (cf x₂ = some s) 
  return (x₁, x₂)

def activeOracles [spec.FiniteRange] [DecidableEq ι] (oa : OracleComp spec α) : Finset ι :=

structure SignatureAlg (m : Type → Type v) (M PK SK S : Type)
    extends ExecutionMethod m where
  keygen : m (PK × SK)
  sign (pk : PK) (sk : SK) (msg : M) : m S
  verify (pk : PK) (msg : M) (σ : S) : m Bool

def signingOracle (sigAlg : SignatureAlg m M PK SK S) (pk : PK) (sk : SK) :
    QueryImpl (M →ₒ S) (WriterT (QueryLog (M →ₒ S)) m) :=
  QueryImpl.withLogging ⟨fun | query () msg => sigAlg.sign pk sk msg⟩

def PerfectlyComplete (sigAlg : SignatureAlg m M PK SK S) : Prop :=
  ∀ msg : M, [= true | sigAlg.exec do
    let (pk, sk) ← sigAlg.keygen
    let sig ← sigAlg.sign pk sk msg
    sigAlg.verify pk msg sig] = 1

structure unforgeableAdv (_sigAlg : SignatureAlg (OracleComp spec) M PK SK S) where
  main (pk : PK) : OracleComp (spec ++ₒ (M →ₒ S)) (M × S)

def unforgeableExp {sigAlg : SignatureAlg (OracleComp spec) M PK SK S}
    (adv : unforgeableAdv sigAlg) : ProbComp Bool :=
  sigAlg.exec do
    let (pk, sk) ← sigAlg.keygen
    
    let sim_adv : WriterT (QueryLog (M →ₒ S)) (OracleComp spec) (M × S) :=
      simulateQ (idOracle ++ₛₒ sigAlg.signingOracle pk sk) (adv.main pk)
    
    let ((m, σ), log) ← sim_adv.run
    return !(log.wasQueried () m) && (← sigAlg.verify pk m σ)

noncomputable def unforgeableAdv.advantage
    {sigAlg : SignatureAlg (OracleComp spec) M PK SK S}
    (adv : unforgeableAdv sigAlg) : ℝ≥0∞ := [= true | unforgeableExp adv]

noncomputable def ProbComp.advantage' (p : ProbComp Bool) : ℝ :=
  |([= true | p]).toReal - ([= false | p]).toReal|

noncomputable def ProbComp.advantage₂' (p q : ProbComp Bool) : ℝ :=
  |([= true | p]).toReal - ([= true | q]).toReal|

noncomputable def ProbComp.advantage (p : ProbComp Unit) : ℝ := |1 / 2 - ([= () | p]).toReal|

noncomputable def ProbComp.advantage₂ (p q : ProbComp Unit) : ℝ :=
  |([= () | p]).toReal - ([= () | q]).toReal|

structure SecAdv {ι : Type u} [DecidableEq ι]
    (spec : OracleSpec ι) (α β : Type u) where
  run : α → OracleComp spec β
  qb : ι → ℕ
  qb_isQueryBound (x : α) : IsQueryBound (run x) (qb)
  activeOracles : List ι
  mem_activeOracles_iff (i : ι) : i ∈ activeOracles ↔ qb i ≠ 0

class LawfulMonadControl (m : semiOutParam (Type u → Type v)) (n : Type u → Type w)
    [Monad m] [Monad n] [MonadControl m n] : Prop where

   
  liftWith_pure {α : Type u} (a : α) :
    MonadControl.liftWith (m := m) (n := n) (fun _ => pure a) = pure a

   
  liftWith_bind {α β : Type u} (ma : m α) (f : α → m β) :
    MonadControl.liftWith (fun _ => ma) >>= MonadControl.liftWith ∘ (fun a _ => f a) =
        MonadControl.liftWith (n := n) (fun _ => ma >>= f)

   
  liftWith_restoreM {α : Type u} (t : n α) :
    MonadControl.liftWith (m := m) (fun run => run t) >>= MonadControl.restoreM ∘ pure = t

class LawfulMonadControlT (m : Type u → Type v) (n : Type u → Type w)
    [Monad m] [Monad n] [MonadControlT m n] : Prop where

   
  liftWith_pure {α : Type u} (a : α) :
    liftWith (m := m) (n := n) (fun _ => pure a) = pure a

   
  liftWith_bind {α β : Type u} (ma : m α) (f : α → m β) :
    liftWith (fun _ => ma) >>= liftWith ∘ (fun a _ => f a) = liftWith (n := n) (fun _ => ma >>= f)

   
  liftWith_restoreM {α : Type u} (t : n α) :
    liftWith (m := m) (fun run => run t) >>= restoreM = t

@[always_inline, inline]
protected def orElse {α : Type u} (x₁ : WriterT ω m α)
    (x₂ : Unit → WriterT ω m α) : WriterT ω m α :=
  WriterT.mk (x₁.run <|> (x₂ ()).run)

@[always_inline, inline]
protected def failure {α : Type u} : WriterT ω m α := WriterT.mk failure

instance [Monoid ω] : AlternativeMonad (WriterT ω m) where
  failure := WriterT.failure
  orElse  := WriterT.orElse

instance [Monoid ω] [LawfulMonad m] [LawfulAlternative m] :
    LawfulAlternative (WriterT ω m) := sorry

instance [Monoid ω] [LawfulMonad m] : LawfulMonadLift m (WriterT ω m) where
  monadLift_pure x := map_pure (·, 1) x
  monadLift_bind {α β} x y := by admit /- proof elided -/

structure SymmEncAlg (m : Type u → Type v)
    (M K C : Type u) extends ExecutionMethod m where
  keygen : m K
  encrypt (k : K) (msg : M) : m C
  decrypt (k : K) (c : C) : Option M

class Complete (encAlg : SymmEncAlg m M K C) : Prop where
  decrypt_encrypt_eq_message (msg : M) : [= some msg | encAlg.exec
    do let k ← encAlg.keygen; return encAlg.decrypt k (← encAlg.encrypt k msg)] = 1

def perfectSecrecy (encAlg : SymmEncAlg m M K C) : Prop :=
  ∀ mgen : ProbComp M, ∀ msg : M, ∀ σ : C,
    [= (msg, σ) | encAlg.exec do
      let msg' ← encAlg.lift_probComp mgen
      (msg', ·) <$> encAlg.encrypt (← encAlg.keygen) msg'] =
    [= msg | mgen]

instance instIsEmptySigma {α : Sort u} {β : α → Sort v} [inst : IsEmpty α] :
    IsEmpty ((a : α) ×' β a) where
  false := fun a => inst.elim a.1

@[simps]
def sumZero : P + 0 ≃ₚ P where
  equivA := Equiv.sumEmpty P.A PEmpty
  equivB := (Sum.casesOn · (fun _ => _root_.Equiv.refl _) (fun a => a.elim))

@[simps]
def zeroSum : 0 + P ≃ₚ P where
  equivA := Equiv.emptySum PEmpty P.A
  equivB := (Sum.casesOn · (fun a => a.elim) (fun _ => _root_.Equiv.refl _))

@[simps]
def sumComm : (P + Q : PFunctor.{max uA₁ uA₂, uB}) ≃ₚ (Q + P : PFunctor.{max uA₁ uA₂, uB}) where
  equivA := _root_.Equiv.sumComm P.A Q.A
  equivB := (Sum.casesOn · (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _))

@[simps]
def sumAssoc :
    ((P + Q) + R : PFunctor.{max uA₁ uA₂ uA₃, uB}) ≃ₚ
    (P + (Q + R) : PFunctor.{max uA₁ uA₂ uA₃, uB}) where
  equivA := _root_.Equiv.sumAssoc P.A Q.A R.A
  equivB := (Sum.casesOn ·
    (Sum.casesOn · (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _))
    (fun _ => _root_.Equiv.refl _))

@[simps]
def sumCongr {P Q} {R : PFunctor.{uA₃, uB₁}} {S : PFunctor.{uA₄, uB₁}} (e₁ : P ≃ₚ R) (e₂ : Q ≃ₚ S) :
    P + Q ≃ₚ (R + S : PFunctor.{max uA₃ uA₄, uB₁}) where
  equivA := _root_.Equiv.sumCongr e₁.equivA e₂.equivA
  equivB := (Sum.casesOn · (e₁.equivB ·) (e₂.equivB ·))

def sumSumSumComm :
    ((P + Q) + (R + S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, uB}) ≃ₚ
    ((P + R) + (Q + S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, uB}) where
  equivA := _root_.Equiv.sumSumSumComm P.A Q.A R.A S.A
  equivB := (Sum.casesOn ·
    (Sum.casesOn · (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _))
    (Sum.casesOn · (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _)))

def prodZero : P * 0 ≃ₚ 0 where
  equivA := Equiv.prodPEmpty P.A
  equivB := fun a => a.2.elim

def zeroProd : 0 * P ≃ₚ 0 where
  equivA := Equiv.pemptyProd P.A
  equivB := fun a => a.1.elim

@[simps]
def prodOne : P * 1 ≃ₚ P where
  equivA := _root_.Equiv.prodPUnit P.A
  equivB := fun a => _root_.Equiv.sumEmpty (P.B a.1) PEmpty

@[simps]
def oneProd : 1 * P ≃ₚ P where
  equivA := _root_.Equiv.punitProd P.A
  equivB := fun a => _root_.Equiv.emptySum PEmpty (P.B a.2)

@[simps]
def prodComm :
    (P * Q : PFunctor.{max uA₁ uA₂, max uB₁ uB₂}) ≃ₚ
    (Q * P : PFunctor.{max uA₁ uA₂, max uB₁ uB₂}) where
  equivA := _root_.Equiv.prodComm P.A Q.A
  equivB := fun a => _root_.Equiv.sumComm (P.B a.1) (Q.B a.2)

@[simps]
def prodAssoc :
    ((P * Q) * R : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃}) ≃ₚ
    (P * (Q * R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃}) where
  equivA := _root_.Equiv.prodAssoc P.A Q.A R.A
  equivB := fun a => _root_.Equiv.sumAssoc (P.B a.1.1) (Q.B a.1.2) (R.B a.2)

@[simps]
def prodCongr {P Q} {R : PFunctor.{uA₃, uB₃}} {S : PFunctor.{uA₄, uB₄}}
    (e₁ : P ≃ₚ R) (e₂ : Q ≃ₚ S) : P * Q ≃ₚ (R * S : PFunctor.{max uA₃ uA₄, max uB₃ uB₄}) where
  equivA := _root_.Equiv.prodCongr e₁.equivA e₂.equivA
  equivB := fun a => _root_.Equiv.sumCongr (e₁.equivB a.1) (e₂.equivB a.2)

@[simps]
def prodProdProdComm :
    ((P * Q) * (R * S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, max uB₁ uB₂ uB₃ uB₄}) ≃ₚ
    ((P * R) * (Q * S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, max uB₁ uB₂ uB₃ uB₄}) where
  equivA := _root_.Equiv.prodProdProdComm P.A Q.A R.A S.A
  equivB := fun a => _root_.Equiv.sumSumSumComm (P.B a.1.1) (Q.B a.1.2) (R.B a.2.1) (S.B a.2.2)

def sumProdDistrib (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₁}) (R : PFunctor.{uA₃, uB₂}) :
    ((P + Q) * R : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) ≃ₚ
    ((P * R) + (Q * R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) where
  equivA := _root_.Equiv.sumProdDistrib P.A Q.A R.A
  equivB := fun ⟨a, _⟩ =>
    Sum.casesOn a (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _)

@[simps]
def prodSumDistrib (R : PFunctor.{uA₃, uB₂}):
    (P * (Q + R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) ≃ₚ
    ((P * Q) + (P * R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) where
  equivA := _root_.Equiv.prodSumDistrib P.A Q.A R.A
  equivB := fun ⟨_, a⟩ =>
    Sum.casesOn a (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _)

instance [inst : IsEmpty I] : IsEmpty (sigma F).A where
  false := fun a => inst.elim a.1

def emptySigma [inst : IsEmpty I] : sigma F ≃ₚ 0 where
  equivA := Equiv.equivPEmpty _
  equivB := fun a => inst.elim a.1

def uniqueSigma [Unique I] : sigma F ≃ₚ F default where
  equivA := _root_.Equiv.uniqueSigma _
  equivB := fun a => by admit /- proof elided -/

def punitSigma {F : PUnit → PFunctor.{uA, uB}} : sigma F ≃ₚ F PUnit.unit where
  equivA := _root_.Equiv.uniqueSigma _
  equivB := sorry

def sumSigmaDistrib (F : I → PFunctor.{uA₂, uB₁}) :
    (P + sigma F : PFunctor.{max uA₁ uA₂ v, uB₁}) ≃ₚ
    sigma (fun i => (P + F i : PFunctor.{max uA₁ uA₂, uB₁})) where
  equivA := by admit /- proof elided -/

def sigmaSumDistrib (F : I → PFunctor.{uA₂, uB₁}) :
    (sigma F + P : PFunctor.{max uA₁ uA₂ v, uB₁}) ≃ₚ
    sigma (fun i => (F i + P : PFunctor.{max uA₁ uA₂, uB₁})) where
  equivA := by admit /- proof elided -/

def prodSigmaDistrib : (P * sigma F : PFunctor.{max uA₁ uA₂ v, max uB₁ uB₂}) ≃ₚ
    sigma (fun i => (P * F i : PFunctor.{max uA₁ uA₂, max uB₁ uB₂})) where
  equivA := sorry
  equivB := sorry

def sigmaProdDistrib : (sigma F * P : PFunctor.{max uA₁ uA₂ v, max uB₁ uB₂}) ≃ₚ
    sigma (fun i => (F i * P : PFunctor.{max uA₁ uA₂, max uB₁ uB₂})) where
  equivA := sorry
  equivB := sorry

def tensorSigmaDistrib :
    P ⊗ sigma F ≃ₚ sigma (fun i => P ⊗ F i) where
  equivA := sorry
  equivB := sorry

def sigmaTensorDistrib {I : Type v} (F : I → PFunctor.{uA₁, uB₁}) (P : PFunctor.{uA₂, uB₂}) :
    sigma F ⊗ P ≃ₚ sigma (fun i => F i ⊗ P) where
  equivA := sorry
  equivB := sorry

def sigmaCompDistrib {I : Type v} (F : I → PFunctor.{uA₁, uB₁}) (P : PFunctor.{uA₂, uB₂}) :
    sigma F ◃ P ≃ₚ sigma (fun i => F i ◃ P) where
  equivA := sorry
  equivB := sorry

def piPUnit (P : PFunctor.{uA, uB}) :
    pi (fun (_ : PUnit) => P) ≃ₚ P where
  equivA := sorry
  equivB := sorry

def uliftEquiv : P ≃ₚ (P.ulift : PFunctor.{max uA₁ u, max uB₁ v}) :=
  sorry

def uliftUliftEquiv : P.ulift.ulift ≃ₚ P.ulift :=
  sorry

def uliftSumEquiv (Q : PFunctor.{uA₂, uB₁}) :
    (PFunctor.ulift.{_, _, u, v} (P + Q : PFunctor.{max uA₁ uA₂, uB₁})) ≃ₚ
    ((PFunctor.ulift.{_, _, uA, uB} P : PFunctor.{max uA₁ uA, max uB₁ uB}) +
      (Q.ulift : PFunctor.{max uA₂ uA', max uB₁ uB}) : PFunctor.{max uA₁ uA uA₂ uA', max uB₁ uB}) :=
  sorry

def tensorZero : P ⊗ 0 ≃ₚ 0 where
  equivA := Equiv.prodPEmpty P.A
  equivB := fun a => Equiv.prodPEmpty (P.B a.1)

def zeroTensor : 0 ⊗ P ≃ₚ 0 where
  equivA := Equiv.pemptyProd P.A
  equivB := fun a => Equiv.pemptyProd (P.B a.2)

instance {P} {a : (P ⊗ 1).A} : IsEmpty ((P ⊗ 1).B a) :=

def tensorOne : P ⊗ 1 ≃ₚ C P.A where
  equivA := Equiv.prodPUnit P.A
  equivB := fun _ => Equiv.equivPEmpty _

instance {P} {a : (1 ⊗ P).A} : IsEmpty ((1 ⊗ P).B a) :=

def oneTensor : 1 ⊗ P ≃ₚ C P.A where
  equivA := Equiv.punitProd P.A
  equivB := fun _ => Equiv.equivPEmpty _

@[simps]
def tensorX : P ⊗ X ≃ₚ P where
  equivA := _root_.Equiv.prodPUnit P.A
  equivB := fun a => _root_.Equiv.prodPUnit (P.B a.1)

@[simps]
def xTensor : X ⊗ P ≃ₚ P where
  equivA := _root_.Equiv.punitProd P.A
  equivB := fun a => _root_.Equiv.punitProd (P.B a.2)

@[simps]
def tensorComm :
    (P ⊗ Q : PFunctor.{max uA₁ uA₂, max uB₁ uB₂}) ≃ₚ
    (Q ⊗ P : PFunctor.{max uA₁ uA₂, max uB₁ uB₂}) where
  equivA := _root_.Equiv.prodComm P.A Q.A
  equivB := fun a => _root_.Equiv.prodComm (P.B a.1) (Q.B a.2)

@[simps]
def tensorAssoc :
    ((P ⊗ Q) ⊗ R : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃}) ≃ₚ
    (P ⊗ (Q ⊗ R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃}) where
  equivA := _root_.Equiv.prodAssoc P.A Q.A R.A
  equivB := fun a => _root_.Equiv.prodAssoc (P.B a.1.1) (Q.B a.1.2) (R.B a.2)

@[simps]
def tensorCongr {P : PFunctor.{uA₁, uB₁}} {Q} {R : PFunctor.{uA₃, uB₃}} {S}
    (e₁ : P ≃ₚ R) (e₂ : Q ≃ₚ S) :
      (P ⊗ Q : PFunctor.{max uA₁ uA₂, max uB₁ uB₂}) ≃ₚ
      (R ⊗ S : PFunctor.{max uA₃ uA₄, max uB₃ uB₄}) where
  equivA := _root_.Equiv.prodCongr e₁.equivA e₂.equivA
  equivB := fun a => _root_.Equiv.prodCongr (e₁.equivB a.1) (e₂.equivB a.2)

def tensorTensorTensorComm :
    ((P ⊗ Q) ⊗ (R ⊗ S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, max uB₁ uB₂ uB₃ uB₄}) ≃ₚ
    ((P ⊗ R) ⊗ (Q ⊗ S) : PFunctor.{max uA₁ uA₂ uA₃ uA₄, max uB₁ uB₂ uB₃ uB₄}) where
  equivA := _root_.Equiv.prodProdProdComm P.A Q.A R.A S.A
  equivB := fun a => _root_.Equiv.prodProdProdComm (P.B a.1.1) (Q.B a.1.2) (R.B a.2.1) (S.B a.2.2)

def sumTensorDistrib (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₁}) (R : PFunctor.{uA₃, uB₂}) :
    ((P + Q : PFunctor.{max uA₁ uA₂, uB₁}) ⊗ R) ≃ₚ
    ((P ⊗ R) + (Q ⊗ R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) where
  equivA := _root_.Equiv.sumProdDistrib P.A Q.A R.A
  equivB := fun ⟨a, _⟩ =>
    Sum.casesOn a (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _)

def tensorSumDistrib (R : PFunctor.{uA₃, uB₂}):
    (P ⊗ (Q + R : PFunctor.{max uA₂ uA₃, uB₂})) ≃ₚ
    ((P ⊗ Q) + (P ⊗ R) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) where
  equivA := _root_.Equiv.prodSumDistrib P.A Q.A R.A
  equivB := fun ⟨_, a⟩ =>
    Sum.casesOn a (fun _ => _root_.Equiv.refl _) (fun _ => _root_.Equiv.refl _)

instance : IsEmpty (0 ◃ P).A where
  false := fun a => a.1.elim

def zeroComp : 0 ◃ P ≃ₚ 0 where
  equivA := Equiv.equivPEmpty _
  equivB := fun a => a.1.elim

instance {a : (1 ◃ P).A} : IsEmpty ((1 ◃ P).B a) where
  false := fun a => a.1.elim

def oneComp : (1 : PFunctor.{uA, uB}) ◃ P ≃ₚ 1 where
  equivA := (@_root_.Equiv.uniqueSigma _ (fun i => B 1 i → P.A)
    (instUniqueAOfNat_toMathlib.{uA, uB})).trans (Equiv.pemptyArrowEquivPUnit _)
  equivB := fun _ => Equiv.equivPEmpty _

def compAssoc : (P ◃ Q) ◃ R ≃ₚ P ◃ (Q ◃ R) where
  equivA := {
    toFun := fun ⟨⟨pa, qf⟩, rf⟩ => ⟨pa, fun pb => ⟨qf pb, fun qb => rf ⟨pb, qb⟩⟩⟩
    invFun := fun ⟨pa, g⟩ => ⟨⟨pa, fun pb => (g pb).1⟩, fun ⟨pb, qb⟩ => (g pb).2 qb⟩
    left_inv := by admit /- proof elided -/

def compX : P ◃ X ≃ₚ P where
  equivA := Equiv.sigmaUnique P.A (fun a => P.B a → PUnit.{_ + 1})
  equivB := fun _ => _root_.Equiv.sigmaPUnit _

def XComp : X ◃ P ≃ₚ P where
  equivA := (_root_.Equiv.uniqueSigma _).trans (Equiv.punitArrowEquiv P.A)
  equivB := fun _ => by admit /- proof elided -/

def sumCompDistrib (Q : PFunctor.{uA₂, uB₁}) :
    (P + Q : PFunctor.{max uA₁ uA₂, uB₁}) ◃ R ≃ₚ
    ((P ◃ R) + (Q ◃ R) : PFunctor.{max uA₁ uA₂ uA₃ uB₁, max uB₁ uB₃}) where
  equivA := sorry
  equivB := sorry

structure AsymmEncAlg (m : Type → Type u) (M PK SK C : Type)
    extends ExecutionMethod m where
  keygen : m (PK × SK)
  encrypt : (pk : PK) → (msg : M) →  m C
  decrypt : (sk : SK) → (c : C) → Option M

alias PKE_Alg := AsymmEncAlg

@[reducible, inline]
def CorrectExp (encAlg : AsymmEncAlg m M PK SK C) (msg : M) :
    ProbComp Unit := encAlg.exec do
  let (pk, sk) ← encAlg.keygen
  guard (encAlg.decrypt sk (← encAlg.encrypt pk msg) = msg)

def PerfectlyCorrect (encAlg : AsymmEncAlg m M PK SK C) : Prop :=
  ∀ (msg : M), [⊥ | CorrectExp encAlg msg] = 0

def IND_CPA_oracleSpec (_encAlg : AsymmEncAlg ProbComp M PK SK C) :=
  unifSpec ++ₒ (M × M →ₒ C) 

def IND_CPA_adversary (encAlg : AsymmEncAlg ProbComp M PK SK C) :=
  PK → OracleComp encAlg.IND_CPA_oracleSpec Bool

def IND_CPA_queryImpl' (encAlg : AsymmEncAlg ProbComp M PK SK C)
    (pk : PK) (b : Bool) : QueryImpl encAlg.IND_CPA_oracleSpec
      (StateT (M × M →ₒ C).QueryCache ProbComp) :=
  have so : QueryImpl (M × M →ₒ C) ProbComp := ⟨fun (query () (m₁, m₂)) =>
    encAlg.encrypt pk (if b then m₁ else m₂)⟩
  idOracle ++ₛₒ so.withCaching

def IND_CPA_queryImpl (encAlg : AsymmEncAlg ProbComp M PK SK C)
    (pk : PK) (b : Bool) : QueryImpl encAlg.IND_CPA_oracleSpec
      (StateT (M × M →ₒ C).QueryCache ProbComp) :=
  have so : QueryImpl (M × M →ₒ C) ProbComp := ⟨fun (query () (m₁, m₂)) =>
    encAlg.encrypt pk (if b then m₁ else m₂)⟩
  idOracle ++ₛₒ so

def IND_CPA_experiment {encAlg : AsymmEncAlg ProbComp M PK SK C}
    (adversary : encAlg.IND_CPA_adversary) : ProbComp Unit := do
  let b ← $ᵗ Bool
  let (pk, _sk) ← encAlg.keygen
  let b' ← (simulateQ (encAlg.IND_CPA_queryImpl' pk b) (adversary pk)).run' ∅
  guard (b = b')

noncomputable def IND_CPA_advantage {encAlg : AsymmEncAlg ProbComp M PK SK C}
    (adversary : encAlg.IND_CPA_adversary) : ℝ≥0∞ :=
  [= () | IND_CPA_experiment adversary] - 1 / 2

def decryptionOracle (encAlg : AsymmEncAlg m M PK SK C)
    (sk : SK) : QueryImpl (C →ₒ M) m where
  impl | query () c => Option.getM (encAlg.decrypt sk c)

def IND_CCA_oracleSpec (_encAlg : AsymmEncAlg m M PK SK C) :=
    (C →ₒ Option M) ++ₒ ((M × M) →ₒ C)

def IND_CCA_oracleImpl [DecidableEq C] (encAlg : AsymmEncAlg m M PK SK C)
    (pk : PK) (sk : SK) (b : Bool) : QueryImpl (IND_CCA_oracleSpec encAlg)
      (StateT (Option C) m) where impl
  | query (Sum.inl ()) c => do
      guard ((← get) ≠ some c)
      return encAlg.decrypt sk c
  | query (Sum.inr ()) (m₁, m₂) => do
      guard (← get).isNone
      let c ← encAlg.encrypt pk (if b then m₁ else m₂)
      set (some c)
      return c

structure IND_CCA_Adversary (encAlg : AsymmEncAlg m M PK SK C) where
    main : PK → OracleComp encAlg.IND_CCA_oracleSpec Bool

def IND_CCA_Game (encAlg : AsymmEncAlg m M PK SK C)
    (adversary : encAlg.IND_CCA_Adversary) : ProbComp Unit :=
  encAlg.exec do
    let (pk, sk) ← encAlg.keygen
    let b ← encAlg.lift_probComp ($ᵗ Bool)
    let b' ← (simulateQ (encAlg.IND_CCA_oracleImpl pk sk b) (adversary.main pk)).run' none
    guard (b = b')

structure IND_CPA_Adv (encAlg : AsymmEncAlg m M PK SK C) where
  State : Type
  chooseMessages : PK → m (M × M × State)
  distinguish : State → C → m Bool

def IND_CPA_OneTime_Game : ProbComp Bool :=
  encAlg.exec do
    let b : Bool ← encAlg.lift_probComp ($ᵗ Bool)
    let (pk, _) ← encAlg.keygen
    let (m₁, m₂, state) ← adv.chooseMessages pk
    let m := if b then m₁ else m₂
    let c ← encAlg.encrypt pk m
    let b' ← adv.distinguish state c
    return b = b'

noncomputable def IND_CPA_OneTime_Advantage (encAlg : AsymmEncAlg (OracleComp spec) M PK SK C)
    (adv : IND_CPA_Adv encAlg) : ℝ :=
  (IND_CPA_OneTime_Game (encAlg := encAlg) adv).advantage'

def withLogging (so : QueryImpl spec m) :
    QueryImpl spec (WriterT (QueryLog spec) m) where
  impl | q => do
    let x ← liftM (so.impl q)
    tell (QueryLog.singleton q x)
    return x

def loggingOracle : QueryImpl spec (WriterT (QueryLog spec) (OracleComp spec)) :=
  idOracle.withLogging

instance subSpec_append_left : spec₁ ⊂ₒ (spec₁ ++ₒ spec₂) where
  monadLift | query i t => query (inl i) t

instance subSpec_append_right : spec₂ ⊂ₒ (spec₁ ++ₒ spec₂) where
  monadLift | query i t => query (inr i) t

instance subSpec_left_append_left_append_of_subSpec [h : spec₁ ⊂ₒ spec₃] :
    spec₁ ++ₒ spec₂ ⊂ₒ spec₃ ++ₒ spec₂ where
  monadLift
    | query (inl i) t => liftM (query i t)
    | query (inr i) t => query (inr i) t

instance subSpec_right_append_right_append_of_subSpec [h : spec₂ ⊂ₒ spec₃] :
    spec₁ ++ₒ spec₂ ⊂ₒ spec₁ ++ₒ spec₃ where
  monadLift
    | query (inl i) t => query (inl i) t
    | query (inr i) t => liftM (query i t)

instance subSpec_assoc : spec₁ ++ₒ (spec₂ ++ₒ spec₃) ⊂ₒ spec₁ ++ₒ spec₂ ++ₒ spec₃ where
  monadLift
    | query (inl i) t => query (inl (inl i)) t
    | query (inr (inl i)) t => query (inl (inr i)) t
    | query (inr (inr i)) t => query (inr i) t

def pointwiseRelation {α β : Type u} (r : β → β → Prop) (f g : α → β) : α → α → Prop :=
  fun a b => r (f a) (g b)

def Proper (A : Type u) (R : A → A → Prop) (m : A) : Prop := R m m

class OrderedMonad (m : Type u → Type v) extends Monad m where
  [monadOrder {α : Type u} : Preorder (m α)]
  bind_mono {α β : Type u} {ma ma' : m α} {f f' : α → m β} (ha : ma ≤ ma') (hf : ∀ a, f a ≤ f' a) :
    ma >>= f ≤ ma' >>= f'

instance {m} [OrderedMonad m] {α : Type u} : Preorder (m α) := monadOrder

class Monad.IsOrdered (m : Type u → Type v) [Monad m] where
  [monadOrder {α : Type u} : Preorder (m α)]
  bind_mono {α β : Type u} {ma ma' : m α} {f f' : α → m β} (ha : ma ≤ ma') (hf : ∀ a, f a ≤ f' a) :
    ma >>= f ≤ ma' >>= f'

instance {m} [Monad m] [Monad.IsOrdered m] : OrderedMonad m where
  monadOrder := Monad.IsOrdered.monadOrder
  bind_mono := Monad.IsOrdered.bind_mono

@[reducible] def monadLE {m} [OrderedMonad m] : {α : Type u} → m α → m α → Prop :=
  monadOrder.le

@[reducible] def monadLT {m} [OrderedMonad m] : {α : Type u} → m α → m α → Prop :=
  monadOrder.lt

scoped instance (priority := low) instDiscreteMonad (m) [Monad m] : OrderedMonad m where
  monadOrder := {
    le := (· = ·)
    le_refl _ := rfl
    le_trans _ _ _ _ _ := by admit /- proof elided -/

class OrderedMonadAlgebra (m : Type u → Type v) [OrderedMonad m] [MonadAlgebra m] where
  [carrierOrder {α : Type u} : Preorder α]
  monadAlg_mono {α β : Type u} {f f' : α → β} {ma ma' : m α} (hf : ∀ a, (f a) ≤ (f' a))
    (hm : ma ≤ₘ ma') : (monadAlg (f <$> ma)) ≤ (monadAlg (f' <$> ma'))

class MonadLift.LE (m : Type u → Type v) (n : Type u → Type w) [Monad m] [OrderedMonad n]
    [φ : MonadLift m n] [ψ : MonadLift m n] where
  monadLift_le {α} (a : m α) : φ.monadLift a ≤ₘ ψ.monadLift a

instance {m n} [Monad m] [OrderedMonad n] : Preorder (MonadLift m n) where
  le := fun φ ψ => ∀ {α : Type u} (a : m α), φ.monadLift a ≤ₘ ψ.monadLift a
  le_refl _ := by admit /- proof elided -/

class OrderedMonadLift (m : semiOutParam (Type u → Type v)) (n : Type u → Type w)
    [OrderedMonad m] [OrderedMonad n] extends MonadLift m n where
  monadLift_mono {α} : Monotone (@monadLift α)

class OrderedMonadLiftT (m : Type u → Type v) (n : Type u → Type w)
    [OrderedMonad m] [OrderedMonad n] extends MonadLiftT m n where
  monadLift_mono {α} : Monotone (@monadLift α)

instance {m} [OrderedMonad m] : OrderedMonadLiftT m m where
  monadLift_mono h := by admit /- proof elided -/

def instDiscreteMonadLift {m n} [Monad m] [h : OrderedMonad n] [MonadLift m n] :
    OrderedMonadLift m n where
  monadLift_mono h := by admit /- proof elided -/

class IsUpperClosed (m : Type u → Type v) (n : Type u → Type w) [Monad m] [OrderedMonad n]
    [MonadRelation m n] where
  monadRel_upper_closed {α} {ma : m α} {na na' : n α} (hr : ma ∼ₘ na) (hn : na ≤ₘ na') : ma ∼ₘ na'

instance {m n} [Monad m] [OrderedMonad n] [MonadLiftT m n] : MonadRelation m n where
  monadRel := fun a b => monadLift a ≤ₘ b

instance {m n} [Monad m] [OrderedMonad n] [MonadLiftT m n] [LawfulMonad m] [LawfulMonad n]
    [LawfulMonadLiftT m n] : LawfulMonadRelation m n where
  monadRel_pure := by admit /- proof elided -/

class OrderedMonadTransformer (t : (Type u → Type v) → Type u → Type w)
    extends MonadTransformer t where
  mapOrderedMonad {m} [OrderedMonad m] : OrderedMonad (t m)
  liftOf_mono {m n} [OrderedMonad m] [OrderedMonad n] [OrderedMonadLiftT m n] :
    OrderedMonadLiftT (t m) (t n)

class AssertAssume (α : Type u) [Preorder α] where
  assert : Prop → α → α
  assume : Prop → α → α
  assert_strengthen : ∀ p x, assert p x ≤ x
  assume_weaken : ∀ p x, x ≤ assume p x
  assert_assume_iff : ∀ p x y, assert p x ≤ y ↔ x ≤ assume p y

class Monad.AssertAssume (m : Type u → Type v) [∀ α, Preorder (m α)] where
  assert_assume {α} : _root_.AssertAssume (m α)

def leftKanExtension {α β : Type u} (f : w β) (p : w α) :=
  { ext : α → w β // p >>= ext ≤ₘ f ∧ (∀ w', p >>= w' ≤ₘ f → ∀ b, w' b ≤ₘ ext b) }

def rightKanExtension {α β : Type u} (f : w β) (p : w α) :=
  { ext : β → w α // f >>= ext ≤ₘ p ∧ (∀ w', f >>= w' ≤ₘ p → ∀ a, w' a ≤ₘ ext a) }

def IsQueryBound (oa : OracleComp spec α) (qb : ι → ℕ) : Prop :=
    ∀ qc ∈ (snd <$> (simulateQ countingOracle oa).run).support, qc ≤ qb

structure PolyQueries {ι : Type} [DecidableEq ι] {spec : ℕ → OracleSpec ι}
  {α β : ℕ → Type} (oa : (n : ℕ) → α n → OracleComp (spec n) (β n)) where
   
  qb : ι → Polynomial ℕ
   
  qb_isQueryBound (n : ℕ) (x : α n) :
    IsQueryBound (oa n x) (λ i ↦ (qb i).eval n)

def generateSeedT (spec : OracleSpec ι) [∀ i, SelectableType (spec.range i)]
    (qc : ι → ℕ) (activeOracles : List ι) :
    StateT (QuerySeed spec) ProbComp Unit :=
  for j in activeOracles do
    modify (QuerySeed.addValues (← ($ᵗ spec.range j).replicate (qc j)))

def generateSeed (spec : OracleSpec ι) [∀ i, SelectableType (spec.range i)]
    (qc : ι → ℕ) (js : List ι) : ProbComp (QuerySeed spec) := do
  let mut seed : QuerySeed spec := ∅
  for j in js do
    seed := seed.addValues (← ($ᵗ spec.range j).replicate (qc j))
  return seed

def generateSingleSeed (spec : OracleSpec ι) (i : ι) [SelectableType (spec.range i)]
    (n : ℕ) : ProbComp (QuerySeed spec) :=
  QuerySeed.ofList <$> ($ᵗ spec.range i).replicate n

structure SigmaAlg
    (S W PC SC Ω P : Type) (p : S → W → Bool) where
   
  commit (s : S) (w : W) : ProbComp (PC × SC)
   
  respond (s : S) (w : W) (sc : SC) (ω : Ω) : ProbComp P
   
  verify (s : S) (pc : PC) (ω : Ω) (p : P) : Bool
   
  sim (s : S) : ProbComp PC
   
  extract (ω₁ : Ω) (p₁ : P) (ω₂ : Ω) (p₂ : P) : ProbComp W

structure GenerableRelation
    (X W : Type) (r : X → W → Bool)
    [SelectableType X] [SelectableType W] where
  gen : ProbComp (X × W)
  gen_sound (x : X) (w : W) : (x, w) ∈ gen.support → r x w
  gen_uniform_right (x : X) : [= x | Prod.fst <$> gen] = [= x | $ᵗ X]
  gen_uniform_left (w : W) : [= w | Prod.snd <$> gen] = [= w | $ᵗ W]

def FiatShamir (sigmaAlg : SigmaAlg X W PC SC Ω P p)
    (hr : GenerableRelation X W p) (M : Type) [DecidableEq M] :
    SignatureAlg (OracleComp (unifSpec ++ₒ (M × PC →ₒ Ω)))
      (M := M) (PK := X) (SK := W) (S := PC × P) where
  keygen := hr.gen
  sign := fun pk sk m => do
    let (c, e) ← sigmaAlg.commit pk sk
    let r ← query (spec := (M × PC →ₒ Ω)) () (m, c)
    let s ← sigmaAlg.respond pk sk e r
    return (c, s)
  verify := fun pk m (c, s) => do
    let r' ← query (spec := (M × PC →ₒ Ω)) () (m, c)
    return sigmaAlg.verify pk c r' s
  exec comp :=
    let so : QueryImpl (unifSpec ++ₒ (M × PC →ₒ Ω))
      (StateT ((M × PC →ₒ Ω).QueryCache) ProbComp) :=
      idOracle ++ₛₒ randomOracle
    StateT.run' (simulateQ so comp) ∅
  lift_probComp := monadLift
  exec_lift_probComp c := by admit /- proof elided -/

instance lensCategory : Category PFunctor.{uA, uB} where
  Hom P Q := Lens P Q
  id P := Lens.id P
  comp f g := Lens.comp g f 
  id_comp _ := rfl
  comp_id _ := rfl
  assoc _ _ _ := rfl

instance chartCategory : Category PFunctor.{uA, uB} where
  Hom P Q := Chart P Q
  id P := Chart.id P
  comp f g := Chart.comp g f 
  id_comp _ := rfl
  comp_id _ := rfl
  assoc _ _ _ := rfl

def FreeContT (f : Type z → Type y) (m : Type u → Type v) (α : Type w) :
    Type (max (u + 1) v w y (z + 1)) :=
  {r : Type u} → ({x : Type z} → f x → ContT r m x) → ContT r m α

def FreeContM (f : Type z → Type y) (α : Type w) : Type (max (u + 1) w y (z + 1)) :=
  FreeContT f Id.{u} α

def PFunctor.FreeContT (P : PFunctor.{z, y}) (m : Type u → Type v) (α : Type w) :
    Type (max (u + 1) v w y z) :=
  {r : Type u} → ((a : P.A) → ContT r m (P.B a)) → ContT r m α

def PFunctor.FreeContM (P : PFunctor.{z, y}) (α : Type w) : Type _ :=
  FreeContT P Id.{u} α

inductive FreeM (f : Type v → Type w) (α : Type u) where
  | pure (a : α) : FreeM f α
  | roll {β : Type v} (x : f β) (k : β → FreeM f α) : FreeM f α

@[inline] def pure (a : α) : FreeContT f m α :=
  fun _ handlePure => handlePure a

@[inline] def bind (x : FreeContT f m α) (g : α → FreeContT f m β) :
    FreeContT f m β :=
  fun handleEff handlePure => x handleEff (fun a => g a handleEff handlePure)

@[inline] def lift [Bind m] {α : Type u} (x : m α) : FreeContT f m α :=
  fun _ handlePure => x >>= handlePure

instance instMonad : Monad (FreeContT f m) where
  pure := pure
  bind := bind

instance instLawfulMonad : LawfulMonad (FreeContT f m) := LawfulMonad.mk'
  (id_map := by admit /- proof elided -/
  )
  (pure_bind := by admit /- proof elided -/
  )
  (bind_assoc := by admit /- proof elided -/
  )

instance instMonadLift [Bind m] : MonadLift m (FreeContT f m) where
  monadLift := lift

instance [Monad m] [LawfulMonad m] : LawfulMonadLift m (FreeContT f m) where
  monadLift_pure := by admit /- proof elided -/

instance {n : Type u → Type v} [MonadLiftT m n] : MonadLiftT (FreeContT f m) (FreeContT f n) where
  monadLift := fun x => fun handleEff handlePure => by admit /- proof elided -/

def FreeMonad.toFreeContM : FreeMonad f α → FreeContM f α :=
  fun x => match x with
    | FreeMonad.pure a => fun _ handlePure => handlePure a
    | FreeMonad.roll x k => fun handleEff handlePure =>
      handleEff x (fun a => FreeMonad.toFreeContM (k a) handleEff handlePure)

def FreeContM.toFreeMonad : FreeContM f α → FreeMonad f α :=
  fun x => x FreeMonad.roll FreeMonad.pure

def equivFreeM : FreeMonad f α ≃ FreeContM f α where
  toFun := FreeMonad.toFreeContM
  invFun := FreeContM.toFreeMonad
  left_inv := FreeMonad.toFreeMonad_toFreeContM
  right_inv := FreeContM.toFreeContM_toFreeMonad

def negligible (f : ℕ → ℝ≥0∞) : Prop :=
  SuperpolynomialDecay atTop (λ x ↦ ↑x) f

@[simp] def negligible_iff (f : ℕ → ℝ≥0∞) :
    negligible f ↔ SuperpolynomialDecay atTop (λ x ↦ ↑x) f := Iff.rfl

protected def id (P : PFunctor.{uA, uB}) : Lens P P where
  toFunA := id
  toFunB := fun _ => id

def comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (l : Lens Q R) (l' : Lens P Q) : Lens P R where
  toFunA := l.toFunA ∘ l'.toFunA
  toFunB := fun i => (l'.toFunB i) ∘ l.toFunB (l'.toFunA i)

@[ext]
structure Equiv (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) where
  toLens : Lens P Q
  invLens : Lens Q P
  left_inv : comp invLens toLens = Lens.id P := by admit /- proof elided -/

@[refl]
def refl (P : PFunctor.{uA, uB}) : P ≃ₗ P :=
  ⟨Lens.id P, Lens.id P, rfl, rfl⟩

@[symm]
def symm {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃ₗ Q) : Q ≃ₗ P :=
  ⟨e.invLens, e.toLens, e.right_inv, e.left_inv⟩

@[trans]
def trans {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (e₁ : P ≃ₗ Q) (e₂ : Q ≃ₗ R) : P ≃ₗ R :=
  ⟨e₂.toLens ∘ₗ e₁.toLens, e₁.invLens ∘ₗ e₂.invLens,
    by admit /- proof elided -/
      ⟩

def initial {P : PFunctor.{uA, uB}} : Lens 0 P :=
  PEmpty.elim ⇆ fun a => PEmpty.elim a

def terminal {P : PFunctor.{uA, uB}} : Lens P 1 :=
  (fun _ => PUnit.unit) ⇆ (fun _ => PEmpty.elim)

alias fromZero := initial
alias toOne := terminal

def inl {P : PFunctor.{uA₁, uB}} {Q : PFunctor.{uA₂, uB}} :
    Lens.{uA₁, uB, max uA₁ uA₂, uB} P (P + Q) :=
  Sum.inl ⇆ (fun _ d => d)

def inr {P : PFunctor.{uA₁, uB}} {Q : PFunctor.{uA₂, uB}} :
    Lens.{uA₂, uB, max uA₁ uA₂, uB} Q (P + Q) :=
  Sum.inr ⇆ (fun _ d => d)

def sumPair {P : PFunctor.{uA₁, uB}} {Q : PFunctor.{uA₂, uB}} {R : PFunctor.{uA₃, uB₃}}
    (l₁ : Lens P R) (l₂ : Lens Q R) :
    Lens.{max uA₁ uA₂, uB, uA₃, uB₃} (P + Q) R :=
  (Sum.elim l₁.toFunA l₂.toFunA) ⇆
    (fun a d => match a with
      | Sum.inl pa => l₁.toFunB pa d
      | Sum.inr qa => l₂.toFunB qa d)

def sumMap {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₁}} {R : PFunctor.{uA₃, uB₃}}
    {W : PFunctor.{uA₄, uB₃}} (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.{max uA₁ uA₂, uB₁, max uA₃ uA₄, uB₃} (P + Q) (R + W) :=
  (Sum.map l₁.toFunA l₂.toFunA) ⇆
    (fun psum => match psum with
      | Sum.inl pa => l₁.toFunB pa
      | Sum.inr qa => l₂.toFunB qa)

def fst {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} :
    Lens.{max uA₁ uA₂, max uB₁ uB₂, uA₁, uB₁} (P * Q) P :=
  Prod.fst ⇆ (fun _ => Sum.inl)

def snd {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} :
    Lens.{max uA₁ uA₂, max uB₁ uB₂, uA₂, uB₂} (P * Q) Q :=
  Prod.snd ⇆ (fun _ => Sum.inr)

def prodPair {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (l₁ : Lens P Q) (l₂ : Lens P R) :
    Lens.{uA₁, uB₁, max uA₂ uA₃, max uB₂ uB₃} P (Q * R) :=
  (fun p => (l₁.toFunA p, l₂.toFunA p)) ⇆
    (fun p => Sum.elim (l₁.toFunB p) (l₂.toFunB p))

def prodMap {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    {W : PFunctor.{uA₄, uB₄}} (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.{max uA₁ uA₂, max uB₁ uB₂, max uA₃ uA₄, max uB₃ uB₄} (P * Q) (R * W) :=
  (fun pq => (l₁.toFunA pq.1, l₂.toFunA pq.2)) ⇆
    (fun pq => Sum.elim (Sum.inl ∘ l₁.toFunB pq.1) (Sum.inr ∘ l₂.toFunB pq.2))

def compMap {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    {W : PFunctor.{uA₄, uB₄}} (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.{max uA₁ uA₂ uB₁, max uB₁ uB₂, max uA₃ uA₄ uB₃, max uB₃ uB₄} (P ◃ Q) (R ◃ W) :=
  (fun ⟨pa, pq⟩ => ⟨l₁.toFunA pa, fun rb' => l₂.toFunA (pq (l₁.toFunB pa rb'))⟩) ⇆
    (fun ⟨pa, pq⟩ ⟨rb, wc⟩ =>
      let pb := l₁.toFunB pa rb
      let qc := l₂.toFunB (pq pb) wc
      ⟨pb, qc⟩)

def tensorMap {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    {W : PFunctor.{uA₄, uB₄}} (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.{max uA₁ uA₂, max uB₁ uB₂, max uA₃ uA₄, max uB₃ uB₄} (P ⊗ Q) (R ⊗ W) :=
  (fun ⟨pa, qa⟩ => (l₁.toFunA pa, l₂.toFunA qa)) ⇆
    (fun ⟨_pa, qa⟩ ⟨rb, wb⟩ => (l₁.toFunB _pa rb, l₂.toFunB qa wb))

def tildeR {P : PFunctor.{uA, uB}} : Lens P (P ◃ X) :=
  (fun a => ⟨a, fun _ => PUnit.unit⟩) ⇆ (fun _a => fun ⟨b, _⟩ => b)

def tildeL {P : PFunctor.{uA, uB}} : Lens P (X ◃ P) :=
  (fun a => ⟨PUnit.unit, fun _ => a⟩) ⇆ (fun _a => fun ⟨_, b⟩ => b)

def invTildeR {P : PFunctor.{uA, uB}} : Lens (P ◃ X) P :=
  (fun a => a.1) ⇆ (fun _ b => ⟨b, PUnit.unit⟩)

def invTildeL {P : PFunctor.{uA, uB}} : Lens (X ◃ P) P :=
  (fun ⟨_, f⟩ => f PUnit.unit) ⇆ (fun _ b => ⟨PUnit.unit, b⟩)

def enclose (P : PFunctor.{uA, uB}) : Type max uA uA₁ uB uB₁ :=
  Lens P X.{uA₁, uB₁}

def fixState {S : Type u} : Lens (selfMonomial S) (selfMonomial S ◃ selfMonomial S) :=
  (fun s₀ => ⟨s₀, fun s₁ => s₁⟩) ⇆ (fun _s₀ => fun ⟨_s₁, s₂⟩ => s₂)

def speedup {S : Type u} {P : PFunctor.{uA, uB}} (l : Lens (selfMonomial S) P) :
    Lens (selfMonomial S) (P ◃ P) :=
  (l ◃ₗ l) ∘ₗ fixState

def sumComm (P : PFunctor.{uA₁, uB}) (Q : PFunctor.{uA₂, uB}) :
    Lens.Equiv.{max uA₁ uA₂, uB, max uA₁ uA₂, uB} (P + Q) (Q + P) where
  toLens := Lens.sumPair Lens.inr Lens.inl
  invLens := Lens.sumPair Lens.inr Lens.inl
  left_inv := by admit /- proof elided -/

def sumAssoc :
    Lens.Equiv.{max uA₁ uA₂ uA₃, uB, max uA₁ uA₂ uA₃, uB} ((P + Q) + R) (P + (Q + R)) where
  toLens := 
    Lens.sumPair
      (Lens.sumPair 
        (Lens.inl) 
        (Lens.inr ∘ₗ Lens.inl) 
      )
      (Lens.inr ∘ₗ Lens.inr) 
  invLens := 
    Lens.sumPair
      (Lens.inl ∘ₗ Lens.inl) 
      (Lens.sumPair 
        (Lens.inl ∘ₗ Lens.inr) 
        (Lens.inr) 
      )
  left_inv := by admit /- proof elided -/

def sumZero :
    Lens.Equiv.{max uA uA₁, uB, uA₁, uB} (P + (0 : PFunctor.{uA, uB})) P where
  toLens := Lens.sumPair (Lens.id P) Lens.initial
  invLens := Lens.inl
  left_inv := by admit /- proof elided -/

def zeroCoprod :
    Lens.Equiv.{max uA uA₁, uB, uA₁, uB} ((0 : PFunctor.{uA, uB}) + P) P where
  toLens := Lens.sumPair Lens.initial (Lens.id P)
  invLens := Lens.inr
  left_inv := by admit /- proof elided -/

def prodComm (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}):
    Lens.Equiv.{max uA₁ uA₂, max uB₁ uB₂, max uA₁ uA₂, max uB₁ uB₂} (P * Q) (Q * P) where
  toLens := Prod.swap ⇆ (fun _ => Sum.elim Sum.inr Sum.inl)
  invLens := Prod.swap ⇆ (fun _ => Sum.elim Sum.inr Sum.inl)
  left_inv := by admit /- proof elided -/

def prodAssoc : Lens.Equiv.{max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃, max uA₁ uA₂ uA₃, max uB₁ uB₂ uB₃}
    ((P * Q) * R) (P * (Q * R)) where
  toLens := (_root_.Equiv.prodAssoc P.A Q.A R.A).toFun ⇆
              (fun _ d => (_root_.Equiv.sumAssoc _ _ _).invFun d)
  invLens := (_root_.Equiv.prodAssoc P.A Q.A R.A).invFun ⇆
               (fun _ d => _root_.Equiv.sumAssoc _ _ _ d)
  left_inv := by admit /- proof elided -/

def prodOne :
    Lens.Equiv.{max uA₁ uA₂, max uB₁ uB₂, uA₁, uB₁} (P * (1 : PFunctor.{uA₂, uB₂})) P where
  toLens := Prod.fst ⇆ (fun _ => Sum.inl)
  invLens := (fun p => (p, PUnit.unit)) ⇆ (fun _ => Sum.elim id PEmpty.elim)
  left_inv := by admit /- proof elided -/

def oneProd :
    Lens.Equiv.{max uA₁ uA₂, max uB₁ uB₂, uA₁, uB₁} ((1 : PFunctor.{uA₂, uB₂}) * P) P where
  toLens := Prod.snd ⇆ (fun _ => Sum.inr)
  invLens := (fun p => (PUnit.unit, p)) ⇆ (fun _ => Sum.elim PEmpty.elim id)
  left_inv := by admit /- proof elided -/

def prodZero :
    Lens.Equiv.{max uA₁ uA₂, max uB₁ uB₂, uA₁, uB₁} (P * (0 : PFunctor.{uA₂, uB₂})) 0 where
  toLens := (fun a => PEmpty.elim a.2) ⇆ (fun _ x => PEmpty.elim x)
  invLens := PEmpty.elim ⇆ (fun pe _ => PEmpty.elim pe)
  left_inv := by admit /- proof elided -/

def zeroProd :
    Lens.Equiv.{max uA₁ uA₂, max uB₁ uB₂, uA₁, uB₁} ((0 : PFunctor.{uA₂, uB₂}) * P) 0 where
  toLens := (fun ⟨pa, _⟩ => PEmpty.elim pa) ⇆ (fun _ x => PEmpty.elim x)
  invLens := PEmpty.elim ⇆ (fun pe _ => PEmpty.elim pe)
  left_inv := by admit /- proof elided -/

def prodCoprodDistrib :
    Lens.Equiv.{max uA₁ uA₂ uA₃, max uB₁ uB₂, max uA₁ uA₂ uA₃, max uB₁ uB₂}
      (P * (Q + R)) ((P * Q) + (P * R)) where
  toLens := (fun ⟨p, qr⟩ => match qr with
              | Sum.inl q => Sum.inl (p, q)
              | Sum.inr r => Sum.inr (p, r)) ⇆
            (fun ⟨_, qr⟩ => match qr with
              | Sum.inl _ => id 
              | Sum.inr _ => id) 
  invLens := (Sum.elim
              (fun ⟨p, q⟩ => (p, Sum.inl q))
              (fun ⟨p, r⟩ => (p, Sum.inr r))) ⇆
             (fun pq_pr => match pq_pr with
              | Sum.inl _ => id 
              | Sum.inr _ => id) 
  left_inv := by admit /- proof elided -/

def sumProdDistrib :
    Lens.Equiv.{max uA₁ uA₂ uA₃, max uB₁ uB₂, max uA₁ uA₂ uA₃, max uB₁ uB₂}
      ((Q + R) * P) ((Q * P) + (R * P)) where
  toLens := (fun ⟨qr, p⟩ => Sum.elim (fun q => Sum.inl (q, p)) (fun r => Sum.inr (r, p)) qr) ⇆
            (fun ⟨qr, p⟩ => match qr with
              | Sum.inl _ => id
              | Sum.inr _ => id)
  invLens := (fun qp_rp => match qp_rp with
              | Sum.inl (q, p) => (Sum.inl q, p)
              | Sum.inr (r, p) => (Sum.inr r, p)) ⇆
             (fun qp_rp => match qp_rp with
              | Sum.inl _ => id
              | Sum.inr _ => id)
  left_inv := by admit /- proof elided -/

def compAssoc : (P ◃ Q) ◃ R ≃ₗ P ◃ (Q ◃ R) where
  toLens := (fun ⟨⟨pa, qf⟩, rf⟩ => ⟨pa, fun pb => ⟨qf pb, fun qb => rf ⟨pb, qb⟩⟩⟩) ⇆
            (fun _ ⟨pb, ⟨qb, rb⟩⟩ => ⟨⟨pb, qb⟩, rb⟩)
  invLens := (fun ⟨pa, g⟩ => ⟨⟨pa, fun pb => (g pb).1⟩, fun ⟨pb, qb⟩ => (g pb).2 qb⟩) ⇆
             (fun _ ⟨⟨pb, qb⟩, rb⟩ => ⟨pb, ⟨qb, rb⟩⟩)
  left_inv := rfl
  right_inv := rfl

def compX : P ◃ X ≃ₗ P where
  toLens := invTildeR
  invLens := tildeR
  left_inv := rfl
  right_inv := rfl

def XComp : X ◃ P ≃ₗ P where
  toLens := invTildeL
  invLens := tildeL
  left_inv := rfl
  right_inv := rfl

def sumCompDistrib {R : PFunctor.{uA₃, uB₂}} :
    Lens.Equiv.{max uA₁ uA₂ uA₃ uB₂, max uB₁ uB₂, max uA₁ uA₂ uA₃ uB₂, max uB₁ uB₂}
      ((Q + R : PFunctor.{max uA₂ uA₃, uB₂}) ◃ P) ((Q ◃ P) + (R ◃ P)) where
  toLens := (fun a => match a with
              | ⟨Sum.inl qa, pf⟩ => Sum.inl ⟨qa, pf⟩
              | ⟨Sum.inr ra, pf⟩ => Sum.inr ⟨ra, pf⟩) ⇆
            (fun ⟨qr, pf⟩ b => match qr with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  invLens := (fun a => match a with
              | Sum.inl ⟨qa, pf⟩ => ⟨Sum.inl qa, pf⟩
              | Sum.inr ⟨ra, pf⟩ => ⟨Sum.inr ra, pf⟩) ⇆
            (fun qprp b => match qprp with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  left_inv := by admit /- proof elided -/

def tensorComm (P : PFunctor.{uA₁, uB₁}) (Q : PFunctor.{uA₂, uB₂}) : P ⊗ Q ≃ₗ Q ⊗ P where
  toLens := Prod.swap ⇆ (fun _ => Prod.swap)
  invLens := Prod.swap ⇆ (fun _ => Prod.swap)
  left_inv := rfl
  right_inv := rfl

def tensorAssoc : (P ⊗ Q) ⊗ R ≃ₗ P ⊗ (Q ⊗ R) where
  toLens := (_root_.Equiv.prodAssoc _ _ _).toFun ⇆
            (fun _ => (_root_.Equiv.prodAssoc _ _ _).invFun)
  invLens := (_root_.Equiv.prodAssoc _ _ _).invFun ⇆
            (fun _ => (_root_.Equiv.prodAssoc _ _ _).toFun)
  left_inv := rfl
  right_inv := rfl

def tensorX : P ⊗ X ≃ₗ P where
  toLens := Prod.fst ⇆ (fun _ b => (b, PUnit.unit))
  invLens := (fun p => (p, PUnit.unit)) ⇆ (fun _ bp => bp.1)
  left_inv := rfl
  right_inv := rfl

def xTensor : X ⊗ P ≃ₗ P where
  toLens := Prod.snd ⇆ (fun _ b => (PUnit.unit, b))
  invLens := (fun p => (PUnit.unit, p)) ⇆ (fun _ bp => bp.2)
  left_inv := rfl
  right_inv := rfl

def zeroTensor : 0 ⊗ P ≃ₗ 0 where
  toLens := (fun a => PEmpty.elim a.1) ⇆ (fun _ b => PEmpty.elim b)
  invLens := PEmpty.elim ⇆ (fun a _ => PEmpty.elim a)
  left_inv := by admit /- proof elided -/

def tensorZero : P ⊗ 0 ≃ₗ 0 where
  toLens := (fun a => PEmpty.elim a.2) ⇆ (fun _ b => PEmpty.elim b)
  invLens := PEmpty.elim ⇆ (fun a _ => PEmpty.elim a)
  left_inv := by admit /- proof elided -/

def tensorCoprodDistrib :
    Lens.Equiv.{max uA₁ uA₂ uA₃, max uB₁ uB₂, max uA₁ uA₂ uA₃, max uB₁ uB₂}
      (P ⊗ (Q + R : PFunctor.{max uA₂ uA₃, uB₂})) ((P ⊗ Q) + (P ⊗ R)) where
  toLens := (fun ⟨p, qr⟩ => match qr with
              | Sum.inl q => Sum.inl (p, q)
              | Sum.inr r => Sum.inr (p, r)) ⇆
            (fun ⟨p, qr⟩ b => match qr with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  invLens := (fun pqpr => match pqpr with
              | Sum.inl (p, q) => (p, Sum.inl q)
              | Sum.inr (p, r) => (p, Sum.inr r)) ⇆
             (fun pqpr b => match pqpr with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  left_inv := by admit /- proof elided -/

def sumTensorDistrib :
    (Q + R : PFunctor.{max uA₂ uA₃, uB₂}) ⊗ P
      ≃ₗ ((Q ⊗ P) + (R ⊗ P) : PFunctor.{max uA₁ uA₂ uA₃, max uB₁ uB₂}) where
  toLens := (fun ⟨qr, p⟩ => match qr with
              | Sum.inl q => Sum.inl (q, p)
              | Sum.inr r => Sum.inr (r, p)) ⇆
            (fun ⟨qr, _⟩ b => match qr with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  invLens := (fun qprp => match qprp with
              | Sum.inl (q, p) => (Sum.inl q, p)
              | Sum.inr (r, p) => (Sum.inr r, p)) ⇆
             (fun qprp b => match qprp with
              | Sum.inl _ => b
              | Sum.inr _ => b)
  left_inv := by admit /- proof elided -/

instance [IsEmpty I] {F : I → PFunctor.{u}} : IsEmpty (sigma F).A :=

instance [IsEmpty I] {F : I → PFunctor.{u}} {a : (sigma F).A} : IsEmpty ((sigma F).B a) :=
  isEmptyElim a

def piUnit {P : PFunctor.{u}} : pi (fun (_ : PUnit) => P) ≃ₗ P where
  toLens := (fun f => f PUnit.unit) ⇆ (fun _ pb => ⟨PUnit.unit, pb⟩)
  invLens := (fun pa _ => pa) ⇆ (fun _ spb => spb.2)
  left_inv := rfl
  right_inv := rfl

def ulift {P : PFunctor.{uA, uB}} : P.ulift ≃ₗ P where
  toLens := (fun a => ULift.down a) ⇆ (fun _ b => ULift.up b)
  invLens := (fun a => ULift.up a) ⇆ (fun _ b => ULift.down b)
  left_inv := rfl
  right_inv := rfl

def toLensEquiv (e : P ≃ₚ Q) : P ≃ₗ Q where
  toLens := e.equivA ⇆ (fun a => (e.equivB a).symm)
  invLens := e.symm.equivA ⇆ (fun a => (e.symm.equivB a).symm)
  left_inv := by admit /- proof elided -/

def OracleSpec (ι : Type u) : Type (max u (v + 1)) :=
  (i : ι) → Type v × Type v

instance : Inhabited (OracleSpec ι) := ⟨λ _ ↦ (PUnit, PUnit)⟩

@[inline, reducible]
protected def domain (spec : OracleSpec ι) (i : ι) : Type v := (spec i).1

@[inline, reducible]
protected def range (spec : OracleSpec ι) (i : ι) : Type w := (spec i).2

protected class DecidableEq (spec : OracleSpec ι) where
  domain_decidableEq' (i : ι) : DecidableEq (spec.domain i)
  range_decidableEq' (i : ι) : DecidableEq (spec.range i)

instance domain_decidableEq {i : ι} [h : spec.DecidableEq] :
    DecidableEq (spec.domain i) := h.domain_decidableEq' i

instance range_decidableEq {i : ι} [h : spec.DecidableEq] :
    DecidableEq (spec.range i) := h.range_decidableEq' i

class FiniteRange (spec : OracleSpec ι) where
    range_inhabited' (i : ι) : Inhabited (spec.range i)
    range_fintype' (i : ι) : Fintype (spec.range i)

instance range_inhabited {i : ι} [h : FiniteRange spec] :
    Inhabited (spec.range i) := h.range_inhabited' i

instance range_fintype {i : ι} [h : FiniteRange spec] :
    Fintype (spec.range i) := h.range_fintype' i

def append {ι₁ : Type u} {ι₂ : Type u'} (spec₁ : OracleSpec ι₁) (spec₂ : OracleSpec ι₂) :
    OracleSpec (ι₁ ⊕ ι₂) := 
  fun | .inl i => spec₁ i | .inr i => spec₂ i

instance [h₁ : spec₁.DecidableEq] [h₂ : spec₂.DecidableEq] :
    (spec₁ ++ₒ spec₂).DecidableEq where
  domain_decidableEq' := Sum.rec h₁.domain_decidableEq' h₂.domain_decidableEq'
  range_decidableEq' := Sum.rec h₁.range_decidableEq' h₂.range_decidableEq'

instance [h₁ : spec₁.FiniteRange] [h₂ : spec₂.FiniteRange] :
    (spec₁ ++ₒ spec₂).FiniteRange where
  range_inhabited' := λ i ↦ Sum.recOn i h₁.range_inhabited' h₂.range_inhabited'
  range_fintype' := λ i ↦ Sum.recOn i h₁.range_fintype' h₂.range_fintype'

@[inline, reducible]
def rename (spec : OracleSpec ι) (f : τ → ι) : OracleSpec τ := spec ∘ f

@[inline, reducible]
def emptySpec : OracleSpec PEmpty := λ _ ↦ (PUnit, PUnit)

instance (i : PEmpty) : Unique ([]ₒ.domain i) := PUnit.instUnique

instance (i : PEmpty) : Unique ([]ₒ.range i) := PUnit.instUnique

instance : OracleSpec.DecidableEq []ₒ where
  domain_decidableEq' := inferInstance
  range_decidableEq' := inferInstance

instance : FiniteRange []ₒ where
  range_inhabited' := inferInstance
  range_fintype' := inferInstance

@[inline, reducible]
def singletonSpec (T U : Type v) : OracleSpec.{u,v} PUnit :=
  λ _ ↦ (T, U)

instance {T U : Type v} [DecidableEq T] [DecidableEq U] : (T →ₒ U).DecidableEq where
  domain_decidableEq' := inferInstance
  range_decidableEq' := inferInstance

instance {T U : Type v} [Inhabited U] [Fintype U] : (T →ₒ U).FiniteRange where
  range_inhabited' := inferInstance
  range_fintype' := inferInstance

@[inline, reducible] def coinSpec : OracleSpec.{0,0} Unit := Unit →ₒ Bool

instance : coinSpec.DecidableEq where
  domain_decidableEq' := inferInstance
  range_decidableEq' := inferInstance

instance : coinSpec.FiniteRange where
  range_inhabited' := inferInstance
  range_fintype' := inferInstance

def unifSpec' : OracleSpec.{u+1,u} (Type u) :=
  λ α : Type u ↦ (PUnit, α)

@[inline, reducible] def unifSpec : OracleSpec.{0,0} ℕ :=
  λ n ↦ (Unit, Fin (n + 1))

def probSpec : OracleSpec.{0,0} ℕ :=
  fun n => (ℕ, Fin (n + 1))

instance : unifSpec.DecidableEq where
  domain_decidableEq' := inferInstance
  range_decidableEq' := inferInstance

instance : unifSpec.FiniteRange where
  range_inhabited' := inferInstance
  range_fintype' := inferInstance

def CommutativeAt (m : Type u → Type v) [Monad m] {α β : Type u} (ma : m α) (mb : m β) : Prop :=
  (do let a ← ma; let b ← mb; pure (a, b)) = (do let b ← mb; let a ← ma; pure (a, b))

class Commutative (m : Type u → Type v) [Monad m] where
  bind_comm {α β} (ma : m α) (mb : m β) : CommutativeAt m ma mb

instance {m} [Monad m] [Commutative m] {α β} (ma : m α) (mb : m β) :
    CommutativeAt m ma mb := bind_comm ma mb

instance : Commutative Id where
  bind_comm := fun _ _ => rfl

instance : Commutative Option where
  bind_comm := fun ma mb => by admit /- proof elided -/

instance {ε} [Subsingleton ε] : Commutative (Except ε) where
  bind_comm := fun ma mb => by admit /- proof elided -/

instance {ρ} {m} [Monad m] [Commutative m] : Commutative (ReaderT ρ m) where
  bind_comm := fun ma mb => by admit /- proof elided -/

instance {ω} {m} [Monad m] [Commutative m] [CommMonoid ω] : Commutative (WriterT ω m) where
  bind_comm := fun ma mb => by admit /- proof elided -/

def Set.monadComm : Commutative Set where
  bind_comm := fun ma mb => by admit /- proof elided -/

instance : Commutative PMF where
  bind_comm := fun ma mb => by admit /- proof elided -/

def compose (so' : QueryImpl spec' m) (so : QueryImpl spec (OracleComp spec')) :
    QueryImpl spec m where
  impl q := simulateQ so' (so.impl q)

def equivState (so : QueryImpl spec (StateT σ (OracleComp spec'))) (e : σ ≃ τ) :
    QueryImpl spec (StateT τ (OracleComp spec')) where
  impl q s := map id e <$> so.impl q (e.symm s)

def unifOracle [∀ i, SelectableType (spec.range i)] :
    QueryImpl spec ProbComp where
  impl | query i _ => $ᵗ spec.range i

def append {m₁ m₂ n : Type u → Type v} [MonadLiftT m₁ n] [MonadLiftT m₂ n]
    (so : QueryImpl spec₁ m₁) (so' : QueryImpl spec₂ m₂) :
    QueryImpl (spec₁ ++ₒ spec₂) n where impl
  | query (inl i) t => so.impl (query i t)
  | query (inr i) t => so'.impl (query i t)

Array in Init.Prelude

IO in Init.System.IO

Unit in Init.Prelude

IO.println in Init.System.IO

List in Init.Prelude

List.range in Init.Data.List.Basic

Num in Mathlib.Data.Num.Basic

CategoryTheory.MonoidalCategory in Mathlib.CategoryTheory.Monoidal.Category

Preord in Mathlib.Order.Category.Preord

CategoryTheory.inv in Mathlib.CategoryTheory.Iso

Monotone in Mathlib.Order.Monotone.Defs

PUnit in Init.Prelude

PUnit.unit in Init.Prelude

Preord.ofHom in Mathlib.Order.Category.Preord

Prod in Init.Prelude

Prod.fst in Init.Prelude

Prod.snd in Init.Prelude

associator in Mathlib.Algebra.Ring.Associator

CategoryTheory.Bundled in Mathlib.CategoryTheory.ConcreteCategory.Bundled

CategoryTheory.EnrichedFunctor.obj in Mathlib.CategoryTheory.Enriched.Basic

CategoryTheory.EnrichedCategory in Mathlib.CategoryTheory.Enriched.Basic

Finset in Mathlib.Data.Finset.Defs

Finset.sum in Mathlib.Algebra.BigOperators.Group.Finset.Defs

Finset.univ in Mathlib.Data.Fintype.Defs

Fintype in Mathlib.Data.Fintype.Defs

Fintype.card in Mathlib.Data.Fintype.Card

Nonempty in Init.Prelude

ENNReal in Mathlib.Data.ENNReal.Basic

List.Vector in Mathlib.Data.Vector.Defs

IsEmpty in Mathlib.Logic.IsEmpty

Function.Injective2 in Mathlib.Logic.Function.Basic

List.cons in Init.Prelude

List.Vector.cons in Mathlib.Data.Vector.Defs

Vector in Init.Data.Vector.Basic

Prod.mk in Init.Prelude

DecidableEq in Init.Prelude

Finset.image in Mathlib.Data.Finset.Image

List.singleton in Init.Data.List.Basic

Bool in Init.Prelude

Fin in Init.Prelude

CharP in Mathlib.Algebra.CharP.Defs

Finset.filter in Mathlib.Data.Finset.Filter

List.count in Init.Data.List.Basic

Nat in Init.Prelude

AddCommMonoid in Mathlib.Algebra.Group.Defs

DecidablePred in Init.Prelude

BitVec in Init.Prelude

BitVec.toFin in Init.Prelude

Function.Bijective in Mathlib.Logic.Function.Defs

BitVec.ofFin in Init.Prelude

Fintype.ofBijective in Mathlib.Data.Fintype.OfMap

Inhabited in Init.Prelude

id in Init.Prelude

HEq in Init.Prelude

Vector.insertIdx in Init.Data.Vector.Basic

Add in Init.Prelude

Vector.add in Init.Data.Vector.Algebra

Vector.ofFn in Init.Data.Vector.Basic

Zero in Init.Prelude

Vector.zero in Init.Data.Vector.Algebra

ContinuousAdd in Mathlib.Topology.Algebra.Monoid.Defs

Function.update in Mathlib.Logic.Function.Basic

Option in Init.Prelude

Summable in Mathlib.Topology.Algebra.InfiniteSum.Defs

T2Space in Mathlib.Topology.Separation.Hausdorff

TopologicalSpace in Mathlib.Topology.Defs.Basic

PMF in Mathlib.Probability.ProbabilityMassFunction.Basic

Pure in Init.Prelude

cast in Init.Prelude

PMF.uniformOfFintype in Mathlib.Probability.Distributions.Uniform

Equiv in Mathlib.Logic.Equiv.Defs

Fin.foldlM in Init.Data.Fin.Fold

LawfulMonad in Init.Control.Lawful.Basic

List.finRange in Init.Data.List.FinRange

List.foldlM in Init.Data.List.Control

Monad in Init.Prelude

List.mapM in Init.Data.List.Control

List.mapM.loop in Init.Data.List.Control

AddGroup in Mathlib.Algebra.Group.Defs

AddTorsor in Mathlib.Algebra.AddTorsor.Defs

Group in Mathlib.Algebra.Group.Defs

Vector.zipWith in Init.Data.Vector.Basic

Fin.castLE in Init.Data.Fin.Basic

NeZero in Init.Data.NeZero

Matrix in Mathlib.LinearAlgebra.Matrix.Defs

Fin.ofNat in Init.Data.Fin.Basic

Fin.val in Init.Prelude

Matrix.mulVec in Mathlib.Data.Matrix.Mul

Matrix.vecMul in Mathlib.Data.Matrix.Mul

Vector.range in Init.Data.Vector.Basic

dotProduct in Mathlib.Data.Matrix.Mul

Fin.sub in Init.Data.Fin.Basic

Vector.get in Init.Data.Vector.Basic

Vector.map in Init.Data.Vector.Basic

String in Init.Prelude

BitVec.ofNat in Init.Prelude

Char in Init.Prelude

Char.ofNat in Init.Prelude

String.mk in Init.Data.String.Bootstrap

Repr in Init.Data.Repr

instReprString in Init.Data.Repr

String.decEq in Init.Prelude

CategoryTheory.Category in Mathlib.CategoryTheory.Category.Basic

PFunctor in Mathlib.Data.PFunctor.Univariate.Basic

PFunctor.comp in Mathlib.Data.PFunctor.Univariate.Basic

PEmpty in Init.Prelude

One in Init.Prelude

PFunctor.A in Mathlib.Data.PFunctor.Univariate.Basic

inferInstanceAs in Init.Prelude

Unique in Mathlib.Logic.Unique

PFunctor.B in Mathlib.Data.PFunctor.Univariate.Basic

Sum in Init.Core

Sum.elim in Init.Data.Sum.Basic

HAdd in Init.Prelude

HMul in Init.Prelude

Mul in Init.Prelude

Nat.succ in Init.Prelude

NatPow in Init.Prelude

ULift in Init.Prelude

ULift.down in Init.Prelude

HPow in Init.Prelude

ULift.up in Init.Prelude

PFunctor.M in Mathlib.Data.PFunctor.Univariate.M

PFunctor.M.head in Mathlib.Data.PFunctor.Univariate.M

PFunctor.M.dest in Mathlib.Data.PFunctor.Univariate.M

inline in Init.Core

PFunctor.Obj in Mathlib.Data.PFunctor.Univariate.Basic

MonadLift in Init.Prelude

Bind in Init.Prelude

OptionT in Init.Control.Option

FunLike in Mathlib.Data.FunLike.Basic

MonadLift.monadLift in Init.Prelude

OptionT.lift in Init.Control.Option

PMF.instMonad in Mathlib.Probability.ProbabilityMassFunction.Monad

liftM in Init.Prelude

PMF.bind in Mathlib.Probability.ProbabilityMassFunction.Monad

OptionT.bind in Init.Control.Option

OptionT.mk in Init.Control.Option

WriterT in Mathlib.Control.Monad.Writer

WriterT.mk in Mathlib.Control.Monad.Writer

Prod.map in Init.Core

Monoid in Mathlib.Algebra.Group.Defs

AlternativeMonad in Batteries.Control.AlternativeMonad

LawfulMonadLift in Init.Control.Lawful.MonadLift.Basic

StateT in Init.Control.State

StateT.mk in Init.Control.State

StateT.lift in Init.Control.State

StateT.bind in Init.Control.State

Alternative in Init.Control.Basic

StateT.failure in Init.Control.State

LawfulAlternativeLift in Batteries.Control.AlternativeMonad

Decidable in Init.Prelude

guard in Init.Control.Basic

optional in Init.Control.Basic

Option.elimM in Init.Data.Option.Basic

Equiv.sumEmpty in Mathlib.Logic.Equiv.Sum

Equiv.emptySum in Mathlib.Logic.Equiv.Sum

Equiv.prodPEmpty in Mathlib.Logic.Equiv.Prod

Equiv.pemptyProd in Mathlib.Logic.Equiv.Prod

Equiv.prodPUnit in Mathlib.Logic.Equiv.Prod

Equiv.punitProd in Mathlib.Logic.Equiv.Prod

Equiv.equivPEmpty in Mathlib.Logic.Equiv.Defs

OfNat in Init.Prelude

OfNat.ofNat in Init.Prelude

One.one in Init.Prelude

Or in Init.Prelude

Or.inr in Init.Prelude

PEmpty.instIsEmpty in Mathlib.Logic.IsEmpty

Or.inl in Init.Prelude

Equiv.pemptyArrowEquivPUnit in Mathlib.Logic.Equiv.Defs

Equiv.sigmaPUnit in Mathlib.Logic.Equiv.Prod

Equiv.sigmaUnique in Mathlib.Logic.Equiv.Prod

Equiv.punitArrowEquiv in Mathlib.Logic.Equiv.Defs

PEmpty.elim in Init.Core

Sum.inl in Init.Core

Sum.inr in Init.Core

Sum.map in Init.Data.Sum.Basic

PFunctor.W in Mathlib.Data.PFunctor.Univariate.Basic

isEmptyElim in Mathlib.Logic.IsEmpty

Id in Init.Control.Id

Functor in Init.Prelude

Functor.map in Init.Prelude

Functor.mapConst in Init.Prelude

LawfulFunctor in Init.Control.Lawful.Basic

List.map in Init.Prelude

List.zip in Init.Data.List.Basic

List.filterMap in Init.Data.List.Basic

List.tails in Batteries.Data.List.Basic

Stream' in Mathlib.Data.Stream.Defs

Stream'.map in Mathlib.Data.Stream.Defs

Stream'.head in Mathlib.Data.Stream.Defs

Stream'.drop in Mathlib.Data.Stream.Defs

Stream'.zip in Mathlib.Data.Stream.Defs

Stream'.get in Mathlib.Data.Stream.Defs

ReaderT in Init.Prelude

ExceptT in Init.Control.Except

ExceptT.bind in Init.Control.Except

ExceptT.lift in Init.Control.Except

ExceptT.mk in Init.Control.Except

MonadLiftT in Init.Prelude

ContT in Mathlib.Control.Monad.Cont

LawfulMonadLiftT in Init.Control.Lawful.MonadLift.Basic

Preorder in Mathlib.Order.Defs.PartialOrder

semiOutParam in Init.Prelude

Except in Init.Prelude

Subsingleton in Init.Core

Bind.bind in Init.Prelude

Except.bind in Init.Control.Except

ReaderT.bind in Init.Prelude

Set in Mathlib.Data.Set.Defs

Function.LeftInverse in Init.Data.Function

Function.RightInverse in Init.Data.Function

Coe in Init.Coe

dite in Init.Prelude

MonadFunctor in Init.Prelude

iSup in Mathlib.Order.SetNotation

ENat in Mathlib.Data.ENat.Defs

CategoryTheory.aesop_cat in Mathlib.CategoryTheory.Category.Basic

CategoryTheory.NatTrans in Mathlib.CategoryTheory.NatTrans

CategoryTheory.NatTrans.mk in Mathlib.CategoryTheory.NatTrans

CategoryTheory.Functor.prod in Mathlib.CategoryTheory.Products.Basic

Function.const in Init.Prelude

Seq in Init.Prelude

CoeFun in Init.Coe

MonadFunctor.monadMap in Init.Prelude

MonadFunctorT in Init.Prelude

instMonadFunctorTOfMonadFunctor in Init.Prelude

monadFunctorRefl in Init.Prelude

MonadState in Init.Prelude

MonadState.get in Init.Prelude

MonadStateOf in Init.Prelude

MonadStateOf.get in Init.Prelude

outParam in Init.Prelude

MonadStateOf.modifyGet in Init.Prelude

getThe in Init.Prelude

modifyGetThe in Init.Prelude

modifyThe in Init.Prelude

modify in Init.Prelude

StateT.get in Init.Control.State

StateT.modifyGet in Init.Control.State

StateT.instMonad in Init.Control.State

StateT.set in Init.Control.State

MonadControl in Init.Control.Basic

MonadControl.liftWith in Init.Control.Basic

MonadControl.restoreM in Init.Control.Basic

MonadControlT in Init.Control.Basic

Set.indicator in Mathlib.Algebra.Notation.Indicator

Set.image in Mathlib.Data.Set.Defs

PMF.toOuterMeasure in Mathlib.Probability.ProbabilityMassFunction.Basic

Set.univ in Mathlib.Data.Set.Defs

Finset.biUnion in Mathlib.Data.Finset.Union

Finite in Mathlib.Data.Finite.Defs

Finite.Set.finite_biUnion'' in Mathlib.Data.Set.Finite.Lattice

Fintype.subtypeEq in Mathlib.Data.Fintype.Basic

Set.fintypeEmpty in Mathlib.Data.Set.Finite.Basic

Set.fintypeiUnion in Mathlib.Data.Set.Finite.Lattice

Decidable.isFalse in Init.Prelude

Fintype.decidableExistsFintype in Mathlib.Data.Fintype.Defs

Iff in Init.Core

Computation in Mathlib.Data.Seq.Computation

IO.rand in Init.Data.Random

IO.userError in Init.System.IOError

Eq in Init.Prelude

LawfulAlternative in Batteries.Control.AlternativeMonad

OptionT.instMonadFunctor in Init.Control.Option

OptionT.fail in Init.Control.Option

OptionT.run in Init.Control.Option

Option.isSome in Init.Data.Option.Basic

Option.isNone in Init.Data.Option.Basic

Fintype.decidableForallFintype in Mathlib.Data.Fintype.Defs

decidable_of_iff' in Init.PropLemmas

instDecidableAnd in Init.Prelude

Decidable.isTrue in Init.Prelude

Polynomial in Mathlib.Algebra.Polynomial.Basic

PUnit.instUnique in Mathlib.Logic.Unique

ENNReal.log in Mathlib.Analysis.SpecialFunctions.Log.ENNRealLog

Option.getM in Init.Data.Option.Basic

impl in Mathlib.Deprecated.MLList.BestFirst

ReaderT.adapt in Init.Prelude

EmptyCollection in Init.Core

HMul.hMul in Init.Prelude

Monoid.toMulOneClass in Mathlib.Algebra.Group.Defs

instHMul in Init.Prelude

Monoid.toOne in Mathlib.Algebra.Group.Defs

One.toOfNat1 in Init.Data.Zero

Pi.hasLe in Mathlib.Order.Basic

Append in Init.Prelude

List.append in Init.Prelude

List.nil in Init.Prelude

List.foldr in Init.Data.List.Basic

DFunLike in Mathlib.Data.FunLike.Basic

List.take in Init.Data.List.Basic

List.length in Init.Prelude

Equiv.Perm in Mathlib.Logic.Equiv.Defs

PMF.map in Mathlib.Probability.ProbabilityMassFunction.Constructions

PMF.uniformOfFinset in Mathlib.Probability.Distributions.Uniform

reduceDIte in Lean.Meta.Tactic.Simp.BuiltinSimprocs.Core

Vector.push in Init.Data.Vector.Basic

List.replicate in Init.Data.List.Basic

List.replicateTR in Init.Data.List.Basic

List.prod in Batteries.Data.List.Basic

List.all in Init.Data.List.Basic

StateT.run in Init.Control.State

Finset.card in Mathlib.Data.Finset.Card

Function.support in Mathlib.Algebra.Notation.Support

AddLECancellable in Mathlib.Algebra.Order.Monoid.Unbundled.Basic

Classical.arbitrary in Mathlib.Logic.Nonempty

Set.preimage in Mathlib.Data.Set.Operations

WithTop in Mathlib.Order.TypeTags

Set.image2 in Mathlib.Data.Set.Operations

Finset.image₂ in Mathlib.Data.Finset.NAry

Function.comp in Init.Prelude

Classical.decEq in Mathlib.Logic.Basic

Classical.decPred in Mathlib.Logic.Basic

Array.drop in Init.Data.Array.Basic

List.zipWith in Init.Data.List.Basic

Array.mapM' in Init.Data.Array.BasicAux

Array.flatMapM in Init.Data.Array.Basic

Array.filterMapM in Init.Data.Array.Basic

Array.foldlM in Init.Data.Array.Basic

Array.foldrM in Init.Data.Array.Basic

List.Vector.toList in Mathlib.Data.Vector.Defs

List.Vector.mmap in Mathlib.Data.Vector.Basic

Cont in Mathlib.Control.Monad.Cont

LE in Init.Prelude

LE.le in Init.Prelude

PartialOrder in Mathlib.Order.Defs.PartialOrder

StateM in Init.Control.State

Function.uncurry in Init.Data.Function

Turing.TM2ComputableInPolyTime in Mathlib.Computability.TMComputable

Asymptotics.SuperpolynomialDecay in Mathlib.Analysis.Asymptotics.SuperpolynomialDecay

Filter.atTop in Mathlib.Order.Filter.AtTopBot.Defs
</all_available_defs>

<all_available_lemmas>
@[simp]
lemma uniformSelectList_nil : ($ ([] : List α) : ProbComp α) = failure

lemma uniformSelectList_cons (x : α) (xs : List α) :
    ($ x :: xs : ProbComp α) = ((x :: xs)[·]) <$> $[0..xs.length]

@[simp] lemma evalDist_uniformSelectList (xs : List α) : evalDist ($ xs) =
    match xs with

@[simp] lemma support_uniformSelectList (xs : List α) :
    ($ xs).support = if xs.isEmpty then ∅ else {y | y ∈ (xs)}

@[simp] lemma finSupport_uniformSelectList [DecidableEq α] (xs : List α) :
    ($ xs).finSupport = if xs.isEmpty then ∅ else xs.toFinset

@[simp] lemma probOutput_uniformSelectList [DecidableEq α] (xs : List α) (x : α) :
    [= x | $ xs] = if xs.isEmpty then 0 else (xs.count x : ℝ≥0∞) / xs.length

@[simp] lemma probFailure_uniformSelectList (xs : List α) :
    [⊥ | $ xs] = if xs.isEmpty then 1 else 0

@[simp] lemma probEvent_uniformSelectList (xs : List α) (p : α → Prop) [DecidablePred p] :
    [p | $ xs] = if xs.isEmpty then 0 else (xs.countP p : ℝ≥0∞) / xs.length

lemma uniformSelectVector_def {α : Type} {n : ℕ} (xs : Vector α (n + 1)) :
    ($ xs) = ($ xs.toList)

lemma uniformSelectFinset_def {α : Type} [DecidableEq α] (s : Finset α) :
    ($ s) = ($ s.toList)

@[simp] lemma support_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    ($ s).support = if s.Nonempty then ↑s else ∅

@[simp] lemma finSupport_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    ($ s).finSupport = if s.Nonempty then s else ∅

@[simp] lemma probOutput_uniformSelectFinset [DecidableEq α] (s : Finset α) (x : α) :
    [= x | $ s] = if x ∈ s then (s.card : ℝ≥0∞)⁻¹ else 0

@[simp] lemma probFailure_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    [⊥ | $ s] = if s.Nonempty then 0 else 1

@[simp] lemma evalDist_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    evalDist ($ s) = if hs : s.Nonempty then
      OptionT.lift (PMF.uniformOfFinset s hs) else failure

@[simp] lemma probOutput_uniformOfFintype [Fintype α] (x : α) :
    [= x | $ᵗ α] = (Fintype.card α : ℝ≥0∞)⁻¹

@[simp] lemma probFailure_uniformOfFintype : [⊥ | $ᵗ α] = 0

@[simp] lemma neverFails_uniformOfFintype : neverFails ($ᵗ α)

@[simp] lemma evalDist_uniformOfFintype [Fintype α] [Inhabited α] :
    evalDist ($ᵗ α) = OptionT.lift (PMF.uniformOfFintype α)

@[simp] lemma support_uniformOfFintype : ($ᵗ α).support = Set.univ

@[simp] lemma finSupport_uniformOfFintype [Fintype α] [DecidableEq α] :
    ($ᵗ α).finSupport = Finset.univ

@[simp] lemma probEvent_uniformOfFintype [Fintype α] (p : α → Prop) [DecidablePred p] :
    [p | $ᵗ α] = (Finset.univ.filter p).card / Fintype.card α

lemma probOutput_uniformBool_not_decide_eq_decide {ob : ProbComp Bool} :
    [= true | do let b ←$ᵗ Bool; let b' ← ob; return !decide (b = b')] =
      [= true | do let b ←$ᵗ Bool; let b' ← ob; return decide (b = b')]

@[simp]
lemma monadLift_eq_lift (x : f α) :
  (x : FreeMonad f α) = FreeMonad.lift x

@[simp]
lemma bind_pure (x : α) (r : α → FreeMonad f β) :
    FreeMonad.bind (FreeMonad.pure x) r = r x

@[simp]
lemma bind_roll (x : f α) (r : α → FreeMonad f β) (g : β → FreeMonad f γ) :
    FreeMonad.bind (FreeMonad.roll x r) g = FreeMonad.roll x (λ u ↦ FreeMonad.bind (r u) g)

@[simp]
lemma bind_lift (x : f α) (r : α → FreeMonad f β) :
    FreeMonad.bind (FreeMonad.lift x) r = FreeMonad.roll x r

@[simp]
lemma monad_pure_def (x : α) : (pure x : FreeMonad f α) = FreeMonad.pure x

@[simp]
lemma monad_bind_def (x : FreeMonad f α) (g : α → FreeMonad f β) :
    x >>= g = FreeMonad.bind x g

@[simp]
lemma construct_pure (y : α) : FreeMonad.construct h_pure h_roll (pure y) = h_pure y

@[simp]
lemma construct_roll (x : f β) (r : β → FreeMonad f α) :
    (FreeMonad.construct h_pure h_roll (roll x r) : C (roll x r)) =
      (h_roll x r (λ u ↦ FreeMonad.construct h_pure h_roll (r u)))

@[simp]
lemma mapM'_lift [Monad m] [LawfulMonad m]
    (s : {α : Type u} → f α → m α) (x : f α) :
    FreeMonad.mapM' m s (FreeMonad.lift x) = s x

@[simp]
lemma mapM_pure (x : α) : (FreeMonad.pure x : FreeMonad f α).mapM s = pure x

@[simp]
lemma mapM_roll (x : f α) (r : α → FreeMonad f β) :
    (FreeMonad.roll x r).mapM s = s x >>= λ u ↦ (r u).mapM s

@[simp]
lemma depth_pure {x : α} : depth (pure x : FreeMonad f α) = 0

@[simp]
lemma depth_pure' {x : α} : depth (FreeMonad.pure x : FreeMonad f α) = 0

@[simp]
lemma depth_roll {x : f α} {r : α → FreeMonad f β} :
    depth (roll x r : FreeMonad f β) = 1 + iSup (λ u ↦ depth (r u))

lemma depth_bind_eq {x : FreeMonad f α} {g : α → FreeMonad f β} :
    depth (x >>= g) = depthBindAux x g

lemma depth_bind_le {x : FreeMonad f α} {g : α → FreeMonad f β} :
    depth (x >>= g) ≤ depth x + iSup (λ u ↦ depth (g u))

lemma depth_eq_zero_iff {x : FreeMonad f α} : depth x = 0 ↔ ∃ y, x = pure y

lemma depth_eq_one_iff {x : FreeMonad f α} : depth x = 1 ↔
    (∃ (β : Type u) (y : f β) (r : β → FreeMonad f α), x = roll y r ∧ ∀ u, depth (r u) = 0)

lemma tsum_run_some_eq_one_sub (p : SPMF α) :
    ∑' x, p.run (some x) = 1 - p.run none

@[simp] lemma tsum_run_some_ne_top (p : SPMF α) :
    ∑' x, p.run (some x) ≠ ⊤

lemma run_none_eq_one_sub (p : SPMF α) :
    p.run none = 1 - ∑' x, p.run (some x)

@[simp] lemma run_none_ne_top (p : SPMF α) : p.run none ≠ ⊤

@[ext] lemma ext {p q : SPMF α} (h : ∀ x : α, p.run (some x) = q.run (some x)) : p = q :=
  PMF.ext fun

@[simp] lemma apply_eq_run_some (p : SPMF α) (x : α) : p x = p.run (some x)

lemma apply'_none_eq_run (p : SPMF α) :
    let p' : PMF (Option α)

lemma probOutput_def (mx : m α) (x : α) : Pr[= x | mx] = (evalDist mx).run (some x)

lemma probEvent_def (mx : m α) (p : α → Prop) :
    Pr[p | mx] = (evalDist mx).run.toOuterMeasure (some '' {x | p x})

lemma probFailure_def (mx : m α) : Pr[⊥ | mx] = (evalDist mx).run none

@[simp] lemma evalDist_comp_pure : evalDist ∘ (pure : α → m α) = pure

@[simp] lemma evalDist_comp_pure' (f : α → β) : evalDist ∘ (pure : β → m β) ∘ f = pure ∘ f

@[simp] lemma probOutput_pure [DecidableEq α] (x y : α) :
    Pr[= x | (pure y : m α)] = if x = y then 1 else 0

@[simp] lemma evalDist_map [LawfulMonad m] (mx : m α) (f : α → β) :
    evalDist (f <$> mx) = f <$> (evalDist mx)

@[simp] lemma evalDist_comp_map [LawfulMonad m] (mx : m α) :
    evalDist ∘ (fun f => f <$> mx) = fun f : (α → β) => f <$> evalDist mx

@[simp] lemma evalDist_seq [LawfulMonad m] (mf : m (α → β)) (mx : m α) :
    evalDist (mf <*> mx) = evalDist mf <*> evalDist mx

@[simp] lemma evalDist_ite (p : Prop) [Decidable p] (mx mx' : m α) :
    evalDist (if p then mx else mx') = if p then evalDist mx else evalDist mx'

lemma probEvent_eq_tsum_indicator (mx : m α) (p : α → Prop) :
    Pr[p | mx] = ∑' x : α, {x | p x}.indicator (Pr[= · | mx]) x

lemma probEvent_eq_tsum_ite (mx : m α) (p : α → Prop) [DecidablePred p] :
    Pr[p | mx] = ∑' x : α, if p x then Pr[= x | mx] else 0

@[simp] lemma probFailure_add_tsum_probOutput (oa : m α) :
    Pr[⊥ | oa] + ∑' x, Pr[= x | oa] = 1

@[simp] lemma tsum_probOutput_add_probFailure (oa : m α) :
    ∑' x, Pr[= x | oa] + Pr[⊥ | oa] = 1

@[simp] lemma probOutput_le_one : Pr[= x | mx] ≤ 1

@[simp] lemma probOutput_ne_top : Pr[= x | mx] ≠ ∞

@[simp] lemma probOutput_lt_top : Pr[= x | mx] < ∞

@[simp] lemma not_one_lt_probOutput : ¬ 1 < Pr[= x | mx]

@[simp] lemma tsum_probOutput_le_one : ∑' x : α, Pr[= x | mx] ≤ 1

@[simp] lemma tsum_probOutput_ne_top : ∑' x : α, Pr[= x | mx] ≠ ⊤

@[simp] lemma probEvent_le_one : Pr[p | mx] ≤ 1

@[simp] lemma probEvent_ne_top : Pr[p | mx] ≠ ∞

@[simp] lemma probEvent_lt_top : Pr[p | mx] < ∞

@[simp] lemma not_one_lt_probEvent : ¬ 1 < Pr[p | mx]

@[simp] lemma probFailure_le_one : Pr[⊥ | mx] ≤ 1

@[simp] lemma probFailure_ne_top : Pr[⊥ | mx] ≠ ∞

@[simp] lemma probFailure_lt_top : Pr[⊥ | mx] < ∞

@[simp] lemma not_one_lt_probFailure : ¬ 1 < Pr[⊥ | mx]

@[simp] lemma one_le_probOutput_iff : 1 ≤ Pr[= x | mx] ↔ Pr[= x | mx] = 1

@[simp] lemma one_le_probEvent_iff : 1 ≤ Pr[p | mx] ↔ Pr[p | mx] = 1

@[simp] lemma one_le_probFailure_iff : 1 ≤ Pr[⊥ | mx] ↔ Pr[⊥ | mx] = 1

lemma probOutput_bind_eq_tsum (y : β) :
    Pr[= y | mx >>= my] = ∑' x : α, Pr[= x | mx] * Pr[= y | my x]

lemma probOutput_true_eq_probEvent {α} {m : Type → Type u} [Monad m] [HasEvalDist m]
    (mx : m α) (p : α → Prop) : Pr{let x ← mx}[p x] = Pr[p | mx]

@[simp] lemma evalDist_eq : evalDist p = p

@[simp] lemma probOutput_eq : probOutput p = p

@[simp] lemma probEvent_eq : probEvent p = p.run.toOuterMeasure ∘ Set.image some

@[simp] lemma probFailure_eq : probFailure p = p.run none

@[simp] lemma evalDist_eq : evalDist p = liftM p

@[simp] lemma probOutput_eq : probOutput p = p

@[simp] lemma probEvent_eq : probEvent p = p.toOuterMeasure

@[simp] lemma probFailure_eq : probFailure p = 0

@[simp]
lemma evalDist_orElse [h : spec.FiniteRange] (oa oa' : OracleComp spec α) :
    evalDist (oa <|> oa') = (evalDist oa <|> evalDist oa')

@[simp]
lemma probFailure_orElse {ι : Type u} {spec : OracleSpec ι} {α : Type u} [h : spec.FiniteRange]
    (oa oa' : OracleComp spec α) : [⊥ | oa <|> oa'] = [⊥ | oa] * [⊥ | oa']

@[simp]
lemma support_orElse {ι : Type u} {spec : OracleSpec ι} {α : Type u}
    (oa oa' : OracleComp spec α) [Decidable oa.neverFails] : (oa <|> oa').support =
      if oa.neverFails then oa.support else oa.support ∪ oa'.support

@[simp] lemma withCounting_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withCounting.impl q = tell (QueryCount.single q.index) *> ↑(so.impl q)

@[simp]
protected lemma impl_apply_eq (q : OracleQuery spec α) :
    countingOracle.impl q = (tell (QueryCount.single q.index) *> liftM q)

@[simp]
lemma fst_map_run_simulateQ (oa : OracleComp spec α) :
    Prod.fst <$> (simulateQ countingOracle oa).run = oa

@[simp]
lemma run_simulateQ_bind_fst (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    ((simulateQ countingOracle oa).run >>= fun x => ob x.1) = oa >>= ob

@[simp]
lemma probFailure_run_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    [⊥ | (simulateQ countingOracle oa).run] = [⊥ | oa]

@[simp]
lemma neverFails_run_simulateQ_iff (oa : OracleComp spec α) :
    neverFails (simulateQ countingOracle oa).run ↔ neverFails oa

@[simp]
theorem head_tails_eq (s : NonEmptyList α) : (tails s).head = s

theorem map_map (g : α → β) (h : β → γ) (nel : NonEmptyList α) : map h (map g nel) = map (h ∘ g) nel

@[simp]
theorem map_mk [Functor f] [Functor g] {α : Type u₁} {β : Type u₂} {a b : Type u₃} (k : a → b) (map' : α → β → a) (fa : f α) (gb : g β) :
  k <$> (⟨map', fa, gb⟩ : Day f g a) = ⟨fun x y => k (map' x y), fa, gb⟩

@[simp]
lemma probOutput_bitVec_ofFin_map {n : ℕ} (oa : OracleComp spec (Fin (2 ^ n)))
    (x : BitVec n) : [= x | ofFin <$> oa] = [= toFin x | oa]

@[simp]
lemma probOutput_bitVec_toFin_map {n : ℕ} (oa : OracleComp spec (BitVec n))
    (x : Fin (2 ^ n)) : [= x | toFin <$> oa] = [= ofFin x | oa]

@[simp]
lemma monadLift_eq_lift (x : P.Obj α) : (x : FreeM P α) = FreeM.lift x

@[simp]
lemma bind_pure (x : α) (r : α → FreeM P β) :
    FreeM.bind (FreeM.pure x) r = r x

@[simp]
lemma bind_roll (a : P.A) (r : P.B a → FreeM P β) (g : β → FreeM P γ) :
    FreeM.bind (FreeM.roll a r) g = FreeM.roll a (λ u ↦ FreeM.bind (r u) g)

@[simp]
lemma bind_lift (x : P.Obj α) (r : α → FreeM P β) :
    FreeM.bind (FreeM.lift x) r = FreeM.roll x.1 (fun a ↦ r (x.2 a))

@[simp]
lemma monad_pure_def (x : α) : (pure x : FreeM P α) = FreeM.pure x

@[simp]
lemma monad_bind_def (x : FreeM P α) (g : α → FreeM P β) :
    x >>= g = FreeM.bind x g

@[simp]
lemma construct_pure (y : α) : FreeM.construct h_pure h_roll (pure y) = h_pure y

@[simp]
lemma construct_roll (x : P.A) (r : P.B x → FreeM P α) :
    (FreeM.construct h_pure h_roll (FreeM.roll x r) : C (FreeM.roll x r)) =
      (h_roll x r (λ u ↦ FreeM.construct h_pure h_roll (r u)))

@[simp]
lemma mapM_lift [Monad m] [LawfulMonad m] (s : (a : P.A) → m (P.B a)) (x : P.Obj α) :
    FreeM.mapM s (FreeM.lift x) = s x.1 >>= (λ u ↦ (pure (x.2 u)).mapM s)

@[simp]
lemma mapM_pure (x : α) : (FreeM.pure x : FreeM P α).mapM s = Pure.pure x

@[simp]
lemma mapM_roll (x : P.A) (r : P.B x → FreeM P α) :
    (FreeM.roll x r).mapM s = s x >>= λ u ↦ (r u).mapM s

@[simp]
lemma evalDist_pure (x : α) : evalDist (pure x : OracleComp spec α) = pure x

@[simp]
lemma evalDist_liftM [Nonempty α] [Fintype α] (q : OracleQuery spec α) :
    evalDist (q : OracleComp spec α) = OptionT.lift (PMF.uniformOfFintype α)

@[simp]
lemma evalDist_query (i : ι) (t : spec.domain i) : evalDist (query i t : OracleComp spec _) =
    OptionT.lift (PMF.uniformOfFintype (spec.range i))

@[simp]
lemma evalDist_failure : evalDist (failure : OracleComp spec α) = failure

@[simp]
lemma evalDist_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    evalDist (oa >>= ob) = (evalDist oa) >>= (evalDist ∘ ob)

lemma evalDist_query_bind (i : ι) (t : spec.domain i) (ou : spec.range i → OracleComp spec α) :
    evalDist ((query i t : OracleComp spec _) >>= ou) =
      (OptionT.lift (PMF.uniformOfFintype (spec.range i))) >>= (evalDist ∘ ou)

@[simp]
lemma evalDist_map (oa : OracleComp spec α) (f : α → β) :
    evalDist (f <$> oa) = f <$> (evalDist oa)

@[simp]
lemma evalDist_seq (oa : OracleComp spec α) (og : OracleComp spec (α → β)) :
    evalDist (og <*> oa) = evalDist og <*> evalDist oa

@[simp]
lemma evalDist_eqRec (h : α = β) (oa : OracleComp spec α) :
    evalDist (h ▸ oa) = h ▸ evalDist oa

@[simp]
lemma evalDist_ite (p : Prop) [Decidable p] (oa oa' : OracleComp spec α) :
    evalDist (if p then oa else oa') = if p then evalDist oa else evalDist oa'

@[simp]
lemma evalDist_coin : evalDist coin = OptionT.lift (PMF.uniformOfFintype Bool)

@[simp]
lemma evalDist_uniformFin (n : ℕ) :
    evalDist $[0..n] = OptionT.lift (PMF.uniformOfFintype (Fin (n + 1)))

lemma probOutput_def (oa : OracleComp spec α) (x : α) :
    [= x | oa] = (evalDist oa).run (some x)

lemma evalDist_apply_some (oa : OracleComp spec α) (x : α) :
    (evalDist oa).run (some x) = [= x | oa]

@[simp]
lemma evalDist_comp_some (oa : OracleComp spec α) :
    (evalDist oa).run ∘ some = ([= · | oa])

lemma probFailure_def (oa : OracleComp spec α) :
    [⊥ | oa] = (evalDist oa).run none

lemma evalDist_apply_none (oa : OracleComp spec α) :
    (evalDist oa).run none = [⊥ | oa]

lemma probEvent_def (oa : OracleComp spec α) (p : α → Prop) :
    [p | oa] = (evalDist oa).run.toOuterMeasure (Option.some '' {x | p x})

lemma probEvent_eq_tsum_indicator (oa : OracleComp spec α) (p : α → Prop) :
    [p | oa] = ∑' x : α, {x | p x}.indicator ([= · | oa]) x

lemma probEvent_eq_tsum_ite (oa : OracleComp spec α) (p : α → Prop) [DecidablePred p] :
    [p | oa] = ∑' x : α, if p x then [= x | oa] else 0

@[simp]
lemma probFailure_add_tsum_probOutput (oa : OracleComp spec α) :
    [⊥ | oa] + ∑' x, [= x | oa] = 1

@[simp]
lemma tsum_probOutput_add_probFailure (oa : OracleComp spec α) :
    ∑' x, [= x | oa] + [⊥ | oa] = 1

@[simp] lemma probOutput_le_one : [= x | oa] ≤ 1

@[simp] lemma probFailure_le_one : [⊥ | oa] ≤ 1

@[simp] lemma tsum_probOutput_le_one : ∑' x : α, [= x | oa] ≤ 1

@[simp] lemma tsum_probOutput_ne_top : ∑' x : α, [= x | oa] ≠ ⊤

@[simp] lemma probEvent_le_one : [p | oa] ≤ 1

@[simp] lemma probOutput_ne_top : [= x | oa] ≠ ∞

@[simp] lemma probOutput_lt_top : [= x | oa] < ∞

@[simp] lemma not_one_lt_probOutput : ¬ 1 < [= x | oa]

@[simp] lemma probEvent_ne_top : [p | oa] ≠ ∞

@[simp] lemma probEvent_lt_top : [p | oa] < ∞

@[simp] lemma not_one_lt_probEvent : ¬ 1 < [p | oa]

@[simp] lemma probFailure_ne_top : [⊥ | oa] ≠ ∞

@[simp] lemma probFailure_lt_top : [⊥ | oa] < ∞

@[simp] lemma not_one_lt_probFailure : ¬ 1 < [⊥ | oa]

@[simp] lemma one_le_probOutput_iff : 1 ≤ [= x | oa] ↔ [= x | oa] = 1

@[simp] lemma one_le_probEvent_iff : 1 ≤ [p | oa] ↔ [p | oa] = 1

@[simp] lemma one_le_probFailure_iff : 1 ≤ [⊥ | oa] ↔ [⊥ | oa] = 1

lemma tsum_probOutput_eq_sub (oa : OracleComp spec α) :
    ∑' x : α, [= x | oa] = 1 - [⊥ | oa]

lemma sum_probOutput_eq_sub [Fintype α] (oa : OracleComp spec α) :
    ∑ x : α, [= x | oa] = 1 - [⊥ | oa]

lemma probFailure_eq_sub_tsum (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - ∑' x : α, [= x | oa]

lemma probFailure_eq_sub_sum [Fintype α] (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - ∑ x : α, [= x | oa]

lemma tsum_probOutput_eq_one (oa : OracleComp spec α) (h : [⊥ | oa] = 0) :
    ∑' x : α, [= x | oa] = 1

lemma sum_probOutput_eq_one [Fintype α] (oa : OracleComp spec α) (h : [⊥ | oa] = 0) :
    ∑ x : α, [= x | oa] = 1

@[simp]
lemma mem_support_evalDist_iff (oa : OracleComp spec α) (x : α) :
    some x ∈ (evalDist oa).run.support ↔ x ∈ oa.support

@[simp]
lemma mem_support_evalDist_iff' [spec.DecidableEq] [DecidableEq α]
    (oa : OracleComp spec α) (x : α) :
    some x ∈ (evalDist oa).run.support ↔ x ∈ oa.finSupport

@[simp]
lemma evalDist_apply_eq_zero_iff (x : Option α) :
    (evalDist oa).run x = 0 ↔ x.rec ([⊥ | oa] = 0) (· ∉ oa.support)

@[simp]
lemma evalDist_apply_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] (x : Option α) :
    (evalDist oa).run x = 0 ↔ x.rec ([⊥ | oa] = 0) (· ∉ oa.finSupport)

lemma support_evalDist : (evalDist oa).run.support = if [⊥ | oa] = 0 then
    some '' oa.support else insert none (some '' oa.support)

lemma support_evalDist' [spec.DecidableEq] [DecidableEq α] :
    (evalDist oa).run.support = if [⊥ | oa] = 0 then
      oa.finSupport.image some else insert none (oa.finSupport.image some)

@[simp low]
lemma probOutput_eq_zero_iff : [= x | oa] = 0 ↔ x ∉ oa.support

@[simp low]
lemma zero_eq_probOutput_iff : 0 = [= x | oa] ↔ x ∉ oa.support

@[simp]
lemma probOutput_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] :
    [= x | oa] = 0 ↔ x ∉ oa.finSupport

@[simp]
lemma zero_eq_probOutput_iff' [spec.DecidableEq] [DecidableEq α] :
    0 = [= x | oa] ↔ x ∉ oa.finSupport

lemma probOutput_ne_zero (h : x ∈ oa.support) : [= x | oa] ≠ 0

lemma probOutput_ne_zero' [DecidableEq α] (h : x ∈ oa.finSupport) : [= x | oa] ≠ 0

@[simp low]
lemma probEvent_eq_zero_iff : [p | oa] = 0 ↔ ∀ x ∈ oa.support, ¬ p x

@[simp low]
lemma zero_eq_probEvent_iff : 0 = [p | oa] ↔ ∀ x ∈ oa.support, ¬ p x

@[simp]
lemma probEvent_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] :
    [p | oa] = 0 ↔ ∀ x ∈ oa.finSupport, ¬ p x

@[simp]
lemma zero_eq_probEvent_iff' [spec.DecidableEq] [DecidableEq α] :
    0 = [p | oa] ↔ ∀ x ∈ oa.finSupport, ¬ p x

@[simp low]
lemma probOutput_pos_iff : 0 < [= x | oa] ↔ x ∈ oa.support

@[simp]
lemma probOutput_pos_iff' [spec.DecidableEq] [DecidableEq α] :
    0 < [= x | oa] ↔ x ∈ oa.finSupport

@[simp low]
lemma probEvent_pos_iff : 0 < [p | oa] ↔ ∃ x ∈ oa.support, p x

@[simp]
lemma probEvent_pos_iff' [spec.DecidableEq] [DecidableEq α] :
    0 < [p | oa] ↔ ∃ x ∈ oa.finSupport, p x

@[simp low]
lemma probOutput_eq_one_iff :
    [= x | oa] = 1 ↔ [⊥ | oa] = 0 ∧ oa.support = {x}

@[simp low]
lemma one_eq_probOutput_iff :
    1 = [= x | oa] ↔ [⊥ | oa] = 0 ∧ oa.support = {x}

@[simp]
lemma probOutput_eq_one_iff' [spec.DecidableEq] [DecidableEq α] :
    [= x | oa] = 1 ↔ [⊥ | oa] = 0 ∧ oa.finSupport = {x}

@[simp]
lemma one_eq_probOutput_iff' [spec.DecidableEq] [DecidableEq α] :
    1 = [= x | oa] ↔ [⊥ | oa] = 0 ∧ oa.finSupport = {x}

@[simp low]
lemma probEvent_eq_one_iff : [p | oa] = 1 ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.support, p x

@[simp low]
lemma one_eq_probEvent_iff : 1 = [p | oa] ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.support, p x

@[simp]
lemma probEvent_eq_one_iff' [spec.DecidableEq] [DecidableEq α] :
    [p | oa] = 1 ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.finSupport, p x

@[simp]
lemma one_eq_probEvent_iff' [spec.DecidableEq] [DecidableEq α] :
    1 = [p | oa] ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.finSupport, p x

lemma mem_support_iff_probOutput_ne_zero : x ∈ oa.support ↔ [= x | oa] ≠ 0

lemma mem_finSupport_iff_probOutput_ne_zero [spec.DecidableEq] [DecidableEq α] :
    x ∈ oa.finSupport ↔ [= x | oa] ≠ 0

lemma mem_support_iff_probOutput_pos : x ∈ oa.support ↔ 0 < [= x | oa]

lemma not_mem_support_iff_probOutput_eq_zero : x ∉ oa.support ↔ [= x | oa] = 0

lemma probEvent_mono (h : ∀ x ∈ oa.support, p x → q x) : [p | oa] ≤ [q | oa]

lemma probEvent_mono' [spec.DecidableEq] [DecidableEq α]
    (h : ∀ x ∈ oa.finSupport, p x → q x) : [p | oa] ≤ [q | oa]

lemma probEvent_congr {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h1 : ∀ x, p x ↔ q x) (h2 : evalDist oa = evalDist oa') : [p | oa] = [q | oa']

lemma probEvent_ext (h : ∀ x ∈ oa.support, p x ↔ q x) : [p | oa] = [q | oa]

lemma probEvent_ext' [spec.DecidableEq] [DecidableEq α]
    (h : ∀ x ∈ oa.finSupport, p x ↔ q x) : [p | oa] = [q | oa]

@[simp]
lemma function_support_probOutput : Function.support ([= · | oa]) = oa.support

lemma mem_support_iff_of_evalDist_eq {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h : evalDist oa = evalDist oa') (x : α) : x ∈ oa.support ↔ x ∈ oa'.support

lemma mem_finSupport_iff_of_evalDist_eq [spec.DecidableEq] [spec'.DecidableEq]
    [DecidableEq α] {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h : evalDist oa = evalDist oa') (x : α) : x ∈ oa.finSupport ↔ x ∈ oa'.finSupport

@[simp] lemma probEvent_eq_eq_probOutput (oa : OracleComp spec α) (x : α) :
    [(· = x) | oa] = [= x | oa]

@[simp] lemma probEvent_eq_eq_probOutput' (oa : OracleComp spec α) (x : α) :
    [(x = ·) | oa] = [= x | oa]

lemma probEvent_eq_tsum_subtype : [p | oa] = ∑' x : {x | p x}, [= x | oa]

lemma probEvent_eq_tsum_subtype_mem_support :
    [p | oa] = ∑' x : {x ∈ oa.support | p x}, [= x | oa]

lemma probEvent_eq_tsum_subtype_support_ite [DecidablePred p] :
    [p | oa] = ∑' x : oa.support, if p x then [= x | oa] else 0

lemma probEvent_eq_sum_fintype_indicator [Fintype α] (oa : OracleComp spec α) (p : α → Prop) :
    [p | oa] = ∑ x : α, {x | p x}.indicator ([= · | oa]) x

lemma probEvent_eq_sum_fintype_ite [DecidablePred p] [Fintype α] :
    [p | oa] = ∑ x : α, if p x then [= x | oa] else 0

lemma probEvent_eq_sum_filter_univ [DecidablePred p] [Fintype α] :
    [p | oa] = ∑ x ∈ Finset.univ.filter p, [= x | oa]

lemma probEvent_eq_sum_filter_finSupport [spec.DecidableEq] [DecidablePred p] [DecidableEq α] :
    [p | oa] = ∑ x ∈ oa.finSupport.filter p, [= x | oa]

lemma probEvent_eq_sum_finSupport_ite [spec.DecidableEq] [DecidablePred p] [DecidableEq α] :
    [p | oa] = ∑ x ∈ oa.finSupport, if p x then [= x | oa] else 0

lemma probOutput_congr {x y : α} {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h1 : x = y) (h2 : evalDist oa = evalDist oa') : [= x | oa] = [= y | oa']

lemma probEvent_congr' {p q : α → Prop} {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h1 : ∀ x, x ∈ oa.support → x ∈ oa'.support → (p x ↔ q x))
    (h2 : evalDist oa = evalDist oa') : [p | oa] = [q | oa']

@[simp] lemma probEvent_const (oa : OracleComp spec α) (p : Prop) [Decidable p] :
    [λ _ ↦ p | oa] = if p then 1 - [⊥ | oa] else 0

lemma probEvent_true (oa : OracleComp spec α) : [λ _ ↦ true | oa] = 1 - [⊥ | oa]

lemma probEvent_false (oa : OracleComp spec α) : [λ _ ↦ false | oa] = 0

lemma probFailure_eq_sub_probEvent (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - [λ _ ↦ true | oa]

lemma evalDist_ext_probEvent {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h : ∀ x, [= x | oa] = [= x | oa']) : (evalDist oa).run = (evalDist oa').run :=
  PMF.ext λ x ↦ match x with

@[simp]
lemma probOutput_pure [DecidableEq α] (y : α) :
    [= y | (pure x : OracleComp spec α)] = if y = x then 1 else 0

@[simp]
lemma probFailure_pure : [⊥ | (pure x : OracleComp spec α)] = 0

lemma probOutput_pure_eq_zero {x y : α} (h : y ≠ x) :
    [= y | (pure x : OracleComp spec α)] = 0

lemma probOutput_pure_eq_one {x y : α} (h : y = x) :
    [= y | (pure x : OracleComp spec α)] = 1

@[simp]
lemma probOutput_pure_self (x : α) : [= x | (pure x : OracleComp spec α)] = 1

@[simp]
lemma probOutput_pure_subsingleton [Subsingleton α] (x y : α) :
    [= x | (pure y : OracleComp spec α)] = 1

@[simp]
lemma probEvent_pure (p : α → Prop) [DecidablePred p] :
    [p | (pure x : OracleComp spec α)] = if p x then 1 else 0

lemma probEvent_pure_eq_zero {p : α → Prop} {x : α} (h : ¬ p x) :
    [p | (pure x : OracleComp spec α)] = 0

lemma probEvent_pure_eq_one {p : α → Prop} {x : α} (h : p x) :
    [p | (pure x : OracleComp spec α)] = 1

lemma probOutput_bind_eq_tsum (y : β) :
    [= y | oa >>= ob] = ∑' x : α, [= x | oa] * [= y | ob x]

lemma probFailure_bind_eq_tsum :
    [⊥ | oa >>= ob] = [⊥ | oa] + ∑' x : α, [= x | oa] * [⊥ | ob x]

lemma probEvent_bind_eq_tsum (q : β → Prop) :
    [q | oa >>= ob] = ∑' x : α, [= x | oa] * [q | ob x]

lemma probOutput_bind_eq_tsum_subtype (y : β) :
    [= y | oa >>= ob] = ∑' x : oa.support, [= x | oa] * [= y | ob x]

lemma probEvent_bind_eq_tsum_subtype (q : β → Prop) :
    [q | oa >>= ob] = ∑' x : oa.support, [= x | oa] * [q | ob x]

lemma probOutput_bind_eq_sum_fintype [Fintype α] (y : β) :
    [= y | oa >>= ob] = ∑ x : α, [= x | oa] * [= y | ob x]

lemma probFailure_bind_eq_sum_fintype [Fintype α] :
    [⊥ | oa >>= ob] = [⊥ | oa] + ∑ x : α, [= x | oa] * [⊥ | ob x]

lemma probEvent_bind_eq_sum_fintype [Fintype α] (q : β → Prop) :
    [q | oa >>= ob] = ∑ x : α, [= x | oa] * [q | ob x]

lemma probOutput_bind_eq_sum_finSupport [spec.DecidableEq] [DecidableEq α] (y : β) :
    [= y | oa >>= ob] = ∑ x ∈ oa.finSupport, [= x | oa] * [= y | ob x]

lemma probEvent_bind_eq_sum_finSupport [spec.DecidableEq] [DecidableEq α]
    (q : β → Prop) :
    [q | oa >>= ob] = ∑ x ∈ oa.finSupport, [= x | oa] * [q | ob x]

lemma probOutput_bind_of_const (y : β) (r : ℝ≥0∞) (h : ∀ x, [= y | ob x] = r) :
    [= y | oa >>= ob] = (1 - [⊥ | oa]) * r

lemma probFailure_bind_of_const [Nonempty α] (r : ℝ≥0∞) (h : ∀ x, [⊥ | ob x] = r) :
    [⊥ | oa >>= ob] = [⊥ | oa] + r - [⊥ | oa] * r

lemma probFailure_bind_eq_sub_mul {oa : OracleComp spec α} {ob : α → OracleComp spec β}
    (r : ℝ≥0∞) (h : ∀ x, [⊥ | ob x] = r) :
    [⊥ | oa >>= ob] = 1 - (1 - [⊥ | oa]) * (1 - r)

lemma probFailure_bind_le_of_forall {oa : OracleComp spec α} {s : ℝ≥0∞}
    -- TODO: this should be a general type of `uniformOutput` computations
    (h' : [⊥ | oa] = s) (ob : α → OracleComp spec β) {r : ℝ≥0∞}
    (hr : ∀ x ∈ oa.support, [⊥ | ob x] ≤ r) : [⊥ | oa >>= ob] ≤ s + (1 - s) * r

lemma probFailure_bind_le_of_forall' {oa : OracleComp spec α} {s : ℝ≥0∞}
    -- TODO: this should be a general type of `uniformOutput` computations
    (h' : [⊥ | oa] = s) (ob : α → OracleComp spec β) {r : ℝ≥0∞}
    (hr : ∀ x ∈ oa.support, [⊥ | ob x] ≤ r) : [⊥ | oa >>= ob] ≤ s + r

lemma probFailure_bind_le_of_le_of_neverFails {oa : OracleComp spec α}
    (h' : oa.neverFails) {ob : α → OracleComp spec β} {r : ℝ≥0∞}
    (hr : ∀ x ∈ oa.support, [⊥ | ob x] ≤ r) : [⊥ | oa >>= ob] ≤ r

lemma probFailure_bind_of_neverFails {oa : OracleComp spec α}
    (h : neverFails oa) (ob : α → OracleComp spec β) :
    [⊥ | oa >>= ob] = ∑' x : α, [= x | oa] * [⊥ | ob x]

lemma mul_le_probEvent_bind {oa : OracleComp spec α} {ob : α → OracleComp spec β}
    {p : α → Prop} {q : β → Prop} {r r' : ℝ≥0∞}
    (h : r ≤ [p | oa]) (h' : ∀ x ∈ oa.support, p x → r' ≤ [q | ob x]) :
    r * r' ≤ [q | oa >>= ob]

@[simp]
lemma probOutput_liftM [Fintype α] (q : OracleQuery spec α) (u : α) :
    [= u | (q : OracleComp spec α)] = (Fintype.card α : ℝ≥0∞)⁻¹

lemma probOutput_query (u : spec.range i) :
    [= u | (query i t : OracleComp spec _)] = (Fintype.card (spec.range i) : ℝ≥0∞)⁻¹

@[simp]
lemma probFailure_liftM (q : OracleQuery spec α) :
    [⊥ | (q : OracleComp spec _)] = 0

lemma probFailure_query : [⊥ | (query i t : OracleComp spec _)] = 0

@[simp]
lemma probEvent_liftM_eq_mul_inv [Fintype α] (q : OracleQuery spec α)
    (p : α → Prop) [DecidablePred p] : [p | (q : OracleComp spec _)] =
      (Finset.univ.filter p).card * (↑(Fintype.card α))⁻¹

lemma probEvent_query_eq_mul_inv (p : spec.range i → Prop) [DecidablePred p] :
    [p | (query i t : OracleComp spec _)] =
      (Finset.univ.filter p).card * (↑(Fintype.card (spec.range i)))⁻¹

lemma probEvent_liftM_eq_inv_mul [Fintype α] (q : OracleQuery spec α)
    (p : α → Prop) [DecidablePred p] : [p | (q : OracleComp spec _)] =
      (↑(Fintype.card α))⁻¹ * (Finset.univ.filter p).card

lemma probEvent_query_eq_inv_mul [spec.DecidableEq] (p : spec.range i → Prop) [DecidablePred p] :
    [p | (query i t : OracleComp spec _)] =
      (↑(Fintype.card (spec.range i)))⁻¹ * (Finset.univ.filter p).card

lemma probEvent_liftM_eq_div [Fintype α] (q : OracleQuery spec α)
    (p : α → Prop) [DecidablePred p] : [p | (q : OracleComp spec _)] =
      (Finset.univ.filter p).card / (Fintype.card α)

lemma probEvent_query_eq_div [spec.DecidableEq] (p : spec.range i → Prop) [DecidablePred p] :
    [p | (query i t : OracleComp spec _)] =
      (Finset.univ.filter p).card / (Fintype.card (spec.range i))

@[simp]
lemma probOutput_failure (x : α) : [= x | (failure : OracleComp spec α)] = 0

@[simp]
lemma probFailure_failure : [⊥ | (failure : OracleComp spec α)] = 1

@[simp]
lemma probEvent_failure (p : α → Prop) :
    [p | (failure : OracleComp spec α)] = 0

lemma probOutput_map_eq_tsum_subtype (y : β) :
    [= y | f <$> oa] = ∑' x : {x ∈ oa.support | y = f x}, [= x | oa]

lemma probOutput_map_eq_tsum (y : β) :
    [= y | f <$> oa] = ∑' x, [= x | oa] * [= y | (pure (f x) : OracleComp spec β)]

lemma probOutput_map_eq_tsum_subtype_ite [DecidableEq β] (y : β) :
    [= y | f <$> oa] = ∑' x : oa.support, if y = f x then [= x | oa] else 0

lemma probOutput_map_eq_tsum_ite [DecidableEq β] (y : β) :
    [= y | f <$> oa] = ∑' x : α, if y = f x then [= x | oa] else 0

lemma probOutput_map_eq_sum_fintype_ite [Fintype α] [DecidableEq β] (y : β) :
    [= y | f <$> oa] = ∑ x : α, if y = f x then [= x | oa] else 0

lemma probOutput_map_eq_sum_finSupport_ite [spec.DecidableEq] [DecidableEq α] [DecidableEq β]
    (y : β) : [= y | f <$> oa] = ∑ x ∈ oa.finSupport, if y = f x then [= x | oa] else 0

lemma probOutput_map_eq_sum_filter_finSupport [spec.DecidableEq] [DecidableEq α] [DecidableEq β]
    (y : β) : [= y | f <$> oa] = ∑ x ∈ oa.finSupport.filter (y = f ·), [= x | oa]

@[simp]
lemma probFailure_map : [⊥ | f <$> oa] = [⊥ | oa]

@[simp]
lemma probEvent_map (q : β → Prop) : [q | f <$> oa] = [q ∘ f | oa]

lemma probEvent_comp (q : β → Prop) : [q ∘ f | oa] = [q | f <$> oa]

lemma probOutput_map_eq_probOutput_inverse (f : α → β) (g : β → α)
    (hl : Function.LeftInverse f g) (hr : Function.RightInverse f g)
    (y : β) : [= y | f <$> oa] = [= g y | oa]

lemma probFailure_eq_sub_sum_probOutput_map [Fintype β] (oa : OracleComp spec α) (f : α → β) :
    [⊥ | oa] = 1 - ∑ y : β, [= y | f <$> oa]

@[simp]
lemma probFailure_eq_zero_iff (oa : OracleComp spec α) : [⊥ | oa] = 0 ↔ oa.neverFails

@[simp]
lemma probFailure_pos_iff (oa : OracleComp spec α) : 0 < [⊥ | oa] ↔ ¬ oa.neverFails

lemma noFailure_of_probFailure_eq_zero {oa : OracleComp spec α} (h : [⊥ | oa] = 0) :
    neverFails oa

lemma not_noFailure_of_probFailure_pos {oa : OracleComp spec α} (h : 0 < [⊥ | oa]) :
    ¬ neverFails oa

@[simp]
lemma probOutput_guard {p : Prop} [Decidable p] :
    [= () | (guard p : OracleComp spec _)] = if p then 1 else 0

@[simp]
lemma probFailure_guard {p : Prop} [Decidable p] :
    [⊥ | (guard p : OracleComp spec _)] = if p then 0 else 1

lemma probOutput_eq_sub_probFailure_of_unit {oa : OracleComp spec PUnit} :
    [= () | oa] = 1 - [⊥ | oa]

lemma probOutput_guard_eq_sub_probOutput_guard_not {α : Type} {oa : OracleComp spec α}
    (h : oa.neverFails) {p : α → Prop} [DecidablePred p] :
    [= () | do let a ← oa; guard (p a)] = 1 - [= () | do let a ← oa; guard (¬ p a)]

lemma probOutput_true_eq_probOutput_false_not {ob : OracleComp spec Bool} :
    [= true | ob] = [= false | do let b ← ob; return !b]

lemma probOutput_false_eq_probOutput_true_not {ob : OracleComp spec Bool} :
    [= false | ob] = [= true | do let b ← ob; return !b]

lemma probOutput_eqRec (y : β) : [= y | h ▸ oa] = [= h ▸ y | oa]

@[simp] lemma probFailure_eqRec : [⊥ | h ▸ oa] = [⊥ | oa]

lemma probEvent_eqRec (q : β → Prop) :
    [q | h ▸ oa] = [λ x ↦ q (h ▸ x) | oa]

@[simp]
lemma probOutput_ite (x : α) : [= x | if p then oa else oa'] =
    if p then [= x | oa] else [= x | oa']

@[simp]
lemma probFailure_ite : [⊥ | if p then oa else oa'] =
    if p then [⊥ | oa] else [⊥ | oa']

@[simp]
lemma probEvent_ite (q : α → Prop) : [q | if p then oa else oa'] =
    if p then [q | oa] else [q | oa']

@[simp]
lemma probOutput_coin (b : Bool) : [= b | coin] = 2⁻¹

lemma probEvent_coin_eq_sum_subtype (p : Bool → Prop) :
    [p | coin] = ∑' _ : {x | p x}, 2⁻¹

@[simp]
lemma probEvent_coin (p : Bool → Prop) [DecidablePred p] : [p | coin] =
    if p true then (if p false then 1 else 2⁻¹) else (if p false then 2⁻¹ else 0)

lemma probEvent_coin_eq_add (p : Bool → Prop) [DecidablePred p] :
    [p | coin] = (if p true then 2⁻¹ else 0) + (if p false then 2⁻¹ else 0)

@[simp]
lemma probOutput_uniformFin (x : Fin (n + 1)) : [= x | $[0..n]] = ((n : ℝ≥0∞) + 1)⁻¹

@[simp]
lemma probFailure_uniformFin : [⊥ | $[0..n]] = 0

@[simp]
lemma probEvent_uniformFin (p : Fin (n + 1) → Prop) [DecidablePred p] :
    [p | $[0..n]] = (Finset.univ.filter p).card * (n + 1 : ℝ≥0∞)⁻¹

@[simp] theorem id_mapᵣ' [RelativeFunctor j f] [LawfulRelativeFunctor j f] (x : f α) :
    (fun a : j α => a) <$>ᵣ x = x

@[simp] theorem RelativeFunctor.map_map [RelativeFunctor j f] [LawfulRelativeFunctor j f]
    (h : j α → j β) (g : j β → j γ) (x : f α) :
      g <$>ᵣ h <$>ᵣ x = (fun a => g (h a)) <$>ᵣ x

@[simp] theorem bind_pureᵣ [RelativeMonad j m] [LawfulRelativeMonad j m] (x : m α) :
    x >>=ᵣ pureᵣ (j := j) = x

theorem map_eq_pure_bindᵣ [RelativeMonad j m] [LawfulRelativeMonad j m]
    (f : j α → j β) (x : m α) : f <$>ᵣ x = x >>=ᵣ fun a => pureᵣ (f a)

theorem bind_congrᵣ [RelativeBind j m] {x : m α} {f g : j α → m β} (h : ∀ a, f a = g a) :
    x >>=ᵣ f = x >>=ᵣ g

theorem bind_pure_unitᵣ [RelativeMonad j m] [LawfulRelativeMonad j m] {x : m PUnit} :
    (x >>=ᵣ fun y : j PUnit => pureᵣ y) = x

theorem map_congrᵣ [RelativeFunctor j m] {x : m α} {f g : j α → j β} (h : ∀ a, f a = g a) :
    (f <$>ᵣ x : m β) = g <$>ᵣ x

@[simp] theorem map_bindᵣ [RelativeMonad j m] [LawfulRelativeMonad j m]
    (f : j β → j γ) (x : m α) (g : j α → m β) :
      f <$>ᵣ (x >>=ᵣ g) = x >>=ᵣ fun a : j α => f <$>ᵣ g a

@[simp] theorem bind_map_leftᵣ [RelativeMonad j m] [LawfulRelativeMonad j m]
    (f : j α → j β) (x : m α) (g : j β → m γ) :
      ((f <$>ᵣ x) >>=ᵣ fun b => g b) = (x >>=ᵣ fun a : j α => g (f a))

theorem RelativeFunctor.map_unitᵣ [RelativeMonad j m] [LawfulRelativeMonad j m] {a : m PUnit} :
    (fun y : j PUnit => y) <$>ᵣ a = a

lemma relax_p_bound {p χ m: ℕ} [hm : NeZero m] (h : p > 4 * (χ * m + 1)) : p > 2 * χ

@[simp]
lemma Fin_Bound_modulus {n : ℕ} (x : Fin n) : Fin_Bound x n

@[simp]
lemma Fin_Bound_ge {n b₁ b₂ : ℕ} {x : Fin n} (h : Fin_Bound x b₁)
 (g : b₁ ≤ b₂) : Fin_Bound x b₂

@[simp]
lemma Fin_bound_zero {n : ℕ} (x : Fin n) : Fin_Bound x 0 ↔ x.val = 0

@[simp]
lemma Fin_Bound_add {n b₁ b₂ : ℕ} {x y : Fin n} (h₁ : Fin_Bound x b₁)
 (h₂ : Fin_Bound y b₂) : Fin_Bound (x + y) (b₁ + b₂)

lemma Fin_bound_mul_helper {n b₁ b₂ : ℕ} {x y : Fin n} (h : b₁ * b₂ < n)
  (h₁ : x.val ≤ b₁) (h₂ : y.val + b₂ ≥ n) : Fin_Bound (x * y) (b₁ * b₂)

@[simp]
lemma Fin_Bound_mul {n b₁ b₂ : ℕ} {x y : Fin n} (h₁ : Fin_Bound x b₁)
 (h₂ : Fin_Bound y b₂) : Fin_Bound (x * y) (b₁ * b₂)

@[simp]
lemma Fin_bound_neg {n b : ℕ} {x : Fin n} (h : Fin_Bound x b) :
  Fin_Bound (-x) b

lemma Fin_bound_dotprod {p m b₁ b₂ : ℕ} {v₁ v₂ : Vector (Fin p) m}
(h1 : Fin_Bound_vec v₁ b₁) (h2 : Fin_Bound_vec v₂ b₂) (Nez : NeZero p) :
  Fin_Bound (dotProduct v₁.get v₂.get) (b₁ * b₂ * m)

@[simp]
lemma Fin_bound_castLE {n m : ℕ} {x : Fin (n + 1)} {h : n < m} :
  Fin_Bound (Fin.castLE h x) n

lemma IntLE_imp_NatLE {a b : ℕ} (h : (a : ℤ) ≤ (b : ℤ)) : a ≤ b

lemma Fin_bound_shift_cast {p χ} {a : Fin (2*χ + 1)} [NeZero p] (h : p > 2*χ) :
    Fin_Bound (Fin.castLE h a - (Fin.ofNat p χ)) χ

lemma Fin_bound_shift_cast_vec {p χ m : ℕ} {v : Vector (Fin (2*χ + 1)) m} [NeZero p] (h : p > 2*χ) :
    Fin_Bound_vec (v.map (fun t ↦ (Fin.castLE h t) - (Fin.ofNat p χ))) χ

theorem isCorrect_of_uniformErrSamp [hm : NeZero m] (χ : ℕ) (he: p > 4*(χ*m + 1)) :
    (regevAsymmEnc n m p (uniformErrSamp χ (relax_p_bound he))).PerfectlyCorrect

theorem Hybrid_0_ind_Hybrid_1 :
    (Hybrid_0 adv).advantage' ≤ (Hybrid_1 adv).advantage'
      + (LWE_Advantage n m p (uniformErrSamp χ (relax_p_bound he)) (Hybrid_01_Reduction adv))

theorem Hybrid_1_ind_Hybrid_2 :
    (Hybrid_1 adv).advantage' ≤ (Hybrid_2 adv).advantage'
      + (LHL_Consequence_Advantage (m := m) (Hybrid_12_Reduction adv))

theorem Hybrid_2_advantage_zero : (Hybrid_2 adv).advantage' = 0

theorem IND_CPA_advantage_le :
  IND_CPA_OneTime_Advantage (encAlg := uniformRegevAsymmEnc n m p χ he) adv ≤
    (LWE_Advantage n m p (uniformErrSamp χ (relax_p_bound he)) (Hybrid_01_Reduction adv))
      + (LHL_Consequence_Advantage (m := m) (Hybrid_12_Reduction adv))

@[simp] theorem liftM_failure [Alternative m] [Alternative n] [MonadLift m n]
    [LawfulAlternativeLift m n] : liftM (failure : m α) = (failure : n α)

@[simp] theorem liftM_orElse [Alternative m] [Alternative n] [MonadLift m n]
    [LawfulAlternativeLift m n] (x y : m α) : liftM (x <|> y) = (liftM x <|> liftM y : n α)

theorem monadLift_guard [AlternativeMonad m] [AlternativeMonad n] [MonadLift m n]
    [LawfulAlternativeLift m n] [LawfulMonadLift m n] (p : Prop) [Decidable p] :
    monadLift (guard p : m Unit) = (guard p : n Unit)

@[simp] theorem liftM_guard [AlternativeMonad m] [AlternativeMonad n] [MonadLift m n]
    [LawfulAlternativeLift m n] [LawfulMonadLift m n] (p : Prop) [Decidable p] :
    liftM (guard p : m Unit) = (guard p : n Unit)

theorem monadLift_optional [AlternativeMonad m] [AlternativeMonad n]
    [LawfulMonad m] [LawfulMonad n] [MonadLift m n] [LawfulAlternativeLift m n]
    [LawfulMonadLift m n]
    (x : m α) : monadLift (optional x) = optional (monadLift x : n α)

@[simp] theorem liftM_optional [AlternativeMonad m] [AlternativeMonad n]
    [LawfulMonad m] [LawfulMonad n] [MonadLift m n] [LawfulAlternativeLift m n]
    [LawfulMonadLift m n]
    (x : m α) : liftM (optional x) = optional (liftM x : n α)

theorem monadLift_elimM [Monad m] [Monad n] [LawfulMonad m] [LawfulMonad n]
    [MonadLift m n] [LawfulMonadLift m n] (x : m (Option α)) (y : m β) (z : α → m β) :
      monadLift (Option.elimM x y z) =
        Option.elimM (monadLift x : n (Option α)) (monadLift y) (fun x => monadLift (z x))

@[simp]
theorem liftM_elimM [Monad m] [Monad n] [LawfulMonad m] [LawfulMonad n]
    [MonadLift m n] [LawfulMonadLift m n] (x : m (Option α)) (y : m β) (z : α → m β) :
      liftM (Option.elimM x y z) = Option.elimM (x : n (Option α)) (y) (fun x => z x)

lemma support_def (oa : OracleComp spec α) :
    oa.support = oa.supportWhen fun _ => Set.univ

lemma finSupport_def [∀ i, Fintype (spec.range i)] [DecidableEq α] (oa : OracleComp spec α) :
    oa.finSupport = oa.finSupportWhen fun

@[simp] lemma supportWhen_pure (x : α) :
    (pure x : OracleComp spec α).supportWhen poss = {x}

@[simp] lemma support_pure (x : α) :
    (pure x : OracleComp spec α).support = {x}

@[simp] lemma finSupportWhen_pure [DecidableEq α] (x : α) :
    (pure x : OracleComp spec α).finSupportWhen fin_poss = {x}

@[simp] lemma finSupport_pure [spec.FiniteRange] [DecidableEq α] (x : α) :
    (pure x : OracleComp spec α).finSupport = {x}

@[simp] lemma supportWhen_failure : (failure : OracleComp spec α).supportWhen poss = ∅

@[simp] lemma support_failure : (failure : OracleComp spec α).support = ∅

@[simp] lemma finSupportWhen_failure [DecidableEq α] :
    (failure : OracleComp spec α).finSupportWhen fin_poss = ∅

@[simp] lemma finSupport_failure [spec.FiniteRange] [DecidableEq α] :
    (failure : OracleComp spec α).finSupport = ∅

@[simp] lemma supportWhen_query (q : OracleQuery spec α) :
    (q : OracleComp spec α).supportWhen poss = poss q

@[simp] lemma support_query (q : OracleQuery spec α) :
    (q : OracleComp spec α).support = Set.univ

@[simp] lemma finSupportWhen_query [DecidableEq α] (q : OracleQuery spec α) :
    (q : OracleComp spec α).finSupportWhen fin_poss = fin_poss q

lemma finSupport_query [spec.FiniteRange] [DecidableEq α] (q : OracleQuery spec α) :
    (q : OracleComp spec _).finSupport = match q with

@[simp] lemma supportWhen_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).supportWhen poss = ⋃ x ∈ poss q, (ob x).supportWhen poss

@[simp] lemma support_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).support = ⋃ x, (ob x).support

@[simp] lemma finSupportWhen_query_bind [DecidableEq β]
    (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).finSupportWhen fin_poss =
      (fin_poss q).biUnion fun x => (ob x).finSupportWhen fin_poss

@[simp] lemma finSupport_query_bind [spec.FiniteRange] [Fintype α] [DecidableEq β]
    (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).finSupport = Finset.univ.biUnion fun x => (ob x).finSupport

@[simp] lemma supportWhen_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).supportWhen poss = ⋃ x ∈ oa.supportWhen poss, (ob x).supportWhen poss

@[simp] lemma support_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).support = ⋃ x ∈ oa.support, (ob x).support

@[simp] lemma finSupportWhen_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β)
    [DecidableEq α] [DecidableEq β] :
    (oa >>= ob).finSupportWhen fin_poss =
      (oa.finSupportWhen fin_poss).biUnion fun x => (ob x).finSupportWhen fin_poss

@[simp] lemma finSupport_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β)
    [hα : DecidableEq α] [hβ : DecidableEq β] [spec.FiniteRange] :
    (oa >>= ob).finSupport = oa.finSupport.biUnion (λ x ↦ (ob x).finSupport)

lemma mem_support_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) (y : β) :
    y ∈ (oa >>= ob).support ↔ ∃ x ∈ oa.support, y ∈ (ob x).support

lemma mem_finSupport_bind_iff [spec.FiniteRange]
    (oa : OracleComp spec α) (ob : α → OracleComp spec β)
    [hoa : DecidableEq α] [hob : DecidableEq β] (y : β) : y ∈ (oa >>= ob).finSupport ↔
      ∃ x ∈ oa.finSupport, y ∈ (ob x).finSupport

@[simp]
lemma coe_finSupport [spec.FiniteRange] [DecidableEq α]
    (oa : OracleComp spec α) : ↑oa.finSupport = oa.support

lemma finSupport_eq_iff_support_eq_coe : oa.finSupport = s ↔ oa.support = ↑s

lemma eq_finSupport_iff_coe_eq_support : s = oa.finSupport ↔ ↑s = oa.support

lemma finSupport_subset_iff_support_subset_coe : oa.finSupport ⊆ s ↔ oa.support ⊆ ↑s

lemma subset_finSupport_iff_coe_subset_support : s ⊆ oa.finSupport ↔ ↑s ⊆ oa.support

lemma mem_finSupport_iff_mem_support (x : α) : x ∈ oa.finSupport ↔ x ∈ oa.support

lemma mem_finSupport_of_mem_support {x : α} (hx : x ∈ oa.support) : x ∈ oa.finSupport

lemma mem_support_of_mem_finSupport {x : α} (hx : x ∈ oa.finSupport) : x ∈ oa.support

@[simp] lemma support_eqRec (oa : OracleComp spec α) (h : α = β) :
    (h ▸ oa).support = h.symm ▸ oa.support

@[simp] lemma finSupport_eqRec [spec.DecidableEq] [spec.FiniteRange]
    [hα : DecidableEq α] [hβ : DecidableEq β] (oa : OracleComp spec α) (h : α = β) :
    @finSupport _ _ _ _ hβ (h ▸ oa : OracleComp spec β) =
      h.symm ▸ @finSupport _ _ _ _ hα oa

lemma mem_support_eqRec_iff (oa : OracleComp spec α) (h : α = β) (y : β) :
    y ∈ (h ▸ oa).support ↔ h.symm ▸ y ∈ oa.support

@[simp] lemma support_map (oa : OracleComp spec α) (f : α → β) :
    (f <$> oa).support = f '' oa.support

@[simp] lemma fin_support_map [spec.DecidableEq] [spec.FiniteRange]
    [DecidableEq α] [DecidableEq β] (oa : OracleComp spec α) (f : α → β) :
    (f <$> oa).finSupport = oa.finSupport.image f

lemma mem_support_map {oa : OracleComp spec α} {x : α}
    (hx : x ∈ oa.support) (f : α → β) : f x ∈ (f <$> oa).support

@[simp] lemma support_ite (p : Prop) [Decidable p] (oa oa' : OracleComp spec α) :
    (if p then oa else oa').support = if p then oa.support else oa'.support

@[simp] lemma finSupport_ite [spec.DecidableEq] [spec.FiniteRange] [DecidableEq α]
    (p : Prop) [Decidable p] (oa oa' : OracleComp spec α) :
    (if p then oa else oa').finSupport = if p then oa.finSupport else oa'.finSupport

@[simp] lemma support_coin : coin.support = {true, false}

@[simp] lemma finSupport_coin : coin.finSupport = {true, false}

@[simp] lemma support_uniformFin (n : ℕ) : ($[0..n]).support = Set.univ

@[simp] lemma finSupport_uniformFin (n : ℕ) : ($[0..n]).finSupport = Finset.univ :=
  finSupport_query _

example : support (do
    let b ← coin; let b' ← coin
    let x ← (if b && b' then return 0 else return 1);
    let z ← (if b && b' then return x else return 0);
    return (x * z)) = {0}

@[simp]
lemma replicate_zero : replicate 0 oa = return []

@[simp]
lemma replicateTR_zero : replicate 0 oa = return []

@[simp]
lemma replicate_succ : replicate (n + 1) oa = List.cons <$> oa <*> replicate n oa

@[simp]
lemma replicate_pure (x : α) :
    (pure x : OracleComp spec α).replicate n = pure (List.replicate n x)

@[simp]
lemma probFailure_replicate [spec.FiniteRange] :
    [⊥ | oa.replicate n] = 1 - (1 - [⊥ | oa]) ^ n

@[simp]
lemma probOutput_replicate [spec.FiniteRange] (xs : List α) :
    [= xs | oa.replicate n] = if xs.length = n then (xs.map ([= · | oa])).prod else 0

lemma probEvent_replicate_of_probEvent_cons [spec.FiniteRange]
    (p : List α → Prop) (hp : p []) (q : α → Prop) (hq : ∀ x xs, p (x :: xs) ↔ q x ∧ p xs) :
    [p | oa.replicate n] = [q | oa] ^ n

@[simp]
lemma probEvent_all_replicate [spec.FiniteRange] (oa : OracleComp spec α) (n : ℕ) (p : α → Bool) :
    [λ xs ↦ List.all xs p | oa.replicate n] = [λ x ↦ p x | oa] ^ n

lemma support_eq_setOf_probOutput_eq_zero [spec.FiniteRange] (oa : OracleComp spec α) :
    oa.support = {x | [= x | oa] ≠ 0}

@[simp]
lemma support_replicate [spec.FiniteRange] (oa : OracleComp spec α) (n : ℕ) :
    (oa.replicate n).support = {xs | xs.length = n ∧ ∀ x ∈ xs, x ∈ oa.support}

lemma support_replicate' [spec.FiniteRange] [DecidableEq α] (oa : OracleComp spec α) (n : ℕ) :
    (oa.replicate n).support = {xs | xs.length = n ∧ xs.all (· ∈ oa.support)}

@[simp]
lemma mem_finSupport_replicate [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (oa : OracleComp spec α) (n : ℕ)
    (xs : List α) : xs ∈ (oa.replicate n).finSupport ↔
      xs.length = n ∧ xs.all (· ∈ oa.finSupport)

lemma cacheQuery_eq_ite_ite (i : ι) (t : spec.domain i) (u : spec.range i) :
    cache.cacheQuery i t u = λ j t' ↦
      if h : j = i then (if h ▸ t' = t then some (h ▸ u) else cache j t') else cache j t'

@[simp] lemma monoid_mul_def (qc qc' : QueryCount spec) :
  (@HMul.hMul _ _ _ (@instHMul _ (Monoid.toMulOneClass.toMul)) qc qc')
     = (qc : ι → ℕ) + (qc' : ι → ℕ)

@[simp] lemma monoid_one_def :
    (@OfNat.ofNat (QueryCount spec) 1 (@One.toOfNat1 _ (Monoid.toOne))) = (0 : ι → ℕ)

@[simp]
lemma single_le_iff_pos [DecidableEq ι] (i : ι) (qc : QueryCount spec) :
    single i ≤ qc ↔ 0 < qc i

@[simp] -- Automatically reduce "multiplication" of query logs to `List.append`
lemma monoid_mul_def (qc qc' : QueryLog spec) :
  (@HMul.hMul _ _ _ (@instHMul _ (Monoid.toMulOneClass.toMul)) qc qc')
     = (qc : List _) ++ (qc' : List _)

@[simp] lemma monoid_one_def : (1 : QueryLog spec) = List.nil

lemma getQ_singleton {α} (q : OracleQuery spec α) (u : α) (i : ι) :
    getQ (singleton q u) i = match q with

@[simp]
lemma getQ_singleton_self (i : ι) (t : spec.domain i) (u : spec.range i) :
    getQ (singleton (query i t) u) i = [(t, u)]

lemma getQ_singleton_of_ne {α} {q : OracleQuery spec α} {u : α} {i : ι}
    (h : q.index ≠ i) : getQ (singleton q u) i = []

@[simp]
lemma getQ_cons (log : QueryLog spec) (q : (i : ι) × spec.domain i × spec.range i) (i : ι) :
    getQ (q :: log) i =
      if h : q.1 = i then h ▸ (q.2.1, q.2.2) :: getQ log i else getQ log i

@[simp]
lemma getQ_append (log log' : QueryLog spec) (i : ι) :
    (log ++ log').getQ i = log.getQ i ++ log'.getQ i

@[simp]
lemma getQ_logQuery {α} (log : QueryLog spec) (q : OracleQuery spec α) (u : α)
    (i : ι) : (log.logQuery q u).getQ i = log.getQ i ++ (singleton q u).getQ i

@[simp]
lemma countQ_singleton {α} (q : OracleQuery spec α) (u : α) (i : ι) :
    countQ (singleton q u) i = if q.index = i then 1 else 0

lemma countQ_singleton_self (i : ι) (t : spec.domain i) (u : spec.range i) :
    countQ (singleton (query i t) u) i = 1

@[simp]
lemma countQ_append (log log' : QueryLog spec) (i : ι) :
    (log ++ log').countQ i = log.countQ i + log'.countQ i

@[simp]
lemma countQ_logQuery {α} (log : QueryLog spec) (q : OracleQuery spec α) (u : α)
    (i : ι) : (log.logQuery q u).countQ i = log.countQ i + if q.index = i then 1 else 0

@[ext]
protected lemma ext (seed₁ seed₂ : QuerySeed spec) (h : ∀ i, seed₁ i = seed₂ i) : seed₁ = seed₂

@[simp]
lemma addValues_apply (j : ι) : seed.addValues us j =
    Function.update seed i (seed i ++ us) j

@[simp]
lemma addValues_nil {i : ι} (seed : QuerySeed spec) : seed.addValues (i := i) [] = seed

@[simp]
lemma takeAtIndex_apply (j : ι) : seed.takeAtIndex i n j =
    (Function.update seed i ((seed i).take n) j)

@[simp]
lemma takeAtIndex_addValues (seed : QuerySeed spec) {i : ι} (n : ℕ) (xs : List (spec.range i)) :
    (seed.addValues xs).takeAtIndex i n = if n ≤ (seed i).length
      then seed.takeAtIndex i n else seed.addValues (xs.take (n - (seed i).length))

@[simp]
lemma takeAtIndex_length (seed : QuerySeed spec) (i : ι) :
    seed.takeAtIndex i (seed i).length = seed

lemma eq_takeAtIndex_length_iff (seed seed' : QuerySeed spec) (i : ι) :
    seed = seed'.takeAtIndex i (seed i).length ↔
      seed' = seed.addValues ((seed' i).drop (seed i).length)

lemma eq_addValues_iff [DecidableEq ι] (seed seed' : QuerySeed spec)
    {i : ι} (xs : List (spec.range i)) :
    seed = seed'.addValues xs ↔ seed' = seed.takeAtIndex i (seed' i).length ∧
      xs = (seed i).drop (seed' i).length

lemma addValues_eq_iff [DecidableEq ι] (seed seed' : QuerySeed spec)
    {i : ι} (xs : List (spec.range i)) :
    seed.addValues xs = seed' ↔ seed = seed'.takeAtIndex i (seed i).length ∧
      xs = (seed' i).drop (seed i).length

@[simp] lemma liftM_query_eq_liftM_liftM (q : OracleQuery spec α) :
    (q : OracleComp superSpec α) = ((q : OracleQuery superSpec α) : OracleComp superSpec α)

lemma evalDist_lift_query [superSpec.FiniteRange] [Fintype α] [Nonempty α]
    (q : OracleQuery spec α) :
    evalDist ((q : OracleQuery superSpec α) : OracleComp superSpec α) =
      OptionT.lift (PMF.uniformOfFintype α)

@[simp] lemma evalDist_liftM [superSpec.FiniteRange] [Fintype α] [Nonempty α]
    (q : OracleQuery spec α) :
    evalDist (q : OracleComp superSpec α) =
      OptionT.lift (PMF.uniformOfFintype α)

@[simp] lemma supportWhen_monadLift (q : OracleQuery spec α)
    (poss : {α : Type w} → OracleQuery superSpec α → Set α) :
    supportWhen (q : OracleComp superSpec α) poss = poss q

@[simp]
lemma support_toFun (q : OracleQuery spec α) :
    support (h.monadLift q : OracleComp superSpec α) = Set.univ

@[simp]
lemma finSupport_toFun [spec.DecidableEq] [superSpec.DecidableEq] [superSpec.FiniteRange]
    [DecidableEq α] [Fintype α] (q : OracleQuery spec α) :
    finSupport (h.monadLift q : OracleComp superSpec α) = Finset.univ

@[simp]
lemma probOutput_toFun [superSpec.FiniteRange] [Fintype α]
    (q : OracleQuery spec α) (u : α) :
    [= u | (h.monadLift q : OracleComp superSpec α)] =
      (↑(Fintype.card α) : ℝ≥0∞)⁻¹

@[simp]
lemma probEvent_toFun [superSpec.FiniteRange] [Fintype α]
    (q : OracleQuery spec α) (p : α → Prop) [DecidablePred p] :
    [p | (h.monadLift q : OracleComp superSpec α)] =
      (Finset.univ.filter p).card / Fintype.card α

lemma liftComp_def (oa : OracleComp spec α) :
    liftComp oa superSpec = simulateQ (m := OracleComp superSpec) ⟨liftM⟩ oa

@[simp]
lemma liftComp_pure (x : α) : liftComp (pure x : OracleComp spec α) superSpec = pure x

@[simp]
lemma liftComp_query (q : OracleQuery spec α) :
    liftComp (q : OracleComp spec _) superSpec = liftM q

@[simp]
lemma liftComp_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    liftComp (oa >>= ob) superSpec =
      liftComp oa superSpec >>= λ x ↦ liftComp (ob x) superSpec

@[simp]
lemma liftComp_failure : liftComp (failure : OracleComp spec α) superSpec = failure

@[simp]
lemma liftComp_map (oa : OracleComp spec α) (f : α → β) :
    liftComp (f <$> oa) superSpec = f <$> liftComp oa superSpec

@[simp]
lemma liftComp_seq (og : OracleComp spec (α → β)) (oa : OracleComp spec α) :
    liftComp (og <*> oa) superSpec = liftComp og superSpec <*> liftComp oa superSpec

@[simp]
lemma evalDist_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : evalDist (liftComp oa superSpec) = evalDist oa

@[simp] -- NOTE: shouldn't actually need finiteness here.
lemma support_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : (liftComp oa superSpec).support = oa.support

@[simp]
lemma finSupport_liftComp [spec.DecidableEq] [superSpec.DecidableEq] [DecidableEq α]
    [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : (liftComp oa superSpec).finSupport = oa.finSupport

@[simp]
lemma probOutput_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) (x : α) : [= x | liftComp oa superSpec] = [= x | oa]

@[simp]
lemma probEvent_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) (p : α → Prop) [DecidablePred p] :
    [p | liftComp oa superSpec] = [p | oa]

@[simp] lemma neverFails_lift_comp_iff (oa : OracleComp spec α) :
    (liftComp oa superSpec).neverFails ↔ oa.neverFails

@[simp]
lemma liftM_eq_liftComp (oa : OracleComp spec α) :
    (liftM oa : OracleComp superSpec α) = liftComp oa superSpec

lemma QueryImpl.ext' {so so' : QueryImpl spec m}
    (h : ∀ {α} (q : OracleQuery spec α), so.impl q = so'.impl q) :
    so = so'

@[simp] lemma simulateQ_ite (p : Prop) [Decidable p] (oa oa' : OracleComp spec α) :
    simulateQ so (ite p oa oa') = ite p (simulateQ so oa) (simulateQ so oa')

@[simp] lemma simulateQ_failure : simulateQ so (failure : OracleComp spec α) = failure

@[simp] lemma simulateQ_query (q : OracleQuery spec α) : simulateQ so q = so.impl q

@[simp] lemma simulateQ_pure (x : α) : simulateQ so (pure x) = pure x

@[simp] lemma simulateQ_comp_pure_comp (f : α → β) : simulateQ so ∘ pure ∘ f = pure ∘ f

@[simp] lemma simulateQ_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    simulateQ so (liftM q >>= ob) = so.impl q >>= (simulateQ so ∘ ob)

@[simp] lemma simulateQ_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    simulateQ so (oa >>= ob) = simulateQ so oa >>= (simulateQ so ∘ ob)

@[simp] lemma simulateQ_map (oa : OracleComp spec α) (f : α → β) :
    simulateQ so (f <$> oa) = f <$> simulateQ so oa

@[simp] lemma simulateQ_seq (og : OracleComp spec (α → β)) (oa : OracleComp spec α) :
    simulateQ so (og <*> oa) = simulateQ so og <*> simulateQ so oa

@[simp] lemma simulateQ_seqLeft (oa : OracleComp spec α) (ob : OracleComp spec β) :
    simulateQ so (oa <* ob) = simulateQ so oa <* simulateQ so ob

@[simp] lemma simulateQ_seqRight (oa : OracleComp spec α) (ob : OracleComp spec β) :
    simulateQ so (oa *> ob) = simulateQ so oa *> simulateQ so ob

@[simp] lemma apply_eq (q : OracleQuery spec α) : idOracle.impl q = q

@[simp] lemma simulateQ_eq_id : @simulateQ ι spec _ α _ idOracle = id

lemma simulateQ_eq (oa : OracleComp spec α) : simulateQ idOracle oa = oa

@[simp] lemma apply_eq [spec.FiniteRange] (q : OracleQuery spec α) :
    defaultOracle.impl q = return q.defaultOutput

@[simp] lemma simulateQ_eq_getM_defaultResult [spec.FiniteRange] :
    @simulateQ ι spec _ α _ defaultOracle = Option.getM ∘ defaultResult

lemma simulateQ_eq [spec.FiniteRange] (oa : OracleComp spec α) :
    simulateQ defaultOracle oa = oa.defaultResult.getM

@[simp] lemma withCaching_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withCaching.impl q = match q with

lemma apply_eq {α} (q : OracleQuery spec α) : cachingOracle.impl q =
  match q with

lemma apply_eq {α} (q : OracleQuery spec α) : randomOracle.impl q =
    match q with

@[simp]
lemma mmap_pure (F : m →ᵐ n) (x : α) :
    F (pure x) = pure x

@[simp]
lemma mmap_bind (F : m →ᵐ n) (x : m α) (y : α → m β) :
    F (x >>= y) = F x >>= fun x => F (y x)

@[simp] -- This doesn't hold without lawful monad
lemma mmap_map [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m α) (g : α → β) : F (g <$> x) = g <$> F x

@[simp]
lemma mmap_seq [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m (α → β)) (y : m α) : F (x <*> y) = F x <*> F y

@[simp]
lemma mmap_seqLeft [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m α) (y : m β) : F (x <* y) = F x <* F y

@[simp]
lemma mmap_seqRight [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m α) (y : m β) : F (x *> y) = F x *> F y

@[simp]
lemma mmap_ofLift (m : Type u → Type v) (n : Type u → Type v) [Monad m] [Monad n]
    [MonadLift m n] [LawfulMonadLift m n] {α : Type u}
    (x : m α) : ofLift m n x = liftM x

lemma probFailure_bind_congr (oa : OracleComp spec α)
    {ob : α → OracleComp spec β} {oc : α → OracleComp spec γ}
    (h : ∀ x ∈ oa.support, [⊥ | ob x] = [⊥ | oc x]) : [⊥ | oa >>= ob] = [⊥ | oa >>= oc]

lemma probFailure_bind_congr' (oa : OracleComp spec α)
    {ob : α → OracleComp spec β} {oc : α → OracleComp spec γ}
    (h : ∀ x, [⊥ | ob x] = [⊥ | oc x]) : [⊥ | oa >>= ob] = [⊥ | oa >>= oc]

lemma probOutput_bind_congr {oa : OracleComp spec α} {ob₁ ob₂ : α → OracleComp spec β} {y : β}
    (h : ∀ x ∈ oa.support, [= y | ob₁ x] = [= y | ob₂ x]) :
    [= y | oa >>= ob₁] = [= y | oa >>= ob₂]

lemma probOutput_bind_congr' (oa : OracleComp spec α) {ob₁ ob₂ : α → OracleComp spec β} (y : β)
    (h : ∀ x, [= y | ob₁ x] = [= y | ob₂ x]) :
    [= y | oa >>= ob₁] = [= y | oa >>= ob₂]

lemma probOutput_bind_mono {oa : OracleComp spec α}
    {ob : α → OracleComp spec β} {oc : α → OracleComp spec γ} {y : β} {z : γ}
    (h : ∀ x ∈ oa.support, [= y | ob x] ≤ [= z | oc x]) :
    [= y | oa >>= ob] ≤ [= z | oa >>= oc]

lemma probOutput_bind_congr_div_const {oa : OracleComp spec α}
    {ob₁ ob₂ : α → OracleComp spec β} {y : β} {r : ℝ≥0∞}
    (h : ∀ x ∈ oa.support, [= y | ob₁ x] = [= y | ob₂ x] / r) :
    [= y | oa >>= ob₁] = [= y | oa >>= ob₂] / r

lemma probOutput_bind_congr_eq_add {γ₁ γ₂ : Type u}
    {oa : OracleComp spec α} {ob : α → OracleComp spec β}
      {oc₁ : α → OracleComp spec γ₁} {oc₂ : α → OracleComp spec γ₂}
    {y : β} {z₁ : γ₁} {z₂ : γ₂}
    (h : ∀ x ∈ oa.support, [= y | ob x] = [= z₁ | oc₁ x] + [= z₂ | oc₂ x]) :
    [= y | oa >>= ob] = [= z₁ | oa >>= oc₁] + [= z₂ | oa >>= oc₂]

lemma probOutput_bind_congr_le_add {γ₁ γ₂ : Type u}
    {oa : OracleComp spec α} {ob : α → OracleComp spec β}
      {oc₁ : α → OracleComp spec γ₁} {oc₂ : α → OracleComp spec γ₂}
    {y : β} {z₁ : γ₁} {z₂ : γ₂}
    (h : ∀ x ∈ oa.support, [= y | ob x] ≤ [= z₁ | oc₁ x] + [= z₂ | oc₂ x]) :
    [= y | oa >>= ob] ≤ [= z₁ | oa >>= oc₁] + [= z₂ | oa >>= oc₂]

lemma probOutput_bind_congr_add_le {γ₁ γ₂ : Type u}
    {oa : OracleComp spec α} {ob : α → OracleComp spec β}
      {oc₁ : α → OracleComp spec γ₁} {oc₂ : α → OracleComp spec γ₂}
    {y : β} {z₁ : γ₁} {z₂ : γ₂}
    (h : ∀ x ∈ oa.support, [= z₁ | oc₁ x] + [= z₂ | oc₂ x] ≤ [= y | ob x]) :
    [= z₁ | oa >>= oc₁] + [= z₂ | oa >>= oc₂] ≤ [= y | oa >>= ob]

lemma probOutput_bind_congr_le_sub {γ₁ γ₂ : Type u}
    {oa : OracleComp spec α} {ob : α → OracleComp spec β}
      {oc₁ : α → OracleComp spec γ₁} {oc₂ : α → OracleComp spec γ₂}
    {y : β} {z₁ : γ₁} {z₂ : γ₂}
    (h : ∀ x ∈ oa.support, [= y | ob x] ≤ [= z₁ | oc₁ x] - [= z₂ | oc₂ x]) :
    [= y | oa >>= ob] ≤ [= z₁ | oa >>= oc₁] - [= z₂ | oa >>= oc₂]

lemma probOutput_bind_congr_sub_le {γ₁ γ₂ : Type u}
    {oa : OracleComp spec α} {ob : α → OracleComp spec β}
      {oc₁ : α → OracleComp spec γ₁} {oc₂ : α → OracleComp spec γ₂}
    {y : β} {z₁ : γ₁} {z₂ : γ₂}
    (h : ∀ x ∈ oa.support, [= z₁ | oc₁ x] - [= z₂ | oc₂ x] ≤ [= y | ob x]) :
    [= z₁ | oa >>= oc₁] - [= z₂ | oa >>= oc₂] ≤ [= y | oa >>= ob]

@[simp] theorem comonad_id_map {α : Type u} (wa : w α) : Functor.map id wa = wa

@[simp] theorem comonad_comp_map {α β γ : Type u} (f : β → γ) (g : α → β) (wa : w α) :
    Functor.map (f ∘ g) wa = Functor.map f (Functor.map g wa)

@[simp] theorem extract_map {α β : Type u} (f : α → β) (wa : w α) :
  extract (Functor.map f wa) = f (extract wa)

@[simp] theorem extract_duplicate_eq_id : extract (duplicate wa) = wa

@[simp] theorem map_extract_duplicate_eq_id : Functor.map extract (duplicate wa) = wa

@[simp] theorem extend_eq_map_duplicate {β : Type u} (f : w α → β) :
  extend wa f = Functor.map f (duplicate wa)

@[simp] theorem duplicate_duplicate_eq_map_duplicate :
    duplicate (duplicate wa) = Functor.map duplicate (duplicate wa)

lemma StateT_run_simulateQ_eq_map_run'_simulateQ {α} (oa : OracleComp spec α) (s s' : σ) :
    (simulateQ so oa).run s = (·, s') <$> (simulateQ so oa).run' s

lemma StateT_run'_simulateQ_eq_self {α} (so : QueryImpl spec (StateT σ (OracleComp spec)))
    (h : ∀ α (q : OracleQuery spec α) s, (so.impl q).run' s = q)
    (oa : OracleComp spec α) (s : σ) : (simulateQ so oa).run' s = oa

@[simp] lemma index_query (i : ι) (t : spec.domain i) : (query i t).index = i

@[simp] lemma input_query (i : ι) (t : spec.domain i) : (query i t).input = t

@[simp]
lemma range_index : (q : OracleQuery spec α) → spec.range q.index = α

lemma eq_query_index_input : (q : OracleQuery spec α) →
    q = q.range_index ▸ OracleQuery.query q.index q.input

protected lemma liftM_def (q : OracleQuery spec α) :
    (q : OracleComp spec α) = OptionT.lift (FreeMonad.lift q)

lemma liftM_query_eq_liftM_liftM {m : Type v → Type z} [MonadLift (OracleComp spec) m] {α : Type v}
    (q : OracleQuery spec α) : (liftM q : m α) = liftM (liftM q : OracleComp spec α)

@[simp]
lemma liftM_query_stateT {σ : Type v} {α : Type v} (q : OracleQuery spec α) :
  (liftM q : StateT σ (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)

@[simp]
lemma liftM_query_writerT {ω : Type v} [Monoid ω] {α : Type v} (q : OracleQuery spec α) :
  (liftM q : WriterT ω (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)

@[simp]
lemma liftM_query_readerT {ρ : Type v} {α : Type v} (q : OracleQuery spec α) :
  (liftM q : ReaderT ρ (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)

lemma query_bind_eq_roll (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (q : OracleComp spec α) >>= ob = OptionT.mk (FreeMonad.roll q ob)

protected lemma pure_def (x : α) : (pure x : OracleComp spec α) = OptionT.pure x

protected lemma bind_def (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    oa >>= ob = OptionT.bind oa ob

protected lemma failure_def : (failure : OracleComp spec α) = OptionT.fail

protected lemma orElse_def (oa oa' : OracleComp spec α) : (oa <|> oa') = OptionT.mk
      (do match ← OptionT.run oa with | some a => pure (some a) | _  => OptionT.run oa')

protected lemma bind_congr' {oa oa' : OracleComp spec α} {ob ob' : α → OracleComp spec β}
    (h : oa = oa') (h' : ∀ x, ob x = ob' x) : oa >>= ob = oa' >>= ob'

@[simp] -- NOTE: debatable if this should be simp
lemma guard_eq {ι : Type} {spec : OracleSpec ι} (p : Prop) [Decidable p] :
    (guard p : OracleComp spec Unit) = if p then pure () else failure

lemma ite_bind (p : Prop) [Decidable p] (oa oa' : OracleComp spec α)
    (ob : α → OracleComp spec β) : ite p oa oa' >>= ob = ite p (oa >>= ob) (oa' >>= ob)

@[simp]
lemma construct_pure (x : α) :
    OracleComp.construct h_pure h_query_bind h_failure (pure x) = h_pure x

@[simp]
lemma construct_failure :
    OracleComp.construct h_pure h_query_bind h_failure failure = h_failure

@[simp]
lemma construct_query (q : OracleQuery spec α) :
    (OracleComp.construct h_pure h_query_bind h_failure (q : OracleComp spec α) : C q) =
      h_query_bind q pure h_pure

@[simp]
lemma construct_query_bind (q : OracleQuery spec β) (oa : β → OracleComp spec α) :
    (OracleComp.construct h_pure h_query_bind h_failure ((q : OracleComp spec β) >>= oa)) =
      h_query_bind q oa (λ u ↦ (oa u).construct h_pure h_query_bind h_failure)

@[simp]
lemma construct_roll (q : OracleQuery spec β) (oa : β → OracleComp spec α) :
    (OracleComp.construct h_pure h_query_bind h_failure (OptionT.mk (FreeMonad.roll q oa)) :
      C (OptionT.mk (FreeMonad.roll q oa))) = h_query_bind q oa
        (λ u ↦ (oa u).construct h_pure h_query_bind h_failure)

@[simp] lemma isPure_pure : isPure (pure x : OracleComp spec α) = true

@[simp] lemma isPure_query_bind : isPure ((q : OracleComp spec β) >>= oa) = false

@[simp] lemma isPure_failure : isPure (failure : OracleComp spec α) = false

@[simp] lemma isFailure_pure : isFailure (pure x : OracleComp spec α) = false

@[simp] lemma isFailure_query_bind : isFailure ((q : OracleComp spec β) >>= oa) = false

@[simp] lemma isFailure_failure : isFailure (failure : OracleComp spec α) = true

lemma exists_eq_of_isPure {oa : OracleComp spec α} (h : isPure oa) : ∃ x, oa = pure x

lemma eq_failure_of_isFailure {oa : OracleComp spec α} (h : isFailure oa) : oa = failure

@[simp] lemma pure_ne_query : pure y ≠ (q : OracleComp spec β)

@[simp] lemma query_ne_pure : (q : OracleComp spec β) ≠ pure y

@[simp] lemma pure_ne_query_bind : pure x ≠ (q : OracleComp spec β) >>= oa

@[simp] lemma query_bind_ne_pure : (q : OracleComp spec β) >>= oa ≠ pure x

@[simp] lemma pure_ne_failure : (pure x : OracleComp spec α) ≠ failure

@[simp] lemma failure_ne_pure : failure ≠ (pure x : OracleComp spec α)

@[simp] lemma failure_ne_query_bind : failure ≠ (q : OracleComp spec β) >>= oa

@[simp] lemma query_bind_ne_failure : (q : OracleComp spec β) >>= oa ≠ failure

@[simp] lemma query_ne_failure : (q : OracleComp spec β) ≠ failure

@[simp] lemma failure_ne_query : failure ≠ (q : OracleComp spec β)

lemma pure_eq_query_iff_false : pure y = (q : OracleComp spec β) ↔ False

lemma query_eq_pure_iff_false : (q : OracleComp spec β) = pure y ↔ False

@[simp] lemma mapM_pure (x : α) : (pure x : OracleComp spec α).mapM fail qm = pure x

@[simp] lemma mapM_failure : (failure : OracleComp spec α).mapM fail qm = fail

@[simp]
lemma mapM_query [LawfulMonad m] (q : OracleQuery spec α) :
    (q : OracleComp spec α).mapM fail qm = qm q

@[simp]
lemma mapM_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    ((q : OracleComp spec α) >>= ob).mapM fail qm =
      (do let x ← qm q; (ob x).mapM fail qm)

lemma mapM_bind [LawfulMonad m] (oa : OracleComp spec α) (ob : α → OracleComp spec β)
    (hfail : ∀ f : α → m β, fail >>= f = fail) :
    (oa >>= ob).mapM fail qm =
      oa.mapM fail qm >>= λ x ↦ (ob x).mapM fail qm

@[simp]
lemma mapM_bind' {m : Type v → Type w} [AlternativeMonad m] [LawfulMonad m]
    [LawfulAlternative m] (qm : {α : Type v} → OracleQuery spec α → m α)
    (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).mapM failure qm =
      oa.mapM failure qm >>= λ x ↦ (ob x).mapM failure qm

lemma mapM_map [LawfulMonad m] (oa : OracleComp spec α) (f : α → β)
    (hfail : ∀ f : α → β, f <$> fail = fail) :
    (f <$> oa).mapM fail qm = f <$> oa.mapM fail qm

@[simp]
lemma mapM_map' {m : Type v → Type w} [AlternativeMonad m] [LawfulAlternative m]
    [LawfulMonad m] (qm : {α : Type v} → OracleQuery spec α → m α)
    (oa : OracleComp spec α) (f : α → β) :
    (f <$> oa).mapM failure qm = f <$> oa.mapM failure qm

lemma mapM_seq [LawfulMonad m] (og : OracleComp spec (α → β)) (oa : OracleComp spec α)
    (hfail : ∀ f : (α → β) → m β, fail >>= f = fail)
    (hfail' : ∀ f : α → β, f <$> fail = fail) :
    (og <*> oa).mapM fail qm = og.mapM fail qm <*> oa.mapM fail qm

@[simp]
lemma mapM_ite (p : Prop) [Decidable p] (oa oa' : OracleComp spec α) :
    (ite p oa oa').mapM fail qm = ite p (oa.mapM fail qm) (oa'.mapM fail qm)

@[simp]
lemma pure_inj (x y : α) : (pure x : OracleComp spec α) = pure y ↔ x = y

@[simp]
lemma liftM_inj (q q' : OracleQuery spec α) : (q : OracleComp spec α) = q' ↔ q = q'

@[simp]
lemma query_inj (i : ι) (t t' : spec.domain i) :
    (query i t : OracleComp spec (spec.range i)) = query i t' ↔ t = t'

@[simp]
lemma queryBind_inj (q q' : OracleQuery spec α) (ob ob' : α → OracleComp spec β) :
    (q : OracleComp spec α) >>= ob = (q' : OracleComp spec α) >>= ob' ↔ q = q' ∧ ob = ob'

@[simp]
lemma bind_eq_pure_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) (y : β) :
    oa >>= ob = pure y ↔ ∃ x : α, oa = pure x ∧ ob x = pure y

@[simp]
lemma pure_eq_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) (y : β) :
    pure y = oa >>= ob ↔ ∃ x : α, oa = pure x ∧ ob x = pure y

@[simp]
lemma liftM_of_liftM_eq [MonadLift m m'] (x : StateT σ m α) :
    (liftM x : StateT σ m' α) = StateT.mk fun s => liftM (x.run s)

lemma liftM_def [Monad m] (x : m α) : (liftM x : StateT σ m α) = StateT.lift x

lemma monad_pure_def [Monad m] (x : α) :
    (pure x : StateT σ m α) = StateT.pure x

lemma monad_bind_def [Monad m] (x : StateT σ m α) (f : α → StateT σ m β) :
    x >>= f = StateT.bind x f

lemma monad_failure_eq [Monad m] [Alternative m] :
    (failure : StateT σ m α) = StateT.failure

@[simp]
lemma run_failure' [Monad m] [Alternative m] :
    (failure : StateT σ m α).run = fun _ => failure

@[simp]
lemma mk_pure_eq_pure [Monad m] (x : α) :
  StateT.mk (λ s ↦ pure (x, s)) = (pure x : StateT σ m α)

@[simp] lemma allWhen_pure (x : α) :
    (pure x : OracleComp spec α).allWhen Q F possible_outputs

@[simp] lemma someWhen_pure (x : α) :
    (pure x : OracleComp spec α).someWhen Q F possible_outputs

@[simp] lemma allWhen_failure_iff :
    (failure : OracleComp spec α).allWhen Q F possible_outputs ↔ F

@[simp] lemma allWhen_query_iff (q : OracleQuery spec α) :
    (q : OracleComp spec α).allWhen Q F possible_outputs ↔ Q q

@[simp] lemma allWhen_query_bind (q : OracleQuery spec α) (oa : α → OracleComp spec β) :
    ((q : OracleComp spec α) >>= oa).allWhen Q F possible_outputs ↔
      Q q ∧ ∀ x ∈ possible_outputs q, (oa x).allWhen Q F possible_outputs

@[simp] lemma allWhen_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).allWhen Q F possible_outputs ↔ oa.allWhen Q F possible_outputs ∧
      ∀ x ∈ oa.supportWhen possible_outputs, (ob x).allWhen Q F possible_outputs

lemma neverFailsWhen_simulate {ι' : Type*} {spec' : OracleSpec ι'}
    (oa : OracleComp spec α)
    (possible_outputs : {α : Type v} → OracleQuery spec α → Set α)
    (h : neverFailsWhen oa possible_outputs)
    -- {m : Type v → Type _} [Monad m]
    (so : QueryImpl spec (OracleComp spec'))
    (h' : ∀ {α}, ∀ q : OracleQuery spec α, (so.impl q).support ⊆ possible_outputs q)
    (hso : ∀ {α}, ∀ q : OracleQuery spec α, neverFails (so.impl q)) :
    neverFails (simulateQ so oa)

lemma neverFails_eq_oracleComp_construct (oa : OracleComp spec α) :
    oa.neverFails = OracleComp.construct
      (fun _ ↦ True) (fun {β} _ _ r ↦ ∀ (x : β), r x) False oa

lemma neverFails_eq_freeMonad_construct (oa : OracleComp spec α) :
    oa.neverFails = FreeMonad.construct
      (fun t ↦ Option.rec False (fun _ ↦ True) t) (fun _ _ r ↦ ∀ x, r x) oa

@[simp]
lemma neverFails_pure (x : α) : neverFails (pure x : OracleComp spec α)

@[simp]
lemma neverFails_query (q : OracleQuery spec α) : neverFails (q : OracleComp spec α)

@[simp]
lemma neverFails_query_bind_iff {q : OracleQuery spec α} {oa : α → OracleComp spec β} :
    (liftM q >>= oa).neverFails ↔ ∀ x, neverFails (oa x)

@[simp]
lemma not_neverFails_failure : ¬ neverFails (failure : OracleComp spec α)

@[simp]
lemma neverFails_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).neverFails ↔ oa.neverFails ∧ ∀ x ∈ oa.support, (ob x).neverFails

@[simp]
lemma neverFails_map_iff (oa : OracleComp spec α) (f : α → β) :
    neverFails (f <$> oa) ↔ neverFails oa

@[simp]
lemma neverFails_guard (p : Prop) [Decidable p] (oa : OracleComp spec α) (h: oa.neverFails) :
    neverFails (if p then oa else failure) ↔ p

@[simp] lemma toExecutionMethod_eq (n : ℕ) :
    (oneTimePad n).toExecutionMethod = ExecutionMethod.default

@[simp]
lemma BitVec.xor_xor_cancel_right {n : ℕ} (bv1 bv2 : BitVec n) :
    bv1 ^^^ bv2 ^^^ bv2 = bv1

@[simp]
lemma bitvec_to_string_to_bitvec (bv : BitVec 256) :
    string_to_bitvec (bitvec_to_string bv) = bv

@[simp]
lemma mock_decrypt_mock_encrypt (msg : BitVec 256) :
    mock_decrypt (mock_encrypt msg) = msg

theorem validateAbuseReport_is_sound (message_content : String) :
    [= true | do
      -- basically simulation_setup
      let facebook_key := BitVec.ofNat 256 123456789
      let context : Context := {
        sender_id := BitVec.ofNat 256 1001,
        recipient_id := BitVec.ofNat 256 1002,
        timestamp := 1730230302,
        message_id := 123 }
      -- simulation data
      let maybeData ← simulation_setup message_content
      match maybeData with
      | none => return false
      | some data =>
        let valid_abuse_report := {
          message := data.verified_msg,
          franking_tag := data.message_package.franking_tag,
          reporting_tag := data.message_package.reporting_tag,
          context := data.message_package.context }
        -- validation result
        return validate_abuse_report valid_abuse_report data.facebook_key] = 1

lemma simulation_setup_succeeds (message_content : String) :
    [⊥ | do
      let maybeData ← simulation_setup message_content
      match maybeData with
      | none => return true
      | some _ => return false] = 0

lemma probFailure_verify_message_valid_message (facebook_key : BitVec 256)
    (message_content : String) (context : Context) :
    [⊥ | do
      let nonce ← generate_nonce
      let franking_tag := generate_franking_tag nonce message_content
      let encrypted_msg := prepare_encrypted_message message_content nonce
      let reporting_tag := generate_reporting_tag franking_tag context facebook_key
      let package := {
        encrypted_message := encrypted_msg,
        franking_tag := franking_tag,
        reporting_tag := reporting_tag,
        context := context,
        nonce := nonce
      }
      verify_message_package package] = 0

@[simp] lemma withPregen_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withPregen.impl q = match q with

lemma apply_eq {α} (q : OracleQuery spec α) :
    seededOracle.impl q = match q with

@[simp]
lemma probOutput_generateSeed_bind_simulateQ_bind {ι : Type _} {spec : OracleSpec ι}
    {α β : Type _} [DecidableEq ι]
    [∀ i, SelectableType (spec.range i)] [unifSpec ⊂ₒ spec] [spec.FiniteRange]
    (qc : ι → ℕ) (js : List ι)
    (oa : OracleComp spec α) (ob : α → OracleComp spec β) (y : β) :
    [= y | do
      let seed ← liftComp (generateSeed spec qc js) spec
      let x ← (simulateQ seededOracle oa).run seed
      ob x] = [= y | oa >>= ob]

@[simp]
lemma probOutput_generateSeed_bind_map_simulateQ {ι : Type _} {spec : OracleSpec ι}
    {α β : Type _} [DecidableEq ι]
    [∀ i, SelectableType (spec.range i)] [unifSpec ⊂ₒ spec] [spec.FiniteRange]
    (qc : ι → ℕ) (js : List ι)
    (oa : OracleComp spec α) (f : α → β) (y : β) :
    [= y | do
      let seed ← liftComp (generateSeed spec qc js) spec
      f <$> (simulateQ seededOracle oa).run seed] = [= y | f <$> oa]

@[simp] lemma run_lift {m : Type u → Type v} [Monad m]
    {α : Type u} (x : m α) : (OptionT.lift x).run = x

lemma monad_pure_eq_pure [Monad m] (x : α) :
    (pure x : OptionT m α) = OptionT.pure x

lemma monad_bind_eq_bind [Monad m] (x : OptionT m α) (y : α → OptionT m β) :
    x >>= y = OptionT.bind x y

lemma liftM_def {m : Type u → Type v} [Monad m] {α : Type u}
    (x : m α) : (x : OptionT m α) = OptionT.lift x

@[simp]
lemma map_pure (f : PureEquiv m n) {α : Type u} (x : α) :
    f.toFun (pure x) = (pure x : n α)

@[simp]
lemma map_pure_inv (f : PureEquiv m n) {α : Type u} (x : α) :
    f.invFun (pure x) = (pure x : m α)

@[simp]
lemma map_bind (f : BindEquiv m n) {α β : Type u} (x : m α) (y : α → m β) :
    f.toFun (x >>= y) = f.toFun x >>= (fun a => f.toFun (y a))

@[simp]
lemma map_bind_inv (f : BindEquiv m n) {α β : Type u} (x : n α) (y : α → n β) :
    f.invFun (x >>= y) = f.invFun x >>= (fun a => f.invFun (y a))

lemma pull_up_4_helper {ι : Type*} {spec : OracleSpec ι} [spec.FiniteRange]
    {α β γ δ ε : Type}
    (oa : OracleComp spec α) (ob : OracleComp spec β)
    (oc : OracleComp spec γ) (od : OracleComp spec δ)
    (oe : α → β → γ → δ → OracleComp spec ε) (z : ε) :
    [= z | do let a ← oa; let b ← ob; let c ← oc; let d ← od; oe a b c d] =
      [= z | do let d ← od; let a ← oa; let b ← ob; let c ← oc; oe a b c d]

lemma probOutput_uniformSelect_bool_bind_eq_add {α : Type}
    (oa : Bool → ProbComp α) (x : α) : -- should be anything $ᵗ Bool can lift to
    [= x | ($ᵗ Bool) >>= oa] = [= x | oa true] / 2 + [= x | oa false] / 2

@[simp] lemma toExecutionMethod_eq :
    (elgamalAsymmEnc G P).toExecutionMethod = ExecutionMethod.default

theorem Correct [DecidableEq P] : (elgamalAsymmEnc G P).PerfectlyCorrect

theorem IND_CPA_advantage_eq_parallelTesting_advantage [DecidableEq G] [DecidableEq P]
    (adversary : (elgamalAsymmEnc G P).IND_CPA_adversary) :
    (IND_CPA_advantage adversary) =
      (parallelTestingAdvantage (IND_CPA_parallelTesting_reduction adversary))

lemma LWE_Experiment_eq_LWE_Game_01 {n m p : ℕ} [NeZero p] {errSamp : ProbComp (Fin p)}
    {adv : LWE_Adversary n m p} :
    2 * (LWE_Experiment n m p errSamp adv).advantage' =
      (LWE_Game_0 n m p errSamp adv).advantage₂' (LWE_Game_1 n m p adv)

lemma mem_support_seq_map_cons_iff' (xs : List α) : xs ∈ (List.cons <$> oa <*> ob).support ↔
    xs.recOn False (λ x xs _ ↦ x ∈ oa.support ∧ xs ∈ ob.support)

lemma mem_support_seq_map_cons_iff (xs : List α) (h : xs ≠ []) :
    xs ∈ (List.cons <$> oa <*> ob).support ↔
      xs.head h ∈ oa.support ∧ xs.tail ∈ ob.support

lemma cons_mem_support_seq_map_cons_iff (x : α) (xs : List α) :
    x :: xs ∈ (cons <$> oa <*> ob).support ↔ x ∈ oa.support ∧ xs ∈ ob.support

lemma mem_finSupport_seq_map_cons_iff' [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (xs : List α) : xs ∈ (cons <$> oa <*> ob).finSupport ↔
      xs.recOn False (λ x xs _ ↦ x ∈ oa.finSupport ∧ xs ∈ ob.finSupport)

lemma mem_finSupport_seq_map_cons_iff [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (xs : List α) (h : xs ≠ []) : xs ∈ (cons <$> oa <*> ob).finSupport ↔
      xs.head h ∈ oa.finSupport ∧ xs.tail ∈ ob.finSupport

lemma cons_mem_finSupport_seq_map_cons_iff [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (x : α) (xs : List α) : x :: xs ∈ (cons <$> oa <*> ob).finSupport ↔
      x ∈ oa.finSupport ∧ xs ∈ ob.finSupport

lemma probOutput_cons_seq_map_cons_eq_mul [spec.FiniteRange] [spec.DecidableEq] (x : α)
    (xs : List α) : [= x :: xs | cons <$> oa <*> ob] = [= x | oa] * [= xs | ob]

lemma probOutput_cons_seq_map_cons_eq_mul' [spec.FiniteRange] [spec.DecidableEq] (x : α)
    (xs : List α) : [= x :: xs | (λ xs x ↦ x :: xs) <$> ob <*> oa] = [= x | oa] * [= xs | ob]

@[simp]
lemma probOutput_seq_map_cons_eq_mul [spec.FiniteRange] [spec.DecidableEq] (xs : List α) :
    [= xs | cons <$> oa <*> ob] = if h : xs.isEmpty then 0 else
      [= xs.head (h ∘ List.isEmpty_iff.2) | oa] * [= xs.tail | ob]

@[simp]
lemma probOutput_map_append_left [DecidableEq α] [spec.FiniteRange] (xs : List α)
    (oa : OracleComp spec (List α)) (ys : List α) :
    [= ys | (xs ++ ·) <$> oa] = if ys.take xs.length = xs
      then [= ys.drop xs.length | oa] else 0

@[simp]
lemma probFailure_list_mapM_loop {α β : Type*} [spec.FiniteRange]
    (xs : List α) (f : α → OracleComp spec β) (ys : List β) :
    [⊥ | List.mapM.loop f xs ys] = 1 - (xs.map (1 - [⊥ | f ·])).prod

@[simp]
lemma probFailure_list_mapM {α β : Type*} [spec.FiniteRange] (xs : List α)
    (f : α → OracleComp spec β) : [⊥ | xs.mapM f] = 1 - (xs.map (1 - [⊥ | f ·])).prod

@[simp]
lemma probOutput_list_mapM_loop {α β : Type*} [DecidableEq β] [spec.FiniteRange]
    (xs : List α) (f : α → OracleComp spec β) (ys : List β)
    (zs : List β) : [= zs | List.mapM.loop f xs ys] =
      if zs.length = xs.length + ys.length ∧ zs.take ys.length = ys.reverse
      then (List.zipWith (λ x z ↦ [= z | f x]) xs (zs.drop ys.length)).prod else 0

@[simp]
lemma probOutput_list_mapM {α β : Type*} [spec.FiniteRange] (xs : List α)
    (f : α → OracleComp spec β) (ys : List β) : [= ys | xs.mapM f] = if ys.length = xs.length
      then (List.zipWith (fun x y => [= y | f x]) xs ys).prod else 0

@[simp] lemma neverFails_list_mapM {f : α → OracleComp spec β} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM f as)

@[simp] lemma neverFails_list_mapM' {f : α → OracleComp spec β} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM' f as)

@[simp] lemma neverFails_list_flatMapM {f : α → OracleComp spec (List β)} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (flatMapM f as)

@[simp] lemma neverFails_list_filterMapM {f : α → OracleComp spec (Option β)} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (filterMapM f as)

@[simp] lemma neverFails_list_foldlM {f : s → α → OracleComp spec s} {init : s} {as : List α}
    (h : ∀ i, ∀ x ∈ as, neverFails (f i x)) : neverFails (foldlM f init as)

@[simp] lemma neverFails_list_foldrM {f : α → s → OracleComp spec s} {init : s} {as : List α}
    (h : ∀ i, ∀ x ∈ as, neverFails (f x i)) : neverFails (foldrM f init as)

@[simp]
lemma support_seq_map_vector_cons : ((· ::ᵥ ·) <$> oa <*> ob).support =
    {xs | xs.head ∈ oa.support ∧ xs.tail ∈ ob.support}

@[simp]
lemma probOutput_seq_map_vector_cons_eq_mul [spec.FiniteRange] [spec.DecidableEq]
    (xs : List.Vector α (n + 1)) :
    [= xs | (· ::ᵥ ·) <$> oa <*> ob] = [= xs.head | oa] * [= xs.tail | ob]

@[simp]
lemma probOutput_seq_map_vector_cons_eq_mul' [spec.FiniteRange] [spec.DecidableEq]
    (xs : List.Vector α (n + 1)) :
    [= xs | (λ xs x ↦ x ::ᵥ xs) <$> ob <*> oa] = [= xs.head | oa] * [= xs.tail | ob]

@[simp]
lemma probOutput_vector_toList [spec.FiniteRange] [spec.DecidableEq]
    {n : ℕ} (oa : OracleComp spec (List.Vector α n))
    (xs : List α) : [= xs | List.Vector.toList <$> oa] =
      if h : xs.length = n then [= ⟨xs, h⟩ | oa] else 0

@[simp] lemma neverFails_list_vector_mmap {f : α → OracleComp spec β} {as : List.Vector α n}
    (h : ∀ x ∈ as.toList, neverFails (f x)) : neverFails (List.Vector.mmap f as)

@[simp] lemma neverFails_array_mapM {f : α → OracleComp spec β} {as : Array α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM f as)

lemma mem_support_vector_mapM {n} {f : α → OracleComp spec β} {as : Vector α n} {x : Vector β n} :
    x ∈ (Vector.mapM f as).support ↔ ∀ i : Fin n, x[i] ∈ (f as[i]).support

@[simp] lemma neverFails_vector_mapM {n} {f : α → OracleComp spec β} {as : Vector α n}
    (h : ∀ x ∈ as.toList, neverFails (f x)) : neverFails (Vector.mapM f as)

theorem pure_eq_pmf_pure {a : α} : (pure a : SPMF α) = PMF.pure a

theorem bind_eq_pmf_bind {p : SPMF α} {f : α → SPMF β} :
    (p >>= f) = PMF.bind p (fun a => match a with | some a' => f a' | none => PMF.pure none)

@[simp] lemma map_some_apply_some (p : PMF α) (x : α) : p.map some (some x) = p x

@[simp] lemma PMF.map_some_apply_some (p : PMF α) (x : α) : (some <$> p) (some x) = p x

theorem IsCoupling.pure_iff {α β : Type u} {a : α} {b : β} {c : SPMF (α × β)} :
    IsCoupling c (pure a) (pure b) ↔ c = pure (a, b)

theorem IsCoupling.none_iff {α β : Type u} {c : SPMF (α × β)} :
    IsCoupling c (failure : SPMF α) (failure : SPMF β) ↔ c = failure

theorem IsCoupling.bind {α₁ α₂ β₁ β₂ : Type u}
    {p : SPMF α₁} {q : SPMF α₂} {f : α₁ → SPMF β₁} {g : α₂ → SPMF β₂}
    (c : Coupling p q) (d : (a₁ : α₁) → (a₂ : α₂) → SPMF (β₁ × β₂))
    (h : ∀ (a₁ : α₁) (a₂ : α₂), c.1.1 (some (a₁, a₂)) ≠ 0 → IsCoupling (d a₁ a₂) (f a₁) (g a₂)) :
    IsCoupling (c.1 >>= λ (p : α₁ × α₂) => d p.1 p.2) (p >>= f) (q >>= g)

theorem IsCoupling.exists_bind {α₁ α₂ β₁ β₂ : Type u}
    {p : SPMF α₁} {q : SPMF α₂} {f : α₁ → SPMF β₁} {g : α₂ → SPMF β₂}
    (c : Coupling p q)
    (h : ∀ (a₁ : α₁) (a₂ : α₂), ∃ (d : SPMF (β₁ × β₂)), IsCoupling d (f a₁) (g a₂)) :
    ∃ (d : SPMF (β₁ × β₂)), IsCoupling d (p >>= f) (q >>= g) :=
  let d : (a₁ : α₁) → (a₂ : α₂) → SPMF (β₁ × β₂)

@[simp] theorem toMonadState_get_eq_monadStateOf_get {m : Type u → Type v} {σ : Type u}
    [MonadStateOf σ m] : (MonadState.get : m σ) = MonadStateOf.get

@[simp] theorem toMonadState_set_eq_monadStateOf_set {m : Type u → Type v} {σ : Type u}
    [MonadStateOf σ m] : (MonadState.set : σ → m PUnit) = MonadStateOf.set

@[simp]
theorem getThe_eq [MonadStateOf σ m] : getThe σ (m := m) = MonadStateOf.get

@[simp]
theorem modifyGetThe_eq [MonadStateOf σ m] {α : Type u} (f : σ → α × σ) :
    modifyGetThe σ (m := m) f = MonadStateOf.modifyGet f

@[simp]
theorem modifyThe_eq (f : σ → σ) :
    modifyThe σ (m := m) f = (do set (f (← MonadStateOf.get)))

@[simp]
theorem modify_eq (f : σ → σ) :
    modify (m := m) f = (do MonadState.set (f (← get)))

theorem modifyGet_eq_monadState {α : Type u} (f : σ → α × σ) :
    StateT.modifyGet (m := m) f = (do let (a, s) := f (← StateT.get); StateT.set s; pure a)

theorem get_get {α : Type u} {a : σ → σ → StateT σ m α} :
    (do let s₁ ← StateT.get; let s₂ ← StateT.get; a s₁ s₂) = (do let s ← StateT.get; a s s)

theorem set_set {s₁ s₂ : σ} : (do StateT.set s₁; StateT.set s₂) = StateT.set (m := m) s₂

theorem get_set {s : σ} : (do StateT.set (m := m) s; StateT.get) = (do StateT.set s; pure s)

theorem set_get : (do let s ← @StateT.get σ m _; StateT.set s) = pure ⟨⟩

@[simp]
theorem PreCondition.top_def {σ : Type _} : PreCondition.top σ = fun _ => True

@[simp]
theorem pure_rule (x : α) :
    HoareTriple (PreCondition.top σ) (pure x) (fun s a s' => s = s' ∧ a = x)

theorem pure_rule_forward {P : PreCondition σ} (x : α) :
    HoareTriple P (pure x) (fun s a s' => s = s' ∧ a = x ∧ P s)

theorem pure_rule_backward {Q : PostCondition σ α} (x : α) :
    HoareTriple (fun s => Q s x s) (pure x) Q

theorem bind_rule {P₁ : PreCondition σ} {Q₁ : PostCondition σ α}
    {P₂ : α → PreCondition σ} {Q₂ : α → PostCondition σ β}
    {comp₁ : StateM σ α} {comp₂ : α → StateM σ β}
    (h₁ : HoareTriple P₁ comp₁ Q₁) (h₂ : ∀ x, HoareTriple (P₂ x) (comp₂ x) (Q₂ x)) :
    HoareTriple (fun s => P₁ s ∧ ∀ x s', Q₁ s x s' → P₂ x s')
                (comp₁ >>= comp₂)
                (fun s y s'' => ∃ x s', Q₁ s x s' ∧ Q₂ x s' y s'')

theorem weaken_rule {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) (P' : PreCondition σ)
    (h_imp : ∀ s, P' s → P s) :
      HoareTriple P' comp Q

theorem strengthen_rule {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) (Q' : PostCondition σ α)
    (h_imp : ∀ s x s', Q s x s' → Q' s x s') :
      HoareTriple P comp Q'

theorem conseq_rule {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) (P' : PreCondition σ) (Q' : PostCondition σ α)
    (hP : ∀ s, P' s → P s) (hQ : ∀ s x s', Q s x s' → Q' s x s') :
      HoareTriple P' comp Q'

theorem frame_rule {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) (R : PreCondition σ) :
    HoareTriple (fun s => P s ∧ R s) comp (fun s x s' => Q s x s' ∧ R s)

@[simp]
theorem frame_true_pre {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) :
      HoareTriple (fun s => P s ∧ True) comp Q

@[simp]
theorem get_rule_basic :
    HoareTriple (fun _ => True) (get : StateM σ σ) (fun s x s' => s = x ∧ s = s')

@[simp]
theorem set_rule_basic (s' : σ) :
    HoareTriple (fun _ => True) (set s' : StateM σ Unit) (fun _ _ s'' => s'' = s')

theorem get_rule_forward (P : PreCondition σ) :
    HoareTriple P (get : StateM σ σ) (fun s x s' => P s ∧ s = x ∧ s = s')

theorem set_rule_forward (P : PreCondition σ) (s' : σ) :
    HoareTriple P (set s' : StateM σ Unit) (fun s _ s'' => P s ∧ s'' = s')

theorem get_rule_backward (Q : σ → σ → σ → Prop) :
    HoareTriple (fun s => Q s s s) get Q

theorem set_rule_backward (s' : σ) (Q : σ → Unit → σ → Prop) :
    HoareTriple (fun s => Q s () s') (set s') Q

theorem conj_rule {P₁ P₂ : PreCondition σ} {Q₁ Q₂ : PostCondition σ α}
    {comp : StateM σ α}
    (h₁ : HoareTriple P₁ comp Q₁) (h₂ : HoareTriple P₂ comp Q₂) :
    HoareTriple (fun s => P₁ s ∧ P₂ s) comp (fun s x s' => Q₁ s x s' ∧ Q₂ s x s')

lemma mul_abs_of_nonneg (h : 0 ≤ a) : a * |b

lemma abs_mul_of_nonneg (h : 0 ≤ b) : |a

lemma mul_abs_of_nonpos (h : a < 0) : a * |b

lemma abs_mul_of_nonpos (h : b < 0) : |a

lemma Fintype.sum_inv_card (α : Type*) [Fintype α] [Nonempty α] :
  Finset.sum Finset.univ (λ _ ↦ (Fintype.card α)⁻¹ : α → ℝ≥0∞) = 1

@[simp] -- mathlib?
lemma vector_eq_nil {α : Type*} (xs : List.Vector α 0) : xs = Vector.nil

lemma List.injective2_cons {α : Type*} : Function.Injective2 (List.cons (α := α))

lemma Vector.injective2_cons {α : Type*} {n : ℕ} :
    Function.Injective2 (Vector.cons : α → List.Vector α n → List.Vector α (n + 1))

@[simp]
lemma Vector.getElem_eq_get {α n} (xs : List.Vector α n) (i : ℕ) (h : i < n) :
  xs[i]'h = xs.get ⟨i, h⟩

lemma Prod.mk.injective2 {α β : Type*} :
    Function.Injective2 (Prod.mk : α → β → α × β)

lemma Function.injective2_swap_iff {α β γ : Type*} (f : α → β → γ) :
    (Function.swap f).Injective2 ↔ f.Injective2

@[simp] theorem Finset.image_const_univ {α β} [DecidableEq β]  [Fintype α]
    [Nonempty α] (b : β) : (Finset.univ.image fun _ : α => b) = singleton b

lemma List.countP_eq_sum_fin_ite {α : Type*} (xs : List α) (p : α → Bool) :
    (∑ i : Fin xs.length, if p xs[i] then 1 else 0) = xs.countP p

lemma List.card_filter_getElem_eq {α : Type*} [DecidableEq α]
    (xs : List α) (x : α) :
    (Finset.filter (λ i : Fin (xs.length) ↦ xs[i] = x) Finset.univ).card =
      xs.count x

@[simp] lemma Finset.sum_boole' {ι β : Type*} [AddCommMonoid β] (r : β)
    (p) [DecidablePred p] (s : Finset ι) :
    (∑ x ∈ s, if p x then r else 0 : β) = (s.filter p).card • r

@[simp]
lemma Finset.count_toList {α} [DecidableEq α] (x : α) (s : Finset α) :
    s.toList.count x = if x ∈ s then 1 else 0

lemma BitVec.toFin_bijective (n : ℕ) :
    Function.Bijective (BitVec.toFin : BitVec n → Fin (2 ^ n))

@[simp]
lemma card_bitVec (n : ℕ) : Fintype.card (BitVec n) = 2 ^ n

@[simp]
lemma BitVec.xor_self_xor {n : ℕ} (x y : BitVec n) : x ^^^ (x ^^^ y) = y

@[simp]
lemma heq_of_toArray_eq_of_size_eq {α} {m n : ℕ} {a : Vector α m} {b : Vector α n}
    (h : a.toArray = b.toArray) (h' : m = n) : HEq a b

@[simp]
theorem vectorofFn_get {α : Type} {n : ℕ} (v : Fin n → α) : (Vector.ofFn v).get = v

@[simp]
theorem vectorAdd_get {α : Type} {n : ℕ} [Add α] [Zero α]
 (vx : Vector α n) (vy : Vector α n)
 : (vx + vy).get = vx.get + vy.get

lemma tsum_option {α β : Type*} [AddCommMonoid α] [TopologicalSpace α]
    [ContinuousAdd α] [T2Space α]
    (f : Option β → α) (hf : Summable (Function.update f none 0)) :
    ∑' x : Option β, f x = f none + ∑' x : β, f (some x)

@[simp]
lemma PMF.monad_pure_eq_pure {α : Type u} (x : α) :
    (Pure.pure x : PMF α) = PMF.pure x

@[simp]
lemma PMF.monad_bind_eq_bind {α β : Type u}
      (p : PMF α) (q : α → PMF β) : p >>= q = p.bind q

theorem PMF.bind_eq_zero {α β : Type _} {p : PMF α} {f : α → PMF β} {b : β} :
    (p >>= f) b = 0 ↔ ∀ a, p a = 0 ∨ f a b = 0

theorem PMF.heq_iff {α β : Type u} {pa : PMF α} {pb : PMF β} (h : α = β) :
    HEq pa pb ↔ ∀ x, pa x = pb (cast h x)

theorem Option.cast_eq_some_iff {α β : Type u} {x : Option α} {b : β} (h : α = β) :
    cast (congrArg Option h) x = some b ↔ x = some (cast h.symm b)

theorem PMF.uniformOfFintype_cast (α β : Type _) [ha : Fintype α] [Nonempty α]
    [hb : Fintype β] [Nonempty β] (h : α = β) :
      cast (congrArg PMF h) (PMF.uniformOfFintype α) = @PMF.uniformOfFintype β _ _

theorem tsum_cast {α β : Type u} {f : α → ENNReal} {g : β → ENNReal}
    (h : α = β) (h' : ∀ a, f a = g (cast h a)) :
      (∑' (a : α), f a) = (∑' (b : β), g b)

@[simp]
lemma List.foldlM_range {m : Type u → Type v} [Monad m] [LawfulMonad m]
    {s : Type u} (n : ℕ) (f : s → Fin n → m s) (init : s)  :
    List.foldlM f init (List.finRange n) =
      Fin.foldlM n f init

lemma list_mapM_loop_eq {m : Type u → Type v} [Monad m] [LawfulMonad m]
    {α : Type w} {β : Type u} (xs : List α) (f : α → m β) (ys : List β) :
    List.mapM.loop f xs ys = (ys.reverse ++ ·) <$> List.mapM.loop f xs []

@[simp]
theorem id_comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Chart P Q) :
    (Chart.id Q) ∘c f = f

@[simp]
theorem comp_id {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Chart P Q) :
    f ∘c (Chart.id P) = f

theorem comp_assoc {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    {S : PFunctor.{uA₄, uB₄}} (c : Chart R S) (c' : Chart Q R) (c'' : Chart P Q) :
    (c ∘c c') ∘c c'' = c ∘c (c' ∘c c'')

@[ext (iff := false)]
theorem ext {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (c₁ c₂ : Chart P Q)
    (h₁ : ∀ a, c₁.toFunA a = c₂.toFunA a) (h₂ : ∀ a, c₁.toFunB a = (h₁ a) ▸ c₂.toFunB a) :
    c₁ = c₂

@[simp] lemma C_empty : C PEmpty = 0

@[simp] lemma C_unit : C PUnit = 1

@[simp] lemma C_A (A : Type u) : (C A).A = A

@[simp] lemma C_B (A : Type u) (a : (C A).A) : (C A).B a = PEmpty

@[simp] lemma X_A : X.A = PUnit

@[simp] lemma X_B (a : X.A) : X.B a = PUnit

@[simp] lemma linear_A (A : Type u) : (linear A).A = A

@[simp] lemma linear_B (A : Type u) (a : (linear A).A) : (linear A).B a = PUnit

@[simp] lemma selfMonomial_A (S : Type u) : (selfMonomial S).A = S

@[simp] lemma selfMonomial_B (S : Type u) (a : (selfMonomial S).A) : (selfMonomial S).B a = S

@[simp] lemma selfMonomial_unit : selfMonomial PUnit = X

@[simp] lemma purePower_A (B : Type u) : (purePower B).A = PUnit

@[simp] lemma purePower_B (B : Type u) (a : (purePower B).A) : (purePower B).B a = B

@[simp] lemma purePower_unit : purePower PUnit = X

@[simp]
theorem symm_symm {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃ₚ Q) :
    e.symm.symm = e

@[simp]
theorem symm_comp_self {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃ₚ Q) :
    e.symm.equivA ∘ e.equivA = id

@[ext (iff := false)]
theorem ext {P Q : PFunctor.{uA, uB}} (h : P.A = Q.A) (h' : ∀ a, P.B a = Q.B (h ▸ a)) : P = Q

lemma X_eq_linear_pUnit : X = linear PUnit

lemma X_eq_purePower_pUnit : X = purePower PUnit

@[simp]
theorem ulift_A : (P.ulift).A = ULift P.A

@[simp]
theorem ulift_B {a : P.A} : (P.ulift).B (ULift.up a) = ULift (P.B a)

@[simp]
theorem MonoContProp_def :
  MonoContProp = fun α => {m : Cont Prop α // ∀ p p', (∀ a, p a → p' a) → m p → m p'}

lemma probOutput_prod_mk_seq_map_eq_mul [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β) (z : α × β) :
    [= z | ((·, ·) <$> oa <*> ob : OracleComp spec (α × β))] = [= z.1 | oa] * [= z.2 | ob]

lemma probOutput_prod_mk_seq_map_eq_mul' [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β) (x : α) (y : β) :
    [= (x, y) | ((·, ·) <$> oa <*> ob : OracleComp spec (α × β))] = [= x | oa] * [= y | ob]

lemma probOutput_prod_mk_apply_seq_map_eq_mul [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β)
    (f : α → γ) (g : β → δ) (z : γ × δ) :
    [= z | (f ·, g ·) <$> oa <*> ob] = [= z.1 | f <$> oa] * [= z.2 | g <$> ob]

lemma probOutput_prod_mk_apply_seq_map_eq_mul' [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β)
    (f : α → γ) (g : β → δ) (x : γ) (y : δ) :
    [= (x, y) | (f ·, g ·) <$> oa <*> ob] = [= x | f <$> oa] * [= y | g <$> ob]

lemma probOutput_bind_bind_prod_mk_eq_mul [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β) (f : α → γ) (g : β → δ) (z : γ × δ) :
    [= z | do let x ← oa; let y ← ob; return (f x, g y)] =
      [= z.1 | f <$> oa] * [= z.2 | g <$> ob]

@[simp]
lemma probOutput_bind_bind_prod_mk_eq_mul' [spec.FiniteRange] (oa : OracleComp spec α)
    (ob : OracleComp spec β) (f : α → γ) (g : β → δ) (x : γ) (y : δ) :
    [= (x, y) | do let x ← oa; let y ← ob; return (f x, g y)] =
      [= x | f <$> oa] * [= y | g <$> ob]

lemma map_ite (oa₁ oa₂ : OracleComp spec α) (f : α → β) (p : Prop) [Decidable p] :
    f <$> (if p then oa₁ else oa₂) = if p then (f <$> oa₁) else (f <$> oa₂)

lemma probFailure_bind_eq_sum_probFailure [spec.FiniteRange] (oa : OracleComp spec α)
    {ob : α → OracleComp spec β} {σ : Type u} {s : Finset σ}
    {oc : σ → α → OracleComp spec γ} :
    [⊥ | oa >>= ob] = ∑ x ∈ s, [⊥ | oa >>= oc x]

lemma probOutput_map_eq_probEvent [spec.FiniteRange]
    (oa : OracleComp spec α) (f : α → β) (y : β) :
    [= y | f <$> oa] = [fun x => f x = y | oa]

@[simp]
lemma probOutput_prod_mk_fst_map [spec.FiniteRange] (oa : OracleComp spec α) (y : β) (z : α × β) :
    [= z | (·, y) <$> oa] = [= z.1 | oa] * [= z.2 | (pure y : OracleComp spec β)]

@[simp]
lemma probOutput_prod_mk_snd_map [spec.FiniteRange] (ob : OracleComp spec β) (x : α) (z : α × β) :
    [= z | (x, ·) <$> ob] = [= z.1 | (pure x : OracleComp spec α)] * [= z.2 | ob]

@[simp]
lemma probOutput_prod_mk_fst_map' [spec.FiniteRange] (oa : OracleComp spec α)
    (f : α → γ) (y : β) (z : γ × β) :
    [= z | (f ·, y) <$> oa] = [= z.1 | f <$> oa] * [= z.2 | (pure y : OracleComp spec β)]

@[simp]
lemma probOutput_prod_mk_snd_map' [spec.FiniteRange] (ob : OracleComp spec β)
    (f : β → γ) (x : α) (z : α × γ) :
    [= z | (x, f ·) <$> ob] = [= z.1 | (pure x : OracleComp spec α)] * [= z.2 | f <$> ob]

lemma probOutput_bind_ite_failure_eq_tsum [spec.FiniteRange] [DecidableEq β]
    (oa : OracleComp spec α) (f : α → β) (p : α → Prop) [DecidablePred p] (y : β) :
    [= y | oa >>= fun x => if p x then pure (f x) else failure] =
      ∑' x : α, if p x ∧ y = f x then [= x | oa] else 0

@[simp] lemma support_map_prod_map_fork : (Prod.map cf cf <$> main.fork qb js i cf).support =
    (fun s => (s, s)) '' (cf <$> main).support

@[simp] lemma finSupport_map_prod_map_fork : (Prod.map cf cf <$> main.fork qb js i cf).finSupport =
    (cf <$> main).finSupport.image fun s => (s, s)

lemma apply_eq_apply_of_mem_support_fork (x₁ x₂ : α)
    (h : (x₁, x₂) ∈ (fork main qb js i cf).support) : cf x₁ = cf x₂

@[simp] lemma probOutput_none_map_fork_left (s : Option (Fin (qb i + 1))) :
    [= (none, s) | Prod.map cf cf <$> main.fork qb js i cf] = 0

@[simp] lemma probOutput_none_map_fork_right (s : Option (Fin (qb i + 1))) :
    [= (s, none) | Prod.map cf cf <$> main.fork qb js i cf] = 0

theorem exists_log_of_mem_support_fork (x₁ x₂ : α)
    (h : (x₁, x₂) ∈ (fork main qb js i cf).support) :
      ∃ s, cf x₁ = some s ∧ cf x₂ = some s ∧
      ∃ log₁ : QueryLog spec, ∃ hcf₁ : ↑s < log₁.countQ i,
      ∃ log₂ : QueryLog spec, ∃ hcf₁ : ↑s < log₂.countQ i,
      (log₁.getQ i)[s].1 = (log₂.getQ i)[s].1 ∧
      (log₁.getQ i)[s].2 ≠ (log₂.getQ i)[s].2 ∧
      (x₁, log₁) ∈ (simulateQ loggingOracle main).run.support ∧
      (x₂, log₂) ∈ (simulateQ loggingOracle main).run.support

lemma le_probOutput_fork (s : Fin (qb i + 1)) :
    let h : ℝ≥0∞

theorem probFailure_fork_le :
    let acc : ℝ≥0∞ := ∑ s, [= some s | cf <$> main]
    let h : ℝ≥0∞ := Fintype.card (spec.range i)
    let q := qb i + 1
    [⊥ | fork main qb js i cf] ≤ 1 - acc * (acc / q - h⁻¹)

lemma ProbComp.advantage_eq_half_sub_probFailure (p : ProbComp Unit) :
    p.advantage = |1 / 2 - ([⊥ | p]).toReal

lemma ProbComp.advantage_eq_half_of_sub (p : ProbComp Unit) :
    p.advantage = 2⁻¹ * |([⊥ | p]).toReal - ([= () | p]).toReal

@[simp]
lemma ProbComp.advantage₂_self (p : ProbComp Unit) : p.advantage₂ p = 0

lemma ProbComp.advantage₂_comm (p q : ProbComp Unit) : p.advantage₂ q = q.advantage₂ p

lemma ProbComp.advantage₂_eq_abs_sub_probFailure (p q : ProbComp Unit) :
    p.advantage₂ q = |([⊥ | p]).toReal - ([⊥ | q]).toReal

@[simp]
lemma run_mk {ω : Type u} [LawfulMonad m] (x : m (α × ω)) :
  (WriterT.mk x).run = x

@[simp]
lemma run_tell (w : ω) : (tell w : WriterT ω m PUnit).run = pure (⟨⟩, w)

@[simp]
lemma run_monadLift (x : m α) : (monadLift x : WriterT ω m α).run = (·, 1) <$> x

lemma liftM_def (x : m α) :
    (liftM x : WriterT ω m α) = WriterT.mk ((·, 1) <$> x)

lemma monadLift_def (x : m α) :
    (MonadLift.monadLift x : WriterT ω m α) = WriterT.mk ((·, 1) <$> x)

lemma bind_def (x : WriterT ω m α) (f : α → WriterT ω m β) :
    x >>= f = WriterT.mk (x.run >>= fun (a, w₁) ↦
      (Prod.map id (w₁ * ·)) <$> (f a))

@[simp]
lemma run_pure [LawfulMonad m] (x : α) :
    (pure x : WriterT ω m α).run = pure (x, 1)

@[simp]
lemma run_bind [LawfulMonad m] (x : WriterT ω m α) (f : α → WriterT ω m β) :
    (x >>= f).run = x.run >>= fun (a, w₁) => Prod.map id (w₁ * ·) <$> (f a).run

@[simp]
lemma run_seqLeft {m : Type u → Type v} [Monad m] {ω : Type u} [Monoid ω] {α β : Type u}
    (x : WriterT ω m α) (y : WriterT ω m β) :
    (x *> y).run = x.run >>= fun z => Prod.map id (z.2 * ·) <$> y.run

@[simp]
lemma run_map (x : WriterT ω m α) (f : α → β) : (f <$> x).run = Prod.map f id <$> x.run

@[simp]
lemma run_failure [Monoid ω] {α : Type u} : (failure : WriterT ω m α).run = failure

theorem perfectSecrecy_iff_of_card_eq [Fintype M] [Fintype K] [Fintype C]
    (encAlg : SymmEncAlg m M K C) [encAlg.Complete] (h1 : Fintype.card M = Fintype.card K)
    (h2 : Fintype.card K = Fintype.card C) : encAlg.perfectSecrecy ↔
      (∀ k, [= k | encAlg.exec encAlg.keygen] = (Fintype.card K : ℝ≥0∞)⁻¹) ∧
      (∀ m c, ∃! k, k ∈ (encAlg.exec encAlg.keygen).support ∧ encAlg.encrypt k m = c)

lemma fst_map_writerT_run_simulateQ
    {so : QueryImpl spec (WriterT ω (OracleComp spec))}
    (hso : ∀ {α}, ∀ q : OracleQuery spec α, fst <$> (so.impl q).run = q)
    (oa : OracleComp spec α) : fst <$> (simulateQ so oa).run = oa

lemma probFailure_writerT_run_simulateQ [spec.FiniteRange]
    {so : QueryImpl spec (WriterT ω (OracleComp spec))}
    (hso : ∀ {α}, ∀ q : OracleQuery spec α, fst <$> (so.impl q).run = q)
    (hso' : ∀ {α}, ∀ q : OracleQuery spec α, [⊥ | (so.impl q).run] = 0)
    (oa : OracleComp spec α) : [⊥ | (simulateQ so oa).run] = [⊥ | oa]

lemma neverFails_writerT_run_simulateQ_iff
    {so : QueryImpl spec (WriterT ω (OracleComp spec))}
    (hso : ∀ {α}, ∀ q : OracleQuery spec α, (fst <$> (so.impl q).run).support = ⊤)
    (hso' : ∀ {α}, ∀ q : OracleQuery spec α, (so.impl q).run.neverFails)
    (oa : OracleComp spec α) : (simulateQ so oa).run.neverFails ↔ oa.neverFails

@[simp] lemma PerfectlyCorrect_iff (encAlg : AsymmEncAlg m M PK SK C) :
    PerfectlyCorrect encAlg ↔ ∀ (msg : M),
      [⊥ | CorrectExp encAlg msg] = 0

lemma probOutput_IND_CPA_experiment_eq_add {encAlg : AsymmEncAlg ProbComp M PK SK C}
    (adversary : encAlg.IND_CPA_adversary) :
    [= () | IND_CPA_experiment adversary] =
      [= () | do
        let (pk, _sk) ← encAlg.keygen
        let b ← (simulateQ (encAlg.IND_CPA_queryImpl' pk true) (adversary pk)).run' ∅
        guard b] / 2 +
      [= () | do
        let (pk, _sk) ← encAlg.keygen
        let b ← (simulateQ (encAlg.IND_CPA_queryImpl' pk false) (adversary pk)).run' ∅
        guard ¬b] / 2

@[simp]
lemma decryptionOracle.apply_eq (encAlg : AsymmEncAlg m M PK SK C)
    (sk : SK) (q : OracleQuery (C →ₒ M) α) : (decryptionOracle encAlg sk).impl q =
    match q with

@[simp] lemma withLogging_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withLogging.impl q =
      do let x ← liftM (so.impl q); tell (QueryLog.singleton q x); return x

@[simp] lemma apply_eq (q : OracleQuery spec α) : loggingOracle.impl q =
    do let u ← q; tell (QueryLog.singleton q u); return u

@[simp]
lemma fst_map_run_simulateQ (oa : OracleComp spec α) :
    (Prod.fst <$> (simulateQ loggingOracle oa).run) = oa

@[simp]
lemma run_simulateQ_bind_fst (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    ((simulateQ loggingOracle oa).run >>= fun x => ob x.1) = oa >>= ob

@[simp]
lemma probFailure_run_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    [⊥ | (simulateQ loggingOracle oa).run] = [⊥ | oa]

@[simp]
lemma neverFails_run_simulateQ_iff (oa : OracleComp spec α) :
    neverFails (simulateQ loggingOracle oa).run ↔ neverFails oa

@[simp]
lemma liftM_append_left_eq (q : OracleQuery spec₁ α) :
    (liftM q : OracleQuery (spec₁ ++ₒ spec₂) α) =
      match q with

@[simp]
lemma liftM_append_right_eq (q : OracleQuery spec₂ α) :
    (liftM q : OracleQuery (spec₁ ++ₒ spec₂) α) =
      match q with

@[simp]
lemma liftM_left_append_left_append_eq [h : spec₁ ⊂ₒ spec₃]
    (q : OracleQuery (spec₁ ++ₒ spec₂) α) : (liftM q : OracleQuery (spec₃ ++ₒ spec₂) α) =
    match q with

@[simp]
lemma liftM_right_append_right_append_eq [h : spec₂ ⊂ₒ spec₃]
    (q : OracleQuery (spec₁ ++ₒ spec₂) α) : (liftM q : OracleQuery (spec₁ ++ₒ spec₃) α) =
    match q with

@[simp] theorem monadLift_mono' {m n} [OrderedMonad m] [OrderedMonad n] [OrderedMonadLiftT m n]
    {α} {a b : m α} (h : a ≤ₘ b) : monadLift a ≤ₘ (monadLift b : n α)

lemma isQueryBound_def (oa : OracleComp spec α) (qb : QueryCount spec) :
    IsQueryBound oa qb ↔ ∀ qc ∈ (snd <$> (simulateQ countingOracle oa).run).support, qc ≤ qb

lemma isQueryBound_mono {oa : OracleComp spec α} (qb : ι → ℕ) {qb' : ι → ℕ}
    (h' : IsQueryBound oa qb) (h : qb ≤ qb') : IsQueryBound oa qb'

lemma isQueryBound_iff_probEvent [spec.FiniteRange] {oa : OracleComp spec α} {qb : ι → ℕ} :
    IsQueryBound oa qb ↔
      [(· ≤ qb) | snd <$> (simulateQ countingOracle oa).run <|> return 0] = 1

@[simp]
lemma isQueryBound_pure (a : α) (qb : ι → ℕ) : IsQueryBound (pure a : OracleComp spec α) qb

@[simp]
lemma isQueryBound_failure (qb : ι → ℕ) : IsQueryBound (failure : OracleComp spec α) qb

@[simp]
lemma isQueryBound_query_iff_pos [Nonempty α] (q : OracleQuery spec α) (qb : ι → ℕ) :
    IsQueryBound (q : OracleComp spec α) qb ↔ 0 < qb q.index

@[simp]
lemma generateSeed_nil : generateSeed spec qc [] = return ∅

@[simp]
lemma generateSeed_cons : generateSeed spec qc (j :: js) =
    ($ᵗ (spec.range j)).replicate (qc j) >>= λ xs ↦
      generateSeed spec qc js

@[simp]
lemma generateSeed_zero : generateSeed spec 0 js = return ∅

@[simp]
lemma support_generateSeed : (generateSeed spec qc js).support =
    {seed | ∀ i, (seed i).length = qc i * js.count i}

@[simp]
lemma finSupport_generateSeed_ne_empty [DecidableEq spec.QuerySeed] :
    (generateSeed spec qc js).finSupport ≠ ∅

lemma probOutput_generateSeed [spec.FiniteRange] (seed : QuerySeed spec)
    (h : seed ∈ (generateSeed spec qc js).support) : [= seed | generateSeed spec qc js] =
    1 / (js.map (λ j ↦ (Fintype.card (spec.range j)) ^ qc j)).prod

lemma probOutput_generateSeed' [spec.FiniteRange]
    [DecidableEq spec.QuerySeed] (seed : QuerySeed spec)
    (h : seed ∈ (generateSeed spec qc js).support) : [= seed | generateSeed spec qc js] =
    ((generateSeed spec qc js).finSupport.card : ℝ≥0∞)⁻¹

@[simp low]
lemma support_seq : (og <*> oa).support = ⋃ g ∈ og.support, g '' oa.support

@[simp low]
lemma finSupport_seq [spec.DecidableEq] [spec.FiniteRange]
    [DecidableEq α] [DecidableEq β] [DecidableEq (α → β)] :
    (og <*> oa).finSupport = og.finSupport.biUnion (λ g ↦ oa.finSupport.image g)

lemma probOutput_seq_eq_tsum [spec.FiniteRange] (y : β) : [= y | og <*> oa] =
    ∑' g, ∑' x, [= g | og] * [= x | oa] * [= y | (pure (g x) : OracleComp spec β)]

lemma probOutput_seq_eq_tsum_ite [spec.FiniteRange] [DecidableEq β] (y : β) :
    [= y | og <*> oa] = ∑' g, ∑' x, if y = g x then [= g | og] * [= x | oa] else 0

lemma probOutput_seq_eq_sum_finSupport_ite [spec.FiniteRange] [spec.DecidableEq]
    [DecidableEq α] [DecidableEq (α → β)] [DecidableEq β]
    (y : β) : [= y | og <*> oa] = ∑ g ∈ og.finSupport, ∑ x ∈ oa.finSupport,
      if y = g x then [= g | og] * [= x | oa] else 0

lemma probFailure_seq [spec.FiniteRange] :
    [⊥ | og <*> oa] = [⊥ | og] + [⊥ | oa] - [⊥ | og] * [⊥ | oa]

lemma probEvent_seq_eq_tsum [spec.FiniteRange] (p : β → Prop) :
    [p | og <*> oa] = ∑' (g : α → β), [= g | og] * [p ∘ g | oa]

lemma probEvent_seq_eq_tsum_ite [spec.FiniteRange] (p : β → Prop) [DecidablePred p] :
    [p | og <*> oa] = ∑' (g : α → β) (x : α),
      if p (g x) then [= g | og] * [= x | oa] else 0

@[simp low + 1]
lemma support_seq_map_eq_image2 :
    (f <$> oa <*> ob).support = Set.image2 f oa.support ob.support

@[simp low + 1]
lemma finSupport_seq_map_eq_image2 [spec.FiniteRange] [spec.DecidableEq]
    [DecidableEq α] [DecidableEq β] [DecidableEq γ] :
    (f <$> oa <*> ob).finSupport = Finset.image₂ f oa.finSupport ob.finSupport

lemma evalDist_seq_map [spec.FiniteRange] :
    evalDist (f <$> oa <*> ob) = f <$> evalDist oa <*> evalDist ob

lemma probOutput_seq_map_eq_tsum [spec.FiniteRange]
    (z : γ) : [= z | f <$> oa <*> ob] = ∑' (x : α) (y : β),
      [= x | oa] * [= y | ob] * [= z | (pure (f x y) : OracleComp spec γ)]

lemma probOutput_seq_map_eq_tsum_ite [spec.FiniteRange] [DecidableEq γ]
    (z : γ) : [= z | f <$> oa <*> ob] =
      ∑' (x : α) (y : β), if z = f x y then [= x | oa] * [= y | ob] else 0

lemma probEvent_seq_map_eq_probEvent_comp_uncurry [spec.FiniteRange]
    (p : γ → Prop) : [p | f <$> oa <*> ob] =
      [p ∘ f.uncurry | Prod.mk <$> oa <*> ob]

lemma probEvent_seq_map_eq_probEvent [spec.FiniteRange] (p : γ → Prop) :
    [p | f <$> oa <*> ob] = [λ z ↦ p (f z.1 z.2) | Prod.mk <$> oa <*> ob]

@[simp]
lemma probOutput_seq_map_swap [spec.FiniteRange] (z : γ) :
    [= z | Function.swap f <$> ob <*> oa] = [= z | f <$> oa <*> ob]

@[simp]
lemma evalDist_seq_map_swap [spec.FiniteRange] :
    evalDist (Function.swap f <$> ob <*> oa) = evalDist (f <$> oa <*> ob)

@[simp]
lemma probEvent_seq_map_swap [spec.FiniteRange] (p : γ → Prop) :
    [p | Function.swap f <$> ob <*> oa] = [p | f <$> oa <*> ob]

@[simp]
lemma support_seq_map_swap [spec.FiniteRange] :
    (Function.swap f <$> ob <*> oa).support = (f <$> oa <*> ob).support

@[simp]
lemma finSupport_seq_map_swap [spec.FiniteRange] [spec.DecidableEq] [DecidableEq γ] :
    (Function.swap f <$> ob <*> oa).finSupport = (f <$> oa <*> ob).finSupport

lemma mem_support_seq_map_iff_of_injective2 (hf : f.Injective2) (x : α) (y : β) :
    f x y ∈ (f <$> oa <*> ob).support ↔ x ∈ oa.support ∧ y ∈ ob.support

lemma mem_finSupport_seq_map_iff_of_injective2 [spec.FiniteRange] [spec.DecidableEq]
    [DecidableEq α] [DecidableEq β] [DecidableEq γ]
    (hf : f.Injective2) (x : α) (y : β) : f x y ∈ (f <$> oa <*> ob).finSupport ↔
      x ∈ oa.finSupport ∧ y ∈ ob.finSupport

lemma probOutput_seq_map_eq_mul_of_injective2 [spec.FiniteRange]
    (hf : f.Injective2) (x : α) (y : β) :
    [= f x y | f <$> oa <*> ob] = [= x | oa] * [= y | ob]

lemma probOutput_seq_map_eq_mul [spec.FiniteRange] (x : α) (y : β) (z : γ)
    (h : ∀ x' ∈ oa.support, ∀ y' ∈ ob.support, z = f x' y' ↔ x' = x ∧ y' = y) :
    [= z | f <$> oa <*> ob] = [= x | oa] * [= y | ob]

lemma probEvent_seq_map_eq_mul {ι : Type u} {spec : OracleSpec ι}
    {α β γ : Type v} (f : α → β → γ) [spec.FiniteRange]
    (oa : OracleComp spec α) (ob : OracleComp spec β)
    (p : γ → Prop) (q1 : α → Prop) (q2 : β → Prop)
    (h : ∀ x ∈ oa.support, ∀ y ∈ ob.support, p (f x y) ↔ q1 x ∧ q2 y) :
    [p | f <$> oa <*> ob] = [q1 | oa] * [q2 | ob]

lemma probOutput_map_eq_single [spec.FiniteRange] {oa : OracleComp spec α} {f : α → β} {y : β}
    (x : α) (h : ∀ x' ∈ oa.support, y = f x' → x = x') (h' : f x = y) :
    [= y | f <$> oa] = [= x | oa]

lemma probOutput_prod_mk_eq_probEvent [spec.FiniteRange] [DecidableEq α] [DecidableEq β]
    (oa : OracleComp spec (α × β)) (x : α) (y : β) :
    [= (x, y) | oa] = [λ z ↦ z.1 = x ∧ z.2 = y | oa]

@[simp]
lemma fst_map_prod_map (oa : OracleComp spec (α × β)) (f : α → γ) (g : β → δ) :
    fst <$> map f g <$> oa = (f ∘ Prod.fst) <$> oa

@[simp]
lemma snd_map_prod_map (oa : OracleComp spec (α × β)) (f : α → γ) (g : β → δ) :
    snd <$> map f g <$> oa = (g ∘ Prod.snd) <$> oa

@[simp]
lemma probOutput_fst_map_eq_tsum [spec.FiniteRange] (oa : OracleComp spec (α × β)) (x : α) :
    [= x | fst <$> oa] = ∑' y, [= (x, y) | oa]

@[simp]
lemma probOutput_fst_map_eq_sum [spec.FiniteRange] [Fintype β]
    (oa : OracleComp spec (α × β)) (x : α) : [= x | fst <$> oa] = ∑ y, [= (x, y) | oa]

@[simp]
lemma probOutput_snd_map_eq_tsum [spec.FiniteRange] (oa : OracleComp spec (α × β)) (y : β) :
    [= y | snd <$> oa] = ∑' x, [= (x, y) | oa]

@[simp]
lemma probOutput_snd_map_eq_sum [spec.FiniteRange] [Fintype α]
    (oa : OracleComp spec (α × β)) (y : β) : [= y | snd <$> oa] = ∑ x, [= (x, y) | oa]

lemma probOutput_seq_map_prod_mk_eq_mul :
    [= (x, y) | Prod.mk <$> oa <*> ob] = [= x | oa] * [= y | ob]

lemma probOutput_seq_map_prod_mk_eq_mul' :
    [= (x, y) | (λ x y ↦ (y, x) : β → α → α × β) <$> ob <*> oa] = [= x | oa] * [= y | ob]

lemma probOutput_seq_map_vec_push_eq_mul {n : ℕ} {ova : OracleComp spec (Vector α n)} {va : Vector α n} :
    [= (va.push x) | Vector.push <$> ova <*> oa] = [= va | ova] * [= x | oa]

@[simp]
lemma probEvent_seq_map_prod_mk_eq_mul :
    [λ z ↦ p z.1 ∧ q z.2 | Prod.mk <$> oa <*> ob] = [p | oa] * [q | ob]

lemma probEvent_seq_map_prod_mk_eq_mul' :
    [λ z ↦ p z.1 ∧ q z.2 | (λ x y ↦ (y, x) : β → α → α × β) <$> ob <*> oa] = [p | oa] * [q | ob]

@[simp]
lemma fst_map_prod_mk_of_subsingleton [Subsingleton β]
    (oa : OracleComp spec α) (y : β) : fst <$> (·, y) <$> oa = oa

@[simp]
lemma snd_map_prod_mk_of_subsingleton [Subsingleton α]
    (ob : OracleComp spec β) (x : α) : snd <$> (x, ·) <$> ob = ob

lemma probEvent_fst_eq_snd [spec.FiniteRange] [DecidableEq α] (oa : OracleComp spec (α × α)) :
    [λ z ↦ z.1 = z.2 | oa] = ∑' x : α, [= (x, x) | oa]

@[simp]
lemma def_eq : FreeContT f m α =
    ({r : Type u} → ({x : Type z} → f x → (x → m r) → m r) → (α → m r) → m r)

@[simp]
lemma FreeContM.def_eq : FreeContM.{u, w, y, z} f α =
    ({r : Type u} → ({x : Type z} → f x → (x → r) → r) → (α → r) → r)

@[simp]
lemma FreeMonad.toFreeMonad_toFreeContM (x : FreeMonad f α) :
    FreeContM.toFreeMonad (FreeMonad.toFreeContM x) = x

lemma FreeContM.toFreeContM_toFreeMonad (x : FreeContM f α):
    @FreeMonad.toFreeContM f α (FreeContM.toFreeMonad x) = @x

lemma negligible_zero : negligible 0

lemma negligible_of_zero {f : ℕ → ℝ≥0∞} (hf : ∀ n, f n = 0) : negligible f

lemma heq_forall_iff (h : ∀ a, β a = γ a) {f : (a : α) → β a} {g : (a : α) → γ a} :
    f ≍ g ↔ ∀ a, (f a) ≍ (g a)

@[simp]
theorem id_comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Lens P Q) :
    (Lens.id Q) ∘ₗ f = f

@[simp]
theorem comp_id {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Lens P Q) :
    f ∘ₗ (Lens.id P) = f

theorem comp_assoc {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    {S : PFunctor.{uA₄, uB₄}} (l : Lens R S) (l' : Lens Q R) (l'' : Lens P Q) :
    (l ∘ₗ l') ∘ₗ l'' = l ∘ₗ (l' ∘ₗ l'')

@[simp]
theorem sumMap_comp_inl (l₁ : Lens P R) (l₂ : Lens Q W) :
    ((l₁ ⊎ₗ l₂) ∘ₗ Lens.inl) = (Lens.inl ∘ₗ l₁)

@[simp]
theorem sumMap_comp_inr (l₁ : Lens P R) (l₂ : Lens Q W) :
    ((l₁ ⊎ₗ l₂) ∘ₗ Lens.inr) = (Lens.inr ∘ₗ l₂)

theorem sumPair_comp_sumMap (l₁ : Lens P R) (l₂ : Lens Q W)
    (f : Lens R X) (g : Lens W X) :
  Lens.sumPair f g ∘ₗ (l₁ ⊎ₗ l₂) = Lens.sumPair (f ∘ₗ l₁) (g ∘ₗ l₂)

@[simp]
theorem sumPair_comp_inl (f : Lens P R) (g : Lens Q R) :
    Lens.sumPair f g ∘ₗ Lens.inl = f

@[simp]
theorem sumPair_comp_inr (f : Lens P R) (g : Lens Q R) :
    Lens.sumPair f g ∘ₗ Lens.inr = g

theorem comp_inl_inr (h : Lens.{max uA₁ uA₂, uB₁, uA₃, uB₃} (P + Q) R) :
    Lens.sumPair (h ∘ₗ Lens.inl) (h ∘ₗ Lens.inr) = h

@[simp]
theorem sumMap_id :
    Lens.sumMap (Lens.id P) (Lens.id Q) = Lens.id.{max uA₁ uA₂, uB₁} (P + Q)

@[simp]
theorem sumPair_inl_inr :
    Lens.sumPair Lens.inl Lens.inr = Lens.id.{max uA₁ uA₂, uB₁} (P + Q)

@[simp]
theorem sumComm_symm :
    (sumComm P Q).symm = sumComm Q P

@[simp]
theorem fst_comp_prodMap (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.fst ∘ₗ (l₁ ×ₗ l₂) = l₁ ∘ₗ Lens.fst

@[simp]
theorem snd_comp_prodMap (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.snd ∘ₗ (l₁ ×ₗ l₂) = l₂ ∘ₗ Lens.snd

theorem prodMap_comp_prodPair (l₁ : Lens Q W) (l₂ : Lens R X) (f : Lens P Q) (g : Lens P R) :
    (l₁ ×ₗ l₂) ∘ₗ Lens.prodPair f g = Lens.prodPair (l₁ ∘ₗ f) (l₂ ∘ₗ g)

@[simp]
theorem fst_comp_prodPair (f : Lens P Q) (g : Lens P R) :
    Lens.fst ∘ₗ Lens.prodPair f g = f

@[simp]
theorem snd_comp_prodPair (f : Lens P Q) (g : Lens P R) :
    Lens.snd ∘ₗ Lens.prodPair f g = g

theorem comp_fst_snd (h : Lens.{uA₁, uB₁, max uA₂ uA₃, max uB₂ uB₃} P (Q * R)) :
    Lens.prodPair (Lens.fst ∘ₗ h) (Lens.snd ∘ₗ h) = h

@[simp]
theorem prodMap_id :
    Lens.prodMap (Lens.id P) (Lens.id Q) = Lens.id.{max uA₁ uA₂, max uB₁ uB₂} (P * Q)

@[simp] theorem bind_comm_comp {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ}
    (ma : m α) (mb : m β) (f : α × β → m γ) :
      (ma >>= fun a => mb >>= fun b => f (a, b)) = (mb >>= fun b => ma >>= fun a => f (a, b))

@[simp] theorem CommutativeAt.bind_comm {m} [Monad m] [LawfulMonad m] {α β}
    (ma : m α) (mb : m β) (h : CommutativeAt m ma mb) :
      (ma >>= fun a => mb >>= fun b => pure (a, b)) =
        (mb >>= fun b => ma >>= fun a => pure (a, b))

@[simp] theorem CommutativeAt.bind_comm_comp {m} [Monad m] [LawfulMonad m] {α β γ}
    (ma : m α) (mb : m β) (h : CommutativeAt m ma mb) (f : α × β → m γ) :
      (ma >>= fun a => mb >>= fun b => f (a, b)) = (mb >>= fun b => ma >>= fun a => f (a, b))

theorem bind_comm_triple_swap_12 {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ}
    (ma : m α) (mb : m β) (mc : m γ) (f : α × β × γ → m δ) :
    (do let a ← ma; let b ← mb; let c ← mc; f (a, b, c)) =
    (do let b ← mb; let a ← ma; let c ← mc; f (a, b, c))

theorem bind_comm_triple_swap_23 {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ}
    (ma : m α) (mb : m β) (mc : m γ) (f : α × β × γ → m δ) :
    (do let a ← ma; let b ← mb; let c ← mc; f (a, b, c)) =
    (ma >>= fun a => mc >>= fun c => mb >>= fun b => f (a, b, c))

theorem bind_comm_quad_swap_12 {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ ε}
    (ma : m α) (mb : m β) (mc : m γ) (md : m δ) (f : α × β × γ × δ → m ε) :
    (ma >>= fun a => mb >>= fun b => mc >>= fun c => md >>= fun d => f (a, b, c, d)) =
    (mb >>= fun b => ma >>= fun a => mc >>= fun c => md >>= fun d => f (a, b, c, d))

theorem bind_comm_quad_swap_23 {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ ε}
    (ma : m α) (mb : m β) (mc : m γ) (md : m δ) (f : α × β × γ × δ → m ε) :
    (ma >>= fun a => mb >>= fun b => mc >>= fun c => md >>= fun d => f (a, b, c, d)) =
    (ma >>= fun a => mc >>= fun c => mb >>= fun b => md >>= fun d => f (a, b, c, d))

theorem bind_comm_quad_swap_34 {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ ε}
    (ma : m α) (mb : m β) (mc : m γ) (md : m δ) (f : α × β × γ × δ → m ε) :
    (ma >>= fun a => mb >>= fun b => mc >>= fun c => md >>= fun d => f (a, b, c, d)) =
    (ma >>= fun a => mb >>= fun b => md >>= fun d => mc >>= fun c => f (a, b, c, d))

theorem bind_comm_quad_swap_pairs {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ ε}
    (ma : m α) (mb : m β) (mc : m γ) (md : m δ) (f : α × β × γ × δ → m ε) :
    (ma >>= fun a => mb >>= fun b => mc >>= fun c => md >>= fun d => f (a, b, c, d)) =
    (mc >>= fun c => md >>= fun d => ma >>= fun a => mb >>= fun b => f (a, b, c, d))

theorem bind_reverse_triple {m} [Monad m] [LawfulMonad m] [Commutative m] {α β γ δ}
    (ma : m α) (mb : m β) (mc : m γ) (f : α × β × γ → m δ) :
    (ma >>= fun a => mb >>= fun b => mc >>= fun c => f (a, b, c)) =
    (mc >>= fun c => mb >>= fun b => ma >>= fun a => f (a, b, c))

@[simp]
lemma apply_compose (so' : QueryImpl spec' m) (so : QueryImpl spec (OracleComp spec'))
    (q : OracleQuery spec α) : (so' ∘ₛ so).impl q = simulateQ so' (so.impl q)

@[simp]
lemma simulateQ_compose [LawfulMonad m] [LawfulAlternative m] (so' : QueryImpl spec' m)
    (so : QueryImpl spec (OracleComp spec'))
    (oa : OracleComp spec α) : simulateQ (so' ∘ₛ so) oa = simulateQ so' (simulateQ so oa)

@[simp]
lemma equivState_apply (q : OracleQuery spec α) :
    (so.equivState e).impl q = λ s ↦ map id e <$> so.impl q (e.symm s)

@[simp]
lemma equivState_subsingleton [Subsingleton σ] (e : σ ≃ σ) :
    so.equivState e = so

@[simp]
lemma equivState_equivState : (so.equivState e).equivState e.symm = so

@[simp]
lemma apply_eq (q : OracleQuery spec α) :
    unifOracle.impl q = match q with

@[simp]
lemma evalDist_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    evalDist (simulateQ unifOracle oa) = evalDist oa

@[simp]
lemma support_simulateQ (oa : OracleComp spec α) :
    (simulateQ unifOracle oa).support = oa.support

@[simp]
lemma finSupport_simulateQ [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (oa : OracleComp spec α) : (simulateQ unifOracle oa).finSupport = oa.finSupport

@[simp]
lemma probOutput_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) (x : α) :
    [= x | simulateQ unifOracle oa] = [= x | oa]

@[simp]
lemma probEvent_simulateQ [spec.FiniteRange] (oa : OracleComp spec α)
    (p : α → Prop) [DecidablePred p] :
    [p | simulateQ unifOracle oa] = [p | oa]

@[simp]
lemma append_apply_inl (i : ι₁) (t : spec₁.domain i) :
    (so ++ₛₒ so' : QueryImpl _ n).impl (query (inl i) t) = so.impl (query i t)

@[simp]
lemma append_apply_inr (i : ι₂) (t : spec₂.domain i) :
    (so ++ₛₒ so' : QueryImpl _ n).impl (query (inr i) t) = so'.impl (query i t)

@[simp]
lemma simulate_coe_append_left [AlternativeMonad m₁] [LawfulMonad m₁] [LawfulAlternative m₁]
    [LawfulMonadLift m₁ n] [LawfulAlternativeLift m₁ n] (oa : OracleComp spec₁ α) :
    simulateQ (so ++ₛₒ so') (liftM oa) = (liftM (simulateQ so oa) : n α)

@[simp]
lemma simulate_coe_append_right [AlternativeMonad m₂] [LawfulMonad m₂] [LawfulAlternative m₂]
    [LawfulMonadLift m₂ n] [LawfulAlternativeLift m₂ n] (oa : OracleComp spec₂ α) :
    simulateQ (so ++ₛₒ so') (liftM oa) = (liftM (simulateQ so' oa) : n α)

congrArg in Init.Prelude

List.isEmpty_iff in Init.Data.List.Lemmas
</all_available_lemmas>

<local_ctx>
import ToMathlib.PFunctor.Basic

section find_home

variable {α : Sort u} {β : α → Sort v} {γ : α → Sort v}

end find_home

namespace PFunctor

namespace Lens

@[inherit_doc] infixl:75 " ∘ₗ " => comp

@[inherit_doc] infix:50 " ≃ₗ " => Equiv

namespace Equiv

end Equiv

def prodPair {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
    (l₁ : Lens P Q) (l₂ : Lens P R) :
    Lens.{uA₁, uB₁, max uA₂ uA₃, max uB₂ uB₃} P (Q * R) :=
  (fun p => (l₁.toFunA p, l₂.toFunA p)) ⇆
    (fun p => Sum.elim (l₁.toFunB p) (l₂.toFunB p))

@[inherit_doc] infixl:75 " ◃ₗ " => compMap

@[inherit_doc] infixl:75 " ×ₗ " => prodMap

@[inherit_doc] infixl:75 " ⊎ₗ " => sumMap

@[inherit_doc] infixl:75 " ⊗ₗ " => tensorMap

notation "[" l₁ "," l₂ "]ₗ" => sumPair l₁ l₂

notation "⟨" l₁ "," l₂ "⟩ₗ" => prodPair l₁ l₂

section Coprod

variable {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₁}}
  {R : PFunctor.{uA₃, uB₃}} {W : PFunctor.{uA₄, uB₃}} {X : PFunctor.{uA₅, uB₅}}

namespace Equiv

variable {P : PFunctor.{uA₁, uB}} {Q : PFunctor.{uA₂, uB}} {R : PFunctor.{uA₃, uB}}

end Equiv

end Coprod

section Prod

variable {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} {R : PFunctor.{uA₃, uB₃}}
  {W : PFunctor.{uA₄, uB₄}} {X : PFunctor.{uA₅, uB₅}}
</local_ctx>

<target_theorem>
@[simp]
theorem prodPair_fst_snd :
    Lens.prodPair Lens.fst Lens.snd = Lens.id.{max uA₁ uA₂, max uB₁ uB₂} (P * Q) :=
</target_theorem>

