diff --git a/Complexity.lean b/Complexity.lean index f59b96f22..189a3474b 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2037,7 +2037,9 @@ public import Complexity.Computability.WordRAM.Randomized.Defs public import Complexity.Computability.WordRAM.Randomized.Expected public import Complexity.Computability.WordRAM.Randomized.LoopSegment public import Complexity.Computability.WordRAM.Randomized.Structured +public import Complexity.Computability.WordRAM.Randomized.Subroutine public import Complexity.Computability.WordRAM.RegisterFrame +public import Complexity.Computability.WordRAM.RelSubroutine public import Complexity.Computability.WordRAM.Sequence public import Complexity.Computability.WordRAM.Signed.Arithmetic public import Complexity.Computability.WordRAM.Signed.Comparison @@ -2662,6 +2664,7 @@ public import Complexity.Foundations.Semantics.Stateful.CostHoare public import Complexity.Foundations.Semantics.Stateful.Hoare public import Complexity.Foundations.Semantics.Stateful.Module public import Complexity.Foundations.Semantics.Stateful.Realization +public import Complexity.Foundations.Semantics.Stateful.Relational public import Complexity.Foundations.Semantics.Stateful.Resource public import Complexity.Init public import Complexity.Languages.Probabilistic.Basic diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean index f0605c71b..b9de086eb 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean @@ -691,7 +691,7 @@ def dynamicProgram (n K_max : ℕ) : DynamicProgram (IndexedMinPQ.spec n K_max) output := pqCode.output input := pqCode.input encode := pqCode.encode - decode := pqCode.decode + decode := pqCode.decode (K_max := K_max) /-- Standalone `.standard`-basis `DynamicCertificate` for the binary min-heap. -/ def certificate {n K_max w base : ℕ} (hS : Fits w (base + space n)) (hK : Fits w K_max) : diff --git a/Complexity/Computability/WordRAM/Dynamic.lean b/Complexity/Computability/WordRAM/Dynamic.lean index ab80464d6..ace6fd08a 100644 --- a/Complexity/Computability/WordRAM/Dynamic.lean +++ b/Complexity/Computability/WordRAM/Dynamic.lean @@ -14,6 +14,10 @@ public import Complexity.Computability.WordRAM.Trace /-! # Fixed-program implementations of dynamic data structures +`DynamicProgram` depends only on the existing `PFunctor` operation signature and its instruction +basis, which defaults to `.standard`. Deterministic and relational specifications supply their +signatures by coercion; correctness certificates retain the actual specification separately. + An implementation has one structured program, one output register, and a register-only calling convention. Each call replaces designated input registers with encoded words, preserving all other registers and the entire memory. Argument encoding, external delivery, and result decoding @@ -74,39 +78,41 @@ universe u v z variable {r : ℕ} {D : Stateful.Spec.{u, v, z}} -/-- A single program serving all operations through a fixed register calling convention. -/ -structure DynamicProgram (D : Stateful.Spec.{u, v, z}) (r : ℕ) where +/-- A single program serving an operation signature through a fixed register calling convention. +Deterministic and relational stateful specifications supply their signatures by coercion; +the program itself makes no assumption about abstract states or permitted transitions. -/ +structure DynamicProgram (S : PFunctor.{v, z}) (r : ℕ) (B : Basis := .standard) where /-- The same code is executed for every operation. -/ - code : Code .standard r + code : Code B r /-- Register returned by the final halt instruction. -/ output : Fin r /-- Registers overwritten by externally supplied operation arguments. -/ input : Fin r → Bool /-- Encoded arguments, independent of the maintained machine state. -/ - encode : D.Op → Fin r → ℕ + encode : S.A → Fin r → ℕ /-- Interpretation of the final register tuple as the operation's typed observation. -/ - decode : (o : D.Op) → (Fin r → ℕ) → Option (D.Result o) + decode : (o : S.A) → (Fin r → ℕ) → Option (S.B o) namespace DynamicProgram -variable (P : DynamicProgram D r) +variable {S : PFunctor.{v, z}} {B : Basis} (P : DynamicProgram S r B) /-- Deliver operation arguments without changing maintained memory or non-input registers. -/ -def prepare (o : D.Op) (x : Data r) : Data r where +def prepare (o : S.A) (x : Data r) : Data r where regs i := if P.input i then P.encode o i else x.regs i mem := x.mem /-- Delivering operation arguments preserves the machine memory unchanged. -/ @[simp] -theorem prepare_mem (o : D.Op) (x : Data r) : (P.prepare o x).mem = x.mem := rfl +theorem prepare_mem (o : S.A) (x : Data r) : (P.prepare o x).mem = x.mem := rfl /-- Registers outside the calling convention retain their contents. -/ -theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : D.Op) (x : Data r) : +theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : S.A) (x : Data r) : (P.prepare o x).regs i = x.regs i := by simp [prepare, hi] /-- Argument delivery preserves bounded words when the arguments fit. -/ -theorem prepare_bounded {w : ℕ} {o : D.Op} {x : Data r} (hx : x.Bounded w) +theorem prepare_bounded {w : ℕ} {o : S.A} {x : Data r} (hx : x.Bounded w) (ho : ∀ i, P.input i = true → Fits w (P.encode o i)) : (P.prepare o x).Bounded w := by refine ⟨fun i => ?_, hx.2⟩ change Fits w (if P.input i then P.encode o i else x.regs i) @@ -120,7 +126,7 @@ instructions; exhaustion, a machine fault, or decoder failure returns `none`. This interpreter does not check the initial state's global word bound or operation admissibility. Use `DynamicCertificate.execOp_of_eval` to connect a successful call to certified execution. -/ -def eval (w fuel : ℕ) (o : D.Op) (x : Data r) : Option (Data r × D.Result o × ℕ) := +def eval (w fuel : ℕ) (o : S.A) (x : Data r) : Option (Data r × S.B o × ℕ) := match P.code.eval w fuel (P.prepare o x) with | none => none | some (y, n) => (P.decode o y.regs).map fun a => (y, a, n + 1) @@ -133,13 +139,13 @@ structure OperationTrace where probes : List Probe /-- A bounded machine call with native execution evidence independent of any resource bound. -/ -def ExecOp (w : ℕ) : Stateful.Execution D (Data r) OperationTrace := fun x o a y trace => +def ExecOp (w : ℕ) : Stateful.Execution S (Data r) OperationTrace := fun x o a y trace => (P.prepare o x).Bounded w ∧ ∃ n, TraceExec w P.code (P.prepare o x) y n trace.probes ∧ P.decode o y.regs = some a ∧ trace.instructions = n + 1 /-- Successful typed evaluation supplies an exact operation trace when the delivered state is bounded. Evaluator success alone does not imply a bound on untouched memory. -/ -theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result o} +theorem ExecOp.of_eval {w fuel k : ℕ} {o : S.A} {x y : Data r} {a : S.B o} (hb : (P.prepare o x).Bounded w) (h : P.eval w fuel o x = some (y, a, k)) : ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := by cases he : P.code.eval w fuel (P.prepare o x) with @@ -156,7 +162,7 @@ theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result /-- Every call is an execution of one fixed flat machine program. The returned register tuple is observed at the final state; the designated output register is also the halt value. -/ -theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) : Executes w (P.code.program P.output) ⟨0, P.prepare o x⟩ (y.regs P.output) trace.instructions := by @@ -165,13 +171,13 @@ theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} exact he.exec.executes P.output /-- A call preserves bounded words, including every word in the observed register tuple. -/ -theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) : y.Bounded w := by obtain ⟨hb, n, he, _, _⟩ := h exact he.exec.bounded hb /-- Calls are deterministic in their final representation, observation, and instruction count. -/ -theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} +theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : S.A} {a a' : S.B o} {trace trace' : OperationTrace} (h : P.ExecOp w x o a y trace) (h' : P.ExecOp w x o a' y' trace') : y = y' ∧ a = a' ∧ trace.instructions = trace'.instructions := by @@ -181,8 +187,8 @@ theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} exact ⟨rfl, Option.some.inj (ha.symm.trans ha'), ht.trans ht'.symm⟩ /-- A call's final state and instruction count agree with any structured execution of the code. -/ -theorem ExecOp.eq_of_exec {P : DynamicProgram D r} {w : ℕ} {x y z : Data r} {o : D.Op} - {a : D.Result o} {trace : OperationTrace} {m : ℕ} (he : P.ExecOp w x o a y trace) +theorem ExecOp.eq_of_exec {P : DynamicProgram S r B} {w : ℕ} {x y z : Data r} {o : S.A} + {a : S.B o} {trace : OperationTrace} {m : ℕ} (he : P.ExecOp w x o a y trace) (h : Exec w P.code (P.prepare o x) z m) : y = z ∧ trace.instructions = m + 1 := by obtain ⟨_, n, ht, _, hn⟩ := he @@ -190,7 +196,7 @@ theorem ExecOp.eq_of_exec {P : DynamicProgram D r} {w : ℕ} {x y z : Data r} {o exact ⟨rfl, hn⟩ /-- The write transcript supplies a frame rule for a call, including register-only delivery. -/ -theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) {Q : HeapAssertion} (hQ : Q.holds x.mem) (hd : Disjoint Q.footprint (Probe.writes trace.probes)) : Q.holds y.mem := by diff --git a/Complexity/Computability/WordRAM/Randomized/Expected.lean b/Complexity/Computability/WordRAM/Randomized/Expected.lean index 4f1881163..d26d77662 100644 --- a/Complexity/Computability/WordRAM/Randomized/Expected.lean +++ b/Complexity/Computability/WordRAM/Randomized/Expected.lean @@ -12,6 +12,7 @@ public import Complexity.Computability.WordRAM.Randomized.Structured public import Complexity.Languages.Probabilistic.Expect public import Complexity.Probability.PMF.Bind public import Complexity.Probability.PMF.Event +import Complexity.Probability.PMF.Expect /-! # Expected running time for randomized word RAMs @@ -47,6 +48,9 @@ additivity (`expectedCodeTime_seq`), branch laws (`expectedCodeTime_branch_pos`, remaining instructions from a `RandCfg r` or initial `State r`. * `Cslib.WordRAM.expectedCodeTime`: `ℝ≥0∞`-valued expected instruction count of a structured `Code B r`. +* `Cslib.WordRAM.ExecCodeDist`: compositional structured execution certificate pairing an output + distribution `μ : PMF (Data r)` with an expected step bound `T : ℝ≥0∞`, closed under unbounded + almost-surely terminating geometric `while` loops (`ExecCodeDist.loop_geometric`). ## Main results @@ -63,16 +67,20 @@ additivity (`expectedCodeTime_seq`), branch laws (`expectedCodeTime_branch_pos`, * `Cslib.WordRAM.expectedCodeTime_seq`, `Cslib.WordRAM.expectedCodeTime_branch_le`, `Cslib.WordRAM.expectedCodeTime_loop_le_of_drift`: compositional expected-time rules for structured `Code`. +* `Cslib.WordRAM.ExecCodeDist.loop_geometric`, + `Cslib.WordRAM.expectedStepsFrom_loop_le_of_geometric`, + `Cslib.WordRAM.ExecCodeDist.program_halts`: expected-time and almost-sure halting rules for + geometric Las Vegas `while` loops and structured programs. Discrete and conditional expectation principles are classical background; see -[MitzenmacherUpfal2017], Sections 2.1 and 2.3. The particular native tail-sum/Bellman definitions, -finite structured-execution-tree bridge and ranked-loop expected-cost formalization are original -library constructions in this module. +[MitzenmacherUpfal2017], Sections 2.1, 2.3, and 2.4. The particular native tail-sum/Bellman +definitions, finite structured-execution-tree bridge and ranked-loop expected-cost formalization are +original library constructions in this module. ## References * [M. Mitzenmacher and E. Upfal, *Probability and Computing*][MitzenmacherUpfal2017], - Sections 2.1 and 2.3. + Sections 2.1, 2.3, and 2.4. -/ @[expose] public section @@ -636,6 +644,1676 @@ theorem expectedCodeTime_loop_le_of_drift {w : ℕ} {cond : Cond r} {body : Code · exact ⟨Exists.intro _ (ExecRand.loop_exit hc), by rw [expectedCodeTime_loop_exit hc]; exact le_add_self⟩ -end WordRAM +/-! ## Distributional structured execution (`ExecCodeDist`) and geometric Las Vegas loops -/ -end Cslib +/-- Non-faulting structured randomized executions transfer instruction-for-instruction along any +defined-evaluation basis simulation `ψ : B.Simulates B'`. -/ +theorem ExecRand.mapSimulates {B' : Basis} (ψ : B.Simulates B') {w : ℕ} {c : Code B r} + {x : Data r} {m : ProbComp (Data r × ℕ)} (h : ExecRand w c x m) : + ExecRand w (c.mapSimulates ψ) x m := by + induction h with + | op ho => exact .op (Op.eval_mapSimulates_of_some ψ ho) + | rand hfit => exact .rand hfit + | seq _ _ ih₁ ih₂ => exact .seq ih₁ ih₂ + | branch_pos hc _ ih => exact .branch_pos hc ih + | branch_neg hc _ ih => exact .branch_neg hc ih + | loop_exit hc => exact .loop_exit hc + | loop_iter hc _ _ ihb ihl => exact .loop_iter hc ihb ihl + +/-- Pointwise halting probability at `.halted v d` is monotone in the horizon `T`. -/ +theorem evalRand_halted_mono (w : ℕ) (p : Program B r) (s : State r) (v : ℕ) (d : Data r) : + Monotone fun T => evalRand w p T s (.halted v d) := by + refine monotone_nat_of_le_succ fun T => ?_ + have hstep : evalRand w p (T + 1) s = + (evalRand w p T s).bind (fun cfg => (stepRand w p cfg).eval) := by + rw [evalRand, runRand_add w p T 1, ProbComp.eval_bind] + simp only [evalRand, runRand_succ, runRand_zero, bind_pure] + rw [hstep, PMF.bind_apply] + calc + evalRand w p T s (.halted v d) + = evalRand w p T s (.halted v d) * (stepRand w p (.halted v d)).eval (.halted v d) := by + simp [stepRand_halted] + _ ≤ ∑' cfg, evalRand w p T s cfg * (stepRand w p cfg).eval (.halted v d) := + le_tsum + (f := fun cfg => evalRand w p T s cfg * (stepRand w p cfg).eval (.halted v d)) + (RandCfg.halted v d) + +private theorem tsum_iSup_of_monotone {α : Type*} {f : ℕ → α → ℝ≥0∞} + (hf : ∀ a, Monotone fun n => f n a) : + (∑' a, ⨆ n, f n a) = ⨆ n, ∑' a, f n a := by + rw [tsum_eq_iSup_sum] + simp_rw [ENNReal.finsetSum_iSup_of_monotone hf] + rw [iSup_comm] + simp_rw [← tsum_eq_iSup_sum] + +/-- Finite-horizon approximation of `expectedStepsFrom`: expected number of active (`.running`) +steps within the first `N` steps starting from configuration `cfg`. -/ +noncomputable def expectedStepsWithin (w : ℕ) (p : Program B r) (N : ℕ) (cfg : RandCfg r) : + ℝ≥0∞ := + ∑ t ∈ Finset.range N, (runRand w p t cfg).eval.toOuterMeasure {cfg' | ∃ u, cfg' = .running u} + +@[simp] +theorem expectedStepsWithin_zero (w : ℕ) (p : Program B r) (cfg : RandCfg r) : + expectedStepsWithin w p 0 cfg = 0 := by + simp [expectedStepsWithin] + +@[simp] +theorem expectedStepsWithin_halted (w : ℕ) (p : Program B r) (N v : ℕ) (d : Data r) : + expectedStepsWithin w p N (.halted v d) = 0 := by + simp [expectedStepsWithin, PMF.toOuterMeasure_pure_apply] + +@[simp] +theorem expectedStepsWithin_faulted (w : ℕ) (p : Program B r) (N : ℕ) : + expectedStepsWithin w p N .faulted = 0 := by + simp [expectedStepsWithin, PMF.toOuterMeasure_pure_apply] + +theorem expectedStepsWithin_mono (w : ℕ) (p : Program B r) (cfg : RandCfg r) : + Monotone fun N => expectedStepsWithin w p N cfg := by + intro N₁ N₂ hN + exact Finset.sum_le_sum_of_subset (Finset.range_mono hN) + +theorem iSup_expectedStepsWithin (w : ℕ) (p : Program B r) (cfg : RandCfg r) : + (⨆ N : ℕ, expectedStepsWithin w p N cfg) = expectedStepsFrom w p cfg := + (ENNReal.tsum_eq_iSup_nat).symm + +theorem expectedStepsWithin_le_expectedStepsFrom (w : ℕ) (p : Program B r) (N : ℕ) + (cfg : RandCfg r) : + expectedStepsWithin w p N cfg ≤ expectedStepsFrom w p cfg := by + rw [← iSup_expectedStepsWithin] + exact le_iSup (fun K => expectedStepsWithin w p K cfg) N + +/-- 1-step horizon recursion for `expectedStepsWithin`: at horizon `N + 1`, an active state `s` +incurs `1` step plus the `N`-step continuation expectation. -/ +theorem expectedStepsWithin_running_succ (w : ℕ) (p : Program B r) (N : ℕ) (s : State r) : + expectedStepsWithin w p (N + 1) (.running s) = + 1 + ProbComp.expect (stepRand w p (.running s)) (expectedStepsWithin w p N) := by + rw [expectedStepsWithin, Finset.sum_range_succ'] + have hzero : (runRand w p 0 (.running s)).eval.toOuterMeasure + {cfg' | ∃ u, cfg' = .running u} = 1 := by + simp [PMF.toOuterMeasure_pure_apply] + rw [hzero, add_comm] + congr 1 + have hsucc : ∀ t : ℕ, (runRand w p (t + 1) (.running s)).eval.toOuterMeasure + {cfg' | ∃ u, cfg' = .running u} = + ∑' cfg, (stepRand w p (.running s)).eval cfg * + (runRand w p t cfg).eval.toOuterMeasure {cfg' | ∃ u, cfg' = .running u} := by + intro t + rw [runRand_succ, ProbComp.eval_bind, PMF.toOuterMeasure_bind_apply] + simp only [hsucc] + rw [← Summable.tsum_finsetSum (fun _ _ => CompleteLattice.summable)] + simp only [ProbComp.expect, expectedStepsWithin, Finset.mul_sum] + +theorem expectedStepsWithin_running_le (w : ℕ) (p : Program B r) (N : ℕ) (s : State r) : + expectedStepsWithin w p N (.running s) ≤ + 1 + ProbComp.expect (stepRand w p (.running s)) (expectedStepsWithin w p N) := by + cases N with + | zero => simp + | succ N => + rw [expectedStepsWithin_running_succ] + gcongr + exact ProbComp.expect_mono fun cfg => expectedStepsWithin_mono w p cfg (Nat.le_succ N) + +theorem ExecRand.expectedStepsWithin_assemble {w : ℕ} {c : Code B r} {x : Data r} + {m : ProbComp (Data r × ℕ)} (h : ExecRand w c x m) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) (N : ℕ) : + expectedStepsWithin w p N (.running ⟨pc, x⟩) ≤ + ProbComp.expect m (fun z => + (z.2 : ℝ≥0∞) + expectedStepsWithin w p N (.running ⟨pc + c.size, z.1⟩)) := by + induction h generalizing pc with + | @op o x y ho => + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_op (s := ⟨pc, x⟩) hp.head ho, ProbComp.expect_pure, ProbComp.expect_pure] + simp [Code.size] + | @rand dst src x hfit => + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_rand_of_fits (s := ⟨pc, x⟩) hp.head hfit, ProbComp.expect_bind, + ProbComp.expect_bind] + simp only [ProbComp.expect_pure, Code.size, Nat.cast_one] + rw [ProbComp.expect_add, ProbComp.expect_const] + | @seq c₁ c₂ x m₁ m₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + refine (ih₁ hp.append_left).trans ?_ + rw [ProbComp.expect_bind] + refine ProbComp.expect_mono_on_support fun z₁ hz₁ => ?_ + refine (add_le_add le_rfl (ih₂ z₁ hz₁ hc₂)).trans (le_of_eq ?_) + rw [ProbComp.expect_bind, + ← ProbComp.expect_const (m₂ z₁.1) (z₁.2 : ℝ≥0∞), ← ProbComp.expect_add] + refine ProbComp.expect_congr_on_support fun z₂ _ => ?_ + simp only [ProbComp.expect_pure, Code.size, Nat.cast_add, add_assoc] + | @branch_pos cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + refine (add_le_add le_rfl (ih hc')).trans (le_of_eq ?_) + rw [ProbComp.expect_map, ← ProbComp.expect_const m 1, ← ProbComp.expect_add] + refine ProbComp.expect_congr_on_support fun z _ => ?_ + simp only [Code.size, Nat.cast_add, Nat.cast_one] + rw [show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega] + ac_rfl + | @branch_neg cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (ih hp.cons_tail.append_left)).trans ?_ + rw [ProbComp.expect_map, ← ProbComp.expect_const m 1, ← ProbComp.expect_add] + refine ProbComp.expect_mono_on_support fun z _ => ?_ + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + refine (add_le_add le_rfl + (add_le_add le_rfl (expectedStepsWithin_running_le w p N ⟨pc + 1 + neg.size, z.1⟩))).trans + (le_of_eq ?_) + rw [stepRand_jump (s := ⟨pc + 1 + neg.size, z.1⟩) hj, ProbComp.expect_pure] + simp only [Code.size, Nat.cast_add, Nat.cast_ofNat] + rw [show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + set E := expectedStepsWithin w p N (.running ⟨pc + (neg.size + pos.size + 2), z.1⟩) + calc + 1 + ((z.2 : ℝ≥0∞) + (1 + E)) = (z.2 : ℝ≥0∞) + (1 + 1) + E := by ac_rfl + _ = (z.2 : ℝ≥0∞) + 2 + E := by rw [one_add_one_eq_two] + | @loop_exit cond body x hc => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hj : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (expectedStepsWithin_running_le w p N ⟨pc + 1, x⟩)).trans + (le_of_eq ?_) + rw [stepRand_jump (s := ⟨pc + 1, x⟩) hj, ProbComp.expect_pure] + simp only [Code.size, Nat.cast_ofNat] + rw [← add_assoc, one_add_one_eq_two, show pc + body.size + 3 = pc + (body.size + 3) by omega] + | @loop_iter cond body x mb ml hc _ _ ihb ihl => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (ihb hbody_contains)).trans ?_ + rw [ProbComp.expect_bind, ← ProbComp.expect_const mb 1, ← ProbComp.expect_add] + refine ProbComp.expect_mono_on_support fun z₁ hz₁ => ?_ + have hjump_le : expectedStepsWithin w p N (.running ⟨pc + 2 + body.size, z₁.1⟩) ≤ + 1 + ProbComp.expect (ml z₁.1) (fun z => + (z.2 : ℝ≥0∞) + + expectedStepsWithin w p N (.running ⟨pc + (Code.loop cond body).size, z.1⟩)) := by + refine (expectedStepsWithin_running_le w p N ⟨pc + 2 + body.size, z₁.1⟩).trans ?_ + rw [stepRand_jump (s := ⟨pc + 2 + body.size, z₁.1⟩) hj, ProbComp.expect_pure] + exact add_le_add le_rfl (ihl z₁ hz₁ hp) + refine (add_le_add le_rfl (add_le_add le_rfl hjump_le)).trans (le_of_eq ?_) + rw [ProbComp.expect_bind] + have hconst : (1 : ℝ≥0∞) + ((z₁.2 : ℝ≥0∞) + + (1 + ProbComp.expect (ml z₁.1) fun z => + (z.2 : ℝ≥0∞) + + expectedStepsWithin w p N (.running ⟨pc + (Code.loop cond body).size, z.1⟩))) = + ProbComp.expect (ml z₁.1) (fun _ => (z₁.2 : ℝ≥0∞) + 2) + + ProbComp.expect (ml z₁.1) (fun z => + (z.2 : ℝ≥0∞) + + expectedStepsWithin w p N (.running ⟨pc + (Code.loop cond body).size, z.1⟩)) := by + rw [ProbComp.expect_const, ← one_add_one_eq_two] + ac_rfl + rw [hconst, ← ProbComp.expect_add] + refine ProbComp.expect_congr_on_support fun z₂ _ => ?_ + simp only [ProbComp.expect_pure, Nat.cast_add, Nat.cast_ofNat] + rw [← add_assoc ((z₁.2 : ℝ≥0∞) + 2) (z₂.2 : ℝ≥0∞), add_right_comm (z₁.2 : ℝ≥0∞) 2] + +/-- Along `ExecRand w c x m`, if no continuation from `⟨pc + c.size, y⟩` faults within `T` steps +for any supported outcome `y`, then running `p` from `⟨pc, x⟩` does not fault within `T` steps. -/ +theorem ExecRand.evalRand_faulted_eq_zero {w : ℕ} {c : Code B r} {x : Data r} + {m : ProbComp (Data r × ℕ)} (h : ExecRand w c x m) {p : Program B r} {pc T : ℕ} + (hp : p.Contains pc (c.assemble pc)) + (hcont : ∀ z ∈ m.support, ∀ t ≤ T, evalRand w p t ⟨pc + c.size, z.1⟩ .faulted = 0) : + ∀ t ≤ T, evalRand w p t ⟨pc, x⟩ .faulted = 0 := by + induction h generalizing pc T with + | @op o x y ho => + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_op (s := ⟨pc, x⟩) hp.head ho, pure_bind] + simpa [evalRand, Code.size] using hcont (y, 1) rfl k (by omega) + | @rand dst src x hfit => + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_rand_of_fits (s := ⟨pc, x⟩) hp.head hfit, bind_assoc, + ProbComp.eval_bind, PMF.bind_apply, tsum_eq_zero_iff] + intro sample + have hmem : (x.set dst sample.val, 1) ∈ + (ProbComp.unifFin (x.regs src) >>= fun s => pure (x.set dst s.val, 1)).support := + OracleComp.mem_supportWith_bind_iff.mpr ⟨sample, ProbComp.mem_support_unifFin _ sample, rfl⟩ + have hzero := hcont _ hmem k (by omega) + simp only [pure_bind] + exact mul_eq_zero_of_right _ hzero + | @seq c₁ c₂ x m₁ m₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + refine ih₁ hp.append_left fun z₁ hz₁ t ht => ?_ + refine ih₂ z₁ hz₁ hc₂ (T := t) (fun z₂ hz₂ t' ht' => ?_) t le_rfl + have hmem : (z₂.1, z₁.2 + z₂.2) ∈ + (m₁ >>= fun z₁ => m₂ z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2)).support := + OracleComp.mem_supportWith_bind_iff.mpr + ⟨z₁, hz₁, OracleComp.mem_supportWith_bind_iff.mpr ⟨z₂, hz₂, rfl⟩⟩ + simpa [Code.size, Nat.add_assoc] using hcont _ hmem t' (ht'.trans ht) + | @branch_pos cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + refine ih hc' (T := k) (fun z hz t' ht' => ?_) k le_rfl + have hmem : (z.1, z.2 + 1) ∈ ((fun z : Data r × ℕ => (z.1, z.2 + 1)) <$> m).support := + OracleComp.mem_supportWith_map_iff.mpr ⟨z, hz, rfl⟩ + simpa [Code.size, show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega] + using hcont _ hmem t' (by omega) + | @branch_neg cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + refine ih hp.cons_tail.append_left (T := k) (fun z hz t' ht' => ?_) k le_rfl + cases t' with + | zero => simp [evalRand] + | succ k' => + rw [evalRand, runRand_succ, stepRand_jump (s := ⟨pc + 1 + neg.size, z.1⟩) hj, pure_bind] + have hmem : (z.1, z.2 + 2) ∈ ((fun z : Data r × ℕ => (z.1, z.2 + 2)) <$> m).support := + OracleComp.mem_supportWith_map_iff.mpr ⟨z, hz, rfl⟩ + simpa [evalRand, Code.size, + show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + using hcont _ hmem k' (by omega) + | @loop_exit cond body x hc => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hj : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + cases k with + | zero => simp + | succ k' => + rw [runRand_succ, stepRand_jump (s := ⟨pc + 1, x⟩) hj, pure_bind] + simpa [evalRand, Code.size, show pc + body.size + 3 = pc + (body.size + 3) by omega] + using hcont (x, 2) rfl k' (by omega) + | @loop_iter cond body x mb ml hc _ _ ihb ihl => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + refine ihb hbody_contains (T := k) (fun z₁ hz₁ t' ht' => ?_) k le_rfl + cases t' with + | zero => simp [evalRand] + | succ k' => + rw [evalRand, runRand_succ, stepRand_jump (s := ⟨pc + 2 + body.size, z₁.1⟩) hj, pure_bind] + refine ihl z₁ hz₁ hp (T := k') (fun z₂ hz₂ t'' ht'' => ?_) k' le_rfl + have hmem : (z₂.1, z₁.2 + z₂.2 + 2) ∈ + (mb >>= fun z₁ => ml z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2 + 2)).support := + OracleComp.mem_supportWith_bind_iff.mpr + ⟨z₁, hz₁, OracleComp.mem_supportWith_bind_iff.mpr ⟨z₂, hz₂, rfl⟩⟩ + exact hcont _ hmem t'' (by omega) + +private theorem iSup_evalRand_halted_le_of_step {w : ℕ} {p : Program B r} {s s' : State r} + (hstep : stepRand w p (.running s) = pure (.running s')) (v : ℕ) (d : Data r) : + (⨆ T : ℕ, evalRand w p T s' (.halted v d)) ≤ ⨆ T : ℕ, evalRand w p T s (.halted v d) := by + refine iSup_le fun T => le_iSup_of_le (T + 1) ?_ + simp only [evalRand, runRand_succ, hstep, pure_bind, le_rfl] + +/-- Along `ExecRand w c x m`, the expected supremum halting probability from `⟨pc + c.size, y⟩` is a +lower bound on the supremum halting probability from `⟨pc, x⟩`. -/ +theorem ExecRand.le_iSup_evalRand_halted {w : ℕ} {c : Code B r} {x : Data r} + {m : ProbComp (Data r × ℕ)} (h : ExecRand w c x m) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) (v : ℕ) (d : Data r) : + ProbComp.expect m (fun z => ⨆ T : ℕ, evalRand w p T ⟨pc + c.size, z.1⟩ (.halted v d)) ≤ + ⨆ T : ℕ, evalRand w p T ⟨pc, x⟩ (.halted v d) := by + induction h generalizing pc with + | @op o x y ho => + rw [ProbComp.expect_pure] + simpa [Code.size] using + iSup_evalRand_halted_le_of_step (stepRand_op (s := ⟨pc, x⟩) hp.head ho) v d + | @rand dst src x hfit => + rw [ProbComp.expect_bind] + simp only [ProbComp.expect_pure, Code.size] + change (∑' sample : Fin (x.regs src + 1), + (ProbComp.unifFin (x.regs src)).eval sample * + ⨆ T : ℕ, evalRand w p T ⟨pc + 1, x.set dst sample.val⟩ (.halted v d)) ≤ + ⨆ T : ℕ, evalRand w p T ⟨pc, x⟩ (.halted v d) + simp_rw [ENNReal.mul_iSup] + rw [tsum_iSup_of_monotone fun sample T₁ T₂ hT => + mul_le_mul_right (evalRand_halted_mono w p ⟨pc + 1, x.set dst sample.val⟩ v d hT) _] + refine iSup_le fun T => le_iSup_of_le (T + 1) ?_ + rw [evalRand, runRand_succ, stepRand_rand_of_fits (s := ⟨pc, x⟩) hp.head hfit, bind_assoc, + ProbComp.eval_bind, PMF.bind_apply] + refine le_of_eq (tsum_congr fun sample => ?_) + simp [evalRand] + | @seq c₁ c₂ x m₁ m₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + rw [ProbComp.expect_bind] + refine (ProbComp.expect_mono_on_support fun z₁ hz₁ => ?_).trans (ih₁ hp.append_left) + rw [ProbComp.expect_bind] + refine (ProbComp.expect_mono_on_support fun z₂ _ => ?_).trans (ih₂ z₁ hz₁ hc₂) + simp only [ProbComp.expect_pure, Code.size, Nat.add_assoc, le_rfl] + | @branch_pos cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + neg.size + 2, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + rw [ProbComp.expect_map] + refine (ProbComp.expect_mono_on_support fun z _ => ?_).trans + ((ih hc').trans (iSup_evalRand_halted_le_of_step hstep v d)) + simp only [Code.size, + show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega, le_rfl] + | @branch_neg cond pos neg x m hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + 1, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + rw [ProbComp.expect_map] + refine (ProbComp.expect_mono_on_support fun z _ => ?_).trans + ((ih hp.cons_tail.append_left).trans (iSup_evalRand_halted_le_of_step hstep v d)) + simpa [Code.size, show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + using iSup_evalRand_halted_le_of_step + (stepRand_jump (s := ⟨pc + 1 + neg.size, z.1⟩) hj) v d + | @loop_exit cond body x hc => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hj : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + 1, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + rw [ProbComp.expect_pure] + simpa [Code.size, show pc + body.size + 3 = pc + (body.size + 3) by omega] using + (iSup_evalRand_halted_le_of_step (stepRand_jump (s := ⟨pc + 1, x⟩) hj) v d).trans + (iSup_evalRand_halted_le_of_step hstep v d) + | @loop_iter cond body x mb ml hc _ _ ihb ihl => + have hbr : p[pc]? = some (.branch cond (pc + 2)) := hp.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + 2, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + rw [ProbComp.expect_bind] + refine (ProbComp.expect_mono_on_support fun z₁ hz₁ => ?_).trans + ((ihb hbody_contains).trans (iSup_evalRand_halted_le_of_step hstep v d)) + rw [ProbComp.expect_bind] + refine (ProbComp.expect_mono_on_support fun z₂ _ => ?_).trans + ((ihl z₁ hz₁ hp).trans + (iSup_evalRand_halted_le_of_step (stepRand_jump (s := ⟨pc + 2 + body.size, z₁.1⟩) hj) v d)) + simp only [ProbComp.expect_pure, le_rfl] + +/-! ### Absorbing Markov chain for geometric Las Vegas loops -/ + +/-- One step of the stopped loop Markov kernel on `Data r`: active states (`cond.Holds x`) step +according to `μ_body x`, while exiting states (`¬cond.Holds x`) are absorbing. -/ +noncomputable def loopStepPMF (cond : Cond r) (μ_body : Data r → PMF (Data r)) (x : Data r) : + PMF (Data r) := + open Classical in + if cond.Holds x then μ_body x else PMF.pure x + +theorem loopStepPMF_of_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} {x : Data r} + (hc : cond.Holds x) : + loopStepPMF cond μ_body x = μ_body x := by + classical + simp [loopStepPMF, hc] + +theorem loopStepPMF_of_not_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} {x : Data r} + (hc : ¬cond.Holds x) : + loopStepPMF cond μ_body x = PMF.pure x := by + classical + simp [loopStepPMF, hc] + +/-- `K`-step iterate of `loopStepPMF`. -/ +noncomputable def loopIterPMF (cond : Cond r) (μ_body : Data r → PMF (Data r)) : + ℕ → Data r → PMF (Data r) + | 0, x => PMF.pure x + | K + 1, x => (loopStepPMF cond μ_body x).bind (loopIterPMF cond μ_body K) + +@[simp] +theorem loopIterPMF_zero (cond : Cond r) (μ_body : Data r → PMF (Data r)) (x : Data r) : + loopIterPMF cond μ_body 0 x = PMF.pure x := rfl + +theorem loopIterPMF_succ (cond : Cond r) (μ_body : Data r → PMF (Data r)) (K : ℕ) (x : Data r) : + loopIterPMF cond μ_body (K + 1) x = + (loopStepPMF cond μ_body x).bind (loopIterPMF cond μ_body K) := rfl + +theorem loopIterPMF_of_not_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} {x : Data r} + (hc : ¬cond.Holds x) (K : ℕ) : + loopIterPMF cond μ_body K x = PMF.pure x := by + induction K with + | zero => rfl + | succ K ih => rw [loopIterPMF_succ, loopStepPMF_of_not_holds hc, PMF.pure_bind, ih] + +theorem loopIterPMF_succ_right (cond : Cond r) (μ_body : Data r → PMF (Data r)) (K : ℕ) + (x : Data r) : + loopIterPMF cond μ_body (K + 1) x = + (loopIterPMF cond μ_body K x).bind (loopStepPMF cond μ_body) := by + induction K generalizing x with + | zero => simp [loopIterPMF] + | succ K ih => + rw [loopIterPMF_succ (K := K), PMF.bind_bind] + exact congrArg ((loopStepPMF cond μ_body x).bind ·) (funext ih) + +theorem loopIterPMF_mono_of_not_holds (cond : Cond r) (μ_body : Data r → PMF (Data r)) + (x : Data r) {y : Data r} (hy : ¬cond.Holds y) : + Monotone fun K => loopIterPMF cond μ_body K x y := by + refine monotone_nat_of_le_succ fun K => ?_ + rw [loopIterPMF_succ_right, PMF.bind_apply] + calc + loopIterPMF cond μ_body K x y + = loopIterPMF cond μ_body K x y * loopStepPMF cond μ_body y y := by + rw [loopStepPMF_of_not_holds hy, PMF.pure_apply_self, mul_one] + _ ≤ ∑' z, loopIterPMF cond μ_body K x z * loopStepPMF cond μ_body z y := + le_tsum + (f := fun z => loopIterPMF cond μ_body K x z * loopStepPMF cond μ_body z y) y + +theorem loopIterPMF_indicator_mono (cond : Cond r) (μ_body : Data r → PMF (Data r)) + (x y : Data r) : + Monotone fun K => Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y := by + intro K₁ K₂ hK + dsimp only + by_cases hy : y ∈ {z | ¬cond.Holds z} + · rw [Set.indicator_of_mem hy, Set.indicator_of_mem hy] + exact loopIterPMF_mono_of_not_holds cond μ_body x hy hK + · rw [Set.indicator_of_notMem hy, Set.indicator_of_notMem hy] + +/-- Combined loop state invariant: either active (`cond.Holds x ∧ I x`) or exited +(`¬cond.Holds x ∧ Q x`). -/ +def LoopStateInv (cond : Cond r) (I Q : Data r → Prop) (x : Data r) : Prop := + (cond.Holds x ∧ I x) ∨ (¬cond.Holds x ∧ Q x) + +theorem loopIterPMF_support_inv {cond : Cond r} {I Q : Data r → Prop} + {μ_body : Data r → PMF (Data r)} + (hinv : ∀ x, I x → cond.Holds x → ∀ y ∈ (μ_body x).support, LoopStateInv cond I Q y) + (K : ℕ) {x : Data r} (hx : LoopStateInv cond I Q x) : + ∀ y ∈ (loopIterPMF cond μ_body K x).support, LoopStateInv cond I Q y := by + induction K generalizing x with + | zero => + intro y hy + rw [loopIterPMF_zero, PMF.support_pure, Set.mem_singleton_iff] at hy + rwa [hy] + | succ K ih => + intro y hy + rw [loopIterPMF_succ, PMF.mem_support_bind_iff] at hy + obtain ⟨z, hz, hyz⟩ := hy + rcases hx with ⟨hcx, hIx⟩ | ⟨hcx, hQx⟩ + · rw [loopStepPMF_of_holds hcx] at hz + exact ih (hinv x hIx hcx z hz) y hyz + · rw [loopStepPMF_of_not_holds hcx, PMF.support_pure, Set.mem_singleton_iff] at hz + subst hz + exact ih (Or.inr ⟨hcx, hQx⟩) y hyz + +private theorem pmf_toOuterMeasure_compl_add (μ : PMF (Data r)) (cond : Cond r) : + μ.toOuterMeasure {y | ¬cond.Holds y} + μ.toOuterMeasure {y | cond.Holds y} = 1 := by + rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← tsum_add] + convert μ.tsum_coe using 1 + congr 1 + funext y + by_cases hc : cond.Holds y <;> simp [hc] + +private theorem pmf_step_drift_bound (μ : PMF (Data r)) (cond : Cond r) + {C p_exit : ℝ≥0∞} (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hp_exit : p_exit ≤ μ.toOuterMeasure {y | ¬cond.Holds y}) : + C + ∑' y, μ y * (if cond.Holds y then C / p_exit else 0) ≤ C / p_exit := by + set M := C / p_exit + have hC : C = p_exit * M := by + rw [mul_comm, ENNReal.div_mul_cancel hp_pos.ne' hp_top] + have hact : (∑' y, μ y * (if cond.Holds y then M else 0)) = + μ.toOuterMeasure {y | cond.Holds y} * M := by + rw [PMF.toOuterMeasure_apply, ← ENNReal.tsum_mul_right] + refine tsum_congr fun y => ?_ + by_cases hc : cond.Holds y <;> simp [hc] + calc + C + ∑' y, μ y * (if cond.Holds y then M else 0) + = p_exit * M + μ.toOuterMeasure {y | cond.Holds y} * M := by rw [hC, hact] + _ ≤ μ.toOuterMeasure {y | ¬cond.Holds y} * M + + μ.toOuterMeasure {y | cond.Holds y} * M := by gcongr + _ = (μ.toOuterMeasure {y | ¬cond.Holds y} + + μ.toOuterMeasure {y | cond.Holds y}) * M := by rw [← add_mul] + _ = M := by rw [pmf_toOuterMeasure_compl_add, one_mul] + +/-- Expected number of active loop iterations within the first `N` steps of `loopIterPMF`. -/ +private noncomputable def loopActiveSteps (cond : Cond r) (μ_body : Data r → PMF (Data r)) + (N : ℕ) (x : Data r) : ℝ≥0∞ := + ∑ K ∈ Finset.range N, (loopIterPMF cond μ_body K x).toOuterMeasure {y | cond.Holds y} + +private theorem loopActiveSteps_of_not_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} + {x : Data r} (hc : ¬cond.Holds x) (N : ℕ) : + loopActiveSteps cond μ_body N x = 0 := by + unfold loopActiveSteps + refine Finset.sum_eq_zero fun K _ => ?_ + rw [loopIterPMF_of_not_holds hc, PMF.toOuterMeasure_pure_apply] + simp [hc] + +private theorem loopActiveSteps_succ_of_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} + {x : Data r} (hc : cond.Holds x) (N : ℕ) : + loopActiveSteps cond μ_body (N + 1) x = + 1 + ∑' z, μ_body x z * loopActiveSteps cond μ_body N z := by + rw [loopActiveSteps, Finset.sum_range_succ'] + have hzero : (loopIterPMF cond μ_body 0 x).toOuterMeasure {y | cond.Holds y} = 1 := by + simp [PMF.toOuterMeasure_pure_apply, hc] + rw [hzero, add_comm] + congr 1 + have hsucc : ∀ K : ℕ, (loopIterPMF cond μ_body (K + 1) x).toOuterMeasure {y | cond.Holds y} = + ∑' z, μ_body x z * (loopIterPMF cond μ_body K z).toOuterMeasure {y | cond.Holds y} := by + intro K + rw [loopIterPMF_succ, loopStepPMF_of_holds hc, PMF.toOuterMeasure_bind_apply] + simp only [hsucc] + rw [← Summable.tsum_finsetSum (fun _ _ => CompleteLattice.summable)] + simp only [loopActiveSteps, Finset.mul_sum] + +private theorem loopActiveSteps_le {cond : Cond r} {I Q : Data r → Prop} + {μ_body : Data r → PMF (Data r)} {p_exit : ℝ≥0∞} + (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hinv : ∀ x, I x → cond.Holds x → ∀ y ∈ (μ_body x).support, LoopStateInv cond I Q y) + (hp_exit : ∀ x, I x → cond.Holds x → p_exit ≤ (μ_body x).toOuterMeasure {y | ¬cond.Holds y}) + (N : ℕ) {x : Data r} (hx : LoopStateInv cond I Q x) : + loopActiveSteps cond μ_body N x ≤ if cond.Holds x then 1 / p_exit else 0 := by + induction N generalizing x with + | zero => simp [loopActiveSteps] + | succ N ih => + rcases hx with ⟨hcx, hIx⟩ | ⟨hcx, _⟩ + · simp only [hcx, ↓reduceIte] + rw [loopActiveSteps_succ_of_holds hcx] + refine (add_le_add le_rfl (tsum_le_tsum fun z => ?_)).trans + (pmf_step_drift_bound (μ_body x) cond hp_pos hp_top (hp_exit x hIx hcx)) + by_cases hz : z ∈ (μ_body x).support + · exact mul_le_mul_right (ih (hinv x hIx hcx z hz)) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hz, zero_mul, zero_mul] + · simp [loopActiveSteps_of_not_holds hcx, hcx] + +theorem hasSum_loopExitDensity {cond : Cond r} {I Q : Data r → Prop} + {μ_body : Data r → PMF (Data r)} {p_exit : ℝ≥0∞} + (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hinv : ∀ x, I x → cond.Holds x → ∀ y ∈ (μ_body x).support, LoopStateInv cond I Q y) + (hp_exit : ∀ x, I x → cond.Holds x → p_exit ≤ (μ_body x).toOuterMeasure {y | ¬cond.Holds y}) + {x : Data r} (hx : LoopStateInv cond I Q x) : + HasSum (fun y => ⨆ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y) 1 := by + rw [CompleteLattice.summable.hasSum_iff, + tsum_iSup_of_monotone (loopIterPMF_indicator_mono cond μ_body x)] + simp_rw [← PMF.toOuterMeasure_apply] + set b := ⨆ K : ℕ, (loopIterPMF cond μ_body K x).toOuterMeasure {z | ¬cond.Holds z} + have hb_le : b ≤ 1 := iSup_le fun K => Cslib.Probability.PMF.toOuterMeasure_le_one _ _ + have hsub_zero : 1 - b = 0 := by + by_contra hne + have hN_bound : ∀ N : ℕ, (N : ℝ≥0∞) * (1 - b) ≤ 1 / p_exit := by + intro N + have hterm : ∀ K : ℕ, 1 - b ≤ + (loopIterPMF cond μ_body K x).toOuterMeasure {z | cond.Holds z} := by + intro K + refine tsub_le_iff_left.mpr ?_ + rw [← pmf_toOuterMeasure_compl_add (loopIterPMF cond μ_body K x) cond] + exact add_le_add + (le_iSup (fun J => (loopIterPMF cond μ_body J x).toOuterMeasure {z | ¬cond.Holds z}) K) + le_rfl + calc + (N : ℝ≥0∞) * (1 - b) + = ∑ _K ∈ Finset.range N, (1 - b) := by simp + _ ≤ ∑ K ∈ Finset.range N, + (loopIterPMF cond μ_body K x).toOuterMeasure {z | cond.Holds z} := + Finset.sum_le_sum fun K _ => hterm K + _ ≤ if cond.Holds x then 1 / p_exit else 0 := + loopActiveSteps_le hp_pos hp_top hinv hp_exit N hx + _ ≤ 1 / p_exit := by split_ifs <;> simp + have htop : (⊤ : ℝ≥0∞) ≤ 1 / p_exit := by + rw [← ENNReal.top_mul hne, ← ENNReal.iSup_natCast, ENNReal.iSup_mul] + exact iSup_le hN_bound + exact ENNReal.div_ne_top ENNReal.one_ne_top hp_pos.ne' (top_le_iff.mp htop) + exact le_antisymm hb_le (tsub_eq_zero_iff_le.mp hsub_zero) + +/-- Limiting exit distribution of `Code.loop cond body` starting from `x` under one-step body +distribution family `μ_body`. -/ +noncomputable def loopExitPMF (cond : Cond r) (μ_body : Data r → PMF (Data r)) (x : Data r) : + PMF (Data r) := + open Classical in + if h : HasSum (fun y => ⨆ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y) 1 then + ⟨_, h⟩ + else + PMF.pure x + +theorem loopExitPMF_apply_of_hasSum {cond : Cond r} {μ_body : Data r → PMF (Data r)} {x : Data r} + (h : HasSum (fun y => ⨆ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y) 1) + (y : Data r) : + loopExitPMF cond μ_body x y = + ⨆ K : ℕ, Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y := by + classical + simp only [loopExitPMF, h, ↓reduceDIte] + rfl + +theorem loopExitPMF_of_not_holds {cond : Cond r} {μ_body : Data r → PMF (Data r)} {x : Data r} + (hc : ¬cond.Holds x) : + loopExitPMF cond μ_body x = PMF.pure x := by + have hfun : (fun y => ⨆ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y) = PMF.pure x := by + funext y + have hK : ∀ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y = PMF.pure x y := by + intro K + rw [loopIterPMF_of_not_holds hc] + by_cases hyx : y = x + · subst hyx + simp [hc] + · simp [PMF.pure_apply, hyx] + simp [hK] + ext y + rw [loopExitPMF_apply_of_hasSum (hfun ▸ (PMF.pure x).2), congrFun hfun y] + +theorem loopExitPMF_of_holds {cond : Cond r} {I Q : Data r → Prop} + {μ_body : Data r → PMF (Data r)} {p_exit : ℝ≥0∞} + (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hinv : ∀ x, I x → cond.Holds x → ∀ y ∈ (μ_body x).support, LoopStateInv cond I Q y) + (hp_exit : ∀ x, I x → cond.Holds x → p_exit ≤ (μ_body x).toOuterMeasure {y | ¬cond.Holds y}) + {x : Data r} (hIx : I x) (hcx : cond.Holds x) : + loopExitPMF cond μ_body x = (μ_body x).bind (loopExitPMF cond μ_body) := by + ext y + have hx : LoopStateInv cond I Q x := Or.inl ⟨hcx, hIx⟩ + rw [loopExitPMF_apply_of_hasSum (hasSum_loopExitDensity hp_pos hp_top hinv hp_exit hx), + PMF.bind_apply] + have hzero : Set.indicator {z | ¬cond.Holds z} (PMF.pure x) y = 0 := by + by_cases hy : ¬cond.Holds y + · have hyx : y ≠ x := fun h => hy (h ▸ hcx) + simp [hy, PMF.pure_apply, hyx] + · simp [Set.indicator_of_notMem, hy] + have hiSup_shift : + (⨆ K : ℕ, Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y) = + ⨆ K : ℕ, Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body (K + 1) x) y := by + refine le_antisymm (iSup_le fun K => ?_) (iSup_le fun K => + le_iSup (fun J => Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body J x) y) (K + 1)) + cases K with + | zero => + rw [loopIterPMF_zero, hzero] + exact zero_le + | succ K => + exact le_iSup + (fun J => Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body (J + 1) x) y) K + rw [hiSup_shift] + have hstep : ∀ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body (K + 1) x) y = + ∑' z, μ_body x z * + Set.indicator {w' | ¬cond.Holds w'} (loopIterPMF cond μ_body K z) y := by + intro K + rw [loopIterPMF_succ, loopStepPMF_of_holds hcx] + by_cases hy : ¬cond.Holds y + · simp [Set.indicator_of_mem, hy, PMF.bind_apply] + · simp [Set.indicator_of_notMem, hy] + simp_rw [hstep] + rw [← tsum_iSup_of_monotone + (f := fun K z => μ_body x z * + Set.indicator {w' | ¬cond.Holds w'} (loopIterPMF cond μ_body K z) y) + (fun z _ _ hK => mul_le_mul_right (loopIterPMF_indicator_mono cond μ_body z y hK) _)] + refine tsum_congr fun z => ?_ + by_cases hz : z ∈ (μ_body x).support + · rw [← ENNReal.mul_iSup, + loopExitPMF_apply_of_hasSum + (hasSum_loopExitDensity hp_pos hp_top hinv hp_exit (hinv x hIx hcx z hz))] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hz, zero_mul] + simp + +theorem mem_support_loopExitPMF {cond : Cond r} {I Q : Data r → Prop} + {μ_body : Data r → PMF (Data r)} {p_exit : ℝ≥0∞} + (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hinv : ∀ x, I x → cond.Holds x → ∀ y ∈ (μ_body x).support, LoopStateInv cond I Q y) + (hp_exit : ∀ x, I x → cond.Holds x → p_exit ≤ (μ_body x).toOuterMeasure {y | ¬cond.Holds y}) + {x : Data r} (hx : LoopStateInv cond I Q x) + {y : Data r} (hy : y ∈ (loopExitPMF cond μ_body x).support) : + (¬cond.Holds y ∧ Q y) ∧ ∃ K, y ∈ (loopIterPMF cond μ_body K x).support := by + rw [PMF.mem_support_iff, + loopExitPMF_apply_of_hasSum (hasSum_loopExitDensity hp_pos hp_top hinv hp_exit hx)] at hy + have ⟨K, hK⟩ : ∃ K : ℕ, + Set.indicator {z | ¬cond.Holds z} (loopIterPMF cond μ_body K x) y ≠ 0 := by + by_contra! h + exact hy (by simp [h]) + have hnc : ¬cond.Holds y := by + by_contra hc + exact hK (by simp [Set.indicator_of_notMem, hc]) + rw [Set.indicator_of_mem hnc, ← PMF.mem_support_iff] at hK + rcases loopIterPMF_support_inv hinv K hx y hK with ⟨hcy, _⟩ | ⟨_, hQy⟩ + · exact absurd hcy hnc + · exact ⟨⟨hnc, hQy⟩, K, hK⟩ + +/-! ### Compositional distributional execution (`ExecCodeDist`) -/ + +/-- `ExecCodeDist w c x μ T`: at word size `w`, running structured program `c` from data `x` +terminates almost surely without faulting, realizes exit distribution `μ : PMF (Data r)` at the +fallthrough address `pc + c.size` of any containing flat program, and uses at most `T : ℝ≥0∞` +expected instructions. + +Unlike `ExecRand`, which requires a finite-depth computation tree, `ExecCodeDist` includes +unbounded Las Vegas `while` loops whose each active iteration exits with probability bounded below +by `p_exit > 0` (`ExecCodeDist.loop_geometric`). -/ +inductive ExecCodeDist {B : Basis} {r : ℕ} (w : ℕ) : Code B r → Data r → PMF (Data r) → + ℝ≥0∞ → Prop where + | of_execRand {c : Code B r} {x : Data r} {m : ProbComp (Data r × ℕ)} : + ExecRand w c x m → + ExecCodeDist w c x (Prod.fst <$> m).eval (ProbComp.expect m fun z => (z.2 : ℝ≥0∞)) + | mono {c : Code B r} {x : Data r} {μ : PMF (Data r)} {T T' : ℝ≥0∞} : + ExecCodeDist w c x μ T → T ≤ T' → ExecCodeDist w c x μ T' + | seq {c₁ c₂ : Code B r} {x : Data r} {μ₁ : PMF (Data r)} + {μ₂ : Data r → PMF (Data r)} {T₁ : ℝ≥0∞} {T₂ : Data r → ℝ≥0∞} : + ExecCodeDist w c₁ x μ₁ T₁ → + (∀ y ∈ μ₁.support, ExecCodeDist w c₂ y (μ₂ y) (T₂ y)) → + ExecCodeDist w (.seq c₁ c₂) x (μ₁.bind μ₂) (T₁ + ∑' y, μ₁ y * T₂ y) + | branch_pos {cond : Cond r} {pos neg : Code B r} {x : Data r} + {μ : PMF (Data r)} {T : ℝ≥0∞} : + cond.Holds x → ExecCodeDist w pos x μ T → + ExecCodeDist w (.branch cond pos neg) x μ (T + 1) + | branch_neg {cond : Cond r} {pos neg : Code B r} {x : Data r} + {μ : PMF (Data r)} {T : ℝ≥0∞} : + ¬cond.Holds x → ExecCodeDist w neg x μ T → + ExecCodeDist w (.branch cond pos neg) x μ (T + 2) + | loop_geometric {cond : Cond r} {body : Code B r} + (I Q : Data r → Prop) {μ_body : Data r → PMF (Data r)} {T_body : Data r → ℝ≥0∞} + {B_body p_exit : ℝ≥0∞} {x : Data r} : + 0 < p_exit → p_exit ≠ ⊤ → + (∀ z, I z → cond.Holds z → ExecCodeDist w body z (μ_body z) (T_body z)) → + (∀ z, I z → cond.Holds z → T_body z ≤ B_body) → + (∀ z, I z → cond.Holds z → + ∀ y ∈ (μ_body z).support, LoopStateInv cond I Q y) → + (∀ z, I z → cond.Holds z → + p_exit ≤ (μ_body z).toOuterMeasure {y | ¬cond.Holds y}) → + LoopStateInv cond I Q x → + ExecCodeDist w (.loop cond body) x (loopExitPMF cond μ_body x) + ((B_body + 2) / p_exit + 2) + +namespace ExecCodeDist + +variable {w : ℕ} {c c₁ c₂ pos neg body : Code B r} {cond : Cond r} {x y : Data r} + {μ μ₁ μ' : PMF (Data r)} {T T' T₁ T₂ : ℝ≥0∞} + +theorem congr_dist (h : ExecCodeDist w c x μ T) (hμ : μ = μ') (hT : T ≤ T') : + ExecCodeDist w c x μ' T' := by + subst hμ + exact h.mono hT + +/-- Every deterministic `Exec w c x y n` gives `ExecCodeDist w c x (PMF.pure y) n`. -/ +theorem of_exec {n : ℕ} (h : Exec w c x y n) : + ExecCodeDist w c x (PMF.pure y) n := by + simpa [ProbComp.expect_pure] using of_execRand h.execRand + +/-- Every deterministic `ExecWithin w c x y n` gives `ExecCodeDist w c x (PMF.pure y) n`. -/ +theorem of_execWithin {n : ℕ} (h : ExecWithin w c x y n) : + ExecCodeDist w c x (PMF.pure y) n := by + obtain ⟨m, hm, he⟩ := h + exact (of_exec he).mono (Nat.cast_le.mpr hm) + +/-- Single deterministic operation instruction. -/ +theorem op {o : Op B r} (ho : o.eval w x = some y) : + ExecCodeDist w (.op o) x (PMF.pure y) 1 := by + simpa using of_exec (Exec.op ho) + +/-- Single `rand dst src` instruction. -/ +theorem rand {dst src : Fin r} (hfit : Fits w (x.regs src)) : + ExecCodeDist (B := B) w (.rand dst src) x + ((ProbComp.unifFin (x.regs src)).eval.map fun k => x.set dst k.val) 1 := by + have h := of_execRand (ExecRand.rand (B := B) (dst := dst) (src := src) hfit) + refine h.congr_dist ?_ ?_ + · ext z + simp [ProbComp.eval_map, PMF.map_apply] + · simp [ProbComp.expect_map, ProbComp.expect_const] + +/-- Exiting a loop immediately when `¬cond.Holds x` takes `2` steps and leaves `x` unchanged. -/ +theorem loop_exit (hc : ¬cond.Holds x) : + ExecCodeDist w (.loop cond body) x (PMF.pure x) 2 := by + simpa using of_exec (Exec.loop_exit hc) + +/-- Sequencing with a uniform continuation step bound `T₂`. -/ +theorem seq_const {μ₂ : Data r → PMF (Data r)} {T₂ : Data r → ℝ≥0∞} {B₂ : ℝ≥0∞} + (h₁ : ExecCodeDist w c₁ x μ₁ T₁) + (h₂ : ∀ y ∈ μ₁.support, ExecCodeDist w c₂ y (μ₂ y) (T₂ y)) + (hB₂ : ∀ y ∈ μ₁.support, T₂ y ≤ B₂) : + ExecCodeDist w (.seq c₁ c₂) x (μ₁.bind μ₂) (T₁ + B₂) := by + refine (h₁.seq h₂).mono (add_le_add le_rfl ?_) + calc + (∑' y, μ₁ y * T₂ y) + ≤ ∑' y, μ₁ y * B₂ := by + refine tsum_le_tsum fun y => ?_ + by_cases hy : y ∈ μ₁.support + · exact mul_le_mul_right (hB₂ y hy) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hy, zero_mul, zero_mul] + _ = B₂ := by rw [ENNReal.tsum_mul_right, μ₁.tsum_coe, one_mul] + +/-- Sequencing after a deterministic first stage (`PMF.pure y`). -/ +theorem seq_pure (h₁ : ExecCodeDist w c₁ x (PMF.pure y) T₁) + (h₂ : ExecCodeDist w c₂ y μ T₂) : + ExecCodeDist w (.seq c₁ c₂) x μ (T₁ + T₂) := by + classical + have h := h₁.seq (c₂ := c₂) (μ₂ := fun z => if z = y then μ else PMF.pure z) + (T₂ := fun z => if z = y then T₂ else 0) fun z hz => by + rw [PMF.support_pure, Set.mem_singleton_iff] at hz + subst hz + simpa only [↓reduceIte] using h₂ + refine h.congr_dist ?_ ?_ + · simp + · rw [tsum_eq_single y] + · simp + · intro z hz + simp [PMF.pure_apply, hz] + +/-- Every state in the support of `μ` preserves `Data.Bounded w` when `x.Bounded w`. -/ +theorem bounded (h : ExecCodeDist w c x μ T) (hx : x.Bounded w) : + ∀ y ∈ μ.support, y.Bounded w := by + induction h with + | @of_execRand c x m hm => + intro y hy + rw [ProbComp.eval_map, PMF.mem_support_map_iff] at hy + obtain ⟨z, hz, rfl⟩ := hy + rw [ProbComp.support_eval] at hz + exact hm.bounded hx hz + | mono _ _ ih => exact ih hx + | seq _ _ ih₁ ih₂ => + intro y hy + rw [PMF.mem_support_bind_iff] at hy + obtain ⟨z, hz, hyz⟩ := hy + exact ih₂ z hz (ih₁ hx z hz) y hyz + | branch_pos _ _ ih => exact ih hx + | branch_neg _ _ ih => exact ih hx + | @loop_geometric cond body I Q μ_body T_body B_body p_exit x + hp_pos hp_top _ _ hinv hp_exit hx_inv ih_body => + intro y hy + obtain ⟨_, K, hK⟩ := mem_support_loopExitPMF hp_pos hp_top hinv hp_exit hx_inv hy + have hK_bdd : ∀ K : ℕ, ∀ x₀ : Data r, LoopStateInv cond I Q x₀ → x₀.Bounded w → + ∀ z ∈ (loopIterPMF cond μ_body K x₀).support, z.Bounded w := by + intro K + induction K with + | zero => + intro x₀ _ hx₀ z hz + rw [loopIterPMF_zero, PMF.support_pure, Set.mem_singleton_iff] at hz + rwa [hz] + | succ K ihK => + intro x₀ hx₀_inv hx₀ z hz + rw [loopIterPMF_succ, PMF.mem_support_bind_iff] at hz + obtain ⟨u, hu, hzu⟩ := hz + rcases hx₀_inv with ⟨hcx₀, hIx₀⟩ | ⟨hcx₀, hQx₀⟩ + · rw [loopStepPMF_of_holds hcx₀] at hu + exact ihK u (hinv x₀ hIx₀ hcx₀ u hu) (ih_body x₀ hIx₀ hcx₀ hx₀ u hu) z hzu + · rw [loopStepPMF_of_not_holds hcx₀, PMF.support_pure, Set.mem_singleton_iff] at hu + rw [hu] at hzu + exact ihK x₀ (Or.inr ⟨hcx₀, hQx₀⟩) hx₀ z hzu + exact hK_bdd K x hx_inv hx y hK + +/-- Any register `i` not written by `c` (`c.Preserves i`) is preserved across the support of `μ`. -/ +theorem regs_eq {i : Fin r} (h : ExecCodeDist w c x μ T) (hi : c.Preserves i) : + ∀ y ∈ μ.support, y.regs i = x.regs i := by + induction h with + | @of_execRand c x m hm => + intro y hy + rw [ProbComp.eval_map, PMF.mem_support_map_iff] at hy + obtain ⟨z, hz, rfl⟩ := hy + rw [ProbComp.support_eval] at hz + exact hm.regs_eq hi hz + | mono _ _ ih => exact ih hi + | seq _ _ ih₁ ih₂ => + intro y hy + rw [PMF.mem_support_bind_iff] at hy + obtain ⟨z, hz, hyz⟩ := hy + exact (ih₂ z hz hi.2 y hyz).trans (ih₁ hi.1 z hz) + | branch_pos _ _ ih => exact ih hi.1 + | branch_neg _ _ ih => exact ih hi.2 + | @loop_geometric cond body I Q μ_body T_body B_body p_exit x + hp_pos hp_top _ _ hinv hp_exit hx_inv ih_body => + intro y hy + obtain ⟨_, K, hK⟩ := mem_support_loopExitPMF hp_pos hp_top hinv hp_exit hx_inv hy + have hK_eq : ∀ K : ℕ, ∀ x₀ : Data r, LoopStateInv cond I Q x₀ → + ∀ z ∈ (loopIterPMF cond μ_body K x₀).support, z.regs i = x₀.regs i := by + intro K + induction K with + | zero => + intro x₀ _ z hz + rw [loopIterPMF_zero, PMF.support_pure, Set.mem_singleton_iff] at hz + rw [hz] + | succ K ihK => + intro x₀ hx₀_inv z hz + rw [loopIterPMF_succ, PMF.mem_support_bind_iff] at hz + obtain ⟨u, hu, hzu⟩ := hz + rcases hx₀_inv with ⟨hcx₀, hIx₀⟩ | ⟨hcx₀, hQx₀⟩ + · rw [loopStepPMF_of_holds hcx₀] at hu + exact (ihK u (hinv x₀ hIx₀ hcx₀ u hu) z hzu).trans (ih_body x₀ hIx₀ hcx₀ hi u hu) + · rw [loopStepPMF_of_not_holds hcx₀, PMF.support_pure, Set.mem_singleton_iff] at hu + rw [hu] at hzu + exact ihK x₀ (Or.inr ⟨hcx₀, hQx₀⟩) z hzu + exact hK_eq K x hx_inv y hK + +/-- Distributional executions transfer along any defined-evaluation basis simulation +`ψ : B.Simulates B'`. -/ +theorem mapSimulates {B' : Basis} (ψ : B.Simulates B') (h : ExecCodeDist w c x μ T) : + ExecCodeDist w (c.mapSimulates ψ) x μ T := by + induction h with + | of_execRand hm => exact of_execRand (hm.mapSimulates ψ) + | mono _ hle ih => exact ih.mono hle + | seq _ _ ih₁ ih₂ => exact ih₁.seq ih₂ + | branch_pos hc _ ih => exact branch_pos hc ih + | branch_neg hc _ ih => exact branch_neg hc ih + | loop_geometric I Q hp_pos hp_top _ hB hinv hp_exit hx ih_body => + exact loop_geometric I Q hp_pos hp_top ih_body hB hinv hp_exit hx + +private theorem extend_left_injective {r' : ℕ} {f : Fin r → Fin r'} (hf : f.Injective) + (x : Data r') : Function.Injective (fun y : Data r => y.extend f x) := by + intro y₁ y₂ h + have h' := congrArg (Data.comap f) h + simpa [Data.comap_extend hf] using h' + +private theorem pmf_map_apply_injective {α β : Type*} (p : PMF α) {g : α → β} + (hg : g.Injective) (a : α) : + p.map g (g a) = p a := by + rw [PMF.map_apply, tsum_eq_single a] + · simp + · intro a' ha' + have hne : g a ≠ g a' := hg.ne ha'.symm + simp [hne] + +private theorem pmf_map_apply_not_mem_range {α β : Type*} (p : PMF α) (g : α → β) {b : β} + (hb : b ∉ Set.range g) : + p.map g b = 0 := by + rw [PMF.map_apply, tsum_eq_zero_iff] + intro a + have hne : b ≠ g a := fun h => hb ⟨a, h.symm⟩ + simp [hne] + +private theorem loopIterPMF_rename {r' : ℕ} {f : Fin r → Fin r'} (hf : f.Injective) + (cond : Cond r) (μ_body : Data r → PMF (Data r)) (x : Data r') (K : ℕ) (u : Data r) : + loopIterPMF (cond.rename f) (fun x' => (μ_body (x'.comap f)).map (fun y => y.extend f x)) + K (u.extend f x) = + (loopIterPMF cond μ_body K u).map (fun y => y.extend f x) := by + induction K generalizing u with + | zero => simp [loopIterPMF] + | succ K ih => + rw [loopIterPMF_succ, loopIterPMF_succ] + by_cases hc : cond.Holds u + · have hc' : (cond.rename f).Holds (u.extend f x) := by + rw [Cond.holds_rename, Data.comap_extend hf] + exact hc + rw [loopStepPMF_of_holds hc', loopStepPMF_of_holds hc, Data.comap_extend hf, + PMF.bind_map, PMF.map_bind] + refine congrArg ((μ_body u).bind ·) (funext fun z => ih z) + · have hc' : ¬(cond.rename f).Holds (u.extend f x) := by + rw [Cond.holds_rename, Data.comap_extend hf] + exact hc + rw [loopStepPMF_of_not_holds hc', loopStepPMF_of_not_holds hc, PMF.pure_bind, + PMF.pure_bind, ih] + +/-- Renaming a distributional execution along an injective register map `f : Fin r → Fin r'` +transforms the output distribution via `Data.extend f x` and preserves the expected step bound. -/ +theorem rename {r' : ℕ} {f : Fin r → Fin r'} (hf : f.Injective) {x : Data r'} + (h : ExecCodeDist w c (x.comap f) μ T) : + ExecCodeDist w (c.rename f) x (μ.map fun y => y.extend f x) T := by + generalize hx₀ : x.comap f = x₀ at h + induction h generalizing x with + | @of_execRand c _ m hm => + subst hx₀ + have hm' := of_execRand (hm.rename hf) + refine hm'.congr_dist ?_ ?_ + · rw [Functor.map_map, ProbComp.eval_map, ProbComp.eval_map, PMF.map_comp] + rfl + · rw [ProbComp.expect_map] + | mono _ hle ih => + exact (ih hx₀).mono hle + | @seq c₁ c₂ _ μ₁ μ₂ T₁ T₂ _ _ ih₁ ih₂ => + subst hx₀ + have h₁' := ih₁ rfl + have hseq := h₁'.seq + (μ₂ := fun y' => (μ₂ (y'.comap f)).map fun z => z.extend f x) + (T₂ := fun y' => T₂ (y'.comap f)) + fun y' hy' => by + rw [PMF.mem_support_map_iff] at hy' + obtain ⟨y₁, hy₁, rfl⟩ := hy' + have h₂' := ih₂ y₁ hy₁ (x := y₁.extend f x) (Data.comap_extend hf y₁ x) + simpa only [Data.comap_extend hf, Data.extend_extend hf] using h₂' + refine hseq.congr_dist ?_ ?_ + · rw [PMF.map_bind, PMF.bind_map] + refine congrArg (μ₁.bind ·) (funext fun y₁ => ?_) + simp [Data.comap_extend hf] + · refine add_le_add le_rfl ?_ + rw [Cslib.Probability.PMF.tsum_map_mul] + simp [Data.comap_extend hf] + | branch_pos hc _ ih => + subst hx₀ + exact branch_pos ((Cond.holds_rename _ _).2 hc) (ih rfl) + | branch_neg hc _ ih => + subst hx₀ + exact branch_neg (fun h => hc ((Cond.holds_rename _ _).1 h)) (ih rfl) + | @loop_geometric cond body I Q μ_body T_body B_body p_exit _ + hp_pos hp_top _ hB hinv hp_exit hx_inv ih_body => + subst hx₀ + let g : Data r → Data r' := fun y => y.extend f x + have hg : g.Injective := extend_left_injective hf x + let I' : Data r' → Prop := fun x' => ∃ u, I u ∧ x' = g u + let Q' : Data r' → Prop := fun x' => ∃ u, Q u ∧ x' = g u + let μ_body' : Data r' → PMF (Data r') := fun x' => (μ_body (x'.comap f)).map g + let T_body' : Data r' → ℝ≥0∞ := fun x' => T_body (x'.comap f) + have hinv' : ∀ z', I' z' → (cond.rename f).Holds z' → + ∀ y' ∈ (μ_body' z').support, LoopStateInv (cond.rename f) I' Q' y' := by + rintro z' ⟨u, hIu, rfl⟩ hcz' y' hy' + have hcu : cond.Holds u := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcz' + simp only [μ_body', g, Data.comap_extend hf, PMF.mem_support_map_iff] at hy' + obtain ⟨y, hy, rfl⟩ := hy' + rcases hinv u hIu hcu y hy with ⟨hcy, hIy⟩ | ⟨hcy, hQy⟩ + · exact Or.inl ⟨by simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcy, + ⟨y, hIy, rfl⟩⟩ + · exact Or.inr ⟨by simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcy, + ⟨y, hQy, rfl⟩⟩ + have hp_exit' : ∀ z', I' z' → (cond.rename f).Holds z' → + p_exit ≤ (μ_body' z').toOuterMeasure {y' | ¬(cond.rename f).Holds y'} := by + rintro z' ⟨u, hIu, rfl⟩ hcz' + have hcu : cond.Holds u := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcz' + simp only [μ_body', g, Data.comap_extend hf, PMF.toOuterMeasure_map_apply] + have hset : ((fun y : Data r => y.extend f x) ⁻¹' {y' | ¬(cond.rename f).Holds y'}) = + {y | ¬cond.Holds y} := by + ext y + simp [Cond.holds_rename, Data.comap_extend hf] + rw [hset] + exact hp_exit u hIu hcu + have hx_inv' : LoopStateInv (cond.rename f) I' Q' x := by + rcases hx_inv with ⟨hcx, hIx⟩ | ⟨hcx, hQx⟩ + · exact Or.inl ⟨(Cond.holds_rename _ _).2 hcx, + ⟨x.comap f, hIx, (Data.extend_comap hf x).symm⟩⟩ + · exact Or.inr ⟨fun h => hcx ((Cond.holds_rename _ _).1 h), + ⟨x.comap f, hQx, (Data.extend_comap hf x).symm⟩⟩ + have hloop := loop_geometric (cond := cond.rename f) (body := body.rename f) + I' Q' hp_pos hp_top + (μ_body := μ_body') (T_body := T_body') (B_body := B_body) (x := x) + (fun z' ⟨u, hIu, hzu⟩ hcz' => by + subst hzu + have hcu : cond.Holds u := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcz' + have hb' := ih_body u hIu hcu (x := g u) (Data.comap_extend hf u x) + simpa only [μ_body', T_body', g, Data.comap_extend hf, Data.extend_extend hf] using hb') + (fun z' ⟨u, hIu, hzu⟩ hcz' => by + subst hzu + have hcu : cond.Holds u := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcz' + simpa only [T_body', g, Data.comap_extend hf] using hB u hIu hcu) + hinv' hp_exit' hx_inv' + refine hloop.congr_dist ?_ le_rfl + ext y' + rw [loopExitPMF_apply_of_hasSum (hasSum_loopExitDensity hp_pos hp_top hinv' hp_exit' hx_inv')] + have hx_eq : x = g (x.comap f) := (Data.extend_comap hf x).symm + by_cases hy' : y' ∈ Set.range g + · obtain ⟨y, rfl⟩ := hy' + rw [pmf_map_apply_injective _ hg, + loopExitPMF_apply_of_hasSum (hasSum_loopExitDensity hp_pos hp_top hinv hp_exit hx_inv)] + refine iSup_congr fun K => ?_ + have hiter : loopIterPMF (cond.rename f) μ_body' K x = + (loopIterPMF cond μ_body K (x.comap f)).map g := by + conv_lhs => rw [hx_eq] + exact loopIterPMF_rename hf cond μ_body x K (x.comap f) + rw [hiter] + by_cases hcy : ¬cond.Holds y + · have hcy' : ¬(cond.rename f).Holds (g y) := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcy + simp [Set.indicator_of_mem, hcy, hcy', pmf_map_apply_injective _ hg] + · have hcy' : ¬¬(cond.rename f).Holds (g y) := by + simpa [g, Cond.holds_rename, Data.comap_extend hf] using hcy + simp [Set.indicator_of_notMem, hcy, hcy'] + · rw [pmf_map_apply_not_mem_range _ g hy'] + refine le_antisymm (iSup_le fun K => ?_) zero_le + have hiter : loopIterPMF (cond.rename f) μ_body' K x = + (loopIterPMF cond μ_body K (x.comap f)).map g := by + conv_lhs => rw [hx_eq] + exact loopIterPMF_rename hf cond μ_body x K (x.comap f) + rw [hiter] + by_cases hcy' : ¬(cond.rename f).Holds y' + · simp [Set.indicator_of_mem, hcy', pmf_map_apply_not_mem_range _ g hy'] + · simp [Set.indicator_of_notMem, hcy'] + +/-! ### Compilation of `ExecCodeDist` to flat `Program` semantics -/ + +/-- Finite-horizon Bellman inequality for `ExecCodeDist` inside any containing flat program `p`. -/ +theorem expectedStepsWithin_assemble (h : ExecCodeDist w c x μ T) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) (N : ℕ) : + expectedStepsWithin w p N (.running ⟨pc, x⟩) ≤ + T + ∑' y, μ y * expectedStepsWithin w p N (.running ⟨pc + c.size, y⟩) := by + induction h generalizing pc N with + | @of_execRand c x m hm => + refine (hm.expectedStepsWithin_assemble hp N).trans (le_of_eq ?_) + rw [ProbComp.expect_add, + ← ProbComp.expect_map Prod.fst m (fun y => + expectedStepsWithin w p N (.running ⟨pc + c.size, y⟩))] + rfl + | mono _ hle ih => + exact (ih hp N).trans (add_le_add hle le_rfl) + | @seq c₁ c₂ x μ₁ μ₂ T₁ T₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + refine (ih₁ hp.append_left N).trans ?_ + have hstep : (∑' y, μ₁ y * expectedStepsWithin w p N (.running ⟨pc + c₁.size, y⟩)) ≤ + (∑' y, μ₁ y * T₂ y) + + ∑' z, (μ₁.bind μ₂) z * + expectedStepsWithin w p N (.running ⟨pc + (c₁.seq c₂).size, z⟩) := by + calc + (∑' y, μ₁ y * expectedStepsWithin w p N (.running ⟨pc + c₁.size, y⟩)) + ≤ ∑' y, μ₁ y * (T₂ y + + ∑' z, (μ₂ y) z * + expectedStepsWithin w p N (.running ⟨pc + c₁.size + c₂.size, z⟩)) := by + refine tsum_le_tsum fun y => ?_ + by_cases hy : y ∈ μ₁.support + · exact mul_le_mul_right (ih₂ y hy hc₂ N) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hy, zero_mul, zero_mul] + _ = (∑' y, μ₁ y * T₂ y) + + ∑' y, μ₁ y * ∑' z, (μ₂ y) z * + expectedStepsWithin w p N (.running ⟨pc + c₁.size + c₂.size, z⟩) := by + simp_rw [mul_add, tsum_add] + _ = (∑' y, μ₁ y * T₂ y) + + ∑' z, (μ₁.bind μ₂) z * + expectedStepsWithin w p N (.running ⟨pc + (c₁.seq c₂).size, z⟩) := by + congr 1 + simp only [Code.size, Nat.add_assoc] + exact (Cslib.Probability.PMF.tsum_bind_mul μ₁ μ₂ _).symm + calc + T₁ + ∑' y, μ₁ y * expectedStepsWithin w p N (.running ⟨pc + c₁.size, y⟩) + ≤ T₁ + ((∑' y, μ₁ y * T₂ y) + + ∑' z, (μ₁.bind μ₂) z * + expectedStepsWithin w p N (.running ⟨pc + (c₁.seq c₂).size, z⟩)) := + add_le_add le_rfl hstep + _ = (T₁ + ∑' y, μ₁ y * T₂ y) + + ∑' z, (μ₁.bind μ₂) z * + expectedStepsWithin w p N (.running ⟨pc + (c₁.seq c₂).size, z⟩) := by + rw [add_assoc] + | @branch_pos cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (ih hc' N)).trans (le_of_eq ?_) + simp only [Code.size, + show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega] + ac_rfl + | @branch_neg cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + refine (expectedStepsWithin_running_le w p N ⟨pc, x⟩).trans ?_ + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (ih hp.cons_tail.append_left N)).trans ?_ + have hjump : (∑' y, μ y * expectedStepsWithin w p N (.running ⟨pc + 1 + neg.size, y⟩)) ≤ + 1 + ∑' y, μ y * + expectedStepsWithin w p N (.running ⟨pc + (neg.size + pos.size + 2), y⟩) := by + calc + (∑' y, μ y * expectedStepsWithin w p N (.running ⟨pc + 1 + neg.size, y⟩)) + ≤ ∑' y, μ y * (1 + + expectedStepsWithin w p N (.running ⟨pc + (neg.size + pos.size + 2), y⟩)) := by + refine tsum_le_tsum fun y => mul_le_mul_right ?_ _ + refine (expectedStepsWithin_running_le w p N ⟨pc + 1 + neg.size, y⟩).trans (le_of_eq ?_) + rw [stepRand_jump (s := ⟨pc + 1 + neg.size, y⟩) hj, ProbComp.expect_pure, + show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + _ = 1 + ∑' y, μ y * + expectedStepsWithin w p N (.running ⟨pc + (neg.size + pos.size + 2), y⟩) := by + simp_rw [mul_add, tsum_add, mul_one, μ.tsum_coe] + calc + 1 + (T + ∑' y, μ y * expectedStepsWithin w p N (.running ⟨pc + 1 + neg.size, y⟩)) + ≤ 1 + (T + (1 + ∑' y, μ y * + expectedStepsWithin w p N (.running ⟨pc + (neg.size + pos.size + 2), y⟩))) := + add_le_add le_rfl (add_le_add le_rfl hjump) + _ = (T + (1 + 1)) + ∑' y, μ y * + expectedStepsWithin w p N (.running ⟨pc + (Code.branch cond pos neg).size, y⟩) := by + simp only [Code.size] + ac_rfl + _ = (T + 2) + ∑' y, μ y * + expectedStepsWithin w p N (.running ⟨pc + (Code.branch cond pos neg).size, y⟩) := by + rw [one_add_one_eq_two] + | @loop_geometric cond body I Q μ_body T_body B_body p_exit x + hp_pos hp_top _ hB hinv hp_exit hx_inv ih_body => + have hj_exit : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj_back : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + set K_cont : Data r → ℝ≥0∞ := fun y => + expectedStepsWithin w p N (.running ⟨pc + (Code.loop cond body).size, y⟩) + set M := (B_body + 2) / p_exit + have hmain : ∀ n ≤ N, ∀ z : Data r, LoopStateInv cond I Q z → + expectedStepsWithin w p n (.running ⟨pc, z⟩) ≤ + (if cond.Holds z then M else 0) + 2 + + ∑' y, loopExitPMF cond μ_body z y * K_cont y := by + intro n + induction n with + | zero => simp + | succ n ihn => + intro hn z hz_inv + rcases hz_inv with ⟨hcz, hIz⟩ | ⟨hcz, _⟩ + · simp only [hcz, ↓reduceIte] + rw [expectedStepsWithin_running_succ, stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp only [hcz, ↓reduceIte, ProbComp.expect_pure] + have hbody_step := (ih_body z hIz hcz hbody_contains n).trans + (add_le_add (hB z hIz hcz) le_rfl) + have hback_step : + (∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc + 2 + body.size, u⟩)) ≤ + 1 + ∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc, u⟩) := by + calc + (∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc + 2 + body.size, u⟩)) + ≤ ∑' u, μ_body z u * (1 + expectedStepsWithin w p n (.running ⟨pc, u⟩)) := by + refine tsum_le_tsum fun u => mul_le_mul_right ?_ _ + refine (expectedStepsWithin_running_le w p n ⟨pc + 2 + body.size, u⟩).trans + (le_of_eq ?_) + rw [stepRand_jump (s := ⟨pc + 2 + body.size, u⟩) hj_back, ProbComp.expect_pure] + _ = 1 + ∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc, u⟩) := by + simp_rw [mul_add, tsum_add, mul_one, (μ_body z).tsum_coe] + have hbind_k : + (∑' u, μ_body z u * ∑' y, loopExitPMF cond μ_body u y * K_cont y) = + ∑' y, loopExitPMF cond μ_body z y * K_cont y := by + rw [loopExitPMF_of_holds hp_pos hp_top hinv hp_exit hIz hcz] + exact (Cslib.Probability.PMF.tsum_bind_mul (μ_body z) + (loopExitPMF cond μ_body) K_cont).symm + have hih_step : + (∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc, u⟩)) ≤ + (∑' u, μ_body z u * (if cond.Holds u then M else 0)) + 2 + + ∑' y, loopExitPMF cond μ_body z y * K_cont y := by + calc + (∑' u, μ_body z u * expectedStepsWithin w p n (.running ⟨pc, u⟩)) + ≤ ∑' u, μ_body z u * ((if cond.Holds u then M else 0) + 2 + + ∑' y, loopExitPMF cond μ_body u y * K_cont y) := by + refine tsum_le_tsum fun u => ?_ + by_cases hu : u ∈ (μ_body z).support + · exact mul_le_mul_right + (ihn (Nat.le_of_succ_le hn) u (hinv z hIz hcz u hu)) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hu, zero_mul, zero_mul] + _ = (∑' u, μ_body z u * (if cond.Holds u then M else 0)) + 2 + + ∑' u, μ_body z u * ∑' y, loopExitPMF cond μ_body u y * K_cont y := by + simp_rw [mul_add, tsum_add, ENNReal.tsum_mul_right, (μ_body z).tsum_coe, + one_mul] + _ = (∑' u, μ_body z u * (if cond.Holds u then M else 0)) + 2 + + ∑' y, loopExitPMF cond μ_body z y * K_cont y := by + rw [hbind_k] + have hdrift := pmf_step_drift_bound (μ_body z) cond (C := B_body + 2) + hp_pos hp_top (hp_exit z hIz hcz) + calc + 1 + expectedStepsWithin w p n (.running ⟨pc + 2, z⟩) + ≤ 1 + (B_body + (1 + ∑' u, μ_body z u * + expectedStepsWithin w p n (.running ⟨pc, u⟩))) := + add_le_add le_rfl (hbody_step.trans (add_le_add le_rfl hback_step)) + _ = (B_body + (1 + 1)) + ∑' u, μ_body z u * + expectedStepsWithin w p n (.running ⟨pc, u⟩) := by ac_rfl + _ = (B_body + 2) + ∑' u, μ_body z u * + expectedStepsWithin w p n (.running ⟨pc, u⟩) := by rw [one_add_one_eq_two] + _ ≤ (B_body + 2) + ((∑' u, μ_body z u * (if cond.Holds u then M else 0)) + 2 + + ∑' y, loopExitPMF cond μ_body z y * K_cont y) := + add_le_add le_rfl hih_step + _ = ((B_body + 2) + ∑' u, μ_body z u * (if cond.Holds u then M else 0)) + 2 + + ∑' y, loopExitPMF cond μ_body z y * K_cont y := by ac_rfl + _ ≤ M + 2 + ∑' y, loopExitPMF cond μ_body z y * K_cont y := + add_le_add (add_le_add hdrift le_rfl) le_rfl + · simp only [hcz, ↓reduceIte, zero_add] + rw [loopExitPMF_of_not_holds hcz, tsum_eq_single z + (fun y hy => by simp [PMF.pure_apply, hy])] + simp only [PMF.pure_apply_self, one_mul] + rw [expectedStepsWithin_running_succ, stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp only [hcz, ↓reduceIte, ProbComp.expect_pure] + refine (add_le_add le_rfl (expectedStepsWithin_running_le w p n ⟨pc + 1, z⟩)).trans ?_ + rw [stepRand_jump (s := ⟨pc + 1, z⟩) hj_exit, ProbComp.expect_pure, ← add_assoc, + one_add_one_eq_two] + refine add_le_add le_rfl ?_ + simpa [K_cont, Code.size, show pc + body.size + 3 = pc + (body.size + 3) by omega] + using expectedStepsWithin_mono w p + (.running ⟨pc + (body.size + 3), z⟩) (Nat.le_of_succ_le hn) + refine (hmain N le_rfl x hx_inv).trans ?_ + refine add_le_add (add_le_add ?_ le_rfl) le_rfl + split_ifs <;> simp + +/-- Full-horizon Bellman inequality for `ExecCodeDist` inside any containing flat program `p`. -/ +theorem expectedStepsFrom_assemble (h : ExecCodeDist w c x μ T) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) : + expectedStepsFrom w p (.running ⟨pc, x⟩) ≤ + T + ∑' y, μ y * expectedStepsFrom w p (.running ⟨pc + c.size, y⟩) := by + rw [← iSup_expectedStepsWithin w p (.running ⟨pc, x⟩)] + refine iSup_le fun N => (h.expectedStepsWithin_assemble hp N).trans ?_ + refine add_le_add le_rfl (tsum_le_tsum fun y => mul_le_mul_right ?_ _) + exact expectedStepsWithin_le_expectedStepsFrom w p N (.running ⟨pc + c.size, y⟩) + +/-- Continuation upper-bound form of `expectedStepsFrom_assemble`. -/ +theorem expectedStepsFrom_le (h : ExecCodeDist w c x μ T) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) {k : Data r → ℝ≥0∞} + (hk : ∀ y ∈ μ.support, expectedStepsFrom w p (.running ⟨pc + c.size, y⟩) ≤ k y) : + expectedStepsFrom w p (.running ⟨pc, x⟩) ≤ T + ∑' y, μ y * k y := by + refine (h.expectedStepsFrom_assemble hp).trans + (add_le_add le_rfl (tsum_le_tsum fun y => ?_)) + by_cases hy : y ∈ μ.support + · exact mul_le_mul_right (hk y hy) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hy, zero_mul, zero_mul] + +/-- Along `ExecCodeDist w c x μ T`, if no continuation from `⟨pc + c.size, y⟩` faults within +`T_hor` steps for any supported `y ∈ μ.support`, then running `p` from `⟨pc, x⟩` does not fault +within `T_hor` steps. -/ +theorem evalRand_faulted_eq_zero (h : ExecCodeDist w c x μ T) {p : Program B r} {pc T_hor : ℕ} + (hp : p.Contains pc (c.assemble pc)) + (hcont : ∀ y ∈ μ.support, ∀ t ≤ T_hor, evalRand w p t ⟨pc + c.size, y⟩ .faulted = 0) : + ∀ t ≤ T_hor, evalRand w p t ⟨pc, x⟩ .faulted = 0 := by + induction h generalizing pc T_hor with + | @of_execRand c x m hm => + refine hm.evalRand_faulted_eq_zero hp fun z hz t ht => ?_ + apply hcont z.1 + · rw [ProbComp.eval_map, PMF.mem_support_map_iff] + refine ⟨z, ?_, rfl⟩ + rwa [ProbComp.support_eval] + · exact ht + | mono _ _ ih => exact ih hp hcont + | @seq c₁ c₂ x μ₁ μ₂ T₁ T₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + refine ih₁ hp.append_left fun y₁ hy₁ => ih₂ y₁ hy₁ hc₂ fun y₂ hy₂ t ht => ?_ + have hmem : y₂ ∈ (μ₁.bind μ₂).support := + (PMF.mem_support_bind_iff _ _ _).mpr ⟨y₁, hy₁, hy₂⟩ + simpa [Code.size, Nat.add_assoc] using hcont y₂ hmem t ht + | @branch_pos cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + refine ih hc' (T_hor := k) (fun y hy t' ht' => ?_) k le_rfl + simpa [Code.size, show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega] + using hcont y hy t' (by omega) + | @branch_neg cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + intro t ht + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, x⟩) hbr] + simp only [hc, ↓reduceIte, pure_bind] + refine ih hp.cons_tail.append_left (T_hor := k) (fun y hy t' ht' => ?_) k le_rfl + cases t' with + | zero => simp [evalRand] + | succ k' => + rw [evalRand, runRand_succ, stepRand_jump (s := ⟨pc + 1 + neg.size, y⟩) hj, pure_bind] + simpa [evalRand, Code.size, + show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + using hcont y hy k' (by omega) + | @loop_geometric cond body I Q μ_body T_body B_body p_exit x + hp_pos hp_top _ _ hinv hp_exit hx_inv ih_body => + have hj_exit : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj_back : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + have hmain : ∀ n ≤ T_hor, ∀ z : Data r, LoopStateInv cond I Q z → + (∀ y ∈ (loopExitPMF cond μ_body z).support, ∀ t ≤ T_hor, + evalRand w p t ⟨pc + (Code.loop cond body).size, y⟩ .faulted = 0) → + evalRand w p n ⟨pc, z⟩ .faulted = 0 := by + intro n + induction n using Nat.strong_induction_on with + | _ n ihn => + intro hn z hz_inv hcont_z + cases n with + | zero => simp [evalRand] + | succ k => + rcases hz_inv with ⟨hcz, hIz⟩ | ⟨hcz, _⟩ + · rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp only [hcz, ↓reduceIte, pure_bind] + refine ih_body z hIz hcz hbody_contains (T_hor := k) (fun u hu t' ht' => ?_) k le_rfl + cases t' with + | zero => simp [evalRand] + | succ k' => + rw [evalRand, runRand_succ, stepRand_jump (s := ⟨pc + 2 + body.size, u⟩) hj_back, + pure_bind] + refine ihn k' (by omega) (by omega) u (hinv z hIz hcz u hu) fun y hy t'' ht'' => ?_ + apply hcont_z y _ t'' ht'' + rw [loopExitPMF_of_holds hp_pos hp_top hinv hp_exit hIz hcz, PMF.mem_support_bind_iff] + exact ⟨u, hu, hy⟩ + · rw [evalRand, runRand_succ, stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp only [hcz, ↓reduceIte, pure_bind] + cases k with + | zero => simp + | succ k' => + rw [runRand_succ, stepRand_jump (s := ⟨pc + 1, z⟩) hj_exit, pure_bind] + have hz_mem : z ∈ (loopExitPMF cond μ_body z).support := by + simp [loopExitPMF_of_not_holds hcz] + simpa [evalRand, Code.size, show pc + body.size + 3 = pc + (body.size + 3) by omega] + using hcont_z z hz_mem k' (by omega) + intro t ht + exact hmain t ht x hx_inv hcont + +/-- If every continuation from `⟨pc + c.size, y⟩` (`y ∈ μ.support`) is fault-free at all horizons, +then running `p` from `⟨pc, x⟩` is fault-free at all horizons. -/ +theorem randFaultFree_assemble (h : ExecCodeDist w c x μ T) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) + (hcont : ∀ y ∈ μ.support, RandFaultFree w p ⟨pc + c.size, y⟩) : + RandFaultFree w p ⟨pc, x⟩ := by + intro T_hor + rw [← support_evalRand, ← PMF.apply_eq_zero_iff] + exact h.evalRand_faulted_eq_zero hp + (fun y hy t _ => (hcont y hy).evalRand_faulted_eq_zero t) + T_hor le_rfl + +/-- Along `ExecCodeDist w c x μ T`, the `μ`-weighted supremum halting probability from +`⟨pc + c.size, y⟩` is a lower bound on the supremum halting probability from `⟨pc, x⟩`. -/ +theorem le_iSup_evalRand_halted (h : ExecCodeDist w c x μ T) {p : Program B r} {pc : ℕ} + (hp : p.Contains pc (c.assemble pc)) (v : ℕ) (d : Data r) : + (∑' y, μ y * ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc + c.size, y⟩ (.halted v d)) ≤ + ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc, x⟩ (.halted v d) := by + induction h generalizing pc with + | @of_execRand c x m hm => + refine (le_of_eq ?_).trans (hm.le_iSup_evalRand_halted hp v d) + exact ProbComp.expect_map Prod.fst m + (fun y => ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc + c.size, y⟩ (.halted v d)) + | mono _ _ ih => exact ih hp + | @seq c₁ c₂ x μ₁ μ₂ T₁ T₂ _ _ ih₁ ih₂ => + have hc₂ : p.Contains (pc + c₁.size) (c₂.assemble (pc + c₁.size)) := by + simpa [Code.length_assemble] using hp.append_right + have hbind : + (∑' y, (μ₁.bind μ₂) y * + ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc + (c₁.seq c₂).size, y⟩ (.halted v d)) = + ∑' y₁, μ₁ y₁ * ∑' y, (μ₂ y₁) y * + ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc + c₁.size + c₂.size, y⟩ (.halted v d) := by + simp only [Code.size, Nat.add_assoc] + exact Cslib.Probability.PMF.tsum_bind_mul μ₁ μ₂ _ + rw [hbind] + refine (tsum_le_tsum fun y₁ => ?_).trans (ih₁ hp.append_left) + by_cases hy₁ : y₁ ∈ μ₁.support + · exact mul_le_mul_right (ih₂ y₁ hy₁ hc₂) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hy₁, zero_mul, zero_mul] + | @branch_pos cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hc' := (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).cons_tail + rw [Code.length_assemble, show pc + 1 + neg.size + 1 = pc + neg.size + 2 by omega] at hc' + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + neg.size + 2, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + refine (le_of_eq ?_).trans ((ih hc').trans (iSup_evalRand_halted_le_of_step hstep v d)) + refine tsum_congr fun y => ?_ + simp [Code.size, show pc + neg.size + 2 + pos.size = pc + (neg.size + pos.size + 2) by omega] + | @branch_neg cond pos neg x μ T hc _ ih => + have hbr : p[pc]? = some (.branch cond (pc + neg.size + 2)) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hp.head + have hj : p[pc + 1 + neg.size]? = some (.jump (pc + neg.size + pos.size + 2)) := by + simpa using (hp.cons_tail.append_right (q₁ := neg.assemble (pc + 1))).head + have hstep : stepRand w p (.running ⟨pc, x⟩) = pure (.running ⟨pc + 1, x⟩) := by + rw [stepRand_branch (s := ⟨pc, x⟩) hbr] + simp [hc] + refine (tsum_le_tsum fun y => mul_le_mul_right ?_ _).trans + ((ih hp.cons_tail.append_left).trans (iSup_evalRand_halted_le_of_step hstep v d)) + simpa [Code.size, show pc + neg.size + pos.size + 2 = pc + (neg.size + pos.size + 2) by omega] + using iSup_evalRand_halted_le_of_step + (stepRand_jump (s := ⟨pc + 1 + neg.size, y⟩) hj) v d + | @loop_geometric cond body I Q μ_body T_body B_body p_exit x + hp_pos hp_top _ _ hinv hp_exit hx_inv ih_body => + have hj_exit : p[pc + 1]? = some (.jump (pc + body.size + 3)) := hp.cons_tail.head + have hbody_contains : p.Contains (pc + 2) (body.assemble (pc + 2)) := by + simpa [Nat.add_assoc] using hp.cons_tail.cons_tail.append_left + have hj_back : p[pc + 2 + body.size]? = some (.jump pc) := by + simpa using hp.cons_tail.cons_tail.append_right.head + set H_loop : Data r → ℝ≥0∞ := fun z => ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc, z⟩ (.halted v d) + set H_exit : Data r → ℝ≥0∞ := fun z => + ⨆ T_hor : ℕ, evalRand w p T_hor ⟨pc + (Code.loop cond body).size, z⟩ (.halted v d) + have hexit_le : ∀ z : Data r, ¬cond.Holds z → H_exit z ≤ H_loop z := by + intro z hcz + have hbr : stepRand w p (.running ⟨pc, z⟩) = pure (.running ⟨pc + 1, z⟩) := by + rw [stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp [hcz] + simpa [H_exit, H_loop, Code.size, show pc + body.size + 3 = pc + (body.size + 3) by omega] + using (iSup_evalRand_halted_le_of_step + (stepRand_jump (s := ⟨pc + 1, z⟩) hj_exit) v d).trans + (iSup_evalRand_halted_le_of_step hbr v d) + have hstep_le : ∀ z : Data r, I z → cond.Holds z → + (∑' u, μ_body z u * H_loop u) ≤ H_loop z := by + intro z hIz hcz + have hbr : stepRand w p (.running ⟨pc, z⟩) = pure (.running ⟨pc + 2, z⟩) := by + rw [stepRand_branch (s := ⟨pc, z⟩) hp.head] + simp [hcz] + refine (tsum_le_tsum fun u => mul_le_mul_right ?_ _).trans + ((ih_body z hIz hcz hbody_contains).trans (iSup_evalRand_halted_le_of_step hbr v d)) + exact iSup_evalRand_halted_le_of_step + (stepRand_jump (s := ⟨pc + 2 + body.size, u⟩) hj_back) v d + have hiter_le : ∀ K : ℕ, ∀ z : Data r, LoopStateInv cond I Q z → + (∑' y, loopIterPMF cond μ_body K z y * H_loop y) ≤ H_loop z := by + intro K + induction K with + | zero => + intro z _ + rw [tsum_eq_single z (fun y hy => by simp [loopIterPMF_zero, PMF.pure_apply, hy])] + simp [H_loop] + | succ K ihK => + intro z hz_inv + rcases hz_inv with ⟨hcz, hIz⟩ | ⟨hcz, _⟩ + · rw [loopIterPMF_succ, loopStepPMF_of_holds hcz] + have hbind : (∑' y, ((μ_body z).bind (loopIterPMF cond μ_body K)) y * H_loop y) = + ∑' u, μ_body z u * ∑' y, loopIterPMF cond μ_body K u y * H_loop y := + Cslib.Probability.PMF.tsum_bind_mul (μ_body z) (loopIterPMF cond μ_body K) H_loop + rw [hbind] + refine (tsum_le_tsum fun u => ?_).trans (hstep_le z hIz hcz) + by_cases hu : u ∈ (μ_body z).support + · exact mul_le_mul_right (ihK u (hinv z hIz hcz u hu)) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hu, zero_mul, zero_mul] + · rw [loopIterPMF_of_not_holds hcz, + tsum_eq_single z (fun y hy => by simp [PMF.pure_apply, hy])] + simp + have hrewrite_sum : + (∑' y, loopExitPMF cond μ_body x y * H_exit y) = + ⨆ K : ℕ, ∑' y, + Set.indicator {w' | ¬cond.Holds w'} (loopIterPMF cond μ_body K x) y * H_exit y := by + simp_rw [loopExitPMF_apply_of_hasSum + (hasSum_loopExitDensity hp_pos hp_top hinv hp_exit hx_inv), ENNReal.iSup_mul] + exact tsum_iSup_of_monotone fun y K₁ K₂ hK => + mul_le_mul_left (loopIterPMF_indicator_mono cond μ_body x y hK) (H_exit y) + rw [hrewrite_sum] + refine iSup_le fun K => (tsum_le_tsum fun y => ?_).trans (hiter_le K x hx_inv) + by_cases hcy : ¬cond.Holds y + · rw [Set.indicator_of_mem hcy] + exact mul_le_mul_right (hexit_le y hcy) _ + · simp [Set.indicator_of_notMem, hcy] + +/-- Compiling `ExecCodeDist w c x μ T` with `c.program out` yields: +1. `expectedTime w (c.program out) ⟨0, x⟩ ≤ T + 1`, +2. `RandFaultFree w (c.program out) ⟨0, x⟩`, +3. `AlmostSurelyHalts w (c.program out) ⟨0, x⟩` whenever `T ≠ ⊤`, and +4. for every `y : Data r`, + `μ y ≤ ⨆ T_hor : ℕ, evalRand w (c.program out) T_hor ⟨0, x⟩ (.halted (y.regs out) y)`. -/ +theorem program_halts (h : ExecCodeDist w c x μ T) (out : Fin r) : + expectedTime w (c.program out) ⟨0, x⟩ ≤ T + 1 ∧ + RandFaultFree w (c.program out) ⟨0, x⟩ ∧ + (T ≠ ⊤ → AlmostSurelyHalts w (c.program out) ⟨0, x⟩) ∧ + ∀ y : Data r, + μ y ≤ ⨆ T_hor : ℕ, evalRand w (c.program out) T_hor ⟨0, x⟩ (.halted (y.regs out) y) := by + have hp : (c.program out).Contains 0 (c.assemble 0) := + (Program.Contains.self (c.program out)).append_left + have hhalt : (c.program out)[0 + c.size]? = some (.halt out) := by + simp [Code.program] + have hexp : expectedTime w (c.program out) ⟨0, x⟩ ≤ T + 1 := by + rw [expectedTime_eq_expectedStepsFrom] + refine (h.expectedStepsFrom_le (k := fun _ => 1) hp fun y _ => ?_).trans ?_ + · rw [expectedStepsFrom_running, stepRand_halt (s := ⟨0 + c.size, y⟩) hhalt, + ProbComp.expect_pure, expectedStepsFrom_halted, add_zero] + · simp [μ.tsum_coe] + have hff : RandFaultFree w (c.program out) ⟨0, x⟩ := by + refine h.randFaultFree_assemble hp fun y _ t => ?_ + rw [← support_evalRand, ← PMF.apply_eq_zero_iff] + cases t with + | zero => simp [evalRand] + | succ k => + rw [evalRand, runRand_succ, stepRand_halt (s := ⟨0 + c.size, y⟩) hhalt, pure_bind, + runRand_halted] + simp [PMF.pure_apply] + refine ⟨hexp, hff, fun hT => ?_, fun y => ?_⟩ + · refine AlmostSurelyHalts.of_expectedTime_ne_top hff ?_ + exact ne_top_of_le_ne_top (ENNReal.add_ne_top.mpr ⟨hT, ENNReal.one_ne_top⟩) hexp + · have hle := h.le_iSup_evalRand_halted hp (y.regs out) y + refine (le_trans ?_ + (le_tsum + (f := fun z => μ z * + ⨆ T_hor : ℕ, evalRand w (c.program out) T_hor ⟨0 + c.size, z⟩ + (.halted (y.regs out) y)) y)).trans hle + have h1 : (1 : ℝ≥0∞) ≤ + ⨆ T_hor : ℕ, evalRand w (c.program out) T_hor ⟨0 + c.size, y⟩ (.halted (y.regs out) y) := by + refine le_iSup_of_le 1 ?_ + rw [evalRand, runRand_succ, stepRand_halt (s := ⟨0 + c.size, y⟩) hhalt, pure_bind, + runRand_zero, ProbComp.eval_pure, PMF.pure_apply_self] + simpa using mul_le_mul_right h1 (μ y) + +end ExecCodeDist + +/-- Geometric Las Vegas loop expected-step bound inside any flat program `p` containing +`(Code.loop cond body).assemble pc`. -/ +theorem expectedStepsFrom_loop_le_of_geometric {w : ℕ} {cond : Cond r} {body : Code B r} + (I Q : Data r → Prop) {μ_body : Data r → PMF (Data r)} {T_body : Data r → ℝ≥0∞} + {B_body p_exit : ℝ≥0∞} {x : Data r} + (hp_pos : 0 < p_exit) (hp_top : p_exit ≠ ⊤) + (hbody : ∀ z, I z → cond.Holds z → ExecCodeDist w body z (μ_body z) (T_body z)) + (hB : ∀ z, I z → cond.Holds z → T_body z ≤ B_body) + (hinv : ∀ z, I z → cond.Holds z → + ∀ y ∈ (μ_body z).support, LoopStateInv cond I Q y) + (hp_exit : ∀ z, I z → cond.Holds z → + p_exit ≤ (μ_body z).toOuterMeasure {y | ¬cond.Holds y}) + (hx_inv : LoopStateInv cond I Q x) + {p : Program B r} {pc : ℕ} (hp : p.Contains pc ((Code.loop cond body).assemble pc)) + {k : Data r → ℝ≥0∞} + (hk : ∀ y, ¬cond.Holds y → Q y → + expectedStepsFrom w p (.running ⟨pc + (Code.loop cond body).size, y⟩) ≤ k y) : + expectedStepsFrom w p (.running ⟨pc, x⟩) ≤ + ((B_body + 2) / p_exit + 2) + ∑' y, loopExitPMF cond μ_body x y * k y := by + have hloop := ExecCodeDist.loop_geometric I Q hp_pos hp_top hbody hB hinv hp_exit hx_inv + refine hloop.expectedStepsFrom_le hp fun y hy => ?_ + obtain ⟨⟨hcy, hQy⟩, _⟩ := mem_support_loopExitPMF hp_pos hp_top hinv hp_exit hx_inv hy + exact hk y hcy hQy + +end Cslib.WordRAM + +end diff --git a/Complexity/Computability/WordRAM/Randomized/Structured.lean b/Complexity/Computability/WordRAM/Randomized/Structured.lean index 1c63438b9..e037de1bd 100644 --- a/Complexity/Computability/WordRAM/Randomized/Structured.lean +++ b/Complexity/Computability/WordRAM/Randomized/Structured.lean @@ -305,16 +305,6 @@ section Rename variable {f : Fin r → Fin r'} -private theorem extend_comap_eq (hf : f.Injective) (x : Data r') : - (x.comap f).extend f x = x := by - ext j - · change Function.extend f (x.regs ∘ f) x.regs j = x.regs j - by_cases hj : ∃ i, f i = j - · obtain ⟨i, rfl⟩ := hj - exact hf.extend_apply _ _ i - · exact Function.extend_apply' _ _ _ hj - · rfl - private theorem extend_set_eq (hf : f.Injective) (y : Data r) (x : Data r') (i : Fin r) (v : ℕ) : (y.set i v).extend f x = (y.extend f x).set (f i) v := Data.ext (hf.extend_update _ _ _ _) rfl @@ -342,7 +332,7 @@ theorem ExecRand.rename (hf : f.Injective) {w : ℕ} {c : Code B r} {x : Data r' pure (x.set (f dst) k.val, 1)) := by rw [← bind_pure_comp, bind_assoc] refine congrArg (ProbComp.unifFin (x.regs (f src)) >>= ·) (funext fun k => ?_) - simp only [pure_bind, extend_set_eq hf, extend_comap_eq hf] + simp only [pure_bind, extend_set_eq hf, Data.extend_comap hf] simp only [Code.rename, Data.comap_regs] rw [heq] exact ExecRand.rand hfit' @@ -386,7 +376,7 @@ theorem ExecRand.rename (hf : f.Injective) {w : ℕ} {c : Code B r} {x : Data r' simpa only [Code.rename, Functor.map_map] using h' | @loop_exit cond body _ hc => subst hx - simpa only [Code.rename, map_pure, extend_comap_eq hf] using + simpa only [Code.rename, map_pure, Data.extend_comap hf] using ExecRand.loop_exit (body := body.rename f) (fun h => hc ((Cond.holds_rename _ _).1 h)) | @loop_iter cond body _ mb ml hc _ hl ihb ihl => subst hx diff --git a/Complexity/Computability/WordRAM/Randomized/Subroutine.lean b/Complexity/Computability/WordRAM/Randomized/Subroutine.lean new file mode 100644 index 000000000..6ec488459 --- /dev/null +++ b/Complexity/Computability/WordRAM/Randomized/Subroutine.lean @@ -0,0 +1,1027 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.WordRAM.Subroutine +public import Complexity.Computability.WordRAM.Randomized.Expected +import Complexity.Probability.PMF.Expect + +/-! +# Composable Randomized Word-RAM Data-Structure Subroutines + +This file extends the deterministic `Cslib.WordRAM.SubroutineDS` interface to **randomized data +structures and Las Vegas subroutines** on the Word-RAM — covering both structures initialized from a +random seed (such as universal hash tables, 2-choice hash tables, and cuckoo hash tables) and +structures whose operations make random choices via `Instr.rand` (such as treaps, skip lists, +reservoir samplers, or randomized rehashing); see [MitzenmacherUpfal2017], Sections 2.1, 2.3, and +2.4. + +## Core design + +A `Cslib.WordRAM.Randomized.SubroutineDS P D w base params s₀` couples machine execution with a +latent seed type `Seed : Type` and reference distribution `seedLaw : PMF Seed` up to a bounded +density factor `seedSlack : ℝ≥0∞`: + +1. **Seed-coupled representation (`rep θ s x`) and potential (`potential θ x`):** + - Data structures without a persistent random seed set `Seed := Unit`, `seedLaw := PMF.pure ()`, + and `seedSlack := 1` (in particular, `Cslib.WordRAM.SubroutineDS.toRandomized` embeds every + deterministic `Cslib.WordRAM.SubroutineDS` directly). + - Hash tables that resample their hash family on rare table-full events maintain a joint + distribution `ν : PMF (Seed × Data r_ds)` whose marginal on `Seed` satisfies + `(ν.map Prod.fst) θ ≤ seedSlack * seedLaw θ`. + +2. **Distributional execution (`ExecCodeDist`):** + - `setup_exec` and `step_exec` use `ExecCodeDist` from + `Complexity.Computability.WordRAM.Randomized.Expected`, which supports both bounded + randomized code (`ExecRand`) and unbounded almost-surely terminating Las Vegas `while` loops + (`ExecCodeDist.loop_geometric`). + +3. **Addition-only `ℝ≥0∞` amortized-in-expectation bound:** + - Every admissible operation `o : D.Op` from abstract state `s : D.State` and coupled state + distribution `ν : PMF (Seed × Data r_ds)` produces a transition kernel + `μ_step : Seed × Data r_ds → PMF (Seed × Data r_ds)` and expected step count + `T_step : Seed × Data r_ds → ℝ≥0∞` satisfying (for `Φ(p) := potential p.1 p.2`) + `∑' p, ν p * (T_step p + ∑' q, μ_step p q * Φ(q)) ≤ charge s o + ∑' p, ν p * Φ(p)`. + - Across any admissible finite operation sequence `ops : List D.Op`, `seq_expected_amortized` + telescopes these one-step bounds without `ℝ≥0∞` subtraction: + total expected step cost is at most `initTime + initPotential + D.totalCost charge s₀ ops`. + +The sequence theorems charge initialization and subroutine bodies for a fixed operation list. +`prepare` delivers each operation's arguments by a semantic register replacement; its encoding +and delivery, caller dispatch and a whole-client driver are not charged. Callers requiring native +argument preparation can use `call_rename`, whose `B_prep` explicitly charges the preparation +code. Compiling a standalone body adds the final halt separately via `ExecCodeDist.program_halts`. + +## Main definitions + +* `Cslib.WordRAM.Randomized.SubroutineDS`: reusable randomized Word-RAM subroutine certificate for + a deterministic specification `D : Stateful.Spec`. +* `Cslib.WordRAM.Randomized.SubroutineDS.ExecSteps`: multi-operation distributional execution trace + threading coupled state distributions and expected step costs across `ops : List D.Op`. +* `Cslib.WordRAM.SubroutineDS.toRandomized`: canonical embedding of any deterministic + `Cslib.WordRAM.SubroutineDS` into `Cslib.WordRAM.Randomized.SubroutineDS`. +* `Cslib.WordRAM.Randomized.SubroutineDS.mapSimulates`, `toStandard`: basis transport from + `Basis.exact` to `Basis.standard`. + +## Main results + +* `Cslib.WordRAM.Randomized.SubroutineDS.initFresh_exec`, `initFresh_rename`: expected-time + initialization on fresh zeroed memory. +* `Cslib.WordRAM.SubroutineCode.zeroFillCode_exec`, + `Cslib.WordRAM.Randomized.SubroutineDS.initClear_exec`, `initClear_rename`: + expected-time initialization on arbitrary dirty memory. +* `Cslib.WordRAM.Randomized.SubroutineDS.code_rename`, `call_rename`: inline subroutine invocation + on caller state space `Data r_caller` via register injection `f : Fin r_ds → Fin r_caller`. +* `Cslib.WordRAM.Randomized.SubroutineDS.frame_caller`, `frame_caller_dist`: preservation of `rep`, + `potential`, and the coupled `(Seed × Data r_caller)` distribution across arbitrary deterministic + or randomized caller steps that do not modify persistent DS registers (`P.input i = false`) or + `[base, base + space)`. +* `Cslib.WordRAM.Randomized.SubroutineDS.steps_expected_amortized`, `seq_expected_amortized`: + telescope theorems bounding initialization and expected body time across any admissible operation + sequence `ops : List D.Op`. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 17][CLRS2009] +* [M. Mitzenmacher and E. Upfal, *Probability and Computing: Randomization and Probabilistic + Techniques in Algorithms and Data Analysis*][MitzenmacherUpfal2017], Sections 2.1, 2.3, and 2.4. +-/ + +@[expose] public section + +namespace Cslib.WordRAM.Randomized + +open Cslib.WordRAM +open scoped ENNReal + +universe u v z + +/-- Unified standalone and inline subroutine specification/resource certificate for a randomized +Word-RAM data structure `P` realizing `D` at word width `w`, base address `base`, runtime +parameters `params`, and initial abstract state `s₀`. -/ +structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} + (P : SubroutineCode B r_ds k_init) (D : Stateful.Spec.{u, v, z}) + (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) : Type (max u v z 1) where + /-- Latent random seed type (use `Unit` when no persistent seed is needed). -/ + Seed : Type + /-- Reference distribution over latent seeds. -/ + seedLaw : PMF Seed + /-- Marginal density slack factor (`1` when the seed distribution is exact). -/ + seedSlack : ℝ≥0∞ := 1 + /-- The marginal density slack factor is finite. -/ + seedSlack_ne_top : seedSlack ≠ ⊤ := by simp + /-- Contiguous memory footprint length `[base, base + space)`. -/ + space : ℕ + /-- Worst-case instruction bound for `P.allocSpan`. -/ + spanTime : ℕ + /-- Expected instruction bound for `P.initSetup`. -/ + setupTime : ℝ≥0∞ + /-- Upper bound on initial concrete potential after initialization. -/ + initPotential : ℕ + /-- Amortized instruction charge per operation. -/ + charge : D.State → D.Op → ℕ + /-- Seed-indexed representation invariant linking `Seed`, `D.State`, and `Data r_ds`. -/ + rep : Seed → D.State → Data r_ds → Prop + /-- Seed-indexed nonnegative integer potential. -/ + potential : Seed → Data r_ds → ℕ + /-- Standalone register encoding for argument delivery. -/ + encode : D.Op → Fin r_ds → ℕ + /-- Partial argument-matching predicate for inline callers (refined by `encode`). -/ + argMatch : D.Op → (Fin r_ds → ℕ) → Prop + /-- Output decoder reading typed operation observations from final registers. -/ + decode : (o : D.Op) → (Fin r_ds → ℕ) → Option (D.Result o) + /-- Represented configurations are word-bounded. -/ + bounded : ∀ {θ s x}, rep θ s x → x.Bounded w + /-- For a fixed seed `θ`, concrete machine data determines at most one abstract state. -/ + rep_unique : ∀ {θ s₁ s₂ x}, rep θ s₁ x → rep θ s₂ x → s₁ = s₂ + /-- Standalone encoded arguments fit in `w`-bit words on admissible calls. -/ + arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (encode o i) + /-- Full standalone argument delivery satisfies `argMatch`. -/ + encode_matches : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), + argMatch o (fun i => if P.input i then encode o i else regs i) + /-- `rep` depends only on persistent registers (`P.input i = false`) and `[base, base + space)`. + -/ + rep_supported : ∀ {θ s x x'}, + (∀ i, P.input i = false → x'.regs i = x.regs i) → + (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → + x'.Bounded w → rep θ s x → rep θ s x' + /-- `potential` depends only on persistent registers and `[base, base + space)` under `rep`. -/ + potential_supported : ∀ {θ s x x'}, + (∀ i, P.input i = false → x'.regs i = x.regs i) → + (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → + rep θ s x → potential θ x' = potential θ x + /-- Distinctness of registers used by `zeroFillCode` relative to `baseReg` and `frontierReg`. -/ + clear_nodup : [P.curReg, P.zeroReg, P.oneReg, P.baseReg, P.frontierReg].Nodup + /-- Initialization parameter registers are not overwritten by `zeroFillCode`. -/ + params_not_clear : ∀ j, P.initParams j ∉ [P.curReg, P.zeroReg, P.oneReg] + /-- `P.incCur` increments `P.curReg` by `1` when `P.oneReg = 1` and the sum fits in `w` bits. -/ + incCur_eval : ∀ {x : Data r_ds}, x.regs P.oneReg = 1 → Fits w (x.regs P.curReg + 1) → + P.incCur.eval w x = some (x.set P.curReg (x.regs P.curReg + 1)) + /-- Execution of `P.allocSpan`: records `baseReg = base` and advances `frontierReg`. -/ + span_exec : ∀ {x : Data r_ds}, + x.Bounded w → x.regs P.frontierReg = base → (∀ j, x.regs (P.initParams j) = params j) → + ∃ x₁, ExecWithin w P.allocSpan x x₁ spanTime ∧ x₁.mem = x.mem ∧ + x₁.regs P.baseReg = base ∧ x₁.regs P.frontierReg = base + space ∧ + (∀ j, x₁.regs (P.initParams j) = params j) + /-- Execution of `P.initSetup` once `[base, base + space)` holds zeros, producing a coupled + distribution `ν₀ : PMF (Seed × Data r_ds)` whose seed marginal is bounded by + `seedSlack * seedLaw`. -/ + setup_exec : ∀ {x₁ : Data r_ds}, + x₁.Bounded w → x₁.regs P.baseReg = base → x₁.regs P.frontierReg = base + space → + (∀ j, x₁.regs (P.initParams j) = params j) → + (∀ a ∈ (Block.mk base space).footprint, x₁.mem a = 0) → + ∃ ν₀ : PMF (Seed × Data r_ds), + ExecCodeDist w P.initSetup x₁ (ν₀.map Prod.snd) setupTime ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ seedSlack * seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs P.frontierReg = base + space ∧ + rep p.1 s₀ p.2 ∧ + potential p.1 p.2 ≤ initPotential ∧ + Modifies (Block.mk base space).footprint x₁.mem p.2.mem + /-- Coupled one-step execution of `P.code` for any admissible operation `o` from abstract state + `s` and coupled state distribution `ν : PMF (Seed × Data r_ds)` with seed marginal bounded by + `seedSlack * seedLaw`: produces a transition kernel `μ_step` and expected step count `T_step` + preserving the seed-marginal bound, realizing `D.step s o`, modifying only `[base, base + space)`, + and satisfying the addition-only `ℝ≥0∞` amortized-in-expectation inequality. -/ + step_exec : ∀ {s : D.State} (o : D.Op) (ν : PMF (Seed × Data r_ds)), + D.valid s o → + (∀ θ, (ν.map Prod.fst) θ ≤ seedSlack * seedLaw θ) → + (∀ p ∈ ν.support, rep p.1 s p.2 ∧ argMatch o p.2.regs) → + ∃ (μ_step : Seed × Data r_ds → PMF (Seed × Data r_ds)) + (T_step : Seed × Data r_ds → ℝ≥0∞), + (∀ p ∈ ν.support, + ExecCodeDist w P.code p.2 ((μ_step p).map Prod.snd) (T_step p) ∧ + ∀ q ∈ (μ_step p).support, + decode o q.2.regs = some (D.step s o).2 ∧ + rep q.1 (D.step s o).1 q.2 ∧ + Modifies (Block.mk base space).footprint p.2.mem q.2.mem) ∧ + (∀ θ', ((ν.bind μ_step).map Prod.fst) θ' ≤ seedSlack * seedLaw θ') ∧ + (∑' p, ν p * (T_step p + ∑' q, μ_step p q * (potential q.1 q.2 : ℝ≥0∞))) ≤ + (charge s o : ℝ≥0∞) + ∑' p, ν p * (potential p.1 p.2 : ℝ≥0∞) + +end Cslib.WordRAM.Randomized + +namespace Cslib.WordRAM.SubroutineDS + +open scoped ENNReal + +universe u v z + +variable {B : Basis} {r_ds k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-- Canonical embedding of any deterministic `Cslib.WordRAM.SubroutineDS` certificate into +`Cslib.WordRAM.Randomized.SubroutineDS` (`Seed := Unit`, `seedLaw := PMF.pure ()`, +`seedSlack := 1`). -/ +noncomputable def toRandomized (C : SubroutineDS P D w base params s₀) : + Randomized.SubroutineDS P D w base params s₀ where + Seed := Unit + seedLaw := PMF.pure () + seedSlack := 1 + space := C.space + spanTime := C.spanTime + setupTime := C.setupTime + initPotential := C.initPotential + charge := C.charge + rep _ s x := C.rep s x + potential _ x := C.potential x + encode := C.encode + argMatch := C.argMatch + decode := C.decode + bounded := C.bounded + rep_unique := C.rep_unique + arguments_fit := C.arguments_fit + encode_matches := C.encode_matches + rep_supported := C.rep_supported + potential_supported := C.potential_supported + clear_nodup := C.clear_nodup + params_not_clear := C.params_not_clear + incCur_eval := C.incCur_eval + span_exec := C.span_exec + setup_exec hx₁ hb hfr hpar hz := by + obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz + refine ⟨PMF.pure ((), y), ?_, ?_, ?_⟩ + · simpa using ExecCodeDist.of_execWithin he + · intro θ + cases θ + simp + · intro p hp + rw [PMF.support_pure, Set.mem_singleton_iff] at hp + subst hp + exact ⟨hfr', hrep, hpot, hmod⟩ + step_exec {s} o ν hv _ hsupp := by + classical + let y : Unit × Data r_ds → Data r_ds := fun p => + if hp : C.rep s p.2 ∧ C.argMatch o p.2.regs then + Classical.choose (C.step_exec o hp.1 hv hp.2) + else p.2 + let n : Unit × Data r_ds → ℕ := fun p => + if hp : C.rep s p.2 ∧ C.argMatch o p.2.regs then + Classical.choose (Classical.choose_spec (C.step_exec o hp.1 hv hp.2)) + else 0 + refine ⟨fun p => PMF.pure ((), y p), fun p => (n p : ℝ≥0∞), ?_, ?_, ?_⟩ + · intro p hp_mem + have hp : C.rep s p.2 ∧ C.argMatch o p.2.regs := hsupp p hp_mem + have hspec := Classical.choose_spec (Classical.choose_spec (C.step_exec o hp.1 hv hp.2)) + rcases hspec with ⟨he, hdec, hrep', hmod, _⟩ + have hy_eq : y p = Classical.choose (C.step_exec o hp.1 hv hp.2) := by simp [y, hp] + have hn_eq : n p = + Classical.choose (Classical.choose_spec (C.step_exec o hp.1 hv hp.2)) := by simp [n, hp] + refine ⟨?_, ?_⟩ + · simpa [hy_eq, hn_eq] using ExecCodeDist.of_exec he + · intro q hq + rw [PMF.support_pure, Set.mem_singleton_iff] at hq + subst hq + simpa only [hy_eq] using ⟨hdec, hrep', hmod⟩ + · intro θ' + cases θ' + have hconst : ((ν.bind fun p => PMF.pure ((), y p)).map Prod.fst) () = 1 := by + rw [PMF.map_bind] + simp + simp [hconst] + · calc + (∑' p, ν p * ((n p : ℝ≥0∞) + ∑' q, PMF.pure ((), y p) q * (C.potential q.2 : ℝ≥0∞))) + ≤ ∑' p, ν p * ((C.charge s o : ℝ≥0∞) + (C.potential p.2 : ℝ≥0∞)) := by + refine tsum_le_tsum fun p => ?_ + by_cases hp_mem : p ∈ ν.support + · refine mul_le_mul_right ?_ _ + have hp : C.rep s p.2 ∧ C.argMatch o p.2.regs := hsupp p hp_mem + have hspec := + Classical.choose_spec (Classical.choose_spec (C.step_exec o hp.1 hv hp.2)) + rcases hspec with ⟨_, _, _, _, hpot⟩ + have hy_eq : y p = Classical.choose (C.step_exec o hp.1 hv hp.2) := by simp [y, hp] + have hn_eq : n p = + Classical.choose (Classical.choose_spec (C.step_exec o hp.1 hv hp.2)) := by + simp [n, hp] + rw [tsum_eq_single ((), y p) (fun q hq => by simp [PMF.pure_apply, hq])] + simp only [PMF.pure_apply_self, one_mul, hy_eq, hn_eq] + exact_mod_cast hpot + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp_mem, zero_mul, zero_mul] + _ = (C.charge s o : ℝ≥0∞) + ∑' p, ν p * (C.potential p.2 : ℝ≥0∞) := by + simp_rw [mul_add, tsum_add, ENNReal.tsum_mul_right, ν.tsum_coe, one_mul] + +end Cslib.WordRAM.SubroutineDS + +namespace Cslib.WordRAM.Randomized.SubroutineDS + +open Cslib.WordRAM +open scoped ENNReal + +universe u v z + +variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-- Total expected instruction bound for `P.initFresh`. -/ +def initTime (C : SubroutineDS P D w base params s₀) : ℝ≥0∞ := + (C.spanTime : ℝ≥0∞) + C.setupTime + +/-! ### Projection 1: Basis lifting (`mapSimulates`, `toStandard`) -/ + +/-- Lift a randomized `SubroutineDS` certificate along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) : + SubroutineDS (P.mapSimulates φ) D w base params s₀ where + Seed := C.Seed + seedLaw := C.seedLaw + seedSlack := C.seedSlack + seedSlack_ne_top := C.seedSlack_ne_top + space := C.space + spanTime := C.spanTime + setupTime := C.setupTime + initPotential := C.initPotential + charge := C.charge + rep := C.rep + potential := C.potential + encode := C.encode + argMatch := C.argMatch + decode := C.decode + bounded := C.bounded + rep_unique := C.rep_unique + arguments_fit := C.arguments_fit + encode_matches := C.encode_matches + rep_supported := C.rep_supported + potential_supported := C.potential_supported + clear_nodup := C.clear_nodup + params_not_clear := C.params_not_clear + incCur_eval h1 hfit := Op.eval_mapSimulates_of_some φ (C.incCur_eval h1 hfit) + span_exec hx hf hp := + let ⟨x₁, he, hm, hb, hfr, hpar⟩ := C.span_exec hx hf hp + ⟨x₁, he.mapSimulates φ, hm, hb, hfr, hpar⟩ + setup_exec hx₁ hb hfr hpar hz := + let ⟨ν₀, he, hseed, hsupp⟩ := C.setup_exec hx₁ hb hfr hpar hz + ⟨ν₀, he.mapSimulates φ, hseed, hsupp⟩ + step_exec o ν hv hseed hsupp := + let ⟨μ_step, T_step, hstep, hseed', hamort⟩ := C.step_exec o ν hv hseed hsupp + ⟨μ_step, T_step, + fun p hp => ⟨(hstep p hp).1.mapSimulates φ, (hstep p hp).2⟩, + hseed', hamort⟩ + +/-- Lift an exact-basis randomized `SubroutineDS` certificate to `Basis.standard`. -/ +abbrev toStandard {P : SubroutineCode .exact r_ds k_init} + (C : SubroutineDS P D w base params s₀) : + SubroutineDS P.toStandard D w base params s₀ := + C.mapSimulates .exactStandard + +/-! ### Projection 2: Fresh initialization and register relocation (`initFresh_exec`, +`initFresh_rename`) -/ + +/-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` expected +instructions. -/ +theorem initFresh_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ ν₀ : PMF (C.Seed × Data r_ds), + ExecCodeDist w P.initFresh x (ν₀.map Prod.snd) C.initTime ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs P.frontierReg = base + C.space ∧ + C.rep p.1 s₀ p.2 ∧ + C.potential p.1 p.2 ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem p.2.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + have hx₁ : x₁.Bounded w := he₁.bounded hx + have hz₁ : ∀ a ∈ (Block.mk base C.space).footprint, x₁.mem a = 0 := by + intro a ha + rw [hm₁] + exact hz a ha + obtain ⟨ν₀, he₂, hseed, hsupp⟩ := C.setup_exec hx₁ hb₁ hfr₁ hpar₁ hz₁ + rw [hm₁] at hsupp + exact ⟨ν₀, (ExecCodeDist.of_execWithin he₁).seq_pure he₂, hseed, hsupp⟩ + +private theorem init_rename_of_exec (C : SubroutineDS P D w base params s₀) + {c : Code B r_ds} {T : ℝ≥0∞} {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {x : Data r_caller} + (hex : ∃ ν₀ : PMF (C.Seed × Data r_ds), + ExecCodeDist w c (x.comap f) (ν₀.map Prod.snd) T ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs P.frontierReg = base + C.space ∧ + C.rep p.1 s₀ p.2 ∧ + C.potential p.1 p.2 ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint (x.comap f).mem p.2.mem) : + ∃ ν₀ : PMF (C.Seed × Data r_caller), + ExecCodeDist w (c.rename f) x (ν₀.map Prod.snd) T ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs (f P.frontierReg) = base + C.space ∧ + C.rep p.1 s₀ (p.2.comap f) ∧ + C.potential p.1 (p.2.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem p.2.mem ∧ + (∀ j ∉ Set.range f, p.2.regs j = x.regs j) := by + obtain ⟨ν₀, he, hseed, hsupp⟩ := hex + refine ⟨ν₀.map fun p => (p.1, p.2.extend f x), ?_, ?_, ?_⟩ + · have he' := he.rename hf + refine he'.congr_dist ?_ le_rfl + rw [PMF.map_comp, PMF.map_comp] + rfl + · intro θ + rw [PMF.map_comp] + exact hseed θ + · intro q hq + rw [PMF.mem_support_map_iff] at hq + obtain ⟨p, hp, rfl⟩ := hq + obtain ⟨hfr', hrep, hpot, hmod⟩ := hsupp p hp + refine ⟨?_, ?_, ?_, hmod, fun j hj => Data.extend_regs_of_notMem p.2 x hj⟩ + · change ((p.2.extend f x).comap f).regs P.frontierReg = base + C.space + rw [Data.comap_extend hf] + exact hfr' + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-- Relocated fresh initialization along any injective register embedding `f`. -/ +theorem initFresh_rename (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ ν₀ : PMF (C.Seed × Data r_caller), + ExecCodeDist w (P.initFresh.rename f) x (ν₀.map Prod.snd) C.initTime ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs (f P.frontierReg) = base + C.space ∧ + C.rep p.1 s₀ (p.2.comap f) ∧ + C.potential p.1 (p.2.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem p.2.mem ∧ + (∀ j ∉ Set.range f, p.2.regs j = x.regs j) := + C.init_rename_of_exec hf (C.initFresh_exec hx hfr hpar hz) + +/-! ### Projection 3: Generic `O(space)` dirty-memory initialization (`zeroFillCode_exec`, +`initClear_exec`, `initClear_rename`) -/ + +/-- Execute `P.initClear` on **arbitrary dirty memory** in +`C.initTime + (4 * C.space + 6 : ℕ)` expected instructions. -/ +theorem initClear_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) : + ∃ ν₀ : PMF (C.Seed × Data r_ds), + ExecCodeDist w P.initClear x (ν₀.map Prod.snd) + (C.initTime + (4 * C.space + 6 : ℕ)) ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs P.frontierReg = base + C.space ∧ + C.rep p.1 s₀ p.2 ∧ + C.potential p.1 p.2 ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem p.2.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := + P.zeroFillCode_exec C.clear_nodup C.params_not_clear C.incCur_eval + (he₁.bounded hx) hb₁ hfr₁ hpar₁ + obtain ⟨ν₀, he₃, hseed, hsupp⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ + rw [hm₁] at hmod₂ + have he_clear : ExecCodeDist w P.initClear x (ν₀.map Prod.snd) + ((C.spanTime : ℝ≥0∞) + ((4 * C.space + 6 : ℕ) + C.setupTime)) := + (ExecCodeDist.of_execWithin he₁).seq_pure ((ExecCodeDist.of_execWithin he₂).seq_pure he₃) + refine ⟨ν₀, he_clear.mono ?_, hseed, fun p hp => ?_⟩ + · unfold initTime + exact le_of_eq (by ac_rfl) + · obtain ⟨hfr₃, hrep, hpot, hmod₃⟩ := hsupp p hp + have hmod : Modifies (Block.mk base C.space).footprint x.mem p.2.mem := by + simpa only [Finset.union_idempotent] using hmod₂.trans hmod₃ + exact ⟨hfr₃, hrep, hpot, hmod⟩ + +/-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ +theorem initClear_rename (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : + ∃ ν₀ : PMF (C.Seed × Data r_caller), + ExecCodeDist w (P.initClear.rename f) x (ν₀.map Prod.snd) + (C.initTime + (4 * C.space + 6 : ℕ)) ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs (f P.frontierReg) = base + C.space ∧ + C.rep p.1 s₀ (p.2.comap f) ∧ + C.potential p.1 (p.2.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem p.2.mem ∧ + (∀ j ∉ Set.range f, p.2.regs j = x.regs j) := + C.init_rename_of_exec hf (C.initClear_exec hx hfr hpar) + +/-! ### Projection 4: Caller-to-DS bidirectional framing (`frame_caller`, `frame_caller_dist`) -/ + +/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS +registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from +`[base, base + C.space)` preserves both `C.rep θ s (x'.comap f)` and +`C.potential θ (x'.comap f)`. -/ +theorem frame_caller (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} {θ : C.Seed} {s : D.State} {x x' : Data r_caller} + {F : Finset ℕ} + (hr : C.rep θ s (x.comap f)) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hdisj : Disjoint (Block.mk base C.space).footprint F) + (hmem : Modifies F x.mem x'.mem) : + C.rep θ s (x'.comap f) ∧ C.potential θ (x'.comap f) = C.potential θ (x.comap f) := by + have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => + hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) + exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ + +/-- Coupled caller distribution after a caller transition kernel `μ_caller` that does not resample +the DS seed `θ`. -/ +noncomputable def frameDist (C : SubroutineDS P D w base params s₀) + (ν : PMF (C.Seed × Data r_caller)) + (μ_caller : C.Seed × Data r_caller → PMF (Data r_caller)) : + PMF (C.Seed × Data r_caller) := + ν.bind fun p => (μ_caller p).map fun x' => (p.1, x') + +@[simp] +theorem frameDist_map_fst (C : SubroutineDS P D w base params s₀) + (ν : PMF (C.Seed × Data r_caller)) + (μ_caller : C.Seed × Data r_caller → PMF (Data r_caller)) : + (C.frameDist ν μ_caller).map Prod.fst = ν.map Prod.fst := by + unfold frameDist + rw [PMF.map_bind, PMF.map] + refine congrArg (ν.bind ·) (funext fun p => ?_) + ext θ + rw [PMF.map_comp] + simp + +/-- Distributional caller framing: any deterministic or randomized caller transition kernel +`μ_caller` (including caller steps that execute `Instr.rand`) that preserves +`(x'.comap f).Bounded w`, leaves persistent DS registers (`P.input i = false`) unchanged, and +writes only to a set `F` disjoint from `[base, base + C.space)` preserves the coupled seed +marginal bound, `C.rep`, and expected potential under `C.frameDist ν μ_caller`. -/ +theorem frame_caller_dist (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} {s : D.State} + {ν : PMF (C.Seed × Data r_caller)} + {μ_caller : C.Seed × Data r_caller → PMF (Data r_caller)} + {F : Finset ℕ} + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) + (hrep : ∀ p ∈ ν.support, C.rep p.1 s (p.2.comap f)) + (hdisj : Disjoint (Block.mk base C.space).footprint F) + (hframe : ∀ p ∈ ν.support, ∀ x' ∈ (μ_caller p).support, + (x'.comap f).Bounded w ∧ + (∀ i, P.input i = false → x'.regs (f i) = p.2.regs (f i)) ∧ + Modifies F p.2.mem x'.mem) : + (∀ θ, ((C.frameDist ν μ_caller).map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + (∀ q ∈ (C.frameDist ν μ_caller).support, C.rep q.1 s (q.2.comap f)) ∧ + (∑' q, C.frameDist ν μ_caller q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) = + ∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + refine ⟨fun θ => by rw [C.frameDist_map_fst]; exact hseed θ, ?_, ?_⟩ + · intro q hq + rw [frameDist, PMF.mem_support_bind_iff] at hq + obtain ⟨p, hp, hq_map⟩ := hq + rw [PMF.mem_support_map_iff] at hq_map + obtain ⟨x', hx', rfl⟩ := hq_map + obtain ⟨hb', hreg, hmem⟩ := hframe p hp x' hx' + exact (C.frame_caller (hrep p hp) hb' hreg hdisj hmem).1 + · rw [frameDist, Cslib.Probability.PMF.tsum_bind_mul] + refine tsum_congr fun p => ?_ + by_cases hp : p ∈ ν.support + · rw [Cslib.Probability.PMF.tsum_map_mul] + have hpot_eq : (∑' x', μ_caller p x' * (C.potential p.1 (x'.comap f) : ℝ≥0∞)) = + ∑' x', μ_caller p x' * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + refine tsum_congr fun x' => ?_ + by_cases hx' : x' ∈ (μ_caller p).support + · obtain ⟨hb', hreg, hmem⟩ := hframe p hp x' hx' + rw [(C.frame_caller (hrep p hp) hb' hreg hdisj hmem).2] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hx', zero_mul, zero_mul] + rw [hpot_eq, ENNReal.tsum_mul_right, (μ_caller p).tsum_coe, one_mul] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp, zero_mul, zero_mul] + +/-! ### Projection 5: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ + +/-- Execute `P.code.rename f` inline when arguments already match `(p.2.comap f).regs` on the +support of a coupled caller distribution `ν : PMF (C.Seed × Data r_caller)`. -/ +theorem code_rename (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} (o : D.Op) (ν : PMF (C.Seed × Data r_caller)) + (hv : D.valid s o) + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) + (hsupp : ∀ p ∈ ν.support, C.rep p.1 s (p.2.comap f) ∧ C.argMatch o (p.2.comap f).regs) : + ∃ (μ_caller : C.Seed × Data r_caller → PMF (C.Seed × Data r_caller)) + (T_caller : C.Seed × Data r_caller → ℝ≥0∞), + (∀ p ∈ ν.support, + ExecCodeDist w (P.code.rename f) p.2 ((μ_caller p).map Prod.snd) (T_caller p) ∧ + ∀ q ∈ (μ_caller p).support, + C.decode o (q.2.comap f).regs = some (D.step s o).2 ∧ + C.rep q.1 (D.step s o).1 (q.2.comap f) ∧ + Modifies (Block.mk base C.space).footprint p.2.mem q.2.mem ∧ + (∀ j ∉ Set.range f, q.2.regs j = p.2.regs j)) ∧ + (∀ θ', ((ν.bind μ_caller).map Prod.fst) θ' ≤ C.seedSlack * C.seedLaw θ') ∧ + (∑' p, ν p * (T_caller p + ∑' q, μ_caller p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞))) ≤ + (C.charge s o : ℝ≥0∞) + ∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + let proj : C.Seed × Data r_caller → C.Seed × Data r_ds := fun p => (p.1, p.2.comap f) + let ν_ds : PMF (C.Seed × Data r_ds) := ν.map proj + have hseed_ds : ∀ θ, (ν_ds.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ := by + intro θ + rw [PMF.map_comp] + exact hseed θ + have hsupp_ds : ∀ p_ds ∈ ν_ds.support, C.rep p_ds.1 s p_ds.2 ∧ C.argMatch o p_ds.2.regs := by + intro p_ds hp_ds + rw [PMF.mem_support_map_iff] at hp_ds + obtain ⟨p, hp, rfl⟩ := hp_ds + exact hsupp p hp + obtain ⟨μ_ds, T_ds, hstep_ds, hseed_ds', hamort_ds⟩ := + C.step_exec o ν_ds hv hseed_ds hsupp_ds + let μ_caller : C.Seed × Data r_caller → PMF (C.Seed × Data r_caller) := + fun p => (μ_ds (proj p)).map fun q => (q.1, q.2.extend f p.2) + let T_caller : C.Seed × Data r_caller → ℝ≥0∞ := fun p => T_ds (proj p) + refine ⟨μ_caller, T_caller, ?_, ?_, ?_⟩ + · intro p hp + have hp_ds : proj p ∈ ν_ds.support := (PMF.mem_support_map_iff _ _ _).mpr ⟨p, hp, rfl⟩ + obtain ⟨he_ds, hq_ds⟩ := hstep_ds (proj p) hp_ds + refine ⟨?_, ?_⟩ + · have he_ren := he_ds.rename hf (x := p.2) + refine he_ren.congr_dist ?_ le_rfl + rw [PMF.map_comp, PMF.map_comp] + rfl + · intro q hq + rw [PMF.mem_support_map_iff] at hq + obtain ⟨q_ds, hq_mem, rfl⟩ := hq + obtain ⟨hdec, hrep', hmod⟩ := hq_ds q_ds hq_mem + refine ⟨?_, ?_, hmod, fun j hj => Data.extend_regs_of_notMem q_ds.2 p.2 hj⟩ + · rw [Data.comap_extend hf] + exact hdec + · rw [Data.comap_extend hf] + exact hrep' + · intro θ' + have hmap_eq : (ν.bind μ_caller).map Prod.fst = (ν_ds.bind μ_ds).map Prod.fst := by + rw [PMF.map_bind, PMF.map_bind, PMF.bind_map] + refine congrArg (ν.bind ·) (funext fun p => ?_) + rw [PMF.map_comp] + rfl + rw [hmap_eq] + exact hseed_ds' θ' + · have hPot_inner : ∀ p : C.Seed × Data r_caller, + (∑' q, μ_caller p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) = + ∑' q_ds, μ_ds (proj p) q_ds * (C.potential q_ds.1 q_ds.2 : ℝ≥0∞) := by + intro p + rw [Cslib.Probability.PMF.tsum_map_mul] + refine tsum_congr fun q_ds => ?_ + rw [Data.comap_extend hf] + simp_rw [hPot_inner] + have hLHS : + (∑' p, ν p * (T_caller p + + ∑' q_ds, μ_ds (proj p) q_ds * (C.potential q_ds.1 q_ds.2 : ℝ≥0∞))) = + ∑' p_ds, ν_ds p_ds * (T_ds p_ds + + ∑' q_ds, μ_ds p_ds q_ds * (C.potential q_ds.1 q_ds.2 : ℝ≥0∞)) := + (Cslib.Probability.PMF.tsum_map_mul ν proj fun p_ds => + T_ds p_ds + ∑' q_ds, μ_ds p_ds q_ds * (C.potential q_ds.1 q_ds.2 : ℝ≥0∞)).symm + have hRHS : + (∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞)) = + ∑' p_ds, ν_ds p_ds * (C.potential p_ds.1 p_ds.2 : ℝ≥0∞) := + (Cslib.Probability.PMF.tsum_map_mul ν proj + fun p_ds => (C.potential p_ds.1 p_ds.2 : ℝ≥0∞)).symm + rw [hLHS, hRHS] + exact hamort_ds + +/-- Execute `.seq prep (P.code.rename f)` inline after a (deterministic or randomized) caller +argument-preparation block `prep` that preserves persistent DS registers and memory in +`[base, base + C.space)`. -/ +theorem call_rename (C : SubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} {prep : Code B r_caller} {B_prep : ℝ≥0∞} + (o : D.Op) (ν : PMF (C.Seed × Data r_caller)) + {μ_prep : C.Seed × Data r_caller → PMF (Data r_caller)} + {T_prep : C.Seed × Data r_caller → ℝ≥0∞} + (hv : D.valid s o) + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) + (hrep : ∀ p ∈ ν.support, C.rep p.1 s (p.2.comap f)) + (hprep : ∀ p ∈ ν.support, + ExecCodeDist w prep p.2 (μ_prep p) (T_prep p) ∧ + T_prep p ≤ B_prep ∧ + ∀ x' ∈ (μ_prep p).support, + (x'.comap f).Bounded w ∧ + (∀ i, P.input i = false → x'.regs (f i) = p.2.regs (f i)) ∧ + (∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = p.2.mem a) ∧ + C.argMatch o (x'.comap f).regs) : + ∃ (μ_call : C.Seed × Data r_caller → PMF (C.Seed × Data r_caller)) + (T_call : C.Seed × Data r_caller → ℝ≥0∞), + (∀ p ∈ ν.support, + ExecCodeDist w (.seq prep (P.code.rename f)) p.2 ((μ_call p).map Prod.snd) (T_call p) ∧ + ∀ q ∈ (μ_call p).support, + C.decode o (q.2.comap f).regs = some (D.step s o).2 ∧ + C.rep q.1 (D.step s o).1 (q.2.comap f) ∧ + ∃ x' ∈ (μ_prep p).support, + Modifies (Block.mk base C.space).footprint x'.mem q.2.mem ∧ + ∀ j ∉ Set.range f, q.2.regs j = x'.regs j) ∧ + (∀ θ', ((ν.bind μ_call).map Prod.fst) θ' ≤ C.seedSlack * C.seedLaw θ') ∧ + (∑' p, ν p * (T_call p + ∑' q, μ_call p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞))) ≤ + B_prep + (C.charge s o : ℝ≥0∞) + ∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + let ν_prep := C.frameDist ν μ_prep + have hseed_prep : ∀ θ, (ν_prep.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ := by + intro θ + rw [C.frameDist_map_fst] + exact hseed θ + have hsupp_prep : ∀ p' ∈ ν_prep.support, + C.rep p'.1 s (p'.2.comap f) ∧ C.argMatch o (p'.2.comap f).regs := by + intro p' hp' + simp only [ν_prep, frameDist, PMF.mem_support_bind_iff] at hp' + obtain ⟨p, hp, hp_map⟩ := hp' + rw [PMF.mem_support_map_iff] at hp_map + obtain ⟨x', hx', rfl⟩ := hp_map + obtain ⟨_, _, hfr_x'⟩ := hprep p hp + obtain ⟨hb', hreg, hmem, harg⟩ := hfr_x' x' hx' + exact ⟨C.rep_supported (x := p.2.comap f) (x' := x'.comap f) hreg hmem hb' (hrep p hp), harg⟩ + obtain ⟨μ_code, T_code, hcode, hseed_code, hamort_code⟩ := + C.code_rename hf o ν_prep hv hseed_prep hsupp_prep + let μ_call : C.Seed × Data r_caller → PMF (C.Seed × Data r_caller) := + fun p => (μ_prep p).bind fun x' => μ_code (p.1, x') + let T_call : C.Seed × Data r_caller → ℝ≥0∞ := + fun p => T_prep p + ∑' x', μ_prep p x' * T_code (p.1, x') + refine ⟨μ_call, T_call, ?_, ?_, ?_⟩ + · intro p hp + obtain ⟨he_prep, _, hfr_x'⟩ := hprep p hp + have he_seq := he_prep.seq + (μ₂ := fun x' => (μ_code (p.1, x')).map Prod.snd) + (T₂ := fun x' => T_code (p.1, x')) + fun x' hx' => by + have hp' : (p.1, x') ∈ ν_prep.support := by + simp only [ν_prep, frameDist, PMF.mem_support_bind_iff] + exact ⟨p, hp, (PMF.mem_support_map_iff _ _ _).mpr ⟨x', hx', rfl⟩⟩ + exact (hcode (p.1, x') hp').1 + refine ⟨he_seq.congr_dist ?_ le_rfl, ?_⟩ + · simp only [μ_call, PMF.map_bind] + · intro q hq + rw [PMF.mem_support_bind_iff] at hq + obtain ⟨x', hx', hq_code⟩ := hq + have hp' : (p.1, x') ∈ ν_prep.support := by + simp only [ν_prep, frameDist, PMF.mem_support_bind_iff] + exact ⟨p, hp, (PMF.mem_support_map_iff _ _ _).mpr ⟨x', hx', rfl⟩⟩ + obtain ⟨hdec, hrep', hmod, hregs⟩ := (hcode (p.1, x') hp').2 q hq_code + exact ⟨hdec, hrep', x', hx', hmod, hregs⟩ + · intro θ' + have hbind_eq : ν.bind μ_call = ν_prep.bind μ_code := by + simp only [ν_prep, frameDist, μ_call, PMF.bind_bind, PMF.bind_map] + rfl + rw [hbind_eq] + exact hseed_code θ' + · have hpot_prep : + (∑' p', ν_prep p' * (C.potential p'.1 (p'.2.comap f) : ℝ≥0∞)) = + ∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + simp only [ν_prep, frameDist, Cslib.Probability.PMF.tsum_bind_mul] + refine tsum_congr fun p => ?_ + by_cases hp : p ∈ ν.support + · rw [Cslib.Probability.PMF.tsum_map_mul] + have hpot_eq : (∑' x', μ_prep p x' * (C.potential p.1 (x'.comap f) : ℝ≥0∞)) = + ∑' x', μ_prep p x' * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + refine tsum_congr fun x' => ?_ + by_cases hx' : x' ∈ (μ_prep p).support + · obtain ⟨_, _, hfr_x'⟩ := hprep p hp + obtain ⟨_, hreg, hmem, _⟩ := hfr_x' x' hx' + rw [C.potential_supported (x := p.2.comap f) (x' := x'.comap f) hreg hmem (hrep p hp)] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hx', zero_mul, zero_mul] + rw [hpot_eq, ENNReal.tsum_mul_right, (μ_prep p).tsum_coe, one_mul] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp, zero_mul, zero_mul] + have hdecomp : + (∑' p, ν p * (T_call p + ∑' q, μ_call p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞))) = + (∑' p, ν p * T_prep p) + + ∑' p', ν_prep p' * + (T_code p' + ∑' q, μ_code p' q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) := by + have hinner : ∀ p : C.Seed × Data r_caller, + T_call p + (∑' q, μ_call p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) = + T_prep p + ∑' x', μ_prep p x' * + (T_code (p.1, x') + + ∑' q, μ_code (p.1, x') q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) := by + intro p + simp only [T_call, μ_call, Cslib.Probability.PMF.tsum_bind_mul, add_assoc] + congr 1 + rw [← tsum_add] + simp_rw [mul_add] + have hmul : ∀ p : C.Seed × Data r_caller, + ν p * (T_call p + ∑' q, μ_call p q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) = + ν p * T_prep p + ν p * ∑' x', μ_prep p x' * + (T_code (p.1, x') + + ∑' q, μ_code (p.1, x') q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) := by + intro p + rw [hinner p, mul_add] + simp_rw [hmul] + rw [tsum_add] + congr 1 + symm + dsimp only [ν_prep, frameDist] + rw [Cslib.Probability.PMF.tsum_bind_mul] + refine tsum_congr fun p => ?_ + rw [Cslib.Probability.PMF.tsum_map_mul] + have hprep_le : (∑' p, ν p * T_prep p) ≤ B_prep := by + calc + (∑' p, ν p * T_prep p) + ≤ ∑' p, ν p * B_prep := by + refine tsum_le_tsum fun p => ?_ + by_cases hp : p ∈ ν.support + · exact mul_le_mul_right (hprep p hp).2.1 _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp, zero_mul, zero_mul] + _ = B_prep := by rw [ENNReal.tsum_mul_right, ν.tsum_coe, one_mul] + rw [hdecomp] + calc + (∑' p, ν p * T_prep p) + + ∑' p', ν_prep p' * + (T_code p' + ∑' q, μ_code p' q * (C.potential q.1 (q.2.comap f) : ℝ≥0∞)) + ≤ B_prep + ((C.charge s o : ℝ≥0∞) + + ∑' p', ν_prep p' * (C.potential p'.1 (p'.2.comap f) : ℝ≥0∞)) := + add_le_add hprep_le hamort_code + _ = B_prep + (C.charge s o : ℝ≥0∞) + + ∑' p, ν p * (C.potential p.1 (p.2.comap f) : ℝ≥0∞) := by + rw [hpot_prep, add_assoc] + +/-! ### Projection 6: End-to-end expected-amortized sequence telescope (`steps_expected_amortized`, +`seq_expected_amortized`) -/ + +/-- Reuse the signature-level program and argument-delivery API with the actual instruction basis. +This projection carries code and the calling convention, without a deterministic certificate. -/ +def toDynamicProgram (C : SubroutineDS P D w base params s₀) : DynamicProgram D r_ds B := + P.toDynamicProgram C.encode C.decode + +theorem prepare_rep (C : SubroutineDS P D w base params s₀) + {θ : C.Seed} {s : D.State} {o : D.Op} {x : Data r_ds} + (hr : C.rep θ s x) (hv : D.valid s o) : + C.rep θ s (C.toDynamicProgram.prepare o x) := + C.rep_supported + (fun _ hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) + (C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit _ hv)) + hr + +theorem prepare_potential (C : SubroutineDS P D w base params s₀) + {θ : C.Seed} {s : D.State} {o : D.Op} {x : Data r_ds} + (hr : C.rep θ s x) : + C.potential θ (C.toDynamicProgram.prepare o x) = C.potential θ x := + C.potential_supported + (fun _ hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) + hr + +theorem prepare_argMatch (C : SubroutineDS P D w base params s₀) (o : D.Op) (x : Data r_ds) : + C.argMatch o (C.toDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + +/-- Inductive multi-operation distributional execution relation for a randomized subroutine `C`. +`C.ExecSteps s ops ν ν_final T_ops` witnesses that starting from abstract state `s` and coupled +state distribution `ν : PMF (C.Seed × Data r_ds)`, executing each operation `o` in `ops` by +delivering arguments via `C.toDynamicProgram.prepare o` and running `P.code` under `ExecCodeDist` +produces the +final coupled distribution `ν_final`, decodes the exact abstract return value `(D.step s o).2` at +every step, modifies memory only within `[base, base + C.space)`, and incurs total expected +operation body cost `T_ops`. Argument delivery is an external register replacement and +contributes no native instructions to this relation. -/ +inductive ExecSteps (C : SubroutineDS P D w base params s₀) : + D.State → List D.Op → PMF (C.Seed × Data r_ds) → PMF (C.Seed × Data r_ds) → ℝ≥0∞ → Prop where + | nil (s : D.State) (ν : PMF (C.Seed × Data r_ds)) : + C.ExecSteps s [] ν ν 0 + | cons {s : D.State} {o : D.Op} {ops : List D.Op} + {ν ν_final : PMF (C.Seed × Data r_ds)} + {μ_step : C.Seed × Data r_ds → PMF (C.Seed × Data r_ds)} + {T_step : C.Seed × Data r_ds → ℝ≥0∞} {T_rest : ℝ≥0∞} : + (∀ p ∈ ν.support, + ExecCodeDist w P.code (C.toDynamicProgram.prepare o p.2) + ((μ_step p).map Prod.snd) (T_step p) ∧ + ∀ q ∈ (μ_step p).support, + C.decode o q.2.regs = some (D.step s o).2 ∧ + C.rep q.1 (D.step s o).1 q.2 ∧ + Modifies (Block.mk base C.space).footprint p.2.mem q.2.mem) → + C.ExecSteps (D.step s o).1 ops (ν.bind μ_step) ν_final T_rest → + C.ExecSteps s (o :: ops) ν ν_final ((∑' p, ν p * T_step p) + T_rest) + +/-- **Multi-operation expected-amortized telescope (`steps_expected_amortized`).** +From any abstract state `s : D.State` and coupled state distribution `ν : PMF (C.Seed × Data r_ds)` +satisfying the seed-marginal bound and `C.rep p.1 s p.2` on `ν.support`, executing any admissible +operation sequence `ops : List D.Op` (`D.ValidHistory s ops`) produces a final coupled distribution +`ν_final` and total expected operation step count `T_ops : ℝ≥0∞` witnessing +`C.ExecSteps s ops ν ν_final T_ops` and satisfying the addition-only `ℝ≥0∞` telescope inequality +(with `Φ(p) := C.potential p.1 p.2`) +`T_ops + ∑' q, ν_final q * Φ(q) ≤ D.totalCost C.charge s ops + ∑' p, ν p * Φ(p)`. -/ +theorem steps_expected_amortized (C : SubroutineDS P D w base params s₀) + {s : D.State} (ops : List D.Op) (ν : PMF (C.Seed × Data r_ds)) + (hv : D.ValidHistory s ops) + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) + (hrep : ∀ p ∈ ν.support, C.rep p.1 s p.2) : + ∃ (ν_final : PMF (C.Seed × Data r_ds)) (T_ops : ℝ≥0∞), + C.ExecSteps s ops ν ν_final T_ops ∧ + (∀ θ, (ν_final.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + (∀ p ∈ ν_final.support, C.rep p.1 (D.run s ops).1 p.2) ∧ + T_ops + (∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞)) ≤ + (D.totalCost C.charge s ops : ℝ≥0∞) + ∑' p, ν p * (C.potential p.1 p.2 : ℝ≥0∞) := by + induction ops generalizing s ν with + | nil => + exact ⟨ν, 0, ExecSteps.nil s ν, hseed, hrep, by simp⟩ + | cons o os ih => + obtain ⟨hvo, hvos⟩ := hv + let ν_prep : PMF (C.Seed × Data r_ds) := ν.map fun p => (p.1, C.toDynamicProgram.prepare o p.2) + have hseed_prep : ∀ θ, (ν_prep.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ := by + intro θ + rw [PMF.map_comp] + exact hseed θ + have hsupp_prep : ∀ p' ∈ ν_prep.support, C.rep p'.1 s p'.2 ∧ C.argMatch o p'.2.regs := by + intro p' hp' + rw [PMF.mem_support_map_iff] at hp' + obtain ⟨p, hp, rfl⟩ := hp' + exact ⟨C.prepare_rep (hrep p hp) hvo, C.prepare_argMatch o p.2⟩ + have hpot_prep : + (∑' p', ν_prep p' * (C.potential p'.1 p'.2 : ℝ≥0∞)) = + ∑' p, ν p * (C.potential p.1 p.2 : ℝ≥0∞) := by + rw [Cslib.Probability.PMF.tsum_map_mul] + refine tsum_congr fun p => ?_ + by_cases hp : p ∈ ν.support + · rw [C.prepare_potential (hrep p hp)] + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp, zero_mul, zero_mul] + obtain ⟨μ_step, T_step, hstep, hseed₁, hamort₁⟩ := + C.step_exec o ν_prep hvo hseed_prep hsupp_prep + let μ_op : C.Seed × Data r_ds → PMF (C.Seed × Data r_ds) := + fun p => μ_step (p.1, C.toDynamicProgram.prepare o p.2) + let T_op : C.Seed × Data r_ds → ℝ≥0∞ := + fun p => T_step (p.1, C.toDynamicProgram.prepare o p.2) + let ν₁ := ν.bind μ_op + have hν₁_eq : ν₁ = ν_prep.bind μ_step := by + simp only [ν₁, ν_prep, μ_op, PMF.bind_map] + rfl + have hseed₁' : ∀ θ, (ν₁.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ := by + rw [hν₁_eq] + exact hseed₁ + have hrep₁ : ∀ q ∈ ν₁.support, C.rep q.1 (D.step s o).1 q.2 := by + intro q hq + rw [hν₁_eq, PMF.mem_support_bind_iff] at hq + obtain ⟨p', hp', hq_step⟩ := hq + exact ((hstep p' hp').2 q hq_step).2.1 + obtain ⟨ν_final, T_rest, hex_rest, hseed_final, hrep_final, hamort_rest⟩ := + ih ν₁ hvos hseed₁' hrep₁ + let T₁ : ℝ≥0∞ := ∑' p, ν p * T_op p + have hT₁_eq : T₁ = ∑' p', ν_prep p' * T_step p' := by + symm + exact Cslib.Probability.PMF.tsum_map_mul ν + (fun p => (p.1, C.toDynamicProgram.prepare o p.2)) T_step + have hex_cons : C.ExecSteps s (o :: os) ν ν_final (T₁ + T_rest) := by + refine ExecSteps.cons (μ_step := μ_op) (T_step := T_op) (fun p hp => ?_) hex_rest + have hp' : (p.1, C.toDynamicProgram.prepare o p.2) ∈ ν_prep.support := + (PMF.mem_support_map_iff _ _ _).mpr ⟨p, hp, rfl⟩ + exact hstep (p.1, C.toDynamicProgram.prepare o p.2) hp' + have hstep_split : + T₁ + (∑' q, ν₁ q * (C.potential q.1 q.2 : ℝ≥0∞)) = + ∑' p', ν_prep p' * (T_step p' + ∑' q, μ_step p' q * (C.potential q.1 q.2 : ℝ≥0∞)) := by + rw [hT₁_eq, hν₁_eq] + simp only [Cslib.Probability.PMF.tsum_bind_mul, ← tsum_add, mul_add] + refine ⟨ν_final, T₁ + T_rest, hex_cons, hseed_final, hrep_final, ?_⟩ + calc + (T₁ + T_rest) + ∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞) + = T₁ + (T_rest + ∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞)) := by ac_rfl + _ ≤ T₁ + ((D.totalCost C.charge (D.step s o).1 os : ℝ≥0∞) + + ∑' q, ν₁ q * (C.potential q.1 q.2 : ℝ≥0∞)) := + add_le_add le_rfl hamort_rest + _ = (D.totalCost C.charge (D.step s o).1 os : ℝ≥0∞) + + (T₁ + ∑' q, ν₁ q * (C.potential q.1 q.2 : ℝ≥0∞)) := by ac_rfl + _ ≤ (D.totalCost C.charge (D.step s o).1 os : ℝ≥0∞) + + ((C.charge s o : ℝ≥0∞) + ∑' p, ν p * (C.potential p.1 p.2 : ℝ≥0∞)) := by + rw [hstep_split, ← hpot_prep] + exact add_le_add le_rfl hamort₁ + _ = (D.totalCost C.charge s (o :: os) : ℝ≥0∞) + + ∑' p, ν p * (C.potential p.1 p.2 : ℝ≥0∞) := by + simp only [Stateful.Spec.totalCost_cons, Nat.cast_add] + ac_rfl + +/-- **End-to-end expected-amortized theorem from fresh initialization (`seq_expected_amortized`).** +Starting from zeroed `[base, base + C.space)`, `P.initFresh` followed by any admissible operation +sequence `ops : List D.Op` (`D.ValidHistory s₀ ops`) has total expected instruction cost +`C.initTime + T_ops` bounded by +`C.initTime + C.initPotential + D.totalCost C.charge s₀ ops`. -/ +theorem seq_expected_amortized (C : SubroutineDS P D w base params s₀) + {x : Data r_ds} (ops : List D.Op) + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) + (hv : D.ValidHistory s₀ ops) : + ∃ (ν₀ ν_final : PMF (C.Seed × Data r_ds)) (T_ops : ℝ≥0∞), + ExecCodeDist w P.initFresh x (ν₀.map Prod.snd) C.initTime ∧ + C.ExecSteps s₀ ops ν₀ ν_final T_ops ∧ + (∀ θ, (ν_final.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + (∀ p ∈ ν_final.support, C.rep p.1 (D.run s₀ ops).1 p.2) ∧ + C.initTime + T_ops + (∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞)) ≤ + C.initTime + (C.initPotential : ℝ≥0∞) + (D.totalCost C.charge s₀ ops : ℝ≥0∞) := by + obtain ⟨ν₀, he_init, hseed₀, hsupp₀⟩ := C.initFresh_exec hx hfr hpar hz + have hrep₀ : ∀ p ∈ ν₀.support, C.rep p.1 s₀ p.2 := fun p hp => (hsupp₀ p hp).2.1 + obtain ⟨ν_final, T_ops, hex_steps, hseed_final, hrep_final, hamort⟩ := + C.steps_expected_amortized ops ν₀ hv hseed₀ hrep₀ + have hpot₀ : (∑' p, ν₀ p * (C.potential p.1 p.2 : ℝ≥0∞)) ≤ (C.initPotential : ℝ≥0∞) := by + calc + (∑' p, ν₀ p * (C.potential p.1 p.2 : ℝ≥0∞)) + ≤ ∑' p, ν₀ p * (C.initPotential : ℝ≥0∞) := by + refine tsum_le_tsum fun p => ?_ + by_cases hp : p ∈ ν₀.support + · exact mul_le_mul_right (Nat.cast_le.mpr (hsupp₀ p hp).2.2.1) _ + · rw [(PMF.apply_eq_zero_iff _ _).mpr hp, zero_mul, zero_mul] + _ = (C.initPotential : ℝ≥0∞) := by + rw [ENNReal.tsum_mul_right, ν₀.tsum_coe, one_mul] + refine ⟨ν₀, ν_final, T_ops, he_init, hex_steps, hseed_final, hrep_final, ?_⟩ + calc + C.initTime + T_ops + ∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞) + = C.initTime + (T_ops + ∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞)) := by ac_rfl + _ ≤ C.initTime + ((D.totalCost C.charge s₀ ops : ℝ≥0∞) + + ∑' p, ν₀ p * (C.potential p.1 p.2 : ℝ≥0∞)) := + add_le_add le_rfl hamort + _ ≤ C.initTime + ((D.totalCost C.charge s₀ ops : ℝ≥0∞) + (C.initPotential : ℝ≥0∞)) := + add_le_add le_rfl (add_le_add le_rfl hpot₀) + _ = C.initTime + (C.initPotential : ℝ≥0∞) + (D.totalCost C.charge s₀ ops : ℝ≥0∞) := by ac_rfl + +end Cslib.WordRAM.Randomized.SubroutineDS + +end diff --git a/Complexity/Computability/WordRAM/RelSubroutine.lean b/Complexity/Computability/WordRAM/RelSubroutine.lean new file mode 100644 index 000000000..ba187f24c --- /dev/null +++ b/Complexity/Computability/WordRAM/RelSubroutine.lean @@ -0,0 +1,613 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Computability.WordRAM.Subroutine +public import Complexity.Foundations.Semantics.Stateful.Relational + +/-! +# Relational Word-RAM dynamic certificates and composable data-structure subroutines + +This file extends `Complexity.Computability.WordRAM.Dynamic` and +`Complexity.Computability.WordRAM.Subroutine` from deterministic specifications (`Stateful.Spec`) +to relational specifications (`Stateful.RelSpec`): + +1. **Standalone relational fixed-program certificates (`RelDynamicCertificate`):** Generalizes + `DynamicCertificate` over `DynamicProgram D r` for `D : Stateful.RelSpec`, where `execute` + witnesses an angelic outcome `(s', a)` satisfying `D.step s o s' a`. Because the Word-RAM + structured semantics `Exec` is deterministic, `RelDynamicCertificate.realization` establishes + `Stateful.RelRealization` directly via `Exec.unique`. +2. **Unified standalone and inline relational subroutine certificates (`RelSubroutineDS`):** + Extends `SubroutineBase P D.Result D.valid w base params s₀` over `D : Stateful.RelSpec`, + inheriting `toDynamicProgram`, `initFresh_exec`, `initFresh_rename`, + `initClear_exec`, `initClear_rename`, `frame_caller`, and `prepareRegs` without duplication, + omitting `rep_unique` (since concrete potential `potential : Data r_ds → ℕ` depends only on + machine data), and existentially quantifying over `(s', a)` with `D.step s o s' a` in + `step_exec`. +3. **Zero-cost embedding of deterministic subroutines (`SubroutineDS.toRelSubroutineDS`):** + Every `SubroutineDS P D w base params s₀` embeds into + `RelSubroutineDS P D.toRelSpec w base params s₀`. +4. **Basis lifting, standalone `Stateful` projections, inline subroutine calls, and flat-program + operation sequences:** Provides `mapSimulates`, `toStandard`, `toRelCertificate`, + `toRelAmortized`, `toRelBound`, `run_client_amortized`, `run_client_bound`, `code_rename`, + `call_rename`, and flat-program sequence execution (`RunsRelOps`, `seq_runsRelOps`, + `run_ops_exact_fresh`, `run_ops_exact_reusable`). + +## Main definitions + +* `Cslib.WordRAM.RelDynamicCertificate`: standalone fixed-program certificate for + `DynamicProgram D r` realizing a relational specification `D : Stateful.RelSpec`. +* `Cslib.WordRAM.RelSubroutineDS`: unified standalone and inline subroutine specification and + amortized resource certificate for `P : SubroutineCode B r_ds k_init` realizing + `D : Stateful.RelSpec` (extending `SubroutineBase` without `rep_unique`). +* `Cslib.WordRAM.SubroutineDS.toRelSubroutineDS`: embedding of a deterministic `SubroutineDS` into + `RelSubroutineDS`. +* `Cslib.WordRAM.RelSubroutineDS.RunsRelOps`: sequential flat-program execution of an operation list + recording the resulting abstract transcript `D.Transcript`. + +## Main results + +* `Cslib.WordRAM.RelDynamicCertificate.realization`, + `Cslib.WordRAM.RelDynamicCertificate.instruction_bound`: standalone `Stateful.RelRealization` + and `Stateful.RelBound` certificates. +* `Cslib.WordRAM.RelSubroutineDS.toRelAmortized`, + `Cslib.WordRAM.RelSubroutineDS.run_client_amortized`: standalone amortized potential certificate + and adaptive-client bound over `Basis.standard`. +* `Cslib.WordRAM.RelSubroutineDS.code_rename`, + `Cslib.WordRAM.RelSubroutineDS.call_rename`: relocated inline operation calls with angelic + relational step outcomes. +* `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_fresh`, + `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_reusable`: end-to-end flat-program execution of any + demonically admissible operation sequence `D.ValidOpSeq s₀ ops`. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 17][CLRS2009] +* [J. C. Reynolds, *Separation Logic: A Logic for Shared Mutable Data Structures*][Reynolds2002] +-/ + +@[expose] public section + +namespace Cslib.WordRAM + +universe u v z + +/-! ## Standalone relational dynamic certificates (`RelDynamicCertificate`) -/ + +variable {r : ℕ} {D : Stateful.RelSpec.{u, v, z}} + +/-- Per-operation angelic machine proof obligations for a `DynamicProgram D r` over a relational +specification `D : Stateful.RelSpec`. -/ +structure RelDynamicCertificate (P : DynamicProgram D r) (w : ℕ) where + /-- Abstract state represented by the persistent machine data. -/ + rep : D.State → Data r → Prop + /-- Represented configurations contain only machine words. -/ + bounded : ∀ {s x}, rep s x → x.Bounded w + /-- Admissible arguments fit the machine's word size. -/ + arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (P.encode o i) + /-- A machine execution implements an admissible operation by realizing some permitted + `(s', a)` with `D.step s o s' a`. -/ + execute : ∀ {s x} (o), rep s x → D.valid s o → + ∃ y s' a n, Exec w P.code (P.prepare o x) y n ∧ + D.step s o s' a ∧ P.decode o y.regs = some a ∧ rep s' y + +/-- Embed a deterministic `DynamicCertificate` as a `RelDynamicCertificate`. -/ +def DynamicCertificate.toRelDynamicCertificate {D : Stateful.Spec.{u, v, z}} {r w : ℕ} + {P : DynamicProgram D r} (C : DynamicCertificate P w) : + RelDynamicCertificate (D := D.toRelSpec) + ⟨P.code, P.output, P.input, P.encode, P.decode⟩ w where + rep := C.rep + bounded := C.bounded + arguments_fit := C.arguments_fit + execute o hr hv := by + obtain ⟨y, n, he, hdec, hrep⟩ := C.execute o hr hv + exact ⟨y, (D.step _ o).1, (D.step _ o).2, n, he, rfl, hdec, hrep⟩ + +namespace RelDynamicCertificate + +variable {P : DynamicProgram D r} {w : ℕ} (C : RelDynamicCertificate P w) + +/-- Turn a successful typed evaluation on a represented state and admissible operation into +certified `ExecOp` evidence. -/ +theorem execOp_of_eval {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} {fuel k : ℕ} + (hr : C.rep s x) (hv : D.valid s o) (h : P.eval w fuel o x = some (y, a, k)) : + ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := + DynamicProgram.ExecOp.of_eval P + (P.prepare_bounded (C.bounded hr) (C.arguments_fit o hv)) h + +/-- Fixed-program relational certificates realize `D` via `Stateful.RelRealization`. -/ +def realization : Stateful.RelRealization D (P.ExecOp w) where + rep := C.rep + total o hr hv := by + obtain ⟨y, _, a, n, he, _, ha, _⟩ := C.execute o hr hv + obtain ⟨ts, hts⟩ := he.exists_trace + exact ⟨a, y, ⟨n + 1, ts⟩, + P.prepare_bounded (C.bounded hr) (C.arguments_fit o hv), n, hts, ha, rfl⟩ + correct hr hv he := by + obtain ⟨y, s', a, n, he', hstep, ha, hr'⟩ := C.execute _ hr hv + obtain ⟨_, _, ht, ha', _⟩ := he + obtain ⟨rfl, rfl⟩ := ht.exec.unique he' + have h_eq : _ = a := Option.some.inj (ha'.symm.trans ha) + subst h_eq + exact ⟨s', hstep, hr'⟩ + +/-- A separate per-operation instruction estimate supplies a reusable `Stateful.RelBound`. -/ +theorem instruction_bound (charge : D.State → D.Op → ℕ) + (hbound : ∀ {s x} (o) {y n}, C.rep s x → D.valid s o → + Exec w P.code (P.prepare o x) y n → n + 1 ≤ charge s o) : + Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions charge := by + intro s x o a y trace hr hv he + obtain ⟨_, n, ht, _, hn⟩ := he + rw [hn] + exact hbound o hr hv ht.exec + +/-- A uniform constant instruction bound follows from an existential per-operation execution. -/ +theorem instruction_bound_const (K : ℕ) + (hbound : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ y n, Exec w P.code (P.prepare o x) y n ∧ n + 1 ≤ K) : + Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions + (fun _ _ => K) := by + apply C.instruction_bound + intro s x o y n hr hv he + obtain ⟨_, _, he', hn⟩ := hbound o hr hv + obtain ⟨_, rfl⟩ := he.unique he' + exact hn + +/-- Adaptive client execution, final representation, and linear total instruction bound for a +uniform constant per-operation instruction certificate. -/ +theorem run_client_const {K : ℕ} + (B : Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions + (fun _ _ => K)) + {α : Type*} (p : D.Client α) {s : D.State} {x : Data r} + (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.Executes (P.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ tr.length * K := by + obtain ⟨a, y, traces, s', tr, he, hrun, hr', hlen, hcost⟩ := B.exists_executes p hr hv + rw [D.totalCost_const] at hcost + exact ⟨a, y, traces, s', tr, he, hrun, hr', hlen, hcost⟩ + +/-- Lift a per-operation pointwise memory frame from `Exec` to `ExecOp`. -/ +theorem frame_of_execute {j : ℕ} + (hframe : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ z n, Exec w P.code (P.prepare o x) z n ∧ z.mem j = x.mem j) + {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.valid s o) (he : P.ExecOp w x o a y trace) : + y.mem j = x.mem j := by + obtain ⟨z, n, hz, hf⟩ := hframe o hr hv + exact (he.eq_of_exec hz).1 ▸ hf + +/-- Lift a per-operation `Modifies` bound from `Exec` to `ExecOp`. -/ +theorem modifies_of_execute {F : Finset ℕ} + (hmod : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ z n, Exec w P.code (P.prepare o x) z n ∧ Modifies F x.mem z.mem) + {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.valid s o) (he : P.ExecOp w x o a y trace) : + Modifies F x.mem y.mem := + fun j hj => C.frame_of_execute + (fun o hr' hv' => let ⟨z, n, hz, hf⟩ := hmod o hr' hv'; ⟨z, n, hz, hf j hj⟩) + hr hv he + +/-- Lift a per-operation pointwise memory frame across a demonically admissible adaptive client +execution. -/ +theorem executes_client_frame {j : ℕ} + (hframe : ∀ {s x y o a trace}, C.rep s x → D.valid s o → + P.ExecOp w x o a y trace → y.mem j = x.mem j) + {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} + {traces : List DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.DemonicValid s p) + (he : Stateful.Executes (P.ExecOp w) p x val y traces) : + y.mem j = x.mem j := by + induction he generalizing s with + | pure _ _ => rfl + | @call o k c a c' trace _ _ _ hstep _ ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s', hstep_d, hr'⟩ := C.realization.correct hr hv_o hstep + exact (ih hr' (hv_k s' a hstep_d)).trans (hframe hr hv_o hstep) + +/-- Lift a per-operation `Modifies` bound across a demonically admissible adaptive client +execution. -/ +theorem executes_client_modifies {F : Finset ℕ} + (hmod : ∀ {s x y o a trace}, C.rep s x → D.valid s o → + P.ExecOp w x o a y trace → Modifies F x.mem y.mem) + {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} + {traces : List DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.DemonicValid s p) + (he : Stateful.Executes (P.ExecOp w) p x val y traces) : + Modifies F x.mem y.mem := + fun j hj => C.executes_client_frame + (fun hr' hv' he' => hmod hr' hv' he' j hj) hr hv he + +/-- Memory probes are bounded by the instruction charge. -/ +theorem probe_bound (charge : D.State → D.Op → ℕ) + (B : Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions charge) : + Stateful.RelBound C.realization (fun t => t.probes.length) charge := by + intro s x o a y trace hr hv he + have hb := B hr hv he + obtain ⟨_, n, ht, _, hn⟩ := he + exact ht.length_le.trans ((Nat.le_add_right n 1).trans (hn ▸ hb)) + +end RelDynamicCertificate + +/-! ## `RelSubroutineDS` and `SubroutineDS.toRelSubroutineDS` -/ + +namespace SubroutineCode + +variable {B : Basis} {r_ds k_init : ℕ} + +/-- Compiled flat `Program B r_ds` for `O(1)` fresh zeroed-memory initialization. -/ +def initFreshProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.initFresh.program P.output + +/-- Compiled flat `Program B r_ds` for `O(space)` dirty-memory reusable initialization. -/ +def initClearProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.initClear.program P.output + +/-- Compiled flat `Program B r_ds` serving all operations of the data structure. -/ +def opProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.code.program P.output + +end SubroutineCode + +/-- Unified standalone and subroutine specification/resource certificate for +`P : SubroutineCode B r_ds k_init` realizing a relational specification `D : Stateful.RelSpec` +at word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. + +Extends `SubroutineBase P D.Result D.valid w base params s₀` (inheriting `toDynamicProgram`, +`initFresh_exec`, `initFresh_rename`, `initClear_exec`, `initClear_rename`, +`frame_caller`, and `prepareRegs`), omits `rep_unique` (because concrete potential +`potential : Data r_ds → ℕ` depends only on machine data), and existentially quantifies over a +permitted outcome `(s', a)` satisfying `D.step s o s' a` in `step_exec`. -/ +structure RelSubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + (D : Stateful.RelSpec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) + extends SubroutineBase P D.Result D.valid w base params s₀ where + /-- Angelic execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`, + witnessing some permitted outcome `(s', a)` with `D.step s o s' a`. -/ + step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), + rep s x → D.valid s o → argMatch o x.regs → + ∃ y s' a n, Exec w P.code x y n ∧ + D.step s o s' a ∧ + decode o y.regs = some a ∧ + rep s' y ∧ + Modifies (Block.mk base space).footprint x.mem y.mem ∧ + n + potential y ≤ charge s o + potential x + +/-- Embed any deterministic `SubroutineDS P D w base params s₀` as a relational +`RelSubroutineDS P D.toRelSpec w base params s₀`. -/ +def SubroutineDS.toRelSubroutineDS {B : Basis} {r_ds k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + (C : SubroutineDS P D w base params s₀) : + RelSubroutineDS P D.toRelSpec w base params s₀ where + toSubroutineBase := C.toSubroutineBase + step_exec o hr hv harg := by + obtain ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + exact ⟨y, (D.step _ o).1, (D.step _ o).2, n, he, rfl, hdec, hrep, hmod, hpot⟩ + +namespace RelSubroutineDS + +variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.RelSpec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ + +/-- Lift a `RelSubroutineDS` certificate along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : RelSubroutineDS P D w base params s₀) : + RelSubroutineDS (P.mapSimulates φ) D w base params s₀ where + toSubroutineBase := C.toSubroutineBase.mapSimulates φ + step_exec o hr hv harg := + let ⟨y, s', a, n, he, hstep, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + ⟨y, s', a, n, he.mapSimulates φ, hstep, hdec, hrep, hmod, hpot⟩ + +/-- Lift an exact-basis `RelSubroutineDS` certificate to `Basis.standard`. -/ +abbrev toStandard {P : SubroutineCode .exact r_ds k_init} + (C : RelSubroutineDS P D w base params s₀) : + RelSubroutineDS P.toStandard D w base params s₀ := + C.mapSimulates .exactStandard + +section Standard + +variable {P_std : SubroutineCode .standard r_ds k_init} + (C : RelSubroutineDS P_std D w base params s₀) + +/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `RelDynamicCertificate`. -/ +def toRelCertificate : RelDynamicCertificate (D := D) C.toDynamicProgram w where + rep := C.rep + bounded := C.bounded + arguments_fit := C.arguments_fit + execute {s x} o hr hv := by + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨y, s', a, n, he, hstep, hdec, hrep, _, _⟩ := C.step_exec o hr' hv harg + exact ⟨y, s', a, n, he, hstep, hdec, hrep⟩ + +/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `Stateful.RelAmortized` +certificate, charging `+ 1` per operation for `DynamicProgram`'s trailing `halt` instruction. -/ +theorem toRelAmortized : + Stateful.RelAmortized C.toRelCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun _ x => C.potential x) + (fun s o => C.charge s o + 1) where + step {s x o a y trace} hr hv he := by + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have hp_eq : C.potential (C.toDynamicProgram.prepare o x) = C.potential x := + C.potential_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hr + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨z, s', a', m, hz, hstep, hdec, hrep, _, hpot⟩ := C.step_exec o hr' hv harg + obtain ⟨rfl, hinst⟩ := he.eq_of_exec hz + obtain ⟨_, _, _, ha_trace, _⟩ := he + have ha_eq : a = a' := Option.some.inj (ha_trace.symm.trans hdec) + subst ha_eq + refine ⟨s', hstep, hrep, ?_⟩ + rw [hinst] + rw [hp_eq] at hpot + omega + +/-- When `C.potential` is identically zero, `RelSubroutineDS` projects directly to a worst-case +`Stateful.RelBound` certificate. -/ +theorem toRelBound (hpot : ∀ x, C.potential x = 0) : + Stateful.RelBound C.toRelCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun s o => C.charge s o + 1) := by + intro s x o a y trace hr hv he + obtain ⟨_, _, _, h⟩ := C.toRelAmortized.step hr hv he + simp only [hpot] at h + omega + +/-- Standalone adaptive-client amortized bound for any demonically admissible client `p`. -/ +theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} + (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces + C.potential y ≤ + D.totalCost (fun s o => C.charge s o + 1) s tr + C.potential x := + C.toRelAmortized.run_client_amortized p hr hv + +/-- Standalone adaptive-client worst-case bound when `C.potential` is identically zero. -/ +theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.Client α) + {s : D.State} {x : Data r_ds} (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ + D.totalCost (fun s o => C.charge s o + 1) s tr := + Stateful.RelBound.exists_executes (C.toRelBound hpot) p hr hv + +end Standard + +/-! ### Projection 2: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ + +/-- Execute `P.code.rename f` inline when arguments already match `(x.comap f).regs`, +witnessing a permitted outcome `(s', a)` with `D.step s o s' a`. -/ +theorem code_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} {x : Data r_caller} (o : D.Op) + (hr : C.rep s (x.comap f)) (hv : D.valid s o) (harg : C.argMatch o (x.comap f).regs) : + ∃ z s' a t, ExecWithin w (P.code.rename f) x z t ∧ + D.step s o s' a ∧ + C.decode o (z.comap f).regs = some a ∧ + C.rep s' (z.comap f) ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) ∧ + t + C.potential (z.comap f) ≤ C.charge s o + C.potential (x.comap f) := by + obtain ⟨y, s', a, n, he, hstep, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + refine ⟨y.extend f x, s', a, n, (he.rename hf).within, hstep, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj, ?_⟩ + · rw [Data.comap_extend hf] + exact hdec + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-- Execute `.seq prep (P.code.rename f)` inline after a caller argument-preparation block `prep` +that preserves persistent DS registers and memory in `[base, base + C.space)`. -/ +theorem call_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} {x x' : Data r_caller} {prep : Code B r_caller} {t_prep : ℕ} (o : D.Op) + (hr : C.rep s (x.comap f)) (hv : D.valid s o) + (hprep : ExecWithin w prep x x' t_prep) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hmem : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a) + (harg : C.argMatch o (x'.comap f).regs) : + ∃ z s' a t, ExecWithin w (.seq prep (P.code.rename f)) x z t ∧ + D.step s o s' a ∧ + C.decode o (z.comap f).regs = some a ∧ + C.rep s' (z.comap f) ∧ + Modifies (Block.mk base C.space).footprint x'.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x'.regs j) ∧ + t + C.potential (z.comap f) ≤ t_prep + C.charge s o + C.potential (x.comap f) := by + have hr' : C.rep s (x'.comap f) := + C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hmem hb' hr + have hp_eq : C.potential (x'.comap f) = C.potential (x.comap f) := + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hmem hr + obtain ⟨z, s', a, t_op, he_op, hstep, hdec, hrep_z, hmod_z, hregs_z, hpot_z⟩ := + C.code_rename hf o hr' hv harg + exact ⟨z, s', a, t_prep + t_op, hprep.seq he_op, hstep, hdec, hrep_z, hmod_z, hregs_z, + by rw [hp_eq] at hpot_z; omega⟩ + +/-! ### Projection 3: Flat-program operation-sequence execution (`RunsRelOps`, `run_ops_exact_*`) -/ + +/-- Sequential flat-program execution of `ops : List D.Op` by repeated calls to `P.opProg`: +each call prepares input registers via `prepRegs`, runs `P.opProg` from `pc = 0` to `halt`, +decodes a permitted outcome `(s₁, a)` with `D.step s o s₁ a`, modifies memory only within +`[base, base + C.space)`, records the resulting transcript `tr : D.Transcript`, and accumulates +total instructions executed (including each trailing `halt`). -/ +inductive RunsRelOps (C : RelSubroutineDS P D w base params s₀) + (prepRegs : D.Op → (Fin r_ds → ℕ) → (Fin r_ds → ℕ) := C.prepareRegs) : + D.State → Data r_ds → List D.Op → D.Transcript → D.State → Data r_ds → ℕ → Prop + | nil {s x} : RunsRelOps C prepRegs s x [] [] s x 0 + | cons {s s₁ s₂ x o a ops tr pc y z steps rest} : + Runs w P.opProg ⟨0, ⟨prepRegs o x.regs, x.mem⟩⟩ ⟨pc, y⟩ steps → + (∃ out, step w P.opProg ⟨pc, y⟩ = .halt out) → + D.step s o s₁ a → + C.decode o y.regs = some a → + Modifies (Block.mk base C.space).footprint x.mem y.mem → + RunsRelOps C prepRegs s₁ y ops tr s₂ z rest → + RunsRelOps C prepRegs s x (o :: ops) (⟨o, a, s₁⟩ :: tr) s₂ z ((steps + 1) + rest) + +private theorem step_program_halt (c : Code B r_ds) (out : Fin r_ds) (y : Data r_ds) : + step w (c.program out) ⟨0 + c.size, y⟩ = .halt (y.regs out) := + step_halt (by + simp only [Code.program, Nat.zero_add, + List.getElem?_append_right (Code.length_assemble c 0).le, + Code.length_assemble, Nat.sub_self, List.getElem?_cons_zero]) + +/-- Flat-program sequence execution under a custom register-preparation function `prepRegs`. -/ +theorem seq_runsRelOps_of_prep (C : RelSubroutineDS P D w base params s₀) + (prepRegs : D.Op → (Fin r_ds → ℕ) → (Fin r_ds → ℕ)) + (hfit : ∀ {s} (o) (regs : Fin r_ds → ℕ), D.valid s o → (∀ i, Fits w (regs i)) → + ∀ i, Fits w (prepRegs o regs i)) + (hnot_in : ∀ (o : D.Op) (regs : Fin r_ds → ℕ) (i : Fin r_ds), + P.input i = false → prepRegs o regs i = regs i) + (harg : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), C.argMatch o (prepRegs o regs)) : + ∀ (ops : List D.Op) {s : D.State} {x : Data r_ds}, + C.rep s x → D.ValidOpSeq s ops → + ∃ tr s_fin z t_ops, + C.RunsRelOps prepRegs s x ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s tr s_fin ∧ + C.rep s_fin z ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s tr + C.potential x + | [], s, x, hr, _ => + ⟨[], s, x, 0, .nil, rfl, .nil s, hr, Nat.zero_add (C.potential x) ▸ le_rfl⟩ + | o :: ops, s, x, hr, ⟨hv_o, hv_rest⟩ => by + let x' : Data r_ds := ⟨prepRegs o x.regs, x.mem⟩ + have hbx := C.bounded hr + have hb' : x'.Bounded w := ⟨hfit o x.regs hv_o hbx.1, hbx.2⟩ + have hreg' : ∀ i, P.input i = false → x'.regs i = x.regs i := + fun i hi => hnot_in o x.regs i hi + have hr' : C.rep s x' := C.rep_supported hreg' (fun _ _ => rfl) hb' hr + have hpot' : C.potential x' = C.potential x := + C.potential_supported hreg' (fun _ _ => rfl) hr + obtain ⟨y, s₁, a, m, he_op, hstep, hdec, hr_y, hmod, hpot_m⟩ := + C.step_exec o hr' hv_o (harg o x.regs) + rw [hpot'] at hpot_m + have hruns : Runs w P.opProg ⟨0, x'⟩ ⟨0 + P.code.size, y⟩ m := + he_op.runs (pc := 0) (p := P.opProg) (Program.Contains.self _).append_left + have hhalt : step w P.opProg ⟨0 + P.code.size, y⟩ = .halt (y.regs P.output) := + step_program_halt P.code P.output y + obtain ⟨tr, s_fin, z, rest, hrest, hops, htr, hr_z, hpot_rest⟩ := + seq_runsRelOps_of_prep C prepRegs hfit hnot_in harg ops hr_y (hv_rest s₁ a hstep) + refine ⟨⟨o, a, s₁⟩ :: tr, s_fin, z, (m + 1) + rest, + .cons hruns ⟨_, hhalt⟩ hstep hdec hmod hrest, + congrArg (o :: ·) hops, .cons _ hv_o hstep htr, hr_z, ?_⟩ + simp only [Stateful.RelSpec.totalCost_cons] + omega + +/-- Flat-program sequence execution using `C.prepareRegs`. -/ +theorem seq_runsRelOps (C : RelSubroutineDS P D w base params s₀) + (ops : List D.Op) {s : D.State} {x : Data r_ds} + (hr : C.rep s x) (hv : D.ValidOpSeq s ops) : + ∃ tr s_fin z t_ops, + C.RunsRelOps C.prepareRegs s x ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s tr s_fin ∧ + C.rep s_fin z ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s tr + C.potential x := by + refine C.seq_runsRelOps_of_prep C.prepareRegs ?_ ?_ C.encode_matches ops hr hv + · intro s' o regs hv_o hregs i + simp only [SubroutineBase.prepareRegs] + split_ifs with hi + · exact C.arguments_fit o hv_o i hi + · exact hregs i + · intro o regs i hi + simp [SubroutineBase.prepareRegs, hi] + +/-- Standalone flat-program operation-sequence theorem with `O(1)` fresh initialization on zeroed +`[base, base + C.space)`. -/ +theorem run_ops_exact_fresh (C : RelSubroutineDS P D w base params s₀) + {d₀ : Data r_ds} (hd₀ : d₀.Bounded w) + (hfr : d₀.regs P.frontierReg = base) + (hpar : ∀ j, d₀.regs (P.initParams j) = params j) + (hzero : ∀ a ∈ (Block.mk base C.space).footprint, d₀.mem a = 0) + (ops : List D.Op) (hv : D.ValidOpSeq s₀ ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w P.initFreshProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w P.initFreshProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base C.space).footprint d₀.mem x₀.mem ∧ + C.RunsRelOps C.prepareRegs s₀ x₀ ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s₀ tr s_fin ∧ + C.rep s_fin z ∧ + t_init ≤ C.initTime ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s₀ tr + C.initPotential := by + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + C.initFresh_exec hd₀ hfr hpar hzero + have hruns₀ : Runs w P.initFreshProg ⟨0, d₀⟩ ⟨0 + P.initFresh.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := P.initFreshProg) (Program.Contains.self _).append_left + have hhalt₀ : step w P.initFreshProg ⟨0 + P.initFresh.size, x₀⟩ = .halt (x₀.regs P.output) := + step_program_halt P.initFresh P.output x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, hr_z, hbound⟩ := + C.seq_runsRelOps ops hr₀ hv + exact ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, hr_z, ht_init, by omega⟩ + +/-- Standalone flat-program operation-sequence theorem with `O(space)` reusable initialization on +arbitrary `w`-bounded memory. -/ +theorem run_ops_exact_reusable (C : RelSubroutineDS P D w base params s₀) + {d₀ : Data r_ds} (hd₀ : d₀.Bounded w) + (hfr : d₀.regs P.frontierReg = base) + (hpar : ∀ j, d₀.regs (P.initParams j) = params j) + (ops : List D.Op) (hv : D.ValidOpSeq s₀ ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w P.initClearProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w P.initClearProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base C.space).footprint d₀.mem x₀.mem ∧ + C.RunsRelOps C.prepareRegs s₀ x₀ ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s₀ tr s_fin ∧ + C.rep s_fin z ∧ + t_init ≤ C.initTime + 4 * C.space + 6 ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s₀ tr + C.initPotential := by + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + C.initClear_exec hd₀ hfr hpar + have hruns₀ : Runs w P.initClearProg ⟨0, d₀⟩ ⟨0 + P.initClear.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := P.initClearProg) (Program.Contains.self _).append_left + have hhalt₀ : step w P.initClearProg ⟨0 + P.initClear.size, x₀⟩ = .halt (x₀.regs P.output) := + step_program_halt P.initClear P.output x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, hr_z, hbound⟩ := + C.seq_runsRelOps ops hr₀ hv + exact ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, hr_z, ht_init, by omega⟩ + +end RelSubroutineDS + +end Cslib.WordRAM diff --git a/Complexity/Computability/WordRAM/Structured.lean b/Complexity/Computability/WordRAM/Structured.lean index a83d3abfb..82425958f 100644 --- a/Complexity/Computability/WordRAM/Structured.lean +++ b/Complexity/Computability/WordRAM/Structured.lean @@ -686,7 +686,8 @@ theorem Data.extend_extend (hf : f.Injective) (y z : Data r) (x : Data r') : · simp [Function.extend_apply' _ _ _ hj] · rfl -private theorem Data.extend_comap (hf : f.Injective) (x : Data r') : +/-- Writing a register view back into its source data changes nothing. -/ +theorem Data.extend_comap (hf : f.Injective) (x : Data r') : (x.comap f).extend f x = x := by ext j · change Function.extend f (x.regs ∘ f) x.regs j = x.regs j diff --git a/Complexity/Computability/WordRAM/Subroutine.lean b/Complexity/Computability/WordRAM/Subroutine.lean index 2dae6c8e7..b6cd0bd1b 100644 --- a/Complexity/Computability/WordRAM/Subroutine.lean +++ b/Complexity/Computability/WordRAM/Subroutine.lean @@ -40,11 +40,12 @@ A data structure is packaged once as a `SubroutineCode B r_ds k_init` and certif ## Main definitions -* `Cslib.WordRAM.SubroutineCode`, `Cslib.WordRAM.SubroutineDS`: uniform relocatable machine code and - unified standalone / inline specification and resource certificate for a Word-RAM data structure. +* `Cslib.WordRAM.SubroutineCode`, `Cslib.WordRAM.SubroutineBase`, `Cslib.WordRAM.SubroutineDS`: + uniform relocatable machine code, step-independent initialization/framing bundle, and unified + standalone / inline specification and resource certificate for a Word-RAM data structure. * `Cslib.WordRAM.SubroutineCode.initFresh`, `Cslib.WordRAM.SubroutineCode.initClear`: `O(1)` fresh initialization on zeroed memory and generic `O(space)` dirty-memory re-initialization. -* `Cslib.WordRAM.SubroutineDS.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: +* `Cslib.WordRAM.SubroutineCode.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: standalone `.standard`-basis `DynamicProgram` and `DynamicCertificate` projections. ## Main results @@ -53,8 +54,8 @@ A data structure is packaged once as a `SubroutineCode B r_ds k_init` and certif * `Cslib.WordRAM.SubroutineDS.toAmortized`, `Cslib.WordRAM.SubroutineDS.toBound`, `Cslib.WordRAM.SubroutineDS.run_client_amortized`, `Cslib.WordRAM.SubroutineDS.run_client_bound`: standalone amortized and worst-case instruction bounds over `Basis.standard`. -* `Cslib.WordRAM.SubroutineDS.initFresh_rename`, `Cslib.WordRAM.SubroutineDS.initClear_rename`, - `Cslib.WordRAM.SubroutineDS.call_rename`, `Cslib.WordRAM.SubroutineDS.frame_caller`: relocated +* `Cslib.WordRAM.SubroutineBase.initFresh_rename`, `Cslib.WordRAM.SubroutineBase.initClear_rename`, + `Cslib.WordRAM.SubroutineDS.call_rename`, `Cslib.WordRAM.SubroutineBase.frame_caller`: relocated inline initialization, inline operation calls, and bidirectional register/memory framing. ## References @@ -205,14 +206,185 @@ def mapSimulates (φ : B.Simulates B') (P : SubroutineCode B r_ds k_init) : abbrev toStandard (P : SubroutineCode .exact r_ds k_init) : SubroutineCode .standard r_ds k_init := P.mapSimulates .exactStandard +/-- Project subroutine code and its calling convention to the same operation signature. +The basis is retained, so this projection does not translate instructions or resource claims. -/ +def toDynamicProgram (P : SubroutineCode B r_ds k_init) {O : Type*} {Result : O → Type*} + (encode : O → Fin r_ds → ℕ) (decode : (o : O) → (Fin r_ds → ℕ) → Option (Result o)) : + DynamicProgram ⟨O, Result⟩ r_ds B where + code := P.code + output := P.output + input := P.input + encode := encode + decode := decode + +/-- Generic execution of `P.zeroFillCode` clearing `[base, base + space)` in `4 * space + 6` +instructions over any basis `B`. -/ +theorem zeroFillCode_exec (P : SubroutineCode B r_ds k_init) + {w base space : ℕ} {params : Fin k_init → ℕ} + (hclear : [P.curReg, P.zeroReg, P.oneReg, P.baseReg, P.frontierReg].Nodup) + (hparams : ∀ j, P.initParams j ∉ [P.curReg, P.zeroReg, P.oneReg]) + (hinc : ∀ {x : Data r_ds}, x.regs P.oneReg = 1 → Fits w (x.regs P.curReg + 1) → + P.incCur.eval w x = some (x.set P.curReg (x.regs P.curReg + 1))) + {x₁ : Data r_ds} + (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) + (hfr₁ : x₁.regs P.frontierReg = base + space) + (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : + ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * space + 6) ∧ + x₂.Bounded w ∧ + x₂.regs P.baseReg = base ∧ + x₂.regs P.frontierReg = base + space ∧ + (∀ j, x₂.regs (P.initParams j) = params j) ∧ + (∀ a ∈ (Block.mk base space).footprint, x₂.mem a = 0) ∧ + Modifies (Block.mk base space).footprint x₁.mem x₂.mem := by + have hfit0 : Fits w 0 := (hx₁.1 P.baseReg).of_le (Nat.zero_le _) + have hfit_stop : Fits w (base + space) := hfr₁ ▸ hx₁.1 P.frontierReg + obtain ⟨hcur_not, hzero_not, hone_not, hbase_ne_fr, _⟩ := + (List.nodup_cons.mp hclear).imp_right fun h => + (List.nodup_cons.mp h).imp_right fun h => + (List.nodup_cons.mp h).imp_right List.nodup_cons.mp + have hcur_ne_zero : P.curReg ≠ P.zeroReg := fun h => hcur_not (by simp [h]) + have hcur_ne_one : P.curReg ≠ P.oneReg := fun h => hcur_not (by simp [h]) + have hcur_ne_base : P.curReg ≠ P.baseReg := fun h => hcur_not (by simp [h]) + have hcur_ne_fr : P.curReg ≠ P.frontierReg := fun h => hcur_not (by simp [h]) + have hzero_ne_one : P.zeroReg ≠ P.oneReg := fun h => hzero_not (by simp [h]) + have hzero_ne_base : P.zeroReg ≠ P.baseReg := fun h => hzero_not (by simp [h]) + have hzero_ne_fr : P.zeroReg ≠ P.frontierReg := fun h => hzero_not (by simp [h]) + have hone_ne_base : P.oneReg ≠ P.baseReg := fun h => hone_not (by simp [h]) + have hone_ne_fr : P.oneReg ≠ P.frontierReg := fun h => hone_not (by simp [h]) + by_cases hsp : 0 < space + · have hc_pos : (Cond.lt P.baseReg P.frontierReg).Holds x₁ := by + simp only [Cond.Holds, hb₁, hfr₁] + omega + have hfit1 : Fits w 1 := hfit_stop.of_le (by omega) + let x_z := x₁.set P.zeroReg 0 + let x_o := x_z.set P.oneReg 1 + let x_c := x_o.set P.curReg (x_o.regs P.baseReg) + have hxc_base : x_c.regs P.baseReg = base := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_base.symm, + Function.update_of_ne hone_ne_base.symm, Function.update_of_ne hzero_ne_base.symm, hb₁] + have hxc_fr : x_c.regs P.frontierReg = base + space := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_fr.symm, + Function.update_of_ne hone_ne_fr.symm, Function.update_of_ne hzero_ne_fr.symm, hfr₁] + have hxc_zero : x_c.regs P.zeroReg = 0 := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_zero.symm, + Function.update_of_ne hzero_ne_one] + have hxc_one : x_c.regs P.oneReg = 1 := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_one.symm] + have hxc_cur : x_c.regs P.curReg = base := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hone_ne_base.symm, + Function.update_of_ne hzero_ne_base.symm, hb₁] + let xs : ℕ → Data r_ds := fun i => + ⟨Function.update x_c.regs P.curReg (base + i), clear x₁.mem base i⟩ + have hxs0 : xs 0 = x_c := by + ext r + · by_cases hr : r = P.curReg + · subst hr + simp [xs, hxc_cur] + · simp [xs, Function.update_of_ne hr, x_c, x_o, x_z, Data.set] + · simp [xs, x_c, x_o, x_z, Data.set] + have hloop_cond : ∀ i < space, (Cond.lt P.curReg P.frontierReg).Holds (xs i) := by + intro i hi + simp only [Cond.Holds, xs, Function.update_self, + Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + omega + have hloop_exit : ¬(Cond.lt P.curReg P.frontierReg).Holds (xs space) := by + simp only [Cond.Holds, xs, Function.update_self, + Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + omega + have hloop_body : ∀ i < space, + ExecWithin w (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur)) + (xs i) (xs (i + 1)) 2 := by + intro i hi + have hsi_zero : (xs i).regs P.zeroReg = 0 := by + simp [xs, Function.update_of_ne hcur_ne_zero.symm, hxc_zero] + have hsi_one : (xs i).regs P.oneReg = 1 := by + simp [xs, Function.update_of_ne hcur_ne_one.symm, hxc_one] + have hsi_cur : (xs i).regs P.curReg = base + i := by simp [xs] + let x_st := (xs i).write ((xs i).regs P.curReg) ((xs i).regs P.zeroReg) + have hst_one : x_st.regs P.oneReg = 1 := hsi_one + have hst_fit : Fits w (x_st.regs P.curReg + 1) := by + change Fits w ((xs i).regs P.curReg + 1) + rw [hsi_cur] + exact hfit_stop.of_le (by omega) + have hinc : ExecWithin w (.op P.incCur) x_st (x_st.set P.curReg (x_st.regs P.curReg + 1)) 1 := + (Exec.op (hinc hst_one hst_fit)).within + have htarget : x_st.set P.curReg (x_st.regs P.curReg + 1) = xs (i + 1) := by + ext r + · simp only [x_st, Data.set, Data.write, xs, hsi_cur] + by_cases hr : r = P.curReg + · subst hr + simp [Nat.add_assoc] + · simp [Function.update_of_ne hr] + · simp only [x_st, Data.set, Data.write, hsi_cur, hsi_zero] + simp [xs, clear_succ] + rw [htarget] at hinc + exact ExecWithin.store.seq hinc + have hloop : ExecWithin w + (.loop (.lt P.curReg P.frontierReg) (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) + x_c (xs space) (space * (2 + 2) + 2) := by + simpa [hxs0] using ExecWithin.loop xs space 2 hloop_cond hloop_exit hloop_body + have hbranch : ExecWithin w P.zeroFillCode x₁ (xs space) (4 * space + 6) := by + have hseq : ExecWithin w + (.seq (.op (.const P.zeroReg 0)) <| + .seq (.op (.const P.oneReg 1)) <| + .seq (.op (.copy P.curReg P.baseReg)) <| + .loop (.lt P.curReg P.frontierReg) + (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) + x₁ (xs space) (3 + (space * 4 + 2)) := by + obtain ⟨n₁, hn₁, he₁⟩ := (ExecWithin.const (x := x₁) (d := P.zeroReg) hfit0) + obtain ⟨n₂, hn₂, he₂⟩ := (ExecWithin.const (x := x_z) (d := P.oneReg) hfit1) + obtain ⟨n₃, hn₃, he₃⟩ := (ExecWithin.copy (B := B) (w := w) (x := x_o) + (d := P.curReg) (s := P.baseReg)) + obtain ⟨n₄, hn₄, he₄⟩ := hloop + exact ⟨n₁ + (n₂ + (n₃ + n₄)), by omega, he₁.seq (he₂.seq (he₃.seq he₄))⟩ + exact (ExecWithin.branch_pos hc_pos hseq).mono (by omega) + refine ⟨xs space, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ + · simp [xs, Function.update_of_ne hcur_ne_base.symm, hxc_base] + · simp [xs, Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + · intro j + have hne := hparams j + have h1 : P.initParams j ≠ P.curReg := fun h => hne (by simp [h]) + have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) + have h3 : P.initParams j ≠ P.oneReg := fun h => hne (by simp [h]) + simp [xs, x_c, x_o, x_z, Data.set, Function.update_of_ne h1, Function.update_of_ne h2, + Function.update_of_ne h3, hpar₁ j] + · intro a ha + exact clear_of_owns (Block.mem_footprint.mp ha) + · intro a ha + exact clear_of_not_owns (mt Block.mem_footprint.mpr ha) + · have hsp0 : space = 0 := by omega + have hc_neg : ¬(Cond.lt P.baseReg P.frontierReg).Holds x₁ := by + simp only [Cond.Holds, hb₁, hfr₁, hsp0] + omega + have hbranch : ExecWithin w P.zeroFillCode x₁ (x₁.set P.zeroReg 0) (4 * space + 6) := + (ExecWithin.branch_neg hc_neg (ExecWithin.const hfit0)).mono (by omega) + refine ⟨x₁.set P.zeroReg 0, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ + · simp [Data.set, Function.update_of_ne hzero_ne_base.symm, hb₁] + · simp [Data.set, Function.update_of_ne hzero_ne_fr.symm, hfr₁] + · intro j + have hne := hparams j + have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) + simp [Data.set, Function.update_of_ne h2, hpar₁ j] + · intro a ha + simp [hsp0, Block.footprint] at ha + · exact Modifies.refl _ _ + end SubroutineCode universe u v z -/-- Unified standalone and subroutine specification/resource certificate for `P` realizing `D` at -word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. -/ -structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) - (D : Stateful.Spec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) where +/-- Step-independent specification, representation, calling-convention, and initialization bundle +for `P : SubroutineCode B r_ds k_init` over a state type `State`, operation type `Op`, observation +family `Result`, and admissibility predicate `valid` at word width `w`, base address `base`, +runtime parameters `params`, and initial state `s₀`. + +Extended by `SubroutineDS` (for deterministic `Stateful.Spec`) and `RelSubroutineDS` (for +relational `Stateful.RelSpec`) so that initialization (`initFresh`, `zeroFillCode`, `initClear`), +register relocation, standalone `toDynamicProgram`, and bidirectional framing (`frame_caller`) are +stated and proved once. -/ +structure SubroutineBase {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + {State : Type u} {O : Type v} (Result : O → Type z) (valid : State → O → Prop) + (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : State) where /-- Contiguous memory footprint length `[base, base + space)`. -/ space : ℕ /-- Instruction bound for `P.allocSpan`. -/ @@ -222,25 +394,23 @@ structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_d /-- Upper bound on initial concrete potential after initialization. -/ initPotential : ℕ /-- Amortized instruction charge per operation (excluding trailing standalone `halt`). -/ - charge : D.State → D.Op → ℕ + charge : State → O → ℕ /-- Representation invariant linking mathematical state `s` to concrete `Data r_ds`. -/ - rep : D.State → Data r_ds → Prop + rep : State → Data r_ds → Prop /-- Concrete integer potential depending only on `Data r_ds`. -/ potential : Data r_ds → ℕ /-- Standalone register encoding for `DynamicProgram.prepare`. -/ - encode : D.Op → Fin r_ds → ℕ + encode : O → Fin r_ds → ℕ /-- Partial argument-matching predicate for inline callers (refined by `encode`). -/ - argMatch : D.Op → (Fin r_ds → ℕ) → Prop + argMatch : O → (Fin r_ds → ℕ) → Prop /-- Output decoder reading typed operation observations from final registers. -/ - decode : (o : D.Op) → (Fin r_ds → ℕ) → Option (D.Result o) + decode : (o : O) → (Fin r_ds → ℕ) → Option (Result o) /-- Represented configurations are word-bounded. -/ bounded : ∀ {s x}, rep s x → x.Bounded w - /-- Concrete machine data determines at most one represented abstract state. -/ - rep_unique : ∀ {s₁ s₂ x}, rep s₁ x → rep s₂ x → s₁ = s₂ /-- Standalone encoded arguments fit in `w`-bit words on admissible calls. -/ - arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (encode o i) + arguments_fit : ∀ {s} (o), valid s o → ∀ i, P.input i = true → Fits w (encode o i) /-- Full standalone `prepare` delivery satisfies `argMatch`. -/ - encode_matches : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), + encode_matches : ∀ (o : O) (regs : Fin r_ds → ℕ), argMatch o (fun i => if P.input i then encode o i else regs i) /-- `rep` depends only on persistent registers (`P.input i = false`) and `[base, base + space)`. -/ @@ -274,30 +444,25 @@ structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_d ∃ y, ExecWithin w P.initSetup x₁ y setupTime ∧ y.regs P.frontierReg = base + space ∧ rep s₀ y ∧ potential y ≤ initPotential ∧ Modifies (Block.mk base space).footprint x₁.mem y.mem - /-- Execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`. -/ - step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), - rep s x → D.valid s o → argMatch o x.regs → - ∃ y n, Exec w P.code x y n ∧ - decode o y.regs = some (D.step s o).2 ∧ - rep (D.step s o).1 y ∧ - Modifies (Block.mk base space).footprint x.mem y.mem ∧ - n + potential y ≤ charge s o + potential x -namespace SubroutineDS +namespace SubroutineBase variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} - {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} - {params : Fin k_init → ℕ} {s₀ : D.State} + {P : SubroutineCode B r_ds k_init} {State : Type u} {O : Type v} + {Result : O → Type z} {valid : State → O → Prop} {params : Fin k_init → ℕ} {s₀ : State} /-- Total instruction bound for `P.initFresh`. -/ -def initTime (C : SubroutineDS P D w base params s₀) : ℕ := +def initTime (C : SubroutineBase P Result valid w base params s₀) : ℕ := C.spanTime + C.setupTime -/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ +/-- Default register-preparation function overwriting `P.input` registers with `C.encode o`. -/ +def prepareRegs (C : SubroutineBase P Result valid w base params s₀) (o : O) + (regs : Fin r_ds → ℕ) : Fin r_ds → ℕ := + fun i => if P.input i then C.encode o i else regs i -/-- Lift a `SubroutineDS` certificate along any defined-evaluation basis simulation. -/ -def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) : - SubroutineDS (P.mapSimulates φ) D w base params s₀ where +/-- Lift a `SubroutineBase` bundle along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : SubroutineBase P Result valid w base params s₀) : + SubroutineBase (P.mapSimulates φ) Result valid w base params s₀ where space := C.space spanTime := C.spanTime setupTime := C.setupTime @@ -309,7 +474,6 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) argMatch := C.argMatch decode := C.decode bounded := C.bounded - rep_unique := C.rep_unique arguments_fit := C.arguments_fit encode_matches := C.encode_matches rep_supported := C.rep_supported @@ -323,6 +487,144 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) setup_exec hx₁ hb hfr hpar hz := let ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz ⟨y, he.mapSimulates φ, hfr', hrep, hpot, hmod⟩ + +/-- Project a subroutine bundle to its signature-level program, retaining the instruction basis. -/ +def toDynamicProgram (C : SubroutineBase P Result valid w base params s₀) : + DynamicProgram ⟨O, Result⟩ r_ds B := + P.toDynamicProgram C.encode C.decode + +/-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ +theorem initFresh_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ y, ExecWithin w P.initFresh x y C.initTime ∧ + y.regs P.frontierReg = base + C.space ∧ + C.rep s₀ y ∧ + C.potential y ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem y.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + have hx₁ : x₁.Bounded w := he₁.bounded hx + have hz₁ : ∀ a ∈ (Block.mk base C.space).footprint, x₁.mem a = 0 := by + intro a ha + rw [hm₁] + exact hz a ha + obtain ⟨y, he₂, hfr₂, hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb₁ hfr₁ hpar₁ hz₁ + rw [hm₁] at hmod + exact ⟨y, he₁.seq he₂, hfr₂, hrep, hpot, hmod⟩ + +/-- Relocated `O(1)` fresh initialization along any injective register embedding `f`. -/ +theorem initFresh_rename (C : SubroutineBase P Result valid w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ z, ExecWithin w (P.initFresh.rename f) x z C.initTime ∧ + z.regs (f P.frontierReg) = base + C.space ∧ + C.rep s₀ (z.comap f) ∧ + C.potential (z.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) := by + obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initFresh_exec hx hfr hpar hz + refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj⟩ + · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space + rw [Data.comap_extend hf] + exact hfr' + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-- Execute `P.initClear` on **arbitrary dirty memory** in `C.initTime + 4 * C.space + 6` +instructions. -/ +theorem initClear_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) : + ∃ y, ExecWithin w P.initClear x y (C.initTime + 4 * C.space + 6) ∧ + y.regs P.frontierReg = base + C.space ∧ + C.rep s₀ y ∧ + C.potential y ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem y.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := + P.zeroFillCode_exec C.clear_nodup C.params_not_clear C.incCur_eval + (he₁.bounded hx) hb₁ hfr₁ hpar₁ + obtain ⟨y, he₃, hfr₃, hrep, hpot, hmod₃⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ + rw [hm₁] at hmod₂ + have hmod : Modifies (Block.mk base C.space).footprint x.mem y.mem := by + simpa only [Finset.union_idempotent] using hmod₂.trans hmod₃ + exact ⟨y, (he₁.seq (he₂.seq he₃)).mono (by unfold initTime; omega), hfr₃, hrep, hpot, hmod⟩ + +/-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ +theorem initClear_rename (C : SubroutineBase P Result valid w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : + ∃ z, ExecWithin w (P.initClear.rename f) x z (C.initTime + 4 * C.space + 6) ∧ + z.regs (f P.frontierReg) = base + C.space ∧ + C.rep s₀ (z.comap f) ∧ + C.potential (z.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) := by + obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initClear_exec hx hfr hpar + refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj⟩ + · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space + rw [Data.comap_extend hf] + exact hfr' + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS +registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from +`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ +theorem frame_caller (C : SubroutineBase P Result valid w base params s₀) + {f : Fin r_ds → Fin r_caller} {s : State} {x x' : Data r_caller} {F : Finset ℕ} + (hr : C.rep s (x.comap f)) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hdisj : Disjoint (Block.mk base C.space).footprint F) + (hmem : Modifies F x.mem x'.mem) : + C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by + have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => + hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) + exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ + +end SubroutineBase + +/-- Unified standalone and subroutine specification/resource certificate for `P` realizing `D` at +word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. -/ +structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + (D : Stateful.Spec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) + extends SubroutineBase P D.Result D.valid w base params s₀ where + /-- Concrete machine data determines at most one represented abstract state. -/ + rep_unique : ∀ {s₁ s₂ x}, rep s₁ x → rep s₂ x → s₁ = s₂ + /-- Execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`. -/ + step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), + rep s x → D.valid s o → argMatch o x.regs → + ∃ y n, Exec w P.code x y n ∧ + decode o y.regs = some (D.step s o).2 ∧ + rep (D.step s o).1 y ∧ + Modifies (Block.mk base space).footprint x.mem y.mem ∧ + n + potential y ≤ charge s o + potential x + +namespace SubroutineDS + +variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ + +/-- Lift a `SubroutineDS` certificate along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) : + SubroutineDS (P.mapSimulates φ) D w base params s₀ where + toSubroutineBase := C.toSubroutineBase.mapSimulates φ + rep_unique := C.rep_unique step_exec o hr hv harg := let ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg ⟨y, n, he.mapSimulates φ, hdec, hrep, hmod, hpot⟩ @@ -338,14 +640,6 @@ section Standard variable {P_std : SubroutineCode .standard r_ds k_init} (C : SubroutineDS P_std D w base params s₀) -/-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicProgram`. -/ -def toDynamicProgram : DynamicProgram D r_ds where - code := P_std.code - output := P_std.output - input := P_std.input - encode := C.encode - decode := C.decode - /-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicCertificate`. -/ def toCertificate : DynamicCertificate C.toDynamicProgram w where rep := C.rep @@ -423,241 +717,7 @@ theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.C end Standard -/-! ### Projection 2: Fresh `O(1)` initialization and register relocation -/ - -/-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ -theorem initFresh_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} - (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) - (hpar : ∀ j, x.regs (P.initParams j) = params j) - (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : - ∃ y, ExecWithin w P.initFresh x y C.initTime ∧ - y.regs P.frontierReg = base + C.space ∧ - C.rep s₀ y ∧ - C.potential y ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem y.mem := by - obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar - have hx₁ : x₁.Bounded w := he₁.bounded hx - have hz₁ : ∀ a ∈ (Block.mk base C.space).footprint, x₁.mem a = 0 := by - intro a ha - rw [hm₁] - exact hz a ha - obtain ⟨y, he₂, hfr₂, hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb₁ hfr₁ hpar₁ hz₁ - rw [hm₁] at hmod - exact ⟨y, he₁.seq he₂, hfr₂, hrep, hpot, hmod⟩ - -/-- Relocated `O(1)` fresh initialization along any injective register embedding `f`. -/ -theorem initFresh_rename (C : SubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} - (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) - (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) - (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : - ∃ z, ExecWithin w (P.initFresh.rename f) x z C.initTime ∧ - z.regs (f P.frontierReg) = base + C.space ∧ - C.rep s₀ (z.comap f) ∧ - C.potential (z.comap f) ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ - (∀ j ∉ Set.range f, z.regs j = x.regs j) := by - obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initFresh_exec hx hfr hpar hz - refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, - fun j hj => Data.extend_regs_of_notMem y x hj⟩ - · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space - rw [Data.comap_extend hf] - exact hfr' - · rw [Data.comap_extend hf] - exact hrep - · rw [Data.comap_extend hf] - exact hpot - -/-! ### Projection 3: Generic `O(space)` dirty-memory initialization (`initClear`) -/ - -/-- Generic execution of `P.zeroFillCode` clearing `[base, base + C.space)` in `4 * C.space + 6` -instructions over any basis `B`. -/ -theorem zeroFillCode_exec (C : SubroutineDS P D w base params s₀) {x₁ : Data r_ds} - (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) - (hfr₁ : x₁.regs P.frontierReg = base + C.space) - (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : - ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * C.space + 6) ∧ - x₂.Bounded w ∧ - x₂.regs P.baseReg = base ∧ - x₂.regs P.frontierReg = base + C.space ∧ - (∀ j, x₂.regs (P.initParams j) = params j) ∧ - (∀ a ∈ (Block.mk base C.space).footprint, x₂.mem a = 0) ∧ - Modifies (Block.mk base C.space).footprint x₁.mem x₂.mem := by - have hfit0 : Fits w 0 := (hx₁.1 P.baseReg).of_le (Nat.zero_le _) - have hfit_stop : Fits w (base + C.space) := hfr₁ ▸ hx₁.1 P.frontierReg - obtain ⟨hcur_not, hzero_not, hone_not, hbase_ne_fr, _⟩ := - (List.nodup_cons.mp C.clear_nodup).imp_right fun h => - (List.nodup_cons.mp h).imp_right fun h => - (List.nodup_cons.mp h).imp_right List.nodup_cons.mp - have hcur_ne_zero : P.curReg ≠ P.zeroReg := fun h => hcur_not (by simp [h]) - have hcur_ne_one : P.curReg ≠ P.oneReg := fun h => hcur_not (by simp [h]) - have hcur_ne_base : P.curReg ≠ P.baseReg := fun h => hcur_not (by simp [h]) - have hcur_ne_fr : P.curReg ≠ P.frontierReg := fun h => hcur_not (by simp [h]) - have hzero_ne_one : P.zeroReg ≠ P.oneReg := fun h => hzero_not (by simp [h]) - have hzero_ne_base : P.zeroReg ≠ P.baseReg := fun h => hzero_not (by simp [h]) - have hzero_ne_fr : P.zeroReg ≠ P.frontierReg := fun h => hzero_not (by simp [h]) - have hone_ne_base : P.oneReg ≠ P.baseReg := fun h => hone_not (by simp [h]) - have hone_ne_fr : P.oneReg ≠ P.frontierReg := fun h => hone_not (by simp [h]) - by_cases hsp : 0 < C.space - · have hc_pos : (Cond.lt P.baseReg P.frontierReg).Holds x₁ := by - simp only [Cond.Holds, hb₁, hfr₁] - omega - have hfit1 : Fits w 1 := hfit_stop.of_le (by omega) - let x_z := x₁.set P.zeroReg 0 - let x_o := x_z.set P.oneReg 1 - let x_c := x_o.set P.curReg (x_o.regs P.baseReg) - have hxc_base : x_c.regs P.baseReg = base := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_base.symm, - Function.update_of_ne hone_ne_base.symm, Function.update_of_ne hzero_ne_base.symm, hb₁] - have hxc_fr : x_c.regs P.frontierReg = base + C.space := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_fr.symm, - Function.update_of_ne hone_ne_fr.symm, Function.update_of_ne hzero_ne_fr.symm, hfr₁] - have hxc_zero : x_c.regs P.zeroReg = 0 := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_zero.symm, - Function.update_of_ne hzero_ne_one] - have hxc_one : x_c.regs P.oneReg = 1 := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_one.symm] - have hxc_cur : x_c.regs P.curReg = base := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hone_ne_base.symm, - Function.update_of_ne hzero_ne_base.symm, hb₁] - let xs : ℕ → Data r_ds := fun i => - ⟨Function.update x_c.regs P.curReg (base + i), clear x₁.mem base i⟩ - have hxs0 : xs 0 = x_c := by - ext r - · by_cases hr : r = P.curReg - · subst hr - simp [xs, hxc_cur] - · simp [xs, Function.update_of_ne hr, x_c, x_o, x_z, Data.set] - · simp [xs, x_c, x_o, x_z, Data.set] - have hloop_cond : ∀ i < C.space, (Cond.lt P.curReg P.frontierReg).Holds (xs i) := by - intro i hi - simp only [Cond.Holds, xs, Function.update_self, - Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - omega - have hloop_exit : ¬(Cond.lt P.curReg P.frontierReg).Holds (xs C.space) := by - simp only [Cond.Holds, xs, Function.update_self, - Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - omega - have hloop_body : ∀ i < C.space, - ExecWithin w (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur)) - (xs i) (xs (i + 1)) 2 := by - intro i hi - have hsi_zero : (xs i).regs P.zeroReg = 0 := by - simp [xs, Function.update_of_ne hcur_ne_zero.symm, hxc_zero] - have hsi_one : (xs i).regs P.oneReg = 1 := by - simp [xs, Function.update_of_ne hcur_ne_one.symm, hxc_one] - have hsi_cur : (xs i).regs P.curReg = base + i := by simp [xs] - let x_st := (xs i).write ((xs i).regs P.curReg) ((xs i).regs P.zeroReg) - have hst_one : x_st.regs P.oneReg = 1 := hsi_one - have hst_fit : Fits w (x_st.regs P.curReg + 1) := by - change Fits w ((xs i).regs P.curReg + 1) - rw [hsi_cur] - exact hfit_stop.of_le (by omega) - have hinc : ExecWithin w (.op P.incCur) x_st (x_st.set P.curReg (x_st.regs P.curReg + 1)) 1 := - (Exec.op (C.incCur_eval hst_one hst_fit)).within - have htarget : x_st.set P.curReg (x_st.regs P.curReg + 1) = xs (i + 1) := by - ext r - · simp only [x_st, Data.set, Data.write, xs, hsi_cur] - by_cases hr : r = P.curReg - · subst hr - simp [Nat.add_assoc] - · simp [Function.update_of_ne hr] - · simp only [x_st, Data.set, Data.write, hsi_cur, hsi_zero] - simp [xs, clear_succ] - rw [htarget] at hinc - exact ExecWithin.store.seq hinc - have hloop : ExecWithin w - (.loop (.lt P.curReg P.frontierReg) (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) - x_c (xs C.space) (C.space * (2 + 2) + 2) := by - simpa [hxs0] using ExecWithin.loop xs C.space 2 hloop_cond hloop_exit hloop_body - have hbranch : ExecWithin w P.zeroFillCode x₁ (xs C.space) (4 * C.space + 6) := by - have hseq : ExecWithin w - (.seq (.op (.const P.zeroReg 0)) <| - .seq (.op (.const P.oneReg 1)) <| - .seq (.op (.copy P.curReg P.baseReg)) <| - .loop (.lt P.curReg P.frontierReg) - (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) - x₁ (xs C.space) (3 + (C.space * 4 + 2)) := by - obtain ⟨n₁, hn₁, he₁⟩ := (ExecWithin.const (x := x₁) (d := P.zeroReg) hfit0) - obtain ⟨n₂, hn₂, he₂⟩ := (ExecWithin.const (x := x_z) (d := P.oneReg) hfit1) - obtain ⟨n₃, hn₃, he₃⟩ := (ExecWithin.copy (B := B) (w := w) (x := x_o) - (d := P.curReg) (s := P.baseReg)) - obtain ⟨n₄, hn₄, he₄⟩ := hloop - exact ⟨n₁ + (n₂ + (n₃ + n₄)), by omega, he₁.seq (he₂.seq (he₃.seq he₄))⟩ - exact (ExecWithin.branch_pos hc_pos hseq).mono (by omega) - refine ⟨xs C.space, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ - · simp [xs, Function.update_of_ne hcur_ne_base.symm, hxc_base] - · simp [xs, Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - · intro j - have hne := C.params_not_clear j - have h1 : P.initParams j ≠ P.curReg := fun h => hne (by simp [h]) - have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) - have h3 : P.initParams j ≠ P.oneReg := fun h => hne (by simp [h]) - simp [xs, x_c, x_o, x_z, Data.set, Function.update_of_ne h1, Function.update_of_ne h2, - Function.update_of_ne h3, hpar₁ j] - · intro a ha - exact clear_of_owns (Block.mem_footprint.mp ha) - · intro a ha - exact clear_of_not_owns (mt Block.mem_footprint.mpr ha) - · have hsp0 : C.space = 0 := by omega - have hc_neg : ¬(Cond.lt P.baseReg P.frontierReg).Holds x₁ := by - simp only [Cond.Holds, hb₁, hfr₁, hsp0] - omega - have hbranch : ExecWithin w P.zeroFillCode x₁ (x₁.set P.zeroReg 0) (4 * C.space + 6) := - (ExecWithin.branch_neg hc_neg (ExecWithin.const hfit0)).mono (by omega) - refine ⟨x₁.set P.zeroReg 0, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ - · simp [Data.set, Function.update_of_ne hzero_ne_base.symm, hb₁] - · simp [Data.set, Function.update_of_ne hzero_ne_fr.symm, hfr₁] - · intro j - have hne := C.params_not_clear j - have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) - simp [Data.set, Function.update_of_ne h2, hpar₁ j] - · intro a ha - simp [hsp0, Block.footprint] at ha - · exact Modifies.refl _ _ - -/-- Execute `P.initClear` on **arbitrary dirty memory** in `C.initTime + 4 * C.space + 6` -instructions. -/ -theorem initClear_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} - (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) - (hpar : ∀ j, x.regs (P.initParams j) = params j) : - ∃ y, ExecWithin w P.initClear x y (C.initTime + 4 * C.space + 6) ∧ - y.regs P.frontierReg = base + C.space ∧ - C.rep s₀ y ∧ - C.potential y ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem y.mem := by - obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar - obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := - C.zeroFillCode_exec (he₁.bounded hx) hb₁ hfr₁ hpar₁ - obtain ⟨y, he₃, hfr₃, hrep, hpot, hmod₃⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ - rw [hm₁] at hmod₂ - have hmod : Modifies (Block.mk base C.space).footprint x.mem y.mem := by - simpa only [Finset.union_idempotent] using hmod₂.trans hmod₃ - exact ⟨y, (he₁.seq (he₂.seq he₃)).mono (by unfold initTime; omega), hfr₃, hrep, hpot, hmod⟩ - -/-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ -theorem initClear_rename (C : SubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} - (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) - (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : - ∃ z, ExecWithin w (P.initClear.rename f) x z (C.initTime + 4 * C.space + 6) ∧ - z.regs (f P.frontierReg) = base + C.space ∧ - C.rep s₀ (z.comap f) ∧ - C.potential (z.comap f) ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ - (∀ j ∉ Set.range f, z.regs j = x.regs j) := by - obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initClear_exec hx hfr hpar - refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, - fun j hj => Data.extend_regs_of_notMem y x hj⟩ - · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space - rw [Data.comap_extend hf] - exact hfr' - · rw [Data.comap_extend hf] - exact hrep - · rw [Data.comap_extend hf] - exact hpot - -/-! ### Projection 4: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ +/-! ### Projection 2: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ /-- Execute `P.code.rename f` inline when arguments already match `(x.comap f).regs`. -/ theorem code_rename (C : SubroutineDS P D w base params s₀) @@ -706,24 +766,6 @@ theorem call_rename (C : SubroutineDS P D w base params s₀) exact ⟨z, t_prep + t_op, hprep.seq he_op, hdec, hrep_z, hmod_z, hregs_z, by rw [hp_eq] at hpot_z; omega⟩ -/-! ### Projection 5: Caller-to-DS bidirectional framing (`frame_caller`) -/ - -/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS -registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from -`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ -theorem frame_caller (C : SubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} {s : D.State} {x x' : Data r_caller} {F : Finset ℕ} - (hr : C.rep s (x.comap f)) - (hb' : (x'.comap f).Bounded w) - (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) - (hdisj : Disjoint (Block.mk base C.space).footprint F) - (hmem : Modifies F x.mem x'.mem) : - C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by - have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => - hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) - exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, - C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ - end SubroutineDS end Cslib.WordRAM diff --git a/Complexity/Foundations/Semantics/Stateful/Realization.lean b/Complexity/Foundations/Semantics/Stateful/Realization.lean index 43afd738d..5761f7fb1 100644 --- a/Complexity/Foundations/Semantics/Stateful/Realization.lean +++ b/Complexity/Foundations/Semantics/Stateful/Realization.lean @@ -39,14 +39,16 @@ namespace Cslib.Stateful universe u v w x y -variable {D E : Spec.{u, v, w}} {C τ : Type x} {α β : Type y} +variable {S : PFunctor.{v, w}} {D E : Spec.{u, v, w}} {C τ : Type x} {α β : Type y} + +instance : Coe Spec.{u, v, w} PFunctor.{v, w} := ⟨Spec.signature⟩ /-- A backend chooses its own execution evidence, independently of a resource measure. -/ -abbrev Execution (D : Spec.{u, v, w}) (C Trace : Type x) := - C → (o : D.Op) → D.Result o → C → Trace → Prop +abbrev Execution (S : PFunctor.{v, w}) (C Trace : Type x) := + C → (o : S.A) → S.B o → C → Trace → Prop /-- Clients collect native execution evidence in call order; no costs occur in this semantics. -/ -inductive Executes (exec : Execution D C τ) : D.Client α → C → α → C → List τ → Prop +inductive Executes (exec : Execution S C τ) : S.FreeM α → C → α → C → List τ → Prop | pure (a c) : Executes exec (.pure a) c a c [] | call {o k c a c' trace b c'' traces} : exec c o a c' trace → Executes exec (k a) c' b c'' traces → @@ -97,12 +99,12 @@ end Realization /-- Execution of a sequential composition splits its native trace at the call boundary. -/ -theorem executes_bind_iff (exec : Execution D C τ) (p : D.Client α) - (k : α → D.Client β) {c c' : C} {b : β} {ts : List τ} : +theorem executes_bind_iff (exec : Execution S C τ) (p : S.FreeM α) + (k : α → S.FreeM β) {c c' : C} {b : β} {ts : List τ} : Executes exec (p.bind k) c b c' ts ↔ ∃ a mid front back, Executes exec p c a mid front ∧ Executes exec (k a) mid b c' back ∧ ts = front ++ back := by - induction p generalizing c ts with + induction p using PFunctor.FreeM.recOn generalizing c ts with | pure a => constructor · intro h; exact ⟨a, c, [], ts, .pure a c, h, rfl⟩ diff --git a/Complexity/Foundations/Semantics/Stateful/Relational.lean b/Complexity/Foundations/Semantics/Stateful/Relational.lean new file mode 100644 index 000000000..6a709a6d1 --- /dev/null +++ b/Complexity/Foundations/Semantics/Stateful/Relational.lean @@ -0,0 +1,1106 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Foundations.Semantics.Stateful.Amortized +public import Complexity.Foundations.Semantics.Stateful.CostHoare +public import Cslib.Foundations.Semantics.LTS.Basic + +/-! +# Relational stateful specifications, demonic adaptive clients, and angelic realizations + +A relational stateful specification (`Cslib.Stateful.RelSpec`) generalizes `Cslib.Stateful.Spec` +from a deterministic transition function `step : State → (o : Op) → State × Result o` to a +transition relation `step : State → (o : Op) → State → Result o → Prop`. This allows data-structure +specifications to leave implementation choices (such as which free slot or handle is allocated, or +how equal-key ties are broken) underspecified in the abstract interface while keeping internal +allocator state hidden inside concrete representation invariants. + +The semantics is **demonic** for callers and **angelic** for implementations: +* An adaptive client `p : D.Client α` is demonically admissible (`D.DemonicValid s p`) when each + issued operation is admissible (`D.valid`) and the continuation remains admissible under *every* + outcome `(s', a)` permitted by `D.step`. Caller postconditions (`D.Hoare`) and abstract cost + budgets (`D.CostHoare`) hold across *all* permitted client runs (`D.ClientRun`). +* A concrete backend realization (`RelRealization`, `RelAmortized`) is angelic in the abstract + post-state: each concrete operation execution witnesses *some* permitted abstract transition + `D.step s o s' a` maintaining the representation invariant and potential inequality. + +Every deterministic `D : Spec` embeds into `RelSpec` with zero overhead via `Spec.toRelSpec` +(preserving `State`, `Op`, `Result`, `valid`, `signature`, and `Client α` definitionally), and +`DemonicValid`, `ClientRun`, `Hoare`, and `CostHoare` on `D.toRelSpec` are equivalent to their +deterministic counterparts on `D`. + +## Main definitions + +* `Cslib.Stateful.RelSpec`: relational stateful specification with `State`, `Op`, `Result`, + transition relation `step`, and input admissibility `valid`. +* `Cslib.Stateful.RelSpec.Total`: typeclass asserting that every admissible `(s, o)` has at least + one permitted outcome `(s', a)`. +* `Cslib.Stateful.Spec.toRelSpec`: zero-cost embedding of a deterministic `Spec` into `RelSpec`. +* `Cslib.Stateful.RelSpec.toLTS`: projection of a `RelSpec` to a `Cslib.LTS` labelled by + input-output pairs `Σ o : D.Op, D.Result o`. +* `Cslib.Stateful.RelSpec.Step`, `Cslib.Stateful.RelSpec.Transcript`, + `Cslib.Stateful.RelSpec.ValidTranscript`, `Cslib.Stateful.RelSpec.ValidOpSeq`, + `Cslib.Stateful.RelSpec.totalCost`, `Cslib.Stateful.RelSpec.totalCostOutcome`: execution + transcripts, non-adaptive operation-sequence admissibility, and abstract cost accounting. +* `Cslib.Stateful.RelSpec.ClientRun`, `Cslib.Stateful.RelSpec.DemonicValid`, + `Cslib.Stateful.RelSpec.Hoare`, `Cslib.Stateful.RelSpec.CostHoare`: adaptive client runs, + demonic admissibility, and compositional Hoare / CostHoare triples. +* `Cslib.Stateful.RelRealization`, `Cslib.Stateful.RelBound`, `Cslib.Stateful.RelAmortized`: + angelic representation simulation and potential-method certificates over `Execution` / `Executes`. + +## Main results + +* `Cslib.Stateful.Spec.toRelSpec_demonicValid_iff`, + `Cslib.Stateful.Spec.toRelSpec_clientRun_iff`, + `Cslib.Stateful.Spec.toRelSpec_hoare_iff`, + `Cslib.Stateful.Spec.toRelSpec_costHoare_iff`: exact collapse of relational client semantics to + deterministic `Spec` semantics on `D.toRelSpec`. +* `Cslib.Stateful.RelRealization.correct_client`, + `Cslib.Stateful.RelRealization.exists_executes`: soundness and existence of native client + executions under `DemonicValid`. +* `Cslib.Stateful.RelAmortized.executes_le`, `Cslib.Stateful.RelAmortized.run_client_amortized`: + amortized potential telescoping along adaptive client executions. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 17][CLRS2009] +* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*][Sangiorgi2011] +-/ + +@[expose] public section + +namespace Cslib.Stateful + +universe u v w x y + +/-! ## Core relational specification and totality -/ + +/-- A relational stateful specification with state type `State`, operation type `Op`, +operation-dependent observation family `Result`, transition relation `step`, and input +admissibility predicate `valid`. -/ +structure RelSpec where + /-- Mathematical states, independent of a concrete storage representation. -/ + State : Type u + /-- Operations available to clients. -/ + Op : Type v + /-- The observation type returned by each operation. -/ + Result : Op → Type w + /-- Relational step specification: `step s o s' a` holds when transitioning from `s` to `s'` + and returning `a : Result o` is a permitted outcome of `o`. -/ + step : State → (o : Op) → State → Result o → Prop + /-- Preconditions under which an operation's implementation must satisfy its contract. -/ + valid : State → Op → Prop := fun _ _ => True + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) + +/-- The set of permitted `(nextState, result)` outcomes of operation `o` from state `s`. -/ +def outcomes (s : D.State) (o : D.Op) : Set (D.State × D.Result o) := + {p | D.step s o p.1 p.2} + +/-- Membership in `D.outcomes s o` unfolds to `D.step s o`. -/ +@[simp] +theorem mem_outcomes_iff (s : D.State) (o : D.Op) (p : D.State × D.Result o) : + p ∈ D.outcomes s o ↔ D.step s o p.1 p.2 := Iff.rfl + +/-- A relational specification is total on admissible inputs if every valid `(s, o)` admits at +least one permitted outcome `(s', a)`. -/ +class Total : Prop where + /-- Every admissible operation call has at least one permitted post-state and result. -/ + step_total : ∀ s o, D.valid s o → ∃ s' a, D.step s o s' a + +/-- Obtain a permitted outcome `(s', a)` for an admissible operation under `[D.Total]`. -/ +theorem exists_step [D.Total] {s : D.State} {o : D.Op} (hv : D.valid s o) : + ∃ s' a, D.step s o s' a := + Total.step_total s o hv + +/-- The polynomial operation signature `⟨D.Op, D.Result⟩`. -/ +abbrev signature : PFunctor.{v, w} := ⟨D.Op, D.Result⟩ + +instance : Coe RelSpec.{u, v, w} PFunctor.{v, w} := ⟨RelSpec.signature⟩ + +/-- An adaptive client over `D`: each continuation may branch on the observed operation result. -/ +abbrev Client (α : Type y) : Type (max v w y) := D.signature.FreeM α + +/-- Invoke a single operation `o : D.Op` in an adaptive `D.Client`. -/ +abbrev call (o : D.Op) : D.Client (D.Result o) := .liftBind o .pure + +/-- An input-output transition label pairing an operation `o : D.Op` with its result `a`. -/ +abbrev Label : Type (max v w) := Σ o : D.Op, D.Result o + +/-- View a relational stateful specification as a labelled transition system (`Cslib.LTS`) +labelled by input-output pairs `⟨o, a⟩ : Σ o : D.Op, D.Result o`. -/ +def toLTS : LTS D.State D.Label where + Tr s lbl s' := D.step s lbl.1 s' lbl.2 + +/-- A transition in `D.toLTS` is a step of `D`. -/ +@[simp] +theorem toLTS_tr (s s' : D.State) (lbl : D.Label) : + D.toLTS.Tr s lbl s' ↔ D.step s lbl.1 s' lbl.2 := Iff.rfl + +end RelSpec + +/-! ## Zero-cost embedding of deterministic specifications (`Spec.toRelSpec`) -/ + +/-- Embed a deterministic `Stateful.Spec` as a relational `RelSpec` whose transition relation +holds if and only if `(s', a) = D.step s o`. -/ +abbrev Spec.toRelSpec (D : Spec.{u, v, w}) : RelSpec.{u, v, w} where + State := D.State + Op := D.Op + Result := D.Result + step s o s' a := (s', a) = D.step s o + valid := D.valid + +namespace Spec + +variable (D : Spec.{u, v, w}) + +/-- `toRelSpec` preserves the state type definitionally. -/ +@[simp] +theorem toRelSpec_state : D.toRelSpec.State = D.State := rfl + +/-- `toRelSpec` preserves the operation type definitionally. -/ +@[simp] +theorem toRelSpec_op : D.toRelSpec.Op = D.Op := rfl + +/-- `toRelSpec` preserves the result family definitionally. -/ +@[simp] +theorem toRelSpec_result : D.toRelSpec.Result = D.Result := rfl + +/-- A step in `D.toRelSpec` holds iff `(s', a) = D.step s o`. -/ +@[simp] +theorem toRelSpec_step (s : D.State) (o : D.Op) (s' : D.State) (a : D.Result o) : + D.toRelSpec.step s o s' a ↔ (s', a) = D.step s o := Iff.rfl + +/-- `toRelSpec` preserves the admissibility predicate definitionally. -/ +@[simp] +theorem toRelSpec_valid (s : D.State) (o : D.Op) : + D.toRelSpec.valid s o ↔ D.valid s o := Iff.rfl + +/-- `toRelSpec` preserves the polynomial signature definitionally. -/ +@[simp] +theorem toRelSpec_signature : D.toRelSpec.signature = D.signature := rfl + +/-- `toRelSpec` preserves the adaptive client type definitionally. -/ +@[simp] +theorem toRelSpec_client (α : Type y) : D.toRelSpec.Client α = D.Client α := rfl + +/-- Every embedded deterministic specification is automatically total. -/ +instance : D.toRelSpec.Total where + step_total s o _ := ⟨(D.step s o).1, (D.step s o).2, Prod.mk.eta⟩ + +/-- Transitions in `D.toRelSpec.toLTS` agree with `D.toFLTS` on states and `(D.step s o).2` on +observations. -/ +theorem toRelSpec_toLTS_tr (s s' : D.State) (o : D.Op) (a : D.Result o) : + D.toRelSpec.toLTS.Tr s ⟨o, a⟩ s' ↔ s' = D.toFLTS.tr s o ∧ a = (D.step s o).2 := by + simp [RelSpec.toLTS, Spec.toRelSpec, Spec.toFLTS, Prod.ext_iff] + +/-- The labelled transition system of an embedded deterministic specification is deterministic. -/ +instance : D.toRelSpec.toLTS.Deterministic where + deterministic s lbl s₁ s₂ h₁ h₂ := by + have h₁' := congrArg Prod.fst h₁ + have h₂' := congrArg Prod.fst h₂ + exact h₁'.trans h₂'.symm + +/-- Multi-step execution `D.run` produces a valid multi-step trace in `D.toRelSpec.toLTS` ending +at `D.toFLTS.mtr s os`. -/ +theorem toRelSpec_toLTS_mtr_run (s : D.State) (os : List D.Op) : + D.toRelSpec.toLTS.MTr s (D.run s os).2 (D.toFLTS.mtr s os) := by + induction os generalizing s with + | nil => exact .refl + | cons o os ih => + exact .stepL Prod.mk.eta (ih (D.step s o).1) + +end Spec + +/-! ## Transcripts, non-adaptive operation sequences, and cost accounting -/ + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) + +/-- One recorded step of a relational specification: the issued operation `op`, its returned +observation `result`, and the resulting post-state `nextState`. -/ +structure Step : Type (max u v w) where + /-- The operation invoked at this step. -/ + op : D.Op + /-- The observation returned by `op`. -/ + result : D.Result op + /-- The abstract post-state reached after `op`. -/ + nextState : D.State + +/-- A finite execution transcript is a list of recorded steps. -/ +abbrev Transcript : Type (max u v w) := List D.Step + +/-- Extract the underlying sequence of operations from a transcript. -/ +def Transcript.ops {D : RelSpec.{u, v, w}} (tr : D.Transcript) : List D.Op := + tr.map Step.op + +/-- Extract the `Cslib.LTS` input-output labels from a transcript. -/ +def Transcript.labels {D : RelSpec.{u, v, w}} (tr : D.Transcript) : List D.Label := + tr.map fun st => ⟨st.op, st.result⟩ + +@[simp] +theorem Transcript.ops_nil {D : RelSpec.{u, v, w}} : + Transcript.ops ([] : D.Transcript) = [] := rfl + +@[simp] +theorem Transcript.ops_cons {D : RelSpec.{u, v, w}} (st : D.Step) (tr : D.Transcript) : + Transcript.ops (st :: tr) = st.op :: Transcript.ops tr := rfl + +@[simp] +theorem Transcript.ops_append {D : RelSpec.{u, v, w}} (tr₁ tr₂ : D.Transcript) : + Transcript.ops (tr₁ ++ tr₂) = Transcript.ops tr₁ ++ Transcript.ops tr₂ := + List.map_append + +@[simp] +theorem Transcript.length_ops {D : RelSpec.{u, v, w}} (tr : D.Transcript) : + (Transcript.ops tr).length = tr.length := + List.length_map _ + +@[simp] +theorem Transcript.labels_nil {D : RelSpec.{u, v, w}} : + Transcript.labels ([] : D.Transcript) = [] := rfl + +@[simp] +theorem Transcript.labels_cons {D : RelSpec.{u, v, w}} (st : D.Step) (tr : D.Transcript) : + Transcript.labels (st :: tr) = ⟨st.op, st.result⟩ :: Transcript.labels tr := rfl + +@[simp] +theorem Transcript.labels_append {D : RelSpec.{u, v, w}} (tr₁ tr₂ : D.Transcript) : + Transcript.labels (tr₁ ++ tr₂) = Transcript.labels tr₁ ++ Transcript.labels tr₂ := + List.map_append + +@[simp] +theorem Transcript.length_labels {D : RelSpec.{u, v, w}} (tr : D.Transcript) : + (Transcript.labels tr).length = tr.length := + List.length_map _ + +/-- `D.ValidTranscript s tr s'` holds when `tr` is a valid step-by-step execution starting at `s` +and ending at `s'`, where each step is admissible (`D.valid`) and permitted by `D.step`. -/ +inductive ValidTranscript : D.State → D.Transcript → D.State → Prop + | nil (s : D.State) : ValidTranscript s [] s + | cons {s : D.State} (st : D.Step) {tr : D.Transcript} {s_fin : D.State} : + D.valid s st.op → + D.step s st.op st.nextState st.result → + ValidTranscript st.nextState tr s_fin → + ValidTranscript s (st :: tr) s_fin + +/-- The empty transcript is valid iff the initial and final states coincide. -/ +@[simp] +theorem validTranscript_nil_iff {D : RelSpec.{u, v, w}} (s s' : D.State) : + D.ValidTranscript s [] s' ↔ s = s' := by + constructor + · intro h; cases h; rfl + · rintro rfl; exact .nil s + +/-- A nonempty transcript is valid iff its head step is admissible and permitted and its tail is +valid from `st.nextState`. -/ +@[simp] +theorem validTranscript_cons_iff {D : RelSpec.{u, v, w}} (s s' : D.State) (st : D.Step) + (tr : D.Transcript) : + D.ValidTranscript s (st :: tr) s' ↔ + D.valid s st.op ∧ D.step s st.op st.nextState st.result ∧ + D.ValidTranscript st.nextState tr s' := by + constructor + · intro h + cases h with + | cons _ hv hstep htr => exact ⟨hv, hstep, htr⟩ + · rintro ⟨hv, hstep, htr⟩ + exact .cons st hv hstep htr + +/-- Valid transcripts compose across concatenation. -/ +theorem ValidTranscript.append {D : RelSpec.{u, v, w}} {s s₁ s₂ : D.State} + {tr₁ tr₂ : D.Transcript} (h₁ : D.ValidTranscript s tr₁ s₁) + (h₂ : D.ValidTranscript s₁ tr₂ s₂) : + D.ValidTranscript s (tr₁ ++ tr₂) s₂ := by + induction h₁ with + | nil _ => exact h₂ + | cons st hv hstep _ ih => exact .cons st hv hstep (ih h₂) + +/-- Every valid transcript projects to a multi-step transition in `D.toLTS`. -/ +theorem ValidTranscript.toLTS_mtr {D : RelSpec.{u, v, w}} {s s' : D.State} + {tr : D.Transcript} (h : D.ValidTranscript s tr s') : + D.toLTS.MTr s tr.labels s' := by + induction h with + | nil _ => exact .refl + | cons _ _ hstep _ ih => exact .stepL hstep ih + +/-- Demonic admissibility of a non-adaptive operation sequence `ops : List D.Op` from `s`: +the head operation is admissible at `s`, and the tail sequence remains admissible from every +permitted post-state `s'` of the head operation. -/ +def ValidOpSeq (s : D.State) : List D.Op → Prop + | [] => True + | o :: ops => D.valid s o ∧ ∀ s' a, D.step s o s' a → ValidOpSeq s' ops + +@[simp] +theorem validOpSeq_nil (s : D.State) : D.ValidOpSeq s [] ↔ True := Iff.rfl + +@[simp] +theorem validOpSeq_cons (s : D.State) (o : D.Op) (ops : List D.Op) : + D.ValidOpSeq s (o :: ops) ↔ D.valid s o ∧ ∀ s' a, D.step s o s' a → D.ValidOpSeq s' ops := + Iff.rfl + +/-- Total interfaces have no operation-sequence admissibility obligations. -/ +theorem validOpSeq_of_forall_valid (h : ∀ s o, D.valid s o) (s : D.State) (ops : List D.Op) : + D.ValidOpSeq s ops := by + induction ops generalizing s with + | nil => trivial + | cons o ops ih => exact ⟨h s o, fun s' _ _ => ih s'⟩ + +/-- Under `[D.Total]`, every demonically admissible operation sequence admits at least one valid +transcript. -/ +theorem exists_validTranscript_of_validOpSeq [D.Total] {s : D.State} {ops : List D.Op} + (hv : D.ValidOpSeq s ops) : + ∃ tr s', tr.ops = ops ∧ D.ValidTranscript s tr s' := by + induction ops generalizing s with + | nil => exact ⟨[], s, rfl, .nil s⟩ + | cons o ops ih => + obtain ⟨hv_o, hv_rest⟩ := hv + obtain ⟨s₁, a, hstep⟩ := D.exists_step hv_o + obtain ⟨tr, s₂, hops, htr⟩ := ih (hv_rest s₁ a hstep) + exact ⟨⟨o, a, s₁⟩ :: tr, s₂, congrArg (o :: ·) hops, .cons _ hv_o hstep htr⟩ + +/-- State-dependent charges summed along a transcript. -/ +def totalCost (charge : D.State → D.Op → ℕ) : D.State → D.Transcript → ℕ + | _, [] => 0 + | s, st :: tr => charge s st.op + totalCost charge st.nextState tr + +/-- Outcome-dependent charges summed along a transcript, where each step charge may also inspect +the post-state `st.nextState` and result `st.result`. -/ +def totalCostOutcome (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) : + D.State → D.Transcript → ℕ + | _, [] => 0 + | s, st :: tr => + charge s st.op st.nextState st.result + totalCostOutcome charge st.nextState tr + +@[simp] +theorem totalCost_nil (charge : D.State → D.Op → ℕ) (s : D.State) : + D.totalCost charge s [] = 0 := rfl + +@[simp] +theorem totalCost_cons (charge : D.State → D.Op → ℕ) (s : D.State) (st : D.Step) + (tr : D.Transcript) : + D.totalCost charge s (st :: tr) = charge s st.op + D.totalCost charge st.nextState tr := rfl + +@[simp] +theorem totalCostOutcome_nil (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) + (s : D.State) : + D.totalCostOutcome charge s [] = 0 := rfl + +@[simp] +theorem totalCostOutcome_cons (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) + (s : D.State) (st : D.Step) (tr : D.Transcript) : + D.totalCostOutcome charge s (st :: tr) = + charge s st.op st.nextState st.result + D.totalCostOutcome charge st.nextState tr := rfl + +/-- `totalCost` is the special case of `totalCostOutcome` that ignores the post-state and +result. -/ +theorem totalCost_eq_totalCostOutcome (charge : D.State → D.Op → ℕ) (s : D.State) + (tr : D.Transcript) : + D.totalCost charge s tr = D.totalCostOutcome (fun s o _ _ => charge s o) s tr := by + induction tr generalizing s with + | nil => rfl + | cons st tr ih => simp [ih] + +/-- Along a valid transcript prefix `D.ValidTranscript s tr₁ s₁`, `totalCost` splits additively at +the intermediate state `s₁`. -/ +theorem totalCost_append {D : RelSpec.{u, v, w}} (charge : D.State → D.Op → ℕ) + {s s₁ : D.State} {tr₁ : D.Transcript} (h₁ : D.ValidTranscript s tr₁ s₁) + (tr₂ : D.Transcript) : + D.totalCost charge s (tr₁ ++ tr₂) = + D.totalCost charge s tr₁ + D.totalCost charge s₁ tr₂ := by + induction h₁ with + | nil _ => simp + | cons st _ _ _ ih => simp [ih, Nat.add_assoc] + +/-- Uniform per-operation bounds scale by the transcript length on any valid transcript. -/ +theorem totalCost_le_length_mul {D : RelSpec.{u, v, w}} (charge : D.State → D.Op → ℕ) (T : ℕ) + (h : ∀ s o, D.valid s o → charge s o ≤ T) {s s' : D.State} {tr : D.Transcript} + (hv : D.ValidTranscript s tr s') : + D.totalCost charge s tr ≤ tr.length * T := by + induction hv with + | nil _ => simp + | cons st hv_o _ _ ih => + have hstep := h _ st.op hv_o + simp only [totalCost_cons, List.length_cons, Nat.add_mul, Nat.one_mul] + omega + +/-- A constant charge `K` per operation totals `tr.length * K`. -/ +theorem totalCost_const (K : ℕ) (s : D.State) (tr : D.Transcript) : + D.totalCost (fun _ _ => K) s tr = tr.length * K := by + induction tr generalizing s with + | nil => simp + | cons st tr ih => simp [ih, Nat.add_mul, Nat.add_comm] + +/-- A unit charge per operation totals the transcript length. -/ +theorem totalCost_one (s : D.State) (tr : D.Transcript) : + D.totalCost (fun _ _ => 1) s tr = tr.length := by + simpa using D.totalCost_const 1 s tr + +end RelSpec + +/-! ## Adaptive clients (`ClientRun`, `DemonicValid`) and demonic `Hoare` / `CostHoare` -/ + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) {α β : Type y} + +/-- `D.ClientRun s p v s' tr` holds when running the adaptive client `p : D.Client α` from initial +state `s` can produce return value `v : α`, final state `s' : D.State`, and transcript `tr` by +making admissible and permitted transitions at each operation call. -/ +inductive ClientRun : D.State → D.Client α → α → D.State → D.Transcript → Prop + | pure (s : D.State) (a : α) : + ClientRun s (.pure a) a s [] + | liftBind {s s₁ s₂ : D.State} (o : D.Op) (k : D.Result o → D.Client α) + (a : D.Result o) {v : α} {tr : D.Transcript} : + D.valid s o → + D.step s o s₁ a → + ClientRun s₁ (k a) v s₂ tr → + ClientRun s (.liftBind o k) v s₂ (⟨o, a, s₁⟩ :: tr) + +/-- Every `ClientRun` produces a valid transcript. -/ +theorem ClientRun.validTranscript {D : RelSpec.{u, v, w}} {s s' : D.State} {p : D.Client α} + {v : α} {tr : D.Transcript} (h : D.ClientRun s p v s' tr) : + D.ValidTranscript s tr s' := by + induction h with + | pure s _ => exact .nil s + | liftBind _ _ _ hv hstep _ ih => exact .cons _ hv hstep ih + +theorem clientRun_pure_iff {D : RelSpec.{u, v, w}} (s : D.State) (a v : α) (s' : D.State) + (tr : D.Transcript) : + D.ClientRun s (.pure a) v s' tr ↔ v = a ∧ s' = s ∧ tr = [] := by + constructor + · intro h + cases h + exact ⟨rfl, rfl, rfl⟩ + · rintro ⟨rfl, rfl, rfl⟩ + exact .pure s' v + +theorem clientRun_liftBind_iff {D : RelSpec.{u, v, w}} (s : D.State) (o : D.Op) + (k : D.Result o → D.Client α) (v : α) (s₂ : D.State) (tr : D.Transcript) : + D.ClientRun s (.liftBind o k) v s₂ tr ↔ + D.valid s o ∧ ∃ a s₁ tr', D.step s o s₁ a ∧ + D.ClientRun s₁ (k a) v s₂ tr' ∧ tr = ⟨o, a, s₁⟩ :: tr' := by + constructor + · intro h + cases h with + | liftBind _ _ a hv hstep hrest => + exact ⟨hv, a, _, _, hstep, hrest, rfl⟩ + · rintro ⟨hv, a, s₁, tr', hstep, hrest, rfl⟩ + exact .liftBind o k a hv hstep hrest + +/-- Sequential client runs compose by concatenating their transcripts. -/ +theorem ClientRun.bind {D : RelSpec.{u, v, w}} {s s₁ s₂ : D.State} {p : D.Client α} + {k : α → D.Client β} {a : α} {b : β} {tr₁ tr₂ : D.Transcript} + (h₁ : D.ClientRun s p a s₁ tr₁) (h₂ : D.ClientRun s₁ (k a) b s₂ tr₂) : + D.ClientRun s (p.bind k) b s₂ (tr₁ ++ tr₂) := by + induction h₁ with + | pure _ _ => exact h₂ + | liftBind o cont res hv hstep _ ih => + exact .liftBind o (fun r => (cont r).bind k) res hv hstep (ih h₂) + +/-- A client run of `p.bind k` splits into a run of `p` and a run of `k` from the intermediate +result and state. -/ +theorem clientRun_bind_iff {D : RelSpec.{u, v, w}} {s s₂ : D.State} {p : D.Client α} + {k : α → D.Client β} {b : β} {tr : D.Transcript} : + D.ClientRun s (p.bind k) b s₂ tr ↔ + ∃ a s₁ tr₁ tr₂, D.ClientRun s p a s₁ tr₁ ∧ + D.ClientRun s₁ (k a) b s₂ tr₂ ∧ tr = tr₁ ++ tr₂ := by + constructor + · intro h + induction p generalizing s tr with + | pure a => + exact ⟨a, s, [], tr, .pure s a, h, rfl⟩ + | liftBind o cont ih => + change D.ClientRun s (.liftBind o fun r => (cont r).bind k) b s₂ tr at h + cases h with + | liftBind _ _ res hv hstep hrest => + obtain ⟨a, s₁, tr₁, tr₂, hp, hk, rfl⟩ := ih res hrest + exact ⟨a, s₁, ⟨o, res, _⟩ :: tr₁, tr₂, .liftBind o cont res hv hstep hp, hk, rfl⟩ + · rintro ⟨a, s₁, tr₁, tr₂, hp, hk, rfl⟩ + exact hp.bind hk + +/-- Demonic admissibility of an adaptive client `p` from state `s`: +* `.pure a` is always admissible; +* `.liftBind o k` requires `D.valid s o` now, and for *every* permitted outcome `(s', a)` of `o` + from `s`, the continuation `k a` must be demonically admissible from `s'`. -/ +inductive DemonicValid : D.State → D.Client α → Prop + | pure (s : D.State) (a : α) : + DemonicValid s (.pure a) + | liftBind {s : D.State} (o : D.Op) (k : D.Result o → D.Client α) : + D.valid s o → + (∀ s' a, D.step s o s' a → DemonicValid s' (k a)) → + DemonicValid s (.liftBind o k) + +theorem demonicValid_pure_iff {D : RelSpec.{u, v, w}} (s : D.State) (a : α) : + D.DemonicValid s (.pure a) ↔ True := + ⟨fun _ => trivial, fun _ => .pure s a⟩ + +theorem demonicValid_liftBind_iff {D : RelSpec.{u, v, w}} (s : D.State) (o : D.Op) + (k : D.Result o → D.Client α) : + D.DemonicValid s (.liftBind o k) ↔ + D.valid s o ∧ ∀ s' a, D.step s o s' a → D.DemonicValid s' (k a) := by + constructor + · intro h + cases h with + | liftBind _ _ hv hk => exact ⟨hv, hk⟩ + · rintro ⟨hv, hk⟩; exact .liftBind o k hv hk + +/-- On a specification where every operation is valid in every state, every client is demonically +admissible. -/ +theorem demonicValid_of_forall_valid (h : ∀ s o, D.valid s o) (s : D.State) (p : D.Client α) : + D.DemonicValid s p := by + induction p generalizing s with + | pure a => exact .pure s a + | liftBind o k ih => exact .liftBind o k (h s o) fun s' a _ => ih a s' + +/-- Under `[D.Total]`, every demonically admissible client admits at least one valid `ClientRun`. -/ +theorem DemonicValid.exists_clientRun {D : RelSpec.{u, v, w}} [D.Total] {s : D.State} + {p : D.Client α} (hv : D.DemonicValid s p) : + ∃ v s' tr, D.ClientRun s p v s' tr := by + induction hv with + | pure s a => exact ⟨a, s, [], .pure s a⟩ + | liftBind o k hv_o _ ih => + obtain ⟨s₁, a, hstep⟩ := D.exists_step hv_o + obtain ⟨v, s₂, tr, hrun⟩ := ih s₁ a hstep + exact ⟨v, s₂, ⟨o, a, s₁⟩ :: tr, .liftBind o k a hv_o hstep hrun⟩ + +/-- Demonic admissibility composes across `bind` when the continuation is demonically admissible +after every valid run of the first client. -/ +theorem DemonicValid.bind {D : RelSpec.{u, v, w}} {s : D.State} {p : D.Client α} + {k : α → D.Client β} (hp : D.DemonicValid s p) + (hk : ∀ a s' tr, D.ClientRun s p a s' tr → D.DemonicValid s' (k a)) : + D.DemonicValid s (p.bind k) := by + induction hp with + | pure s a => exact hk a s [] (.pure s a) + | liftBind o cont hv_o _ ih => + refine .liftBind o (fun r => (cont r).bind k) hv_o fun s₁ r hstep => ?_ + exact ih s₁ r hstep fun a s₂ tr hrun => hk a s₂ (⟨o, r, s₁⟩ :: tr) + (.liftBind o cont r hv_o hstep hrun) + +/-- Demonic Hoare triple for a relational specification: from any initial state satisfying `pre`, +the client `p` is demonically admissible and *every* valid `ClientRun` satisfies `post`. -/ +def Hoare (pre : D.State → Prop) (p : D.Client α) (post : α → D.State → Prop) : Prop := + ∀ s, pre s → D.DemonicValid s p ∧ ∀ v s' tr, D.ClientRun s p v s' tr → post v s' + +namespace Hoare + +variable {D : RelSpec.{u, v, w}} + +/-- Returning a pure value leaves the state unchanged. -/ +theorem pure (pre : D.State → Prop) (a : α) (post : α → D.State → Prop) + (h : ∀ s, pre s → post a s) : D.Hoare pre (.pure a) post := by + intro s hs + refine ⟨.pure s a, ?_⟩ + intro v s' tr hrun + cases hrun + exact h s hs + +/-- Calling an operation requires `D.valid s o` and establishes `post a s'` for every permitted +outcome `D.step s o s' a`. -/ +theorem call (pre : D.State → Prop) (o : D.Op) (post : D.Result o → D.State → Prop) + (h : ∀ s, pre s → D.valid s o ∧ ∀ s' a, D.step s o s' a → post a s') : + D.Hoare pre (.liftBind o fun a => .pure a) post := by + intro s hs + obtain ⟨hv, hpost⟩ := h s hs + refine ⟨.liftBind o (fun a => .pure a) hv fun s' a _ => .pure s' a, ?_⟩ + intro v s' tr hrun + cases hrun with + | liftBind _ _ a _ hstep hrest => + cases hrest + exact hpost s' v hstep + +/-- Sequential composition of demonic Hoare triples. -/ +theorem bind {pre : D.State → Prop} {mid : α → D.State → Prop} + {post : β → D.State → Prop} {p : D.Client α} {k : α → D.Client β} + (hp : D.Hoare pre p mid) (hk : ∀ a, D.Hoare (mid a) (k a) post) : + D.Hoare pre (p.bind k) post := by + intro s hs + obtain ⟨hvp, hpost_p⟩ := hp s hs + refine ⟨hvp.bind fun a s₁ tr₁ hrun₁ => (hk a s₁ (hpost_p a s₁ tr₁ hrun₁)).1, ?_⟩ + intro b s₂ tr hrun + obtain ⟨a, s₁, tr₁, tr₂, hrun₁, hrun₂, _⟩ := clientRun_bind_iff.mp hrun + exact (hk a s₁ (hpost_p a s₁ tr₁ hrun₁)).2 b s₂ tr₂ hrun₂ + +/-- Consequence rule for demonic Hoare triples. -/ +theorem consequence {pre pre' : D.State → Prop} {post post' : α → D.State → Prop} + {p : D.Client α} (h : D.Hoare pre p post) (hp : ∀ s, pre' s → pre s) + (hq : ∀ a s, post a s → post' a s) : D.Hoare pre' p post' := by + intro s hs + obtain ⟨hv, hpost⟩ := h s (hp s hs) + exact ⟨hv, fun v s' tr hrun => hq v s' (hpost v s' tr hrun)⟩ + +end Hoare + +/-- Demonic `CostHoare` triple: strengthens `D.Hoare` with a worst-case abstract charge bound +`D.totalCost charge s tr ≤ budget s` across *every* valid `ClientRun`. -/ +def CostHoare (charge : D.State → D.Op → ℕ) (pre : D.State → Prop) + (p : D.Client α) (post : α → D.State → Prop) (budget : D.State → ℕ) : Prop := + D.Hoare pre p post ∧ + ∀ s, pre s → ∀ v s' tr, D.ClientRun s p v s' tr → D.totalCost charge s tr ≤ budget s + +namespace CostHoare + +variable {D : RelSpec.{u, v, w}} {charge : D.State → D.Op → ℕ} {pre : D.State → Prop} + {post : α → D.State → Prop} {budget : D.State → ℕ} {p : D.Client α} + +/-- Project a `CostHoare` triple to its underlying `Hoare` triple. -/ +theorem hoare (h : D.CostHoare charge pre p post budget) : D.Hoare pre p post := h.1 + +/-- Returning a pure value incurs zero operation cost. -/ +theorem pure (a : α) (h : ∀ s, pre s → post a s) : + D.CostHoare charge pre (.pure a) post (fun _ => 0) := by + refine ⟨Hoare.pure pre a post h, ?_⟩ + intro s _ v s' tr hrun + cases hrun + exact Nat.le_refl 0 + +/-- Calling a single operation charges `charge s o` at the pre-state `s`. -/ +theorem call (o : D.Op) {post : D.Result o → D.State → Prop} + (h : ∀ s, pre s → D.valid s o ∧ ∀ s' a, D.step s o s' a → post a s') : + D.CostHoare charge pre (.liftBind o fun a => .pure a) post (fun s => charge s o) := by + refine ⟨Hoare.call pre o post h, ?_⟩ + intro s _ v s' tr hrun + cases hrun with + | liftBind _ _ a _ _ hrest => + cases hrest + simp + +/-- Compose `CostHoare` budgets at every intermediate state satisfying `mid`. -/ +theorem bind {mid : α → D.State → Prop} {post : β → D.State → Prop} + {k : α → D.Client β} {first : D.State → ℕ} {next : α → D.State → ℕ} + (hp : D.CostHoare charge pre p mid first) + (hk : ∀ a, D.CostHoare charge (mid a) (k a) post (next a)) + (hb : ∀ s, pre s → ∀ a s', mid a s' → first s + next a s' ≤ budget s) : + D.CostHoare charge pre (p.bind k) post budget := by + refine ⟨Hoare.bind hp.hoare (fun a => (hk a).hoare), ?_⟩ + intro s hs b s₂ tr hrun + obtain ⟨a, s₁, tr₁, tr₂, hrun₁, hrun₂, rfl⟩ := clientRun_bind_iff.mp hrun + have hmid : mid a s₁ := (hp.hoare s hs).2 a s₁ tr₁ hrun₁ + have hf := hp.2 s hs a s₁ tr₁ hrun₁ + have hn := (hk a).2 s₁ hmid b s₂ tr₂ hrun₂ + rw [D.totalCost_append charge hrun₁.validTranscript tr₂] + exact (Nat.add_le_add hf hn).trans (hb s hs a s₁ hmid) + +/-- Consequence rule for demonic `CostHoare` triples. -/ +theorem consequence {pre' : D.State → Prop} {post' : α → D.State → Prop} + {budget' : D.State → ℕ} (h : D.CostHoare charge pre p post budget) + (hp : ∀ s, pre' s → pre s) (hq : ∀ a s, post a s → post' a s) + (hb : ∀ s, pre' s → budget s ≤ budget' s) : + D.CostHoare charge pre' p post' budget' := + ⟨h.hoare.consequence hp hq, + fun s hs v s' tr hrun => (h.2 s (hp s hs) v s' tr hrun).trans (hb s hs)⟩ + +end CostHoare + +end RelSpec + +/-! ## Equivalence of relational and deterministic client semantics on `D.toRelSpec` -/ + +namespace Spec + +variable (D : Spec.{u, v, w}) {α : Type y} + +/-- On `D.toRelSpec`, non-adaptive operation-sequence admissibility `ValidOpSeq` coincides with +`D.ValidHistory`. -/ +theorem toRelSpec_validOpSeq_iff (s : D.State) (ops : List D.Op) : + D.toRelSpec.ValidOpSeq s ops ↔ D.ValidHistory s ops := by + induction ops generalizing s with + | nil => rfl + | cons o ops ih => + change (D.valid s o ∧ ∀ s' a, (s', a) = D.step s o → D.toRelSpec.ValidOpSeq s' ops) ↔ + D.valid s o ∧ D.ValidHistory (D.step s o).1 ops + refine and_congr_right fun _ => ?_ + constructor + · intro h + exact (ih (D.step s o).1).mp (h (D.step s o).1 (D.step s o).2 Prod.mk.eta) + · intro h s' a heq + have hs' : s' = (D.step s o).1 := congrArg Prod.fst heq + subst hs' + exact (ih (D.step s o).1).mpr h + +/-- The unique canonical transcript determined by a deterministic specification `D` on an +operation list `os` from state `s`. -/ +def canonicalTranscript (s : D.State) : List D.Op → D.toRelSpec.Transcript + | [] => [] + | o :: os => + let next := D.step s o + ⟨o, next.2, next.1⟩ :: canonicalTranscript next.1 os + +@[simp] +theorem canonicalTranscript_nil (s : D.State) : D.canonicalTranscript s [] = [] := rfl + +@[simp] +theorem canonicalTranscript_cons (s : D.State) (o : D.Op) (os : List D.Op) : + D.canonicalTranscript s (o :: os) = + ⟨o, (D.step s o).2, (D.step s o).1⟩ :: D.canonicalTranscript (D.step s o).1 os := rfl + +/-- The underlying operation list of `D.canonicalTranscript s os` is `os`. -/ +@[simp] +theorem canonicalTranscript_ops (s : D.State) (os : List D.Op) : + (D.canonicalTranscript s os).ops = os := by + induction os generalizing s with + | nil => rfl + | cons o os ih => simp [ih] + +/-- `totalCost` along `D.canonicalTranscript s os` equals `D.totalCost charge s os`. -/ +@[simp] +theorem toRelSpec_totalCost_canonicalTranscript (charge : D.State → D.Op → ℕ) (s : D.State) + (os : List D.Op) : + D.toRelSpec.totalCost charge s (D.canonicalTranscript s os) = D.totalCost charge s os := by + induction os generalizing s with + | nil => rfl + | cons o os ih => + change charge s o + + D.toRelSpec.totalCost charge (D.step s o).1 (D.canonicalTranscript (D.step s o).1 os) = + charge s o + D.totalCost charge (D.step s o).1 os + rw [ih] + +/-- On `D.toRelSpec`, demonic client admissibility `DemonicValid s p` is equivalent to +`D.ValidHistory s (D.runClient s p).2.2`. -/ +theorem toRelSpec_demonicValid_iff (s : D.State) (p : D.Client α) : + D.toRelSpec.DemonicValid s p ↔ D.ValidHistory s (D.runClient s p).2.2 := by + induction p generalizing s with + | pure a => + exact ⟨fun _ => trivial, fun _ => RelSpec.DemonicValid.pure (D := D.toRelSpec) s a⟩ + | liftBind o k ih => + rw [RelSpec.demonicValid_liftBind_iff (D := D.toRelSpec), runClient_liftBind, validHistory_cons] + refine and_congr_right fun _ => ?_ + constructor + · intro h + exact (ih (D.step s o).2 (D.step s o).1).mp + (h (D.step s o).1 (D.step s o).2 Prod.mk.eta) + · intro h s' a heq + have hs' : s' = (D.step s o).1 := congrArg Prod.fst heq + have ha : a = (D.step s o).2 := congrArg Prod.snd heq + subst hs'; subst ha + exact (ih (D.step s o).2 (D.step s o).1).mpr h + +/-- Every client with an admissible deterministic history executes canonically in `D.toRelSpec`. -/ +theorem toRelSpec_clientRun_canonical (s : D.State) (p : D.Client α) + (hv : D.ValidHistory s (D.runClient s p).2.2) : + D.toRelSpec.ClientRun s p (D.runClient s p).1 (D.runClient s p).2.1 + (D.canonicalTranscript s (D.runClient s p).2.2) := by + induction p generalizing s with + | pure a => + exact RelSpec.ClientRun.pure (D := D.toRelSpec) s a + | liftBind o k ih => + exact RelSpec.ClientRun.liftBind (D := D.toRelSpec) o k (D.step s o).2 hv.1 Prod.mk.eta + (ih (D.step s o).2 (D.step s o).1 hv.2) + +private theorem toRelSpec_clientRun_imp {s : D.toRelSpec.State} {p : D.toRelSpec.Client α} + {v : α} {s' : D.toRelSpec.State} {tr : D.toRelSpec.Transcript} + (h : D.toRelSpec.ClientRun s p v s' tr) : + D.ValidHistory s (D.runClient s p).2.2 ∧ + v = (D.runClient s p).1 ∧ + s' = (D.runClient s p).2.1 ∧ + tr = D.canonicalTranscript s (D.runClient s p).2.2 := by + induction h with + | pure s a => + exact ⟨trivial, rfl, rfl, rfl⟩ + | @liftBind s s₁ s₂ o k res v tr hv hstep _ ih => + have hs₁ : s₁ = (D.step s o).1 := congrArg Prod.fst hstep + have hres : res = (D.step s o).2 := congrArg Prod.snd hstep + subst hs₁; subst hres + obtain ⟨hv_rest, rfl, rfl, rfl⟩ := ih + exact ⟨⟨hv, hv_rest⟩, rfl, rfl, rfl⟩ + +/-- On `D.toRelSpec`, `ClientRun` collapses uniquely to `D.runClient` and `D.ValidHistory`. -/ +theorem toRelSpec_clientRun_iff (s : D.State) (p : D.Client α) (v : α) (s' : D.State) + (tr : D.toRelSpec.Transcript) : + D.toRelSpec.ClientRun s p v s' tr ↔ + D.ValidHistory s (D.runClient s p).2.2 ∧ + v = (D.runClient s p).1 ∧ + s' = (D.runClient s p).2.1 ∧ + tr = D.canonicalTranscript s (D.runClient s p).2.2 := + ⟨D.toRelSpec_clientRun_imp, fun ⟨hv, h₁, h₂, h₃⟩ => + h₁ ▸ h₂ ▸ h₃ ▸ D.toRelSpec_clientRun_canonical s p hv⟩ + +/-- On `D.toRelSpec`, `RelSpec.Hoare` is equivalent to `Spec.Hoare`. -/ +theorem toRelSpec_hoare_iff (pre : D.State → Prop) (p : D.Client α) (post : α → D.State → Prop) : + D.toRelSpec.Hoare pre p post ↔ D.Hoare pre p post := by + refine forall_congr' fun s => imp_congr_right fun _ => ?_ + rw [toRelSpec_demonicValid_iff] + constructor + · rintro ⟨hv, hpost⟩ + exact ⟨hv, hpost _ _ _ (D.toRelSpec_clientRun_canonical s p hv)⟩ + · rintro ⟨hv, hpost⟩ + refine ⟨hv, fun v s' tr hrun => ?_⟩ + obtain ⟨_, rfl, rfl, _⟩ := (D.toRelSpec_clientRun_iff s p v s' tr).mp hrun + exact hpost + +/-- On `D.toRelSpec`, `RelSpec.CostHoare` is equivalent to `Spec.CostHoare`. -/ +theorem toRelSpec_costHoare_iff (charge : D.State → D.Op → ℕ) (pre : D.State → Prop) + (p : D.Client α) (post : α → D.State → Prop) (budget : D.State → ℕ) : + D.toRelSpec.CostHoare charge pre p post budget ↔ D.CostHoare charge pre p post budget := by + unfold RelSpec.CostHoare Spec.CostHoare + rw [toRelSpec_hoare_iff] + refine and_congr_right fun hhoare => forall_congr' fun s => imp_congr_right fun hs => ?_ + have hv := (hhoare s hs).1 + constructor + · intro h + have hb := h _ _ _ (D.toRelSpec_clientRun_canonical s p hv) + rwa [D.toRelSpec_totalCost_canonicalTranscript] at hb + · intro h v s' tr hrun + obtain ⟨_, _, _, rfl⟩ := (D.toRelSpec_clientRun_iff s p v s' tr).mp hrun + rwa [D.toRelSpec_totalCost_canonicalTranscript] + +end Spec + +/-! ## Angelic backend realizations (`RelRealization`, `RelBound`, `RelAmortized`) -/ + +/-- Angelic semantic realization of a relational specification `D : RelSpec`: +* `total`: every represented state and admissible operation admits a native execution; +* `correct`: every native execution from a represented state on an admissible operation realizes + *some* permitted abstract post-state `s'` with `D.step s o s' a ∧ rep s' c'`. -/ +structure RelRealization (D : RelSpec.{u, v, w}) {C τ : Type x} + (exec : Execution D C τ) where + /-- Representation invariant linking abstract states to concrete backend states. -/ + rep : D.State → C → Prop + /-- Existence of a native execution for every represented state and admissible operation. -/ + total : ∀ {s c} o, rep s c → D.valid s o → ∃ a c' trace, exec c o a c' trace + /-- Angelic step correctness: every native execution realizes some permitted abstract step. -/ + correct : ∀ {s c o a c' trace}, rep s c → D.valid s o → exec c o a c' trace → + ∃ s', D.step s o s' a ∧ rep s' c' + +namespace RelRealization + +variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} (R : RelRealization D exec) + +/-- From related states, every native execution of a demonically admissible client realizes a +valid `ClientRun` ending in a related state. -/ +theorem correct_client {p : D.Client α} {s : D.State} {c c' : C} {a : α} + {traces : List τ} (hr : R.rep s c) (hv : D.DemonicValid s p) + (he : Executes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by + induction he generalizing s with + | pure a c => + exact ⟨s, [], .pure s a, hr, rfl⟩ + | @call o k c res c₁ trace b c₂ traces ho hes ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s₁, hstep, hr₁⟩ := R.correct hr hv_o ho + obtain ⟨s₂, tr, hrun, hr₂, hlen⟩ := ih hr₁ (hv_k s₁ res hstep) + exact ⟨s₂, ⟨o, res, s₁⟩ :: tr, .liftBind o k res hv_o hstep hrun, hr₂, + congrArg (· + 1) hlen⟩ + +/-- From related states, every demonically admissible client admits a native execution realizing a +valid `ClientRun` ending in a related state. -/ +theorem exists_executes (p : D.Client α) {s : D.State} {c : C} (hr : R.rep s c) + (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by + induction hv generalizing c with + | pure s a => + exact ⟨a, c, [], s, [], .pure a c, .pure s a, hr, rfl⟩ + | liftBind o k hv_o _ ih => + obtain ⟨res, c₁, trace, ho⟩ := R.total o hr hv_o + obtain ⟨s₁, hstep, hr₁⟩ := R.correct hr hv_o ho + obtain ⟨b, c₂, traces, s₂, tr, hes, hrun, hr₂, hlen⟩ := ih s₁ res hstep hr₁ + exact ⟨b, c₂, trace :: traces, s₂, ⟨o, res, s₁⟩ :: tr, + .call ho hes, .liftBind o k res hv_o hstep hrun, hr₂, congrArg (· + 1) hlen⟩ + +end RelRealization + +/-- Lift a deterministic `Realization D exec` to a relational `RelRealization D.toRelSpec exec`. -/ +def Realization.toRelRealization {D : Spec.{u, v, w}} {C τ : Type x} + {exec : Execution D C τ} (R : Realization D exec) : + RelRealization D.toRelSpec exec where + rep := R.rep + total o hr hv := R.total o hr hv + correct {s c o a c' trace} hr hv he := by + obtain ⟨ha, hr'⟩ := R.correct hr hv he + exact ⟨(D.step s o).1, Prod.ext rfl ha, hr'⟩ + +/-- Every native execution of a verified demonic `Hoare` client satisfies its abstract +postcondition in a related final state. -/ +theorem RelSpec.Hoare.realize {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} + {exec : Execution D C Trace} (R : RelRealization D exec) + {pre : D.State → Prop} {post : α → D.State → Prop} {p : D.Client α} + (h : D.Hoare pre p post) {s : D.State} {c c' : C} {a : α} {traces : List Trace} + (hp : pre s) (hr : R.rep s c) (he : Executes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' := by + obtain ⟨hv, hpost⟩ := h s hp + obtain ⟨s', tr, hrun, hr', _⟩ := R.correct_client hr hv he + exact ⟨s', tr, hrun, hr', hpost a s' tr hrun⟩ + +/-- Per-operation worst-case resource certificate over a relational realization `R`. -/ +def RelBound {D : RelSpec.{u, v, w}} {C τ : Type x} {exec : Execution D C τ} + (R : RelRealization D exec) (weight : τ → ℕ) (charge : D.State → D.Op → ℕ) : Prop := + ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → + weight trace ≤ charge s o + +/-- Lift a deterministic `Bound R weight charge` to `RelBound R.toRelRealization weight charge`. -/ +theorem Bound.toRelBound {D : Spec.{u, v, w}} {C τ : Type x} {exec : Execution D C τ} + {R : Realization D exec} {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + (B : Bound R weight charge) : + RelBound R.toRelRealization weight charge := + fun hr hv he => B hr hv he + +/-- Potential-method amortized resource certificate over a relational realization `R`: +for every native operation execution from `R.rep s c` on an admissible `o`, there exists a +permitted abstract post-state `s'` satisfying `D.step s o s' a`, `R.rep s' c'`, and the +single-step potential inequality `weight trace + potential s' c' ≤ charge s o + potential s c`. -/ +structure RelAmortized {D : RelSpec.{u, v, w}} {C Trace : Type x} + {exec : Execution D C Trace} (R : RelRealization D exec) (weight : Trace → ℕ) + (potential : D.State → C → ℕ) (charge : D.State → D.Op → ℕ) : Prop where + /-- Angelic single-step potential inequality witnessing a permitted post-state `s'`. -/ + step : ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → + ∃ s', D.step s o s' a ∧ R.rep s' c' ∧ + weight trace + potential s' c' ≤ charge s o + potential s c + +namespace RelAmortized + +variable {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} + {exec : Execution D C Trace} {R : RelRealization D exec} + {weight : Trace → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + (A : RelAmortized R weight potential charge) + +include A in +/-- **Amortized telescoping along adaptive clients (`executes_le`).** +For any demonically admissible client `p` and native execution `Executes exec p c a c' traces`, +there exist a final abstract state `s'` and transcript `tr` such that `D.ClientRun s p a s' tr`, +`R.rep s' c'`, and +`total weight traces + potential s' c' ≤ D.totalCost charge s tr + potential s c`. -/ +theorem executes_le {p : D.Client α} {s : D.State} {c c' : C} {a : α} + {traces : List Trace} (hr : R.rep s c) (hv : D.DemonicValid s p) + (he : Executes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces + potential s' c' ≤ + D.totalCost charge s tr + potential s c := by + induction he generalizing s with + | pure a c => + exact ⟨s, [], .pure s a, hr, rfl, Nat.le_refl _⟩ + | @call o k c res c₁ trace b c₂ traces ho hes ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s₁, hstep, hr₁, hpot₁⟩ := A.step hr hv_o ho + obtain ⟨s₂, tr, hrun, hr₂, hlen, hpot₂⟩ := ih hr₁ (hv_k s₁ res hstep) + refine ⟨s₂, ⟨o, res, s₁⟩ :: tr, .liftBind o k res hv_o hstep hrun, hr₂, + congrArg (· + 1) hlen, ?_⟩ + simp only [total_cons, RelSpec.totalCost_cons] + omega + +include A in +/-- **Existence, correctness, and amortized bound (`run_client_amortized`).** +From related initial states, every demonically admissible client `p` admits a native execution +satisfying `D.ClientRun`, `R.rep`, and the telescoping potential bound. -/ +theorem run_client_amortized (p : D.Client α) {s : D.State} {c : C} + (hr : R.rep s c) (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces + potential s' c' ≤ + D.totalCost charge s tr + potential s c := by + obtain ⟨a, c', traces, _, _, he, _, _, _⟩ := R.exists_executes p hr hv + obtain ⟨s', tr, hrun, hr', hlen, hpot⟩ := A.executes_le hr hv he + exact ⟨a, c', traces, s', tr, he, hrun, hr', hlen, hpot⟩ + +/-- A worst-case `RelBound` is a zero-potential `RelAmortized` certificate. -/ +theorem of_relBound (B : RelBound R weight charge) : + RelAmortized R weight (fun _ _ => 0) charge where + step hr hv he := by + obtain ⟨s', hstep, hr'⟩ := R.correct hr hv he + exact ⟨s', hstep, hr', by simpa using B hr hv he⟩ + +end RelAmortized + +/-- Lift a deterministic `Amortized R weight potential charge` certificate to +`RelAmortized R.toRelRealization weight potential charge`. -/ +theorem Amortized.toRelAmortized {D : Spec.{u, v, w}} {C Trace : Type x} + {exec : Execution D C Trace} {R : Realization D exec} + {weight : Trace → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + (A : Amortized R weight potential charge) : + RelAmortized R.toRelRealization weight potential charge where + step {s c o a c' trace} hr hv he := by + obtain ⟨ha, hr'⟩ := R.correct hr hv he + exact ⟨(D.step s o).1, Prod.ext rfl ha, hr', A.step hr hv he⟩ + +namespace RelBound + +variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + (B : RelBound R weight charge) + +include B in +/-- Under a worst-case `RelBound`, every native execution of a demonically admissible client has +total weight at most `D.totalCost charge s tr` for some valid `ClientRun` transcript `tr`. -/ +theorem client {p : D.Client α} {s : D.State} {c c' : C} {a : α} {traces : List τ} + (hr : R.rep s c) (hv : D.DemonicValid s p) (he : Executes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces ≤ D.totalCost charge s tr := by + obtain ⟨s', tr, hrun, hr', hlen, hpot⟩ := (RelAmortized.of_relBound B).executes_le hr hv he + exact ⟨s', tr, hrun, hr', hlen, by simpa using hpot⟩ + +include B in +/-- Under a worst-case `RelBound`, every demonically admissible client admits a native execution +meeting the total charge bound. -/ +theorem exists_executes (p : D.Client α) {s : D.State} {c : C} + (hr : R.rep s c) (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces ≤ D.totalCost charge s tr := by + obtain ⟨a, c', traces, s', tr, he, hrun, hr', hlen, hpot⟩ := + (RelAmortized.of_relBound B).run_client_amortized p hr hv + exact ⟨a, c', traces, s', tr, he, hrun, hr', hlen, by simpa using hpot⟩ + +end RelBound + +/-- Transport a demonic `CostHoare` triple through a `RelAmortized` certificate to bound native +execution weight plus final potential by `budget s + potential s c`. -/ +theorem RelSpec.CostHoare.realize_amortized {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (A : RelAmortized R weight potential charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} + {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) + (he : Executes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' ∧ + total weight traces + potential s' c' ≤ budget s + potential s c := by + obtain ⟨hv, hpost⟩ := h.1 s hs + obtain ⟨s', tr, hrun, hr', _, hpot⟩ := A.executes_le hr hv he + have hbud := h.2 s hs a s' tr hrun + exact ⟨s', tr, hrun, hr', hpost a s' tr hrun, by omega⟩ + +/-- Transport a demonic `CostHoare` triple through a worst-case `RelBound` certificate. -/ +theorem RelSpec.CostHoare.realize {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (B : RelBound R weight charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} + {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) + (he : Executes exec p c a c' traces) : + (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by + obtain ⟨s', _, _, hr', hpost, hpot⟩ := + h.realize_amortized (RelAmortized.of_relBound B) hs hr he + exact ⟨⟨s', hr', hpost⟩, by simpa using hpot⟩ + +/-- Existence of a native execution satisfying a demonic `CostHoare` contract under `RelBound`. -/ +theorem RelSpec.CostHoare.exists_executes {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (B : RelBound R weight charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c : C} + (hs : pre s) (hr : R.rep s c) : + ∃ a c' traces, Executes exec p c a c' traces ∧ + (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by + obtain ⟨a, c', traces, _, _, he, _, _, _⟩ := R.exists_executes p hr (h.1 s hs).1 + exact ⟨a, c', traces, he, h.realize B hs hr he⟩ + +end Cslib.Stateful diff --git a/Complexity/Probability/PMF/Expect.lean b/Complexity/Probability/PMF/Expect.lean index 4a00e266b..6606eb95d 100644 --- a/Complexity/Probability/PMF/Expect.lean +++ b/Complexity/Probability/PMF/Expect.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Copyright (c) 2026 Samuel Schlesinger, Renfei Zhou. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Samuel Schlesinger +Authors: Samuel Schlesinger, Renfei Zhou -/ module @@ -29,6 +29,8 @@ into the vocabulary of `Finset.expect` (`𝔼`) and `Finset.dens`. * `Cslib.Probability.PMF.sum_le_affine`: average pointwise affine bounds. * `Cslib.Probability.PMF.sum_map_mul`, `.sum_bind_mul`: average deterministic and random scores. +* `Cslib.Probability.PMF.tsum_map_mul`, `.tsum_bind_mul`: the same laws for extended + nonnegative scores over arbitrary types. * `Cslib.Probability.PMF.toReal_uniformOfFintype_bind_apply`: a uniform first stage averages the second stages. @@ -44,6 +46,23 @@ namespace Cslib.Probability.PMF open Finset open scoped BigOperators ENNReal +/-- Expectation of `k : β → ℝ≥0∞` under `p.map g` equals expectation of `k ∘ g` under `p`. -/ +theorem tsum_map_mul {α β : Type*} (p : PMF α) (g : α → β) (k : β → ℝ≥0∞) : + (∑' b, p.map g b * k b) = ∑' a, p a * k (g a) := by + simp only [PMF.map_apply, ← ENNReal.tsum_mul_right] + rw [tsum_comm] + refine tsum_congr fun a => ?_ + rw [tsum_eq_single (g a)] + · simp + · intro b hb + simp [hb] + +/-- Expectation of `k : β → ℝ≥0∞` under `p.bind f` decomposes as an iterated expectation. -/ +theorem tsum_bind_mul {α β : Type*} (p : PMF α) (f : α → PMF β) (k : β → ℝ≥0∞) : + (∑' b, (p.bind f) b * k b) = ∑' a, p a * ∑' b, f a b * k b := by + simp only [PMF.bind_apply, ← ENNReal.tsum_mul_right, ← ENNReal.tsum_mul_left, mul_assoc] + exact tsum_comm + /-- Averaging a score after a deterministic map averages its composite with that map. Adapted from the cslib `crypto` branch at `5ff69ca`. -/ theorem sum_map_mul {α β : Type*} [Fintype α] [Fintype β] diff --git a/ComplexityTests/StatefulRelational.lean b/ComplexityTests/StatefulRelational.lean new file mode 100644 index 000000000..1b6980b9c --- /dev/null +++ b/ComplexityTests/StatefulRelational.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Init +public import Complexity.Foundations.Semantics.Stateful.Relational + +/-! +# Tests for Relational Stateful Specifications + +Concrete non-vacuous tests for `Cslib.Stateful.RelSpec`, its totality class `RelSpec.Total`, +projection `RelSpec.toLTS`, zero-cost deterministic embedding `Spec.toRelSpec`, demonic adaptive +client semantics (`ClientRun`, `DemonicValid`, `RelSpec.Hoare`, `RelSpec.CostHoare`), and angelic +backend realization and amortized analysis (`RelRealization`, `RelBound`, `RelAmortized`). +-/ + +@[expose] public section + +namespace ComplexityTests.StatefulRelational + +open Cslib.Stateful + +/-! ## 1. A genuinely nondeterministic relational specification (two-slot allocator) -/ + +/-- Operations of a two-slot index allocator: `alloc` nondeterministically returns any free +slot in `Fin 2`; `free i` releases slot `i`. -/ +inductive TwoSlotOp : Type + | alloc : TwoSlotOp + | free : Fin 2 → TwoSlotOp + deriving DecidableEq + +/-- Relational specification of a two-slot allocator whose state `(b₀, b₁) : Bool × Bool` +records whether slots `0` and `1` are currently occupied. When both slots are free, `alloc` +nondeterministically returns either `0` or `1`. -/ +abbrev TwoSlotAlloc : RelSpec where + State := Bool × Bool + Op := TwoSlotOp + Result + | .alloc => Fin 2 + | .free _ => Unit + valid s + | .alloc => s.1 = false ∨ s.2 = false + | .free _ => True + step s o s' a := + match o, a with + | .alloc, i => + (i = 0 ∧ s.1 = false ∧ s' = (true, s.2)) ∨ + (i = 1 ∧ s.2 = false ∧ s' = (s.1, true)) + | .free i, () => + s' = if i = 0 then (false, s.2) else (s.1, false) + +instance : TwoSlotAlloc.Total where + step_total s o hv := by + cases o with + | alloc => + rcases hv with h0 | h1 + · exact ⟨(true, s.2), 0, Or.inl ⟨rfl, h0, rfl⟩⟩ + · exact ⟨(s.1, true), 1, Or.inr ⟨rfl, h1, rfl⟩⟩ + | free i => + exact ⟨if i = 0 then (false, s.2) else (s.1, false), (), rfl⟩ + +/-- Both slot `0` and slot `1` are valid outcomes of `alloc` from `(false, false)`. -/ +theorem twoSlotAlloc_nondeterministic : + ((true, false), (0 : Fin 2)) ∈ TwoSlotAlloc.outcomes (false, false) .alloc ∧ + ((false, true), (1 : Fin 2)) ∈ TwoSlotAlloc.outcomes (false, false) .alloc := + ⟨Or.inl ⟨rfl, rfl, rfl⟩, Or.inr ⟨rfl, rfl, rfl⟩⟩ + +/-- Sample LTS transition via `RelSpec.toLTS`. -/ +theorem twoSlotAlloc_toLTS_tr : + TwoSlotAlloc.toLTS.Tr (false, false) ⟨.alloc, (1 : Fin 2)⟩ (false, true) := + Or.inr ⟨rfl, rfl, rfl⟩ + +/-! ## 2. Adaptive client, demonic admissibility, and Hoare / CostHoare verification -/ + +/-- Adaptive client that allocates two slots sequentially, frees the first slot returned, and +returns the pair `(i, j)` of allocated slots. -/ +abbrev allocTwoAndFreeFirst : TwoSlotAlloc.Client (Fin 2 × Fin 2) := + .liftBind TwoSlotOp.alloc fun i => + .liftBind TwoSlotOp.alloc fun j => + .liftBind (TwoSlotOp.free i) fun _ => + .pure (i, j) + +/-- From `(false, false)`, `allocTwoAndFreeFirst` is demonically admissible across all +nondeterministic choices of the first and second allocations. -/ +theorem allocTwoAndFreeFirst_demonicValid : + TwoSlotAlloc.DemonicValid (false, false) allocTwoAndFreeFirst := by + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) TwoSlotOp.alloc _ (Or.inl rfl) + fun s₁ i h₁ => ?_ + have hv₂ : TwoSlotAlloc.valid s₁ TwoSlotOp.alloc := by + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact Or.inr rfl + · exact Or.inl rfl + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) TwoSlotOp.alloc _ hv₂ + fun s₂ j _ => ?_ + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) (TwoSlotOp.free i) _ trivial + fun s₃ _ _ => .pure s₃ (i, j) + +/-- Demonic `CostHoare` specification: under unit per-operation charge, every relational execution +of `allocTwoAndFreeFirst` from `(false, false)` returns distinct slots `i ≠ j`, leaves `i` free +and `j` occupied, and incurs abstract cost `3`. -/ +theorem allocTwoAndFreeFirst_costHoare : + TwoSlotAlloc.CostHoare (fun _ _ => 1) + (fun s => s = (false, false)) + allocTwoAndFreeFirst + (fun p s' => p.1 ≠ p.2 ∧ (if p.1 = 0 then s'.1 = false else s'.2 = false)) + (fun _ => 3) := by + refine ⟨fun s hs => ?_, fun s hs v s' tr hrun => ?_⟩ + · subst hs + refine ⟨allocTwoAndFreeFirst_demonicValid, fun v s' tr hrun => ?_⟩ + obtain ⟨_, i, s₁, tr₁, h₁, hrun₁, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun + obtain ⟨_, j, s₂, tr₂, h₂, hrun₂, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₁ + obtain ⟨_, _, s₃, tr₃, h₃, hrun₃, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₂ + obtain ⟨rfl, rfl, rfl⟩ := (RelSpec.clientRun_pure_iff ..).mp hrun₃ + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · rcases h₂ with ⟨_, hfalse, _⟩ | ⟨rfl, _, rfl⟩ + · cases hfalse + · subst h₃ + exact ⟨by decide, by decide⟩ + · rcases h₂ with ⟨rfl, _, rfl⟩ | ⟨_, hfalse, _⟩ + · subst h₃ + exact ⟨by decide, by decide⟩ + · cases hfalse + · subst hs + obtain ⟨_, i, s₁, tr₁, _, hrun₁, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun + obtain ⟨_, j, s₂, tr₂, _, hrun₂, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₁ + obtain ⟨_, _, s₃, tr₃, _, hrun₃, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₂ + obtain ⟨rfl, rfl, rfl⟩ := (RelSpec.clientRun_pure_iff ..).mp hrun₃ + simp + +/-- Consequence to plain demonic `Hoare`. -/ +theorem allocTwoAndFreeFirst_hoare : + TwoSlotAlloc.Hoare + (fun s => s = (false, false)) + allocTwoAndFreeFirst + (fun p s' => p.1 ≠ p.2 ∧ (if p.1 = 0 then s'.1 = false else s'.2 = false)) := + allocTwoAndFreeFirst_costHoare.hoare + +/-! ## 3. Concrete first-fit backend realization and amortized certificate -/ + +/-- Concrete first-fit implementation of `TwoSlotAlloc`: `alloc` chooses slot `0` when free and +slot `1` otherwise, recording `1` unit of execution trace cost per operation. -/ +def firstFitExec : Execution TwoSlotAlloc (Bool × Bool) ℕ + | c, .alloc, i, c', n => + n = 1 ∧ + if c.1 = false then i = 0 ∧ c' = (true, c.2) + else i = 1 ∧ c' = (c.1, true) + | c, .free i, (), c', n => + n = 1 ∧ c' = (if i = 0 then (false, c.2) else (c.1, false)) + +/-- Angelic realization of `TwoSlotAlloc` by `firstFitExec`. -/ +def firstFitRealization : RelRealization TwoSlotAlloc firstFitExec where + rep s c := s = c + total {s c} o hr _ := by + subst hr + cases o with + | alloc => + rcases Bool.dichotomy s.1 with h0 | h0 + · exact ⟨0, (true, s.2), 1, rfl, by simp [h0]⟩ + · exact ⟨1, (s.1, true), 1, rfl, by simp [h0]⟩ + | free i => + exact ⟨(), if i = 0 then (false, s.2) else (s.1, false), 1, rfl, rfl⟩ + correct {s c o a c' n} hr hv he := by + subst hr + cases o with + | alloc => + obtain ⟨_, hbranch⟩ := he + rcases Bool.dichotomy s.1 with h0 | h0 + · simp only [h0, ↓reduceIte] at hbranch + obtain ⟨rfl, rfl⟩ := hbranch + exact ⟨(true, s.2), Or.inl ⟨rfl, h0, rfl⟩, rfl⟩ + · simp only [h0, Bool.true_eq_false, ↓reduceIte] at hbranch + obtain ⟨rfl, rfl⟩ := hbranch + have h1 : s.2 = false := hv.resolve_left (by simp [h0]) + exact ⟨(s.1, true), Or.inr ⟨rfl, h1, rfl⟩, by simp [h0]⟩ + | free i => + obtain ⟨_, rfl⟩ := he + cases a + exact ⟨if i = 0 then (false, s.2) else (s.1, false), rfl, rfl⟩ + +/-- Per-operation worst-case bound for `firstFitRealization`. -/ +theorem firstFitBound : + RelBound firstFitRealization id (fun _ _ => 1) := by + intro s c o a c' n _ _ he + cases o with + | alloc => exact Nat.le_of_eq he.1 + | free _ => exact Nat.le_of_eq he.1 + +/-- Amortized certificate for `firstFitRealization` with zero potential. -/ +theorem firstFitAmortized : + RelAmortized firstFitRealization id (fun _ _ => 0) (fun _ _ => 1) := + RelAmortized.of_relBound firstFitBound + +/-- End-to-end execution of `allocTwoAndFreeFirst` on `firstFitRealization` via +`RelAmortized.run_client_amortized` and `RelSpec.CostHoare.realize_amortized`. -/ +theorem firstFit_allocTwoAndFreeFirst_executes : + ∃ v c' traces s' tr, + Executes firstFitExec allocTwoAndFreeFirst (false, false) v c' traces ∧ + TwoSlotAlloc.ClientRun (false, false) allocTwoAndFreeFirst v s' tr ∧ + firstFitRealization.rep s' c' ∧ + (v.1 ≠ v.2 ∧ (if v.1 = 0 then s'.1 = false else s'.2 = false)) ∧ + total id traces ≤ 3 := by + obtain ⟨v, c', traces, _, _, he, _, _, _, _⟩ := + firstFitAmortized.run_client_amortized allocTwoAndFreeFirst + (s := (false, false)) (c := (false, false)) rfl allocTwoAndFreeFirst_demonicValid + obtain ⟨s', tr, hrun, hr, hpost, hcost⟩ := + allocTwoAndFreeFirst_costHoare.realize_amortized firstFitAmortized rfl rfl he + exact ⟨v, c', traces, s', tr, he, hrun, hr, hpost, by omega⟩ + +/-! ## 4. Layer 1 (`Spec.toRelSpec`) embedding and collapse equivalences -/ + +/-- Simple deterministic counter specification to exercise `Spec.toRelSpec`. -/ +abbrev CounterSpec : Spec where + State := ℕ + Op := Unit + Result _ := ℕ + step n _ := (n + 1, n) + +/-- Adaptive client on `CounterSpec` that increments twice and returns the sum of results. -/ +def counterTwice : CounterSpec.Client ℕ := + .liftBind () fun a => .liftBind () fun b => .pure (a + b) + +/-- `DemonicValid` on `CounterSpec.toRelSpec` collapses to `ValidHistory` on `CounterSpec`. -/ +theorem counterTwice_demonicValid (n : ℕ) : + CounterSpec.toRelSpec.DemonicValid n counterTwice := by + rw [CounterSpec.toRelSpec_demonicValid_iff] + exact ⟨trivial, trivial, trivial⟩ + +/-- `RelSpec.Hoare` on `CounterSpec.toRelSpec` is equivalent to `Spec.Hoare`. -/ +theorem counterTwice_relHoare : + CounterSpec.toRelSpec.Hoare (fun n => n = 5) counterTwice (fun v s' => v = 11 ∧ s' = 7) := by + rw [CounterSpec.toRelSpec_hoare_iff] + intro s hs + subst hs + exact ⟨⟨trivial, trivial, trivial⟩, rfl, rfl⟩ + +end ComplexityTests.StatefulRelational diff --git a/ComplexityTests/WordRAMDynamic.lean b/ComplexityTests/WordRAMDynamic.lean index 3e98d9e66..d27a344b5 100644 --- a/ComplexityTests/WordRAMDynamic.lean +++ b/ComplexityTests/WordRAMDynamic.lean @@ -147,9 +147,11 @@ example : (fun (_, answer, _) => answer) = some none ∧ ((Stack.implementation 4 2).eval 4 0 .size (Stack.initial 3)).map (fun (_, answer, _) => answer) = some 0 ∧ - ({ exchangeProgram 4 with decode := fun _ _ => none }).eval 4 0 7 + ({ exchangeProgram 4 with decode := fun _ _ => none } : + DynamicProgram (exchangeSpec 4) 3 .standard).eval 4 0 7 ⟨fun _ => 0, fun _ => 0⟩ = none ∧ - ({ exchangeProgram 4 with code := .loop (.eq 0 0) (.op (.copy 0 0)) }).eval 4 2 7 + ({ exchangeProgram 4 with code := .loop (.eq 0 0) (.op (.copy 0 0)) } : + DynamicProgram (exchangeSpec 4) 3 .standard).eval 4 2 7 ⟨fun _ => 0, fun _ => 0⟩ = none := by decide diff --git a/ComplexityTests/WordRAMRandomizedSubroutine.lean b/ComplexityTests/WordRAMRandomizedSubroutine.lean new file mode 100644 index 000000000..23f2c2292 --- /dev/null +++ b/ComplexityTests/WordRAMRandomizedSubroutine.lean @@ -0,0 +1,471 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Computability.WordRAM.Randomized.Expected +public import Complexity.Computability.WordRAM.Randomized.Subroutine + +/-! +# Randomized Word-RAM geometric loop and subroutine interface tests + +Verifies the distributional structured execution relation `ExecCodeDist`, the geometric Las Vegas +loop expected-time bound `ExecCodeDist.loop_geometric`, and the randomized Word-RAM subroutine +interface `Cslib.WordRAM.Randomized.SubroutineDS`: +* a concrete geometric coin-flipping Las Vegas loop (`while r0 == r1 do r0 ← rand r1` with + `r1 = 1` and exit probability `1 / 2` per iteration) almost surely halts with `r0 = 0` and + bounded expected step count; +* a concrete randomized data structure executing `Instr.rand` during its operations instantiates + `Cslib.WordRAM.Randomized.SubroutineDS` and exercises `toStandard`, `initFresh_exec`, + `initClear_exec`, `frame_caller_dist` (across a randomized caller step), `call_rename`, and + `seq_expected_amortized`. +-/ + +@[expose] public section + +namespace ComplexityTests.WordRAMRandomizedSubroutine + +open Cslib Cslib.WordRAM Cslib.WordRAM.Randomized +open Cslib.Probability.PMF (uniformOfFintype uniformOfFintype_apply) +open scoped ENNReal + +/-! ## 1. Geometric coin-flipping Las Vegas loop (`ExecCodeDist.loop_geometric`) -/ + +abbrev g0 : Fin 2 := 0 +abbrev g1 : Fin 2 := 1 + +/-- Geometric Las Vegas loop: while `r0 == r1` (with `r1 = 1`), sample `r0 ← rand r1` uniformly +from `{0, 1}`. Each iteration exits with probability `1 / 2` in `1` body instruction. -/ +def geomCoinLoop : Code .exact 2 := + .loop (.eq g0 g1) (.rand g0 g1) + +/-- Loop-head invariant: `x` is `w`-bounded and `r1 = 1`. -/ +def geomInv (w : ℕ) (x : Data 2) : Prop := + x.Bounded w ∧ x.regs g1 = 1 + +/-- Loop-exit postcondition: `x` is `w`-bounded, `r0 = 0`, and `r1 = 1`. -/ +def geomPost (w : ℕ) (x : Data 2) : Prop := + x.Bounded w ∧ x.regs g0 = 0 ∧ x.regs g1 = 1 + +/-- Single-iteration transition distribution of `r0 ← rand r1` when `r1 = 1`. -/ +noncomputable def geomBodyDist (x : Data 2) : PMF (Data 2) := + (uniformOfFintype (Fin (x.regs g1 + 1))).map fun k => x.set g0 k.val + +private theorem fits_one_of_pos {w : ℕ} (hw : 1 ≤ w) : Fits w 1 := + fits_one (by omega) + +theorem geomCoinLoop_execCodeDist {w : ℕ} (hw : 1 ≤ w) (x₀ : Data 2) + (hx₀ : geomInv w x₀ ∧ (Cond.eq g0 g1).Holds x₀) : + ∃ μ_exit : PMF (Data 2), + ExecCodeDist w geomCoinLoop x₀ μ_exit (((1 : ℝ≥0∞) + 2) / (2 : ℝ≥0∞)⁻¹ + 2) ∧ + ∀ y ∈ μ_exit.support, ¬(Cond.eq g0 g1).Holds y ∧ geomPost w y := by + have hp_pos : (0 : ℝ≥0∞) < (2 : ℝ≥0∞)⁻¹ := by simp + have hp_top : ((2 : ℝ≥0∞)⁻¹) ≠ ⊤ := by simp + have hbody : ∀ z, geomInv w z → (Cond.eq g0 g1).Holds z → + ExecCodeDist (B := .exact) w (.rand g0 g1) z (geomBodyDist z) 1 := by + intro z ⟨hbz, _⟩ _ + simpa [geomBodyDist, ProbComp.eval_unifFin] using ExecCodeDist.rand (B := .exact) (hbz.1 g1) + have hB : ∀ z, geomInv w z → (Cond.eq g0 g1).Holds z → (1 : ℝ≥0∞) ≤ 1 := + fun _ _ _ => le_rfl + have hinv : ∀ z, geomInv w z → (Cond.eq g0 g1).Holds z → + ∀ y ∈ (geomBodyDist z).support, LoopStateInv (.eq g0 g1) (geomInv w) (geomPost w) y := by + intro x ⟨hbx, hr1⟩ _ y hy + rw [geomBodyDist, PMF.mem_support_map_iff] at hy + obtain ⟨k, _, rfl⟩ := hy + have hk_lt : k.val < 2 := by omega + have hby : (x.set g0 k.val).Bounded w := by + refine hbx.set ?_ + rcases Nat.lt_succ_iff_lt_or_eq.mp hk_lt with hk0 | hk1 + · have hk0' : k.val = 0 := Nat.lt_one_iff.mp hk0 + rw [hk0'] + exact fits_zero w + · rw [hk1] + exact fits_one_of_pos hw + have hy_r1 : (x.set g0 k.val).regs g1 = 1 := by + simp [Data.set, hr1] + rcases Nat.lt_succ_iff_lt_or_eq.mp hk_lt with hk0 | hk1 + · have hk0' : k.val = 0 := Nat.lt_one_iff.mp hk0 + right + refine ⟨?_, hby, ?_, hy_r1⟩ + · simp [Cond.Holds, Data.set, hr1, hk0'] + · simp [Data.set, hk0'] + · left + refine ⟨?_, hby, hy_r1⟩ + simp [Cond.Holds, Data.set, hr1, hk1] + have hp_exit : ∀ z, geomInv w z → (Cond.eq g0 g1).Holds z → + (2 : ℝ≥0∞)⁻¹ ≤ (geomBodyDist z).toOuterMeasure {y | ¬(Cond.eq g0 g1).Holds y} := by + intro x ⟨_, hr1⟩ _ + classical + rw [PMF.toOuterMeasure_apply] + have h_zero_lt : 0 < x.regs g1 + 1 := by omega + let k₀ : Fin (x.regs g1 + 1) := ⟨0, h_zero_lt⟩ + let y₀ : Data 2 := x.set g0 0 + have hy₀_not : ¬(Cond.eq g0 g1).Holds y₀ := by + simp [y₀, Cond.Holds, Data.set, hr1] + have h1 : (2 : ℝ≥0∞)⁻¹ ≤ geomBodyDist x y₀ := by + rw [geomBodyDist, PMF.map_apply] + have hle := le_tsum + (f := fun k : Fin (x.regs g1 + 1) => + if y₀ = x.set g0 k.val then uniformOfFintype (Fin (x.regs g1 + 1)) k else 0) k₀ + simpa [y₀, k₀, uniformOfFintype_apply, hr1] using hle + have h2 : geomBodyDist x y₀ ≤ + ∑' y, Set.indicator {y | ¬(Cond.eq g0 g1).Holds y} (geomBodyDist x) y := by + calc + geomBodyDist x y₀ + = Set.indicator {y | ¬(Cond.eq g0 g1).Holds y} (geomBodyDist x) y₀ := by + rw [Set.indicator_of_mem hy₀_not] + _ ≤ ∑' y, Set.indicator {y | ¬(Cond.eq g0 g1).Holds y} (geomBodyDist x) y := + le_tsum (f := fun y => Set.indicator {y | ¬(Cond.eq g0 g1).Holds y} + (geomBodyDist x) y) y₀ + exact le_trans h1 h2 + have hx₀_inv : LoopStateInv (.eq g0 g1) (geomInv w) (geomPost w) x₀ := Or.inl ⟨hx₀.2, hx₀.1⟩ + refine ⟨loopExitPMF (.eq g0 g1) geomBodyDist x₀, + ExecCodeDist.loop_geometric (geomInv w) (geomPost w) hp_pos hp_top hbody hB hinv hp_exit + hx₀_inv, + fun y hy => + (mem_support_loopExitPMF hp_pos hp_top hinv hp_exit hx₀_inv hy).1⟩ + +/-- Complete flat program for the geometric coin-flipping loop exercises `program_halts`: +it halts almost surely from `r0 = 1, r1 = 1` with finite expected step count. -/ +theorem geomCoinLoop_halts {w : ℕ} (hw : 1 ≤ w) : + let x₀ : Data 2 := ((Data.init [] : Data 2).set g0 1).set g1 1 + AlmostSurelyHalts w (geomCoinLoop.program g0) ⟨0, x₀⟩ ∧ + expectedTime w (geomCoinLoop.program g0) ⟨0, x₀⟩ ≤ + ((1 : ℝ≥0∞) + 2) / (2 : ℝ≥0∞)⁻¹ + 2 + 1 := by + intro x₀ + have hx₀_inv : geomInv w x₀ := by + refine ⟨?_, by simp [x₀, Data.set]⟩ + exact ((Data.Bounded.init (by simp [InputFits])).set + (fits_one_of_pos hw)).set (fits_one_of_pos hw) + have hx₀_cond : (Cond.eq g0 g1).Holds x₀ := by + simp [x₀, Cond.Holds, Data.set] + obtain ⟨μ_exit, hex, _⟩ := geomCoinLoop_execCodeDist hw x₀ ⟨hx₀_inv, hx₀_cond⟩ + obtain ⟨hExp, _, hAS, _⟩ := hex.program_halts g0 + have h12_ne : (1 : ℝ≥0∞) + 2 ≠ ⊤ := + ENNReal.add_ne_top.mpr ⟨ENNReal.one_ne_top, ENNReal.ofNat_ne_top⟩ + have hT_ne : ((1 : ℝ≥0∞) + 2) / (2 : ℝ≥0∞)⁻¹ + 2 ≠ ⊤ := + ENNReal.add_ne_top.mpr ⟨ENNReal.div_ne_top h12_ne (by simp), ENNReal.ofNat_ne_top⟩ + exact ⟨hAS hT_ne, hExp⟩ + +/-! ## 2. Concrete randomized data structure (`Cslib.WordRAM.Randomized.SubroutineDS`) -/ + +/-- Trivial stateful specification for a randomized sampler subroutine whose implementation invokes +`Instr.rand` during each operation. -/ +def coinSpec : Stateful.Spec.{0, 0, 0} where + State := PUnit + Op := PUnit + Result _ := PUnit + step _ _ := (PUnit.unit, PUnit.unit) + +/-- Subroutine code with 5 registers (`0` = `baseReg`, `1` = `frontierReg`, `2` = `zeroReg`, +`3` = `curReg` / scratch output, `4` = `oneReg`). Its operation body `code` executes +`r3 ← rand r4` (`Instr.rand`), with `r4 = 1`, so it samples both `0` and `1`. -/ +def coinSubroutineCode : SubroutineCode .exact 5 0 where + allocSpan := .op (.copy 0 1) + initSetup := .op (.const 4 1) + code := .rand 3 4 + baseReg := 0 + frontierReg := 1 + zeroReg := 2 + oneReg := 4 + curReg := 3 + incCur := Op.exactBin .add 3 3 4 + initParams := Fin.elim0 + input i := i == 3 + output := 3 + +/-- Representation invariant for `coinSubroutineCode`: machine words are `w`-bounded, `baseReg` +holds `base`, and `oneReg` holds `1`. -/ +def coinRep (w base : ℕ) (_θ : Fin 2) (_s : PUnit) (x : Data 5) : Prop := + x.Bounded w ∧ x.regs 0 = base ∧ x.regs 4 = 1 + +private theorem pmf_map_fst_const {α β γ : Type*} (q : PMF α) (b : β) (g : α → γ) : + (q.map fun a => (b, g a)).map Prod.fst = PMF.pure b := by + ext θ + classical + rw [PMF.map_comp] + by_cases h : θ = b <;> simp [PMF.map_apply, h, q.tsum_coe] + +private theorem pmf_map_snd_const {α β γ : Type*} (q : PMF α) (f : α → β) (c : γ) : + (q.map fun a => (f a, c)).map Prod.snd = PMF.pure c := by + ext y + classical + rw [PMF.map_comp] + by_cases h : y = c <;> simp [PMF.map_apply, h, q.tsum_coe] + +/-- Concrete randomized `SubroutineDS` certificate for `coinSubroutineCode` with latent seed type +`Fin 2` and uniform reference distribution `uniformOfFintype (Fin 2)`. The native operation +samples from `Fin 2`; its randomness is separate from this latent coupling seed. -/ +noncomputable def coinSubroutineDS (w base : ℕ) (hw : 1 ≤ w) : + Cslib.WordRAM.Randomized.SubroutineDS + coinSubroutineCode coinSpec w base Fin.elim0 PUnit.unit where + Seed := Fin 2 + seedLaw := uniformOfFintype (Fin 2) + seedSlack := 1 + seedSlack_ne_top := ENNReal.one_ne_top + space := 0 + spanTime := 1 + setupTime := 1 + initPotential := 0 + charge _ _ := 1 + rep := coinRep w base + potential _ _ := 0 + encode _ _ := 0 + argMatch _ _ := True + decode _ _ := some PUnit.unit + bounded h := h.1 + rep_unique _ _ := rfl + arguments_fit _ _ _ _ := fits_zero w + encode_matches _ _ := trivial + rep_supported hreg _ hb' hrep := + ⟨hb', + by rw [hreg 0 rfl, hrep.2.1], + by rw [hreg 4 rfl, hrep.2.2]⟩ + potential_supported _ _ _ := rfl + clear_nodup := by decide + params_not_clear j := Fin.elim0 j + incCur_eval {x} h1 hfit := by + change Data.put w x 3 (x.regs 3 + x.regs 4) = + some (x.set coinSubroutineCode.curReg (x.regs coinSubroutineCode.curReg + 1)) + change x.regs 4 = 1 at h1 + rw [h1] + exact Data.put_of_fits hfit + span_exec hx hfr _ := by + refine ⟨_, ExecWithin.copy, rfl, ?_, ?_, fun j => Fin.elim0 j⟩ + · simpa [coinSubroutineCode, Data.set] using hfr + · simpa [coinSubroutineCode, Data.set] using hfr + setup_exec {x₁} hx₁ hb₁ hfr₁ _ _ := by + let x₂ : Data 5 := x₁.set 4 1 + let ν₀ : PMF (Fin 2 × Data 5) := (uniformOfFintype (Fin 2)).map fun θ => (θ, x₂) + refine ⟨ν₀, ?_, ?_, ?_⟩ + · have hex : ExecCodeDist (B := .exact) w (.op (.const 4 1)) x₁ (PMF.pure x₂) (1 : ℕ) := + ExecCodeDist.of_exec (Exec.const (fits_one_of_pos hw)) + exact hex.congr_dist (pmf_map_snd_const (uniformOfFintype (Fin 2)) id x₂).symm (by simp) + · intro θ + rw [PMF.map_comp] + simp + · intro p hp + rw [PMF.mem_support_map_iff] at hp + obtain ⟨θ, _, rfl⟩ := hp + refine ⟨?_, ?_, Nat.le_refl 0, Modifies.refl _ _⟩ + · simpa [coinSubroutineCode, x₂, Data.set] using hfr₁ + · refine ⟨hx₁.set (fits_one_of_pos hw), ?_, ?_⟩ + · simp [x₂, Data.set, ← hb₁, coinSubroutineCode] + · simp [x₂, Data.set] + step_exec _ ν _ hseed hsupp := by + let μ_step : Fin 2 × Data 5 → PMF (Fin 2 × Data 5) := fun p => + (uniformOfFintype (Fin (p.2.regs 4 + 1))).map fun k => (p.1, p.2.set 3 k.val) + refine ⟨μ_step, fun _ => 1, ?_, ?_, ?_⟩ + · intro p hp + obtain ⟨⟨hbp, hb0, ho4⟩, _⟩ := hsupp p hp + refine ⟨?_, ?_⟩ + · have hr := ExecCodeDist.rand (B := .exact) (w := w) (x := p.2) (dst := 3) (src := 4) + (hbp.1 4) + refine hr.congr_dist ?_ le_rfl + rw [ProbComp.eval_unifFin, PMF.map_comp] + rfl + · intro q hq + rw [PMF.mem_support_map_iff] at hq + obtain ⟨k, _, rfl⟩ := hq + have hk1 : k.val ≤ 1 := by omega + refine ⟨rfl, ⟨?_, ?_, ?_⟩, Modifies.refl _ _⟩ + · exact hbp.set ((fits_one_of_pos hw).of_le hk1) + · simp [Data.set, hb0] + · simp [Data.set, ho4] + · intro θ' + have hmap : (ν.bind μ_step).map Prod.fst = ν.map Prod.fst := by + rw [PMF.map_bind, PMF.map] + refine congrArg (ν.bind ·) (funext fun p => ?_) + exact pmf_map_fst_const (uniformOfFintype (Fin (p.2.regs 4 + 1))) p.1 + (fun k => p.2.set 3 k.val) + rw [hmap] + exact hseed θ' + · simp [ν.tsum_coe] + +/-- The concrete represented state with `oneReg = 1` executes the native sampler in one body +instruction, and its output register is exactly fair on both `0` and `1`. -/ +theorem coinSubroutineCode_two_outcomes {w : ℕ} (hw : 1 ≤ w) : + let x : Data 5 := (Data.init []).set 4 1 + let μ : PMF (Data 5) := (uniformOfFintype (Fin 2)).map fun k => x.set 3 k.val + coinRep w 0 0 PUnit.unit x ∧ + ExecCodeDist w coinSubroutineCode.code x μ 1 ∧ + (μ.map fun y => y.regs 3) 0 = (2 : ℝ≥0∞)⁻¹ ∧ + (μ.map fun y => y.regs 3) 1 = (2 : ℝ≥0∞)⁻¹ := by + intro x μ + have hx : x.Bounded w := + (Data.Bounded.init (by simp [InputFits])).set (fits_one_of_pos hw) + refine ⟨⟨hx, by simp [x, Data.set], by simp [x, Data.set]⟩, ?_, ?_, ?_⟩ + · have hsource : x.regs 4 = 1 := by simp [x, Data.set] + have he := ExecCodeDist.rand (B := .exact) (w := w) (x := x) (dst := 3) (src := 4) (hx.1 4) + rw [ProbComp.eval_unifFin, hsource] at he + exact he + · simp [μ, PMF.map_comp, Function.comp_def, PMF.map_apply, tsum_fintype, + Fin.sum_univ_two, uniformOfFintype_apply, Data.set] + · simp [μ, PMF.map_comp, Function.comp_def, PMF.map_apply, tsum_fintype, + Fin.sum_univ_two, uniformOfFintype_apply, Data.set] + +/-- Standard-basis lifting of `coinSubroutineDS`. -/ +noncomputable def coinSubroutineDS_standard (w base : ℕ) (hw : 1 ≤ w) : + Cslib.WordRAM.Randomized.SubroutineDS + coinSubroutineCode.toStandard coinSpec w base Fin.elim0 PUnit.unit := + (coinSubroutineDS w base hw).toStandard + +/-- Fresh initialization + multi-operation expected-amortized sequence bound for +`coinSubroutineDS`. -/ +theorem coinSubroutineDS_seq_amortized (w base : ℕ) (hw : 1 ≤ w) + (ops : List PUnit) {x₀ : Data 5} + (hx₀ : x₀.Bounded w) (hfr : x₀.regs 1 = base) : + let C := coinSubroutineDS w base hw + ∃ (ν₀ ν_final : PMF (C.Seed × Data 5)) (T_ops : ℝ≥0∞), + ExecCodeDist w coinSubroutineCode.initFresh x₀ (ν₀.map Prod.snd) C.initTime ∧ + C.ExecSteps PUnit.unit ops ν₀ ν_final T_ops ∧ + (∀ θ, (ν_final.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + (∀ p ∈ ν_final.support, C.rep p.1 (coinSpec.run PUnit.unit ops).1 p.2) ∧ + C.initTime + T_ops + (∑' q, ν_final q * (C.potential q.1 q.2 : ℝ≥0∞)) ≤ + C.initTime + (C.initPotential : ℝ≥0∞) + + (coinSpec.totalCost C.charge PUnit.unit ops : ℝ≥0∞) := by + intro C + have hvalid : coinSpec.ValidHistory PUnit.unit ops := by + induction ops with + | nil => trivial + | cons _ _ ih => exact ⟨trivial, ih⟩ + have hz : ∀ a ∈ (Block.mk base C.space).footprint, x₀.mem a = 0 := by + change ∀ a ∈ (Block.mk base 0).footprint, x₀.mem a = 0 + simp [Block.footprint] + exact C.seq_expected_amortized ops hx₀ hfr (fun j => Fin.elim0 j) hz hvalid + +/-- From concrete empty memory, initialization and two genuine coin-sampling bodies have +expected cost at most four; external argument delivery is uncharged by `ExecSteps`. -/ +example : + let C := coinSubroutineDS 1 0 (by decide) + ∃ (ν₀ ν_final : PMF (C.Seed × Data 5)) (T_ops : ℝ≥0∞), + ExecCodeDist 1 coinSubroutineCode.initFresh (Data.init []) (ν₀.map Prod.snd) C.initTime ∧ + C.ExecSteps PUnit.unit [PUnit.unit, PUnit.unit] ν₀ ν_final T_ops ∧ + C.initTime + T_ops ≤ 4 := by + intro C + obtain ⟨ν₀, ν_final, T_ops, hinit, hsteps, _, _, hcost⟩ := + coinSubroutineDS_seq_amortized 1 0 (by decide) [PUnit.unit, PUnit.unit] + (x₀ := (Data.init [] : Data 5)) + (Data.Bounded.init (by simp [InputFits])) (by simp [Data.init]) + refine ⟨ν₀, ν_final, T_ops, hinit, hsteps, ?_⟩ + have hT : T_ops ≤ 2 := by + simpa [C, coinSubroutineDS, Cslib.WordRAM.Randomized.SubroutineDS.initTime, + Stateful.Spec.totalCost, coinSpec] using hcost + have hinitTime : C.initTime = 2 := by + norm_num [C, coinSubroutineDS, Cslib.WordRAM.Randomized.SubroutineDS.initTime] + rw [hinitTime] + calc + 2 + T_ops ≤ 2 + 2 := add_le_add le_rfl hT + _ = 4 := by norm_num + +/-- Dirty-memory initialization via `initClear_exec` for `coinSubroutineDS`. -/ +theorem coinSubroutineDS_initClear (w base : ℕ) (hw : 1 ≤ w) {x₀ : Data 5} + (hx₀ : x₀.Bounded w) (hfr : x₀.regs 1 = base) : + let C := coinSubroutineDS w base hw + ∃ ν₀ : PMF (C.Seed × Data 5), + ExecCodeDist w coinSubroutineCode.initClear x₀ (ν₀.map Prod.snd) + (C.initTime + (4 * C.space + 6 : ℕ)) ∧ + (∀ θ, (ν₀.map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + ∀ p ∈ ν₀.support, + p.2.regs coinSubroutineCode.frontierReg = base + C.space ∧ + C.rep p.1 PUnit.unit p.2 ∧ + C.potential p.1 p.2 ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x₀.mem p.2.mem := by + intro C + exact C.initClear_exec hx₀ hfr (fun j => Fin.elim0 j) + +/-- Inline caller subroutine invocation via `call_rename` for `coinSubroutineDS`: a caller with +6 registers embeds `Fin 5` via `Fin.castSucc`, executes `prep := .op (.const 5 0)` on its own +register `r5`, and invokes `coinSubroutineCode.code.rename Fin.castSucc`. -/ +theorem coinSubroutineDS_call_rename (w base : ℕ) (hw : 1 ≤ w) + (ν : PMF ((coinSubroutineDS w base hw).Seed × Data 6)) + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ + (coinSubroutineDS w base hw).seedSlack * (coinSubroutineDS w base hw).seedLaw θ) + (hrep : ∀ p ∈ ν.support, + (coinSubroutineDS w base hw).rep p.1 PUnit.unit (p.2.comap Fin.castSucc)) : + let C := coinSubroutineDS w base hw + let prep : Code .exact 6 := .op (.const 5 0) + ∃ (μ_call : C.Seed × Data 6 → PMF (C.Seed × Data 6)) + (T_call : C.Seed × Data 6 → ℝ≥0∞), + (∀ p ∈ ν.support, + ExecCodeDist w (.seq prep (coinSubroutineCode.code.rename Fin.castSucc)) + p.2 ((μ_call p).map Prod.snd) (T_call p) ∧ + ∀ q ∈ (μ_call p).support, + C.decode PUnit.unit (q.2.comap Fin.castSucc).regs = + some (coinSpec.step PUnit.unit PUnit.unit).2 ∧ + C.rep q.1 (coinSpec.step PUnit.unit PUnit.unit).1 (q.2.comap Fin.castSucc) ∧ + ∃ x' ∈ (PMF.pure (p.2.set 5 0) : PMF (Data 6)).support, + Modifies (Block.mk base C.space).footprint x'.mem q.2.mem ∧ + ∀ j ∉ Set.range (Fin.castSucc : Fin 5 → Fin 6), q.2.regs j = x'.regs j) ∧ + (∀ θ', ((ν.bind μ_call).map Prod.fst) θ' ≤ C.seedSlack * C.seedLaw θ') ∧ + (∑' p, ν p * (T_call p + + ∑' q, μ_call p q * (C.potential q.1 (q.2.comap Fin.castSucc) : ℝ≥0∞))) ≤ + 1 + (C.charge PUnit.unit PUnit.unit : ℝ≥0∞) + + ∑' p, ν p * (C.potential p.1 (p.2.comap Fin.castSucc) : ℝ≥0∞) := by + intro C prep + refine C.call_rename (Fin.castSucc_injective 5) PUnit.unit ν + (prep := prep) (B_prep := 1) + (μ_prep := fun p => PMF.pure (p.2.set 5 0)) (T_prep := fun _ => 1) + trivial hseed hrep ?_ + intro p hp + refine ⟨?_, le_rfl, ?_⟩ + · simpa [prep] using ExecCodeDist.of_exec (B := .exact) (w := w) (x := p.2) + (Exec.const (d := (5 : Fin 6)) (fits_zero w)) + · intro x' hx' + rw [PMF.mem_support_pure_iff] at hx' + subst hx' + have hbp : (p.2.comap Fin.castSucc).Bounded w := C.bounded (hrep p hp) + refine ⟨?_, ?_, fun _ _ => rfl, trivial⟩ + · refine ⟨fun i => ?_, hbp.2⟩ + have hne : Fin.castSucc i ≠ (5 : Fin 6) := Fin.castSucc_ne_last i + simp only [Data.comap_regs, Data.set_regs, Function.update_of_ne hne] + exact hbp.1 i + · intro i _ + have hne : Fin.castSucc i ≠ (5 : Fin 6) := Fin.castSucc_ne_last i + simp [Data.set, hne] + +/-- Caller framing across a randomized caller step: a caller with 6 registers embeds `Fin 5` via +`Fin.castSucc` and executes `r5 ← rand r4` on its own register `r5` (`5 : Fin 6`), preserving the +coupled seed marginal bound, `rep`, and expected potential via `frame_caller_dist`. -/ +theorem coinSubroutineDS_caller_rand_frame (w base : ℕ) (hw : 1 ≤ w) + (ν : PMF ((coinSubroutineDS w base hw).Seed × Data 6)) + (hseed : ∀ θ, (ν.map Prod.fst) θ ≤ + (coinSubroutineDS w base hw).seedSlack * (coinSubroutineDS w base hw).seedLaw θ) + (hrep : ∀ p ∈ ν.support, + (coinSubroutineDS w base hw).rep p.1 PUnit.unit (p.2.comap Fin.castSucc)) : + let C := coinSubroutineDS w base hw + let μ_caller : C.Seed × Data 6 → PMF (Data 6) := fun p => + (uniformOfFintype (Fin 2)).map fun k => p.2.set 5 k.val + (∀ p ∈ ν.support, ExecCodeDist (B := .exact) w (.rand 5 4) p.2 (μ_caller p) 1) ∧ + (∀ θ, ((C.frameDist ν μ_caller).map Prod.fst) θ ≤ C.seedSlack * C.seedLaw θ) ∧ + (∀ q ∈ (C.frameDist ν μ_caller).support, C.rep q.1 PUnit.unit (q.2.comap Fin.castSucc)) ∧ + (∑' q, C.frameDist ν μ_caller q * (C.potential q.1 (q.2.comap Fin.castSucc) : ℝ≥0∞)) = + ∑' p, ν p * (C.potential p.1 (p.2.comap Fin.castSucc) : ℝ≥0∞) := by + intro C μ_caller + refine ⟨?_, ?_⟩ + · intro p hp + have hsource : p.2.regs 4 = 1 := (hrep p hp).2.2 + have hfit : Fits w (p.2.regs 4) := by rw [hsource]; exact fits_one_of_pos hw + have he := ExecCodeDist.rand (B := .exact) (w := w) (x := p.2) (dst := 5) (src := 4) hfit + rw [ProbComp.eval_unifFin, hsource] at he + exact he + · refine C.frame_caller_dist (F := ∅) hseed hrep (Finset.disjoint_empty_right _) ?_ + intro p hp x' hx' + rw [PMF.mem_support_map_iff] at hx' + obtain ⟨k, _, rfl⟩ := hx' + have hbp : (p.2.comap Fin.castSucc).Bounded w := C.bounded (hrep p hp) + refine ⟨?_, ?_, Modifies.refl _ _⟩ + · refine ⟨fun i => ?_, hbp.2⟩ + have hne : Fin.castSucc i ≠ (5 : Fin 6) := Fin.castSucc_ne_last i + simp only [Data.comap_regs, Data.set_regs, Function.update_of_ne hne] + exact hbp.1 i + · intro i _ + have hne : Fin.castSucc i ≠ (5 : Fin 6) := Fin.castSucc_ne_last i + simp [Data.set, hne] + +end ComplexityTests.WordRAMRandomizedSubroutine diff --git a/ComplexityTests/WordRAMRelSubroutine.lean b/ComplexityTests/WordRAMRelSubroutine.lean new file mode 100644 index 000000000..b8aeee2fd --- /dev/null +++ b/ComplexityTests/WordRAMRelSubroutine.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Init +public import Complexity.Computability.WordRAM.RelSubroutine + +/-! +# Tests for Relational Word-RAM Subroutine Realizations + +Concrete non-vacuous tests for `Cslib.WordRAM.RelSubroutineDS`, `DynamicProgram`, +`RelDynamicCertificate`, `SubroutineDS.toRelSubroutineDS`, `RelSubroutineDS.toStandard`, +`RelSubroutineDS.call_rename`, `RelSubroutineDS.run_client_amortized`, +`RelSubroutineDS.run_ops_exact_fresh`, and `RelSubroutineDS.run_ops_exact_reusable` on a +genuinely nondeterministic two-slot allocator specification. +-/ + +@[expose] public section + +namespace ComplexityTests.WordRAMRelSubroutine + +open Cslib Cslib.Stateful Cslib.WordRAM + +/-! ## 1. Nondeterministic two-slot allocator specification -/ + +/-- Relational specification of a two-slot allocator: from state `(b₀, b₁) : Bool × Bool`, an +allocation operation `()` nondeterministically returns any free slot `i : Fin 2` and marks slot +`i` occupied. When both slots are free (`(false, false)`), both `0` and `1` are permitted. -/ +abbrev TwoSlotAlloc : RelSpec where + State := Bool × Bool + Op := Unit + Result _ := Fin 2 + valid s _ := s.1 = false ∨ s.2 = false + step s _ s' i := + (i = 0 ∧ s.1 = false ∧ s' = (true, s.2)) ∨ + (i = 1 ∧ s.2 = false ∧ s' = (s.1, true)) + +instance : TwoSlotAlloc.Total where + step_total s _ hv := by + rcases hv with h0 | h1 + · exact ⟨(true, s.2), 0, Or.inl ⟨rfl, h0, rfl⟩⟩ + · exact ⟨(s.1, true), 1, Or.inr ⟨rfl, h1, rfl⟩⟩ + +/-! ## 2. Concrete `SubroutineCode .exact` implementation and `RelSubroutineDS` certificate -/ + +/-- Six-register `.exact` Word-RAM subroutine implementing `TwoSlotAlloc` by sequential +allocation of slot `0` followed by slot `1`: +* register `0`: `baseReg` (persistent) +* register `1`: `frontierReg` (persistent) +* register `2`: `curReg` (scratch) +* register `3`: `zeroReg` (scratch) +* register `4`: `oneReg` / `output` (scratch) +* register `5`: persistent next-free-slot counter (`0`, `1`, or `2`). -/ +abbrev twoSlotCode : SubroutineCode .exact 6 0 where + allocSpan := .op (.copy 0 1) + initSetup := .op (.const 5 0) + code := .seq (.op (.copy 4 5)) (.seq (.op (.const 3 1)) (.op (.exactBin .add 5 5 3))) + frontierReg := 1 + baseReg := 0 + initParams := Fin.elim0 + curReg := 2 + zeroReg := 3 + oneReg := 4 + incCur := .exactBin .add 2 2 4 + input i := i == 2 || i == 3 || i == 4 + output := 4 + +/-- Representation invariant for `twoSlotCode` at word width `w` and base address `base`. -/ +abbrev twoSlotRep (w base : ℕ) (s : Bool × Bool) (x : Data 6) : Prop := + x.Bounded w ∧ x.regs 0 = base ∧ + ((s = (false, false) ∧ x.regs 5 = 0) ∨ + (s = (true, false) ∧ x.regs 5 = 1) ∨ + (s = (true, true) ∧ x.regs 5 = 2)) + +/-- `RelSubroutineDS` certificate showing that `twoSlotCode` realizes the nondeterministic +`TwoSlotAlloc` specification whenever `Fits w 2`. -/ +abbrev twoSlotSubroutine (w base : ℕ) (h2 : Fits w 2) : + RelSubroutineDS twoSlotCode TwoSlotAlloc w base Fin.elim0 (false, false) where + space := 0 + spanTime := 1 + setupTime := 1 + initPotential := 0 + charge _ _ := 3 + rep := twoSlotRep w base + potential _ := 0 + encode _ _ := 0 + argMatch _ _ := True + decode _ regs := some ⟨regs 4 % 2, Nat.mod_lt _ (by decide)⟩ + bounded hr := hr.1 + arguments_fit _ _ _ _ := fits_zero w + encode_matches _ _ := trivial + rep_supported {s x x'} hregs _ hx' hr := by + refine ⟨hx', ?_, ?_⟩ + · rw [hregs 0 rfl]; exact hr.2.1 + · rw [hregs 5 rfl]; exact hr.2.2 + potential_supported _ _ _ := rfl + clear_nodup := by decide + params_not_clear j := j.elim0 + incCur_eval {x} hone hfit := by + simp only [Op.eval_exactBin, BinOp.evalExact, hone, Option.bind_some, Data.put_of_fits hfit] + span_exec {x} _ hfr _ := by + refine ⟨x.set 0 (x.regs 1), ⟨1, Nat.le_refl 1, Exec.copy⟩, rfl, ?_, ?_, fun j => j.elim0⟩ + · simp [Data.set, hfr] + · simp [Data.set, hfr] + setup_exec {x₁} hx₁ hb₁ hfr₁ _ _ := by + refine ⟨x₁.set 5 0, ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩, ?_, ?_, Nat.le_refl 0, + fun _ _ => rfl⟩ + · simp [Data.set, hfr₁] + · refine ⟨hx₁.set (fits_zero w), ?_, Or.inl ⟨rfl, by simp [Data.set]⟩⟩ + simp [Data.set, hb₁] + step_exec {s x} _ hr hv _ := by + have h1 : Fits w 1 := h2.of_le (by decide) + rcases hr with ⟨hx, hb, ⟨rfl, h5⟩ | ⟨rfl, h5⟩ | ⟨rfl, _⟩⟩ + · let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + simpa [x₂, x₁, Data.set, h5] using h1 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + have hy_b : y.Bounded w := hex.bounded hx + refine ⟨y, (true, false), 0, 3, hex, Or.inl ⟨rfl, rfl, rfl⟩, ?_, ?_, + fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · refine ⟨hy_b, ?_, Or.inr (Or.inl ⟨rfl, ?_⟩)⟩ + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + · let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + simpa [x₂, x₁, Data.set, h5] using h2 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + have hy_b : y.Bounded w := hex.bounded hx + refine ⟨y, (true, true), 1, 3, hex, Or.inr ⟨rfl, rfl, rfl⟩, ?_, ?_, + fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · refine ⟨hy_b, ?_, Or.inr (Or.inr ⟨rfl, ?_⟩)⟩ + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + · cases hv with + | inl h => cases h + | inr h => cases h + +/-! ## 3. Exercising `call_rename`, `run_client_amortized`, and flat-program execution -/ + +/-- Adaptive client allocating two slots sequentially and returning both indices. -/ +abbrev allocPair : TwoSlotAlloc.Client (Fin 2 × Fin 2) := + .liftBind () fun i => + .liftBind () fun j => + .pure (i, j) + +/-- `allocPair` is demonically admissible from `(false, false)` across all permitted outcomes. -/ +theorem allocPair_demonicValid : + TwoSlotAlloc.DemonicValid (false, false) allocPair := by + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) () _ (Or.inl rfl) fun s₁ i h₁ => ?_ + have hv₂ : TwoSlotAlloc.valid s₁ () := by + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact Or.inr rfl + · exact Or.inl rfl + exact RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) () _ hv₂ + fun s₂ j _ => .pure s₂ (i, j) + +/-- Standalone adaptive-client amortized theorem via `RelSubroutineDS.toStandard` and +`RelSubroutineDS.run_client_amortized`. -/ +theorem twoSlot_run_client_amortized (w base : ℕ) (h2 : Fits w 2) + {x : Data 6} (hr : (twoSlotSubroutine w base h2).rep (false, false) x) : + ∃ a y traces s' tr, + Stateful.Executes + ((twoSlotSubroutine w base h2).toStandard.toDynamicProgram.ExecOp w) + allocPair x a y traces ∧ + TwoSlotAlloc.ClientRun (false, false) allocPair a s' tr ∧ + (twoSlotSubroutine w base h2).rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ + TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := + (twoSlotSubroutine w base h2).toStandard.run_client_bound (fun _ => rfl) + allocPair hr allocPair_demonicValid + +/-- Canonical injective register embedding `Fin 6 → Fin 8`. -/ +def embed6to8 : Fin 6 → Fin 8 := Fin.castLE (by decide) + +theorem embed6to8_injective : Function.Injective embed6to8 := + (Fin.castLEOrderEmb (by decide : 6 ≤ 8)).injective + +/-- Relocated inline call via `RelSubroutineDS.call_rename` inside an 8-register caller. -/ +theorem twoSlot_call_rename (w base : ℕ) (h2 : Fits w 2) + {x : Data 8} (hx : (x.comap embed6to8).Bounded w) + (hr : (twoSlotSubroutine w base h2).rep (false, false) (x.comap embed6to8)) : + ∃ z s' a t, + ExecWithin w (.seq (.op (.const 2 0)) (twoSlotCode.code.rename embed6to8)) x z t ∧ + TwoSlotAlloc.step (false, false) () s' a ∧ + (twoSlotSubroutine w base h2).decode () + (z.comap embed6to8).regs = some a ∧ + (twoSlotSubroutine w base h2).rep s' (z.comap embed6to8) ∧ + Modifies (Block.mk base 0).footprint (x.set 2 0).mem z.mem ∧ + (∀ j ∉ Set.range embed6to8, z.regs j = (x.set 2 0).regs j) ∧ + t ≤ 4 := by + have hprep : ExecWithin (B := .exact) w (.op (.const (2 : Fin 8) 0)) x (x.set 2 0) 1 := + ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩ + have hb' : ((x.set 2 0).comap embed6to8).Bounded w := by + refine ⟨fun i => ?_, hx.2⟩ + by_cases hi : embed6to8 i = 2 + · simp [Data.comap, Data.set, hi, fits_zero w] + · simp only [Fin.isValue, Data.comap_regs, Data.set_regs, Function.update_of_ne hi] + exact hx.1 i + have hreg : ∀ i : Fin 6, twoSlotCode.input i = false → + (x.set 2 0).regs (embed6to8 i) = x.regs (embed6to8 i) := by + intro i hi + have hne : embed6to8 i ≠ 2 := by + fin_cases i <;> revert hi <;> decide + simp [Data.set, Function.update_of_ne hne] + obtain ⟨z, s', a, t, he, hstep, hdec, hrep, hmod, hframe, ht⟩ := + (twoSlotSubroutine w base h2).call_rename + embed6to8_injective () hr (Or.inl rfl) hprep hb' hreg (fun _ _ => rfl) trivial + exact ⟨z, s', a, t, he, hstep, hdec, hrep, hmod, hframe, by omega⟩ + +/-- Two-operation sequence `[(), ()]` is demonically valid from `(false, false)`. -/ +theorem twoSlot_validOpSeq : + TwoSlotAlloc.ValidOpSeq (false, false) [(), ()] := by + refine ⟨Or.inl rfl, fun s₁ a₁ h₁ => ?_⟩ + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact ⟨Or.inr rfl, fun _ _ _ => trivial⟩ + · exact ⟨Or.inl rfl, fun _ _ _ => trivial⟩ + +/-- Flat-program execution on fresh zeroed memory via `RelSubroutineDS.run_ops_exact_fresh`. -/ +theorem twoSlot_run_ops_fresh (w base : ℕ) (h2 : Fits w 2) + {d₀ : Data 6} (hd₀ : d₀.Bounded w) (hfr : d₀.regs 1 = base) + (hz : ∀ a ∈ (Block.mk base 0).footprint, d₀.mem a = 0) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w twoSlotCode.initFreshProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w twoSlotCode.initFreshProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base 0).footprint d₀.mem x₀.mem ∧ + (twoSlotSubroutine w base h2).RunsRelOps + (twoSlotSubroutine w base h2).prepareRegs (false, false) x₀ [(), ()] tr s_fin z + t_ops ∧ + tr.ops = [(), ()] ∧ + TwoSlotAlloc.ValidTranscript (false, false) tr s_fin ∧ + (twoSlotSubroutine w base h2).rep s_fin z ∧ + t_init ≤ 2 ∧ + t_ops ≤ TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := by + obtain ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, ht_ops⟩ := + (twoSlotSubroutine w base h2).run_ops_exact_fresh + hd₀ hfr (fun j => j.elim0) hz [(), ()] twoSlot_validOpSeq + exact ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, by simpa using ht_ops⟩ + +/-- Flat-program execution on reusable dirty memory via `RelSubroutineDS.run_ops_exact_reusable`. -/ +theorem twoSlot_run_ops_reusable (w base : ℕ) (h2 : Fits w 2) + {d₀ : Data 6} (hd₀ : d₀.Bounded w) (hfr : d₀.regs 1 = base) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w twoSlotCode.initClearProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w twoSlotCode.initClearProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base 0).footprint d₀.mem x₀.mem ∧ + (twoSlotSubroutine w base h2).RunsRelOps + (twoSlotSubroutine w base h2).prepareRegs (false, false) x₀ [(), ()] tr s_fin z + t_ops ∧ + tr.ops = [(), ()] ∧ + TwoSlotAlloc.ValidTranscript (false, false) tr s_fin ∧ + (twoSlotSubroutine w base h2).rep s_fin z ∧ + t_init ≤ 8 ∧ + t_ops ≤ TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := by + obtain ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, ht_ops⟩ := + (twoSlotSubroutine w base h2).run_ops_exact_reusable + hd₀ hfr (fun j => j.elim0) [(), ()] twoSlot_validOpSeq + exact ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, by simpa using ht_ops⟩ + +/-! ## 4. Lifting a deterministic `SubroutineDS` via `SubroutineDS.toRelSubroutineDS` -/ + +/-- Deterministic specification of a bounded two-step counter (`0 → 1 → 2`). -/ +abbrev DetCounter2 : Spec where + State := ℕ + Op := Unit + Result _ := Fin 2 + valid n _ := n < 2 + step n _ := (n + 1, ⟨n % 2, Nat.mod_lt _ (by decide)⟩) + +/-- Deterministic `SubroutineDS` certificate for `twoSlotCode` over `DetCounter2`. -/ +abbrev detCounter2Subroutine (w base : ℕ) (h2 : Fits w 2) : + SubroutineDS twoSlotCode DetCounter2 w base Fin.elim0 0 where + space := 0 + spanTime := 1 + setupTime := 1 + initPotential := 0 + charge _ _ := 3 + rep n x := x.Bounded w ∧ x.regs 0 = base ∧ x.regs 5 = n ∧ n ≤ 2 + potential _ := 0 + encode _ _ := 0 + argMatch _ _ := True + decode _ regs := some ⟨regs 4 % 2, Nat.mod_lt _ (by decide)⟩ + bounded hr := hr.1 + rep_unique hr₁ hr₂ := hr₁.2.2.1.symm.trans hr₂.2.2.1 + arguments_fit _ _ _ _ := fits_zero w + encode_matches _ _ := trivial + rep_supported {s x x'} hregs _ hx' hr := by + refine ⟨hx', ?_, ?_, hr.2.2.2⟩ + · rw [hregs 0 rfl]; exact hr.2.1 + · rw [hregs 5 rfl]; exact hr.2.2.1 + potential_supported _ _ _ := rfl + clear_nodup := by decide + params_not_clear j := j.elim0 + incCur_eval {x} hone hfit := by + simp only [Op.eval_exactBin, BinOp.evalExact, hone, Option.bind_some, Data.put_of_fits hfit] + span_exec {x} _ hfr _ := by + refine ⟨x.set 0 (x.regs 1), ⟨1, Nat.le_refl 1, Exec.copy⟩, rfl, ?_, ?_, fun j => j.elim0⟩ + · simp [Data.set, hfr] + · simp [Data.set, hfr] + setup_exec {x₁} hx₁ hb₁ hfr₁ _ _ := by + refine ⟨x₁.set 5 0, ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩, ?_, ?_, Nat.le_refl 0, + fun _ _ => rfl⟩ + · simp [Data.set, hfr₁] + · refine ⟨hx₁.set (fits_zero w), ?_, ?_, Nat.zero_le 2⟩ + · simp [Data.set, hb₁] + · simp [Data.set] + step_exec {s x} _ hr hv _ := by + have h1 : Fits w 1 := h2.of_le (by decide) + obtain ⟨hx, hb, h5, _⟩ := hr + let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + have hfit2 : Fits w (s + 1) := h2.of_le hv + simpa [x₂, x₁, Data.set, h5] using hfit2 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + refine ⟨y, 3, hex, ?_, ⟨hex.bounded hx, ?_, ?_, hv⟩, fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + +/-- Lifting `detCounter2Subroutine` to `RelSubroutineDS` via `SubroutineDS.toRelSubroutineDS`. -/ +def detCounter2RelSubroutine (w base : ℕ) (h2 : Fits w 2) : + RelSubroutineDS twoSlotCode DetCounter2.toRelSpec w base Fin.elim0 0 := + (detCounter2Subroutine w base h2).toRelSubroutineDS + +end ComplexityTests.WordRAMRelSubroutine