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>
namespace OracleComp
class HasUniformSelect (cont : Type u) (β : outParam (Type)) where
  uniformSelect : cont → ProbComp β
end OracleComp

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

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

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

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

namespace OracleComp
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
end OracleComp

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

namespace OracleComp
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 -/
end OracleComp

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

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

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

namespace OracleComp
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 -/
end OracleComp

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

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

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 α

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

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

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

namespace FreeMonad
@[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)
end FreeMonad

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

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

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

namespace FreeMonad
@[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))
end FreeMonad

namespace FreeMonad
@[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))
end FreeMonad

namespace FreeMonad
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
end FreeMonad

namespace FreeMonad
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 -/
end FreeMonad

namespace FreeMonad
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
end FreeMonad

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

namespace FreeMonad
@[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)
end FreeMonad

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

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

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

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

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

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

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

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

namespace Id
instance : Extract Id where
  extract := id
end Id

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

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

namespace Id
instance : Coapplicative Id where
end Id

namespace Id
instance : Comonad Id where
end Id

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

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

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

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

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

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

namespace Prod
instance : Coapplicative (Prod ε) where
end Prod

namespace Prod
instance : Comonad (Prod ε) where
end Prod

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

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

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

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

deriving Repr, DecidableEq

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

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

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

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

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

namespace NonEmptyList
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⟩ 
end NonEmptyList

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

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

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

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

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

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

namespace Stream
instance : Coapplicative Stream' where
end Stream

namespace Stream
instance : Comonad Stream' where
end Stream

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

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

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

namespace NonEmptyList
instance : Functor NonEmptyList where
  map := NonEmptyList.map
end NonEmptyList

namespace NonEmptyList
instance : Extract NonEmptyList where
  extract := NonEmptyList.head_nel 
end NonEmptyList

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

namespace NonEmptyList
instance : Coseq NonEmptyList where
  coseq := NonEmptyList.zip 
end NonEmptyList

namespace NonEmptyList
instance : Coapplicative NonEmptyList where
end NonEmptyList

namespace NonEmptyList
instance : Comonad NonEmptyList where
end NonEmptyList

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

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

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

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

deriving Repr, DecidableEq

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

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

namespace List.Zipper
@[simp]
def duplicate (z : Zipper α) : Zipper (Zipper α) :=
  
  sorry 
end List.Zipper

namespace List.Zipper
def coseq (za : Zipper α) (zb : Zipper β) : Zipper (α × β) :=
  sorry 
end List.Zipper

namespace List.Zipper
instance : Functor Zipper where
  map := map
end List.Zipper

namespace List.Zipper
instance : Extract Zipper where
  extract := extract
end List.Zipper

namespace List.Zipper
instance : Extend Zipper where
  extend z f := map f (duplicate z)
end List.Zipper

namespace List.Zipper
instance : Coapplicative Zipper where
  coseq := coseq
end List.Zipper

namespace List.Zipper
instance : Comonad Zipper where
end List.Zipper

namespace List.Zipper
instance : LawfulFunctor Zipper where
  id_map    := sorry
  comp_map  := sorry
  map_const := sorry
end List.Zipper

namespace List.Zipper
instance : LawfulCoapplicative Zipper where
  coseqLeft_eq  := sorry
  coseqRight_eq := sorry
  coseq_assoc   := sorry
end List.Zipper

namespace List.Zipper
instance : LawfulComonad Zipper where
  map_eq_extend_extract := sorry 
  extend_extract        := sorry 
  extract_extend        := sorry 
  extend_assoc          := sorry 
end List.Zipper

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

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

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

namespace EnvT
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 }
end EnvT

namespace EnvT
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 }
end EnvT

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

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

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

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

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

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

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

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

namespace StoreT
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 }
end StoreT

namespace StoreT
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 }
end StoreT

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

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

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

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

namespace StoreT
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 -/
end StoreT

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 β

namespace Day
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⟩
end Day

namespace Day
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)
end Day

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

namespace Day
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⟩
end Day

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

namespace Day
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 
end Day

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

namespace PFunctor
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
end PFunctor

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

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

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

namespace PFunctor.FreeM
@[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)
end PFunctor.FreeM

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

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

namespace PFunctor.FreeM
@[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))
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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))
end PFunctor.FreeM

namespace PFunctor.FreeM
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)
end PFunctor.FreeM

namespace PFunctor.FreeM
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 -/
end PFunctor.FreeM

namespace OracleComp
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)
end OracleComp

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

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

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

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

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

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

namespace OracleComp
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') :=
end OracleComp

namespace PFunctor
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
end PFunctor

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

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

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

namespace PFunctor.CofreeC
def extract (t : CofreeC F α) : α :=
  head t
end PFunctor.CofreeC

namespace PFunctor.CofreeC
def extend (f : CofreeC F α → α) (t : CofreeC F α) : α :=
  f t
end PFunctor.CofreeC

namespace PFunctor.CofreeC
instance : Comonad (CofreeC F) where
  extract := extract
  extend := sorry
  coseq := sorry
end PFunctor.CofreeC

namespace PFunctor.CofreeC
instance : LawfulComonad (CofreeC F) := sorry
end PFunctor.CofreeC

namespace CategoryTheory
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 -/
end CategoryTheory

namespace CategoryTheory.RelativeMonad
@[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 -/
end CategoryTheory.RelativeMonad

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

namespace CategoryTheory.RelativeMonad
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 -/
end CategoryTheory.RelativeMonad

namespace CategoryTheory.RelativeMonad
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 -/
end CategoryTheory.RelativeMonad

namespace CategoryTheory.RelativeMonad
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.μ
end CategoryTheory.RelativeMonad

namespace CategoryTheory.RelativeMonad
@[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⟩
end CategoryTheory.RelativeMonad

namespace CategoryTheory
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 -/
end CategoryTheory

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

namespace Regev
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 :=
end Regev

namespace Regev
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'
end Regev

namespace Regev
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'
end Regev

namespace Regev
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'
end Regev

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

namespace Regev
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)
end Regev

namespace Regev
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)
end Regev

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

namespace Regev
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'
end Regev

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"

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

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

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

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

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

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

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

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

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

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

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

namespace Preord
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
end Preord

namespace CategoryTheory.EnrichedCategory
@[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 -/
end CategoryTheory.EnrichedCategory

namespace CategoryTheory.EnrichedCategory
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)
end CategoryTheory.EnrichedCategory

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

namespace CategoryTheory.EnrichedCategory
structure RelativeMonadHom (M N : RelativeMonad C D J) where
end CategoryTheory.EnrichedCategory

namespace CategoryTheory.EnrichedCategory
class RelativeMonadHom.IsStrict (M N : RelativeMonad C D J) (F : RelativeMonadHom C D J M N) where
end CategoryTheory.EnrichedCategory

namespace CategoryTheory
abbrev PreordEnrichedCategory (C : Type u) := EnrichedCategory Preord C
end CategoryTheory

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

namespace OracleSpec.QueryCache
instance : EmptyCollection (QueryCache spec) := ⟨fun _ _ => none⟩
end OracleSpec.QueryCache

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

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

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

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

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

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

namespace OracleSpec.QueryLog
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
end OracleSpec.QueryLog

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

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

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

namespace OracleSpec.QueryLog
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
end OracleSpec.QueryLog

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

namespace OracleSpec.QueryLog
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
end OracleSpec.QueryLog

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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)

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

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

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₂ α)

namespace QueryImpl
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)
end QueryImpl

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

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

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 α)

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

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))

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

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

namespace MonadHom
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
end MonadHom

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

namespace OracleSpec
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)
end OracleSpec

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

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

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

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

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

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

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

namespace OracleSpec.OracleQuery
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')
end OracleSpec.OracleQuery

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

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

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

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

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

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

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

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

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

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

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

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

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

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

namespace OracleComp
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
end OracleComp

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

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

namespace OracleComp
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
end OracleComp

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

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

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

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

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

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

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

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

namespace OracleComp
@[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
end OracleComp

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

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

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}"

namespace QueryImpl
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)
end QueryImpl

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

namespace MonadTransformer
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)
end MonadTransformer

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

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

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)

namespace DijkstraMonad
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)
end DijkstraMonad

namespace DijkstraMonad
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)
end DijkstraMonad

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)

namespace DijkstraMonad
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)⟩
end DijkstraMonad

namespace DijkstraMonad
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')
end DijkstraMonad

namespace DijkstraMonad
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)⟩
end DijkstraMonad

namespace DijkstraMonad
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 -/
      )
end DijkstraMonad

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

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

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)

namespace OptionT
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
end OptionT

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 -/

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

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

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

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

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

namespace NatEquiv
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
end NatEquiv

namespace NatEquiv
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 -/
end NatEquiv

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 α)

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

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

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

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))

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

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

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

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

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

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

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

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

namespace elgamalAsymmEnc
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₁))
end elgamalAsymmEnc

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

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

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)

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

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

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

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

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

namespace SPMF
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 :=
end SPMF

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

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

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

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

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

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

namespace OracleComp
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) 
end OracleComp

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

namespace OracleComp
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)
end OracleComp

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

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

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

namespace OracleComp.StateM
def PreCondition (σ : Type*) := σ → Prop
end OracleComp.StateM

namespace OracleComp.StateM
abbrev PreCondition.top (σ : Type*) : PreCondition σ := fun _ => True
end OracleComp.StateM

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

namespace OracleComp.StateM
def PostCondition (σ α : Type*) := σ → α → σ → Prop
end OracleComp.StateM

namespace OracleComp.StateM
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 -/
end OracleComp.StateM

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

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

namespace OracleComp.StateM.HoareState
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₃⟩⟩
end OracleComp.StateM.HoareState

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

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

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

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

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

namespace OracleComp.StateM
instance {comp : StateM σ α} {Q : PostCondition σ α} :
    Subsingleton (WeakestPrecondition comp Q) :=
end OracleComp.StateM

namespace OracleComp.StateM
instance {P : PreCondition σ} {comp : StateM σ α} :
    Subsingleton (StrongestPostcondition P comp) :=
end OracleComp.StateM

namespace OracleComp.StateM
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'⟩
end OracleComp.StateM

namespace OracleComp.StateM
instance {Q : PostCondition σ σ} {x : σ} : WeakestPrecondition (pure x : StateM σ σ) Q := default
end OracleComp.StateM

namespace OracleComp.StateM
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 -/
    ⟩
end OracleComp.StateM

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

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

namespace OracleComp.StateM
instance {Q : PostCondition σ σ} : WeakestPrecondition (get : StateM σ σ) Q := default
end OracleComp.StateM

namespace OracleComp.StateM
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 -/
    ⟩
end OracleComp.StateM

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

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

namespace OracleComp
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'')
end OracleComp

namespace OracleComp
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'
end OracleComp

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

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

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

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

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

namespace Vector
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 -/
end Vector

namespace Vector
@[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 :=
end Vector

namespace Vector
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 -/
end Vector

namespace Vector
@[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' :=
end Vector

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

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

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

namespace PFunctor.Chart
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
end PFunctor.Chart

namespace PFunctor.Chart
@[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
end PFunctor.Chart

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

namespace PFunctor.Chart.Equiv
@[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⟩
end PFunctor.Chart.Equiv

namespace PFunctor.Chart.Equiv
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 -/
      ⟩
end PFunctor.Chart.Equiv

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

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

alias fromZero := initial
alias toOne := terminal
end PFunctor.Chart

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

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

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

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

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

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

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

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

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

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

namespace PFunctor
instance : IsEmpty (A 0) := inferInstanceAs (IsEmpty PEmpty)
end PFunctor

namespace PFunctor
instance : Unique (A 1) := inferInstanceAs (Unique PUnit)
end PFunctor

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

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

namespace PFunctor
instance : Unique (A X) := inferInstanceAs (Unique PUnit)
end PFunctor

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

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

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

namespace PFunctor
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⟩
end PFunctor

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

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

alias coprod := sum
end PFunctor

namespace PFunctor
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⟩
end PFunctor

namespace PFunctor
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⟩
end PFunctor

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

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

namespace PFunctor
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)⟩
end PFunctor

namespace PFunctor
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⟩
end PFunctor

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

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

namespace PFunctor
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))⟩
end PFunctor

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

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

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

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

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

namespace PFunctor
@[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
end PFunctor

namespace 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)
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

namespace PFunctor.Equiv
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))
end PFunctor.Equiv

namespace PFunctor.Equiv
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)
end PFunctor.Equiv

namespace PFunctor
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
end PFunctor

namespace PFunctor
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)
end PFunctor

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'}

namespace MonoCont
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 -/
    ⟩
end MonoCont

namespace MonoCont
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)
end MonoCont

namespace MonoCont
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 -/
end MonoCont

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

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

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

namespace OracleComp
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₂)
end OracleComp

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

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

namespace SignatureAlg
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⟩
end SignatureAlg

namespace SignatureAlg
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
end SignatureAlg

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

namespace SignatureAlg
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 σ)
end SignatureAlg

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

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

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

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

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

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

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

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

namespace SymmEncAlg
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
end SymmEncAlg

namespace SymmEncAlg
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]
end SymmEncAlg

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

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

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

namespace PFunctor.Equiv
@[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 _))
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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 _))
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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 ·))
end PFunctor.Equiv

namespace PFunctor.Equiv
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 _)))
end PFunctor.Equiv

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

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

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

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

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
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 _)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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 _)
end PFunctor.Equiv

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

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

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

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

namespace PFunctor.Equiv
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 -/
end PFunctor.Equiv

namespace PFunctor.Equiv
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 -/
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

namespace PFunctor.Equiv
def tensorSigmaDistrib :
    P ⊗ sigma F ≃ₚ sigma (fun i => P ⊗ F i) where
  equivA := sorry
  equivB := sorry
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

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

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

namespace PFunctor.Equiv
def uliftUliftEquiv : P.ulift.ulift ≃ₚ P.ulift :=
  sorry
end PFunctor.Equiv

namespace PFunctor.Equiv
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
end PFunctor.Equiv

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

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

namespace PFunctor.Equiv
instance {P} {a : (P ⊗ 1).A} : IsEmpty ((P ⊗ 1).B a) :=
end PFunctor.Equiv

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

namespace PFunctor.Equiv
instance {P} {a : (1 ⊗ P).A} : IsEmpty ((1 ⊗ P).B a) :=
end PFunctor.Equiv

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

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

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

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
@[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)
end PFunctor.Equiv

namespace PFunctor.Equiv
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)
end PFunctor.Equiv

namespace PFunctor.Equiv
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 _)
end PFunctor.Equiv

namespace PFunctor.Equiv
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 _)
end PFunctor.Equiv

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

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

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

namespace PFunctor.Equiv
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 _
end PFunctor.Equiv

namespace PFunctor.Equiv
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 -/
end PFunctor.Equiv

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

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

namespace PFunctor.Equiv
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
end PFunctor.Equiv

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

namespace 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)
end AsymmEncAlg

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

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

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

namespace AsymmEncAlg
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
end AsymmEncAlg

namespace AsymmEncAlg
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
end AsymmEncAlg

namespace AsymmEncAlg
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')
end AsymmEncAlg

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

namespace AsymmEncAlg
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)
end AsymmEncAlg

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

namespace AsymmEncAlg
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
end AsymmEncAlg

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

namespace AsymmEncAlg
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')
end AsymmEncAlg

namespace AsymmEncAlg
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
end AsymmEncAlg

namespace AsymmEncAlg
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'
end AsymmEncAlg

namespace AsymmEncAlg
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'
end AsymmEncAlg

namespace QueryImpl
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
end QueryImpl

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

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

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

namespace OracleSpec
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
end OracleSpec

namespace OracleSpec
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)
end OracleSpec

namespace OracleSpec
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
end OracleSpec

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

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

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

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

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 -/

namespace MonadRelation
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'
end MonadRelation

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

namespace MonadRelation
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 -/
end MonadRelation

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) }

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

namespace OracleComp
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)
end OracleComp

namespace OracleComp
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)))
end OracleComp

namespace OracleComp
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
end OracleComp

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

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 -/

namespace PFunctor
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
end PFunctor

namespace PFunctor
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
end PFunctor

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} α

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

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

namespace FreeContT
@[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)
end FreeContT

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

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

namespace FreeContT
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 -/
  )
end FreeContT

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

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

namespace FreeContT
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 -/
end FreeContT

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

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

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
@[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 -/
end PFunctor.Lens

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

namespace PFunctor.Lens.Equiv
@[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⟩
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
@[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 -/
      ⟩
end PFunctor.Lens.Equiv

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

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

alias fromZero := initial
alias toOne := terminal
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
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))
end PFunctor.Lens

namespace PFunctor.Lens
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))
end PFunctor.Lens

namespace PFunctor.Lens
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⟩)
end PFunctor.Lens

namespace PFunctor.Lens
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))
end PFunctor.Lens

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

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

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

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

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

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

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

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
def compX : P ◃ X ≃ₗ P where
  toLens := invTildeR
  invLens := tildeR
  left_inv := rfl
  right_inv := rfl
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
def XComp : X ◃ P ≃ₗ P where
  toLens := invTildeL
  invLens := tildeL
  left_inv := rfl
  right_inv := rfl
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

namespace PFunctor.Lens.Equiv
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 -/
end PFunctor.Lens.Equiv

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

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

namespace PFunctor.Lens
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
end PFunctor.Lens

namespace PFunctor.Lens.Equiv
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
end PFunctor.Lens.Equiv

namespace PFunctor.Equiv
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 -/
end PFunctor.Equiv

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

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

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

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

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

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

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

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

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

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

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

namespace OracleSpec
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'
end OracleSpec

namespace OracleSpec
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'
end OracleSpec

namespace OracleSpec
@[inline, reducible]
def rename (spec : OracleSpec ι) (f : τ → ι) : OracleSpec τ := spec ∘ f
end OracleSpec

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

namespace Monad
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))
end Monad

namespace Monad
class Commutative (m : Type u → Type v) [Monad m] where
  bind_comm {α β} (ma : m α) (mb : m β) : CommutativeAt m ma mb
end Monad

namespace Monad
instance {m} [Monad m] [Commutative m] {α β} (ma : m α) (mb : m β) :
    CommutativeAt m ma mb := bind_comm ma mb
end Monad

namespace Monad
instance : Commutative Id where
  bind_comm := fun _ _ => rfl
end Monad

namespace Monad
instance : Commutative Option where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace Monad
instance {ε} [Subsingleton ε] : Commutative (Except ε) where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace Monad
instance {ρ} {m} [Monad m] [Commutative m] : Commutative (ReaderT ρ m) where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace Monad
instance {ω} {m} [Monad m] [Commutative m] [CommMonoid ω] : Commutative (WriterT ω m) where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace Monad
def Set.monadComm : Commutative Set where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace Monad
instance : Commutative PMF where
  bind_comm := fun ma mb => by admit /- proof elided -/
end Monad

namespace QueryImpl
def compose (so' : QueryImpl spec' m) (so : QueryImpl spec (OracleComp spec')) :
    QueryImpl spec m where
  impl q := simulateQ so' (so.impl q)
end QueryImpl

namespace QueryImpl
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)
end QueryImpl

def unifOracle [∀ i, SelectableType (spec.range i)] :
    QueryImpl spec ProbComp where
  impl | query i _ => $ᵗ spec.range i

namespace SimOracle
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)
end SimOracle

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>
namespace OracleComp
@[simp]
lemma uniformSelectList_nil : ($ ([] : List α) : ProbComp α) = failure
end OracleComp

namespace OracleComp
lemma uniformSelectList_cons (x : α) (xs : List α) :
    ($ x :: xs : ProbComp α) = ((x :: xs)[·]) <$> $[0..xs.length]
end OracleComp

namespace OracleComp
@[simp] lemma evalDist_uniformSelectList (xs : List α) : evalDist ($ xs) =
    match xs with
end OracleComp

namespace OracleComp
@[simp] lemma support_uniformSelectList (xs : List α) :
    ($ xs).support = if xs.isEmpty then ∅ else {y | y ∈ (xs)}
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_uniformSelectList [DecidableEq α] (xs : List α) :
    ($ xs).finSupport = if xs.isEmpty then ∅ else xs.toFinset
end OracleComp

namespace OracleComp
@[simp] lemma probOutput_uniformSelectList [DecidableEq α] (xs : List α) (x : α) :
    [= x | $ xs] = if xs.isEmpty then 0 else (xs.count x : ℝ≥0∞) / xs.length
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_uniformSelectList (xs : List α) :
    [⊥ | $ xs] = if xs.isEmpty then 1 else 0
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_uniformSelectList (xs : List α) (p : α → Prop) [DecidablePred p] :
    [p | $ xs] = if xs.isEmpty then 0 else (xs.countP p : ℝ≥0∞) / xs.length
end OracleComp

namespace OracleComp
lemma uniformSelectVector_def {α : Type} {n : ℕ} (xs : Vector α (n + 1)) :
    ($ xs) = ($ xs.toList)
end OracleComp

namespace OracleComp
lemma uniformSelectFinset_def {α : Type} [DecidableEq α] (s : Finset α) :
    ($ s) = ($ s.toList)
end OracleComp

namespace OracleComp
@[simp] lemma support_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    ($ s).support = if s.Nonempty then ↑s else ∅
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    ($ s).finSupport = if s.Nonempty then s else ∅
end OracleComp

namespace OracleComp
@[simp] lemma probOutput_uniformSelectFinset [DecidableEq α] (s : Finset α) (x : α) :
    [= x | $ s] = if x ∈ s then (s.card : ℝ≥0∞)⁻¹ else 0
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    [⊥ | $ s] = if s.Nonempty then 0 else 1
end OracleComp

namespace OracleComp
@[simp] lemma evalDist_uniformSelectFinset [DecidableEq α] (s : Finset α) :
    evalDist ($ s) = if hs : s.Nonempty then
      OptionT.lift (PMF.uniformOfFinset s hs) else failure
end OracleComp

namespace OracleComp
@[simp] lemma probOutput_uniformOfFintype [Fintype α] (x : α) :
    [= x | $ᵗ α] = (Fintype.card α : ℝ≥0∞)⁻¹
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_uniformOfFintype : [⊥ | $ᵗ α] = 0
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_uniformOfFintype : neverFails ($ᵗ α)
end OracleComp

namespace OracleComp
@[simp] lemma evalDist_uniformOfFintype [Fintype α] [Inhabited α] :
    evalDist ($ᵗ α) = OptionT.lift (PMF.uniformOfFintype α)
end OracleComp

namespace OracleComp
@[simp] lemma support_uniformOfFintype : ($ᵗ α).support = Set.univ
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_uniformOfFintype [Fintype α] [DecidableEq α] :
    ($ᵗ α).finSupport = Finset.univ
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_uniformOfFintype [Fintype α] (p : α → Prop) [DecidablePred p] :
    [p | $ᵗ α] = (Finset.univ.filter p).card / Fintype.card α
end OracleComp

namespace OracleComp
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')]
end OracleComp

namespace FreeMonad
@[simp]
lemma monadLift_eq_lift (x : f α) :
  (x : FreeMonad f α) = FreeMonad.lift x
end FreeMonad

namespace FreeMonad
@[simp]
lemma bind_pure (x : α) (r : α → FreeMonad f β) :
    FreeMonad.bind (FreeMonad.pure x) r = r x
end FreeMonad

namespace FreeMonad
@[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)
end FreeMonad

namespace FreeMonad
@[simp]
lemma bind_lift (x : f α) (r : α → FreeMonad f β) :
    FreeMonad.bind (FreeMonad.lift x) r = FreeMonad.roll x r
end FreeMonad

namespace FreeMonad
@[simp]
lemma monad_pure_def (x : α) : (pure x : FreeMonad f α) = FreeMonad.pure x
end FreeMonad

namespace FreeMonad
@[simp]
lemma monad_bind_def (x : FreeMonad f α) (g : α → FreeMonad f β) :
    x >>= g = FreeMonad.bind x g
end FreeMonad

namespace FreeMonad
@[simp]
lemma construct_pure (y : α) : FreeMonad.construct h_pure h_roll (pure y) = h_pure y
end FreeMonad

namespace FreeMonad
@[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)))
end FreeMonad

namespace FreeMonad
@[simp]
lemma mapM'_lift [Monad m] [LawfulMonad m]
    (s : {α : Type u} → f α → m α) (x : f α) :
    FreeMonad.mapM' m s (FreeMonad.lift x) = s x
end FreeMonad

namespace FreeMonad
@[simp]
lemma mapM_pure (x : α) : (FreeMonad.pure x : FreeMonad f α).mapM s = pure x
end FreeMonad

namespace FreeMonad
@[simp]
lemma mapM_roll (x : f α) (r : α → FreeMonad f β) :
    (FreeMonad.roll x r).mapM s = s x >>= λ u ↦ (r u).mapM s
end FreeMonad

namespace FreeMonad
@[simp]
lemma depth_pure {x : α} : depth (pure x : FreeMonad f α) = 0
end FreeMonad

namespace FreeMonad
@[simp]
lemma depth_pure' {x : α} : depth (FreeMonad.pure x : FreeMonad f α) = 0
end FreeMonad

namespace FreeMonad
@[simp]
lemma depth_roll {x : f α} {r : α → FreeMonad f β} :
    depth (roll x r : FreeMonad f β) = 1 + iSup (λ u ↦ depth (r u))
end FreeMonad

namespace FreeMonad
lemma depth_bind_eq {x : FreeMonad f α} {g : α → FreeMonad f β} :
    depth (x >>= g) = depthBindAux x g
end FreeMonad

namespace FreeMonad
lemma depth_bind_le {x : FreeMonad f α} {g : α → FreeMonad f β} :
    depth (x >>= g) ≤ depth x + iSup (λ u ↦ depth (g u))
end FreeMonad

namespace FreeMonad
lemma depth_eq_zero_iff {x : FreeMonad f α} : depth x = 0 ↔ ∃ y, x = pure y
end FreeMonad

namespace FreeMonad
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)
end FreeMonad

namespace SPMF
lemma tsum_run_some_eq_one_sub (p : SPMF α) :
    ∑' x, p.run (some x) = 1 - p.run none
end SPMF

namespace SPMF
@[simp] lemma tsum_run_some_ne_top (p : SPMF α) :
    ∑' x, p.run (some x) ≠ ⊤
end SPMF

namespace SPMF
lemma run_none_eq_one_sub (p : SPMF α) :
    p.run none = 1 - ∑' x, p.run (some x)
end SPMF

namespace SPMF
@[simp] lemma run_none_ne_top (p : SPMF α) : p.run none ≠ ⊤
end SPMF

namespace SPMF
@[ext] lemma ext {p q : SPMF α} (h : ∀ x : α, p.run (some x) = q.run (some x)) : p = q :=
  PMF.ext fun
end SPMF

namespace SPMF
@[simp] lemma apply_eq_run_some (p : SPMF α) (x : α) : p x = p.run (some x)
end SPMF

namespace SPMF
lemma apply'_none_eq_run (p : SPMF α) :
    let p' : PMF (Option α)
end SPMF

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]

namespace SPMF
@[simp] lemma evalDist_eq : evalDist p = p
end SPMF

namespace SPMF
@[simp] lemma probOutput_eq : probOutput p = p
end SPMF

namespace SPMF
@[simp] lemma probEvent_eq : probEvent p = p.run.toOuterMeasure ∘ Set.image some
end SPMF

namespace SPMF
@[simp] lemma probFailure_eq : probFailure p = p.run none
end SPMF

namespace PMF
@[simp] lemma evalDist_eq : evalDist p = liftM p
end PMF

namespace PMF
@[simp] lemma probOutput_eq : probOutput p = p
end PMF

namespace PMF
@[simp] lemma probEvent_eq : probEvent p = p.toOuterMeasure
end PMF

namespace PMF
@[simp] lemma probFailure_eq : probFailure p = 0
end PMF

namespace OracleComp
@[simp]
lemma evalDist_orElse [h : spec.FiniteRange] (oa oa' : OracleComp spec α) :
    evalDist (oa <|> oa') = (evalDist oa <|> evalDist oa')
end OracleComp

namespace OracleComp
@[simp]
lemma probFailure_orElse {ι : Type u} {spec : OracleSpec ι} {α : Type u} [h : spec.FiniteRange]
    (oa oa' : OracleComp spec α) : [⊥ | oa <|> oa'] = [⊥ | oa] * [⊥ | oa']
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace QueryImpl
@[simp] lemma withCounting_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withCounting.impl q = tell (QueryCount.single q.index) *> ↑(so.impl q)
end QueryImpl

namespace countingOracle
@[simp]
protected lemma impl_apply_eq (q : OracleQuery spec α) :
    countingOracle.impl q = (tell (QueryCount.single q.index) *> liftM q)
end countingOracle

namespace countingOracle
@[simp]
lemma fst_map_run_simulateQ (oa : OracleComp spec α) :
    Prod.fst <$> (simulateQ countingOracle oa).run = oa
end countingOracle

namespace countingOracle
@[simp]
lemma run_simulateQ_bind_fst (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    ((simulateQ countingOracle oa).run >>= fun x => ob x.1) = oa >>= ob
end countingOracle

namespace countingOracle
@[simp]
lemma probFailure_run_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    [⊥ | (simulateQ countingOracle oa).run] = [⊥ | oa]
end countingOracle

namespace countingOracle
@[simp]
lemma neverFails_run_simulateQ_iff (oa : OracleComp spec α) :
    neverFails (simulateQ countingOracle oa).run ↔ neverFails oa
end countingOracle

namespace NonEmptyList
@[simp]
theorem head_tails_eq (s : NonEmptyList α) : (tails s).head = s
end NonEmptyList

namespace NonEmptyList
theorem map_map (g : α → β) (h : β → γ) (nel : NonEmptyList α) : map h (map g nel) = map (h ∘ g) nel
end NonEmptyList

namespace Day
@[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⟩
end Day

namespace OracleComp
@[simp]
lemma probOutput_bitVec_ofFin_map {n : ℕ} (oa : OracleComp spec (Fin (2 ^ n)))
    (x : BitVec n) : [= x | ofFin <$> oa] = [= toFin x | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_bitVec_toFin_map {n : ℕ} (oa : OracleComp spec (BitVec n))
    (x : Fin (2 ^ n)) : [= x | toFin <$> oa] = [= ofFin x | oa]
end OracleComp

namespace PFunctor.FreeM
@[simp]
lemma monadLift_eq_lift (x : P.Obj α) : (x : FreeM P α) = FreeM.lift x
end PFunctor.FreeM

namespace PFunctor.FreeM
@[simp]
lemma bind_pure (x : α) (r : α → FreeM P β) :
    FreeM.bind (FreeM.pure x) r = r x
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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)
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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))
end PFunctor.FreeM

namespace PFunctor.FreeM
@[simp]
lemma monad_pure_def (x : α) : (pure x : FreeM P α) = FreeM.pure x
end PFunctor.FreeM

namespace PFunctor.FreeM
@[simp]
lemma monad_bind_def (x : FreeM P α) (g : α → FreeM P β) :
    x >>= g = FreeM.bind x g
end PFunctor.FreeM

namespace PFunctor.FreeM
@[simp]
lemma construct_pure (y : α) : FreeM.construct h_pure h_roll (pure y) = h_pure y
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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)))
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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)
end PFunctor.FreeM

namespace PFunctor.FreeM
@[simp]
lemma mapM_pure (x : α) : (FreeM.pure x : FreeM P α).mapM s = Pure.pure x
end PFunctor.FreeM

namespace PFunctor.FreeM
@[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
end PFunctor.FreeM

namespace OracleComp
@[simp]
lemma evalDist_pure (x : α) : evalDist (pure x : OracleComp spec α) = pure x
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_liftM [Nonempty α] [Fintype α] (q : OracleQuery spec α) :
    evalDist (q : OracleComp spec α) = OptionT.lift (PMF.uniformOfFintype α)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_query (i : ι) (t : spec.domain i) : evalDist (query i t : OracleComp spec _) =
    OptionT.lift (PMF.uniformOfFintype (spec.range i))
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_failure : evalDist (failure : OracleComp spec α) = failure
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    evalDist (oa >>= ob) = (evalDist oa) >>= (evalDist ∘ ob)
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_map (oa : OracleComp spec α) (f : α → β) :
    evalDist (f <$> oa) = f <$> (evalDist oa)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_seq (oa : OracleComp spec α) (og : OracleComp spec (α → β)) :
    evalDist (og <*> oa) = evalDist og <*> evalDist oa
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_eqRec (h : α = β) (oa : OracleComp spec α) :
    evalDist (h ▸ oa) = h ▸ evalDist oa
end OracleComp

namespace OracleComp
@[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'
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_coin : evalDist coin = OptionT.lift (PMF.uniformOfFintype Bool)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_uniformFin (n : ℕ) :
    evalDist $[0..n] = OptionT.lift (PMF.uniformOfFintype (Fin (n + 1)))
end OracleComp

namespace OracleComp
lemma probOutput_def (oa : OracleComp spec α) (x : α) :
    [= x | oa] = (evalDist oa).run (some x)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_comp_some (oa : OracleComp spec α) :
    (evalDist oa).run ∘ some = ([= · | oa])
end OracleComp

namespace OracleComp
lemma probFailure_def (oa : OracleComp spec α) :
    [⊥ | oa] = (evalDist oa).run none
end OracleComp

namespace OracleComp
lemma evalDist_apply_none (oa : OracleComp spec α) :
    (evalDist oa).run none = [⊥ | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_tsum_ite (oa : OracleComp spec α) (p : α → Prop) [DecidablePred p] :
    [p | oa] = ∑' x : α, if p x then [= x | oa] else 0
end OracleComp

namespace OracleComp
@[simp]
lemma probFailure_add_tsum_probOutput (oa : OracleComp spec α) :
    [⊥ | oa] + ∑' x, [= x | oa] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma tsum_probOutput_add_probFailure (oa : OracleComp spec α) :
    ∑' x, [= x | oa] + [⊥ | oa] = 1
end OracleComp

namespace OracleComp
@[simp] lemma probOutput_le_one : [= x | oa] ≤ 1
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_le_one : [⊥ | oa] ≤ 1
end OracleComp

namespace OracleComp
@[simp] lemma tsum_probOutput_le_one : ∑' x : α, [= x | oa] ≤ 1
end OracleComp

namespace OracleComp
@[simp] lemma tsum_probOutput_ne_top : ∑' x : α, [= x | oa] ≠ ⊤
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_le_one : [p | oa] ≤ 1
end OracleComp

namespace OracleComp
@[simp] lemma probOutput_lt_top : [= x | oa] < ∞
end OracleComp

namespace OracleComp
@[simp] lemma not_one_lt_probOutput : ¬ 1 < [= x | oa]
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_ne_top : [p | oa] ≠ ∞
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_lt_top : [p | oa] < ∞
end OracleComp

namespace OracleComp
@[simp] lemma not_one_lt_probEvent : ¬ 1 < [p | oa]
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_ne_top : [⊥ | oa] ≠ ∞
end OracleComp

namespace OracleComp
@[simp] lemma probFailure_lt_top : [⊥ | oa] < ∞
end OracleComp

namespace OracleComp
@[simp] lemma not_one_lt_probFailure : ¬ 1 < [⊥ | oa]
end OracleComp

namespace OracleComp
@[simp] lemma one_le_probOutput_iff : 1 ≤ [= x | oa] ↔ [= x | oa] = 1
end OracleComp

namespace OracleComp
@[simp] lemma one_le_probEvent_iff : 1 ≤ [p | oa] ↔ [p | oa] = 1
end OracleComp

namespace OracleComp
@[simp] lemma one_le_probFailure_iff : 1 ≤ [⊥ | oa] ↔ [⊥ | oa] = 1
end OracleComp

namespace OracleComp
lemma tsum_probOutput_eq_sub (oa : OracleComp spec α) :
    ∑' x : α, [= x | oa] = 1 - [⊥ | oa]
end OracleComp

namespace OracleComp
lemma sum_probOutput_eq_sub [Fintype α] (oa : OracleComp spec α) :
    ∑ x : α, [= x | oa] = 1 - [⊥ | oa]
end OracleComp

namespace OracleComp
lemma probFailure_eq_sub_tsum (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - ∑' x : α, [= x | oa]
end OracleComp

namespace OracleComp
lemma probFailure_eq_sub_sum [Fintype α] (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - ∑ x : α, [= x | oa]
end OracleComp

namespace OracleComp
lemma tsum_probOutput_eq_one (oa : OracleComp spec α) (h : [⊥ | oa] = 0) :
    ∑' x : α, [= x | oa] = 1
end OracleComp

namespace OracleComp
lemma sum_probOutput_eq_one [Fintype α] (oa : OracleComp spec α) (h : [⊥ | oa] = 0) :
    ∑ x : α, [= x | oa] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma mem_support_evalDist_iff (oa : OracleComp spec α) (x : α) :
    some x ∈ (evalDist oa).run.support ↔ x ∈ oa.support
end OracleComp

namespace OracleComp
@[simp]
lemma mem_support_evalDist_iff' [spec.DecidableEq] [DecidableEq α]
    (oa : OracleComp spec α) (x : α) :
    some x ∈ (evalDist oa).run.support ↔ x ∈ oa.finSupport
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_apply_eq_zero_iff (x : Option α) :
    (evalDist oa).run x = 0 ↔ x.rec ([⊥ | oa] = 0) (· ∉ oa.support)
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_apply_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] (x : Option α) :
    (evalDist oa).run x = 0 ↔ x.rec ([⊥ | oa] = 0) (· ∉ oa.finSupport)
end OracleComp

namespace OracleComp
lemma support_evalDist : (evalDist oa).run.support = if [⊥ | oa] = 0 then
    some '' oa.support else insert none (some '' oa.support)
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
@[simp low]
lemma probOutput_eq_zero_iff : [= x | oa] = 0 ↔ x ∉ oa.support
end OracleComp

namespace OracleComp
@[simp low]
lemma zero_eq_probOutput_iff : 0 = [= x | oa] ↔ x ∉ oa.support
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] :
    [= x | oa] = 0 ↔ x ∉ oa.finSupport
end OracleComp

namespace OracleComp
@[simp]
lemma zero_eq_probOutput_iff' [spec.DecidableEq] [DecidableEq α] :
    0 = [= x | oa] ↔ x ∉ oa.finSupport
end OracleComp

namespace OracleComp
lemma probOutput_ne_zero' [DecidableEq α] (h : x ∈ oa.finSupport) : [= x | oa] ≠ 0
end OracleComp

namespace OracleComp
@[simp low]
lemma probEvent_eq_zero_iff : [p | oa] = 0 ↔ ∀ x ∈ oa.support, ¬ p x
end OracleComp

namespace OracleComp
@[simp low]
lemma zero_eq_probEvent_iff : 0 = [p | oa] ↔ ∀ x ∈ oa.support, ¬ p x
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_eq_zero_iff' [spec.DecidableEq] [DecidableEq α] :
    [p | oa] = 0 ↔ ∀ x ∈ oa.finSupport, ¬ p x
end OracleComp

namespace OracleComp
@[simp]
lemma zero_eq_probEvent_iff' [spec.DecidableEq] [DecidableEq α] :
    0 = [p | oa] ↔ ∀ x ∈ oa.finSupport, ¬ p x
end OracleComp

namespace OracleComp
@[simp low]
lemma probOutput_pos_iff : 0 < [= x | oa] ↔ x ∈ oa.support
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_pos_iff' [spec.DecidableEq] [DecidableEq α] :
    0 < [= x | oa] ↔ x ∈ oa.finSupport
end OracleComp

namespace OracleComp
@[simp low]
lemma probEvent_pos_iff : 0 < [p | oa] ↔ ∃ x ∈ oa.support, p x
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_pos_iff' [spec.DecidableEq] [DecidableEq α] :
    0 < [p | oa] ↔ ∃ x ∈ oa.finSupport, p x
end OracleComp

namespace OracleComp
@[simp low]
lemma probOutput_eq_one_iff :
    [= x | oa] = 1 ↔ [⊥ | oa] = 0 ∧ oa.support = {x}
end OracleComp

namespace OracleComp
@[simp low]
lemma one_eq_probOutput_iff :
    1 = [= x | oa] ↔ [⊥ | oa] = 0 ∧ oa.support = {x}
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_eq_one_iff' [spec.DecidableEq] [DecidableEq α] :
    [= x | oa] = 1 ↔ [⊥ | oa] = 0 ∧ oa.finSupport = {x}
end OracleComp

namespace OracleComp
@[simp]
lemma one_eq_probOutput_iff' [spec.DecidableEq] [DecidableEq α] :
    1 = [= x | oa] ↔ [⊥ | oa] = 0 ∧ oa.finSupport = {x}
end OracleComp

namespace OracleComp
@[simp low]
lemma probEvent_eq_one_iff : [p | oa] = 1 ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.support, p x
end OracleComp

namespace OracleComp
@[simp low]
lemma one_eq_probEvent_iff : 1 = [p | oa] ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.support, p x
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_eq_one_iff' [spec.DecidableEq] [DecidableEq α] :
    [p | oa] = 1 ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.finSupport, p x
end OracleComp

namespace OracleComp
@[simp]
lemma one_eq_probEvent_iff' [spec.DecidableEq] [DecidableEq α] :
    1 = [p | oa] ↔ [⊥ | oa] = 0 ∧ ∀ x ∈ oa.finSupport, p x
end OracleComp

namespace OracleComp
lemma mem_support_iff_probOutput_ne_zero : x ∈ oa.support ↔ [= x | oa] ≠ 0
end OracleComp

namespace OracleComp
lemma mem_finSupport_iff_probOutput_ne_zero [spec.DecidableEq] [DecidableEq α] :
    x ∈ oa.finSupport ↔ [= x | oa] ≠ 0
end OracleComp

namespace OracleComp
lemma mem_support_iff_probOutput_pos : x ∈ oa.support ↔ 0 < [= x | oa]
end OracleComp

namespace OracleComp
lemma not_mem_support_iff_probOutput_eq_zero : x ∉ oa.support ↔ [= x | oa] = 0
end OracleComp

namespace OracleComp
lemma probEvent_mono (h : ∀ x ∈ oa.support, p x → q x) : [p | oa] ≤ [q | oa]
end OracleComp

namespace OracleComp
lemma probEvent_mono' [spec.DecidableEq] [DecidableEq α]
    (h : ∀ x ∈ oa.finSupport, p x → q x) : [p | oa] ≤ [q | oa]
end OracleComp

namespace OracleComp
lemma probEvent_congr {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h1 : ∀ x, p x ↔ q x) (h2 : evalDist oa = evalDist oa') : [p | oa] = [q | oa']
end OracleComp

namespace OracleComp
lemma probEvent_ext (h : ∀ x ∈ oa.support, p x ↔ q x) : [p | oa] = [q | oa]
end OracleComp

namespace OracleComp
lemma probEvent_ext' [spec.DecidableEq] [DecidableEq α]
    (h : ∀ x ∈ oa.finSupport, p x ↔ q x) : [p | oa] = [q | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma function_support_probOutput : Function.support ([= · | oa]) = oa.support
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_eq_eq_probOutput (oa : OracleComp spec α) (x : α) :
    [(· = x) | oa] = [= x | oa]
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_eq_eq_probOutput' (oa : OracleComp spec α) (x : α) :
    [(x = ·) | oa] = [= x | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_tsum_subtype : [p | oa] = ∑' x : {x | p x}, [= x | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_tsum_subtype_mem_support :
    [p | oa] = ∑' x : {x ∈ oa.support | p x}, [= x | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_tsum_subtype_support_ite [DecidablePred p] :
    [p | oa] = ∑' x : oa.support, if p x then [= x | oa] else 0
end OracleComp

namespace OracleComp
lemma probEvent_eq_sum_fintype_indicator [Fintype α] (oa : OracleComp spec α) (p : α → Prop) :
    [p | oa] = ∑ x : α, {x | p x}.indicator ([= · | oa]) x
end OracleComp

namespace OracleComp
lemma probEvent_eq_sum_fintype_ite [DecidablePred p] [Fintype α] :
    [p | oa] = ∑ x : α, if p x then [= x | oa] else 0
end OracleComp

namespace OracleComp
lemma probEvent_eq_sum_filter_univ [DecidablePred p] [Fintype α] :
    [p | oa] = ∑ x ∈ Finset.univ.filter p, [= x | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_sum_filter_finSupport [spec.DecidableEq] [DecidablePred p] [DecidableEq α] :
    [p | oa] = ∑ x ∈ oa.finSupport.filter p, [= x | oa]
end OracleComp

namespace OracleComp
lemma probEvent_eq_sum_finSupport_ite [spec.DecidableEq] [DecidablePred p] [DecidableEq α] :
    [p | oa] = ∑ x ∈ oa.finSupport, if p x then [= x | oa] else 0
end OracleComp

namespace OracleComp
lemma probOutput_congr {x y : α} {oa : OracleComp spec α} {oa' : OracleComp spec' α}
    (h1 : x = y) (h2 : evalDist oa = evalDist oa') : [= x | oa] = [= y | oa']
end OracleComp

namespace OracleComp
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']
end OracleComp

namespace OracleComp
@[simp] lemma probEvent_const (oa : OracleComp spec α) (p : Prop) [Decidable p] :
    [λ _ ↦ p | oa] = if p then 1 - [⊥ | oa] else 0
end OracleComp

namespace OracleComp
lemma probEvent_true (oa : OracleComp spec α) : [λ _ ↦ true | oa] = 1 - [⊥ | oa]
end OracleComp

namespace OracleComp
lemma probEvent_false (oa : OracleComp spec α) : [λ _ ↦ false | oa] = 0
end OracleComp

namespace OracleComp
lemma probFailure_eq_sub_probEvent (oa : OracleComp spec α) :
    [⊥ | oa] = 1 - [λ _ ↦ true | oa]
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_pure [DecidableEq α] (y : α) :
    [= y | (pure x : OracleComp spec α)] = if y = x then 1 else 0
end OracleComp

namespace OracleComp
@[simp]
lemma probFailure_pure : [⊥ | (pure x : OracleComp spec α)] = 0
end OracleComp

namespace OracleComp
lemma probOutput_pure_eq_zero {x y : α} (h : y ≠ x) :
    [= y | (pure x : OracleComp spec α)] = 0
end OracleComp

namespace OracleComp
lemma probOutput_pure_eq_one {x y : α} (h : y = x) :
    [= y | (pure x : OracleComp spec α)] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_pure_self (x : α) : [= x | (pure x : OracleComp spec α)] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_pure_subsingleton [Subsingleton α] (x y : α) :
    [= x | (pure y : OracleComp spec α)] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_pure (p : α → Prop) [DecidablePred p] :
    [p | (pure x : OracleComp spec α)] = if p x then 1 else 0
end OracleComp

namespace OracleComp
lemma probEvent_pure_eq_zero {p : α → Prop} {x : α} (h : ¬ p x) :
    [p | (pure x : OracleComp spec α)] = 0
end OracleComp

namespace OracleComp
lemma probEvent_pure_eq_one {p : α → Prop} {x : α} (h : p x) :
    [p | (pure x : OracleComp spec α)] = 1
end OracleComp

namespace OracleComp
lemma probOutput_bind_eq_tsum (y : β) :
    [= y | oa >>= ob] = ∑' x : α, [= x | oa] * [= y | ob x]
end OracleComp

namespace OracleComp
lemma probFailure_bind_eq_tsum :
    [⊥ | oa >>= ob] = [⊥ | oa] + ∑' x : α, [= x | oa] * [⊥ | ob x]
end OracleComp

namespace OracleComp
lemma probOutput_bind_eq_tsum_subtype (y : β) :
    [= y | oa >>= ob] = ∑' x : oa.support, [= x | oa] * [= y | ob x]
end OracleComp

namespace OracleComp
lemma probEvent_bind_eq_tsum_subtype (q : β → Prop) :
    [q | oa >>= ob] = ∑' x : oa.support, [= x | oa] * [q | ob x]
end OracleComp

namespace OracleComp
lemma probOutput_bind_eq_sum_fintype [Fintype α] (y : β) :
    [= y | oa >>= ob] = ∑ x : α, [= x | oa] * [= y | ob x]
end OracleComp

namespace OracleComp
lemma probFailure_bind_eq_sum_fintype [Fintype α] :
    [⊥ | oa >>= ob] = [⊥ | oa] + ∑ x : α, [= x | oa] * [⊥ | ob x]
end OracleComp

namespace OracleComp
lemma probEvent_bind_eq_sum_fintype [Fintype α] (q : β → Prop) :
    [q | oa >>= ob] = ∑ x : α, [= x | oa] * [q | ob x]
end OracleComp

namespace OracleComp
lemma probOutput_bind_eq_sum_finSupport [spec.DecidableEq] [DecidableEq α] (y : β) :
    [= y | oa >>= ob] = ∑ x ∈ oa.finSupport, [= x | oa] * [= y | ob x]
end OracleComp

namespace OracleComp
lemma probEvent_bind_eq_sum_finSupport [spec.DecidableEq] [DecidableEq α]
    (q : β → Prop) :
    [q | oa >>= ob] = ∑ x ∈ oa.finSupport, [= x | oa] * [q | ob x]
end OracleComp

namespace OracleComp
lemma probOutput_bind_of_const (y : β) (r : ℝ≥0∞) (h : ∀ x, [= y | ob x] = r) :
    [= y | oa >>= ob] = (1 - [⊥ | oa]) * r
end OracleComp

namespace OracleComp
lemma probFailure_bind_of_const [Nonempty α] (r : ℝ≥0∞) (h : ∀ x, [⊥ | ob x] = r) :
    [⊥ | oa >>= ob] = [⊥ | oa] + r - [⊥ | oa] * r
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma probFailure_bind_of_neverFails {oa : OracleComp spec α}
    (h : neverFails oa) (ob : α → OracleComp spec β) :
    [⊥ | oa >>= ob] = ∑' x : α, [= x | oa] * [⊥ | ob x]
end OracleComp

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

namespace Regev
theorem isCorrect_of_uniformErrSamp [hm : NeZero m] (χ : ℕ) (he: p > 4*(χ*m + 1)) :
    (regevAsymmEnc n m p (uniformErrSamp χ (relax_p_bound he))).PerfectlyCorrect
end Regev

namespace Regev
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))
end Regev

namespace Regev
theorem Hybrid_1_ind_Hybrid_2 :
    (Hybrid_1 adv).advantage' ≤ (Hybrid_2 adv).advantage'
      + (LHL_Consequence_Advantage (m := m) (Hybrid_12_Reduction adv))
end Regev

namespace Regev
theorem Hybrid_2_advantage_zero : (Hybrid_2 adv).advantage' = 0
end Regev

namespace Regev
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))
end Regev

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

namespace Option
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))
end Option

namespace Option
@[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)
end Option

namespace OracleComp
lemma support_def (oa : OracleComp spec α) :
    oa.support = oa.supportWhen fun _ => Set.univ
end OracleComp

namespace OracleComp
lemma finSupport_def [∀ i, Fintype (spec.range i)] [DecidableEq α] (oa : OracleComp spec α) :
    oa.finSupport = oa.finSupportWhen fun
end OracleComp

namespace OracleComp
@[simp] lemma supportWhen_pure (x : α) :
    (pure x : OracleComp spec α).supportWhen poss = {x}
end OracleComp

namespace OracleComp
@[simp] lemma support_pure (x : α) :
    (pure x : OracleComp spec α).support = {x}
end OracleComp

namespace OracleComp
@[simp] lemma finSupportWhen_pure [DecidableEq α] (x : α) :
    (pure x : OracleComp spec α).finSupportWhen fin_poss = {x}
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_pure [spec.FiniteRange] [DecidableEq α] (x : α) :
    (pure x : OracleComp spec α).finSupport = {x}
end OracleComp

namespace OracleComp
@[simp] lemma supportWhen_failure : (failure : OracleComp spec α).supportWhen poss = ∅
end OracleComp

namespace OracleComp
@[simp] lemma support_failure : (failure : OracleComp spec α).support = ∅
end OracleComp

namespace OracleComp
@[simp] lemma finSupportWhen_failure [DecidableEq α] :
    (failure : OracleComp spec α).finSupportWhen fin_poss = ∅
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_failure [spec.FiniteRange] [DecidableEq α] :
    (failure : OracleComp spec α).finSupport = ∅
end OracleComp

namespace OracleComp
@[simp] lemma supportWhen_query (q : OracleQuery spec α) :
    (q : OracleComp spec α).supportWhen poss = poss q
end OracleComp

namespace OracleComp
@[simp] lemma support_query (q : OracleQuery spec α) :
    (q : OracleComp spec α).support = Set.univ
end OracleComp

namespace OracleComp
@[simp] lemma finSupportWhen_query [DecidableEq α] (q : OracleQuery spec α) :
    (q : OracleComp spec α).finSupportWhen fin_poss = fin_poss q
end OracleComp

namespace OracleComp
lemma finSupport_query [spec.FiniteRange] [DecidableEq α] (q : OracleQuery spec α) :
    (q : OracleComp spec _).finSupport = match q with
end OracleComp

namespace OracleComp
@[simp] lemma supportWhen_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).supportWhen poss = ⋃ x ∈ poss q, (ob x).supportWhen poss
end OracleComp

namespace OracleComp
@[simp] lemma support_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (liftM q >>= ob).support = ⋃ x, (ob x).support
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[simp] lemma supportWhen_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).supportWhen poss = ⋃ x ∈ oa.supportWhen poss, (ob x).supportWhen poss
end OracleComp

namespace OracleComp
@[simp] lemma support_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).support = ⋃ x ∈ oa.support, (ob x).support
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
lemma mem_support_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) (y : β) :
    y ∈ (oa >>= ob).support ↔ ∃ x ∈ oa.support, y ∈ (ob x).support
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp]
lemma coe_finSupport [spec.FiniteRange] [DecidableEq α]
    (oa : OracleComp spec α) : ↑oa.finSupport = oa.support
end OracleComp

namespace OracleComp
lemma finSupport_eq_iff_support_eq_coe : oa.finSupport = s ↔ oa.support = ↑s
end OracleComp

namespace OracleComp
lemma eq_finSupport_iff_coe_eq_support : s = oa.finSupport ↔ ↑s = oa.support
end OracleComp

namespace OracleComp
lemma finSupport_subset_iff_support_subset_coe : oa.finSupport ⊆ s ↔ oa.support ⊆ ↑s
end OracleComp

namespace OracleComp
lemma subset_finSupport_iff_coe_subset_support : s ⊆ oa.finSupport ↔ ↑s ⊆ oa.support
end OracleComp

namespace OracleComp
lemma mem_finSupport_iff_mem_support (x : α) : x ∈ oa.finSupport ↔ x ∈ oa.support
end OracleComp

namespace OracleComp
lemma mem_finSupport_of_mem_support {x : α} (hx : x ∈ oa.support) : x ∈ oa.finSupport
end OracleComp

namespace OracleComp
lemma mem_support_of_mem_finSupport {x : α} (hx : x ∈ oa.finSupport) : x ∈ oa.support
end OracleComp

namespace OracleComp
@[simp] lemma support_eqRec (oa : OracleComp spec α) (h : α = β) :
    (h ▸ oa).support = h.symm ▸ oa.support
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
lemma mem_support_eqRec_iff (oa : OracleComp spec α) (h : α = β) (y : β) :
    y ∈ (h ▸ oa).support ↔ h.symm ▸ y ∈ oa.support
end OracleComp

namespace OracleComp
@[simp] lemma support_map (oa : OracleComp spec α) (f : α → β) :
    (f <$> oa).support = f '' oa.support
end OracleComp

namespace OracleComp
@[simp] lemma fin_support_map [spec.DecidableEq] [spec.FiniteRange]
    [DecidableEq α] [DecidableEq β] (oa : OracleComp spec α) (f : α → β) :
    (f <$> oa).finSupport = oa.finSupport.image f
end OracleComp

namespace OracleComp
lemma mem_support_map {oa : OracleComp spec α} {x : α}
    (hx : x ∈ oa.support) (f : α → β) : f x ∈ (f <$> oa).support
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[simp] lemma support_coin : coin.support = {true, false}
end OracleComp

namespace OracleComp
@[simp] lemma finSupport_coin : coin.finSupport = {true, false}
end OracleComp

namespace OracleComp
@[simp] lemma support_uniformFin (n : ℕ) : ($[0..n]).support = Set.univ
end OracleComp

namespace OracleComp
@[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}
end OracleComp

namespace OracleComp
@[simp]
lemma replicate_zero : replicate 0 oa = return []
end OracleComp

namespace OracleComp
@[simp]
lemma replicateTR_zero : replicate 0 oa = return []
end OracleComp

namespace OracleComp
@[simp]
lemma replicate_succ : replicate (n + 1) oa = List.cons <$> oa <*> replicate n oa
end OracleComp

namespace OracleComp
@[simp]
lemma replicate_pure (x : α) :
    (pure x : OracleComp spec α).replicate n = pure (List.replicate n x)
end OracleComp

namespace OracleComp
@[simp]
lemma probFailure_replicate [spec.FiniteRange] :
    [⊥ | oa.replicate n] = 1 - (1 - [⊥ | oa]) ^ n
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_replicate [spec.FiniteRange] (xs : List α) :
    [= xs | oa.replicate n] = if xs.length = n then (xs.map ([= · | oa])).prod else 0
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
lemma support_eq_setOf_probOutput_eq_zero [spec.FiniteRange] (oa : OracleComp spec α) :
    oa.support = {x | [= x | oa] ≠ 0}
end OracleComp

namespace OracleComp
@[simp]
lemma support_replicate [spec.FiniteRange] (oa : OracleComp spec α) (n : ℕ) :
    (oa.replicate n).support = {xs | xs.length = n ∧ ∀ x ∈ xs, x ∈ oa.support}
end OracleComp

namespace OracleComp
lemma support_replicate' [spec.FiniteRange] [DecidableEq α] (oa : OracleComp spec α) (n : ℕ) :
    (oa.replicate n).support = {xs | xs.length = n ∧ xs.all (· ∈ oa.support)}
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleSpec.QueryCache
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'
end OracleSpec.QueryCache

namespace OracleSpec.QueryCount
@[simp] lemma monoid_mul_def (qc qc' : QueryCount spec) :
  (@HMul.hMul _ _ _ (@instHMul _ (Monoid.toMulOneClass.toMul)) qc qc')
     = (qc : ι → ℕ) + (qc' : ι → ℕ)
end OracleSpec.QueryCount

namespace OracleSpec.QueryCount
@[simp] lemma monoid_one_def :
    (@OfNat.ofNat (QueryCount spec) 1 (@One.toOfNat1 _ (Monoid.toOne))) = (0 : ι → ℕ)
end OracleSpec.QueryCount

namespace OracleSpec.QueryCount
@[simp]
lemma single_le_iff_pos [DecidableEq ι] (i : ι) (qc : QueryCount spec) :
    single i ≤ qc ↔ 0 < qc i
end OracleSpec.QueryCount

namespace OracleSpec.QueryLog
@[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 _)
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[simp] lemma monoid_one_def : (1 : QueryLog spec) = List.nil
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
lemma getQ_singleton {α} (q : OracleQuery spec α) (u : α) (i : ι) :
    getQ (singleton q u) i = match q with
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[simp]
lemma getQ_singleton_self (i : ι) (t : spec.domain i) (u : spec.range i) :
    getQ (singleton (query i t) u) i = [(t, u)]
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
lemma getQ_singleton_of_ne {α} {q : OracleQuery spec α} {u : α} {i : ι}
    (h : q.index ≠ i) : getQ (singleton q u) i = []
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[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
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[simp]
lemma getQ_append (log log' : QueryLog spec) (i : ι) :
    (log ++ log').getQ i = log.getQ i ++ log'.getQ i
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[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
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[simp]
lemma countQ_singleton {α} (q : OracleQuery spec α) (u : α) (i : ι) :
    countQ (singleton q u) i = if q.index = i then 1 else 0
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
lemma countQ_singleton_self (i : ι) (t : spec.domain i) (u : spec.range i) :
    countQ (singleton (query i t) u) i = 1
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[simp]
lemma countQ_append (log log' : QueryLog spec) (i : ι) :
    (log ++ log').countQ i = log.countQ i + log'.countQ i
end OracleSpec.QueryLog

namespace OracleSpec.QueryLog
@[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
end OracleSpec.QueryLog

namespace OracleSpec.QuerySeed
@[ext]
protected lemma ext (seed₁ seed₂ : QuerySeed spec) (h : ∀ i, seed₁ i = seed₂ i) : seed₁ = seed₂
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
@[simp]
lemma addValues_apply (j : ι) : seed.addValues us j =
    Function.update seed i (seed i ++ us) j
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
@[simp]
lemma addValues_nil {i : ι} (seed : QuerySeed spec) : seed.addValues (i := i) [] = seed
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
@[simp]
lemma takeAtIndex_apply (j : ι) : seed.takeAtIndex i n j =
    (Function.update seed i ((seed i).take n) j)
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
@[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))
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
@[simp]
lemma takeAtIndex_length (seed : QuerySeed spec) (i : ι) :
    seed.takeAtIndex i (seed i).length = seed
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
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)
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
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
end OracleSpec.QuerySeed

namespace OracleSpec.QuerySeed
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
end OracleSpec.QuerySeed

namespace OracleSpec.SubSpec
@[simp] lemma liftM_query_eq_liftM_liftM (q : OracleQuery spec α) :
    (q : OracleComp superSpec α) = ((q : OracleQuery superSpec α) : OracleComp superSpec α)
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
lemma evalDist_lift_query [superSpec.FiniteRange] [Fintype α] [Nonempty α]
    (q : OracleQuery spec α) :
    evalDist ((q : OracleQuery superSpec α) : OracleComp superSpec α) =
      OptionT.lift (PMF.uniformOfFintype α)
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[simp] lemma evalDist_liftM [superSpec.FiniteRange] [Fintype α] [Nonempty α]
    (q : OracleQuery spec α) :
    evalDist (q : OracleComp superSpec α) =
      OptionT.lift (PMF.uniformOfFintype α)
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[simp] lemma supportWhen_monadLift (q : OracleQuery spec α)
    (poss : {α : Type w} → OracleQuery superSpec α → Set α) :
    supportWhen (q : OracleComp superSpec α) poss = poss q
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[simp]
lemma support_toFun (q : OracleQuery spec α) :
    support (h.monadLift q : OracleComp superSpec α) = Set.univ
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[simp]
lemma finSupport_toFun [spec.DecidableEq] [superSpec.DecidableEq] [superSpec.FiniteRange]
    [DecidableEq α] [Fintype α] (q : OracleQuery spec α) :
    finSupport (h.monadLift q : OracleComp superSpec α) = Finset.univ
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[simp]
lemma probOutput_toFun [superSpec.FiniteRange] [Fintype α]
    (q : OracleQuery spec α) (u : α) :
    [= u | (h.monadLift q : OracleComp superSpec α)] =
      (↑(Fintype.card α) : ℝ≥0∞)⁻¹
end OracleSpec.SubSpec

namespace OracleSpec.SubSpec
@[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 α
end OracleSpec.SubSpec

namespace OracleComp
lemma liftComp_def (oa : OracleComp spec α) :
    liftComp oa superSpec = simulateQ (m := OracleComp superSpec) ⟨liftM⟩ oa
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_pure (x : α) : liftComp (pure x : OracleComp spec α) superSpec = pure x
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_query (q : OracleQuery spec α) :
    liftComp (q : OracleComp spec _) superSpec = liftM q
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    liftComp (oa >>= ob) superSpec =
      liftComp oa superSpec >>= λ x ↦ liftComp (ob x) superSpec
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_failure : liftComp (failure : OracleComp spec α) superSpec = failure
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_map (oa : OracleComp spec α) (f : α → β) :
    liftComp (f <$> oa) superSpec = f <$> liftComp oa superSpec
end OracleComp

namespace OracleComp
@[simp]
lemma liftComp_seq (og : OracleComp spec (α → β)) (oa : OracleComp spec α) :
    liftComp (og <*> oa) superSpec = liftComp og superSpec <*> liftComp oa superSpec
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : evalDist (liftComp oa superSpec) = evalDist oa
end OracleComp

namespace OracleComp
@[simp] -- NOTE: shouldn't actually need finiteness here.
lemma support_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : (liftComp oa superSpec).support = oa.support
end OracleComp

namespace OracleComp
@[simp]
lemma finSupport_liftComp [spec.DecidableEq] [superSpec.DecidableEq] [DecidableEq α]
    [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) : (liftComp oa superSpec).finSupport = oa.finSupport
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) (x : α) : [= x | liftComp oa superSpec] = [= x | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_liftComp [spec.FiniteRange] [superSpec.FiniteRange]
    (oa : OracleComp spec α) (p : α → Prop) [DecidablePred p] :
    [p | liftComp oa superSpec] = [p | oa]
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_lift_comp_iff (oa : OracleComp spec α) :
    (liftComp oa superSpec).neverFails ↔ oa.neverFails
end OracleComp

namespace OracleComp
@[simp]
lemma liftM_eq_liftComp (oa : OracleComp spec α) :
    (liftM oa : OracleComp superSpec α) = liftComp oa superSpec
end OracleComp

lemma QueryImpl.ext' {so so' : QueryImpl spec m}
    (h : ∀ {α} (q : OracleQuery spec α), so.impl q = so'.impl q) :
    so = so'

namespace OracleComp
@[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')
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_failure : simulateQ so (failure : OracleComp spec α) = failure
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_query (q : OracleQuery spec α) : simulateQ so q = so.impl q
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_pure (x : α) : simulateQ so (pure x) = pure x
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_comp_pure_comp (f : α → β) : simulateQ so ∘ pure ∘ f = pure ∘ f
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_query_bind (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    simulateQ so (liftM q >>= ob) = so.impl q >>= (simulateQ so ∘ ob)
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_bind (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    simulateQ so (oa >>= ob) = simulateQ so oa >>= (simulateQ so ∘ ob)
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_map (oa : OracleComp spec α) (f : α → β) :
    simulateQ so (f <$> oa) = f <$> simulateQ so oa
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_seq (og : OracleComp spec (α → β)) (oa : OracleComp spec α) :
    simulateQ so (og <*> oa) = simulateQ so og <*> simulateQ so oa
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_seqLeft (oa : OracleComp spec α) (ob : OracleComp spec β) :
    simulateQ so (oa <* ob) = simulateQ so oa <* simulateQ so ob
end OracleComp

namespace OracleComp
@[simp] lemma simulateQ_seqRight (oa : OracleComp spec α) (ob : OracleComp spec β) :
    simulateQ so (oa *> ob) = simulateQ so oa *> simulateQ so ob
end OracleComp

namespace idOracle
@[simp] lemma apply_eq (q : OracleQuery spec α) : idOracle.impl q = q
end idOracle

namespace idOracle
@[simp] lemma simulateQ_eq_id : @simulateQ ι spec _ α _ idOracle = id
end idOracle

namespace idOracle
lemma simulateQ_eq (oa : OracleComp spec α) : simulateQ idOracle oa = oa
end idOracle

namespace defaultOracle
@[simp] lemma apply_eq [spec.FiniteRange] (q : OracleQuery spec α) :
    defaultOracle.impl q = return q.defaultOutput
end defaultOracle

namespace defaultOracle
@[simp] lemma simulateQ_eq_getM_defaultResult [spec.FiniteRange] :
    @simulateQ ι spec _ α _ defaultOracle = Option.getM ∘ defaultResult
end defaultOracle

namespace defaultOracle
lemma simulateQ_eq [spec.FiniteRange] (oa : OracleComp spec α) :
    simulateQ defaultOracle oa = oa.defaultResult.getM
end defaultOracle

namespace QueryImpl
@[simp] lemma withCaching_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withCaching.impl q = match q with
end QueryImpl

namespace cachingOracle
lemma apply_eq {α} (q : OracleQuery spec α) : cachingOracle.impl q =
  match q with
end cachingOracle

namespace randOracle
lemma apply_eq {α} (q : OracleQuery spec α) : randomOracle.impl q =
    match q with
end randOracle

namespace MonadHom
@[simp]
lemma mmap_pure (F : m →ᵐ n) (x : α) :
    F (pure x) = pure x
end MonadHom

namespace MonadHom
@[simp]
lemma mmap_bind (F : m →ᵐ n) (x : m α) (y : α → m β) :
    F (x >>= y) = F x >>= fun x => F (y x)
end MonadHom

namespace MonadHom
@[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
end MonadHom

namespace MonadHom
@[simp]
lemma mmap_seq [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m (α → β)) (y : m α) : F (x <*> y) = F x <*> F y
end MonadHom

namespace MonadHom
@[simp]
lemma mmap_seqLeft [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m α) (y : m β) : F (x <* y) = F x <* F y
end MonadHom

namespace MonadHom
@[simp]
lemma mmap_seqRight [LawfulMonad m] [LawfulMonad n]
    (F : m →ᵐ n) (x : m α) (y : m β) : F (x *> y) = F x *> F y
end MonadHom

namespace MonadHom
@[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
end MonadHom

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)

namespace OracleComp
lemma StateT_run_simulateQ_eq_map_run'_simulateQ {α} (oa : OracleComp spec α) (s s' : σ) :
    (simulateQ so oa).run s = (·, s') <$> (simulateQ so oa).run' s
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleSpec.OracleQuery
@[simp] lemma index_query (i : ι) (t : spec.domain i) : (query i t).index = i
end OracleSpec.OracleQuery

namespace OracleSpec.OracleQuery
@[simp] lemma input_query (i : ι) (t : spec.domain i) : (query i t).input = t
end OracleSpec.OracleQuery

namespace OracleSpec.OracleQuery
@[simp]
lemma range_index : (q : OracleQuery spec α) → spec.range q.index = α
end OracleSpec.OracleQuery

namespace OracleSpec.OracleQuery
lemma eq_query_index_input : (q : OracleQuery spec α) →
    q = q.range_index ▸ OracleQuery.query q.index q.input
end OracleSpec.OracleQuery

namespace OracleComp
protected lemma liftM_def (q : OracleQuery spec α) :
    (q : OracleComp spec α) = OptionT.lift (FreeMonad.lift q)
end OracleComp

namespace OracleComp
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 α)
end OracleComp

namespace OracleComp
@[simp]
lemma liftM_query_stateT {σ : Type v} {α : Type v} (q : OracleQuery spec α) :
  (liftM q : StateT σ (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp]
lemma liftM_query_writerT {ω : Type v} [Monoid ω] {α : Type v} (q : OracleQuery spec α) :
  (liftM q : WriterT ω (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp]
lemma liftM_query_readerT {ρ : Type v} {α : Type v} (q : OracleQuery spec α) :
  (liftM q : ReaderT ρ (OracleComp spec) α) = liftM (liftM q : OracleComp spec α)
end OracleComp

namespace OracleComp
lemma query_bind_eq_roll (q : OracleQuery spec α) (ob : α → OracleComp spec β) :
    (q : OracleComp spec α) >>= ob = OptionT.mk (FreeMonad.roll q ob)
end OracleComp

namespace OracleComp
protected lemma pure_def (x : α) : (pure x : OracleComp spec α) = OptionT.pure x
end OracleComp

namespace OracleComp
protected lemma bind_def (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    oa >>= ob = OptionT.bind oa ob
end OracleComp

namespace OracleComp
protected lemma failure_def : (failure : OracleComp spec α) = OptionT.fail
end OracleComp

namespace OracleComp
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')
end OracleComp

namespace OracleComp
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'
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
@[simp]
lemma construct_pure (x : α) :
    OracleComp.construct h_pure h_query_bind h_failure (pure x) = h_pure x
end OracleComp

namespace OracleComp
@[simp]
lemma construct_failure :
    OracleComp.construct h_pure h_query_bind h_failure failure = h_failure
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[simp] lemma isPure_pure : isPure (pure x : OracleComp spec α) = true
end OracleComp

namespace OracleComp
@[simp] lemma isPure_query_bind : isPure ((q : OracleComp spec β) >>= oa) = false
end OracleComp

namespace OracleComp
@[simp] lemma isPure_failure : isPure (failure : OracleComp spec α) = false
end OracleComp

namespace OracleComp
@[simp] lemma isFailure_pure : isFailure (pure x : OracleComp spec α) = false
end OracleComp

namespace OracleComp
@[simp] lemma isFailure_query_bind : isFailure ((q : OracleComp spec β) >>= oa) = false
end OracleComp

namespace OracleComp
@[simp] lemma isFailure_failure : isFailure (failure : OracleComp spec α) = true
end OracleComp

namespace OracleComp
lemma exists_eq_of_isPure {oa : OracleComp spec α} (h : isPure oa) : ∃ x, oa = pure x
end OracleComp

namespace OracleComp
lemma eq_failure_of_isFailure {oa : OracleComp spec α} (h : isFailure oa) : oa = failure
end OracleComp

namespace OracleComp
@[simp] lemma pure_ne_query : pure y ≠ (q : OracleComp spec β)
end OracleComp

namespace OracleComp
@[simp] lemma query_ne_pure : (q : OracleComp spec β) ≠ pure y
end OracleComp

namespace OracleComp
@[simp] lemma pure_ne_query_bind : pure x ≠ (q : OracleComp spec β) >>= oa
end OracleComp

namespace OracleComp
@[simp] lemma query_bind_ne_pure : (q : OracleComp spec β) >>= oa ≠ pure x
end OracleComp

namespace OracleComp
@[simp] lemma pure_ne_failure : (pure x : OracleComp spec α) ≠ failure
end OracleComp

namespace OracleComp
@[simp] lemma failure_ne_pure : failure ≠ (pure x : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp] lemma failure_ne_query_bind : failure ≠ (q : OracleComp spec β) >>= oa
end OracleComp

namespace OracleComp
@[simp] lemma query_bind_ne_failure : (q : OracleComp spec β) >>= oa ≠ failure
end OracleComp

namespace OracleComp
@[simp] lemma query_ne_failure : (q : OracleComp spec β) ≠ failure
end OracleComp

namespace OracleComp
@[simp] lemma failure_ne_query : failure ≠ (q : OracleComp spec β)
end OracleComp

namespace OracleComp
lemma pure_eq_query_iff_false : pure y = (q : OracleComp spec β) ↔ False
end OracleComp

namespace OracleComp
lemma query_eq_pure_iff_false : (q : OracleComp spec β) = pure y ↔ False
end OracleComp

namespace OracleComp
@[simp] lemma mapM_pure (x : α) : (pure x : OracleComp spec α).mapM fail qm = pure x
end OracleComp

namespace OracleComp
@[simp] lemma mapM_failure : (failure : OracleComp spec α).mapM fail qm = fail
end OracleComp

namespace OracleComp
@[simp]
lemma mapM_query [LawfulMonad m] (q : OracleQuery spec α) :
    (q : OracleComp spec α).mapM fail qm = qm q
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
lemma mapM_map [LawfulMonad m] (oa : OracleComp spec α) (f : α → β)
    (hfail : ∀ f : α → β, f <$> fail = fail) :
    (f <$> oa).mapM fail qm = f <$> oa.mapM fail qm
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[simp]
lemma pure_inj (x y : α) : (pure x : OracleComp spec α) = pure y ↔ x = y
end OracleComp

namespace OracleComp
@[simp]
lemma liftM_inj (q q' : OracleQuery spec α) : (q : OracleComp spec α) = q' ↔ q = q'
end OracleComp

namespace OracleComp
@[simp]
lemma query_inj (i : ι) (t t' : spec.domain i) :
    (query i t : OracleComp spec (spec.range i)) = query i t' ↔ t = t'
end OracleComp

namespace OracleComp
@[simp]
lemma queryBind_inj (q q' : OracleQuery spec α) (ob ob' : α → OracleComp spec β) :
    (q : OracleComp spec α) >>= ob = (q' : OracleComp spec α) >>= ob' ↔ q = q' ∧ ob = ob'
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace StateT
@[simp]
lemma liftM_of_liftM_eq [MonadLift m m'] (x : StateT σ m α) :
    (liftM x : StateT σ m' α) = StateT.mk fun s => liftM (x.run s)
end StateT

namespace StateT
lemma liftM_def [Monad m] (x : m α) : (liftM x : StateT σ m α) = StateT.lift x
end StateT

namespace StateT
lemma monad_pure_def [Monad m] (x : α) :
    (pure x : StateT σ m α) = StateT.pure x
end StateT

namespace StateT
lemma monad_bind_def [Monad m] (x : StateT σ m α) (f : α → StateT σ m β) :
    x >>= f = StateT.bind x f
end StateT

namespace StateT
lemma monad_failure_eq [Monad m] [Alternative m] :
    (failure : StateT σ m α) = StateT.failure
end StateT

namespace StateT
@[simp]
lemma run_failure' [Monad m] [Alternative m] :
    (failure : StateT σ m α).run = fun _ => failure
end StateT

namespace StateT
@[simp]
lemma mk_pure_eq_pure [Monad m] (x : α) :
  StateT.mk (λ s ↦ pure (x, s)) = (pure x : StateT σ m α)
end StateT

namespace OracleComp
@[simp] lemma allWhen_pure (x : α) :
    (pure x : OracleComp spec α).allWhen Q F possible_outputs
end OracleComp

namespace OracleComp
@[simp] lemma someWhen_pure (x : α) :
    (pure x : OracleComp spec α).someWhen Q F possible_outputs
end OracleComp

namespace OracleComp
@[simp] lemma allWhen_failure_iff :
    (failure : OracleComp spec α).allWhen Q F possible_outputs ↔ F
end OracleComp

namespace OracleComp
@[simp] lemma allWhen_query_iff (q : OracleQuery spec α) :
    (q : OracleComp spec α).allWhen Q F possible_outputs ↔ Q q
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
lemma neverFails_eq_oracleComp_construct (oa : OracleComp spec α) :
    oa.neverFails = OracleComp.construct
      (fun _ ↦ True) (fun {β} _ _ r ↦ ∀ (x : β), r x) False oa
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_pure (x : α) : neverFails (pure x : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_query (q : OracleQuery spec α) : neverFails (q : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_query_bind_iff {q : OracleQuery spec α} {oa : α → OracleComp spec β} :
    (liftM q >>= oa).neverFails ↔ ∀ x, neverFails (oa x)
end OracleComp

namespace OracleComp
@[simp]
lemma not_neverFails_failure : ¬ neverFails (failure : OracleComp spec α)
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_bind_iff (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    (oa >>= ob).neverFails ↔ oa.neverFails ∧ ∀ x ∈ oa.support, (ob x).neverFails
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_map_iff (oa : OracleComp spec α) (f : α → β) :
    neverFails (f <$> oa) ↔ neverFails oa
end OracleComp

namespace OracleComp
@[simp]
lemma neverFails_guard (p : Prop) [Decidable p] (oa : OracleComp spec α) (h: oa.neverFails) :
    neverFails (if p then oa else failure) ↔ p
end OracleComp

namespace oneTimePad
@[simp] lemma toExecutionMethod_eq (n : ℕ) :
    (oneTimePad n).toExecutionMethod = ExecutionMethod.default
end oneTimePad

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

namespace QueryImpl
@[simp] lemma withPregen_apply {α} (so : QueryImpl spec m) (q : OracleQuery spec α) :
    so.withPregen.impl q = match q with
end QueryImpl

namespace seededOracle
lemma apply_eq {α} (q : OracleQuery spec α) :
    seededOracle.impl q = match q with
end seededOracle

namespace seededOracle
@[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]
end seededOracle

namespace seededOracle
@[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]
end seededOracle

namespace OptionT
@[simp] lemma run_lift {m : Type u → Type v} [Monad m]
    {α : Type u} (x : m α) : (OptionT.lift x).run = x
end OptionT

namespace OptionT
lemma monad_pure_eq_pure [Monad m] (x : α) :
    (pure x : OptionT m α) = OptionT.pure x
end OptionT

namespace OptionT
lemma monad_bind_eq_bind [Monad m] (x : OptionT m α) (y : α → OptionT m β) :
    x >>= y = OptionT.bind x y
end OptionT

namespace OptionT
lemma liftM_def {m : Type u → Type v} [Monad m] {α : Type u}
    (x : m α) : (x : OptionT m α) = OptionT.lift x
end OptionT

namespace PureEquiv
@[simp]
lemma map_pure (f : PureEquiv m n) {α : Type u} (x : α) :
    f.toFun (pure x) = (pure x : n α)
end PureEquiv

namespace PureEquiv
@[simp]
lemma map_pure_inv (f : PureEquiv m n) {α : Type u} (x : α) :
    f.invFun (pure x) = (pure x : m α)
end PureEquiv

namespace BindEquiv
@[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))
end BindEquiv

namespace BindEquiv
@[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))
end BindEquiv

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

namespace elgamalAsymmEnc
@[simp] lemma toExecutionMethod_eq :
    (elgamalAsymmEnc G P).toExecutionMethod = ExecutionMethod.default
end elgamalAsymmEnc

namespace elgamalAsymmEnc
theorem Correct [DecidableEq P] : (elgamalAsymmEnc G P).PerfectlyCorrect
end elgamalAsymmEnc

namespace elgamalAsymmEnc
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))
end elgamalAsymmEnc

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)

namespace OracleComp
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)
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma cons_mem_support_seq_map_cons_iff (x : α) (xs : List α) :
    x :: xs ∈ (cons <$> oa <*> ob).support ↔ x ∈ oa.support ∧ xs ∈ ob.support
end OracleComp

namespace OracleComp
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)
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma probOutput_cons_seq_map_cons_eq_mul [spec.FiniteRange] [spec.DecidableEq] (x : α)
    (xs : List α) : [= x :: xs | cons <$> oa <*> ob] = [= x | oa] * [= xs | ob]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
@[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]
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[simp]
lemma probFailure_list_mapM {α β : Type*} [spec.FiniteRange] (xs : List α)
    (f : α → OracleComp spec β) : [⊥ | xs.mapM f] = 1 - (xs.map (1 - [⊥ | f ·])).prod
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_list_mapM {f : α → OracleComp spec β} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM f as)
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_list_mapM' {f : α → OracleComp spec β} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM' f as)
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_list_flatMapM {f : α → OracleComp spec (List β)} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (flatMapM f as)
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_list_filterMapM {f : α → OracleComp spec (Option β)} {as : List α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (filterMapM f as)
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[simp]
lemma support_seq_map_vector_cons : ((· ::ᵥ ·) <$> oa <*> ob).support =
    {xs | xs.head ∈ oa.support ∧ xs.tail ∈ ob.support}
end OracleComp

namespace OracleComp
@[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]
end OracleComp

namespace OracleComp
@[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]
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_array_mapM {f : α → OracleComp spec β} {as : Array α}
    (h : ∀ x ∈ as, neverFails (f x)) : neverFails (mapM f as)
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp] lemma neverFails_vector_mapM {n} {f : α → OracleComp spec β} {as : Vector α n}
    (h : ∀ x ∈ as.toList, neverFails (f x)) : neverFails (Vector.mapM f as)
end OracleComp

namespace SPMF
theorem pure_eq_pmf_pure {a : α} : (pure a : SPMF α) = PMF.pure a
end SPMF

namespace SPMF
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)
end SPMF

namespace SPMF
@[simp] lemma map_some_apply_some (p : PMF α) (x : α) : p.map some (some x) = p x
end SPMF

namespace SPMF
@[simp] lemma PMF.map_some_apply_some (p : PMF α) (x : α) : (some <$> p) (some x) = p x
end SPMF

namespace SPMF
theorem IsCoupling.pure_iff {α β : Type u} {a : α} {b : β} {c : SPMF (α × β)} :
    IsCoupling c (pure a) (pure b) ↔ c = pure (a, b)
end SPMF

namespace SPMF
theorem IsCoupling.none_iff {α β : Type u} {c : SPMF (α × β)} :
    IsCoupling c (failure : SPMF α) (failure : SPMF β) ↔ c = failure
end SPMF

namespace SPMF
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)
end SPMF

namespace SPMF
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 (β₁ × β₂)
end 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

namespace LawfulMonadStateOf
@[simp]
theorem getThe_eq [MonadStateOf σ m] : getThe σ (m := m) = MonadStateOf.get
end LawfulMonadStateOf

namespace LawfulMonadStateOf
@[simp]
theorem modifyGetThe_eq [MonadStateOf σ m] {α : Type u} (f : σ → α × σ) :
    modifyGetThe σ (m := m) f = MonadStateOf.modifyGet f
end LawfulMonadStateOf

namespace LawfulMonadStateOf
@[simp]
theorem modifyThe_eq (f : σ → σ) :
    modifyThe σ (m := m) f = (do set (f (← MonadStateOf.get)))
end LawfulMonadStateOf

namespace LawfulMonadState
@[simp]
theorem modify_eq (f : σ → σ) :
    modify (m := m) f = (do MonadState.set (f (← get)))
end LawfulMonadState

namespace StateT
theorem modifyGet_eq_monadState {α : Type u} (f : σ → α × σ) :
    StateT.modifyGet (m := m) f = (do let (a, s) := f (← StateT.get); StateT.set s; pure a)
end StateT

namespace StateT
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)
end StateT

namespace StateT
theorem set_set {s₁ s₂ : σ} : (do StateT.set s₁; StateT.set s₂) = StateT.set (m := m) s₂
end StateT

namespace StateT
theorem get_set {s : σ} : (do StateT.set (m := m) s; StateT.get) = (do StateT.set s; pure s)
end StateT

namespace StateT
theorem set_get : (do let s ← @StateT.get σ m _; StateT.set s) = pure ⟨⟩
end StateT

namespace OracleComp.StateM
@[simp]
theorem PreCondition.top_def {σ : Type _} : PreCondition.top σ = fun _ => True
end OracleComp.StateM

namespace OracleComp.StateM.HoareTriple
@[simp]
theorem pure_rule (x : α) :
    HoareTriple (PreCondition.top σ) (pure x) (fun s a s' => s = s' ∧ a = x)
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem pure_rule_forward {P : PreCondition σ} (x : α) :
    HoareTriple P (pure x) (fun s a s' => s = s' ∧ a = x ∧ P s)
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem pure_rule_backward {Q : PostCondition σ α} (x : α) :
    HoareTriple (fun s => Q s x s) (pure x) Q
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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'')
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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'
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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'
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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)
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
@[simp]
theorem frame_true_pre {P : PreCondition σ} {Q : PostCondition σ α}
    {comp : StateM σ α} (h : HoareTriple P comp Q) :
      HoareTriple (fun s => P s ∧ True) comp Q
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
@[simp]
theorem get_rule_basic :
    HoareTriple (fun _ => True) (get : StateM σ σ) (fun s x s' => s = x ∧ s = s')
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
@[simp]
theorem set_rule_basic (s' : σ) :
    HoareTriple (fun _ => True) (set s' : StateM σ Unit) (fun _ _ s'' => s'' = s')
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem get_rule_forward (P : PreCondition σ) :
    HoareTriple P (get : StateM σ σ) (fun s x s' => P s ∧ s = x ∧ s = s')
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem set_rule_forward (P : PreCondition σ) (s' : σ) :
    HoareTriple P (set s' : StateM σ Unit) (fun s _ s'' => P s ∧ s'' = s')
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem get_rule_backward (Q : σ → σ → σ → Prop) :
    HoareTriple (fun s => Q s s s) get Q
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
theorem set_rule_backward (s' : σ) (Q : σ → Unit → σ → Prop) :
    HoareTriple (fun s => Q s () s') (set s') Q
end OracleComp.StateM.HoareTriple

namespace OracleComp.StateM.HoareTriple
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')
end OracleComp.StateM.HoareTriple

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

namespace Vector
@[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
end Vector

namespace Vector
@[simp]
theorem vectorofFn_get {α : Type} {n : ℕ} (v : Fin n → α) : (Vector.ofFn v).get = v
end Vector

namespace Vector
@[simp]
theorem vectorAdd_get {α : Type} {n : ℕ} [Add α] [Zero α]
 (vx : Vector α n) (vy : Vector α n)
 : (vx + vy).get = vx.get + vy.get
end Vector

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

namespace PFunctor.Chart
@[simp]
theorem id_comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Chart P Q) :
    (Chart.id Q) ∘c f = f
end PFunctor.Chart

namespace PFunctor.Chart
@[simp]
theorem comp_id {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Chart P Q) :
    f ∘c (Chart.id P) = f
end PFunctor.Chart

namespace PFunctor.Chart
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'')
end PFunctor.Chart

namespace PFunctor.Chart
@[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₂
end PFunctor.Chart

namespace PFunctor
@[simp] lemma C_empty : C PEmpty = 0
end PFunctor

namespace PFunctor
@[simp] lemma C_unit : C PUnit = 1
end PFunctor

namespace PFunctor
@[simp] lemma C_A (A : Type u) : (C A).A = A
end PFunctor

namespace PFunctor
@[simp] lemma C_B (A : Type u) (a : (C A).A) : (C A).B a = PEmpty
end PFunctor

namespace PFunctor
@[simp] lemma X_A : X.A = PUnit
end PFunctor

namespace PFunctor
@[simp] lemma X_B (a : X.A) : X.B a = PUnit
end PFunctor

namespace PFunctor
@[simp] lemma linear_A (A : Type u) : (linear A).A = A
end PFunctor

namespace PFunctor
@[simp] lemma linear_B (A : Type u) (a : (linear A).A) : (linear A).B a = PUnit
end PFunctor

namespace PFunctor
@[simp] lemma selfMonomial_A (S : Type u) : (selfMonomial S).A = S
end PFunctor

namespace PFunctor
@[simp] lemma selfMonomial_B (S : Type u) (a : (selfMonomial S).A) : (selfMonomial S).B a = S
end PFunctor

namespace PFunctor
@[simp] lemma selfMonomial_unit : selfMonomial PUnit = X
end PFunctor

namespace PFunctor
@[simp] lemma purePower_A (B : Type u) : (purePower B).A = PUnit
end PFunctor

namespace PFunctor
@[simp] lemma purePower_B (B : Type u) (a : (purePower B).A) : (purePower B).B a = B
end PFunctor

namespace PFunctor
@[simp] lemma purePower_unit : purePower PUnit = X
end PFunctor

namespace PFunctor.Equiv
@[simp]
theorem symm_symm {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃ₚ Q) :
    e.symm.symm = e
end PFunctor.Equiv

namespace PFunctor.Equiv
@[simp]
theorem symm_comp_self {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (e : P ≃ₚ Q) :
    e.symm.equivA ∘ e.equivA = id
end PFunctor.Equiv

namespace PFunctor
@[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
end PFunctor

namespace PFunctor
lemma X_eq_linear_pUnit : X = linear PUnit
end PFunctor

namespace PFunctor
lemma X_eq_purePower_pUnit : X = purePower PUnit
end PFunctor

namespace PFunctor
@[simp]
theorem ulift_A : (P.ulift).A = ULift P.A
end PFunctor

namespace PFunctor
@[simp]
theorem ulift_B {a : P.A} : (P.ulift).B (ULift.up a) = ULift (P.B a)
end PFunctor

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

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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)
end OracleComp

namespace OracleComp
lemma apply_eq_apply_of_mem_support_fork (x₁ x₂ : α)
    (h : (x₁, x₂) ∈ (fork main qb js i cf).support) : cf x₁ = cf x₂
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma le_probOutput_fork (s : Fin (qb i + 1)) :
    let h : ℝ≥0∞
end OracleComp

namespace OracleComp
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⁻¹)
end OracleComp

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

namespace WriterT
@[simp]
lemma run_mk {ω : Type u} [LawfulMonad m] (x : m (α × ω)) :
  (WriterT.mk x).run = x
end WriterT

namespace WriterT
@[simp]
lemma run_tell (w : ω) : (tell w : WriterT ω m PUnit).run = pure (⟨⟩, w)
end WriterT

namespace WriterT
@[simp]
lemma run_monadLift (x : m α) : (monadLift x : WriterT ω m α).run = (·, 1) <$> x
end WriterT

namespace WriterT
lemma liftM_def (x : m α) :
    (liftM x : WriterT ω m α) = WriterT.mk ((·, 1) <$> x)
end WriterT

namespace WriterT
lemma monadLift_def (x : m α) :
    (MonadLift.monadLift x : WriterT ω m α) = WriterT.mk ((·, 1) <$> x)
end WriterT

namespace WriterT
lemma bind_def (x : WriterT ω m α) (f : α → WriterT ω m β) :
    x >>= f = WriterT.mk (x.run >>= fun (a, w₁) ↦
      (Prod.map id (w₁ * ·)) <$> (f a))
end WriterT

namespace WriterT
@[simp]
lemma run_pure [LawfulMonad m] (x : α) :
    (pure x : WriterT ω m α).run = pure (x, 1)
end WriterT

namespace WriterT
@[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
end WriterT

namespace WriterT
@[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
end WriterT

namespace WriterT
@[simp]
lemma run_map (x : WriterT ω m α) (f : α → β) : (f <$> x).run = Prod.map f id <$> x.run
end WriterT

namespace WriterT
@[simp]
lemma run_failure [Monoid ω] {α : Type u} : (failure : WriterT ω m α).run = failure
end WriterT

namespace SymmEncAlg
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)
end SymmEncAlg

namespace OracleComp
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
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
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
end OracleComp

namespace AsymmEncAlg
@[simp] lemma PerfectlyCorrect_iff (encAlg : AsymmEncAlg m M PK SK C) :
    PerfectlyCorrect encAlg ↔ ∀ (msg : M),
      [⊥ | CorrectExp encAlg msg] = 0
end AsymmEncAlg

namespace AsymmEncAlg
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
end AsymmEncAlg

namespace AsymmEncAlg
@[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
end AsymmEncAlg

namespace QueryImpl
@[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
end QueryImpl

namespace loggingOracle
@[simp] lemma apply_eq (q : OracleQuery spec α) : loggingOracle.impl q =
    do let u ← q; tell (QueryLog.singleton q u); return u
end loggingOracle

namespace loggingOracle
@[simp]
lemma fst_map_run_simulateQ (oa : OracleComp spec α) :
    (Prod.fst <$> (simulateQ loggingOracle oa).run) = oa
end loggingOracle

namespace loggingOracle
@[simp]
lemma run_simulateQ_bind_fst (oa : OracleComp spec α) (ob : α → OracleComp spec β) :
    ((simulateQ loggingOracle oa).run >>= fun x => ob x.1) = oa >>= ob
end loggingOracle

namespace loggingOracle
@[simp]
lemma probFailure_run_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    [⊥ | (simulateQ loggingOracle oa).run] = [⊥ | oa]
end loggingOracle

namespace loggingOracle
@[simp]
lemma neverFails_run_simulateQ_iff (oa : OracleComp spec α) :
    neverFails (simulateQ loggingOracle oa).run ↔ neverFails oa
end loggingOracle

namespace OracleSpec
@[simp]
lemma liftM_append_left_eq (q : OracleQuery spec₁ α) :
    (liftM q : OracleQuery (spec₁ ++ₒ spec₂) α) =
      match q with
end OracleSpec

namespace OracleSpec
@[simp]
lemma liftM_append_right_eq (q : OracleQuery spec₂ α) :
    (liftM q : OracleQuery (spec₁ ++ₒ spec₂) α) =
      match q with
end OracleSpec

namespace OracleSpec
@[simp]
lemma liftM_left_append_left_append_eq [h : spec₁ ⊂ₒ spec₃]
    (q : OracleQuery (spec₁ ++ₒ spec₂) α) : (liftM q : OracleQuery (spec₃ ++ₒ spec₂) α) =
    match q with
end OracleSpec

namespace OracleSpec
@[simp]
lemma liftM_right_append_right_append_eq [h : spec₂ ⊂ₒ spec₃]
    (q : OracleQuery (spec₁ ++ₒ spec₂) α) : (liftM q : OracleQuery (spec₁ ++ₒ spec₃) α) =
    match q with
end OracleSpec

@[simp] theorem monadLift_mono' {m n} [OrderedMonad m] [OrderedMonad n] [OrderedMonadLiftT m n]
    {α} {a b : m α} (h : a ≤ₘ b) : monadLift a ≤ₘ (monadLift b : n α)

namespace OracleComp
lemma isQueryBound_def (oa : OracleComp spec α) (qb : QueryCount spec) :
    IsQueryBound oa qb ↔ ∀ qc ∈ (snd <$> (simulateQ countingOracle oa).run).support, qc ≤ qb
end OracleComp

namespace OracleComp
lemma isQueryBound_mono {oa : OracleComp spec α} (qb : ι → ℕ) {qb' : ι → ℕ}
    (h' : IsQueryBound oa qb) (h : qb ≤ qb') : IsQueryBound oa qb'
end OracleComp

namespace OracleComp
lemma isQueryBound_iff_probEvent [spec.FiniteRange] {oa : OracleComp spec α} {qb : ι → ℕ} :
    IsQueryBound oa qb ↔
      [(· ≤ qb) | snd <$> (simulateQ countingOracle oa).run <|> return 0] = 1
end OracleComp

namespace OracleComp
@[simp]
lemma isQueryBound_pure (a : α) (qb : ι → ℕ) : IsQueryBound (pure a : OracleComp spec α) qb
end OracleComp

namespace OracleComp
@[simp]
lemma isQueryBound_failure (qb : ι → ℕ) : IsQueryBound (failure : OracleComp spec α) qb
end OracleComp

namespace OracleComp
@[simp]
lemma isQueryBound_query_iff_pos [Nonempty α] (q : OracleQuery spec α) (qb : ι → ℕ) :
    IsQueryBound (q : OracleComp spec α) qb ↔ 0 < qb q.index
end OracleComp

namespace OracleComp
@[simp]
lemma generateSeed_nil : generateSeed spec qc [] = return ∅
end OracleComp

namespace OracleComp
@[simp]
lemma generateSeed_cons : generateSeed spec qc (j :: js) =
    ($ᵗ (spec.range j)).replicate (qc j) >>= λ xs ↦
      generateSeed spec qc js
end OracleComp

namespace OracleComp
@[simp]
lemma generateSeed_zero : generateSeed spec 0 js = return ∅
end OracleComp

namespace OracleComp
@[simp]
lemma support_generateSeed : (generateSeed spec qc js).support =
    {seed | ∀ i, (seed i).length = qc i * js.count i}
end OracleComp

namespace OracleComp
@[simp]
lemma finSupport_generateSeed_ne_empty [DecidableEq spec.QuerySeed] :
    (generateSeed spec qc js).finSupport ≠ ∅
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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∞)⁻¹
end OracleComp

namespace OracleComp
@[simp low]
lemma support_seq : (og <*> oa).support = ⋃ g ∈ og.support, g '' oa.support
end OracleComp

namespace OracleComp
@[simp low]
lemma finSupport_seq [spec.DecidableEq] [spec.FiniteRange]
    [DecidableEq α] [DecidableEq β] [DecidableEq (α → β)] :
    (og <*> oa).finSupport = og.finSupport.biUnion (λ g ↦ oa.finSupport.image g)
end OracleComp

namespace OracleComp
lemma probOutput_seq_eq_tsum [spec.FiniteRange] (y : β) : [= y | og <*> oa] =
    ∑' g, ∑' x, [= g | og] * [= x | oa] * [= y | (pure (g x) : OracleComp spec β)]
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma probFailure_seq [spec.FiniteRange] :
    [⊥ | og <*> oa] = [⊥ | og] + [⊥ | oa] - [⊥ | og] * [⊥ | oa]
end OracleComp

namespace OracleComp
lemma probEvent_seq_eq_tsum [spec.FiniteRange] (p : β → Prop) :
    [p | og <*> oa] = ∑' (g : α → β), [= g | og] * [p ∘ g | oa]
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
@[simp low + 1]
lemma support_seq_map_eq_image2 :
    (f <$> oa <*> ob).support = Set.image2 f oa.support ob.support
end OracleComp

namespace OracleComp
@[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
end OracleComp

namespace OracleComp
lemma evalDist_seq_map [spec.FiniteRange] :
    evalDist (f <$> oa <*> ob) = f <$> evalDist oa <*> evalDist ob
end OracleComp

namespace OracleComp
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 γ)]
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
lemma probEvent_seq_map_eq_probEvent_comp_uncurry [spec.FiniteRange]
    (p : γ → Prop) : [p | f <$> oa <*> ob] =
      [p ∘ f.uncurry | Prod.mk <$> oa <*> ob]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_seq_map_swap [spec.FiniteRange] (z : γ) :
    [= z | Function.swap f <$> ob <*> oa] = [= z | f <$> oa <*> ob]
end OracleComp

namespace OracleComp
@[simp]
lemma evalDist_seq_map_swap [spec.FiniteRange] :
    evalDist (Function.swap f <$> ob <*> oa) = evalDist (f <$> oa <*> ob)
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_seq_map_swap [spec.FiniteRange] (p : γ → Prop) :
    [p | Function.swap f <$> ob <*> oa] = [p | f <$> oa <*> ob]
end OracleComp

namespace OracleComp
@[simp]
lemma support_seq_map_swap [spec.FiniteRange] :
    (Function.swap f <$> ob <*> oa).support = (f <$> oa <*> ob).support
end OracleComp

namespace OracleComp
@[simp]
lemma finSupport_seq_map_swap [spec.FiniteRange] [spec.DecidableEq] [DecidableEq γ] :
    (Function.swap f <$> ob <*> oa).finSupport = (f <$> oa <*> ob).finSupport
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
@[simp]
lemma fst_map_prod_map (oa : OracleComp spec (α × β)) (f : α → γ) (g : β → δ) :
    fst <$> map f g <$> oa = (f ∘ Prod.fst) <$> oa
end OracleComp

namespace OracleComp
@[simp]
lemma snd_map_prod_map (oa : OracleComp spec (α × β)) (f : α → γ) (g : β → δ) :
    snd <$> map f g <$> oa = (g ∘ Prod.snd) <$> oa
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_fst_map_eq_tsum [spec.FiniteRange] (oa : OracleComp spec (α × β)) (x : α) :
    [= x | fst <$> oa] = ∑' y, [= (x, y) | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_fst_map_eq_sum [spec.FiniteRange] [Fintype β]
    (oa : OracleComp spec (α × β)) (x : α) : [= x | fst <$> oa] = ∑ y, [= (x, y) | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_snd_map_eq_tsum [spec.FiniteRange] (oa : OracleComp spec (α × β)) (y : β) :
    [= y | snd <$> oa] = ∑' x, [= (x, y) | oa]
end OracleComp

namespace OracleComp
@[simp]
lemma probOutput_snd_map_eq_sum [spec.FiniteRange] [Fintype α]
    (oa : OracleComp spec (α × β)) (y : β) : [= y | snd <$> oa] = ∑ x, [= (x, y) | oa]
end OracleComp

namespace OracleComp
lemma probOutput_seq_map_prod_mk_eq_mul :
    [= (x, y) | Prod.mk <$> oa <*> ob] = [= x | oa] * [= y | ob]
end OracleComp

namespace OracleComp
lemma probOutput_seq_map_prod_mk_eq_mul' :
    [= (x, y) | (λ x y ↦ (y, x) : β → α → α × β) <$> ob <*> oa] = [= x | oa] * [= y | ob]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
@[simp]
lemma probEvent_seq_map_prod_mk_eq_mul :
    [λ z ↦ p z.1 ∧ q z.2 | Prod.mk <$> oa <*> ob] = [p | oa] * [q | ob]
end OracleComp

namespace OracleComp
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]
end OracleComp

namespace OracleComp
@[simp]
lemma fst_map_prod_mk_of_subsingleton [Subsingleton β]
    (oa : OracleComp spec α) (y : β) : fst <$> (·, y) <$> oa = oa
end OracleComp

namespace OracleComp
@[simp]
lemma snd_map_prod_mk_of_subsingleton [Subsingleton α]
    (ob : OracleComp spec β) (x : α) : snd <$> (x, ·) <$> ob = ob
end OracleComp

namespace OracleComp
lemma probEvent_fst_eq_snd [spec.FiniteRange] [DecidableEq α] (oa : OracleComp spec (α × α)) :
    [λ z ↦ z.1 = z.2 | oa] = ∑' x : α, [= (x, x) | oa]
end OracleComp

namespace FreeContT
@[simp]
lemma def_eq : FreeContT f m α =
    ({r : Type u} → ({x : Type z} → f x → (x → m r) → m r) → (α → m r) → m r)
end FreeContT

namespace FreeContT
@[simp]
lemma FreeContM.def_eq : FreeContM.{u, w, y, z} f α =
    ({r : Type u} → ({x : Type z} → f x → (x → r) → r) → (α → r) → r)
end FreeContT

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

namespace PFunctor.Lens
@[ext (iff := false)]
theorem ext {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (l₁ l₂ : Lens P Q)
    (h₁ : ∀ a, l₁.toFunA a = l₂.toFunA a) (h₂ : ∀ a, l₁.toFunB a = (h₁ a) ▸ l₂.toFunB a) :
    l₁ = l₂
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem id_comp {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Lens P Q) :
    (Lens.id Q) ∘ₗ f = f
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem comp_id {P : PFunctor.{uA₁, uB₁}} {Q : PFunctor.{uA₂, uB₂}} (f : Lens P Q) :
    f ∘ₗ (Lens.id P) = f
end PFunctor.Lens

namespace PFunctor.Lens
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'')
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumMap_comp_inl (l₁ : Lens P R) (l₂ : Lens Q W) :
    ((l₁ ⊎ₗ l₂) ∘ₗ Lens.inl) = (Lens.inl ∘ₗ l₁)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumMap_comp_inr (l₁ : Lens P R) (l₂ : Lens Q W) :
    ((l₁ ⊎ₗ l₂) ∘ₗ Lens.inr) = (Lens.inr ∘ₗ l₂)
end PFunctor.Lens

namespace PFunctor.Lens
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₂)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumPair_comp_inl (f : Lens P R) (g : Lens Q R) :
    Lens.sumPair f g ∘ₗ Lens.inl = f
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumPair_comp_inr (f : Lens P R) (g : Lens Q R) :
    Lens.sumPair f g ∘ₗ Lens.inr = g
end PFunctor.Lens

namespace PFunctor.Lens
theorem comp_inl_inr (h : Lens.{max uA₁ uA₂, uB₁, uA₃, uB₃} (P + Q) R) :
    Lens.sumPair (h ∘ₗ Lens.inl) (h ∘ₗ Lens.inr) = h
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumMap_id :
    Lens.sumMap (Lens.id P) (Lens.id Q) = Lens.id.{max uA₁ uA₂, uB₁} (P + Q)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem sumPair_inl_inr :
    Lens.sumPair Lens.inl Lens.inr = Lens.id.{max uA₁ uA₂, uB₁} (P + Q)
end PFunctor.Lens

namespace PFunctor.Lens.Equiv
@[simp]
theorem sumComm_symm :
    (sumComm P Q).symm = sumComm Q P
end PFunctor.Lens.Equiv

namespace PFunctor.Lens
@[simp]
theorem fst_comp_prodMap (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.fst ∘ₗ (l₁ ×ₗ l₂) = l₁ ∘ₗ Lens.fst
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem snd_comp_prodMap (l₁ : Lens P R) (l₂ : Lens Q W) :
    Lens.snd ∘ₗ (l₁ ×ₗ l₂) = l₂ ∘ₗ Lens.snd
end PFunctor.Lens

namespace PFunctor.Lens
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)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem fst_comp_prodPair (f : Lens P Q) (g : Lens P R) :
    Lens.fst ∘ₗ Lens.prodPair f g = f
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem snd_comp_prodPair (f : Lens P Q) (g : Lens P R) :
    Lens.snd ∘ₗ Lens.prodPair f g = g
end PFunctor.Lens

namespace PFunctor.Lens
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
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem prodMap_id :
    Lens.prodMap (Lens.id P) (Lens.id Q) = Lens.id.{max uA₁ uA₂, max uB₁ uB₂} (P * Q)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem prodPair_fst_snd :
    Lens.prodPair Lens.fst Lens.snd = Lens.id.{max uA₁ uA₂, max uB₁ uB₂} (P * Q)
end PFunctor.Lens

namespace PFunctor.Lens.Equiv
@[simp]
theorem prodComm_symm : (prodComm P Q).symm = prodComm Q P
end PFunctor.Lens.Equiv

namespace PFunctor.Lens
@[simp]
theorem compMap_id :
    (Lens.id P) ◃ₗ (Lens.id Q) = Lens.id (P ◃ Q)
end PFunctor.Lens

namespace PFunctor.Lens
theorem compMap_comp
    {P' : PFunctor.{uA₄, uB₄}} {Q' : PFunctor.{uA₅, uB₅}} {R' : PFunctor.{uA₆, uB₆}}
    (l₁ : Lens P P') (l₂ : Lens Q Q') (l₁' : Lens P' R) (l₂' : Lens Q' R') :
    (l₁' ∘ₗ l₁) ◃ₗ (l₂' ∘ₗ l₂) = (l₁' ◃ₗ l₂') ∘ₗ (l₁ ◃ₗ l₂)
end PFunctor.Lens

namespace PFunctor.Lens
@[simp]
theorem tensorMap_id : (Lens.id P) ⊗ₗ (Lens.id Q) = Lens.id (P ⊗ Q)
end PFunctor.Lens

namespace PFunctor.Lens
theorem tensorMap_comp
    {P' : PFunctor.{uA₄, uB₄}} {Q' : PFunctor.{uA₅, uB₅}} {R' : PFunctor.{uA₆, uB₆}}
    (l₁ : Lens P P') (l₂ : Lens Q Q') (l₁' : Lens P' R) (l₂' : Lens Q' R') :
    (l₁' ∘ₗ l₁) ⊗ₗ (l₂' ∘ₗ l₂) = (l₁' ⊗ₗ l₂') ∘ₗ (l₁ ⊗ₗ l₂)
end PFunctor.Lens

namespace Monad
@[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))
end Monad

namespace Monad
@[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))
end Monad

namespace Monad
@[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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace Monad
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))
end Monad

namespace QueryImpl
@[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)
end QueryImpl

namespace QueryImpl
@[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)
end QueryImpl

namespace QueryImpl
@[simp]
lemma equivState_apply (q : OracleQuery spec α) :
    (so.equivState e).impl q = λ s ↦ map id e <$> so.impl q (e.symm s)
end QueryImpl

namespace QueryImpl
@[simp]
lemma equivState_subsingleton [Subsingleton σ] (e : σ ≃ σ) :
    so.equivState e = so
end QueryImpl

namespace QueryImpl
@[simp]
lemma equivState_equivState : (so.equivState e).equivState e.symm = so
end QueryImpl

namespace unifOracle
@[simp]
lemma apply_eq (q : OracleQuery spec α) :
    unifOracle.impl q = match q with
end unifOracle

namespace unifOracle
@[simp]
lemma evalDist_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) :
    evalDist (simulateQ unifOracle oa) = evalDist oa
end unifOracle

namespace unifOracle
@[simp]
lemma support_simulateQ (oa : OracleComp spec α) :
    (simulateQ unifOracle oa).support = oa.support
end unifOracle

namespace unifOracle
@[simp]
lemma finSupport_simulateQ [spec.FiniteRange] [spec.DecidableEq] [DecidableEq α]
    (oa : OracleComp spec α) : (simulateQ unifOracle oa).finSupport = oa.finSupport
end unifOracle

namespace unifOracle
@[simp]
lemma probOutput_simulateQ [spec.FiniteRange] (oa : OracleComp spec α) (x : α) :
    [= x | simulateQ unifOracle oa] = [= x | oa]
end unifOracle

namespace unifOracle
@[simp]
lemma probEvent_simulateQ [spec.FiniteRange] (oa : OracleComp spec α)
    (p : α → Prop) [DecidablePred p] :
    [p | simulateQ unifOracle oa] = [p | oa]
end unifOracle

namespace SimOracle
@[simp]
lemma append_apply_inl (i : ι₁) (t : spec₁.domain i) :
    (so ++ₛₒ so' : QueryImpl _ n).impl (query (inl i) t) = so.impl (query i t)
end SimOracle

namespace SimOracle
@[simp]
lemma append_apply_inr (i : ι₂) (t : spec₂.domain i) :
    (so ++ₛₒ so' : QueryImpl _ n).impl (query (inr i) t) = so'.impl (query i t)
end SimOracle

namespace SimOracle
@[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 α)
end SimOracle

namespace SimOracle
@[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 α)
end SimOracle

congrArg in Init.Prelude

List.isEmpty_iff in Init.Data.List.Lemmas
</all_available_lemmas>

<local_ctx>
import VCVio.OracleComp.Traversal

import VCVio.OracleComp.SimSemantics.SimulateQ

import Mathlib.Probability.Distributions.Uniform

import ToMathlib.General

open OracleSpec Option ENNReal BigOperators

namespace OracleComp

variable {ι : Type u} {spec : OracleSpec ι} {ι' : Type v} {spec' : OracleSpec ι'}
  {α β γ : Type w} [spec.FiniteRange] [spec'.FiniteRange]

section evalDist

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)⟩

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

end evalDist

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

notation "[=" x "|" oa "]" => probOutput oa x

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])

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

notation "[⊥" "|" oa "]" => probFailure oa

lemma probFailure_def (oa : OracleComp spec α) :
    [⊥ | oa] = (evalDist oa).run none

lemma evalDist_apply_none (oa : OracleComp spec α) :
    (evalDist oa).run none = [⊥ | oa]

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

notation "[" p "|" oa "]" => probEvent oa p

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

section bounds

variable {oa : OracleComp spec α} {x : α} {p : α → Prop}

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

end bounds

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

section support

variable (oa : OracleComp spec α) (x : α) (p q : α → Prop)

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

variable {oa x p q}

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

end support

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

section sums

variable (oa : OracleComp spec α) (p : α → Prop)

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

end sums

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

section pure

variable (x : α)

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

end pure

section bind

variable (oa : OracleComp spec α) (ob : α → OracleComp spec β)

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]

end bind

section mul_le_probEvent_bind
</local_ctx>

<target_theorem>
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] :=
</target_theorem>

