From 434f5e19e474a69dd4ece63099cbd10e24405605 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 01:59:53 +0100 Subject: [PATCH 01/88] add #simulate command for random-walk state exploration --- Veil/Base.lean | 10 ++ Veil/Core/Tools/ModelChecker/Simulation.lean | 158 +++++++++++++++++++ Veil/Frontend/DSL/Module/Elaborators.lean | 105 ++++++++++++ Veil/Frontend/DSL/Module/Syntax.lean | 6 + 4 files changed, 279 insertions(+) create mode 100644 Veil/Core/Tools/ModelChecker/Simulation.lean diff --git a/Veil/Base.lean b/Veil/Base.lean index 87ad6447..d348e02d 100644 --- a/Veil/Base.lean +++ b/Veil/Base.lean @@ -97,4 +97,14 @@ register_option veil.smt.timeout : Nat := { descr := "Timeout for the SMT solver in seconds. Default is 60 seconds." } +register_option veil.simulate.maxTraces : Nat := { + defValue := 10000 + descr := "Maximum number of traces to generate during simulation. Default is 10000." +} + +register_option veil.simulate.maxSteps : Nat := { + defValue := 100 + descr := "Maximum number of steps per trace during simulation. Default is 100 (same as TLC)." +} + end Veil diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean new file mode 100644 index 00000000..4030b6d4 --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -0,0 +1,158 @@ +import Veil.Core.Tools.ModelChecker.Interface +import Veil.Core.Tools.ModelChecker.Trace +import Veil.Core.Tools.ModelChecker.Concrete.Core + +namespace Veil.ModelChecker.Simulation + + +/-- Configuration for the `#simulate` command. -/ +structure SimulateConfig where + maxTraces : Nat := 10000 + maxSteps : Nat := 100 + seed : Nat := 0 +deriving Inhabited, Repr + + +/-- Result of a simulation run, wrapping a `ModelCheckingResult` with metadata. -/ +structure SimulateResult (ρ σ κ : Type) where + result : ModelCheckingResult ρ σ κ Unit + tracesRun : Nat + elapsedMs : Nat + seed : Nat + depth : Nat + totalSteps : Nat + +/-- Return names of invariants violated in the given state. -/ +@[inline] +def violatedInvariantNames {ρ σ : Type} + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := + params.invariants.filterMap fun p => + if !p.holdsOn th st then some p.name else none + + +/-- Inner loop of a single random trace: walk from `currSt` for up to +`stepsLeft` steps, picking a random enabled transition at each step. +Returns `(violation?, updatedRng, stepsTaken)`. -/ +@[inline, specialize] +partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (stepsLeft : Nat) + (currSt : σ) + (trace : Trace ρ σ κ) + (gen : StdGen) + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + match stepsLeft with + | 0 => (none, gen, 0) + | stepsLeft + 1 => + let outcomes := sys.tr th currSt + -- Check assertion failures first (highest priority) + let assertionFailures := outcomes.filterMap fun (_, outcome) => + match outcome with + | .assertionFailure exId _ => some exId + | _ => none + match assertionFailures.head? with + | some exId => + let failingStep := outcomes.findSome? fun (label, outcome) => + match outcome with + | .assertionFailure exId' st => + if exId' == exId then some { transitionLabel := label, nextState := st } else none + | _ => none + let failedTrace := { trace with failingStep := failingStep } + (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), + gen, trace.steps.size) + | none => + let nexts := Concrete.extractSuccessfulTransitions outcomes + if nexts.isEmpty then + if !params.terminating.holdsOn th currSt then + -- No enabled transitions and not a terminating state: deadlock + (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) + else + (none, gen, trace.steps.size) + else + let (idx, gen) := randNat gen 0 (nexts.length - 1) + let (label, nextSt) := nexts[idx]! + let trace := trace.push { transitionLabel := label, nextState := nextSt } + let violations := violatedInvariantNames params th nextSt + if !violations.isEmpty then + (some (.foundViolation () (.safetyFailure violations) (some trace)), + gen, trace.steps.size) + else + simulateOnceLoop sys params th stepsLeft nextSt trace gen + + +/-- Run a single random trace from a randomly chosen initial state. +Returns `(violation?, updatedRng, stepsTaken)`. -/ +@[inline, specialize] +partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (gen : StdGen) + (maxSteps : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + if sys.initStates.isEmpty then + (none, gen, 0) + else + let (idx, gen) := randNat gen 0 (sys.initStates.length - 1) + let initSt := sys.initStates[idx]! + let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } + let initViolations := violatedInvariantNames params th initSt + if !initViolations.isEmpty then + (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) + else + simulateOnceLoop sys params th maxSteps initSt initTrace gen + + +/-- Run `maxTraces` independent random traces, stopping on first violation. +Each trace uses an independent seed derived from `(masterSeed + traceIndex)` +for maximum prefix diversity across traces. -/ +@[inline, specialize] +partial def simulate {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + [Inhabited σ] + [Inhabited (κ × σ)] + : IO (SimulateResult ρ σ κ) := do + let actualSeed ← if cfg.seed == 0 + then IO.rand 0 0xFFFFFFFFFFFFFFFF + else pure cfg.seed + let startMs ← IO.monoMsNow + let mut i := 0 + let mut totalSteps := 0 + while i < cfg.maxTraces do + let traceGen := mkStdGen (actualSeed + i) + let (maybeResult, _, stepsUsed) := simulateOnce sys params th traceGen cfg.maxSteps + totalSteps := totalSteps + stepsUsed + match maybeResult with + | some result => + let elapsedMs := (← IO.monoMsNow) - startMs + return { + result := result + tracesRun := i + 1 + elapsedMs := elapsedMs + seed := actualSeed + depth := stepsUsed + totalSteps := totalSteps + } + | none => + i := i + 1 + let elapsedMs := (← IO.monoMsNow) - startMs + return { + result := .noViolationFound cfg.maxTraces + (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + tracesRun := cfg.maxTraces + elapsedMs := elapsedMs + seed := actualSeed + depth := 0 + totalSteps := totalSteps + } + + +end Veil.ModelChecker.Simulation diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 4aaece25..80e30e39 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -11,6 +11,7 @@ import Veil.Core.Tools.Verifier.Results import Veil.Core.UI.Verifier.VerificationResults import Veil.Core.UI.Trace.TraceDisplay import Veil.Core.Tools.ModelChecker.Concrete.Checker +import Veil.Core.Tools.ModelChecker.Simulation import Veil.Frontend.DSL.Action.Extract import Veil.Frontend.DSL.Module.Util.Enumeration import Veil.Util.Multiprocessing @@ -523,6 +524,8 @@ def defaultThresholdToParallel : Nat := 20 declare_command_config_elab elabModelCheckerConfig ModelCheckerConfig +declare_command_config_elab elabSimulateConfig ModelChecker.Simulation.SimulateConfig + /-- Model checking mode: interpreted only, compiled only, or default (both with handoff). -/ inductive ModelCheckingMode where | interpreted @@ -912,4 +915,106 @@ where ModelChecker.displayStreamingProgress stx ctx.instanceId +/-- Build the simulator call syntax. -/ +private def mkSimulatorCall (mod : Module) (instTerm theoryTerm : Term) + (sp : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Term := do + let inst := mkVeilImplementationDetailIdent `inst + let th := mkVeilImplementationDetailIdent `th + let instSortArgs ← (← mod.sortIdents).mapM fun sortIdent => `($inst.$(sortIdent)) + let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) + $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) + `((let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + $(mkIdent ``Veil.ModelChecker.Simulation.simulate) + ($(Lean.mkIdent (mod.name ++ `enumerableTransitionSystem)) $instSortArgs* $th) + $sp $th $cfgTerm)) + +@[command_elab Veil.simulate] +def elabSimulate : CommandElab := fun stx => do + withTraceNode `veil.perf.elaborator.simulate (fun _ => return "#simulate") do + let instTerm : Term := ⟨stx[1]⟩ + let theoryTermOpt : Option Term := if stx[2].isNone then none else some ⟨stx[2][0]⟩ + let mod ← getCurrentModule (errMsg := "You cannot #simulate outside of a Veil module!") + mod.throwIfSpecNotFinalized + let theoryTerm ← getTheoryTerm theoryTermOpt mod instTerm + let cfg0 ← elabSimulateConfig stx[3] + let opts ← getOptions + let maxTraces := if cfg0.maxTraces == 10000 then veil.simulate.maxTraces.get opts else cfg0.maxTraces + let maxSteps := if cfg0.maxSteps == 100 then veil.simulate.maxSteps.get opts else cfg0.maxSteps + let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps } + let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } + let sp ← mkSearchParameters mod mcCfg + let callExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg + let wrappedCallExpr ← `(Functor.map (fun r => Lean.Json.mkObj [ + ("result", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.result r)), + ("traces_run", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.tracesRun r)), + ("elapsed_ms", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.elapsedMs r)), + ("seed", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.seed r)), + ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth r)), + ("total_steps", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.totalSteps r)) + ]) $callExpr:term) + trace[veil.desugar] "{wrappedCallExpr}" + let ioJson ← liftTermElabM do + let expr ← Term.elabTerm wrappedCallExpr none + Term.synthesizeSyntheticMVarsNoPostponing + unsafe Meta.evalExpr (IO Lean.Json) + (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) + (← instantiateMVars expr) + let combinedJson ← liftIO ioJson + let assertionSources := extractAssertionSources (← globalEnv.get).assertions (← getFileMap) + let resultJson := enrichJsonWithAssertions (combinedJson.getObjValD "result") assertionSources + let seed := (combinedJson.getObjValD "seed").getNat? |>.getD 0 + let tracesRun := (combinedJson.getObjValD "traces_run").getNat? |>.getD 0 + let elapsedMs := (combinedJson.getObjValD "elapsed_ms").getNat? |>.getD 0 + let depth := (combinedJson.getObjValD "depth").getNat? |>.getD 0 + let totalSteps := (combinedJson.getObjValD "total_steps").getNat? |>.getD 0 + let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 + let stepsPerSec := if elapsedMs > 0 then totalSteps * 1000 / elapsedMs else 0 + let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || + resultJson.getObjValD "error" != .null + let summary := if isViolation then + s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." + else + s!"simulation: no violation in {tracesRun} traces ({totalSteps} steps, {elapsedMs}ms, {stepsPerSec} steps/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." + let details := TraceDisplay.formatModelCheckingResult resultJson + let msg := summary ++ "\n" ++ details + let violationIsError := veil.violationIsError.get opts + if isViolation && violationIsError then logErrorAt stx msg else logInfoAt stx msg +where + /-- Get the theory term, defaulting to `{}` if not provided and there are no theory fields. + Throws a helpful error if theory fields exist but no term was provided. -/ + getTheoryTerm (theoryTermOpt : Option Term) (mod : Module) (instTerm : Term) : CommandElabM Term := do + match theoryTermOpt with + | some t => pure t + | none => + unless mod.immutableComponents.isEmpty do + let fieldStrs := mod.immutableComponents.map (fun c => s!"{c.name} := ...") + let theoryExample := "{ " ++ ", ".intercalate fieldStrs.toList ++ " }" + throwError "This module has immutable fields, so you must specify the theory instantiation:\n\ + #simulate {instTerm} {theoryExample}" + `({}) + + /-- Prepend `name` with `mod.name`. Useful when expressions are printed out for debugging. -/ + mkIdentWithModName (mod : Module) (name : Name) : Ident := + Lean.mkIdent (mod.name ++ name) + + /-- Build search parameters reused by simulator execution. -/ + mkSearchParameters (mod : Module) (config : ModelCheckerConfig) : CommandElabM Term := do + let mkProp (sa : StateAssertion) : CommandElabM Term := + `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) + ($(mkIdent `name) := $(quote sa.name)) + ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName mod sa.name) $(mkIdent `th) $(mkIdent `st))) + let safetyList ← `([$((← mod.invariants.mapM mkProp)),*]) + let terminatingProp ← match mod.terminations[0]? with + | some t => mkProp t + | none => `($(mkIdent `default)) + let earlyTermConds ← do + let base ← `([$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.foundViolatingState), + $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.assertionFailed), + $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.deadlockOccurred)]) + if config.maxDepth > 0 then `($base ++ [$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.reachedDepthBound) $(quote config.maxDepth)]) + else pure base + `({ $(mkIdent `invariants):ident := $safetyList, $(mkIdent `terminating):ident := $terminatingProp, + $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) + end Veil diff --git a/Veil/Frontend/DSL/Module/Syntax.lean b/Veil/Frontend/DSL/Module/Syntax.lean index 664ba7d0..5570d0a2 100644 --- a/Veil/Frontend/DSL/Module/Syntax.lean +++ b/Veil/Frontend/DSL/Module/Syntax.lean @@ -300,4 +300,10 @@ syntax (name := compiled) "compiled" : modelCheckMode syntax (name := modelCheck) "#model_check " (modelCheckMode)? term:max (term:max)? Parser.Tactic.optConfig : command +/-- Run random-walk simulation on the current module. + Explores random traces to find shallow invariant violations quickly. + Seed defaults to current timestamp if omitted (always shown in output for reproducibility). + Example: `#simulate {}` or `#simulate {} (maxTraces := 100, seed := 42)` -/ +syntax (name := simulate) "#simulate " term:max (term:max)? Parser.Tactic.optConfig : command + end Veil From f15aca5358e1e1e5d111a9a3dd6fd1fd41fae40e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 04:26:36 +0100 Subject: [PATCH 02/88] lazy trace recording with replay-on-violation --- Veil/Core/Tools/ModelChecker/Simulation.lean | 113 +++++++++++++++---- 1 file changed, 90 insertions(+), 23 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 4030b6d4..415ba456 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -30,9 +30,72 @@ def violatedInvariantNames {ρ σ : Type} if !p.holdsOn th st then some p.name else none -/-- Inner loop of a single random trace: walk from `currSt` for up to -`stepsLeft` steps, picking a random enabled transition at each step. -Returns `(violation?, updatedRng, stepsTaken)`. -/ +/-- Lightweight scan loop: walk without building a trace. +Returns `(violated?, updatedRng, stepsTaken)`. -/ +@[inline, specialize] +partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (stepsLeft : Nat) + (currSt : σ) + (gen : StdGen) + [Inhabited (κ × σ)] + : Bool × StdGen × Nat := + match stepsLeft with + | 0 => (false, gen, 0) + | stepsLeft + 1 => + let outcomes := sys.tr th currSt + let assertionFailureFound := outcomes.any fun (_, outcome) => + match outcome with + | .assertionFailure _ _ => true + | _ => false + if assertionFailureFound then + (true, gen, 1) + else + let nexts := Concrete.extractSuccessfulTransitions outcomes + if nexts.isEmpty then + if !params.terminating.holdsOn th currSt then + (true, gen, 0) -- deadlock + else + (false, gen, 0) + else + let (idx, gen) := randNat gen 0 (nexts.length - 1) + let (_, nextSt) := nexts[idx]! + let violations := violatedInvariantNames params th nextSt + if !violations.isEmpty then + (true, gen, 1) + else + let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen + (violated, gen, innerSteps + 1) + + +/-- Lightweight scan: pick random init state, walk without trace. +Returns `(violated?, updatedRng, stepsTaken)`. -/ +@[inline, specialize] +partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (gen : StdGen) + (maxSteps : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Bool × StdGen × Nat := + if sys.initStates.isEmpty then + (false, gen, 0) + else + let (idx, gen) := randNat gen 0 (sys.initStates.length - 1) + let initSt := sys.initStates[idx]! + let initViolations := violatedInvariantNames params th initSt + if !initViolations.isEmpty then + (true, gen, 0) + else + scanOnceLoop sys params th maxSteps initSt gen + + +/-- Full trace loop: walk and record every step for counterexample. +Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ @[inline, specialize] partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -48,7 +111,6 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} | 0 => (none, gen, 0) | stepsLeft + 1 => let outcomes := sys.tr th currSt - -- Check assertion failures first (highest priority) let assertionFailures := outcomes.filterMap fun (_, outcome) => match outcome with | .assertionFailure exId _ => some exId @@ -67,7 +129,6 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} let nexts := Concrete.extractSuccessfulTransitions outcomes if nexts.isEmpty then if !params.terminating.holdsOn th currSt then - -- No enabled transitions and not a terminating state: deadlock (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) else (none, gen, trace.steps.size) @@ -83,8 +144,7 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} simulateOnceLoop sys params th stepsLeft nextSt trace gen -/-- Run a single random trace from a randomly chosen initial state. -Returns `(violation?, updatedRng, stepsTaken)`. -/ +/-- Full trace run from random init state. Used only for replay. -/ @[inline, specialize] partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -109,8 +169,8 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} /-- Run `maxTraces` independent random traces, stopping on first violation. -Each trace uses an independent seed derived from `(masterSeed + traceIndex)` -for maximum prefix diversity across traces. -/ +Scans without trace recording for speed; replays only the violating trace. +Each trace uses an independent seed derived from `(masterSeed + traceIndex)`. -/ @[inline, specialize] partial def simulate {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -127,21 +187,28 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} let mut i := 0 let mut totalSteps := 0 while i < cfg.maxTraces do - let traceGen := mkStdGen (actualSeed + i) - let (maybeResult, _, stepsUsed) := simulateOnce sys params th traceGen cfg.maxSteps + let traceSeed := actualSeed + i + -- Fast scan: no trace allocation + let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps totalSteps := totalSteps + stepsUsed - match maybeResult with - | some result => - let elapsedMs := (← IO.monoMsNow) - startMs - return { - result := result - tracesRun := i + 1 - elapsedMs := elapsedMs - seed := actualSeed - depth := stepsUsed - totalSteps := totalSteps - } - | none => + if violated then + -- Replay with same seed to build counterexample trace + let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + match maybeResult with + | some result => + let elapsedMs := (← IO.monoMsNow) - startMs + return { + result := result + tracesRun := i + 1 + elapsedMs := elapsedMs + seed := actualSeed + depth := stepsUsed + totalSteps := totalSteps + } + | none => + -- Scan flagged violation but replay didn't reproduce (should not happen) + i := i + 1 + else i := i + 1 let elapsedMs := (← IO.monoMsNow) - startMs return { From df4f8e5069c3fe60ba03bee5922695344309a1fd Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 06:24:20 +0100 Subject: [PATCH 03/88] try/catch error handling with seed reporting in simulate loop --- Veil/Core/Tools/ModelChecker/Simulation.lean | 43 +++++++++++--------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 415ba456..255e5a59 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -188,27 +188,30 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} let mut totalSteps := 0 while i < cfg.maxTraces do let traceSeed := actualSeed + i - -- Fast scan: no trace allocation - let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - totalSteps := totalSteps + stepsUsed - if violated then - -- Replay with same seed to build counterexample trace - let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - match maybeResult with - | some result => - let elapsedMs := (← IO.monoMsNow) - startMs - return { - result := result - tracesRun := i + 1 - elapsedMs := elapsedMs - seed := actualSeed - depth := stepsUsed - totalSteps := totalSteps - } - | none => - -- Scan flagged violation but replay didn't reproduce (should not happen) + try + -- Fast scan: no trace allocation + let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + totalSteps := totalSteps + stepsUsed + if violated then + -- Replay with same seed to build counterexample trace + let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + match maybeResult with + | some result => + let elapsedMs := (← IO.monoMsNow) - startMs + return { + result := result + tracesRun := i + 1 + elapsedMs := elapsedMs + seed := actualSeed + depth := stepsUsed + totalSteps := totalSteps + } + | none => + i := i + 1 + else i := i + 1 - else + catch e => + IO.eprintln s!"#simulate: error on trace {i} (seed := {traceSeed}): {e.toString}" i := i + 1 let elapsedMs := (← IO.monoMsNow) - startMs return { From 543cce4551f7952ca6c090b976f0accc6aa847d2 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 06:24:39 +0100 Subject: [PATCH 04/88] share helpers between #model_check and #simulate, add widget support --- Veil/Frontend/DSL/Module/Elaborators.lean | 183 +++++++++------------- 1 file changed, 75 insertions(+), 108 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 80e30e39..6000c33f 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -550,6 +550,66 @@ def getModelCheckingMode (modeStx : Syntax) : ModelCheckingMode := | `(modelCheckMode| compiled) => .compiled | _ => .default + +/-- Get all action label names for never-enabled action warnings. -/ +private def getActionLabelNames (mod : Module) : CommandElabM (List String) := do + let labelTypeName ← resolveGlobalConstNoOverload labelType + return mod.actions.map (fun a => s!"{labelTypeName}.{a.name}") |>.toList + +private def warnAboutTransitions (mod : Module) : CommandElabM Unit := do + let transitions := mod.procedures.filter (·.info.isTransition) + if transitions.isEmpty then return + let names := ", ".intercalate (transitions.map (·.info.name.toString) |>.toList) + logWarning m!"Explicit state model checking of transitions is SLOW!\n\n\ + The current implementation enumerates all possible states and filters those satisfying \ + the transition relation. Your specification has {transitions.size} \ + transition{if transitions.size > 1 then "s" else ""}: {names}\n\n\ + Consider encoding transitions as imperative actions where possible." + +private def resolveTheoryTerm (cmdName : String) (theoryTermOpt : Option Term) + (mod : Module) (instTerm : Term) : CommandElabM Term := do + match theoryTermOpt with + | some t => pure t + | none => + unless mod.immutableComponents.isEmpty do + let fieldStrs := mod.immutableComponents.map (fun c => s!"{c.name} := ...") + let theoryExample := "{ " ++ ", ".intercalate fieldStrs.toList ++ " }" + throwError "This module has immutable fields, so you must specify the theory instantiation:\n\ + {cmdName} {instTerm} {theoryExample}" + `({}) + +/-- Prepend `name` with `mod.name`. -/ +private def mkIdentWithModName' (mod : Module) (name : Name) : Ident := + Lean.mkIdent (mod.name ++ name) + +/-- Build search parameters for model checking / simulation. -/ +private def buildSearchParameters (mod : Module) (config : ModelCheckerConfig) : CommandElabM Term := do + let mkProp (sa : StateAssertion) : CommandElabM Term := + `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) + ($(mkIdent `name) := $(quote sa.name)) + ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName' mod sa.name) $(mkIdent `th) $(mkIdent `st))) + let safetyList ← `([$((← mod.invariants.mapM mkProp)),*]) + let terminatingProp ← match mod.terminations[0]? with + | some t => mkProp t + | none => `($(mkIdent `default)) + let earlyTermConds ← do + let base ← `([$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.foundViolatingState), + $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.assertionFailed), + $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.deadlockOccurred)]) + if config.maxDepth > 0 then `($base ++ [$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.reachedDepthBound) $(quote config.maxDepth)]) + else pure base + `({ $(mkIdent `invariants):ident := $safetyList, $(mkIdent `terminating):ident := $terminatingProp, + $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) + +/-- Display a TraceDisplayViewer widget with the given result JSON. -/ +private def displayResultWidget (stx : Syntax) (resultTerm : Term) : CommandElabM Unit := do + let widgetExpr ← `(open ProofWidgets.Jsx in + ) + let html ← ← liftTermElabM <| ProofWidgets.HtmlCommand.evalCommandMHtml <| ← ``(ProofWidgets.HtmlEval.eval $widgetExpr) + liftCoreM <| Widget.savePanelWidgetInfo + (hash ProofWidgets.HtmlDisplayPanel.javascript) + (return json% { html: $(← Server.rpcEncode html) }) stx + @[command_elab Veil.modelCheck] def elabModelCheck : CommandElab := fun stx => do -- Use dynamic trace class name for detailed profiling @@ -561,19 +621,6 @@ def elabModelCheck : CommandElab := fun stx => do let cfg := stx[4] elabModelCheckCore stx mode instTerm theoryTermOpt cfg where - /-- Get the theory term, defaulting to `{}` if not provided and there are no theory fields. - Throws a helpful error if theory fields exist but no term was provided. -/ - getTheoryTerm (theoryTermOpt : Option Term) (mod : Module) (instTerm : Term) : CommandElabM Term := do - match theoryTermOpt with - | some t => pure t - | none => - unless mod.immutableComponents.isEmpty do - let fieldStrs := mod.immutableComponents.map (fun c => s!"{c.name} := ...") - let theoryExample := "{ " ++ ", ".intercalate fieldStrs.toList ++ " }" - throwError "This module has immutable fields, so you must specify the theory instantiation:\n\ - #model_check {instTerm} {theoryExample}" - `({}) - /-- Generate the model source for compilation: 1. Insert `set_option veil.__modelCheckCompileMode true` after imports 2. Keep everything up to the point where the spec was finalized @@ -599,65 +646,22 @@ where let modelCheckCmd := String.Pos.Raw.extract src modelCheckStart modelCheckEnd return beforeImports ++ compileModePreamble ++ afterImportsToSpecFinalized ++ "\n" ++ modelCheckCmd ++ "\n" - /-- Prepend `name` with `mod.name`. Useful when expressions are printed out for debugging. -/ - mkIdentWithModName (mod : Module) (name : Name) : Ident := - Lean.mkIdent (mod.name ++ name) - - /-- Display a TraceDisplayViewer widget with the given result term. -/ - displayResultWidget (stx : Syntax) (resultTerm : Term) : CommandElabM Unit := do - let widgetExpr ← `(open ProofWidgets.Jsx in - ) - let html ← ← liftTermElabM <| ProofWidgets.HtmlCommand.evalCommandMHtml <| ← ``(ProofWidgets.HtmlEval.eval $widgetExpr) - liftCoreM <| Widget.savePanelWidgetInfo - (hash ProofWidgets.HtmlDisplayPanel.javascript) - (return json% { html: $(← Server.rpcEncode html) }) stx - - mkSearchParameters (mod : Module) (config : ModelCheckerConfig) : CommandElabM Term := do - -- Build SafetyProperty.mk syntax for a StateAssertion - let mkProp (sa : StateAssertion) : CommandElabM Term := - `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) - ($(mkIdent `name) := $(quote sa.name)) - ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName mod sa.name) $(mkIdent `th) $(mkIdent `st))) - let safetyList ← `([$((← mod.invariants.mapM mkProp)),*]) - let terminatingProp ← match mod.terminations[0]? with - | some t => mkProp t - | none => `($(mkIdent `default)) - let earlyTermConds ← do - let base ← `([$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.foundViolatingState), - $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.assertionFailed), - $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.deadlockOccurred)]) - if config.maxDepth > 0 then `($base ++ [$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.reachedDepthBound) $(quote config.maxDepth)]) - else pure base - `({ $(mkIdent `invariants):ident := $safetyList, $(mkIdent `terminating):ident := $terminatingProp, - $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) - /-- Build the core model checker call syntax (without parallel config). -/ mkModelCheckerCall (mod : Module) (config : ModelCheckerConfig) (instTerm theoryTerm : Term) : CommandElabM Term := do let inst := mkVeilImplementationDetailIdent `inst let th := mkVeilImplementationDetailIdent `th let instSortArgs ← (← mod.sortIdents).mapM fun sortIdent => `($inst.$(sortIdent)) - let sp ← mkSearchParameters mod config + let sp ← buildSearchParameters mod config -- Model checker call with type annotation to help inference -- Note: findReachable takes parallelCfg, progressInstanceId, and cancelToken as the last three args `((let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Concrete.findReachable) ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType $instSortArgs*) - ($(mkIdentWithModName mod `enumerableTransitionSystem) $instSortArgs* $th) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp : _ → _ → _ → IO _)) - /-- Warn if the module contains transitions (which are slow to model check). -/ - warnAboutTransitions (mod : Module) : CommandElabM Unit := do - let transitions := mod.procedures.filter (·.info.isTransition) - if transitions.isEmpty then return - let names := ", ".intercalate (transitions.map (·.info.name.toString) |>.toList) - logWarning m!"Explicit state model checking of transitions is SLOW!\n\n\ - The current implementation enumerates all possible states and filters those satisfying \ - the transition relation. Your specification has {transitions.size} \ - transition{if transitions.size > 1 then "s" else ""}: {names}\n\n\ - Consider encoding transitions as imperative actions where possible." - /-- Create an error JSON object. -/ errorJson (msg : String) : Json := Json.mkObj [("error", msg)] @@ -743,11 +747,6 @@ where Term.synthesizeSyntheticMVarsNoPostponing unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) - /-- Get all action label names for never-enabled action warnings. -/ - getActionLabelNames (mod : Module) : CommandElabM (List String) := do - let labelTypeName ← resolveGlobalConstNoOverload labelType - return mod.actions.map (fun a => s!"{labelTypeName}.{a.name}") |>.toList - /-- Log model checking result. -/ logModelCheckResult (stx : Syntax) (resultJson : Json) : CommandElabM Unit := do let msg := TraceDisplay.formatModelCheckingResult resultJson @@ -805,7 +804,7 @@ where let mod ← getCurrentModule (errMsg := "You cannot #model_check outside of a Veil module!") mod.throwIfSpecNotFinalized - let theoryTerm ← getTheoryTerm theoryTermOpt mod instTerm + let theoryTerm ← resolveTheoryTerm "#model_check" theoryTermOpt mod instTerm warnAboutTransitions mod let config ← elabModelCheckerConfig cfg @@ -926,7 +925,7 @@ private def mkSimulatorCall (mod : Module) (instTerm theoryTerm : Term) `((let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Simulation.simulate) - ($(Lean.mkIdent (mod.name ++ `enumerableTransitionSystem)) $instSortArgs* $th) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp $th $cfgTerm)) @[command_elab Veil.simulate] @@ -936,14 +935,15 @@ def elabSimulate : CommandElab := fun stx => do let theoryTermOpt : Option Term := if stx[2].isNone then none else some ⟨stx[2][0]⟩ let mod ← getCurrentModule (errMsg := "You cannot #simulate outside of a Veil module!") mod.throwIfSpecNotFinalized - let theoryTerm ← getTheoryTerm theoryTermOpt mod instTerm + let theoryTerm ← resolveTheoryTerm "#simulate" theoryTermOpt mod instTerm + warnAboutTransitions mod let cfg0 ← elabSimulateConfig stx[3] let opts ← getOptions let maxTraces := if cfg0.maxTraces == 10000 then veil.simulate.maxTraces.get opts else cfg0.maxTraces let maxSteps := if cfg0.maxSteps == 100 then veil.simulate.maxSteps.get opts else cfg0.maxSteps let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps } let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } - let sp ← mkSearchParameters mod mcCfg + let sp ← buildSearchParameters mod mcCfg let callExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg let wrappedCallExpr ← `(Functor.map (fun r => Lean.Json.mkObj [ ("result", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.result r)), @@ -972,49 +972,16 @@ def elabSimulate : CommandElab := fun stx => do let stepsPerSec := if elapsedMs > 0 then totalSteps * 1000 / elapsedMs else 0 let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || resultJson.getObjValD "error" != .null + -- Log simulation-specific summary let summary := if isViolation then s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." else s!"simulation: no violation in {tracesRun} traces ({totalSteps} steps, {elapsedMs}ms, {stepsPerSec} steps/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." - let details := TraceDisplay.formatModelCheckingResult resultJson - let msg := summary ++ "\n" ++ details - let violationIsError := veil.violationIsError.get opts - if isViolation && violationIsError then logErrorAt stx msg else logInfoAt stx msg -where - /-- Get the theory term, defaulting to `{}` if not provided and there are no theory fields. - Throws a helpful error if theory fields exist but no term was provided. -/ - getTheoryTerm (theoryTermOpt : Option Term) (mod : Module) (instTerm : Term) : CommandElabM Term := do - match theoryTermOpt with - | some t => pure t - | none => - unless mod.immutableComponents.isEmpty do - let fieldStrs := mod.immutableComponents.map (fun c => s!"{c.name} := ...") - let theoryExample := "{ " ++ ", ".intercalate fieldStrs.toList ++ " }" - throwError "This module has immutable fields, so you must specify the theory instantiation:\n\ - #simulate {instTerm} {theoryExample}" - `({}) - - /-- Prepend `name` with `mod.name`. Useful when expressions are printed out for debugging. -/ - mkIdentWithModName (mod : Module) (name : Name) : Ident := - Lean.mkIdent (mod.name ++ name) - - /-- Build search parameters reused by simulator execution. -/ - mkSearchParameters (mod : Module) (config : ModelCheckerConfig) : CommandElabM Term := do - let mkProp (sa : StateAssertion) : CommandElabM Term := - `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) - ($(mkIdent `name) := $(quote sa.name)) - ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName mod sa.name) $(mkIdent `th) $(mkIdent `st))) - let safetyList ← `([$((← mod.invariants.mapM mkProp)),*]) - let terminatingProp ← match mod.terminations[0]? with - | some t => mkProp t - | none => `($(mkIdent `default)) - let earlyTermConds ← do - let base ← `([$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.foundViolatingState), - $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.assertionFailed), - $(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.deadlockOccurred)]) - if config.maxDepth > 0 then `($base ++ [$(mkIdent ``Veil.ModelChecker.EarlyTerminationCondition.reachedDepthBound) $(quote config.maxDepth)]) - else pure base - `({ $(mkIdent `invariants):ident := $safetyList, $(mkIdent `terminating):ident := $terminatingProp, - $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) - + logInfoAt stx summary + -- Log the same trace display as #model_check + elabModelCheck.logModelCheckResult stx resultJson + -- Display the same TraceDisplayViewer widget as #model_check + let (instanceId, _) ← ModelChecker.Concrete.allocProgressInstance (← getActionLabelNames mod) + ModelChecker.Concrete.finishProgress instanceId resultJson + ModelChecker.displayStreamingProgress stx instanceId end Veil From 1e9c481df3e3c0b06e46208b4da9ce5ed668f664 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 06:45:38 +0100 Subject: [PATCH 05/88] restore docstrings and inline comments removed during refactor --- Veil/Core/Tools/ModelChecker/Simulation.lean | 8 ++++++-- Veil/Frontend/DSL/Module/Elaborators.lean | 3 +++ 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 255e5a59..0a13efd7 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -94,7 +94,8 @@ partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} scanOnceLoop sys params th maxSteps initSt gen -/-- Full trace loop: walk and record every step for counterexample. +/-- Inner loop of a single random trace: walk from `currSt` for up to +`stepsLeft` steps, picking a random enabled transition at each step. Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ @[inline, specialize] partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} @@ -111,6 +112,7 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} | 0 => (none, gen, 0) | stepsLeft + 1 => let outcomes := sys.tr th currSt + -- Check assertion failures first (highest priority) let assertionFailures := outcomes.filterMap fun (_, outcome) => match outcome with | .assertionFailure exId _ => some exId @@ -129,6 +131,7 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} let nexts := Concrete.extractSuccessfulTransitions outcomes if nexts.isEmpty then if !params.terminating.holdsOn th currSt then + -- No enabled transitions and not a terminating state: deadlock (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) else (none, gen, trace.steps.size) @@ -144,7 +147,8 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} simulateOnceLoop sys params th stepsLeft nextSt trace gen -/-- Full trace run from random init state. Used only for replay. -/ +/-- Run a single random trace from a randomly chosen initial state. +Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ @[inline, specialize] partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 6000c33f..336dde4c 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -556,6 +556,7 @@ private def getActionLabelNames (mod : Module) : CommandElabM (List String) := d let labelTypeName ← resolveGlobalConstNoOverload labelType return mod.actions.map (fun a => s!"{labelTypeName}.{a.name}") |>.toList +/-- Warn if the module contains transitions (which are slow to model check). -/ private def warnAboutTransitions (mod : Module) : CommandElabM Unit := do let transitions := mod.procedures.filter (·.info.isTransition) if transitions.isEmpty then return @@ -566,6 +567,7 @@ private def warnAboutTransitions (mod : Module) : CommandElabM Unit := do transition{if transitions.size > 1 then "s" else ""}: {names}\n\n\ Consider encoding transitions as imperative actions where possible." +/-- Get the theory term, defaulting to `{}` if not provided and there are no theory fields. -/ private def resolveTheoryTerm (cmdName : String) (theoryTermOpt : Option Term) (mod : Module) (instTerm : Term) : CommandElabM Term := do match theoryTermOpt with @@ -584,6 +586,7 @@ private def mkIdentWithModName' (mod : Module) (name : Name) : Ident := /-- Build search parameters for model checking / simulation. -/ private def buildSearchParameters (mod : Module) (config : ModelCheckerConfig) : CommandElabM Term := do + -- Build SafetyProperty.mk syntax for a StateAssertion let mkProp (sa : StateAssertion) : CommandElabM Term := `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) ($(mkIdent `name) := $(quote sa.name)) From 2f12dd7f9f06cf9c76f14f17c492be52404c1b85 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 18:36:17 +0100 Subject: [PATCH 06/88] uncomment violationIsError option in MutexViolation example --- Examples/TLA/MutexViolation.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Examples/TLA/MutexViolation.lean b/Examples/TLA/MutexViolation.lean index 3b962025..74da3964 100644 --- a/Examples/TLA/MutexViolation.lean +++ b/Examples/TLA/MutexViolation.lean @@ -345,8 +345,8 @@ termination [AllDone] ∀s ≠ NONE, pc s Done = true #time #gen_spec -- NOTE: comment out the line containing `BUG:` to fix the violation --- set_option veil.violationIsError false in /- `Fin n` means `n-1` valid threads.-/ +set_option veil.violationIsError false in #model_check { process := Fin 10 } { NONE := 0 } end MutexViolation From c066bee2432819af824ee0c1ad3be74bef2c03f9 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 19:35:23 +0100 Subject: [PATCH 07/88] simplify assertion failure handling to single-pass in simulateOnceLoop --- Veil/Core/Tools/ModelChecker/Simulation.lean | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 0a13efd7..edacf062 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -113,20 +113,17 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} | stepsLeft + 1 => let outcomes := sys.tr th currSt -- Check assertion failures first (highest priority) - let assertionFailures := outcomes.filterMap fun (_, outcome) => + let failingStep := outcomes.findSome? fun (label, outcome) => match outcome with - | .assertionFailure exId _ => some exId + | .assertionFailure exId st => + some (exId, { transitionLabel := label, nextState := st }) | _ => none - match assertionFailures.head? with - | some exId => - let failingStep := outcomes.findSome? fun (label, outcome) => - match outcome with - | .assertionFailure exId' st => - if exId' == exId then some { transitionLabel := label, nextState := st } else none - | _ => none - let failedTrace := { trace with failingStep := failingStep } + match failingStep with + | some (exId, step) => + let failedTrace := { trace with failingStep := some step } + -- +1 for the failing action itself (not in trace.steps, stored in failingStep) (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), - gen, trace.steps.size) + gen, trace.steps.size + 1) | none => let nexts := Concrete.extractSuccessfulTransitions outcomes if nexts.isEmpty then From 53cbc95542c4521dd94e0c91e3a4cf265bfa7aba Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 19:37:07 +0100 Subject: [PATCH 08/88] remove totalSteps tracking from simulate pipeline --- Veil/Core/Tools/ModelChecker/Simulation.lean | 5 ----- Veil/Frontend/DSL/Module/Elaborators.lean | 7 ++----- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index edacf062..c071d9b5 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -20,7 +20,6 @@ structure SimulateResult (ρ σ κ : Type) where elapsedMs : Nat seed : Nat depth : Nat - totalSteps : Nat /-- Return names of invariants violated in the given state. -/ @[inline] @@ -186,13 +185,11 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} else pure cfg.seed let startMs ← IO.monoMsNow let mut i := 0 - let mut totalSteps := 0 while i < cfg.maxTraces do let traceSeed := actualSeed + i try -- Fast scan: no trace allocation let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - totalSteps := totalSteps + stepsUsed if violated then -- Replay with same seed to build counterexample trace let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps @@ -205,7 +202,6 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} elapsedMs := elapsedMs seed := actualSeed depth := stepsUsed - totalSteps := totalSteps } | none => i := i + 1 @@ -222,7 +218,6 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} elapsedMs := elapsedMs seed := actualSeed depth := 0 - totalSteps := totalSteps } diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 336dde4c..990cdfe0 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -953,8 +953,7 @@ def elabSimulate : CommandElab := fun stx => do ("traces_run", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.tracesRun r)), ("elapsed_ms", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.elapsedMs r)), ("seed", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.seed r)), - ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth r)), - ("total_steps", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.totalSteps r)) + ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth r)) ]) $callExpr:term) trace[veil.desugar] "{wrappedCallExpr}" let ioJson ← liftTermElabM do @@ -970,16 +969,14 @@ def elabSimulate : CommandElab := fun stx => do let tracesRun := (combinedJson.getObjValD "traces_run").getNat? |>.getD 0 let elapsedMs := (combinedJson.getObjValD "elapsed_ms").getNat? |>.getD 0 let depth := (combinedJson.getObjValD "depth").getNat? |>.getD 0 - let totalSteps := (combinedJson.getObjValD "total_steps").getNat? |>.getD 0 let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 - let stepsPerSec := if elapsedMs > 0 then totalSteps * 1000 / elapsedMs else 0 let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || resultJson.getObjValD "error" != .null -- Log simulation-specific summary let summary := if isViolation then s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." else - s!"simulation: no violation in {tracesRun} traces ({totalSteps} steps, {elapsedMs}ms, {stepsPerSec} steps/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." + s!"simulation: no violation in {tracesRun} traces ({elapsedMs}ms, {tracesPerSec} traces/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." logInfoAt stx summary -- Log the same trace display as #model_check elabModelCheck.logModelCheckResult stx resultJson From e2783dd7d19296e573745d454f1598dc426542ee Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 19:37:43 +0100 Subject: [PATCH 09/88] remove unused displayResultWidget, clean up formatting --- Veil/Core/Tools/ModelChecker/Simulation.lean | 16 ++++------------ Veil/Frontend/DSL/Module/Elaborators.lean | 10 ---------- 2 files changed, 4 insertions(+), 22 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index c071d9b5..847bb276 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -4,7 +4,6 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation - /-- Configuration for the `#simulate` command. -/ structure SimulateConfig where maxTraces : Nat := 10000 @@ -12,7 +11,6 @@ structure SimulateConfig where seed : Nat := 0 deriving Inhabited, Repr - /-- Result of a simulation run, wrapping a `ModelCheckingResult` with metadata. -/ structure SimulateResult (ρ σ κ : Type) where result : ModelCheckingResult ρ σ κ Unit @@ -28,9 +26,9 @@ def violatedInvariantNames {ρ σ : Type} params.invariants.filterMap fun p => if !p.holdsOn th st then some p.name else none - /-- Lightweight scan loop: walk without building a trace. Returns `(violated?, updatedRng, stepsTaken)`. -/ +-- NOTE: keep in sync with `simulateOnceLoop` (trace-building variant for replay) @[inline, specialize] partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -61,14 +59,12 @@ partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} else let (idx, gen) := randNat gen 0 (nexts.length - 1) let (_, nextSt) := nexts[idx]! - let violations := violatedInvariantNames params th nextSt - if !violations.isEmpty then + if !(violatedInvariantNames params th nextSt).isEmpty then (true, gen, 1) else let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen (violated, gen, innerSteps + 1) - /-- Lightweight scan: pick random init state, walk without trace. Returns `(violated?, updatedRng, stepsTaken)`. -/ @[inline, specialize] @@ -86,16 +82,15 @@ partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} else let (idx, gen) := randNat gen 0 (sys.initStates.length - 1) let initSt := sys.initStates[idx]! - let initViolations := violatedInvariantNames params th initSt - if !initViolations.isEmpty then + if !(violatedInvariantNames params th initSt).isEmpty then (true, gen, 0) else scanOnceLoop sys params th maxSteps initSt gen - /-- Inner loop of a single random trace: walk from `currSt` for up to `stepsLeft` steps, picking a random enabled transition at each step. Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ +-- NOTE: keep in sync with `scanOnceLoop` (allocation-free variant for scanning) @[inline, specialize] partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -142,7 +137,6 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} else simulateOnceLoop sys params th stepsLeft nextSt trace gen - /-- Run a single random trace from a randomly chosen initial state. Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ @[inline, specialize] @@ -167,7 +161,6 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} else simulateOnceLoop sys params th maxSteps initSt initTrace gen - /-- Run `maxTraces` independent random traces, stopping on first violation. Scans without trace recording for speed; replays only the violating trace. Each trace uses an independent seed derived from `(masterSeed + traceIndex)`. -/ @@ -220,5 +213,4 @@ partial def simulate {ρ σ κ : Type} {th₀ : ρ} depth := 0 } - end Veil.ModelChecker.Simulation diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 990cdfe0..ed45ee9d 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -550,7 +550,6 @@ def getModelCheckingMode (modeStx : Syntax) : ModelCheckingMode := | `(modelCheckMode| compiled) => .compiled | _ => .default - /-- Get all action label names for never-enabled action warnings. -/ private def getActionLabelNames (mod : Module) : CommandElabM (List String) := do let labelTypeName ← resolveGlobalConstNoOverload labelType @@ -604,15 +603,6 @@ private def buildSearchParameters (mod : Module) (config : ModelCheckerConfig) : `({ $(mkIdent `invariants):ident := $safetyList, $(mkIdent `terminating):ident := $terminatingProp, $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) -/-- Display a TraceDisplayViewer widget with the given result JSON. -/ -private def displayResultWidget (stx : Syntax) (resultTerm : Term) : CommandElabM Unit := do - let widgetExpr ← `(open ProofWidgets.Jsx in - ) - let html ← ← liftTermElabM <| ProofWidgets.HtmlCommand.evalCommandMHtml <| ← ``(ProofWidgets.HtmlEval.eval $widgetExpr) - liftCoreM <| Widget.savePanelWidgetInfo - (hash ProofWidgets.HtmlDisplayPanel.javascript) - (return json% { html: $(← Server.rpcEncode html) }) stx - @[command_elab Veil.modelCheck] def elabModelCheck : CommandElab := fun stx => do -- Use dynamic trace class name for detailed profiling From 542db5cafc84fe42d6507d8b56ebb54e8f6924ad Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 16 Mar 2026 19:58:03 +0100 Subject: [PATCH 10/88] add SharedCounter example where #simulate outperforms #model_check --- Examples/Simulate/SharedCounter.lean | 54 ++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 Examples/Simulate/SharedCounter.lean diff --git a/Examples/Simulate/SharedCounter.lean b/Examples/Simulate/SharedCounter.lean new file mode 100644 index 00000000..0fcac8b7 --- /dev/null +++ b/Examples/Simulate/SharedCounter.lean @@ -0,0 +1,54 @@ +import Veil + +/- +Demonstrates #simulate advantage over #model_check on large state spaces. + +N processes each have a boolean active flag, creating 2^N flag combinations. +A shared counter increments when any active process acts. Safety: counter < 10. + +With Fin 20 (20 processes), the state space is ~2^20 * 10 ~ 10M states -- +intractable for exhaustive model checking. Simulate finds the violation in a +single trace by activating one process and incrementing 10 times. +-/ +veil module SharedCounter + +type process + +individual counter : Nat +relation active : process -> Bool + +#gen_state + +after_init { + counter := 0 + active P := false +} + +action activate (p : process) { + require ¬ active p + active p := true +} + +action deactivate (p : process) { + require active p + active p := false +} + +action increment (p : process) { + require active p + counter := counter + 1 +} + +safety [bounded] counter < 10 + +#gen_spec + +-- model_check needs to explore ~10M states (times out even after 60s) +-- set_option veil.violationIsError false in +-- #model_check { process := Fin 20 } {} + +-- simulate finds the violation in a single trace +set_option veil.violationIsError false in +#simulate { process := Fin 20 } {} (maxTraces := 100) (maxSteps := 50) + +end SharedCounter From 2c1598e640aaec922991e58bf0f1b5893d3c98eb Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 05:48:36 +0200 Subject: [PATCH 11/88] fix: build --- Veil/Core/Tools/ModelChecker/Simulation.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 847bb276..aaa7158f 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -50,7 +50,7 @@ partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} if assertionFailureFound then (true, gen, 1) else - let nexts := Concrete.extractSuccessfulTransitions outcomes + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes if nexts.isEmpty then if !params.terminating.holdsOn th currSt then (true, gen, 0) -- deadlock @@ -119,7 +119,7 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), gen, trace.steps.size + 1) | none => - let nexts := Concrete.extractSuccessfulTransitions outcomes + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes if nexts.isEmpty then if !params.terminating.holdsOn th currSt then -- No enabled transitions and not a terminating state: deadlock From 8201073d9727051ae40e2515981c7d84b88dd0fc Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:18:09 +0200 Subject: [PATCH 12/88] fix: qualify compilation status constructors --- Veil/Core/Tools/ModelChecker/Concrete/Progress.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index 10a77d10..3922d455 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -228,15 +228,15 @@ def updateCompilationStatus (instanceId : Nat) (status : CompilationStatus) : IO /-- Update compilation log with a new line. -/ def updateCompilationLog (instanceId : Nat) (elapsedMs : Nat) (line : String) (isError : Bool) : IO Unit := withRefs instanceId fun refs => refs.progressRef.modify fun p => - let existingLines := match p.compilationStatus with | .inProgress _ l => l | _ => #[] + let existingLines := match p.compilationStatus with | CompilationStatus.inProgress _ l => l | _ => #[] let newLine : CompilationLogLine := { timestamp := elapsedMs, content := line, isError } - { p with compilationStatus := .inProgress elapsedMs (existingLines.push newLine) } + { p with compilationStatus := CompilationStatus.inProgress elapsedMs (existingLines.push newLine) } /-- Update just elapsed time without adding a log line. -/ def updateCompilationElapsed (instanceId : Nat) (elapsedMs : Nat) : IO Unit := withRefs instanceId fun refs => refs.progressRef.modify fun p => - let lines := match p.compilationStatus with | .inProgress _ l => l | _ => #[] - { p with compilationStatus := .inProgress elapsedMs lines } + let lines := match p.compilationStatus with | CompilationStatus.inProgress _ l => l | _ => #[] + { p with compilationStatus := CompilationStatus.inProgress elapsedMs lines } def requestHandoff (instanceId : Nat) : IO Unit := withRefs instanceId (·.handoffRequested.set true) From a8e9419ef82a427ec10a0a3b8f03731d1ad659df Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:18:23 +0200 Subject: [PATCH 13/88] feat: align command architecture with #model_check --- .../Tools/ModelChecker/ExecutionOutcome.lean | 2 +- Veil/Core/Tools/ModelChecker/Simulation.lean | 289 +++++++++++++--- Veil/Core/UI/Trace/TraceDisplay.lean | 5 +- Veil/Frontend/DSL/Module/Elaborators.lean | 316 ++++++++++++++---- Veil/Frontend/DSL/Module/Syntax.lean | 23 +- .../DSL/Module/Util/ForModelChecker.lean | 55 +-- 6 files changed, 564 insertions(+), 126 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean b/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean index 96fb3da7..83602bf0 100644 --- a/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean +++ b/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean @@ -21,7 +21,7 @@ inductive ExecutionOutcome (ε σ : Type) where | assertionFailure (error : ε) (state : σ) /-- The action diverged (did not terminate). -/ | divergence -deriving Repr, BEq, Inhabited +deriving Repr, BEq, DecidableEq, Inhabited namespace ExecutionOutcome diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index aaa7158f..8c9268b7 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -1,8 +1,10 @@ import Veil.Core.Tools.ModelChecker.Interface import Veil.Core.Tools.ModelChecker.Trace import Veil.Core.Tools.ModelChecker.Concrete.Core +import Veil.Core.Tools.ModelChecker.Concrete.Progress namespace Veil.ModelChecker.Simulation +open Veil.ModelChecker.Concrete /-- Configuration for the `#simulate` command. -/ structure SimulateConfig where @@ -26,6 +28,142 @@ def violatedInvariantNames {ρ σ : Type} params.invariants.filterMap fun p => if !p.holdsOn th st then some p.name else none +/-- Filter initial states according to the search parameters' state constraints. -/ +@[inline] +def filterInitStatesByConstraints {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) : List σ := + if params.stateConstraints.isEmpty then + sys.initStates + else + sys.initStates.filter (params.satisfiesConstraints th) + +/-- Filter transition outcomes according to the search parameters' state constraints. +Successful and assertion-failure outcomes whose post-state violates a state +constraint are silently skipped, matching `Concrete.findReachable`. -/ +@[inline] +def filterOutcomesByConstraints {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List (κ × ExecutionOutcome Int σ) := + if params.stateConstraints.isEmpty then + sys.tr th st + else + (sys.tr th st).filter fun (_, outcome) => + match outcome with + | .success st' => params.satisfiesConstraints th st' + | .assertionFailure _ st' => params.satisfiesConstraints th st' + | .divergence => true + +/-- Relational view of simulation semantics: initial states and successful +transitions filtered by the configured state constraints. -/ +def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where + assumptions := fun _ => True + init := fun th st => st ∈ filterInitStatesByConstraints sys params th + tr := fun th st label st' => + (label, ExecutionOutcome.success st') ∈ filterOutcomesByConstraints sys params th st + +/-- Boolean check that a concrete step list follows successful constrained +simulation transitions. Used as the decision procedure for simulation soundness. -/ +def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Bool + | [] => true + | step :: steps => + (filterOutcomesByConstraints sys params th st).any fun (label, outcome) => + match outcome with + | .success st' => label == step.transitionLabel && st' == step.nextState + | _ => false + && StepList.validFromSimulation sys params th step.nextState steps + +/-- Boolean validity check for simulation traces, matching the constrained +search semantics used by `#simulate`. -/ +def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Bool := + (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState && + StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList + +/-- Validity predicate for simulation traces, matching the constrained search +semantics used by `#simulate`. -/ +abbrev Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := + Trace.isSimulationValidB sys params trace = true + +instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : + Decidable (Trace.isSimulationValid sys params trace) := by + unfold Trace.isSimulationValid + infer_instance + +/-- Boolean checker used to decide whether a trace witnesses a simulation +violation; the exported theorem remains Prop-level. -/ +def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Bool + | .safetyFailure violates => + Trace.isSimulationValidB sys params trace && + trace.failingStep.isNone && + decide (violatedInvariantNames params trace.theory trace.lastState = violates) && + !violates.isEmpty + | .deadlock => + Trace.isSimulationValidB sys params trace && + trace.failingStep.isNone && + !params.terminating.holdsOn trace.theory trace.lastState && + let (nexts, _) := partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty + | .assertionFailure exId => + match trace.failingStep with + | some step => + Trace.isSimulationValidB sys params trace && + (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) + | none => false + +/-- A concrete trace witnesses a particular simulation violation. -/ +abbrev Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Prop := + Trace.witnessesSimulationViolationB sys params trace violation = true + +def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Bool := + match result with + | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolationB sys params trace violation + | .foundViolation _ _ none => false + | .noViolationFound _ _ => true + | .cancelled => true + +/-- Soundness predicate for `#simulate` results. +Simulation is not complete, so `noViolationFound` carries no proof obligation, +but any reported violation must come with a valid witness trace. -/ +def ResultSound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := + ResultSoundB sys params result = true + +instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : + Decidable (ResultSound sys params result) := by + unfold ResultSound + infer_instance + /-- Lightweight scan loop: walk without building a trace. Returns `(violated?, updatedRng, stepsTaken)`. -/ -- NOTE: keep in sync with `simulateOnceLoop` (trace-building variant for replay) @@ -42,7 +180,7 @@ partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} match stepsLeft with | 0 => (false, gen, 0) | stepsLeft + 1 => - let outcomes := sys.tr th currSt + let outcomes := filterOutcomesByConstraints sys params th currSt let assertionFailureFound := outcomes.any fun (_, outcome) => match outcome with | .assertionFailure _ _ => true @@ -77,11 +215,12 @@ partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} [Inhabited σ] [Inhabited (κ × σ)] : Bool × StdGen × Nat := - if sys.initStates.isEmpty then + let initStates := filterInitStatesByConstraints sys params th + if initStates.isEmpty then (false, gen, 0) else - let (idx, gen) := randNat gen 0 (sys.initStates.length - 1) - let initSt := sys.initStates[idx]! + let (idx, gen) := randNat gen 0 (initStates.length - 1) + let initSt := initStates[idx]! if !(violatedInvariantNames params th initSt).isEmpty then (true, gen, 0) else @@ -105,7 +244,7 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} match stepsLeft with | 0 => (none, gen, 0) | stepsLeft + 1 => - let outcomes := sys.tr th currSt + let outcomes := filterOutcomesByConstraints sys params th currSt -- Check assertion failures first (highest priority) let failingStep := outcomes.findSome? fun (label, outcome) => match outcome with @@ -149,11 +288,12 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} [Inhabited σ] [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := - if sys.initStates.isEmpty then + let initStates := filterInitStatesByConstraints sys params th + if initStates.isEmpty then (none, gen, 0) else - let (idx, gen) := randNat gen 0 (sys.initStates.length - 1) - let initSt := sys.initStates[idx]! + let (idx, gen) := randNat gen 0 (initStates.length - 1) + let initSt := initStates[idx]! let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } let initViolations := violatedInvariantNames params th initSt if !initViolations.isEmpty then @@ -161,56 +301,127 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} else simulateOnceLoop sys params th maxSteps initSt initTrace gen -/-- Run `maxTraces` independent random traces, stopping on first violation. -Scans without trace recording for speed; replays only the violating trace. -Each trace uses an independent seed derived from `(masterSeed + traceIndex)`. -/ +/-- Pure simulation core for a fixed seed. +Scans without trace recording for speed; replays only the violating trace. -/ @[inline, specialize] -partial def simulate {ρ σ κ : Type} {th₀ : ρ} +def simulateCoreLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (cfg : SimulateConfig) + (remaining : Nat) + (traceIndex : Nat) [Inhabited σ] [Inhabited (κ × σ)] - : IO (SimulateResult ρ σ κ) := do - let actualSeed ← if cfg.seed == 0 - then IO.rand 0 0xFFFFFFFFFFFFFFFF - else pure cfg.seed - let startMs ← IO.monoMsNow - let mut i := 0 - while i < cfg.maxTraces do - let traceSeed := actualSeed + i - try - -- Fast scan: no trace allocation + : SimulateResult ρ σ κ := + match remaining with + | 0 => { + result := .noViolationFound cfg.maxTraces + (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + tracesRun := cfg.maxTraces + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } + | remaining + 1 => + let traceSeed := cfg.seed + traceIndex let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps if violated then - -- Replay with same seed to build counterexample trace let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps match maybeResult with - | some result => - let elapsedMs := (← IO.monoMsNow) - startMs - return { + | some result => { result := result - tracesRun := i + 1 - elapsedMs := elapsedMs - seed := actualSeed + tracesRun := traceIndex + 1 + elapsedMs := 0 + seed := cfg.seed depth := stepsUsed } - | none => - i := i + 1 + | none => simulateCoreLoop sys params th cfg remaining (traceIndex + 1) else - i := i + 1 - catch e => - IO.eprintln s!"#simulate: error on trace {i} (seed := {traceSeed}): {e.toString}" - i := i + 1 - let elapsedMs := (← IO.monoMsNow) - startMs + simulateCoreLoop sys params th cfg remaining (traceIndex + 1) + +/-- Run `maxTraces` independent random traces for a fixed seed. +This function is pure and is the proof-producing core used by `#simulate`. -/ +@[inline, specialize] +def simulateCore {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : SimulateResult ρ σ κ := + simulateCoreLoop sys params th cfg cfg.maxTraces 0 + +/-- IO simulation runner with progress and cancellation hooks. +Uses the configured seed exactly once and reuses its per-trace derivation scheme. -/ +@[inline, specialize] +def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (progressInstanceId : Nat) + (cancelToken : IO.CancelToken) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : IO (SimulateResult ρ σ κ) := do + let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed + let cfg := { cfg with seed := actualSeed } + let startMs ← IO.monoMsNow + let mut tracesRun := 0 + let mut lastStatusUpdate := startMs + while tracesRun < cfg.maxTraces do + if ← Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId then + return { + result := .cancelled + tracesRun + elapsedMs := (← IO.monoMsNow) - startMs + seed := actualSeed + depth := 0 + } + let now ← IO.monoMsNow + if now - lastStatusUpdate ≥ 100 then + Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" + lastStatusUpdate := now + let traceSeed := cfg.seed + tracesRun + let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + if violated then + let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + match maybeResult with + | some result => + Veil.ModelChecker.Concrete.setViolationFound progressInstanceId + return { + result + tracesRun := tracesRun + 1 + elapsedMs := (← IO.monoMsNow) - startMs + seed := actualSeed + depth := stepsUsed + } + | none => + tracesRun := tracesRun + 1 + else + tracesRun := tracesRun + 1 return { - result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + result := .noViolationFound cfg.maxTraces (.earlyTermination (.reachedDepthBound cfg.maxTraces)) tracesRun := cfg.maxTraces - elapsedMs := elapsedMs + elapsedMs := (← IO.monoMsNow) - startMs seed := actualSeed depth := 0 } +/-- IO wrapper around `simulateCore` that fills in a seed when omitted and records +wall-clock time for UI/reporting. -/ +@[inline, specialize] +def simulate {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : IO (SimulateResult ρ σ κ) := do + let cancelToken ← IO.CancelToken.new + simulateWithProgress sys params th cfg 0 cancelToken + end Veil.ModelChecker.Simulation diff --git a/Veil/Core/UI/Trace/TraceDisplay.lean b/Veil/Core/UI/Trace/TraceDisplay.lean index 73db3ca2..b622af47 100644 --- a/Veil/Core/UI/Trace/TraceDisplay.lean +++ b/Veil/Core/UI/Trace/TraceDisplay.lean @@ -99,7 +99,10 @@ def formatModelCheckingResult (j : Json) : MessageData := | "no_violation_found" => let trace := j.getObjValD "trace" if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}" - else m!"✅ No violation (explored {fmtJson (j.getObjValD "explored_states")} states)" + else if j.getObjValD "simulation" == Json.bool true then + m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces" + else + m!"✅ No violation (explored {fmtJson (j.getObjValD "explored_states")} states)" | "cancelled" => m!"⚠️ Cancelled" | r => if j.getObjValD "error" != .null then m!"💥 Error: {fmtJson (j.getObjValD "error")}" else m!"Unknown: {r}" diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index fd0d7caa..dd906bd3 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -735,7 +735,10 @@ where /-- Handle internal mode: define and export the model checker result. -/ elabModelCheckInternalMode (mod : Module) (callExpr : Term) : CommandElabM Unit := do - elabVeilCommand (← `(def $(mkIdent `modelCheckerResult) (pcfg : Option Veil.ModelChecker.ParallelConfig) (progressInstanceId : Nat) (cancelToken : IO.CancelToken) := $callExpr pcfg progressInstanceId cancelToken)) + elabVeilCommand (← `(def $(mkIdent `modelCheckerResult) + (pcfg : Option Veil.ModelChecker.ParallelConfig) (progressInstanceId : Nat) + (cancelToken : IO.CancelToken) : IO Lean.Json := + Lean.toJson <$> $callExpr pcfg progressInstanceId cancelToken)) elabVeilCommand (← `(end $(mkIdent mod.name))) elabVeilCommand (← `(export $(mkIdent mod.name) ($(mkIdent `modelCheckerResult)))) @@ -752,12 +755,10 @@ where ModelChecker.Concrete.finishProgress instanceId (errorJson s!"Binary not found at {binPath}") return none - /-- Run the model checker binary and finish with result. Returns true if completed. -/ - runBinaryAndFinish (binPath : System.FilePath) (parallelCfg : Option ModelChecker.ParallelConfig) - (instanceId : Nat) (cancelToken : IO.CancelToken) - (assertionSources : Std.HashMap AssertionId AssertionSourceInfo) : IO Bool := do + /-- Run the compiled binary and return its JSON result if completed. -/ + runBinaryForJson (binPath : System.FilePath) (args : Array String) + (instanceId : Nat) (cancelToken : IO.CancelToken) : IO (Option Json) := do ModelChecker.Concrete.updateStatus instanceId "Running compiled binary..." - let args := parallelCfg.map (fun p => #[s!"{p.numSubTasks}", s!"{p.thresholdToParallel}"]) |>.getD #[] let child ← IO.Process.spawn { cmd := toString (binPath / "ModelCheckerMain"), args, stdin := .piped, stdout := .piped, stderr := .piped } @@ -783,17 +784,15 @@ where let waitTask ← IO.asTask (prio := .dedicated) child.wait -- Monitor for cancellation while !(← IO.hasFinished waitTask) do - if ← checkCancelled cancelToken instanceId then child.kill; return false + if ← checkCancelled cancelToken instanceId then child.kill; return none IO.sleep 100 let stdout ← IO.ofExcept (← IO.wait stdoutTask) let exitCode ← IO.ofExcept (← IO.wait waitTask) let stderr ← stderrAccum.get if exitCode != 0 then ModelChecker.Concrete.finishProgress instanceId (errorJson s!"Binary exited with code {exitCode}{if stderr.isEmpty then "" else s!"\n{stderr}"}") - return true - let json := Json.parse stdout |>.toOption.getD (errorJson s!"Failed to parse output: {stdout.take 500}") - ModelChecker.Concrete.finishProgress instanceId (enrichJsonWithAssertions json assertionSources) - return true + return none + return some (Json.parse stdout |>.toOption.getD (errorJson s!"Failed to parse output: {stdout.take 500}")) /-- Elaborate the interpreted mode computation. Must be called synchronously. -/ elaborateInterpretedComputation (instanceId : Nat) (callExpr : Term) @@ -838,20 +837,27 @@ where runBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) (sourceFile : String) : CommandElabM Unit := do let some binPath ← verifyBinaryExists buildFolder ctx.instanceId | return - let _ ← runBinaryAndFinish binPath ctx.parallelCfg ctx.instanceId ctx.cancelToken ctx.assertionSources + let args := ctx.parallelCfg.map (fun p => #[s!"{p.numSubTasks}", s!"{p.thresholdToParallel}"]) |>.getD #[] + let some json ← runBinaryForJson binPath args ctx.instanceId ctx.cancelToken | return + ModelChecker.Concrete.finishProgress ctx.instanceId (enrichJsonWithAssertions json ctx.assertionSources) ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder let some resultJson ← ModelChecker.Concrete.getResultJson ctx.instanceId | return logModelCheckResult ctx.stx resultJson /-- Compile the model. Returns the build folder path if compilation succeeded, none otherwise. -/ compileModel (mod : Module) (sourceFile : String) (modelSource : String) - (instanceId : Nat) : IO (Option System.FilePath) := do - let buildFolder ← ModelChecker.Compilation.createBuildFolder sourceFile modelSource mod.name.toString + (instanceId : Nat) (cancelToken : IO.CancelToken) + (command : ModelChecker.Compilation.CompiledCommandSpec) : IO (Option System.FilePath) := do + let buildFolder ← ModelChecker.Compilation.createBuildFolder sourceFile modelSource mod.name.toString command ModelChecker.Compilation.markRegistryInProgress sourceFile instanceId buildFolder let result ← ModelChecker.Compilation.runProcessWithStatusCallback + sourceFile { cmd := "lake", args := #["build", "ModelCheckerMain"], cwd := buildFolder } + instanceId "Compiling model" cancelToken (fun elapsedMs => ModelChecker.Concrete.updateCompilationElapsed instanceId elapsedMs) (fun line isError elapsedMs => ModelChecker.Concrete.updateCompilationLog instanceId elapsedMs line isError) + if result.interrupted then + return none if result.exitCode != 0 then ModelChecker.Concrete.updateCompilationStatus instanceId (.failed (mkCompilationErrorMsg result)) return none @@ -921,7 +927,8 @@ where let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId | return + let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId ctx.cancelToken + { exportedName := "modelCheckerResult", supportsParallelConfig := true } | return if ← checkCancelled ctx.cancelToken ctx.instanceId then return runBinaryAndLogResult ctx buildFolder sourceFile catch e : Exception => @@ -959,7 +966,8 @@ where let compilationCancelTk ← IO.CancelToken.new let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId | return + let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId compilationCancelTk + { exportedName := "modelCheckerResult", supportsParallelConfig := true } | return -- Skip handoff if violation found or interpreted finished if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) then ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder @@ -979,71 +987,253 @@ where ModelChecker.displayStreamingProgress stx ctx.instanceId -/-- Build the simulator call syntax. -/ +/-- Build the pure simulator core call syntax. -/ private def mkSimulatorCall (mod : Module) (instTerm theoryTerm : Term) (sp : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Term := do let inst := mkVeilImplementationDetailIdent `inst let th := mkVeilImplementationDetailIdent `th - let instSortArgs ← (← mod.sortIdents).mapM fun sortIdent => `($inst.$(sortIdent)) + let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) `((let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.simulate) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp $th $cfgTerm)) + let $th : $theoryIdent $instSortArgs* := $theoryTerm + $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore) + ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) + ($(mkIdent `inhabκσ) := by infer_instance) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp $th $cfgTerm)) + +/-- Build the simulator runtime call syntax with progress and cancellation hooks. -/ +private def mkSimulateJsonExpr (resultIdent : Ident) : CommandElabM Term := + `(Lean.Json.mkObj [ + ("result", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.result $resultIdent)), + ("traces_run", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.tracesRun $resultIdent)), + ("elapsed_ms", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.elapsedMs $resultIdent)), + ("seed", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.seed $resultIdent)), + ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth $resultIdent)) + ]) + +private def generateCompiledModelSourcePrefix (mod : Module) (stx : Syntax) : CommandElabM String := do + let src := (← getFileMap).source + let afterImportsPos := ModelChecker.Compilation.findPosAfterImports src + let compileModePreamble := "\nset_option veil.__modelCheckCompileMode true\n" + let some specFinalizedAtStx := mod.specFinalizedAtStx + | throwError "Internal error: spec should be finalized before generating model source" + let some commandStart := stx.getPos? | throwError "Unexpected error: command has no position" + let modelCheckTriggeredFinalization := specFinalizedAtStx.getPos? == stx.getPos? + let specFinalizedAtPos := if modelCheckTriggeredFinalization + then commandStart + else specFinalizedAtStx.getTailPos?.getD commandStart + let beforeImports := String.Pos.Raw.extract src 0 afterImportsPos + let afterImportsToSpecFinalized := String.Pos.Raw.extract src afterImportsPos specFinalizedAtPos + return beforeImports ++ compileModePreamble ++ afterImportsToSpecFinalized ++ "\n" + +private def getSourceSlice (stx : Syntax) : CommandElabM String := do + let some startPos := stx.getPos? | throwError "Unexpected error: syntax has no start position" + let some endPos := stx.getTailPos? | throwError "Unexpected error: syntax has no end position" + return String.Pos.Raw.extract (← getFileMap).source startPos endPos + +private def generateSimulateModelSource (mod : Module) (stx : Syntax) + (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM String := do + let srcPrefix ← generateCompiledModelSourcePrefix mod stx + let instSrc ← getSourceSlice stx[2] + let theorySrc ← if stx[3].isNone then pure "" else do + let raw ← getSourceSlice stx[3][0] + pure s!" {raw}" + let cmd := s!"#simulate {instSrc}{theorySrc} (maxTraces := {cfg.maxTraces}) (maxSteps := {cfg.maxSteps}) (seed := {cfg.seed})" + return srcPrefix ++ cmd ++ "\n" + +private def evaluateSimulateJson (resultIdent : Ident) : CommandElabM Lean.Json := do + let jsonExpr ← mkSimulateJsonExpr resultIdent + liftTermElabM do + let expr ← Term.elabTerm jsonExpr none + Term.synthesizeSyntheticMVarsNoPostponing + unsafe Meta.evalExpr Lean.Json (mkConst ``Lean.Json) (← instantiateMVars expr) + +private def setJsonField (json : Json) (key : String) (value : Json) : Json := + match json with + | .obj kvs => + Json.mkObj <| (kvs.toList.filter fun (entry : String × Json) => entry.1 != key) ++ [(key, value)] + | _ => json + +private def attachSimulationMetadata (combinedJson : Json) : Json := + match combinedJson.getObjValD "result" with + | .obj kvs => + Json.mkObj <| kvs.toList ++ [ + ("simulation", Json.bool true), + ("traces_run", combinedJson.getObjValD "traces_run"), + ("elapsed_ms", combinedJson.getObjValD "elapsed_ms"), + ("seed", combinedJson.getObjValD "seed"), + ("depth", combinedJson.getObjValD "depth") + ] + | other => other + +private def attachSimulationElapsed (combinedJson : Json) (elapsedMs : Nat) : Json := + setJsonField combinedJson "elapsed_ms" (toJson elapsedMs) + +private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) + (resultIdent soundIdent : Ident) : CommandElabM Unit := do + elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) + let inst := mkVeilImplementationDetailIdent `inst + let th := mkVeilImplementationDetailIdent `th + let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) + elabVeilCommand (← `(theorem $soundIdent : + (let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + $(mkIdent ``Veil.ModelChecker.Simulation.ResultSound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by + native_decide)) + +private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do + let resultJson := attachSimulationMetadata combinedJson + let seed := (combinedJson.getObjValD "seed").getNat? |>.getD 0 + let tracesRun := (combinedJson.getObjValD "traces_run").getNat? |>.getD 0 + let elapsedMs := (combinedJson.getObjValD "elapsed_ms").getNat? |>.getD 0 + let depth := (combinedJson.getObjValD "depth").getNat? |>.getD 0 + let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 + let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || + resultJson.getObjValD "error" != .null + let summary := if isViolation then + s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." + else if resultJson.getObjValD "result" == Json.str "cancelled" then + s!"simulation: cancelled after {tracesRun} traces ({elapsedMs}ms, seed := {seed})." + else + s!"simulation: no violation in {tracesRun} traces ({elapsedMs}ms, {tracesPerSec} traces/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." + logInfoAt stx summary + return resultJson + +private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : Json) : CommandElabM Unit := do + let resultJson ← logSimulationSummary ctx.stx combinedJson + elabModelCheck.finishWithResult ctx resultJson + +private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) + (sourceFile : String) : CommandElabM Unit := do + let some binPath ← elabModelCheck.verifyBinaryExists buildFolder ctx.instanceId | return + let startMs ← liftIO IO.monoMsNow + let some combinedJson ← elabModelCheck.runBinaryForJson binPath #[] ctx.instanceId ctx.cancelToken | return + ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + let elapsedMs := (← liftIO IO.monoMsNow) - startMs + finishWithSimulationResult ctx (attachSimulationElapsed combinedJson elapsedMs) + +private def elabSimulateInternalMode (mod : Module) (resultIdent : Ident) : CommandElabM Unit := do + let jsonExpr ← mkSimulateJsonExpr resultIdent + elabVeilCommand (← `(def $(mkIdent `simulateResult) + (progressInstanceId : Nat) (cancelToken : IO.CancelToken) : IO Lean.Json := + pure $jsonExpr)) + elabVeilCommand (← `(end $(mkIdent mod.name))) + elabVeilCommand (← `(export $(mkIdent mod.name) ($(mkIdent `simulateResult)))) + +private def elabSimulateInterpretedMode (mod : Module) (stx : Syntax) (resultIdent : Ident) : CommandElabM Unit := do + let ctx ← elabModelCheck.allocModelCheckContext mod stx none + let computation ← Command.wrapAsyncAsSnapshot (fun () => do + try + if ← elabModelCheck.checkCancelled ctx.cancelToken ctx.instanceId then return + ModelChecker.Concrete.updateStatus ctx.instanceId "Running random traces..." + let startMs ← IO.monoMsNow + let combinedJson ← evaluateSimulateJson resultIdent + let endMs ← IO.monoMsNow + finishWithSimulationResult ctx (attachSimulationElapsed combinedJson (endMs - startMs)) + catch e : Exception => + elabModelCheck.handleModelCheckError ctx e + ) ctx.cancelToken + let task ← BaseIO.asTask (computation ()) (prio := .dedicated) + Command.logSnapshotTask { stx? := none, cancelTk? := ctx.cancelToken, task } + ModelChecker.displayStreamingProgress stx ctx.instanceId + +private def elabSimulateCompiledMode (mod : Module) (stx : Syntax) + (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do + let ctx ← elabModelCheck.allocModelCheckContext mod stx none + let sourceFile ← getFileName + let modelSource ← generateSimulateModelSource mod stx cfg + let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do + try + let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource ctx.instanceId ctx.cancelToken + { exportedName := "simulateResult", supportsParallelConfig := false } | return + if ← elabModelCheck.checkCancelled ctx.cancelToken ctx.instanceId then return + runSimulateBinaryAndLogResult ctx buildFolder sourceFile + catch e : Exception => + elabModelCheck.handleModelCheckError ctx e + ) ctx.cancelToken + let compilationTask ← BaseIO.asTask (compilationComputation ()) (prio := .dedicated) + Command.logSnapshotTask { stx? := none, cancelTk? := ctx.cancelToken, task := compilationTask } + ModelChecker.displayStreamingProgress stx ctx.instanceId + +private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (resultIdent : Ident) + (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do + let ctx ← elabModelCheck.allocModelCheckContext mod stx none + let sourceFile ← getFileName + let modelSource ← generateSimulateModelSource mod stx cfg + let compilationCancelTk ← IO.CancelToken.new + let interpretedComputation ← Command.wrapAsyncAsSnapshot (fun () => do + try + ModelChecker.Concrete.updateStatus ctx.instanceId "Running random traces..." + let startMs ← IO.monoMsNow + let combinedJson ← evaluateSimulateJson resultIdent + let endMs ← IO.monoMsNow + match (← ctx.cancelToken.isSet, ← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) with + | (true, false) => ModelChecker.Concrete.cancelProgress ctx.instanceId + | (false, _) => + compilationCancelTk.set + finishWithSimulationResult ctx (attachSimulationElapsed combinedJson (endMs - startMs)) + | (true, true) => pure () + catch e : Exception => + elabModelCheck.handleModelCheckError ctx e + ) ctx.cancelToken + let interpretedTask ← BaseIO.asTask (interpretedComputation ()) (prio := .dedicated) + Command.logSnapshotTask { stx? := none, cancelTk? := ctx.cancelToken, task := interpretedTask } + let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do + try + let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource ctx.instanceId compilationCancelTk + { exportedName := "simulateResult", supportsParallelConfig := false } | return + if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) then + ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + return + ModelChecker.Concrete.requestHandoff ctx.instanceId + ctx.cancelToken.set + let _ ← IO.wait interpretedTask + let some newCancelToken ← ModelChecker.Concrete.resetProgressForHandoff ctx.instanceId | return + let ctxWithNewToken := { ctx with cancelToken := newCancelToken } + runSimulateBinaryAndLogResult ctxWithNewToken buildFolder sourceFile + catch e : Exception => + ModelChecker.Concrete.updateCompilationStatus ctx.instanceId (.failed s!"{← e.toMessageData.toString}") + ) compilationCancelTk + let compilationTask ← BaseIO.asTask (compilationComputation ()) (prio := .dedicated) + Command.logSnapshotTask { stx? := none, cancelTk? := compilationCancelTk, task := compilationTask } + ModelChecker.displayStreamingProgress stx ctx.instanceId @[command_elab Veil.simulate] def elabSimulate : CommandElab := fun stx => do withTraceNode `veil.perf.elaborator.simulate (fun _ => return "#simulate") do - let instTerm : Term := ⟨stx[1]⟩ - let theoryTermOpt : Option Term := if stx[2].isNone then none else some ⟨stx[2][0]⟩ + let mode := getModelCheckingMode stx[1] + let instTerm : Term := ⟨stx[2]⟩ + let theoryTermOpt : Option Term := if stx[3].isNone then none else some ⟨stx[3][0]⟩ let mod ← getCurrentModule (errMsg := "You cannot #simulate outside of a Veil module!") mod.throwIfSpecNotFinalized let theoryTerm ← resolveTheoryTerm "#simulate" theoryTermOpt mod instTerm warnAboutTransitions mod - let cfg0 ← elabSimulateConfig stx[3] + let cfg0 ← elabSimulateConfig stx[4] let opts ← getOptions let maxTraces := if cfg0.maxTraces == 10000 then veil.simulate.maxTraces.get opts else cfg0.maxTraces let maxSteps := if cfg0.maxSteps == 100 then veil.simulate.maxSteps.get opts else cfg0.maxSteps - let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps } + let seed ← liftIO <| if cfg0.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg0.seed + let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps, seed } let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } let sp ← buildSearchParameters mod mcCfg - let callExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg - let wrappedCallExpr ← `(Functor.map (fun r => Lean.Json.mkObj [ - ("result", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.result r)), - ("traces_run", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.tracesRun r)), - ("elapsed_ms", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.elapsedMs r)), - ("seed", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.seed r)), - ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth r)) - ]) $callExpr:term) - trace[veil.desugar] "{wrappedCallExpr}" - let ioJson ← liftTermElabM do - let expr ← Term.elabTerm wrappedCallExpr none - Term.synthesizeSyntheticMVarsNoPostponing - unsafe Meta.evalExpr (IO Lean.Json) - (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) - (← instantiateMVars expr) - let combinedJson ← liftIO ioJson - let assertionSources := extractAssertionSources (← globalEnv.get).assertions (← getFileMap) - let resultJson := enrichJsonWithAssertions (combinedJson.getObjValD "result") assertionSources - let seed := (combinedJson.getObjValD "seed").getNat? |>.getD 0 - let tracesRun := (combinedJson.getObjValD "traces_run").getNat? |>.getD 0 - let elapsedMs := (combinedJson.getObjValD "elapsed_ms").getNat? |>.getD 0 - let depth := (combinedJson.getObjValD "depth").getNat? |>.getD 0 - let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 - let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || - resultJson.getObjValD "error" != .null - -- Log simulation-specific summary - let summary := if isViolation then - s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." - else - s!"simulation: no violation in {tracesRun} traces ({elapsedMs}ms, {tracesPerSec} traces/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." - logInfoAt stx summary - -- Log the same trace display as #model_check - elabModelCheck.logModelCheckResult stx resultJson - -- Display the same TraceDisplayViewer widget as #model_check - let (instanceId, _) ← ModelChecker.Concrete.allocProgressInstance (← getActionLabelNames mod) - ModelChecker.Concrete.finishProgress instanceId resultJson - ModelChecker.displayStreamingProgress stx instanceId + let pureCallExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg + if ← isModelCheckCompileMode then + let simulateResultIdent := mkVeilImplementationDetailIdent `simulateResultValue + let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent + elabSimulateInternalMode mod simulateResultIdent + return + let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) + let simulateSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateSound)) + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent + let effectiveMode := if (← liftIO isVeilOnlineEnv) then .interpreted else mode + match effectiveMode with + | .interpreted => elabSimulateInterpretedMode mod stx simulateResultIdent + | .compiled => elabSimulateCompiledMode mod stx cfg + | .default => elabSimulateWithHandoff mod stx simulateResultIdent cfg end Veil diff --git a/Veil/Frontend/DSL/Module/Syntax.lean b/Veil/Frontend/DSL/Module/Syntax.lean index 8f04bd1d..e5e0a3b7 100644 --- a/Veil/Frontend/DSL/Module/Syntax.lean +++ b/Veil/Frontend/DSL/Module/Syntax.lean @@ -369,8 +369,25 @@ scoped syntax (name := concreteRepresentationDecl) "veil_set_field_representatio /-- Run random-walk simulation on the current module. Explores random traces to find shallow invariant violations quickly. - Seed defaults to current timestamp if omitted (always shown in output for reproducibility). - Example: `#simulate {}` or `#simulate {} (maxTraces := 100, seed := 42)` -/ -syntax (name := simulate) "#simulate " term:max (term:max)? Parser.Tactic.optConfig : command + +## Execution Modes + +**Default behavior** (`#simulate`): +- Runs interpreted mode immediately and shows streaming progress +- Starts compilation in background +- When compilation finishes before interpreted mode does, restarts with the + compiled binary using the same chosen seed + +**Interpreted-only mode** (`#simulate interpreted`): +- Runs only interpreted mode without background compilation + +**Compiled-only mode** (`#simulate compiled`): +- Builds and runs the compiled binary directly + +Seed defaults to a generated value if omitted; the chosen seed is always shown +in output for reproducibility and reused consistently across mode handoff. + +Example: `#simulate {}` or `#simulate compiled {} (maxTraces := 100, seed := 42)` -/ +syntax (name := simulate) "#simulate " (modelCheckMode)? term:max (term:max)? Parser.Tactic.optConfig : command end Veil diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index 795ca921..90234d4e 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -51,13 +51,17 @@ def getBuildBaseDir : IO System.FilePath := do let pwd ← IO.currentDir return pwd / ".lake" / "model_checker_builds" -/-- Generate a build folder name based on the source file name, so that for the -same source file we get the same build folder. -/ -def generateBuildFolderName (sourceFile : String) : IO System.FilePath := do - -- Use the source file's stem (filename without extension) for readability +structure CompiledCommandSpec where + exportedName : String + supportsParallelConfig : Bool := false + +/-- Generate a build folder name based on the source file and exported command, +so distinct compiled commands do not race on the same temp project. -/ +def generateBuildFolderName (sourceFile : String) (command : CompiledCommandSpec) : IO System.FilePath := do let stem := System.FilePath.mk sourceFile |>.fileStem.getD "unrecognized_model" + let suffix := toString (hash (sourceFile ++ ":" ++ command.exportedName)) let baseDir ← getBuildBaseDir - return baseDir / stem + return baseDir / s!"{stem}_{command.exportedName}_{suffix}" /-- Template for the `lakefile.lean` in the temp project. Note that it does not only require the parent Veil project, but also *all the dependencies*; @@ -93,7 +97,7 @@ lean_exe ModelCheckerMain where /-- Template for the ModelCheckerMain.lean in the temp project. Takes the namespace of the specification to open scoped instances. -/ -def modelCheckerMainTemplate (specNamespace : String) : String := +def modelCheckerMainTemplate (specNamespace : String) (command : CompiledCommandSpec) : String := "import Model set_option maxHeartbeats 6400000 @@ -129,17 +133,21 @@ def main (args : List String) : IO Unit := do -- Instance ID is not used in compiled mode, pass 0 -- Cancel token is created locally; cancellation is handled by killing the process from outside let cancelTk ← IO.CancelToken.new - let res ← modelCheckerResult pcfg 0 cancelTk - IO.println s!\"{Lean.toJson res}\" + let res ← " ++ + (if command.supportsParallelConfig + then command.exportedName ++ " pcfg 0 cancelTk" + else command.exportedName ++ " 0 cancelTk") ++ " + IO.println s!\"{res}\" flushStdoutAndStderr IO.Process.forceExit 0 " /-- Create the temp build folder with all necessary files. Returns the absolute path to the build folder. -/ -def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespace : String) : IO System.FilePath := do +def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespace : String) + (command : CompiledCommandSpec) : IO System.FilePath := do let veilPath ← IO.currentDir - let buildFolder ← generateBuildFolderName sourceFile + let buildFolder ← generateBuildFolderName sourceFile command -- Create the build folder IO.FS.createDirAll buildFolder -- Write the lakefile @@ -147,7 +155,7 @@ def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespac -- Write the model source (renamed to Model.lean) IO.FS.writeFile (buildFolder / "Model.lean") modelSource -- Write the ModelCheckerMain.lean - IO.FS.writeFile (buildFolder / "ModelCheckerMain.lean") (modelCheckerMainTemplate specNamespace) + IO.FS.writeFile (buildFolder / "ModelCheckerMain.lean") (modelCheckerMainTemplate specNamespace command) -- Create a minimal lean-toolchain file (copy from parent) let toolchainPath := veilPath / "lean-toolchain" if ← toolchainPath.pathExists then @@ -199,11 +207,10 @@ def runProcessWithStatus (sourceFile : String) (cfg : IO.Process.SpawnArgs) | .ok exitCode => return { exitCode, stdout, stderr, interrupted } | .error err => return { exitCode := 1, stdout, stderr := s!"{stderr}\nIO error: {err}", interrupted } -/-- Run a process with callbacks for status updates and line-by-line output capture. - - `statusCallback` is called periodically (every 500ms) with the elapsed time in ms. - - `lineCallback` is called for each line of output (content, isError, elapsedMs). - This variant does not check for cancellation - it runs to completion. -/ -def runProcessWithStatusCallback (cfg : IO.Process.SpawnArgs) +/-- Run a process with callbacks for status updates and line-by-line output capture, +checking both explicit cancellation and whether this compilation is still current. -/ +def runProcessWithStatusCallback (sourceFile : String) (cfg : IO.Process.SpawnArgs) + (instanceId : Nat) (_statusPrefix : String) (cancelToken : IO.CancelToken) (statusCallback : Nat → IO Unit) (lineCallback : String → Bool → Nat → IO Unit := fun _ _ _ => pure ()) : IO ProcessResult := do @@ -221,14 +228,24 @@ def runProcessWithStatusCallback (cfg : IO.Process.SpawnArgs) let stdoutTask ← IO.asTask (prio := .dedicated) (readLines proc.stdout stdoutAccum false) let stderrTask ← IO.asTask (prio := .dedicated) (readLines proc.stderr stderrAccum true) let waitTask ← IO.asTask (prio := .dedicated) proc.wait + let mut interrupted := false while !(← IO.hasFinished waitTask) do - statusCallback ((← IO.monoMsNow) - startTime) + if ← cancelToken.isSet then + proc.kill + interrupted := true + break + let current? ← stillCurrentCont sourceFile instanceId do + statusCallback ((← IO.monoMsNow) - startTime) + unless current? do + proc.kill + interrupted := true + break IO.sleep 500 let _ ← IO.wait stdoutTask let _ ← IO.wait stderrTask match ← IO.wait waitTask with - | .ok exitCode => return { exitCode, stdout := ← stdoutAccum.get, stderr := ← stderrAccum.get, interrupted := false } - | .error err => return { exitCode := 1, stdout := ← stdoutAccum.get, stderr := s!"{← stderrAccum.get}\nIO error: {err}", interrupted := false } + | .ok exitCode => return { exitCode, stdout := ← stdoutAccum.get, stderr := ← stderrAccum.get, interrupted } + | .error err => return { exitCode := 1, stdout := ← stdoutAccum.get, stderr := s!"{← stderrAccum.get}\nIO error: {err}", interrupted } -- /-- Clean up all build folders older than the specified age (in milliseconds). -/ -- def cleanupOldBuildFolders (maxAgeMs : Nat := 24 * 60 * 60 * 1000) : IO Nat := do From ed7f8105868b57a4234f7b9637b3f3324be63948 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:18:35 +0200 Subject: [PATCH 14/88] test: cover parity regressions --- VeilTest/Regression/MultipleSimulate.lean | 28 +++++++++++++++++++ VeilTest/Regression/SimulateModes.lean | 33 +++++++++++++++++++++++ VeilTest/RequiresGenSpec.lean | 24 +++++++++++++++-- VeilTest/UninterpretedParameter.lean | 3 +++ 4 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 VeilTest/Regression/MultipleSimulate.lean create mode 100644 VeilTest/Regression/SimulateModes.lean diff --git a/VeilTest/Regression/MultipleSimulate.lean b/VeilTest/Regression/MultipleSimulate.lean new file mode 100644 index 00000000..36023627 --- /dev/null +++ b/VeilTest/Regression/MultipleSimulate.lean @@ -0,0 +1,28 @@ +import Veil + +veil module MultipleSimulate + +type node + +relation flag : node -> Bool + +after_init { + flag N := false +} + +action set_flag (n : node) { + flag n := true +} + +invariant [bounded] ∀ n, flag n -> flag n + +#guard_msgs(drop warning) in +#gen_spec + +#guard_msgs(drop info) in +#simulate { node := Fin 2 } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +#guard_msgs(drop info) in +#simulate { node := Fin 2 } {} (seed := 2) (maxTraces := 1) (maxSteps := 1) + +end MultipleSimulate diff --git a/VeilTest/Regression/SimulateModes.lean b/VeilTest/Regression/SimulateModes.lean new file mode 100644 index 00000000..0b4e746f --- /dev/null +++ b/VeilTest/Regression/SimulateModes.lean @@ -0,0 +1,33 @@ +import Veil + +veil module SimulateModes + +individual flag : Bool + +#gen_state + +after_init { + flag := false +} + +action set_flag { + flag := true +} + +invariant [safe_flag] ¬ flag + +#gen_spec + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateModes diff --git a/VeilTest/RequiresGenSpec.lean b/VeilTest/RequiresGenSpec.lean index cb4fcf73..24b34444 100644 --- a/VeilTest/RequiresGenSpec.lean +++ b/VeilTest/RequiresGenSpec.lean @@ -3,8 +3,9 @@ import Veil /-! # Tests that commands requiring finalized spec throw errors without #gen_spec -These tests verify that `#check_invariants`, `#model_check`, and `sat trace`/`unsat trace` -all throw an appropriate error message when called before `#gen_spec`. +These tests verify that `#check_invariants`, `#model_check`, `#simulate`, and +`sat trace`/`unsat trace` all throw an appropriate error message when called +before `#gen_spec`. -/ veil module TestCheckInvariants @@ -49,6 +50,25 @@ invariant ¬ flag end TestModelCheck +veil module TestSimulate + +individual flag : Bool + +#gen_state + +after_init { flag := false } + +action set_flag { flag := true } + +invariant ¬ flag + +/-- error: The specification of module TestSimulate has not been finalized. Please call #gen_spec first! -/ +#guard_msgs in +#simulate { } + +end TestSimulate + + veil module TestSatTrace individual flag : Bool diff --git a/VeilTest/UninterpretedParameter.lean b/VeilTest/UninterpretedParameter.lean index 417a3d76..b541316f 100644 --- a/VeilTest/UninterpretedParameter.lean +++ b/VeilTest/UninterpretedParameter.lean @@ -34,4 +34,7 @@ invariant [bounded] ∀ (x : node), counter x ≤ n #model_check interpreted { node := Fin 2, n := 1, color := Fin 2, m := ⟨1, by decide⟩ } {} +#guard_msgs(drop info) in +#simulate { node := Fin 2, n := 1, color := Fin 2, m := ⟨1, by decide⟩ } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + end TestParameter From 534c9f2b86fd263f4e105655e3090778597806fd Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:44:09 +0200 Subject: [PATCH 15/88] refactor: share executed path semantics --- Veil/Core/Tools/ModelChecker/Simulation.lean | 93 +++++++++++--------- 1 file changed, 50 insertions(+), 43 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 8c9268b7..3009e6da 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -164,9 +164,37 @@ instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} unfold ResultSound infer_instance +private inductive StepDecision (σ κ : Type) where + | assertionFailure (exId : Int) (step : Step σ κ) + | deadlock + | terminated + | continue (nexts : List (κ × σ)) + +private def decideAtState {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := + let outcomes := filterOutcomesByConstraints sys params th currSt + let failingStep := outcomes.findSome? fun (label, outcome) => + match outcome with + | .assertionFailure exId st => + some (exId, { transitionLabel := label, nextState := st }) + | _ => none + match failingStep with + | some (exId, step) => .assertionFailure exId step + | none => + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes + if nexts.isEmpty then + if !params.terminating.holdsOn th currSt then .deadlock else .terminated + else + .continue nexts + +private def pickNextTransition {σ κ : Type} + (nexts : List (κ × σ)) (gen : StdGen) [Inhabited (κ × σ)] : (κ × σ) × StdGen := + let (idx, gen) := randNat gen 0 (nexts.length - 1) + (nexts[idx]!, gen) + /-- Lightweight scan loop: walk without building a trace. Returns `(violated?, updatedRng, stepsTaken)`. -/ --- NOTE: keep in sync with `simulateOnceLoop` (trace-building variant for replay) @[inline, specialize] partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -180,23 +208,15 @@ partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} match stepsLeft with | 0 => (false, gen, 0) | stepsLeft + 1 => - let outcomes := filterOutcomesByConstraints sys params th currSt - let assertionFailureFound := outcomes.any fun (_, outcome) => - match outcome with - | .assertionFailure _ _ => true - | _ => false - if assertionFailureFound then - (true, gen, 1) - else - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes - if nexts.isEmpty then - if !params.terminating.holdsOn th currSt then - (true, gen, 0) -- deadlock - else - (false, gen, 0) - else - let (idx, gen) := randNat gen 0 (nexts.length - 1) - let (_, nextSt) := nexts[idx]! + match decideAtState sys params th currSt with + | .assertionFailure _ _ => + (true, gen, 1) + | .deadlock => + (true, gen, 0) + | .terminated => + (false, gen, 0) + | .continue nexts => + let ((_, nextSt), gen) := pickNextTransition nexts gen if !(violatedInvariantNames params th nextSt).isEmpty then (true, gen, 1) else @@ -229,7 +249,6 @@ partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} /-- Inner loop of a single random trace: walk from `currSt` for up to `stepsLeft` steps, picking a random enabled transition at each step. Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ --- NOTE: keep in sync with `scanOnceLoop` (allocation-free variant for scanning) @[inline, specialize] partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -244,30 +263,18 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} match stepsLeft with | 0 => (none, gen, 0) | stepsLeft + 1 => - let outcomes := filterOutcomesByConstraints sys params th currSt - -- Check assertion failures first (highest priority) - let failingStep := outcomes.findSome? fun (label, outcome) => - match outcome with - | .assertionFailure exId st => - some (exId, { transitionLabel := label, nextState := st }) - | _ => none - match failingStep with - | some (exId, step) => - let failedTrace := { trace with failingStep := some step } - -- +1 for the failing action itself (not in trace.steps, stored in failingStep) - (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), - gen, trace.steps.size + 1) - | none => - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes - if nexts.isEmpty then - if !params.terminating.holdsOn th currSt then - -- No enabled transitions and not a terminating state: deadlock - (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) - else - (none, gen, trace.steps.size) - else - let (idx, gen) := randNat gen 0 (nexts.length - 1) - let (label, nextSt) := nexts[idx]! + match decideAtState sys params th currSt with + | .assertionFailure exId step => + let failedTrace := { trace with failingStep := some step } + -- +1 for the failing action itself (not in trace.steps, stored in failingStep) + (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), + gen, trace.steps.size + 1) + | .deadlock => + (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) + | .terminated => + (none, gen, trace.steps.size) + | .continue nexts => + let ((label, nextSt), gen) := pickNextTransition nexts gen let trace := trace.push { transitionLabel := label, nextState := nextSt } let violations := violatedInvariantNames params th nextSt if !violations.isEmpty then From 2fc5d47c3d757945b09a2f7bc7043660040d43a5 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:51:01 +0200 Subject: [PATCH 16/88] refactor: share pure and runtime trace loops --- Veil/Core/Tools/ModelChecker/Simulation.lean | 125 ++++++++++--------- 1 file changed, 65 insertions(+), 60 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 3009e6da..09833fbd 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -193,6 +193,11 @@ private def pickNextTransition {σ κ : Type} let (idx, gen) := randNat gen 0 (nexts.length - 1) (nexts[idx]!, gen) +private structure SimulationHooks (m : Type → Type) where + shouldStop : Nat → m Bool + onTraceProgress : Nat → m PUnit + onViolation : m PUnit + /-- Lightweight scan loop: walk without building a trace. Returns `(violated?, updatedRng, stepsTaken)`. -/ @[inline, specialize] @@ -308,10 +313,25 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} else simulateOnceLoop sys params th maxSteps initSt initTrace gen -/-- Pure simulation core for a fixed seed. -Scans without trace recording for speed; replays only the violating trace. -/ -@[inline, specialize] -def simulateCoreLoop {ρ σ κ : Type} {th₀ : ρ} +private def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (traceIndex : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit × Nat) := + let traceSeed := cfg.seed + traceIndex + let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + if violated then + let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + maybeResult.map (fun result => (result, stepsUsed)) + else + none + +private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ : ρ} + (hooks : SimulationHooks m) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) @@ -320,32 +340,40 @@ def simulateCoreLoop {ρ σ κ : Type} {th₀ : ρ} (traceIndex : Nat) [Inhabited σ] [Inhabited (κ × σ)] - : SimulateResult ρ σ κ := - match remaining with - | 0 => { - result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedDepthBound cfg.maxTraces)) - tracesRun := cfg.maxTraces + : m (SimulateResult ρ σ κ) := do + if ← hooks.shouldStop traceIndex then + return { + result := .cancelled + tracesRun := traceIndex elapsedMs := 0 seed := cfg.seed depth := 0 } + match remaining with + | 0 => + return { + result := .noViolationFound cfg.maxTraces + (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + tracesRun := cfg.maxTraces + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } | remaining + 1 => - let traceSeed := cfg.seed + traceIndex - let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - if violated then - let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - match maybeResult with - | some result => { + hooks.onTraceProgress traceIndex + match runTraceAtSeed sys params th cfg traceIndex with + | some (result, stepsUsed) => + hooks.onViolation + return { result := result tracesRun := traceIndex + 1 elapsedMs := 0 seed := cfg.seed depth := stepsUsed } - | none => simulateCoreLoop sys params th cfg remaining (traceIndex + 1) - else - simulateCoreLoop sys params th cfg remaining (traceIndex + 1) + | none => + simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) +termination_by remaining /-- Run `maxTraces` independent random traces for a fixed seed. This function is pure and is the proof-producing core used by `#simulate`. -/ @@ -358,7 +386,11 @@ def simulateCore {ρ σ κ : Type} {th₀ : ρ} [inhabσ : Inhabited σ] [inhabκσ : Inhabited (κ × σ)] : SimulateResult ρ σ κ := - simulateCoreLoop sys params th cfg cfg.maxTraces 0 + Id.run <| simulateLoopM + { shouldStop := fun _ => false + onTraceProgress := fun _ => PUnit.unit + onViolation := PUnit.unit } + sys params th cfg cfg.maxTraces 0 /-- IO simulation runner with progress and cancellation hooks. Uses the configured seed exactly once and reuses its per-trace derivation scheme. -/ @@ -376,46 +408,19 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed let cfg := { cfg with seed := actualSeed } let startMs ← IO.monoMsNow - let mut tracesRun := 0 - let mut lastStatusUpdate := startMs - while tracesRun < cfg.maxTraces do - if ← Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId then - return { - result := .cancelled - tracesRun - elapsedMs := (← IO.monoMsNow) - startMs - seed := actualSeed - depth := 0 - } - let now ← IO.monoMsNow - if now - lastStatusUpdate ≥ 100 then - Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" - lastStatusUpdate := now - let traceSeed := cfg.seed + tracesRun - let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - if violated then - let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - match maybeResult with - | some result => - Veil.ModelChecker.Concrete.setViolationFound progressInstanceId - return { - result - tracesRun := tracesRun + 1 - elapsedMs := (← IO.monoMsNow) - startMs - seed := actualSeed - depth := stepsUsed - } - | none => - tracesRun := tracesRun + 1 - else - tracesRun := tracesRun + 1 - return { - result := .noViolationFound cfg.maxTraces (.earlyTermination (.reachedDepthBound cfg.maxTraces)) - tracesRun := cfg.maxTraces - elapsedMs := (← IO.monoMsNow) - startMs - seed := actualSeed - depth := 0 - } + let lastStatusUpdateRef ← IO.mkRef startMs + let simResult ← simulateLoopM + { shouldStop := fun _ => Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId + onTraceProgress := fun tracesRun => do + let now ← IO.monoMsNow + let lastStatusUpdate ← lastStatusUpdateRef.get + if now - lastStatusUpdate ≥ 100 then + Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" + lastStatusUpdateRef.set now + onViolation := do + Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } + sys params th cfg cfg.maxTraces 0 + return { simResult with elapsedMs := (← IO.monoMsNow) - startMs } /-- IO wrapper around `simulateCore` that fills in a seed when omitted and records wall-clock time for UI/reporting. -/ From 96d39f09e3f6230a554670ec109f4dfaeabd0d50 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:53:19 +0200 Subject: [PATCH 17/88] feat: use runtime runner for command execution --- Veil/Frontend/DSL/Module/Elaborators.lean | 70 +++++++++++++++-------- 1 file changed, 46 insertions(+), 24 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index dd906bd3..99a1bad6 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -997,12 +997,28 @@ private def mkSimulatorCall (mod : Module) (instTerm theoryTerm : Term) $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) `((let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore) + $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore) ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) ($(mkIdent `inhabκσ) := by infer_instance) ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp $th $cfgTerm)) +/-- Build the progress-aware simulator runtime call syntax. -/ +private def mkSimulatorRuntimeCall (mod : Module) (instTerm theoryTerm : Term) + (sp : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Term := do + let inst := mkVeilImplementationDetailIdent `inst + let th := mkVeilImplementationDetailIdent `th + let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) + let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) + $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) + `((let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + $(mkIdent ``Veil.ModelChecker.Simulation.simulateWithProgress) + ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) + ($(mkIdent `inhabκσ) := by infer_instance) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp $th $cfgTerm : _ → _ → IO _)) + /-- Build the simulator runtime call syntax with progress and cancellation hooks. -/ private def mkSimulateJsonExpr (resultIdent : Ident) : CommandElabM Term := `(Lean.Json.mkObj [ @@ -1050,6 +1066,18 @@ private def evaluateSimulateJson (resultIdent : Ident) : CommandElabM Lean.Json Term.synthesizeSyntheticMVarsNoPostponing unsafe Meta.evalExpr Lean.Json (mkConst ``Lean.Json) (← instantiateMVars expr) +private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : CommandElabM (IO Lean.Json) := do + let resultIdent := mkVeilImplementationDetailIdent `simulateRuntimeResult + let jsonExpr ← mkSimulateJsonExpr resultIdent + let resultExpr ← `(do + let some refs ← Veil.ModelChecker.Concrete.getProgressRefs $(quote instanceId) | pure Lean.Json.null + let $resultIdent ← ($callExpr $(quote instanceId) refs.cancelToken) + pure $jsonExpr) + liftTermElabM do + let expr ← Term.elabTerm resultExpr none + Term.synthesizeSyntheticMVarsNoPostponing + unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) + private def setJsonField (json : Json) (key : String) (value : Json) : Json := match json with | .obj kvs => @@ -1068,9 +1096,6 @@ private def attachSimulationMetadata (combinedJson : Json) : Json := ] | other => other -private def attachSimulationElapsed (combinedJson : Json) (elapsedMs : Nat) : Json := - setJsonField combinedJson "elapsed_ms" (toJson elapsedMs) - private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) (resultIdent soundIdent : Ident) : CommandElabM Unit := do elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) @@ -1111,30 +1136,28 @@ private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) (sourceFile : String) : CommandElabM Unit := do let some binPath ← elabModelCheck.verifyBinaryExists buildFolder ctx.instanceId | return - let startMs ← liftIO IO.monoMsNow let some combinedJson ← elabModelCheck.runBinaryForJson binPath #[] ctx.instanceId ctx.cancelToken | return ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder - let elapsedMs := (← liftIO IO.monoMsNow) - startMs - finishWithSimulationResult ctx (attachSimulationElapsed combinedJson elapsedMs) + finishWithSimulationResult ctx combinedJson -private def elabSimulateInternalMode (mod : Module) (resultIdent : Ident) : CommandElabM Unit := do +private def elabSimulateInternalMode (mod : Module) (callExpr : Term) : CommandElabM Unit := do + let resultIdent := mkVeilImplementationDetailIdent `simulateRuntimeResult let jsonExpr ← mkSimulateJsonExpr resultIdent elabVeilCommand (← `(def $(mkIdent `simulateResult) - (progressInstanceId : Nat) (cancelToken : IO.CancelToken) : IO Lean.Json := + (progressInstanceId : Nat) (cancelToken : IO.CancelToken) : IO Lean.Json := do + let $resultIdent ← ($callExpr progressInstanceId cancelToken) pure $jsonExpr)) elabVeilCommand (← `(end $(mkIdent mod.name))) elabVeilCommand (← `(export $(mkIdent mod.name) ($(mkIdent `simulateResult)))) -private def elabSimulateInterpretedMode (mod : Module) (stx : Syntax) (resultIdent : Ident) : CommandElabM Unit := do +private def elabSimulateInterpretedMode (mod : Module) (stx : Syntax) (callExpr : Term) : CommandElabM Unit := do let ctx ← elabModelCheck.allocModelCheckContext mod stx none + let ioComputation ← elaborateSimulateComputation ctx.instanceId callExpr let computation ← Command.wrapAsyncAsSnapshot (fun () => do try if ← elabModelCheck.checkCancelled ctx.cancelToken ctx.instanceId then return - ModelChecker.Concrete.updateStatus ctx.instanceId "Running random traces..." - let startMs ← IO.monoMsNow - let combinedJson ← evaluateSimulateJson resultIdent - let endMs ← IO.monoMsNow - finishWithSimulationResult ctx (attachSimulationElapsed combinedJson (endMs - startMs)) + let combinedJson ← IO.ofExcept (← ioComputation.toIO') + finishWithSimulationResult ctx combinedJson catch e : Exception => elabModelCheck.handleModelCheckError ctx e ) ctx.cancelToken @@ -1160,23 +1183,21 @@ private def elabSimulateCompiledMode (mod : Module) (stx : Syntax) Command.logSnapshotTask { stx? := none, cancelTk? := ctx.cancelToken, task := compilationTask } ModelChecker.displayStreamingProgress stx ctx.instanceId -private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (resultIdent : Ident) +private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do let ctx ← elabModelCheck.allocModelCheckContext mod stx none let sourceFile ← getFileName let modelSource ← generateSimulateModelSource mod stx cfg + let ioComputation ← elaborateSimulateComputation ctx.instanceId callExpr let compilationCancelTk ← IO.CancelToken.new let interpretedComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - ModelChecker.Concrete.updateStatus ctx.instanceId "Running random traces..." - let startMs ← IO.monoMsNow - let combinedJson ← evaluateSimulateJson resultIdent - let endMs ← IO.monoMsNow + let combinedJson ← IO.ofExcept (← ioComputation.toIO') match (← ctx.cancelToken.isSet, ← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) with | (true, false) => ModelChecker.Concrete.cancelProgress ctx.instanceId | (false, _) => compilationCancelTk.set - finishWithSimulationResult ctx (attachSimulationElapsed combinedJson (endMs - startMs)) + finishWithSimulationResult ctx combinedJson | (true, true) => pure () catch e : Exception => elabModelCheck.handleModelCheckError ctx e @@ -1222,18 +1243,19 @@ def elabSimulate : CommandElab := fun stx => do let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } let sp ← buildSearchParameters mod mcCfg let pureCallExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg + let runtimeCallExpr ← mkSimulatorRuntimeCall mod instTerm theoryTerm sp cfg if ← isModelCheckCompileMode then let simulateResultIdent := mkVeilImplementationDetailIdent `simulateResultValue let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent - elabSimulateInternalMode mod simulateResultIdent + elabSimulateInternalMode mod runtimeCallExpr return let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) let simulateSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateSound)) emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent let effectiveMode := if (← liftIO isVeilOnlineEnv) then .interpreted else mode match effectiveMode with - | .interpreted => elabSimulateInterpretedMode mod stx simulateResultIdent + | .interpreted => elabSimulateInterpretedMode mod stx runtimeCallExpr | .compiled => elabSimulateCompiledMode mod stx cfg - | .default => elabSimulateWithHandoff mod stx simulateResultIdent cfg + | .default => elabSimulateWithHandoff mod stx runtimeCallExpr cfg end Veil From 7ad5f605c3cb9da8ec2e394a32c4681f6e7e1cc7 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 08:58:01 +0200 Subject: [PATCH 18/88] refactor: clean result rendering semantics --- Veil/Core/UI/Trace/TraceDisplay.lean | 2 +- Veil/Frontend/DSL/Module/Elaborators.lean | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/Veil/Core/UI/Trace/TraceDisplay.lean b/Veil/Core/UI/Trace/TraceDisplay.lean index b622af47..46689d66 100644 --- a/Veil/Core/UI/Trace/TraceDisplay.lean +++ b/Veil/Core/UI/Trace/TraceDisplay.lean @@ -99,7 +99,7 @@ def formatModelCheckingResult (j : Json) : MessageData := | "no_violation_found" => let trace := j.getObjValD "trace" if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}" - else if j.getObjValD "simulation" == Json.bool true then + else if j.getObjValD "traces_run" != .null then m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces" else m!"✅ No violation (explored {fmtJson (j.getObjValD "explored_states")} states)" diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 99a1bad6..0dce3c79 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1078,17 +1078,10 @@ private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : Term.synthesizeSyntheticMVarsNoPostponing unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) -private def setJsonField (json : Json) (key : String) (value : Json) : Json := - match json with - | .obj kvs => - Json.mkObj <| (kvs.toList.filter fun (entry : String × Json) => entry.1 != key) ++ [(key, value)] - | _ => json - private def attachSimulationMetadata (combinedJson : Json) : Json := match combinedJson.getObjValD "result" with | .obj kvs => Json.mkObj <| kvs.toList ++ [ - ("simulation", Json.bool true), ("traces_run", combinedJson.getObjValD "traces_run"), ("elapsed_ms", combinedJson.getObjValD "elapsed_ms"), ("seed", combinedJson.getObjValD "seed"), From 12adb4c3d7964a5a8b9b44a458b0165214492076 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 15:28:12 +0200 Subject: [PATCH 19/88] refactor: split simulation into modular files --- Veil/Core/Tools/ModelChecker/Simulation.lean | 440 +----------------- .../Tools/ModelChecker/Simulation/Basic.lean | 44 ++ .../ModelChecker/Simulation/Checker.lean | 6 + .../Tools/ModelChecker/Simulation/Path.lean | 151 ++++++ .../ModelChecker/Simulation/Runtime.lean | 111 +++++ .../ModelChecker/Simulation/Soundness.lean | 102 ++++ 6 files changed, 415 insertions(+), 439 deletions(-) create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Basic.lean create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Checker.lean create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Path.lean create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean diff --git a/Veil/Core/Tools/ModelChecker/Simulation.lean b/Veil/Core/Tools/ModelChecker/Simulation.lean index 09833fbd..146ab9ae 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation.lean @@ -1,439 +1 @@ -import Veil.Core.Tools.ModelChecker.Interface -import Veil.Core.Tools.ModelChecker.Trace -import Veil.Core.Tools.ModelChecker.Concrete.Core -import Veil.Core.Tools.ModelChecker.Concrete.Progress - -namespace Veil.ModelChecker.Simulation -open Veil.ModelChecker.Concrete - -/-- Configuration for the `#simulate` command. -/ -structure SimulateConfig where - maxTraces : Nat := 10000 - maxSteps : Nat := 100 - seed : Nat := 0 -deriving Inhabited, Repr - -/-- Result of a simulation run, wrapping a `ModelCheckingResult` with metadata. -/ -structure SimulateResult (ρ σ κ : Type) where - result : ModelCheckingResult ρ σ κ Unit - tracesRun : Nat - elapsedMs : Nat - seed : Nat - depth : Nat - -/-- Return names of invariants violated in the given state. -/ -@[inline] -def violatedInvariantNames {ρ σ : Type} - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := - params.invariants.filterMap fun p => - if !p.holdsOn th st then some p.name else none - -/-- Filter initial states according to the search parameters' state constraints. -/ -@[inline] -def filterInitStatesByConstraints {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) : List σ := - if params.stateConstraints.isEmpty then - sys.initStates - else - sys.initStates.filter (params.satisfiesConstraints th) - -/-- Filter transition outcomes according to the search parameters' state constraints. -Successful and assertion-failure outcomes whose post-state violates a state -constraint are silently skipped, matching `Concrete.findReachable`. -/ -@[inline] -def filterOutcomesByConstraints {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List (κ × ExecutionOutcome Int σ) := - if params.stateConstraints.isEmpty then - sys.tr th st - else - (sys.tr th st).filter fun (_, outcome) => - match outcome with - | .success st' => params.satisfiesConstraints th st' - | .assertionFailure _ st' => params.satisfiesConstraints th st' - | .divergence => true - -/-- Relational view of simulation semantics: initial states and successful -transitions filtered by the configured state constraints. -/ -def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where - assumptions := fun _ => True - init := fun th st => st ∈ filterInitStatesByConstraints sys params th - tr := fun th st label st' => - (label, ExecutionOutcome.success st') ∈ filterOutcomesByConstraints sys params th st - -/-- Boolean check that a concrete step list follows successful constrained -simulation transitions. Used as the decision procedure for simulation soundness. -/ -def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Bool - | [] => true - | step :: steps => - (filterOutcomesByConstraints sys params th st).any fun (label, outcome) => - match outcome with - | .success st' => label == step.transitionLabel && st' == step.nextState - | _ => false - && StepList.validFromSimulation sys params th step.nextState steps - -/-- Boolean validity check for simulation traces, matching the constrained -search semantics used by `#simulate`. -/ -def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Bool := - (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState && - StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList - -/-- Validity predicate for simulation traces, matching the constrained search -semantics used by `#simulate`. -/ -abbrev Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := - Trace.isSimulationValidB sys params trace = true - -instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : - Decidable (Trace.isSimulationValid sys params trace) := by - unfold Trace.isSimulationValid - infer_instance - -/-- Boolean checker used to decide whether a trace witnesses a simulation -violation; the exported theorem remains Prop-level. -/ -def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Bool - | .safetyFailure violates => - Trace.isSimulationValidB sys params trace && - trace.failingStep.isNone && - decide (violatedInvariantNames params trace.theory trace.lastState = violates) && - !violates.isEmpty - | .deadlock => - Trace.isSimulationValidB sys params trace && - trace.failingStep.isNone && - !params.terminating.holdsOn trace.theory trace.lastState && - let (nexts, _) := partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty - | .assertionFailure exId => - match trace.failingStep with - | some step => - Trace.isSimulationValidB sys params trace && - (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) - | none => false - -/-- A concrete trace witnesses a particular simulation violation. -/ -abbrev Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Prop := - Trace.witnessesSimulationViolationB sys params trace violation = true - -def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Bool := - match result with - | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolationB sys params trace violation - | .foundViolation _ _ none => false - | .noViolationFound _ _ => true - | .cancelled => true - -/-- Soundness predicate for `#simulate` results. -Simulation is not complete, so `noViolationFound` carries no proof obligation, -but any reported violation must come with a valid witness trace. -/ -def ResultSound {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := - ResultSoundB sys params result = true - -instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : - Decidable (ResultSound sys params result) := by - unfold ResultSound - infer_instance - -private inductive StepDecision (σ κ : Type) where - | assertionFailure (exId : Int) (step : Step σ κ) - | deadlock - | terminated - | continue (nexts : List (κ × σ)) - -private def decideAtState {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := - let outcomes := filterOutcomesByConstraints sys params th currSt - let failingStep := outcomes.findSome? fun (label, outcome) => - match outcome with - | .assertionFailure exId st => - some (exId, { transitionLabel := label, nextState := st }) - | _ => none - match failingStep with - | some (exId, step) => .assertionFailure exId step - | none => - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes - if nexts.isEmpty then - if !params.terminating.holdsOn th currSt then .deadlock else .terminated - else - .continue nexts - -private def pickNextTransition {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) [Inhabited (κ × σ)] : (κ × σ) × StdGen := - let (idx, gen) := randNat gen 0 (nexts.length - 1) - (nexts[idx]!, gen) - -private structure SimulationHooks (m : Type → Type) where - shouldStop : Nat → m Bool - onTraceProgress : Nat → m PUnit - onViolation : m PUnit - -/-- Lightweight scan loop: walk without building a trace. -Returns `(violated?, updatedRng, stepsTaken)`. -/ -@[inline, specialize] -partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (stepsLeft : Nat) - (currSt : σ) - (gen : StdGen) - [Inhabited (κ × σ)] - : Bool × StdGen × Nat := - match stepsLeft with - | 0 => (false, gen, 0) - | stepsLeft + 1 => - match decideAtState sys params th currSt with - | .assertionFailure _ _ => - (true, gen, 1) - | .deadlock => - (true, gen, 0) - | .terminated => - (false, gen, 0) - | .continue nexts => - let ((_, nextSt), gen) := pickNextTransition nexts gen - if !(violatedInvariantNames params th nextSt).isEmpty then - (true, gen, 1) - else - let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen - (violated, gen, innerSteps + 1) - -/-- Lightweight scan: pick random init state, walk without trace. -Returns `(violated?, updatedRng, stepsTaken)`. -/ -@[inline, specialize] -partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (gen : StdGen) - (maxSteps : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] - : Bool × StdGen × Nat := - let initStates := filterInitStatesByConstraints sys params th - if initStates.isEmpty then - (false, gen, 0) - else - let (idx, gen) := randNat gen 0 (initStates.length - 1) - let initSt := initStates[idx]! - if !(violatedInvariantNames params th initSt).isEmpty then - (true, gen, 0) - else - scanOnceLoop sys params th maxSteps initSt gen - -/-- Inner loop of a single random trace: walk from `currSt` for up to -`stepsLeft` steps, picking a random enabled transition at each step. -Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ -@[inline, specialize] -partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (stepsLeft : Nat) - (currSt : σ) - (trace : Trace ρ σ κ) - (gen : StdGen) - [Inhabited (κ × σ)] - : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := - match stepsLeft with - | 0 => (none, gen, 0) - | stepsLeft + 1 => - match decideAtState sys params th currSt with - | .assertionFailure exId step => - let failedTrace := { trace with failingStep := some step } - -- +1 for the failing action itself (not in trace.steps, stored in failingStep) - (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), - gen, trace.steps.size + 1) - | .deadlock => - (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) - | .terminated => - (none, gen, trace.steps.size) - | .continue nexts => - let ((label, nextSt), gen) := pickNextTransition nexts gen - let trace := trace.push { transitionLabel := label, nextState := nextSt } - let violations := violatedInvariantNames params th nextSt - if !violations.isEmpty then - (some (.foundViolation () (.safetyFailure violations) (some trace)), - gen, trace.steps.size) - else - simulateOnceLoop sys params th stepsLeft nextSt trace gen - -/-- Run a single random trace from a randomly chosen initial state. -Returns `(violation?, updatedRng, stepsTaken)`. Used only for replay. -/ -@[inline, specialize] -partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (gen : StdGen) - (maxSteps : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] - : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := - let initStates := filterInitStatesByConstraints sys params th - if initStates.isEmpty then - (none, gen, 0) - else - let (idx, gen) := randNat gen 0 (initStates.length - 1) - let initSt := initStates[idx]! - let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } - let initViolations := violatedInvariantNames params th initSt - if !initViolations.isEmpty then - (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) - else - simulateOnceLoop sys params th maxSteps initSt initTrace gen - -private def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - (traceIndex : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] - : Option (ModelCheckingResult ρ σ κ Unit × Nat) := - let traceSeed := cfg.seed + traceIndex - let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - if violated then - let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - maybeResult.map (fun result => (result, stepsUsed)) - else - none - -private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ : ρ} - (hooks : SimulationHooks m) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - (remaining : Nat) - (traceIndex : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] - : m (SimulateResult ρ σ κ) := do - if ← hooks.shouldStop traceIndex then - return { - result := .cancelled - tracesRun := traceIndex - elapsedMs := 0 - seed := cfg.seed - depth := 0 - } - match remaining with - | 0 => - return { - result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedDepthBound cfg.maxTraces)) - tracesRun := cfg.maxTraces - elapsedMs := 0 - seed := cfg.seed - depth := 0 - } - | remaining + 1 => - hooks.onTraceProgress traceIndex - match runTraceAtSeed sys params th cfg traceIndex with - | some (result, stepsUsed) => - hooks.onViolation - return { - result := result - tracesRun := traceIndex + 1 - elapsedMs := 0 - seed := cfg.seed - depth := stepsUsed - } - | none => - simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) -termination_by remaining - -/-- Run `maxTraces` independent random traces for a fixed seed. -This function is pure and is the proof-producing core used by `#simulate`. -/ -@[inline, specialize] -def simulateCore {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] - : SimulateResult ρ σ κ := - Id.run <| simulateLoopM - { shouldStop := fun _ => false - onTraceProgress := fun _ => PUnit.unit - onViolation := PUnit.unit } - sys params th cfg cfg.maxTraces 0 - -/-- IO simulation runner with progress and cancellation hooks. -Uses the configured seed exactly once and reuses its per-trace derivation scheme. -/ -@[inline, specialize] -def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - (progressInstanceId : Nat) - (cancelToken : IO.CancelToken) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] - : IO (SimulateResult ρ σ κ) := do - let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed - let cfg := { cfg with seed := actualSeed } - let startMs ← IO.monoMsNow - let lastStatusUpdateRef ← IO.mkRef startMs - let simResult ← simulateLoopM - { shouldStop := fun _ => Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId - onTraceProgress := fun tracesRun => do - let now ← IO.monoMsNow - let lastStatusUpdate ← lastStatusUpdateRef.get - if now - lastStatusUpdate ≥ 100 then - Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" - lastStatusUpdateRef.set now - onViolation := do - Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } - sys params th cfg cfg.maxTraces 0 - return { simResult with elapsedMs := (← IO.monoMsNow) - startMs } - -/-- IO wrapper around `simulateCore` that fills in a seed when omitted and records -wall-clock time for UI/reporting. -/ -@[inline, specialize] -def simulate {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] - : IO (SimulateResult ρ σ κ) := do - let cancelToken ← IO.CancelToken.new - simulateWithProgress sys params th cfg 0 cancelToken - -end Veil.ModelChecker.Simulation +import Veil.Core.Tools.ModelChecker.Simulation.Checker diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean new file mode 100644 index 00000000..829b85cf --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -0,0 +1,44 @@ +import Veil.Core.Tools.ModelChecker.Interface + +namespace Veil.ModelChecker.Simulation + +structure SimulateConfig where + maxTraces : Nat := 10000 + maxSteps : Nat := 100 + seed : Nat := 0 +deriving Inhabited, Repr + +structure SimulateResult (ρ σ κ : Type) where + result : ModelCheckingResult ρ σ κ Unit + tracesRun : Nat + elapsedMs : Nat + seed : Nat + depth : Nat + +@[inline] +def violatedInvariantNames {ρ σ : Type} + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := + params.invariants.filterMap fun p => + if !p.holdsOn th st then some p.name else none + +@[inline] +def filterInitStatesByConstraints {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) : List σ := + if params.stateConstraints.isEmpty then sys.initStates + else sys.initStates.filter (params.satisfiesConstraints th) + +@[inline] +def filterOutcomesByConstraints {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List (κ × ExecutionOutcome Int σ) := + if params.stateConstraints.isEmpty then + sys.tr th st + else + (sys.tr th st).filter fun (_, outcome) => + match outcome with + | .success st' => params.satisfiesConstraints th st' + | .assertionFailure _ st' => params.satisfiesConstraints th st' + | .divergence => true + +end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean b/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean new file mode 100644 index 00000000..e085dea3 --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean @@ -0,0 +1,6 @@ +import Veil.Core.Tools.ModelChecker.Simulation.Runtime +import Veil.Core.Tools.ModelChecker.Simulation.Soundness + +namespace Veil.ModelChecker.Simulation + +end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean new file mode 100644 index 00000000..cb5afe77 --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -0,0 +1,151 @@ +import Veil.Core.Tools.ModelChecker.Simulation.Basic +import Veil.Core.Tools.ModelChecker.Concrete.Core + +namespace Veil.ModelChecker.Simulation + +private inductive StepDecision (σ κ : Type) where + | assertionFailure (exId : Int) (step : Step σ κ) + | deadlock + | terminated + | continue (nexts : List (κ × σ)) + +private def decideAtState {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := + let outcomes := filterOutcomesByConstraints sys params th currSt + let failingStep := outcomes.findSome? fun (label, outcome) => + match outcome with + | .assertionFailure exId st => some (exId, { transitionLabel := label, nextState := st }) + | _ => none + match failingStep with + | some (exId, step) => .assertionFailure exId step + | none => + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes + if nexts.isEmpty then + if !params.terminating.holdsOn th currSt then .deadlock else .terminated + else + .continue nexts + +private def pickNextTransition {σ κ : Type} + (nexts : List (κ × σ)) (gen : StdGen) [Inhabited (κ × σ)] : (κ × σ) × StdGen := + let (idx, gen) := randNat gen 0 (nexts.length - 1) + (nexts[idx]!, gen) + +@[inline, specialize] +partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (stepsLeft : Nat) + (currSt : σ) + (gen : StdGen) + [Inhabited (κ × σ)] + : Bool × StdGen × Nat := + match stepsLeft with + | 0 => (false, gen, 0) + | stepsLeft + 1 => + match decideAtState sys params th currSt with + | .assertionFailure _ _ => (true, gen, 1) + | .deadlock => (true, gen, 0) + | .terminated => (false, gen, 0) + | .continue nexts => + let ((_, nextSt), gen) := pickNextTransition nexts gen + if !(violatedInvariantNames params th nextSt).isEmpty then + (true, gen, 1) + else + let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen + (violated, gen, innerSteps + 1) + +@[inline, specialize] +partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (gen : StdGen) + (maxSteps : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Bool × StdGen × Nat := + let initStates := filterInitStatesByConstraints sys params th + if initStates.isEmpty then + (false, gen, 0) + else + let (idx, gen) := randNat gen 0 (initStates.length - 1) + let initSt := initStates[idx]! + if !(violatedInvariantNames params th initSt).isEmpty then + (true, gen, 0) + else + scanOnceLoop sys params th maxSteps initSt gen + +@[inline, specialize] +partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (stepsLeft : Nat) + (currSt : σ) + (trace : Trace ρ σ κ) + (gen : StdGen) + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + match stepsLeft with + | 0 => (none, gen, 0) + | stepsLeft + 1 => + match decideAtState sys params th currSt with + | .assertionFailure exId step => + let failedTrace := { trace with failingStep := some step } + (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), gen, trace.steps.size + 1) + | .deadlock => + (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) + | .terminated => + (none, gen, trace.steps.size) + | .continue nexts => + let ((label, nextSt), gen) := pickNextTransition nexts gen + let trace := trace.push { transitionLabel := label, nextState := nextSt } + let violations := violatedInvariantNames params th nextSt + if !violations.isEmpty then + (some (.foundViolation () (.safetyFailure violations) (some trace)), gen, trace.steps.size) + else + simulateOnceLoop sys params th stepsLeft nextSt trace gen + +@[inline, specialize] +partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (gen : StdGen) + (maxSteps : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + let initStates := filterInitStatesByConstraints sys params th + if initStates.isEmpty then + (none, gen, 0) + else + let (idx, gen) := randNat gen 0 (initStates.length - 1) + let initSt := initStates[idx]! + let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } + let initViolations := violatedInvariantNames params th initSt + if !initViolations.isEmpty then + (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) + else + simulateOnceLoop sys params th maxSteps initSt initTrace gen + +def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (traceIndex : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : Option (ModelCheckingResult ρ σ κ Unit × Nat) := + let traceSeed := cfg.seed + traceIndex + let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + if violated then + let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + maybeResult.map (fun result => (result, stepsUsed)) + else + none + +end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean new file mode 100644 index 00000000..cda499d6 --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -0,0 +1,111 @@ +import Veil.Core.Tools.ModelChecker.Simulation.Path +import Veil.Core.Tools.ModelChecker.Concrete.Progress + +namespace Veil.ModelChecker.Simulation + +private structure SimulationHooks (m : Type → Type) where + shouldStop : Nat → m Bool + onTraceProgress : Nat → m PUnit + onViolation : m PUnit + +private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ : ρ} + (hooks : SimulationHooks m) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (remaining : Nat) + (traceIndex : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : m (SimulateResult ρ σ κ) := do + if ← hooks.shouldStop traceIndex then + return { + result := .cancelled + tracesRun := traceIndex + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } + match remaining with + | 0 => + return { + result := .noViolationFound cfg.maxTraces + (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + tracesRun := cfg.maxTraces + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } + | remaining + 1 => + hooks.onTraceProgress traceIndex + match runTraceAtSeed sys params th cfg traceIndex with + | some (result, stepsUsed) => + hooks.onViolation + return { + result := result + tracesRun := traceIndex + 1 + elapsedMs := 0 + seed := cfg.seed + depth := stepsUsed + } + | none => + simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) +termination_by remaining + +@[inline, specialize] +def simulateCore {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : SimulateResult ρ σ κ := + Id.run <| simulateLoopM + { shouldStop := fun _ => false + onTraceProgress := fun _ => PUnit.unit + onViolation := PUnit.unit } + sys params th cfg cfg.maxTraces 0 + +@[inline, specialize] +def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (progressInstanceId : Nat) + (cancelToken : IO.CancelToken) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : IO (SimulateResult ρ σ κ) := do + let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed + let cfg := { cfg with seed := actualSeed } + let startMs ← IO.monoMsNow + let lastStatusUpdateRef ← IO.mkRef startMs + let simResult ← simulateLoopM + { shouldStop := fun _ => Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId + onTraceProgress := fun tracesRun => do + let now ← IO.monoMsNow + let lastStatusUpdate ← lastStatusUpdateRef.get + if now - lastStatusUpdate ≥ 100 then + Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" + lastStatusUpdateRef.set now + onViolation := do + Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } + sys params th cfg cfg.maxTraces 0 + return { simResult with elapsedMs := (← IO.monoMsNow) - startMs } + +@[inline, specialize] +def simulate {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : IO (SimulateResult ρ σ κ) := do + let cancelToken ← IO.CancelToken.new + simulateWithProgress sys params th cfg 0 cancelToken + +end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean new file mode 100644 index 00000000..6379cc89 --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -0,0 +1,102 @@ +import Veil.Core.Tools.ModelChecker.Simulation.Basic +import Veil.Core.Tools.ModelChecker.Concrete.Core + +namespace Veil.ModelChecker.Simulation + +def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where + assumptions := fun _ => True + init := fun th st => st ∈ filterInitStatesByConstraints sys params th + tr := fun th st label st' => + (label, ExecutionOutcome.success st') ∈ filterOutcomesByConstraints sys params th st + +def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Bool + | [] => true + | step :: steps => + (filterOutcomesByConstraints sys params th st).any fun (label, outcome) => + match outcome with + | .success st' => label == step.transitionLabel && st' == step.nextState + | _ => false + && StepList.validFromSimulation sys params th step.nextState steps + +def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Bool := + (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState && + StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList + +abbrev Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := + Trace.isSimulationValidB sys params trace = true + +instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : + Decidable (Trace.isSimulationValid sys params trace) := by + unfold Trace.isSimulationValid + infer_instance + +def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Bool + | .safetyFailure violates => + Trace.isSimulationValidB sys params trace && + trace.failingStep.isNone && + decide (violatedInvariantNames params trace.theory trace.lastState = violates) && + !violates.isEmpty + | .deadlock => + Trace.isSimulationValidB sys params trace && + trace.failingStep.isNone && + !params.terminating.holdsOn trace.theory trace.lastState && + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty + | .assertionFailure exId => + match trace.failingStep with + | some step => + Trace.isSimulationValidB sys params trace && + (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) + | none => false + +abbrev Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Prop := + Trace.witnessesSimulationViolationB sys params trace violation = true + +def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Bool := + match result with + | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolationB sys params trace violation + | .foundViolation _ _ none => false + | .noViolationFound _ _ => true + | .cancelled => true + +def ResultSound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := + ResultSoundB sys params result = true + +instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : + Decidable (ResultSound sys params result) := by + unfold ResultSound + infer_instance + +end Veil.ModelChecker.Simulation From 55e15e4918abcb1a7c929737268fe5c176e9c536 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 15:34:56 +0200 Subject: [PATCH 20/88] feat: support assumptions checks --- Veil/Frontend/DSL/Module/Elaborators.lean | 4 ++ Veil/Frontend/DSL/Module/Syntax.lean | 2 +- VeilTest/Regression/SimulateAssumptions.lean | 41 ++++++++++++++++++++ 3 files changed, 46 insertions(+), 1 deletion(-) create mode 100644 VeilTest/Regression/SimulateAssumptions.lean diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 0dce3c79..7b444a7b 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1223,6 +1223,8 @@ def elabSimulate : CommandElab := fun stx => do let mode := getModelCheckingMode stx[1] let instTerm : Term := ⟨stx[2]⟩ let theoryTermOpt : Option Term := if stx[3].isNone then none else some ⟨stx[3][0]⟩ + let assumptionsHoldBy : Option (TSyntax `Lean.Parser.Tactic.tacticSeq) := + if stx[5].isNone then none else some ⟨stx[5][0][1]⟩ let mod ← getCurrentModule (errMsg := "You cannot #simulate outside of a Veil module!") mod.throwIfSpecNotFinalized let theoryTerm ← resolveTheoryTerm "#simulate" theoryTermOpt mod instTerm @@ -1234,6 +1236,8 @@ def elabSimulate : CommandElab := fun stx => do let seed ← liftIO <| if cfg0.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg0.seed let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps, seed } let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } + if assumptionsHoldBy.isSome && !(← isModelCheckCompileMode) && !mod.assumptions.isEmpty then + elabModelCheck.checkTheorySatisfiesAssumptions mod instTerm theoryTerm assumptionsHoldBy let sp ← buildSearchParameters mod mcCfg let pureCallExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg let runtimeCallExpr ← mkSimulatorRuntimeCall mod instTerm theoryTerm sp cfg diff --git a/Veil/Frontend/DSL/Module/Syntax.lean b/Veil/Frontend/DSL/Module/Syntax.lean index e5e0a3b7..0d901a24 100644 --- a/Veil/Frontend/DSL/Module/Syntax.lean +++ b/Veil/Frontend/DSL/Module/Syntax.lean @@ -388,6 +388,6 @@ Seed defaults to a generated value if omitted; the chosen seed is always shown in output for reproducibility and reused consistently across mode handoff. Example: `#simulate {}` or `#simulate compiled {} (maxTraces := 100, seed := 42)` -/ -syntax (name := simulate) "#simulate " (modelCheckMode)? term:max (term:max)? Parser.Tactic.optConfig : command +scoped syntax (name := simulate) "#simulate " (modelCheckMode)? term:max (term:max)? Parser.Tactic.optConfig (assumptionsHoldBy)? : command end Veil diff --git a/VeilTest/Regression/SimulateAssumptions.lean b/VeilTest/Regression/SimulateAssumptions.lean new file mode 100644 index 00000000..6de30ee3 --- /dev/null +++ b/VeilTest/Regression/SimulateAssumptions.lean @@ -0,0 +1,41 @@ +import Veil + +set_option linter.unusedVariables false + +veil module SimulateAssumptionsTest + +type node + +immutable relation leader : node → Bool +relation flag : node → Bool + +#gen_state + +assumption ∀ (n1 n2 : node), leader n1 ∧ leader n2 → n1 = n2 + +after_init { + flag N := false +} + +action do_something (n : node) { + require leader n + flag n := true +} + +invariant true + +#gen_spec + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by native_decide + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by decide + +end SimulateAssumptionsTest From 7f586965c23d4419dc59b6b4f6886993a5eaa0dc Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 15:50:14 +0200 Subject: [PATCH 21/88] feat: add simulation-native results and progress --- .../Tools/ModelChecker/Concrete/Progress.lean | 35 ++++++++ .../ModelChecker/Simulation/Checker.lean | 1 + .../Tools/ModelChecker/Simulation/Result.lean | 80 +++++++++++++++++++ .../ModelChecker/Simulation/Runtime.lean | 4 +- Veil/Core/UI/Widget/ProgressViewer.lean | 12 +-- Veil/Frontend/DSL/Module/Elaborators.lean | 29 ++----- 6 files changed, 131 insertions(+), 30 deletions(-) create mode 100644 Veil/Core/Tools/ModelChecker/Simulation/Result.lean diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index 3922d455..f0dd4efe 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -82,6 +82,14 @@ structure Progress where allActionLabels : List String := [] /-- Time-series history for charting progress over time -/ history : Array ProgressHistoryPoint := #[] + /-- Whether this progress entry is for `#simulate` rather than `#model_check`. -/ + isSimulation : Bool := false + /-- Number of traces completed so far (simulation only). -/ + tracesRun : Nat := 0 + /-- Configured maximum trace budget (simulation only). -/ + maxTraces : Nat := 0 + /-- Depth reached in the current/last trace (simulation only). -/ + simulationDepth : Nat := 0 deriving ToJson, FromJson, Inhabited, Repr /-- Refs for tracking progress of a single model checker instance. -/ @@ -174,6 +182,33 @@ def updateStatus (instanceId : Nat) (status : String) : IO Unit := withRefs inst let now ← IO.monoMsNow refs.progressRef.modify fun p => { p with status, elapsedMs := now - p.startTimeMs } +/-- Update progress for a simulation run. -/ +def updateSimulationProgress (instanceId : Nat) (status : String) + (tracesRun maxTraces depth : Nat) : IO Unit := do + let now ← IO.monoMsNow + if let some refs ← getProgressRefs instanceId then + refs.progressRef.modify fun p => + { p with + status + elapsedMs := now - p.startTimeMs + isSimulation := true + tracesRun + maxTraces + simulationDepth := depth } + if ← compiledModeEnabled.get then + let startTime ← compiledModeStartTime.get + let p : Progress := { + status := status + isRunning := true + startTimeMs := startTime + elapsedMs := now - startTime + isSimulation := true + tracesRun := tracesRun + maxTraces := maxTraces + simulationDepth := depth + } + IO.eprintln (toJson p).compress + /-- Mark progress as complete for a given instance ID. -/ def finishProgress (instanceId : Nat) (resultJson : Lean.Json) : IO Unit := withRefs instanceId fun refs => do let now ← IO.monoMsNow diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean b/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean index e085dea3..6aaa1b19 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Checker.lean @@ -1,4 +1,5 @@ import Veil.Core.Tools.ModelChecker.Simulation.Runtime +import Veil.Core.Tools.ModelChecker.Simulation.Result import Veil.Core.Tools.ModelChecker.Simulation.Soundness namespace Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean new file mode 100644 index 00000000..049b810c --- /dev/null +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -0,0 +1,80 @@ +import Veil.Core.Tools.ModelChecker.Simulation.Basic + +namespace Veil.ModelChecker.Simulation +open Lean + +private def earlyTerminationReasonToJson (reason : EarlyTerminationReason Unit) : Json := + match reason with + | .foundViolatingState _ violates => Json.mkObj [ + ("kind", "found_violating_state"), + ("state_fingerprint", Json.null), + ("violates", toJson violates) + ] + | .deadlockOccurred _ => Json.mkObj [ + ("kind", "deadlock_occurred"), + ("state_fingerprint", Json.null) + ] + | .assertionFailed _ exId => Json.mkObj [ + ("kind", "assertion_failed"), + ("state_fingerprint", Json.null), + ("exception_id", toJson exId) + ] + | .reachedDepthBound depth => Json.mkObj [ + ("kind", "reached_depth_bound"), + ("depth", toJson depth) + ] + | .cancelled => Json.mkObj [("kind", "cancelled")] + +private def terminationReasonToJson (reason : TerminationReason Unit) : Json := + match reason with + | .exploredAllReachableStates => Json.mkObj [("kind", "explored_all_reachable_states")] + | .earlyTermination condition => Json.mkObj [ + ("kind", "early_termination"), + ("condition", earlyTerminationReasonToJson condition) + ] + +private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] + (result : ModelCheckingResult ρ σ κ Unit) : Json := + match result with + | .foundViolation _ violation trace => Json.mkObj + [ ("result", "found_violation") + , ("violation", toJson violation) + , ("trace", toJson trace) + , ("state_fingerprint", Json.null) + ] + | .noViolationFound exploredStates reason => Json.mkObj + [ ("result", "no_violation_found") + , ("explored_states", toJson exploredStates) + , ("termination_reason", terminationReasonToJson reason) + ] + | .cancelled => Json.mkObj [("result", "cancelled")] + +instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where + toJson r := Json.mkObj [ + ("result", resultToJson r.result), + ("traces_run", Lean.toJson r.tracesRun), + ("elapsed_ms", Lean.toJson r.elapsedMs), + ("seed", Lean.toJson r.seed), + ("depth", Lean.toJson r.depth) + ] + +def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] + (r : SimulateResult ρ σ κ) : Json := + match resultToJson r.result with + | Json.obj kvs => + Json.mkObj <| kvs.toList ++ [ + ("traces_run", Lean.toJson r.tracesRun), + ("elapsed_ms", Lean.toJson r.elapsedMs), + ("seed", Lean.toJson r.seed), + ("depth", Lean.toJson r.depth) + ] + | other => + Json.mkObj [ + ("result", other), + ("traces_run", Lean.toJson r.tracesRun), + ("elapsed_ms", Lean.toJson r.elapsedMs), + ("seed", Lean.toJson r.seed), + ("depth", Lean.toJson r.depth) + ] + +end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index cda499d6..4d8ee7f3 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -89,7 +89,9 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} let now ← IO.monoMsNow let lastStatusUpdate ← lastStatusUpdateRef.get if now - lastStatusUpdate ≥ 100 then - Veil.ModelChecker.Concrete.updateStatus progressInstanceId s!"Running random traces ({tracesRun}/{cfg.maxTraces})" + Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId + s!"Running random traces ({tracesRun}/{cfg.maxTraces})" + tracesRun cfg.maxTraces 0 lastStatusUpdateRef.set now onViolation := do Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } diff --git a/Veil/Core/UI/Widget/ProgressViewer.lean b/Veil/Core/UI/Widget/ProgressViewer.lean index 39644ea5..e160d0d9 100644 --- a/Veil/Core/UI/Widget/ProgressViewer.lean +++ b/Veil/Core/UI/Widget/ProgressViewer.lean @@ -519,15 +519,15 @@ def progressToHtml (p : Progress) (instanceId? : Option Nat := none) : Html := } - {statRow "Diameter:" (toString p.diameter)} - {statRow "States Found:" (toString p.statesFound)} - {statRow "Distinct States:" (toString p.distinctStates)} - {statRow "Queue:" (toString p.queue)} + {if p.isSimulation then statRow "Traces Run:" (toString p.tracesRun) else statRow "Diameter:" (toString p.diameter)} + {if p.isSimulation then statRow "Max Traces:" (toString p.maxTraces) else statRow "States Found:" (toString p.statesFound)} + {if p.isSimulation then statRow "Depth:" (toString p.simulationDepth) else statRow "Distinct States:" (toString p.distinctStates)} + {if p.isSimulation then .text "" else statRow "Queue:" (toString p.queue)} {statRow "Elapsed time:" (formatElapsedTime p.elapsedMs)}
- {metricsHistoryHtml p.history} - {actionCoverageHtml p.actionStats p.allActionLabels} + {if p.isSimulation then .text "" else metricsHistoryHtml p.history} + {if p.isSimulation then .text "" else actionCoverageHtml p.actionStats p.allActionLabels} {match p.compilationStatus with | .inProgress ms lines => if lines.isEmpty then .text "" else compilationLogHtml ms lines | .failed err => compilationFailureHtml err diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 7b444a7b..fba59452 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1021,13 +1021,7 @@ private def mkSimulatorRuntimeCall (mod : Module) (instTerm theoryTerm : Term) /-- Build the simulator runtime call syntax with progress and cancellation hooks. -/ private def mkSimulateJsonExpr (resultIdent : Ident) : CommandElabM Term := - `(Lean.Json.mkObj [ - ("result", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.result $resultIdent)), - ("traces_run", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.tracesRun $resultIdent)), - ("elapsed_ms", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.elapsedMs $resultIdent)), - ("seed", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.seed $resultIdent)), - ("depth", Lean.toJson (Veil.ModelChecker.Simulation.SimulateResult.depth $resultIdent)) - ]) + `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.toDisplayJson) $resultIdent) private def generateCompiledModelSourcePrefix (mod : Module) (stx : Syntax) : CommandElabM String := do let src := (← getFileMap).source @@ -1078,17 +1072,6 @@ private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : Term.synthesizeSyntheticMVarsNoPostponing unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) -private def attachSimulationMetadata (combinedJson : Json) : Json := - match combinedJson.getObjValD "result" with - | .obj kvs => - Json.mkObj <| kvs.toList ++ [ - ("traces_run", combinedJson.getObjValD "traces_run"), - ("elapsed_ms", combinedJson.getObjValD "elapsed_ms"), - ("seed", combinedJson.getObjValD "seed"), - ("depth", combinedJson.getObjValD "depth") - ] - | other => other - private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) (resultIdent soundIdent : Ident) : CommandElabM Unit := do elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) @@ -1105,11 +1088,11 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal native_decide)) private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do - let resultJson := attachSimulationMetadata combinedJson - let seed := (combinedJson.getObjValD "seed").getNat? |>.getD 0 - let tracesRun := (combinedJson.getObjValD "traces_run").getNat? |>.getD 0 - let elapsedMs := (combinedJson.getObjValD "elapsed_ms").getNat? |>.getD 0 - let depth := (combinedJson.getObjValD "depth").getNat? |>.getD 0 + let resultJson := combinedJson + let seed := (resultJson.getObjValD "seed").getNat? |>.getD 0 + let tracesRun := (resultJson.getObjValD "traces_run").getNat? |>.getD 0 + let elapsedMs := (resultJson.getObjValD "elapsed_ms").getNat? |>.getD 0 + let depth := (resultJson.getObjValD "depth").getNat? |>.getD 0 let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || resultJson.getObjValD "error" != .null From 60754261098ee0ca4619686c8b2d474cc7b8823c Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 16:04:35 +0200 Subject: [PATCH 22/88] refactor: add theorem-level soundness bridges --- .../ModelChecker/Simulation/Soundness.lean | 86 ++++++++++++++++++- 1 file changed, 82 insertions(+), 4 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 6379cc89..daf6b28d 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -18,12 +18,33 @@ def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Bool | [] => true | step :: steps => - (filterOutcomesByConstraints sys params th st).any fun (label, outcome) => - match outcome with - | .success st' => label == step.transitionLabel && st' == step.nextState - | _ => false + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th st)).fst.contains + (step.transitionLabel, step.nextState) && StepList.validFromSimulation sys params th step.nextState steps +theorem StepList.validFromSimulation_sound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : + ∀ steps, StepList.validFromSimulation sys params th st steps = true → + StepList.validFrom (simulationTransitionSystem sys params) th st steps + | [], _ => by simp [StepList.validFrom] + | step :: steps, h => by + have h' : + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th st)).fst.contains + (step.transitionLabel, step.nextState) = true ∧ + StepList.validFromSimulation sys params th step.nextState steps = true := by + simpa [StepList.validFromSimulation, Bool.and_eq_true] using h + constructor + · have hmem : (step.transitionLabel, step.nextState) ∈ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th st)).fst := by + simpa using h'.1 + exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hmem + · exact StepList.validFromSimulation_sound sys params th step.nextState steps h'.2 + def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -37,6 +58,25 @@ abbrev Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := Trace.isSimulationValidB sys params trace = true +theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : + Trace.isSimulationValid sys params trace → trace.isValid (simulationTransitionSystem sys params) := by + intro h + have h' : + (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState = true ∧ + StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList = true := by + simpa [Trace.isSimulationValid, Trace.isSimulationValidB, Bool.and_eq_true] using h + refine { + theorySatisfiesAssumptions := by simp [simulationTransitionSystem] + initialStateSatisfiesInit := ?_ + stepsValid := ?_ + } + · simpa [simulationTransitionSystem] using h'.1 + · simpa [Steps.validFrom] using + StepList.validFromSimulation_sound sys params trace.theory trace.initialState trace.steps.toList h'.2 + instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -75,6 +115,44 @@ abbrev Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Prop := Trace.witnessesSimulationViolationB sys params trace violation = true +theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : + Trace.witnessesSimulationViolation sys params trace violation → + trace.isValid (simulationTransitionSystem sys params) := by + intro h + cases violation with + | safetyFailure violates => + have hValid : Trace.isSimulationValidB sys params trace = true := by + have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ + (!violates.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + exact h'.1.1.1 + exact Trace.isSimulationValid_sound sys params trace hValid + | deadlock => + have hValid : Trace.isSimulationValidB sys params trace = true := by + have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ + (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + exact h'.1.1.1 + exact Trace.isSimulationValid_sound sys params trace hValid + | assertionFailure exId => + cases hFail : trace.failingStep with + | none => simp [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, hFail] at h + | some step => + have hValid : Trace.isSimulationValidB sys params trace = true := by + have h' : Trace.isSimulationValidB sys params trace = true ∧ + (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true := by + simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, hFail, Bool.and_eq_true] using h + exact h'.1 + exact Trace.isSimulationValid_sound sys params trace hValid + def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From 9dba342ee572e9258496284d968c639aa435d191 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 16:35:40 +0200 Subject: [PATCH 23/88] fix: recreate temp build folders --- Veil/Frontend/DSL/Module/Util/ForModelChecker.lean | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index 90234d4e..43562cb7 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -148,7 +148,9 @@ def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespac (command : CompiledCommandSpec) : IO System.FilePath := do let veilPath ← IO.currentDir let buildFolder ← generateBuildFolderName sourceFile command - -- Create the build folder + -- Recreate the build folder from scratch to avoid stale Lake state from prior runs. + if ← buildFolder.pathExists then + IO.FS.removeDirAll buildFolder IO.FS.createDirAll buildFolder -- Write the lakefile IO.FS.writeFile (buildFolder / "lakefile.lean") lakefileTemplate From 4353e5f855ae62bb42ba8717f15fd3e783682aa4 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 16:35:53 +0200 Subject: [PATCH 24/88] refactor: emit prop-level soundness theorems --- .../ModelChecker/Simulation/Soundness.lean | 136 ++++++++++++++---- Veil/Frontend/DSL/Module/Elaborators.lean | 12 +- 2 files changed, 119 insertions(+), 29 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index daf6b28d..9f9c6239 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -109,18 +109,35 @@ def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) | none => false -abbrev Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} +def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Prop := - Trace.witnessesSimulationViolationB sys params trace violation = true + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Prop + | .safetyFailure violates => + trace.isValid (simulationTransitionSystem sys params) ∧ + trace.failingStep = none ∧ + violatedInvariantNames params trace.theory trace.lastState = violates ∧ + violates ≠ [] + | .deadlock => + trace.isValid (simulationTransitionSystem sys params) ∧ + trace.failingStep = none ∧ + params.terminating.holdsOn trace.theory trace.lastState = false ∧ + let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts = [] + | .assertionFailure exId => + trace.isValid (simulationTransitionSystem sys params) ∧ + ∃ step, + trace.failingStep = some step ∧ + (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true -theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} +theorem Trace.witnessesSimulationViolation_of_check_true {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : - Trace.witnessesSimulationViolation sys params trace violation → - trace.isValid (simulationTransitionSystem sys params) := by + Trace.witnessesSimulationViolationB sys params trace violation = true → + Trace.witnessesSimulationViolation sys params trace violation := by intro h cases violation with | safetyFailure violates => @@ -128,30 +145,73 @@ theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ (!violates.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h exact h'.1.1.1 - exact Trace.isSimulationValid_sound sys params trace hValid + refine ⟨Trace.isSimulationValid_sound sys params trace hValid, ?_, ?_, ?_⟩ + · have hNone : trace.failingStep.isNone = true := by + have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ + (!violates.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + exact h'.1.1.2 + cases hFail : trace.failingStep <;> simp [Option.isNone, hFail] at hNone ⊢ + · have hEq : decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true := by + have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ + (!violates.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + exact h'.1.2 + simpa [decide_eq_true_eq] using hEq + · intro hNil + have h' : (!violates.isEmpty) = true := by + have hx : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ + (!violates.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + exact hx.2 + simpa [hNil] using h' | deadlock => - have hValid : Trace.isSimulationValidB sys params trace = true := by - have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ - (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - exact h'.1.1.1 - exact Trace.isSimulationValid_sound sys params trace hValid + have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ + (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty) = true := by + simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h + refine ⟨Trace.isSimulationValid_sound sys params trace h'.1.1.1, ?_, ?_, ?_⟩ + · have hNone : trace.failingStep.isNone = true := h'.1.1.2 + cases hFail : trace.failingStep <;> simp [Option.isNone, hFail] at hNone ⊢ + · simpa using h'.1.2 + · simpa using h'.2 | assertionFailure exId => cases hFail : trace.failingStep with - | none => simp [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, hFail] at h + | none => simp [Trace.witnessesSimulationViolationB, hFail] at h | some step => - have hValid : Trace.isSimulationValidB sys params trace = true := by - have h' : Trace.isSimulationValidB sys params trace = true ∧ - (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true := by - simpa [Trace.witnessesSimulationViolation, Trace.witnessesSimulationViolationB, hFail, Bool.and_eq_true] using h - exact h'.1 - exact Trace.isSimulationValid_sound sys params trace hValid + have h' : Trace.isSimulationValidB sys params trace = true ∧ + (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true := by + simpa [Trace.witnessesSimulationViolationB, hFail, Bool.and_eq_true] using h + refine ⟨Trace.isSimulationValid_sound sys params trace h'.1, step, hFail, ?_⟩ + simpa using h'.2 + +theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : + Trace.witnessesSimulationViolation sys params trace violation → + trace.isValid (simulationTransitionSystem sys params) := by + intro h + cases violation with + | safetyFailure _ => exact h.1 + | deadlock => exact h.1 + | assertionFailure _ => exact h.1 + +noncomputable instance instDecidableTraceWitnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : + Decidable (Trace.witnessesSimulationViolation sys params trace violation) := by + classical + infer_instance def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -167,14 +227,34 @@ def ResultSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := - ResultSoundB sys params result = true + match result with + | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolation sys params trace violation + | .foundViolation _ _ none => False + | .noViolationFound _ _ => True + | .cancelled => True + +theorem resultSound_of_check_true {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : + ResultSoundB sys params result = true → ResultSound sys params result := by + intro h + cases result with + | foundViolation _ violation traceOpt => + cases traceOpt with + | none => simp [ResultSoundB] at h + | some trace => + simp [ResultSound] + exact Trace.witnessesSimulationViolation_of_check_true sys params trace violation h + | noViolationFound _ _ => simp [ResultSound] + | cancelled => simp [ResultSound] -instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} +noncomputable instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Decidable (ResultSound sys params result) := by - unfold ResultSound + classical infer_instance end Veil.ModelChecker.Simulation diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index fba59452..ef308ea3 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1085,7 +1085,17 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by - native_decide)) + let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + exact $(mkIdent ``Veil.ModelChecker.Simulation.resultSound_of_check_true) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent) + (by native_decide : + $(mkIdent ``Veil.ModelChecker.Simulation.ResultSoundB) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent) = true))) private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do let resultJson := combinedJson From a4483a8a671ad10689bf27ba12beffdf5cc2438f Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 17:36:59 +0200 Subject: [PATCH 25/88] refactor: make random selection proof-carrying --- .../Tools/ModelChecker/Simulation/Path.lean | 126 +++++++++++++----- 1 file changed, 89 insertions(+), 37 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index cb5afe77..b9c61d94 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -7,7 +7,7 @@ private inductive StepDecision (σ κ : Type) where | assertionFailure (exId : Int) (step : Step σ κ) | deadlock | terminated - | continue (nexts : List (κ × σ)) + | continue (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) private def decideAtState {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -21,18 +21,62 @@ private def decideAtState {ρ σ κ : Type} {th₀ : ρ} | some (exId, step) => .assertionFailure exId step | none => let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes - if nexts.isEmpty then - if !params.terminating.holdsOn th currSt then .deadlock else .terminated - else - .continue nexts + match nexts with + | [] => if !params.terminating.holdsOn th currSt then .deadlock else .terminated + | hd :: tl => .continue (hd :: tl) (by simp) + +theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdGen) : + (let p := randNat gen 0 (xs.length - 1); p.1 < xs.length) := by + have hlen : 0 < xs.length := by simpa [List.length_pos_iff_ne_nil] using h + have hk : xs.length - 1 + 1 = xs.length := Nat.sub_add_cancel (Nat.succ_le_of_lt hlen) + unfold randNat + simp [Nat.not_lt.mpr (Nat.zero_le (xs.length - 1)), hk] + exact Nat.mod_lt _ hlen + +private structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where + value : κ × σ + mem : value ∈ nexts + gen : StdGen + +def pickNextTransition {σ κ : Type} + (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) [Inhabited (κ × σ)] : PickedTransition nexts := + let p := randNat gen 0 (nexts.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < nexts.length := by + simpa [p, idx] using randNat_lt_length nexts h gen + { value := nexts.get ⟨idx, hlt⟩ + mem := by simpa using List.get_mem nexts ⟨idx, hlt⟩ + gen := gen' } + +theorem pickNextTransition_mem {σ κ : Type} + (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) [Inhabited (κ × σ)] : + (pickNextTransition nexts gen h).value ∈ nexts := + (pickNextTransition nexts gen h).mem + +private structure PickedInitState {σ : Type} (initStates : List σ) where + value : σ + mem : value ∈ initStates + gen : StdGen -private def pickNextTransition {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) [Inhabited (κ × σ)] : (κ × σ) × StdGen := - let (idx, gen) := randNat gen 0 (nexts.length - 1) - (nexts[idx]!, gen) +def pickInitialState {σ : Type} + (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) [Inhabited σ] : PickedInitState initStates := + let p := randNat gen 0 (initStates.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < initStates.length := by + simpa [p, idx] using randNat_lt_length initStates h gen + { value := initStates.get ⟨idx, hlt⟩ + mem := by simpa using List.get_mem initStates ⟨idx, hlt⟩ + gen := gen' } + +theorem pickInitialState_mem {σ : Type} + (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) [Inhabited σ] : + (pickInitialState initStates gen h).value ∈ initStates := + (pickInitialState initStates gen h).mem @[inline, specialize] -partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} +def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) @@ -48,16 +92,19 @@ partial def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} | .assertionFailure _ _ => (true, gen, 1) | .deadlock => (true, gen, 0) | .terminated => (false, gen, 0) - | .continue nexts => - let ((_, nextSt), gen) := pickNextTransition nexts gen + | .continue nexts hNonempty => + let picked := pickNextTransition nexts gen hNonempty + let (_, nextSt) := picked.value + let gen := picked.gen if !(violatedInvariantNames params th nextSt).isEmpty then (true, gen, 1) else let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen (violated, gen, innerSteps + 1) +termination_by stepsLeft @[inline, specialize] -partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} +def scanOnce {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) @@ -67,18 +114,19 @@ partial def scanOnce {ρ σ κ : Type} {th₀ : ρ} [Inhabited (κ × σ)] : Bool × StdGen × Nat := let initStates := filterInitStatesByConstraints sys params th - if initStates.isEmpty then - (false, gen, 0) - else - let (idx, gen) := randNat gen 0 (initStates.length - 1) - let initSt := initStates[idx]! - if !(violatedInvariantNames params th initSt).isEmpty then - (true, gen, 0) - else - scanOnceLoop sys params th maxSteps initSt gen + match initStates with + | [] => (false, gen, 0) + | hd :: tl => + let picked := pickInitialState (hd :: tl) gen (by simp) + let initSt := picked.value + let gen := picked.gen + if !(violatedInvariantNames params th initSt).isEmpty then + (true, gen, 0) + else + scanOnceLoop sys params th maxSteps initSt gen @[inline, specialize] -partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} +def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) @@ -99,17 +147,20 @@ partial def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) | .terminated => (none, gen, trace.steps.size) - | .continue nexts => - let ((label, nextSt), gen) := pickNextTransition nexts gen + | .continue nexts hNonempty => + let picked := pickNextTransition nexts gen hNonempty + let (label, nextSt) := picked.value + let gen := picked.gen let trace := trace.push { transitionLabel := label, nextState := nextSt } let violations := violatedInvariantNames params th nextSt if !violations.isEmpty then (some (.foundViolation () (.safetyFailure violations) (some trace)), gen, trace.steps.size) else simulateOnceLoop sys params th stepsLeft nextSt trace gen +termination_by stepsLeft @[inline, specialize] -partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} +def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) @@ -119,17 +170,18 @@ partial def simulateOnce {ρ σ κ : Type} {th₀ : ρ} [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := let initStates := filterInitStatesByConstraints sys params th - if initStates.isEmpty then - (none, gen, 0) - else - let (idx, gen) := randNat gen 0 (initStates.length - 1) - let initSt := initStates[idx]! - let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } - let initViolations := violatedInvariantNames params th initSt - if !initViolations.isEmpty then - (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) - else - simulateOnceLoop sys params th maxSteps initSt initTrace gen + match initStates with + | [] => (none, gen, 0) + | hd :: tl => + let picked := pickInitialState (hd :: tl) gen (by simp) + let initSt := picked.value + let gen := picked.gen + let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } + let initViolations := violatedInvariantNames params th initSt + if !initViolations.isEmpty then + (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) + else + simulateOnceLoop sys params th maxSteps initSt initTrace gen def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From b304781abd0c657941d8fba8fe13cb379a48ca4b Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 17:43:08 +0200 Subject: [PATCH 26/88] refactor: simplify single-trace proof foundations --- .../Tools/ModelChecker/Simulation/Path.lean | 12 +-- .../ModelChecker/Simulation/Soundness.lean | 80 ++++++++++++++++++- 2 files changed, 83 insertions(+), 9 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index b9c61d94..ff939ad7 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -33,7 +33,7 @@ theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdG simp [Nat.not_lt.mpr (Nat.zero_le (xs.length - 1)), hk] exact Nat.mod_lt _ hlen -private structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where +structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where value : κ × σ mem : value ∈ nexts gen : StdGen @@ -54,7 +54,7 @@ theorem pickNextTransition_mem {σ κ : Type} (pickNextTransition nexts gen h).value ∈ nexts := (pickNextTransition nexts gen h).mem -private structure PickedInitState {σ : Type} (initStates : List σ) where +structure PickedInitState {σ : Type} (initStates : List σ) where value : σ mem : value ∈ initStates gen : StdGen @@ -193,11 +193,7 @@ def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit × Nat) := let traceSeed := cfg.seed + traceIndex - let (violated, _, stepsUsed) := scanOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - if violated then - let (maybeResult, _, _) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - maybeResult.map (fun result => (result, stepsUsed)) - else - none + let (maybeResult, _, depth) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps + maybeResult.map (fun result => (result, depth)) end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 9f9c6239..c24add66 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -1,4 +1,5 @@ import Veil.Core.Tools.ModelChecker.Simulation.Basic +import Veil.Core.Tools.ModelChecker.Simulation.Path import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation @@ -45,6 +46,27 @@ theorem StepList.validFromSimulation_sound {ρ σ κ : Type} {th₀ : ρ} exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hmem · exact StepList.validFromSimulation_sound sys params th step.nextState steps h'.2 +theorem StepList.validFromSimulation_complete {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : + ∀ steps, StepList.validFrom (simulationTransitionSystem sys params) th st steps -> + StepList.validFromSimulation sys params th st steps = true + | [], _ => by simp [StepList.validFromSimulation] + | step :: steps, h => by + rcases h with ⟨hStep, hTail⟩ + have hStep' : (step.transitionLabel, ExecutionOutcome.success step.nextState) ∈ + filterOutcomesByConstraints sys params th st := by + simpa [simulationTransitionSystem] using hStep + have hContains : (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th st)).fst.contains + (step.transitionLabel, step.nextState) = true := by + exact List.elem_eq_true_of_mem <| + (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mpr hStep' + rw [StepList.validFromSimulation] + rw [hContains] + simp [StepList.validFromSimulation_complete sys params th step.nextState steps hTail] + def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -73,10 +95,66 @@ theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} initialStateSatisfiesInit := ?_ stepsValid := ?_ } - · simpa [simulationTransitionSystem] using h'.1 + · exact by + have hMem : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := + List.mem_of_elem_eq_true h'.1 + simpa [simulationTransitionSystem] using hMem · simpa [Steps.validFrom] using StepList.validFromSimulation_sound sys params trace.theory trace.initialState trace.steps.toList h'.2 +theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : + trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValid sys params trace := by + intro h + have hInitMem : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := by + simpa [simulationTransitionSystem] using h.initialStateSatisfiesInit + have hInit : (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState = true := by + exact List.elem_eq_true_of_mem hInitMem + have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList = true := by + exact StepList.validFromSimulation_complete sys params trace.theory trace.initialState trace.steps.toList (by + simpa [Steps.validFrom] using h.stepsValid) + rw [Trace.isSimulationValid, Trace.isSimulationValidB] + rw [hInit, hSteps] + simp + +theorem pickedTransition_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) + (nexts : List (κ × σ)) + (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst) + (hNonempty : nexts ≠ []) (gen : StdGen) : + let picked := pickNextTransition nexts gen hNonempty + (simulationTransitionSystem sys params).tr th currSt picked.value.1 picked.value.2 := by + intro picked + have hmem : picked.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty + have hGood : picked.value ∈ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst := by + simpa [hNexts] using hmem + exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hGood + +theorem pickedInitialState_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + [Inhabited σ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) + (initStates : List σ) + (hInitStates : initStates = filterInitStatesByConstraints sys params th) + (hNonempty : initStates ≠ []) (gen : StdGen) : + let picked := pickInitialState initStates gen hNonempty + ({ theory := th, initialState := picked.value, steps := #[] } : Trace ρ σ κ).isValid + (simulationTransitionSystem sys params) := by + intro picked + have hmem : picked.value ∈ initStates := by simpa [picked] using pickInitialState_mem initStates gen hNonempty + refine Trace.isValid_empty (simulationTransitionSystem sys params) th picked.value ?_ ?_ + · simp [simulationTransitionSystem] + · simpa [simulationTransitionSystem, hInitStates] using hmem + instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From 7ee56dcac9330d5ae57a8f78dabd8611601c13db Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 18:53:18 +0200 Subject: [PATCH 27/88] refactor: prove single-trace engine soundness --- .../Tools/ModelChecker/Simulation/Path.lean | 109 +++++++- .../ModelChecker/Simulation/Soundness.lean | 233 +++++++++++++++++- 2 files changed, 329 insertions(+), 13 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index ff939ad7..24f1e611 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -3,20 +3,29 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation -private inductive StepDecision (σ κ : Type) where +inductive StepDecision (σ κ : Type) where | assertionFailure (exId : Int) (step : Step σ κ) | deadlock | terminated | continue (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) -private def decideAtState {ρ σ κ : Type} {th₀ : ρ} +private def StepDecision.assertionInfo? : StepDecision σ κ → Option (Int × Step σ κ) + | .assertionFailure exId step => some (exId, step) + | _ => none + +private def StepDecision.continueNexts? : StepDecision σ κ → Option (List (κ × σ)) + | .continue nexts _ => some nexts + | _ => none + +private def assertionFailureWitness {σ κ : Type} : κ × ExecutionOutcome Int σ → Option (Int × Step σ κ) + | (label, .assertionFailure exId st) => some (exId, { transitionLabel := label, nextState := st }) + | _ => none + +def decideAtState {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := let outcomes := filterOutcomesByConstraints sys params th currSt - let failingStep := outcomes.findSome? fun (label, outcome) => - match outcome with - | .assertionFailure exId st => some (exId, { transitionLabel := label, nextState := st }) - | _ => none + let failingStep := outcomes.findSome? assertionFailureWitness match failingStep with | some (exId, step) => .assertionFailure exId step | none => @@ -25,6 +34,94 @@ private def decideAtState {ρ σ κ : Type} {th₀ : ρ} | [] => if !params.terminating.holdsOn th currSt then .deadlock else .terminated | hd :: tl => .continue (hd :: tl) (by simp) +theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) + (exId : Int) (step : Step σ κ) : + decideAtState sys params th currSt = .assertionFailure exId step -> + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params th currSt := by + intro h + let outcomes := filterOutcomesByConstraints sys params th currSt + cases hFind : outcomes.findSome? assertionFailureWitness with + | none => + cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with + | nil => + by_cases hTerm : params.terminating.holdsOn th currSt = false + · have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + exact False.elim this + · have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + exact False.elim this + | cons hd tl => + have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] using h + exact False.elim this + | some found => + rcases found with ⟨foundExId, foundStep⟩ + simp [decideAtState, outcomes, assertionFailureWitness, hFind] at h + rcases h with ⟨rfl, rfl⟩ + obtain ⟨entry, hEntryMem, hEntryEq⟩ := List.exists_of_findSome?_eq_some hFind + rcases entry with ⟨label, outcome⟩ + cases outcome <;> simp [assertionFailureWitness] at hEntryEq + case assertionFailure exId' st => + rcases hEntryEq with ⟨rfl, rfl⟩ + simpa [outcomes] using hEntryMem + +theorem decideAtState_deadlock_spec {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : + decideAtState sys params th currSt = .deadlock -> + params.terminating.holdsOn th currSt = false ∧ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst = [] := by + intro h + let outcomes := filterOutcomesByConstraints sys params th currSt + cases hFind : outcomes.findSome? assertionFailureWitness with + | some found => + have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind] using h + exact False.elim this + | none => + cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with + | nil => + have hTerm : params.terminating.holdsOn th currSt = false := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] using h + exact ⟨hTerm, by simpa [outcomes] using hNexts⟩ + | cons hd tl => + simp [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] at h + +theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) + (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) : + decideAtState sys params th currSt = .continue nexts hNonempty -> + nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst := by + intro h + let outcomes := filterOutcomesByConstraints sys params th currSt + cases hFind : outcomes.findSome? assertionFailureWitness with + | some found => + have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind] using h + exact False.elim this + | none => + cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with + | nil => + by_cases hTerm : params.terminating.holdsOn th currSt = false + · have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + exact False.elim this + · have : False := by + simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + exact False.elim this + | cons hd tl => + have h' := h + simp [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] at h' + cases h' + simpa [outcomes] using hNexts.symm + theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdGen) : (let p := randNat gen 0 (xs.length - 1); p.1 < xs.length) := by have hlen : 0 < xs.length := by simpa [List.length_pos_iff_ne_nil] using h diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index c24add66..2e73d2a1 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -4,6 +4,15 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation +private instance (priority := high) instBEqTransitionOutcome {σ κ : Type} + [DecidableEq σ] [DecidableEq κ] : BEq (κ × ExecutionOutcome Int σ) := + ⟨fun a b => decide (a = b)⟩ + +private instance (priority := high) instLawfulBEqTransitionOutcome {σ κ : Type} + [DecidableEq σ] [DecidableEq κ] : LawfulBEq (κ × ExecutionOutcome Int σ) where + eq_of_beq := of_decide_eq_true + rfl := of_decide_eq_self_eq_true _ + def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -155,6 +164,56 @@ theorem pickedInitialState_valid {ρ σ κ : Type} {th₀ : ρ} · simp [simulationTransitionSystem] · simpa [simulationTransitionSystem, hInitStates] using hmem +private theorem pushedTrace_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (currSt : σ) + (trace : Trace ρ σ κ) + (hTheory : trace.theory = th) + (hValid : trace.isValid (simulationTransitionSystem sys params)) + (hLast : trace.lastState = currSt) + (hNoFail : trace.failingStep = none) + (nexts : List (κ × σ)) + (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst) + (hNonempty : nexts ≠ []) + (gen : StdGen) : + let picked := pickNextTransition nexts gen hNonempty + let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } + trace'.isValid (simulationTransitionSystem sys params) ∧ + trace'.theory = th ∧ + trace'.lastState = picked.value.2 ∧ + trace'.failingStep = none := by + intro picked trace' + have hRel : (simulationTransitionSystem sys params).tr th currSt picked.value.1 picked.value.2 := + pickedTransition_valid sys params th currSt nexts hNexts hNonempty gen + have hValid' : trace'.isValid (simulationTransitionSystem sys params) := by + subst hTheory + exact Trace.push_isValid trace { transitionLabel := picked.value.1, nextState := picked.value.2 } + (simulationTransitionSystem sys params) hValid (by simpa [hLast] using hRel) + exact ⟨hValid', by simpa [trace', hTheory], by simp [trace'], by simpa [trace', hNoFail]⟩ + +private theorem initialTrace_valid {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] [Inhabited σ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (initStates : List σ) + (hInitStates : initStates = filterInitStatesByConstraints sys params th) + (hNonempty : initStates ≠ []) + (gen : StdGen) : + let picked := pickInitialState initStates gen hNonempty + let trace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } + trace.isValid (simulationTransitionSystem sys params) ∧ + trace.theory = th ∧ + trace.lastState = picked.value ∧ + trace.failingStep = none := by + intro picked trace + have hValid := pickedInitialState_valid sys params th initStates hInitStates hNonempty gen + exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ + instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -183,8 +242,8 @@ def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} match trace.failingStep with | some step => Trace.isSimulationValidB sys params trace && - (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) + decide ((step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params trace.theory trace.lastState) | none => false def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} @@ -207,8 +266,8 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} trace.isValid (simulationTransitionSystem sys params) ∧ ∃ step, trace.failingStep = some step ∧ - (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params trace.theory trace.lastState theorem Trace.witnessesSimulationViolation_of_check_true {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -265,11 +324,11 @@ theorem Trace.witnessesSimulationViolation_of_check_true {ρ σ κ : Type} {th | none => simp [Trace.witnessesSimulationViolationB, hFail] at h | some step => have h' : Trace.isSimulationValidB sys params trace = true ∧ - (filterOutcomesByConstraints sys params trace.theory trace.lastState).contains - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) = true := by + decide ((step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params trace.theory trace.lastState) = true := by simpa [Trace.witnessesSimulationViolationB, hFail, Bool.and_eq_true] using h refine ⟨Trace.isSimulationValid_sound sys params trace h'.1, step, hFail, ?_⟩ - simpa using h'.2 + simpa [decide_eq_true_eq] using h'.2 theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -327,6 +386,166 @@ theorem resultSound_of_check_true {ρ σ κ : Type} {th₀ : ρ} | noViolationFound _ _ => simp [ResultSound] | cancelled => simp [ResultSound] +private theorem traceValid_check {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : + trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValidB sys params trace = true := + Trace.isSimulationValid_complete sys params trace + +theorem simulateOnceLoop_check {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (currSt : σ) + (trace : Trace ρ σ κ) + (hTheory : trace.theory = th) + (hValid : trace.isValid (simulationTransitionSystem sys params)) + (hLast : trace.lastState = currSt) + (hNoFail : trace.failingStep = none) : + ∀ stepsLeft gen result, + (simulateOnceLoop sys params th stepsLeft currSt trace gen).1 = some result -> + ResultSoundB sys params result = true := by + intro stepsLeft + induction stepsLeft generalizing currSt trace with + | zero => + intro gen result h + simp [simulateOnceLoop] at h + | succ steps ih => + intro gen result h + cases hStep : decideAtState sys params th currSt with + | assertionFailure exId step => + simp [simulateOnceLoop, hStep] at h + cases h + have hMem : (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params th currSt := + decideAtState_assertionFailure_mem sys params th currSt exId step hStep + have hSound : + Trace.isSimulationValidB sys params { trace with failingStep := some step } = true ∧ + (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + filterOutcomesByConstraints sys params { trace with failingStep := some step }.theory + { trace with failingStep := some step }.lastState := by + constructor + · simpa [Trace.isSimulationValidB] using traceValid_check sys params trace hValid + · have hLastFail : ({ trace with failingStep := some step } : Trace ρ σ κ).lastState = currSt := by + simpa [Trace.lastState] using hLast + rw [hLastFail] + simpa [hTheory] using hMem + simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using hSound + | deadlock => + simp [simulateOnceLoop, hStep] at h + cases h + have hDead := decideAtState_deadlock_spec sys params th currSt hStep + have hTerm : (!params.terminating.holdsOn trace.theory trace.lastState) = true := by + simpa [hTheory, hLast] using hDead.1 + have hNexts : + (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty) = true := by + simpa [hTheory, hLast, hDead.2] + have hSound : + ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ + (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ + (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params trace.theory trace.lastState) + nexts.isEmpty) = true := by + refine ⟨?_, hNexts⟩ + refine ⟨?_, hTerm⟩ + exact ⟨traceValid_check sys params trace hValid, by simpa [hNoFail]⟩ + simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using hSound + | terminated => + simp [simulateOnceLoop, hStep] at h + | «continue» nexts hNonempty => + let picked := pickNextTransition nexts gen hNonempty + let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } + have hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (filterOutcomesByConstraints sys params th currSt)).fst := + decideAtState_continue_nexts sys params th currSt nexts hNonempty hStep + have hTrace' := pushedTrace_valid sys params th currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen + have hValid' : trace'.isValid (simulationTransitionSystem sys params) := hTrace'.1 + have hTheory' : trace'.theory = th := hTrace'.2.1 + have hNoFail' : trace'.failingStep = none := hTrace'.2.2.2 + have hLast' : trace'.lastState = picked.value.2 := hTrace'.2.2.1 + cases hViol : (violatedInvariantNames params th picked.value.2).isEmpty with + | true => + simp [simulateOnceLoop, hStep, picked, hViol] at h + exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' picked.gen result h + | false => + simp [simulateOnceLoop, hStep, picked, hViol] at h + cases h + have hEq : decide (violatedInvariantNames params trace'.theory trace'.lastState = + violatedInvariantNames params th picked.value.2) = true := by + simp [hTheory', hLast'] + have hNonempty : (!(violatedInvariantNames params th picked.value.2).isEmpty) = true := by + simp [hViol] + have hSound : + (((Trace.isSimulationValidB sys params trace' = true ∧ trace'.failingStep.isNone = true) ∧ + decide (violatedInvariantNames params trace'.theory trace'.lastState = + violatedInvariantNames params th picked.value.2) = true) ∧ + (!(violatedInvariantNames params th picked.value.2).isEmpty) = true) := by + refine ⟨?_, hNonempty⟩ + refine ⟨?_, hEq⟩ + exact ⟨traceValid_check sys params trace' hValid', by simpa [hNoFail']⟩ + simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true, picked, trace'] using hSound + +theorem simulateOnce_check {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : ModelCheckingResult ρ σ κ Unit) : + (simulateOnce sys params th gen maxSteps).1 = some result -> + ResultSoundB sys params result = true := by + intro h + unfold simulateOnce at h + cases hStates : filterInitStatesByConstraints sys params th with + | nil => simp [hStates] at h + | cons initSt rest => + let picked := pickInitialState (initSt :: rest) gen (by simp) + let initTrace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } + have hInit := initialTrace_valid sys params th (initSt :: rest) hStates.symm (by simp) gen + have hValid : initTrace.isValid (simulationTransitionSystem sys params) := hInit.1 + have hLast : initTrace.lastState = picked.value := hInit.2.2.1 + have hNoFail : initTrace.failingStep = none := hInit.2.2.2 + cases hViol : (violatedInvariantNames params th picked.value).isEmpty with + | true => + simp [hStates, picked, hViol] at h + exact simulateOnceLoop_check sys params th picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h + | false => + simp [hStates, picked, hViol] at h + cases h + have hSound : + Trace.isSimulationValidB sys params initTrace = true ∧ + violatedInvariantNames params th picked.value ≠ [] := by + constructor + · exact traceValid_check sys params initTrace hValid + · simpa using hViol + simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true, hNoFail, hLast] using hSound + +theorem runTraceAtSeed_check {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (traceIndex : Nat) + (result : ModelCheckingResult ρ σ κ Unit) (depth : Nat) : + runTraceAtSeed sys params th cfg traceIndex = some (result, depth) -> + ResultSoundB sys params result = true := by + intro h + unfold runTraceAtSeed at h + set traceSeed := cfg.seed + traceIndex + rcases hSim : simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps with ⟨maybeResult, gen', depth'⟩ + simp [traceSeed, hSim] at h + rcases h with ⟨hSome, rfl⟩ + cases hMaybe : maybeResult with + | none => simp [hMaybe] at hSome + | some result' => + simp [hMaybe] at hSome + subst hSome + have hSimSome : (simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps).1 = some result' := by + simp [hSim, hMaybe] + exact simulateOnce_check sys params th (mkStdGen traceSeed) cfg.maxSteps result' hSimSome + noncomputable instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From d26185f7aae4fa5ecfcd5e6ab7bd57f26a15e33d Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 18:53:39 +0200 Subject: [PATCH 28/88] feat: lift engine soundness through runtime --- .../ModelChecker/Simulation/Runtime.lean | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 4d8ee7f3..3f6eeb30 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -1,4 +1,5 @@ import Veil.Core.Tools.ModelChecker.Simulation.Path +import Veil.Core.Tools.ModelChecker.Simulation.Soundness import Veil.Core.Tools.ModelChecker.Concrete.Progress namespace Veil.ModelChecker.Simulation @@ -110,4 +111,48 @@ def simulate {ρ σ κ : Type} {th₀ : ρ} let cancelToken ← IO.CancelToken.new simulateWithProgress sys params th cfg 0 cancelToken +private theorem simulateLoopM_id_check {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + [Inhabited σ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) : + ∀ remaining traceIndex, + ResultSoundB sys params + (SimulateResult.result + (Id.run <| simulateLoopM + { shouldStop := fun _ => false + onTraceProgress := fun _ => PUnit.unit + onViolation := PUnit.unit } + sys params th cfg remaining traceIndex)) = true := by + intro remaining + induction remaining with + | zero => + intro traceIndex + have hStop : Id.run false = false := rfl + simp [simulateLoopM, ResultSoundB, hStop] + | succ remaining ih => + intro traceIndex + simp [simulateLoopM, Id.run] + by_cases hTrace : runTraceAtSeed sys params th cfg traceIndex = none + · simp [hTrace] + exact ih (traceIndex + 1) + · cases hRun : runTraceAtSeed sys params th cfg traceIndex with + | none => contradiction + | some pair => + rcases pair with ⟨result, depth⟩ + simp [hRun] + exact runTraceAtSeed_check sys params th cfg traceIndex result depth hRun + +theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + [Inhabited σ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) : + ResultSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by + exact resultSound_of_check_true sys params _ (simulateLoopM_id_check sys params th cfg cfg.maxTraces 0) + end Veil.ModelChecker.Simulation From 8f2c504bb988c86196c652e861f0dfdf910788b9 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 18:53:56 +0200 Subject: [PATCH 29/88] refactor: emit engine-level soundness theorem --- Veil/Frontend/DSL/Module/Elaborators.lean | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index ef308ea3..2fb748dc 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1073,11 +1073,14 @@ private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) + (cfg : ModelChecker.Simulation.SimulateConfig) (resultIdent soundIdent : Ident) : CommandElabM Unit := do elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) let inst := mkVeilImplementationDetailIdent `inst let th := mkVeilImplementationDetailIdent `th let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) + let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) + $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) elabVeilCommand (← `(theorem $soundIdent : (let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm @@ -1087,15 +1090,11 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm - exact $(mkIdent ``Veil.ModelChecker.Simulation.resultSound_of_check_true) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent) - (by native_decide : - $(mkIdent ``Veil.ModelChecker.Simulation.ResultSoundB) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent) = true))) + simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore_sound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + $th + $cfgTerm)) private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do let resultJson := combinedJson @@ -1237,12 +1236,12 @@ def elabSimulate : CommandElab := fun stx => do if ← isModelCheckCompileMode then let simulateResultIdent := mkVeilImplementationDetailIdent `simulateResultValue let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateSoundIdent elabSimulateInternalMode mod runtimeCallExpr return let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) let simulateSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateSound)) - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr simulateResultIdent simulateSoundIdent + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateSoundIdent let effectiveMode := if (← liftIO isVeilOnlineEnv) then .interpreted else mode match effectiveMode with | .interpreted => elabSimulateInterpretedMode mod stx runtimeCallExpr From f05510eeba0369405f36937bd660a53ab4ca9076 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 20:33:47 +0200 Subject: [PATCH 30/88] refactor: remove bool soundness certificates --- .../ModelChecker/Simulation/Soundness.lean | 311 ++++-------------- 1 file changed, 73 insertions(+), 238 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 2e73d2a1..64bc2592 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -25,69 +25,45 @@ def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Bool - | [] => true + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Prop + | [] => True | step :: steps => - (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th st)).fst.contains - (step.transitionLabel, step.nextState) - && StepList.validFromSimulation sys params th step.nextState steps + (step.transitionLabel, ExecutionOutcome.success step.nextState) ∈ + filterOutcomesByConstraints sys params th st ∧ + StepList.validFromSimulation sys params th step.nextState steps theorem StepList.validFromSimulation_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (st : σ) : - ∀ steps, StepList.validFromSimulation sys params th st steps = true → + ∀ steps, StepList.validFromSimulation sys params th st steps → StepList.validFrom (simulationTransitionSystem sys params) th st steps | [], _ => by simp [StepList.validFrom] | step :: steps, h => by - have h' : - (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th st)).fst.contains - (step.transitionLabel, step.nextState) = true ∧ - StepList.validFromSimulation sys params th step.nextState steps = true := by - simpa [StepList.validFromSimulation, Bool.and_eq_true] using h + rcases h with ⟨hStep, hTail⟩ constructor - · have hmem : (step.transitionLabel, step.nextState) ∈ - (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th st)).fst := by - simpa using h'.1 - exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hmem - · exact StepList.validFromSimulation_sound sys params th step.nextState steps h'.2 + · simpa [simulationTransitionSystem] using hStep + · exact StepList.validFromSimulation_sound sys params th step.nextState steps hTail theorem StepList.validFromSimulation_complete {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (st : σ) : ∀ steps, StepList.validFrom (simulationTransitionSystem sys params) th st steps -> - StepList.validFromSimulation sys params th st steps = true + StepList.validFromSimulation sys params th st steps | [], _ => by simp [StepList.validFromSimulation] | step :: steps, h => by rcases h with ⟨hStep, hTail⟩ - have hStep' : (step.transitionLabel, ExecutionOutcome.success step.nextState) ∈ - filterOutcomesByConstraints sys params th st := by - simpa [simulationTransitionSystem] using hStep - have hContains : (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th st)).fst.contains - (step.transitionLabel, step.nextState) = true := by - exact List.elem_eq_true_of_mem <| - (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mpr hStep' - rw [StepList.validFromSimulation] - rw [hContains] - simp [StepList.validFromSimulation_complete sys params th step.nextState steps hTail] - -def Trace.isSimulationValidB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Bool := - (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState && - StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList + constructor + · simpa [simulationTransitionSystem] using hStep + · exact StepList.validFromSimulation_complete sys params th step.nextState steps hTail -abbrev Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} +def Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := - Trace.isSimulationValidB sys params trace = true + trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory ∧ + StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -95,21 +71,15 @@ theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Trace.isSimulationValid sys params trace → trace.isValid (simulationTransitionSystem sys params) := by intro h - have h' : - (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState = true ∧ - StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList = true := by - simpa [Trace.isSimulationValid, Trace.isSimulationValidB, Bool.and_eq_true] using h + rcases h with ⟨hInit, hSteps⟩ refine { theorySatisfiesAssumptions := by simp [simulationTransitionSystem] initialStateSatisfiesInit := ?_ stepsValid := ?_ } - · exact by - have hMem : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := - List.mem_of_elem_eq_true h'.1 - simpa [simulationTransitionSystem] using hMem + · simpa [simulationTransitionSystem] using hInit · simpa [Steps.validFrom] using - StepList.validFromSimulation_sound sys params trace.theory trace.initialState trace.steps.toList h'.2 + StepList.validFromSimulation_sound sys params trace.theory trace.initialState trace.steps.toList hSteps theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -117,16 +87,12 @@ theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValid sys params trace := by intro h - have hInitMem : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := by + have hInit : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := by simpa [simulationTransitionSystem] using h.initialStateSatisfiesInit - have hInit : (filterInitStatesByConstraints sys params trace.theory).contains trace.initialState = true := by - exact List.elem_eq_true_of_mem hInitMem - have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList = true := by + have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList := by exact StepList.validFromSimulation_complete sys params trace.theory trace.initialState trace.steps.toList (by simpa [Steps.validFrom] using h.stepsValid) - rw [Trace.isSimulationValid, Trace.isSimulationValidB] - rw [hInit, hSteps] - simp + exact ⟨hInit, hSteps⟩ theorem pickedTransition_valid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -214,6 +180,17 @@ private theorem initialTrace_valid {ρ σ κ : Type} {th₀ : ρ} have hValid := pickedInitialState_valid sys params th initStates hInitStates hNonempty gen exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ +instance instDecidableStepListValidFromSimulation {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (st : σ) (steps : StepList σ κ) : + Decidable (StepList.validFromSimulation sys params th st steps) := by + induction steps generalizing st with + | nil => exact isTrue trivial + | cons step steps ih => + dsimp [StepList.validFromSimulation] + infer_instance + instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -222,114 +199,29 @@ instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} unfold Trace.isSimulationValid infer_instance -def Trace.witnessesSimulationViolationB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Bool - | .safetyFailure violates => - Trace.isSimulationValidB sys params trace && - trace.failingStep.isNone && - decide (violatedInvariantNames params trace.theory trace.lastState = violates) && - !violates.isEmpty - | .deadlock => - Trace.isSimulationValidB sys params trace && - trace.failingStep.isNone && - !params.terminating.holdsOn trace.theory trace.lastState && - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty - | .assertionFailure exId => - match trace.failingStep with - | some step => - Trace.isSimulationValidB sys params trace && - decide ((step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params trace.theory trace.lastState) - | none => false - def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Prop | .safetyFailure violates => - trace.isValid (simulationTransitionSystem sys params) ∧ + Trace.isSimulationValid sys params trace ∧ trace.failingStep = none ∧ violatedInvariantNames params trace.theory trace.lastState = violates ∧ violates ≠ [] | .deadlock => - trace.isValid (simulationTransitionSystem sys params) ∧ + Trace.isSimulationValid sys params trace ∧ trace.failingStep = none ∧ params.terminating.holdsOn trace.theory trace.lastState = false ∧ let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome (filterOutcomesByConstraints sys params trace.theory trace.lastState) nexts = [] | .assertionFailure exId => - trace.isValid (simulationTransitionSystem sys params) ∧ + Trace.isSimulationValid sys params trace ∧ ∃ step, trace.failingStep = some step ∧ (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ filterOutcomesByConstraints sys params trace.theory trace.lastState -theorem Trace.witnessesSimulationViolation_of_check_true {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : - Trace.witnessesSimulationViolationB sys params trace violation = true → - Trace.witnessesSimulationViolation sys params trace violation := by - intro h - cases violation with - | safetyFailure violates => - have hValid : Trace.isSimulationValidB sys params trace = true := by - have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ - (!violates.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - exact h'.1.1.1 - refine ⟨Trace.isSimulationValid_sound sys params trace hValid, ?_, ?_, ?_⟩ - · have hNone : trace.failingStep.isNone = true := by - have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ - (!violates.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - exact h'.1.1.2 - cases hFail : trace.failingStep <;> simp [Option.isNone, hFail] at hNone ⊢ - · have hEq : decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true := by - have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ - (!violates.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - exact h'.1.2 - simpa [decide_eq_true_eq] using hEq - · intro hNil - have h' : (!violates.isEmpty) = true := by - have hx : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - decide (violatedInvariantNames params trace.theory trace.lastState = violates) = true) ∧ - (!violates.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - exact hx.2 - simpa [hNil] using h' - | deadlock => - have h' : ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ - (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty) = true := by - simpa [Trace.witnessesSimulationViolationB, Bool.and_eq_true] using h - refine ⟨Trace.isSimulationValid_sound sys params trace h'.1.1.1, ?_, ?_, ?_⟩ - · have hNone : trace.failingStep.isNone = true := h'.1.1.2 - cases hFail : trace.failingStep <;> simp [Option.isNone, hFail] at hNone ⊢ - · simpa using h'.1.2 - · simpa using h'.2 - | assertionFailure exId => - cases hFail : trace.failingStep with - | none => simp [Trace.witnessesSimulationViolationB, hFail] at h - | some step => - have h' : Trace.isSimulationValidB sys params trace = true ∧ - decide ((step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params trace.theory trace.lastState) = true := by - simpa [Trace.witnessesSimulationViolationB, hFail, Bool.and_eq_true] using h - refine ⟨Trace.isSimulationValid_sound sys params trace h'.1, step, hFail, ?_⟩ - simpa [decide_eq_true_eq] using h'.2 - theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -338,9 +230,9 @@ theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} trace.isValid (simulationTransitionSystem sys params) := by intro h cases violation with - | safetyFailure _ => exact h.1 - | deadlock => exact h.1 - | assertionFailure _ => exact h.1 + | safetyFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 + | deadlock => exact Trace.isSimulationValid_sound sys params trace h.1 + | assertionFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 noncomputable instance instDecidableTraceWitnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -350,16 +242,6 @@ noncomputable instance instDecidableTraceWitnessesSimulationViolation {ρ σ κ classical infer_instance -def ResultSoundB {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Bool := - match result with - | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolationB sys params trace violation - | .foundViolation _ _ none => false - | .noViolationFound _ _ => true - | .cancelled => true - def ResultSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -370,30 +252,7 @@ def ResultSound {ρ σ κ : Type} {th₀ : ρ} | .noViolationFound _ _ => True | .cancelled => True -theorem resultSound_of_check_true {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : - ResultSoundB sys params result = true → ResultSound sys params result := by - intro h - cases result with - | foundViolation _ violation traceOpt => - cases traceOpt with - | none => simp [ResultSoundB] at h - | some trace => - simp [ResultSound] - exact Trace.witnessesSimulationViolation_of_check_true sys params trace violation h - | noViolationFound _ _ => simp [ResultSound] - | cancelled => simp [ResultSound] - -private theorem traceValid_check {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : - trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValidB sys params trace = true := - Trace.isSimulationValid_complete sys params trace - -theorem simulateOnceLoop_check {ρ σ κ : Type} {th₀ : ρ} +theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) @@ -406,7 +265,7 @@ theorem simulateOnceLoop_check {ρ σ κ : Type} {th₀ : ρ} (hNoFail : trace.failingStep = none) : ∀ stepsLeft gen result, (simulateOnceLoop sys params th stepsLeft currSt trace gen).1 = some result -> - ResultSoundB sys params result = true := by + ResultSound sys params result := by intro stepsLeft induction stepsLeft generalizing currSt trace with | zero => @@ -421,39 +280,25 @@ theorem simulateOnceLoop_check {ρ σ κ : Type} {th₀ : ρ} have hMem : (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ filterOutcomesByConstraints sys params th currSt := decideAtState_assertionFailure_mem sys params th currSt exId step hStep - have hSound : - Trace.isSimulationValidB sys params { trace with failingStep := some step } = true ∧ - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params { trace with failingStep := some step }.theory - { trace with failingStep := some step }.lastState := by - constructor - · simpa [Trace.isSimulationValidB] using traceValid_check sys params trace hValid - · have hLastFail : ({ trace with failingStep := some step } : Trace ρ σ κ).lastState = currSt := by - simpa [Trace.lastState] using hLast - rw [hLastFail] - simpa [hTheory] using hMem - simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using hSound + let failedTrace := { trace with failingStep := some step } + have hValidFail : failedTrace.isValid (simulationTransitionSystem sys params) := by + exact { + theorySatisfiesAssumptions := hValid.theorySatisfiesAssumptions + initialStateSatisfiesInit := hValid.initialStateSatisfiesInit + stepsValid := hValid.stepsValid + } + refine ⟨Trace.isSimulationValid_complete sys params failedTrace hValidFail, step, rfl, ?_⟩ + have hLastFail : failedTrace.lastState = currSt := by + simpa [failedTrace, Trace.lastState] using hLast + rw [hLastFail] + simpa [failedTrace, hTheory] using hMem | deadlock => simp [simulateOnceLoop, hStep] at h cases h have hDead := decideAtState_deadlock_spec sys params th currSt hStep - have hTerm : (!params.terminating.holdsOn trace.theory trace.lastState) = true := by - simpa [hTheory, hLast] using hDead.1 - have hNexts : - (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty) = true := by - simpa [hTheory, hLast, hDead.2] - have hSound : - ((Trace.isSimulationValidB sys params trace = true ∧ trace.failingStep.isNone = true) ∧ - (!params.terminating.holdsOn trace.theory trace.lastState) = true) ∧ - (let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts.isEmpty) = true := by - refine ⟨?_, hNexts⟩ - refine ⟨?_, hTerm⟩ - exact ⟨traceValid_check sys params trace hValid, by simpa [hNoFail]⟩ - simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true] using hSound + exact ⟨Trace.isSimulationValid_complete sys params trace hValid, hNoFail, + by simpa [hTheory, hLast] using hDead.1, + by simpa [hTheory, hLast] using hDead.2⟩ | terminated => simp [simulateOnceLoop, hStep] at h | «continue» nexts hNonempty => @@ -474,27 +319,20 @@ theorem simulateOnceLoop_check {ρ σ κ : Type} {th₀ : ρ} | false => simp [simulateOnceLoop, hStep, picked, hViol] at h cases h - have hEq : decide (violatedInvariantNames params trace'.theory trace'.lastState = - violatedInvariantNames params th picked.value.2) = true := by - simp [hTheory', hLast'] - have hNonempty : (!(violatedInvariantNames params th picked.value.2).isEmpty) = true := by - simp [hViol] - have hSound : - (((Trace.isSimulationValidB sys params trace' = true ∧ trace'.failingStep.isNone = true) ∧ - decide (violatedInvariantNames params trace'.theory trace'.lastState = - violatedInvariantNames params th picked.value.2) = true) ∧ - (!(violatedInvariantNames params th picked.value.2).isEmpty) = true) := by - refine ⟨?_, hNonempty⟩ - refine ⟨?_, hEq⟩ - exact ⟨traceValid_check sys params trace' hValid', by simpa [hNoFail']⟩ - simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true, picked, trace'] using hSound + have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by + intro hNil + simpa [hNil] using hViol + have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = + violatedInvariantNames params th picked.value.2 := by + simpa [hTheory', hLast'] + exact ⟨Trace.isSimulationValid_complete sys params trace' hValid', hNoFail', hViolEq, hNonempty⟩ -theorem simulateOnce_check {ρ σ κ : Type} {th₀ : ρ} +theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : ModelCheckingResult ρ σ κ Unit) : (simulateOnce sys params th gen maxSteps).1 = some result -> - ResultSoundB sys params result = true := by + ResultSound sys params result := by intro h unfold simulateOnce at h cases hStates : filterInitStatesByConstraints sys params th with @@ -509,19 +347,16 @@ theorem simulateOnce_check {ρ σ κ : Type} {th₀ : ρ} cases hViol : (violatedInvariantNames params th picked.value).isEmpty with | true => simp [hStates, picked, hViol] at h - exact simulateOnceLoop_check sys params th picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h + exact simulateOnceLoop_sound sys params th picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h | false => simp [hStates, picked, hViol] at h cases h - have hSound : - Trace.isSimulationValidB sys params initTrace = true ∧ - violatedInvariantNames params th picked.value ≠ [] := by - constructor - · exact traceValid_check sys params initTrace hValid - · simpa using hViol - simpa [ResultSoundB, Trace.witnessesSimulationViolationB, Bool.and_eq_true, hNoFail, hLast] using hSound + have hNonempty : violatedInvariantNames params th picked.value ≠ [] := by + intro hNil + simpa [hNil] using hViol + exact ⟨Trace.isSimulationValid_complete sys params initTrace hValid, hNoFail, by simpa [hLast], hNonempty⟩ -theorem runTraceAtSeed_check {ρ σ κ : Type} {th₀ : ρ} +theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) @@ -530,7 +365,7 @@ theorem runTraceAtSeed_check {ρ σ κ : Type} {th₀ : ρ} (traceIndex : Nat) (result : ModelCheckingResult ρ σ κ Unit) (depth : Nat) : runTraceAtSeed sys params th cfg traceIndex = some (result, depth) -> - ResultSoundB sys params result = true := by + ResultSound sys params result := by intro h unfold runTraceAtSeed at h set traceSeed := cfg.seed + traceIndex @@ -544,7 +379,7 @@ theorem runTraceAtSeed_check {ρ σ κ : Type} {th₀ : ρ} subst hSome have hSimSome : (simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps).1 = some result' := by simp [hSim, hMaybe] - exact simulateOnce_check sys params th (mkStdGen traceSeed) cfg.maxSteps result' hSimSome + exact simulateOnce_sound sys params th (mkStdGen traceSeed) cfg.maxSteps result' hSimSome noncomputable instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] From 78542c00ea8048b5b3d0eb6d685dc8cb8083c4a3 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 20:34:01 +0200 Subject: [PATCH 31/88] refactor: prove runtime soundness directly --- Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 3f6eeb30..12e344ca 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -111,7 +111,7 @@ def simulate {ρ σ κ : Type} {th₀ : ρ} let cancelToken ← IO.CancelToken.new simulateWithProgress sys params th cfg 0 cancelToken -private theorem simulateLoopM_id_check {ρ σ κ : Type} {th₀ : ρ} +private theorem simulateLoopM_id_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -119,19 +119,19 @@ private theorem simulateLoopM_id_check {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) : ∀ remaining traceIndex, - ResultSoundB sys params + ResultSound sys params (SimulateResult.result (Id.run <| simulateLoopM { shouldStop := fun _ => false onTraceProgress := fun _ => PUnit.unit onViolation := PUnit.unit } - sys params th cfg remaining traceIndex)) = true := by + sys params th cfg remaining traceIndex)) := by intro remaining induction remaining with | zero => intro traceIndex have hStop : Id.run false = false := rfl - simp [simulateLoopM, ResultSoundB, hStop] + simp [simulateLoopM, ResultSound, hStop] | succ remaining ih => intro traceIndex simp [simulateLoopM, Id.run] @@ -143,7 +143,7 @@ private theorem simulateLoopM_id_check {ρ σ κ : Type} {th₀ : ρ} | some pair => rcases pair with ⟨result, depth⟩ simp [hRun] - exact runTraceAtSeed_check sys params th cfg traceIndex result depth hRun + exact runTraceAtSeed_sound sys params th cfg traceIndex result depth hRun theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -153,6 +153,6 @@ theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) : ResultSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by - exact resultSound_of_check_true sys params _ (simulateLoopM_id_check sys params th cfg cfg.maxTraces 0) + exact simulateLoopM_id_sound sys params th cfg cfg.maxTraces 0 end Veil.ModelChecker.Simulation From 8ca3b6fa9fa87203d35adb13b370c8409a475e6c Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 12 Apr 2026 22:24:55 +0200 Subject: [PATCH 32/88] refactor: make simulate theorem assumptions-aware --- .../ModelChecker/Simulation/Soundness.lean | 16 ++++++++++++++++ Veil/Frontend/DSL/Module/Elaborators.lean | 19 ++++++++++++------- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 64bc2592..0aabc076 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -252,6 +252,13 @@ def ResultSound {ρ σ κ : Type} {th₀ : ρ} | .noViolationFound _ _ => True | .cancelled => True +def ResultSoundUnder {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (assumptions : ρ → Prop) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := + assumptions th → ResultSound sys params result + theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -389,4 +396,13 @@ noncomputable instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} classical infer_instance +noncomputable instance instDecidableResultSoundUnder {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + (assumptions : ρ → Prop) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) (result : ModelCheckingResult ρ σ κ Unit) : + Decidable (ResultSoundUnder assumptions sys params th result) := by + classical + infer_instance + end Veil.ModelChecker.Simulation diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 2fb748dc..c63fdba8 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1078,23 +1078,28 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) let inst := mkVeilImplementationDetailIdent `inst let th := mkVeilImplementationDetailIdent `th + let ρArg := mkIdent `ρ let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) + let theoryT ← `($theoryIdent $instSortArgs*) + let assumptionsTerm ← `($assembledAssumptions ($ρArg := $theoryT) $instSortArgs* $th) let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) elabVeilCommand (← `(theorem $soundIdent : (let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.ResultSound) + $(mkIdent ``Veil.ModelChecker.Simulation.ResultSoundUnder) + (fun $ρArg : $theoryT => $assembledAssumptions ($ρArg := $theoryT) $instSortArgs* $ρArg) ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp + $sp $th ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm - simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore_sound) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - $th - $cfgTerm)) + exact fun _ => by + simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore_sound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + $th + $cfgTerm)) private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do let resultJson := combinedJson From a379849d3ad7370469809be38ec439623deeadd8 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Mon, 13 Apr 2026 11:32:16 +0200 Subject: [PATCH 33/88] refactor: align simulate theorem boundary with command semantics --- .../ModelChecker/Simulation/Runtime.lean | 111 ++++++++++++++---- Veil/Frontend/DSL/Module/Elaborators.lean | 31 +++-- Veil/Frontend/DSL/Module/Names.lean | 5 + 3 files changed, 114 insertions(+), 33 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 12e344ca..b3689711 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -54,6 +54,62 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) termination_by remaining +private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} + (shouldStop : Nat → Bool) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (cfg : SimulateConfig) + (remaining : Nat) + (traceIndex : Nat) + [Inhabited σ] + [Inhabited (κ × σ)] + : SimulateResult ρ σ κ := + if shouldStop traceIndex then + { + result := .cancelled + tracesRun := traceIndex + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } + else + match remaining with + | 0 => + { + result := .noViolationFound cfg.maxTraces + (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + tracesRun := cfg.maxTraces + elapsedMs := 0 + seed := cfg.seed + depth := 0 + } + | remaining + 1 => + match runTraceAtSeed sys params th cfg traceIndex with + | some (result, stepsUsed) => + { + result := result + tracesRun := traceIndex + 1 + elapsedMs := 0 + seed := cfg.seed + depth := stepsUsed + } + | none => + simulateLoopId shouldStop sys params th cfg remaining (traceIndex + 1) +termination_by remaining + +@[inline, specialize] +def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (shouldStop : Nat → Bool) + (cfg : SimulateConfig) + [inhabσ : Inhabited σ] + [inhabκσ : Inhabited (κ × σ)] + : SimulateResult ρ σ κ := + simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 + @[inline, specialize] def simulateCore {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -63,11 +119,7 @@ def simulateCore {ρ σ κ : Type} {th₀ : ρ} [inhabσ : Inhabited σ] [inhabκσ : Inhabited (κ × σ)] : SimulateResult ρ σ κ := - Id.run <| simulateLoopM - { shouldStop := fun _ => false - onTraceProgress := fun _ => PUnit.unit - onViolation := PUnit.unit } - sys params th cfg cfg.maxTraces 0 + simulateCommandSemantics sys params th (fun _ => false) cfg @[inline, specialize] def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} @@ -117,33 +169,40 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) - (cfg : SimulateConfig) : + (cfg : SimulateConfig) + (shouldStop : Nat → Bool) : ∀ remaining traceIndex, - ResultSound sys params - (SimulateResult.result - (Id.run <| simulateLoopM - { shouldStop := fun _ => false - onTraceProgress := fun _ => PUnit.unit - onViolation := PUnit.unit } - sys params th cfg remaining traceIndex)) := by + ResultSound sys params (SimulateResult.result (simulateLoopId shouldStop sys params th cfg remaining traceIndex)) := by intro remaining induction remaining with | zero => intro traceIndex - have hStop : Id.run false = false := rfl - simp [simulateLoopM, ResultSound, hStop] + cases hStop : shouldStop traceIndex <;> simp [simulateLoopId, hStop, ResultSound] | succ remaining ih => intro traceIndex - simp [simulateLoopM, Id.run] - by_cases hTrace : runTraceAtSeed sys params th cfg traceIndex = none - · simp [hTrace] - exact ih (traceIndex + 1) - · cases hRun : runTraceAtSeed sys params th cfg traceIndex with - | none => contradiction - | some pair => - rcases pair with ⟨result, depth⟩ - simp [hRun] - exact runTraceAtSeed_sound sys params th cfg traceIndex result depth hRun + cases hStop : shouldStop traceIndex with + | true => + simp [simulateLoopId, hStop, ResultSound] + | false => + by_cases hTrace : runTraceAtSeed sys params th cfg traceIndex = none + · simpa [simulateLoopId, hStop, hTrace] using ih (traceIndex + 1) + · cases hRun : runTraceAtSeed sys params th cfg traceIndex with + | none => contradiction + | some pair => + rcases pair with ⟨result, depth⟩ + simpa [simulateLoopId, hStop, hRun] using + runTraceAtSeed_sound sys params th cfg traceIndex result depth hRun + +theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} + [DecidableEq σ] [DecidableEq κ] + [Inhabited σ] [Inhabited (κ × σ)] + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) + (th : ρ) + (shouldStop : Nat → Bool) + (cfg : SimulateConfig) : + ResultSound sys params (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by + exact simulateLoopM_id_sound sys params th cfg shouldStop cfg.maxTraces 0 theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -153,6 +212,6 @@ theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) : ResultSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by - exact simulateLoopM_id_sound sys params th cfg cfg.maxTraces 0 + simpa [simulateCore] using simulateCommandSemantics_sound sys params th (fun _ => false) cfg end Veil.ModelChecker.Simulation diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index c63fdba8..457dfef2 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1074,17 +1074,31 @@ private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) (cfg : ModelChecker.Simulation.SimulateConfig) - (resultIdent soundIdent : Ident) : CommandElabM Unit := do + (resultIdent coreSoundIdent commandSoundIdent : Ident) : CommandElabM Unit := do elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) let inst := mkVeilImplementationDetailIdent `inst let th := mkVeilImplementationDetailIdent `th let ρArg := mkIdent `ρ let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) let theoryT ← `($theoryIdent $instSortArgs*) - let assumptionsTerm ← `($assembledAssumptions ($ρArg := $theoryT) $instSortArgs* $th) let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) - elabVeilCommand (← `(theorem $soundIdent : + elabVeilCommand (← `(theorem $coreSoundIdent : + (let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + $(mkIdent ``Veil.ModelChecker.Simulation.ResultSound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by + let $inst : $instantiationType := $instTerm + let $th : $theoryIdent $instSortArgs* := $theoryTerm + simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCommandSemantics_sound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + $sp + $th + (fun _ => false) + $cfgTerm)) + elabVeilCommand (← `(theorem $commandSoundIdent : (let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Simulation.ResultSoundUnder) @@ -1095,10 +1109,11 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm exact fun _ => by - simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore_sound) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCommandSemantics_sound) + ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp $th + (fun _ => false) $cfgTerm)) private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do @@ -1240,13 +1255,15 @@ def elabSimulate : CommandElab := fun stx => do let runtimeCallExpr ← mkSimulatorRuntimeCall mod instTerm theoryTerm sp cfg if ← isModelCheckCompileMode then let simulateResultIdent := mkVeilImplementationDetailIdent `simulateResultValue + let simulateCoreSoundIdent := mkVeilImplementationDetailIdent `simulateCoreSound let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateSoundIdent + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent elabSimulateInternalMode mod runtimeCallExpr return let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) + let simulateCoreSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateCoreSound)) let simulateSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateSound)) - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateSoundIdent + emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent let effectiveMode := if (← liftIO isVeilOnlineEnv) then .interpreted else mode match effectiveMode with | .interpreted => elabSimulateInterpretedMode mod stx runtimeCallExpr diff --git a/Veil/Frontend/DSL/Module/Names.lean b/Veil/Frontend/DSL/Module/Names.lean index 62b00669..89147d54 100644 --- a/Veil/Frontend/DSL/Module/Names.lean +++ b/Veil/Frontend/DSL/Module/Names.lean @@ -38,6 +38,11 @@ def assembledAssumptionsName : Name := `Assumptions /-- The conjunction of all assumption clauses. -/ def assembledAssumptions : Ident := mkIdent assembledAssumptionsName +def simulateCoreSoundName : Name := `simulateCoreSound +def simulateCoreSound : Ident := mkIdent simulateCoreSoundName +def simulateCommandSoundName : Name := `simulateSound +def simulateCommandSound : Ident := mkIdent simulateCommandSoundName + def assembledInvariantsName : Name := `Invariants /-- The conjunction of all `invariant`, `safety`, and `trusted invariant` clauses. -/ From 64f76afcab0529677e0ce95aa0121389d6b6696a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:24:55 +0200 Subject: [PATCH 34/88] fix: persist final progress metrics --- Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean | 6 +++++- Veil/Frontend/DSL/Module/Elaborators.lean | 11 +++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index b3689711..ef6fc399 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -149,7 +149,11 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} onViolation := do Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } sys params th cfg cfg.maxTraces 0 - return { simResult with elapsedMs := (← IO.monoMsNow) - startMs } + let simResult := { simResult with elapsedMs := (← IO.monoMsNow) - startMs } + Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId + "Complete" + simResult.tracesRun cfg.maxTraces simResult.depth + return simResult @[inline, specialize] def simulate {ρ σ κ : Type} {th₀ : ρ} diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 457dfef2..a9bf9bc3 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1145,12 +1145,19 @@ private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder finishWithSimulationResult ctx combinedJson -private def elabSimulateInternalMode (mod : Module) (callExpr : Term) : CommandElabM Unit := do +private def elabSimulateInternalMode (mod : Module) (callExpr : Term) + (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do let resultIdent := mkVeilImplementationDetailIdent `simulateRuntimeResult let jsonExpr ← mkSimulateJsonExpr resultIdent elabVeilCommand (← `(def $(mkIdent `simulateResult) (progressInstanceId : Nat) (cancelToken : IO.CancelToken) : IO Lean.Json := do let $resultIdent ← ($callExpr progressInstanceId cancelToken) + Veil.ModelChecker.Concrete.updateSimulationProgress + progressInstanceId + "Complete" + ($resultIdent).tracesRun + $(quote cfg.maxTraces) + ($resultIdent).depth pure $jsonExpr)) elabVeilCommand (← `(end $(mkIdent mod.name))) elabVeilCommand (← `(export $(mkIdent mod.name) ($(mkIdent `simulateResult)))) @@ -1258,7 +1265,7 @@ def elabSimulate : CommandElab := fun stx => do let simulateCoreSoundIdent := mkVeilImplementationDetailIdent `simulateCoreSound let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent - elabSimulateInternalMode mod runtimeCallExpr + elabSimulateInternalMode mod runtimeCallExpr cfg return let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) let simulateCoreSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateCoreSound)) From f2656c28b5280bc00a313650011efd319dce61d5 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:28:40 +0200 Subject: [PATCH 35/88] fix: encode trace budget termination --- .../Tools/ModelChecker/Simulation/Basic.lean | 1 + .../Tools/ModelChecker/Simulation/Result.lean | 25 +++++++++++++++-- .../ModelChecker/Simulation/Runtime.lean | 8 +++++- widget/src/traceDisplay.tsx | 27 +++++++++++++++++-- 4 files changed, 56 insertions(+), 5 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index 829b85cf..f98cec82 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -11,6 +11,7 @@ deriving Inhabited, Repr structure SimulateResult (ρ σ κ : Type) where result : ModelCheckingResult ρ σ κ Unit tracesRun : Nat + maxTraces : Nat elapsedMs : Nat seed : Nat depth : Nat diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index 049b810c..a29519e6 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -33,6 +33,13 @@ private def terminationReasonToJson (reason : TerminationReason Unit) : Json := ("condition", earlyTerminationReasonToJson condition) ] +private def simulationTerminationReasonToJson (r : SimulateResult ρ σ κ) : Json := + Json.mkObj [ + ("kind", "reached_trace_limit"), + ("traces_run", Lean.toJson r.tracesRun), + ("max_traces", Lean.toJson r.maxTraces) + ] + private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (result : ModelCheckingResult ρ σ κ Unit) : Json := match result with @@ -51,8 +58,14 @@ private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where toJson r := Json.mkObj [ - ("result", resultToJson r.result), + ("result", match r.result with + | .noViolationFound _ _ => Json.mkObj [ + ("result", "no_violation_found"), + ("termination_reason", simulationTerminationReasonToJson r) + ] + | other => resultToJson other), ("traces_run", Lean.toJson r.tracesRun), + ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), ("seed", Lean.toJson r.seed), ("depth", Lean.toJson r.depth) @@ -60,10 +73,17 @@ instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (r : SimulateResult ρ σ κ) : Json := - match resultToJson r.result with + let resultJson := match r.result with + | .noViolationFound _ _ => Json.mkObj [ + ("result", "no_violation_found"), + ("termination_reason", simulationTerminationReasonToJson r) + ] + | other => resultToJson other + match resultJson with | Json.obj kvs => Json.mkObj <| kvs.toList ++ [ ("traces_run", Lean.toJson r.tracesRun), + ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), ("seed", Lean.toJson r.seed), ("depth", Lean.toJson r.depth) @@ -72,6 +92,7 @@ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJs Json.mkObj [ ("result", other), ("traces_run", Lean.toJson r.tracesRun), + ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), ("seed", Lean.toJson r.seed), ("depth", Lean.toJson r.depth) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index ef6fc399..a6d0d22c 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -24,6 +24,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ return { result := .cancelled tracesRun := traceIndex + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := 0 @@ -34,6 +35,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ result := .noViolationFound cfg.maxTraces (.earlyTermination (.reachedDepthBound cfg.maxTraces)) tracesRun := cfg.maxTraces + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := 0 @@ -46,6 +48,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ return { result := result tracesRun := traceIndex + 1 + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := stepsUsed @@ -69,6 +72,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} { result := .cancelled tracesRun := traceIndex + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := 0 @@ -80,6 +84,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} result := .noViolationFound cfg.maxTraces (.earlyTermination (.reachedDepthBound cfg.maxTraces)) tracesRun := cfg.maxTraces + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := 0 @@ -90,6 +95,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} { result := result tracesRun := traceIndex + 1 + maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed depth := stepsUsed @@ -152,7 +158,7 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} let simResult := { simResult with elapsedMs := (← IO.monoMsNow) - startMs } Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId "Complete" - simResult.tracesRun cfg.maxTraces simResult.depth + simResult.tracesRun simResult.maxTraces simResult.depth return simResult @[inline, specialize] diff --git a/widget/src/traceDisplay.tsx b/widget/src/traceDisplay.tsx index 063bb719..762bb140 100644 --- a/widget/src/traceDisplay.tsx +++ b/widget/src/traceDisplay.tsx @@ -45,13 +45,17 @@ interface Violation { } interface EarlyTerminationCondition { - kind: "found_violating_state" | "deadlock_occurred" | "reached_depth_bound"; + kind: "found_violating_state" | "deadlock_occurred" | "reached_depth_bound" | "reached_trace_limit"; depth?: number; + traces_run?: number; + max_traces?: number; } interface TerminationReason { - kind: "explored_all_reachable_states" | "early_termination"; + kind: "explored_all_reachable_states" | "early_termination" | "reached_trace_limit"; condition?: EarlyTerminationCondition; + traces_run?: number; + max_traces?: number; } interface TraceData { @@ -353,6 +357,17 @@ const ResultHeader: React.FC<{ if (reason.kind === "explored_all_reachable_states") { return count !== undefined ? `Explored all reachable states (${count})` : `Explored all reachable states`; } + if (reason.kind === "reached_trace_limit") { + const tracesRun = reason.traces_run; + const maxTraces = reason.max_traces; + if (tracesRun !== undefined && maxTraces !== undefined) { + return `Checked ${tracesRun}/${maxTraces} traces`; + } + if (tracesRun !== undefined) { + return `Checked ${tracesRun} traces`; + } + return `Checked configured trace budget`; + } if (reason.kind === "early_termination" && reason.condition) { switch (reason.condition.kind) { case "found_violating_state": @@ -361,6 +376,14 @@ const ResultHeader: React.FC<{ return `Stopped: deadlock occurred${countSuffix}`; case "reached_depth_bound": return `Reached depth bound ${reason.condition.depth}${countSuffix}`; + case "reached_trace_limit": + if (reason.condition.traces_run !== undefined && reason.condition.max_traces !== undefined) { + return `Checked ${reason.condition.traces_run}/${reason.condition.max_traces} traces`; + } + if (reason.condition.traces_run !== undefined) { + return `Checked ${reason.condition.traces_run} traces`; + } + return `Checked configured trace budget`; default: return `Early termination${countSuffix}`; } From 025d752c48c9532330a832e0670ff8a14418a42a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:29:50 +0200 Subject: [PATCH 36/88] fix: use a single result log path --- Veil/Frontend/DSL/Module/Elaborators.lean | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index a9bf9bc3..7751f84f 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1116,27 +1116,8 @@ private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCal (fun _ => false) $cfgTerm)) -private def logSimulationSummary (stx : Syntax) (combinedJson : Json) : CommandElabM Json := do - let resultJson := combinedJson - let seed := (resultJson.getObjValD "seed").getNat? |>.getD 0 - let tracesRun := (resultJson.getObjValD "traces_run").getNat? |>.getD 0 - let elapsedMs := (resultJson.getObjValD "elapsed_ms").getNat? |>.getD 0 - let depth := (resultJson.getObjValD "depth").getNat? |>.getD 0 - let tracesPerSec := if elapsedMs > 0 then tracesRun * 1000 / elapsedMs else 0 - let isViolation := resultJson.getObjValD "result" == Json.str "found_violation" || - resultJson.getObjValD "error" != .null - let summary := if isViolation then - s!"simulation: found violation at depth {depth} (trace #{tracesRun}, {elapsedMs}ms, seed := {seed}). A shorter violation may exist at depth < {depth}." - else if resultJson.getObjValD "result" == Json.str "cancelled" then - s!"simulation: cancelled after {tracesRun} traces ({elapsedMs}ms, seed := {seed})." - else - s!"simulation: no violation in {tracesRun} traces ({elapsedMs}ms, {tracesPerSec} traces/s, seed := {seed}). Not exhaustive -- use #model_check for full coverage." - logInfoAt stx summary - return resultJson - private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : Json) : CommandElabM Unit := do - let resultJson ← logSimulationSummary ctx.stx combinedJson - elabModelCheck.finishWithResult ctx resultJson + elabModelCheck.finishWithResult ctx combinedJson private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) (sourceFile : String) : CommandElabM Unit := do From 1fde08c93bb35df499179d48c27254bf33b4fdd2 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:33:06 +0200 Subject: [PATCH 37/88] test: cover emitted mode behavior --- VeilTest/Regression/SimulateAssumptions.lean | 19 +++++++++++++++---- VeilTest/Regression/SimulateModes.lean | 11 +++++------ 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/VeilTest/Regression/SimulateAssumptions.lean b/VeilTest/Regression/SimulateAssumptions.lean index 6de30ee3..08b4a903 100644 --- a/VeilTest/Regression/SimulateAssumptions.lean +++ b/VeilTest/Regression/SimulateAssumptions.lean @@ -26,16 +26,27 @@ invariant true #gen_spec -#guard_msgs(drop info, drop warning) in -set_option veil.violationIsError false in +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide -#guard_msgs(drop info, drop warning) in -set_option veil.violationIsError false in +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by decide +#guard_msgs(drop info, drop warning) in +#simulate compiled { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by native_decide + +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in +#simulate { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by native_decide + end SimulateAssumptionsTest diff --git a/VeilTest/Regression/SimulateModes.lean b/VeilTest/Regression/SimulateModes.lean index 0b4e746f..3ac92bd9 100644 --- a/VeilTest/Regression/SimulateModes.lean +++ b/VeilTest/Regression/SimulateModes.lean @@ -14,20 +14,19 @@ action set_flag { flag := true } -invariant [safe_flag] ¬ flag +invariant [safe_flag] true #gen_spec -#guard_msgs(drop info, drop warning) in -set_option veil.violationIsError false in +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in #simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) #guard_msgs(drop info, drop warning) in -set_option veil.violationIsError false in #simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) -#guard_msgs(drop info, drop warning) in -set_option veil.violationIsError false in +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in #simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) end SimulateModes From d81587c0aa10e83b10cdd69ef4da2806b14f09ac Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:33:56 +0200 Subject: [PATCH 38/88] refactor: drop unused path helpers --- .../Tools/ModelChecker/Simulation/Path.lean | 58 ------------------- 1 file changed, 58 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 24f1e611..c74e7184 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -9,14 +9,6 @@ inductive StepDecision (σ κ : Type) where | terminated | continue (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) -private def StepDecision.assertionInfo? : StepDecision σ κ → Option (Int × Step σ κ) - | .assertionFailure exId step => some (exId, step) - | _ => none - -private def StepDecision.continueNexts? : StepDecision σ κ → Option (List (κ × σ)) - | .continue nexts _ => some nexts - | _ => none - private def assertionFailureWitness {σ κ : Type} : κ × ExecutionOutcome Int σ → Option (Int × Step σ κ) | (label, .assertionFailure exId st) => some (exId, { transitionLabel := label, nextState := st }) | _ => none @@ -172,56 +164,6 @@ theorem pickInitialState_mem {σ : Type} (pickInitialState initStates gen h).value ∈ initStates := (pickInitialState initStates gen h).mem -@[inline, specialize] -def scanOnceLoop {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (stepsLeft : Nat) - (currSt : σ) - (gen : StdGen) - [Inhabited (κ × σ)] - : Bool × StdGen × Nat := - match stepsLeft with - | 0 => (false, gen, 0) - | stepsLeft + 1 => - match decideAtState sys params th currSt with - | .assertionFailure _ _ => (true, gen, 1) - | .deadlock => (true, gen, 0) - | .terminated => (false, gen, 0) - | .continue nexts hNonempty => - let picked := pickNextTransition nexts gen hNonempty - let (_, nextSt) := picked.value - let gen := picked.gen - if !(violatedInvariantNames params th nextSt).isEmpty then - (true, gen, 1) - else - let (violated, gen, innerSteps) := scanOnceLoop sys params th stepsLeft nextSt gen - (violated, gen, innerSteps + 1) -termination_by stepsLeft - -@[inline, specialize] -def scanOnce {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (gen : StdGen) - (maxSteps : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] - : Bool × StdGen × Nat := - let initStates := filterInitStatesByConstraints sys params th - match initStates with - | [] => (false, gen, 0) - | hd :: tl => - let picked := pickInitialState (hd :: tl) gen (by simp) - let initSt := picked.value - let gen := picked.gen - if !(violatedInvariantNames params th initSt).isEmpty then - (true, gen, 0) - else - scanOnceLoop sys params th maxSteps initSt gen - @[inline, specialize] def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From dd975539f57db3e0b2e99f164342e435ff316c27 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:35:11 +0200 Subject: [PATCH 39/88] refactor: remove unused simulate names --- Veil/Frontend/DSL/Module/Names.lean | 5 ----- 1 file changed, 5 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Names.lean b/Veil/Frontend/DSL/Module/Names.lean index 89147d54..62b00669 100644 --- a/Veil/Frontend/DSL/Module/Names.lean +++ b/Veil/Frontend/DSL/Module/Names.lean @@ -38,11 +38,6 @@ def assembledAssumptionsName : Name := `Assumptions /-- The conjunction of all assumption clauses. -/ def assembledAssumptions : Ident := mkIdent assembledAssumptionsName -def simulateCoreSoundName : Name := `simulateCoreSound -def simulateCoreSound : Ident := mkIdent simulateCoreSoundName -def simulateCommandSoundName : Name := `simulateSound -def simulateCommandSound : Ident := mkIdent simulateCommandSoundName - def assembledInvariantsName : Name := `Invariants /-- The conjunction of all `invariant`, `safety`, and `trusted invariant` clauses. -/ From d09d7d29d4a2e57de86c0ceecb2cc3428c96b663 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:37:57 +0200 Subject: [PATCH 40/88] chore: remove new proof warnings --- .../Tools/ModelChecker/Simulation/Path.lean | 38 ++++++++++--------- .../ModelChecker/Simulation/Soundness.lean | 8 ++-- 2 files changed, 25 insertions(+), 21 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index c74e7184..14aa1c36 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -41,18 +41,18 @@ theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} | nil => by_cases hTerm : params.terminating.holdsOn th currSt = false · have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h exact False.elim this · have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h exact False.elim this | cons hd tl => have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] using h + simp [decideAtState, outcomes, hFind, hNexts] at h exact False.elim this | some found => rcases found with ⟨foundExId, foundStep⟩ - simp [decideAtState, outcomes, assertionFailureWitness, hFind] at h + simp [decideAtState, outcomes, hFind] at h rcases h with ⟨rfl, rfl⟩ obtain ⟨entry, hEntryMem, hEntryEq⟩ := List.exists_of_findSome?_eq_some hFind rcases entry with ⟨label, outcome⟩ @@ -73,16 +73,18 @@ theorem decideAtState_deadlock_spec {ρ σ κ : Type} {th₀ : ρ} cases hFind : outcomes.findSome? assertionFailureWitness with | some found => have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind] using h + simp [decideAtState, outcomes, hFind] at h exact False.elim this | none => cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with | nil => have hTerm : params.terminating.holdsOn th currSt = false := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] using h - exact ⟨hTerm, by simpa [outcomes] using hNexts⟩ + have h' := h + simp [decideAtState, outcomes, hFind, hNexts] at h' + exact h' + exact ⟨hTerm, rfl⟩ | cons hd tl => - simp [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] at h + simp [decideAtState, outcomes, hFind, hNexts] at h theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -96,23 +98,23 @@ theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} cases hFind : outcomes.findSome? assertionFailureWitness with | some found => have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind] using h + simp [decideAtState, outcomes, hFind] at h exact False.elim this | none => cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with | nil => by_cases hTerm : params.terminating.holdsOn th currSt = false · have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h exact False.elim this · have : False := by - simpa [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts, hTerm] using h + simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h exact False.elim this | cons hd tl => have h' := h - simp [decideAtState, outcomes, assertionFailureWitness, hFind, hNexts] at h' + simp [decideAtState, outcomes, hFind, hNexts] at h' cases h' - simpa [outcomes] using hNexts.symm + rfl theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdGen) : (let p := randNat gen 0 (xs.length - 1); p.1 < xs.length) := by @@ -133,9 +135,10 @@ def pickNextTransition {σ κ : Type} let idx := p.1 let gen' := p.2 have hlt : idx < nexts.length := by - simpa [p, idx] using randNat_lt_length nexts h gen + dsimp [idx, p] + exact randNat_lt_length nexts h gen { value := nexts.get ⟨idx, hlt⟩ - mem := by simpa using List.get_mem nexts ⟨idx, hlt⟩ + mem := by exact List.get_mem nexts ⟨idx, hlt⟩ gen := gen' } theorem pickNextTransition_mem {σ κ : Type} @@ -154,9 +157,10 @@ def pickInitialState {σ : Type} let idx := p.1 let gen' := p.2 have hlt : idx < initStates.length := by - simpa [p, idx] using randNat_lt_length initStates h gen + dsimp [idx, p] + exact randNat_lt_length initStates h gen { value := initStates.get ⟨idx, hlt⟩ - mem := by simpa using List.get_mem initStates ⟨idx, hlt⟩ + mem := by exact List.get_mem initStates ⟨idx, hlt⟩ gen := gen' } theorem pickInitialState_mem {σ : Type} diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 0aabc076..7626a84b 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -328,10 +328,10 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} cases h have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by intro hNil - simpa [hNil] using hViol + simp [hNil] at hViol have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = violatedInvariantNames params th picked.value.2 := by - simpa [hTheory', hLast'] + simp [hTheory', hLast'] exact ⟨Trace.isSimulationValid_complete sys params trace' hValid', hNoFail', hViolEq, hNonempty⟩ theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} @@ -360,8 +360,8 @@ theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} cases h have hNonempty : violatedInvariantNames params th picked.value ≠ [] := by intro hNil - simpa [hNil] using hViol - exact ⟨Trace.isSimulationValid_complete sys params initTrace hValid, hNoFail, by simpa [hLast], hNonempty⟩ + simp [hNil] at hViol + exact ⟨Trace.isSimulationValid_complete sys params initTrace hValid, hNoFail, rfl, hNonempty⟩ theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] From dcf67353b9615343832385b4de2b160b87ced88e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 00:49:04 +0200 Subject: [PATCH 41/88] fix: make trace limits part of core results --- .../Tools/ModelChecker/Concrete/Checker.lean | 2 ++ .../Tools/ModelChecker/Concrete/Core.lean | 2 ++ Veil/Core/Tools/ModelChecker/Interface.lean | 5 +++- .../Tools/ModelChecker/Simulation/Result.lean | 25 +++++-------------- .../ModelChecker/Simulation/Runtime.lean | 4 +-- Veil/Frontend/DSL/Module/Elaborators.lean | 11 ++------ VeilTest/Regression/SimulateResultJson.lean | 17 +++++++++++++ 7 files changed, 35 insertions(+), 31 deletions(-) create mode 100644 VeilTest/Regression/SimulateResultJson.lean diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean b/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean index 2aab2059..3b543c21 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean @@ -111,6 +111,8 @@ def findReachable {ρ σ κ : Type} {m : Type → Type} | some (.earlyTermination (.reachedDepthBound _)) => -- No violation found within depth bound; report number of states explored return ModelCheckingResult.noViolationFound distinctCount (.earlyTermination (.reachedDepthBound ctx.completedDepth)) + | some (.earlyTermination (.reachedTraceLimit maxTraces)) => + return ModelCheckingResult.noViolationFound distinctCount (.earlyTermination (.reachedTraceLimit maxTraces)) | some (.earlyTermination .cancelled) => -- Search was cancelled by the user return ModelCheckingResult.cancelled diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean index 92769266..973d7002 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean @@ -236,6 +236,7 @@ def checkViolationsAndMaybeTerminate let earlyTermination := params.earlyTerminationConditions.findSome? fun | .foundViolatingState => if safetyViolation then some (.foundViolatingState fpSt safetyViolations) else none | .reachedDepthBound bound => if completedDepth >= bound then some (.reachedDepthBound bound) else none + | .reachedTraceLimit _ => none | .deadlockOccurred => if deadlock then some (.deadlockOccurred fpSt) else none | .assertionFailed => assertionFailures.head?.map fun (exId, _) => .assertionFailed fpSt exId | .cancelled => none -- Cancellation is handled externally via cancel token, not through early termination conditions @@ -258,6 +259,7 @@ def BaseSearchContext.processState match x with | .foundViolatingState fp violations => {ctx with finished := some (.earlyTermination (.foundViolatingState fp violations))} | .reachedDepthBound bound => {ctx with finished := some (.earlyTermination (.reachedDepthBound bound))} + | .reachedTraceLimit maxTraces => {ctx with finished := some (.earlyTermination (.reachedTraceLimit maxTraces))} | .deadlockOccurred fp => {ctx with finished := some (.earlyTermination (.deadlockOccurred fp))} | .assertionFailed fp exId => {ctx with finished := some (.earlyTermination (.assertionFailed fp exId))} | .cancelled => {ctx with finished := some (.earlyTermination .cancelled)} diff --git a/Veil/Core/Tools/ModelChecker/Interface.lean b/Veil/Core/Tools/ModelChecker/Interface.lean index 97feef41..d7e3b15d 100644 --- a/Veil/Core/Tools/ModelChecker/Interface.lean +++ b/Veil/Core/Tools/ModelChecker/Interface.lean @@ -40,6 +40,7 @@ inductive EarlyTerminationCondition where | deadlockOccurred | assertionFailed | reachedDepthBound (depth : Nat) + | reachedTraceLimit (maxTraces : Nat) | cancelled deriving Inhabited, Hashable, BEq, Repr @@ -50,13 +51,14 @@ inductive EarlyTerminationReason (σₕ : Type) where | deadlockOccurred (fp : σₕ) | assertionFailed (fp : σₕ) (exceptionId : Int) | reachedDepthBound (depth : Nat) + | reachedTraceLimit (maxTraces : Nat) | cancelled deriving Inhabited, Hashable, BEq, Repr /-- Check if the termination reason represents a violation that should prevent handoff. -/ def EarlyTerminationReason.isViolation {σₕ : Type} : EarlyTerminationReason σₕ → Bool | .foundViolatingState _ _ | .deadlockOccurred _ | .assertionFailed _ _ => true - | .reachedDepthBound _ | .cancelled => false + | .reachedDepthBound _ | .reachedTraceLimit _ | .cancelled => false instance [ToJson σₕ] : ToJson (EarlyTerminationReason σₕ) where toJson @@ -64,6 +66,7 @@ instance [ToJson σₕ] : ToJson (EarlyTerminationReason σₕ) where | .deadlockOccurred fp => Json.mkObj [("kind", "deadlock_occurred"), ("state_fingerprint", toJson fp)] | .assertionFailed fp exId => Json.mkObj [("kind", "assertion_failed"), ("state_fingerprint", toJson fp), ("exception_id", toJson exId)] | .reachedDepthBound depth => Json.mkObj [("kind", "reached_depth_bound"), ("depth", toJson depth)] + | .reachedTraceLimit maxTraces => Json.mkObj [("kind", "reached_trace_limit"), ("max_traces", toJson maxTraces)] | .cancelled => Json.mkObj [("kind", "cancelled")] inductive TerminationReason (σₕ : Type) where diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index a29519e6..e508c5e6 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -23,6 +23,10 @@ private def earlyTerminationReasonToJson (reason : EarlyTerminationReason Unit) ("kind", "reached_depth_bound"), ("depth", toJson depth) ] + | .reachedTraceLimit maxTraces => Json.mkObj [ + ("kind", "reached_trace_limit"), + ("max_traces", toJson maxTraces) + ] | .cancelled => Json.mkObj [("kind", "cancelled")] private def terminationReasonToJson (reason : TerminationReason Unit) : Json := @@ -33,13 +37,6 @@ private def terminationReasonToJson (reason : TerminationReason Unit) : Json := ("condition", earlyTerminationReasonToJson condition) ] -private def simulationTerminationReasonToJson (r : SimulateResult ρ σ κ) : Json := - Json.mkObj [ - ("kind", "reached_trace_limit"), - ("traces_run", Lean.toJson r.tracesRun), - ("max_traces", Lean.toJson r.maxTraces) - ] - private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (result : ModelCheckingResult ρ σ κ Unit) : Json := match result with @@ -58,12 +55,7 @@ private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where toJson r := Json.mkObj [ - ("result", match r.result with - | .noViolationFound _ _ => Json.mkObj [ - ("result", "no_violation_found"), - ("termination_reason", simulationTerminationReasonToJson r) - ] - | other => resultToJson other), + ("result", resultToJson r.result), ("traces_run", Lean.toJson r.tracesRun), ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), @@ -73,12 +65,7 @@ instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (r : SimulateResult ρ σ κ) : Json := - let resultJson := match r.result with - | .noViolationFound _ _ => Json.mkObj [ - ("result", "no_violation_found"), - ("termination_reason", simulationTerminationReasonToJson r) - ] - | other => resultToJson other + let resultJson := resultToJson r.result match resultJson with | Json.obj kvs => Json.mkObj <| kvs.toList ++ [ diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index a6d0d22c..a4f276df 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -33,7 +33,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ | 0 => return { result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + (.earlyTermination (.reachedTraceLimit cfg.maxTraces)) tracesRun := cfg.maxTraces maxTraces := cfg.maxTraces elapsedMs := 0 @@ -82,7 +82,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} | 0 => { result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedDepthBound cfg.maxTraces)) + (.earlyTermination (.reachedTraceLimit cfg.maxTraces)) tracesRun := cfg.maxTraces maxTraces := cfg.maxTraces elapsedMs := 0 diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 7751f84f..359cabca 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1126,19 +1126,12 @@ private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder finishWithSimulationResult ctx combinedJson -private def elabSimulateInternalMode (mod : Module) (callExpr : Term) - (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do +private def elabSimulateInternalMode (mod : Module) (callExpr : Term) : CommandElabM Unit := do let resultIdent := mkVeilImplementationDetailIdent `simulateRuntimeResult let jsonExpr ← mkSimulateJsonExpr resultIdent elabVeilCommand (← `(def $(mkIdent `simulateResult) (progressInstanceId : Nat) (cancelToken : IO.CancelToken) : IO Lean.Json := do let $resultIdent ← ($callExpr progressInstanceId cancelToken) - Veil.ModelChecker.Concrete.updateSimulationProgress - progressInstanceId - "Complete" - ($resultIdent).tracesRun - $(quote cfg.maxTraces) - ($resultIdent).depth pure $jsonExpr)) elabVeilCommand (← `(end $(mkIdent mod.name))) elabVeilCommand (← `(export $(mkIdent mod.name) ($(mkIdent `simulateResult)))) @@ -1246,7 +1239,7 @@ def elabSimulate : CommandElab := fun stx => do let simulateCoreSoundIdent := mkVeilImplementationDetailIdent `simulateCoreSound let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent - elabSimulateInternalMode mod runtimeCallExpr cfg + elabSimulateInternalMode mod runtimeCallExpr return let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) let simulateCoreSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateCoreSound)) diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean new file mode 100644 index 00000000..03dffbc7 --- /dev/null +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -0,0 +1,17 @@ +import Veil + +open Veil.ModelChecker +open Veil.ModelChecker.Simulation + +/-- +info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"explored_states":3,"result":"no_violation_found","termination_reason":{"condition":{"kind":"reached_trace_limit","max_traces":3},"kind":"early_termination"}},"seed":1,"traces_run":3} +-/ +#guard_msgs in +#eval IO.println <| (Lean.toJson ({ + result := ModelCheckingResult.noViolationFound 3 (.earlyTermination (.reachedTraceLimit 3)) + tracesRun := 3 + maxTraces := 3 + elapsedMs := 0 + seed := 1 + depth := 0 +} : SimulateResult Unit Unit Unit)).compress From 41f2602bbf7ed66a80d59050976ba9b28acf420e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 01:00:24 +0200 Subject: [PATCH 42/88] fix: align display trace-limit counts --- VeilTest/Regression/SimulateResultJson.lean | 13 +++++++++++++ widget/src/traceDisplay.tsx | 11 ++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean index 03dffbc7..b1417efc 100644 --- a/VeilTest/Regression/SimulateResultJson.lean +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -15,3 +15,16 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"explored_states":3,"re seed := 1 depth := 0 } : SimulateResult Unit Unit Unit)).compress + +/-- +info: {"depth":0,"elapsed_ms":0,"explored_states":3,"max_traces":3,"result":"no_violation_found","seed":1,"termination_reason":{"condition":{"kind":"reached_trace_limit","max_traces":3},"kind":"early_termination"},"traces_run":3} +-/ +#guard_msgs in +#eval IO.println <| (SimulateResult.toDisplayJson ({ + result := ModelCheckingResult.noViolationFound 3 (.earlyTermination (.reachedTraceLimit 3)) + tracesRun := 3 + maxTraces := 3 + elapsedMs := 0 + seed := 1 + depth := 0 +} : SimulateResult Unit Unit Unit)).compress diff --git a/widget/src/traceDisplay.tsx b/widget/src/traceDisplay.tsx index 762bb140..2f4c3411 100644 --- a/widget/src/traceDisplay.tsx +++ b/widget/src/traceDisplay.tsx @@ -80,6 +80,8 @@ type ModelCheckingResult = result: "no_violation_found"; explored_states: number; termination_reason: TerminationReason; + traces_run?: number; + max_traces?: number; trace?: TraceData | null; } | { @@ -301,7 +303,9 @@ const ResultHeader: React.FC<{ violation?: Violation; exploredStates?: number; terminationReason?: TerminationReason; -}> = ({ resultType, violation, exploredStates, terminationReason }) => { + tracesRun?: number; + maxTraces?: number; +}> = ({ resultType, violation, exploredStates, terminationReason, tracesRun, maxTraces }) => { if (resultType === "cancelled") { return (
@@ -377,6 +381,9 @@ const ResultHeader: React.FC<{ case "reached_depth_bound": return `Reached depth bound ${reason.condition.depth}${countSuffix}`; case "reached_trace_limit": + if (tracesRun !== undefined && maxTraces !== undefined) { + return `Checked ${tracesRun}/${maxTraces} traces`; + } if (reason.condition.traces_run !== undefined && reason.condition.max_traces !== undefined) { return `Checked ${reason.condition.traces_run}/${reason.condition.max_traces} traces`; } @@ -809,6 +816,8 @@ const ModelCheckerView: React.FC = ({ resultType="no_violation_found" exploredStates={result.explored_states} terminationReason={result.termination_reason} + tracesRun={result.traces_run} + maxTraces={result.max_traces} /> ) : ( Date: Wed, 15 Apr 2026 01:45:13 +0200 Subject: [PATCH 43/88] test: add simulate violation mode regression --- .../Regression/SimulateViolationModes.lean | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 VeilTest/Regression/SimulateViolationModes.lean diff --git a/VeilTest/Regression/SimulateViolationModes.lean b/VeilTest/Regression/SimulateViolationModes.lean new file mode 100644 index 00000000..76cbba4f --- /dev/null +++ b/VeilTest/Regression/SimulateViolationModes.lean @@ -0,0 +1,45 @@ +import Veil + +veil module SimulateViolationModes + +individual flag : Bool + +#gen_state + +after_init { + flag := false +} + +action set_flag { + flag := true +} + +invariant [safe_flag] ¬ flag + +#gen_spec + +/-- +error: ❌ Violation: safety_failure (violates: safe_flag) + State 0 (via init): + flag = false + State 1 (via set_flag): + flag = true +-/ +#guard_msgs in +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +#guard_msgs(drop info, drop warning) in +set_option veil.violationIsError false in +#simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +/-- +error: ❌ Violation: safety_failure (violates: safe_flag) + State 0 (via init): + flag = false + State 1 (via set_flag): + flag = true +-/ +#guard_msgs in +#simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateViolationModes From 797f9f6298022096685db91e228502f14574b43e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 02:21:53 +0200 Subject: [PATCH 44/88] fix(model-checker): isolate compiled command instances --- Veil/Frontend/DSL/Module/Elaborators.lean | 64 ++++++++++++------ .../DSL/Module/Util/ForModelChecker.lean | 67 ++++++++++++------- .../Regression/CompilationRegistryKey.lean | 33 +++++++++ 3 files changed, 120 insertions(+), 44 deletions(-) create mode 100644 VeilTest/Regression/CompilationRegistryKey.lean diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 359cabca..c8dd764b 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -639,6 +639,12 @@ private def buildSearchParameters (mod : Module) (config : ModelCheckerConfig) : $(mkIdent `stateConstraints):ident := $constraintList, $(mkIdent `earlyTerminationConditions):ident := $earlyTermConds }) +/-- Stable identity for a single compiled command invocation within a file. -/ +private def getCompiledCommandId (cmdName : String) (stx : Syntax) : CommandElabM String := do + let some startPos := stx.getPos? | throwError s!"Unexpected error: {cmdName} has no position" + let some endPos := stx.getTailPos? | throwError s!"Unexpected error: {cmdName} has no end position" + pure s!"{startPos.1}-{endPos.1}" + @[command_elab Veil.modelCheck] def elabModelCheck : CommandElab := fun stx => do -- Use dynamic trace class name for detailed profiling @@ -833,25 +839,37 @@ where logModelCheckResult ctx.stx json ModelChecker.Concrete.finishProgress ctx.instanceId json + modelCheckerCommandSpec : ModelChecker.Compilation.CompiledCommandSpec := { + exportedName := "modelCheckerResult" + supportsParallelConfig := true + } + + simulateCommandSpec : ModelChecker.Compilation.CompiledCommandSpec := { + exportedName := "simulateResult" + } + /-- Run the compiled binary and log the result. -/ runBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) - (sourceFile : String) : CommandElabM Unit := do + (sourceFile : String) (command : ModelChecker.Compilation.CompiledCommandSpec) + (commandId : String) : CommandElabM Unit := do let some binPath ← verifyBinaryExists buildFolder ctx.instanceId | return let args := ctx.parallelCfg.map (fun p => #[s!"{p.numSubTasks}", s!"{p.thresholdToParallel}"]) |>.getD #[] let some json ← runBinaryForJson binPath args ctx.instanceId ctx.cancelToken | return ModelChecker.Concrete.finishProgress ctx.instanceId (enrichJsonWithAssertions json ctx.assertionSources) - ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + ModelChecker.Compilation.markRegistryFinished sourceFile command commandId buildFolder let some resultJson ← ModelChecker.Concrete.getResultJson ctx.instanceId | return logModelCheckResult ctx.stx resultJson /-- Compile the model. Returns the build folder path if compilation succeeded, none otherwise. -/ compileModel (mod : Module) (sourceFile : String) (modelSource : String) - (instanceId : Nat) (cancelToken : IO.CancelToken) + (commandId : String) (instanceId : Nat) (cancelToken : IO.CancelToken) (command : ModelChecker.Compilation.CompiledCommandSpec) : IO (Option System.FilePath) := do - let buildFolder ← ModelChecker.Compilation.createBuildFolder sourceFile modelSource mod.name.toString command - ModelChecker.Compilation.markRegistryInProgress sourceFile instanceId buildFolder + let buildFolder ← ModelChecker.Compilation.createBuildFolder sourceFile modelSource mod.name.toString command commandId + ModelChecker.Compilation.markRegistryInProgress sourceFile command commandId instanceId buildFolder let result ← ModelChecker.Compilation.runProcessWithStatusCallback sourceFile + command + commandId { cmd := "lake", args := #["build", "ModelCheckerMain"], cwd := buildFolder } instanceId "Compiling model" cancelToken (fun elapsedMs => ModelChecker.Concrete.updateCompilationElapsed instanceId elapsedMs) @@ -923,14 +941,15 @@ where -- dbg_trace "elabModelCheckCompiledMode" let ctx ← allocModelCheckContext mod stx parallelCfg let sourceFile ← getFileName + let commandId ← getCompiledCommandId "#model_check" stx let modelSource ← generateModelSource mod stx let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId ctx.cancelToken - { exportedName := "modelCheckerResult", supportsParallelConfig := true } | return + let some buildFolder ← compileModel mod sourceFile modelSource commandId ctx.instanceId ctx.cancelToken + modelCheckerCommandSpec | return if ← checkCancelled ctx.cancelToken ctx.instanceId then return - runBinaryAndLogResult ctx buildFolder sourceFile + runBinaryAndLogResult ctx buildFolder sourceFile modelCheckerCommandSpec commandId catch e : Exception => handleModelCheckError ctx e ) ctx.cancelToken @@ -945,6 +964,7 @@ where -- dbg_trace "elabModelCheckWithHandoff" let ctx ← allocModelCheckContext mod stx parallelCfg let sourceFile ← getFileName + let commandId ← getCompiledCommandId "#model_check" stx let modelSource ← generateModelSource mod stx let ioComputation ← elaborateInterpretedComputation ctx.instanceId callExpr parallelCfg @@ -966,11 +986,11 @@ where let compilationCancelTk ← IO.CancelToken.new let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← compileModel mod sourceFile modelSource ctx.instanceId compilationCancelTk - { exportedName := "modelCheckerResult", supportsParallelConfig := true } | return + let some buildFolder ← compileModel mod sourceFile modelSource commandId ctx.instanceId compilationCancelTk + modelCheckerCommandSpec | return -- Skip handoff if violation found or interpreted finished if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) then - ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + ModelChecker.Compilation.markRegistryFinished sourceFile modelCheckerCommandSpec commandId buildFolder return -- Handoff to compiled binary ModelChecker.Concrete.requestHandoff ctx.instanceId @@ -978,7 +998,7 @@ where let _ ← IO.wait interpretedTask let some newCancelToken ← ModelChecker.Concrete.resetProgressForHandoff ctx.instanceId | return let ctxWithNewToken := { ctx with cancelToken := newCancelToken } - runBinaryAndLogResult ctxWithNewToken buildFolder sourceFile + runBinaryAndLogResult ctxWithNewToken buildFolder sourceFile modelCheckerCommandSpec commandId catch e : Exception => ModelChecker.Concrete.updateCompilationStatus ctx.instanceId (.failed s!"{← e.toMessageData.toString}") ) compilationCancelTk @@ -1120,10 +1140,10 @@ private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : elabModelCheck.finishWithResult ctx combinedJson private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) - (sourceFile : String) : CommandElabM Unit := do + (sourceFile : String) (commandId : String) : CommandElabM Unit := do let some binPath ← elabModelCheck.verifyBinaryExists buildFolder ctx.instanceId | return let some combinedJson ← elabModelCheck.runBinaryForJson binPath #[] ctx.instanceId ctx.cancelToken | return - ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder finishWithSimulationResult ctx combinedJson private def elabSimulateInternalMode (mod : Module) (callExpr : Term) : CommandElabM Unit := do @@ -1155,13 +1175,14 @@ private def elabSimulateCompiledMode (mod : Module) (stx : Syntax) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do let ctx ← elabModelCheck.allocModelCheckContext mod stx none let sourceFile ← getFileName + let commandId ← getCompiledCommandId "#simulate" stx let modelSource ← generateSimulateModelSource mod stx cfg let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource ctx.instanceId ctx.cancelToken - { exportedName := "simulateResult", supportsParallelConfig := false } | return + let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource commandId ctx.instanceId ctx.cancelToken + elabModelCheck.simulateCommandSpec | return if ← elabModelCheck.checkCancelled ctx.cancelToken ctx.instanceId then return - runSimulateBinaryAndLogResult ctx buildFolder sourceFile + runSimulateBinaryAndLogResult ctx buildFolder sourceFile commandId catch e : Exception => elabModelCheck.handleModelCheckError ctx e ) ctx.cancelToken @@ -1173,6 +1194,7 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Unit := do let ctx ← elabModelCheck.allocModelCheckContext mod stx none let sourceFile ← getFileName + let commandId ← getCompiledCommandId "#simulate" stx let modelSource ← generateSimulateModelSource mod stx cfg let ioComputation ← elaborateSimulateComputation ctx.instanceId callExpr let compilationCancelTk ← IO.CancelToken.new @@ -1192,17 +1214,17 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te Command.logSnapshotTask { stx? := none, cancelTk? := ctx.cancelToken, task := interpretedTask } let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try - let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource ctx.instanceId compilationCancelTk - { exportedName := "simulateResult", supportsParallelConfig := false } | return + let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource commandId ctx.instanceId compilationCancelTk + elabModelCheck.simulateCommandSpec | return if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) then - ModelChecker.Compilation.markRegistryFinished sourceFile buildFolder + ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder return ModelChecker.Concrete.requestHandoff ctx.instanceId ctx.cancelToken.set let _ ← IO.wait interpretedTask let some newCancelToken ← ModelChecker.Concrete.resetProgressForHandoff ctx.instanceId | return let ctxWithNewToken := { ctx with cancelToken := newCancelToken } - runSimulateBinaryAndLogResult ctxWithNewToken buildFolder sourceFile + runSimulateBinaryAndLogResult ctxWithNewToken buildFolder sourceFile commandId catch e : Exception => ModelChecker.Concrete.updateCompilationStatus ctx.instanceId (.failed s!"{← e.toMessageData.toString}") ) compilationCancelTk diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index 43562cb7..6b6ad531 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -19,17 +19,36 @@ inductive Status | finished (buildDir : System.FilePath) deriving Inhabited -/-- Global state tracking compilation status for multiple models. -Keyed by the source file path (absolute path). -Uses `Std.Mutex` to prevent race conditions when multiple tasks access the registry. -/ -initialize compilationRegistry : Std.Mutex (Std.HashMap String Status) ← +structure CompiledCommandSpec where + exportedName : String + supportsParallelConfig : Bool := false + +structure CompilationKey where + sourceFile : String + exportedName : String + commandId : String + deriving BEq, Hashable, Inhabited + +/-- Global state tracking compilation status for multiple compiled commands. + Keyed by source file path, exported command name, and command identity so + different command invocations in the same file do not supersede each other. + Uses `Std.Mutex` to prevent race conditions when multiple tasks access the registry. -/ +initialize compilationRegistry : Std.Mutex (Std.HashMap CompilationKey Status) ← Std.Mutex.new {} @[inline] -def stillCurrentCont (sourceFile : String) (instanceId : Nat) (k : Std.AtomicT (Std.HashMap String Status) IO Unit) : IO Bool := +def mkCompilationKey (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) : CompilationKey := { + sourceFile, + exportedName := command.exportedName, + commandId, +} + +@[inline] +def stillCurrentCont (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) (instanceId : Nat) + (k : Std.AtomicT (Std.HashMap CompilationKey Status) IO Unit) : IO Bool := compilationRegistry.atomically fun ref => do let registry ← ref.get - match registry[sourceFile]? with + match registry[mkCompilationKey sourceFile command commandId]? with | some info => match info with | .inProgress id _ => if id == instanceId then k ref ; pure true else pure false @@ -37,29 +56,29 @@ def stillCurrentCont (sourceFile : String) (instanceId : Nat) (k : Std.AtomicT ( | none => pure false /-- Mark compilation as finished in the registry. -/ -def markRegistryFinished (sourceFile : String) (buildFolder : System.FilePath) : IO Unit := +def markRegistryFinished (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) + (buildFolder : System.FilePath) : IO Unit := compilationRegistry.atomically fun ref => - ref.modify fun registry => registry.insert sourceFile (.finished buildFolder) + ref.modify fun registry => + registry.insert (mkCompilationKey sourceFile command commandId) (.finished buildFolder) /-- Mark compilation as in progress in the registry. -/ -def markRegistryInProgress (sourceFile : String) (instanceId : Nat) (buildFolder : System.FilePath) : IO Unit := +def markRegistryInProgress (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) + (instanceId : Nat) (buildFolder : System.FilePath) : IO Unit := compilationRegistry.atomically fun ref => - ref.modify fun registry => registry.insert sourceFile (.inProgress instanceId buildFolder) + ref.modify fun registry => + registry.insert (mkCompilationKey sourceFile command commandId) (.inProgress instanceId buildFolder) /-- Base directory for model checker build folders. This is an absolute path. -/ def getBuildBaseDir : IO System.FilePath := do let pwd ← IO.currentDir return pwd / ".lake" / "model_checker_builds" -structure CompiledCommandSpec where - exportedName : String - supportsParallelConfig : Bool := false - /-- Generate a build folder name based on the source file and exported command, -so distinct compiled commands do not race on the same temp project. -/ -def generateBuildFolderName (sourceFile : String) (command : CompiledCommandSpec) : IO System.FilePath := do +so distinct compiled command invocations do not race on the same temp project. -/ +def generateBuildFolderName (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) : IO System.FilePath := do let stem := System.FilePath.mk sourceFile |>.fileStem.getD "unrecognized_model" - let suffix := toString (hash (sourceFile ++ ":" ++ command.exportedName)) + let suffix := toString (hash (sourceFile ++ ":" ++ command.exportedName ++ ":" ++ commandId)) let baseDir ← getBuildBaseDir return baseDir / s!"{stem}_{command.exportedName}_{suffix}" @@ -145,9 +164,9 @@ def main (args : List String) : IO Unit := do /-- Create the temp build folder with all necessary files. Returns the absolute path to the build folder. -/ def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespace : String) - (command : CompiledCommandSpec) : IO System.FilePath := do + (command : CompiledCommandSpec) (commandId : String) : IO System.FilePath := do let veilPath ← IO.currentDir - let buildFolder ← generateBuildFolderName sourceFile command + let buildFolder ← generateBuildFolderName sourceFile command commandId -- Recreate the build folder from scratch to avoid stale Lake state from prior runs. if ← buildFolder.pathExists then IO.FS.removeDirAll buildFolder @@ -181,7 +200,8 @@ structure ProcessResult where /-- Run a process with status updates, checking if compilation is still current or cancelled. Returns the exit code, stdout, stderr, and whether it was interrupted. -/ -def runProcessWithStatus (sourceFile : String) (cfg : IO.Process.SpawnArgs) +def runProcessWithStatus (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) + (cfg : IO.Process.SpawnArgs) (instanceId : Nat) (statusPrefix : String) (cancelToken : IO.CancelToken) : IO ProcessResult := do let proc ← IO.Process.spawn { cfg with stdin := .piped, stdout := .piped, stderr := .piped } -- Start reading stdout/stderr in background tasks to avoid blocking @@ -196,7 +216,7 @@ def runProcessWithStatus (sourceFile : String) (cfg : IO.Process.SpawnArgs) interrupted := true break -- Check if this compilation is still current (not superseded) - let current? ← stillCurrentCont sourceFile instanceId do + let current? ← stillCurrentCont sourceFile command commandId instanceId do updateElapsedTimeStatus instanceId statusPrefix unless current? do proc.kill @@ -211,7 +231,8 @@ def runProcessWithStatus (sourceFile : String) (cfg : IO.Process.SpawnArgs) /-- Run a process with callbacks for status updates and line-by-line output capture, checking both explicit cancellation and whether this compilation is still current. -/ -def runProcessWithStatusCallback (sourceFile : String) (cfg : IO.Process.SpawnArgs) +def runProcessWithStatusCallback (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) + (cfg : IO.Process.SpawnArgs) (instanceId : Nat) (_statusPrefix : String) (cancelToken : IO.CancelToken) (statusCallback : Nat → IO Unit) (lineCallback : String → Bool → Nat → IO Unit := fun _ _ _ => pure ()) @@ -236,7 +257,7 @@ def runProcessWithStatusCallback (sourceFile : String) (cfg : IO.Process.SpawnAr proc.kill interrupted := true break - let current? ← stillCurrentCont sourceFile instanceId do + let current? ← stillCurrentCont sourceFile command commandId instanceId do statusCallback ((← IO.monoMsNow) - startTime) unless current? do proc.kill diff --git a/VeilTest/Regression/CompilationRegistryKey.lean b/VeilTest/Regression/CompilationRegistryKey.lean new file mode 100644 index 00000000..51733c5e --- /dev/null +++ b/VeilTest/Regression/CompilationRegistryKey.lean @@ -0,0 +1,33 @@ +import Veil + +open Veil.ModelChecker.Compilation + +#eval do + let sourceFile := "/tmp/compilation-registry-key.lean" + let modelCheckCommand : CompiledCommandSpec := { + exportedName := "modelCheckerResult" + supportsParallelConfig := true + } + let simulateCommand : CompiledCommandSpec := { + exportedName := "simulateResult" + } + let modelCheckBuildDirA := System.FilePath.mk "build/model-check-a" + let modelCheckBuildDirB := System.FilePath.mk "build/model-check-b" + let simulateBuildDirA := System.FilePath.mk "build/simulate-a" + let simulateBuildDirB := System.FilePath.mk "build/simulate-b" + let simulateBuildDirC := System.FilePath.mk "build/simulate-c" + markRegistryInProgress sourceFile modelCheckCommand "model-check-a" 1 modelCheckBuildDirA + markRegistryInProgress sourceFile modelCheckCommand "model-check-b" 2 modelCheckBuildDirB + markRegistryInProgress sourceFile simulateCommand "simulate-a" 3 simulateBuildDirA + markRegistryInProgress sourceFile simulateCommand "simulate-b" 4 simulateBuildDirB + markRegistryInProgress sourceFile simulateCommand "simulate-c" 5 simulateBuildDirC + assert! (← stillCurrentCont sourceFile modelCheckCommand "model-check-a" 1 (pure ())) + assert! (← stillCurrentCont sourceFile modelCheckCommand "model-check-b" 2 (pure ())) + assert! (← stillCurrentCont sourceFile simulateCommand "simulate-a" 3 (pure ())) + assert! (← stillCurrentCont sourceFile simulateCommand "simulate-b" 4 (pure ())) + assert! (← stillCurrentCont sourceFile simulateCommand "simulate-c" 5 (pure ())) + markRegistryFinished sourceFile modelCheckCommand "model-check-a" modelCheckBuildDirA + markRegistryFinished sourceFile modelCheckCommand "model-check-b" modelCheckBuildDirB + markRegistryFinished sourceFile simulateCommand "simulate-a" simulateBuildDirA + markRegistryFinished sourceFile simulateCommand "simulate-b" simulateBuildDirB + markRegistryFinished sourceFile simulateCommand "simulate-c" simulateBuildDirC From 7140a1502f483af96df809e699c295203e1cf279 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 02:23:23 +0200 Subject: [PATCH 45/88] fix(simulate): keep default compilation running --- Veil/Frontend/DSL/Module/Elaborators.lean | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index c8dd764b..02b9565a 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1203,9 +1203,7 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te let combinedJson ← IO.ofExcept (← ioComputation.toIO') match (← ctx.cancelToken.isSet, ← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) with | (true, false) => ModelChecker.Concrete.cancelProgress ctx.instanceId - | (false, _) => - compilationCancelTk.set - finishWithSimulationResult ctx combinedJson + | (false, _) => finishWithSimulationResult ctx combinedJson | (true, true) => pure () catch e : Exception => elabModelCheck.handleModelCheckError ctx e From c27a938a73824378b01b24941ed5267963a64220 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 05:58:30 +0200 Subject: [PATCH 46/88] fix(simulate): tighten handoff cancellation and parity --- .../Tools/ModelChecker/Concrete/Progress.lean | 13 ++- .../Tools/ModelChecker/Simulation/Path.lean | 13 +-- .../ModelChecker/Simulation/Runtime.lean | 21 +--- Veil/Frontend/DSL/Module/Elaborators.lean | 106 +++++------------- .../Regression/SimulateAssertionFailure.lean | 38 +++++++ VeilTest/Regression/SimulateAssumptions.lean | 51 +++++++++ VeilTest/Regression/SimulateEmptySpec.lean | 21 ++++ 7 files changed, 158 insertions(+), 105 deletions(-) create mode 100644 VeilTest/Regression/SimulateAssertionFailure.lean create mode 100644 VeilTest/Regression/SimulateEmptySpec.lean diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index f0dd4efe..1e052a8c 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -98,6 +98,8 @@ structure ProgressRefs where resultRef : IO.Ref (Option Lean.Json) /-- Cancellation token for this instance. -/ cancelToken : IO.CancelToken + /-- Cancellation token for background compilation, when default handoff is active. -/ + compilationCancelTokenRef : IO.Ref (Option IO.CancelToken) /-- Set by compilation task to signal interpreted mode to stop for handoff. -/ handoffRequested : IO.Ref Bool /-- Set by interpreted mode when a violation is found (prevents handoff). -/ @@ -133,6 +135,7 @@ def allocProgressInstance (allActionLabels : List String := []) : IO (Nat × IO. progressRef := ← IO.mkRef { startTimeMs := ← IO.monoMsNow, status := "Running...", isRunning := true, allActionLabels } resultRef := ← IO.mkRef none cancelToken := cancelTk + compilationCancelTokenRef := ← IO.mkRef none handoffRequested := ← IO.mkRef false violationFound := ← IO.mkRef false } @@ -234,7 +237,15 @@ def isCancelled (instanceId : Nat) : IO Bool := do | none => return false /-- Request cancellation for an instance. -/ -def requestCancellation (instanceId : Nat) : IO Unit := withRefs instanceId (·.cancelToken.set) +def requestCancellation (instanceId : Nat) : IO Unit := withRefs instanceId fun refs => do + refs.cancelToken.set + let compilationCancelToken? ← refs.compilationCancelTokenRef.get + if let some compilationCancelToken := compilationCancelToken? then + compilationCancelToken.set + +/-- Register or clear the background compilation cancellation token for an instance. -/ +def setCompilationCancelToken (instanceId : Nat) (cancelToken? : Option IO.CancelToken) : IO Unit := + withRefs instanceId fun refs => refs.compilationCancelTokenRef.set cancelToken? /-- Mark progress as cancelled for a given instance ID. -/ def cancelProgress (instanceId : Nat) : IO Unit := withRefs instanceId fun refs => do diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 14aa1c36..08d03d72 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -130,7 +130,7 @@ structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where gen : StdGen def pickNextTransition {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) [Inhabited (κ × σ)] : PickedTransition nexts := + (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) : PickedTransition nexts := let p := randNat gen 0 (nexts.length - 1) let idx := p.1 let gen' := p.2 @@ -142,7 +142,7 @@ def pickNextTransition {σ κ : Type} gen := gen' } theorem pickNextTransition_mem {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) [Inhabited (κ × σ)] : + (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) : (pickNextTransition nexts gen h).value ∈ nexts := (pickNextTransition nexts gen h).mem @@ -152,7 +152,7 @@ structure PickedInitState {σ : Type} (initStates : List σ) where gen : StdGen def pickInitialState {σ : Type} - (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) [Inhabited σ] : PickedInitState initStates := + (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) : PickedInitState initStates := let p := randNat gen 0 (initStates.length - 1) let idx := p.1 let gen' := p.2 @@ -164,7 +164,7 @@ def pickInitialState {σ : Type} gen := gen' } theorem pickInitialState_mem {σ : Type} - (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) [Inhabited σ] : + (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) : (pickInitialState initStates gen h).value ∈ initStates := (pickInitialState initStates gen h).mem @@ -177,7 +177,6 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (currSt : σ) (trace : Trace ρ σ κ) (gen : StdGen) - [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := match stepsLeft with | 0 => (none, gen, 0) @@ -209,8 +208,6 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (gen : StdGen) (maxSteps : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := let initStates := filterInitStatesByConstraints sys params th match initStates with @@ -232,8 +229,6 @@ def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) (traceIndex : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] : Option (ModelCheckingResult ρ σ κ Unit × Nat) := let traceSeed := cfg.seed + traceIndex let (maybeResult, _, depth) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index a4f276df..54845120 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -17,8 +17,6 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ (cfg : SimulateConfig) (remaining : Nat) (traceIndex : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] : m (SimulateResult ρ σ κ) := do if ← hooks.shouldStop traceIndex then return { @@ -65,8 +63,6 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} (cfg : SimulateConfig) (remaining : Nat) (traceIndex : Nat) - [Inhabited σ] - [Inhabited (κ × σ)] : SimulateResult ρ σ κ := if shouldStop traceIndex then { @@ -111,8 +107,6 @@ def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (shouldStop : Nat → Bool) (cfg : SimulateConfig) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] : SimulateResult ρ σ κ := simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 @@ -122,8 +116,6 @@ def simulateCore {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (cfg : SimulateConfig) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] : SimulateResult ρ σ κ := simulateCommandSemantics sys params th (fun _ => false) cfg @@ -135,8 +127,6 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} (cfg : SimulateConfig) (progressInstanceId : Nat) (cancelToken : IO.CancelToken) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] : IO (SimulateResult ρ σ κ) := do let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed let cfg := { cfg with seed := actualSeed } @@ -156,9 +146,12 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} Veil.ModelChecker.Concrete.setViolationFound progressInstanceId } sys params th cfg cfg.maxTraces 0 let simResult := { simResult with elapsedMs := (← IO.monoMsNow) - startMs } - Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId - "Complete" - simResult.tracesRun simResult.maxTraces simResult.depth + match simResult.result with + | .cancelled => pure () + | _ => + Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId + "Complete" + simResult.tracesRun simResult.maxTraces simResult.depth return simResult @[inline, specialize] @@ -167,8 +160,6 @@ def simulate {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (cfg : SimulateConfig) - [inhabσ : Inhabited σ] - [inhabκσ : Inhabited (κ × σ)] : IO (SimulateResult ρ σ κ) := do let cancelToken ← IO.CancelToken.new simulateWithProgress sys params th cfg 0 cancelToken diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 02b9565a..e5b86b81 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1007,22 +1007,6 @@ where ModelChecker.displayStreamingProgress stx ctx.instanceId -/-- Build the pure simulator core call syntax. -/ -private def mkSimulatorCall (mod : Module) (instTerm theoryTerm : Term) - (sp : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Term := do - let inst := mkVeilImplementationDetailIdent `inst - let th := mkVeilImplementationDetailIdent `th - let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) - let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) - $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) - `((let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.simulateCore) - ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) - ($(mkIdent `inhabκσ) := by infer_instance) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp $th $cfgTerm)) - /-- Build the progress-aware simulator runtime call syntax. -/ private def mkSimulatorRuntimeCall (mod : Module) (instTerm theoryTerm : Term) (sp : Term) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM Term := do @@ -1034,8 +1018,6 @@ private def mkSimulatorRuntimeCall (mod : Module) (instTerm theoryTerm : Term) `((let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Simulation.simulateWithProgress) - ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) - ($(mkIdent `inhabκσ) := by infer_instance) ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) $sp $th $cfgTerm : _ → _ → IO _)) @@ -1073,13 +1055,6 @@ private def generateSimulateModelSource (mod : Module) (stx : Syntax) let cmd := s!"#simulate {instSrc}{theorySrc} (maxTraces := {cfg.maxTraces}) (maxSteps := {cfg.maxSteps}) (seed := {cfg.seed})" return srcPrefix ++ cmd ++ "\n" -private def evaluateSimulateJson (resultIdent : Ident) : CommandElabM Lean.Json := do - let jsonExpr ← mkSimulateJsonExpr resultIdent - liftTermElabM do - let expr ← Term.elabTerm jsonExpr none - Term.synthesizeSyntheticMVarsNoPostponing - unsafe Meta.evalExpr Lean.Json (mkConst ``Lean.Json) (← instantiateMVars expr) - private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : CommandElabM (IO Lean.Json) := do let resultIdent := mkVeilImplementationDetailIdent `simulateRuntimeResult let jsonExpr ← mkSimulateJsonExpr resultIdent @@ -1092,52 +1067,16 @@ private def elaborateSimulateComputation (instanceId : Nat) (callExpr : Term) : Term.synthesizeSyntheticMVarsNoPostponing unsafe Meta.evalExpr (IO Lean.Json) (mkApp (mkConst ``IO) (mkConst ``Lean.Json)) (← instantiateMVars expr) -private def emitSimulateArtifacts (mod : Module) (instTerm theoryTerm sp pureCallExpr : Term) - (cfg : ModelChecker.Simulation.SimulateConfig) - (resultIdent coreSoundIdent commandSoundIdent : Ident) : CommandElabM Unit := do - elabVeilCommand (← `(def $resultIdent := $pureCallExpr)) - let inst := mkVeilImplementationDetailIdent `inst - let th := mkVeilImplementationDetailIdent `th - let ρArg := mkIdent `ρ - let instSortArgs ← (← mod.uninterpretedParamIdents).mapM fun paramIdent => `($inst.$(paramIdent)) - let theoryT ← `($theoryIdent $instSortArgs*) - let cfgTerm ← `($(mkIdent ``Veil.ModelChecker.Simulation.SimulateConfig.mk) - $(quote cfg.maxTraces) $(quote cfg.maxSteps) $(quote cfg.seed)) - elabVeilCommand (← `(theorem $coreSoundIdent : - (let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.ResultSound) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by - let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCommandSemantics_sound) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - $th - (fun _ => false) - $cfgTerm)) - elabVeilCommand (← `(theorem $commandSoundIdent : - (let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - $(mkIdent ``Veil.ModelChecker.Simulation.ResultSoundUnder) - (fun $ρArg : $theoryT => $assembledAssumptions ($ρArg := $theoryT) $instSortArgs* $ρArg) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp $th - ($(mkIdent ``Veil.ModelChecker.Simulation.SimulateResult.result) $resultIdent)) := by - let $inst : $instantiationType := $instTerm - let $th : $theoryIdent $instSortArgs* := $theoryTerm - exact fun _ => by - simpa [$resultIdent:ident] using $(mkIdent ``Veil.ModelChecker.Simulation.simulateCommandSemantics_sound) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) - $sp - $th - (fun _ => false) - $cfgTerm)) +private def simulationResultWasCancelled (combinedJson : Json) : Bool := + match combinedJson.getObjValAs? String "result" |>.toOption with + | some "cancelled" => true + | _ => false private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : Json) : CommandElabM Unit := do - elabModelCheck.finishWithResult ctx combinedJson + if simulationResultWasCancelled combinedJson then + liftIO <| ModelChecker.Concrete.cancelProgress ctx.instanceId + else + elabModelCheck.finishWithResult ctx combinedJson private def runSimulateBinaryAndLogResult (ctx : ModelCheckContext) (buildFolder : System.FilePath) (sourceFile : String) (commandId : String) : CommandElabM Unit := do @@ -1198,6 +1137,7 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te let modelSource ← generateSimulateModelSource mod stx cfg let ioComputation ← elaborateSimulateComputation ctx.instanceId callExpr let compilationCancelTk ← IO.CancelToken.new + liftIO <| ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId (some compilationCancelTk) let interpretedComputation ← Command.wrapAsyncAsSnapshot (fun () => do try let combinedJson ← IO.ofExcept (← ioComputation.toIO') @@ -1213,17 +1153,32 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te let compilationComputation ← Command.wrapAsyncAsSnapshot (fun () => do try let some buildFolder ← elabModelCheck.compileModel mod sourceFile modelSource commandId ctx.instanceId compilationCancelTk - elabModelCheck.simulateCommandSpec | return - if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) then + elabModelCheck.simulateCommandSpec | do + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + return + if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) || + (← ModelChecker.Concrete.isCancelled ctx.instanceId) then ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none return ModelChecker.Concrete.requestHandoff ctx.instanceId ctx.cancelToken.set let _ ← IO.wait interpretedTask + if (← ctx.cancelToken.isSet) && !(← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) then + ModelChecker.Concrete.cancelProgress ctx.instanceId + ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + return + if (← ModelChecker.Concrete.getResultJson ctx.instanceId).isSome || (← ModelChecker.Concrete.isCancelled ctx.instanceId) then + ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + return let some newCancelToken ← ModelChecker.Concrete.resetProgressForHandoff ctx.instanceId | return + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none let ctxWithNewToken := { ctx with cancelToken := newCancelToken } runSimulateBinaryAndLogResult ctxWithNewToken buildFolder sourceFile commandId catch e : Exception => + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none ModelChecker.Concrete.updateCompilationStatus ctx.instanceId (.failed s!"{← e.toMessageData.toString}") ) compilationCancelTk let compilationTask ← BaseIO.asTask (compilationComputation ()) (prio := .dedicated) @@ -1252,19 +1207,10 @@ def elabSimulate : CommandElab := fun stx => do if assumptionsHoldBy.isSome && !(← isModelCheckCompileMode) && !mod.assumptions.isEmpty then elabModelCheck.checkTheorySatisfiesAssumptions mod instTerm theoryTerm assumptionsHoldBy let sp ← buildSearchParameters mod mcCfg - let pureCallExpr ← mkSimulatorCall mod instTerm theoryTerm sp cfg let runtimeCallExpr ← mkSimulatorRuntimeCall mod instTerm theoryTerm sp cfg if ← isModelCheckCompileMode then - let simulateResultIdent := mkVeilImplementationDetailIdent `simulateResultValue - let simulateCoreSoundIdent := mkVeilImplementationDetailIdent `simulateCoreSound - let simulateSoundIdent := mkVeilImplementationDetailIdent `simulateSound - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent elabSimulateInternalMode mod runtimeCallExpr return - let simulateResultIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateResult)) - let simulateCoreSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateCoreSound)) - let simulateSoundIdent ← Lean.mkIdent <$> liftCoreM (mkFreshUserName (mkVeilImplementationDetailName `simulateSound)) - emitSimulateArtifacts mod instTerm theoryTerm sp pureCallExpr cfg simulateResultIdent simulateCoreSoundIdent simulateSoundIdent let effectiveMode := if (← liftIO isVeilOnlineEnv) then .interpreted else mode match effectiveMode with | .interpreted => elabSimulateInterpretedMode mod stx runtimeCallExpr diff --git a/VeilTest/Regression/SimulateAssertionFailure.lean b/VeilTest/Regression/SimulateAssertionFailure.lean new file mode 100644 index 00000000..18e5116e --- /dev/null +++ b/VeilTest/Regression/SimulateAssertionFailure.lean @@ -0,0 +1,38 @@ +import Veil + +set_option linter.unusedVariables false + +veil module SimulateAssertionFailure + +type node + +relation pending : node -> node -> Bool + +#gen_state + +after_init { + pending M N := false +} + +action send (n next : node) { + assert false + pending n next := true +} + +invariant true + +/-- error: This assertion might fail when called from send -/ +#guard_msgs in +#gen_spec + +/-- +error: ❌ Violation: assertion_failure + State 0 (via init): + pending = [] + State 1 (via send(n=0, next=0)): + pending = [] +-/ +#guard_msgs in +#simulate interpreted { node := Fin 2 } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateAssertionFailure diff --git a/VeilTest/Regression/SimulateAssumptions.lean b/VeilTest/Regression/SimulateAssumptions.lean index 08b4a903..c6b31b8a 100644 --- a/VeilTest/Regression/SimulateAssumptions.lean +++ b/VeilTest/Regression/SimulateAssumptions.lean @@ -32,6 +32,23 @@ invariant true (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide +/-- +error: Tactic `native_decide` evaluated that the proposition + assumption_0 { leader := fun n => n == 0 || n == 1 } +is false +--- +info: ✅ No violation in 1 traces +-/ +#guard_msgs in +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) || n == (1 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by native_decide + +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) || n == (1 : Fin 3) } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + /-- info: ✅ No violation in 1 traces -/ #guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } @@ -50,3 +67,37 @@ invariant true assumptions_hold_by native_decide end SimulateAssumptionsTest + +veil module SimulateAssumptionsCustomProof + +type node + +immutable function weight : node → Nat + +relation active : node → Bool + +#gen_state + +assumption ∀ (n : node), 0 < weight n +assumption ∀ (n1 n2 : node), weight n1 = weight n2 → n1 = n2 + +after_init { + active N := false +} + +action activate (n : node) { + active n := true +} + +invariant true + +#gen_spec + +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in +#simulate interpreted { node := Fin 3 } { weight := fun (n : Fin 3) => n.val + 1 } + (seed := 1) (maxTraces := 1) (maxSteps := 1) + assumptions_hold_by + constructor <;> decide + +end SimulateAssumptionsCustomProof diff --git a/VeilTest/Regression/SimulateEmptySpec.lean b/VeilTest/Regression/SimulateEmptySpec.lean new file mode 100644 index 00000000..cde294dc --- /dev/null +++ b/VeilTest/Regression/SimulateEmptySpec.lean @@ -0,0 +1,21 @@ +import Veil + +veil module SimulateEmptySpec + +after_init { + pure () +} + +invariant true + +/-- +warning: you have not defined any actions for this specification; did you forget? +-/ +#guard_msgs in +#gen_spec + +/-- info: ✅ No violation in 1 traces -/ +#guard_msgs in +#simulate interpreted { } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateEmptySpec From ed23a6733bb3bb2915b2a870e7cae9c023617e91 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 07:26:30 +0200 Subject: [PATCH 47/88] fix(examples): replace SharedCounter with lease race examples --- .../Simulate/CheckpointLeaseFailover.lean | 93 +++++++++++++++++++ Examples/Simulate/LeaseKeepaliveRace.lean | 85 +++++++++++++++++ Examples/Simulate/SharedCounter.lean | 54 ----------- 3 files changed, 178 insertions(+), 54 deletions(-) create mode 100644 Examples/Simulate/CheckpointLeaseFailover.lean create mode 100644 Examples/Simulate/LeaseKeepaliveRace.lean delete mode 100644 Examples/Simulate/SharedCounter.lean diff --git a/Examples/Simulate/CheckpointLeaseFailover.lean b/Examples/Simulate/CheckpointLeaseFailover.lean new file mode 100644 index 00000000..2ebc2f38 --- /dev/null +++ b/Examples/Simulate/CheckpointLeaseFailover.lean @@ -0,0 +1,93 @@ +import Veil + +/- +Original source/reference: +- Local modeling analogues: + - Examples/Ivy/DecentralizedLock.lean (epoched authority transfer) + - Examples/TLA/Raft.lean (leader failover) +- Production inspiration: etcd lease checkpoint persistence across leader + failover (etcd-io/etcd#13508) + +Bug/race shape: +A leader checkpoints a lease's reduced remaining TTL. After failover, the new +leader forgets that checkpointed TTL and reconstructs the lease from the older +grant state, reviving a lease that should already be considered expired. + +Why #simulate here: +The violating trace is short, but exhaustive search must branch over leaders, +leases, epochs, and recovery schedules. +-/ + +veil module CheckpointLeaseFailover + +type node +type epoch +type lease + +instantiate epochOrd : TotalOrder epoch + +individual leader : node +immutable individual initial_leader : node +immutable individual initial_epoch : epoch +relation current_epoch (e : epoch) +relation granted_until (l : lease) (e : epoch) +relation checkpointed_until (l : lease) (e : epoch) +relation active_on_leader (l : lease) + +#gen_state + +after_init { + leader := initial_leader + current_epoch E := E == initial_epoch + granted_until L E := false + checkpointed_until L E := false + active_on_leader L := false +} + +action grantLease (l : lease) (expiry : epoch) { + require ∀ now, current_epoch now -> ¬ epochOrd.le expiry now + granted_until l E := E == expiry + active_on_leader l := true +} + +action checkpointRemainingTTL (l : lease) (expiry : epoch) { + require active_on_leader l + require ∀ now, current_epoch now -> ¬ epochOrd.le expiry now + checkpointed_until l E := E == expiry +} + +action failover (newLeader : node) (newEpoch : epoch) { + require newLeader != leader + require ∀ oldEpoch, current_epoch oldEpoch -> ¬ epochOrd.le newEpoch oldEpoch + leader := newLeader + current_epoch E := E == newEpoch + active_on_leader L := false +} + +action recoverLeaseFromGrant (l : lease) (expiry : epoch) { + require granted_until l expiry + active_on_leader l := true +} + +invariant [one_current_epoch] + ∀ (e1 e2 : epoch), current_epoch e1 ∧ current_epoch e2 -> e1 = e2 + +safety [checkpointed_expiry_respected] + ∀ (l : lease) (expiry now : epoch), + checkpointed_until l expiry ∧ current_epoch now ∧ epochOrd.le expiry now -> + ¬ active_on_leader l + +#gen_spec + +-- model_check must branch over failovers, recovery choices, and many lease/epoch combinations. +-- set_option veil.violationIsError false in +-- #model_check { node := Fin 12, epoch := Fin 8, lease := Fin 8 } +-- { initial_leader := (0 : Fin 12), initial_epoch := (0 : Fin 8) } + +-- simulate quickly finds the stale-recovery bug after failover. +set_option veil.violationIsError false in +#simulate { node := Fin 12, epoch := Fin 8, lease := Fin 8 } + { initial_leader := (0 : Fin 12), initial_epoch := (0 : Fin 8) } + (seed := 23) (maxTraces := 2000) (maxSteps := 10) + +end CheckpointLeaseFailover diff --git a/Examples/Simulate/LeaseKeepaliveRace.lean b/Examples/Simulate/LeaseKeepaliveRace.lean new file mode 100644 index 00000000..7b12f17c --- /dev/null +++ b/Examples/Simulate/LeaseKeepaliveRace.lean @@ -0,0 +1,85 @@ +import Veil + +/- +Original source/reference: +- Closest local modeling analogue: Examples/Ivy/DecentralizedLock.lean +- Production reference: etcd KeepAlive vs lease-expiry revocation race + (etcd-io/etcd#21389, issue #14758) + +Bug/race shape: +A client still has keys attached to a lease when revocation starts. A late +keepalive succeeds after revocation has already removed the keys, so the client +appears renewed even though its data is gone. + +Why #simulate here: +The bad trace is only a handful of steps, but exhaustive search must branch over +clients, keys, revoke timing, and keepalive interleavings. +-/ + +veil module LeaseKeepaliveRace + +type client +type key + +relation lease_alive (c : client) +relation revoke_started (c : client) +relation keepalive_succeeded (c : client) +relation key_attached (c : client) (k : key) +relation key_present (k : key) + +#gen_state + +after_init { + lease_alive C := false + revoke_started C := false + keepalive_succeeded C := false + key_attached C K := false + key_present K := false +} + +action grantLease (c : client) { + require !(lease_alive c) + lease_alive c := true + revoke_started c := false + keepalive_succeeded c := false +} + +action attachKey (c : client) (k : key) { + require lease_alive c + key_attached c k := true + key_present k := true +} + +action startRevoke (c : client) { + require lease_alive c + revoke_started c := true + lease_alive c := false +} + +action deleteKey (c : client) (k : key) { + require revoke_started c + require key_attached c k + key_present k := false +} + +action keepAlive (c : client) { + require revoke_started c + keepalive_succeeded c := true + lease_alive c := true +} + +safety [renewal_keeps_keys_live] + ∀ (c : client) (k : key), keepalive_succeeded c ∧ key_attached c k -> key_present k + +#gen_spec + +-- model_check must branch over clients, keys, revoke order, and late keepalives. +-- set_option veil.violationIsError false in +-- #model_check { client := Fin 8, key := Fin 8 } {} + +-- simulate usually hits the keepalive-after-revoke race in a short trace. +set_option veil.violationIsError false in +#simulate { client := Fin 8, key := Fin 8 } {} + (seed := 11) (maxTraces := 300) (maxSteps := 12) + +end LeaseKeepaliveRace diff --git a/Examples/Simulate/SharedCounter.lean b/Examples/Simulate/SharedCounter.lean deleted file mode 100644 index 0fcac8b7..00000000 --- a/Examples/Simulate/SharedCounter.lean +++ /dev/null @@ -1,54 +0,0 @@ -import Veil - -/- -Demonstrates #simulate advantage over #model_check on large state spaces. - -N processes each have a boolean active flag, creating 2^N flag combinations. -A shared counter increments when any active process acts. Safety: counter < 10. - -With Fin 20 (20 processes), the state space is ~2^20 * 10 ~ 10M states -- -intractable for exhaustive model checking. Simulate finds the violation in a -single trace by activating one process and incrementing 10 times. --/ -veil module SharedCounter - -type process - -individual counter : Nat -relation active : process -> Bool - -#gen_state - -after_init { - counter := 0 - active P := false -} - -action activate (p : process) { - require ¬ active p - active p := true -} - -action deactivate (p : process) { - require active p - active p := false -} - -action increment (p : process) { - require active p - counter := counter + 1 -} - -safety [bounded] counter < 10 - -#gen_spec - --- model_check needs to explore ~10M states (times out even after 60s) --- set_option veil.violationIsError false in --- #model_check { process := Fin 20 } {} - --- simulate finds the violation in a single trace -set_option veil.violationIsError false in -#simulate { process := Fin 20 } {} (maxTraces := 100) (maxSteps := 50) - -end SharedCounter From 3f9605f6ad708a25d7d99ba77d6b172cea9ebc01 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 07:26:41 +0200 Subject: [PATCH 48/88] fix(examples): add simulate-friendly reliable broadcast --- Examples/Simulate/ReliableBroadcast.lean | 73 ++++++++++++++++++++++++ 1 file changed, 73 insertions(+) create mode 100644 Examples/Simulate/ReliableBroadcast.lean diff --git a/Examples/Simulate/ReliableBroadcast.lean b/Examples/Simulate/ReliableBroadcast.lean new file mode 100644 index 00000000..9c33183b --- /dev/null +++ b/Examples/Simulate/ReliableBroadcast.lean @@ -0,0 +1,73 @@ +import Veil + +/- +Original source/reference: +- Local analogue: Examples/Ivy/ReliableBroadcast.lean +- External family reference: tlaplus/Examples/specifications/bcastByz/bcastByz.tla + +Bug/race shape: +This simulate-focused variant keeps the initial/echo/vote/deliver structure, but +intentionally uses weak quorum rules. An equivocating originator can get two +different values delivered by different receivers. + +Why #simulate here: +The violating trace is short, but exhaustive search must branch over broadcast, +echo, vote, and delivery orderings across many nodes and values. +-/ + +veil module ReliableBroadcastSim + +type node +type value + +immutable individual originator : node + +relation initial_msg (src : node) (dst : node) (v : value) +relation echo_msg (src : node) (dst : node) (v : value) +relation vote_msg (src : node) (dst : node) (v : value) +relation delivered (dst : node) (v : value) + +#gen_state + +after_init { + initial_msg S D V := false + echo_msg S D V := false + vote_msg S D V := false + delivered D V := false +} + +action initialSend (dst : node) (v : value) { + require ∀ V, !(initial_msg originator dst V) + initial_msg originator dst v := true +} + +action echo (src : node) (v : value) { + require initial_msg originator src v + echo_msg src D v := true +} + +action vote (observer : node) (v : value) { + require ∃ (n1 n2 : node), n1 != n2 ∧ echo_msg n1 observer v ∧ echo_msg n2 observer v + vote_msg observer D v := true +} + +action deliver (observer : node) (v : value) { + require ∃ (n1 n2 : node), n1 != n2 ∧ vote_msg n1 observer v ∧ vote_msg n2 observer v + delivered observer v := true +} + +safety [agreement] + ∀ (n1 n2 : node) (v1 v2 : value), delivered n1 v1 ∧ delivered n2 v2 -> v1 = v2 + +#gen_spec + +-- model_check must enumerate many broadcast, echo, vote, and delivery schedules. +-- set_option veil.violationIsError false in +-- #model_check { node := Fin 10, value := Fin 2 } { originator := (0 : Fin 10) } + +-- simulate quickly finds an equivocation trace with the weak quorum rules above. +set_option veil.violationIsError false in +#simulate { node := Fin 10, value := Fin 2 } { originator := (0 : Fin 10) } + (seed := 41) (maxTraces := 2000) (maxSteps := 24) + +end ReliableBroadcastSim From 9971ba13c28745157207479ca33ffbfb1abbcf12 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 09:08:46 +0200 Subject: [PATCH 49/88] fix(simulate): preserve explicit default config values --- Veil/Frontend/DSL/Module/Elaborators.lean | 27 ++++++++- .../Regression/SimulateConfigDefaults.lean | 58 +++++++++++++++++++ 2 files changed, 83 insertions(+), 2 deletions(-) create mode 100644 VeilTest/Regression/SimulateConfigDefaults.lean diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index e5b86b81..1f2841cd 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -559,6 +559,27 @@ declare_command_config_elab elabModelCheckerConfig ModelCheckerConfig declare_command_config_elab elabSimulateConfig ModelChecker.Simulation.SimulateConfig +private partial def simulateConfigItems (cfgStx : Syntax) : TSyntaxArray ``Lean.Parser.Tactic.configItem := + if cfgStx.isOfKind nullKind then + cfgStx.getArgs.flatMap simulateConfigItems + else + match cfgStx with + | `(Lean.Parser.Tactic.optConfig| $items:configItem*) => items + | `(Lean.Parser.Tactic.config| (config := $_)) => #[⟨cfgStx⟩] + | _ => #[] + +/-- Check whether a particular config field was written explicitly in the command syntax. -/ +def simulateConfigHasField (cfgStx : Syntax) (fieldName : Name) : Bool := + Lean.Elab.Tactic.mkConfigItemViews (simulateConfigItems cfgStx) |>.any + (fun item => item.option.getId.eraseMacroScopes == fieldName) + +/-- Resolve `#simulate` trace-bound fields, preserving explicit default literals. -/ +def resolveSimulateTraceBounds (cfg0 : ModelChecker.Simulation.SimulateConfig) + (hasMaxTraces hasMaxSteps : Bool) (optionMaxTraces optionMaxSteps : Nat) : Nat × Nat := + let maxTraces := if hasMaxTraces then cfg0.maxTraces else optionMaxTraces + let maxSteps := if hasMaxSteps then cfg0.maxSteps else optionMaxSteps + (maxTraces, maxSteps) + /-- Model checking mode: interpreted only, compiled only, or default (both with handoff). -/ inductive ModelCheckingMode where | interpreted @@ -1199,8 +1220,10 @@ def elabSimulate : CommandElab := fun stx => do warnAboutTransitions mod let cfg0 ← elabSimulateConfig stx[4] let opts ← getOptions - let maxTraces := if cfg0.maxTraces == 10000 then veil.simulate.maxTraces.get opts else cfg0.maxTraces - let maxSteps := if cfg0.maxSteps == 100 then veil.simulate.maxSteps.get opts else cfg0.maxSteps + let hasMaxTraces := simulateConfigHasField stx[4] `maxTraces + let hasMaxSteps := simulateConfigHasField stx[4] `maxSteps + let (maxTraces, maxSteps) := resolveSimulateTraceBounds cfg0 hasMaxTraces hasMaxSteps + (veil.simulate.maxTraces.get opts) (veil.simulate.maxSteps.get opts) let seed ← liftIO <| if cfg0.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg0.seed let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps, seed } let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } diff --git a/VeilTest/Regression/SimulateConfigDefaults.lean b/VeilTest/Regression/SimulateConfigDefaults.lean new file mode 100644 index 00000000..63aca489 --- /dev/null +++ b/VeilTest/Regression/SimulateConfigDefaults.lean @@ -0,0 +1,58 @@ +import Veil + +open Veil.ModelChecker.Simulation + +example : + Veil.resolveSimulateTraceBounds + { maxTraces := 10000, maxSteps := 100, seed := 0 } + true true 7 3 = (10000, 100) := rfl + +example : + Veil.resolveSimulateTraceBounds + { maxTraces := 10000, maxSteps := 100, seed := 0 } + false false 7 3 = (7, 3) := rfl + +veil module SimulateConfigDefaults + +individual flag : Bool +individual tripped : Bool + +#gen_state + +after_init { + flag := false + tripped := false +} + +action set_flag { + require !flag + flag := true +} + +action trip { + require flag + tripped := true +} + +invariant [still_safe] ¬ tripped + +#gen_spec + +set_option veil.simulate.maxSteps 1 in +/-- +error: ❌ Violation: safety_failure (violates: still_safe) + State 0 (via init): + flag = false + tripped = false + State 1 (via set_flag): + flag = true + tripped = false + State 2 (via trip): + flag = true + tripped = true +Seed: 1 +-/ +#guard_msgs in +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 100) + +end SimulateConfigDefaults From 6da620806f9aace68ab3c0b217084202a1947278 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 09:08:46 +0200 Subject: [PATCH 50/88] fix(simulate): show chosen seed in output --- Veil/Core/UI/Trace/TraceDisplay.lean | 14 ++++++---- .../Regression/SimulateAssertionFailure.lean | 1 + VeilTest/Regression/SimulateAssumptions.lean | 26 +++++++++++++++---- VeilTest/Regression/SimulateEmptySpec.lean | 5 +++- VeilTest/Regression/SimulateModes.lean | 10 +++++-- .../Regression/SimulateViolationModes.lean | 2 ++ widget/src/traceDisplay.tsx | 19 ++++++++++++-- 7 files changed, 62 insertions(+), 15 deletions(-) diff --git a/Veil/Core/UI/Trace/TraceDisplay.lean b/Veil/Core/UI/Trace/TraceDisplay.lean index 46689d66..86c687bf 100644 --- a/Veil/Core/UI/Trace/TraceDisplay.lean +++ b/Veil/Core/UI/Trace/TraceDisplay.lean @@ -88,6 +88,10 @@ def formatTrace (j : Json) (ind : String := " ") : String := Id.run do | .arr states => r ++ (states.toList.map (fmtState · ind) |> "\n".intercalate) | _ => r ++ s!"{ind}(no states)" +private def fmtSeedSuffix (j : Json) : String := + let seed := j.getObjValD "seed" + if seed == .null then "" else s!"\nSeed: {fmtJson seed}" + def formatModelCheckingResult (j : Json) : MessageData := match fmtJson (j.getObjValD "result") with | "found_violation" => @@ -95,15 +99,15 @@ def formatModelCheckingResult (j : Json) : MessageData := let violates := match v.getObjValD "violates" with | .arr arr => if arr.isEmpty then "" else s!" (violates: {", ".intercalate (arr.map fmtJson).toList})" | _ => "" - m!"❌ Violation: {fmtJson (v.getObjValD "kind")}{violates}\n{formatTrace (j.getObjValD "trace")}" + m!"❌ Violation: {fmtJson (v.getObjValD "kind")}{violates}\n{formatTrace (j.getObjValD "trace")}{fmtSeedSuffix j}" | "no_violation_found" => let trace := j.getObjValD "trace" - if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}" + if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}{fmtSeedSuffix j}" else if j.getObjValD "traces_run" != .null then - m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces" + m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces{fmtSeedSuffix j}" else - m!"✅ No violation (explored {fmtJson (j.getObjValD "explored_states")} states)" - | "cancelled" => m!"⚠️ Cancelled" + m!"✅ No violation (explored {fmtJson (j.getObjValD "explored_states")} states){fmtSeedSuffix j}" + | "cancelled" => m!"⚠️ Cancelled{fmtSeedSuffix j}" | r => if j.getObjValD "error" != .null then m!"💥 Error: {fmtJson (j.getObjValD "error")}" else m!"Unknown: {r}" end Veil.TraceDisplay diff --git a/VeilTest/Regression/SimulateAssertionFailure.lean b/VeilTest/Regression/SimulateAssertionFailure.lean index 18e5116e..baeb7bba 100644 --- a/VeilTest/Regression/SimulateAssertionFailure.lean +++ b/VeilTest/Regression/SimulateAssertionFailure.lean @@ -31,6 +31,7 @@ error: ❌ Violation: assertion_failure pending = [] State 1 (via send(n=0, next=0)): pending = [] +Seed: 1 -/ #guard_msgs in #simulate interpreted { node := Fin 2 } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) diff --git a/VeilTest/Regression/SimulateAssumptions.lean b/VeilTest/Regression/SimulateAssumptions.lean index c6b31b8a..7ed972cc 100644 --- a/VeilTest/Regression/SimulateAssumptions.lean +++ b/VeilTest/Regression/SimulateAssumptions.lean @@ -26,7 +26,10 @@ invariant true #gen_spec -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) @@ -38,18 +41,25 @@ error: Tactic `native_decide` evaluated that the proposition is false --- info: ✅ No violation in 1 traces +Seed: 1 -/ #guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) || n == (1 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) || n == (1 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) @@ -60,7 +70,10 @@ info: ✅ No violation in 1 traces (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) @@ -93,7 +106,10 @@ invariant true #gen_spec -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted { node := Fin 3 } { weight := fun (n : Fin 3) => n.val + 1 } (seed := 1) (maxTraces := 1) (maxSteps := 1) diff --git a/VeilTest/Regression/SimulateEmptySpec.lean b/VeilTest/Regression/SimulateEmptySpec.lean index cde294dc..f3958ec5 100644 --- a/VeilTest/Regression/SimulateEmptySpec.lean +++ b/VeilTest/Regression/SimulateEmptySpec.lean @@ -14,7 +14,10 @@ warning: you have not defined any actions for this specification; did you forget #guard_msgs in #gen_spec -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted { } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) diff --git a/VeilTest/Regression/SimulateModes.lean b/VeilTest/Regression/SimulateModes.lean index 3ac92bd9..4f0d1f53 100644 --- a/VeilTest/Regression/SimulateModes.lean +++ b/VeilTest/Regression/SimulateModes.lean @@ -18,14 +18,20 @@ invariant [safe_flag] true #gen_spec -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) #guard_msgs(drop info, drop warning) in #simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) -/-- info: ✅ No violation in 1 traces -/ +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ #guard_msgs in #simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) diff --git a/VeilTest/Regression/SimulateViolationModes.lean b/VeilTest/Regression/SimulateViolationModes.lean index 76cbba4f..75a4b973 100644 --- a/VeilTest/Regression/SimulateViolationModes.lean +++ b/VeilTest/Regression/SimulateViolationModes.lean @@ -24,6 +24,7 @@ error: ❌ Violation: safety_failure (violates: safe_flag) flag = false State 1 (via set_flag): flag = true +Seed: 1 -/ #guard_msgs in #simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) @@ -38,6 +39,7 @@ error: ❌ Violation: safety_failure (violates: safe_flag) flag = false State 1 (via set_flag): flag = true +Seed: 1 -/ #guard_msgs in #simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) diff --git a/widget/src/traceDisplay.tsx b/widget/src/traceDisplay.tsx index 2f4c3411..0f4a49cf 100644 --- a/widget/src/traceDisplay.tsx +++ b/widget/src/traceDisplay.tsx @@ -75,6 +75,7 @@ type ModelCheckingResult = result: "found_violation"; violation: Violation; trace: TraceData | null; + seed?: number; } | { result: "no_violation_found"; @@ -83,9 +84,11 @@ type ModelCheckingResult = traces_run?: number; max_traces?: number; trace?: TraceData | null; + seed?: number; } | { result: "cancelled"; + seed?: number; } | { // Trace-only data without a result (for displaying execution traces) @@ -305,7 +308,14 @@ const ResultHeader: React.FC<{ terminationReason?: TerminationReason; tracesRun?: number; maxTraces?: number; -}> = ({ resultType, violation, exploredStates, terminationReason, tracesRun, maxTraces }) => { + seed?: number; +}> = ({ resultType, violation, exploredStates, terminationReason, tracesRun, maxTraces, seed }) => { + const seedDetails = seed !== undefined ? ( +
+ Seed: {seed} +
+ ) : null; + if (resultType === "cancelled") { return (
@@ -314,6 +324,7 @@ const ResultHeader: React.FC<{
Model checking was cancelled before completion
+ {seedDetails}
); } @@ -348,6 +359,7 @@ const ResultHeader: React.FC<{ Location: {violation.assertion_info.moduleName}.{violation.assertion_info.procedureName} (line {violation.assertion_info.line}, column {violation.assertion_info.column})
)} + {seedDetails} ); } @@ -409,6 +421,7 @@ const ResultHeader: React.FC<{ {terminationText} )} + {seedDetails} ); }; @@ -810,7 +823,7 @@ const ModelCheckerView: React.FC = ({ {'result' in result && ( <> {result.result === "cancelled" ? ( - + ) : result.result === "no_violation_found" ? ( = ({ terminationReason={result.termination_reason} tracesRun={result.traces_run} maxTraces={result.max_traces} + seed={result.seed} /> ) : ( )} From 48fdf21ff0869e10dfa473b75aba33ca54a29707 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 15 Apr 2026 09:08:46 +0200 Subject: [PATCH 51/88] fix(simulate): short-circuit empty initial states --- .../ModelChecker/Simulation/Runtime.lean | 32 +++++++++++++++++-- .../SimulateEmptyFilteredInitStates.lean | 26 +++++++++++++++ 2 files changed, 56 insertions(+), 2 deletions(-) create mode 100644 VeilTest/Regression/SimulateEmptyFilteredInitStates.lean diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 54845120..b91ba777 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -4,6 +4,20 @@ import Veil.Core.Tools.ModelChecker.Concrete.Progress namespace Veil.ModelChecker.Simulation +private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : SimulateResult ρ σ κ := { + result := .noViolationFound 0 .exploredAllReachableStates + tracesRun := 0 + maxTraces := cfg.maxTraces + elapsedMs := 0 + seed := cfg.seed + depth := 0 +} + +private def hasNoInitialStates {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) : Bool := + (filterInitStatesByConstraints sys params th).isEmpty + private structure SimulationHooks (m : Type → Type) where shouldStop : Nat → m Bool onTraceProgress : Nat → m PUnit @@ -108,7 +122,10 @@ def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} (shouldStop : Nat → Bool) (cfg : SimulateConfig) : SimulateResult ρ σ κ := - simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 + if hasNoInitialStates sys params th then + noInitialStatesResult cfg + else + simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 @[inline, specialize] def simulateCore {ρ σ κ : Type} {th₀ : ρ} @@ -131,6 +148,12 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed let cfg := { cfg with seed := actualSeed } let startMs ← IO.monoMsNow + if hasNoInitialStates sys params th then + let simResult := { noInitialStatesResult cfg with elapsedMs := (← IO.monoMsNow) - startMs } + Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId + "Complete" + simResult.tracesRun simResult.maxTraces simResult.depth + return simResult let lastStatusUpdateRef ← IO.mkRef startMs let simResult ← simulateLoopM { shouldStop := fun _ => Veil.ModelChecker.Concrete.shouldStop cancelToken progressInstanceId @@ -203,7 +226,12 @@ theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} (shouldStop : Nat → Bool) (cfg : SimulateConfig) : ResultSound sys params (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by - exact simulateLoopM_id_sound sys params th cfg shouldStop cfg.maxTraces 0 + cases hNoInit : hasNoInitialStates sys params th with + | true => + simp [simulateCommandSemantics, hNoInit, noInitialStatesResult, ResultSound] + | false => + simpa [simulateCommandSemantics, hNoInit] using + simulateLoopM_id_sound sys params th cfg shouldStop cfg.maxTraces 0 theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] diff --git a/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean b/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean new file mode 100644 index 00000000..1675802e --- /dev/null +++ b/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean @@ -0,0 +1,26 @@ +import Veil + +veil module SimulateEmptyFilteredInitStates + +after_init { + pure () +} + +invariant true + +state_constraint [no_initial_states] False + +/-- +warning: you have not defined any actions for this specification; did you forget? +-/ +#guard_msgs in +#gen_spec + +/-- +info: ✅ No violation in 0 traces +Seed: 1 +-/ +#guard_msgs in +#simulate interpreted {} {} (seed := 1) (maxTraces := 5) (maxSteps := 1) + +end SimulateEmptyFilteredInitStates From 312d8e2438ebaf72ebb265d8f4ae969ac49c0311 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 16 Apr 2026 15:49:25 +0200 Subject: [PATCH 52/88] test(simulate): make interpreted mode explicit --- VeilTest/UninterpretedParameter.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VeilTest/UninterpretedParameter.lean b/VeilTest/UninterpretedParameter.lean index b541316f..1ab4e343 100644 --- a/VeilTest/UninterpretedParameter.lean +++ b/VeilTest/UninterpretedParameter.lean @@ -35,6 +35,6 @@ invariant [bounded] ∀ (x : node), counter x ≤ n #model_check interpreted { node := Fin 2, n := 1, color := Fin 2, m := ⟨1, by decide⟩ } {} #guard_msgs(drop info) in -#simulate { node := Fin 2, n := 1, color := Fin 2, m := ⟨1, by decide⟩ } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted { node := Fin 2, n := 1, color := Fin 2, m := ⟨1, by decide⟩ } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) end TestParameter From 17228a126cba057338e9482d769c74e85beaa84e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 16 Apr 2026 17:58:41 +0200 Subject: [PATCH 53/88] chore: reduce noises --- Veil/Core/Tools/ModelChecker/Concrete/Progress.lean | 8 ++++---- Veil/Core/Tools/ModelChecker/Simulation/Result.lean | 3 +-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index 1e052a8c..1a19f5d7 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -274,15 +274,15 @@ def updateCompilationStatus (instanceId : Nat) (status : CompilationStatus) : IO /-- Update compilation log with a new line. -/ def updateCompilationLog (instanceId : Nat) (elapsedMs : Nat) (line : String) (isError : Bool) : IO Unit := withRefs instanceId fun refs => refs.progressRef.modify fun p => - let existingLines := match p.compilationStatus with | CompilationStatus.inProgress _ l => l | _ => #[] + let existingLines := match p.compilationStatus with | .inProgress _ l => l | _ => #[] let newLine : CompilationLogLine := { timestamp := elapsedMs, content := line, isError } - { p with compilationStatus := CompilationStatus.inProgress elapsedMs (existingLines.push newLine) } + { p with compilationStatus := .inProgress elapsedMs (existingLines.push newLine) } /-- Update just elapsed time without adding a log line. -/ def updateCompilationElapsed (instanceId : Nat) (elapsedMs : Nat) : IO Unit := withRefs instanceId fun refs => refs.progressRef.modify fun p => - let lines := match p.compilationStatus with | CompilationStatus.inProgress _ l => l | _ => #[] - { p with compilationStatus := CompilationStatus.inProgress elapsedMs lines } + let lines := match p.compilationStatus with | .inProgress _ l => l | _ => #[] + { p with compilationStatus := .inProgress elapsedMs lines } def requestHandoff (instanceId : Nat) : IO Unit := withRefs instanceId (·.handoffRequested.set true) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index e508c5e6..82750ea8 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -65,8 +65,7 @@ instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (r : SimulateResult ρ σ κ) : Json := - let resultJson := resultToJson r.result - match resultJson with + match resultToJson r.result with | Json.obj kvs => Json.mkObj <| kvs.toList ++ [ ("traces_run", Lean.toJson r.tracesRun), From fd86b56110fae8516337e847da3237a57153d63c Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 16 Apr 2026 20:46:21 +0200 Subject: [PATCH 54/88] fix(simulate): align violation soundness with runtime semantics --- .../Tools/ModelChecker/Simulation/Path.lean | 25 ---------- .../ModelChecker/Simulation/Runtime.lean | 12 ++--- .../ModelChecker/Simulation/Soundness.lean | 49 +++---------------- VeilTest/Regression/SimulateDeadlock.lean | 31 ++++++++++++ 4 files changed, 43 insertions(+), 74 deletions(-) create mode 100644 VeilTest/Regression/SimulateDeadlock.lean diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 08d03d72..7bf3cb64 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -61,31 +61,6 @@ theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} rcases hEntryEq with ⟨rfl, rfl⟩ simpa [outcomes] using hEntryMem -theorem decideAtState_deadlock_spec {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : - decideAtState sys params th currSt = .deadlock -> - params.terminating.holdsOn th currSt = false ∧ - (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst = [] := by - intro h - let outcomes := filterOutcomesByConstraints sys params th currSt - cases hFind : outcomes.findSome? assertionFailureWitness with - | some found => - have : False := by - simp [decideAtState, outcomes, hFind] at h - exact False.elim this - | none => - cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with - | nil => - have hTerm : params.terminating.holdsOn th currSt = false := by - have h' := h - simp [decideAtState, outcomes, hFind, hNexts] at h' - exact h' - exact ⟨hTerm, rfl⟩ - | cons hd tl => - simp [decideAtState, outcomes, hFind, hNexts] at h - theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index b91ba777..7bb73083 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -196,17 +196,17 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} {th₀ : ρ} (cfg : SimulateConfig) (shouldStop : Nat → Bool) : ∀ remaining traceIndex, - ResultSound sys params (SimulateResult.result (simulateLoopId shouldStop sys params th cfg remaining traceIndex)) := by + ReportedViolationSound sys params (SimulateResult.result (simulateLoopId shouldStop sys params th cfg remaining traceIndex)) := by intro remaining induction remaining with | zero => intro traceIndex - cases hStop : shouldStop traceIndex <;> simp [simulateLoopId, hStop, ResultSound] + cases hStop : shouldStop traceIndex <;> simp [simulateLoopId, hStop, ReportedViolationSound] | succ remaining ih => intro traceIndex cases hStop : shouldStop traceIndex with | true => - simp [simulateLoopId, hStop, ResultSound] + simp [simulateLoopId, hStop, ReportedViolationSound] | false => by_cases hTrace : runTraceAtSeed sys params th cfg traceIndex = none · simpa [simulateLoopId, hStop, hTrace] using ih (traceIndex + 1) @@ -225,10 +225,10 @@ theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (shouldStop : Nat → Bool) (cfg : SimulateConfig) : - ResultSound sys params (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by + ReportedViolationSound sys params (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by cases hNoInit : hasNoInitialStates sys params th with | true => - simp [simulateCommandSemantics, hNoInit, noInitialStatesResult, ResultSound] + simp [simulateCommandSemantics, hNoInit, noInitialStatesResult, ReportedViolationSound] | false => simpa [simulateCommandSemantics, hNoInit] using simulateLoopM_id_sound sys params th cfg shouldStop cfg.maxTraces 0 @@ -240,7 +240,7 @@ theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (cfg : SimulateConfig) : - ResultSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by + ReportedViolationSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by simpa [simulateCore] using simulateCommandSemantics_sound sys params th (fun _ => false) cfg end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 7626a84b..37e78fb3 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -211,10 +211,7 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} | .deadlock => Trace.isSimulationValid sys params trace ∧ trace.failingStep = none ∧ - params.terminating.holdsOn trace.theory trace.lastState = false ∧ - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params trace.theory trace.lastState) - nexts = [] + decideAtState sys params trace.theory trace.lastState = .deadlock | .assertionFailure exId => Trace.isSimulationValid sys params trace ∧ ∃ step, @@ -234,15 +231,7 @@ theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} | deadlock => exact Trace.isSimulationValid_sound sys params trace h.1 | assertionFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 -noncomputable instance instDecidableTraceWitnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : - Decidable (Trace.witnessesSimulationViolation sys params trace violation) := by - classical - infer_instance - -def ResultSound {ρ σ κ : Type} {th₀ : ρ} +def ReportedViolationSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := @@ -252,13 +241,6 @@ def ResultSound {ρ σ κ : Type} {th₀ : ρ} | .noViolationFound _ _ => True | .cancelled => True -def ResultSoundUnder {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (assumptions : ρ → Prop) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := - assumptions th → ResultSound sys params result - theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -272,7 +254,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} (hNoFail : trace.failingStep = none) : ∀ stepsLeft gen result, (simulateOnceLoop sys params th stepsLeft currSt trace gen).1 = some result -> - ResultSound sys params result := by + ReportedViolationSound sys params result := by intro stepsLeft induction stepsLeft generalizing currSt trace with | zero => @@ -302,10 +284,8 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} | deadlock => simp [simulateOnceLoop, hStep] at h cases h - have hDead := decideAtState_deadlock_spec sys params th currSt hStep exact ⟨Trace.isSimulationValid_complete sys params trace hValid, hNoFail, - by simpa [hTheory, hLast] using hDead.1, - by simpa [hTheory, hLast] using hDead.2⟩ + by simpa [hTheory, hLast] using hStep⟩ | terminated => simp [simulateOnceLoop, hStep] at h | «continue» nexts hNonempty => @@ -339,7 +319,7 @@ theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : ModelCheckingResult ρ σ κ Unit) : (simulateOnce sys params th gen maxSteps).1 = some result -> - ResultSound sys params result := by + ReportedViolationSound sys params result := by intro h unfold simulateOnce at h cases hStates : filterInitStatesByConstraints sys params th with @@ -372,7 +352,7 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} (traceIndex : Nat) (result : ModelCheckingResult ρ σ κ Unit) (depth : Nat) : runTraceAtSeed sys params th cfg traceIndex = some (result, depth) -> - ResultSound sys params result := by + ReportedViolationSound sys params result := by intro h unfold runTraceAtSeed at h set traceSeed := cfg.seed + traceIndex @@ -388,21 +368,4 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} simp [hSim, hMaybe] exact simulateOnce_sound sys params th (mkStdGen traceSeed) cfg.maxSteps result' hSimSome -noncomputable instance instDecidableResultSound {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : - Decidable (ResultSound sys params result) := by - classical - infer_instance - -noncomputable instance instDecidableResultSoundUnder {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (assumptions : ρ → Prop) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (result : ModelCheckingResult ρ σ κ Unit) : - Decidable (ResultSoundUnder assumptions sys params th result) := by - classical - infer_instance - end Veil.ModelChecker.Simulation diff --git a/VeilTest/Regression/SimulateDeadlock.lean b/VeilTest/Regression/SimulateDeadlock.lean new file mode 100644 index 00000000..15d36852 --- /dev/null +++ b/VeilTest/Regression/SimulateDeadlock.lean @@ -0,0 +1,31 @@ +import Veil + +veil module SimulateDeadlock + +individual stuck : Bool + +#gen_state + +after_init { + stuck := true +} + +invariant true +termination false = true + +/-- +warning: you have not defined any actions for this specification; did you forget? +-/ +#guard_msgs in +#gen_spec + +/-- +error: ❌ Violation: deadlock + State 0 (via init): + stuck = true +Seed: 1 +-/ +#guard_msgs in +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateDeadlock From 6dd0370c3e51957e072fc1b5e7c37fdb08277cf2 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sun, 26 Apr 2026 16:08:48 +0200 Subject: [PATCH 55/88] fix(simulate): respect config bounds and omitted theory --- Veil/Frontend/DSL/Module/Elaborators.lean | 6 ++++-- VeilTest/Regression/SimulateConfigDefaults.lean | 17 +++++++++++++++++ VeilTest/Regression/SimulateModes.lean | 13 +++++++++++++ 3 files changed, 34 insertions(+), 2 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 1f2841cd..993ae37b 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -571,7 +571,9 @@ private partial def simulateConfigItems (cfgStx : Syntax) : TSyntaxArray ``Lean. /-- Check whether a particular config field was written explicitly in the command syntax. -/ def simulateConfigHasField (cfgStx : Syntax) (fieldName : Name) : Bool := Lean.Elab.Tactic.mkConfigItemViews (simulateConfigItems cfgStx) |>.any - (fun item => item.option.getId.eraseMacroScopes == fieldName) + (fun item => + let optionName := item.option.getId.eraseMacroScopes + optionName == fieldName || optionName == `config) /-- Resolve `#simulate` trace-bound fields, preserving explicit default literals. -/ def resolveSimulateTraceBounds (cfg0 : ModelChecker.Simulation.SimulateConfig) @@ -1070,7 +1072,7 @@ private def generateSimulateModelSource (mod : Module) (stx : Syntax) (cfg : ModelChecker.Simulation.SimulateConfig) : CommandElabM String := do let srcPrefix ← generateCompiledModelSourcePrefix mod stx let instSrc ← getSourceSlice stx[2] - let theorySrc ← if stx[3].isNone then pure "" else do + let theorySrc ← if stx[3].isNone then pure " {}" else do let raw ← getSourceSlice stx[3][0] pure s!" {raw}" let cmd := s!"#simulate {instSrc}{theorySrc} (maxTraces := {cfg.maxTraces}) (maxSteps := {cfg.maxSteps}) (seed := {cfg.seed})" diff --git a/VeilTest/Regression/SimulateConfigDefaults.lean b/VeilTest/Regression/SimulateConfigDefaults.lean index 63aca489..1bdc90ae 100644 --- a/VeilTest/Regression/SimulateConfigDefaults.lean +++ b/VeilTest/Regression/SimulateConfigDefaults.lean @@ -55,4 +55,21 @@ Seed: 1 #guard_msgs in #simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 100) +set_option veil.simulate.maxSteps 1 in +/-- +error: ❌ Violation: safety_failure (violates: still_safe) + State 0 (via init): + flag = false + tripped = false + State 1 (via set_flag): + flag = true + tripped = false + State 2 (via trip): + flag = true + tripped = true +Seed: 1 +-/ +#guard_msgs in +#simulate interpreted {} {} (config := { maxTraces := 1, maxSteps := 100, seed := 1 }) + end SimulateConfigDefaults diff --git a/VeilTest/Regression/SimulateModes.lean b/VeilTest/Regression/SimulateModes.lean index 4f0d1f53..e6155f79 100644 --- a/VeilTest/Regression/SimulateModes.lean +++ b/VeilTest/Regression/SimulateModes.lean @@ -28,6 +28,11 @@ Seed: 1 #guard_msgs(drop info, drop warning) in #simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +set_option veil.simulate.maxTraces 1 in +set_option veil.simulate.maxSteps 1 in +#guard_msgs(drop info, drop warning) in +#simulate compiled {} + /-- info: ✅ No violation in 1 traces Seed: 1 @@ -35,4 +40,12 @@ Seed: 1 #guard_msgs in #simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +set_option veil.simulate.maxTraces 2 in +/-- +info: ✅ No violation in 1 traces +Seed: 1 +-/ +#guard_msgs in +#simulate interpreted {} {} (config := { maxTraces := 1, maxSteps := 1, seed := 1 }) + end SimulateModes From ec620dd37f8725170ecf243d8ea8610261f3176a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 7 May 2026 16:46:05 +0200 Subject: [PATCH 56/88] fix(simulate): use dedicated simulation result --- .../Tools/ModelChecker/Simulation/Basic.lean | 7 ++- .../Tools/ModelChecker/Simulation/Path.lean | 14 +++--- .../Tools/ModelChecker/Simulation/Result.lean | 46 ++----------------- .../ModelChecker/Simulation/Runtime.lean | 18 ++++---- .../ModelChecker/Simulation/Soundness.lean | 19 ++++---- VeilTest/Regression/SimulateResultJson.lean | 8 ++-- widget/src/traceDisplay.tsx | 14 ++++-- 7 files changed, 49 insertions(+), 77 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index f98cec82..672d5dc7 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -8,8 +8,13 @@ structure SimulateConfig where seed : Nat := 0 deriving Inhabited, Repr +inductive SimulationResult (ρ σ κ : Type) where + | cancelled + | foundViolation (violation : ViolationKind) (viaTrace : Trace ρ σ κ) +deriving Inhabited, Repr + structure SimulateResult (ρ σ κ : Type) where - result : ModelCheckingResult ρ σ κ Unit + result : Option (SimulationResult ρ σ κ) tracesRun : Nat maxTraces : Nat elapsedMs : Nat diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 7bf3cb64..754bbf31 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -152,16 +152,16 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (currSt : σ) (trace : Trace ρ σ κ) (gen : StdGen) - : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + : Option (SimulationResult ρ σ κ) × StdGen × Nat := match stepsLeft with | 0 => (none, gen, 0) | stepsLeft + 1 => match decideAtState sys params th currSt with | .assertionFailure exId step => let failedTrace := { trace with failingStep := some step } - (some (.foundViolation () (.assertionFailure exId) (some failedTrace)), gen, trace.steps.size + 1) + (some (.foundViolation (.assertionFailure exId) failedTrace), gen, trace.steps.size + 1) | .deadlock => - (some (.foundViolation () .deadlock (some trace)), gen, trace.steps.size) + (some (.foundViolation .deadlock trace), gen, trace.steps.size) | .terminated => (none, gen, trace.steps.size) | .continue nexts hNonempty => @@ -171,7 +171,7 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} let trace := trace.push { transitionLabel := label, nextState := nextSt } let violations := violatedInvariantNames params th nextSt if !violations.isEmpty then - (some (.foundViolation () (.safetyFailure violations) (some trace)), gen, trace.steps.size) + (some (.foundViolation (.safetyFailure violations) trace), gen, trace.steps.size) else simulateOnceLoop sys params th stepsLeft nextSt trace gen termination_by stepsLeft @@ -183,7 +183,7 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (gen : StdGen) (maxSteps : Nat) - : Option (ModelCheckingResult ρ σ κ Unit) × StdGen × Nat := + : Option (SimulationResult ρ σ κ) × StdGen × Nat := let initStates := filterInitStatesByConstraints sys params th match initStates with | [] => (none, gen, 0) @@ -194,7 +194,7 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } let initViolations := violatedInvariantNames params th initSt if !initViolations.isEmpty then - (some (.foundViolation () (.safetyFailure initViolations) (some initTrace)), gen, 0) + (some (.foundViolation (.safetyFailure initViolations) initTrace), gen, 0) else simulateOnceLoop sys params th maxSteps initSt initTrace gen @@ -204,7 +204,7 @@ def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) (traceIndex : Nat) - : Option (ModelCheckingResult ρ σ κ Unit × Nat) := + : Option (SimulationResult ρ σ κ × Nat) := let traceSeed := cfg.seed + traceIndex let (maybeResult, _, depth) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps maybeResult.map (fun result => (result, depth)) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index 82750ea8..200aeb01 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -3,55 +3,17 @@ import Veil.Core.Tools.ModelChecker.Simulation.Basic namespace Veil.ModelChecker.Simulation open Lean -private def earlyTerminationReasonToJson (reason : EarlyTerminationReason Unit) : Json := - match reason with - | .foundViolatingState _ violates => Json.mkObj [ - ("kind", "found_violating_state"), - ("state_fingerprint", Json.null), - ("violates", toJson violates) - ] - | .deadlockOccurred _ => Json.mkObj [ - ("kind", "deadlock_occurred"), - ("state_fingerprint", Json.null) - ] - | .assertionFailed _ exId => Json.mkObj [ - ("kind", "assertion_failed"), - ("state_fingerprint", Json.null), - ("exception_id", toJson exId) - ] - | .reachedDepthBound depth => Json.mkObj [ - ("kind", "reached_depth_bound"), - ("depth", toJson depth) - ] - | .reachedTraceLimit maxTraces => Json.mkObj [ - ("kind", "reached_trace_limit"), - ("max_traces", toJson maxTraces) - ] - | .cancelled => Json.mkObj [("kind", "cancelled")] - -private def terminationReasonToJson (reason : TerminationReason Unit) : Json := - match reason with - | .exploredAllReachableStates => Json.mkObj [("kind", "explored_all_reachable_states")] - | .earlyTermination condition => Json.mkObj [ - ("kind", "early_termination"), - ("condition", earlyTerminationReasonToJson condition) - ] - private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] - (result : ModelCheckingResult ρ σ κ Unit) : Json := + (result : Option (SimulationResult ρ σ κ)) : Json := match result with - | .foundViolation _ violation trace => Json.mkObj + | some (.foundViolation violation trace) => Json.mkObj [ ("result", "found_violation") , ("violation", toJson violation) , ("trace", toJson trace) , ("state_fingerprint", Json.null) ] - | .noViolationFound exploredStates reason => Json.mkObj - [ ("result", "no_violation_found") - , ("explored_states", toJson exploredStates) - , ("termination_reason", terminationReasonToJson reason) - ] - | .cancelled => Json.mkObj [("result", "cancelled")] + | some .cancelled => Json.mkObj [("result", "cancelled")] + | none => Json.mkObj [("result", "no_violation_found")] instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where toJson r := Json.mkObj [ diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 7bb73083..577ca73d 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -5,7 +5,7 @@ import Veil.Core.Tools.ModelChecker.Concrete.Progress namespace Veil.ModelChecker.Simulation private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : SimulateResult ρ σ κ := { - result := .noViolationFound 0 .exploredAllReachableStates + result := none tracesRun := 0 maxTraces := cfg.maxTraces elapsedMs := 0 @@ -34,7 +34,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ : m (SimulateResult ρ σ κ) := do if ← hooks.shouldStop traceIndex then return { - result := .cancelled + result := some .cancelled tracesRun := traceIndex maxTraces := cfg.maxTraces elapsedMs := 0 @@ -44,8 +44,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ match remaining with | 0 => return { - result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedTraceLimit cfg.maxTraces)) + result := none tracesRun := cfg.maxTraces maxTraces := cfg.maxTraces elapsedMs := 0 @@ -58,7 +57,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ | some (result, stepsUsed) => hooks.onViolation return { - result := result + result := some result tracesRun := traceIndex + 1 maxTraces := cfg.maxTraces elapsedMs := 0 @@ -80,7 +79,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} : SimulateResult ρ σ κ := if shouldStop traceIndex then { - result := .cancelled + result := some .cancelled tracesRun := traceIndex maxTraces := cfg.maxTraces elapsedMs := 0 @@ -91,8 +90,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} match remaining with | 0 => { - result := .noViolationFound cfg.maxTraces - (.earlyTermination (.reachedTraceLimit cfg.maxTraces)) + result := none tracesRun := cfg.maxTraces maxTraces := cfg.maxTraces elapsedMs := 0 @@ -103,7 +101,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} match runTraceAtSeed sys params th cfg traceIndex with | some (result, stepsUsed) => { - result := result + result := some result tracesRun := traceIndex + 1 maxTraces := cfg.maxTraces elapsedMs := 0 @@ -170,7 +168,7 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} sys params th cfg cfg.maxTraces 0 let simResult := { simResult with elapsedMs := (← IO.monoMsNow) - startMs } match simResult.result with - | .cancelled => pure () + | some .cancelled => pure () | _ => Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId "Complete" diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 37e78fb3..36d8b79c 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -234,12 +234,11 @@ theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} def ReportedViolationSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (result : ModelCheckingResult ρ σ κ Unit) : Prop := + (params : SearchParameters ρ σ) (result : Option (SimulationResult ρ σ κ)) : Prop := match result with - | .foundViolation _ violation (some trace) => Trace.witnessesSimulationViolation sys params trace violation - | .foundViolation _ _ none => False - | .noViolationFound _ _ => True - | .cancelled => True + | some (.foundViolation violation trace) => Trace.witnessesSimulationViolation sys params trace violation + | some .cancelled => True + | none => True theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] @@ -254,7 +253,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} (hNoFail : trace.failingStep = none) : ∀ stepsLeft gen result, (simulateOnceLoop sys params th stepsLeft currSt trace gen).1 = some result -> - ReportedViolationSound sys params result := by + ReportedViolationSound sys params (some result) := by intro stepsLeft induction stepsLeft generalizing currSt trace with | zero => @@ -317,9 +316,9 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : ModelCheckingResult ρ σ κ Unit) : + (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : SimulationResult ρ σ κ) : (simulateOnce sys params th gen maxSteps).1 = some result -> - ReportedViolationSound sys params result := by + ReportedViolationSound sys params (some result) := by intro h unfold simulateOnce at h cases hStates : filterInitStatesByConstraints sys params th with @@ -350,9 +349,9 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) (traceIndex : Nat) - (result : ModelCheckingResult ρ σ κ Unit) (depth : Nat) : + (result : SimulationResult ρ σ κ) (depth : Nat) : runTraceAtSeed sys params th cfg traceIndex = some (result, depth) -> - ReportedViolationSound sys params result := by + ReportedViolationSound sys params (some result) := by intro h unfold runTraceAtSeed at h set traceSeed := cfg.seed + traceIndex diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean index b1417efc..b7b0eeaf 100644 --- a/VeilTest/Regression/SimulateResultJson.lean +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -4,11 +4,11 @@ open Veil.ModelChecker open Veil.ModelChecker.Simulation /-- -info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"explored_states":3,"result":"no_violation_found","termination_reason":{"condition":{"kind":"reached_trace_limit","max_traces":3},"kind":"early_termination"}},"seed":1,"traces_run":3} +info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"result":"no_violation_found"},"seed":1,"traces_run":3} -/ #guard_msgs in #eval IO.println <| (Lean.toJson ({ - result := ModelCheckingResult.noViolationFound 3 (.earlyTermination (.reachedTraceLimit 3)) + result := none tracesRun := 3 maxTraces := 3 elapsedMs := 0 @@ -17,11 +17,11 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"explored_states":3,"re } : SimulateResult Unit Unit Unit)).compress /-- -info: {"depth":0,"elapsed_ms":0,"explored_states":3,"max_traces":3,"result":"no_violation_found","seed":1,"termination_reason":{"condition":{"kind":"reached_trace_limit","max_traces":3},"kind":"early_termination"},"traces_run":3} +info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","seed":1,"traces_run":3} -/ #guard_msgs in #eval IO.println <| (SimulateResult.toDisplayJson ({ - result := ModelCheckingResult.noViolationFound 3 (.earlyTermination (.reachedTraceLimit 3)) + result := none tracesRun := 3 maxTraces := 3 elapsedMs := 0 diff --git a/widget/src/traceDisplay.tsx b/widget/src/traceDisplay.tsx index 0f4a49cf..bbf179e7 100644 --- a/widget/src/traceDisplay.tsx +++ b/widget/src/traceDisplay.tsx @@ -79,8 +79,8 @@ type ModelCheckingResult = } | { result: "no_violation_found"; - explored_states: number; - termination_reason: TerminationReason; + explored_states?: number; + termination_reason?: TerminationReason; traces_run?: number; max_traces?: number; trace?: TraceData | null; @@ -369,7 +369,15 @@ const ResultHeader: React.FC<{ const countSuffix = count !== undefined ? ` (explored ${count} states)` : ''; const countText = count !== undefined ? `Explored ${count} states` : null; - if (!reason) return countText; + if (!reason) { + if (tracesRun !== undefined && maxTraces !== undefined) { + return `Checked ${tracesRun}/${maxTraces} traces`; + } + if (tracesRun !== undefined) { + return `Checked ${tracesRun} traces`; + } + return countText; + } if (reason.kind === "explored_all_reachable_states") { return count !== undefined ? `Explored all reachable states (${count})` : `Explored all reachable states`; } From 0ebceb95c623a69221357005a89a6715f34bcc6d Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 7 May 2026 18:43:20 +0200 Subject: [PATCH 57/88] refactor(model-checker): share invariant violation helper --- Veil/Core/Tools/ModelChecker/Concrete/Core.lean | 3 +-- Veil/Core/Tools/ModelChecker/Interface.lean | 6 ++++++ Veil/Core/Tools/ModelChecker/Simulation/Basic.lean | 6 ------ 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean index 973d7002..ad4e6c30 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean @@ -221,8 +221,7 @@ def checkViolationsAndMaybeTerminate (assertionFailures : List (Int × σ)) : List (σₕ × ViolationKind) × Option (EarlyTerminationReason σₕ) := -- Compute all violation conditions once - let safetyViolations := params.invariants.filterMap fun p => - if !p.holdsOn th curr then some p.name else none + let safetyViolations := violatedInvariantNames params th curr let safetyViolation := !safetyViolations.isEmpty let deadlock := !hasSuccessfulTransition && !params.terminating.holdsOn th curr diff --git a/Veil/Core/Tools/ModelChecker/Interface.lean b/Veil/Core/Tools/ModelChecker/Interface.lean index d7e3b15d..85c82570 100644 --- a/Veil/Core/Tools/ModelChecker/Interface.lean +++ b/Veil/Core/Tools/ModelChecker/Interface.lean @@ -262,6 +262,12 @@ structure SearchParameters (ρ σ : Type) where def SearchParameters.satisfiesConstraints (params : SearchParameters ρ σ) (th : ρ) (st : σ) : Bool := params.stateConstraints.all fun c => c.holdsOn th st +@[inline] +def violatedInvariantNames {ρ σ : Type} + (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := + params.invariants.filterMap fun p => + if !p.holdsOn th st then some p.name else none + -- class ModelChecker (ts : TransitionSystem ρ σ l) where -- isReachable : SearchParameters ρ σ → Option ParallelConfig → ModelCheckingResult ρ σ l σₕ diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index 672d5dc7..a14275d3 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -21,12 +21,6 @@ structure SimulateResult (ρ σ κ : Type) where seed : Nat depth : Nat -@[inline] -def violatedInvariantNames {ρ σ : Type} - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := - params.invariants.filterMap fun p => - if !p.holdsOn th st then some p.name else none - @[inline] def filterInitStatesByConstraints {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) From 18746f9915c639ccc7b044875ce55fe53075f80e Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 8 May 2026 01:39:19 +0200 Subject: [PATCH 58/88] refactor(simulate): restrict constrained system once --- .../Tools/ModelChecker/Simulation/Basic.lean | 20 +++++-------- .../Tools/ModelChecker/Simulation/Path.lean | 12 ++++---- .../ModelChecker/Simulation/Runtime.lean | 26 +++++++++------- .../ModelChecker/Simulation/Soundness.lean | 30 +++++++++---------- 4 files changed, 43 insertions(+), 45 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index a14275d3..48602c00 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -22,23 +22,17 @@ structure SimulateResult (ρ σ κ : Type) where depth : Nat @[inline] -def filterInitStatesByConstraints {ρ σ κ : Type} {th₀ : ρ} +def restrictSystemByStateConstraints {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) : List σ := - if params.stateConstraints.isEmpty then sys.initStates - else sys.initStates.filter (params.satisfiesConstraints th) - -@[inline] -def filterOutcomesByConstraints {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List (κ × ExecutionOutcome Int σ) := - if params.stateConstraints.isEmpty then - sys.tr th st - else - (sys.tr th st).filter fun (_, outcome) => + (params : SearchParameters ρ σ) (th : ρ) : + EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀ := + if params.stateConstraints.isEmpty then sys else { + initStates := sys.initStates.filter (params.satisfiesConstraints th) + tr := fun th' st => (sys.tr th' st).filter fun (_, outcome) => match outcome with | .success st' => params.satisfiesConstraints th st' | .assertionFailure _ st' => params.satisfiesConstraints th st' | .divergence => true + } end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 754bbf31..23a1fc89 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -16,7 +16,7 @@ private def assertionFailureWitness {σ κ : Type} : κ × ExecutionOutcome Int def decideAtState {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := - let outcomes := filterOutcomesByConstraints sys params th currSt + let outcomes := sys.tr th currSt let failingStep := outcomes.findSome? assertionFailureWitness match failingStep with | some (exId, step) => .assertionFailure exId step @@ -32,9 +32,9 @@ theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} (exId : Int) (step : Step σ κ) : decideAtState sys params th currSt = .assertionFailure exId step -> (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params th currSt := by + sys.tr th currSt := by intro h - let outcomes := filterOutcomesByConstraints sys params th currSt + let outcomes := sys.tr th currSt cases hFind : outcomes.findSome? assertionFailureWitness with | none => cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with @@ -67,9 +67,9 @@ theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) : decideAtState sys params th currSt = .continue nexts hNonempty -> nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst := by + (sys.tr th currSt)).fst := by intro h - let outcomes := filterOutcomesByConstraints sys params th currSt + let outcomes := sys.tr th currSt cases hFind : outcomes.findSome? assertionFailureWitness with | some found => have : False := by @@ -184,7 +184,7 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (gen : StdGen) (maxSteps : Nat) : Option (SimulationResult ρ σ κ) × StdGen × Nat := - let initStates := filterInitStatesByConstraints sys params th + let initStates := sys.initStates match initStates with | [] => (none, gen, 0) | hd :: tl => diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 577ca73d..2ca736e1 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -14,9 +14,8 @@ private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : Sim } private def hasNoInitialStates {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) : Bool := - (filterInitStatesByConstraints sys params th).isEmpty + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) : Bool := + sys.initStates.isEmpty private structure SimulationHooks (m : Type → Type) where shouldStop : Nat → m Bool @@ -120,7 +119,8 @@ def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} (shouldStop : Nat → Bool) (cfg : SimulateConfig) : SimulateResult ρ σ κ := - if hasNoInitialStates sys params th then + let sys := restrictSystemByStateConstraints sys params th + if hasNoInitialStates sys then noInitialStatesResult cfg else simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 @@ -146,7 +146,8 @@ def simulateWithProgress {ρ σ κ : Type} {th₀ : ρ} let actualSeed ← if cfg.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg.seed let cfg := { cfg with seed := actualSeed } let startMs ← IO.monoMsNow - if hasNoInitialStates sys params th then + let sys := restrictSystemByStateConstraints sys params th + if hasNoInitialStates sys then let simResult := { noInitialStatesResult cfg with elapsedMs := (← IO.monoMsNow) - startMs } Veil.ModelChecker.Concrete.updateSimulationProgress progressInstanceId "Complete" @@ -223,13 +224,15 @@ theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (shouldStop : Nat → Bool) (cfg : SimulateConfig) : - ReportedViolationSound sys params (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by - cases hNoInit : hasNoInitialStates sys params th with + ReportedViolationSound (restrictSystemByStateConstraints sys params th) params + (SimulateResult.result (simulateCommandSemantics sys params th shouldStop cfg)) := by + let restrictedSys := restrictSystemByStateConstraints sys params th + cases hNoInit : hasNoInitialStates restrictedSys with | true => - simp [simulateCommandSemantics, hNoInit, noInitialStatesResult, ReportedViolationSound] + simp [simulateCommandSemantics, restrictedSys, hNoInit, noInitialStatesResult, ReportedViolationSound] | false => - simpa [simulateCommandSemantics, hNoInit] using - simulateLoopM_id_sound sys params th cfg shouldStop cfg.maxTraces 0 + simpa [simulateCommandSemantics, restrictedSys, hNoInit] using + simulateLoopM_id_sound restrictedSys params th cfg shouldStop cfg.maxTraces 0 theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -238,7 +241,8 @@ theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (cfg : SimulateConfig) : - ReportedViolationSound sys params (SimulateResult.result (simulateCore sys params th cfg)) := by + ReportedViolationSound (restrictSystemByStateConstraints sys params th) params + (SimulateResult.result (simulateCore sys params th cfg)) := by simpa [simulateCore] using simulateCommandSemantics_sound sys params th (fun _ => false) cfg end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 36d8b79c..902e395b 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -16,11 +16,11 @@ private instance (priority := high) instLawfulBEqTransitionOutcome {σ κ : Type def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where + (_params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where assumptions := fun _ => True - init := fun th st => st ∈ filterInitStatesByConstraints sys params th + init := fun _ st => st ∈ sys.initStates tr := fun th st label st' => - (label, ExecutionOutcome.success st') ∈ filterOutcomesByConstraints sys params th st + (label, ExecutionOutcome.success st') ∈ sys.tr th st def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -29,7 +29,7 @@ def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} | [] => True | step :: steps => (step.transitionLabel, ExecutionOutcome.success step.nextState) ∈ - filterOutcomesByConstraints sys params th st ∧ + sys.tr th st ∧ StepList.validFromSimulation sys params th step.nextState steps theorem StepList.validFromSimulation_sound {ρ σ κ : Type} {th₀ : ρ} @@ -62,7 +62,7 @@ def Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := - trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory ∧ + trace.initialState ∈ sys.initStates ∧ StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} @@ -87,7 +87,7 @@ theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValid sys params trace := by intro h - have hInit : trace.initialState ∈ filterInitStatesByConstraints sys params trace.theory := by + have hInit : trace.initialState ∈ sys.initStates := by simpa [simulationTransitionSystem] using h.initialStateSatisfiesInit have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList := by exact StepList.validFromSimulation_complete sys params trace.theory trace.initialState trace.steps.toList (by @@ -101,7 +101,7 @@ theorem pickedTransition_valid {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) (nexts : List (κ × σ)) (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst) + (sys.tr th currSt)).fst) (hNonempty : nexts ≠ []) (gen : StdGen) : let picked := pickNextTransition nexts gen hNonempty (simulationTransitionSystem sys params).tr th currSt picked.value.1 picked.value.2 := by @@ -109,7 +109,7 @@ theorem pickedTransition_valid {ρ σ κ : Type} {th₀ : ρ} have hmem : picked.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty have hGood : picked.value ∈ (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst := by + (sys.tr th currSt)).fst := by simpa [hNexts] using hmem exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hGood @@ -119,7 +119,7 @@ theorem pickedInitialState_valid {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (initStates : List σ) - (hInitStates : initStates = filterInitStatesByConstraints sys params th) + (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : let picked := pickInitialState initStates gen hNonempty ({ theory := th, initialState := picked.value, steps := #[] } : Trace ρ σ κ).isValid @@ -143,7 +143,7 @@ private theorem pushedTrace_valid {ρ σ κ : Type} {th₀ : ρ} (hNoFail : trace.failingStep = none) (nexts : List (κ × σ)) (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst) + (sys.tr th currSt)).fst) (hNonempty : nexts ≠ []) (gen : StdGen) : let picked := pickNextTransition nexts gen hNonempty @@ -167,7 +167,7 @@ private theorem initialTrace_valid {ρ σ κ : Type} {th₀ : ρ} (params : SearchParameters ρ σ) (th : ρ) (initStates : List σ) - (hInitStates : initStates = filterInitStatesByConstraints sys params th) + (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : let picked := pickInitialState initStates gen hNonempty @@ -217,7 +217,7 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} ∃ step, trace.failingStep = some step ∧ (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params trace.theory trace.lastState + sys.tr trace.theory trace.lastState theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -266,7 +266,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} simp [simulateOnceLoop, hStep] at h cases h have hMem : (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - filterOutcomesByConstraints sys params th currSt := + sys.tr th currSt := decideAtState_assertionFailure_mem sys params th currSt exId step hStep let failedTrace := { trace with failingStep := some step } have hValidFail : failedTrace.isValid (simulationTransitionSystem sys params) := by @@ -291,7 +291,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} let picked := pickNextTransition nexts gen hNonempty let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } have hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (filterOutcomesByConstraints sys params th currSt)).fst := + (sys.tr th currSt)).fst := decideAtState_continue_nexts sys params th currSt nexts hNonempty hStep have hTrace' := pushedTrace_valid sys params th currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen have hValid' : trace'.isValid (simulationTransitionSystem sys params) := hTrace'.1 @@ -321,7 +321,7 @@ theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} ReportedViolationSound sys params (some result) := by intro h unfold simulateOnce at h - cases hStates : filterInitStatesByConstraints sys params th with + cases hStates : sys.initStates with | nil => simp [hStates] at h | cons initSt rest => let picked := pickInitialState (initSt :: rest) gen (by simp) From ad7cc3f344b77178c8ea347870898e9fa80b4e5c Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 8 May 2026 01:57:08 +0200 Subject: [PATCH 59/88] refactor(model-checker): move state constraint helper --- Veil/Core/Tools/ModelChecker/Interface.lean | 18 ++++++++++++++++++ .../Tools/ModelChecker/Simulation/Basic.lean | 14 -------------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Interface.lean b/Veil/Core/Tools/ModelChecker/Interface.lean index 85c82570..bc34ef0b 100644 --- a/Veil/Core/Tools/ModelChecker/Interface.lean +++ b/Veil/Core/Tools/ModelChecker/Interface.lean @@ -262,6 +262,24 @@ structure SearchParameters (ρ σ : Type) where def SearchParameters.satisfiesConstraints (params : SearchParameters ρ σ) (th : ρ) (st : σ) : Bool := params.stateConstraints.all fun c => c.holdsOn th st +/-- Create a filtered transition system that explores only states satisfying +state constraints. -/ +@[inline] +def restrictSystemByStateConstraints {ρ σ κ : Type} {th₀ : ρ} + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) + (params : SearchParameters ρ σ) (th : ρ) : + EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀ := + if params.stateConstraints.isEmpty then sys else { + initStates := sys.initStates.filter (params.satisfiesConstraints th) + tr := fun th' st => (sys.tr th' st).filter fun (_, outcome) => + match outcome with + | .success st' => params.satisfiesConstraints th st' + -- Assertion failures should satisfy constraints to be considered. + | .assertionFailure _ st' => params.satisfiesConstraints th st' + -- Divergence has no successor state to constrain. + | .divergence => true + } + @[inline] def violatedInvariantNames {ρ σ : Type} (params : SearchParameters ρ σ) (th : ρ) (st : σ) : List Lean.Name := diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index 48602c00..a2784a65 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -21,18 +21,4 @@ structure SimulateResult (ρ σ κ : Type) where seed : Nat depth : Nat -@[inline] -def restrictSystemByStateConstraints {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) : - EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀ := - if params.stateConstraints.isEmpty then sys else { - initStates := sys.initStates.filter (params.satisfiesConstraints th) - tr := fun th' st => (sys.tr th' st).filter fun (_, outcome) => - match outcome with - | .success st' => params.satisfiesConstraints th st' - | .assertionFailure _ st' => params.satisfiesConstraints th st' - | .divergence => true - } - end Veil.ModelChecker.Simulation From ebfbe4b43f1c96526ca8b552095a3db09b60c1b5 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 8 May 2026 01:57:12 +0200 Subject: [PATCH 60/88] refactor(model-checker): reuse state constraint helper --- Veil/Core/Tools/ModelChecker/Concrete/Checker.lean | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean b/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean index 3b543c21..f37037f9 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Checker.lean @@ -87,13 +87,7 @@ def findReachable {ρ σ κ : Type} {m : Type → Type} (cancelToken : IO.CancelToken) : m (ModelCheckingResult ρ σ κ UInt64) := do -- Create a "filtered" version of the system - let sys := if params.stateConstraints.isEmpty then sys else { - initStates := sys.initStates.filter (params.satisfiesConstraints th) - tr := fun th' s => (sys.tr th' s).filter (fun (_, o) => match o with - | .success s' => params.satisfiesConstraints th s' - | .assertionFailure _ s' => params.satisfiesConstraints th s' -- assertion failures should satisfy constraints to be considered - | .divergence => true) -- well - } + let sys := Veil.ModelChecker.restrictSystemByStateConstraints sys params th let (ctx, distinctCount) ← match parallelCfg with | some cfg => do let mctx ← breadthFirstSearchParallel params sys cfg progressInstanceId cancelToken From e5435511176d5d9e032cb5706847baf622cba313 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 8 May 2026 02:13:08 +0200 Subject: [PATCH 61/88] refactor(simulate): reuse model checker result json --- Veil/Core/Tools/ModelChecker/Simulation/Result.lean | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index 200aeb01..2c0d50fe 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -6,13 +6,10 @@ open Lean private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (result : Option (SimulationResult ρ σ κ)) : Json := match result with - | some (.foundViolation violation trace) => Json.mkObj - [ ("result", "found_violation") - , ("violation", toJson violation) - , ("trace", toJson trace) - , ("state_fingerprint", Json.null) - ] - | some .cancelled => Json.mkObj [("result", "cancelled")] + | some (.foundViolation violation trace) => + toJson (ModelCheckingResult.foundViolation Json.null violation (some trace) : ModelCheckingResult ρ σ κ Json) + | some .cancelled => + toJson (ModelCheckingResult.cancelled : ModelCheckingResult ρ σ κ Json) | none => Json.mkObj [("result", "no_violation_found")] instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where From b42bb4393324811d0c1cd07ae563661179a44753 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 14:35:12 +0200 Subject: [PATCH 62/88] fix(simulate): unify result json serialization --- .../Tools/ModelChecker/Simulation/Result.lean | 27 +++++-------------- VeilTest/Regression/SimulateResultJson.lean | 2 +- 2 files changed, 8 insertions(+), 21 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index 2c0d50fe..1a30efb3 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -12,9 +12,7 @@ private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] toJson (ModelCheckingResult.cancelled : ModelCheckingResult ρ σ κ Json) | none => Json.mkObj [("result", "no_violation_found")] -instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where - toJson r := Json.mkObj [ - ("result", resultToJson r.result), +private def metadataToJsonFields {ρ σ κ : Type} (r : SimulateResult ρ σ κ) : List (String × Json) := [ ("traces_run", Lean.toJson r.tracesRun), ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), @@ -22,25 +20,14 @@ instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJ ("depth", Lean.toJson r.depth) ] +/-- Flatten the result object while keeping simulation metadata at the top level. -/ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] (r : SimulateResult ρ σ κ) : Json := match resultToJson r.result with - | Json.obj kvs => - Json.mkObj <| kvs.toList ++ [ - ("traces_run", Lean.toJson r.tracesRun), - ("max_traces", Lean.toJson r.maxTraces), - ("elapsed_ms", Lean.toJson r.elapsedMs), - ("seed", Lean.toJson r.seed), - ("depth", Lean.toJson r.depth) - ] - | other => - Json.mkObj [ - ("result", other), - ("traces_run", Lean.toJson r.tracesRun), - ("max_traces", Lean.toJson r.maxTraces), - ("elapsed_ms", Lean.toJson r.elapsedMs), - ("seed", Lean.toJson r.seed), - ("depth", Lean.toJson r.depth) - ] + | Json.obj kvs => Json.mkObj <| kvs.toList ++ metadataToJsonFields r + | other => Json.mkObj <| ("result", other) :: metadataToJsonFields r + +instance instToJsonSimulateResult {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] : ToJson (SimulateResult ρ σ κ) where + toJson r := SimulateResult.toDisplayJson r end Veil.ModelChecker.Simulation diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean index b7b0eeaf..fe4202b6 100644 --- a/VeilTest/Regression/SimulateResultJson.lean +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -4,7 +4,7 @@ open Veil.ModelChecker open Veil.ModelChecker.Simulation /-- -info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":{"result":"no_violation_found"},"seed":1,"traces_run":3} +info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","seed":1,"traces_run":3} -/ #guard_msgs in #eval IO.println <| (Lean.toJson ({ From 93793e53c9688e19aaa175cb3ab664ca5b8699ec Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 15:07:17 +0200 Subject: [PATCH 63/88] refactor(model-checker): remove unused status prefix --- Veil/Frontend/DSL/Module/Elaborators.lean | 2 +- Veil/Frontend/DSL/Module/Util/ForModelChecker.lean | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index bb3dd1a4..5dd627b7 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -941,7 +941,7 @@ where command commandId { cmd := "lake", args := #["build", "ModelCheckerMain"], cwd := buildFolder } - instanceId "Compiling model" cancelToken + instanceId cancelToken (fun elapsedMs => ModelChecker.Concrete.updateCompilationElapsed instanceId elapsedMs) (fun line isError elapsedMs => ModelChecker.Concrete.updateCompilationLog instanceId elapsedMs line isError) if result.interrupted then diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index 6b6ad531..dedb0858 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -233,7 +233,7 @@ def runProcessWithStatus (sourceFile : String) (command : CompiledCommandSpec) ( checking both explicit cancellation and whether this compilation is still current. -/ def runProcessWithStatusCallback (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) (cfg : IO.Process.SpawnArgs) - (instanceId : Nat) (_statusPrefix : String) (cancelToken : IO.CancelToken) + (instanceId : Nat) (cancelToken : IO.CancelToken) (statusCallback : Nat → IO Unit) (lineCallback : String → Bool → Nat → IO Unit := fun _ _ _ => pure ()) : IO ProcessResult := do From ea1dc6b2d09aa929b76304e13df6107c4f453503 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 15:35:39 +0200 Subject: [PATCH 64/88] refactor(frontend): remove unnecessary prime from ident helper --- Veil/Frontend/DSL/Module/Elaborators.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 5dd627b7..2bab9f36 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -678,7 +678,7 @@ private def resolveTheoryTerm (cmdName : String) (theoryTermOpt : Option Term) `({}) /-- Prepend `name` with `mod.name`. -/ -private def mkIdentWithModName' (mod : Module) (name : Name) : Ident := +private def mkIdentWithModName (mod : Module) (name : Name) : Ident := Lean.mkIdent (mod.name ++ name) /-- Build search parameters for model checking / simulation. -/ @@ -686,12 +686,12 @@ private def buildSearchParameters (mod : Module) (config : ModelCheckerConfig) : let mkAssumption (sa : StateAssertion) : CommandElabM Term := `($(mkIdent ``Veil.ModelChecker.TheoryProperty.mk) ($(mkIdent `name) := $(quote sa.name)) - ($(mkIdent `property) := fun $(mkIdent `th) => $(mkIdentWithModName' mod sa.name) $(mkIdent `th))) + ($(mkIdent `property) := fun $(mkIdent `th) => $(mkIdentWithModName mod sa.name) $(mkIdent `th))) -- Build SafetyProperty.mk syntax for a StateAssertion let mkProp (sa : StateAssertion) : CommandElabM Term := `($(mkIdent ``Veil.ModelChecker.SafetyProperty.mk) ($(mkIdent `name) := $(quote sa.name)) - ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName' mod sa.name) $(mkIdent `th) $(mkIdent `st))) + ($(mkIdent `property) := fun $(mkIdent `th) $(mkIdent `st) => $(mkIdentWithModName mod sa.name) $(mkIdent `th) $(mkIdent `st))) let assumptionList ← `([$((← mod.assumptions.mapM mkAssumption)),*]) let safetyList ← `([$((← mod.invariants.mapM mkProp)),*]) -- FIXME: Only recognizing the first termination property might confuse users @@ -770,7 +770,7 @@ where let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Concrete.findReachable) ($(mkIdent `inhabσ) := $instInhabitedStateFieldConcreteType) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + ($(mkIdentWithModName mod `enumerableTransitionSystem) $instSortArgs* $th) $sp : _ → _ → _ → IO _)) /-- Check that the provided theory satisfies all module assumptions by @@ -1089,7 +1089,7 @@ private def mkSimulatorRuntimeCall (mod : Module) (instTerm theoryTerm : Term) `((let $inst : $instantiationType := $instTerm let $th : $theoryIdent $instSortArgs* := $theoryTerm $(mkIdent ``Veil.ModelChecker.Simulation.simulateWithProgress) - ($(mkIdentWithModName' mod `enumerableTransitionSystem) $instSortArgs* $th) + ($(mkIdentWithModName mod `enumerableTransitionSystem) $instSortArgs* $th) $sp $th $cfgTerm : _ → _ → IO _)) /-- Build the simulator runtime call syntax with progress and cancellation hooks. -/ From 8550732f6ed6e307d1248db358cd71b9dc62a62a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 16:31:08 +0200 Subject: [PATCH 65/88] refactor(simulation): use relational transition system directly --- .../ModelChecker/Simulation/Runtime.lean | 24 +-- .../ModelChecker/Simulation/Soundness.lean | 181 +++++++++--------- 2 files changed, 102 insertions(+), 103 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 2ca736e1..da049a4d 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -186,12 +186,12 @@ def simulate {ρ σ κ : Type} {th₀ : ρ} let cancelToken ← IO.CancelToken.new simulateWithProgress sys params th cfg 0 cancelToken -private theorem simulateLoopM_id_sound {ρ σ κ : Type} {th₀ : ρ} +private theorem simulateLoopM_id_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (cfg : SimulateConfig) (shouldStop : Nat → Bool) : ∀ remaining traceIndex, @@ -214,14 +214,14 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} {th₀ : ρ} | some pair => rcases pair with ⟨result, depth⟩ simpa [simulateLoopId, hStop, hRun] using - runTraceAtSeed_sound sys params th cfg traceIndex result depth hRun + runTraceAtSeed_sound th sys params cfg traceIndex result depth hRun -theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} +theorem simulateCommandSemantics_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (shouldStop : Nat → Bool) (cfg : SimulateConfig) : ReportedViolationSound (restrictSystemByStateConstraints sys params th) params @@ -232,17 +232,17 @@ theorem simulateCommandSemantics_sound {ρ σ κ : Type} {th₀ : ρ} simp [simulateCommandSemantics, restrictedSys, hNoInit, noInitialStatesResult, ReportedViolationSound] | false => simpa [simulateCommandSemantics, restrictedSys, hNoInit] using - simulateLoopM_id_sound restrictedSys params th cfg shouldStop cfg.maxTraces 0 + simulateLoopM_id_sound th restrictedSys params cfg shouldStop cfg.maxTraces 0 -theorem simulateCore_sound {ρ σ κ : Type} {th₀ : ρ} +theorem simulateCore_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (cfg : SimulateConfig) : ReportedViolationSound (restrictSystemByStateConstraints sys params th) params (SimulateResult.result (simulateCore sys params th cfg)) := by - simpa [simulateCore] using simulateCommandSemantics_sound sys params th (fun _ => false) cfg + simpa [simulateCore] using simulateCommandSemantics_sound th sys params (fun _ => false) cfg end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 88e17bd4..cdb55f4d 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -13,15 +13,6 @@ private instance (priority := high) instLawfulBEqTransitionOutcome {σ κ : Type eq_of_beq := of_decide_eq_true rfl := of_decide_eq_self_eq_true _ -def simulationTransitionSystem {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (_params : SearchParameters ρ σ) : RelationalTransitionSystem ρ σ κ where - assumptions := fun _ => True - init := fun _ st => st ∈ sys.initStates - tr := fun th st label st' => - (label, ExecutionOutcome.success st') ∈ sys.tr th st - def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -32,31 +23,33 @@ def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} sys.tr th st ∧ StepList.validFromSimulation sys params th step.nextState steps -theorem StepList.validFromSimulation_sound {ρ σ κ : Type} {th₀ : ρ} +theorem StepList.validFromSimulation_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : + (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (st : σ) : ∀ steps, StepList.validFromSimulation sys params th st steps → - StepList.validFrom (simulationTransitionSystem sys params) th st steps + StepList.validFrom sys.toRelational th st steps | [], _ => by simp [StepList.validFrom] | step :: steps, h => by rcases h with ⟨hStep, hTail⟩ constructor - · simpa [simulationTransitionSystem] using hStep - · exact StepList.validFromSimulation_sound sys params th step.nextState steps hTail + · simpa [EnumerableTransitionSystem.toRelational] using hStep + · exact StepList.validFromSimulation_sound th sys params step.nextState steps hTail -theorem StepList.validFromSimulation_complete {ρ σ κ : Type} {th₀ : ρ} +theorem StepList.validFromSimulation_complete {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : - ∀ steps, StepList.validFrom (simulationTransitionSystem sys params) th st steps -> + (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (st : σ) : + ∀ steps, StepList.validFrom sys.toRelational th st steps -> StepList.validFromSimulation sys params th st steps | [], _ => by simp [StepList.validFromSimulation] | step :: steps, h => by rcases h with ⟨hStep, hTail⟩ constructor - · simpa [simulationTransitionSystem] using hStep - · exact StepList.validFromSimulation_complete sys params th step.nextState steps hTail + · simpa [EnumerableTransitionSystem.toRelational] using hStep + · exact StepList.validFromSimulation_complete th sys params step.nextState steps hTail def Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -65,80 +58,85 @@ def Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} trace.initialState ∈ sys.initStates ∧ StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList -theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th₀ : ρ} +theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th : ρ} [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : - Trace.isSimulationValid sys params trace → trace.isValid (simulationTransitionSystem sys params) := by + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) : + Trace.isSimulationValid sys params trace → trace.isValid sys.toRelational := by + subst th intro h rcases h with ⟨hInit, hSteps⟩ refine { - theorySatisfiesAssumptions := by simp [simulationTransitionSystem] + theorySatisfiesAssumptions := by simp [EnumerableTransitionSystem.toRelational] initialStateSatisfiesInit := ?_ stepsValid := ?_ } - · simpa [simulationTransitionSystem] using hInit + · simpa [EnumerableTransitionSystem.toRelational] using hInit · simpa [Steps.validFrom] using - StepList.validFromSimulation_sound sys params trace.theory trace.initialState trace.steps.toList hSteps + StepList.validFromSimulation_sound trace.theory sys params trace.initialState trace.steps.toList hSteps -theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th₀ : ρ} +theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th : ρ} [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : - trace.isValid (simulationTransitionSystem sys params) -> Trace.isSimulationValid sys params trace := by + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) : + trace.isValid sys.toRelational -> Trace.isSimulationValid sys params trace := by + subst th intro h have hInit : trace.initialState ∈ sys.initStates := by - simpa [simulationTransitionSystem] using h.initialStateSatisfiesInit + simpa [EnumerableTransitionSystem.toRelational] using h.initialStateSatisfiesInit have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList := by - exact StepList.validFromSimulation_complete sys params trace.theory trace.initialState trace.steps.toList (by + exact StepList.validFromSimulation_complete trace.theory sys params trace.initialState trace.steps.toList (by simpa [Steps.validFrom] using h.stepsValid) exact ⟨hInit, hSteps⟩ -theorem pickedTransition_valid {ρ σ κ : Type} {th₀ : ρ} +theorem pickedTransition_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) + (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (_params : SearchParameters ρ σ) (currSt : σ) (nexts : List (κ × σ)) (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst) (hNonempty : nexts ≠ []) (gen : StdGen) : let picked := pickNextTransition nexts gen hNonempty - (simulationTransitionSystem sys params).tr th currSt picked.value.1 picked.value.2 := by + sys.toRelational.tr th currSt picked.value.1 picked.value.2 := by intro picked have hmem : picked.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty have hGood : picked.value ∈ (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := by simpa [hNexts] using hmem - exact (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hGood + simpa [EnumerableTransitionSystem.toRelational] using + (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hGood -theorem pickedInitialState_valid {ρ σ κ : Type} {th₀ : ρ} +theorem pickedInitialState_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (_params : SearchParameters ρ σ) (initStates : List σ) (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : let picked := pickInitialState initStates gen hNonempty ({ theory := th, initialState := picked.value, steps := #[] } : Trace ρ σ κ).isValid - (simulationTransitionSystem sys params) := by + sys.toRelational := by intro picked have hmem : picked.value ∈ initStates := by simpa [picked] using pickInitialState_mem initStates gen hNonempty - refine Trace.isValid_empty (simulationTransitionSystem sys params) th picked.value ?_ ?_ - · simp [simulationTransitionSystem] - · simpa [simulationTransitionSystem, hInitStates] using hmem + refine Trace.isValid_empty sys.toRelational th picked.value ?_ ?_ + · simp [EnumerableTransitionSystem.toRelational] + · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hmem -private theorem pushedTrace_valid {ρ σ κ : Type} {th₀ : ρ} +private theorem pushedTrace_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (currSt : σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) - (hValid : trace.isValid (simulationTransitionSystem sys params)) + (hValid : trace.isValid sys.toRelational) (hLast : trace.lastState = currSt) (hNoFail : trace.failingStep = none) (nexts : List (κ × σ)) @@ -148,36 +146,35 @@ private theorem pushedTrace_valid {ρ σ κ : Type} {th₀ : ρ} (gen : StdGen) : let picked := pickNextTransition nexts gen hNonempty let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } - trace'.isValid (simulationTransitionSystem sys params) ∧ + trace'.isValid sys.toRelational ∧ trace'.theory = th ∧ trace'.lastState = picked.value.2 ∧ trace'.failingStep = none := by intro picked trace' - have hRel : (simulationTransitionSystem sys params).tr th currSt picked.value.1 picked.value.2 := - pickedTransition_valid sys params th currSt nexts hNexts hNonempty gen - have hValid' : trace'.isValid (simulationTransitionSystem sys params) := by - subst hTheory + have hRel : sys.toRelational.tr th currSt picked.value.1 picked.value.2 := + pickedTransition_valid th sys params currSt nexts hNexts hNonempty gen + have hValid' : trace'.isValid sys.toRelational := by exact Trace.push_isValid trace { transitionLabel := picked.value.1, nextState := picked.value.2 } - (simulationTransitionSystem sys params) hValid (by simpa [hLast] using hRel) + sys.toRelational hValid (by simpa [hTheory, hLast] using hRel) exact ⟨hValid', by simpa [trace', hTheory], by simp [trace'], by simpa [trace', hNoFail]⟩ -private theorem initialTrace_valid {ρ σ κ : Type} {th₀ : ρ} +private theorem initialTrace_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (initStates : List σ) (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : let picked := pickInitialState initStates gen hNonempty let trace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } - trace.isValid (simulationTransitionSystem sys params) ∧ + trace.isValid sys.toRelational ∧ trace.theory = th ∧ trace.lastState = picked.value ∧ - trace.failingStep = none := by + trace.failingStep = none := by intro picked trace - have hValid := pickedInitialState_valid sys params th initStates hInitStates hNonempty gen + have hValid := pickedInitialState_valid th sys params initStates hInitStates hNonempty gen exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ instance instDecidableStepListValidFromSimulation {ρ σ κ : Type} {th₀ : ρ} @@ -223,18 +220,19 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ sys.tr trace.theory trace.lastState -theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th₀ : ρ} +theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th : ρ} [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) + (hTheory : trace.theory = th) : Trace.witnessesSimulationViolation sys params trace violation → - trace.isValid (simulationTransitionSystem sys params) := by + trace.isValid sys.toRelational := by intro h cases violation with - | assumptionFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 - | safetyFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 - | deadlock => exact Trace.isSimulationValid_sound sys params trace h.1 - | assertionFailure _ => exact Trace.isSimulationValid_sound sys params trace h.1 + | assumptionFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 + | safetyFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 + | deadlock => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 + | assertionFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 def ReportedViolationSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -245,15 +243,15 @@ def ReportedViolationSound {ρ σ κ : Type} {th₀ : ρ} | some .cancelled => True | none => True -theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} +theorem simulateOnceLoop_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (currSt : σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) - (hValid : trace.isValid (simulationTransitionSystem sys params)) + (hValid : trace.isValid sys.toRelational) (hLast : trace.lastState = currSt) (hNoFail : trace.failingStep = none) : ∀ stepsLeft gen result, @@ -274,13 +272,13 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} sys.tr th currSt := decideAtState_assertionFailure_mem sys params th currSt exId step hStep let failedTrace := { trace with failingStep := some step } - have hValidFail : failedTrace.isValid (simulationTransitionSystem sys params) := by + have hValidFail : failedTrace.isValid sys.toRelational := by exact { theorySatisfiesAssumptions := hValid.theorySatisfiesAssumptions initialStateSatisfiesInit := hValid.initialStateSatisfiesInit stepsValid := hValid.stepsValid } - refine ⟨Trace.isSimulationValid_complete sys params failedTrace hValidFail, step, rfl, ?_⟩ + refine ⟨Trace.isSimulationValid_complete sys params failedTrace (by simp [failedTrace, hTheory]) hValidFail, step, rfl, ?_⟩ have hLastFail : failedTrace.lastState = currSt := by simpa [failedTrace, Trace.lastState] using hLast rw [hLastFail] @@ -288,7 +286,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} | deadlock => simp [simulateOnceLoop, hStep] at h cases h - exact ⟨Trace.isSimulationValid_complete sys params trace hValid, hNoFail, + exact ⟨Trace.isSimulationValid_complete sys params trace hTheory hValid, hNoFail, by simpa [hTheory, hLast] using hStep⟩ | terminated => simp [simulateOnceLoop, hStep] at h @@ -298,8 +296,8 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} have hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := decideAtState_continue_nexts sys params th currSt nexts hNonempty hStep - have hTrace' := pushedTrace_valid sys params th currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen - have hValid' : trace'.isValid (simulationTransitionSystem sys params) := hTrace'.1 + have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen + have hValid' : trace'.isValid sys.toRelational := hTrace'.1 have hTheory' : trace'.theory = th := hTrace'.2.1 have hNoFail' : trace'.failingStep = none := hTrace'.2.2.2 have hLast' : trace'.lastState = picked.value.2 := hTrace'.2.2.1 @@ -316,12 +314,13 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} {th₀ : ρ} have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = violatedInvariantNames params th picked.value.2 := by simp [hTheory', hLast'] - exact ⟨Trace.isSimulationValid_complete sys params trace' hValid', hNoFail', hViolEq, hNonempty⟩ + exact ⟨Trace.isSimulationValid_complete sys params trace' hTheory' hValid', hNoFail', hViolEq, hNonempty⟩ -theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} +theorem simulateOnce_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (gen : StdGen) (maxSteps : Nat) (result : SimulationResult ρ σ κ) : + (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (gen : StdGen) (maxSteps : Nat) (result : SimulationResult ρ σ κ) : (simulateOnce sys params th gen maxSteps).1 = some result -> ReportedViolationSound sys params (some result) := by intro h @@ -331,27 +330,27 @@ theorem simulateOnce_sound {ρ σ κ : Type} {th₀ : ρ} | cons initSt rest => let picked := pickInitialState (initSt :: rest) gen (by simp) let initTrace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } - have hInit := initialTrace_valid sys params th (initSt :: rest) hStates.symm (by simp) gen - have hValid : initTrace.isValid (simulationTransitionSystem sys params) := hInit.1 + have hInit := initialTrace_valid th sys params (initSt :: rest) hStates.symm (by simp) gen + have hValid : initTrace.isValid sys.toRelational := hInit.1 have hLast : initTrace.lastState = picked.value := hInit.2.2.1 have hNoFail : initTrace.failingStep = none := hInit.2.2.2 cases hViol : (violatedInvariantNames params th picked.value).isEmpty with | true => simp [hStates, picked, hViol] at h - exact simulateOnceLoop_sound sys params th picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h + exact simulateOnceLoop_sound th sys params picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h | false => simp [hStates, picked, hViol] at h cases h have hNonempty : violatedInvariantNames params th picked.value ≠ [] := by intro hNil simp [hNil] at hViol - exact ⟨Trace.isSimulationValid_complete sys params initTrace hValid, hNoFail, rfl, hNonempty⟩ + exact ⟨Trace.isSimulationValid_complete sys params initTrace rfl hValid, hNoFail, rfl, hNonempty⟩ -theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} +theorem runTraceAtSeed_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) + (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) + (params : SearchParameters ρ σ) (cfg : SimulateConfig) (traceIndex : Nat) (result : SimulationResult ρ σ κ) (depth : Nat) : @@ -370,6 +369,6 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} {th₀ : ρ} subst hSome have hSimSome : (simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps).1 = some result' := by simp [hSim, hMaybe] - exact simulateOnce_sound sys params th (mkStdGen traceSeed) cfg.maxSteps result' hSimSome + exact simulateOnce_sound th sys params (mkStdGen traceSeed) cfg.maxSteps result' hSimSome end Veil.ModelChecker.Simulation From 732188c09bd47aa7d071d44133f29b4bbabf1bb7 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 18:27:41 +0200 Subject: [PATCH 66/88] refactor(simulation): reuse execution outcome partitioning --- .../Tools/ModelChecker/Concrete/Core.lean | 23 +++++-- .../Tools/ModelChecker/Simulation/Path.lean | 69 ++++++++++--------- 2 files changed, 51 insertions(+), 41 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean index ad4e6c30..a144bad5 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Core.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Core.lean @@ -192,16 +192,16 @@ def BaseSearchContext.initial (initialStates : List σ) : BaseSearchContext σ -- achieve zero additional memory allocation here? /-- Partition a list of `(label × ExecutionOutcome)` pairs into two components: -a list of successful transitions, and a list of transitions where exceptions -were raised. The divergence part is discarded. -/ +a list of successful transitions, and a list of labeled transitions where +exceptions were raised. The divergence part is discarded. -/ def partitionExecutionOutcome (outcomes : List (κ × ExecutionOutcome Int σ)) : - List (κ × σ) × List (Int × σ) := + List (κ × σ) × List (κ × Int × σ) := outcomes.foldr (init := ([], [])) (fun (label, outcome) (succs, exns) => match outcome with | .success st => ((label, st) :: succs, exns) - | .assertionFailure exId st => (succs, (exId, st) :: exns) + | .assertionFailure exId st => (succs, (label, exId, st) :: exns) | .divergence => (succs, exns)) theorem partitionExecutionOutcome.fst_spec {κ σ : Type} (outcomes : List (κ × ExecutionOutcome Int σ)) : @@ -213,12 +213,21 @@ theorem partitionExecutionOutcome.fst_spec {κ σ : Type} (outcomes : List (κ | nil => simp | cons x l ih => rcases x with ⟨l, _ | _ | _⟩ <;> grind +theorem partitionExecutionOutcome.snd_spec {κ σ : Type} (outcomes : List (κ × ExecutionOutcome Int σ)) : + ∀ (label : κ) (exId : Int) (st : σ), + (label, exId, st) ∈ (partitionExecutionOutcome outcomes).snd ↔ + (label, ExecutionOutcome.assertionFailure exId st) ∈ outcomes := by + introv ; unfold partitionExecutionOutcome + induction outcomes with + | nil => simp + | cons x l ih => rcases x with ⟨l, _ | _ | _⟩ <;> grind + -- NOTE: If this function is put inside `BaseSearchContext.checkViolationsAndMaybeTerminate`, -- `specialize` of `List.filterMap` may not exhibit def checkViolationsAndMaybeTerminate (completedDepth : Nat) (hasSuccessfulTransition : Bool) - (assertionFailures : List (Int × σ)) : + (assertionFailures : List (κ × Int × σ)) : List (σₕ × ViolationKind) × Option (EarlyTerminationReason σₕ) := -- Compute all violation conditions once let safetyViolations := violatedInvariantNames params th curr @@ -230,14 +239,14 @@ def checkViolationsAndMaybeTerminate (if safetyViolation then [(fpSt, .safetyFailure safetyViolations)] else []) ++ (if deadlock then [(fpSt, .deadlock)] else []) ++ -- NOTE: This should be further optimized to avoid extra memory allocation - (assertionFailures.map fun (exId, _) => (fpSt, .assertionFailure exId)) + (assertionFailures.map fun (_, exId, _) => (fpSt, .assertionFailure exId)) let earlyTermination := params.earlyTerminationConditions.findSome? fun | .foundViolatingState => if safetyViolation then some (.foundViolatingState fpSt safetyViolations) else none | .reachedDepthBound bound => if completedDepth >= bound then some (.reachedDepthBound bound) else none | .reachedTraceLimit _ => none | .deadlockOccurred => if deadlock then some (.deadlockOccurred fpSt) else none - | .assertionFailed => assertionFailures.head?.map fun (exId, _) => .assertionFailed fpSt exId + | .assertionFailed => assertionFailures.head?.map fun (_, exId, _) => .assertionFailed fpSt exId | .cancelled => none -- Cancellation is handled externally via cancel token, not through early termination conditions (newViolations, earlyTermination) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 23a1fc89..70a58c2a 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -9,19 +9,15 @@ inductive StepDecision (σ κ : Type) where | terminated | continue (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) -private def assertionFailureWitness {σ κ : Type} : κ × ExecutionOutcome Int σ → Option (Int × Step σ κ) - | (label, .assertionFailure exId st) => some (exId, { transitionLabel := label, nextState := st }) - | _ => none - def decideAtState {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := let outcomes := sys.tr th currSt - let failingStep := outcomes.findSome? assertionFailureWitness - match failingStep with - | some (exId, step) => .assertionFailure exId step - | none => - let (nexts, _) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes + let (nexts, assertionFailures) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes + match assertionFailures with + | (label, exId, st) :: _ => + .assertionFailure exId { transitionLabel := label, nextState := st } + | [] => match nexts with | [] => if !params.terminating.holdsOn th currSt then .deadlock else .terminated | hd :: tl => .continue (hd :: tl) (by simp) @@ -35,31 +31,33 @@ theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} sys.tr th currSt := by intro h let outcomes := sys.tr th currSt - cases hFind : outcomes.findSome? assertionFailureWitness with - | none => - cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with + cases hPart : Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes with + | mk nexts assertionFailures => + cases assertionFailures with + | nil => + cases nexts with | nil => by_cases hTerm : params.terminating.holdsOn th currSt = false · have : False := by - simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h + simp [decideAtState, outcomes, hPart, hTerm] at h exact False.elim this · have : False := by - simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h + simp [decideAtState, outcomes, hPart, hTerm] at h exact False.elim this | cons hd tl => have : False := by - simp [decideAtState, outcomes, hFind, hNexts] at h + simp [decideAtState, outcomes, hPart] at h exact False.elim this - | some found => - rcases found with ⟨foundExId, foundStep⟩ - simp [decideAtState, outcomes, hFind] at h + | cons failed _ => + rcases failed with ⟨label, foundExId, foundSt⟩ + simp [decideAtState, outcomes, hPart] at h rcases h with ⟨rfl, rfl⟩ - obtain ⟨entry, hEntryMem, hEntryEq⟩ := List.exists_of_findSome?_eq_some hFind - rcases entry with ⟨label, outcome⟩ - cases outcome <;> simp [assertionFailureWitness] at hEntryEq - case assertionFailure exId' st => - rcases hEntryEq with ⟨rfl, rfl⟩ - simpa [outcomes] using hEntryMem + have hFailed : (label, foundExId, foundSt) ∈ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).snd := by + rw [hPart] + simp + simpa [outcomes] using + (Veil.ModelChecker.Concrete.partitionExecutionOutcome.snd_spec outcomes label foundExId foundSt).mp hFailed theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -70,24 +68,27 @@ theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} (sys.tr th currSt)).fst := by intro h let outcomes := sys.tr th currSt - cases hFind : outcomes.findSome? assertionFailureWitness with - | some found => - have : False := by - simp [decideAtState, outcomes, hFind] at h - exact False.elim this - | none => - cases hNexts : (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).fst with + cases hPart : Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes with + | mk foundNexts assertionFailures => + cases assertionFailures with + | cons failed rest => + have : False := by + rcases failed with ⟨label, exId, st⟩ + simp [decideAtState, outcomes, hPart] at h + exact False.elim this + | nil => + cases foundNexts with | nil => by_cases hTerm : params.terminating.holdsOn th currSt = false · have : False := by - simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h + simp [decideAtState, outcomes, hPart, hTerm] at h exact False.elim this · have : False := by - simp [decideAtState, outcomes, hFind, hNexts, hTerm] at h + simp [decideAtState, outcomes, hPart, hTerm] at h exact False.elim this | cons hd tl => have h' := h - simp [decideAtState, outcomes, hFind, hNexts] at h' + simp [decideAtState, outcomes, hPart] at h' cases h' rfl From effe56d2df1a9d46212f465c02ccfc93162c421a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 19:58:58 +0200 Subject: [PATCH 67/88] refactor(simulation): use state monad for random traces --- .../Tools/ModelChecker/Simulation/Path.lean | 66 +++++++------ .../ModelChecker/Simulation/Soundness.lean | 97 ++++++++++++------- 2 files changed, 95 insertions(+), 68 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 70a58c2a..55bc6089 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -103,46 +103,54 @@ theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdG structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where value : κ × σ mem : value ∈ nexts - gen : StdGen def pickNextTransition {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) : PickedTransition nexts := + (nexts : List (κ × σ)) (h : nexts ≠ []) : StateM StdGen (PickedTransition nexts) := do + let gen ← get let p := randNat gen 0 (nexts.length - 1) let idx := p.1 let gen' := p.2 have hlt : idx < nexts.length := by dsimp [idx, p] exact randNat_lt_length nexts h gen - { value := nexts.get ⟨idx, hlt⟩ + set gen' + return { + value := nexts.get ⟨idx, hlt⟩ mem := by exact List.get_mem nexts ⟨idx, hlt⟩ - gen := gen' } + } theorem pickNextTransition_mem {σ κ : Type} (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) : - (pickNextTransition nexts gen h).value ∈ nexts := - (pickNextTransition nexts gen h).mem + ((pickNextTransition nexts h).run gen).1.value ∈ nexts := + ((pickNextTransition nexts h).run gen).1.mem structure PickedInitState {σ : Type} (initStates : List σ) where value : σ mem : value ∈ initStates - gen : StdGen def pickInitialState {σ : Type} - (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) : PickedInitState initStates := + (initStates : List σ) (h : initStates ≠ []) : StateM StdGen (PickedInitState initStates) := do + let gen ← get let p := randNat gen 0 (initStates.length - 1) let idx := p.1 let gen' := p.2 have hlt : idx < initStates.length := by dsimp [idx, p] exact randNat_lt_length initStates h gen - { value := initStates.get ⟨idx, hlt⟩ + set gen' + return { + value := initStates.get ⟨idx, hlt⟩ mem := by exact List.get_mem initStates ⟨idx, hlt⟩ - gen := gen' } + } theorem pickInitialState_mem {σ : Type} (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) : - (pickInitialState initStates gen h).value ∈ initStates := - (pickInitialState initStates gen h).mem + ((pickInitialState initStates h).run gen).1.value ∈ initStates := + ((pickInitialState initStates h).run gen).1.mem + +private def SimulationResult.depth {ρ σ κ : Type} : SimulationResult ρ σ κ → Nat + | .foundViolation _ trace => trace.steps.size + if trace.failingStep.isSome then 1 else 0 + | .cancelled => 0 @[inline, specialize] def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} @@ -152,29 +160,27 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (stepsLeft : Nat) (currSt : σ) (trace : Trace ρ σ κ) - (gen : StdGen) - : Option (SimulationResult ρ σ κ) × StdGen × Nat := + : StateM StdGen (Option (SimulationResult ρ σ κ)) := do match stepsLeft with - | 0 => (none, gen, 0) + | 0 => return none | stepsLeft + 1 => match decideAtState sys params th currSt with | .assertionFailure exId step => let failedTrace := { trace with failingStep := some step } - (some (.foundViolation (.assertionFailure exId) failedTrace), gen, trace.steps.size + 1) + return some (.foundViolation (.assertionFailure exId) failedTrace) | .deadlock => - (some (.foundViolation .deadlock trace), gen, trace.steps.size) + return some (.foundViolation .deadlock trace) | .terminated => - (none, gen, trace.steps.size) + return none | .continue nexts hNonempty => - let picked := pickNextTransition nexts gen hNonempty + let picked ← pickNextTransition nexts hNonempty let (label, nextSt) := picked.value - let gen := picked.gen let trace := trace.push { transitionLabel := label, nextState := nextSt } let violations := violatedInvariantNames params th nextSt if !violations.isEmpty then - (some (.foundViolation (.safetyFailure violations) trace), gen, trace.steps.size) + return some (.foundViolation (.safetyFailure violations) trace) else - simulateOnceLoop sys params th stepsLeft nextSt trace gen + simulateOnceLoop sys params th stepsLeft nextSt trace termination_by stepsLeft @[inline, specialize] @@ -182,22 +188,20 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) - (gen : StdGen) (maxSteps : Nat) - : Option (SimulationResult ρ σ κ) × StdGen × Nat := + : StateM StdGen (Option (SimulationResult ρ σ κ)) := do let initStates := sys.initStates match initStates with - | [] => (none, gen, 0) + | [] => return none | hd :: tl => - let picked := pickInitialState (hd :: tl) gen (by simp) + let picked ← pickInitialState (hd :: tl) (by simp) let initSt := picked.value - let gen := picked.gen let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } let initViolations := violatedInvariantNames params th initSt if !initViolations.isEmpty then - (some (.foundViolation (.safetyFailure initViolations) initTrace), gen, 0) + return some (.foundViolation (.safetyFailure initViolations) initTrace) else - simulateOnceLoop sys params th maxSteps initSt initTrace gen + simulateOnceLoop sys params th maxSteps initSt initTrace def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -207,7 +211,7 @@ def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} (traceIndex : Nat) : Option (SimulationResult ρ σ κ × Nat) := let traceSeed := cfg.seed + traceIndex - let (maybeResult, _, depth) := simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps - maybeResult.map (fun result => (result, depth)) + let (maybeResult, _) := (simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed) + maybeResult.map (fun result => (result, SimulationResult.depth result)) end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index cdb55f4d..cc3b4576 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -99,11 +99,11 @@ theorem pickedTransition_valid {ρ σ κ : Type} (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst) (hNonempty : nexts ≠ []) (gen : StdGen) : - let picked := pickNextTransition nexts gen hNonempty - sys.toRelational.tr th currSt picked.value.1 picked.value.2 := by + let picked := (pickNextTransition nexts hNonempty).run gen + sys.toRelational.tr th currSt picked.1.value.1 picked.1.value.2 := by intro picked - have hmem : picked.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty - have hGood : picked.value ∈ + have hmem : picked.1.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty + have hGood : picked.1.value ∈ (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := by simpa [hNexts] using hmem @@ -119,12 +119,12 @@ theorem pickedInitialState_valid {ρ σ κ : Type} (initStates : List σ) (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : - let picked := pickInitialState initStates gen hNonempty - ({ theory := th, initialState := picked.value, steps := #[] } : Trace ρ σ κ).isValid + let picked := (pickInitialState initStates hNonempty).run gen + ({ theory := th, initialState := picked.1.value, steps := #[] } : Trace ρ σ κ).isValid sys.toRelational := by intro picked - have hmem : picked.value ∈ initStates := by simpa [picked] using pickInitialState_mem initStates gen hNonempty - refine Trace.isValid_empty sys.toRelational th picked.value ?_ ?_ + have hmem : picked.1.value ∈ initStates := by simpa [picked] using pickInitialState_mem initStates gen hNonempty + refine Trace.isValid_empty sys.toRelational th picked.1.value ?_ ?_ · simp [EnumerableTransitionSystem.toRelational] · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hmem @@ -144,17 +144,17 @@ private theorem pushedTrace_valid {ρ σ κ : Type} (sys.tr th currSt)).fst) (hNonempty : nexts ≠ []) (gen : StdGen) : - let picked := pickNextTransition nexts gen hNonempty - let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } + let picked := (pickNextTransition nexts hNonempty).run gen + let trace' := trace.push { transitionLabel := picked.1.value.1, nextState := picked.1.value.2 } trace'.isValid sys.toRelational ∧ trace'.theory = th ∧ - trace'.lastState = picked.value.2 ∧ + trace'.lastState = picked.1.value.2 ∧ trace'.failingStep = none := by intro picked trace' - have hRel : sys.toRelational.tr th currSt picked.value.1 picked.value.2 := + have hRel : sys.toRelational.tr th currSt picked.1.value.1 picked.1.value.2 := pickedTransition_valid th sys params currSt nexts hNexts hNonempty gen have hValid' : trace'.isValid sys.toRelational := by - exact Trace.push_isValid trace { transitionLabel := picked.value.1, nextState := picked.value.2 } + exact Trace.push_isValid trace { transitionLabel := picked.1.value.1, nextState := picked.1.value.2 } sys.toRelational hValid (by simpa [hTheory, hLast] using hRel) exact ⟨hValid', by simpa [trace', hTheory], by simp [trace'], by simpa [trace', hNoFail]⟩ @@ -167,11 +167,11 @@ private theorem initialTrace_valid {ρ σ κ : Type} (hInitStates : initStates = sys.initStates) (hNonempty : initStates ≠ []) (gen : StdGen) : - let picked := pickInitialState initStates gen hNonempty - let trace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } + let picked := (pickInitialState initStates hNonempty).run gen + let trace : Trace ρ σ κ := { theory := th, initialState := picked.1.value, steps := #[] } trace.isValid sys.toRelational ∧ trace.theory = th ∧ - trace.lastState = picked.value ∧ + trace.lastState = picked.1.value ∧ trace.failingStep = none := by intro picked trace have hValid := pickedInitialState_valid th sys params initStates hInitStates hNonempty gen @@ -255,7 +255,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} (hLast : trace.lastState = currSt) (hNoFail : trace.failingStep = none) : ∀ stepsLeft gen result, - (simulateOnceLoop sys params th stepsLeft currSt trace gen).1 = some result -> + ((simulateOnceLoop sys params th stepsLeft currSt trace).run gen).1 = some result -> ReportedViolationSound sys params (some result) := by intro stepsLeft induction stepsLeft generalizing currSt trace with @@ -291,23 +291,35 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} | terminated => simp [simulateOnceLoop, hStep] at h | «continue» nexts hNonempty => - let picked := pickNextTransition nexts gen hNonempty + rcases hPick : (pickNextTransition nexts hNonempty).run gen with ⟨picked, gen'⟩ let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } have hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := decideAtState_continue_nexts sys params th currSt nexts hNonempty hStep have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen - have hValid' : trace'.isValid sys.toRelational := hTrace'.1 - have hTheory' : trace'.theory = th := hTrace'.2.1 - have hNoFail' : trace'.failingStep = none := hTrace'.2.2.2 - have hLast' : trace'.lastState = picked.value.2 := hTrace'.2.2.1 + have hValid' : trace'.isValid sys.toRelational := by + simpa [hPick, trace'] using hTrace'.1 + have hTheory' : trace'.theory = th := by + simpa [hPick, trace'] using hTrace'.2.1 + have hNoFail' : trace'.failingStep = none := by + simpa [hPick, trace'] using hTrace'.2.2.2 + have hLast' : trace'.lastState = picked.value.2 := by + simp [trace'] cases hViol : (violatedInvariantNames params th picked.value.2).isEmpty with | true => - simp [simulateOnceLoop, hStep, picked, hViol] at h - exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' picked.gen result h + have hLoop : ((simulateOnceLoop sys params th steps picked.value.2 trace').run gen').1 = some result := by + rw [simulateOnceLoop, hStep] at h + simp only [StateT.run_bind, hPick, Id.instMonad] at h + simpa [trace', hViol] using h + exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' gen' result hLoop | false => - simp [simulateOnceLoop, hStep, picked, hViol] at h - cases h + have hFound : (some (SimulationResult.foundViolation + (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value.2)) trace') : + Option (SimulationResult ρ σ κ)) = some result := by + rw [simulateOnceLoop, hStep] at h + simp only [StateT.run_bind, hPick, Id.instMonad] at h + simpa [trace', hViol] using h + cases hFound have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by intro hNil simp [hNil] at hViol @@ -321,26 +333,37 @@ theorem simulateOnce_sound {ρ σ κ : Type} (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) (params : SearchParameters ρ σ) (gen : StdGen) (maxSteps : Nat) (result : SimulationResult ρ σ κ) : - (simulateOnce sys params th gen maxSteps).1 = some result -> + ((simulateOnce sys params th maxSteps).run gen).1 = some result -> ReportedViolationSound sys params (some result) := by intro h unfold simulateOnce at h cases hStates : sys.initStates with | nil => simp [hStates] at h | cons initSt rest => - let picked := pickInitialState (initSt :: rest) gen (by simp) + rcases hPick : (pickInitialState (initSt :: rest) (by simp)).run gen with ⟨picked, gen'⟩ let initTrace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } have hInit := initialTrace_valid th sys params (initSt :: rest) hStates.symm (by simp) gen - have hValid : initTrace.isValid sys.toRelational := hInit.1 - have hLast : initTrace.lastState = picked.value := hInit.2.2.1 - have hNoFail : initTrace.failingStep = none := hInit.2.2.2 + have hValid : initTrace.isValid sys.toRelational := by + simpa [hPick, initTrace] using hInit.1 + have hLast : initTrace.lastState = picked.value := by + simp [initTrace] + have hNoFail : initTrace.failingStep = none := by + simp [initTrace] cases hViol : (violatedInvariantNames params th picked.value).isEmpty with | true => - simp [hStates, picked, hViol] at h - exact simulateOnceLoop_sound th sys params picked.value initTrace rfl hValid hLast hNoFail maxSteps picked.gen result h + have hLoop : ((simulateOnceLoop sys params th maxSteps picked.value initTrace).run gen').1 = some result := by + rw [hStates] at h + simp only [StateT.run_bind, hPick, Id.instMonad] at h + simpa [initTrace, hViol] using h + exact simulateOnceLoop_sound th sys params picked.value initTrace rfl hValid hLast hNoFail maxSteps gen' result hLoop | false => - simp [hStates, picked, hViol] at h - cases h + have hFound : (some (SimulationResult.foundViolation + (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value)) initTrace) : + Option (SimulationResult ρ σ κ)) = some result := by + rw [hStates] at h + simp only [StateT.run_bind, hPick, Id.instMonad] at h + simpa [initTrace, hViol] using h + cases hFound have hNonempty : violatedInvariantNames params th picked.value ≠ [] := by intro hNil simp [hNil] at hViol @@ -359,7 +382,7 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} intro h unfold runTraceAtSeed at h set traceSeed := cfg.seed + traceIndex - rcases hSim : simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps with ⟨maybeResult, gen', depth'⟩ + rcases hSim : (simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed) with ⟨maybeResult, gen'⟩ simp [traceSeed, hSim] at h rcases h with ⟨hSome, rfl⟩ cases hMaybe : maybeResult with @@ -367,7 +390,7 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} | some result' => simp [hMaybe] at hSome subst hSome - have hSimSome : (simulateOnce sys params th (mkStdGen traceSeed) cfg.maxSteps).1 = some result' := by + have hSimSome : ((simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed)).1 = some result' := by simp [hSim, hMaybe] exact simulateOnce_sound th sys params (mkStdGen traceSeed) cfg.maxSteps result' hSimSome From 747c4cc9f161bcb62bd71eb0d031e429bec4ca69 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 20:50:26 +0200 Subject: [PATCH 68/88] refactor(simulation): rename indexed trace helper --- Veil/Core/Tools/ModelChecker/Simulation/Path.lean | 6 +++++- Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean | 10 +++++----- Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean | 7 ++++--- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 55bc6089..22adf7f2 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -203,7 +203,11 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} else simulateOnceLoop sys params th maxSteps initSt initTrace -def runTraceAtSeed {ρ σ κ : Type} {th₀ : ρ} +/-- +Simulates the trace identified by `traceIndex` using seed `cfg.seed + traceIndex`. +Returns the first violation found by that trace together with its derived trace depth. +-/ +def simulateTraceAtIndex {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (th : ρ) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index da049a4d..9ad42cba 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -52,7 +52,7 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ } | remaining + 1 => hooks.onTraceProgress traceIndex - match runTraceAtSeed sys params th cfg traceIndex with + match simulateTraceAtIndex sys params th cfg traceIndex with | some (result, stepsUsed) => hooks.onViolation return { @@ -97,7 +97,7 @@ private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} depth := 0 } | remaining + 1 => - match runTraceAtSeed sys params th cfg traceIndex with + match simulateTraceAtIndex sys params th cfg traceIndex with | some (result, stepsUsed) => { result := some result @@ -207,14 +207,14 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} | true => simp [simulateLoopId, hStop, ReportedViolationSound] | false => - by_cases hTrace : runTraceAtSeed sys params th cfg traceIndex = none + by_cases hTrace : simulateTraceAtIndex sys params th cfg traceIndex = none · simpa [simulateLoopId, hStop, hTrace] using ih (traceIndex + 1) - · cases hRun : runTraceAtSeed sys params th cfg traceIndex with + · cases hRun : simulateTraceAtIndex sys params th cfg traceIndex with | none => contradiction | some pair => rcases pair with ⟨result, depth⟩ simpa [simulateLoopId, hStop, hRun] using - runTraceAtSeed_sound th sys params cfg traceIndex result depth hRun + simulateTraceAtIndex_sound th sys params cfg traceIndex result depth hRun theorem simulateCommandSemantics_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index cc3b4576..133d800c 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -369,7 +369,8 @@ theorem simulateOnce_sound {ρ σ κ : Type} simp [hNil] at hViol exact ⟨Trace.isSimulationValid_complete sys params initTrace rfl hValid, hNoFail, rfl, hNonempty⟩ -theorem runTraceAtSeed_sound {ρ σ κ : Type} +/-- Any violation reported by a single indexed random trace is sound. -/ +theorem simulateTraceAtIndex_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) @@ -377,10 +378,10 @@ theorem runTraceAtSeed_sound {ρ σ κ : Type} (cfg : SimulateConfig) (traceIndex : Nat) (result : SimulationResult ρ σ κ) (depth : Nat) : - runTraceAtSeed sys params th cfg traceIndex = some (result, depth) -> + simulateTraceAtIndex sys params th cfg traceIndex = some (result, depth) -> ReportedViolationSound sys params (some result) := by intro h - unfold runTraceAtSeed at h + unfold simulateTraceAtIndex at h set traceSeed := cfg.seed + traceIndex rcases hSim : (simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed) with ⟨maybeResult, gen'⟩ simp [traceSeed, hSim] at h From 85a9dd6d87e1aa08397c87c4ae71774986b16419 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 20:57:30 +0200 Subject: [PATCH 69/88] docs(model-checker): document compiled command fields --- Veil/Frontend/DSL/Module/Util/ForModelChecker.lean | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index dedb0858..f7f297a4 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -19,13 +19,20 @@ inductive Status | finished (buildDir : System.FilePath) deriving Inhabited +/-- Description of a command that can be compiled into a generated executable. -/ structure CompiledCommandSpec where + /-- Name of the generated definition that the compiled executable calls. -/ exportedName : String + /-- Whether the generated definition accepts an optional parallel configuration. -/ supportsParallelConfig : Bool := false +/-- Registry key for one compiled command invocation. -/ structure CompilationKey where + /-- Source file containing the compiled command invocation. -/ sourceFile : String + /-- Generated definition called by the compiled executable. -/ exportedName : String + /-- Identity of the specific command invocation within `sourceFile`. -/ commandId : String deriving BEq, Hashable, Inhabited From 956968e922c80a76dc9a9bffaba5347f2113da21 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 21:40:56 +0200 Subject: [PATCH 70/88] chore(model-checker): remove redundant helpers --- .../Tools/ModelChecker/ExecutionOutcome.lean | 30 --------------- .../ModelChecker/Simulation/Soundness.lean | 28 -------------- .../DSL/Module/Util/ForModelChecker.lean | 37 ------------------- 3 files changed, 95 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean b/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean index 83602bf0..f01f2c0c 100644 --- a/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean +++ b/Veil/Core/Tools/ModelChecker/ExecutionOutcome.lean @@ -33,36 +33,6 @@ def toPostState : ExecutionOutcome ε σ → Option σ | .assertionFailure _ _ => .none | .divergence => .none -/-- Check if the outcome is a successful transition. -/ -@[inline] -def isSuccess : ExecutionOutcome ε σ → Bool - | .success _ => true - | _ => false - -/-- Check if the outcome is an assertion failure. -/ -@[inline] -def isAssertionFailure : ExecutionOutcome ε σ → Bool - | .assertionFailure _ _ => true - | _ => false - -/-- Check if the outcome is divergence. -/ -@[inline] -def isDivergence : ExecutionOutcome ε σ → Bool - | .divergence => true - | _ => false - -/-- Extract the state from a successful outcome. -/ -@[inline] -def getSuccessState? : ExecutionOutcome ε σ → Option σ - | .success st => some st - | _ => none - -/-- Extract the error and state from an assertion failure. -/ -@[inline] -def getAssertionFailure? : ExecutionOutcome ε σ → Option (ε × σ) - | .assertionFailure e st => some (e, st) - | _ => none - /-- Extract just the exception ID from an assertion failure. -/ @[inline] def exceptionId? : ExecutionOutcome ε σ → Option ε diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 133d800c..7566cf79 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -4,15 +4,6 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation -private instance (priority := high) instBEqTransitionOutcome {σ κ : Type} - [DecidableEq σ] [DecidableEq κ] : BEq (κ × ExecutionOutcome Int σ) := - ⟨fun a b => decide (a = b)⟩ - -private instance (priority := high) instLawfulBEqTransitionOutcome {σ κ : Type} - [DecidableEq σ] [DecidableEq κ] : LawfulBEq (κ × ExecutionOutcome Int σ) where - eq_of_beq := of_decide_eq_true - rfl := of_decide_eq_self_eq_true _ - def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -177,25 +168,6 @@ private theorem initialTrace_valid {ρ σ κ : Type} have hValid := pickedInitialState_valid th sys params initStates hInitStates hNonempty gen exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ -instance instDecidableStepListValidFromSimulation {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) (steps : StepList σ κ) : - Decidable (StepList.validFromSimulation sys params th st steps) := by - induction steps generalizing st with - | nil => exact isTrue trivial - | cons step steps ih => - dsimp [StepList.validFromSimulation] - infer_instance - -instance instDecidableTraceIsSimulationValid {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : - Decidable (Trace.isSimulationValid sys params trace) := by - unfold Trace.isSimulationValid - infer_instance - def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index f7f297a4..f4e1862b 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -191,12 +191,6 @@ def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespac IO.FS.writeFile (buildFolder / "lean-toolchain") toolchain return buildFolder -/-- Update elapsed time status for a progress instance. -/ -def updateElapsedTimeStatus (instanceId : Nat) (statusPrefix : String) : IO Unit := do - if let some refs ← ModelChecker.Concrete.getProgressRefs instanceId then - let elapsed := ModelChecker.formatElapsedTime (← refs.progressRef.get).elapsedMs - ModelChecker.Concrete.updateStatus instanceId s!"{statusPrefix} ({elapsed})" - /-- Result of running a compilation process. -/ structure ProcessResult where exitCode : UInt32 @@ -205,37 +199,6 @@ structure ProcessResult where interrupted : Bool := false deriving Inhabited -/-- Run a process with status updates, checking if compilation is still current or cancelled. - Returns the exit code, stdout, stderr, and whether it was interrupted. -/ -def runProcessWithStatus (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) - (cfg : IO.Process.SpawnArgs) - (instanceId : Nat) (statusPrefix : String) (cancelToken : IO.CancelToken) : IO ProcessResult := do - let proc ← IO.Process.spawn { cfg with stdin := .piped, stdout := .piped, stderr := .piped } - -- Start reading stdout/stderr in background tasks to avoid blocking - let stdoutTask ← IO.asTask (prio := .dedicated) proc.stdout.readToEnd - let stderrTask ← IO.asTask (prio := .dedicated) proc.stderr.readToEnd - let waitTask ← IO.asTask (prio := .dedicated) proc.wait - let mut interrupted := false - while !(← IO.hasFinished waitTask) do - -- Check for explicit cancellation request - if ← cancelToken.isSet then - proc.kill - interrupted := true - break - -- Check if this compilation is still current (not superseded) - let current? ← stillCurrentCont sourceFile command commandId instanceId do - updateElapsedTimeStatus instanceId statusPrefix - unless current? do - proc.kill - interrupted := true - break - IO.sleep 100 - let stdout ← IO.ofExcept (← IO.wait stdoutTask) - let stderr ← IO.ofExcept (← IO.wait stderrTask) - match ← IO.wait waitTask with - | .ok exitCode => return { exitCode, stdout, stderr, interrupted } - | .error err => return { exitCode := 1, stdout, stderr := s!"{stderr}\nIO error: {err}", interrupted } - /-- Run a process with callbacks for status updates and line-by-line output capture, checking both explicit cancellation and whether this compilation is still current. -/ def runProcessWithStatusCallback (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) From 5c213c926b3b10d4e1a5d134652bb3cee59819a5 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Fri, 5 Jun 2026 22:54:06 +0200 Subject: [PATCH 71/88] fix(simulation): clarify empty initial state result --- Veil/Core/Tools/ModelChecker/Simulation/Basic.lean | 1 + Veil/Core/Tools/ModelChecker/Simulation/Result.lean | 6 ++++-- Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean | 1 + Veil/Core/UI/Trace/TraceDisplay.lean | 2 ++ VeilTest/Regression/SimulateEmptyFilteredInitStates.lean | 2 +- 5 files changed, 9 insertions(+), 3 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index a2784a65..b248dd6c 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -20,5 +20,6 @@ structure SimulateResult (ρ σ κ : Type) where elapsedMs : Nat seed : Nat depth : Nat + terminationReason : Option String := none end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean index 1a30efb3..62aba82b 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Result.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Result.lean @@ -12,13 +12,15 @@ private def resultToJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] toJson (ModelCheckingResult.cancelled : ModelCheckingResult ρ σ κ Json) | none => Json.mkObj [("result", "no_violation_found")] -private def metadataToJsonFields {ρ σ κ : Type} (r : SimulateResult ρ σ κ) : List (String × Json) := [ +private def metadataToJsonFields {ρ σ κ : Type} (r : SimulateResult ρ σ κ) : List (String × Json) := + let reasonField := r.terminationReason.map fun reason => ("termination_reason", Lean.toJson reason) + [ ("traces_run", Lean.toJson r.tracesRun), ("max_traces", Lean.toJson r.maxTraces), ("elapsed_ms", Lean.toJson r.elapsedMs), ("seed", Lean.toJson r.seed), ("depth", Lean.toJson r.depth) - ] + ] ++ reasonField.toList /-- Flatten the result object while keeping simulation metadata at the top level. -/ def SimulateResult.toDisplayJson {ρ σ κ : Type} [ToJson ρ] [ToJson σ] [ToJson κ] diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 9ad42cba..77121b9b 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -11,6 +11,7 @@ private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : Sim elapsedMs := 0 seed := cfg.seed depth := 0 + terminationReason := some "no_initial_states" } private def hasNoInitialStates {ρ σ κ : Type} {th₀ : ρ} diff --git a/Veil/Core/UI/Trace/TraceDisplay.lean b/Veil/Core/UI/Trace/TraceDisplay.lean index 1934d355..5859bd73 100644 --- a/Veil/Core/UI/Trace/TraceDisplay.lean +++ b/Veil/Core/UI/Trace/TraceDisplay.lean @@ -105,6 +105,8 @@ def formatModelCheckingResult (j : Json) : MessageData := | "no_violation_found" => let trace := j.getObjValD "trace" if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}{fmtSeedSuffix j}" + else if fmtJson (j.getObjValD "termination_reason") == "no_initial_states" then + m!"✅ No initial states available after applying state constraints{fmtSeedSuffix j}" else if j.getObjValD "traces_run" != .null then m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces{fmtSeedSuffix j}" else diff --git a/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean b/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean index 1675802e..0af484bc 100644 --- a/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean +++ b/VeilTest/Regression/SimulateEmptyFilteredInitStates.lean @@ -17,7 +17,7 @@ warning: you have not defined any actions for this specification; did you forget #gen_spec /-- -info: ✅ No violation in 0 traces +info: ✅ No initial states available after applying state constraints Seed: 1 -/ #guard_msgs in From e6b0d6a9e717831951eabd6e56bc301b205e06bd Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 00:11:55 +0200 Subject: [PATCH 72/88] refactor(simulation): inline step decision logic --- .../Tools/ModelChecker/Simulation/Path.lean | 112 ++------------ .../ModelChecker/Simulation/Soundness.lean | 137 +++++++++++------- 2 files changed, 101 insertions(+), 148 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 22adf7f2..f82f3068 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -3,95 +3,6 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation -inductive StepDecision (σ κ : Type) where - | assertionFailure (exId : Int) (step : Step σ κ) - | deadlock - | terminated - | continue (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) - -def decideAtState {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) : StepDecision σ κ := - let outcomes := sys.tr th currSt - let (nexts, assertionFailures) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes - match assertionFailures with - | (label, exId, st) :: _ => - .assertionFailure exId { transitionLabel := label, nextState := st } - | [] => - match nexts with - | [] => if !params.terminating.holdsOn th currSt then .deadlock else .terminated - | hd :: tl => .continue (hd :: tl) (by simp) - -theorem decideAtState_assertionFailure_mem {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) - (exId : Int) (step : Step σ κ) : - decideAtState sys params th currSt = .assertionFailure exId step -> - (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ - sys.tr th currSt := by - intro h - let outcomes := sys.tr th currSt - cases hPart : Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes with - | mk nexts assertionFailures => - cases assertionFailures with - | nil => - cases nexts with - | nil => - by_cases hTerm : params.terminating.holdsOn th currSt = false - · have : False := by - simp [decideAtState, outcomes, hPart, hTerm] at h - exact False.elim this - · have : False := by - simp [decideAtState, outcomes, hPart, hTerm] at h - exact False.elim this - | cons hd tl => - have : False := by - simp [decideAtState, outcomes, hPart] at h - exact False.elim this - | cons failed _ => - rcases failed with ⟨label, foundExId, foundSt⟩ - simp [decideAtState, outcomes, hPart] at h - rcases h with ⟨rfl, rfl⟩ - have hFailed : (label, foundExId, foundSt) ∈ - (Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes).snd := by - rw [hPart] - simp - simpa [outcomes] using - (Veil.ModelChecker.Concrete.partitionExecutionOutcome.snd_spec outcomes label foundExId foundSt).mp hFailed - -theorem decideAtState_continue_nexts {ρ σ κ : Type} {th₀ : ρ} - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (currSt : σ) - (nexts : List (κ × σ)) (hNonempty : nexts ≠ []) : - decideAtState sys params th currSt = .continue nexts hNonempty -> - nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (sys.tr th currSt)).fst := by - intro h - let outcomes := sys.tr th currSt - cases hPart : Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes with - | mk foundNexts assertionFailures => - cases assertionFailures with - | cons failed rest => - have : False := by - rcases failed with ⟨label, exId, st⟩ - simp [decideAtState, outcomes, hPart] at h - exact False.elim this - | nil => - cases foundNexts with - | nil => - by_cases hTerm : params.terminating.holdsOn th currSt = false - · have : False := by - simp [decideAtState, outcomes, hPart, hTerm] at h - exact False.elim this - · have : False := by - simp [decideAtState, outcomes, hPart, hTerm] at h - exact False.elim this - | cons hd tl => - have h' := h - simp [decideAtState, outcomes, hPart] at h' - cases h' - rfl - theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdGen) : (let p := randNat gen 0 (xs.length - 1); p.1 < xs.length) := by have hlen : 0 < xs.length := by simpa [List.length_pos_iff_ne_nil] using h @@ -164,15 +75,22 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} match stepsLeft with | 0 => return none | stepsLeft + 1 => - match decideAtState sys params th currSt with - | .assertionFailure exId step => - let failedTrace := { trace with failingStep := some step } + let outcomes := sys.tr th currSt + let (nexts, assertionFailures) := Veil.ModelChecker.Concrete.partitionExecutionOutcome outcomes + match assertionFailures with + | (label, exId, st) :: _ => + let failedTrace := { trace with failingStep := some { transitionLabel := label, nextState := st } } return some (.foundViolation (.assertionFailure exId) failedTrace) - | .deadlock => - return some (.foundViolation .deadlock trace) - | .terminated => - return none - | .continue nexts hNonempty => + | [] => + match nexts with + | [] => + if !params.terminating.holdsOn th currSt then + return some (.foundViolation .deadlock trace) + else + return none + | hd :: tl => + let nexts := hd :: tl + have hNonempty : nexts ≠ [] := by simp let picked ← pickNextTransition nexts hNonempty let (label, nextSt) := picked.value let trace := trace.push { transitionLabel := label, nextState := nextSt } diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 7566cf79..e6fa7562 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -119,6 +119,11 @@ theorem pickedInitialState_valid {ρ σ κ : Type} · simp [EnumerableTransitionSystem.toRelational] · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hmem +private theorem pickNextTransition_run_irrel {σ κ : Type} + (nexts : List (κ × σ)) (h₁ h₂ : nexts ≠ []) (gen : StdGen) : + (pickNextTransition nexts h₁).run gen = (pickNextTransition nexts h₂).run gen := by + rw [show h₁ = h₂ from Subsingleton.elim h₁ h₂] + private theorem pushedTrace_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] (th : ρ) @@ -184,7 +189,11 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} | .deadlock => Trace.isSimulationValid sys params trace ∧ trace.failingStep = none ∧ - decideAtState sys params trace.theory trace.lastState = .deadlock + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr trace.theory trace.lastState)).fst = [] ∧ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr trace.theory trace.lastState)).snd = [] ∧ + !params.terminating.holdsOn trace.theory trace.lastState = true | .assertionFailure exId => Trace.isSimulationValid sys params trace ∧ ∃ step, @@ -236,13 +245,23 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} simp [simulateOnceLoop] at h | succ steps ih => intro gen result h - cases hStep : decideAtState sys params th currSt with - | assertionFailure exId step => - simp [simulateOnceLoop, hStep] at h + cases hPartition : Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr th currSt) with + | mk nexts assertionFailures => + cases hFailures : assertionFailures with + | cons failure failures => + rcases failure with ⟨label, exId, st⟩ + simp [simulateOnceLoop, hPartition, hFailures] at h cases h - have hMem : (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ + have hFailureMem : (label, exId, st) ∈ + (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr th currSt)).snd := by + rw [hPartition] + simp [hFailures] + have hMem : (label, ExecutionOutcome.assertionFailure exId st) ∈ sys.tr th currSt := - decideAtState_assertionFailure_mem sys params th currSt exId step hStep + (Veil.ModelChecker.Concrete.partitionExecutionOutcome.snd_spec _ _ _ _).mp hFailureMem + let step : Step σ κ := { transitionLabel := label, nextState := st } let failedTrace := { trace with failingStep := some step } have hValidFail : failedTrace.isValid sys.toRelational := by exact { @@ -254,51 +273,67 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} have hLastFail : failedTrace.lastState = currSt := by simpa [failedTrace, Trace.lastState] using hLast rw [hLastFail] - simpa [failedTrace, hTheory] using hMem - | deadlock => - simp [simulateOnceLoop, hStep] at h - cases h - exact ⟨Trace.isSimulationValid_complete sys params trace hTheory hValid, hNoFail, - by simpa [hTheory, hLast] using hStep⟩ - | terminated => - simp [simulateOnceLoop, hStep] at h - | «continue» nexts hNonempty => - rcases hPick : (pickNextTransition nexts hNonempty).run gen with ⟨picked, gen'⟩ - let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } - have hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (sys.tr th currSt)).fst := - decideAtState_continue_nexts sys params th currSt nexts hNonempty hStep - have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail nexts hNexts hNonempty gen - have hValid' : trace'.isValid sys.toRelational := by - simpa [hPick, trace'] using hTrace'.1 - have hTheory' : trace'.theory = th := by - simpa [hPick, trace'] using hTrace'.2.1 - have hNoFail' : trace'.failingStep = none := by - simpa [hPick, trace'] using hTrace'.2.2.2 - have hLast' : trace'.lastState = picked.value.2 := by - simp [trace'] - cases hViol : (violatedInvariantNames params th picked.value.2).isEmpty with - | true => - have hLoop : ((simulateOnceLoop sys params th steps picked.value.2 trace').run gen').1 = some result := by - rw [simulateOnceLoop, hStep] at h - simp only [StateT.run_bind, hPick, Id.instMonad] at h - simpa [trace', hViol] using h - exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' gen' result hLoop - | false => - have hFound : (some (SimulationResult.foundViolation - (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value.2)) trace') : - Option (SimulationResult ρ σ κ)) = some result := by - rw [simulateOnceLoop, hStep] at h - simp only [StateT.run_bind, hPick, Id.instMonad] at h - simpa [trace', hViol] using h - cases hFound - have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by - intro hNil - simp [hNil] at hViol - have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = - violatedInvariantNames params th picked.value.2 := by - simp [hTheory', hLast'] - exact ⟨Trace.isSimulationValid_complete sys params trace' hTheory' hValid', hNoFail', hViolEq, hNonempty⟩ + simpa [failedTrace, step, hTheory] using hMem + | nil => + cases hNexts : nexts with + | nil => + cases hTerminating : !params.terminating.holdsOn th currSt with + | true => + simp [simulateOnceLoop, hPartition, hFailures, hNexts, hTerminating] at h + cases h + have hNoSuccesses : (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr trace.theory trace.lastState)).fst = [] := by + simp [hTheory, hLast, hPartition, hNexts] + have hNoFailures : (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr trace.theory trace.lastState)).snd = [] := by + simp [hTheory, hLast, hPartition, hFailures] + have hDeadlock : !params.terminating.holdsOn trace.theory trace.lastState = true := by + simpa [hTheory, hLast] using hTerminating + exact ⟨Trace.isSimulationValid_complete sys params trace hTheory hValid, + hNoFail, hNoSuccesses, hNoFailures, hDeadlock⟩ + | false => + simp [simulateOnceLoop, hPartition, hFailures, hNexts, hTerminating] at h + | cons hd tl => + let nexts' : List (κ × σ) := hd :: tl + rcases hPick : (pickNextTransition (hd :: tl) (by simp)).run gen with ⟨picked, gen'⟩ + let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } + have hNextsHd : hd :: tl = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + (sys.tr th currSt)).fst := by + simp [hPartition, hNexts] + have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail + (hd :: tl) hNextsHd (by simp) gen + have hValid' : trace'.isValid sys.toRelational := by + simpa [hPick, trace'] using hTrace'.1 + have hTheory' : trace'.theory = th := by + simpa [hPick, trace'] using hTrace'.2.1 + have hNoFail' : trace'.failingStep = none := by + simpa [hPick, trace'] using hTrace'.2.2.2 + have hLast' : trace'.lastState = picked.value.2 := by + simp [trace'] + cases hViol : (violatedInvariantNames params th picked.value.2).isEmpty with + | true => + have hLoop : ((simulateOnceLoop sys params th steps picked.value.2 trace').run gen').1 = some result := by + rw [simulateOnceLoop] at h + simp only [hPartition, hFailures, hNexts, StateT.run_bind, Id.instMonad] at h + rw [pickNextTransition_run_irrel (hd :: tl) _ (by simp) gen, hPick] at h + simpa [nexts', trace', hViol] using h + exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' gen' result hLoop + | false => + have hFound : (some (SimulationResult.foundViolation + (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value.2)) trace') : + Option (SimulationResult ρ σ κ)) = some result := by + rw [simulateOnceLoop] at h + simp only [hPartition, hFailures, hNexts, StateT.run_bind, Id.instMonad] at h + rw [pickNextTransition_run_irrel (hd :: tl) _ (by simp) gen, hPick] at h + simpa [nexts', trace', hViol] using h + cases hFound + have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by + intro hNil + simp [hNil] at hViol + have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = + violatedInvariantNames params th picked.value.2 := by + simp [hTheory', hLast'] + exact ⟨Trace.isSimulationValid_complete sys params trace' hTheory' hValid', hNoFail', hViolEq, hNonempty⟩ theorem simulateOnce_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] From cee1687f48522cddf15b8611a247d4c83d298552 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 12:11:58 +0200 Subject: [PATCH 73/88] refactor(simulation): inline random path selection --- .../Tools/ModelChecker/Simulation/Path.lean | 72 ++----- .../ModelChecker/Simulation/Soundness.lean | 176 ++++++++++-------- 2 files changed, 120 insertions(+), 128 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index f82f3068..7aafa8c8 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -11,54 +11,6 @@ theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdG simp [Nat.not_lt.mpr (Nat.zero_le (xs.length - 1)), hk] exact Nat.mod_lt _ hlen -structure PickedTransition {σ κ : Type} (nexts : List (κ × σ)) where - value : κ × σ - mem : value ∈ nexts - -def pickNextTransition {σ κ : Type} - (nexts : List (κ × σ)) (h : nexts ≠ []) : StateM StdGen (PickedTransition nexts) := do - let gen ← get - let p := randNat gen 0 (nexts.length - 1) - let idx := p.1 - let gen' := p.2 - have hlt : idx < nexts.length := by - dsimp [idx, p] - exact randNat_lt_length nexts h gen - set gen' - return { - value := nexts.get ⟨idx, hlt⟩ - mem := by exact List.get_mem nexts ⟨idx, hlt⟩ - } - -theorem pickNextTransition_mem {σ κ : Type} - (nexts : List (κ × σ)) (gen : StdGen) (h : nexts ≠ []) : - ((pickNextTransition nexts h).run gen).1.value ∈ nexts := - ((pickNextTransition nexts h).run gen).1.mem - -structure PickedInitState {σ : Type} (initStates : List σ) where - value : σ - mem : value ∈ initStates - -def pickInitialState {σ : Type} - (initStates : List σ) (h : initStates ≠ []) : StateM StdGen (PickedInitState initStates) := do - let gen ← get - let p := randNat gen 0 (initStates.length - 1) - let idx := p.1 - let gen' := p.2 - have hlt : idx < initStates.length := by - dsimp [idx, p] - exact randNat_lt_length initStates h gen - set gen' - return { - value := initStates.get ⟨idx, hlt⟩ - mem := by exact List.get_mem initStates ⟨idx, hlt⟩ - } - -theorem pickInitialState_mem {σ : Type} - (initStates : List σ) (gen : StdGen) (h : initStates ≠ []) : - ((pickInitialState initStates h).run gen).1.value ∈ initStates := - ((pickInitialState initStates h).run gen).1.mem - private def SimulationResult.depth {ρ σ κ : Type} : SimulationResult ρ σ κ → Nat | .foundViolation _ trace => trace.steps.size + if trace.failingStep.isSome then 1 else 0 | .cancelled => 0 @@ -91,8 +43,15 @@ def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} | hd :: tl => let nexts := hd :: tl have hNonempty : nexts ≠ [] := by simp - let picked ← pickNextTransition nexts hNonempty - let (label, nextSt) := picked.value + let gen ← get + let p := randNat gen 0 (nexts.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < nexts.length := by + dsimp [idx, p] + exact randNat_lt_length nexts hNonempty gen + set gen' + let (label, nextSt) := nexts.get ⟨idx, hlt⟩ let trace := trace.push { transitionLabel := label, nextState := nextSt } let violations := violatedInvariantNames params th nextSt if !violations.isEmpty then @@ -112,8 +71,17 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} match initStates with | [] => return none | hd :: tl => - let picked ← pickInitialState (hd :: tl) (by simp) - let initSt := picked.value + let initStates := hd :: tl + have hNonempty : initStates ≠ [] := by simp + let gen ← get + let p := randNat gen 0 (initStates.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < initStates.length := by + dsimp [idx, p] + exact randNat_lt_length initStates hNonempty gen + set gen' + let initSt := initStates.get ⟨idx, hlt⟩ let initTrace : Trace ρ σ κ := { theory := th, initialState := initSt, steps := #[] } let initViolations := violatedInvariantNames params th initSt if !initViolations.isEmpty then diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index e6fa7562..60e3a42c 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -82,50 +82,39 @@ theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th : ρ} theorem pickedTransition_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] - [Inhabited (κ × σ)] (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) (_params : SearchParameters ρ σ) (currSt : σ) (nexts : List (κ × σ)) (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst) - (hNonempty : nexts ≠ []) (gen : StdGen) : - let picked := (pickNextTransition nexts hNonempty).run gen - sys.toRelational.tr th currSt picked.1.value.1 picked.1.value.2 := by - intro picked - have hmem : picked.1.value ∈ nexts := by simpa [picked] using pickNextTransition_mem nexts gen hNonempty - have hGood : picked.1.value ∈ + (selected : κ × σ) + (hSelected : selected ∈ nexts) : + sys.toRelational.tr th currSt selected.1 selected.2 := by + have hGood : selected ∈ (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := by - simpa [hNexts] using hmem + simpa [hNexts] using hSelected simpa [EnumerableTransitionSystem.toRelational] using (Veil.ModelChecker.Concrete.partitionExecutionOutcome.fst_spec _ _ _).mp hGood theorem pickedInitialState_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] - [Inhabited σ] (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) (_params : SearchParameters ρ σ) (initStates : List σ) (hInitStates : initStates = sys.initStates) - (hNonempty : initStates ≠ []) (gen : StdGen) : - let picked := (pickInitialState initStates hNonempty).run gen - ({ theory := th, initialState := picked.1.value, steps := #[] } : Trace ρ σ κ).isValid + (selectedInit : σ) + (hSelected : selectedInit ∈ initStates) : + ({ theory := th, initialState := selectedInit, steps := #[] } : Trace ρ σ κ).isValid sys.toRelational := by - intro picked - have hmem : picked.1.value ∈ initStates := by simpa [picked] using pickInitialState_mem initStates gen hNonempty - refine Trace.isValid_empty sys.toRelational th picked.1.value ?_ ?_ + refine Trace.isValid_empty sys.toRelational th selectedInit ?_ ?_ · simp [EnumerableTransitionSystem.toRelational] - · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hmem - -private theorem pickNextTransition_run_irrel {σ κ : Type} - (nexts : List (κ × σ)) (h₁ h₂ : nexts ≠ []) (gen : StdGen) : - (pickNextTransition nexts h₁).run gen = (pickNextTransition nexts h₂).run gen := by - rw [show h₁ = h₂ from Subsingleton.elim h₁ h₂] + · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hSelected private theorem pushedTrace_valid {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] [Inhabited (κ × σ)] + [DecidableEq σ] [DecidableEq κ] (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) (params : SearchParameters ρ σ) @@ -138,39 +127,37 @@ private theorem pushedTrace_valid {ρ σ κ : Type} (nexts : List (κ × σ)) (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst) - (hNonempty : nexts ≠ []) - (gen : StdGen) : - let picked := (pickNextTransition nexts hNonempty).run gen - let trace' := trace.push { transitionLabel := picked.1.value.1, nextState := picked.1.value.2 } + (selected : κ × σ) + (hSelected : selected ∈ nexts) : + let trace' := trace.push { transitionLabel := selected.1, nextState := selected.2 } trace'.isValid sys.toRelational ∧ trace'.theory = th ∧ - trace'.lastState = picked.1.value.2 ∧ + trace'.lastState = selected.2 ∧ trace'.failingStep = none := by - intro picked trace' - have hRel : sys.toRelational.tr th currSt picked.1.value.1 picked.1.value.2 := - pickedTransition_valid th sys params currSt nexts hNexts hNonempty gen + intro trace' + have hRel : sys.toRelational.tr th currSt selected.1 selected.2 := + pickedTransition_valid th sys params currSt nexts hNexts selected hSelected have hValid' : trace'.isValid sys.toRelational := by - exact Trace.push_isValid trace { transitionLabel := picked.1.value.1, nextState := picked.1.value.2 } + exact Trace.push_isValid trace { transitionLabel := selected.1, nextState := selected.2 } sys.toRelational hValid (by simpa [hTheory, hLast] using hRel) exact ⟨hValid', by simpa [trace', hTheory], by simp [trace'], by simpa [trace', hNoFail]⟩ private theorem initialTrace_valid {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] [Inhabited σ] + [DecidableEq σ] [DecidableEq κ] (th : ρ) (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) (params : SearchParameters ρ σ) (initStates : List σ) (hInitStates : initStates = sys.initStates) - (hNonempty : initStates ≠ []) - (gen : StdGen) : - let picked := (pickInitialState initStates hNonempty).run gen - let trace : Trace ρ σ κ := { theory := th, initialState := picked.1.value, steps := #[] } + (selectedInit : σ) + (hSelected : selectedInit ∈ initStates) : + let trace : Trace ρ σ κ := { theory := th, initialState := selectedInit, steps := #[] } trace.isValid sys.toRelational ∧ trace.theory = th ∧ - trace.lastState = picked.1.value ∧ + trace.lastState = selectedInit ∧ trace.failingStep = none := by - intro picked trace - have hValid := pickedInitialState_valid th sys params initStates hInitStates hNonempty gen + intro trace + have hValid := pickedInitialState_valid th sys params initStates hInitStates selectedInit hSelected exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} @@ -295,43 +282,59 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} simp [simulateOnceLoop, hPartition, hFailures, hNexts, hTerminating] at h | cons hd tl => let nexts' : List (κ × σ) := hd :: tl - rcases hPick : (pickNextTransition (hd :: tl) (by simp)).run gen with ⟨picked, gen'⟩ - let trace' := trace.push { transitionLabel := picked.value.1, nextState := picked.value.2 } - have hNextsHd : hd :: tl = (Veil.ModelChecker.Concrete.partitionExecutionOutcome + have hNonempty : nexts' ≠ [] := by simp [nexts'] + let p := randNat gen 0 (nexts'.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < nexts'.length := by + dsimp [idx, p] + exact randNat_lt_length nexts' hNonempty gen + let selected := nexts'.get ⟨idx, hlt⟩ + let trace' := trace.push { transitionLabel := selected.1, nextState := selected.2 } + have hSelected : selected ∈ nexts' := by + dsimp [selected] + exact List.get_mem nexts' ⟨idx, hlt⟩ + have hNextsHd : nexts' = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := by - simp [hPartition, hNexts] + simp [nexts', hPartition, hNexts] have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail - (hd :: tl) hNextsHd (by simp) gen + nexts' hNextsHd selected hSelected have hValid' : trace'.isValid sys.toRelational := by - simpa [hPick, trace'] using hTrace'.1 + simpa [trace'] using hTrace'.1 have hTheory' : trace'.theory = th := by - simpa [hPick, trace'] using hTrace'.2.1 + simpa [trace'] using hTrace'.2.1 have hNoFail' : trace'.failingStep = none := by - simpa [hPick, trace'] using hTrace'.2.2.2 - have hLast' : trace'.lastState = picked.value.2 := by + simpa [trace'] using hTrace'.2.2.2 + have hLast' : trace'.lastState = selected.2 := by simp [trace'] - cases hViol : (violatedInvariantNames params th picked.value.2).isEmpty with + cases hViol : (violatedInvariantNames params th selected.2).isEmpty with | true => - have hLoop : ((simulateOnceLoop sys params th steps picked.value.2 trace').run gen').1 = some result := by + have hViolNil : violatedInvariantNames params th selected.2 = [] := by + simpa using hViol + have hViolNilRaw : + violatedInvariantNames params th (hd :: tl)[(randNat gen 0 tl.length).1].2 = [] := by + simpa [nexts', p, idx, selected] using hViolNil + have hLoop : ((simulateOnceLoop sys params th steps selected.2 trace').run gen').1 = some result := by rw [simulateOnceLoop] at h simp only [hPartition, hFailures, hNexts, StateT.run_bind, Id.instMonad] at h - rw [pickNextTransition_run_irrel (hd :: tl) _ (by simp) gen, hPick] at h - simpa [nexts', trace', hViol] using h - exact ih picked.value.2 trace' hTheory' hValid' hLast' hNoFail' gen' result hLoop + simpa [nexts', p, idx, gen', hlt, selected, trace', hViolNilRaw] using h + exact ih selected.2 trace' hTheory' hValid' hLast' hNoFail' gen' result hLoop | false => + have hNonempty : violatedInvariantNames params th selected.2 ≠ [] := by + intro hNil + simp [hNil] at hViol + have hNonemptyRaw : + violatedInvariantNames params th (hd :: tl)[(randNat gen 0 tl.length).1].2 ≠ [] := by + simpa [nexts', p, idx, selected] using hNonempty have hFound : (some (SimulationResult.foundViolation - (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value.2)) trace') : + (ViolationKind.safetyFailure (violatedInvariantNames params th selected.2)) trace') : Option (SimulationResult ρ σ κ)) = some result := by rw [simulateOnceLoop] at h simp only [hPartition, hFailures, hNexts, StateT.run_bind, Id.instMonad] at h - rw [pickNextTransition_run_irrel (hd :: tl) _ (by simp) gen, hPick] at h - simpa [nexts', trace', hViol] using h + simpa [nexts', p, idx, gen', hlt, selected, trace', hNonemptyRaw] using h cases hFound - have hNonempty : violatedInvariantNames params th picked.value.2 ≠ [] := by - intro hNil - simp [hNil] at hViol have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = - violatedInvariantNames params th picked.value.2 := by + violatedInvariantNames params th selected.2 := by simp [hTheory', hLast'] exact ⟨Trace.isSimulationValid_complete sys params trace' hTheory' hValid', hNoFail', hViolEq, hNonempty⟩ @@ -347,33 +350,54 @@ theorem simulateOnce_sound {ρ σ κ : Type} cases hStates : sys.initStates with | nil => simp [hStates] at h | cons initSt rest => - rcases hPick : (pickInitialState (initSt :: rest) (by simp)).run gen with ⟨picked, gen'⟩ - let initTrace : Trace ρ σ κ := { theory := th, initialState := picked.value, steps := #[] } - have hInit := initialTrace_valid th sys params (initSt :: rest) hStates.symm (by simp) gen + let initStates : List σ := initSt :: rest + have hNonempty : initStates ≠ [] := by simp [initStates] + let p := randNat gen 0 (initStates.length - 1) + let idx := p.1 + let gen' := p.2 + have hlt : idx < initStates.length := by + dsimp [idx, p] + exact randNat_lt_length initStates hNonempty gen + let selectedInit := initStates.get ⟨idx, hlt⟩ + let initTrace : Trace ρ σ κ := { theory := th, initialState := selectedInit, steps := #[] } + have hSelectedInit : selectedInit ∈ initStates := by + dsimp [selectedInit] + exact List.get_mem initStates ⟨idx, hlt⟩ + have hInitStates : initStates = sys.initStates := by + simp [initStates, hStates] + have hInit := initialTrace_valid th sys params initStates hInitStates selectedInit hSelectedInit have hValid : initTrace.isValid sys.toRelational := by - simpa [hPick, initTrace] using hInit.1 - have hLast : initTrace.lastState = picked.value := by + simpa [initTrace] using hInit.1 + have hLast : initTrace.lastState = selectedInit := by simp [initTrace] have hNoFail : initTrace.failingStep = none := by simp [initTrace] - cases hViol : (violatedInvariantNames params th picked.value).isEmpty with + cases hViol : (violatedInvariantNames params th selectedInit).isEmpty with | true => - have hLoop : ((simulateOnceLoop sys params th maxSteps picked.value initTrace).run gen').1 = some result := by + have hViolNil : violatedInvariantNames params th selectedInit = [] := by + simpa using hViol + have hViolNilRaw : + violatedInvariantNames params th (initSt :: rest)[(randNat gen 0 rest.length).1] = [] := by + simpa [initStates, p, idx, selectedInit] using hViolNil + have hLoop : ((simulateOnceLoop sys params th maxSteps selectedInit initTrace).run gen').1 = some result := by rw [hStates] at h - simp only [StateT.run_bind, hPick, Id.instMonad] at h - simpa [initTrace, hViol] using h - exact simulateOnceLoop_sound th sys params picked.value initTrace rfl hValid hLast hNoFail maxSteps gen' result hLoop + simp only [StateT.run_bind, Id.instMonad] at h + simpa [initStates, p, idx, gen', hlt, selectedInit, initTrace, hViolNilRaw] using h + exact simulateOnceLoop_sound th sys params selectedInit initTrace rfl hValid hLast hNoFail maxSteps gen' result hLoop | false => + have hNonempty : violatedInvariantNames params th selectedInit ≠ [] := by + intro hNil + simp [hNil] at hViol + have hNonemptyRaw : + violatedInvariantNames params th (initSt :: rest)[(randNat gen 0 rest.length).1] ≠ [] := by + simpa [initStates, p, idx, selectedInit] using hNonempty have hFound : (some (SimulationResult.foundViolation - (ViolationKind.safetyFailure (violatedInvariantNames params th picked.value)) initTrace) : + (ViolationKind.safetyFailure (violatedInvariantNames params th selectedInit)) initTrace) : Option (SimulationResult ρ σ κ)) = some result := by rw [hStates] at h - simp only [StateT.run_bind, hPick, Id.instMonad] at h - simpa [initTrace, hViol] using h + simp only [StateT.run_bind, Id.instMonad] at h + simpa [initStates, p, idx, gen', hlt, selectedInit, initTrace, hNonemptyRaw] using h cases hFound - have hNonempty : violatedInvariantNames params th picked.value ≠ [] := by - intro hNil - simp [hNil] at hViol exact ⟨Trace.isSimulationValid_complete sys params initTrace rfl hValid, hNoFail, rfl, hNonempty⟩ /-- Any violation reported by a single indexed random trace is sound. -/ From cf689c54d6a7309e9ffca92d1f05f1fdd08ecc38 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 13:12:26 +0200 Subject: [PATCH 74/88] refactor(simulation): use relational trace validity --- .../ModelChecker/Simulation/Soundness.lean | 104 +++--------------- 1 file changed, 13 insertions(+), 91 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 60e3a42c..33fb6287 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -4,82 +4,6 @@ import Veil.Core.Tools.ModelChecker.Concrete.Core namespace Veil.ModelChecker.Simulation -def StepList.validFromSimulation {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (th : ρ) (st : σ) : StepList σ κ → Prop - | [] => True - | step :: steps => - (step.transitionLabel, ExecutionOutcome.success step.nextState) ∈ - sys.tr th st ∧ - StepList.validFromSimulation sys params th step.nextState steps - -theorem StepList.validFromSimulation_sound {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] - (th : ρ) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) (st : σ) : - ∀ steps, StepList.validFromSimulation sys params th st steps → - StepList.validFrom sys.toRelational th st steps - | [], _ => by simp [StepList.validFrom] - | step :: steps, h => by - rcases h with ⟨hStep, hTail⟩ - constructor - · simpa [EnumerableTransitionSystem.toRelational] using hStep - · exact StepList.validFromSimulation_sound th sys params step.nextState steps hTail - -theorem StepList.validFromSimulation_complete {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] - (th : ρ) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) (st : σ) : - ∀ steps, StepList.validFrom sys.toRelational th st steps -> - StepList.validFromSimulation sys params th st steps - | [], _ => by simp [StepList.validFromSimulation] - | step :: steps, h => by - rcases h with ⟨hStep, hTail⟩ - constructor - · simpa [EnumerableTransitionSystem.toRelational] using hStep - · exact StepList.validFromSimulation_complete th sys params step.nextState steps hTail - -def Trace.isSimulationValid {ρ σ κ : Type} {th₀ : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : Prop := - trace.initialState ∈ sys.initStates ∧ - StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList - -theorem Trace.isSimulationValid_sound {ρ σ κ : Type} {th : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) : - Trace.isSimulationValid sys params trace → trace.isValid sys.toRelational := by - subst th - intro h - rcases h with ⟨hInit, hSteps⟩ - refine { - theorySatisfiesAssumptions := by simp [EnumerableTransitionSystem.toRelational] - initialStateSatisfiesInit := ?_ - stepsValid := ?_ - } - · simpa [EnumerableTransitionSystem.toRelational] using hInit - · simpa [Steps.validFrom] using - StepList.validFromSimulation_sound trace.theory sys params trace.initialState trace.steps.toList hSteps - -theorem Trace.isSimulationValid_complete {ρ σ κ : Type} {th : ρ} - [DecidableEq σ] [DecidableEq κ] - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (hTheory : trace.theory = th) : - trace.isValid sys.toRelational -> Trace.isSimulationValid sys params trace := by - subst th - intro h - have hInit : trace.initialState ∈ sys.initStates := by - simpa [EnumerableTransitionSystem.toRelational] using h.initialStateSatisfiesInit - have hSteps : StepList.validFromSimulation sys params trace.theory trace.initialState trace.steps.toList := by - exact StepList.validFromSimulation_complete trace.theory sys params trace.initialState trace.steps.toList (by - simpa [Steps.validFrom] using h.stepsValid) - exact ⟨hInit, hSteps⟩ - theorem pickedTransition_valid {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] (th : ρ) @@ -165,16 +89,16 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) : ViolationKind → Prop | .assumptionFailure violates => - Trace.isSimulationValid sys params trace ∧ + trace.isValid sys.toRelational ∧ params.violatedAssumptions trace.theory = violates ∧ violates ≠ [] | .safetyFailure violates => - Trace.isSimulationValid sys params trace ∧ + trace.isValid sys.toRelational ∧ trace.failingStep = none ∧ violatedInvariantNames params trace.theory trace.lastState = violates ∧ violates ≠ [] | .deadlock => - Trace.isSimulationValid sys params trace ∧ + trace.isValid sys.toRelational ∧ trace.failingStep = none ∧ (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr trace.theory trace.lastState)).fst = [] ∧ @@ -182,7 +106,7 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} (sys.tr trace.theory trace.lastState)).snd = [] ∧ !params.terminating.holdsOn trace.theory trace.lastState = true | .assertionFailure exId => - Trace.isSimulationValid sys params trace ∧ + trace.isValid sys.toRelational ∧ ∃ step, trace.failingStep = some step ∧ (step.transitionLabel, ExecutionOutcome.assertionFailure exId step.nextState) ∈ @@ -191,16 +115,15 @@ def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} theorem Trace.witnessesSimulationViolation_valid {ρ σ κ : Type} {th : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) - (hTheory : trace.theory = th) : + (params : SearchParameters ρ σ) (trace : Trace ρ σ κ) (violation : ViolationKind) : Trace.witnessesSimulationViolation sys params trace violation → trace.isValid sys.toRelational := by intro h cases violation with - | assumptionFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 - | safetyFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 - | deadlock => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 - | assertionFailure _ => exact Trace.isSimulationValid_sound sys params trace hTheory h.1 + | assumptionFailure _ => exact h.1 + | safetyFailure _ => exact h.1 + | deadlock => exact h.1 + | assertionFailure _ => exact h.1 def ReportedViolationSound {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] @@ -256,7 +179,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} initialStateSatisfiesInit := hValid.initialStateSatisfiesInit stepsValid := hValid.stepsValid } - refine ⟨Trace.isSimulationValid_complete sys params failedTrace (by simp [failedTrace, hTheory]) hValidFail, step, rfl, ?_⟩ + refine ⟨hValidFail, step, rfl, ?_⟩ have hLastFail : failedTrace.lastState = currSt := by simpa [failedTrace, Trace.lastState] using hLast rw [hLastFail] @@ -276,8 +199,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} simp [hTheory, hLast, hPartition, hFailures] have hDeadlock : !params.terminating.holdsOn trace.theory trace.lastState = true := by simpa [hTheory, hLast] using hTerminating - exact ⟨Trace.isSimulationValid_complete sys params trace hTheory hValid, - hNoFail, hNoSuccesses, hNoFailures, hDeadlock⟩ + exact ⟨hValid, hNoFail, hNoSuccesses, hNoFailures, hDeadlock⟩ | false => simp [simulateOnceLoop, hPartition, hFailures, hNexts, hTerminating] at h | cons hd tl => @@ -336,7 +258,7 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} have hViolEq : violatedInvariantNames params trace'.theory trace'.lastState = violatedInvariantNames params th selected.2 := by simp [hTheory', hLast'] - exact ⟨Trace.isSimulationValid_complete sys params trace' hTheory' hValid', hNoFail', hViolEq, hNonempty⟩ + exact ⟨hValid', hNoFail', hViolEq, hNonempty⟩ theorem simulateOnce_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] [Inhabited σ] [Inhabited (κ × σ)] @@ -398,7 +320,7 @@ theorem simulateOnce_sound {ρ σ κ : Type} simp only [StateT.run_bind, Id.instMonad] at h simpa [initStates, p, idx, gen', hlt, selectedInit, initTrace, hNonemptyRaw] using h cases hFound - exact ⟨Trace.isSimulationValid_complete sys params initTrace rfl hValid, hNoFail, rfl, hNonempty⟩ + exact ⟨hValid, hNoFail, rfl, hNonempty⟩ /-- Any violation reported by a single indexed random trace is sound. -/ theorem simulateTraceAtIndex_sound {ρ σ κ : Type} From 6c873e6409ffe93da0dd7ba518c469938ce50e77 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 14:22:02 +0200 Subject: [PATCH 75/88] refactor(simulation): remove pure simulation loop --- .../ModelChecker/Simulation/Runtime.lean | 67 +++++-------------- 1 file changed, 17 insertions(+), 50 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 77121b9b..85c35a54 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -68,50 +68,6 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) termination_by remaining -private def simulateLoopId {ρ σ κ : Type} {th₀ : ρ} - (shouldStop : Nat → Bool) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) - (params : SearchParameters ρ σ) - (th : ρ) - (cfg : SimulateConfig) - (remaining : Nat) - (traceIndex : Nat) - : SimulateResult ρ σ κ := - if shouldStop traceIndex then - { - result := some .cancelled - tracesRun := traceIndex - maxTraces := cfg.maxTraces - elapsedMs := 0 - seed := cfg.seed - depth := 0 - } - else - match remaining with - | 0 => - { - result := none - tracesRun := cfg.maxTraces - maxTraces := cfg.maxTraces - elapsedMs := 0 - seed := cfg.seed - depth := 0 - } - | remaining + 1 => - match simulateTraceAtIndex sys params th cfg traceIndex with - | some (result, stepsUsed) => - { - result := some result - tracesRun := traceIndex + 1 - maxTraces := cfg.maxTraces - elapsedMs := 0 - seed := cfg.seed - depth := stepsUsed - } - | none => - simulateLoopId shouldStop sys params th cfg remaining (traceIndex + 1) -termination_by remaining - @[inline, specialize] def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -124,7 +80,11 @@ def simulateCommandSemantics {ρ σ κ : Type} {th₀ : ρ} if hasNoInitialStates sys then noInitialStatesResult cfg else - simulateLoopId shouldStop sys params th cfg cfg.maxTraces 0 + simulateLoopM + ({ shouldStop := fun traceIndex => shouldStop traceIndex + onTraceProgress := fun _ => () + onViolation := () } : SimulationHooks Id) + sys params th cfg cfg.maxTraces 0 @[inline, specialize] def simulateCore {ρ σ κ : Type} {th₀ : ρ} @@ -196,25 +156,32 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} (cfg : SimulateConfig) (shouldStop : Nat → Bool) : ∀ remaining traceIndex, - ReportedViolationSound sys params (SimulateResult.result (simulateLoopId shouldStop sys params th cfg remaining traceIndex)) := by + ReportedViolationSound sys params + (SimulateResult.result + (simulateLoopM + ({ shouldStop := fun traceIndex => shouldStop traceIndex + onTraceProgress := fun _ => () + onViolation := () } : SimulationHooks Id) + sys params th cfg remaining traceIndex)) := by intro remaining induction remaining with | zero => intro traceIndex - cases hStop : shouldStop traceIndex <;> simp [simulateLoopId, hStop, ReportedViolationSound] + cases hStop : shouldStop traceIndex <;> + simp [simulateLoopM, hStop, ReportedViolationSound, Id.instMonad] | succ remaining ih => intro traceIndex cases hStop : shouldStop traceIndex with | true => - simp [simulateLoopId, hStop, ReportedViolationSound] + simp [simulateLoopM, hStop, ReportedViolationSound, Id.instMonad] | false => by_cases hTrace : simulateTraceAtIndex sys params th cfg traceIndex = none - · simpa [simulateLoopId, hStop, hTrace] using ih (traceIndex + 1) + · simpa [simulateLoopM, hStop, hTrace, Id.instMonad] using ih (traceIndex + 1) · cases hRun : simulateTraceAtIndex sys params th cfg traceIndex with | none => contradiction | some pair => rcases pair with ⟨result, depth⟩ - simpa [simulateLoopId, hStop, hRun] using + simpa [simulateLoopM, hStop, hRun, Id.instMonad] using simulateTraceAtIndex_sound th sys params cfg traceIndex result depth hRun theorem simulateCommandSemantics_sound {ρ σ κ : Type} From 41be2579dc61cb162edf68f27bc208ed7eb25f12 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 15:19:49 +0200 Subject: [PATCH 76/88] refactor(progress): split simulation payload --- .../Tools/ModelChecker/Concrete/Progress.lean | 29 ++++++++----------- Veil/Core/UI/Widget/ProgressViewer.lean | 12 ++++---- Veil/Frontend/DSL/Module/Elaborators.lean | 20 ++++++++----- 3 files changed, 30 insertions(+), 31 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index 1a19f5d7..22d1b92f 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -59,7 +59,14 @@ structure ProgressHistoryPoint where queue : Nat deriving ToJson, FromJson, Inhabited, Repr -/-- Progress information for model checking, using TLC-style terminology. -/ +/-- Progress information for a simulation run. -/ +structure SimulationProgress where + tracesRun : Nat := 0 + maxTraces : Nat := 0 + depth : Nat := 0 + deriving ToJson, FromJson, Inhabited, Repr + +/-- Progress information for model checking or simulation. -/ structure Progress where status : String := "Initializing..." /-- Length of the longest behavior found so far (BFS depth) -/ @@ -82,14 +89,8 @@ structure Progress where allActionLabels : List String := [] /-- Time-series history for charting progress over time -/ history : Array ProgressHistoryPoint := #[] - /-- Whether this progress entry is for `#simulate` rather than `#model_check`. -/ - isSimulation : Bool := false - /-- Number of traces completed so far (simulation only). -/ - tracesRun : Nat := 0 - /-- Configured maximum trace budget (simulation only). -/ - maxTraces : Nat := 0 - /-- Depth reached in the current/last trace (simulation only). -/ - simulationDepth : Nat := 0 + /-- Progress information for `#simulate`; absent for `#model_check`. -/ + simulation : Option SimulationProgress := none deriving ToJson, FromJson, Inhabited, Repr /-- Refs for tracking progress of a single model checker instance. -/ @@ -194,10 +195,7 @@ def updateSimulationProgress (instanceId : Nat) (status : String) { p with status elapsedMs := now - p.startTimeMs - isSimulation := true - tracesRun - maxTraces - simulationDepth := depth } + simulation := some { tracesRun, maxTraces, depth } } if ← compiledModeEnabled.get then let startTime ← compiledModeStartTime.get let p : Progress := { @@ -205,10 +203,7 @@ def updateSimulationProgress (instanceId : Nat) (status : String) isRunning := true startTimeMs := startTime elapsedMs := now - startTime - isSimulation := true - tracesRun := tracesRun - maxTraces := maxTraces - simulationDepth := depth + simulation := some { tracesRun, maxTraces, depth } } IO.eprintln (toJson p).compress diff --git a/Veil/Core/UI/Widget/ProgressViewer.lean b/Veil/Core/UI/Widget/ProgressViewer.lean index e160d0d9..464e0289 100644 --- a/Veil/Core/UI/Widget/ProgressViewer.lean +++ b/Veil/Core/UI/Widget/ProgressViewer.lean @@ -519,15 +519,15 @@ def progressToHtml (p : Progress) (instanceId? : Option Nat := none) : Html := } - {if p.isSimulation then statRow "Traces Run:" (toString p.tracesRun) else statRow "Diameter:" (toString p.diameter)} - {if p.isSimulation then statRow "Max Traces:" (toString p.maxTraces) else statRow "States Found:" (toString p.statesFound)} - {if p.isSimulation then statRow "Depth:" (toString p.simulationDepth) else statRow "Distinct States:" (toString p.distinctStates)} - {if p.isSimulation then .text "" else statRow "Queue:" (toString p.queue)} + {match p.simulation with | some sim => statRow "Traces Run:" (toString sim.tracesRun) | none => statRow "Diameter:" (toString p.diameter)} + {match p.simulation with | some sim => statRow "Max Traces:" (toString sim.maxTraces) | none => statRow "States Found:" (toString p.statesFound)} + {match p.simulation with | some sim => statRow "Depth:" (toString sim.depth) | none => statRow "Distinct States:" (toString p.distinctStates)} + {match p.simulation with | some _ => .text "" | none => statRow "Queue:" (toString p.queue)} {statRow "Elapsed time:" (formatElapsedTime p.elapsedMs)}
- {if p.isSimulation then .text "" else metricsHistoryHtml p.history} - {if p.isSimulation then .text "" else actionCoverageHtml p.actionStats p.allActionLabels} + {match p.simulation with | some _ => .text "" | none => metricsHistoryHtml p.history} + {match p.simulation with | some _ => .text "" | none => actionCoverageHtml p.actionStats p.allActionLabels} {match p.compilationStatus with | .inProgress ms lines => if lines.isEmpty then .text "" else compilationLogHtml ms lines | .failed err => compilationFailureHtml err diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 2bab9f36..43de45c9 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -847,14 +847,18 @@ where match Json.parse line >>= FromJson.fromJson? (α := ModelChecker.Concrete.Progress) with | .ok p => if let some refs ← ModelChecker.Concrete.getProgressRefs instanceId then refs.progressRef.modify fun old => - let historyPoint : ModelChecker.Concrete.ProgressHistoryPoint := { - timestamp := p.elapsedMs - diameter := p.diameter - statesFound := p.statesFound - distinctStates := p.distinctStates - queue := p.queue - } - { p with allActionLabels := old.allActionLabels, history := old.history.push historyPoint } + let history := match p.simulation with + | some _ => old.history + | none => + let historyPoint : ModelChecker.Concrete.ProgressHistoryPoint := { + timestamp := p.elapsedMs + diameter := p.diameter + statesFound := p.statesFound + distinctStates := p.distinctStates + queue := p.queue + } + old.history.push historyPoint + { p with allActionLabels := old.allActionLabels, history } | .error _ => stderrAccum.modify (· ++ line) let stdoutTask ← IO.asTask (prio := .dedicated) child.stdout.readToEnd let waitTask ← IO.asTask (prio := .dedicated) child.wait From 242d22b96b630ac99e38db995bb92061144a6274 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 15:52:44 +0200 Subject: [PATCH 77/88] refactor(progress): consolidate viewer rendering --- Veil/Core/UI/Widget/ProgressViewer.lean | 31 ++++++++++++++++--------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/Veil/Core/UI/Widget/ProgressViewer.lean b/Veil/Core/UI/Widget/ProgressViewer.lean index 464e0289..1247f615 100644 --- a/Veil/Core/UI/Widget/ProgressViewer.lean +++ b/Veil/Core/UI/Widget/ProgressViewer.lean @@ -498,8 +498,23 @@ private def metricsHistoryHtml (history : Array ProgressHistoryPoint) : Html := /-- Convert Progress to Html for display, with optional Stop button. Uses TLC-style terminology. -/ -def progressToHtml (p : Progress) (instanceId? : Option Nat := none) : Html := -
+def progressToHtml (p : Progress) (instanceId? : Option Nat := none) : Html := Id.run do + let (progressRows, metricsHistory, actionCoverage) : Array Html × Html × Html := + match p.simulation with + | some sim => + (#[ + statRow "Traces Run:" (toString sim.tracesRun), + statRow "Max Traces:" (toString sim.maxTraces), + statRow "Depth:" (toString sim.depth), + ], .text "", .text "") + | none => + (#[ + statRow "Diameter:" (toString p.diameter), + statRow "States Found:" (toString p.statesFound), + statRow "Distinct States:" (toString p.distinctStates), + statRow "Queue:" (toString p.queue), + ], metricsHistoryHtml p.history, actionCoverageHtml p.actionStats p.allActionLabels) + return
{if p.isRunning then
@@ -518,16 +533,10 @@ def progressToHtml (p : Progress) (instanceId? : Option Nat := none) : Html :=
Done!
} - - {match p.simulation with | some sim => statRow "Traces Run:" (toString sim.tracesRun) | none => statRow "Diameter:" (toString p.diameter)} - {match p.simulation with | some sim => statRow "Max Traces:" (toString sim.maxTraces) | none => statRow "States Found:" (toString p.statesFound)} - {match p.simulation with | some sim => statRow "Depth:" (toString sim.depth) | none => statRow "Distinct States:" (toString p.distinctStates)} - {match p.simulation with | some _ => .text "" | none => statRow "Queue:" (toString p.queue)} - {statRow "Elapsed time:" (formatElapsedTime p.elapsedMs)} - + {.element "tbody" #[] (progressRows.push (statRow "Elapsed time:" (formatElapsedTime p.elapsedMs)))}
- {match p.simulation with | some _ => .text "" | none => metricsHistoryHtml p.history} - {match p.simulation with | some _ => .text "" | none => actionCoverageHtml p.actionStats p.allActionLabels} + {metricsHistory} + {actionCoverage} {match p.compilationStatus with | .inProgress ms lines => if lines.isEmpty then .text "" else compilationLogHtml ms lines | .failed err => compilationFailureHtml err From dbdae2cefc3ad3a9649b30b4dc518dce51eca223 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 16:34:33 +0200 Subject: [PATCH 78/88] test(simulation): avoid compiled-mode cases --- VeilTest/Regression/MultipleSimulate.lean | 4 ++-- VeilTest/Regression/SimulateAssumptions.lean | 4 ++-- VeilTest/Regression/SimulateModes.lean | 6 +++--- VeilTest/Regression/SimulateViolationModes.lean | 4 ++-- VeilTest/RequiresGenSpec.lean | 2 +- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/VeilTest/Regression/MultipleSimulate.lean b/VeilTest/Regression/MultipleSimulate.lean index 36023627..e32fd814 100644 --- a/VeilTest/Regression/MultipleSimulate.lean +++ b/VeilTest/Regression/MultipleSimulate.lean @@ -20,9 +20,9 @@ invariant [bounded] ∀ n, flag n -> flag n #gen_spec #guard_msgs(drop info) in -#simulate { node := Fin 2 } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted { node := Fin 2 } {} (seed := 1) (maxTraces := 1) (maxSteps := 1) #guard_msgs(drop info) in -#simulate { node := Fin 2 } {} (seed := 2) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted { node := Fin 2 } {} (seed := 2) (maxTraces := 1) (maxSteps := 1) end MultipleSimulate diff --git a/VeilTest/Regression/SimulateAssumptions.lean b/VeilTest/Regression/SimulateAssumptions.lean index 7ed972cc..f27a36d4 100644 --- a/VeilTest/Regression/SimulateAssumptions.lean +++ b/VeilTest/Regression/SimulateAssumptions.lean @@ -66,7 +66,7 @@ Seed: 1 assumptions_hold_by decide #guard_msgs(drop info, drop warning) in -#simulate compiled { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide @@ -75,7 +75,7 @@ info: ✅ No violation in 1 traces Seed: 1 -/ #guard_msgs in -#simulate { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } +#simulate interpreted { node := Fin 3 } { leader := fun n => n == (0 : Fin 3) } (seed := 1) (maxTraces := 1) (maxSteps := 1) assumptions_hold_by native_decide diff --git a/VeilTest/Regression/SimulateModes.lean b/VeilTest/Regression/SimulateModes.lean index e6155f79..bb0f3e38 100644 --- a/VeilTest/Regression/SimulateModes.lean +++ b/VeilTest/Regression/SimulateModes.lean @@ -26,19 +26,19 @@ Seed: 1 #simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) #guard_msgs(drop info, drop warning) in -#simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) set_option veil.simulate.maxTraces 1 in set_option veil.simulate.maxSteps 1 in #guard_msgs(drop info, drop warning) in -#simulate compiled {} +#simulate interpreted {} /-- info: ✅ No violation in 1 traces Seed: 1 -/ #guard_msgs in -#simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) set_option veil.simulate.maxTraces 2 in /-- diff --git a/VeilTest/Regression/SimulateViolationModes.lean b/VeilTest/Regression/SimulateViolationModes.lean index 75a4b973..2cdae613 100644 --- a/VeilTest/Regression/SimulateViolationModes.lean +++ b/VeilTest/Regression/SimulateViolationModes.lean @@ -31,7 +31,7 @@ Seed: 1 #guard_msgs(drop info, drop warning) in set_option veil.violationIsError false in -#simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) /-- error: ❌ Violation: safety_failure (violates: safe_flag) @@ -42,6 +42,6 @@ error: ❌ Violation: safety_failure (violates: safe_flag) Seed: 1 -/ #guard_msgs in -#simulate {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) +#simulate interpreted {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) end SimulateViolationModes diff --git a/VeilTest/RequiresGenSpec.lean b/VeilTest/RequiresGenSpec.lean index 24b34444..31d448bc 100644 --- a/VeilTest/RequiresGenSpec.lean +++ b/VeilTest/RequiresGenSpec.lean @@ -64,7 +64,7 @@ invariant ¬ flag /-- error: The specification of module TestSimulate has not been finalized. Please call #gen_spec first! -/ #guard_msgs in -#simulate { } +#simulate interpreted { } end TestSimulate From a2fd1093a8928df712ccb7dc6b0c9b784563778f Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 17:24:39 +0200 Subject: [PATCH 79/88] fix(model-checker): avoid per-command build folders --- Veil/Frontend/DSL/Module/Util/ForModelChecker.lean | 7 +++---- VeilTest/Regression/CompilationRegistryKey.lean | 5 +++++ 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index f4e1862b..e80a0c6d 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -81,11 +81,10 @@ def getBuildBaseDir : IO System.FilePath := do let pwd ← IO.currentDir return pwd / ".lake" / "model_checker_builds" -/-- Generate a build folder name based on the source file and exported command, -so distinct compiled command invocations do not race on the same temp project. -/ -def generateBuildFolderName (sourceFile : String) (command : CompiledCommandSpec) (commandId : String) : IO System.FilePath := do +/-- Generate a build folder name based on the source file and exported command. -/ +def generateBuildFolderName (sourceFile : String) (command : CompiledCommandSpec) (_commandId : String) : IO System.FilePath := do let stem := System.FilePath.mk sourceFile |>.fileStem.getD "unrecognized_model" - let suffix := toString (hash (sourceFile ++ ":" ++ command.exportedName ++ ":" ++ commandId)) + let suffix := toString (hash (sourceFile ++ ":" ++ command.exportedName)) let baseDir ← getBuildBaseDir return baseDir / s!"{stem}_{command.exportedName}_{suffix}" diff --git a/VeilTest/Regression/CompilationRegistryKey.lean b/VeilTest/Regression/CompilationRegistryKey.lean index 51733c5e..7e62bb0d 100644 --- a/VeilTest/Regression/CompilationRegistryKey.lean +++ b/VeilTest/Regression/CompilationRegistryKey.lean @@ -11,6 +11,11 @@ open Veil.ModelChecker.Compilation let simulateCommand : CompiledCommandSpec := { exportedName := "simulateResult" } + let modelCheckFolderA ← generateBuildFolderName sourceFile modelCheckCommand "model-check-a" + let modelCheckFolderB ← generateBuildFolderName sourceFile modelCheckCommand "model-check-b" + let simulateFolderA ← generateBuildFolderName sourceFile simulateCommand "simulate-a" + assert! (toString modelCheckFolderA == toString modelCheckFolderB) + assert! (toString modelCheckFolderA != toString simulateFolderA) let modelCheckBuildDirA := System.FilePath.mk "build/model-check-a" let modelCheckBuildDirB := System.FilePath.mk "build/model-check-b" let simulateBuildDirA := System.FilePath.mk "build/simulate-a" From b3ed49e7b91d37abcd74ecf714cc00098377e7c3 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 18:01:29 +0200 Subject: [PATCH 80/88] refactor(simulation): clarify config precedence --- Veil/Frontend/DSL/Module/Elaborators.lean | 42 +++++++++++-------- .../Regression/SimulateConfigDefaults.lean | 10 +++++ 2 files changed, 34 insertions(+), 18 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 43de45c9..c8791a1e 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -601,27 +601,31 @@ declare_command_config_elab elabModelCheckerConfig ModelCheckerConfig declare_command_config_elab elabSimulateConfig ModelChecker.Simulation.SimulateConfig -private partial def simulateConfigItems (cfgStx : Syntax) : TSyntaxArray ``Lean.Parser.Tactic.configItem := - if cfgStx.isOfKind nullKind then - cfgStx.getArgs.flatMap simulateConfigItems - else - match cfgStx with - | `(Lean.Parser.Tactic.optConfig| $items:configItem*) => items - | `(Lean.Parser.Tactic.config| (config := $_)) => #[⟨cfgStx⟩] - | _ => #[] - -/-- Check whether a particular config field was written explicitly in the command syntax. -/ +/-- +Check whether a particular config field was written explicitly in the command syntax. + +`elabSimulateConfig` returns a complete `SimulateConfig`, so omitted fields are +indistinguishable from fields explicitly written with their structure defaults +after elaboration. Inspect the raw `Parser.Tactic.optConfig` only for this +distinction. A `(config := cfg)` item is an opaque full `SimulateConfig`, so it +is treated as explicitly providing all fields rather than being overlaid with +global options. +-/ def simulateConfigHasField (cfgStx : Syntax) (fieldName : Name) : Bool := - Lean.Elab.Tactic.mkConfigItemViews (simulateConfigItems cfgStx) |>.any + Lean.Elab.Tactic.mkConfigItemViews (Lean.Parser.Tactic.getConfigItems cfgStx) |>.any (fun item => let optionName := item.option.getId.eraseMacroScopes optionName == fieldName || optionName == `config) +/-- Return which `#simulate` trace-bound fields were supplied by command syntax. -/ +private def simulateTraceBoundFieldsExplicit (cfgStx : Syntax) : Bool × Bool := + (simulateConfigHasField cfgStx `maxTraces, simulateConfigHasField cfgStx `maxSteps) + /-- Resolve `#simulate` trace-bound fields, preserving explicit default literals. -/ def resolveSimulateTraceBounds (cfg0 : ModelChecker.Simulation.SimulateConfig) - (hasMaxTraces hasMaxSteps : Bool) (optionMaxTraces optionMaxSteps : Nat) : Nat × Nat := - let maxTraces := if hasMaxTraces then cfg0.maxTraces else optionMaxTraces - let maxSteps := if hasMaxSteps then cfg0.maxSteps else optionMaxSteps + (commandHasMaxTraces commandHasMaxSteps : Bool) (optionMaxTraces optionMaxSteps : Nat) : Nat × Nat := + let maxTraces := if commandHasMaxTraces then cfg0.maxTraces else optionMaxTraces + let maxSteps := if commandHasMaxSteps then cfg0.maxSteps else optionMaxSteps (maxTraces, maxSteps) /-- Model checking mode: interpreted only, compiled only, or default (both with handoff). -/ @@ -1272,12 +1276,14 @@ def elabSimulate : CommandElab := fun stx => do mod.throwIfSpecNotFinalized let theoryTerm ← resolveTheoryTerm "#simulate" theoryTermOpt mod instTerm warnAboutTransitions mod - let cfg0 ← elabSimulateConfig stx[4] + let simulateCfgStx := stx[4] + let cfg0 ← elabSimulateConfig simulateCfgStx let opts ← getOptions - let hasMaxTraces := simulateConfigHasField stx[4] `maxTraces - let hasMaxSteps := simulateConfigHasField stx[4] `maxSteps + let (hasMaxTraces, hasMaxSteps) := simulateTraceBoundFieldsExplicit simulateCfgStx + let optionMaxTraces := veil.simulate.maxTraces.get opts + let optionMaxSteps := veil.simulate.maxSteps.get opts let (maxTraces, maxSteps) := resolveSimulateTraceBounds cfg0 hasMaxTraces hasMaxSteps - (veil.simulate.maxTraces.get opts) (veil.simulate.maxSteps.get opts) + optionMaxTraces optionMaxSteps let seed ← liftIO <| if cfg0.seed == 0 then IO.rand 0 0xFFFFFFFFFFFFFFFF else pure cfg0.seed let cfg : ModelChecker.Simulation.SimulateConfig := { cfg0 with maxTraces, maxSteps, seed } let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } diff --git a/VeilTest/Regression/SimulateConfigDefaults.lean b/VeilTest/Regression/SimulateConfigDefaults.lean index 1bdc90ae..2e460444 100644 --- a/VeilTest/Regression/SimulateConfigDefaults.lean +++ b/VeilTest/Regression/SimulateConfigDefaults.lean @@ -12,6 +12,16 @@ example : { maxTraces := 10000, maxSteps := 100, seed := 0 } false false 7 3 = (7, 3) := rfl +example : + Veil.resolveSimulateTraceBounds + { maxTraces := 10000, maxSteps := 100, seed := 0 } + true false 7 3 = (10000, 3) := rfl + +example : + Veil.resolveSimulateTraceBounds + { maxTraces := 10000, maxSteps := 100, seed := 0 } + false true 7 3 = (7, 100) := rfl + veil module SimulateConfigDefaults individual flag : Bool From e717e6cb3dbacda330d505f8cd804ac6f040ae4a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Sat, 6 Jun 2026 18:45:29 +0200 Subject: [PATCH 81/88] refactor(simulation): consolidate handoff cleanup --- Veil/Frontend/DSL/Module/Elaborators.lean | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index c8791a1e..2353f6af 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1217,6 +1217,9 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te let ioComputation ← elaborateSimulateComputation ctx.instanceId callExpr let compilationCancelTk ← IO.CancelToken.new liftIO <| ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId (some compilationCancelTk) + let finishCompilation (buildFolder : System.FilePath) : IO Unit := do + ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder + ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none let interpretedComputation ← Command.wrapAsyncAsSnapshot (fun () => do try let combinedJson ← IO.ofExcept (← ioComputation.toIO') @@ -1237,20 +1240,17 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te return if (← ModelChecker.Concrete.isViolationFound ctx.instanceId) || (← IO.hasFinished interpretedTask) || (← ModelChecker.Concrete.isCancelled ctx.instanceId) then - ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder - ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + finishCompilation buildFolder return ModelChecker.Concrete.requestHandoff ctx.instanceId ctx.cancelToken.set let _ ← IO.wait interpretedTask if (← ctx.cancelToken.isSet) && !(← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) then ModelChecker.Concrete.cancelProgress ctx.instanceId - ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder - ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + finishCompilation buildFolder return if (← ModelChecker.Concrete.getResultJson ctx.instanceId).isSome || (← ModelChecker.Concrete.isCancelled ctx.instanceId) then - ModelChecker.Compilation.markRegistryFinished sourceFile elabModelCheck.simulateCommandSpec commandId buildFolder - ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none + finishCompilation buildFolder return let some newCancelToken ← ModelChecker.Concrete.resetProgressForHandoff ctx.instanceId | return ModelChecker.Concrete.setCompilationCancelToken ctx.instanceId none From 535b23718eec6eda6832d7779a572d5ea5e73b6b Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 17 Jun 2026 21:37:57 +0200 Subject: [PATCH 82/88] test(simulation): add compiled smoke test --- .../Regression/SimulateCompiledSmoke.lean | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 VeilTest/Regression/SimulateCompiledSmoke.lean diff --git a/VeilTest/Regression/SimulateCompiledSmoke.lean b/VeilTest/Regression/SimulateCompiledSmoke.lean new file mode 100644 index 00000000..3d5c65b8 --- /dev/null +++ b/VeilTest/Regression/SimulateCompiledSmoke.lean @@ -0,0 +1,24 @@ +import Veil + +veil module SimulateCompiledSmoke + +individual flag : Bool + +#gen_state + +after_init { + flag := false +} + +action set_flag { + flag := true +} + +invariant [safe_flag] true + +#gen_spec + +#guard_msgs(drop info, drop warning) in +#simulate compiled {} {} (seed := 1) (maxTraces := 1) (maxSteps := 1) + +end SimulateCompiledSmoke From 2abddc65d68868870375927c602d11e21885b238 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 17 Jun 2026 22:19:53 +0200 Subject: [PATCH 83/88] fix(simulation): structure no-initial result metadata --- .../Tools/ModelChecker/Simulation/Basic.lean | 11 +++++++- .../ModelChecker/Simulation/Runtime.lean | 2 +- Veil/Core/UI/Trace/TraceDisplay.lean | 7 ++++- VeilTest/Regression/SimulateResultJson.lean | 27 +++++++++++++++++++ 4 files changed, 44 insertions(+), 3 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index b248dd6c..8f56b57a 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -1,6 +1,7 @@ import Veil.Core.Tools.ModelChecker.Interface namespace Veil.ModelChecker.Simulation +open Lean structure SimulateConfig where maxTraces : Nat := 10000 @@ -13,6 +14,14 @@ inductive SimulationResult (ρ σ κ : Type) where | foundViolation (violation : ViolationKind) (viaTrace : Trace ρ σ κ) deriving Inhabited, Repr +inductive SimulationTerminationReason where + | noInitialStates +deriving Inhabited, Hashable, BEq, Repr + +instance : ToJson SimulationTerminationReason where + toJson + | .noInitialStates => Json.mkObj [("kind", "no_initial_states")] + structure SimulateResult (ρ σ κ : Type) where result : Option (SimulationResult ρ σ κ) tracesRun : Nat @@ -20,6 +29,6 @@ structure SimulateResult (ρ σ κ : Type) where elapsedMs : Nat seed : Nat depth : Nat - terminationReason : Option String := none + terminationReason : Option SimulationTerminationReason := none end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 85c35a54..1072b4f9 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -11,7 +11,7 @@ private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : Sim elapsedMs := 0 seed := cfg.seed depth := 0 - terminationReason := some "no_initial_states" + terminationReason := some .noInitialStates } private def hasNoInitialStates {ρ σ κ : Type} {th₀ : ρ} diff --git a/Veil/Core/UI/Trace/TraceDisplay.lean b/Veil/Core/UI/Trace/TraceDisplay.lean index 5859bd73..1606c242 100644 --- a/Veil/Core/UI/Trace/TraceDisplay.lean +++ b/Veil/Core/UI/Trace/TraceDisplay.lean @@ -92,6 +92,11 @@ private def fmtSeedSuffix (j : Json) : String := let seed := j.getObjValD "seed" if seed == .null then "" else s!"\nSeed: {fmtJson seed}" +private def isNoInitialStatesTermination (j : Json) : Bool := + match j.getObjValD "termination_reason" with + | .obj reason => fmtJson ((Json.obj reason).getObjValD "kind") == "no_initial_states" + | _ => false + def formatModelCheckingResult (j : Json) : MessageData := match fmtJson (j.getObjValD "result") with | "found_violation" => @@ -105,7 +110,7 @@ def formatModelCheckingResult (j : Json) : MessageData := | "no_violation_found" => let trace := j.getObjValD "trace" if trace != .null then m!"✅ Satisfying trace found\n{formatTrace trace}{fmtSeedSuffix j}" - else if fmtJson (j.getObjValD "termination_reason") == "no_initial_states" then + else if isNoInitialStatesTermination j then m!"✅ No initial states available after applying state constraints{fmtSeedSuffix j}" else if j.getObjValD "traces_run" != .null then m!"✅ No violation in {fmtJson (j.getObjValD "traces_run")} traces{fmtSeedSuffix j}" diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean index fe4202b6..fb682ffb 100644 --- a/VeilTest/Regression/SimulateResultJson.lean +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -28,3 +28,30 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","se seed := 1 depth := 0 } : SimulateResult Unit Unit Unit)).compress + +/-- +info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","seed":1,"termination_reason":{"kind":"no_initial_states"},"traces_run":0} +-/ +#guard_msgs in +#eval IO.println <| (Lean.toJson ({ + result := none + tracesRun := 0 + maxTraces := 3 + elapsedMs := 0 + seed := 1 + depth := 0 + terminationReason := some .noInitialStates +} : SimulateResult Unit Unit Unit)).compress + +/-- +info: {"depth":4,"elapsed_ms":12,"max_traces":10,"result":"cancelled","seed":7,"traces_run":5} +-/ +#guard_msgs in +#eval IO.println <| (Lean.toJson ({ + result := some .cancelled + tracesRun := 5 + maxTraces := 10 + elapsedMs := 12 + seed := 7 + depth := 4 +} : SimulateResult Unit Unit Unit)).compress From 2e748261e224d9d29022e78e0645369b061f619f Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 17 Jun 2026 22:20:25 +0200 Subject: [PATCH 84/88] fix(progress): preserve cancelled simulation metadata --- Veil/Core/Tools/ModelChecker/Concrete/Progress.lean | 4 ++-- Veil/Frontend/DSL/Module/Elaborators.lean | 8 ++++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean index 22d1b92f..86386be0 100644 --- a/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean +++ b/Veil/Core/Tools/ModelChecker/Concrete/Progress.lean @@ -243,11 +243,11 @@ def setCompilationCancelToken (instanceId : Nat) (cancelToken? : Option IO.Cance withRefs instanceId fun refs => refs.compilationCancelTokenRef.set cancelToken? /-- Mark progress as cancelled for a given instance ID. -/ -def cancelProgress (instanceId : Nat) : IO Unit := withRefs instanceId fun refs => do +def cancelProgress (instanceId : Nat) (resultJson : Lean.Json := Json.mkObj [("result", "cancelled")]) : IO Unit := withRefs instanceId fun refs => do let now ← IO.monoMsNow refs.progressRef.modify fun p => { p with status := "Cancelled", isRunning := false, isCancelled := true, elapsedMs := now - p.startTimeMs } - refs.resultRef.set (some (Json.mkObj [("result", "cancelled")])) + refs.resultRef.set (some resultJson) /-- Wait for model check to complete and return the result JSON. -/ partial def waitForResult (instanceId : Nat) (pollIntervalMs : Nat := 100) : IO (Option Lean.Json) := do diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 2353f6af..e02f0188 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1153,7 +1153,7 @@ private def simulationResultWasCancelled (combinedJson : Json) : Bool := private def finishWithSimulationResult (ctx : ModelCheckContext) (combinedJson : Json) : CommandElabM Unit := do if simulationResultWasCancelled combinedJson then - liftIO <| ModelChecker.Concrete.cancelProgress ctx.instanceId + liftIO <| ModelChecker.Concrete.cancelProgress ctx.instanceId combinedJson else elabModelCheck.finishWithResult ctx combinedJson @@ -1224,7 +1224,11 @@ private def elabSimulateWithHandoff (mod : Module) (stx : Syntax) (callExpr : Te try let combinedJson ← IO.ofExcept (← ioComputation.toIO') match (← ctx.cancelToken.isSet, ← ModelChecker.Concrete.checkHandoffRequested ctx.instanceId) with - | (true, false) => ModelChecker.Concrete.cancelProgress ctx.instanceId + | (true, false) => + if simulationResultWasCancelled combinedJson then + finishWithSimulationResult ctx combinedJson + else + ModelChecker.Concrete.cancelProgress ctx.instanceId | (false, _) => finishWithSimulationResult ctx combinedJson | (true, true) => pure () catch e : Exception => From 9d4739521dd6213eb13c3bcba7c454d5ec1d9e75 Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Wed, 17 Jun 2026 22:20:57 +0200 Subject: [PATCH 85/88] fix(widget): render simulation result metadata --- widget/src/traceDisplay.tsx | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/widget/src/traceDisplay.tsx b/widget/src/traceDisplay.tsx index a564acb9..c7856fe1 100644 --- a/widget/src/traceDisplay.tsx +++ b/widget/src/traceDisplay.tsx @@ -52,7 +52,7 @@ interface EarlyTerminationCondition { } interface TerminationReason { - kind: "explored_all_reachable_states" | "early_termination" | "reached_trace_limit"; + kind: "explored_all_reachable_states" | "early_termination" | "reached_trace_limit" | "no_initial_states"; condition?: EarlyTerminationCondition; traces_run?: number; max_traces?: number; @@ -88,6 +88,8 @@ type ModelCheckingResult = } | { result: "cancelled"; + traces_run?: number; + max_traces?: number; seed?: number; } | { @@ -317,12 +319,17 @@ const ResultHeader: React.FC<{ ) : null; if (resultType === "cancelled") { + const details = tracesRun !== undefined && maxTraces !== undefined + ? `Checked ${tracesRun}/${maxTraces} traces before cancellation` + : tracesRun !== undefined + ? `Checked ${tracesRun} traces before cancellation` + : 'Run was cancelled before completion'; return (
⊘ Cancelled
- Model checking was cancelled before completion + {details}
{seedDetails}
@@ -396,6 +403,9 @@ const ResultHeader: React.FC<{ } return `Checked configured trace budget`; } + if (reason.kind === "no_initial_states") { + return `No initial states available after applying state constraints`; + } if (reason.kind === "early_termination" && reason.condition) { switch (reason.condition.kind) { case "found_violating_state": @@ -835,7 +845,12 @@ const ModelCheckerView: React.FC = ({ {'result' in result && ( <> {result.result === "cancelled" ? ( - + ) : result.result === "no_violation_found" ? ( Date: Wed, 17 Jun 2026 23:26:22 +0200 Subject: [PATCH 86/88] refactor(simulation): derive result depth from traces --- .../Tools/ModelChecker/Simulation/Basic.lean | 10 ++- .../Tools/ModelChecker/Simulation/Path.lean | 10 +-- .../ModelChecker/Simulation/Runtime.lean | 11 +-- .../ModelChecker/Simulation/Soundness.lean | 80 +++---------------- VeilTest/Regression/SimulateResultJson.lean | 23 ++++-- 5 files changed, 46 insertions(+), 88 deletions(-) diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean index 8f56b57a..27b0e6d1 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Basic.lean @@ -14,6 +14,10 @@ inductive SimulationResult (ρ σ κ : Type) where | foundViolation (violation : ViolationKind) (viaTrace : Trace ρ σ κ) deriving Inhabited, Repr +def SimulationResult.depth {ρ σ κ : Type} : SimulationResult ρ σ κ → Nat + | .foundViolation _ trace => trace.steps.size + if trace.failingStep.isSome then 1 else 0 + | .cancelled => 0 + inductive SimulationTerminationReason where | noInitialStates deriving Inhabited, Hashable, BEq, Repr @@ -28,7 +32,11 @@ structure SimulateResult (ρ σ κ : Type) where maxTraces : Nat elapsedMs : Nat seed : Nat - depth : Nat terminationReason : Option SimulationTerminationReason := none +def SimulateResult.depth {ρ σ κ : Type} (result : SimulateResult ρ σ κ) : Nat := + match result.result with + | some result => result.depth + | none => 0 + end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean index 7aafa8c8..3984b30b 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Path.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Path.lean @@ -11,10 +11,6 @@ theorem randNat_lt_length {α : Type} (xs : List α) (h : xs ≠ []) (gen : StdG simp [Nat.not_lt.mpr (Nat.zero_le (xs.length - 1)), hk] exact Nat.mod_lt _ hlen -private def SimulationResult.depth {ρ σ κ : Type} : SimulationResult ρ σ κ → Nat - | .foundViolation _ trace => trace.steps.size + if trace.failingStep.isSome then 1 else 0 - | .cancelled => 0 - @[inline, specialize] def simulateOnceLoop {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -91,7 +87,7 @@ def simulateOnce {ρ σ κ : Type} {th₀ : ρ} /-- Simulates the trace identified by `traceIndex` using seed `cfg.seed + traceIndex`. -Returns the first violation found by that trace together with its derived trace depth. +Returns the first violation found by that trace. -/ def simulateTraceAtIndex {ρ σ κ : Type} {th₀ : ρ} (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -99,9 +95,9 @@ def simulateTraceAtIndex {ρ σ κ : Type} {th₀ : ρ} (th : ρ) (cfg : SimulateConfig) (traceIndex : Nat) - : Option (SimulationResult ρ σ κ × Nat) := + : Option (SimulationResult ρ σ κ) := let traceSeed := cfg.seed + traceIndex let (maybeResult, _) := (simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed) - maybeResult.map (fun result => (result, SimulationResult.depth result)) + maybeResult end Veil.ModelChecker.Simulation diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean index 1072b4f9..bf99f3c7 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Runtime.lean @@ -10,7 +10,6 @@ private def noInitialStatesResult {ρ σ κ : Type} (cfg : SimulateConfig) : Sim maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed - depth := 0 terminationReason := some .noInitialStates } @@ -39,7 +38,6 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed - depth := 0 } match remaining with | 0 => @@ -49,12 +47,11 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed - depth := 0 } | remaining + 1 => hooks.onTraceProgress traceIndex match simulateTraceAtIndex sys params th cfg traceIndex with - | some (result, stepsUsed) => + | some result => hooks.onViolation return { result := some result @@ -62,7 +59,6 @@ private def simulateLoopM {m : Type → Type} [Monad m] {ρ σ κ : Type} {th₀ maxTraces := cfg.maxTraces elapsedMs := 0 seed := cfg.seed - depth := stepsUsed } | none => simulateLoopM hooks sys params th cfg remaining (traceIndex + 1) @@ -179,10 +175,9 @@ private theorem simulateLoopM_id_sound {ρ σ κ : Type} · simpa [simulateLoopM, hStop, hTrace, Id.instMonad] using ih (traceIndex + 1) · cases hRun : simulateTraceAtIndex sys params th cfg traceIndex with | none => contradiction - | some pair => - rcases pair with ⟨result, depth⟩ + | some result => simpa [simulateLoopM, hStop, hRun, Id.instMonad] using - simulateTraceAtIndex_sound th sys params cfg traceIndex result depth hRun + simulateTraceAtIndex_sound th sys params cfg traceIndex result hRun theorem simulateCommandSemantics_sound {ρ σ κ : Type} [DecidableEq σ] [DecidableEq κ] diff --git a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean index 33fb6287..fa30ae37 100644 --- a/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean +++ b/Veil/Core/Tools/ModelChecker/Simulation/Soundness.lean @@ -37,53 +37,6 @@ theorem pickedInitialState_valid {ρ σ κ : Type} · simp [EnumerableTransitionSystem.toRelational] · simpa [EnumerableTransitionSystem.toRelational, hInitStates] using hSelected -private theorem pushedTrace_valid {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] - (th : ρ) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) - (currSt : σ) - (trace : Trace ρ σ κ) - (hTheory : trace.theory = th) - (hValid : trace.isValid sys.toRelational) - (hLast : trace.lastState = currSt) - (hNoFail : trace.failingStep = none) - (nexts : List (κ × σ)) - (hNexts : nexts = (Veil.ModelChecker.Concrete.partitionExecutionOutcome - (sys.tr th currSt)).fst) - (selected : κ × σ) - (hSelected : selected ∈ nexts) : - let trace' := trace.push { transitionLabel := selected.1, nextState := selected.2 } - trace'.isValid sys.toRelational ∧ - trace'.theory = th ∧ - trace'.lastState = selected.2 ∧ - trace'.failingStep = none := by - intro trace' - have hRel : sys.toRelational.tr th currSt selected.1 selected.2 := - pickedTransition_valid th sys params currSt nexts hNexts selected hSelected - have hValid' : trace'.isValid sys.toRelational := by - exact Trace.push_isValid trace { transitionLabel := selected.1, nextState := selected.2 } - sys.toRelational hValid (by simpa [hTheory, hLast] using hRel) - exact ⟨hValid', by simpa [trace', hTheory], by simp [trace'], by simpa [trace', hNoFail]⟩ - -private theorem initialTrace_valid {ρ σ κ : Type} - [DecidableEq σ] [DecidableEq κ] - (th : ρ) - (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th) - (params : SearchParameters ρ σ) - (initStates : List σ) - (hInitStates : initStates = sys.initStates) - (selectedInit : σ) - (hSelected : selectedInit ∈ initStates) : - let trace : Trace ρ σ κ := { theory := th, initialState := selectedInit, steps := #[] } - trace.isValid sys.toRelational ∧ - trace.theory = th ∧ - trace.lastState = selectedInit ∧ - trace.failingStep = none := by - intro trace - have hValid := pickedInitialState_valid th sys params initStates hInitStates selectedInit hSelected - exact ⟨by simpa [trace] using hValid, rfl, by simp [trace], by simp [trace]⟩ - def Trace.witnessesSimulationViolation {ρ σ κ : Type} {th₀ : ρ} [DecidableEq σ] [DecidableEq κ] (sys : EnumerableTransitionSystem ρ (List ρ) σ (List σ) Int κ (List (κ × ExecutionOutcome Int σ)) th₀) @@ -219,14 +172,15 @@ theorem simulateOnceLoop_sound {ρ σ κ : Type} have hNextsHd : nexts' = (Veil.ModelChecker.Concrete.partitionExecutionOutcome (sys.tr th currSt)).fst := by simp [nexts', hPartition, hNexts] - have hTrace' := pushedTrace_valid th sys params currSt trace hTheory hValid hLast hNoFail - nexts' hNextsHd selected hSelected + have hRel : sys.toRelational.tr th currSt selected.1 selected.2 := + pickedTransition_valid th sys params currSt nexts' hNextsHd selected hSelected have hValid' : trace'.isValid sys.toRelational := by - simpa [trace'] using hTrace'.1 + exact Trace.push_isValid trace { transitionLabel := selected.1, nextState := selected.2 } + sys.toRelational hValid (by simpa [hTheory, hLast] using hRel) have hTheory' : trace'.theory = th := by - simpa [trace'] using hTrace'.2.1 + simpa [trace', hTheory] have hNoFail' : trace'.failingStep = none := by - simpa [trace'] using hTrace'.2.2.2 + simpa [trace', hNoFail] have hLast' : trace'.lastState = selected.2 := by simp [trace'] cases hViol : (violatedInvariantNames params th selected.2).isEmpty with @@ -287,9 +241,9 @@ theorem simulateOnce_sound {ρ σ κ : Type} exact List.get_mem initStates ⟨idx, hlt⟩ have hInitStates : initStates = sys.initStates := by simp [initStates, hStates] - have hInit := initialTrace_valid th sys params initStates hInitStates selectedInit hSelectedInit have hValid : initTrace.isValid sys.toRelational := by - simpa [initTrace] using hInit.1 + simpa [initTrace] using + pickedInitialState_valid th sys params initStates hInitStates selectedInit hSelectedInit have hLast : initTrace.lastState = selectedInit := by simp [initTrace] have hNoFail : initTrace.failingStep = none := by @@ -330,22 +284,14 @@ theorem simulateTraceAtIndex_sound {ρ σ κ : Type} (params : SearchParameters ρ σ) (cfg : SimulateConfig) (traceIndex : Nat) - (result : SimulationResult ρ σ κ) (depth : Nat) : - simulateTraceAtIndex sys params th cfg traceIndex = some (result, depth) -> + (result : SimulationResult ρ σ κ) : + simulateTraceAtIndex sys params th cfg traceIndex = some result -> ReportedViolationSound sys params (some result) := by intro h unfold simulateTraceAtIndex at h set traceSeed := cfg.seed + traceIndex - rcases hSim : (simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed) with ⟨maybeResult, gen'⟩ - simp [traceSeed, hSim] at h - rcases h with ⟨hSome, rfl⟩ - cases hMaybe : maybeResult with - | none => simp [hMaybe] at hSome - | some result' => - simp [hMaybe] at hSome - subst hSome - have hSimSome : ((simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed)).1 = some result' := by - simp [hSim, hMaybe] - exact simulateOnce_sound th sys params (mkStdGen traceSeed) cfg.maxSteps result' hSimSome + have hSimSome : ((simulateOnce sys params th cfg.maxSteps).run (mkStdGen traceSeed)).1 = some result := by + simpa [traceSeed] using h + exact simulateOnce_sound th sys params (mkStdGen traceSeed) cfg.maxSteps result hSimSome end Veil.ModelChecker.Simulation diff --git a/VeilTest/Regression/SimulateResultJson.lean b/VeilTest/Regression/SimulateResultJson.lean index fb682ffb..8f9744d1 100644 --- a/VeilTest/Regression/SimulateResultJson.lean +++ b/VeilTest/Regression/SimulateResultJson.lean @@ -13,7 +13,6 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","se maxTraces := 3 elapsedMs := 0 seed := 1 - depth := 0 } : SimulateResult Unit Unit Unit)).compress /-- @@ -26,7 +25,6 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","se maxTraces := 3 elapsedMs := 0 seed := 1 - depth := 0 } : SimulateResult Unit Unit Unit)).compress /-- @@ -39,12 +37,11 @@ info: {"depth":0,"elapsed_ms":0,"max_traces":3,"result":"no_violation_found","se maxTraces := 3 elapsedMs := 0 seed := 1 - depth := 0 terminationReason := some .noInitialStates } : SimulateResult Unit Unit Unit)).compress /-- -info: {"depth":4,"elapsed_ms":12,"max_traces":10,"result":"cancelled","seed":7,"traces_run":5} +info: {"depth":0,"elapsed_ms":12,"max_traces":10,"result":"cancelled","seed":7,"traces_run":5} -/ #guard_msgs in #eval IO.println <| (Lean.toJson ({ @@ -53,5 +50,21 @@ info: {"depth":4,"elapsed_ms":12,"max_traces":10,"result":"cancelled","seed":7," maxTraces := 10 elapsedMs := 12 seed := 7 - depth := 4 +} : SimulateResult Unit Unit Unit)).compress + +/-- +info: {"depth":2,"elapsed_ms":0,"max_traces":3,"result":"found_violation","seed":1,"state_fingerprint":null,"trace":{"states":[{"fields":"()","index":0,"transition":"after_init"},{"fields":"()","index":1,"transition":"()"},{"failing":true,"fields":"()","index":2,"transition":"()"}],"theory":"()"},"traces_run":1,"violation":{"exception_id":5,"kind":"assertion_failure"}} +-/ +#guard_msgs in +#eval IO.println <| (Lean.toJson ({ + result := some (.foundViolation (.assertionFailure 5) ({ + theory := () + initialState := () + steps := #[{ transitionLabel := (), nextState := () }] + failingStep := some { transitionLabel := (), nextState := () } + } : Trace Unit Unit Unit)) + tracesRun := 1 + maxTraces := 3 + elapsedMs := 0 + seed := 1 } : SimulateResult Unit Unit Unit)).compress From 90cb9de24bc359b3256ef92ff6d49e11bda5b51f Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 18 Jun 2026 00:35:50 +0200 Subject: [PATCH 87/88] fix(model-checker): preserve compiled build cache --- .../DSL/Module/Util/ForModelChecker.lean | 6 ++---- .../Regression/CompilationRegistryKey.lean | 19 +++++++++++++++++++ 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean index e80a0c6d..74bfc012 100644 --- a/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean +++ b/Veil/Frontend/DSL/Module/Util/ForModelChecker.lean @@ -168,14 +168,12 @@ def main (args : List String) : IO Unit := do " /-- Create the temp build folder with all necessary files. -Returns the absolute path to the build folder. -/ +Returns the absolute path to the build folder. Generated inputs are overwritten +on each call while preserving the Lake build cache in the folder. -/ def createBuildFolder (sourceFile : String) (modelSource : String) (specNamespace : String) (command : CompiledCommandSpec) (commandId : String) : IO System.FilePath := do let veilPath ← IO.currentDir let buildFolder ← generateBuildFolderName sourceFile command commandId - -- Recreate the build folder from scratch to avoid stale Lake state from prior runs. - if ← buildFolder.pathExists then - IO.FS.removeDirAll buildFolder IO.FS.createDirAll buildFolder -- Write the lakefile IO.FS.writeFile (buildFolder / "lakefile.lean") lakefileTemplate diff --git a/VeilTest/Regression/CompilationRegistryKey.lean b/VeilTest/Regression/CompilationRegistryKey.lean index 7e62bb0d..92c173a2 100644 --- a/VeilTest/Regression/CompilationRegistryKey.lean +++ b/VeilTest/Regression/CompilationRegistryKey.lean @@ -36,3 +36,22 @@ open Veil.ModelChecker.Compilation markRegistryFinished sourceFile simulateCommand "simulate-a" simulateBuildDirA markRegistryFinished sourceFile simulateCommand "simulate-b" simulateBuildDirB markRegistryFinished sourceFile simulateCommand "simulate-c" simulateBuildDirC + +#eval do + let sourceFile := "/tmp/compilation-build-folder-cache.lean" + let command : CompiledCommandSpec := { + exportedName := "simulateResult" + } + let firstSource := "namespace CacheFirst\nend CacheFirst\n" + let secondSource := "namespace CacheSecond\nend CacheSecond\n" + let firstFolder ← createBuildFolder sourceFile firstSource "CacheFirst" command "simulate-cache" + let cacheDir := firstFolder / ".lake" / "build" + IO.FS.createDirAll cacheDir + let cacheSentinel := cacheDir / "cache-sentinel" + IO.FS.writeFile cacheSentinel "cached" + let secondFolder ← createBuildFolder sourceFile secondSource "CacheSecond" command "simulate-cache" + assert! (toString firstFolder == toString secondFolder) + assert! (← cacheSentinel.pathExists) + assert! ((← IO.FS.readFile (secondFolder / "Model.lean")) == secondSource) + assert! ((← IO.FS.readFile (secondFolder / "ModelCheckerMain.lean")) == modelCheckerMainTemplate "CacheSecond" command) + assert! ((← IO.FS.readFile (secondFolder / "lakefile.lean")) == lakefileTemplate) From 0d5d0f43e04722778cd783e62fccfcd24d59603a Mon Sep 17 00:00:00 2001 From: Ranadeep Biswas Date: Thu, 18 Jun 2026 01:25:53 +0200 Subject: [PATCH 88/88] fix(simulation): generate executable definitions for simulate --- Veil/Frontend/DSL/Module/Elaborators.lean | 1 + 1 file changed, 1 insertion(+) diff --git a/Veil/Frontend/DSL/Module/Elaborators.lean b/Veil/Frontend/DSL/Module/Elaborators.lean index 5cc4da3a..78726036 100644 --- a/Veil/Frontend/DSL/Module/Elaborators.lean +++ b/Veil/Frontend/DSL/Module/Elaborators.lean @@ -1302,6 +1302,7 @@ def elabSimulate : CommandElab := fun stx => do let mcCfg : ModelCheckerConfig := { maxDepth := 0, sequential := false, parallelCfg := none } if assumptionsHoldBy.isSome && !(← isModelCheckCompileMode) && !mod.assumptions.isEmpty then elabModelCheck.checkTheorySatisfiesAssumptions mod instTerm theoryTerm assumptionsHoldBy + mod.ensureExecutableModelCheckerDefinitions let sp ← buildSearchParameters mod mcCfg let runtimeCallExpr ← mkSimulatorRuntimeCall mod instTerm theoryTerm sp cfg if ← isModelCheckCompileMode then